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

DECLARE FUNCTION neoLayerGetHandle% ()
DECLARE FUNCTION neoLayerCreate% (NoLayers AS INTEGER)
DECLARE FUNCTION neoLayerFreeLayers% ()

DECLARE SUB neoLayerRemove ()
DECLARE SUB neoLayerCopy (SrcLayer AS INTEGER, DstLayer AS INTEGER)
DECLARE SUB neoLayerCopyTrans (SrcLayer AS INTEGER, DstLayer AS INTEGER, TransCol AS INTEGER)
DECLARE SUB neoLayerClear (Layer AS INTEGER, Colour AS INTEGER)
DECLARE SUB neoLayerExchange (SrcLayer AS INTEGER, DstLayer AS INTEGER)
DECLARE SUB neoLayerMirror (Layer AS INTEGER, HorVerBits AS INTEGER)
DECLARE SUB neoLayerFilter (Layer AS INTEGER, FromCol AS INTEGER, ToCol AS INTEGER)
DECLARE SUB neoLayerSave (Layer AS INTEGER, Filename AS STRING)
DECLARE SUB neoLayerLoad (Layer AS INTEGER, Filename AS STRING)
DECLARE SUB neoLayerCopyColor (SrcLayer AS INTEGER, DstLayer AS INTEGER, TransCol AS INTEGER, ReplaceCol AS INTEGER)
DECLARE SUB neoLayerCopyForward (SrcLayer AS INTEGER, DstLayer AS INTEGER, CheckCol AS INTEGER, TransCol AS INTEGER)
DECLARE SUB neoLayerCopyBlend (SrcLayer AS INTEGER, DstLayer AS INTEGER, StdPal AS STRING, Neg AS INTEGER)
DECLARE SUB neoLayerLighting (Layer AS INTEGER, LightFactor AS INTEGER, StdPal AS STRING)

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

CONST VIDEO = 0
CONST HORIZONTAL = 1, VERTICAL = 2

DIM SHARED LAYERhandle AS INTEGER

'/////////////////////////////////////////////////////////////////////////
' FUNCTIONS
'/////////////////////////////////////////////////////////////////////////
FUNCTION neoLayerGetHandle
	'returns the layer handle
	neoLayerGetHandle = LAYERhandle
END FUNCTION

FUNCTION neoLayerCreate (NoLayers AS INTEGER)
	'Creates layers
	' NoLayer = number of layers to create
	'Returns: error code:
	' -1 = successful
	' 0 = error
	IF NOT neoEMSexist THEN neoLayerCreate = 0: EXIT FUNCTION
        LAYERhandle = neoEMSalloc(NoLayers * 4)
        IF neoEMSisError THEN neoLayerCreate = 0: EXIT FUNCTION
        neoLayerCreate = -1
END FUNCTION

FUNCTION neoLayerFreeLayers
	'Returns the amount of layers free
        neoLayerFreeLayers = INT(neoEMSfreePages / 4)
END FUNCTION


'/////////////////////////////////////////////////////////////////////////
' SUBS
'/////////////////////////////////////////////////////////////////////////
SUB neoLayerRemove
	'Removes allocated layers

	neoEMSdealloc LAYERhandle
END SUB

SUB neoLayerCopy (SrcLayer AS INTEGER, DstLayer AS INTEGER)
        'copies SrcLayer to DstLayer
        ' SrcLayer = the layer to copy from
        ' DstLayer = the destination layer

        IF (SrcLayer <> VIDEO) AND (DstLayer = VIDEO) THEN
        	neoEMSmapX (SrcLayer - 1) * 4, 0, 4, LAYERhandle
        	neoEMSmove 0, neoEMSpageFrame, 0, 0, &HA000, 0, 65536&
        ELSEIF (SrcLayer = VIDEO) AND (DstLayer <> VIDEO) THEN
                FOR I = 0 TO 3
                        neoEMSmove 0, &HA000, I * &H4000&, LAYERhandle, (DstLayer - 1) * 4 + I, 0, 16384
                NEXT I
        ELSEIF (SrcLayer <> VIDEO) AND (DstLayer <> VIDEO) THEN
        	FOR I = 0 TO 3
                	neoEMSmove LAYERhandle, (SrcLayer - 1) * 4 + I, 0, LAYERhandle, (DstLayer - 1) * 4 + I, 0, 16384
                NEXT I
        END IF
