REM > ChangeFSI REM REM Copyright 2016 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 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 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% 1023,paltemp% 1023,buffer% 267,idata% 1023 ELSE DIM z% 1699,q% 255,ifactors% 15,factors% 15,pixtrans% 255,paltemp% 1023,buffer% 267,idata% 2399 eidata%=idata%+2400 ENDIF scrap%= FALSE sprite%= FALSE sar%= -1 saved%= TRUE isopen%= FALSE lastm%= 0 z$= STRING$(12,CHR$13) SYS "Wimp_OpenTemplate",,".Templates" 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") !(z%+88+0*32+24)=1:REM force sprite area to be correct 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) pngo%=-1 PROCdotemplate("PNGOutput") SYS CreateW,,z% TO pngo% pngspecial%=!(z%+88+9*32+20) pngcomp%=!(z%+88+17*32+20) pngsize%=-1 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%="" $pngcomp%="5" $pngspecial%="" pngstate%=%1000000001000000 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) IF NOT EOF#A% THEN REM If there's more data, assume it relates to the PNG status INPUT#A%,$pngcomp%,$pngspecial%,pngstate% ELSE REM Old choices, use defaults $pngcomp%="5" $pngspecial%="" pngstate%=%1000000001000000 ENDIF CLOSE#A% ENDIF q%!12=1<<21 REM PNG choices display buttons !q%=pngo% q%!4=10 FOR J%=2 TO 15 q%!4=J% q%!8=((pngstate%>>J%) AND 1)<<21 SYS SetI,,q% NEXT !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 REM If kernel can't plot 4k/64k, fade on the frontend. This is because REM after processing the sprite is plotted using the kernel and will be REM shown grossly in error. In contrast, at the CLI, no plotting is done REM so it's OK to allow these outputs that way. kernspt%=%1111111100 SYS "XOS_ReadModeVariable",&79005051,9 TO,,m : REM Log2bpp 4k IF m<>4 THEN kernspt%=kernspt% AND NOT(1<<6) SYS "XOS_ReadModeVariable",&501680B5,9 TO,,m : REM Log2bpp 64k IF m<>4 THEN kernspt%=kernspt% AND NOT(1<<8) REM If monochrome, fade true colours IF (pngstate% AND (1<<11)) THEN !q%=pngo% q%!4=6 q%!8=1<<22 q%!12=1<<22 SYS SetI,,q% ENDIF !q%=output% q%!12=1<<22 FOR I%=6 TO 9 IF kernspt%>>I% AND1 q%!8=0 ELSE q%!8=1<<22 IF stateoutput%>>17 AND1 q%!8=1<<22 q%!4=I% SYS SetI,,q% NEXT PROCshowscaletofit $z%(0)="1" $z%(1)="1" SYS "OS_UpdateMEMC" TO oldmemc imgsave%= 1 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 CASE imgsave% OF WHEN 0:q%!40=&c85:q%!36=!sar%+3 WHEN 1:q%!40=&ff9:q%!36=!sar%+3 WHEN 2:q%!40=&b60:q%!36=pngsize% ENDCASE 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,TRUE,TRUE,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 CASE imgsave% OF WHEN 0:SYS "OS_File",10,FNZS(q%+44),&c85,,sar%,sar%+jpegsize% WHEN 1:SYS &2E,&10C,sar%,FNZS(q%+44) WHEN 2:base%=sar%:PROCsavepng(FNZS(q%+44)) ENDCASE $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%)) WHENpngo% $(q%+20)=FNmsg0("Hpng"+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=7) AND vram% THEN grey$="g" IF (q%!20=6) 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 imgsave%= dest% CASE dest% OF WHEN 0 A$="JPEG" IF FNgeticonstate(jpego%,2) A$="JPEGMONO" A$+=$adjpegq% WHEN 1 IF FNgeticonstate(output%,15) THEN A$+=$adspcl% ELSE IF FNgeticonstate(output%,16) THEN IF FNgeticonstate(output%,3) AND FNgeticonstate(output%,11) A$+="R" ELSE SYS 53,VAL A$,3 TO ,,A% IF A%=63 THEN IF FNgeticonstate(output%,5) THEN IF FNgeticonstate(output%,11) A$="27t":REM Square 256 IF FNgeticonstate(output%,10) A$="12t":REM Rect 256 ENDIF ELSE IF A%=255 A$+="d" ENDIF ENDIF ENDIF WHEN 2 REM basic PNG flavour pngmono%=FNgeticonstate(pngo%,11) IF pngmono% A$="PNGMONO" ELSE A$="PNG" REM colour/bit depth IF FNgeticonstate(pngo%,2) A$+="1" IF FNgeticonstate(pngo%,3) A$+="2" IF FNgeticonstate(pngo%,4) A$+="4" IF FNgeticonstate(pngo%,5) A$+="8" IF FNgeticonstate(pngo%,6) A$+="24" REM special options IF FNgeticonstate(pngo%,8) A$+=$pngspecial% REM compression A$+=","+$pngcomp% REM interlace IF FNgeticonstate(pngo%,10) A$+="i" ENDCASE 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%,FALSE,FALSE,sar%,FALSE) IF fast% SYS "OS_UpdateMEMC",oldmemc,&700 IF scrap% scrap%= FALSE :SYS "OS_File",6,F$ IF A%<2 AND sar%<>-1 THEN $adsx%= STR$xsp% $adsy%= STR$ysp% CASE imgsave% OF WHEN 0 $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)="-1) THEN$adsm%=STR$ m ELSE$adsm%="&"+STR$~m $adsname%=n$ $adsbytes%= STR$ sar%!12 SYS &35,m,4 TO ,,nx x=x<"." 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 IF FNgeticonstate(scalew%,1) A$+=" "+ STR$tofitx%+": "+ STR$tofity%+":" REM geticonstate(scalew%,2) no op 1:1 1:1 IF FNgeticonstate(scalew%,3) A$+=" 1:1 1:2" IF FNgeticonstate(scalew%,4) A$+=" 1:2 1:1" IF FNgeticonstate(scalew%,5) A$+=" 1:2" IF FNgeticonstate(scalew%,9) THEN REM Custom scaling 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 IF FNgeticonstate(scalew%,16) A$+=" -rotate" ELSE A$+=" -rotate-" ENDIF IF FNgeticonstate(scalew%,7) A$+=" -hflip" IF FNgeticonstate(scalew%,8) A$+=" -vflip" IF FNgeticonstate(proc%,0) A$+=" -range" IF FNgeticonstate(proc%,1) A$+=" -equal" IF FNgeticonstate(proc%,2) A$+=" -nodither" IF FNgeticonstate(proc%,3) A$+=" -invert" 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$,".") IF FNgeticonstate(proc%,7) A$+=" -sharpen"+$p%(2) 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 CASE imgsave% OF WHEN 0:SYS "OS_File",10,$adsave%,&c85,,sar%,sar%+jpegsize% WHEN 1:SYS &2E,&10C,sar%,$adsave% WHEN 2:base%=sar%:PROCsavepng($adsave%) ENDCASE SYS CrMenu,,-1 ENDPROC : REM « » DEF PROCsavepng(filename$) REM When calling from the front end we need to make REM sure that the palette arrays are available LOCAL r%(),g%(),b%() DIM r%(255),g%(255),b%(255) IF FNcreatePNG(filename$) ENDPROC : REM « » DEF PROCcheckmouse(mousex%,mousey%,b%,handle%,icon%,ob%) LOCAL moved%,sqr$,imenu$,pmenu$,spropt%,jpegopt%,pngopt% jpegopt%=(1<>1) AND 1 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%:spropt%,"+FNmsg0("Ijpg")+">jpego%:jpegopt%,"+FNmsg0("Ipng")+">pngo%:pngopt%,"+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%<>1 THEN dest%=1 spropt%=1 pngopt%=0 jpegopt%=0 PROCdomenu(101,imenu$,FNmsg0("_TaskName")):SYS Getcaret%,,q%:moved%= TRUE ENDIF IFFNgeticonstate(output%,11) THENsqr$="90" ELSEsqr$="45" CASE icon% OF WHEN 2,3,4,5 IFsqr$="90" THEN PROCkillcurrent(MID$("25262728",(2*icon%)-3,2)) ELSE PROCkillcurrent(MID$(" 0 81215",(2*icon%)-3,2)) ENDIF !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% WHEN 6 PROCkillcurrent("S12,90,"+sqr$) !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% WHEN 7 PROCkillcurrent("S15,90,"+sqr$) !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% WHEN 8 PROCkillcurrent("S16,90,"+sqr$) !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% WHEN 9 PROCkillcurrent("S32,90,"+sqr$) !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% WHEN 10,11 REM The dpi changed, simulate a colour click to force a mode recalc FOR I%=2 TO 9 IFFNgeticonstate(output%,I%) PROCcheckmouse(0,0,b%,output%,I%,0):I%=10 NEXT WHEN 15 REM 'Special' PROCkillcurrent(FNdeducemode) SYS SetI,,q% SYS Caretpos%,output%,19,,,-1,LEN ($adspcl%) !q%=output% q%!8=0 q%!12=1<<22 FOR I%=6 TO 9 IF kernspt%>>I% AND1 q%!8=0 ELSE q%!8=1<<22 q%!4=I% SYS SetI,,q% NEXT WHEN 16 REM 'Colour' PROCkillcurrent(FNdeducemode) !q%=output% q%!8=0 q%!12=1<<22 FOR I%=6 TO 9 IF kernspt%>>I% AND1 q%!8=0 ELSE q%!8=1<<22 q%!4=I% SYS SetI,,q% NEXT WHEN 17 REM 'Monochrome' PROCkillcurrent(FNdeducemode) !q%=output% q%!8=1<<22 q%!12=1<<22 FOR I%=6 TO 9 q%!4=I% SYS SetI,,q% NEXT IF LEFT$($admode%,1) = "S" THEN IF RIGHT$($admode%,2) = "45" THEN PROCkillcurrent("15") ELSE PROCkillcurrent("28") ENDIF !q%=output% q%!4=18 q%!8=0 q%!12=1<<21 SYS SetI,,q% q%!4=24 SYS SetI,,q% 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%<>0 THEN SYS Getcaret%,,q% dest%=0 jpegopt%=1 pngopt%=0 spropt%=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 WHEN pngo% IF dest%<>2 THEN SYS Getcaret%,,q% dest%=2 jpegopt%=0 pngopt%=1 spropt%=0 PROCdomenu(101,imenu$,FNmsg0("_TaskName")) IF icon%=9 SYS Caretpos%,pngo%,q%!4,q%!8,q%!12,q%!16,q%!20 ENDIF CASE icon% OF WHEN 8,15 !q%=pngo% q%!4=6 q%!8=0 q%!12=1<<22 SYS SetI,,q% WHEN 11 !q%=pngo% IF FNgeticonstate(pngo%,6) THEN q%!4=5 q%!8=1<<21 q%!12=1<<21 SYS SetI,,q% ENDIF q%!4=6 q%!8=1<<22 q%!12=3<<21 SYS SetI,,q% WHEN 19 IF b% AND 4 I%=VAL($pngcomp%)+1 ELSE I%=VAL($pngcomp%)-1 IF I%<0 I%=0 ELSE IF I%>9 I%=9 $pngcomp%=STR$I% !q%=pngo% q%!4=17 q%!8=0 q%!12=0 SYS SetI,,q% WHEN 18 IF b% AND 4 I%=VAL($pngcomp%)-1 ELSE I%=VAL($pngcomp%)+1 IF I%<0 I%=0 ELSE IF I%>9 I%=9 $pngcomp%=STR$I% !q%=pngo% q%!4=17 q%!8=0 q%!12=0 SYS SetI,,q% 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$=$adsavesprite% 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+10*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 F$="PNGImage")) 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("Ipng") dest%=2 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) PRINT#A%,$pngcomp%,$pngspecial%,pngstate% 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% CASE imgsave% OF WHEN 0 IF jpegpaint% SYS jpegpaint%,sar%,bx%,by%,factors%,jpegsize%,1 TO ;V%:IF (V% AND 1)=0 ELSE CLG WHEN 1 SYS &2002E,&134,sar%,n$,bx%,by%,,factors%,spx% WHEN 2 SYS &2002E,&134,sar%,n$,bx%,by%,(1<<5) OR (1<<6),factors%,spx% ENDCASE 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 CASE imgsave% OF WHEN 0 SYS &35,-1,4 TO ,,nx SYS &35,-1,5 TO ,,ny !ifactors%=1 ifactors%!4=1 ifactors%!8=nx ifactors%!12=ny ENDPROC WHEN 1 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 WHEN 2 SYS"ColourTrans_GenerateTable",256,sar%+sar%!8,-1,-1,pixtrans%,(1<<0) OR (1<<4) spx%=pixtrans% ENDCASE ENDPROC : REM « » DEF FNdeducemode LOCAL n,m,f,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) IF m=4 THEN SYS &35,-1,3 TO ,,n:REM ncolour SYS &35,-1,0 TO ,,f:REM modeflags IF n=4095 THEN f=4 ELSE IF n=65535 AND (f AND 128)=0 THEN f=1 ELSE f=0 ENDIF ="S"+ STR$((2^m)-f)+","+ 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,dpi%,col% $admode%=FNdeducemode CASE ?admode% OF WHEN ASC "S" IF VAL MID$($admode%,5)>VAL MID$($admode%,8) dpi%=45 ELSE dpi%=90 col%=6+INSTR("12151632",MID$($admode%,2,2))DIV2 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% dpi%=90 : col%=12 : REM So no radio button is selected. OTHERWISE 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 dpi%=45 ELSE dpi%=90 SYS &35,m,9 TO ,,y col%=2+y ENDCASE tofitx%+=1 tofity%+=1 $adscale%=FNmsg2("ScaleFill",STR$tofitx%,STR$tofity%) q%!12=1<<21 !q%=output% q%!4=10 : IF dpi%=45 THEN q%!8=1<<21 ELSE q%!8=0 SYS SetI,,q% q%!4=11 : IF dpi%=90 THEN q%!8=1<<21 ELSE q%!8=0 SYS SetI,,q% FOR I%=2 TO 9 IF I%=col% q%!8=1<<21 ELSE q%!8=0 q%!4=I% SYS SetI,,q% NEXT IF col%=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