'===========================================================================
' Subject: QUICK IMAGE CONVERTER             Date: 05-11-97 (14:59)       
' Author:  Tika Carr                         Code: QB, QBasic, PDS        
' Origin:  t.carr@juno.com                 Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB MakeProg ()
DECLARE SUB BMPLoad ()
DECLARE SUB PCXLoad ()
DECLARE SUB TGALoad ()
DECLARE SUB Menu ()
DEFINT A-Z

' QIMCV.BAS
' Quick Image Converter 1.0
' by Tika Carr
' May 4, 1997
'
' Freeware:
'
' This program can be used as you please, as long as you give credit to
' the respective author(s).
'
' No warranties or guarantees are expressed or implied.
'
' Credits:
'
' Tika Carr       (t.carr@juno.com)            Put together the pieces :)
' Dave Shea                                    BMP Decoder
' Jonathan Leger  (leger@mail.dtx.net)         PCX Decoder
' Erika Schulze   (100775.2275@compuserve.com) TGA Decoder
' Earl Montgomery                              Load/Save QIM format
'
' Special thanks to others in the FidoNet QUIK_BAS Echo who helped
' contribute ideas to this project.
'
' Description:
'
' Quick Image Converter will convert 256 color 320 x 200 images saved in
' BMP, PCX or TGA format (sorry, no GIF due to licensing requirements).
' TGA images must be saved in uncompressed format. The result is a
' .QIM file, that can be quickly BLOADed into your programs:
'
' Block 1:  QuickBasic BLOADable Image (64006 bytes)
' Block 2:  Palette information        (768 bytes)
'   Total:  Total File Size            (64774)
'
' This program also saves a .BAS file that you can merge into your programs
' and display the QIM file.
'
' Revision History:
'
' 1.0         5/4/1997       Put together different sources, and created
'                            main and sub menus.

'**** Startup ****
TYPE tga
	info AS STRING * 1
	clr  AS STRING * 1
	img  AS STRING * 1
	orig AS INTEGER
	col  AS INTEGER
	bits AS STRING * 1
	xval AS INTEGER
	yval AS INTEGER
	w    AS INTEGER
	h    AS INTEGER
	pix  AS STRING * 1
	desc AS STRING * 1
END TYPE

'**** Main Program ****

SCREEN 0, 0, 0: WIDTH 80: COLOR 15, 1: CLS

PRINT TAB(25); CHR$(219) + CHR$(178) + CHR$(177) + CHR$(176);
PRINT " Quick Image Converter ";
PRINT CHR$(176) + CHR$(177) + CHR$(178) + CHR$(219)
PRINT TAB(34); "by Tika Carr"

LOCATE 7
PRINT TAB(25); "[L] Load an Image"
PRINT TAB(25); "[D] Get a Directory Listing"
PRINT TAB(25); "[Q] Quit Program"
PRINT : PRINT : COLOR 10
PRINT TAB(25); "While viewing picture:"
PRINT
PRINT TAB(25); "[S] Save screen"
PRINT TAB(25); "[E] Exit to main menu without saving"
PRINT TAB(25); "[Q] Quit program without saving"

DO: P$ = LCASE$(INPUT$(1)): LOOP WHILE INSTR("ldqv", P$) = 0

IF P$ = "q" THEN COLOR 7, 0: CLS : END
IF P$ = "d" THEN COLOR 7, 0: CLS : SHELL "dir /w /p": SLEEP: RUN

COLOR 11: LOCATE 23, 3
WHILE format$ <> "bmp" AND format$ <> "tga" AND format$ <> "pcx"
	PRINT "File to load (MUST give BMP, PCX or TGA ext) ENTER = Menu: ";
	LINE INPUT file$
	IF file$ = "" THEN RUN
	IF LEN(file$) > 4 THEN format$ = LCASE$(RIGHT$(file$, 3))
WEND

LOCATE 23, 3: PRINT SPACE$(70); : LOCATE 23, 3
PRINT "Image Filename (no ext): "; : LINE INPUT img$
LOCATE 23, 3: PRINT SPACE$(70); : LOCATE 23, 3
PRINT "BASIC Program Name (no ext) or ENTER for same as Image: ";
LINE INPUT BAS$

IF BAS$ = "" THEN BAS$ = img$ + ".BAS" ELSE BAS$ = BAS$ + ".BAS"
img$ = img$ + ".QIM"

SCREEN 13

'**** Load A BMP Image
IF format$ = "bmp" THEN
	LOCATE 10, 5: PRINT "Please wait for image to load."
	SLEEP 2: CLS
	OPEN file$ FOR BINARY AS #1
		h$ = SPACE$(14): s$ = SPACE$(4)
		GET #1, 1, h$: GET #1, 15, s$: bz = CVI(s$)
		IF bz = 12 THEN
			P$ = SPACE$(768)
		ELSEIF bz = 40 THEN P$ = SPACE$(1024)
		ELSE SCREEN 0, 0, 0: WIDTH 80: CLS : PRINT "Unable to load BMP image.": END
		END IF
		i$ = SPACE$(bz): GET #1, 15, i$: nb = CVI(MID$(i$, 15, 4))
		IF nb <> 8 THEN END
		GET #1, bz + 15, P$
		IF bz = 40 THEN ng = 4 ELSE ng = 3
		FOR x = 1 TO LEN(P$) STEP ng
			b# = INT((ASC(MID$(P$, x, 1))) / 4)
			g# = INT((ASC(MID$(P$, x + 1, 1))) / 4)
			r# = INT((ASC(MID$(P$, x + 2, 1))) / 4)
			c# = b# * 65536# + g# * 256# + r#: PALETTE ((x - 1) / ng), c#
		NEXT
		y = 199: d$ = " "
		WHILE y >= 0
			x = 0: WHILE x < 320: GET 1, , d$: PSET (x, y), ASC(d$): x = x + 1: WEND
			y = y - 1
		WEND
	CLOSE #1