END SUB

SUB neoLayerCopyTrans (SrcLayer AS INTEGER, DstLayer AS INTEGER, TransCol AS INTEGER)
	'copies SrcLayer to DstLayer while skipping pixels with color TransCol
	'this is much slower than normal neoLAYERcopy
	' SrcLayer = the layer to copy from
	' DstLayer = the layer to copy to
	' TransCol = the pixelcolor to be skipped

	IF (SrcLayer <> VIDEO) AND (DstLayer = VIDEO) THEN
        	neoEMSmapX (SrcLayer - 1) * 4, 0, 4, LAYERhandle
        	pF% = neoEMSpageFrame
        	DEF SEG = pF%
        	FOR I& = 0 TO 65535&
                        colval = PEEK(I&)
                        IF colval <> TransCol THEN
                        	DEF SEG = &HA000
                        	POKE I&, colval
                        	DEF SEG = pF%
                        END IF
        	NEXT I&
	ELSEIF (SrcLayer = VIDEO) AND (DstLayer <> VIDEO) THEN
                neoEMSmapX (DstLayer - 1) * 4, 0, 4, LAYERhandle
                pF% = neoEMSpageFrame
                DEF SEG = &HA000
                FOR I& = 0 TO 65535&
                	colval = PEEK(I&)
                	IF colval <> TransCol THEN
                		DEF SEG = pF%
                		POKE I&, colval
                		DEF SEG = &HA000
                	END IF
                NEXT I&
                FOR I = 0 TO 3
                        neoEMSmove 0, pF%, &H4000& * I, LAYERhandle, (DstLayer - 1) * 4 + I, 0, 16384
                NEXT I
	ELSEIF (SrcLayer <> VIDEO) AND (DstLayer <> VIDEO) THEN
		pF% = neoEMSpageFrame
                DEF SEG = pF%

		FOR K = 0 TO 1
                	neoEMSmapX (SrcLayer - 1) * 4 + 2 * K, 0, 2, LAYERhandle
                	neoEMSmapX (DstLayer - 1) * 4 + 2 * K, 2, 2, LAYERhandle
                	FOR I& = 0 TO 32767&
                		colval = PEEK(I&)
                		IF colval <> TransCol THEN POKE I& + 32768&, colval
                	NEXT I&
                	FOR J = 0 TO 1
                		neoEMSmove 0, pF%, 32768& + J * 16384, LAYERhandle, (DstLayer - 1) * 4 + J + 2 * K, 0, 16384
                	NEXT J
                NEXT K
	END IF
END SUB

SUB neoLayerClear (Layer AS INTEGER, Colour AS INTEGER)
	'clears layer to colour
	' Layer = the layer to clear
	' Colour = the color to clear the layer to

	IF Layer <> VIDEO THEN
        	neoEMSmapX (Layer - 1) * 4, 0, 4, LAYERhandle
        	pF% = neoEMSpageFrame
        	DEF SEG = pF%
        	FOR I& = 0 TO 65535&
	        	POKE I&, Colour
        	NEXT I&

        	FOR I = 0 TO 3
        		neoEMSmove 0, pF%, I * &H4000, LAYERhandle, (Layer - 1) * 4 + I, 0, 16384
        	NEXT I
        ELSEIF Layer = VIDEO THEN
        	DEF SEG = &HA000
        	FOR I& = 0 TO 65535&
        		POKE I&, Colour
        	NEXT I&
        END IF
END SUB

