'
' NeoLib - Image Module
'
' Features:
'  5 subs
'  0 functions
' For a total of: 5 routines
'
' Specially designed and coded for AAP's QBCPC
' Official Library of the QuickBASIC Caliber Programming Compo (Summer & Autumn 2003)
'

DECLARE SUB neoImageLoadPP256Put (Filename AS STRING, Array() AS INTEGER)
DECLARE SUB neoImageLoadBMP (Filename AS STRING, Layer AS INTEGER, X AS INTEGER, Y AS INTEGER, Pal AS STRING)
DECLARE SUB neoImageLoadArrayBMP (Filename AS STRING, Array() AS INTEGER, Pal AS STRING)
DECLARE SUB neoImageSaveBMP (Filename AS STRING, Layer AS INTEGER, X AS INTEGER, Y AS INTEGER, Wid AS INTEGER, Hei AS INTEGER, Pal AS STRING)
DECLARE SUB neoImageSaveArrayBMP (Filename AS STRING, ArraySeg AS INTEGER, ArrayOff AS INTEGER, Pal AS STRING)

DEFINT A-Z
'$DYNAMIC
'$INCLUDE: 'neoEMS.bi'
'$INCLUDE: 'neoLAYER.bi'

'/////////////////////////////////////////////////////////////////////////
' FUNCTIONS
'/////////////////////////////////////////////////////////////////////////


'/////////////////////////////////////////////////////////////////////////
' SUBS
'/////////////////////////////////////////////////////////////////////////
SUB neoImageLoadPP256Put (Filename AS STRING, Array() AS INTEGER)
	'loads an image made in PP256
	'- Filename: the PUT file to load (with extension and path!)
	'- Array(): to store the image in

	l& = 0
	FF = FREEFILE
	OPEN Filename FOR BINARY AS #FF
		l& = LOF(FF) - 7
	CLOSE #FF
	IF l& < 0 THEN EXIT SUB
	REDIM Array(l& \ 2) AS INTEGER
	DEF SEG = VARSEG(Array(0))
	BLOAD Filename, VARPTR(Array(0))
END SUB

SUB neoImageLoadBMP (Filename AS STRING, Layer AS INTEGER, X AS INTEGER, Y AS INTEGER, Pal AS STRING)
	'loads a BMP file onto a layer
	'- Filename: BMP file to load
	'- Layer: layer to put it on
	'- X: x-coordinate to put the BMP
	'- Y: y-coordinate to put the BMP
	'- Pal: the BMP's palette will be stored in here

	IF Layer = VIDEO THEN
		DEF SEG = &HA000
	ELSE
		neoEMSmapX (Layer - 1) * 4, 0, 4, neoLayerGetHandle
		pF% = neoEMSpageFrame
		DEF SEG = pF%
	END IF

	FF = FREEFILE
	OPEN Filename FOR BINARY AS #FF
		'stuff
		p$ = SPACE$(18)
		GET #FF, , p$

		'now width and height
		Wid& = 0
		Hei& = 0
		GET #FF, , Wid&
		GET #FF, , Hei&

		'crap
		p$ = SPACE$(28)
		GET #FF, , p$

		'now the palette
		p$ = SPACE$(1024)
		GET #FF, , p$
		Pal = ""
		FOR I = 1 TO 1024 STEP 4
			B% = ASC(MID$(p$, I, 1)) \ 4
			G% = ASC(MID$(p$, I + 1, 1)) \ 4
			R% = ASC(MID$(p$, I + 2, 1)) \ 4
			Pal = Pal + CHR$(R%) + CHR$(G%) + CHR$(B%)
		NEXT I
		p$ = ""

		'now image data
		FOR zy = Hei& - 1 TO 0 STEP -1
			dat$ = SPACE$(Wid&)
			GET #FF, , dat$
			realY% = Y + zy
			FOR zx = 0 TO Wid& - 1
				realX% = X + zx
				IF realX% >= 0 AND realX% <= 319 AND realY% >= 0 AND realY% <= 199 THEN
					POKE 320& * realY% + realX%, ASC(MID$(dat$, zx + 1, 1))
				END IF
			NEXT zx
		NEXT zy
	CLOSE #FF

	IF Layer <> VIDEO THEN
		FOR I = 0 TO 3
			neoEMSmove 0, pF%, &H4000& * I, neoLayerGetHandle, (Layer - 1) * 4 + I, 0, 16384
		NEXT I
	END IF