END IF

'**** Load a PCX Image
IF format$ = "pcx" THEN
	DIM q AS STRING * 768, ver AS STRING * 1

	OPEN file$ FOR BINARY AS #1
		GET #1, 2, ver
		IF ASC(ver) <> 5 THEN
			SCREEN 0, 0, 0, 0: WIDTH 80: CLS
			PRINT "Unable to load PCX Image"
			END
		END IF
		GET #1, LOF(1) - 767, q
		FOR i = 1 TO 768 STEP 3: OUT &H3C8, P
			r = INT(ASC(MID$(q, i, 1)) / 4): OUT &H3C9, r
			g = INT(ASC(MID$(q, i + 1, 1)) / 4): OUT &H3C9, g
			b = INT(ASC(MID$(q, i + 2, 1)) / 4): OUT &H3C9, b
			P = P + 1
		NEXT
		SEEK #1, 129
		ds = 2000: dat$ = INPUT$(ds, 1): dc = 1
		FOR half = 1 TO 2
			DEF SEG = &HA000 + ofs
			FOR c = 0 TO 31999
				IF dc > ds THEN dat$ = INPUT$(ds, 1): dc = 1
				cl = ASC(MID$(dat$, dc, 1))
				dc = dc + 1
				IF dc > ds THEN : dat$ = INPUT$(ds, 1): dc = 1
				IF cl > 192 THEN
					LPS = cl - 192: cl = ASC(MID$(dat$, dc, 1)): dc = dc + 1
					FOR L = LPS TO 1 STEP -1: POKE c, cl: c = c + 1: NEXT: c = c - 1
				ELSE POKE c, cl
				END IF
			NEXT
			ofs = ofs + &H7D0
		NEXT
		DEF SEG
	CLOSE #1
END IF

'**** Load a TGA Image
IF format$ = "tga" THEN
	DIM hdr AS tga

	OPEN file$ FOR BINARY AS #1: GET #1, 1, hdr: CLOSE #1

	OPEN file$ FOR BINARY AS #1
		IF ASC(hdr.clr) <> 1 OR ASC(hdr.img) <> 1 THEN
			SCREEN 0, 0, 0, 0: WIDTH 80: CLS
			PRINT "Unable to load TGA file."
			END
		END IF
		dcl = hdr.col * ASC(hdr.bits) / 8: dcs& = 19 + ASC(hdr.info)
		dce& = dcs& + dcl%
		SEEK #1, dcs&
		FOR reg = 0 TO 255
			t$ = SPACE$(3): GET #1, , t$
			r = ASC(MID$(t$, 3)) \ 4: g = ASC(MID$(t$, 2)) \ 4
			b = ASC(MID$(t$, 1)) \ 4
			OUT &H3C8, reg: OUT &H3C9, r: OUT &H3C9, g: OUT &H3C9, b
		NEXT
		SEEK #1, dce&: t$ = SPACE$(1)
		FOR y = 0 TO hdr.h - 1: FOR x = 0 TO hdr.w - 1
			GET #1, , t$: col = ASC(t$): PSET (x, y), col
		NEXT x, y
	CLOSE #1
END IF

'**** Save Image (or Exit to menu or quit) ****'
DO
	QI$ = LCASE$(INPUT$(1))
 
	'**** Save to .QIM File Format ****

	IF QI$ = "s" THEN  'Save Screen & palette
		DEF SEG = &HA000 + 4000
		OUT &H3C7, 0
		FOR x = 0 TO 767: cv = INP(&H3C9): POKE x, cv: NEXT
		DEF SEG = &HA000
		BSAVE img$, 0, 63999 + 768
 
		'**** Save a .BAS file loader
		OPEN BAS$ FOR OUTPUT AS #1
			PRINT #1, "' Loader for " + img$
			PRINT #1, "' by Earl Montgomery"
			PRINT #1, ""
			PRINT #1, "DEFINT A-Z"
			PRINT #1, ""
			PRINT #1, "SCREEN 13"
			PRINT #1, "OUT &H3C8, 0"
			PRINT #1, "FOR x = 0 TO 767: OUT &H3C9, 0: NEXT"
			PRINT #1, "DEF SEG = &HA000"
			PRINT #1, "BLOAD " + CHR$(34) + img$ + CHR$(34) + ", 0"
			PRINT #1, "DEF SEG = &HA000 + 4000"
			PRINT #1, "OUT &H3C8, 0"
			PRINT #1, "FOR x = 0 TO 767: P = PEEK(x): OUT &H3C9, P: NEXT"
			PRINT #1, ""
			PRINT #1, "SLEEP"
			PRINT #1, "SCREEN 0, 0, 0, 0: WIDTH 80: COLOR 7,0: CLS: END"
		CLOSE #1
	END IF
	 
	IF QI$ = "q" THEN  'Exit program without saving
		SCREEN 0, 0, 0, 0: WIDTH 80: CLS : END
	END IF
	RUN
LOOP WHILE INSTR("seq", QI$) = 0