SUB neoLayerExchange (SrcLayer AS INTEGER, DstLayer AS INTEGER)
	'exchanges SrcLayer with DstLayer
	' SrcLayer = first layer
	' DstLayer = second layer

        IF (SrcLayer <> VIDEO) AND (DstLayer = VIDEO) THEN
        	neoEMSmapX (SrcLayer - 1) * 4, 0, 4, LAYERhandle
        	pF% = neoEMSpageFrame
        	neoEMSexchange 0, &HA000, 0, 0, pF%, 0, 65536&
        	FOR I = 0 TO 3
        		neoEMSmove 0, pF%, I * &H4000&, LAYERhandle, (SrcLayer - 1) * 4 + I, 0, 16384
        	NEXT I
        ELSEIF (SrcLayer = VIDEO) AND (DstLayer <> VIDEO) THEN
                neoEMSmapX (DstLayer - 1) * 4, 0, 4, LAYERhandle
        	pF% = neoEMSpageFrame
        	neoEMSexchange 0, &HA000, 0, 0, pF%, 0, 65536&
        	FOR I = 0 TO 3
        		neoEMSmove 0, pF%, I * &H4000&, LAYERhandle, (DstLayer - 1) * 4 + I, 0, 16384
        	NEXT I
        ELSEIF (SrcLayer <> VIDEO) AND (DstLayer <> VIDEO) THEN
        	FOR I = 0 TO 3
                	neoEMSexchange LAYERhandle, (SrcLayer - 1) * 4 + I, 0, LAYERhandle, (DstLayer - 1) * 4 + I, 0, 16384
                NEXT I
        END IF
END SUB

SUB neoLayerMirror (Layer AS INTEGER, HorVerBits AS INTEGER)
	'mirrors a layer vertically, horizontally, or both
	' Layer = the layer to apply effects on
	' HorVerBits = horizontal or vertical bit flags, use HORIZONTAL or VERTICAL, for both do HORIZONTAL + VERTICAL

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

        IF HorVerBits AND HORIZONTAL THEN
        	FOR y = 0 TO 199
                       	FOR x = 0 TO 159
                       		lcoord = y * 320& + x
                       		rcoord = y * 320& + 319 - x
                       		col1 = PEEK(lcoord)
                       		col2 = PEEK(rcoord)
                       		POKE lcoord, col2
                       		POKE rcoord, col1
                       	NEXT x
                NEXT y
        END IF
        IF HorVerBits AND VERTICAL THEN
        	FOR x = 0 TO 319
        		FOR y = 0 TO 99
        			ucoord = y * 320& + x
        			dcoord = (199 - y) * 320& + x
        			col1 = PEEK(ucoord)
        			col2 = PEEK(dcoord)
        			POKE ucoord, col2
        			POKE dcoord, col1
        		NEXT y
        	NEXT x
        END IF

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

SUB neoLayerFilter (Layer AS INTEGER, FromCol AS INTEGER, ToCol AS INTEGER)
        'filters a layer to the specified colours
        ' Layer = the layer to filter in
        ' FromCol = the color to change
        ' ToCol = the color to change 'FromCol' to

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

        FOR I& = 0 TO 65535&
        	IF PEEK(I&) = FromCol THEN POKE I&, ToCol
        NEXT I&

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

SUB neoLayerSave (Layer AS INTEGER, Filename AS STRING)
        'saves the layer specified to a file
        ' Layer = layer to save
        ' Filename = filename to store layer in

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

        OPEN Filename FOR BINARY AS #FF
                IF Layer = VIDEO THEN
                	DEF SEG = &HA000
                ELSE
                	neoEMSmapX (Layer - 1) * 4, 0, 4, LAYERhandle
                	DEF SEG = neoEMSpageFrame
                END IF

                FOR I& = 0 TO 65535&
                        byte$ = CHR$(PEEK(I&))
                        PUT #FF, , byte$
                NEXT I&
        CLOSE #FF
END SUB

SUB neoLayerLoad (Layer AS INTEGER, Filename AS STRING)
	'loads a previously saved layer into a layer
	' Layer = the layer to load into
	' Filename = the file to load

	FF = FREEFILE
	OPEN Filename FOR BINARY AS #FF
		IF Layer = VIDEO THEN
			DEF SEG = &HA000
		ELSE
			pF% = neoEMSpageFrame
			DEF SEG = pF%
		END IF

		FOR I& = 0 TO 65535&
			byte$ = " "
			GET #FF, , byte$
			POKE I&, ASC(byte$)
		NEXT I&

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