END SUB

SUB neoImageSaveBMP (Filename AS STRING, Layer AS INTEGER, X AS INTEGER, Y AS INTEGER, Wid AS INTEGER, Hei AS INTEGER, Pal AS STRING)
	'saves a part of a layer to a BMP file
	'- Filename: filename of the BMP file
	'- Layer: the layer to retrieve data from
	'- X: upperleft corner-x
	'- Y: upperleft corner-y
	'- Wid: width of the picture to save
	'- Hei: heigth of the picture to save
	'- Pal: current palette to be saved in the BMP file

	IF Layer = VIDEO THEN
		DEF SEG = &HA000
	ELSE
		neoEMSmapX (Layer - 1) * 4, 0, 4, neoLayerGetHandle
		pF% = neoEMSpageFrame
		DEF SEG = pF%
	END IF

	FF = FREEFILE
	OPEN Filename FOR BINARY AS #FF
		IF LOF(FF) > 0 THEN
			CLOSE #FF
			KILL Filename
			OPEN Filename FOR BINARY AS #FF
		END IF

                iD$ = "BM"
                PUT #FF, , iD$

                fsize& = 1078 + CLNG(Wid) * CLNG(Hei)
                PUT #FF, , fsize&

                rr& = 0
                PUT #FF, , rr&

                offset& = 1078
                PUT #FF, , offset&

                h& = 40
                PUT #FF, , h&

                W& = Wid
                H& = Hei
                PUT #FF, , W&
                PUT #FF, , H&

                p% = 1
                PUT #FF, , p%
                bpp% = 8
                PUT #FF, , bpp%
                pb& = 0
                PUT #FF, , pb&
                img& = CLNG(Wid) * CLNG(Hei)
                PUT #FF, , img&
                res& = 0
                PUT #FF, , res&
                PUT #FF, , res&
                C& = 256
                PUT #FF, , C&
                PUT #FF, , C&

                'palette
                FOR I = 0 TO 255
                	R% = ASC(MID$(Pal, I * 3 + 1, 1))
                	G% = ASC(MID$(Pal, I * 3 + 2, 1))
                	B% = ASC(MID$(Pal, I * 3 + 3, 1))
                	z$ = CHR$(B% * 4) + CHR$(G% * 4) + CHR$(R% * 4) + CHR$(0)
                	PUT #FF, , z$
                NEXT I

                'image data
                FOR zy = Y + Hei - 1 TO Y STEP -1
                	FOR zx = X TO X + Wid - 1
                		z$ = CHR$(0)
                		IF zx >= 0 AND zx <= 319 AND zy >= 0 AND zy <= 199 THEN z$ = CHR$(PEEK(320& * zy + zx))

                		PUT #FF, , z$
                	NEXT zx
                NEXT zy
	CLOSE #FF
END SUB

