matherp Guru
Joined: 11/12/2012 Location: United KingdomPosts: 9124 |
Posted: 10:05am 16 Sep 2023 |
Copy link to clipboard |
Print this post |
|
Set the const separatesubs% to 1 to get an individual csub for each sprite file Set to 0 to have all sprite files converted into a single CSub Output is to the console but just change the print #0 lines to print #2 and open a file to get output to a file.
The program deals with the colour conversions, the correct endianness, handles comments in the sprite file, deals with short or long lines in the sprite file, and reports the offsets for easy use
'program to convert all the sprite files in a directory to a CSUB Option explicit Option default none Const separatesubs% = 0 Dim offset%,cols%(15)=(0,1,6,7,8,9,14,15,2,3,4,5,10,11,12,13) Dim fname$=Dir$("*.spr",FILE) If separatesubs%=0 Then Print #0,"CSUB SPRITES" Print #0,"00000000" offset%=0 EndIf Do If fname$<>"" Then code fname$ fname$=Dir$() Loop Until fname$="" If separatesubs%=0 Then Print #0,"END CSUB"
Sub code f$ Local i%,j%,h%,l%,w%,n%,s% Local a$,o$ Open f$ For input As #1 Line Input #1,a$ w%=Val(Field$(a$,1,",")) n%=Val(Field$(a$,2,",")) h%=Val(Field$(a$,3,",")) If h%=0 Then h%=w% i%=Instr(f$,".") o$=Left$(f$,i%-1) If separatesubs%=1 Then Print #0,"CSUB "+o$ Print #0,"00000000" offset%=0 Else Print #0,"'"+o$ EndIf Local buff%(w%*h%\8+2) For s%=1 To n% Print "'Offset ";offset% Print #0,Hex$(h%,4)+Hex$(w%,4) For l%=1 To h% a$="'" Do While Left$(a$,1)="'" 'skip comments Line Input #1,a$ Loop If Len(a$)<w% Then Inc a$,Space$(w%-Len(a$)) If Len(a$)>w% Then a$=Left$(a$,w%) LongString append buff%(),a$ Next l% If LLen(buff%()) Mod 8 Then LongString append buff%(),Space$(8-(LLen(buff%()) Mod 8)) EndIf j%=0 For i%=8 To LLen(buff%()) Step 8 o$=mycol$(LGetStr$(buff%(),i%,1)) Inc o$,mycol$(LGetStr$(buff%(),i%-1,1)) Inc o$,mycol$(LGetStr$(buff%(),i%-2,1)) Inc o$,mycol$(LGetStr$(buff%(),i%-3,1)) Inc o$,mycol$(LGetStr$(buff%(),i%-4,1)) Inc o$,mycol$(LGetStr$(buff%(),i%-5,1)) Inc o$,mycol$(LGetStr$(buff%(),i%-6,1)) Inc o$,mycol$(LGetStr$(buff%(),i%-7,1)) Print #0,o$+" "; Inc j% If j% Mod 8 = 0 Then Print #0,"" Next i% Inc offset%,4+LLen(buff%())\2 LongString clear buff%() If j% Mod 8 <> 0 Then Print #0,"" Next s% Close #1 If separatesubs%=1 Then Print #0,"END CSUB" End Sub Function mycol$(c$) Local i% If c$=" " Then c$="0" i%=Val("&H"+c$) mycol$=Hex$(cols%(i%)) End Function
Example output
CSUB SPRITES 00000000 'balloon 'Offset 0 002A001E 00000000 77777777 00777777 00000000 77000000 77777777 00007777 00000000 77777777 77777777 00777777 77000000 77777777 77777777 00007777 77777700 77777777 77777777 00007777 77777777 77777777 77777777 77000077 77777777 77770000 77777777 77770000 00777777 77777700 00777777 77777777 77770077 77770000 77777777 77777777 00777700 77777700 77777777 00777777 77777777 77777777 77777777 77007777 77777777 77777777 77777777 77770077 77770000 77777777 77777777 00777700 77777700 77007777 77777777 77770000 77777777 77770000 00777777 77777700 00777777 77777700 77777777 77777777 00007777 77777777 77777777 77777777 77000077 77777777 77777777 77777777 77770000 77777777 77777777 00777777 77007700 77777777 77777777 00007700 77770077 77777777 00777777 00000077 77770077 77777777 00770077 77000000 77777700 77777777 00007700 00770000 77777700 00007777 00000077 00007700 77777777 77000077 00000000 00007700 00777777 00007700 00000000 77000077 00007777 00000077 77000000 77770000 77000077 00000000 00770000 77777700 00770000 00000000 00770000 00007700 00000077 00000000 00007700 77000077 00000000 00000000 77000077 00770000 00000000 77000000 00770000 00007700 00000000 77000000 77777777 00000000 00000000 77770000 00777777 00000000 00000000 77777700 00007777 00000000 00000000 77777777 00000077 00000000 77000000 77777777 00000000 00000000 77770000 00777777 00000000 00000000 77770000 00000077 00000000 00000000 77777700 00000000 00000000 'Offset 636 002A001E 00000000 99999999 00999999 00000000 99000000 99999999 00009999 00000000 99999999 99999999 00999999 99000000 99999999 99999999 00009999 99999900 99999999 99999999 00009999 99999999 99999999 99999999 99000099 99999999 99990000 99999999 99990000 00999999 99999900 00999999 99999999 99990099 99990000 99999999 99999999 00999900 99999900 99999999 00999999 99999999 99999999 99999999 99009999 99999999 99999999 99999999 99990099 99990000 99999999 99999999 00999900 99999900 99009999 99999999 99990000 99999999 99990000 00999999 99999900 00999999 99999900 99999999 99999999 00009999 99999999 99999999 99999999 99000099 99999999 99999999 99999999 99990000 99999999 99999999 00999999 99009900 99999999 99999999 00009900 99990099 99999999 00999999 00000099 99990099 99999999 00990099 99000000 99999900 99999999 00009900 00990000 99999900 00009999 00000099 00009900 99999999 99000099 00000000 00009900 00999999 00009900 00000000 99000099 00009999 00000099 99000000 99990000 99000099 00000000 00990000 99999900 00990000 00000000 00990000 00009900 00000099 00000000 00009900 99000099 00000000 00000000 99000099 00990000 00000000 99000000 00990000 00009900 00000000 99000000 99999999 00000000 00000000 99990000 00999999 00000000 00000000 99999900 00009999 00000000 00000000 99999999 00000099 00000000 99000000 99999999 00000000 00000000 99990000 00999999 00000000 00000000 99990000 00000099 00000000 00000000 99999900 00000000 00000000 'gballoon 'Offset 1272 0015000F 66660000 00000666 66666660 60006666 66666666 66006666 66600666 66660666 66006606 66666666 66666660 06666666 66660066 06666606 06666660 66666660 00666666 66666666 60066666 66666660 60006066 66666660 06000060 00666660 06000006 06006660 00600000 00600666 00600000 00006006 60060000 00000600 66660000 00000006 66666000 00000000 06666600 00000000 00066600 00000000 'test 'Offset 1436 00050005 00222222 22000220 22222000 00000002 'Offset 1456 00050005 FF111111 11FFF11F 11111444 00000001 'mouse 'Offset 1476 0013000D 0000000F 0FF00000 00000000 000F0F00 F0000000 00000F00 000F0000 0000000F 0F0000F0 0F000000 000F0000 0000F000 00000F00 0000000F 00F0000F 0F000000 00000F00 F00F0000 00000000 000F0F00 FFFFF000 00F000FF 0F00000F 00F00FF0 00F0F000 0000F00F 00F000FF 0000000F 0F00F000 00000000 0000FFFF 'redmouse 'Offset 1604 0013000D 00000008 08800000 00000000 00080800 80000000 00000800 00080000 00000008 08000080 08000000 00080000 00008000 00000800 00000008 00800008 08000000 00000800 80080000 00000000 00080800 88888000 00800088 08000008 00800F80 00808000 00008008 00800088 00000008 08008000 00000000 00008888 'simple 'Offset 1732 00100010 66666666 00000000 66666666 00000000 66666666 00000000 66666666 00000000 66666666 00000000 66666666 00000000 66666666 00000000 66666666 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 END CSUB
Edited 2023-09-16 21:40 by matherp |
matherp Guru
Joined: 11/12/2012 Location: United KingdomPosts: 9124 |
Posted: 07:41am 17 Sep 2023 |
Copy link to clipboard |
Print this post |
|
This is an update to the program that will also compress the CSUB. This will be supported by a new command BLIT COMPRESSED address%, x%, y% [,col]
'program to convert all the sprite files in a directory to a compressed CSUB Option explicit Option default none Const separatesubs% = 0 Dim offset% Dim fname$=Dir$("a:/*.spr",FILE) If separatesubs%=0 Then Print #0,"CSUB SPRITES" Print #0,"00000000" offset%=0 EndIf Do If fname$<>"" Then code fname$ fname$=Dir$() Loop Until fname$="" If separatesubs%=0 Then Print #0,"END CSUB"
'convert the file f$ to a compressed CSUB Sub code f$ Local i%,j%,h%,l%,w%,n%,s% Local a$,o$,oc$ Open f$ For input As #1 Line Input #1,a$ 'process the dimensions and count w%=Val(Field$(a$,1,",")) n%=Val(Field$(a$,2,",")) h%=Val(Field$(a$,3,",")) If h%=0 Then h%=w% i%=Instr(f$,".") o$=Left$(f$,i%-1) If separatesubs%=1 Then Print #0,"CSUB "+o$ Print #0,"00000000" offset%=0 Else Print #0,"'"+o$ EndIf Local obuff%(w%*h%\8+2),buff%(w%*h%\8+2) For s%=1 To n% 'process all the sprites in a file Print #0,"'Offset ";offset% Print #0,Hex$(h%,4)+Hex$(w%,4) For l%=1 To h% a$="'" Do While Left$(a$,1)="'" 'skip comments Line Input #1,a$ Loop 'make sure all lines are the correct length If Len(a$)<w% Then Inc a$,Space$(w%-Len(a$)) If Len(a$)>w% Then a$=Left$(a$,w%) LongString append buff%(),a$ 'get all the file into a single longstring Next l% j%=0 For i%=1 To LLen(buff%()) LongString append obuff%(),mycol$(LGetStr$(buff%(),i%,1)) Next i% LongString clear buff%() i%=0 Do While i%<w%*h% 'compress the data j%=LGetByte(obuff%(),i%) l%=1 Inc i% Do While LGetByte(obuff%(),i%)=j% And l%<15 Inc l% Inc i% Loop LongString append buff%(), Hex$(l%)+Chr$(j%) Loop 'the output must be a multiple of 8 nibbles LongString append buff%(),Left$("00000000",8-(LLen(buff%()) Mod 8)) j%=0 For i%=8 To LLen(buff%()) Step 8 'reverse the order o$=LGetStr$(buff%(),i%,1) Inc o$,LGetStr$(buff%(),i%-1,1) Inc o$,LGetStr$(buff%(),i%-2,1) Inc o$,LGetStr$(buff%(),i%-3,1) Inc o$,LGetStr$(buff%(),i%-4,1) Inc o$,LGetStr$(buff%(),i%-5,1) Inc o$,LGetStr$(buff%(),i%-6,1) Inc o$,LGetStr$(buff%(),i%-7,1) Inc j% If j%=8 Then Print #0,o$ j%=0 Else Print #0,o$+" "; EndIf Next i% If j%<>0 Then Print #0,"" Inc offset%,4+LLen(buff%())\2 LongString clear obuff%() LongString clear buff%() Next s% Close #1 If separatesubs%=1 Then Print #0,"END CSUB" End Sub ' 'converts the Ascii colour from the Maximite standard to PicoMite standard Function mycol$(c$) Static cols%(15)=(0,1,6,7,8,9,14,15,2,3,4,5,10,11,12,13) Local i% If c$=" " Then c$="0" i%=Val("&H"+c$) mycol$=Hex$(cols%(i%)) End Function
Sample output. Note the size of the "balloon" sprites compared to the version above
CSUB SPRITES 00000000 'balloon 'Offset 0 002A001E 010F7E08 777F0C7E 06777F08 7F047B7F 047A047B 047A047C 027A027C 757F0474 7F047402 7D7F0275 027D7F02 757F0474 7A047402 7C047A02 7C047A04 047B7F04 7F047B7F 7B7F047B 7F027204 04720273 737F0272 72067202 72027E02 7E027208 72087202 72047A04 7A047208 720A7204 72047604 7604720C 720C7204 72047604 7604720C 720E7204 72047204 0472010F 0F720472 72047201 010F7204 04720472 7A030F72 0F7A050F 050F7A05 7A050F7A 0F7A050F 090F7607 00000C76 'Offset 192 002A001E 010F9E08 979F0C9E 06979F08 9F049B9F 049A049B 049A049C 029A029C 959F0494 9F049402 9D9F0295 029D9F02 959F0494 9A049402 9C049A02 9C049A04 049B9F04 9F049B9F 9B9F049B 9F029204 04920293 939F0292 92069202 92029E02 9E029208 92089202 92049A04 9A049208 920A9204 92049604 9604920C 920C9204 92049604 9604920C 920E9204 92049204 0492010F 0F920492 92049201 010F9204 04920492 9A030F92 0F9A050F 050F9A05 9A050F9A 0F9A050F 090F9607 00000C96 't2 'Offset 384 00050005 03220326 00260322 'Offset 396 00050005 F312F316 00164312 'test 'Offset 408 00050005 03220326 00260322 'Offset 420 00050005 F312F316 00164312 'test3 'Offset 432 00060006 00161F1F 'tloe1 'Offset 440 00180018 0341E102 03410441 E14104E1 0C41E102 410541E1 52024102 0341E104 F2510B41 0F4202D1 51F3D151 41E1410B F3D15104 08410A51 0351D251 010FE141 02320152 4102E141 08E14106 41023151 4106E103 0531D109 01390741 080F31F1 410831F1 023A41E1 410631D1 31D1010F 4104E10A 0131D107 41E10131 41054103 015107E1 0AE10251 03310541 E1410951 3301E106 410AD151 41E104E1 0341E10C 0F410441 410B4104 020FE104 410441E1 4102E108 E10D4105 4107E104 000002E1 END CSUB Edited 2023-09-17 20:36 by matherp |