SUB neoLayerCopyColor (SrcLayer AS INTEGER, DstLayer AS INTEGER, TransCol AS INTEGER, ReplaceCol AS INTEGER)
	'copies a layer to another one (similar to neoLayerCopy), but this supports transparency and all not transparent pixels are replaced by ReplaceCol
	'- SrcLayer: the source layer (which should be copied)
	'- DstLayer: the destination layer (where it should be copied to)
	'- TransCol: the transparent color of both layers
	'- ReplaceCol: the color to draw SrcLayer in on DstLayer
	'NOTE: copying from VIDEO to VIDEO is allowed

	pF% = neoEMSpageFrame

	'map in page frame
	IF SrcLayer = VIDEO THEN
		neoEMSmove 0, &HA000, 0, 0, pF%, 0, 65536&
	ELSE
		neoEMSmapX (SrcLayer - 1) * 4, 0, 4, LAYERhandle
	END IF

	'filter out the colors
	DEF SEG = pF%
        FOR I& = 0 TO 65535&
        	IF PEEK(I&) <> TransCol THEN POKE I&, ReplaceCol
        NEXT I&

	'map page frame back to screen or ems
	IF DstLayer = VIDEO THEN
		neoEMSmove 0, pF%, 0, 0, &HA000, 0, 65536&
	ELSE
		FOR I = 0 TO 3
			neoEMSmove 0, pF%, &H4000& * I, LAYERhandle, (DstLayer - 1) * 4 + I, 0, 16384
		NEXT I
	END IF
END SUB

SUB neoLayerCopyForward (SrcLayer AS INTEGER, DstLayer AS INTEGER, CheckCol AS INTEGER, TransCol AS INTEGER)
	'copies a layer to another one, while only the pixels are copied where the destination pixel is CheckCol
	'- SrcLayer: the source layer to copy
	'- DstLayer: the destination layer to copy to
	'- CheckCol: the color that will be overwritten on the destination layer
	'- TransCol: the color on the SrcLayer that will be skipped

	pF% = neoEMSpageFrame
	FOR pages = 0 TO 3
                IF SrcLayer = VIDEO THEN
                	neoEMSmove 0, &HA000, &H4000& * pages, 0, pF%, 0, 16384
                ELSE
                        neoEMSmap (SrcLayer - 1) * 4 + pages, 0, LAYERhandle
                END IF

                IF DstLayer = VIDEO THEN
                	neoEMSmove 0, &HA000, &H4000& * pages, 0, pF%, &H4000&, 16384
                ELSE
                	neoEMSmap (DstLayer - 1) * 4 + pages, 1, LAYERhandle
                END IF

		DEF SEG = pF%
                FOR I& = 0 TO 16383
                        valuehere% = PEEK(I&)
                        IF valuehere% <> TransCol THEN
                        	IF PEEK(I&+16384&) = CheckCol THEN POKE I& + 16384&, valuehere%
                        END IF
                NEXT I&

                IF DstLayer = VIDEO THEN
                	neoEMSmove 0, pF%, &H4000&, 0, &HA000, &H4000& * pages, 16384
                ELSE
                	neoEMSmove 0, pF%, &H4000&, LAYERhandle, (DstLayer - 1) * 4 + pages, 0, 16384
                END IF
	NEXT pages
END SUB

