'===========================================================================
' Subject: 24BIT TGA VIEWER                  Date: 02-19-97 (21:10)       
' Author:  Jeff Ward                         Code: QB, QBasic, PDS        
' Origin:  dward@mesa5.mesa.colorado.edu   Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB ClosePset (x!, y!, r!, g!, b!)
DECLARE SUB FastPal (clr, red!, green!, blue!)

' TGANEW.BAS   by Jeff Ward  FOR PLAIN OLD QBASIC! :)
' -----------------------------------------------------------------------
'  This was something I whipped up in a hurry. It does 24bit
'  images at any size (the screen limits us to 320x200).  It uses the
'  3-2-2 palette to emulate 24 bit color.  Looks pretty nice on most
'  images, but 16 million colors is hard to squeeze into 255 attribs.
'  They look best when the image is a scanned photo or such, worst
'  when it contains a ton of shades of the same color.

SCREEN 13
FOR r = 0 TO 63 STEP 9                       ' This sets and shows our
 FOR g = 0 TO 63 STEP 9                      ' all-purpose, handy dandy
  FOR b = 0 TO 63 STEP 21                    ' 3-2-2 palette.  It has
   FastPal x, r, g, b: x = x + 1             ' all the color that could be
   PSET (x, 199), x                          ' jammed into 256 attributes
  NEXT b
 NEXT g
NEXT r
INPUT "Enter filename:", f$
OPEN f$ FOR BINARY AS 1
IF LOF(1) = 0 THEN CLOSE : KILL f$: PRINT "File not found!": END

' This next portion finds the size of the image
a$ = " ": b$ = a$: c$ = b$: d$ = c$
GET #1, 13, a$
GET #1, 14, b$
GET #1, 15, c$
GET #1, 16, d$
a = ASC(a$): b = ASC(b$): c = ASC(c$): d = ASC(d$)
PRINT a, b, c, d
IF b = 0 THEN xx = a ELSE xx = (256 * b) + a
IF d = 0 THEN yy = c ELSE yy = (256 * d) + c

' This next portion displays
x = 0: y = 0
FOR i = 1 TO xx * yy * 3 STEP 12000
 a$ = SPACE$(12000)                  ' It loads faster if you load a heap of
 GET #1, i + 18, a$                  ' it and then chop it up in the memory.
 FOR z = 0 TO 11999 STEP 3           ' I'm going by STEP 3 all these times
  b = ASC(MID$(a$, 1 + z, 1))        ' because TGAs format is (except for
  g = ASC(MID$(a$, 2 + z, 1))        ' the header) BGR over and over!
  r = ASC(MID$(a$, 3 + z, 1))        ' ClosePset is our magicical sub! It
  ClosePset x, y, r, g, b            ' finds the closest color to true RGB
  x = x + 1                          ' in the 3-2-2 palette and PSETs it.
  IF x = xx THEN x = 0: y = y + 1
 NEXT z
NEXT

' It is slow, but I just whipped this up as I said.

SUB ClosePset (x, y, r, g, b)
r = INT(r / 32)
g = INT(g / 32)
b = INT(b / 64)
PSET (x, y), ((r * 32) + (g * 4) + b)
END SUB

SUB FastPal (clr, red, green, blue)
 OUT &H3C8, clr
 OUT &H3C9, red
 OUT &H3C9, green
 OUT &H3C9, blue
END SUB

SUB StorePal (clr, OldR, OldG, OldB)
OUT &H3C7, clr
OldR = INP(&H3C9)
OldG = INP(&H3C9)
OldB = INP(&H3C9)
END SUB