'
' ####################
' #####  PROLOG  #####
' ####################
'
' Sprite extractor for R-Type CPC
' use with a SNA snap file created with Winape
' must be a Version 1 64K SNA to work properly
' 
' it is fully fonctional but a sample code so use at your own risk
'	it does not provide error checking too
'
' created 22/11/09 by Fano
' you'll need Xblite distribution (www.xblite.org) and Xfree lib to run it (avaible on xblite website)
' 
' 1.1 added checker for skipped chars

VERSION "1.1"
CONSOLE

	IMPORT "xst"				' Standard library : required by most programs

	IMPORT "xfree"      'xfree is freeimage for xblite

'colors in ARGB format
$$DEF_COLOR1 = 0x0000FFFF
'$$DEF_COLOR1 = 0x000000FF
$$DEF_COLOR2 = 0x0000FF00
$$DEF_COLOR3 = 0x00FFFFFF

DECLARE FUNCTION Entry ()
DECLARE FUNCTION ExtractSprite (adr)
'
'
' ######################
' #####  Entry ()  #####
' ######################
'
FUNCTION Entry ()
SHARED UBYTE data[]
SHARED s_count

	Xfree_Init ()
	a$=FreeImage_GetCopyrightMessage()
	PRINT a$

'64K mem
DIM data[0xFFFF]

'read the snapshot

fl=OPEN("rtype_l1.sna",$$RD) 

SEEK(fl,0x100) 'skip header

READ [fl],data[]

CLOSE (fl)

'sprite table address

adr=0xBC67 'basic sprites

'adr=data[0xC4BA]+(data[0xC4BB]*256) 'unquote to read level sprites

'show if 

PRINT HEXX$(adr)

'sprite count
s_count=0

'loop all the sprites

DO	
	
	IF data[adr]<128 THEN
		
		ExtractSprite (adr)
		INC s_count
	ENDIF
	
	adr=adr+4	
	
LOOP UNTIL data[adr]>=128

PRINT s_count;" sprites processed"

a$=INLINE$("Job done !")

END FUNCTION
'
' ###########################
' #####  ExtractSprite  #####
' ###########################
'
FUNCTION ExtractSprite (adr)
SHARED UBYTE data[]
SHARED s_count

'get dimensions
larg=data[adr+0]
haut=data[adr+1]

'get sprite adress
ptr=data[adr+2]+(data[adr+3]*256)

'show sprite infos
PRINT s_count;" ";larg;haut;" ";HEXX$(ptr,4)
IF larg=0 THEN RETURN
IF haut=0 THEN RETURN

'generate an empty image
i_larg=larg*8
i_haut=haut*8

img=FreeImage_Allocate (i_larg,i_haut,8,$$FI_RGBA_RED_MASK,$$FI_RGBA_GREEN_MASK,$$FI_RGBA_BLUE_MASK)

'get infos as pointers, etc...
p_bits=FreeImage_GetBits(img)
p_pal=FreeImage_GetPalette(img)
larg_line=FreeImage_GetPitch(img)

'palette for checker

	UBYTEAT(0+p_pal+(255*4))=255
	UBYTEAT(1+p_pal+(255*4))=64
	UBYTEAT(2+p_pal+(255*4))=0
	
	UBYTEAT(0+p_pal+(127*4))=64
	UBYTEAT(1+p_pal+(127*4))=64
	UBYTEAT(2+p_pal+(127*4))=255

'set colors 1,2 & 3

XLONGAT(p_pal+4)=$$DEF_COLOR1
XLONGAT(p_pal+8)=$$DEF_COLOR2
XLONGAT(p_pal+12)=$$DEF_COLOR3

'process sprite

FOR y=0 TO haut-1
	FOR x=0 TO larg-1
		
	adr_i=p_bits+(larg_line*8*y)+(x*8)
	attr=data[ptr]
	INC ptr
	
	IF attr<>0x36 THEN
		attr=attr AND 3
		
			SELECT CASE attr
				CASE 2
					color=1
				CASE 3
					color=3
				CASE ELSE
					color=2
			END SELECT
			
'characters
		
		FOR j=0 TO 7
			mask=128
			char=data[ptr]
			FOR i=0 TO 7
				t_adr=adr_i+i+(j*larg_line)
				
				IF char AND mask THEN
					UBYTEAT(t_adr)=color
				ELSE
					UBYTEAT(t_adr)=0
				ENDIF
				
				mask=mask\2
			NEXT
			INC ptr
		NEXT
		
	ELSE
		
		'add non editable zone with a checker
		color=255
		FOR j=0 TO 7
			FOR i=0 TO 7	
				t_adr=adr_i+i+(j*larg_line)
				UBYTEAT(t_adr)=color
				color=color XOR 128
			NEXT
			color=color XOR 128
		NEXT
		
	ENDIF
			
	NEXT	
NEXT

'flip for BMP format
FreeImage_FlipVertical(img)

'done save
s$=STRING$(s_count)
fname$="gfx_l1/spr_"+FORMAT$(s$,"####")+".bmp"
FreeImage_Save($$FIF_BMP,img,&fname$,0)

'free image
FreeImage_Unload(img)

END FUNCTION
END PROGRAM