REM Copyright 2012 Castle Technology Ltd REM REM Licensed under the Apache License, Version 2.0 (the "License"); REM you may not use this file except in compliance with the License. REM You may obtain a copy of the License at REM REM http://www.apache.org/licenses/LICENSE-2.0 REM REM Unless required by applicable law or agreed to in writing, software REM distributed under the License is distributed on an "AS IS" BASIS, REM WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. REM See the License for the specific language governing permissions and REM limitations under the License. REM REM > ChangeFSI REM REM REM This program written by Roger Wilson at Acorn Computers Apr 1989-Jun 1994 REM and by Sophie Wilson Aug 1994- REM - please send bugs back! REM Subject to change without notice REM REM All information is held in 32 bit fixed point with the . at bit 28 REM this gives an integer range of 0-15 (OR negative numbers!) REM REM ChangeFSI is written so as to allow use from CLI and from other BASIC REM programs such as WIMP front ends, plus use of its own wimp front end. REM areanumber%=0 leaf$="" SYS "OS_GetEnv" TO A$ REM Read CLI string task%=INSTR(A$," -wimp") SYS "OS_SWINumberFromString",,"OS_ReadMonotonicTime" TO Time% SYS "OS_SWINumberFromString",,"ColourTrans_ReturnColourNumber" TO ctran% IF task% THEN DIM z%(1),p%(3),s%(3) SYS"MessageTrans_FileInfo",,".Messages" TO,,S% DIM msgb% 16,msgf% S% SYS"MessageTrans_OpenFile",msgb%,".Messages",msgf% startfile%=RIGHT$(A$,6)<>"-wimp " DIM taskid% 4,taskmsg% 4 $taskid%="TASK" !taskmsg%=0:REM All messages SYS "Wimp_Initialise",310,!taskid%,FNmsg0("_TaskName"),taskmsg% TO version% IF version%>=350 THEN SYS "XOS_Memory",8+(2<<8) TO ,r1,r2;F% IF F% AND 1 vramsize%=0 ELSE vramsize%=r1*r2 IF vramsize%>0 vram%= TRUE ELSE vram%= FALSE ELSE vram%= FALSE ENDIF Wimp = (1<<18) + (3<<6) CreateW = Wimp+1 OpenW = Wimp+5 CloseW = Wimp+6 RedrawW = Wimp+8 UpdateW = Wimp+9 GetR% = Wimp+10 GetW = Wimp+11 SetI = Wimp+13 GetI = Wimp+14 GetP = Wimp+15 Drag = Wimp+16 CrMenu = Wimp+20 DcMenu = Wimp+21 SYS "OS_SWINumberFromString",,"Wimp_PollIdle" TO Poll% SYS "OS_SWINumberFromString",,"Wimp_SetCaretPosition" TO Caretpos% SYS "OS_SWINumberFromString",,"Wimp_GetCaretPosition" TO Getcaret% SYS "XOS_SWINumberFromString",,"DragASprite_Start" TO dstart%;f% IF f% AND 1 dstart%=0 SYS "XOS_SWINumberFromString",,"JPEG_PlotScaled" TO jpegpaint%;f% IF f% AND 1 jpegpaint%=0 SYS "OS_Byte",161,&1C TO ,,f% IF (f% AND 2)=0 dstart%=0 nextlocation%=HIMEM SYS "Wimp_SlotSize",-1,-1 TO originalslot% PROClocale_initialise IF version%>=300 THEN DIM q% 255,ifactors% 15,factors% 15,pixtrans% 255,paltemp% 1023,buffer% 255,idata% 1023 ELSE DIM z% 1699,q% 255,ifactors% 15,factors% 15,pixtrans% 255,paltemp% 1023,buffer% 255,idata% 2399 eidata%=idata%+2400 ENDIF scrap%= FALSE sprite%= FALSE sar%= FALSE saved%= TRUE isopen%= FALSE lastm%= 0 z$= STRING$(12,CHR$13) SYS "OS_Byte",161,&8C TO ,,f% IF f% AND 1 THEN SYS "Wimp_OpenTemplate",,".Template3d" ELSE SYS "Wimp_OpenTemplate",,".Templates" ENDIF LOCAL ERROR ON ERROR SYS "Wimp_CloseTemplate":ERROR 0,REPORT$+" (code "+ STR$ERL+")" IF version%>=300 THEN DIM z% FNlargest_buffer indsize%=FNsize_indirect("Info") DIM info_wind% indsize% SYS "Wimp_LoadTemplate",,z%,info_wind%,info_wind%+indsize%,-1,"Info"+z$,0 ELSE SYS "Wimp_LoadTemplate",,z%,idata%,eidata%,-1,"Info"+z$,0 TO ,,idata% ENDIF SYS CreateW,,z% TO infow% $!(z%+88+7*32+20)=FNmsg0("_Version") PROCdotemplate("Processing") SYS CreateW,,z% TO proc% p%(0)=!(z%+88+8*32+20) p%(1)=!(z%+88+9*32+20) p%(2)=!(z%+88+10*32+20) p%(3)=!(z%+88+11*32+20) PROCdotemplate("Output") SYS CreateW,,z% TO output% admode%=!(z%+88+20*32+20) adspcl%=!(z%+88+19*32+20) oldmode%=!(z%+88+33*32+20) PROCdotemplate("Scaling") SYS CreateW,,z% TO scalew% adscale%=!(z%+88+1*32+20) s%(0)=!(z%+88+10*32+20) s%(1)=!(z%+88+11*32+20) s%(2)=!(z%+88+12*32+20) s%(3)=!(z%+88+13*32+20) PROCdotemplate("Save") SYS CreateW,,z% TO save% adsave%=!(z%+88+1*32+20) adsavesprite%=!(z%+88+0*32+20) PROCdotemplate("Sprite") SYS CreateW,,z% TO sinfo% adsname%=!(z%+88+5*32+20) adsbytes%=!(z%+88+8*32+20) adsx%=!(z%+88+7*32+20) adsy%=!(z%+88+9*32+20) adsm%=!(z%+88+6*32+20) PROCdotemplate("Source") SYS CreateW,,z% TO srcinfo% adsrc%=!(z%+88+0*32+20) PROCdotemplate("Range") SYS CreateW,,z% TO raninfo% adran%=!(z%+88+0*32+20) PROCdotemplate("Zoom") SYS CreateW,,z% TO zoom% z%(0)=!(z%+88+4*32+20) z%(1)=!(z%+88+5*32+20) PROCdotemplate("JPEGOutput") SYS CreateW,,z% TO jpego% adjpegq%=!(z%+88+5*32+20) PROCdotemplate("Pic") SYS CreateW,,z% TO pic% adtitle%=z%!72 RESTORE ERROR SYS "Wimp_CloseTemplate" !q%=-1 q%!4=0 q%!8=0 q%!12=68 q%!16=68 q%!20=%11000000000010 $(q%+24)="!"+FNmsg0("_TaskName") SYS "Wimp_CreateIcon",,q% TO iconbar% SYS "XOS_Find",&40,"Choices:ChangeFSI.Choices" TO A%;V% IF (A%=0) OR ((V% AND 1)=1) THEN fast%= FALSE dest%=1 statescale%=%10000000100 stateproc%=0 stateoutput%=&4052008 statejpeg%=&2 $p%(0)="" $p%(1)="2"+decimal_point$+"2" $p%(2)="24" $p%(3)="4" $adspcl%="" $admode%="28" $s%(0)="1" $s%(1)="4" $s%(2)="1" $s%(3)="4" $adjpegq%="75" $oldmode%="" ELSE INPUT#A%,fast%,dest%,statescale%,stateproc%,stateoutput%,statejpeg%,$adjpegq%,$oldmode% INPUT#A%,$p%(0),$p%(1),$p%(2),$p%(3),$admode%,$adspcl% $p%(1)=FNlocale_convert($p%(1),".",decimal_point$) INPUT#A%,$s%(0),$s%(1),$s%(2),$s%(3) CLOSE#A% ENDIF q%!12=1<<21 !q%=scalew% FOR I%=0 TO 9 IF statescale%>>I% AND 1 q%!8=1<<21 ELSE q%!8=0 q%!4=I% SYS SetI,,q% NEXT FOR I%=10 TO 13 IF statescale%>>I% AND 1 q%!8=1<<21 ELSE q%!8=0 q%!4=I%+6 SYS SetI,,q% NEXT !q%=proc% FOR I%=0 TO 7 IF stateproc%>>I% AND 1 q%!8=1<<21 ELSE q%!8=0 q%!4=I% SYS SetI,,q% NEXT !q%=output% FOR I%=0 TO 26 IF stateoutput%>>I% AND 1 q%!8=1<<21 ELSE q%!8=0 q%!4=I% SYS SetI,,q% NEXT !q%=jpego% FOR I%=0 TO 3 IF statejpeg%>>I% AND 1 q%!8=1<<21 ELSE q%!8=0 q%!4=I% SYS SetI,,q% NEXT IF stateoutput%>>17 AND 1 q%!8=1<<22 ELSE q%!8=0 !q%=output% q%!12=1<<22 q%!4=7 SYS SetI,,q% q%!4=8 SYS SetI,,q% q%!4=13 SYS SetI,,q% q%!4=14 SYS SetI,,q% PROCshowscaletofit $z%(0)="1" $z%(1)="1" SYS "OS_UpdateMEMC" TO oldmemc jpegsave%= FALSE ON ERROR SYS "OS_UpdateMEMC",oldmemc,&700:PROCerrorbox:SYS CrMenu,,-1 : REM close menus! SYS Drag,,-1 IF NOT sprite% SYS "Wimp_SlotSize",originalslot%,-1 F$="" IF startfile% startfile%= FALSE :F$=MID$(A$,INSTR(A$,"-wimp")+6):PROCcallFSI REPEAT SYS Poll%,1,q% TO A% CASE A% OF WHEN 1 IF sprite% PROCredraw_window(!q%) WHEN 2 PROCopen_window(!q%,q%!4,q%!8,q%!12,q%!16,q%!20,q%!24,q%!28) WHEN 3 SYS &400c3,,q% nextlocation%=HIMEM PROCremovearea SYS "Wimp_SlotSize",originalslot%,-1 saved%= TRUE sprite%= FALSE isopen%= FALSE WHEN 6 PROCcheckmouse(!q%,q%!4,q%!8,q%!12,q%!16,q%!20) WHEN 7 SYS GetP,,q% dw%=q%!12 di%=q%!16 IF dstart% SYS "DragASprite_Stop" q%!12=0 q%!16=1 q%!20=dw% q%!24=di% q%!28=!q% q%!32=q%!4 q%!36=!sar%+3 IF jpegsave% THEN q%!40=&c85 ELSE q%!40=&ff9 ENDIF temp$=FNZS(adsave%) foo%=INSTR(temp$,".") WHILE foo% temp$=MID$(temp$,foo%+1) foo%=INSTR(temp$,".") ENDWHILE $(q%+44)=temp$+CHR$0 !q%=44+(LEN temp$+1+3 AND NOT 3) SYS "Wimp_SendMessage",17,q%,dw%,di% myref%=q%!8 WHEN 8 PROCkey(!q%,q%!4,q%!24) WHEN 9 PROCmenuselect(q%) WHEN 17,18 PROCreceive(q%) ENDCASE UNTIL FALSE ELSE Q%=HIMEM REM Remember memory size END=&4000000 REM Grab all the memory ON ERROR ON ERROR OFF:OSCLI"Set ChangeFSI$ReturnCode "+REPORT$+" (code "+ STR$ERL+")":PROCremovearea:CLEAR:END=Q%:END foo%=0 REM Call program A%=FNChangeFSI(A$,-1,-1,0,-1,-1,foo%,TRUE) PROCremovearea OSCLI"unset ChangeFSI$ReturnCode" CLEAR END=Q% REM Return it all again ENDIF END : REM « » DEF PROCdotemplate(a$) LOCAL A% IF version%>300 THEN SYS "Wimp_LoadTemplate",,0,,,,a$+z$,0 TO ,,indsize% DIM A% indsize% SYS "Wimp_LoadTemplate",,z%,A%,A%+indsize%,-1,a$+z$,0 ELSE SYS "Wimp_LoadTemplate",,z%,idata%,eidata%,-1,a$+z$,0 TO ,,idata% ENDIF ENDPROC : REM « » DEF PROClocale_initialise LOCAL p% LOCAL ERROR ON ERROR LOCAL decimal_point$=".":ENDPROC SYS "Territory_ReadSymbols",-1,0 TO p% decimal_point$=CHR$?p% ENDPROC : REM « » DEF FNlocale_convert(n$,f$,t$) IF f$=t$ THEN =n$ LOCAL i% i%=INSTR(n$,f$) IF i%<>0 : =LEFT$(n$,i%-1)+t$+MID$(n$,i%+1) =n$ : REM « » DEF FNsize_indirect(name$) LOCAL size% SYS "Wimp_LoadTemplate",,0,,,,name$+z$,0 TO ,,size% =size% : REM Returns the largest buffer size necessary for passing REM to R1 on a Wimp_LoadTemplate DEF FNlargest_buffer LOCAL largest_tem%,size%,here%,name DIM name 12 $name="*" here%=0 largest_tem%=0 SYS "Wimp_LoadTemplate", ,0,,,,name,0 TO ,size%,,,,,here% WHILE here% IF largest_tem%save% THEN !q%=60 q%!12=q%!8 q%!16=2 q%!36=-1 $(q%+44)=""+CHR$0 SYS "Wimp_SendMessage",17,q%,q%!4 scrap%=q%!8 ENDIF WHEN 2 IF jpegsave% THEN SYS "OS_File",10,FNZS(q%+44),&c85,,sar%,sar%+jpegsize% ELSE SYS &2E,&10C,sar%,FNZS(q%+44) ENDIF $adsave%=FNZS(q%+44) q%!12=q%!8 q%!16=3 SYS "Wimp_SendMessage",18,q%,q%!4 IF q%!36<>-1 saved%= TRUE SYS CrMenu,,-1 WHEN 3 F$=FNZS(q%+44) IF scrap% scrap%=scrap%=q%!12 q%!12=q%!8 q%!16=4 SYS "Wimp_SendMessage",17,q%,q%!4 PROCcallFSI WHEN 5 CASE q%!40 OF WHEN &ff0,&c85 q%!12=q%!8 q%!16=4 SYS "Wimp_SendMessage",17,q%,q%!4 F$=FNZS(q%+44) PROCcallFSI ENDCASE WHEN 8 PROCchecksaved(q%) WHEN 9,&400C1 IF sprite% PROCgetmodeinfo:SYS &400d1,pic%,0,-32767,32767,0 PROCshowscaletofit WHEN 10 SYS "XOS_ReadVarVal","ChangeFSI$Dir",paltemp%,256,0,3 TO ,,bootlen% paltemp%?bootlen%=13 BPUT#q%!20,"Run "+$paltemp% WHEN &502 REM Interactive help PROCgethelp(q%!32,q%!36) ENDCASE ENDPROC : REM « » DEF PROCgethelp(w%,i%) IF i%<-1 THEN ENDPROC CASE w% OF WHENinfow% $(q%+20)=FNmsg0("Hinfo"+STR$(i%)) WHENproc% $(q%+20)=FNmsg0("Hproc"+STR$(i%)) WHENoutput% $(q%+20)=FNmsg0("Hout"+STR$(i%)) WHENscalew% $(q%+20)=FNmsg0("Hscale"+STR$(i%)) WHENsave% $(q%+20)=FNmsg0("Hsave"+STR$(i%)) WHENsinfo% $(q%+20)=FNmsg0("Hsprite"+STR$(i%)) WHENsrcinfo% $(q%+20)=FNmsg0("Hsrc"+STR$(i%)) WHENraninfo% $(q%+20)=FNmsg0("Hrange"+STR$(i%)) WHENzoom% $(q%+20)=FNmsg0("Hzoom"+STR$(i%)) WHENjpego% $(q%+20)=FNmsg0("Hjpeg"+STR$(i%)) WHENpic% $(q%+20)=FNmsg0("Hpic"+STR$(i%)) WHEN-2 ENDPROC:REM Default from !Help used OTHERWISE IF i%<>-1 THEN REM Must be a menu then SYS "Wimp_GetMenuState",1,q%+20,w%,i% IF lastm%=101 THEN REM The iconbar menu LOCAL grey$ IF (q%!20=6) AND vram% THEN grey$="g" IF (q%!20=5) AND (F$="" OR F$="SpriteFile" OR F$="JPEGImage") THEN grey$="g" $(q%+20)=FNmsg0("Himnu"+STR$(q%!20)+grey$) ELSE IF lastm%=pic% THEN REM The picture menu $(q%+20)=FNmsg0("Hpmnu"+STR$(q%!20)) ELSE REM Yikes, some menu we didn't open ENDPROC ENDIF ENDIF ENDIF ENDCASE q%!0=((20+LEN($(q%+20))+1)+3)ANDNOT3 q%!12=q%!8 q%!16=&503:REM Message_HelpReply SYS "Wimp_SendMessage",17,q%,q%!4 ENDPROC : REM « » DEF PROCcallFSI IF FNcheckvalues <> 0 THEN ENDPROC A$=FNdeducemode A%=47 jpegsave%= FALSE IF dest%=0 THEN jpegsave%= TRUE A$="JPEG" IF FNgeticonstate(jpego%,2) A$="JPEGMONO" A$+=$adjpegq% ELSE IF FNgeticonstate(output%,15) THEN A$+=$adspcl% ELSE IF FNgeticonstate(output%,16) THEN IF FNgeticonstate(output%,5) OR FNgeticonstate(output%,11) A$+="R" ELSE SYS 53,VAL A$,3 TO ,,A% IF A%=63 THEN IF FNgeticonstate(output%,6) A$="27t" IF FNgeticonstate(output%,12) A$="12t" ELSE IF A%=255 A$+="d" ENDIF ENDIF ENDIF ENDIF A$="garbage "+F$+" .Foo "+A$ PROCChangeFSISuffix info$="" range$=FNmsg0("NoRange") cputime%=0 IF sprite% !q%=pic%:SYS &400c3,,q%:saved%= TRUE :sprite%= FALSE nextlocation%=HIMEM SYS "Wimp_SlotSize",originalslot%,-1 PROCremovearea IF fast% SYS "OS_UpdateMEMC",&300,&700 TO oldmemc A%=FNChangeFSI(A$,-1,-1,nextlocation%,0,0,sar%,0) IF fast% SYS "OS_UpdateMEMC",oldmemc,&700 IF scrap% scrap%= FALSE :SYS "OS_File",6,F$ IF A%<2 AND sar%<>0 THEN $adsx%= STR$xsp% $adsy%= STR$ysp% IF jpegsave% THEN $adsm%="JPEG" $adsname%="JPEG" $adsbytes%= STR$jpegsize% x=xsp%*2 y=ysp%*2 SYS &35,-1,4 TO ,,nx SYS &35,-1,5 TO ,,ny !ifactors%=1 ifactors%!4=1 ifactors%!8=nx ifactors%!12=ny $adsavesprite%="file_c85" IF LEFT$(F$,7)=""." A%-=1 ENDWHILE $adsave%=MID$("."+F$,A%+1) pic%=FNcreate_window(x,y,F$) PROCpopup(pic%,-1) ENDIF ENDPROC : REM « » DEF FNcheckvalues LOCAL e,error$,flag% REM Is the JPEG quality within the correct range? IF dest%=0 AND VAL ($adjpegq%) > 100 THEN e = 1 error$ = FNmsg0("BadJQ") ENDIF REM Is it a numerical mode? IF LEFT$($admode%,1) < "A" AND dest%=1 THEN SYS &35, VAL ($admode%), 0 TO ;flag% REM Is the numerical mode valid? IF LEN ($admode%) = 0 flag%=2 IF VAL ($admode%) > 127 AND VAL ($admode%) < 256 flag%=2 IF (flag% AND 2) > 0 THEN e = 2 error$ = FNmsg0("BadMode") ENDIF ENDIF IF e <> 0 THEN SYS Drag,,-1 !buffer%=e $(buffer%+4)=error$+CHR$0 SYS "Wimp_ReportError",buffer%,%01,FNmsg0("_TaskName") TO ,A% IF A%=2 THEN PROCfinishandquit ENDIF =e : REM « » DEF PROCChangeFSISuffix safe%= TRUE IF FNgeticonstate(scalew%,1) A$+=" "+ STR$tofitx+": "+ STR$tofity+":":safe%= FALSE IF FNgeticonstate(scalew%,5) A$+=" 1:2":safe%= FALSE IF FNgeticonstate(scalew%,4) A$+=" 1:2 1:1":safe%= FALSE IF FNgeticonstate(scalew%,3) A$+=" 1:1 1:2":safe%= FALSE IF FNgeticonstate(scalew%,9) THEN safe%= FALSE IF VAL $s%(0) A$+=" "+$s%(0) ELSE A$+=" 1" A$+=":"+$s%(1) IF VAL $s%(2) A$+=" "+$s%(2) ELSE A$+=" 1" A$+=":"+$s%(3) ENDIF IF FNgeticonstate(scalew%,0) A$+=" -nosize" IF FNgeticonstate(scalew%,18) A$+=" -noscale" IF FNgeticonstate(scalew%,19) A$+=" -lock" IF FNgeticonstate(scalew%,6) THEN safe%= FALSE IF FNgeticonstate(scalew%,16) A$+=" -rotate" ELSE A$+=" -rotate-" ENDIF IF FNgeticonstate(scalew%,7) A$+=" -hflip":safe%= FALSE IF FNgeticonstate(scalew%,8) A$+=" -vflip":safe%= FALSE IF FNgeticonstate(proc%,0) A$+=" -range":safe%= FALSE IF FNgeticonstate(proc%,1) A$+=" -equal":safe%= FALSE IF FNgeticonstate(proc%,2) A$+=" -nodither" IF FNgeticonstate(proc%,3) A$+=" -invert":safe%= FALSE IF FNgeticonstate(proc%,4) A$+=" -brighten" IF FNgeticonstate(proc%,5) A$+=" -black"+$p%(0) IF FNgeticonstate(proc%,6) A$+=" -gamma"+FNlocale_convert($p%(1),decimal_point$,"."):safe%= FALSE IF FNgeticonstate(proc%,7) A$+=" -sharpen"+$p%(2):safe%= FALSE IF FNgeticonstate(proc%,11) A$+=" -smooth"+$p%(3) ENDPROC : REM « » DEF PROCfinishandquit PROCremovearea SYS "Wimp_CloseDown" SYS "XMessageTrans_CloseFile",msgb% END ENDPROC : REM « » DEF PROCcheckandfinish IF saved% OR NOT sprite% THEN PROCfinishandquit !buffer%=ERR $(buffer%+4)=FNmsg1("Unsaved",F$)+CHR$0 SYS "Wimp_ReportError",buffer%,%010100000000,FNmsg0("_TaskName"),"!changefsi",1,FNmsg0("ButCon") TO ,A% IF A%=4 THEN PROCfinishandquit ENDPROC : REM « » DEF PROCchecksaved(q%) IF saved% OR NOT sprite% ENDPROC !buffer%=ERR $(buffer%+4)=FNmsg1("Unsaved",F$)+CHR$0 SYS "Wimp_ReportError",buffer%,%010100000000,FNmsg0("_TaskName"),"!changefsi",1,FNmsg0("ButCon") TO ,A% q%!12=q%!8 IF A%<>4 SYS "Wimp_SendMessage" ,19, q%, 0 ENDPROC : REM « » DEF PROCkey(handle%,icon%,key%) IF key%=&1b SYS CrMenu,,-1:ENDPROC CASE handle% OF WHEN zoom% CASE key% OF WHEN 13 PROCdozoom(icon%-4,0) IF icon%=4 SYS &400d2,zoom%,5,,,-1,LEN $z%(0) IF icon%=5 SYS CrMenu,,-1 ENDPROC WHEN &18e,&18f PROCdozoom(icon%-4,0) SYS &400d2,zoom%,icon% EOR 1,,,-1,LEN $z%(icon% EOR 5) ENDPROC ENDCASE WHEN save% IF key%=13 PROCsavesprite:ENDPROC WHEN output% IF icon%=33 AND FNgeticonstate(output%, 24) THEN $admode% = $oldmode%:!q%=output%:q%!4=20:q%!8=0:q%!12=0:SYS SetI,,q% PROCshowscaletofit IF key%=13 SYS CrMenu,,-1:ENDPROC IF key%=&18e THEN CASE icon% OF WHEN 19 icon%=33 key%=oldmode% WHEN 33 icon%=19 key%=adspcl% ENDCASE ENDIF IF key%=&18f THEN CASE icon% OF WHEN 33 icon%=19 key%=adspcl% WHEN 19 icon%=33 key%=oldmode% ENDCASE ENDIF IF key%>1024 SYS &400d2,output%,icon%,,,-1,LEN $key%:ENDPROC WHEN proc% CASE key% OF WHEN &18e,13 icon%+=1 IF icon%>11 icon%=8:IF key%=13 SYS CrMenu,,-1:ENDPROC SYS &400d2,proc%,icon%,,,-1,LEN $p%(icon%-8) ENDPROC WHEN &18f icon%-=1 IF icon%<8 icon%=11 SYS &400d2,proc%,icon%,,,-1,LEN $p%(icon%-8) ENDPROC ENDCASE WHEN scalew% CASE key% OF WHEN &18e,13 icon%+=1 IF icon%>13 icon%=10:IF key%=13 SYS CrMenu,,-1:ENDPROC SYS &400d2,scalew%,icon%,,,-1,LEN $s%(icon%-10) ENDPROC WHEN &18f icon%-=1 IF icon%<10 icon%=13 SYS &400d2,scalew%,icon%,,,-1,LEN $s%(icon%-10) ENDPROC ENDCASE ENDCASE SYS "Wimp_ProcessKey",key% ENDPROC : REM « » DEF PROCsavesprite IF F$ = $adsave% THEN SYS Drag,,-1 !buffer%=3 $(buffer%+4)=FNmsg0("OverW")+CHR$0 SYS "Wimp_ReportError",buffer%,%11,FNmsg0("_TaskName") TO ,A% IF A%=2 THEN REM Cancel SYS CrMenu,,-1 ENDPROC ENDIF ENDIF IF jpegsave% THEN SYS "OS_File",10,$adsave%,&c85,,sar%,sar%+jpegsize% ELSE SYS &2E,&10C,sar%,$adsave% ENDIF SYS CrMenu,,-1 ENDPROC : REM « » DEF PROCcheckmouse(mousex%,mousey%,b%,handle%,icon%,ob%) LOCAL moved%,imenu$,pmenu$ REM Picture menu structure pmenu$= FNmsg0("Pimg")+">sinfo%,"+FNmsg0("Psrc")+">srcinfo%,"+FNmsg0("Prange")+">raninfo%," pmenu$=pmenu$+FNmsg0("Pzoom")+">zoom%,"+FNmsg0("Psave")+">save%,"+FNmsg0("PIredo") REM Iconbar menu structure imenu$= FNmsg0("Iinfo")+">infow%,"+FNmsg0("Iscale")+">scalew%,"+FNmsg0("Iproc")+">proc%," imenu$=imenu$+FNmsg0("Ispr")+">output%:dest%,"+FNmsg0("Ijpg")+">jpego%:1-dest%,"+FNmsg0("PIredo")+"," imenu$=imenu$+FNmsg0("Ifast")+":fast%AND1,"+FNmsg0("Ichoice")+","+FNmsg0("Iquit") moved%= FALSE REM Button 'menu' IF b% AND 2 THEN CASE handle% OF WHEN pic% PROCdomenu(pic%,pmenu$,FNmsg0("_TaskName")) WHEN -2 PROCdomenu(101,imenu$,FNmsg0("_TaskName")) ENDCASE rmenuhandle%=handle% ENDIF REM Button 'select' IF b% AND 4 THEN CASE handle% OF WHEN zoom% CASE icon% OF WHEN 0 PROCdozoom(0,1) WHEN 1 PROCdozoom(0,-1) WHEN 2 PROCdozoom(1,1) WHEN 3 PROCdozoom(1,-1) ENDCASE ENDCASE ENDIF REM Button 'adjust' IF b% AND 1 THEN CASE handle% OF WHEN zoom% CASE icon% OF WHEN 0 PROCdozoom(0,-1) WHEN 1 PROCdozoom(0,1) WHEN 2 PROCdozoom(1,-1) WHEN 3 PROCdozoom(1,1) ENDCASE ENDCASE ENDIF REM Button 'adjust' or 'select' IF b% AND 5 THEN CASE handle% OF WHEN output% IF dest%=0 THEN dest%=1:PROCdomenu(101,imenu$,FNmsg0("_TaskName")):SYS Getcaret%,,q%:moved%= TRUE CASE icon% OF WHEN 3,4,5,6 PROCkillcurrent( STR$(22+icon%)) !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% WHEN 7 PROCkillcurrent("S16,90,90") !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% WHEN 8 PROCkillcurrent("S32,90,90") !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% WHEN 9 PROCkillcurrent("0") !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% WHEN 10 PROCkillcurrent("8") !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% WHEN 11 PROCkillcurrent("12") !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% WHEN 12 PROCkillcurrent("15") !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% WHEN 13 PROCkillcurrent("S16,90,45") !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% WHEN 14 PROCkillcurrent("S32,90,45") !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% WHEN 15 PROCkillcurrent(FNdeducemode) SYS SetI,,q% SYS Caretpos%,output%,19,,,-1,LEN ($adspcl%) !q%=output% q%!4=7 q%!8=0 q%!12=1<<22 SYS SetI,,q% q%!4=8 SYS SetI,,q% q%!4=13 SYS SetI,,q% q%!4=14 SYS SetI,,q% WHEN 16 PROCkillcurrent(FNdeducemode) !q%=output% q%!4=7 q%!8=0 q%!12=1<<22 SYS SetI,,q% q%!4=8 SYS SetI,,q% q%!4=13 SYS SetI,,q% q%!4=14 SYS SetI,,q% WHEN 17 PROCkillcurrent(FNdeducemode) !q%=output% q%!4=7 q%!8=1<<22 q%!12=1<<22 SYS SetI,,q% q%!4=8 SYS SetI,,q% q%!4=13 SYS SetI,,q% q%!4=14 SYS SetI,,q% IF LEFT$($admode%,1) = "S" THEN IF RIGHT$($admode%,2) = "45" THEN PROCkillcurrent("15") !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% ELSE PROCkillcurrent("28") !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% ENDIF ENDIF WHEN 18 !q%=output% q%!4=24 q%!8=0 q%!12=1<<21 SYS SetI,,q% WHEN 24 !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% PROCkillcurrent(FNdeducemode) SYS Caretpos%,output%,33,,,-1,LEN ($oldmode%) WHEN 33 IF moved% SYS Caretpos%,output%,q%!4,q%!8,q%!12,q%!16,q%!20 WHEN 19 IF moved% SYS Caretpos%,output%,q%!4,q%!8,q%!12,q%!16,q%!20 ENDCASE IF FNgeticonstate(output%,18) $admode%=FNdeducemode:REM SYS Caretpos%,output%,20,,,-1,LEN(FNdeducemode) !q%=output% q%!4=20 q%!8=0 q%!12=0 SYS SetI,,q% PROCshowscaletofit WHEN save% CASE icon% OF WHEN 2 PROCsavesprite ENDCASE WHEN -2 IF sprite% PROCgetw(pic%):PROCopen_window(pic%,x0%,y0%,x1%,y1%,scx%,scy%,-1) WHEN jpego% IF dest%=1 THEN SYS Getcaret%,,q% dest%=0 PROCdomenu(101,imenu$,FNmsg0("_TaskName")) IF icon%=5 SYS Caretpos%,jpego%,q%!4,q%!8,q%!12,q%!16,q%!20 ENDIF CASE icon% OF WHEN 3 IF b% AND 4 $adjpegq% = STR$(VAL ($adjpegq%)-1) ELSE $adjpegq% = STR$(VAL ($adjpegq%)+1) IF VAL ($adjpegq%)<0 $adjpegq%="0" IF VAL ($adjpegq%)>100 $adjpegq%="100" !q%=jpego% q%!4=5 q%!8=0 q%!12=0 SYS SetI,,q% SYS Caretpos%,jpego%,5,,,-1,LEN ($adjpegq%) WHEN 4 IF b% AND 4 $adjpegq% = STR$(VAL ($adjpegq%)+1) ELSE $adjpegq% = STR$(VAL ($adjpegq%)-1) IF VAL ($adjpegq%)<0 $adjpegq%="0" IF VAL ($adjpegq%)>100 $adjpegq%="100" !q%=jpego% q%!4=5 q%!8=0 q%!12=0 SYS SetI,,q% SYS Caretpos%,jpego%,5,,,-1,LEN ($adjpegq%) WHEN 5 REM Quality ENDCASE ENDCASE ENDIF IF b% AND &50 THEN CASE handle% OF WHEN save% CASE icon% OF WHEN 0 PROCgetw(save%) !q%=save% q%!4=0 SYS GetI,,q% !q%=save% q%!4=5 q%!8+=bx% q%!12+=by% q%!16+=bx% q%!20+=by% q%!24=0 q%!28=0 q%!32=&7FFFFFFF q%!36=&7FFFFFFF t$="file_ff9" IF jpegsave% t$="file_c85" IF dstart% SYS dstart%,%11000101,1,t$,q%+8,q%+24 ELSE SYS "Wimp_DragBox",,q% ENDCASE ENDCASE ENDIF ENDPROC : REM « » DEF PROCdozoom(s%,a%) IF s%=0 THEN $z%(0)= STR$(VAL $z%(0)+a%) IF $z%(0)="0" $z%(0)="1" ELSE $z%(1)= STR$(VAL $z%(1)+a%) IF $z%(1)="0" $z%(1)="1" ENDIF !q%=zoom% q%!4=4+s% q%!8=0 q%!12=0 SYS SetI,,q% !q%=pic% SYS GetW,,q% f%=q%!28 SYS &400c3,,q% pic%=FNcreate_window(x,y,F$) PROCpopup(pic%,f%) ENDPROC : REM « » DEF PROCdomenu(handle%,menu$,menutitle$) menuhandle%=handle% menuptr%=buffer% indirect%=idata% i%=0 menuptr%!20=44 $menuptr%=menutitle$ menuptr%?12=7 menuptr%?13=2 menuptr%?14=7 menuptr%?15=0 menuptr%!16=200 menuptr%!24=0 menuptr%+=28 REPEAT i1%=i%+1 i%=INSTR(menu$+",",",",i1%) item$=MID$(menu$,i1%,i%-i1%) PROCmenuitem(item$) UNTIL item$="" menuptr%!-24=(menuptr%!-24) OR &80 IF handle%=101 SYS CrMenu,,buffer%,mousex%-64,96+9*44 ELSE SYS CrMenu,,buffer%,mousex%-64,mousey% lastm%=handle%:REM Record last menu opened for interactive help ENDPROC : REM « » DEF PROCmenuitem(text$) IF text$="" ENDPROC flg%=0 submenu%=-1 I%=INSTR(text$,":") IF I% THEN flg%=EVALMID$(text$,I%+1) text$=LEFT$(text$,I%-1) ENDIF I%=INSTR(text$,">") IF I% THEN submenu%=EVALMID$(text$,I%+1) text$=LEFT$(text$,I%-1) ENDIF menuptr%!0=flg% menuptr%!4=submenu% IF (text$=FNmsg0("PIredo") AND (F$="" OR F$="SpriteFile" OR F$="JPEGImage")) OR (text$=FNmsg0("Ifast") AND vram%) THEN menuptr%!8=&07400021 ELSE menuptr%!8=&07000021 ENDIF IF LEN text$*16+8>buffer%!16 buffer%!16=LEN text$*16+8 IF LEN text$>12 THEN menuptr%!8=menuptr%!8 OR 256 menuptr%!20=LEN text$+1 menuptr%!16=0 menuptr%!12=indirect% $indirect%=text$ indirect%+=LEN text$+2 ELSE $(menuptr%+12)=text$ ENDIF menuptr%+=24 ENDPROC : REM « » DEF PROCmenuselect(menus%) SYS GetP,,paltemp% adjust%=paltemp%!8 AND 1 SYS DcMenu,,buffer%,menus%, STRING$(200," ") TO ,,,a$ IF a$="" THEN ENDPROC CASE menuhandle% OF WHEN pic% CASE a$ OF WHEN FNmsg0("PIredo") PROCcallFSI ENDCASE WHEN 101 CASE a$ OF WHEN FNmsg0("Ifast") fast%=NOT fast% WHEN FNmsg0("Ijpg") dest%=0 WHEN FNmsg0("Ispr") dest%=1 WHEN FNmsg0("PIredo") PROCcallFSI WHEN FNmsg0("Ichoice") statescale%=0 FOR I%=0 TO 9 statescale%+=FNgeticonstate(scalew%,I%)<.ChangeFSI" A%= OPENOUT".ChangeFSI.Choices" PRINT#A%,fast%,dest%,statescale%,stateproc%,stateoutput%,statejpeg%,$adjpegq%,$oldmode% PRINT#A%,$p%(0),FNlocale_convert($p%(1),decimal_point$,"."),$p%(2),$p%(3),$admode%,$adspcl% PRINT#A%,$s%(0),$s%(1),$s%(2),$s%(3) CLOSE#A% WHEN FNmsg0("Iquit") PROCcheckandfinish ENDCASE ENDCASE IF adjust% PROCcheckmouse(0,0,2,rmenuhandle%,0,0) ENDPROC : REM « » DEF FNcreate_window(x,y,title$) x=x*VAL $z%(0) DIV VAL $z%(1) y=y*VAL $z%(0) DIV VAL $z%(1) !z%=0 z%!4=-y z%!8=x z%!12=0 z%!40=0 z%!44=-y z%!48=x z%!52=0 IF x<128 OR y<128 z%?35=0 ELSE z%?35=255 $adtitle%="" SYS CreateW,,z% TO handle% $adtitle%=title$ =handle% : REM « » DEF PROCpopup(handle%,f%) SYS "OS_ReadModeVariable",-1,4 TO ,,modexshift% SYS "OS_ReadModeVariable",-1,5 TO ,,modeyshift% SYS "OS_ReadModeVariable",-1,11 TO ,,rightscr% SYS "OS_ReadModeVariable",-1,12 TO ,,topscr% rightscr%=rightscr%<>>16 ELSE REM New image,start in the middle xo%=rightscr%/2-(x0%+x1%)/2 yo%=topscr%/2-(y0%+y1%)/2 ENDIF PROCopen_window(handle%,x0%+xo%,y0%+yo%,x1%+xo%,y1%+yo%,scx%,scy%,f%) ENDPROC : REM « » DEF PROCopen_window(handle%,x0%,y0%,x1%,y1%,scx%,scy%,bhandle%) IF handle%=-1 THEN ENDPROC q%!0=handle% q%!28=bhandle% q%!4=x0% q%!8=y0% q%!12=x1% q%!16=y1% q%!20=scx% q%!24=scy% SYS OpenW,,q% isopen%=x0% OR (y1%<<16) ENDPROC : REM « » DEF PROCgetw(handle%) !q%=handle% SYS GetW,,q% PROCinfo(q%+4) bhandle%=q%!28 flags%=q%!32 ENDPROC : REM « » DEF PROCinfo(q%) x0%=!q% y0%=q%!4 x1%=q%!8 y1%=q%!12 scx%=q%!16 scy%=q%!20 bx%=x0%-scx% by%=y1%-scy% ENDPROC : REM « » DEF PROCredraw_window(handle%) IF handle%=pic% THEN !factors%=!ifactors%*VAL $z%(0) factors%!4=ifactors%!4*VAL $z%(0) factors%!8=ifactors%!8*VAL $z%(1) factors%!12=ifactors%!12*VAL $z%(1) PROCreduce(!factors%,factors%!8) PROCreduce(factors%!4,factors%!12) !q%=handle% SYS RedrawW,,q% TO more% PROCinfo(q%+4) by%=by%-INT (y*VAL $z%(0) DIV VAL $z%(1)) WHILE more% IF jpegsave% THEN IF jpegpaint% SYS jpegpaint%,sar%,bx%,by%,factors%,jpegsize%,1 TO ;V%:IF (V% AND 1)=0 ELSE CLG ELSE SYS &2002E,&134,sar%,n$,bx%,by%,,factors%,spx% ENDIF SYS GetR%,0,q% TO more% ENDWHILE ENDIF ENDPROC : REM « » DEF FNgeticonstate(handle%,icon%) !q%=handle% q%!4=icon% SYS GetI,,q% =q%!24>>21 AND 1 : REM « » DEF PROCgetmodeinfo IF jpegsave% THEN SYS &35,-1,4 TO ,,nx SYS &35,-1,5 TO ,,ny !ifactors%=1 ifactors%!4=1 ifactors%!8=nx ifactors%!12=ny ENDPROC ENDIF SYS "XWimp_ReadPixTrans",&100,sar%,n$,,,,ifactors%,pixtrans% SYS &2002E,&118,sar%,n$ TO ,,sptr% IF sptr%!32=44 THEN palptr%=0 ELSE FOR grab%=0 TO 2048-8 STEP 8 paltemp%!(grab%>>1)=sptr%!(grab%+44) NEXT palptr%=paltemp% ENDIF FOR Q%=0 TO 255 pixtrans%?Q%=Q% NEXT IF sptr%!32=44+2048 THEN FOR Q%=0 TO 255 SYS ctran%,palptr%!(Q%<<2) TO pixtrans%?Q% NEXT ELSE SYS "ColourTrans_SelectTable",m,palptr%,-1,-1,pixtrans% ENDIF spx%=0 FOR Q%=0 TO 255 IF pixtrans%?Q%<>Q% spx%=pixtrans% NEXT ENDPROC : REM « » DEF FNdeducemode LOCAL m,x,y IF FNgeticonstate(output%,18) THEN REM Use current screen mode SYS &35,-1,9 TO ,,m:REM log2bpp IF m>3 THEN SYS &35,-1,4 TO ,,x:REM xeigen SYS &35,-1,5 TO ,,y:REM yeigen x=180/(2^x) y=180/(2^y) ="S"+ STR$(2^m)+","+ STR$x+","+ STR$y ELSE = STR$MODE ENDIF ELSE IF FNgeticonstate(output%,24) THEN REM Use the number from the writeable icon =$oldmode% ELSE =$admode% ENDIF ENDIF : REM « » DEF PROCshowscaletofit LOCAL m,x,y $admode%=FNdeducemode CASE ?admode% OF WHEN ASC "S" IF VAL MID$($admode%,5)>VAL MID$($admode%,8) x=6 ELSE x=0 IF VAL MID$($admode%,2)>16 x+=5 ELSE x+=4 SYS &35,-1,11 TO ,,tofitx SYS &35,-1,12 TO ,,tofity WHEN ASC "J" SYS &35,-1,11 TO ,,tofitx SYS &35,-1,12 TO ,,tofity REM IFVALMID$($admode%,5)=8 x=3 ELSE x=5 x = 12 REM So no radio button is selected. OTHERWISE REM IF FNgeticonstate(output%,24) THEN REM SYS&35,m,11 TO,,tofitx:SYS&35,m,12 TO,,tofity REM x = 13: REM So no radio button is selected. REM ELSE m=VAL $admode% SYS &35,m,11 TO ,,tofitx SYS &35,m,12 TO ,,tofity SYS &35,m,4 TO ,,x SYS &35,m,5 TO ,,y IF y>x x=6 ELSE x=0 SYS &35,m,9 TO ,,y x+=y REM ENDIF ENDCASE tofitx+=1 tofity+=1 $adscale%=FNmsg2("ScaleFill",STR$tofitx,STR$tofity) q%!12=1<<21 !q%=output% FOR I%=0 TO 11 IF I%=x q%!8=1<<21 ELSE q%!8=0 q%!4=I%+3 SYS SetI,,q% NEXT IF x=12 q%!8=0:q%!4=24:SYS SetI,,q% ENDPROC : REM « » DEF PROCkillcurrent(m$) q%!12=1<<21 !q%=output% q%!8=0 q%!4=20 SYS SetI,,q% $admode%=m$ REM SYS Caretpos%,output%,20,,,-1,LEN(m$) ENDPROC : REM « » DEF FNmsg0(t$) =FNmsg2(t$,"","") : REM « » DEF FNmsg1(t$,a$) =FNmsg2(t$,a$,"") : REM « » DEF FNmsg2(t$,a$,b$) LOCALr$ REM Superset of message lookup with substitution SYS"MessageTrans_Lookup",msgb%,t$,STRING$(200,"@"),200,a$,b$ TO,,r$ =r$ : REM « » DEF FNZS(I%)LOCAL A$ REPEAT A$+=CHR$?I% I%+=1 UNTIL ?I%<14 =A$ : REM « » DEF PROCerrorbox SYS Drag,,-1 !buffer%=ERR $(buffer%+4)=REPORT$+CHR$0 REM $(buffer%+4)=REPORT$+" (ref: "+STR$ERL+")"+CHR$0 SYS "Wimp_ReportError",buffer%,%010100000000,FNmsg0("_TaskName"),"!changefsi",1,FNmsg0("ButErr") TO ,A% IF A%=4 THEN PROCfinishandquit ENDPROC : REM A$ Command String REM spritearea% = address - Use the spritearea at 'address' REM or -1 REM REM workspace% = -1 and worklimit% = 0 - Use BASIC variable space REM REM workspace% = -1 - ChangeFSI's slot handling REM worklimit% = current end of wimp slot will be used. REM REM workspace% <> -1 - Use memory at workspace% REM worklimit% = end of workspace% REM REM oksave% TRUE = save to output file given in command string REM okinfo% TRUE = print messages (and histograms if appropriate) REM during processing REM ram% receives address of sprite area REM fast% TRUE = switch down to MODE0 to reduce RAM bandwidth during REM processing (only useful if no VRAM fitted) REM Returned values REM 0 = Image processed as requested REM 1 = Information messages printed REM 100 = Error - image may not be complete REM DEF FNChangeFSI(A$,spritearea%,workspace%,worklimit%,oksave%,okinfo%,RETURN ram%,fast%) LOCAL A$(),r%(),g%(),b%(),rpal%(),gpal%(),bpal%(),table%(),cl%(),xl%(),xl2%() LOCAL xp%(),rm%(),rm1%(),rm2%(),vals%(),nl%(),A%(),B%(),new%(),st%(),jpq%(),pos%,m,Z%() DIM Z%(2): Z%(0)=%10000:Z%(2) =%10010 WHILE LEFT$(A$,1)<>" " AND LEN A$<>0 A$=MID$(A$,2) ENDWHILE WHILE LEFT$(A$,1)=" " A$=MID$(A$,2) ENDWHILE WHILE RIGHT$(A$,1)=" " A$=LEFT$(A$) ENDWHILE IF FNuc(LEFT$(A$,5))="-QUIT" THEN A$=MID$(A$,7) WHILE LEFT$(A$,1)<>" " AND LEN A$<>0 A$=MID$(A$,2) ENDWHILE WHILE LEFT$(A$,1)=" " A$=MID$(A$,2) ENDWHILE ENDIF DIM A$(100) ARG%=0 B%=INSTR(A$," ") WHILE B%<>0 ARG%+=1 A$(ARG%)=LEFT$(A$,B%-1) A$=MID$(A$,B%+1) WHILE LEFT$(A$,1)=" " A$=MID$(A$,2) ENDWHILE B%=INSTR(A$," ") ENDWHILE IF A$<>"" ARG%+=1:A$(ARG%)=A$ invert%= FALSE range%= FALSE sharpen%= FALSE info%= FALSE cache%= FALSE cacheareanumber%=0 dither%= TRUE black%= FALSE hist%= FALSE equal%= FALSE vflip%= FALSE hflip%= FALSE scale%= TRUE scaleo%= TRUE scrapf%= FALSE gamma=1 rotate%= FALSE max%=64*1024*1024 bright%=15 lock%= FALSE rwt=.299 : gwt=.587 : bwt=.114 : REM CIE Y weightings for R, G, B IF ARG%<3 THEN PRINT "ChangeFSI interactive input (read CmdBasUse for command line details)" INPUT "Source file: "s$,"Destination file: "f$,"Output mode: "m$ INPUT "X Scale (eg. 2:1): "xs$ INPUT "Y Scale (eg. 2:1): "ys$ INPUT "Info on input picture? "a$ IF FNuc(LEFT$(a$,1))="Y" info%= TRUE INPUT "Invert picture colours? "a$ IF FNuc(LEFT$(a$,1))="Y" invert%= TRUE INPUT "Compute histogram of input? "a$ IF FNuc(LEFT$(a$,1))="Y" hist%= TRUE INPUT "Apply histogram equalisation? "a$ IF FNuc(LEFT$(a$,1))="Y" equal%= TRUE INPUT "Expand input dynamic range? "a$ IF FNuc(LEFT$(a$,1))="Y" range%= TRUE :equal%= FALSE INPUT "Sharpen picture by (eg. 12 for harsh, 24 for soft): "a$ IF a$<>"" sharpen%=VAL a$ INPUT "Rotate? "a$ IF FNuc(LEFT$(a$,1))="Y" rotate%=1 scale%= FALSE scaleo%= FALSE fast%= FALSE ELSE REPEAT A%=ARG% IF FNuc(A$(ARG%))="-INFO" info%= TRUE :A$(ARG%)="":ARG%-=1 IF FNuc(A$(ARG%))="-HIST" hist%= TRUE :A$(ARG%)="":ARG%-=1 IF FNuc(A$(ARG%))="-LOCK" lock%= TRUE :A$(ARG%)="":ARG%-=1 IF FNuc(A$(ARG%))="-EQUAL" equal%= TRUE :range%= FALSE :A$(ARG%)="":ARG%-=1 IF FNuc(A$(ARG%))="-RANGE" range%= TRUE :equal%= FALSE :A$(ARG%)="":ARG%-=1 IF FNuc(A$(ARG%))="-INVERT" invert%= TRUE :A$(ARG%)="":ARG%-=1 IF FNuc(A$(ARG%))="-NOSCALE" scale%= FALSE :scaleo%= FALSE :A$(ARG%)="":ARG%-=1 IF FNuc(A$(ARG%))="-NOSIZE" scale%= FALSE :A$(ARG%)="":ARG%-=1 IF FNuc(A$(ARG%))="-NODITHER" dither%= FALSE :A$(ARG%)="":ARG%-=1 IF FNuc(A$(ARG%))="-BRIGHTEN" bright%=16:A$(ARG%)="":ARG%-=1 IF FNuc(A$(ARG%))="-ROTATE" rotate%=1:A$(ARG%)="":ARG%-=1 IF FNuc(A$(ARG%))="-ROTATE-" rotate%=-1:A$(ARG%)="":ARG%-=1 IF FNuc(A$(ARG%))="-VFLIP" vflip%= TRUE :A$(ARG%)="":ARG%-=1 IF FNuc(A$(ARG%))="-HFLIP" hflip%= TRUE :A$(ARG%)="":ARG%-=1 IF FNuc(A$(ARG%))="-NOMODE" fast%= FALSE :A$(ARG%)="":ARG%-=1 IF FNuc(LEFT$(A$(ARG%),6))="-BLACK" THEN black%=32 IF LEN A$(ARG%)>6 black%=VAL MID$(A$(ARG%),7):IF black%>128 black%=128 A$(ARG%)="" ARG%-=1 ENDIF IF FNuc(LEFT$(A$(ARG%),6))="-GAMMA" THEN gamma=2.2 IF LEN A$(ARG%)>6 gamma=VAL MID$(A$(ARG%),7) A$(ARG%)="" ARG%-=1 ENDIF IF FNuc(LEFT$(A$(ARG%),8))="-SHARPEN" THEN sharpen%=24 IF LEN A$(ARG%)>8 sharpen%=VAL MID$(A$(ARG%),9) A$(ARG%)="" ARG%-=1 ENDIF IF FNuc(LEFT$(A$(ARG%),7))="-SMOOTH" THEN sharpen%=-1 IF LEN A$(ARG%)>7 sharpen%=-VAL MID$(A$(ARG%),8) A$(ARG%)="" ARG%-=1 IF sharpen%<-23 sharpen%=-23 ENDIF IF FNuc(LEFT$(A$(ARG%),4))="-RED" rwt=VAL MID$(A$(ARG%),5):A$(ARG%)="":ARG%-=1 IF FNuc(LEFT$(A$(ARG%),6))="-GREEN" gwt=VAL MID$(A$(ARG%),7):A$(ARG%)="":ARG%-=1 IF FNuc(LEFT$(A$(ARG%),5))="-BLUE" bwt=VAL MID$(A$(ARG%),6):A$(ARG%)="":ARG%-=1 IF FNuc(LEFT$(A$(ARG%),4))="-MAX" THEN max%=VAL MID$(A$(ARG%),5) IF INSTR(A$(ARG%),"K") OR INSTR(A$(ARG%),"k") max%=max%*1024 A$(ARG%)="" ARG%-=1 ENDIF UNTIL A%=ARG% s$=A$(1) f$=A$(2) m$=A$(3) xs$=A$(4) ys$=A$(5) ENDIF IF okinfo% ELSE info%= FALSE :REM if no output, then no info! IF workspace%<>-1 THEN flex%= FALSE ELSE IF worklimit%=0 THEN flex%= FALSE ELSE flex%= TRUE :nextlocation%=worklimit% ENDIF pnm$=FNuc(m$) CASE LEFT$(pnm$+",",3) OF WHEN "AIM" m=-1 m$="" WHEN "P1,","P4," m=-2 m$="" spm=18 WHEN "P2,","P5," m=-2 m$="T" spm=20 WHEN "P3,","P6," m=-4 pnm$=LEFT$(pnm$,2) p6bits=8 I%=VAL MID$(m$,4) m$="" IF I%>0IF I%<8 p6bits=I% WHEN "P15" m=-3 m$="" WHEN "C15" m=-5 m$="" WHEN "IRL" m=-4 m$="" p6bits=8 WHEN "S16" m=-6 m$="" WHEN "S24" m=-8 m$="" p6bits=8 REM 24bpp is an alias for 32bpp for now WHEN "S32" m=-8 m$="" p6bits=8 WHEN "JPE" m$="" p6bits=8 IF LEFT$(pnm$,8)="JPEGMONO" m=-9:jpegquality%=VAL MID$(pnm$,9) ELSE m=-10:jpegquality%=VAL MID$(pnm$,5) OTHERWISE m=VAL m$ spm=m m$=FNuc(RIGHT$(m$,1)) IF INSTR("CDRT",m$)=0 m$="" ENDCASE IF xs$="" OR LEFT$(xs$,1)="-" THEN xmul%=1 xdiv%=1 ymul%=1 ydiv%=1 ELSE IF ys$="" ys$=xs$ xmul%=VAL xs$ xdiv%=VAL MID$(xs$,INSTR(xs$,":")+1) ymul%=VAL ys$ ydiv%=VAL MID$(ys$,INSTR(ys$,":")+1) ENDIF flag=-1 SYS 8,5,s$ TO r0,,r2 dir=r0=2 IF dir THEN panic= TRUE SYS 8,5,s$+".raw" TO r0,,r2 IF r0=1 s$+=".raw":dir= FALSE :panic= FALSE IF panic SYS 8,5,s$+".red" TO r0,,r2:IF r0=1 panic= FALSE IF panic ERROR 42,"Directory given" ENDIF ftype=r2>>8 AND &FFF bits=28 F=2^bits c%=0 cc%=0 ccc%=0 o%=0 IF dir THEN c%= OPENIN(s$+".red") IF c%=0 ERROR 42,"Red file "+s$+".red not found" cc%= OPENIN(s$+".green") IF cc%=0 ERROR 42,"Green file "+s$+".green not found" ccc%= OPENIN(s$+".blue") IF ccc%=0 ERROR 42,"Blue file "+s$+".blue not found" ELSE c%= OPENINs$ IF c%=0 ERROR 42,"File "+s$+" not found" leaf$=FNleaf(s$) pos%=INSTR(leaf$,"/") IF pos% THEN leaf$=LEFT$(leaf$,pos%-1) ENDIF LOCAL ERROR ON ERROR LOCAL RESTORE ERROR :TRACE OFF:PROCclose:ERROR ERR,REPORT$ REM TRACE TO ":4.foo" REM TRACE ON colourindex=255 SYS &66f4d TO ;pcd% CASE ftype OF WHEN &FF9 flag=0 IF INSTR("."+FNuc(s$),".HIP.") OR INSTR(FNuc(s$),":HIP.") THEN flag=300 I%=INSTR(FNuc(s$),"HIP.") MID$(s$,I%)="LOP." cc%= OPENINs$ IF cc%=0 ERROR 42,"Can't find Lop file "+s$ ENDIF WHEN &FF0 PTR#c%=0 S$="" FOR I%=1 TO 4 S$+=CHR$BGET#c% NEXT IF S$="II*"+CHR$0 flag=1500:bigendian= FALSE IF S$="MM"+CHR$0+"*" flag=1500:bigendian= TRUE WHEN &DFA flag=800 IF dir flag=801 WHEN &DE2 flag=1000 WHEN &CBE flag=3800 WHEN &BE8 IF (pcd% AND 1)=0 flag=3600 WHEN &7A0 flag=1200 WHEN &69d flag=2000 WHEN &699 flag=700 WHEN &698 flag=100 WHEN &697 flag=1900 WHEN &691 flag=2600 WHEN &690 flag=2500 WHEN &666 flag=666 WHEN &601 flag=3000 WHEN &371 flag=3100 WHEN &300 flag=1300 IF dir flag=1301 WHEN 4 flag=900 IF dir flag=901 WHEN 6 flag=950 ENDCASE IF flag=-1 THEN PTR#c%=0 S$="" FOR I%=1 TO 22 S$+=CHR$BGET#c% NEXT IF LEFT$(S$,7)="FSIfile" flag=2100 IF flag=-1 IF LEFT$(S$,8)="SIMPLE " flag=2800 IF flag=-1 IF FNuc(LEFT$(S$,8))="MERCSOFT" OR FNuc(LEFT$(S$,8))="SNAPSHOT" flag=902 IF flag=-1 IF FNuc(LEFT$(S$,8))="MERCSOF1" flag=903 IF flag=-1 IF FNuc(LEFT$(S$,13))="IRLAM YUV 411" flag=2250 IF flag=-1 IF LEFT$(S$,5)="Irlam" flag=2200 IF flag=-1 IF LEFT$(S$,2)="BM" flag=2400:riffoff%=0 IF flag=-1 IF LEFT$(S$,4)="RIFF" AND MID$(S$,9,8)="RDIBdata" AND MID$(S$,21,2)="BM" flag=2400:riffoff%=20 IF flag=-1 IF LEFT$(S$,4)="GIF8" flag=500 IF flag=-1 IF LEFT$(S$,5)="AV_VO" flag=600 IF flag=-1 IF LEFT$(S$,4)=CHR$&59+CHR$&A6+CHR$&6A+CHR$&95 flag=1100 IF flag=-1 IF LEFT$(S$,4)=CHR$0+CHR$1+CHR$0+CHR$8 flag=1400 IF flag=-1 IF LEFT$(S$,4)=CHR$0+CHR$1+CHR$0+CHR$1 flag=2900 IF flag=-1 IF LEFT$(S$,4)="RIX3" flag=2700 IF flag=-1 IF LEFT$(S$,4)="II*"+CHR$0 flag=1500:bigendian= FALSE IF flag=-1 IF LEFT$(S$,4)="MM"+CHR$0+"*" flag=1500:bigendian= TRUE IF flag=-1 IF LEFT$(S$,2)=CHR$&52+CHR$&CC flag=2300 IF flag=-1 IF LEFT$(S$,2)="P4" OR LEFT$(S$,2)="P5" OR LEFT$(S$,2)="P6" OR LEFT$(S$,2)="P8" flag=3300:info$="" IF flag=-1 IF LEFT$(S$,3)="P15" flag=3400 IF flag=-1 IF LEFT$(S$,3)="P14" flag=3410 IF flag=-1 IF LEFT$(S$,3)="PIC" flag=3500 IF flag=-1 IF LEFT$(S$,3)="T-I" flag=3800 IF flag=-1 IF FNuc(LEFT$(S$,3))="P13" flag=3450 IF flag=-1 IF LEFT$(S$,4)="FORM" IF MID$(S$,9,4)="ILBM" flag=1600 IF flag=-1 IF LEFT$(S$,8)="ALPIAR12" flag=3900:colourindex=4095 IF flag=-1 IF LEFT$(S$,8)="ALPIAR16" flag=3905:colourindex=65535 IF flag=-1 IF LEFT$(S$,8)=CHR$&89+"PNG"+CHR$13+CHR$10+CHR$26+CHR$10 flag=4000 IF flag=-1 IF LEFT$(S$,2)=CHR$0+CHR$0 AND (ftype=&F8F OR FNuc(RIGHT$(s$,5))="/WBMP") THEN flag=4100 IF flag=-1 THEN IF MID$(S$,7,4)="JFIF" OR LEFT$(S$,3)=CHR$&FF+CHR$&D8+CHR$&FF OR ftype=&C85 THEN REM Read the cache size variable jpegblk%=FNdim(20) PROCcachesize A%=0 IF cache%>=EXT#c% THEN REM Pre load the high speed reader A%=OPENIN".CFSIjpeg" IF A%<>0 THEN jpeg%=FNdim(EXT#A%) SYS 12,4,A%,jpeg%,EXT#A% CLOSE#A% REM Call the reader to get the image dimensions, this fails if it's an unsupported type datacache%=FNcachedim(EXT#c%) IF datacache%=-1 datacache%=FNdim(EXT#c%) PTR#c%=0 SYS 12,4,c%,datacache%,EXT#c% A%=datacache% B%=jpegblk% C%=jpegblk%+4 D%=jpegblk%+8 E%=jpegblk%+12 IFUSR(jpeg%+8)<>0 THENA%=0 ENDIF ENDIF IF A%=0 THEN CLOSE#c% c%=0 REM Not something that can be done cached with the high speed reader X%= OPENIN"Run:djpeg" IF X% THEN CLOSE#X% PROCsubtask("djpeg "+s$+" ") ELSE SYS "XOS_CLI","djpeg "+s$+" " TO ;V IF V AND 1 THEN PROCsubtask(".djpeg "+s$+" ") ENDIF ENDIF c%= OPENIN"" IF c%=0 THEN =100 IF EXT#c%=0 THEN CLOSE#c%:=100:REM When djpeg fails it can output a zero length file scrapf%= TRUE flag=3300:REM Converted to a PBM by djpeg info$="JFIF image converted to " ELSE REM Can use the high speed reader flag=3700 ENDIF ENDIF ENDIF IF flag=-1 THEN IF LEFT$(S$,5)="btpc " THEN CLOSE#c% c%=0 PROCsubtask(".btpc "+s$+" ") c%= OPENIN"" IF c%=0 THEN =100 scrapf%= TRUE flag=3300 info$="BTPC file converted to " ENDIF ENDIF IF flag=-1 AND EXT#c%>&19 THEN PTR#c%=&10 S$="" FOR I%=1 TO 9 S$+=CHR$BGET#c% NEXT IF S$="MILLIPEDE" flag=200 ENDIF IF flag=-1 AND EXT#c%>&49 THEN PTR#c%=&41 S$="" FOR I%=1 TO 8 S$+=CHR$BGET#c% NEXT IF LEFT$(S$,4)="PNTG" flag=1800:st%=&280 ENDIF IF flag=-1 AND EXT#c%>&CC THEN PTR#c%=&C4 S$="" FOR I%=1 TO 8 S$+=CHR$BGET#c% NEXT IF LEFT$(S$,4)="PNTG" flag=1800:st%=&2e2 ENDIF IF flag=-1 AND EXT#c%>&212 THEN PTR#c%=&20A S$="" FOR I%=1 TO 8 S$+=CHR$BGET#c% NEXT IF S$=CHR$0+CHR$&11+CHR$2+CHR$&ff+CHR$&c+CHR$0+CHR$&ff+CHR$&fe flag=1850 ENDIF IF flag=-1 THEN PTR#c%=0 IF BGET#c%=10 THEN C%=BGET#c% IF C%<6 AND C%<>1 AND BGET#c%=1 flag=1900 ENDIF ENDIF IF flag=-1 IF INSTR("."+FNuc(s$),".PCX.") OR INSTR(FNuc(s$),":PCX.") OR RIGHT$(s$,4)="/PCX" flag=1900 IF flag=-1 IF INSTR("."+FNuc(s$),".IMAGE.") OR INSTR(FNuc(s$),":IMAGE.") flag=400 IF flag=-1 IF FNuc(RIGHT$(s$,4))=".RAW" flag=100 IF flag=-1 IF FNuc(RIGHT$(s$,3))="TGA" flag=2000 IF flag=-1 IF FNuc(RIGHT$(s$,3))="VDA" flag=2000 IF flag=-1 IF INSTR("."+FNuc(s$),".PIC.") OR INSTR(FNuc(s$),":PIC.") flag=700 IF flag=-1 IF INSTR("."+FNuc(s$),".IMG.") OR INSTR(FNuc(s$),":IMG.") OR RIGHT$(s$,4)="/IMG" flag=1400 IF flag=-1 IF INSTR("."+FNuc(s$),".DSP.") OR INSTR(FNuc(s$),":DSP.") OR RIGHT$(s$,4)="/DSP" flag=1700 IF flag=-1 IF FNuc(RIGHT$(s$,4))="/RGB" flag=3200 IF flag=-1 AND (FNuc(RIGHT$(s$,4))="/PCD" OR ftype=&be8) AND ((pcd% AND 1)=1) THEN CLOSE#c% c%=0 PROCsubtask(".hpcdtoppm -3 -a "+s$+" { > .pcdtemp }") c%= OPENIN"" scrapf%= TRUE flag=3300 info$="PhotoCD file converted to " ENDIF ENDIF IF flag=-1 PROCclose:ERROR 42,"This type of file is not recognised by ChangeFSI" step24=1 input=8 ham=0 planar%=0 bigendianbits= FALSE r$="FN"+ STR$flag compression=0 hpredict%=1 striprows%=-1 cachebytes%= FALSE IF xdiv%=0 AND ydiv%=0 scale%= FALSE REM Colour maps (or just r%() for monochrome), in 0-colourindex => out 0-1 fixed point DIM r%(colourindex),g%(colourindex),b%(colourindex) CASE flag OF WHEN 0 REM Archimedes Sprite file quant%=4 PTR#c%=4 F%=FNW+&1C PTR#c%=F% st%=FNW+F%-&20:REM Sprite K%=FNW+F%-&20:REM Mask sm=FNW s$="" IF sm<256 THEN SYS 53,sm,3 TO ,,I% CASE I% OF WHEN 1 IF st%=F%+12 PROCdefpal2 ELSE PROCipal(2):s$="paletted, " PTR#c%=F%-16 sx%=(FNW+1)*32 rowbytes%=sx%>>3 input=1 sy%=FNW+1 I%=FNW sx%-=31-FNW WHEN 3 IF st%=F%+12 PROCdefpal4 ELSE PROCipal(4):s$="paletted, " PTR#c%=F%-16 sx%=(FNW+1)*16 rowbytes%=sx%>>2 input=2 sy%=FNW+1 I%=FNW sx%-=(31-FNW) DIV 2 WHEN 15 IF st%=F%+12 PROCdefpal16 ELSE PROCipal(16):s$="paletted, " PTR#c%=F%-16 sx%=(FNW+1)*8 rowbytes%=sx%>>1 input=4 sy%=FNW+1 I%=FNW sx%-=(31-FNW) DIV 4 WHEN 63,255 IF st%=F%+12 THEN PROCdefpal ELSE IF K%>st% K%=st%:REM find first of mask or sprite IF K%-12-F%=2048 OR I%=255 THEN PROCnewropal(256):s$="256 entry palette, ":REM A full size 256 entry palette ELSE PROCipal63:s$="64 entry palette, ":REM VIDC1 compatible 64 entry palette ENDIF ENDIF PTR#c%=F%-16 sx%=(FNW+1)*4 rowbytes%=sx% sy%=FNW+1 I%=FNW sx%-=(31-FNW) DIV 8 OTHERWISE ERROR 42,"Not understood RISC OS sprite" ENDCASE r$="FN8" SYS 53,sm,4 TO ,,nx SYS 53,sm,5 TO ,,ny nx=1<>>27 CASE bpp% OF WHEN 1 bpp%=1 r$="FN8" IF st%=F%+12 PROCdefpal2 ELSE PROCnewropal(2):s$="paletted, " WHEN 2 bpp%=2 r$="FN8" IF st%=F%+12 PROCdefpal4 ELSE PROCnewropal(4):s$="paletted, " WHEN 3 bpp%=4 r$="FN8" IF st%=F%+12 PROCdefpal16 ELSE PROCnewropal(16):s$="paletted, " WHEN 4 bpp%=8 r$="FN8" IF st%=F%+12 THEN PROCdefpal ELSE IF K%>st% K%=st%:REM find first of mask or sprite IF K%-12-F%=2048 THEN PROCnewropal(256):s$="256 entry palette, ":REM A full size 256 entry palette ELSE PROCipal63:s$="64 entry palette, ":REM VIDC1 compatible 64 entry palette ENDIF ENDIF WHEN 5 bpp%=16 r$="FN16" IF st%=F%+12 ELSE DIM rpal%(255),gpal%(255) step24=2 FOR C%=0 TO 255 gpal%(C%)=(C%>>5)<<8 OR (C% AND 31) rpal%(C%)=((C%>>2) AND 31)<<16 OR (C% AND 3)<<11 NEXT FOR C%=0 TO 31 r%(C%)=C%/31*F NEXT g%()=r%() b%()=r%() WHEN 6 bpp%=32 r$="FN24" IF st%=F%+12 PROCnopal ELSE rbo%=0 gbo%=1 bbo%=2 step24=4 WHEN 8 bpp%=24 r$="FN24" IF st%=F%+12 PROCnopal ELSE rbo%=0 gbo%=1 bbo%=2 OTHERWISE ERROR 42,"Not understood new format RISC OS sprite bpp" ENDCASE nx=(sm>>1) AND &1fff ny=(sm>>14) AND &1fff IF scale% xdiv%=xdiv%*nx:ydiv%=ydiv%*ny:xmul%=xmul%*90:ymul%=ymul%*90 PTR#c%=F%-16 rowbytes%=(FNW+1)*4 sy%=FNW+1 I%=FNW sx%=(rowbytes%*8-(31-FNW))/bpp% input=bpp% info$="New RISC OS sprite, "+s$+STR$sx%+" by "+STR$sy%+" pixels, "+FNbits(input) IF bpp%=32 input=24 ENDIF PTR#c%=st% cache%= TRUE WHEN 100 REM QRT ".raw" image quant%=8 PTR#c%=0 sx%=FNHW sy%=FNHW PROCnopal input=24 rowbytes%=sx%*3+2 rbo%=2 gbo%=2+sx% bbo%=2+2*sx% r$="FN24" cache%= TRUE info$="QRT .raw image, "+ STR$sx%+" by "+ STR$sy%+" pixels, 24 bits per pixel" WHEN 200 REM CadSoft Image quant%=8 PTR#c%=5 sx%=FNHW sy%=FNHW sx%=(FNHW-sx%+2)/2 sy%=(FNHW-sy%+2)/2 REM round and convert to pixels PTR#c%=&1a cadsoft%=BGET#c% PTR#c%=&200 FOR C%=0 TO 255 r%(C%)=BGET#c%/255*F NEXT FOR C%=0 TO 255 g%(C%)=BGET#c%/255*F NEXT FOR C%=0 TO 255 b%(C%)=BGET#c%/255*F NEXT PTR#c%=&600 st%=&600 cache%= TRUE IF cadsoft%=2 THEN rep%=0 r$="FN1100" plbuff%=FNdim(sx%) plbytes%=sx% cachebytes%= TRUE ELSE r$="FN8" rowbytes%=sx% ENDIF info$="Cadsoft type "+ STR$cadsoft%+" image, "+ STR$sx%+" by "+ STR$sy%+" pixels, 8 bits per pixel" WHEN 300 REM Arvis Video quant%=5 PTR#c%=&2c st%=FNW+(&38-&2c) PTR#cc%=&2c stcc%=FNW1(cc%)+(&38-&2c) PTR#c%=&1c sx%=(FNW+1)*4 sy%=FNW+1 PTR#c%=st% PTR#cc%=stcc% DIM rpal%(255),gpal%(255) input=16 cache%= TRUE rowbytes%=sx% FOR C%=0 TO 255 rpal%(C%)=C% AND 7 OR (C% AND 64)<<2 OR (C% AND &38)<<13 gpal%(C%)=(C% AND 4)<<1 OR C% AND 16 OR ((C% AND 3)<<1 OR (C% AND &60)>>2)<<8 OR (C% AND 8 OR (C% AND 128)>>3)<<16 NEXT FOR C%=0 TO 31 r%(C%)=C%/31*F NEXT g%()=r%() b%()=r%() pbuff%=FNdim(sx%) IF scale% ymul%=ymul%*2 info$="ArVis image, "+ STR$sx%+" by "+ STR$sy%+" pixels, 15 bits per pixel" WHEN 400 REM RT "image." quant%=8 PTR#c%=0 sx%=FNbeHW sy%=FNbeHW X%=FNbeHW st%=PTR#c%+X% PTR#c%=st% plbuff%=FNdim(sx%*3) plbytes%=sx%*3 rb%=plbuff% gb%=plbuff%+1 bb%=plbuff%+2 rbo%=-1 PROCnopal input=24 rep%=0 cachebytes%= TRUE cache%= TRUE step24=3 info$="RT image. run length encoded image, "+ STR$sx%+" by "+ STR$sy%+" pixels, 24 bits per pixel" WHEN 500 REM GIF file compression=5 PTR#c%=6 GIFsx=FNHW GIFsy=FNHW GIF=BGET#c% GIFback=BGET#c% GIFext=BGET#c% quant%=((GIF>>4)AND 7)+1:REM Log2bpp IF GIF AND &80 THEN REM Have global colour table I%=1<<((GIF AND 7)+1) FOR C%=0 TO I%-1 r%(C%)=BGET#c%/255*F g%(C%)=BGET#c%/255*F b%(C%)=BGET#c%/255*F NEXT ENDIF I%=BGET#c% WHILE I%=ASC "!" REM 'Graphic Control Extension's IF BGET#c% REM skip 'function code' REPEAT GIFgcesz=BGET#c% PTR#c%=PTR#c%+GIFgcesz REM GCEs are only supposed to have one data subblock, but there REM are some GIFs around (eg 'GIFLITE' ones) that have 2 or more UNTIL GIFgcesz=0 I%=BGET#c% ENDWHILE IF I%<>ASC "," ERROR 42,"GIF without image separator in right place" REM pixel aspect ratio IF GIFext<>0 AND GIFext<>49 THEN IF GIFext>49 THEN REM pixel width > height xdiv%=xdiv%*64 xmul%=xmul%*(GIFext+15) ELSE ydiv%=ydiv%*(GIFext+15) ymul%=ymul%*64 ENDIF ENDIF GIFleft=FNHW GIFtop=FNHW sx%=FNHW sy%=FNHW IF GIFsx>4) OR ((C%AND3)<<10) REM NEXT REM FORC%=0TO15:r%(C%)=C%/15*F:NEXT:g%()=r%():b%()=r%() REM info$="The number of the beast, 160 by "+STR$sy%+" pixels, 12 bits per pixel" REM 8 bit Y format reader st%=0 PTR#c%=0 sx%=160 sy%=128 input=8 cache%= TRUE rowbytes%=sx% FOR C%=0 TO 255 r%(C%)=C%/255*F NEXT g%()=r%() b%()=r%() r$="FN8" info$="The number of the beast, 160 by "+ STR$sy%+" pixels, 8 bits per pixel" WHEN 700 REM MTV ".pic" image quant%=8 PTR#c%=0 a$= GET$#c% st%=PTR#c% sx%=VAL a$ sy%=VAL (MID$(a$,INSTR(a$," "))) PROCnopal input=24 step24=3 rowbytes%=sx%*3 r$="FN24" rbo%=0 gbo%=1 bbo%=2 cache%= TRUE info$="MTV .pic image, "+ STR$sx%+" by "+ STR$sy%+" pixels, 24 bits per pixel" WHEN 800 REM Watford picture sx%=512 sy%=256 IF scale% ymul%=ymul%*2 plbuff%=FNdim(sx%) rep%=0 wt%=0 wtsx%=plbuff%+sx% cache%= TRUE cachebytes%= TRUE FOR C%=0 TO 255 r%(C%)=(C% AND 63)/63*F NEXT g%()=r%() b%()=r%() quant%=6 info$="Watford digitiser picture, 512 by 256 pixels, 6 bits per pixel" WHEN 801 REM Triple Watford picture sx%=512 sy%=256 input=24 quant%=6 IF scale% ymul%=ymul%*2 rep1%=0 wt1%=0 rep2%=0 wt2%=0 rep3%=0 wt3%=0 buff%=FNdim(sx%*3) rb%=buff% gb%=buff%+sx% bb%=buff%+2*sx% wtsx1%=buff%+sx% wtsx2%=buff%+2*sx% wtsx3%=buff%+3*sx% FOR C%=0 TO 255 r%(C%)=(C% AND 63)/63*F NEXT g%()=r%() b%()=r%() info$="Triple Watford digitiser picture, 512 by 256 pixels, 18 bits per pixel" WHEN 900 REM AIM/Wild Vision quant%=8 st%=0 PTR#c%=0 IF EXT#c%=65536 THEN sx%=256 sy%=256 IF scale% ymul%=ymul%*2:xmul%=xmul%*2 ELSE sx%=512 sy%=512 ENDIF FOR C%=0 TO 255 r%(C%)=C%/255*F NEXT g%()=r%() b%()=r%() rowbytes%=sx% r$="FN8" cache%= TRUE info$="AIM .raw image, 256 by 256 pixels, 8 bits per pixel" WHEN 901 REM Triple AIM/Wild Vision quant%=4 IF EXT#c%=65536 THEN sx%=256 sy%=256 IF scale% ymul%=ymul%*2:xmul%=xmul%*2 ELSE sx%=512 sy%=512 ENDIF buff%=FNdim(sx%*3) rb%=buff% gb%=buff%+sx% bb%=buff%+sx%*2 FOR C%=0 TO 255 r%(C%)=C%/255*F NEXT g%()=r%() b%()=r%() input=24 info$="Hawk V9 Triple image, 256 by 256 pixels, 24 bits per pixel" WHEN 902 REM MercSoft V9 image quant%=4 PTR#c%=8 sx%=FNW rowbytes%=sx%*3/2 sy%=FNW st%=20 PTR#c%=20 IF scale% ymul%=ymul%*2 plbuff%=FNdim(sx%*3) rb%=plbuff% gb%=plbuff%+sx% bb%=plbuff%+sx%*2 rbo%=-1 FOR C%=0 TO 255 r%(C%)=(C% AND &F)/&F*F NEXT g%()=r%() b%()=r%() cache%= TRUE input=24 info$="Hawk V9/Snapshot Colour image, "+ STR$sx%+" by "+ STR$sy%+" pixels, 12 bits per pixel" WHEN 903 REM MercSoft V9 mk II image quant%=5 PTR#c%=8 sx%=FNW rowbytes%=sx%*2 sy%=FNW st%=20 PTR#c%=20 cache%= TRUE r$="FN16" flag=700 DIM rpal%(255),gpal%(255) input=16 step24=2 FOR C%=0 TO 255 gpal%(C%)=(C%>>5)<<8 OR (C% AND 31) rpal%(C%)=((C%>>2) AND 31)<<16 OR (C% AND 3)<<11 NEXT FOR C%=0 TO 31 r%(C%)=C%/31*F NEXT g%()=r%() b%()=r%() input=16 info$="Hawk V9 mk II Colour image, "+ STR$sx%+" by "+ STR$sy%+" pixels, 16 bits per pixel" WHEN 950 REM Wild Vision V12 quant%=8 PTR#c%=0 sx%=512 rowbytes%=512 sy%=512 st%=0 flag=900 FOR C%=0 TO 255 r%(C%)=C%/255*F NEXT g%()=r%() b%()=r%() r$="FN8" cache%= TRUE info$="Wild Vision V12 image, 512 by 512 pixels, 8 bits per pixel" WHEN 1000 REM ProArtisan quant%=4 sx%=640 sy%=256 PROCdefpal st%=FNW r$="FN"+ STR$(1000+FNW) IF scale% ymul%=ymul%*2 REM read compression type and add to flag. 0/1 known! buff%=FNdim(sx%) ctable%=FNdim(st%) SYS 12,4,c%,ctable%,st% st%=PTR#c% REM read in colour table pa%=ctable% rep%=0 rep2%=0 pasx%=buff%+sx% info$="ProArtisan image, 640 by 256 pixels, 8 bits per pixel" WHEN 1100 REM Sun pixrect quant%=1 PTR#c%=4 sx%=FNbeW sy%=FNbeW input=FNbeW bigendianbits= TRUE S%=FNbeW S%=FNbeW REM 0=RT_OLD,1=RT_STD(BGR),2=RT_BYTE_ENC,3=RT_FORMAT_RGB cache%= TRUE IF S%=2 cachebytes%= TRUE :info$="Byte Encoded " ELSE info$="":r$="FN8" C%=FNbeW REM maptype 0=RMT_NONE,1=RMT_EQUAL_RGB,2=RMT_RAW D%=FNbeW REM maplength in bytes CASE C% OF WHEN 1,2 FOR I%=0 TO D%/3-1 r%(I%)=BGET#c%/255*F NEXT FOR I%=0 TO D%/3-1 g%(I%)=BGET#c%/255*F NEXT FOR I%=0 TO D%/3-1 b%(I%)=BGET#c%/255*F NEXT OTHERWISE CASE input OF WHEN 1 r%(0)=F g%(0)=F b%(0)=F WHEN 4,8 PROCnopal WHEN 24 PROCnopal ENDCASE ENDCASE CASE input OF WHEN 1 rowbytes%=(sx%+15>>4)<<1 WHEN 4 rowbytes%=(sx%+3>>2)<<1 WHEN 8 rowbytes%=(sx%+1>>1)<<1 WHEN 24 rowbytes%=(3*sx%+1>>1)<<1 r$="FN24" rbo%=0 gbo%=1 bbo%=2 step24=3 IF S%=1 bbo%=0:rbo%=2 OTHERWISE ERROR 42,"Can't do this Sun pixrect" ENDCASE st%=D%+&20 rep%=0 IF cachebytes% plbuff%=FNdim(rowbytes%):plbytes%=rowbytes% info$+="Sun image, "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(input) WHEN 1200 REM unknown TimeStep satellite format quant%=8 sx%=800 sy%=800 st%=1600 PTR#c%=st% vflip%=NOT vflip% PROCnopal r$="FN8" rowbytes%=sx% cache%= TRUE info$="TimeStep satellite image, 800 by 800 pixels, 8 bits per pixel" WHEN 1300 REM another unknown TimeStep satellite format quant%=8 sx%=128 sy%=256 st%=0 PTR#c%=0 IF scale% xmul%=xmul%*2 PROCnopal r$="FN8" rowbytes%=sx% cache%= TRUE info$="Satellite image, 128 by 256 pixels, 8 bits per pixel" WHEN 1301 REM "colour" unknown TimeStep satellite format input=24 quant%=8 sx%=128 sy%=256 IF scale% xmul%=xmul%*2 buff%=FNdim(sx%*3) rb%=buff% gb%=buff%+sx% bb%=buff%+2*sx% PROCnopal r$="FN901" info$="Triple satellite image, 128 by 256 pixels, 24 bits per pixel" WHEN 1400 REM GEM IMG. format planar%= TRUE PTR#c%=0 Z%=FNHW IF Z%>255 THEN st%=FNbeHW*2 planes%=FNbeHW patlen%=FNbeHW pw%=FNbeHW ph%=FNbeHW sx%=FNbeHW sy%=FNbeHW ELSE st%=FNHW*2 input=FNHW patlen%=FNHW pw%=FNHW ph%=FNHW sx%=FNHW sy%=FNHW ENDIF IF scale% THEN xmul%=xmul%*pw% xdiv%=xdiv%*282 ymul%=ymul%*ph% ydiv%=ydiv%*282 ENDIF rowbytes%=sx%+7>>3 pbuff%=FNdim(sx%) plbytes%=rowbytes%*planes% buff%=FNdim(plbytes%) PTR#c%=st% vrep%=0 FOR C%=0 TO (1<1 V%=FNtiff(4) ELSE IF D%=2 PTR#c%=dir%+2+Z%*12 ELSE IF D%<4 V%=FNtiff(D%):PTR#c%=dir%+2+Z%*12 ELSE V%=FNtiff(4) REM PRINT"Debug: Read tag ";T%" datatype "D%" count "C%" value/pointer "V% CASE T% OF WHEN 256 sx%=V% WHEN 257 sy%=V% WHEN 258 IF C%>1 THEN IF D%*C%>6 THEN PTR#c%=V% quant%=FNtiff(D%) input=quant% FOR I%=1 TO C%-1 V%=FNtiff(D%) IF V%<>quant% ERROR 42,"Can't do RGB TIFF with different numbers of bits per pixel" input+=V% NEXT PROCnopal ELSE quant%=V% AND &FF input=quant% FOR I%=0 TO (1<1 THEN PTR#c%=stv% FOR I%=0 TO stc%-1 st%(I%)=FNtiff(std%) NEXT REM PTR#c%=stvbyte%:FORI%=0TOstcbyte%-1:st%(I%,1)=FNtiff(stdbyte%):NEXT ELSE st%(0)=stv% ENDIF CASE compression OF WHEN 0,1 info$="" WHEN 2 info$="CCITT Group 3 compressed " WHEN 5 info$="LZW compressed " r$="FN1505" IF hpredict%=2 THEN info$+="horizontal differenced " ELSE IF hpredict%>2 info$+=" unknown predictor ("+ STR$hpredict%+") " setcodes%=8 clearcode%=1<=sy% striprows%=-1 CASE input OF WHEN 1 rowbytes%=sx%+7>>3 WHEN 2 rowbytes%=sx%+3>>2 WHEN 4 rowbytes%=sx%+1>>1 WHEN 8 rowbytes%=sx% WHEN 24 rowbytes%=3*sx% WHEN 32 rowbytes%=4*sx% IF photometric<>5 ERROR 42,"32 bpp TIFF but not CMYK" OTHERWISE ERROR 42,"Can't do "+FNbits(input)+" TIFF" ENDCASE IF planar%=2 rowbytes%=rowbytes%*sampperpix% IF planar%<>1 AND rgb<>0 ERROR 42,"Can't do this style of TIFF yet" ELSE planar%= FALSE IF compression<2 THEN cache%= TRUE stripptr=-1 r$="FN8" IF input=24 rbo%=0:gbo%=1:bbo%=2:step24=3:r$="FN24" IF input=32 rbo%=0:gbo%=1:bbo%=2:step24=4:r$="FN24":r%()=F-r%():g%()=F-g%():b%()=F-b%():input=24 ELSE IF compression=5 OR compression=32773 THEN cache%= TRUE cachebytes%=rowbytes%*striprows% plbuff%=FNdim(rowbytes%) rowstogo%=striprows% IF input=24 rb%=plbuff%:gb%=plbuff%+1:bb%=plbuff%+2:r$="FN"+ STR$(VAL MID$(r$,3)+10):step24=3:rbo%=-1 ELSE buff%=FNdim(rowbytes%) rowstogo%=striprows% IF input=24 rb%=buff%:gb%=buff%+1:bb%=buff%+2:r$="FN"+ STR$(VAL MID$(r$,3)+10):step24=3 ENDIF ENDIF IF scale% THEN S%=resunit IF S%=2 S%=90 IF S%=3 S%=35 xdiv%=xdiv%*xnum% xmul%=xmul%*xdenom%*S% ydiv%=ydiv%*ynum% ymul%=ymul%*ydenom%*S% ENDIF IF r$="FN1500" r$="FN8":REM worth a try.. WHEN 1600 REM Electronic Arts ILBM inside IFF PTR#c%=12 camg=0 planar%= TRUE REPEAT S$=CHR$BGET#c%+CHR$BGET#c%+CHR$BGET#c%+CHR$BGET#c% S%=FNbeW CASE S$ OF WHEN "BMHD" sx%=FNbeHW sy%=FNbeHW S%=FNW planes%=BGET#c% masking%=BGET#c%=1 compression=BGET#c% S%=BGET#c%+FNHW U%=BGET#c% V%=BGET#c% S%=FNW IF scale% ymul%=ymul%*V%:ydiv%=ydiv%*U% FOR I%=0 TO (1<>4)/15*F g%(I%)=(BGET#c%>>4)/15*F b%(I%)=(BGET#c%>>4)/15*F NEXT PTR#c%=S% IF info% PRINT "Warning: truncated IFF CMAP information to 4 bits" WHEN "CAMG" camg=FNbeW IF info% PRINT "Amiga viewport mode ";~camg WHEN "BODY" st%=PTR#c% OTHERWISE IF info% PRINT "Ignoring IFF property "S$" size ";S% PTR#c%=PTR#c%+S% ENDCASE UNTIL S$="BODY" IF compression info$="Compressed " ELSE info$="" REM camg AND 4=interlace, AND&80=halfbright, AND&8000=hires ham=(camg AND &800)<>0 IF ham info$+="HAM " half=(camg AND &80)<>0 IF half info$+="half-bright " IF half half%=1<>4)<<1 plbytes%=rowbytes%*planes% pbuff%=FNdim(sx%) r$="FN"+ STR$(1600+compression) cache%= TRUE IF compression THEN cachebytes%= TRUE plbuff%=FNdim(plbytes%) ELSE realrowbytes%=rowbytes% rowbytes%=plbytes% IF masking% rowbytes%+=realrowbytes% ENDIF PTR#c%=st% WHEN 1700 REM EGA image in DSP. sx%=640 rowbytes%=80 sy%=350 planes%=4 plbytes%=4*80 planar%= TRUE buff%=FNdim(80*4) pbuff%=FNdim(640) G=F/3 H=F*2/3 r%()=0,0,0,0,F,F,F,H,G,G,G,G,F,F,F,F g%()=0,0,F,F,0,0,F,H,G,G,F,F,G,G,F,F b%()=0,F,0,F,0,F,0,H,G,F,G,F,G,F,G,F masking%= FALSE r$="FN1600" st%=16 PTR#c%=16 cache%= TRUE realrowbytes%=80 rowbytes%=plbytes% info$="PC EGA '.dsp' file, 640 by 350 pixels, 4 bits per pixel (fixed palette)" WHEN 1800 REM MacPaint image sx%=72*8 sy%=720 quant%=1 input=1 PTR#c%=st% plbuff%=FNdim(72) cache%= TRUE cachebytes%= TRUE r%(0)=F g%(0)=F b%(0)=F bigendianbits= TRUE rowbytes%=72 r$="FN1501" rowstogo%=-1 IF scale% xmul%=xmul%*90:xdiv%=xdiv%*72:ymul%=ymul%*90:ydiv%=ydiv%*72 info$="MacPaint file, 576 by 720 bits, creator id "+RIGHT$(S$,4) WHEN 1850 REM MacPict Image Extended Version 2 PTR#c%=552 done%= FALSE REPEAT code%=FNbeHW CASE code% OF WHEN &01 PTR#c%=PTR#c%+FNbeHW REM Skip Clip Region WHEN &1E REM Ignore DefHilite WHEN &98 REM PackBitsRect rowbytes%=FNbeHW IF (rowbytes% AND &8000)=0 ERROR 42,"PICT without Pixmap" sy%=FNbeHW sx%=FNbeHW sy%=FNbeHW-sy% sx%=FNbeHW-sx% junk%=FNHW packtype%=FNbeHW junk%=FNW resx%=FNbeW resy%=FNbeW IF FNbeHW<>0 CLOSE#c%:ERROR 42,"ChangeFSI expected Mac PICT2 pixeltype=Chunky" bpp%=FNbeHW junk%=FNbeHW junk%=FNbeHW REM components and component size junk%=FNbeW junk%=FNbeW junk%=FNbeW REM planebytes=0, pmtable, pmreserved junk%=FNbeW junk%=FNbeHW REM ctseed, ctflags C%=FNbeHW FOR I%=0 TO C% J%=FNbeHW r%(J%)=FNbeHW/65535*F g%(J%)=FNbeHW/65535*F b%(J%)=FNbeHW/65535*F NEXT done%= TRUE WHEN &9A junk%=FNW rowbytes%=FNbeHW IF (rowbytes% AND &8000)=0 ERROR 42,"PICT without Pixmap" sy%=FNbeHW sx%=FNbeHW sy%=FNbeHW-sy% sx%=FNbeHW-sx% junk%=FNHW packtype%=FNbeHW junk%=FNW resx%=FNbeW resy%=FNbeW IF FNbeHW<>16 CLOSE#c%:ERROR 42,"ChangeFSI expected Mac PICT2 pixeltype=RGBDirect" bpp%=FNbeHW comps%=FNbeHW junk%=FNbeHW REM components and component size junk%=FNbeW junk%=FNbeW REM planebytes=0, ctseed junk%=FNbeHW junk%=FNbeHW REM ctflags, ctsize IF bpp%>16 PROCnopal ELSE J%=2^(bpp% DIV 3):FOR I%=0 TO J%-1:r%(I%)=I%/(J%-1)*F:NEXT:g%()=r%():b%()=r%() IF bpp%=32 AND comps%=3 bpp%=24:rowbytes%=3*sx% done%= TRUE OTHERWISE CLOSE#c% ERROR 42,"ChangeFSI can't understand Mac PICT2 code "+ STR$~code% ENDCASE UNTIL done% junk%=FNbeHW junk%=FNbeHW junk%=FNbeHW junk%=FNbeHW REM src rect junk%=FNbeHW junk%=FNbeHW junk%=FNbeHW junk%=FNbeHW REM dest rect junk%=FNbeHW REM transfer mode cache%= TRUE cachebytes%= TRUE bigendianbits= TRUE st%=PTR#c% rowbytes%=rowbytes% AND NOT &8000 IF scale% xmul%=xmul%*90*65536:xdiv%=xdiv%*resx%:ymul%=ymul%*90*65536:ydiv%=ydiv%*resy% info$="Mac PICT2, "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(bpp%) plbuff%=FNdim(rowbytes%) IF bpp%>8 THEN rbo%=-1 rb%=plbuff%+sx% gb%=plbuff%+sx%*2 bb%=plbuff%+sx%*3 r$="FN1851" input=24 IF comps%=3 rb%=plbuff%:gb%=plbuff%+sx%:bb%=plbuff%+sx%*2 ENDIF WHEN 1900 REM ZSoft PCX PTR#c%=1 C%=BGET#c% E%=BGET#c% IF E%<>1 ERROR 42,"ZSoft .PCX file with unknown encoding" E%=BGET#c% sx%=FNHW sy%=FNHW sx%=FNHW+1-sx% sy%=FNHW+1-sy% IF scale% xmul%=xmul%*90:xdiv%=xdiv%*FNHW:ymul%=ymul%*90:ydiv%=ydiv%*FNHW ELSE IF FNW PTR#c%=65 planes%=BGET#c% planar%=planes%>1 rowbytes%=FNHW bpp%=E%*planes% pcxpal=16 IF bpp%>4 AND C%=5 THEN PTR#c%=EXT#c%-769 IF BGET#c%=12 pcxpal=EXT#c%-768 ENDIF PTR#c%=pcxpal E%=0 FOR C%=0 TO (1<8 THEN IF B%>16 THEN input=24 bbo%=0 gbo%=1 rbo%=2 step24=B% DIV 8 r$="FN24" rowbytes%=step24*sx% ELSE rowbytes%=sx%*2 DIM rpal%(255),gpal%(255) input=16 step24=2 r$="FN16" FOR C%=0 TO 255 gpal%(C%)=(C%>>5)<<8 OR (C% AND 31)<<16 rpal%(C%)=(C%>>2) AND 31 OR (C% AND 3)<<11 NEXT FOR C%=0 TO 31 r%(C%)=C%/31*F NEXT g%()=r%() b%()=r%() ENDIF ELSE r$="FN8" rowbytes%=sx% ENDIF info$="Truevision TGA image, "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(B%) WHEN 9,10,11 step24=B% DIV 8 rowbytes%=step24*sx% buff%=FNdim(rowbytes%) IF B%>8 THEN IF B%>16 THEN input=24 bb%=buff% gb%=buff%+1 rb%=buff%+2 r$="FN2002" ELSE DIM rpal%(255),gpal%(255) input=16 step24=2 r$="FN2001" FOR C%=0 TO 255 gpal%(C%)=(C%>>5)<<8 OR (C% AND 31)<<16 rpal%(C%)=(C%>>2) AND 31 OR (C% AND 3)<<11 NEXT FOR C%=0 TO 31 r%(C%)=C%/31*F NEXT g%()=r%() b%()=r%() ENDIF ENDIF info$="Truevision TGA RLE image, "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(B%) ENDCASE WHEN 2100 REM Pineapple FSIfile quant%=6 sx%=512 rowbytes%=2*sx% sy%=256 cache%= TRUE r$="FN16" DIM rpal%(255),gpal%(255) input=16 step24=2 FOR C%=0 TO 255 gpal%(C%)=C%>>3 OR (C% AND 7)<<11 rpal%(C%)=(C% AND 7)<<8 OR (C%>>3)<<16 NEXT FOR C%=0 TO 31 r%(C%)=C%/31*F NEXT b%()=r%() FOR C%=0 TO 63 g%(C%)=C%/63*F NEXT IF scale% ymul%=ymul%*2 info$="Pineapple image, 512 by 256 pixels, 16 bits per pixel" PTR#c%=7 WHEN 2200 REM Irlam 24 bit image quant%=8 step24=1 PTR#c%=0 s$= GET$#c% E%=INSTR(s$,":") st%=PTR#c% sx%=VAL MID$(s$,E%+1) sy%=VAL MID$(s$,E%+2+LEN STR$sx%) PROCnopal input=24 rowbytes%=sx%*3 rbo%=0 gbo%=sx% bbo%=2*sx% cache%= TRUE r$="FN24" info$="Irlam image, "+ STR$sx%+" by "+ STR$sy%+" pixels, 24 bits per pixel" WHEN 2250 REM Irlam YUV 411 image PTR#c%=16 sx%=FNW sy%=FNW DIM rpal%(255),gpal%(255),bpal%(255),table%(255) FOR C%=0 TO 255 D%=C% OR 1 table%(C%)=(D%-16)/219*F IF D% AND 128 D%-=256 r%(C%)=INT (D%/160*F) b%(C%)=INT (D%/126*F) g%(C%)=INT (-D%/160*rwt/gwt*F) gpal%(C%)=INT (-D%/126*bwt/gwt*F) NEXT table%()=0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 REM first 16 zero'd st%=32 PTR#c%=32 cache%= TRUE rowbytes%=2*sx% input=411 info$="Irlam YUV 4:1:1 file "+ STR$sx%+" by "+ STR$sy%+" pixels" WHEN 2300 REM Utah raster toolkit "RLE" PTR#c%=6 sx%=FNHW sy%=FNHW D%=BGET#c% ncolors%=BGET#c% input=24 vflip%=NOT vflip% quant%=BGET#c% ncmap%=BGET#c% cmaplen%=1<0 THEN FOR I%=0 TO cmaplen%-1 r%(I%)=FNHW/&FF00*F NEXT FOR I%=0 TO cmaplen%-1 g%(I%)=FNHW/&FF00*F NEXT FOR I%=0 TO cmaplen%-1 b%(I%)=FNHW/&FF00*F NEXT ENDIF IF D% AND 8 THEN PTR#c%=FNHW+PTR#c% IF PTR#c% AND 1 PTR#c%=PTR#c%+1 ENDIF st%=PTR#c% buff%=FNdim(sx%*3) rb%=buff% gb%=buff%+1*sx% bb%=buff%+2*sx% PROCrewind info$="Utah rle image, "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(ncolors%*quant%) WHEN 2400 REM Windows 3 .BMP (guessed currently) PTR#c%=riffoff%+&0a st%=FNW pal%=FNW sx%=FNW sy%=FNW CASE pal% OF WHEN 12 REM OS/2 1.x variant PTR#c%=riffoff%+&18 input=FNHW compression=0 WHEN 40 REM proper Windows form PTR#c%=riffoff%+&1c input=FNHW compression=FNW PTR#c%=riffoff%+&26 xppm=FNW yppm=FNW REM pixels per meter IF (xppm<>0 AND yppm<>0 AND scale%<>0) THEN xdiv%=xdiv%*xppm xmul%=xmul%*3543 REM 3543 = pixels/metre at 90dpi ydiv%=ydiv%*yppm ymul%=ymul%*3543 ENDIF OTHERWISE ERROR 42,"Unknown .BMP variant ("+ STR$pal%+")" ENDCASE bigendianbits= TRUE vflip%=NOT vflip% CASE input OF WHEN 1 rowbytes%=sx%+7>>3 WHEN 4 rowbytes%=sx%+1>>1 WHEN 8 rowbytes%=sx% WHEN 16 rowbytes%=sx%*2 r$="FN16" step24=2 DIM rpal%(255),gpal%(255) rmask%=&7c00 gmask%=42 bmask%=-42 IF compression=3 PTR#c%=riffoff%+14+pal%:rmask%=FNW:gmask%=FNW:bmask%=FNW:compression=0 IF rmask%=&7c00 THEN FOR C%=0 TO 255 gpal%(C%)=(C%>>5)<<8 OR (C% AND 31)<<16 rpal%(C%)=(C%>>2) AND 31 OR (C% AND 3)<<11 NEXT FOR C%=0 TO 31 r%(C%)=C%/31*F NEXT g%()=r%() b%()=r%() ENDIF IF rmask%=&f800 THEN FOR C%=0 TO 255 gpal%(C%)=(C%>>5)<<8 OR (C% AND 31)<<16 rpal%(C%)=(C%>>3) AND 31 OR (C% AND 7)<<11 NEXT FOR C%=0 TO 31 r%(C%)=C%/31*F NEXT b%()=r%() FOR C%=0 TO 63 g%(C%)=C%/63*F NEXT ENDIF WHEN 24,32 rbo%=2 gbo%=1 bbo%=0 r$="FN24" FOR C%=0 TO 255 r%(C%)=C%/255*F NEXT g%()=r%() b%()=r%() r$="FN24" step24=input/8 rowbytes%=sx%*step24 rmask%=-1 gmask%=42 bmask%=-42 IF compression=3 PTR#c%=riffoff%+14+pal%:rmask%=FNW:gmask%=FNW:bmask%=FNW:compression=0 IF rmask%=&FF THEN rbo%=0:gbo%=1:bbo%=2 IF gmask%=&FF THEN gbo%=0:bbo%=1:rbo%=2 IF bmask%=&FF THEN bbo%=0:gbo%=1:rbo%=2 input=24 OTHERWISE ERROR 42,".BMP file of unusual depth ("+ STR$input+")" ENDCASE IF input<=8 THEN PTR#c%=riffoff%+14+pal% r$="FN8" FOR C%=0 TO 2^input-1 b%(C%)=BGET#c%/255*F g%(C%)=BGET#c%/255*F r%(C%)=BGET#c%/255*F IF BGET#c% NEXT ENDIF CASE compression OF WHEN 0 info$="Uncompressed " WHEN 1 info$="RLE8 compressed " r$="FN2401" WHEN 2 info$="RLE4 compressed " r$="FN2402" OTHERWISE ERROR 42,".BMP compression type not supported ("+ STR$compression+")" ENDCASE rowbytes%=rowbytes%+3 AND NOT 3 IF compression<>0 cachebytes%= TRUE :plbuff%=FNdim(rowbytes%) cache%= TRUE PTR#c%=riffoff%+st% info$+="Windows 3.0 .BMP image, "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(input) WHEN 2500 REM !Translator Clear format PTR#c%=0 s$="" C%=BGET#c% WHILE C%<>0 s$+=CHR$C% C%=BGET#c% ENDWHILE s$+=" version "+ STR$FNW sx%=FNW sy%=FNW input=FNW cache%= TRUE info$="!Translator Clear format made by "+s$+", "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(input) IF input>8 THEN PROCnopal input=24 step24=3 rowbytes%=3*sx% rbo%=0 gbo%=1 bbo%=2 r$="FN24" ELSE FOR C%=0 TO 2^input-1 r%(C%)=BGET#c%/255*F g%(C%)=BGET#c%/255*F b%(C%)=BGET#c%/255*F NEXT input=8 r$="FN8" rowbytes%=sx% ENDIF st%=PTR#c% WHEN 2600 REM Atari Degas file PTR#c%=0 C%=BGET#c% D%=BGET#c% CASE D% OF WHEN 0 sx%=320 sy%=200 planes%=4 WHEN 1 sx%=640 sy%=200 planes%=2 WHEN 2 sx%=640 sy%=400 planes%=1 OTHERWISE ERROR 42,"ChangeFSI knows nothing of "+ STR$C%+" type Degas files" ENDCASE FOR I%=0 TO (1<>8 AND 7)/7*F g%(I%)=(D%>>4 AND 7)/7*F b%(I%)=(D% AND 7)/7*F NEXT cache%= TRUE planar%= TRUE masking%= FALSE st%=34 PTR#c%=34 r$="FN1600" rowbytes%=(sx%+15>>4)<<1 plbytes%=rowbytes%*planes% pbuff%=FNdim(sx%) IF C% AND 128 r$="FN1601":flag=1600:cachebytes%= TRUE :plbuff%=FNdim(plbytes%) ELSE realrowbytes%=2:rowbytes%=plbytes% info$="Degas file "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(planes%) WHEN 2700 REM RIX SoftWorks ColoRIX image PTR#c%=4 sx%=FNHW sy%=FNHW CASE FNHW OF WHEN &AF rowbytes%=sx% cache%= TRUE r$="FN8" st%=&30A OTHERWISE CLOSE#c% ERROR 42,"Panic in ColoRIX reading - ChangeFSI largely ignorant of format!" ENDCASE FOR C%=0 TO 2^input-1 r%(C%)=BGET#c%/63*F g%(C%)=BGET#c%/63*F b%(C%)=BGET#c%/63*F NEXT PTR#c%=st% info$="ColoRIX file "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(input) WHEN 2800 REM FITS telescope format PTR#c%=0 bzero=0:bscale=1 REPEAT s$="" FOR Z%=1 TO 80 s$+=CHR$BGET#c% NEXT CASE LEFT$(s$,8) OF WHEN "SIMPLE " IF MID$(s$,30,1)<>"T" ERROR 42,"ChangeFSI can only read Simple FITS format" WHEN "BITPIX " quant%=VAL MID$(s$,10) WHEN "BZERO " bzero=VAL MID$(s$,10) WHEN "BSCALE " bscale=VAL MID$(s$,10) WHEN "NAXIS " IF VAL MID$(s$,10)<>2 ERROR 42,"ChangeFSI can only read 2d FITS images" WHEN "NAXIS1 " sx%=VAL MID$(s$,10) WHEN "NAXIS2 " sy%=VAL MID$(s$,10) WHEN "END " OTHERWISE IF info% PRINT "Ignoring FITS record "s$ ENDCASE UNTIL LEFT$(s$,8)="END " st%=(PTR#c% DIV 2880 + 1)*2880 cache%= TRUE PTR#c%=st% vflip%=NOT vflip% CASE quant% OF WHEN 8 r$="FN8" input=8 rowbytes%=sx% PROCnopal WHEN 16,32 rowbytes%=(quant% DIV8)*sx% DIM rpal%(255),gpal%(255) step24=quant% DIV8 r$="FN16" input=16 S%=bzero/bscale:REM Adjust DC level FOR C%=0 TO 255 gpal%(C%)=((C%<<8)-S%) AND &FF00 rpal%(C%)=((C%<<8)-S%) AND &FF NEXT cheat%=0 IF invert% cheat%=F FOR C%=0 TO 255 r%(C%)=cheat%+C%/65535*F g%(C%)=(C%<<8)/65535*F b%(C%)=cheat% NEXT rwt=1 gwt=1 bwt=1 OTHERWISE ERROR 42,"ChangeFSI can't read a FITS image with this number of bits per pixel" ENDCASE info$="FITS file "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(quant%) WHEN 2900 REM Apollo GPR format PTR#c%=4 sx%=FNbeHW sy%=FNbeHW PTR#c%=&42 input=FNbeHW C%=FNbeHW rowbytes%=FNbeHW C%=FNbeW st%=FNbeW PTR#c%=st% r$="FN8" PROCnopal DIM rpal%(15),gpal%(15),bpal%(15) rpal%()=&e6,&23,&e6,&7f,&17,&00,&a1,&45,&e6,&4a,&e6,&73,&6e,&47,&8a,0 gpal%()=&e6,&78,&00,&23,&a1,&73,&2e,&2e,&c8,&a6,&75,&40,&b8,&78,&55,0 bpal%()=&b8,&e6,&00,&a1,&17,&2e,&0c,&2e,&00,&c6,&00,&e6,&00,&00,&00,0 FOR C%=&80 TO &8F r%(C%)=rpal%(C%-&80)/255*F g%(C%)=gpal%(C%-&80)/255*F b%(C%)=bpal%(C%-&80)/255*F NEXT cache%= TRUE info$="Apollo GPR file "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(input) WHEN 3000 REM CCIR 601 file sx%=720 sy%=EXT#c%/1440 DIM rpal%(255),gpal%(255),bpal%(255),table%(255) REM YIQ code removed IF FALSE THEN FOR C%=0 TO 255 table%(C%)=(C%-16)/219*F r%(C%)=(C%-128)/186*0.624*F rpal%(C%)=(C%-128)/160*0.952*F g%(C%)=-(C%-128)/186*0.64*F gpal%(C%)=-(C%-128)/160*0.277*F b%(C%)=(C%-128)/186*1.73*F bpal%(C%)=-(C%-128)/160*1.11*F NEXT ELSE REM YUV code FOR C%=0 TO 255 table%(C%)=(C%-16)/219*F r%(C%)=INT ((C%-128)/160*F) b%(C%)=INT ((C%-128)/126*F) g%(C%)=INT (-(C%-128)/160*rwt/gwt*F) gpal%(C%)=INT (-(C%-128)/126*bwt/gwt*F) NEXT ENDIF table%()=-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1 REM first 16 zero'd st%=0 PTR#c%=0 cache%= TRUE rowbytes%=1440 input=422 gamma=1 IF scale% ymul%=ymul%*2 info$="CCIR601 4:2:2 file "+ STR$sx%+" by "+ STR$sy%+" pixels" WHEN 3100 REM !RayShade "RGB" image quant%=8 PTR#c%=0 a$= GET$#c% st%=PTR#c% sx%=VAL a$ sy%=VAL (MID$(a$,INSTR(a$," "))) PROCnopal input=24 step24=3 rowbytes%=sx%*3 rbo%=0 gbo%=1 bbo%=2 cache%= TRUE flag=700 r$="FN24" info$="!RayShade 'RGB' image, "+ STR$sx%+" by "+ STR$sy%+" pixels, 24 bits per pixel" WHEN 3200 REM Kodak sampler CD quant%=8 PTR#c%=0 st%=0 sx%=VAL MID$(s$,INSTR(s$,"_")+1,1) CASE sx% OF WHEN 5 sx%=768 sy%=512 WHEN 2 sx%=3072 sy%=2048 WHEN 1 sx%=1536 sy%=1024 ENDCASE PROCnopal input=24 step24=3 rowbytes%=sx%*3 rbo%=0 gbo%=1 bbo%=2 cache%= TRUE flag=700 r$="FN24" info$="Kodak /RGB image, "+ STR$sx%+" by "+ STR$sy%+" pixels, 24 bits per pixel" WHEN 3300 REM p4/p5/p6/p8 PTR#c%=0 input=VAL MID$(FNGET,2) s$=FNGET sx%=VAL s$ sy%=VAL MID$(s$,INSTR(s$," ")) IF sy%=0 sy%=VAL FNGET cache%= TRUE CASE input OF WHEN 4 input=1 r$="FN8" r%(0)=F g%()=r%() b%()=r%() bigendianbits= TRUE rowbytes%=(sx%+7) DIV 8 WHEN 5 input=8 r$="FN8" E%=VAL FNGET FOR C%=0 TO E% r%(C%)=C%/E%*F NEXT g%()=r%() b%()=r%() rowbytes%=sx% WHEN 6 input=24 r$="FN24" E%=VAL FNGET step24=3 rbo%=0 gbo%=1 bbo%=2 FOR C%=0 TO E% r%(C%)=C%/E%*F NEXT g%()=r%() b%()=r%() rowbytes%=sx%*3 WHEN 8 input=24 r$="FN24" E%=VAL FNGET step24=4 rbo%=0 gbo%=1 bbo%=2 FOR C%=0 TO E% r%(C%)=C%/E%*F NEXT g%()=r%() b%()=r%() rowbytes%=sx%*4 ENDCASE st%=PTR#c% flag=700 info$+="pbm image, "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(input) WHEN 3400 REM p15 PTR#c%=0 s$=FNGET input=16 quant%=5 s$=FNGET sx%=VAL s$ sy%=VAL MID$(s$,INSTR(s$," ")) s$=FNGET DIM rpal%(255),gpal%(255) input=16 step24=2 FOR C%=0 TO 255 gpal%(C%)=(C%>>5)<<8 OR (C% AND 31) rpal%(C%)=((C%>>2) AND 31)<<16 OR (C% AND 3)<<11 NEXT cache%= TRUE r$="FN16" FOR C%=0 TO 31 r%(C%)=C%/31*F NEXT g%()=r%() b%()=r%() rowbytes%=sx%*2 st%=PTR#c% flag=700 info$="p15 image, "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(input) WHEN 3410 REM p14 PTR#c%=0 s$=FNGET input=16 quant%=5 s$=FNGET sx%=VAL s$ sy%=VAL MID$(s$,INSTR(s$," ")) s$=FNGET DIM rpal%(255),gpal%(255) input=16 step24=2 FOR C%=0 TO 255 gpal%(C%)=(C%>>4)<<8 OR (C% AND 15) rpal%(C%)=(C% AND 15)<<16 NEXT cache%= TRUE r$="FN16" FOR C%=0 TO 15 r%(C%)=C%/15*F NEXT g%()=r%() b%()=r%() rowbytes%=sx%*2 st%=PTR#c% flag=700 info$="p14 image, "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(input) WHEN 3450 REM p13 n Y n U n V PTR#c%=0 info$=FNGET ybits%=VAL MID$(info$,INSTR(info$," ")) ymax%=(1<1 d=-(D%-C%)/umax% b%(C%)=INT (d*(1-bwt)*F) gpal%(C%)=INT (-d*(1-bwt)*bwt/gwt*F) NEXT D%=(1<1 d=-(D%-C%)/vmax% r%(C%)=INT (d*(1-rwt)*F) g%(C%)=INT (-d*(1-rwt)*rwt/gwt*F) NEXT rowbytes%=sx%*2 st%=PTR#c% cache%= TRUE r$="FN2250" input=555 info$+=", "+ STR$sx%+" by "+ STR$sy%+" pixels" WHEN 3500 REM Pocketbook quant%=1 PTR#c%=6 E%=FNHW sx%=FNHW sx%=FNHW sy%=FNHW st%=FNHW st%=FNW rowbytes%=sx%/8+1 AND NOT 1 cache%= TRUE st%+=PTR#c% PTR#c%=st% CASE E% OF WHEN 1 r$="FN8" input=1 r%(0)=F g%(0)=F b%(0)=F info$="Pocketbook bitmap, "+ STR$sx%+" by "+ STR$sy%+" pixels, 1 bit per pixel" WHEN 2 planar%= TRUE planes%=2 r$="FN1600" input=8 cachebytes%= TRUE r%(0)=F r%(1)=(F/3)*2 r%(2)=F/3 r%(3)=0 g%()=r%() b%()=r%() plbytes%=rowbytes%*planes% buff%=FNdim(plbytes%*sy%) pbuff%=FNdim(sx%) realrowbytes%=rowbytes%*sy% info$="PocketbookII bitmap, "+ STR$sx%+" by "+ STR$sy%+" pixels, 2 bits per pixel" OTHERWISE ERROR 42,"Unknown Pocketbook PIC format" ENDCASE WHEN 3600 REM real PhotoCD reader pcdblk%=FNdim(40) SYS &20023,"ChangeFSI$PCDindex",pcdblk%,20 TO ,,Z IF Z THEN pcdblk%?Z=13:pcdindex%=VAL $pcdblk% ELSE pcdindex%=3 SYS "PhotoCD_Open",1,c%,1 TO pcdh% SYS "PhotoCD_GetCount",pcdh% TO ,Z IF (Z>>pcdindex%)=0 CLOSE#c%:ERROR 42,"Desired resolution unavailable" SYS "PhotoCD_GetRotation",pcdh% TO ,,pcdtr% SYS "PhotoCD_GetSize",pcdh%,,pcdindex% TO ,,,,sx%,sy% pcdblk%!0=0 pcdblk%!8=sx% pcdblk%!4=0 pcdblk%!16=0 pcdblk%!20=2 pcdblk%!24=1 pcdblk%!28=3 REM VDU4,30:PRINT rotate%'vflip%'hflip%'~pcdtr% CASE pcdtr% OF WHEN 0 WHEN &80000000 hflip%=NOT hflip% WHEN 90 CASE rotate% OF WHEN 0 rotate%=1 WHEN -1 rotate%=0 WHEN 1 rotate%=0 vflip%=NOT vflip% hflip%=NOT hflip% ENDCASE WHEN &8000005A CASE rotate% OF WHEN 0 rotate%=1 vflip%=NOT vflip% WHEN -1 rotate%=0 vflip%=NOT vflip% WHEN 1 rotate%=0 hflip%=NOT hflip% ENDCASE WHEN 180 hflip%=NOT hflip% vflip%=NOT vflip% WHEN &800000B4 vflip%=NOT vflip% WHEN 270 CASE rotate% OF WHEN 0 rotate%=-1 WHEN 1 rotate%=0 WHEN -1 rotate%=0 vflip%=NOT vflip% hflip%=NOT hflip% ENDCASE WHEN &8000010E CASE rotate% OF WHEN 0 rotate%=-1 vflip%=NOT vflip% WHEN 1 rotate%=0 vflip%=NOT vflip% WHEN -1 rotate%=0 hflip%=NOT hflip% ENDCASE OTHERWISE PANIC ENDCASE REM PRINT rotate%'vflip%'hflip%:VDU5 input=24 step24=3 rbo%=0 gbo%=1 bbo%=2 pcdcachesize%=32*1024 rowbytes%=sx%*3 PROCnopal cache%= TRUE pcdcache%=FNdim(pcdcachesize%) info$="PhotoCD image, "+ STR$sx%+" by "+ STR$sy%+" pixels, 24 bits per pixel" WHEN 3700 REM High speed reader already loaded and JPEG in cache A%=datacache% B%=jpegblk% C%=jpegblk%+4 D%=jpegblk%+8 E%=jpegblk%+12 CALL jpeg%+8 D%=EXT#c% C%=datacache% B%=jpegblk%!12:jpegspace%=FNdim(B%):REM workspace needed A%=jpegspace% CALL jpeg%+0 cache%=FALSE IF !A% ERROR 42,"JPEG render stopped (reason "+ STR$!A%+")" sx%=A%!20 sy%=A%!24 input=8*A%?28 PROCnopal step24=4 info$="JFIF image, "+ STR$sx%+" by "+ STR$sy%+" pixels, "+FNbits(input) jpegy%=sy% r$="FN"+ STR$INT (3700+input) WHEN 3800 REM TechnoI video digitiser PTR#c%=24 sx%=FNW sy%=FNW IF scale% ymul%=ymul%*2 DIM rpal%(255),gpal%(255),bpal%(255),table%(255) FOR C%=0 TO 255 IF C%<128 table%(C%)=C%/127*F D%=C% IF D% AND 128 D%-=256 r%(C%)=INT (D%/160*F) b%(C%)=INT (D%/126*F) g%(C%)=INT (-D%/160*rwt/gwt*F) gpal%(C%)=INT (-D%/126*bwt/gwt*F) NEXT REM lots to do - see 411 reader PTR#c%=52 st%=FNW PTR#c%=64 cache%= TRUE rowbytes%=2*sx% input=411 info$="Uncompressed Techno-I YUV file "+ STR$sx%+" by "+ STR$sy%+" pixels" WHEN 3900 REM Ronald Alpiar 12 bits per component PTR#c%=8 sx%=FNW sy%=FNW st%=16 quant%=12 step24=6 FOR C%=0 TO 4095 r%(C%)=C%/4095*F NEXT g%()=r%() b%()=r%() input=48 rowbytes%=sx%*6 cache%= TRUE r$="FN24" rbo%=0 gbo%=2 bbo%=4 info$="Ronald Alpiar format, "+ STR$sx%+" by "+ STR$sy%+" pixels, 36 bits per pixel" WHEN 3905 REM Ronald Alpiar 16 bits per component PTR#c%=8 sx%=FNW sy%=FNW st%=16 quant%=16 step24=6 FOR C%=0 TO 65535 r%(C%)=C%/65535*F NEXT g%()=r%() b%()=r%() input=48 rowbytes%=sx%*6 cache%= TRUE r$="FN24" rbo%=0 gbo%=2 bbo%=4 info$="Ronald Alpiar format, "+ STR$sx%+" by "+ STR$sy%+" pixels, 48 bits per pixel" WHEN 4000 REM Portable network graphics (PNG) PTR#c%=8 A%=OPENIN".CFSIpng" IF A%=0 THEN ERROR 42,"Can't load PNG support code" png%=FNdim(EXT#A%) SYS 12,4,A%,png%,EXT#A% CLOSE#A% SYS "XOS_CLI","rmensure ZLib 0 rmload System:Modules.ZLib" OSCLI"rmensure ZLib 0 ERROR ChangeFSI requires the ZLib module to perform this operation" png1st%=0:REM File PTR of 1st IDAT T%=0:REM Tag order checking has seen nothing V%=TRUE:REM Validity starts OK REPEAT L%=FNbeW:t$=CHR$BGET#c%+CHR$BGET#c%+CHR$BGET#c%+CHR$BGET#c% CASE t$ OF WHEN"IHDR" IF T%<>0 THEN V%=FALSE ELSE T%=T% OR1:REM Only once, must come first sx%=FNbeW sy%=FNbeW PNGdep%=BGET#c%:REM Bit depth PNGcol%=BGET#c%:REM Type 0 is greyscale 1/2/4/8/16bpp REM Type 2 is 24/48bpp RGB REM Type 3 is paletted 1,2,4,8bpp REM Type 4 is 8/16bpp greyscale + alpha REM Type 6 is 24/48bpp RGB + alpha PNGcmp%=BGET#c%:PNGflt%=BGET#c%:PNGint%=BGET#c%:REM Compressor, filter, interlacing C%=FNbeW:REM Skip CRC32 WHEN"PLTE" IF (T% AND15)<>1 THEN V%=FALSE ELSE T%=T% OR2:REM Only once, before IDAT, before IEND IF (L% MOD3)<>0 THEN ERROR42, "PNG palette must have R/G/B triplets" L%=L% DIV3 FOR C%=0 TO L%-1 r%(C%)=BGET#c%/255*F g%(C%)=BGET#c%/255*F b%(C%)=BGET#c%/255*F NEXT C%=FNbeW:REM Skip CRC32 WHEN"IDAT" IF (T% AND9)<>1 THEN V%=FALSE ELSE T%=T% OR4:REM Can be multiple, after IHDR, before IEND, PLTE optional IF png1st%=0 AND L%<>0 THEN png1st%=PTR#c%-8:REM Latch first occupied IDAT for rewind PTR#c%=PTR#c%+L%+4:REM Skip data & CRC32 WHEN"IEND" IF (T% AND13)<>5 THEN V%=FALSE ELSE T%=T% OR8:REM Only once, must be last, PLTE optional IF L%<>0 THEN ERROR42, "IEND contains data" C%=FNbeW:REM Skip CRC32 OTHERWISE IF (ASC(t$) AND32)=0 THEN ERROR42, "Unhandled critical tag encountered":REM Not one in PNG spec 1.2 PTR#c%=PTR#c%+L%+4:REM Skip unhandled ancilliary tags ENDCASE UNTIL EOF#c% IF NOT V% THEN ERROR42,"Out of order tag in PNG" CASE PNGcol% OF WHEN0: IF PNGdep%<>1 AND PNGdep%<>2 AND PNGdep%<>4 AND PNGdep%<>8 AND PNGdep%<>16 THEN V%=FALSE WHEN2,4,6: IF PNGdep%<>8 AND PNGdep%<>16 THEN V%=FALSE WHEN3: IF PNGdep%<>1 AND PNGdep%<>2 AND PNGdep%<>4 AND PNGdep%<>8 THEN V%=FALSE OTHERWISE: V%=FALSE ENDCASE IF NOT V% THEN ERROR42,"Invalid PNG colour combination" IF ((PNGcol%=0 OR PNGcol%=4) AND (T% AND2)=2) THEN ERROR42,"Unexpected palette with greyscale PNG" IF (PNGcol%=3 AND (T% AND2)=0) THEN ERROR42,"Expected palette for colour indexed PNG" IF PNGcmp%<>0 OR PNGflt%<>0 THEN ERROR42,"Unsupported compressor or filter type for PNG" IF PNGint%<>0 AND PNGint%<>1 THEN ERROR42,"Unsupported interlacing scheme for PNG" CASE PNGcol% OF WHEN 0: quant%=PNGdep%:input=quant%+(8*(PNGdep%=16)) bppbytes%=(PNGdep%+7) DIV8:bppbits%=quant% r$="FN4008":PROCflatpal(1<"D" m$="R" ENDIF ENDIF ENDCASE IF m=-6 OR m=-7 OR m=-8 THEN nx=VAL MID$(pnm$,5) ny=VAL MID$(pnm$,INSTR(pnm$,",",5)+1) IF nx<>0 AND ny=0 THEN ny=nx:REM No y DPI given,make it square pixels IF nx=0 AND ny=0 THEN nx=90:ny=90:REM Silly user forgot to specify any x or y DPI at all IF scaleo% THEN IF rotate% THEN IF xdiv% ymul%=ymul%*nx IF ydiv% xmul%=xmul%*ny ELSE IF xdiv% xmul%=xmul%*nx IF ydiv% ymul%=ymul%*ny ENDIF xdiv%=xdiv%*90 ydiv%=ydiv%*90 ENDIF ENDIF IF rotate% SWAP x%,y%:REM SWAP xmul%,ymul% REM VDU4,30:PRINT x% xmul% xdiv%'y% ymul% ydiv%:VDU5 IF xdiv%=0 xdiv%=sx% IF ydiv%=0 ydiv%=sy% IF xs$="=" xmul%=x%:xdiv%=sx% IF ys$="=" ymul%=y%:ydiv%=sy% IF lock% THEN IF xmul%/xdiv%>ymul%/ydiv% xmul%=ymul%:xdiv%=ydiv% ELSE ymul%=xmul%:ydiv%=xdiv% ENDIF IF ncol=1 THEN CASE m$ OF WHEN "C" xdiv%=xdiv%*4 ydiv%=ydiv%*4 DIM A%(16),B%(16) A%()=0,&00000001,&08000001,&08000101,&08080101,&08080103,&0C080103,&0C080303,&0C0C0303,&0C0E0303,&0C0E0703,&0E0E0703,&0E0E0707,&0E0F0707,&0E0F0F07,&0F0F0F07,&0F0F0F0F B%()=0,&00000008,&01000008,&01000808,&01010808,&0101080C,&0301080C,&03010C0C,&03030C0C,&03070C0C,&03070E0C,&07070E0C,&07070E0E,&070F0E0E,&070F0F0E,&0F0F0F0E,&0F0F0F0F even_gard=FNdim(17*32*4) odd_gard=FNdim(17*32*4) FOR I%=0 TO 16 FOR J%=0 TO 16 even_gard!(J%*32*4+I%*4)=A%(I%) OR B%(J%)<<4 NEXT NEXT FOR I%=0 TO 16 FOR J%=0 TO 16 odd_gard!(I%*32*4+J%*4)=B%(I%) OR A%(J%)<<4 NEXT NEXT WHEN "T" xdiv%=xdiv%*3 ydiv%=ydiv%*3 REM Clustered dithering with a 3x3 cell DIM A%(9),B%(9) A%()=0,&0001,&4001,&4041,&4043,&40C3,&60C3,&61C3,&71C3,&71C7 B%()=0,&0004,&1004,&1104,&1106,&1186,&3186,&31C6,&71C6,&71C7 even_gard=FNdim(10*16*4) odd_gard=FNdim(10*16*4) FOR I%=0 TO 9 FOR J%=0 TO 9 even_gard!(J%*16*4+I%*4)=A%(I%) OR B%(J%)<<3 NEXT NEXT FOR I%=0 TO 9 FOR J%=0 TO 9 odd_gard!(I%*16*4+J%*4)=B%(I%) OR A%(J%)<<3 NEXT NEXT WHEN "D" xdiv%=xdiv%*2 ydiv%=ydiv%*2 DIM A%(4),B%(4) A%()=0,&1,&21,&31,&33 B%()=0,&2,&12,&32,&33 even_gard=FNdim(5*8) odd_gard=FNdim(5*8) FOR I%=0 TO 4 FOR J%=0 TO 4 even_gard?(J%*8+I%)=A%(I%) OR B%(J%)<<2 NEXT NEXT FOR I%=0 TO 4 FOR J%=0 TO 4 odd_gard?(I%*8+J%)=B%(I%) OR A%(J%)<<2 NEXT NEXT ENDCASE ENDIF REPEAT PROCreduce(xmul%,xdiv%) PROCreduce(ymul%,ydiv%) IF xdiv%*ydiv%*255>2^32 xdiv%=xdiv% AND NOT 1:ydiv%=ydiv% AND NOT 1:xmul%=xmul% AND NOT 1:ymul%=ymul% AND NOT 1 UNTIL xdiv%*ydiv%*255<2^32 REM deal with large ratios IF info% PRINT "Size ratios are x ";xmul%":"xdiv%" y "ymul%":"ydiv% x%=sx%*xmul%/xdiv%+.9999 y%=sy%*ymul%/ydiv%+.9999 rows%=sy% order%=x%*y%>sx%*sy%:REM TRUE if scaling up code%=FNdim(8192) SP=13 IF cache% THEN PROCcachesize IF cachebytes% THEN filesize%=EXT#c%-PTR#c% IF cache%>filesize% cache%=filesize% IF cachebytes%>0 IF cache%>cachebytes% cache%=cachebytes% cacherows%=cache% ELSE filesize%=sy%*rowbytes% IF cache%filesize% cache%=filesize% cacherows%=striprows% IF cacherows%<1 cacherows%=cache% DIV rowbytes% cache%=cacherows%*rowbytes% ENDIF datacache%=FNcachedim(cache%) IF datacache%=-1 datacache%=FNdim(cache%) ENDIF IF m$="T" AND ncol=63 THEN REM Table lookup mode,load the 4096 colour table lookup%=FNdim(4096+256*4) palette%=lookup%+4096 SYS "OS_File",16,".Palettes.CFSIict",lookup% ENDIF REM An 8bpp mode will always be devious (R),unless (D) was specifically selected as (C) doesn't do 8bpp IF ncol=255 IF (m$<>"D") AND (m$<>"T") THEN m$="R" IF m$="R" OR (ncol=63 AND m$="") THEN REM Got here because we're not outputting in true colour,so must do some form of dithering SYS 53,-1,3 TO ,,J% IF ncol=255 AND MODE =m J%=ncol:REM 8bpp,and in the right mode,skip error IF ncol=63 AND (m$="" OR m$="R") J%=ncol:REM 8bpp (64 definable colours),being devious (R),skip error IF J%<>ncol THEN REM Need to read the palette but can't because we're in the wrong mode - load a default J%=ncol IF J%=63 J%=255:REM Well it's kind of 256 colours palette%=FNdim((J%+1)*4) REM Grab 256,16,4,or 2 words s$="" CASE ncol OF WHEN 1 s$="Palette2" REM The 2 colours are B&W WHEN 3 s$="Palette4" REM The 4 colours are infact greys WHEN 15 s$="Palette16" WHEN 63 s$="Palette64" WHEN 255 s$="Palette256" ENDCASE SYS "XOS_File",16,".Palettes."+s$,palette% TO ;I% IF ((I% AND 1)=1) THEN PROCclose:ERROR 42,"Couldn't find a default palette file for a "+ STR$(ncol+1)+" colour mode" IF info% PRINT "Inappropriate mode for this operation, a default palette has been loaded" ELSE REM Already in an appropriate mode,so can just ask the OS for the palette IF J%=63 J%=255:REM Well it's kind of 256 colours palette%=FNdim((J%+1)*4) REM Grab 256,16,4,or 2 words IF ncol=255 THEN REM Pick up the palette as seen by ColourTrans in this 8bpp mode SYS "ColourTrans_ReadPalette",-1,-1,palette%,256*4 FOR I%=0 TO 255 palette%!(I%<<2)=palette%!(I%<<2)>>>8 NEXT ELSE IF ncol=63 THEN REM Make up a palette from what we know about VIDC 1 FOR I%=0 TO 255 palette%!(I%<<2)=(I% AND 7 OR (I% AND 16)>>1)*17 palette%?(I%<<2 OR 1)=(I% AND 3 OR (I% AND &60)>>3)*17 palette%?(I%<<2 OR 2)=(I% AND 3 OR (I% AND 8)>>1 OR (I% AND 128)>>4)*17 NEXT ELSE REM For 16,4 or 2 colour modes the OS knows best FOR I%=0 TO ncol SYS "OS_ReadPalette",I%,16 TO ,,i% palette%!(I%<<2)=i%>>>8 NEXT ENDIF ENDIF ENDIF REM See if the palette is any use t%= TRUE k%=palette%+1 nk%=palette%+2 FOR I%=0 TO ncol*4 STEP 4 REM t% becomes false (ie.we don't force grey scale output) if the palette's R,G,B content differs IF palette%?I%<>k%?I% OR palette%?I%<>nk%?I% t%= FALSE :I%=ncol*4 NEXT IF ncol>16 IF t% m$="D":REM Force 256 greys IF ncol=15 IF t% m$="T":REM Force 16 greys REM Now be devious and recycle the palette IF m$="R" THEN IF sx%*xmul%/xdiv%*sy%*ymul%/ydiv%<200000 k%=3 ELSE k%=4 nk%=8-k% t%=1<bk min=bi-bd SUBCS r11,r8,r2 REM if bik>bk max=bi-bn MUL r3,r10,r10 REM min=min^2 .doneblue MUL r4,r11,r11 REM max=(bi-bd)^2 MOV r8,r7,lsr #8 AND r8,r8,#255 REM gi BIC r10,r8,#mask% REM gik ADD r11,r1,#t% REM gd CMP r10,r1 REM if gik=gk BEQ greenequal SUBCC r10,r1,r8 REM if gikgk min=gi-gd SUBCS r11,r8,r1 REM if gik>gk max=gi-gn REM MLA r3,r10,r10,r3 REMmin+=min^2 MUL r8,r10,r10 ADD r8,r8,r8,LSL #2 ADD r3,r3,r8,LSL #1 REM min+=gmin^2*10 .donegreen MUL r8,r11,r11 ADD r8,r8,r8,LSL #2 ADD r4,r4,r8,LSL #1 REM max+=gmax^2*10 REM MLA r4,r11,r11,r4 REMmax+=(gi-gd)^2 AND r8,r7,#255 REM ri REM r7 is now a suitable temporary register BIC r10,r8,#mask% REM rik ADD r11,r0,#t% REM rd CMP r10,r0 REM if rik=rk BEQ redequal0 SUBCC r10,r0,r8 REM if rikrk min=ri-rd SUBCS r11,r8,r0 REM if rik>rk max=ri-rn REM MLA r7,r10,r10,r3 REMmin=minsofar+min^2 MUL r7,r10,r10 ADD r7,r7,r7,LSL #1 ADD r7,r3,r7 REM min=minsofar+min^2*3 STR r7,[r12,r5,LSL #2] REM min(I,0)=min .donered0 MUL r7,r11,r11 ADD r7,r7,r7,LSL #1 ADD r7,r4,r7 REM max=maxsofar+max^2*3 REM MLA r7,r11,r11,r4 REMmax=maxsofar+(ri-rd)^2 CMP r7,r9 REM ifmaxrk min=ri-rd SUBCS r11,r8,r7 REM if rik>rk max=ri-rn MUL r7,r10,r10 ADD r7,r7,r7,LSL #1 ADD r3,r3,r7 REM min=minsofar+min^2*3 REM MLA r3,r10,r10,r3 REMmin=minsofar+min^2 .donered1 ADD r7,r5,#ncol% STR r3,[r12,r7,LSL #2] REM min(I,1)=min MUL r7,r11,r11 ADD r7,r7,r7,LSL #1 ADD r7,r4,r7 REM max=maxsofar+max^2*3 REM MLA r7,r11,r11,r4 REMmax=maxsofar+(ri-rd)^2 CMP r7,r14 REM ifmax>>24)>3 ict%!I%=ict%!I%-scratch%+safesubict% NEXT ENDIF ENDIF IF fast% IF MODE <>0 MODE 0 REM test for as many colours as possible CASE m OF WHEN -1,-9 col=0:REM Monochrome AIM and JPEG WHEN -3,-4,-5,-6,-7,-8,-10 col=2 OTHERWISE col=0 IF m$="D" IF ncol=3 m$="" IF ncol>15 OR m$="C" OR m$="D" OR m$="R" col=2:REM depth of colour arrays IF ncol=63 OR ncol=255 IF m$="D" col=0:ncol=256 ENDCASE IF ncol=1 THEN CASE m$ OF WHEN "C" col=0 x%=x%+1 AND NOT 1 WHEN "D" col=0 x%=x%+3 AND NOT 3 WHEN "T" col=0 x%=x%+1 AND NOT 1 REM for now ENDCASE ENDIF DIM cl%(x%+7,col) REM current line additive errors DIM xl%(x%+7,col),xp%(sx%+7,col) REM extra input line for scaling vertically DIM xl2%(x%+7,col) IF sharpen% THEN IF order% THEN DIM rm%(sx%+7,col),rm1%(sx%+7,col),rm2%(sx%+7,col) ELSE DIM rm%(x%+7,col),rm1%(x%+7,col),rm2%(x%+7,col) ENDIF ENDIF IF hist% OR equal% DIM vals%(256,col) DIM nl%(x%+7,col) : REM next line additive errors totvals%=x%*(col+1) : REM total number of elements in a scaled line totvals2%=sx%*(col+1) : REM total number of elements in an input line FOR Z=0 TO 2 STEP 2 P%=code% CASE ncol OF WHEN 2^24-1 [ OPT Z%(Z) .div255 ] FOR I%=0 TO 2^p6bits-1 [ OPT Z%(Z) EQUD I%/(2^p6bits-1)*F ] NEXT [ OPT Z%(Z) .fs% FNcpsr_to_r(1) STMFD SP !,{R1,R14} ADR R7,div255 LDR R1,[R9,#6*8] LDR R1,[R1] REM incr LDR R10,[R9,#5*8] REM addr current LDR R11,[R9,#4*8] REM addr next LDR R12,[R9,#3*8] LDR R12,[R12] REM pixel address LDR R8,[R9,#2*8] LDR R8,[R8] REM step LDR R14,[R9] LDR R14,[R14] REM base addr ADD R12,R12,R14 LDR R9,[R9,#8] LDR R9,[R9] REM count LDR R4,[R10] REM r LDR R5,[R10,#4] REM g LDR R6,[R10,#8] REM b .fsloop ADD R10,R10,R8 REM +step CMP R4,#F MOVCS R4,#0 MOVGE R4,#F SUB R0,R4,R4,LSR #p6bits ADD R0,R0,#1<<(bits-p6bits-1) MOV R0,R0,LSR #(bits-p6bits) LDR R2,[R7,R0,LSL #2] SUB R4,R4,R2 CMP R5,#F MOVCS R5,#0 MOVGE R5,#F SUB R3,R5,R5,LSR #p6bits ADD R3,R3,#1<<(bits-p6bits-1) MOV R3,R3,LSR #(bits-p6bits) ORR R0,R0,R3,LSL #8 LDR R2,[R7,R3,LSL #2] SUB R5,R5,R2 CMP R6,#F MOVCS R6,#0 MOVGE R6,#F SUB R3,R6,R6,LSR #p6bits ADD R3,R3,#1<<(bits-p6bits-1) MOV R3,R3,LSR #(bits-p6bits) ORR R0,R0,R3,LSL #16 LDR R2,[R7,R3,LSL #2] SUB R6,R6,R2 STRB R0,[R12] MOV R0,R0,LSR #8 STRB R0,[R12,#1] MOV R0,R0,LSR #8 STRB R0,[R12,#2] ] IF m=-8 THEN [ OPT Z%(Z) ADD R12,R12,R1,LSL #2 ] ELSE [ OPT Z%(Z) ADD R12,R12,R1,LSL #1 ADD R12,R12,R1 ] ENDIF IF dither% THEN [ OPT Z%(Z) ADD R0,R11,#4 REM nl g%(S%) ADD R2,R4,R4,LSL #1 REM r*3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM r*5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM r/16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM r*7 LDR R4,[R10] REM next r light value ADD R4,R4,R2,ASR #4 REM next value +7/16 of r error -> new r ADD R2,R5,R5,LSL #1 REM g*3 LDR R3,[R0,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R0,-R8] MOV R3,R5,ASR #4 REM g/16 STR R3,[R0,R8] REM not seen so far ADD R2,R5,R5,LSL #2 REM g*5 LDR R3,[R0] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R0],#4 REM computes nl b into the bargain RSB R2,R5,R5,LSL #3 REM g*7 LDR R5,[R10,#4] REM next g light value ADD R5,R5,R2,ASR #4 REM next value +7/16 of g error -> new g ADD R2,R6,R6,LSL #1 REM b*3 LDR R3,[R0,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R0,-R8] ADD R2,R6,R6,LSL #2 REM b*5 LDR R3,[R0] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R0] MOV R3,R6,ASR #4 REM b/16 STR R3,[R0,R8] REM not seen so far RSB R2,R6,R6,LSL #3 REM b*7 LDR R6,[R10,#8] REM next b light value ADD R6,R6,R2,ASR #4 REM next value +7/16 of b error -> new b ] ELSE [ OPT Z%(Z) LDMIA R10,{R4,R5,R6} ] ENDIF [ OPT Z%(Z) SUBS R9,R9,#1 BNE fsloop LDMFD SP !,{R9,R14} FNcpsr_from_r(9) MOV PC,R14 ] WHEN 2^15-1 [ OPT Z%(Z) .div31 ] FOR I%=0 TO 31 [ OPT Z%(Z) EQUD I%/31*F ] NEXT [ OPT Z%(Z) .fs% FNcpsr_to_r(1) STMFD SP !,{R1,R14} ADR R7,div31 LDR R1,[R9,#6*8] LDR R1,[R1] REM incr LDR R10,[R9,#5*8] REM addr current LDR R11,[R9,#4*8] REM addr next LDR R12,[R9,#3*8] LDR R12,[R12] REM pixel address LDR R8,[R9,#2*8] LDR R8,[R8] REM step LDR R14,[R9] LDR R14,[R14] REM base addr ADD R12,R12,R14 LDR R9,[R9,#8] LDR R9,[R9] REM count LDR R4,[R10] REM r LDR R5,[R10,#4] REM g LDR R6,[R10,#8] REM b .fsloop ADD R10,R10,R8 REM +step CMP R4,#F MOVCS R4,#0 MOVGE R4,#F SUB R0,R4,R4,LSR #5 ADD R0,R0,#1<<(bits-6) MOV R0,R0,LSR #(bits-5) LDR R2,[R7,R0,LSL #2] SUB R4,R4,R2 CMP R5,#F MOVCS R5,#0 MOVGE R5,#F SUB R3,R5,R5,LSR #5 ADD R3,R3,#1<<(bits-6) MOV R3,R3,LSR #(bits-5) ORR R0,R0,R3,LSL #5 LDR R2,[R7,R3,LSL #2] SUB R5,R5,R2 CMP R6,#F MOVCS R6,#0 MOVGE R6,#F SUB R3,R6,R6,LSR #5 ADD R3,R3,#1<<(bits-6) MOV R3,R3,LSR #(bits-5) ORR R0,R0,R3,LSL #10 LDR R2,[R7,R3,LSL #2] SUB R6,R6,R2 STRB R0,[R12] MOV R0,R0,LSR #8 STRB R0,[R12,#1] ADD R12,R12,R1,LSL #1 ] IF dither% THEN [ OPT Z%(Z) ADD R0,R11,#4 REM nl g%(S%) ADD R2,R4,R4,LSL #1 REM r*3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM r*5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM r/16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM r*7 LDR R4,[R10] REM next r light value ADD R4,R4,R2,ASR #4 REM next value +7/16 of r error -> new r ADD R2,R5,R5,LSL #1 REM g*3 LDR R3,[R0,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R0,-R8] MOV R3,R5,ASR #4 REM g/16 STR R3,[R0,R8] REM not seen so far ADD R2,R5,R5,LSL #2 REM g*5 LDR R3,[R0] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R0],#4 REM computes nl b into the bargain RSB R2,R5,R5,LSL #3 REM g*7 LDR R5,[R10,#4] REM next g light value ADD R5,R5,R2,ASR #4 REM next value +7/16 of g error -> new g ADD R2,R6,R6,LSL #1 REM b*3 LDR R3,[R0,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R0,-R8] ADD R2,R6,R6,LSL #2 REM b*5 LDR R3,[R0] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R0] MOV R3,R6,ASR #4 REM b/16 STR R3,[R0,R8] REM not seen so far RSB R2,R6,R6,LSL #3 REM b*7 LDR R6,[R10,#8] REM next b light value ADD R6,R6,R2,ASR #4 REM next value +7/16 of b error -> new b ] ELSE [ OPT Z%(Z) LDMIA R10,{R4,R5,R6} ] ENDIF [ OPT Z%(Z) SUBS R9,R9,#1 BNE fsloop LDMFD SP !,{R9,R14} FNcpsr_from_r(9) MOV PC,R14 ] WHEN 256 [ OPT Z%(Z) .div255 ] FOR I%=0 TO 255 [ OPT Z%(Z) EQUD I%/255*F ] NEXT [ OPT Z%(Z) REM CALL fs%,sprinc%,current%(),next%(),pixel index%,increment%,count%,image base address% .fs% FNcpsr_to_r(10) STMFD SP !,{R10,R14} ADR R7,div255 LDR R10,[R9,#5*8] REM addr current LDR R1,[R9,#6*8] LDR R1,[R1] REM sprite incr LDR R11,[R9,#4*8] REM addr next LDR R12,[R9,#3*8] LDR R12,[R12] REM pixel address LDR R8,[R9,#2*8] LDR R8,[R8] REM step LDR R14,[R9] LDR R14,[R14] REM base addr ADD R12,R12,R14 LDR R9,[R9,#8] LDR R9,[R9] REM count LDR R4,[R10],R8 REM mono value .fsloop CMP R4,#F MOVCS R4,#0 MOVGE R4,#F SUB R0,R4,R4,LSR #8 ADD R0,R0,#1<<(bits-9) MOV R0,R0,LSR #(bits-8) STRB R0,[R12],R1 LDR R2,[R7,R0,LSL #2] ] IF dither% THEN [ OPT Z%(Z) SUB R4,R4,R2 REM subtract converted value MOVCS R4,#0 ADD R2,R4,R4,LSL #1 REM *3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM *5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM /16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM *7 LDR R4,[R10],R8 REM next light value ADD R4,R4,R2,ASR #4 REM next value +7/16 of error -> new value ] ELSE [ OPT Z%(Z) LDR R4,[R10],R8 ] ENDIF [ OPT Z%(Z) SUBS R9,R9,#1 BNE fsloop LDMFD SP !,{R9,R14} FNcpsr_from_r(9) MOV PC,R14 ] WHEN 63,255 div15=P% FOR I%=0 TO 255*4 STEP 4 [ OPT Z%(Z) EQUD (palette%!I% AND &FF)/255*F EQUD (palette%!I%>>8 AND &FF)/255*F EQUD (palette%!I%>>16 AND &FF)/255*F ] NEXT IF m$="R" THEN [ OPT Z%(Z) .ictloc EQUD ict% ] ENDIF IF m$="T" THEN [ OPT Z%(Z) .colmatchloc EQUD lookup% ] ENDIF [ OPT Z%(Z) EQUD div15 .fs% FNcpsr_to_r(1) STMFD SP !,{R1,R14} LDR R1, [R9,#6*8] LDR R1,[R1] REM sprite incr LDR R10,[R9,#5*8] REM addr current LDR R11,[R9,#4*8] REM addr next LDR R12,[R9,#3*8] LDR R12,[R12] REM pixel address LDR R8, [R9,#2*8] LDR R8,[R8] REM step LDR R14,[R9] LDR R14,[R14] REM base addr ADD R12,R12,R14 LDR R9, [R9,#1*8] LDR R9,[R9] REM column count LDR R4,[R10,#0] REM r LDR R5,[R10,#4] REM g LDR R6,[R10,#8] REM b LDR R7,fs%-4 .fsloop ADD R10,R10,R8 REM +step ] CASE m$ OF WHEN "T" [ OPT Z%(Z) REM This converts from a 4.4.4 rgb 4096 entry colour space to 256 colours CMP R4,#F MOVCS R4,#0 MOVGE R4,#F MOV R0,R4,LSR #(bits-4) CMP R0,#15 MOVCS R0,#15 REM 0<=r<=F CMP R5,#F MOVCS R5,#0 MOVGE R5,#F MOV R3,R5,LSR #(bits-4) CMP R3,#15 MOVCS R3,#15 ORR R0,R0,R3,LSL #4 REM 0<=g<=F CMP R6,#F MOVCS R6,#0 MOVGE R6,#F MOV R3,R6,LSR #(bits-4) CMP R3,#15 MOVCS R3,#15 ORR R0,R0,R3,LSL #8 REM 0<=b<=F LDR R3,colmatchloc REM 4k table followed by 256x12 palette LDRB R0,[R3,R0] REM R0 is %0000bbbbggggrrrr (a 12 bit number,hence 4k table) ADD R3,R0,R0,LSL #1 ADD R3,R7,R3,LSL #2 REM Byte read into R0 times 12 offset into R7,the palette LDR R2,[R3],#4 SUB R4,R4,R2 LDMIA R3,{R2,R3} SUB R5,R5,R2 SUB R6,R6,R3 REM Calculate RGB error voltages for next line pass ] WHEN "R" PROCsrchdevlist OTHERWISE [ OPT Z%(Z) CMP R4,#F MOVCS R4,#0 MOVGE R4,#F CMP R5,#F MOVCS R5,#0 MOVGE R5,#F CMP R6,#F MOVCS R6,#0 MOVGE R6,#F STMFD SP !,{R7,R8,R9} MVN R2,#0 MOV R3,#&30<<23 .srch RSB R7,R3,#&20<<23 MOV R8,R6,LSR #bits-8 SUB R8,R8,R8,LSR #4 ADDS R7,R7,R8,LSL #23 MOVVSS R7,#&7F000000 MOVMI R7,#0 AND R7,R7,#&60000000 ADD R7,R7,R3 ADD R14,R7,R7,LSR #4 ADD R7,R14,R14,LSR #8 ADD R7,R7,R7,LSR #16 SUBS R8,R6,R7,LSR #31-bits RSBLT R8,R8,#0 MOV R8,R8,LSR #bits/2 MUL R9,R8,R8 RSB R7,R3,#&20<<23 MOV R8,R5,LSR #bits-8 SUB R8,R8,R8,LSR #4 ADDS R7,R7,R8,LSL #23 MOVVSS R7,#&7F000000 MOVMI R7,#0 AND R7,R7,#&60000000 ADD R7,R3,R7 ADD R7,R7,R7,LSR #4 ORR R14,R14,R7,LSR #8 ADD R7,R7,R7,LSR #8 ADD R7,R7,R7,LSR #16 SUBS R8,R5,R7,LSR #31-bits RSBLT R8,R8,#0 MOV R8,R8,LSR #bits/2 MUL R7,R8,R8 ADD R7,R7,R7,LSL #2 ADD R9,R9,R7,LSL #1 RSB R7,R3,#&20<<23 MOV R8,R4,LSR #bits-8 SUB R8,R8,R8,LSR #4 ADDS R7,R7,R8,LSL #23 MOVVSS R7,#&7F000000 MOVMI R7,#0 AND R7,R7,#&60000000 ADD R7,R3,R7 ADD R7,R7,R7,LSR #4 ORR R14,R14,R7,LSR #16 ADD R7,R7,R7,LSR #8 ADD R7,R7,R7,LSR #16 SUBS R8,R4,R7,LSR #31-bits RSBLT R8,R8,#0 MOV R8,R8,LSR #bits/2 MUL R7,R8,R8 ADD R7,R7,R7,LSL #1 ADD R9,R9,R7 CMP R9,R2 MOVLS R2,R9 MOVLS R0,R14 SUBS R3,R3,#&10<<23 BGE srch AND R7,R0,#&40000000 MOV R8,R7,LSR #23 AND R7,R0,#&600000 ORR R8,R8,R7,LSR #16 AND R7,R0,#&4000 ORR R8,R8,R7,LSR #10 AND R7,R0,#&20000000 ORR R8,R8,R7,LSR #26 AND R7,R0,#&3800 ORR R0,R8,R7,LSR #11 LDMFD SP !,{R7,R8,R9} ADD R3,R0,R0,LSL #1 ADD R3,R7,R3,LSL #2 LDR R2,[R3],#4 SUB R4,R4,R2 LDMIA R3,{R2,R3} SUB R5,R5,R2 SUB R6,R6,R3 ] ENDCASE [ OPT Z%(Z) REM The output pixel being stored in 256 colour mode STRB R0,[R12],R1 ] IF dither% THEN [ OPT Z%(Z) ADD R0,R11,#4 REM nl g%(S%) ADD R2,R4,R4,LSL #1 REM r*3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM r*5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM r/16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM r*7 LDR R4,[R10] REM next r light value ADD R4,R4,R2,ASR #4 REM next value +7/16 of r error -> new r ADD R2,R5,R5,LSL #1 REM g*3 LDR R3,[R0,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R0,-R8] MOV R3,R5,ASR #4 REM g/16 STR R3,[R0,R8] REM not seen so far ADD R2,R5,R5,LSL #2 REM g*5 LDR R3,[R0] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R0],#4 REM computes nl b into the bargain RSB R2,R5,R5,LSL #3 REM g*7 LDR R5,[R10,#4] REM next g light value ADD R5,R5,R2,ASR #4 REM next value +7/16 of g error -> new g ADD R2,R6,R6,LSL #1 REM b*3 LDR R3,[R0,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R0,-R8] ADD R2,R6,R6,LSL #2 REM b*5 LDR R3,[R0] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R0] MOV R3,R6,ASR #4 REM b/16 STR R3,[R0,R8] REM not seen so far RSB R2,R6,R6,LSL #3 REM b*7 LDR R6,[R10,#8] REM next b light value ADD R6,R6,R2,ASR #4 REM next value +7/16 of b error -> new b ] ELSE [ OPT Z%(Z) LDMIA R10,{R4,R5,R6} ] ENDIF [ OPT Z%(Z) SUBS R9,R9,#1 BNE fsloop LDMFD SP !,{R9,R14} FNcpsr_from_r(9) MOV PC,R14 ] WHEN 15 divtable=P% CASE m$ OF WHEN "D" REM nothing... WHEN "R" FOR I%=0 TO 15*4 STEP 4 [ OPT Z%(Z) EQUD (palette%!I%>>4 AND &F)/bright%*F EQUD (palette%!I%>>12 AND &F)/bright%*F EQUD (palette%!I%>>20 AND &F)/bright%*F ] NEXT [ OPT Z%(Z) .ictloc EQUD ict% ] WHEN "T" FOR I%=0 TO 15 [ OPT Z%(Z) EQUD I%/bright%*F ] NEXT OTHERWISE FOR I%=0 TO 7 [ OPT Z%(Z) EQUD I%/(bright% DIV 2)*F ] NEXT ENDCASE [ OPT Z%(Z) .fs% FNcpsr_to_r(1) STMFD SP !,{R1,R14} LDR R1,[R9,#6*8] LDR R1,[R1] REM sprite incr LDR R10,[R9,#5*8] REM addr current LDR R11,[R9,#4*8] REM addr next LDR R12,[R9,#3*8] LDR R12,[R12] REM pixel address LDR R8,[R9,#2*8] LDR R8,[R8] REM step LDR R14,[R9] LDR R14,[R14] REM base addr LDR R9,[R9,#8] LDR R9,[R9] REM count ] IF m$="D" OR m$="R" THEN [ OPT Z%(Z) LDR R4,[R10] REM r LDR R5,[R10,#4] REM g LDR R6,[R10,#8] REM b ] ELSE [ OPT Z%(Z) LDR R4,[R10],R8 REM mono value ] ENDIF IF m$<>"D" THEN [ OPT Z%(Z) ADR R7,divtable ] ENDIF [ OPT Z%(Z) .fsloop ] CASE m$ OF WHEN "R" [ OPT Z%(Z) ADD R10,R10,R8 ] PROCsrchdevlist [ OPT Z%(Z) MOV r3,r0 ] WHEN "D" [ OPT Z%(Z) ADD R10,R10,R8 REM +step MOV R3,#0 CMP R4,#F MOVCS R4,#0 MOVGE R4,#F CMP R4,#F>>1 REM >1/2? SUBCS R4,R4,#F ORRCS R3,R3,#1 CMP R5,#F MOVCS R5,#0 MOVGE R5,#F CMP R5,#F>>1 REM >1/2? SUBCS R5,R5,#F ORRCS R3,R3,#2 CMP R6,#F MOVCS R6,#0 MOVGE R6,#F CMP R6,#F>>1 REM >1/2? SUBCS R6,R6,#F ORRCS R3,R3,#4 ] WHEN "T" [ OPT Z%(Z) CMP R4,#F MOVCS R4,#0 MOVGE R4,#F RSB R3,R4,R4,LSL #4 ADD R3,R3,#F>>1 MOV R3,R3,LSR #bits REM final int0-15 LDR R2,[R7,R3,LSL #2] REM divide by 15 from table SUB R4,R4,R2 REM subtract converted value ] OTHERWISE [ OPT Z%(Z) CMP R4,#F MOVCS R4,#0 MOVGE R4,#F RSB R3,R4,R4,LSL #3 ADD R3,R3,#F>>1 MOV R3,R3,LSR #bits REM final int0-7 LDR R2,[R7,R3,LSL #2] REM divide by 7 from table SUB R4,R4,R2 REM subtract converted value ] ENDCASE [ OPT Z%(Z) ADD R2,R14,R12,LSR #1 TST R12,#1 LDRB R0,[R2] ANDEQ R0,R0,#&F0 ORREQ R0,R0,R3 ANDNE R0,R0,#&0F ORRNE R0,R0,R3,LSL #4 STRB R0,[R2] ADD R12,R12,R1 ] IF m$="D" OR m$="R" THEN IF dither% THEN [ OPT Z%(Z) ADD R0,R11,#4 REM nl g%(S%) ADD R2,R4,R4,LSL #1 REM r*3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM r*5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM r/16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM r*7 LDR R4,[R10] REM next r light value ADD R4,R4,R2,ASR #4 REM next value +7/16 of r error -> new r ADD R2,R5,R5,LSL #1 REM g*3 LDR R3,[R0,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R0,-R8] MOV R3,R5,ASR #4 REM g/16 STR R3,[R0,R8] REM not seen so far ADD R2,R5,R5,LSL #2 REM g*5 LDR R3,[R0] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R0],#4 REM computes nl b into the bargain RSB R2,R5,R5,LSL #3 REM g*7 LDR R5,[R10,#4] REM next g light value ADD R5,R5,R2,ASR #4 REM next value +7/16 of g error -> new g ADD R2,R6,R6,LSL #1 REM b*3 LDR R3,[R0,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R0,-R8] ADD R2,R6,R6,LSL #2 REM b*5 LDR R3,[R0] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R0] MOV R3,R6,ASR #4 REM b/16 STR R3,[R0,R8] REM not seen so far RSB R2,R6,R6,LSL #3 REM b*7 LDR R6,[R10,#8] REM next b light value ADD R6,R6,R2,ASR #4 REM next value +7/16 of b error -> new b ] ELSE [ OPT Z%(Z) LDMIA R10,{R4,R5,R6} ] ENDIF ELSE IF dither% THEN [ OPT Z%(Z) ADD R2,R4,R4,LSL #1 REM *3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM *5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM /16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM *7 LDR R4,[R10],R8 REM next light value ADD R4,R4,R2,ASR #4 REM next value +7/16 of error -> new value ] ELSE [ OPT Z%(Z) LDR R4,[R10],R8 ] ENDIF ENDIF [ OPT Z%(Z) SUBS R9,R9,#1 BNE fsloop LDMFD SP !,{R9,R14} FNcpsr_from_r(9) MOV PC,R14 ] WHEN 3 divtable=P% CASE m$ OF WHEN "C" REM nothing WHEN "R" FOR I%=0 TO 3*4 STEP 4 [ OPT Z%(Z) EQUD (palette%!I%>>4 AND &F)/bright%*F EQUD (palette%!I%>>12 AND &F)/bright%*F EQUD (palette%!I%>>20 AND &F)/bright%*F ] NEXT OTHERWISE [ OPT Z%(Z) EQUD 0 EQUD 1/(bright% DIV 4)*F EQUD 2/(bright% DIV 4)*F EQUD F ] ENDCASE [ OPT Z%(Z) .fs% FNcpsr_to_r(1) STMFD SP !,{R1,R14} LDR R1,[R9,#6*8] LDR R1,[R1] REM sprite incr LDR R10,[R9,#5*8] REM addr current LDR R11,[R9,#4*8] REM addr next LDR R12,[R9,#3*8] REM addr pixel address LDR R12,[R12] REM pixel address LDR R8,[R9,#2*8] REM addr step LDR R8,[R8] REM step LDR R14,[R9] LDR R14,[R14] REM base addr LDR R9,[R9,#8] REM addr count LDR R9,[R9] REM count ] IF m$="C" OR m$="R" THEN [ OPT Z%(Z) LDR R4,[R10] REM r LDR R5,[R10,#4] REM g LDR R6,[R10,#8] REM b ] ELSE [ OPT Z%(Z) LDR R4,[R10],R8 REM mono value ] ENDIF [ OPT Z%(Z) .fsloop ] IF m$<>"C" THEN [ OPT Z%(Z) ADR R7,divtable ] ENDIF CASE m$ OF WHEN "C" [ OPT Z%(Z) ADD R10,R10,R8 REM +step CMP R4,#F MOVCS R4,#0 MOVGE R4,#F CMP R5,#F MOVCS R5,#0 MOVGE R5,#F CMP R6,#F MOVCS R6,#0 MOVGE R6,#F MOV R3,#0 REM black octant CMP R4,#F>>1 ORRCS R3,R3,#1 CMP R5,#F>>1 ORRCS R3,R3,#2 CMP R6,#F>>1 ORRCS R3,R3,#4 CMP R3,#6 MOVEQ R3,#1 BEQ octcyan BCS octwhite CMP R3,#4 BEQ octblue MOVCS R3,#2 BCS octmagenta CMP R3,#2 BEQ octgreen BCS octyellow CMP R3,#0 BEQ octblack .octred RSB R0,R4,#F REM 1-r CMP R5,R0 REM g>1-r? BLT octred1 CMP R5,R6 REM yes- g>b? MOVGE R3,#3 REM if g>b then g is largest MOVLT R3,#2 REM else b is B octconvert .octred1 CMP R0,R6 REM no- 1-r>b? MOVGE R3,#0 REM if 1-r>b then 1-r is largest MOVLT R3,#2 REM else b is B octconvert .octgreen RSB R0,R5,#F REM 1-g CMP R0,R4 REM 1-g>r? BLT octgreen1 CMP R0,R6 REM yes- 1-g>b? MOVGE R3,#0 REM if 1-g>b then 1-g is largest MOVLT R3,#1 REM else b is B octconvert .octgreen1 CMP R4,R6 REM no- r>b? MOVGE R3,#3 REM if r>b then r is largest MOVLT R3,#1 REM else b is B octconvert .octblue RSB R0,R6,#F REM 1-b CMP R0,R4 REM 1-b>r? BLT octblue1 CMP R0,R5 REM yes- 1-b>g? MOVGE R3,#0 REM if 1-b>g then 1-b is largest MOVLT R3,#1 REM else g is B octconvert .octblue1 CMP R4,R5 REM no- r>g? MOVGE R3,#2 REM if r>g then r is largest MOVLT R3,#1 REM else g is B octconvert .octwhite CMP R4,R5 REM if r>g BLT octwhite1 CMP R5,R6 REM yes - g>b? MOVGE R3,#3 REM if g>b b is smallest MOVLT R3,#2 REM else g is B octconvert .octwhite1 CMP R4,R6 REM no - r>b? MOVGE R3,#3 REM if r>b b is smallest MOVLT R3,#1 REM else r is .octconvert CMP R3,#1 REM not red=cyan .octcyan SUBEQ R5,R5,#F SUBEQ R6,R6,#F .octmagenta CMP R3,#2 REM not green=magenta SUBEQ R4,R4,#F SUBEQ R6,R6,#F .octyellow CMP R3,#3 REM not blue=yellow SUBEQ R4,R4,#F SUBEQ R5,R5,#F .octblack AND R7,R12,#3 MOV R7,R7,LSL #1 MOV R2,#3 LDRB R0,[R14,R12,LSR #2] BIC R0,R0,R2,LSL R7 ORR R0,R0,R3,LSL R7 STRB R0,[R14,R12,LSR #2] ADD R12,R12,R1 ] WHEN "R" [ OPT Z%(Z) ADD R10,R10,R8 CMP R4,#F MOVCS R4,#0 MOVGE R4,#F CMP R5,#F MOVCS R5,#0 MOVGE R5,#F CMP R6,#F MOVCS R6,#0 MOVGE R6,#F STMFD SP !,{R8,R9,R10,R14} MVN R2,#0 MOV R3,#3 .srch ADD R14,R3,R3,LSL #1 ADD R14,R7,R14,LSL #2 LDMIA R14,{R8,R9,R10} SUBS R8,R4,R8 RSBMI R8,R8,#0 SUBS R9,R5,R9 RSBMI R9,R9,#0 SUBS R10,R6,R10 RSBMI R10,R10,#0 MOV R14,R8,LSR #bits/2 MUL R8,R14,R14 MOV R14,R9,LSR #bits/2 MUL R9,R14,R14 MOV R14,R10,LSR #bits/2 MUL R10,R14,R14 ADD R9,R9,R9,LSL #2 ADD R8,R8,R8,LSL #1 ADD R14,R8,R9,LSL #1 ADD R14,R14,R10 CMP R14,R2 MOVCC R2,R14 MOVCC R0,R3 SUBS R3,R3,#1 BPL srch LDMFD SP !,{R8,R9,R10,R14} ADD R3,R0,R0,LSL #1 ADD R3,R7,R3,LSL #2 LDR R2,[R3],#4 SUB R4,R4,R2 LDMIA R3,{R2,R3} SUB R5,R5,R2 SUB R6,R6,R3 MOV R3,R0 MOV R2,#3 AND R7,R12,#3 MOV R7,R7,LSL #1 LDRB R0,[R14,R12,LSR #2] BIC R0,R0,R2,LSL R7 ORR R0,R0,R3,LSL R7 STRB R0,[R14,R12,LSR #2] ADD R12,R12,R1 ] OTHERWISE [ OPT Z%(Z) CMP R4,#F MOVCS R4,#0 MOVGE R4,#F RSB R3,R4,R4,LSL #2 ADD R3,R3,#F>>1 MOV R3,R3,LSR#bits REM final int0-3 LDR R2,[R7,R3,LSL #2] REM divide by 3 from table SUB R4,R4,R2 REM subtract converted value ADD R2,R14,R12,LSR #2 AND R5,R12,#3 MOV R5,R5,LSL #1 MOV R6,#3 LDRB R0,[R2] BIC R0,R0,R6,LSL R5 ORR R0,R0,R3,LSL R5 STRB R0,[R2] ADD R12,R12,R1 ] ENDCASE IF m$="C" OR m$="R" THEN IF dither% THEN [ OPT Z%(Z) ADD R0,R11,#4 REM nl g%(S%) ADD R2,R4,R4,LSL #1 REM r*3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM r*5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM r/16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM r*7 LDR R4,[R10] REM next r light value ADD R4,R4,R2,ASR #4 REM next value +7/16 of r error -> new r ADD R2,R5,R5,LSL #1 REM g*3 LDR R3,[R0,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R0,-R8] MOV R3,R5,ASR #4 REM g/16 STR R3,[R0,R8] REM not seen so far ADD R2,R5,R5,LSL #2 REM g*5 LDR R3,[R0] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R0],#4 REM computes nl b into the bargain RSB R2,R5,R5,LSL #3 REM g*7 LDR R5,[R10,#4] REM next g light value ADD R5,R5,R2,ASR #4 REM next value +7/16 of g error -> new g ADD R2,R6,R6,LSL #1 REM b*3 LDR R3,[R0,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R0,-R8] ADD R2,R6,R6,LSL #2 REM b*5 LDR R3,[R0] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R0] MOV R3,R6,ASR #4 REM b/16 STR R3,[R0,R8] REM not seen so far RSB R2,R6,R6,LSL #3 REM b*7 LDR R6,[R10,#8] REM next b light value ADD R6,R6,R2,ASR #4 REM next value +7/16 of b error -> new b ] ELSE [ OPT Z%(Z) LDMIA R10,{R4,R5,R6} ] ENDIF ELSE IF dither% THEN [ OPT Z%(Z) ADD R2,R4,R4,LSL #1 REM *3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM *5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM /16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM *7 LDR R4,[R10],R8 REM next light value ADD R4,R4,R2,ASR #4 REM next value +7/16 of error -> new value ] ELSE [ OPT Z%(Z) LDR R4,[R10],R8 ] ENDIF ENDIF [ OPT Z%(Z) SUBS R9,R9,#1 BNE fsloop LDMFD SP !,{R9,R14} FNcpsr_from_r(9) MOV PC,R14 ] WHEN 1 CASE m$ OF WHEN "C" [ OPT Z%(Z) .divtable EQUD 0 EQUD (1-black%/256*2)/16*F EQUD (2-black%/256*4)/16*F EQUD (3-black%/256*5)/16*F EQUD (4-black%/256*6)/16*F EQUD (5-black%/256*7)/16*F EQUD (6-black%/256*8)/16*F EQUD (7-black%/256*8)/16*F EQUD (8-black%/256*8)/16*F EQUD (9-black%/256*8)/16*F EQUD (10-black%/256*8)/16*F EQUD (11-black%/256*7)/16*F EQUD (12-black%/256*6)/16*F EQUD (13-black%/256*5)/16*F EQUD (14-black%/256*4)/16*F EQUD (15-black%/256*2)/16*F EQUD F .evenrow_gard DCD even_gard .oddrow_gard DCD odd_gard .rowinc DCD 0 .fs% FNcpsr_to_r(1) STMFD SP !,{R1,R14} LDR R1,[R9,#6*8] LDR R1,[R1] REM sprite incr LDR R10,[R9,#5*8] REM addr current LDR R11,[R9,#4*8] REM addr next LDR R12,[R9,#3*8] REM addr pixel address LDR R12,[R12] REM pixel address LDR R8,[R9,#2*8] REM addr step LDR R8,[R8] REM step LDR R14,[R9] LDR R14,[R14] REM base addr LDR R9,[R9,#8] REM addr count LDR R9,[R9] REM count LDR R4,[R10],R8 REM mono value STMFD R13!,{R14} TEQ R8,#0 LDRPL R6,evenrow_gard LDRMI R6,oddrow_gard MOV R1,R1,LSL #1 LDR R7,rowinc ADR R14,divtable .fsloop CMP R4,#F MOVCS R4,#0 MOVGE R4,#F ADD R5,R4,#F>>5 REM round up MOVS R5,R5,LSR #bits-4 REM final int 0-16 LDRNE R0,[R14,R5,LSL #2] SUBNE R4,R4,R0 REM subtract converted value ] IF dither% THEN [ OPT Z%(Z) ADD R2,R4,R4,LSL #1 REM *3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM *5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM /16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM *7 LDR R4,[R10],R8 REM next light value ADDS R4,R4,R2,ASR #4 REM next value +7/16 of error -> new value ] ELSE [ OPT Z%(Z) LDR R4,[R10],R8 ] ENDIF [ OPT Z%(Z) CMP R4,#F MOVCS R4,#0 MOVGE R4,#F ADD R3,R4,#F>>5 REM round up MOVS R3,R3,LSR #bits-4 REM final int 0-16 LDRNE R0,[R14,R3,LSL #2] SUBNE R4,R4,R0 REM subtract converted value ORR R5,R5,R3,LSL #5 LDR R3,[R6,R5,LSL #2] REM get 4 patterns LDR R2,[R13] ADD R2,R2,R12,LSR #1 STRB R3,[R2],R7 MOV R3,R3,LSR #8 STRB R3,[R2],R7 MOV R3,R3,LSR #8 STRB R3,[R2],R7 MOV R3,R3,LSR #8 STRB R3,[R2] ADD R12,R12,R1 ] IF dither% THEN [ OPT Z%(Z) ADD R2,R4,R4,LSL #1 REM *3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM *5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM /16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM *7 LDR R4,[R10],R8 REM next light value ADD R4,R4,R2,ASR #4 REM next value +7/16 of error -> new value ] ELSE [ OPT Z%(Z) LDR R4,[R10],R8 ] ENDIF [ OPT Z%(Z) SUBS R9,R9,#2 BNE fsloop ADD R13,R13,#4 LDMFD SP !,{R9,R14} FNcpsr_from_r(9) MOV PC,R14 ] WHEN "T" [ OPT Z%(Z) .divtable EQUD 0 EQUD (1-black%/256*2)/9*F EQUD (2-black%/256*4)/9*F EQUD (3-black%/256*5)/9*F EQUD (4-black%/256*6)/9*F EQUD (5-black%/256*6)/9*F EQUD (6-black%/256*5)/9*F EQUD (7-black%/256*4)/9*F EQUD (8-black%/256*2)/9*F EQUD F .evenrow_gard DCD even_gard .oddrow_gard DCD odd_gard .rowinc DCD 0 .fs% FNcpsr_to_r(1) STMFD SP !,{R1,R14} LDR R1,[R9,#6*8] LDR R1,[R1] REM sprite incr LDR R10,[R9,#5*8] REM addr current LDR R11,[R9,#4*8] REM addr next LDR R12,[R9,#3*8] REM addr pixel address LDR R12,[R12] REM pixel address LDR R8,[R9,#2*8] REM addr step LDR R8,[R8] REM step LDR R14,[R9] LDR R14,[R14] REM base addr LDR R9,[R9,#8] REM addr count LDR R9,[R9] REM count LDR R4,[R10],R8 REM mono value STMFD R13!,{R14} TEQ R8,#0 LDRPL R6,evenrow_gard LDRMI R6,oddrow_gard MOV R1,R1,LSL #1 LDR R7,rowinc ADR R14,divtable .fsloop CMP R4,#F MOVCS R4,#0 MOVGE R4,#F ADD R5,R4,#F>>4 REM round up ADD R5,R5,R5,LSL #3 REM *9 MOVS R5,R5,LSR #bits REM final int 0-9 LDRNE R0,[R14,R5,LSL #2] SUBNE R4,R4,R0 REM subtract converted value ] IF dither% THEN [ OPT Z%(Z) ADD R2,R4,R4,LSL #1 REM *3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM *5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM /16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM *7 LDR R4,[R10],R8 REM next light value ADDS R4,R4,R2,ASR #4 REM next value +7/16 of error -> new value ] ELSE [ OPT Z%(Z) LDR R4,[R10],R8 ] ENDIF [ OPT Z%(Z) CMP R4,#F MOVCS R4,#0 MOVGE R4,#F ADD R3,R4,#F>>4 REM round up ADD R3,R3,R3,LSL #3 REM *9 MOVS R3,R3,LSR #bits REM final int 0-9 LDRNE R0,[R14,R3,LSL #2] SUBNE R4,R4,R0 REM subtract converted value ORR R5,R5,R3,LSL #4 LDR R5,[R6,R5,LSL #2] REM get 3 patterns LDR R2,[R13] ADD R2,R2,R12,LSR #1 AND R3,R5,#&3F STRB R3,[R2],R7 MOV R3,R5,LSR #6 AND R3,R3,#&3F STRB R3,[R2],R7 MOV R3,R5,LSR #12 STRB R3,[R2] ADD R12,R12,R1 ] IF dither% THEN [ OPT Z%(Z) ADD R2,R4,R4,LSL #1 REM *3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM *5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM /16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM *7 LDR R4,[R10],R8 REM next light value ADD R4,R4,R2,ASR #4 REM next value +7/16 of error -> new value ] ELSE [ OPT Z%(Z) LDR R4,[R10],R8 ] ENDIF [ OPT Z%(Z) SUBS R9,R9,#2 BNE fsloop ADD R13,R13,#4 LDMFD SP !,{R9,R14} FNcpsr_from_r(9) MOV PC,R14 ] WHEN "D" [ OPT Z%(Z) .divtable EQUD 0 EQUD (1-black%/256*2)/4*F EQUD (2-black%/256*4)/4*F EQUD (3-black%/256*2)/4*F EQUD F .evenrow_gard DCD even_gard .oddrow_gard DCD odd_gard .rowinc DCD 0 .fs% FNcpsr_to_r(1) STMFD SP !,{R1,R14} LDR R1,[R9,#6*8] LDR R1,[R1] REM sprite incr LDR R10,[R9,#5*8] REM addr current LDR R11,[R9,#4*8] REM addr next LDR R12,[R9,#3*8] REM addr pixel address LDR R12,[R12] REM pixel address LDR R8,[R9,#2*8] REM addr step LDR R8,[R8] REM step LDR R14,[R9] LDR R14,[R14] REM base addr LDR R9,[R9,#8] REM addr count LDR R9,[R9] REM count LDR R4,[R10],R8 REM mono value STMFD R13!,{R14} TEQ R8,#0 LDRPL R6,evenrow_gard LDRMI R6,oddrow_gard MOV R1,R1,LSL #1 LDR R7,rowinc ADR R14,divtable .fsloop CMP R4,#F MOVCS R4,#0 MOVGE R4,#F ADD R5,R4,#F>>3 REM round up MOVS R5,R5,LSR #bits-2 REM final int 0-4 LDRNE R0,[R14,R5,LSL #2] SUBNE R4,R4,R0 REM subtract converted value ] IF dither% THEN [ OPT Z%(Z) ADD R2,R4,R4,LSL #1 REM *3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM *5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM /16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM *7 LDR R4,[R10],R8 REM next light value ADDS R4,R4,R2,ASR #4 REM next value +7/16 of error -> new value ] ELSE [ OPT Z%(Z) LDR R4,[R10],R8 ] ENDIF [ OPT Z%(Z) CMP R4,#F MOVCS R4,#0 MOVGE R4,#F ADD R3,R4,#F>>3 REM round up MOVS R3,R3,LSR #bits-2 REM final int 0-4 LDRNE R0,[R14,R3,LSL #2] SUBNE R4,R4,R0 REM subtract converted value ORR R5,R5,R3,LSL #3 LDRB R5,[R6,R5] REM get 2 patterns LDR R2,[R13] ADD R2,R2,R12,LSR #2 TST R12,#2 AND R3,R5,#&F LDRB R0,[R2] ANDEQ R0,R0,#&F0 ORREQ R0,R0,R3 ANDNE R0,R0,#&0F ORRNE R0,R0,R3,LSL #4 STRB R0,[R2],R7 MOV R3,R5,LSR #4 LDRB R0,[R2] ANDEQ R0,R0,#&F0 ORREQ R0,R0,R3 ANDNE R0,R0,#&0F ORRNE R0,R0,R3,LSL #4 STRB R0,[R2] ADD R12,R12,R1 ] IF dither% THEN [ OPT Z%(Z) ADD R2,R4,R4,LSL #1 REM *3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM *5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM /16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM *7 LDR R4,[R10],R8 REM next light value ADD R4,R4,R2,ASR #4 REM next value +7/16 of error -> new value ] ELSE [ OPT Z%(Z) LDR R4,[R10],R8 ] ENDIF [ OPT Z%(Z) SUBS R9,R9,#2 BNE fsloop ADD R13,R13,#4 LDMFD SP !,{R9,R14} FNcpsr_from_r(9) MOV PC,R14 ] OTHERWISE [ OPT Z%(Z) .fs% FNcpsr_to_r(1) STMFD SP !,{R1,R14} LDR R1,[R9,#6*8] LDR R1,[R1] REM sprite incr LDR R10,[R9,#5*8] REM addr current LDR R11,[R9,#4*8] REM addr next LDR R12,[R9,#3*8] REM addr pixel address LDR R12,[R12] REM pixel address LDR R8,[R9,#2*8] REM addr step LDR R8,[R8] REM step LDR R14,[R9] LDR R14,[R14] REM base addr LDR R9,[R9,#8] REM addr count LDR R9,[R9] REM count LDR R4,[R10],R8 REM mono value MOV R7,#1 REM previous value=1 .fsloop CMP R4,#F MOVCS R4,#0 MOVGE R4,#F ] IF black% THEN [ OPT Z%(Z) ADD R2,R14,R12,LSR #3 AND R5,R12,#7 MOV R6,#1 LDRB R0,[R2,#-(x%+7>>3)] REM above pixel in here SUB R3,R4,#F REM error for white CMP R7,#0 ADDNE R4,R4,#black%<<(bits-8) REM correct for black overlapping a white on left ADDEQ R3,R3,#black%<<(bits-8) REM correct for white overlapped by black on left TST R0,R6,LSL R5 ADDNE R4,R4,#black%<<(bits-8) REM correct for black overlapping a white above ADDEQ R3,R3,#black%<<(bits-8) REM correct for white overlapped by black above MOVS R0,R3 RSBMI R0,R3,#0 REM absolute value of white error CMP R4,R0 REM check which has least error MOVCC R3,#0 REM black has least error MOVCS R4,R3 MOVCS R3,#1 REM white has least error MOV R7,R3 REM copy to previous ] ELSE [ OPT Z%(Z) ADD R3,R4,#F>>1 MOV R3,R3,LSR #bits REM final int 0-1 SUB R4,R4,R3,LSL #bits ADD R2,R14,R12,LSR #3 AND R5,R12,#7 MOV R6,#1 ] ENDIF [ OPT Z%(Z) LDRB R0,[R2] BIC R0,R0,R6,LSL R5 ORR R0,R0,R3,LSL R5 STRB R0,[R2] ADD R12,R12,R1 ] IF dither% THEN [ OPT Z%(Z) ADD R2,R4,R4,LSL #1 REM *3 LDR R3,[R11,-R8] ADD R3,R3,R2,ASR #4 REM +3/16 STR R3,[R11,-R8] ADD R2,R4,R4,LSL #2 REM *5 LDR R3,[R11] ADD R3,R3,R2,ASR #4 REM +5/16 STR R3,[R11] MOV R3,R4,ASR #4 REM /16 STR R3,[R11,R8]! REM not seen so far inc nl ptr RSB R2,R4,R4,LSL #3 REM *7 LDR R4,[R10],R8 REM next light value ADD R4,R4,R2,ASR #4 REM next value +7/16 of error -> new value ] ELSE [ OPT Z%(Z) LDR R4,[R10],R8 ] ENDIF [ OPT Z%(Z) SUBS R9,R9,#1 BNE fsloop LDMFD SP !,{R9,R14} FNcpsr_from_r(9) MOV PC,R14 ] ENDCASE ENDCASE [ OPT Z%(Z) .sxloc DCD sx% ] CASE col OF WHEN 0 IF input<=8 THEN [ OPT Z%(Z) .mappix% REM CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),buff% LDR R0,sxloc REM count LDR R1,[R9,#0*8] LDR R1,[R1] REM base of byte array LDR R2,[R9,#3*8] REM base of r array LDR R5,[R9,#4*8] REM base of z array MOV R8,#0 .mappixlp LDRB R6,[R1],#step24 ] ENDIF CASE input OF WHEN 8 IF ham THEN [ OPT Z%(Z) ADR R9,ltable MOVS R7,R6,LSR #4 AND R6,R6,#15 LDREQ R10,[R2,R6,LSL #2] MOVEQ R11,R10 MOVEQ R12,R10 CMP R7,#1 LDREQ R12,[R9,R6,LSL #2] CMP R7,#2 LDREQ R10,[R9,R6,LSL #2] CMP R7,#3 LDREQ R11,[R9,R6,LSL #2] ADD R3,R10,R11 ADD R3,R3,R12 MOV R3,R3,LSR #2 STMIA R5!,{R3} SUBS R0,R0,#1 BNE mappixlp MOV PC,R14 .ltable ] FOR I%=0 TO 15 [ OPT Z%(Z) EQUD I%/15*F ] NEXT ELSE IF hpredict%=2 THEN [ OPT Z%(Z) ADD R6,R6,R8 AND R6,R6,#255 MOV R8,R6 ] ENDIF [ OPT Z%(Z) LDR R7,[R2,R6,LSL #2] STR R7,[R5],#4 SUBS R0,R0,#1 BNE mappixlp MOV PC,R14 ] ENDIF WHEN 4 IF bigendianbits THEN [ OPT Z%(Z) MOV R10,R6,LSR #4 LDR R7,[R2,R10,LSL #2] AND R10,R6,#&F ] ELSE [ OPT Z%(Z) AND R10,R6,#&F LDR R7,[R2,R10,LSL #2] MOV R10,R6,LSR #4 ] ENDIF [ OPT Z%(Z) LDR R8,[R2,R10,LSL #2] STMIA R5!,{R7,R8} SUBS R0,R0,#2 BHI mappixlp MOV PC,R14 ] WHEN 2 IF bigendianbits THEN [ OPT Z%(Z) MOV R10,R6,LSR #6 LDR R7,[R2,R10,LSL #2] AND R10,R6,#&30 LDR R8,[R2,R10,LSR #2] AND R10,R6,#&C LDR R9,[R2,R10] AND R10,R6,#&3 ] ELSE [ OPT Z%(Z) AND R10,R6,#&3 LDR R7,[R2,R10,LSL #2] AND R10,R6,#&C LDR R8,[R2,R10] AND R10,R6,#&30 LDR R9,[R2,R10,LSR #2] MOV R10,R6,LSR #6 ] ENDIF [ OPT Z%(Z) LDR R10,[R2,R10,LSL #2] STMIA R5!,{R7,R8,R9,R10} SUBS R0,R0,#4 BHI mappixlp MOV PC,R14 ] WHEN 1 IF bigendianbits THEN [ OPT Z%(Z) AND R10,R6,#&80 LDR R7,[R2,R10,LSR #5] AND R10,R6,#&40 LDR R8,[R2,R10,LSR #4] AND R10,R6,#&20 LDR R9,[R2,R10,LSR #3] AND R10,R6,#&10 LDR R10,[R2,R10,LSR #2] STMIA R5!,{R7,R8,R9,R10} AND R10,R6,#&8 LDR R7,[R2,R10,LSR #1] AND R10,R6,#&4 LDR R8,[R2,R10] AND R10,R6,#&2 LDR R9,[R2,R10,LSL #1] AND R10,R6,#&1 ] ELSE [ OPT Z%(Z) AND R10,R6,#&1 LDR R7,[R2,R10,LSL #2] AND R10,R6,#&2 LDR R8,[R2,R10,LSL #1] AND R10,R6,#&4 LDR R9,[R2,R10] AND R10,R6,#&8 LDR R10,[R2,R10,LSR #1] STMIA R5!,{R7,R8,R9,R10} AND R10,R6,#&10 LDR R7,[R2,R10,LSR #2] AND R10,R6,#&20 LDR R8,[R2,R10,LSR #3] AND R10,R6,#&40 LDR R9,[R2,R10,LSR #4] MOV R10,R6,LSR #7 ] ENDIF [ OPT Z%(Z) LDR R10,[R2,R10,LSL #2] STMIA R5!,{R7,R8,R9,R10} SUBS R0,R0,#8 BHI mappixlp MOV PC,R14 ] WHEN 16 [ OPT Z%(Z) .mappix% REM CALL mappix%,z%(1,0),rpal%(0),gpal%(0),r%(0),g%(0),b%(0),pbuff%,buff% LDR R0,sxloc REM count LDR R1,[R9] LDR R1,[R1] REM base of byte array LDR R2,[R9,#8] LDR R2,[R2] REM base of second byte array LDR R3,[R9,#4*8] REM base of r array LDR R4,[R9,#3*8] REM base of g array LDR R5,[R9,#2*8] REM base of b array LDR R6,[R9,#5*8] REM base of byte g (buff) map array LDR R7,[R9,#6*8] REM base of byte r (pbuff) map array LDR R8,[R9,#7*8] REM base of z array CMP R1,R2 ADDEQ R2,R2,#1 .mappixlp LDRB R9,[R1],#step24 LDRB R10,[R2],#step24 LDR R9,[R6,R9,LSL #2] LDR R10,[R7,R10,LSL #2] ORR R9,R9,R10 AND R10,R9,#255 LDR R10,[R3,R10,LSL #2] MOV R11,R9,LSR #8 AND R11,R11,#255 LDR R11,[R4,R11,LSL #2] MOV R12,R9,LSR #16 LDR R12,[R5,R12,LSL #2] ADD R10,R10,R11 ADD R10,R10,R12 STMIA R8!,{R10} SUBS R0,R0,#1 BNE mappixlp MOV PC,R14 ] WHEN 24 [ OPT Z%(Z) .mappix% REM CALLmappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% LDR R0,sxloc REM count LDR R1,[R9,#2*8] LDR R1,[R1] REM base of r byte array LDR R2,[R9,#8] LDR R2,[R2] REM base of g byte array LDR R3,[R9] LDR R3,[R3] REM base of b byte array LDR R4,[R9,#5*8] REM base of r array LDR R5,[R9,#4*8] REM base of g array LDR R6,[R9,#3*8] REM base of b array LDR R7,[R9,#6*8] REM base of z array FNcpsr_to_r(11) STMFD SP !,{R11,R14} MOV r11,#0 MOV R12,#0 MOV R14,#0 .mappixlp LDRB R8,[R1],#step24 LDRB R9,[R2],#step24 LDRB R10,[R3],#step24 ] IF hpredict%=2 THEN [ OPT Z%(Z) ADD r8,r8,r11 AND r8,r8,#255 MOV r11,r8 ADD r9,r9,r12 AND r9,r9,#255 MOV r12,r9 ADD r10,r10,r14 AND r10,r10,#255 MOV r14,r10 ] ENDIF [ OPT Z%(Z) LDR R8,[R4,R8,LSL #2] LDR R9,[R5,R9,LSL #2] LDR R10,[R6,R10,LSL #2] ADD R8,R8,R9 ADD R8,R8,R10 STR R8,[R7],#4 SUBS R0,R0,#1 BNE mappixlp LDMFD SP !,{R0,R14} FNcpsr_from_r(0) MOV PC,R14 ] WHEN 48 [ OPT Z%(Z) .mappix% REM CALLmappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% LDR R0,sxloc REM count LDR R1,[R9,#2*8] LDR R1,[R1] REM base of r half word array LDR R2,[R9,#8] LDR R2,[R2] REM base of g half word array LDR R3,[R9] LDR R3,[R3] REM base of b half word array LDR R4,[R9,#5*8] REM base of r array LDR R5,[R9,#4*8] REM base of g array LDR R6,[R9,#3*8] REM base of b array LDR R7,[R9,#6*8] REM base of z array FNcpsr_to_r(11) STMFD SP !,{R11,R14} MOV r11,#colourindex AND 255 ADD r11,r11,#colourindex AND &ff00 .mappixlp LDRB R14,[R1,#1] LDRB R8,[R1],#step24 ORR R8,R8,R14,LSL #8 AND R8,R8,R11 LDRB R14,[R2,#1] LDRB R9,[R2],#step24 ORR R9,R9,R14,LSL #8 AND R9,R9,R11 LDRB R14,[R3,#1] LDRB R10,[R3],#step24 ORR R10,R10,R14,LSL #8 AND R10,R10,R11 LDR R8,[R4,R8,LSL #2] LDR R9,[R5,R9,LSL #2] LDR R10,[R6,R10,LSL #2] ADD R8,R8,R9 ADD R8,R8,R10 STR R8,[R7],#4 SUBS R0,R0,#1 BNE mappixlp LDMFD SP !,{R0,R14} FNcpsr_from_r(0) MOV PC,R14 ] WHEN 411 [ OPT Z%(Z) .mappix% REM CALLmappix%,z%(1,0),rpal%(0),r%(0),gpal%(0),g%(0),bpal%(0),b%(0),table%(0),buff% LDR R0,sxloc REM count LDR R1,[R9] LDR R1,[R1] REM base of 411 byte array LDR R4,[R9,#1*8] REM base of table array LDR R7,[R9,#8*8] REM base of z array .mappixlp LDRB R8,[R1],#2 REM get Y value LDR R8,[R4,R8,LSL #2] CMP R8,#F MOVCS R8,#F STR R8,[R7],#4 SUBS R0,R0,#1 BNE mappixlp MOV PC,R14 ] WHEN 422 [ OPT Z%(Z) .mappix% REM CALLmappix%,z%(1,0),rpal%(0),r%(0),gpal%(0),g%(0),bpal%(0),b%(0),table%(0),buff% LDR R0,sxloc REM count LDR R1,[R9] LDR R1,[R1] REM base of 422 byte array ADD R1,R1,#1 REM Y samples here! LDR R4,[R9,#1*8] REM base of table array LDR R7,[R9,#8*8] REM base of z array .mappixlp LDRB R8,[R1],#2 REM get Y value LDR R8,[R4,R8,LSL #2] CMP R8,#F MOVCS R8,#F STR R8,[R7],#4 SUBS R0,R0,#1 BNE mappixlp MOV PC,R14 ] WHEN 555 [ OPT Z%(Z) .mappix% REM CALLmappix%,z%(1,0),rpal%(0),r%(0),gpal%(0),g%(0),bpal%(0),b%(0),table%(0),buff% LDR R0,sxloc REM count LDR R1,[R9] LDR R1,[R1] REM base of 555 byte array ADD R1,R1,#1 REM Y samples here! LDR R4,[R9,#1*8] REM base of table array LDR R7,[R9,#8*8] REM base of z array .mappixlp LDRB R8,[R1],#2 REM get Y value AND R8,R8,#ymax% LDR R8,[R4,R8,LSL #2] CMP R8,#F MOVCS R8,#F STR R8,[R7],#4 SUBS R0,R0,#1 BNE mappixlp MOV PC,R14 ] ENDCASE IF xmul%=2 AND xdiv%=1 THEN [ OPT Z%(Z) REM change size in x CALLxsample%,xmul%,xdiv%,z%(1,0),xp%(1,0),x% .xsample% LDR R0,[R9] LDR R0,[R0] REM x% LDR R1,[R9,#8] REM xp (in) LDR R2,[R9,#2*8] REM z SUBS R0,R0,#2 BEQ xdonediv BMI xdonediv .xsamplelp LDMIA R1,{R5,R6} ADD R6,R6,R5 MOV R6,R6,LSR #1 STMIA R2!,{R5,R6} ADD R1,R1,#4 SUBS R0,R0,#2 BGT xsamplelp .xdonediv LDMIA R1,{R5} MOV R6,R5 STMIA R2!,{R5,R6} MOV PC,R14 ] ELSE [ OPT Z%(Z) REM change size in x CALLxsample%,xmul%,xdiv%,z%(1,0),xp%(1,0),x% .xsample% LDR R0,[R9] LDR R0,[R0] REM x% LDR R1,[R9,#8] REM xp (in) LDR R2,[R9,#2*8] REM z LDR R3,[R9,#3*8] LDR R3,[R3] REM xdiv% LDR R4,[R9,#4*8] LDR R4,[R4] REM xmul% MOV R11,R4 .xsamplelp LDMIA R1,{R5} SUBS R11,R11,#1 MOVEQ R11,R4 ADDEQ R1,R1,#4 SUBS R12,R3,#1 REM (in range 1..) BEQ xdonediv .xdivlp CMP R12,R11 BCC xdivlp2 LDMIA R1!,{R8} MLA R5,R8,R11,R5 SUBS R12,R12,R11 MOV R11,R4 BNE xdivlp B xdonediv .xdivlp2 LDMIA R1,{R8} SUBS R11,R11,#1 MOVEQ R11,R4 ADDEQ R1,R1,#4 ADD R5,R5,R8 SUBS R12,R12,#1 BNE xdivlp .xdonediv STMIA R2!,{R5} SUBS R0,R0,#1 BPL xsamplelp MOV PC,R14 ] ENDIF WHEN 2 REM when col=2 IF input<=8 THEN [ OPT Z%(Z) .mappix% REM CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),buff% LDR R0,sxloc REM count LDR R1,[R9] LDR R1,[R1] REM base of byte array LDR R2,[R9,#3*8] REM base of r array LDR R3,[R9,#2*8] REM base of g array LDR R4,[R9,#8] REM base of b array LDR R5,[R9,#4*8] REM base of z array MOV R10,#0 .mappixlp LDRB R6,[R1],#step24 ] ENDIF CASE input OF WHEN 8 IF ham THEN [ OPT Z%(Z) ADR R9,ltable MOVS R7,R6,LSR #4 AND R6,R6,#15 LDREQ R10,[R2,R6,LSL #2] LDREQ R11,[R3,R6,LSL #2] LDREQ R12,[R4,R6,LSL #2] CMP R7,#1 LDREQ R12,[R9,R6,LSL #2] CMP R7,#2 LDREQ R10,[R9,R6,LSL #2] CMP R7,#3 LDREQ R11,[R9,R6,LSL #2] STMIA R5!,{R10,R11,R12} SUBS R0,R0,#1 BNE mappixlp MOV PC,R14 .ltable ] FOR I%=0 TO 15 [ OPT Z%(Z) EQUD I%/15*F ] NEXT ELSE IF hpredict%=2 THEN [ OPT Z%(Z) ADD R6,R6,R10 AND R6,R6,#255 MOV R10,R6 ] ENDIF [ OPT Z%(Z) LDR R7,[R2,R6,LSL #2] LDR R8,[R3,R6,LSL #2] LDR R9,[R4,R6,LSL #2] STMIA R5!,{R7,R8,R9} SUBS R0,R0,#1 BNE mappixlp MOV PC,R14 ] ENDIF WHEN 4 IF bigendianbits THEN [ OPT Z%(Z) MOV R10,R6,LSR #4 LDR R7,[R2,R10,LSL #2] LDR R8,[R3,R10,LSL #2] LDR R9,[R4,R10,LSL #2] STMIA R5!,{R7,R8,R9} AND R10,R6,#&F ] ELSE [ OPT Z%(Z) AND R10,R6,#&F LDR R7,[R2,R10,LSL #2] LDR R8,[R3,R10,LSL #2] LDR R9,[R4,R10,LSL #2] STMIA R5!,{R7,R8,R9} MOV R10,R6,LSR #4 ] ENDIF [ OPT Z%(Z) LDR R7,[R2,R10,LSL #2] LDR R8,[R3,R10,LSL #2] LDR R9,[R4,R10,LSL #2] STMIA R5!,{R7,R8,R9} SUBS R0,R0,#2 BHI mappixlp MOV PC,R14 ] WHEN 2 IF bigendianbits THEN [ OPT Z%(Z) MOV R10,R6,LSR #6 LDR R7,[R2,R10,LSL #2] LDR R8,[R3,R10,LSL #2] LDR R9,[R4,R10,LSL #2] STMIA R5!,{R7,R8,R9} AND R10,R6,#&30 LDR R7,[R2,R10,LSR #2] LDR R8,[R3,R10,LSR #2] LDR R9,[R4,R10,LSR #2] STMIA R5!,{R7,R8,R9} AND R10,R6,#&C LDR R7,[R2,R10] LDR R8,[R3,R10] LDR R9,[R4,R10] STMIA R5!,{R7,R8,R9} AND R10,R6,#&3 ] ELSE [ OPT Z%(Z) AND R10,R6,#&3 LDR R7,[R2,R10,LSL #2] LDR R8,[R3,R10,LSL #2] LDR R9,[R4,R10,LSL #2] STMIA R5!,{R7,R8,R9} AND R10,R6,#&C LDR R7,[R2,R10] LDR R8,[R3,R10] LDR R9,[R4,R10] STMIA R5!,{R7,R8,R9} AND R10,R6,#&30 LDR R7,[R2,R10,LSR #2] LDR R8,[R3,R10,LSR #2] LDR R9,[R4,R10,LSR #2] STMIA R5!,{R7,R8,R9} MOV R10,R6,LSR #6 ] ENDIF [ OPT Z%(Z) LDR R7,[R2,R10,LSL #2] LDR R8,[R3,R10,LSL #2] LDR R9,[R4,R10,LSL #2] STMIA R5!,{R7,R8,R9} SUBS R0,R0,#4 BHI mappixlp MOV PC,R14 ] WHEN 1 IF bigendianbits THEN [ OPT Z%(Z) AND R10,R6,#&80 LDR R7,[R2,R10,LSR #5] LDR R8,[R3,R10,LSR #5] LDR R9,[R4,R10,LSR #5] STMIA R5!,{R7,R8,R9} AND R10,R6,#&40 LDR R7,[R2,R10,LSR #4] LDR R8,[R3,R10,LSR #4] LDR R9,[R4,R10,LSR #4] STMIA R5!,{R7,R8,R9} AND R10,R6,#&20 LDR R7,[R2,R10,LSR #3] LDR R8,[R3,R10,LSR #3] LDR R9,[R4,R10,LSR #3] STMIA R5!,{R7,R8,R9} AND R10,R6,#&10 LDR R7,[R2,R10,LSR #2] LDR R8,[R3,R10,LSR #2] LDR R9,[R4,R10,LSR #2] STMIA R5!,{R7,R8,R9} AND R10,R6,#&8 LDR R7,[R2,R10,LSR #1] LDR R8,[R3,R10,LSR #1] LDR R9,[R4,R10,LSR #1] STMIA R5!,{R7,R8,R9} AND R10,R6,#&4 LDR R7,[R2,R10] LDR R8,[R3,R10] LDR R9,[R4,R10] STMIA R5!,{R7,R8,R9} AND R10,R6,#&2 LDR R7,[R2,R10,LSL #1] LDR R8,[R3,R10,LSL #1] LDR R9,[R4,R10,LSL #1] STMIA R5!,{R7,R8,R9} AND R10,R6,#&1 ] ELSE [ OPT Z%(Z) AND R10,R6,#&1 LDR R7,[R2,R10,LSL #2] LDR R8,[R3,R10,LSL #2] LDR R9,[R4,R10,LSL #2] STMIA R5!,{R7,R8,R9} AND R10,R6,#&2 LDR R7,[R2,R10,LSL #1] LDR R8,[R3,R10,LSL #1] LDR R9,[R4,R10,LSL #1] STMIA R5!,{R7,R8,R9} AND R10,R6,#&4 LDR R7,[R2,R10] LDR R8,[R3,R10] LDR R9,[R4,R10] STMIA R5!,{R7,R8,R9} AND R10,R6,#&8 LDR R7,[R2,R10,LSR #1] LDR R8,[R3,R10,LSR #1] LDR R9,[R4,R10,LSR #1] STMIA R5!,{R7,R8,R9} AND R10,R6,#&10 LDR R7,[R2,R10,LSR #2] LDR R8,[R3,R10,LSR #2] LDR R9,[R4,R10,LSR #2] STMIA R5!,{R7,R8,R9} AND R10,R6,#&20 LDR R7,[R2,R10,LSR #3] LDR R8,[R3,R10,LSR #3] LDR R9,[R4,R10,LSR #3] STMIA R5!,{R7,R8,R9} AND R10,R6,#&40 LDR R7,[R2,R10,LSR #4] LDR R8,[R3,R10,LSR #4] LDR R9,[R4,R10,LSR #4] STMIA R5!,{R7,R8,R9} MOV R10,R6,LSR #7 ] ENDIF [ OPT Z%(Z) LDR R7,[R2,R10,LSL #2] LDR R8,[R3,R10,LSL #2] LDR R9,[R4,R10,LSL #2] STMIA R5!,{R7,R8,R9} SUBS R0,R0,#8 BHI mappixlp MOV PC,R14 ] WHEN 16 [ OPT Z%(Z) .mappix% REM CALL mappix%,z%(1,0),rpal%(0),gpal%(0),r%(0),g%(0),b%(0),pbuff%,buff% LDR R0,sxloc REM count LDR R1,[R9] LDR R1,[R1] REM base of byte array LDR R2,[R9,#8] LDR R2,[R2] REM base of second byte array LDR R3,[R9,#4*8] REM base of r array LDR R4,[R9,#3*8] REM base of g array LDR R5,[R9,#2*8] REM base of b array LDR R6,[R9,#5*8] REM base of byte g (buff) map array LDR R7,[R9,#6*8] REM base of byte r (pbuff) map array LDR R8,[R9,#7*8] REM base of z array CMP R1,R2 ADDEQ R2,R2,#1 .mappixlp LDRB R9,[R1],#step24 LDRB R10,[R2],#step24 LDR R9,[R6,R9,LSL #2] LDR R10,[R7,R10,LSL #2] ORR R9,R9,R10 AND R10,R9,#255 LDR R10,[R3,R10,LSL #2] MOV R11,R9,LSR #8 AND R11,R11,#255 LDR R11,[R4,R11,LSL #2] MOV R12,R9,LSR #16 LDR R12,[R5,R12,LSL #2] STMIA R8!,{R10,R11,R12} SUBS R0,R0,#1 BNE mappixlp MOV PC,R14 ] WHEN 24 [ OPT Z%(Z) .mappix% REM CALLmappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% LDR R0,sxloc REM count LDR R1,[R9,#2*8] LDR R1,[R1] REM base of r byte array LDR R2,[R9,#8] LDR R2,[R2] REM base of g byte array LDR R3,[R9] LDR R3,[R3] REM base of b byte array LDR R4,[R9,#5*8] REM base of r array LDR R5,[R9,#4*8] REM base of g array LDR R6,[R9,#3*8] REM base of b array LDR R7,[R9,#6*8] REM base of z array FNcpsr_to_r(11) STMFD SP !,{R11,R14} MOV r11,#0 MOV R12,#0 MOV R14,#0 .mappixlp LDRB R8,[R1],#step24 LDRB R9,[R2],#step24 LDRB R10,[R3],#step24 ] IF hpredict%=2 THEN [ OPT Z%(Z) ADD r8,r8,r11 AND r8,r8,#255 MOV r11,r8 ADD r9,r9,r12 AND r9,r9,#255 MOV r12,r9 ADD r10,r10,r14 AND r10,r10,#255 MOV r14,r10 ] ENDIF [ OPT Z%(Z) LDR R8,[R4,R8,LSL #2] LDR R9,[R5,R9,LSL #2] LDR R10,[R6,R10,LSL #2] STMIA R7!,{R8,R9,R10} SUBS R0,R0,#1 BNE mappixlp LDMFD SP !,{R0,R14} FNcpsr_from_r(0) MOV PC,R14 ] WHEN 48 [ OPT Z%(Z) .mappix% REM CALLmappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% LDR R0,sxloc REM count LDR R1,[R9,#2*8] LDR R1,[R1] REM base of r half word array LDR R2,[R9,#8] LDR R2,[R2] REM base of g half word array LDR R3,[R9] LDR R3,[R3] REM base of b half word array LDR R4,[R9,#5*8] REM base of r array LDR R5,[R9,#4*8] REM base of g array LDR R6,[R9,#3*8] REM base of b array LDR R7,[R9,#6*8] REM base of z array FNcpsr_to_r(11) STMFD SP !,{R11,R14} MOV r11,#colourindex AND 255 ADD r11,r11,#colourindex AND &ff00 .mappixlp LDRB R14,[R1,#1] LDRB R8,[R1],#step24 ORR R8,R8,R14,LSL #8 AND R8,R8,R11 LDRB R14,[R2,#1] LDRB R9,[R2],#step24 ORR R9,R9,R14,LSL #8 AND R9,R9,R11 LDRB R14,[R3,#1] LDRB R10,[R3],#step24 ORR R10,R10,R14,LSL #8 AND R10,R10,R11 LDR R8,[R4,R8,LSL #2] LDR R9,[R5,R9,LSL #2] LDR R10,[R6,R10,LSL #2] STMIA R7!,{R8,R9,R10} SUBS R0,R0,#1 BNE mappixlp LDMFD SP !,{R0,R14} FNcpsr_from_r(0) MOV PC,R14 ] WHEN 411 REM B=table(Y)+b(U) R=table(Y)+r(V) G=table(Y)+g(V)+gpal(U) [ OPT Z%(Z) .mappix% REM CALLmappix%,z%(1,0),rpal%(0),r%(0),gpal%(0),g%(0),bpal%(0),b%(0),table%(0),buff% LDR R0,sxloc REM count LDR R1,[R9] LDR R1,[R1] REM base of 411 byte array LDR R2,[R9,#1*8] REM base of table array LDR R3,[R9,#2*8] REM base of b array LDR R5,[R9,#4*8] REM base of g array LDR R6,[R9,#5*8] REM base of gpal array LDR R7,[R9,#6*8] REM base of r array LDR R9,[R9,#8*8] REM base of z array FNcpsr_to_r(8) STMFD SP !,{R8,R14} .mappixlp LDMIA R1!,{R4,R10} REM get 411 values AND R8,R4,#&C000 MOV R8,R8,LSR #8 AND R14,R4,#&C0000000 ORR R8,R8,R14,LSR #16+8+2 AND R14,R10,#&C000 ORR R8,R8,R14,LSR #8+4 ORR R8,R8,R10,LSR #16+8+6 REM (=30) U AND R11,R4,#&3000 MOV R11,R11,LSR #6 AND R14,R4,#&30000000 ORR R11,R11,R14,LSR #16+6+2 AND R14,R10,#&3000 ORR R11,R11,R14,LSR #6+4 AND R14,R10,#&30000000 ORR R11,R11,R14,LSR #16+6+6 REM V AND R12,R4,#&FF REM Y1 LDR R12,[R2,R12,LSL #2] REM t(Y) LDR R14,[R7,R11,LSL #2] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 LDR R14,[R6,R8,LSL #2] ADD R14,R14,R12 LDR R12,[R5,R11,LSL #2] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R12,R4,#&FF REM Y1 LDR R12,[R2,R12,LSL #2] REM t(Y) LDR R14,[R3,R8,LSL #2] ADDS R14,R12,R14 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 MOV R4,R4,LSR #16 AND R12,R4,#&FF REM Y2 LDR R12,[R2,R12,LSL #2] REM t(Y) LDR R14,[R7,R11,LSL #2] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 LDR R14,[R6,R8,LSL #2] ADD R14,R14,R12 LDR R12,[R5,R11,LSL #2] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R12,R4,#&FF REM Y2 LDR R12,[R2,R12,LSL #2] REM t(Y) LDR R14,[R3,R8,LSL #2] ADDS R14,R12,R14 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R12,R10,#&FF REM Y3 LDR R12,[R2,R12,LSL #2] REM t(Y) LDR R14,[R7,R11,LSL #2] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 LDR R14,[R6,R8,LSL #2] ADD R14,R14,R12 LDR R12,[R5,R11,LSL #2] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R12,R10,#&FF REM Y3 LDR R12,[R2,R12,LSL #2] REM t(Y) LDR R14,[R3,R8,LSL #2] ADDS R14,R12,R14 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 MOV R10,R10,LSR #16 AND R12,R10,#&FF REM Y4 LDR R12,[R2,R12,LSL #2] REM t(Y) LDR R14,[R7,R11,LSL #2] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 LDR R14,[R6,R8,LSL #2] ADD R14,R14,R12 LDR R12,[R5,R11,LSL #2] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R12,R10,#&FF REM Y4 LDR R12,[R2,R12,LSL #2] REM t(Y) LDR R14,[R3,R8,LSL #2] ADDS R14,R12,R14 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 SUBS R0,R0,#4 BNE mappixlp LDMFD SP !,{R0,R14} FNcpsr_from_r(0) MOV PC,R14 ] WHEN 423 REM YIQ code "disabled" [ OPT Z%(Z) .mappix% REM CALLmappix%,z%(1,0),rpal%(0),r%(0),gpal%(0),g%(0),bpal%(0),b%(0),table%(0),buff% LDR R0,sxloc REM count LDR R1,[R9] LDR R1,[R1] REM base of 422 byte array LDR R2,[R9,#1*8] REM base of table array LDR R3,[R9,#2*8] REM base of b array LDR R4,[R9,#3*8] REM base of bpal array LDR R5,[R9,#4*8] REM base of g array LDR R6,[R9,#5*8] REM base of gpal array LDR R7,[R9,#6*8] REM base of r array LDR R8,[R9,#7*8] REM base of rpal array LDR R9,[R9,#8*8] REM base of z array FNcpsr_to_r(10) STMFD SP !,{R10,R14} .mappixlp LDR R10,[R1],#4 REM get 422 values AND R11,R10,#&FF00 REM Y1 LDR R11,[R2,R11,LSR #6] AND R12,R10,#&FF LDR R12,[R7,R12,LSL #2] ADD R14,R12,R11 AND R12,R10,#&FF0000 LDR R12,[R8,R12,LSR #14] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R12,R10,#&FF LDR R12,[R5,R12,LSL #2] ADD R14,R12,R11 AND R12,R10,#&FF0000 LDR R12,[R6,R12,LSR #14] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R12,R10,#&FF LDR R12,[R3,R12,LSL #2] ADD R14,R12,R11 AND R12,R10,#&FF0000 LDR R12,[R4,R12,LSR #14] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R11,R10,#&FF000000 REM Y2 LDR R11,[R2,R11,LSR #22] AND R12,R10,#&FF LDR R12,[R7,R12,LSL #2] ADD R14,R12,R11 AND R12,R10,#&FF0000 LDR R12,[R8,R12,LSR #14] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R12,R10,#&FF LDR R12,[R5,R12,LSL #2] ADD R14,R12,R11 AND R12,R10,#&FF0000 LDR R12,[R6,R12,LSR #14] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R12,R10,#&FF LDR R12,[R3,R12,LSL #2] ADD R14,R12,R11 AND R12,R10,#&FF0000 LDR R12,[R4,R12,LSR #14] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 SUBS R0,R0,#2 BNE mappixlp LDMFD SP !,{R0,R14} FNcpsr_from_r(0) MOV PC,R14 ] WHEN 422 REM YUV code "enabled" [ OPT Z%(Z) .mappix% REM CALLmappix%,z%(1,0),rpal%(0),r%(0),gpal%(0),g%(0),bpal%(0),b%(0),table%(0),buff% LDR R0,sxloc REM count LDR R1,[R9] LDR R1,[R1] REM base of 422 byte array LDR R2,[R9,#1*8] REM base of table array LDR R3,[R9,#2*8] REM base of b array LDR R5,[R9,#4*8] REM base of g array LDR R6,[R9,#5*8] REM base of gpal array LDR R7,[R9,#6*8] REM base of r array LDR R9,[R9,#8*8] REM base of z array FNcpsr_to_r(10) STMFD SP !,{R10,R14} .mappixlp LDR R10,[R1],#4 REM get 422 values AND R11,R10,#&FF00 REM Y1 LDR R11,[R2,R11,LSR #6] AND R12,R10,#&FF0000 LDR R12,[R7,R12,LSR #14] ADDS R14,R12,R11 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R12,R10,#&FF LDR R12,[R5,R12,LSL #2] ADD R14,R12,R11 AND R12,R10,#&FF0000 LDR R12,[R6,R12,LSR #14] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R12,R10,#&FF LDR R12,[R3,R12,LSL #2] ADDS R14,R12,R11 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R11,R10,#&FF000000 REM Y2 LDR R11,[R2,R11,LSR #22] AND R12,R10,#&FF0000 LDR R12,[R7,R12,LSR #14] ADDS R14,R12,R11 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R12,R10,#&FF LDR R12,[R5,R12,LSL #2] ADD R14,R12,R11 AND R12,R10,#&FF0000 LDR R12,[R6,R12,LSR #14] ADDS R14,R14,R12 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 AND R12,R10,#&FF LDR R12,[R3,R12,LSL #2] ADDS R14,R12,R11 MOVMI R14,#0 CMP R14,#F MOVCS R14,#F STR R14,[R9],#4 SUBS R0,R0,#2 BNE mappixlp LDMFD SP !,{R0,R14} FNcpsr_from_r(0) MOV PC,R14 ] WHEN 555 REM YUV REM B=table(Y)+b(U) R=table(Y)+r(V) G=table(Y)+g(V)+gpal(U) [ OPT Z%(Z) .mappix% REM CALLmappix%,z%(1,0),rpal%(0),r%(0),gpal%(0),g%(0),bpal%(0),b%(0),table%(0),buff% LDR R0,sxloc REM count LDR R1,[R9] LDR R1,[R1] REM base of 555 byte array LDR R2,[R9,#1*8] REM base of table array LDR R3,[R9,#2*8] REM base of b array LDR R5,[R9,#4*8] REM base of g array LDR R6,[R9,#5*8] REM base of gpal array LDR R7,[R9,#6*8] REM base of r array LDR R9,[R9,#8*8] REM base of z array FNcpsr_to_r(10) STMFD SP !,{R10,R14} .mappixlp LDR R10,[R1],#2 REM get 555 values AND R11,R10,#ymax% REM Y LDR R11,[R2,R11,LSL #2] AND R8,R10,#((1<=maxcode STRCSB R2,[R6],#1 REM *sp++=firstcode MOVCS R0,R3 REM code=oldcode CMP R0,#clearcode% BCC lzwdonepush .lzwpushtable LDR R14,[R12,R0,LSL #2] REM table%(code%,1) STRB R14,[R6],#1 REM *sp++= MOV R0,R14,LSR #16 REM code=table%(code%,0) CMP R0,#clearcode% BCS lzwpushtable .lzwdonepush LDR R2,[R12,R0,LSL #2] BIC R2,R2,#&FF0000 BIC R2,R2,#&FF000000 REM firstcode=table%(code%,1) STRB R2,[R6],#1 REM *sp++=firstcode CMP R7,#4096 BCS lzwnocode ORR R0,R2,R3,LSL #16 STR R0,[R12,R7,LSL #2] REM table%(code%,0)=oldcode;table%(code%,1)=firstcode ADD R7,R7,#1 REM maxcode++ CMP R7,R8 BCC lzwnocode REM if maxcode>=maxcodesize CMP R8,#4096 REM and maxcodesize<4096 ADDCC R5,R5,#1 REM codesize++ MOVCC R8,R8,LSL #1 REM double maxcodesize ] IF flag=1500 THEN [ OPT Z%(Z) ORRCC R8,R8,#1 ] ENDIF [ OPT Z%(Z) .lzwnocode MOV R3,R1 REM oldcode=incode CMP R6,R4 REM until sp>stk BLS lzwengine .lzwunstack LDRB R0,[R6,#-1]! REM *--sp .lzwloopend STRB R0,[R11],#1 SUBS R10,R10,#1 BNE lzwloop STR R2,firstcode STR R3,oldcode STR R5,codesize STR R6,sp STR R7,maxcode STR R8,maxcodesize LDMFD SP !,{R8,R14} FNcpsr_from_r(8) MOV PC,R14 .lzwclear MOV R0,#0 MOV R3,R12 .lzwdefaulttable STR R0,[R3],#4 ADD R0,R0,#1 CMP R0,#clearcode% BCC lzwdefaulttable MOV R5,#setcodes%+1 MOV R7,#clearcode% MOV R8,R7,LSL #1 REM maxcodesize=clearcode*2 ] IF flag=1500 THEN [ OPT Z%(Z) SUB R8,R8,#1 ] ENDIF [ OPT Z%(Z) ADD R7,R7,#2 REM maxcode=clearcode+2 BL getcode MOV R2,R0 REM firstcode MOV R3,R0 REM oldcode MOV R6,R4 REM sp=stk B lzwloopend REM enter with codesize in R5. Result in R0. Kills R1 .curbit DCD 0 .lastbit DCD 0 .buf DCD buf% .getcode STMFD SP !,{R6,R7,R8} ADR R6,curbit LDMIA R6,{R6,R7,R8} ADD R1,R5,R6 REM curbit+codesize CMP R1,R7 BCS needmoredata .simplecode ADD R7,R8,R6,LSR #3 BIC R7,R7,#3 LDMIA R7,{R0,R7} ] IF flag=1500 THEN [ OPT Z%(Z) EOR R1,R0,R0,ROR #16 BIC R1,R1,#&FF0000 MOV R0,R0,ROR #8 EOR R0,R0,R1,LSR #8 EOR R1,R7,R7,ROR #16 BIC R1,R1,#&FF0000 MOV R7,R7,ROR #8 EOR R7,R7,R1,LSR #8 ANDS R1,R6,#31 MOVNE R0,R0,LSL R1 RSBNE R1,R1,#32 ORRNE R0,R0,R7,LSR R1 RSB R1,R5,#32 MOV R0,R0,LSR R1 ] ELSE [ OPT Z%(Z) ANDS R1,R6,#31 MOVNE R0,R0,LSR R1 RSBNE R1,R1,#32 ORRNE R0,R0,R7,LSL R1 MVN R1,#0 BIC R0,R0,R1,LSL R5 ] ENDIF [ OPT Z%(Z) ADD R6,R6,R5 STR R6,curbit LDMFD SP !,{R6,R7,R8} MOV PC,R14 .needmoredata STMFD SP !,{R2,R3,R4,R14} MOV R3,R7,LSR #3 SUB R0,R3,#2 REM lastbyte-2 LDRB R0,[R8,R0] STRB R0,[R8] SUB R0,R3,#1 REM lastbyte-1 LDRB R0,[R8,R0] STRB R0,[R8,#1] LDR R1,[R9,#16] LDR R1,[R1] REM c% ] IF flag=1500 THEN [ OPT Z%(Z) MOV R0,#256 MOV R3,#256 ] ELSE [ OPT Z%(Z) BL bytefromcache% MOVS R3,R0 REM count BEQ simplecode1 ] ENDIF [ OPT Z%(Z) SUB R6,R6,R7 REM curbit-lastbit ADD R6,R6,#16 ADD R0,R0,#2 REM lastbyte=2+count MOV R7,R0,LSL #3 STR R7,lastbit ADD R2,R8,#2 REM buf+2 BL multibytefromcache% .simplecode1 LDMFD SP !,{R2,R3,R4,R14} B simplecode ] ENDIF IF range% THEN [ OPT Z%(Z) REM CALL maxmin%,a%(1,0),totvals% .maxmin% LDR R0,[R9] LDR R0,[R0] REM totvals% LDR R1,[R9,#8] REM a%() LDR R2,min LDR R3,max .maxminlp LDR R4,[R1],#4 CMP R4,R3 MOVCS R3,R4 REM if r4>max max=r4 CMP R4,R2 MOVCC R2,R4 REM if r40 THEN IF sharpen%<>8 sharpmul%=F/(sharpen%-8) ELSE sharpmul%=F/(8-sharpen%) ENDIF [ OPT Z%(Z) REM CALL sharp%,z%(1,0),rm%(1,0),rm1%(1,0),rm2%(1,0),totvals% .sharp% LDR R0,[R9] LDR R0,[R0] REM sx% LDR R1,[R9,#8] REM rm2%() LDR R2,[R9,#16] REM rm1%() LDR R3,[R9,#24] REM rm%() LDR R4,[R9,#32] REM z%() ] CASE sharpen% OF WHEN -8 WHEN 8,9,12,16,24 OTHERWISE [ OPT Z%(Z) MOV R8,#sharpmul% AND &FF ORR R8,R8,#sharpmul% AND &FF00 MOV R9,#(sharpmul% >> 16) AND &FF ORR R9,R9,#(sharpmul% >> 16) AND &FF00 ] ENDCASE [ OPT Z%(Z) .sharplp LDR R5,[R1,#-sharp] LDR R6,[R1,#sharp] ADD R5,R5,R6 LDR R6,[R1],#4 ADD R5,R5,R6 LDR R6,[R3,#-sharp] ADD R5,R5,R6 LDR R6,[R3,#sharp] ADD R5,R5,R6 LDR R6,[R3],#4 ADD R5,R5,R6 LDR R6,[R2,#-sharp] ADD R5,R5,R6 LDR R6,[R2,#sharp] ADD R5,R5,R6 REM unsigned total to add/subtract LDR R6,[R2],#4 REM centre MOV R6,R6,LSR #1 MOV R7,#ABS sharpen% MUL R7,R6,R7 REM avoid duplicate register while keeping Rs small ] IF sharpen%>0 THEN [ OPT Z%(Z) SUBS R5,R7,R5,LSR #1 MOVCC R5,#0 REM underflow to 0 now! ] ELSE [ OPT Z%(Z) ADD R5,R7,R5,LSR #1 ] ENDIF CASE sharpen% OF WHEN 8,9 [ OPT Z%(Z) MOV R6,R5,LSL #1 ] WHEN 10 [ OPT Z%(Z) MOV R6,R5 ] WHEN 12 [ OPT Z%(Z) MOV R6,R5,LSR #1 ] WHEN 16 [ OPT Z%(Z) MOV R6,R5,LSR #2 ] WHEN -8,24 [ OPT Z%(Z) MOV R6,R5,LSR #3 ] OTHERWISE [ OPT Z%(Z) MOV R6,R5,LSR #16 EOR R5,R5,R6,LSL #16 MUL R7,R8,R5 MUL R5,R9,R5 MUL R10,R6,R8 MUL R6,R9,R6 ADDS R10,R5,R10 ADDCS R6,R6,#&10000 ADDS R7,R7,R10,LSL #16 ADC R6,R6,R10,LSR #16 MOV R6,R6,LSL #(32-27) ORRS R6,R6,R7,LSR #27 ADDCS R6,R6,#1 REM carry is shifted out bit ] ENDCASE IF sharpen%>0 THEN [ OPT Z%(Z) CMP R6,#F MOVCS R6,#F ] ENDIF [ OPT Z%(Z) STR R6,[R4],#4 SUBS R0,R0,#1 BNE sharplp MOV PC,R14 ] ENDIF IF hist% OR equal% THEN [ OPT Z%(Z) REM CALLhisto%,z%(1,0),vals%(0,0),sx% .histo% LDR R0,[R9] LDR R0,[R0] REM sx% LDR R1,[R9,#8] REM vals%() LDR R2,[R9,#16] .histlp LDR R3,[R2],#4 CMP R3,#F MOVCS R3,#F MOV R3,R3,LSR #bits-8 ] IF col=2 THEN [ OPT Z%(Z) ADD R3,R3,R3,LSL #1 LDR R4,[R1,R3,LSL #2] ADD R4,R4,#1 STR R4,[R1,R3,LSL #2] LDR R3,[R2],#4 CMP R3,#F MOVCS R3,#F MOV R3,R3,LSR #bits-8 ADD R3,R3,R3,LSL #1 ADD R3,R3,#1 LDR R4,[R1,R3,LSL #2] ADD R4,R4,#1 STR R4,[R1,R3,LSL #2] LDR R3,[R2],#4 CMP R3,#F MOVCS R3,#F MOV R3,R3,LSR #bits-8 ADD R3,R3,R3,LSL #1 ADD R3,R3,#2 ] ENDIF [ OPT Z%(Z) LDR R4,[R1,R3,LSL #2] ADD R4,R4,#1 STR R4,[R1,R3,LSL #2] SUBS R0,R0,#1 BNE histlp MOV PC,R14 ] ENDIF IF equal% THEN [ OPT Z%(Z) REM CALLhistequal%,z%(1,0),new%(0),sx% .histequal% LDR R0,[R9] LDR R0,[R0] REM sx% LDR R1,[R9,#8] REM new%() LDR R2,[R9,#16] REM z%() .equallp LDR R3,[R2] CMP R3,#F MOVCS R3,#F MOV R3,R3,LSR #bits-8 ] IF col=2 THEN [ OPT Z%(Z) LDR R3,[R2] CMP R3,#F MOVCS R3,#F MOV R3,R3,LSR #bits-8 ADD R3,R3,R3,LSL #1 LDR R4,[R1,R3,LSL #2] STR R4,[R2],#4 LDR R3,[R2] CMP R3,#F MOVCS R3,#F MOV R3,R3,LSR #bits-8 ADD R3,R3,R3,LSL #1 ADD R3,R3,#1 LDR R4,[R1,R3,LSL #2] STR R4,[R2],#4 LDR R3,[R2] CMP R3,#F MOVCS R3,#F MOV R3,R3,LSR #bits-8 ADD R3,R3,R3,LSL #1 ADD R3,R3,#2 ] ENDIF [ OPT Z%(Z) LDR R4,[R1,R3,LSL #2] STR R4,[R2],#4 SUBS R0,R0,#1 BNE equallp MOV PC,R14 ] ENDIF CASE r$ OF WHEN "FN800","FN801","FN1000","FN1001" [ OPT Z%(Z) REM CALL rlexpand%,limit%,decr%,colour%,address% REM IFdecr%>1 REPEAT?address%++=colour%;decr%--;UNTILdecr%<1 OR address%=limit% .rlexpand% LDR R0,[R9] REM adr of address% LDR R1,[R0] REM address% LDR R2,[R9,#8] LDR R2,[R2] REM colour% LDR R3,[R9,#16] REM adr of decr% LDR R4,[R3] REM decr% CMP R4,#1 MOVLTS PC,R14 LDR R5,[R9,#24] LDR R5,[R5] REM limit% .rle STRB R2,[R1],#1 SUB R4,R4,#1 CMP R1,R5 TEQNE R4,#0 BNE rle .rlexit STR R1,[R0] REM update address% STR R4,[R3] REM update decr% MOV PC,R14 ] WHEN "FN902" [ OPT Z%(Z) .unpack% LDR R0,[R9] REM adr of buff% LDR R0,[R0] REM buff% LDR R1,plbuff ADD R2,R0,#768 .unpackloop LDR R3,[R0],#4 MOV R5,#0 .bitloop MOV R6,R3,LSR R5 AND R6,R6,#15 ADD R5,R5,#4 MOV R7,R3,LSR R5 AND R7,R7,#15 ADD R5,R5,#4 STRB R7,[R1],#1 STRB R6,[R1],#1 CMP R5,#32 BNE bitloop CMP R2,R0 BNE unpackloop MOV PC,R14 .plbuff EQUD plbuff% ] WHEN "FN1601","FN1501","FN1850","FN1851" [ OPT Z%(Z) REM CALL readiff%,limit%,address% .readiff% MOV R1,#c% LDR R8,[R9] LDR R8,[R8] REM address% LDR R7,[R9,#8] LDR R7,[R7] ADD R7,R7,R8 REM limit% FNcpsr_to_r(0) STMFD SP !,{R0,R14} ] IF r$="FN1850" OR r$="FN1851" THEN [ OPT Z%(Z) BL bytefromcache% ] IF sy%>250 THEN [ OPT Z%(Z) BL bytefromcache% ] ENDIF ENDIF [ OPT Z%(Z) .rle BL bytefromcache% CMP R0,#128 BCC rle1 RSB R2,R0,#256 BL bytefromcache% .rle0 STRB R0,[R8],#1 SUBS R2,R2,#1 BPL rle0 B rle2 .rle1 ADD R3,R0,#1 MOV R2,R8 ADD R8,R8,R3 BL multibytefromcache% .rle2 CMP R8,R7 BCC rle LDMFD SP !,{R2,R14} FNcpsr_from_r(2) MOV PC,R14 ] WHEN "FN1900","FN1100","FN400" [ OPT Z%(Z) REM CALL readline%,limitbytes%,repeat%,colour%,address% .readline% LDR R2,[R9] LDR R2,[R2] REM address% LDR R3,[R9,#8] REM adr of colour% LDR R0,[R3] LDR R4,[R9,#16] REM adr of repeat% FNcpsr_to_r(5) STMFD SP !,{R5,R14} LDR R5,[R4] LDR R6,[R9,#24] LDR R6,[R6] ADD R6,R6,R2 REM limit% .rle CMP R5,#1 BGE rle1 BL bytefromcache% MOV R5,#1 ] IF flag=1900 THEN [ OPT Z%(Z) CMP R0,#192 ANDCS R5,R0,#63 BLCS bytefromcache% ] ENDIF IF flag=1100 THEN [ OPT Z%(Z) CMP R0,#128 BNE rle1 BL bytefromcache% TEQ R0,#0 MOVEQ R0,#128 BEQ rle1 ADD R5,R0,#1 BL bytefromcache% ] ENDIF IF flag=400 THEN [ OPT Z%(Z) MOV R1,R0 REM red BL bytefromcache% REM green ORR R1,R1,R0,LSL #8 BL bytefromcache% REM blue ORR R1,R1,R0,LSL #16 BL bytefromcache% ADD R5,R0,#1 MOV R0,R1 ] ENDIF IF flag=200 THEN [ OPT Z%(Z) ADD R5,R0,#1 BL bytefromcache% ] ENDIF [ OPT Z%(Z) .rle1 STRB R0,[R2],#1 ] IF flag=400 THEN [ OPT Z%(Z) MOV R1,R0,LSR #8 STRB R1,[R2],#1 MOV R1,R0,LSR #16 STRB R1,[R2],#1 ] ENDIF [ OPT Z%(Z) SUB R5,R5,#1 TEQ R2,R6 BNE rle .rlexit STR R0,[R3] STR R5,[R4] LDMFD SP !,{R5,R14} FNcpsr_from_r(5) MOV PC,R14 ] WHEN "FN2401" [ OPT Z%(Z) .bm_rle8 MOV R1,#c% LDR R8,[R9] LDR R8,[R8] FNcpsr_to_r(7) STMFD SP !,{R7,R14} LDR R7,[R9,#8] LDR R7,[R7] ADD R7,R7,R8 .rle BL bytefromcache% REM get code TEQ r0,#0 REM = 0 (copy-run or special-sequence)? BEQ rlecopy REM repeated byte MOV r4,r0 REM preserve repeat count BL bytefromcache% REM else get byte to be repeated .rle1 STRB r0,[r8],#1 SUBS r4,r4,#1 BGT rle1 B rle .rlecopy REM if here, then either a copy-run or a special code sequence BL bytefromcache% REM get extension code CMP r0,#3 REM if >= 3 means a copy run BLT rlespecial MOV r4,r0 REM preserve copy count .rle2 REM 'copy pixels's are always stored as a multiple of two bytes... BL bytefromcache% STRB r0,[r8],#1 BL bytefromcache% SUBS r4,r4,#1 STRGTB r0,[r8],#1 SUBGTS r4,r4,#1 BGT rle2 B rle .rlespecial REM if here; one of the special code sequences.. REM [0 0] = end of row REM [0 1] = end of bitmap ==> should never see this one REM (ChangeFSI will stop before we strike it) REM [0 2 x y] = continue from position x to the right and y down REM ==> probably rare (used only for animations??) REM TEQ r0,#0 REM is it end-of-row? REM LDMEQFD SP !,{R14} REM MOVEQS PC,R14 REM others not implemented... LDMFD SP !,{R4,R14} FNcpsr_from_r(4) MOV PC,R14 ] WHEN "FN2402" [ OPT Z%(Z) .bm_rle4 MOV R1,#c% LDR R8,[R9] LDR R8,[R8] FNcpsr_to_r(7) STMFD SP !,{R7,R14} LDR R7,[R9,#8] LDR R7,[R7] ADD R7,R7,R8 MOV r2,#0 REM bit buffer MOV r3,#0 REM bit pointer .rle BL bytefromcache% REM get code TEQ r0,#0 REM = 0 (copy-run or special-sequence)? BEQ rlecopy REM repeated byte MOV r4,r0 REM preserve repeat count BL bytefromcache% REM else get byte to be repeated .rle1 BL bmrle4_insert CMP r3,#8 MOVGE r5,r2,LSR#24 STRGEB r5,[r8],#1 MOVGE r2,r2,LSL#8 SUBGE r3,r3,#8 CMP r4,#0 BGT rle1 B rle .rlecopy REM if here, then either a copy-run or a special code sequence BL bytefromcache% REM get extension code CMP r0,#3 REM if >= 3 means a copy run BLT rlespecial MOV r4,r0 REM preserve copy count .rle2 REM 'copy pixels's are always stored as a multiple of two bytes... BL bytefromcache% BL bmrle4_insert BL bytefromcache% CMP r4,#0 BLGT bmrle4_insert B rle4 .rle3 MOV r5,r2,LSR#24 STRB r5,[r8],#1 MOV r2,r2,LSL#8 SUB r3,r3,#8 .rle4 CMP r3,#8 BGE rle3 CMP r4,#0 BGT rle2 B rle .rlespecial REM if here; one of the special code sequences.. REM [0 0] = end of row REM [0 1] = end of bitmap ==> should never see this one REM (ChangeFSI will stop before we strike it) REM [0 2 x y] = continue from position x to the right and y down REM ==> probably rare (used only for animations??) REM TEQ r0,#0 REM is it end-of-row? REM LDMEQFD SP !,{R14} REM MOVEQS PC,R14 CMP r3,#0 MOVGT r5,r2,LSR#24 STRGTB r5,[r8],#1 REM others not implemented... LDMFD SP !,{R5,R14} FNcpsr_from_r(5) MOV PC,R14 .bmrle4_insert RSB r5,r3,#32 MOV r2,r2,LSR r5 MOV r2,r2,LSL r5 SUB r5,r5,#8 ORR r2,r2,r0,LSL r5 SUBS r4,r4,#2 ADDMI r3,r3,#4 ADDPL r3,r3,#8 MOV PC,R14 ] ENDCASE IF cachebytes% THEN [ OPT Z%(Z) .bytefromcache% STMFD SP !,{R1,R2} LDR R1,incacheptr LDR R2,numlefttogo LDRB R0,[R1],#1 SUBS R2,R2,#1 STRNE R1,incacheptr STRNE R2,numlefttogo LDMFD SP !,{R1,R2} MOVNE PC,R14 STMFD SP !,{R0,R1,R2,R3,R4} LDR R2,valdatacache STR R2,incacheptr LDR R3,valcache STR R3,numlefttogo MOV R0,#4 MOV R1,#c% SWI "OS_GBPB" LDMFD SP !,{R0,R1,R2,R3,R4} MOV PC,R14 .valdatacache DCD datacache% .valcache DCD cache% .incacheptr DCD datacache% .numlefttogo DCD cache% .multibytefromcache% CMP R3,#0 MOVEQ PC,R14 STMFD SP !,{R0,R14} .multibytefromcachel BL bytefromcache% STRB R0,[R2],#1 SUBS R3,R3,#1 BNE multibytefromcachel LDMFD SP !,{R0,PC} ] ENDIF IF planar%<0 THEN C%=7 IF flag=2600 C%=15 [ OPT Z%(Z) .plancnv% REM CALLplancnv%,rowbytes%,buff%,pbuff% LDR R0,sxloc REM count LDR R1,[R9] LDR R1,[R1] REM pbuff% LDR R3,[R9,#8] LDR R3,[R3] REM buff% LDR R4,[R9,#16] LDR R4,[R4] REM rowbytes% ] IF flag=3500 THEN [ OPT Z%(Z) MOV R9,#0 ] ELSE [ OPT Z%(Z) MOV R9,#C% ] ENDIF [ OPT Z%(Z) .planelp MOV R7,#0 MOV R5,R3 ] FOR N%=1 TO planes% [ OPT Z%(Z) LDR R6,[R5],R4 ] IF flag=2600 THEN [ OPT Z%(Z) MOV R6,R6,LSL #8 BIC R6,R6,#&FF000000 ORR R6,R6,R6,LSR #16 ] ENDIF IF flag=3500 THEN [ OPT Z%(Z) MOV R6,R6,LSR R9 ANDS R6,R6,#1 ORR R7,R7,R6,LSL #(planes%-N%) REM hopefully planes%=2 ORRNE R7,R7,#(planes%-1) ] ELSE [ OPT Z%(Z) MOV R6,R6,LSR R9 AND R6,R6,#1 ORR R7,R7,R6,LSL #(N%-1) ] ENDIF NEXT [ OPT Z%(Z) STRB R7,[R1],#1 ] IF flag=3500 THEN [ OPT Z%(Z) ADD R9,R9,#1 CMP R9,#C%+1 MOVEQ R9,#0 ] ELSE [ OPT Z%(Z) SUBS R9,R9,#1 MOVMI R9,#C% ] ENDIF CASE flag OF WHEN 2600 [ OPT Z%(Z) MOVMI R3,R5 ] WHEN 3500 [ OPT Z%(Z) ADDEQ R3,R3,#1 ] OTHERWISE [ OPT Z%(Z) ADDMI R3,R3,#1 ] ENDCASE [ OPT Z%(Z) SUBS R0,R0,#1 BNE planelp MOV PC,R14 ] ENDIF NEXT cputime%=TIME IF cache% THEN IF flag=3600 THEN pcdblk%!12=cacherows% PROCrefillpcd IF cache%>=filesize% rowstogo%=-1 ELSE IF striprows%>0 AND compression>1 THEN REM PROCnextstrip SYS 12,4,c%,datacache%,cache% IF cachebytes% !incacheptr=datacache%:!numlefttogo=cache% ELSE PROCrefill IF cache%>=filesize% rowstogo%=-1 ENDIF ENDIF ENDIF sizeshft%=0 CASE ncol OF WHEN 2^24-1 size%=1 REM /3 WHEN 2^15-1 size%=1 REM /2 WHEN 63,255,256 size%=1 WHEN 15 size%=2 sizeshft%=1 WHEN 3 size%=4 sizeshft%=2 WHEN 1 size%=8 sizeshft%=3 IF m$="C" size%=2:sizeshft%=1 IF m$="D" size%=4:sizeshft%=2 IF m$="T" size%=2:sizeshft%=1 ENDCASE REM fixup images that can't be read in row order CASE flag OF WHEN 501 IF info% PRINT "Reading interlaced GIF" sz%=sx%*sy% plbuff%=FNdim(sz%+100) FOR Y%=0 TO sy%-1 STEP 8 X%=plbuff%+Y%*sx% CALL LZWdecode%,table%(0),c%,X%,sx% NEXT FOR Y%=4 TO sy%-1 STEP 8 X%=plbuff%+Y%*sx% CALL LZWdecode%,table%(0),c%,X%,sx% NEXT FOR Y%=2 TO sy%-1 STEP 4 X%=plbuff%+Y%*sx% CALL LZWdecode%,table%(0),c%,X%,sx% NEXT FOR Y%=1 TO sy%-1 STEP 2 X%=plbuff%+Y%*sx% CALL LZWdecode%,table%(0),c%,X%,sx% NEXT datacache%=plbuff% buff%=plbuff% rowbytes%=sx% rowstogo%=-1 REM mark as all in cache... ENDCASE IF gamma<>1 AND gamma<>0 THEN k=1/gamma FOR C%=0 TO colourindex IF r%(C%) r%(C%)=((r%(C%)/F)^k)*F IF g%(C%) g%(C%)=((g%(C%)/F)^k)*F IF b%(C%) b%(C%)=((b%(C%)/F)^k)*F NEXT ENDIF rmax=F gmax=F bmax=F IF col=0 THEN IF input<9 THEN FOR C%=0 TO 255 r%(C%)=r%(C%)*rwt+g%(C%)*gwt+b%(C%)*bwt NEXT ELSE IF input<400 THEN rmax=F*rwt gmax=F*gwt bmax=F*bwt FOR C%=0 TO colourindex r%(C%)=r%(C%)*rwt g%(C%)=g%(C%)*gwt b%(C%)=b%(C%)*bwt NEXT ENDIF ENDIF ENDIF IF NOT order% PROCadjustpalette(1/ydiv%/xdiv%,0) REM if image processing the input stream to maximise luminance IF range% THEN IF info% PRINT "Scanning data to compute parameters for '-range'" IF order% THEN Y%=0 REPEAT SYS hour%,Y%*100 DIV sy% W%=EVAL(r$+"(xp%())") CALL maxmin%,xp%(1,0),totvals2% Y%+=1 UNTIL Y%=sy% OR !min<255 AND !max+255>=F ELSE Y%=0 ysamp%=1 REPEAT SYS hour%,Y%*100 DIV y% PROCscaledpixelrow(cl%()) CALL maxmin%,cl%(1,0),totvals% Y%+=1 UNTIL Y%=y% OR !min<255 AND !max+255>=F ENDIF IF !max+255>=F AND !min<255 range%= FALSE :range$="No point in '-range' on this image" IF range% PROCadjustpalette(F/(!max-!min),!min/ydiv%/xdiv%):range$="Input image maximum "+ STR$(!max/F*100)+"% minimum "+ STR$(!min/F*100)+"%" PROCrewind IF info% PRINT range$ ENDIF IF hist% OR equal% THEN IF equal% IF info% PRINT "Scanning data to compute parameters for '-equal'" IF order% THEN FOR yr%=0 TO sy%-1 SYS hour%,yr%*100 DIV sy% W%=EVAL(r$+"(xp%())") CALL histo%,xp%(1,0),vals%(0,0),sx% NEXT ELSE ysamp%=1 FOR yr%=0 TO y%-1 SYS hour%,yr%*100 DIV y% PROCscaledpixelrow(cl%()) CALL histo%,cl%(1,0),vals%(0,0),x% NEXT ENDIF IF info% PRINT "Done. Now processing the picture" ENDIF IF input<400 THEN FOR C%=0 TO colourindex IF r%(C%)<0 r%(C%)=0 IF g%(C%)<0 g%(C%)=0 IF b%(C%)<0 b%(C%)=0 IF r%(C%)>rmax r%(C%)=rmax IF g%(C%)>gmax g%(C%)=gmax IF b%(C%)>bmax b%(C%)=bmax NEXT ENDIF IF hist% THEN M%=0 ZM%=-1 FOR C%=0 TO col FOR Z%=0 TO 256 IF vals%(Z%,C%)>M% M%=vals%(Z%,C%):ZM%=Z% NEXT NEXT IF ZM%=-1 OR okinfo%=0 THEN =100 IF col>0 THEN MODE 66 ht=500 IF MODE <>66 MODE 16:ht=400 LINE 0,6,2000,6 ELSE MODE 18 ht=400 LINE 0,6,1024,6 ENDIF M=M%/(ht*2-8) FOR C%=0 TO col CASE C% OF WHEN 0 GCOL 1 WHEN 1 GCOL 2 WHEN 2 GCOL 4 ENDCASE IF col>0 THEN FOR Z%=0 TO 256 IF vals%(Z%,C%) X%=Z%*3+C%<<1:LINE X%,8,X%,vals%(Z%,C%)/M+8 NEXT ELSE FOR Z%=0 TO 256 IF vals%(Z%,C%) X%=Z%<<2:RECTANGLE FILL X%,8,2,vals%(Z%,C%)/M NEXT ENDIF NEXT PROCclose SYS "Hourglass_Off" =100 ENDIF IF m>=0 oname$="p"+ STR$m+m$ ELSE oname$=m$ IF m=-6 OR m=-7 OR m=-8 oname$=pnm$ IF range% oname$+="r" IF equal% oname$+="e" IF sharpen% oname$+="s"+ STR$sharpen% IF black% oname$+="b"+ STR$black% IF gamma<>1 A%=@%:@%=&1020100:oname$+="g"+ STR$gamma:@%=A% IF bright%=16 oname$+="b" IF LEN (leaf$) THEN oname$=leaf$ xsp%=x% ysp%=y% IF rotate% SWAP xsp%,ysp% IF rotate% OR hflip% OR vflip% IF m=-9 OR m=-10 THEN m-=2 IF m=-9 OR m=-10 THEN DIM jpq%(20) jpq%()=60,75,90,105,120,135,150,160,170,180,190,205,215,235,255,280,320,380,500,750,850 ENDIF CASE m OF WHEN -1 xwords%=xsp% sz%=xwords%*ysp% Y%=ysp% PROCgetoutput(sz%,0,xwords%,Y%) base%=ram% WHEN -3,-5 xwords%=xsp%*2 sz%=xwords%*ysp% Y%=ysp% PROCgetoutput(sz%,0,xwords%,Y%) base%=ram% WHEN -4 xwords%=xsp%*3 sz%=xwords%*ysp% Y%=ysp% PROCgetoutput(sz%,0,xwords%,Y%) base%=ram% WHEN -6 xwords%=xsp%*2+3 AND NOT 3 sz%=xwords%*ysp% Y%=ysp% A%=Y% PROCgetoutput(sz%,64,xwords%,Y%) ram%!4=0 ram%!8=16 ram%!12=16 SYS &2E,&109,ram% SYS &2E,&10f,ram%,oname$,0,xsp%*2,Y%,28 base%=ram%+ram%!8 base%!(5*4)=A%-1 !base%=!base%-Y%*xwords%+A%*xwords% ram%!12=ram%!12-Y%*xwords%+A%*xwords% base%!(10*4)=5<<27 OR nx<<1 OR ny<<14 OR 1 base%+=base%!(8*4) WHEN -7 REM xwords%=xsp%*3+3ANDNOT3:sz%=xwords%*ysp%:Y%=ysp% REM A%=Y%:PROCgetoutput(sz%,64,xwords%,Y%) REM ram%!4=0:ram%!8=16:ram%!12=16:SYS&2E,&109,ram% REM SYS&2E,&10f,ram%,oname$,0,xsp%*3,Y%,28 REM base%=ram%+ram%!8:base%!(5*4)=A%-1:!base%=!base%-Y%*xwords%+A%*xwords% REM ram%!12=ram%!12-Y%*xwords%+A%*xwords% REM base%!(10*4)=8<<27 OR nx<<1 OR ny<<14 OR 1:base%+=base%!(8*4) WHEN -8 xwords%=xsp%*4 sz%=xwords%*ysp% Y%=ysp% A%=Y% PROCgetoutput(sz%,64,xwords%,Y%) ram%!4=0 ram%!8=16 ram%!12=16 SYS &2E,&109,ram% SYS &2E,&10f,ram%,oname$,0,xsp%*4,Y%,28 base%=ram%+ram%!8 base%!(5*4)=A%-1 !base%=!base%-Y%*xwords%+A%*xwords% ram%!12=ram%!12-Y%*xwords%+A%*xwords% base%!(10*4)=6<<27 OR nx<<1 OR ny<<14 OR 1 base%+=base%!(8*4) WHEN -9 xwords%=xsp%+3 AND NOT 3 sz%=(xsp%+7 AND NOT 7)*(ysp%+7 AND NOT 7) Y%=ysp% sz%=sz%*jpq%(jpegquality% DIV 5)/588+1024 jpegwrk%=FNdim((xsp%+7 AND NOT 7)*9+20000) base%=FNdim(xwords%) PROCgetoutputjp(sz%) !ram%=xsp% ram%!4=ysp% ram%!8=jpegquality% ram%!12=1 ram%!16=90 ram%!20=90 SYS "CompressJPEG_Start",ram%,sz%,ram%,jpegwrk%,(xsp%+7 AND NOT 7)*9+20000 TO jpegtag% WHEN -10 xwords%=xsp%*3+3 AND NOT 3 sz%=(xsp%+15 AND NOT 15)*(ysp%+15 AND NOT 15)*12/8 Y%=ysp% sz%=sz%*jpq%(jpegquality% DIV 5)/588+1024 jpegwrk%=FNdim((xsp%+15 AND NOT 15)*30+20000) base%=FNdim(xwords%) PROCgetoutputjp(sz%) !ram%=xsp% ram%!4=ysp% ram%!8=jpegquality% ram%!12=3 ram%!16=90 ram%!20=90 SYS "CompressJPEG_Start",ram%,sz%,ram%,jpegwrk%,(xsp%+15 AND NOT 15)*30+20000 TO jpegtag% WHEN -11 xwords%=xsp% sz%=xwords%*ysp%+20000 Y%=ysp% jpegwrk%=FNdim((xsp%+7 AND NOT 7)*9+20000) PROCgetoutput(sz%,0,xwords%,Y%) base%=ram%+20000 WHEN -12 xwords%=xsp%*3 sz%=xwords%*ysp%+20000 Y%=ysp% jpegwrk%=FNdim((xsp%+15 AND NOT 15)*30+20000) PROCgetoutput(sz%,0,xwords%,Y%) base%=ram%+20000 OTHERWISE xwords%=xsp%/size%+3.9999 AND NOT 3 sz%=xwords%*ysp% X%=xsp% Y%=ysp% IF ncol=1 THEN CASE m$ OF WHEN "C" !rowinc=xwords% xwords%=xwords%*4 sz%=xwords%*ysp% X%=xsp%*4 Y%=ysp%*4 WHEN "T" !rowinc=xwords% xwords%=xwords%*3 sz%=xwords%*ysp% X%=xsp%*4 Y%=ysp%*3 WHEN "D" !rowinc=xwords% xwords%=xwords%*2 sz%=xwords%*ysp% X%=xsp%*2 Y%=ysp%*2 ENDCASE ENDIF A%=Y% PROCgetoutput(sz%,2048+64,xwords%,Y%) ram%!4=0 ram%!8=16 ram%!12=16 SYS &2E,&109,ram% SYS &2E,&10f,ram%,oname$,(ncol<63) AND 1,X%,Y%,spm base%=ram%+ram%!8 base%!(5*4)=A%-1 !base%=!base%-Y%*xwords%+A%*xwords% ram%!12=ram%!12-Y%*xwords%+A%*xwords% pal%=base%+11*4 base%+=base%!(8*4) CASE ncol OF WHEN 256 !(pal%-8)+=2048 !(pal%-12)+=2048 base%+=2048 !(ram%+12)+=2048 !(pal%-44)+=2048 FOR Z%=0 TO 255 B%=Z% OR Z%<<8 OR Z%<<16 B%=B%<<8 pal%!(Z%*8)=B% pal%!(Z%*8+4)=B% NEXT WHEN 255 !(pal%-8)+=2048 !(pal%-12)+=2048 base%+=2048 !(ram%+12)+=2048 !(pal%-44)+=2048 FOR Z%=0 TO 255 B%=palette%!(Z%<<2)<<8 pal%!(Z%*8)=B% pal%!(Z%*8+4)=B% NEXT WHEN 15 CASE m$ OF WHEN "R" FOR Z%=0 TO 15 PROCcol(Z%,palette%!(Z%<<2) AND &F0F0F0) NEXT WHEN "D" FOR Z%=0 TO 7 A%=0 IF Z% AND 1 A%+=&F0 IF Z% AND 2 A%+=&F000 IF Z% AND 4 A%+=&F00000 PROCcol(Z%,A%) NEXT WHEN "T" FOR Z%=0 TO 15 A%=Z%<<4 PROCcol(Z%,A% OR A%<<8 OR A%<<16) NEXT OTHERWISE FOR Z%=0 TO 15 A%=(Z% AND 7)/7*15+.2<<4 PROCcol(Z%,A% OR A%<<8 OR A%<<16) NEXT ENDCASE WHEN 3 CASE m$ OF WHEN "C" PROCcol(0,0) PROCcol(1,&F0F000) PROCcol(2,&F000F0) PROCcol(3,&F0F0) WHEN "R" FOR Z%=0 TO 3 PROCcol(Z%,palette%!(Z%<<2) AND &F0F0F0) NEXT OTHERWISE FOR Z%=0 TO 3 A%=Z%*5<<4 PROCcol(Z%,A% OR A%<<8 OR A%<<16) NEXT ENDCASE WHEN 1 PROCcol(0,0) PROCcol(1,&F0F0F0) ENDCASE ENDCASE REM put back all possible memory... IF flex% THEN REM can't ELSE IF workspace%=-1 THEN P%=END [ OPT 0 STR r13,P%+16 MOV Pc,r14 ] CALL END END=END+32*1024+HIMEM-!(END+16) REM can't be too careful ELSE REM can't ENDIF ENDIF LOCAL ERROR ON ERROR LOCAL :RESTORE ERROR :PROCSave:ERROR ERR,REPORT$+" (internal number "+ STR$ERL+")":REM Error Return REM SYS"Hourglass_LEDs",3 ysamp%=1 nl%()=0 step%=4*(col+1) addr%=0 rowstep%=xwords%*size% colstep%=1 dist%=xsp%-1 IF m=-3 OR m=-5 OR m=-6 dist%=dist%*2 IF m=-4 OR m=-7 OR m=-10 OR m=-12 dist%=dist%*3 IF m=-8 dist%=dist%*4 IF rotate% THEN odist%=dist% SWAP colstep%,rowstep% SWAP hflip%,vflip% IF rotate%=1 THEN addr%+=(ysp%-1)*colstep% colstep%=-colstep% dist%=(ysp%-1)*colstep% REM +90 ELSE addr%+=dist% rowstep%=-rowstep% dist%=(ysp%-1)*colstep% REM -90 ENDIF IF m=-3 OR m=-5 OR m=-6 colstep%=colstep%/2:rowstep%=rowstep%*2 IF m=-4 OR m=-7 OR m=-10 OR m=-12 colstep%=colstep%/3:rowstep%=rowstep%*3 IF m=-8 colstep%=colstep%/4:rowstep%=rowstep%*4 ENDIF IF hflip% THEN addr%+=dist% dist%=-dist% colstep%=-colstep% ENDIF IF vflip% THEN IF rotate% THEN addr%+=odist%*rotate% rowstep%=-rowstep% ELSE addr%+=(ysp%-1)*rowstep% rowstep%=-rowstep% ENDIF ENDIF outlim%=((xwords%*Y%)<outlim% PROCflushoutput W%=EVAL(r$+"(cl%())") B%=x% CALL fs%,colstep%,cl%(1,0),I%,addr%,I%,B%,base% SYS wl%,jpegtag%,base%+addr% NEXT ENDIF ELSE IF equal% THEN PROCrewind Havg%=SUM(vals%())/256/(col+1) DIM new%(256,col) FOR B%=0 TO col R%=0 Hint%=0 FOR Z%=0 TO 256 L%=R% Hint%+=vals%(Z%,B%) WHILE Hint%>Havg% Hint%-=Havg% R%+=1 ENDWHILE new%(Z%,B%)=(L%+R%)/2*F/256 NEXT NEXT ENDIF IF sharpen% THEN IF order% THEN yread%=sy%-1 W%=EVAL(r$+"(rm1%())") IF equal% PROCfit2(rm1%()) FOR B%=0 TO col rm1%(0,B%)=rm1%(1,B%) rm1%(sx%+1,B%)=rm1%(sx%,B%) NEXT ELSE yread%=y%-1 PROCscaledpixelrow(rm1%()) IF equal% PROCfit(rm1%()) FOR B%=0 TO col rm1%(0,B%)=rm1%(1,B%) rm1%(x%+1,B%)=rm1%(x%,B%) NEXT ENDIF rm2%()=rm1%() ENDIF IF order% THEN FOR yr%=0 TO y%-1 SYS hour%,yr%*100 DIV y% IF addr%>outlim% PROCflushoutput IF sy%=y% THEN PROCsharppixelrow(cl%()) ELSE ysamp%-=1 IF ysamp%=0 PROCsharppixelrow(xl%()):ysamp%=ymul% IF ydiv%=1 THEN cl%()=xl%() ELSE IF ysamp%>=ydiv% THEN ysamp%-=ydiv% cl%()=xl%()*ydiv% ELSE cl%()=xl%()*ysamp% Y%=ydiv%-ysamp% ysamp%=0 REPEAT IF ysamp%=0 PROCsharppixelrow(xl%()):ysamp%=ymul% IF ysamp%>Y% THEN ysamp%-=Y% xl2%()=xl%()*Y% cl%()=cl%()+xl2%() Y%=0 ELSE Y%-=ysamp% xl2%()=xl%()*ysamp% cl%()=cl%()+xl2%() ysamp%=0 ENDIF UNTIL Y%=0 ENDIF ysamp%+=1 ENDIF ENDIF cl%()=cl%()+nl%() nl%()=0 B%=x% A%=addr%+dist% IF yr% AND 1 THEN CALL fs%,colstep%,cl%(1,0),nl%(1,0),addr%,step%,B%,base% ELSE CALL fs%,oddcolstep%,cl%(x%,0),nl%(x%,0),A%,oddstep%,B%,base% ENDIF SYS wl%,jpegtag%,base%+addr% NEXT ELSE FOR yr%=0 TO y%-1 SYS hour%,yr%*100 DIV y% IF addr%>outlim% PROCflushoutput IF sharpen% THEN IF yread% yread%-=1:PROCscaledpixelrow(rm%()):IF equal% PROCfit(rm%()) FOR B%=0 TO col rm%(0,B%)=rm%(1,B%) rm%(x%+1,B%)=rm%(x%,B%) NEXT CALL sharp%,cl%(1,0),rm%(1,0),rm1%(1,0),rm2%(1,0),totvals% SWAP rm2%(),rm1%() rm1%()=rm%() ELSE PROCscaledpixelrow(cl%()) IF equal% PROCfit(cl%()) ENDIF cl%()=cl%()+nl%() nl%()=0 B%=x% A%=addr%+dist% IF yr% AND 1 THEN CALL fs%,colstep%,cl%(1,0),nl%(1,0),addr%,step%,B%,base% ELSE CALL fs%,oddcolstep%,cl%(x%,0),nl%(x%,0),A%,oddstep%,B%,base% ENDIF SYS wl%,jpegtag%,base%+addr% NEXT ENDIF ENDIF SYS "CompressJPEG_Finish",jpegtag% TO jpegsize% ELSE REM Target isn't a JPEG IF sy%=y% AND sx%=x% AND range%= FALSE AND sharpen%= FALSE AND equal%= FALSE THEN IF dither% THEN FOR yr%=0 TO y%-1 SYS hour%,yr%*100 DIV y% IF addr%>outlim% PROCflushoutput W%=EVAL(r$+"(cl%())") cl%()=cl%()+nl%() nl%()=0 B%=x% A%=addr% addr%+=rowstep% IF yr% AND 1 THEN CALL fs%,colstep%,cl%(1,0),nl%(1,0),A%,step%,B%,base% ELSE A%+=dist% CALL fs%,oddcolstep%,cl%(x%,0),nl%(x%,0),A%,oddstep%,B%,base% ENDIF NEXT ELSE I%=step% FOR yr%=0 TO y%-1 SYS hour%,yr%*100 DIV y% IF addr%>outlim% PROCflushoutput W%=EVAL(r$+"(cl%())") B%=x% A%=addr% addr%+=rowstep% CALL fs%,colstep%,cl%(1,0),I%,A%,I%,B%,base% NEXT ENDIF ELSE IF equal% THEN PROCrewind Havg%=SUM(vals%())/256/(col+1) DIM new%(256,col) FOR B%=0 TO col R%=0 Hint%=0 FOR Z%=0 TO 256 L%=R% Hint%+=vals%(Z%,B%) WHILE Hint%>Havg% Hint%-=Havg% R%+=1 ENDWHILE new%(Z%,B%)=(L%+R%)/2*F/256 NEXT NEXT ENDIF IF sharpen% THEN IF order% THEN yread%=sy%-1 W%=EVAL(r$+"(rm1%())") IF equal% PROCfit2(rm1%()) FOR B%=0 TO col rm1%(0,B%)=rm1%(1,B%) rm1%(sx%+1,B%)=rm1%(sx%,B%) NEXT ELSE yread%=y%-1 PROCscaledpixelrow(rm1%()) IF equal% PROCfit(rm1%()) FOR B%=0 TO col rm1%(0,B%)=rm1%(1,B%) rm1%(x%+1,B%)=rm1%(x%,B%) NEXT ENDIF rm2%()=rm1%() ENDIF IF order% THEN FOR yr%=0 TO y%-1 SYS hour%,yr%*100 DIV y% IF addr%>outlim% PROCflushoutput IF sy%=y% THEN PROCsharppixelrow(cl%()) ELSE ysamp%-=1 IF ysamp%=0 PROCsharppixelrow(xl%()):ysamp%=ymul% IF ydiv%=1 THEN cl%()=xl%() ELSE IF ysamp%>=ydiv% THEN ysamp%-=ydiv% cl%()=xl%()*ydiv% ELSE cl%()=xl%()*ysamp% Y%=ydiv%-ysamp% ysamp%=0 REPEAT IF ysamp%=0 PROCsharppixelrow(xl%()):ysamp%=ymul% IF ysamp%>Y% THEN ysamp%-=Y% xl2%()=xl%()*Y% cl%()=cl%()+xl2%() Y%=0 ELSE Y%-=ysamp% xl2%()=xl%()*ysamp% cl%()=cl%()+xl2%() ysamp%=0 ENDIF UNTIL Y%=0 ENDIF ysamp%+=1 ENDIF ENDIF cl%()=cl%()+nl%() nl%()=0 B%=x% A%=addr% addr%+=rowstep% IF yr% AND 1 THEN CALL fs%,colstep%,cl%(1,0),nl%(1,0),A%,step%,B%,base% ELSE A%+=dist% CALL fs%,oddcolstep%,cl%(x%,0),nl%(x%,0),A%,oddstep%,B%,base% ENDIF NEXT ELSE FOR yr%=0 TO y%-1 SYS hour%,yr%*100 DIV y% IF addr%>outlim% PROCflushoutput IF sharpen% THEN IF yread% yread%-=1:PROCscaledpixelrow(rm%()):IF equal% PROCfit(rm%()) FOR B%=0 TO col rm%(0,B%)=rm%(1,B%) rm%(x%+1,B%)=rm%(x%,B%) NEXT CALL sharp%,cl%(1,0),rm%(1,0),rm1%(1,0),rm2%(1,0),totvals% SWAP rm2%(),rm1%() rm1%()=rm%() ELSE PROCscaledpixelrow(cl%()) IF equal% PROCfit(cl%()) ENDIF cl%()=cl%()+nl%() nl%()=0 B%=x% A%=addr% addr%+=rowstep% IF yr% AND 1 THEN CALL fs%,colstep%,cl%(1,0),nl%(1,0),A%,step%,B%,base% ELSE A%+=dist% CALL fs%,oddcolstep%,cl%(x%,0),nl%(x%,0),A%,oddstep%,B%,base% ENDIF NEXT ENDIF ENDIF REM JPEG tidy up IF m=-11 OR m=-12 THEN SYS "OS_SWINumberFromString",,"CompressJPEG_WriteLine" TO wl% IF m=-11 THEN !ram%=xsp% ram%!4=ysp% ram%!8=jpegquality% ram%!12=1 ram%!16=90 ram%!20=90 SYS "CompressJPEG_Start",ram%,sz%,ram%,jpegwrk%,(xsp%+7 AND NOT 7)*9+20000 TO jpegtag% ELSE !ram%=xsp% ram%!4=ysp% ram%!8=jpegquality% ram%!12=3 ram%!16=90 ram%!20=90 SYS "CompressJPEG_Start",ram%,sz%,ram%,jpegwrk%,(xsp%+15 AND NOT 15)*30+20000 TO jpegtag% ENDIF addr%=ram%+20000 FOR yr%=0 TO ysp%-1 SYS hour%,yr%*100 DIV ysp% SYS wl%,jpegtag%,addr% addr%+=xwords% NEXT SYS "CompressJPEG_Finish",jpegtag% TO jpegsize% ENDIF ENDIF cputime%=TIME-cputime% PROCSave =0 REM Success! : REM « » DEF FNGET REPEAT s$= GET$#c% UNTIL LEFT$(s$,1)<>"#" =s$ : REM Return leafname from a filename string DEF FNleaf(str$) LOCAL p% p% = INSTR(str$, ".") WHILE p% str$ = MID$(str$, p% + 1) p% = INSTR(str$, ".") ENDWHILE p% = INSTR(str$, ":") WHILE p% str$ = MID$(str$, p% + 1) p% = INSTR(str$, ":") ENDWHILE =str$ : REM « » DEF FNcpsr_from_r(reg%) REM Emulate assembly of 'MSR CPSR_f,reg%' on old BASICs [OPT0:EQUD &E128F000 OR reg%:] =TRUE : REM « » DEF FNcpsr_to_r(reg%) REM Emulate assembly of 'MRS reg%,CPSR' on old BASICs [OPT0:EQUD &E10F0000 OR (reg%<<12):] =TRUE : REM « » DEF PROCsrchdevlist [ OPT Z%(Z) REM r1=incr, r4=r, r5=g, r6=b, r7=div15 palette REM r8=step, r9= count, r10=curr, r11=next, r12=pixel CMP R4,#F MOVCS R4,#0 MOVGE R4,#F MOV R0,R4,LSR #(bits-k%) CMP R0,#1<3 then pointer is in cell LDRB r0,[r2],#1 REM first cell SUBS r14,r14,#1 BEQ gotit REM r14 count, r0 candidate. Calculate distance ADD r3,r0,r0,lsl #1 ADD r3,r7,r3,lsl #2 LDMIA r3,{r8,r9,r10} SUBS r8,r8,r4 RSBMI r8,r8,#0 MOV r8,r8,lsr #bits/2 REM abs dr SUBS r9,r9,r5 RSBMI r9,r9,#0 MOV r9,r9,lsr #bits/2 REM abs dg SUBS r10,r10,r6 RSBMI r10,r10,#0 MOV r10,r10,lsr #bits/2 REM abs db MUL r3,r8,r8 MUL r11,r9,r9 ADD r11,r11,r11,LSL #2 ADD r3,r3,r3,LSL #1 ADD r3,r3,r11,LSL #1 MLA r11,r10,r10,r3 REM dr^2*3+dg^2*10+db^2 REM r11 is 'closest so far', r0 is candidate .srchlist LDRB r3,[r2],#1 ADD R8,R3,R3,LSL #1 ADD R8,R7,R8,LSL #2 LDMIA R8,{R8,R9,R10} SUBS R9,R5,R9 RSBMI R9,R9,#0 MOV R3,R9,LSR #bits/2 MUL R9,R3,R3 ADD r9,r9,r9,LSL #2 CMP R11,R9,LSL #1 BCC srchquick SUBS R8,R4,R8 RSBMI R8,R8,#0 MOV R3,R8,LSR #bits/2 MUL R8,r3,r3 ADD r8,r8,r8,LSL #1 ADD r8,r8,r9,LSL #1 SUBS R10,R6,R10 RSBMI R10,R10,#0 MOV R3,R10,LSR #bits/2 MLA R10,R3,R3,R8 CMP R10,R11 MOVCC R11,R10 LDRCCB R0,[r2,#-1] .srchquick SUBS R14,R14,#1 BNE srchlist .gotit ADD R3,R0,R0,LSL #1 ADD R3,R7,R3,LSL #2 LDMIA R3,{R8,R9,R10} SUB R4,R4,R8 SUB R5,R5,R9 SUB R6,R6,R10 LDMFD r13!,{R8,R9,R10,R11,R14} ] ENDPROC : REM « » DEF PROCgetoutput(A%,E%,B%,RETURN C%) IF A%>max% AND rotate%= FALSE AND vflip%= FALSE THEN C%=max% DIV B%+1 A%=xwords%*C%+E% first%= TRUE o%= OPENOUTf$ ELSE A%+=E% ENDIF IF spritearea%=-1 THEN ram%=FNcreatearea(A%) IF ram%=-1 ram%=FNdim(A%) ELSE ram%=spritearea% ENDIF !ram%=A% ENDPROC : REM « » DEF PROCgetoutputjp(RETURN A%) IF spritearea%=-1 THEN ram%=FNcreateareajp(A%) IF ram%=-1 ram%=FNdimjp(A%) ELSE ram%=spritearea% ENDIF !ram%=A% ENDPROC : REM « » DEF FNcreatearea(size%) LOCAL ERROR areanumber%=0 ON ERROR LOCAL :=-1 SYS &20066,0,-1,size%,-1,%10000000,size%,0,0,"ChangeFSI sprite" TO ,areanumber%,,areabase%;V% IF V% AND 1 THEN areanumber%=0:=-1 REM If the above SWI returns an error, then the area is guaranteed not to have been created. REM However, at the moment there is a bug/undesirable feature, whereby if the area is created successfully REM (initially at zero size), but then it fails to grow the area to the requested initial size, rather than REM destroying the area and returning an error, it returns without error with the area having zero size. REM So the following code checks that the area does indeed have the size we asked for (this can be removed eventually) SYS "OS_ReadDynamicArea",areanumber% TO ,areasize% IF areasize%" IF cc% CLOSE#cc%:cc%=0 IF ccc% CLOSE#ccc%:ccc%=0 PROCremovecachearea ENDPROC : REM « » DEF PROCSave PROCclose CASE m OF WHEN -1 IF spritearea%=-1 AND oksave% THEN IF o% PROCflushoutput ELSE SYS "OS_File",10,f$,&004,,ram%,ram%+sz% ENDIF WHEN -2 o%= OPENOUTf$ BPUT#o%,pnm$ CASE pnm$ OF WHEN "P1" BPUT#o%,"# "+f$+".pbm (options "+oname$+")" BPUT#o%, STR$xsp%+" "+ STR$ysp% FOR Y%=0 TO ysp%-1 B%=base%+Y%*xwords% FOR X%=0 TO xsp%-1 IF B%?(X%>>3) AND (1<<(X% AND 7)) BPUT#o%,"1"; ELSE BPUT#o%,"0"; NEXT BPUT#o%,"" NEXT WHEN "P4" BPUT#o%,"# "+f$+".pbm (options "+oname$+") binary encoded" BPUT#o%, STR$xsp%+" "+ STR$ysp% FOR X%=0 TO 255 code%?X%=X%<<7 OR X%<<5 AND &40 OR X%<<3 AND &20 OR X%<<1 AND &10 OR X%>>1 AND 8 OR X%>>3 AND 4 OR X%>>5 AND 2 OR X%>>7 NEXT FOR Y%=0 TO ysp%-1 B%=base%+Y%*xwords% FOR X%=0 TO xsp%-1 STEP 8 BPUT#o%,code%?(B%?(X%>>3)) NEXT NEXT WHEN "P2" BPUT#o%,"# "+f$+".pgm (options "+oname$+")" BPUT#o%, STR$xsp%+" "+ STR$ysp% BPUT#o%,"15" FOR Y%=0 TO ysp%-1 B%=base%+Y%*xwords% FOR X%=0 TO xsp%-1 C%=B%?(X%>>1) IF X% AND 1 C%=C%>>4 ELSE C%=C% AND 15 BPUT#o%," "+ STR$C%; NEXT BPUT#o%,"" NEXT WHEN "P5" BPUT#o%,"# "+f$+".pgm (options "+oname$+") binary encoded" BPUT#o%, STR$xsp%+" "+ STR$ysp% BPUT#o%,"15" FOR Y%=0 TO ysp%-1 B%=base%+Y%*xwords% FOR X%=0 TO xsp%-1 C%=B%?(X%>>1) IF X% AND 1 C%=C%>>4 ELSE C%=C% AND 15 BPUT#o%,C% NEXT NEXT ENDCASE CLOSE#o% o%=0 IF pnm$="P2" OR pnm$="P1" OSCLI"Settype "+f$+" &FFF" WHEN -3 o%= OPENOUTf$ BPUT#o%,pnm$ BPUT#o%,"# "+f$+".pcm (options "+oname$+") binary encoded 15bpp (5bits r,g,b)" BPUT#o%, STR$xsp%+" "+ STR$ysp% BPUT#o%,"31" SYS 12,2,o%,ram%,xsp%*ysp%*2 CLOSE#o% o%=0 WHEN -4 o%= OPENOUTf$ IF pnm$="IRLAM" THEN BPUT#o%,"Irlam 24: "+ STR$xsp%+" "+ STR$ysp% FOR Y%=0 TO ysp%-1 B%=ram%+Y%*xwords% FOR X%=0 TO xsp%*3-1 STEP 3 BPUT#o%,B%?X% NEXT B%+=1 FOR X%=0 TO xsp%*3-1 STEP 3 BPUT#o%,B%?X% NEXT B%+=1 FOR X%=0 TO xsp%*3-1 STEP 3 BPUT#o%,B%?X% NEXT NEXT ELSE BPUT#o%,pnm$ IF pnm$="P6" THEN BPUT#o%,"# "+f$+".ppm (options "+oname$+") binary encoded 24bpp r,g,b" ELSE BPUT#o%,"# "+f$+".ppm (options "+oname$+") "+ STR$(p6bits*3)+"bpp r,g,b" ENDIF BPUT#o%, STR$xsp%+" "+ STR$ysp% BPUT#o%, STR$(2^p6bits-1) IF pnm$="P6" THEN SYS 12,2,o%,ram%,xsp%*ysp%*3 ELSE FOR Y%=0 TO ysp%-1 B%=ram%+Y%*xwords% FOR X%=0 TO xsp%-1 C%=B%!(X%*3) BPUT#o%," "+ STR$(C% AND 255)+" "+ STR$((C%>>8) AND &FF)+" "+ STR$((C%>>16) AND 255); NEXT BPUT#o%,"" NEXT ENDIF ENDIF CLOSE#o% o%=0 IF pnm$="P3" OSCLI"Settype "+f$+" &FFF" WHEN -5 o%= OPENOUTf$ BPUT#o%,pnm$ BPUT#o%,"# "+f$+".pcm (options "+oname$+") binary encoded 15bpp (5bits y,u,v)" BPUT#o%, STR$xsp%+" "+ STR$ysp% BPUT#o%,"31 27 21" SYS 12,2,o%,ram%,xsp%*ysp%*2 CLOSE#o% o%=0 WHEN -9,-10,-11,-12 IF spritearea%=-1 AND oksave% SYS 8,10,f$,&c85,,ram%,ram%+jpegsize% OTHERWISE IF ncol=1 AND m$="T" THEN FOR X%=(xsp%*4-1) DIV 8*8+6 TO 6 STEP -8 SYS &2E,&12e,ram%,oname$,X% SYS &2E,&12e,ram%,oname$,X% NEXT ENDIF IF spritearea%=-1 AND oksave% THEN IF o% PROCflushoutput ELSE SYS &2E,&10c,ram%,f$ ENDIF ENDCASE IF o% CLOSE#o%:o%=0:OSCLI"Settype "+f$+" &ff9":PROCremovearea SYS "Hourglass_Off" ENDPROC : REM « » DEF PROCdefpal FOR C%=0 TO 255 r%(C%)=(C% AND 7 OR (C% AND 16)>>1)/15*F g%(C%)=(C% AND 3 OR (C% AND &60)>>3)/15*F b%(C%)=(C% AND 3 OR (C% AND 8)>>1 OR (C% AND 128)>>4)/15*F NEXT ENDPROC : REM « » DEF PROCdefpal2 r%(0)=F g%(0)=F b%(0)=F ENDPROC : REM « » DEF PROCdefpal4 r%()=15,10,5,0 FOR C%=0 TO 3 r%(C%)=r%(C%)/15*F NEXT g%()=r%() b%()=r%() ENDPROC : REM « » DEF PROCdefpal16 r%()=15,13,11,9,7,5,3,0,0,14, 0,13,14,5,15, 0 g%()=15,13,11,9,7,5,3,0,4,14,12, 0,14,8,11,10 b%()=15,13,11,9,7,5,3,0,9, 0, 0, 0,11,0, 0,15 FOR C%=0 TO 15 r%(C%)=r%(C%)/15*F g%(C%)=g%(C%)/15*F b%(C%)=b%(C%)/15*F NEXT ENDPROC : REM « » DEF PROCipal63 PTR#c%=&38 DIM rpal%(15),gpal%(15),bpal%(15) FOR C%=0 TO 15 D%=BGET#c% rpal%(C%)=BGET#c%>>4 AND 7 gpal%(C%)=BGET#c%>>4 AND 3 bpal%(C%)=BGET#c%>>4 AND 7 D%=FNW NEXT FOR C%=0 TO 255 r%(C%)=(rpal%(C% AND 15) OR (C% AND 16)>>1)/15*F g%(C%)=(gpal%(C% AND 15) OR (C% AND &60)>>3)/15*F b%(C%)=(bpal%(C% AND 15) OR (C% AND 128)>>4)/15*F NEXT ENDPROC : REM « » DEF PROCipal(D%) PTR#c%=&38 FOR C%=0 TO D%-1 D%=BGET#c% r%(C%)=(BGET#c%>>4)/15*F g%(C%)=(BGET#c%>>4)/15*F b%(C%)=(BGET#c%>>4)/15*F D%=FNW NEXT ENDPROC : REM « » DEF PROCnewropal(D%) PTR#c%=&38 FOR C%=0 TO D%-1 D%=FNW r%(C%)=(D%>>8 AND 255)/255*F g%(C%)=(D%>>16 AND 255)/255*F b%(C%)=(D%>>24 AND 255)/255*F D%=FNW:REM Flash colour ignored NEXT ENDPROC : REM « » DEF PROCflatpal(E%) E%=E%-1 FOR C%=0 TO E% r%(C%)=C%/E%*F NEXT g%()=r%() b%()=r%() ENDPROC : REM « » DEF PROCnopal PROCflatpal(256) ENDPROC : REM « » DEF PROCcol(A%,B%) B%=B%<<8 OR B%<<4 OR &10 pal%!(A%*8)=B% pal%!(A%*8+4)=B% ENDPROC : REM « » DEF FNbits(A%) IF A%=1 THEN ="1 bit per pixel" ELSE = STR$A%+" bits per pixel" : REM « » DEF FNuc(a$) LOCAL Z%,z$,b$ FOR Z%=1 TO LEN a$ z$=MID$(a$,Z%,1) IF z$>="a"IF z$<="z" z$=CHR$(ASC z$-32) b$+=z$ NEXT =b$ : REM « » DEF FNdim(A%) LOCAL B% IF flex% THEN B%=nextlocation% A%=A%+3 AND NOT 3 nextlocation%+=A% SYS "Wimp_SlotSize",-1,-1 TO currentslot% IF currentslot%+&8000worklimit% ERROR 42,"Not enough workspace" ENDIF ENDIF =B% : REM « » DEF FNdimjp(RETURN A%) LOCAL B% IF flex% THEN B%=nextlocation% A%=A%+3 AND NOT 3 nextlocation%+=A% SYS "Wimp_SlotSize",-1,-1 TO currentslot% IF currentslot%+&8000worklimit% ERROR 42,"Not enough workspace" ENDIF ENDIF =B% : REM read little endian 32 bit word DEF FNW =BGET#c% OR BGET#c%<<8 OR BGET#c%<<16 OR BGET#c%<<24 : REM read little endian 16 bit word DEF FNHW =BGET#c% OR BGET#c%<<8 : REM read big endian 32 bit word DEF FNbeW =BGET#c%<<24 OR BGET#c%<<16 OR BGET#c%<<8 OR BGET#c% : REM read big endian 16 bit word DEF FNbeHW =BGET#c%<<8 OR BGET#c% : REM read a TIFF type DEF FNtiff(T%) CASE T% OF WHEN 1,7 =BGET#c% WHEN 2 LOCAL s$,t$ REPEAT s$+=t$ t$=CHR$BGET#c% UNTIL t$=CHR$0 =s$ WHEN 3 IF bigendian THEN =FNbeHW ELSE =FNHW WHEN 4,9 IF bigendian THEN =FNbeW ELSE =FNW WHEN 6 =(BGET#c%<<24)>>24 WHEN 8 =(FNtiff(3)<<16)>>16 ENDCASE ERROR 42,"Silly TIFF tag:"+ STR$T% : REM « » DEF PROCnextstrip rowstogo%=striprows% stripptr+=1 PTR#c%=st%(stripptr) IF compression=5 THEN !firstcode=0 !oldcode=0 !codesize=setcodes%+1 !stack=stk% !sp=stk% !maxcode=clearcode%+2 !maxcodesize=2*clearcode% !curbit=0 !lastbit=0 ENDIF IF compression=5 OR compression=32773 THEN !incacheptr=datacache% !numlefttogo=cache% SYS 12,4,c%,datacache%,cache% ENDIF ENDPROC : REM « » DEF PROCwatford(wtsx%,RETURN rep%,RETURN wt%,X%,c%) CALL rlexpand%,wtsx%,rep%,wt%,X% REPEAT C%=BGET#c% CASE C%>>6 OF WHEN 0 ?X%=C% X%+=1 wt%=C% WHEN 1 wt%-=1 rep%=C% AND 63 CALL rlexpand%,wtsx%,rep%,wt%,X% WHEN 2 rep%=C% AND 63 CALL rlexpand%,wtsx%,rep%,wt%,X% WHEN 3 wt%+=1 rep%=C% AND 63 CALL rlexpand%,wtsx%,rep%,wt%,X% ENDCASE UNTIL X%=wtsx% ENDPROC : REM « » DEF PROCwatfordcache(wtsx%,RETURN rep%,RETURN wt%,X%) CALL rlexpand%,wtsx%,rep%,wt%,X% REPEAT C%=USR bytefromcache% CASE C%>>6 OF WHEN 0 ?X%=C% X%+=1 wt%=C% WHEN 1 wt%-=1 rep%=C% AND 63 CALL rlexpand%,wtsx%,rep%,wt%,X% WHEN 2 rep%=C% AND 63 CALL rlexpand%,wtsx%,rep%,wt%,X% WHEN 3 wt%+=1 rep%=C% AND 63 CALL rlexpand%,wtsx%,rep%,wt%,X% ENDCASE UNTIL X%=wtsx% ENDPROC : REM « » DEF PROCreduce(RETURN A%,RETURN B%) LOCAL C%,D% C%=A% D%=B% REPEAT IF C%=ydiv% THEN ysamp%-=ydiv% z%()=xl%()*ydiv% ELSE LOCAL Y% z%()=xl%()*ysamp% Y%=ydiv%-ysamp% ysamp%=0 REPEAT IF ysamp%=0 PROCreadpixelrow(xl%()):ysamp%=ymul% IF ysamp%>Y% THEN ysamp%-=Y% xl2%()=xl%()*Y% z%()=z%()+xl2%() Y%=0 ELSE Y%-=ysamp% xl2%()=xl%()*ysamp% z%()=z%()+xl2%() ysamp%=0 ENDIF UNTIL Y%=0 ENDIF ysamp%+=1 ENDIF ENDIF ENDPROC : REM « » DEF PROCfit(z%()) CALL histequal%,z%(1,0),new%(0,0),x% ENDPROC : REM « » DEF PROCfit2(z%()) CALL histequal%,z%(1,0),new%(0,0),sx% ENDPROC : REM « » DEF PROCadjustpalette(mul,sub) IF mul=1 AND sub=0 ENDPROC FOR C%=0 TO colourindex r%(C%)=(r%(C%)-sub)*mul+1 g%(C%)=(g%(C%)-sub)*mul+1 b%(C%)=(b%(C%)-sub)*mul+1 NEXT IF ham THEN FOR C%=0 TO 15*4 STEP 4 ltable!C%=(ltable!C%-sub)*mul+1 NEXT ENDIF IF input>400 THEN FOR C%=0 TO colourindex rpal%(C%)=(rpal%(C%)-sub)*mul+1 gpal%(C%)=(gpal%(C%)-sub)*mul+1 bpal%(C%)=(bpal%(C%)-sub)*mul+1 table%(C%)=(table%(C%)-sub)*mul+1 NEXT ENDIF ENDPROC : REM « » DEF PROCcachesize LOCAL size%,str$ SYS &20023,"ChangeFSI$Cache",0,-1 TO ,,size% IF size%<>0 THEN SYS &23,"ChangeFSI$Cache",STRING$(32,CHR$13),32 TO ,str$ cache%=VAL str$ IF INSTR(str$,"K") OR INSTR(str$,"k") cache%=cache%*1024 IF cache%<4096 THEN cache%=4096:REM Sensible floor ELSE cache%=128*1024 ENDIF ENDPROC : REM « » DEF PROCrefill IF striprows%>0 PROCnextstrip SYS 12,4,c%,datacache%,cache% rowstogo%=cacherows% buff%=datacache% IF input=24 OR input=48 IF rbo%>=0 rb%=buff%+rbo%:gb%=buff%+gbo%:bb%=buff%+bbo% ENDPROC : REM « » DEF PROCrefillpcd IF pcdblk%!4>=sy% ENDPROC IF pcdblk%!12>=sy% pcdblk%!12=sy% REM FORI%=0TO40STEP4:P.pcdblk%!I%;:NEXT:PRINT SYS "PhotoCD_GetBlock",pcdh%,,pcdblk%,datacache%,pcdindex%,,,pcdcache%,pcdcachesize% rowstogo%=cacherows% buff%=datacache% pcdblk%!4+=cacherows% pcdblk%!12+=cacherows% rb%=buff%+rbo% gb%=buff%+gbo% bb%=buff%+bbo% ENDPROC : REM 1-8 bpp packed pixels from cache DEF FN8(z%()) CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),buff% buff%+=rowbytes% rowstogo%-=1 IF rowstogo%=0 PROCrefill = TRUE : REM 16bpp packed from cache DEF FN16(z%()) CALL mappix%,z%(1,0),rpal%(0),gpal%(0),r%(0),g%(0),b%(0),buff%,buff% buff%+=rowbytes% rowstogo%-=1 IF rowstogo%=0 PROCrefill = TRUE : REM 24 bpp packed pixels from cache DEF FN24(z%()) CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% rb%+=rowbytes% gb%+=rowbytes% bb%+=rowbytes% rowstogo%-=1 IF rowstogo%=0 PROCrefill = TRUE : REM 16 bpp from 2 files, 1 in cache: Arvis DEF FN300(z%()) SYS 12,4,cc%,pbuff%,sx% CALL mappix%,z%(1,0),rpal%(0),gpal%(0),r%(0),g%(0),b%(0),pbuff%,buff% buff%+=rowbytes% rowstogo%-=1 IF rowstogo%=0 PROCrefill = TRUE : REM 24 bpp packed pixels RLE'd: RT DEF FN400(z%()) CALL readline%,plbytes%,rep%,pix%,plbuff% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% = TRUE : REM LZ12 decoded 1-8 bpp packed pixels: GIF DEF FN500(z%()) CALL LZWdecode%,table%(0),c%,plbuff%,sx% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),plbuff% = TRUE : REM 6bpp RLE'd: Watford DEF FN800(z%()) PROCwatfordcache(wtsx%,rep%,wt%,plbuff%) CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),plbuff% = TRUE : REM 18bpp from 3 files RLE'd: Watford DEF FN801(z%()) PROCwatford(wtsx1%,rep1%,wt1%,buff%,c%) PROCwatford(wtsx2%,rep2%,wt2%,wtsx1%,cc%) PROCwatford(wtsx3%,rep3%,wt3%,wtsx2%,ccc%) CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% = TRUE : REM 24bpp from 3 files: Wild Vision DEF FN901(z%()) SYS 12,4,c%,rb%,sx% SYS 12,4,cc%,gb%,sx% SYS 12,4,ccc%,bb%,sx% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% = TRUE : REM 12bpp packed from cache: Wild Vision V9 DEF FN902(z%()) CALL unpack%,buff% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% buff%+=rowbytes% rowstogo%-=1 IF rowstogo%=0 PROCrefill = TRUE : REM 8bpp RLE'd: ProArtisan DEF FN1000(z%()) X%=buff% IF rep%>0 C%=?pa%:CALL rlexpand%,pasx%,rep%,C%,X%:pa%+=1 IF rep2%>0 C%=?pa%:CALL rlexpand%,pasx%,rep2%,C%,X%:pa%+=1 REPEAT C%=BGET#c% IF C%=0 THEN rep%=BGET#c% C%=?pa% CALL rlexpand%,pasx%,rep%,C%,X% IF rep%=0 pa%+=1 ELSE rep2%=C% AND 15 rep%=C%>>4 IF rep% C%=?pa%:CALL rlexpand%,pasx%,rep%,C%,X%:IF rep%=0 pa%+=1 IF X%0 C%=?pa%:CALL rlexpand%,pasx%,rep%,C%,X%:pa%+=1 REPEAT rep%=BGET#c% C%=?pa% CALL rlexpand%,pasx%,rep%,C%,X% IF rep%=0 pa%+=1 UNTIL X%=pasx% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),buff% = TRUE : REM 1-8bpp packed RLE'd: SunRaster, CADSoft DEF FN1100(z%()) CALL readline%,plbytes%,rep%,pix%,plbuff% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),plbuff% = TRUE : REM 1-8bpp planar RLE'd: IMG DEF FN1400(z%()) IF vrep% THEN vrep%-=1 ELSE G%=buff% FOR X%=1 TO planes% G%+=rowbytes% F%=G%-rowbytes% REPEAT C%=BGET#c% IF C%=0 THEN C%=BGET#c% IF C%=0 THEN C%=BGET#c% vrep%=BGET#c%-1 ELSE D%=F% SYS 12,4,c%,F%,patlen% F%+=patlen% IF C%>1 FOR N%=2 TO C%:FOR E%=0 TO patlen%-1:F%?E%=D%?E%:NEXT:F%+=patlen%:NEXT ENDIF ELSE IF C%=128 THEN C%=BGET#c% SYS 12,4,c%,F%,C% F%+=C% ELSE ?F%=(C% AND &80)<>0 FOR E%=F%+1 TO F%+(C% AND &7F) ?E%=?F% NEXT F%+=C% AND &7F ENDIF ENDIF UNTIL F%>=G% NEXT CALL plancnv%,rowbytes%,buff%,pbuff% ENDIF CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),pbuff% = TRUE : REM 1-8bpp RLE'd: TIFF DEF FN1501(z%()) CALL readiff%,rowbytes%,plbuff% rowstogo%-=1 IF rowstogo%=0 PROCnextstrip CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),plbuff% = TRUE : REM 1-8bpp LZ12: TIFF DEF FN1505(z%()) CALL LZWdecode%,table%(0),c%,plbuff%,rowbytes% rowstogo%-=1 IF rowstogo%=0 PROCnextstrip CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),plbuff% = TRUE : REM 24bpp LZ12: TIFF DEF FN1515(z%()) CALL LZWdecode%,table%(0),c%,plbuff%,rowbytes% rowstogo%-=1 IF rowstogo%=0 PROCnextstrip CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% = TRUE : REM 1-8bpp planar (possibly masked): ILBM IFF DEF FN1600(z%()) CALL plancnv%,realrowbytes%,buff%,pbuff% buff%+=rowbytes% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),pbuff% rowstogo%-=1 IF rowstogo%=0 PROCrefill = TRUE : REM 1-8bpp planar RLE'd (possibly masked): ILBM IFF DEF FN1601(z%()) FOR X%=0 TO planes%-1 F%=plbuff%+X%*rowbytes% CALL readiff%,rowbytes%,F% NEXT IF masking% CALL readiff%,rowbytes%,pbuff% CALL plancnv%,rowbytes%,plbuff%,pbuff% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),pbuff% = TRUE : REM Mac PICT 8bpp DEF FN1850(z%()) CALL readiff%,rowbytes%,plbuff% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),plbuff% = TRUE : REM Mac PICT 24/32bpp DEF FN1851(z%()) CALL readiff%,rowbytes%,plbuff% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% = TRUE : REM 1-8bpp planar RLE'd: PCX DEF FN1900(z%()) CALL readline%,plbytes%,rep%,pix%,plbuff% CALL plancnv%,rowbytes%,plbuff%,pbuff% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),pbuff% = TRUE : REM 1-8bpp packed RLE'd: Targa DEF FN2000(z%()) X%=buff% REPEAT C%=BGET#c% IF C%<128 THEN C%+=1 SYS 12,4,c%,X%,C% X%+=C% ELSE F%=X% ?F%=BGET#c% FOR C%=C% TO 128 STEP -1 ?X%=?F% X%+=1 NEXT ENDIF UNTIL X%=buff%+rowbytes% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),buff% = TRUE : REM 16bpp packed RLE'd: Targa DEF FN2001(z%()) X%=buff% REPEAT C%=BGET#c% IF C%<128 THEN C%=(C%+1)*2 SYS 12,4,c%,X%,C% X%+=C% ELSE F%=X% SYS 12,4,c%,X%,2 FOR C%=C% TO 128 STEP -1 !X%=!F% X%+=2 NEXT ENDIF UNTIL X%=buff%+rowbytes% CALL mappix%,z%(1,0),rpal%(0),gpal%(0),r%(0),g%(0),b%(0),buff%,buff% = TRUE : REM 24/32bpp packed RLE'd: Targa DEF FN2002(z%()) X%=buff% REPEAT C%=BGET#c% IF C%<128 THEN C%=(C%+1)*step24 SYS 12,4,c%,X%,C% X%+=C% ELSE F%=X% SYS 12,4,c%,X%,step24 FOR C%=C% TO 128 STEP -1 !X%=!F% X%+=step24 NEXT ENDIF UNTIL X%=buff%+rowbytes% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% = TRUE : REM Irlam YUV 411 DEF FN2250(z%()) CALL mappix%,z%(1,0),rpal%(0),r%(0),gpal%(0),g%(0),bpal%(0),b%(0),table%(0),buff% buff%+=rowbytes% rowstogo%-=1 IF rowstogo%=0 PROCrefill = TRUE : REM 24bpp: Utah RLE DEF FN2300(z%()) IF clrfirst% FOR X%=0 TO sx%-1:rb%?X%=?back%:gb%?X%=back%?1:bb%?X%=back%?2:NEXT IF vrep% THEN vrep%-=1 ELSE LOCAL ERROR ON ERROR LOCAL vrep%=-1:CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb%:= TRUE E%= FALSE REPEAT C%=BGET#c% D%=BGET#c% IF C% AND &40 D%=FNHW CASE C% AND &3f OF WHEN 1 E%= TRUE vrep%=D%-1 IF vrep%<0 vrep%= FALSE WHEN 2 ccol%=back%?D% cbuf%=rb%+sx%*D% IF D%=255 cbuf%=alpha% WHEN 3 FOR X%=0 TO D%-1 cbuf%?X%=ccol% NEXT cbuf%+=D% WHEN 5 SYS 12,4,c%,cbuf%,D%+1 cbuf%+=D%+1 IF D%+1 AND 1 IF BGET#c% WHEN 6 C%=FNHW FOR X%=0 TO D% cbuf%?X%=C% NEXT cbuf%+=D%+1 ENDCASE UNTIL E% ENDIF CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% = TRUE : REM 8 bpp rle compressed MicroSoft BM DEF FN2401(z%()) CALL bm_rle8,rowbytes%,plbuff% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),plbuff% = TRUE : REM 4 bpp rle compressed MicroSoft BM DEF FN2402(z%()) CALL bm_rle4,rowbytes%,plbuff% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),plbuff% = TRUE : REM 24bpp CCIR601 422 DEF FN3000(z%()) CALL mappix%,z%(1,0),rpal%(0),r%(0),gpal%(0),g%(0),bpal%(0),b%(0),table%(0),buff% buff%+=rowbytes% rowstogo%-=1 IF rowstogo%=0 PROCrefill = TRUE : REM « » DEF FN3500(z%()) = TRUE : REM « » DEF FN3600(z%()) CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% rb%+=rowbytes% gb%+=rowbytes% bb%+=rowbytes% rowstogo%-=1 IF rowstogo%=0 PROCrefillpcd = TRUE : REM « » DEF FN3708(z%()) REM Greyscale output R=G=B (8bpp) A%=jpegspace% jpegy%-=1 B%=jpegy% rb%=USR (jpeg%+4) CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb% = TRUE : REM « » DEF FN3724(z%()) REM Colour output (24bpp) A%=jpegspace% jpegy%-=1 B%=jpegy% rb%=USR (jpeg%+4) gb%=rb%+1 bb%=rb%+2 CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% = TRUE : REM « » DEF FN4008(z%()) A%=pngblk% B%=c% C%=pngy%:pngy%+=1 D%=sy% E%=pngbuff% rb%=USR (png%+4):REM Decompress a line of 8bpp-equivalent CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb% = TRUE : REM « » DEF FN4024(z%()) A%=pngblk% B%=c% C%=pngy%:pngy%+=1 D%=sy% E%=pngbuff% rb%=USR (png%+4):REM Decompress a line of 24bpp-equivalent gb%=rb%+gbo% bb%=rb%+bbo% CALL mappix%,z%(1,0),r%(0),g%(0),b%(0),rb%,gb%,bb% = TRUE : REM « » DEF PROCrewind rows%=sy% CASE flag OF WHEN 0 PTR#c%=st% WHEN 100 PTR#c%=4 WHEN 200 PTR#c%=st% rep%=0 WHEN 300 PTR#c%=st% PTR#cc%=stcc% WHEN 400 PTR#c%=st% rep%=0 WHEN 500 FOR I%=0 TO clearcode%-1 table%(I%)=I% NEXT PTR#c%=st% !firstcode=0 !oldcode=0 !codesize=setcodes%+1 !stack=stk% !sp=stk% !maxcode=clearcode%+2 !maxcodesize=2*clearcode% !curbit=0 !lastbit=0 WHEN 501 buff%=datacache% WHEN 600 PTR#c%=&380 WHEN 700 PTR#c%=st% WHEN 800 PTR#c%=0 rep%=0 wt%=0 WHEN 801 PTR#c%=0 PTR#cc%=0 PTR#ccc%=0 rep1%=0 wt1%=0 rep2%=0 wt2%=0 rep3%=0 wt3%=0 WHEN 900 PTR#c%=0 WHEN 901 PTR#c%=0 PTR#cc%=0 PTR#ccc%=0 WHEN 902 PTR#c%=st% WHEN 1000 PTR#c%=st% pa%=ctable% rep%=0 rep2%=0 WHEN 1100 PTR#c%=st% rep%=0 WHEN 1200 PTR#c%=1600 WHEN 1300 PTR#c%=0 WHEN 1301 PTR#c%=0 PTR#cc%=0 PTR#ccc%=0 WHEN 1400 PTR#c%=st% vrep%=0 WHEN 1500 PTR#c%=st%(0) rowstogo%=striprows% stripptr=0 IF compression=5 THEN !firstcode=0 !oldcode=0 !codesize=setcodes%+1 !stack=stk% !sp=stk% !maxcode=clearcode%+2 !maxcodesize=2*clearcode% !curbit=0 !lastbit=0 ENDIF WHEN 1600 PTR#c%=st% WHEN 1700 PTR#c%=16 WHEN 1800,1850 PTR#c%=st% WHEN 1900 PTR#c%=128 rep%=-1 WHEN 2000 PTR#c%=st% WHEN 2100 PTR#c%=7 WHEN 2200 PTR#c%=st% WHEN 2250 PTR#c%=st% WHEN 2300 PTR#c%=st% vrep%=0 WHEN 2400 PTR#c%=st% WHEN 2500 PTR#c%=st% WHEN 2600 PTR#c%=st% WHEN 2700 PTR#c%=st% WHEN 2800 PTR#c%=st% WHEN 2900 PTR#c%=st% WHEN 3000 PTR#c%=0 WHEN 3600 pcdblk%!4=0 WHEN 3700 jpegy%=sy% WHEN 3900,3905 PTR#c%=st% WHEN 4000 pngy%=0 A%=pngblk% B%=buff% C%=datacache% D%=pngspace% E%=png1st% F%=bppbytes%+(bppbits%<<8) G%=pngsub% CALL (png%+0),st%(0):REM Prime the helper WHEN 4100 PTR#c%=st% ENDCASE IF cache% THEN IF flag=3600 THEN pcdblk%!12=cacherows% PROCrefillpcd IF cache%>=filesize% rowstogo%=-1 ELSE IF cache%=0 rb%=buff%+rbo%:gb%=buff%+gbo%:bb%=buff%+bbo% IF flag=1500 IF compression=5 rowstogo%=striprows% ENDIF ENDPROC : REM « » DEF PROCAssemble_Shell FOR I%=0 TO 2 STEP 2 P%=code% [ OPT I% .Shell_Call MOV R9,R0 REM save string address MOV R0,#0 MOV R1,#0 MOV R2,#0 MOV R3,#2 MOV R4,#0 MOV R5,#0 MOV R6,#0 MOV R7,#0 SWI "OS_SetEnv" STMFD R13!,{R0-R7, R12} REM Save BASIC's environment MOV R0,#0 MOV R1,#0 MOV R2,#0 MOV R3,#0 SWI "OS_Control" STMFD R13!,{R0-R3} REM Save BASIC's control MOV R0,#&10 MOV R1,#0 MOV R2,#0 SWI "OS_ChangeEnvironment" STMFD R13!,{R1,R2} REM Save BASIC's upcall handler LDR R3,[R14,#28] REM Magic useful value ! LDR R3,[R8,R3] REM Address of current end of work space STMFD R13!,{R3,R9,R14} REM Save parameters needed to restore world SUB R9,R13,#1024 REM Address of where to copy code to MOV R5,R9 ADR R6,Shell_Job ADR R4,Shell_Job_End .Shell_Copy LDR R2,[R6],#4 REM Copy the asm core program to the stack STR R2,[R5],#4 CMP R6,R4 BCC Shell_Copy MOV R0,#1 REM Selective flush SUB R2,R5,#4 MOV R1,R9 SWI &2006E REM XOS_SynchroniseCodeAreas MOV PC,R9 REM Call copied shell code .Shell_Job LDR R2,[R3,#-4]! REM Now copy BASIC's workspace upstairs STR R2,[R9,#-4]! CMP R3,#&8000 BHI Shell_Job STMFD R13!,{R9} ADR R0,Shell_Exit MOV R1,R9 MOV R2,#0 MOV R3,#2 MOV R4,#0 MOV R5,#0 MOV R6,#0 MOV R7,#0 SWI "OS_SetEnv" ADR R0,Shell_Error ADR R1,Shell_Buffer MOV R2,#0 MOV R3,#0 SWI "OS_Control" MOV R0,#&10 ADR R1,Shell_UpCall MVN R2,#0 SWI "OS_ChangeEnvironment" STR R13,Shell_Job_End LDR R0,[R13,#4*2] ADD R0,R0,R9 SUB R0,R0,#&8000 SWI "OS_CLI" .Shell_Exit MOV r0, #0 .Shell_Common STR r0, Shell_ErrorWord LDR R13,Shell_Job_End LDMFD R13!,{R8,R9,R10,R14} LDMFD R13!,{R1-R2} MOV R0,#&10 SWI "OS_ChangeEnvironment" LDMFD R13!,{R0-R3} SWI "OS_Control" LDMFD R13!,{R0-R7, R12} SWI "OS_SetEnv" MOV R1,#&8000 .Shell_Restore LDR R2,[R8],#4 STR R2,[R1],#4 CMP R1,R9 BCC Shell_Restore MOV R0,#1 REM Selective flush SUB R2,R1,#4 MOV R1,#&8000 SWI &2006E REM Ensure SYS dispatcher not in instr cache LDR R0,Shell_ErrorWord CMP R0,#0 REM Clears V MOVEQ PC,R14 CMP R0,#&80000000 CMNVC R0,#&80000000 REM If the error pointer is non zero, set V MOV PC,R14 .Shell_UpCall MOV PC,R14 REM Just stop them getting to BASIC's handler .Shell_Error ADR r0, Shell_Buffer + 4 B Shell_Common .Shell_Buffer REM Must be within copied area EQUD 0 EQUD &12345678 EQUS STRING$(128,CHR$13) EQUS STRING$(128,CHR$13) .Shell_ErrorWord EQUD 0 .Shell_Job_End EQUD 0 ] NEXT A%=Shell_Job_End+4 ENDPROC : REM « » DEF PROCsubtask(a$) IF task% THEN SYS "Wimp_StartTask",a$ ELSE REM we have all the memory already... DIM code% 1024 PROCAssemble_Shell $A%=a$ CALL Shell_Call ENDIF ENDPROC