SUB neoImageLoadArrayBMP (Filename AS STRING, Array() AS INTEGER, Pal AS STRING)
	'loads a BMP file into an array (PUT-compatible)
	'- Filename: BMP file to load
	'- Array(): array to put it in
	'- Pal: the BMP's palette will be stored in here

	FF = FREEFILE
	OPEN Filename FOR BINARY AS #FF
		'stuff
		p$ = SPACE$(18)
		GET #FF, , p$

		'now width and height
		Wid& = 0
		Hei& = 0
		GET #FF, , Wid&
		GET #FF, , Hei&
		REDIM Array((Wid& * Hei& + 4) \ 2) AS INTEGER

		segm% = VARSEG(Array(0))
		offs% = VARPTR(Array(0))

		DEF SEG = segm%

		POKE offs%, (Wid& MOD 32) * 8
		POKE offs% + 1, Wid& \ 32
		POKE offs% + 2, Hei&
		POKE offs% + 3, 0

		offs% = offs% + 4

		'crap
		p$ = SPACE$(28)
		GET #FF, , p$

		'now the palette
		p$ = SPACE$(1024)
		GET #FF, , p$
		Pal = ""
		FOR I = 1 TO 1024 STEP 4
			B% = ASC(MID$(p$, I, 1)) \ 4
			G% = ASC(MID$(p$, I + 1, 1)) \ 4
			R% = ASC(MID$(p$, I + 2, 1)) \ 4
			Pal = Pal + CHR$(R%) + CHR$(G%) + CHR$(B%)
		NEXT I

		'now image data
		DEF SEG = segm%
		FOR zy = Hei& - 1 TO 0 STEP -1
			dat$ = SPACE$(Wid&)
			GET #FF, , dat$
			FOR zx = 0 TO Wid& - 1
				POKE offs% + Wid& * zy + zx, ASC(MID$(dat$, zx + 1, 1))
			NEXT zx
		NEXT zy
	CLOSE #FF
END SUB

SUB neoImageSaveArrayBMP (Filename AS STRING, ArraySeg AS INTEGER, ArrayOff AS INTEGER, Pal AS STRING)
	'saves a PUT-image to a BMP file
	'- Filename: filename of the BMP file
	'- ArraySeg: PUT image's segment
	'- ArrayOff: PUT image's offset
	'- Pal: current palette to be saved in the BMP file

	DEF SEG = ArraySeg
	Wid& = PEEK(ArrayOff) \ 8 + PEEK(ArrayOff + 1) * 32
	Hei& = PEEK(ArrayOff + 2)

	FF = FREEFILE
	OPEN Filename FOR BINARY AS #FF
		IF LOF(FF) > 0 THEN
			CLOSE #FF
			KILL Filename
			OPEN Filename FOR BINARY AS #FF
		END IF

                iD$ = "BM"
                PUT #FF, , iD$

                fsize& = 1078 + Wid& * Hei&
                PUT #FF, , fsize&

                rr& = 0
                PUT #FF, , rr&

                offset& = 1078
                PUT #FF, , offset&

                h& = 40
                PUT #FF, , h&

                PUT #FF, , Wid&
                PUT #FF, , Hei&

                p% = 1
                PUT #FF, , p%
                bpp% = 8
                PUT #FF, , bpp%
                pb& = 0
                PUT #FF, , pb&
                img& = Wid& * Hei&
                PUT #FF, , img&
                res& = 0
                PUT #FF, , res&
                PUT #FF, , res&
                C& = 256
                PUT #FF, , C&
                PUT #FF, , C&

                'palette
                FOR I = 0 TO 255
                	R% = ASC(MID$(Pal, I * 3 + 1, 1))
                	G% = ASC(MID$(Pal, I * 3 + 2, 1))
                	B% = ASC(MID$(Pal, I * 3 + 3, 1))
                	z$ = CHR$(B% * 4) + CHR$(G% * 4) + CHR$(R% * 4) + CHR$(0)
                	PUT #FF, , z$
                NEXT I

                'image data
                FOR zy& = Hei& - 1 TO 0 STEP -1
                	FOR zx& = 0 TO Wid& - 1
                		z$ = CHR$(0)
                		IF zx& >= 0 AND zx& <= 319 AND zy& >= 0 AND zy& <= 199 THEN z$ = CHR$(PEEK(ArrayOff + 4 + zy& * Wid& + zx&))

                		PUT #FF, , z$
                	NEXT zx&
                NEXT zy&
	CLOSE #FF
END SUB