SUB neoLayerCopyBlend (SrcLayer AS INTEGER, DstLayer AS INTEGER, StdPal AS STRING, Neg AS INTEGER)
	'copy SrcLayer blended to DstLayer
	'- SrcLayer: the source layer
	'- DstLayer: the destination layer
	'- StdPal: a 768-byte palette string which is the current palette of the both layers
	'- Neg: TRUE for negative blend, FALSE for positive blend

        pF% = neoEMSpageFrame
        FOR pages = 0 TO 3
		IF SrcLayer = VIDEO THEN
                	neoEMSmove 0, &HA000, &H4000& * pages, 0, pF%, 0, 16384
                ELSE
                        neoEMSmap (SrcLayer - 1) * 4 + pages, 0, LAYERhandle
                END IF

                IF DstLayer = VIDEO THEN
                	neoEMSmove 0, &HA000, &H4000& * pages, 0, pF%, &H4000&, 16384
                ELSE
                	neoEMSmap (DstLayer - 1) * 4 + pages, 1, LAYERhandle
                END IF

                DEF SEG = pF%
                FOR I& = 0 TO 16383
                        valuehere% = PEEK(I&)
                        valuethere% = PEEK(I&+16384)

 			aR = ASC(MID$(StdPal, valuehere% * 3 + 1, 1))
 			aG = ASC(MID$(StdPal, valuehere% * 3 + 2, 1))
 			aB = ASC(MID$(StdPal, valuehere% * 3 + 3, 1))

 			dR = ASC(MID$(StdPal, valuethere% * 3 + 1, 1))
 			dG = ASC(MID$(StdPal, valuethere% * 3 + 2, 1))
 			dB = ASC(MID$(StdPal, valuethere% * 3 + 3, 1))

			IF NOT Neg THEN
 				mR = aR + dR
 				mG = aG + dG
 				mB = aB + dB
 				IF mR > 63 THEN mR = 63
 				IF mG > 63 THEN mG = 63
 				IF mB > 63 THEN mB = 63
 			ELSE
 				mR = ABS(aR - dR)
 				mG = ABS(aG - dG)
 				mB = ABS(aB - dB)
 			END IF

			'search best matching color in StdPal, equal to neoPalSearchIn
 			mindif% = 32000
 			minimum% = 0
 			FOR checkC = 0 TO 255
				aR = ASC(MID$(StdPal, checkC * 3 + 1, 1))
				aG = ASC(MID$(StdPal, checkC * 3 + 2, 1))
				aB = ASC(MID$(StdPal, checkC * 3 + 3, 1))
                                dif% = ABS(mR - aR) + ABS(mG - aG) + ABS(mB - aB)
                                IF dif% < mindif% THEN mindif% = dif%: minimum% = checkC
 			NEXT checkC

                        POKE I& + 16384, minimum%
		NEXT I&

		IF DstLayer = VIDEO THEN
                	neoEMSmove 0, pF%, &H4000&, 0, &HA000, &H4000& * pages, 16384
                ELSE
                	neoEMSmove 0, pF%, &H4000&, LAYERhandle, (DstLayer - 1) * 4 + pages, 0, 16384
                END IF
        NEXT pages
END SUB

SUB neoLayerLighting (Layer AS INTEGER, LightFactor AS INTEGER, StdPal AS STRING)
        'changes the lighting of a layer, making it darker or lighter
        '- Layer: the layer to apply light-effects on
        '- LightFactor: how many c-units the colors will differ (min: -63, max: 63) (<0: darken, >0: lighten)
        '- StdPal: the current palette, to be used with the light effect

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

        FOR I& = 0 TO 65535&
                value% = PEEK(I&)

                aR = ASC(MID$(StdPal, value% * 3 + 1, 1))
                aG = ASC(MID$(StdPal, value% * 3 + 2, 1))
                aB = ASC(MID$(StdPal, value% * 3 + 3, 1))

                NewR = aR + LightFactor
                NewG = aG + LightFactor
                NewB = aB + LightFactor

                'find best matching color
                mindif% = 32000
                minimum% = 0
                FOR checkC = 0 TO 255
                	aR = ASC(MID$(StdPal, checkC * 3 + 1, 1))
			aG = ASC(MID$(StdPal, checkC * 3 + 2, 1))
			aB = ASC(MID$(StdPal, checkC * 3 + 3, 1))
			dif% = ABS(NewR - aR) + ABS(NewG - aG) + ABS(NewB - aB)
			IF dif% < mindif% THEN mindif% = dif%: minimum% = checkC
                NEXT checkC

                POKE I&, minimum%
        NEXT I&

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

