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",,"<ChangeFSI$Dir>.Messages" TO,,S%
  DIM msgb% 16,msgf% S%
  SYS"MessageTrans_OpenFile",msgb%,"<ChangeFSI$Dir>.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",,"<ChangeFSI$Dir>.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%<size% largest_tem%=size%
    $name= "*"
    SYS "Wimp_LoadTemplate", ,0,,,,name,here% TO ,size%,,,,,here%
  ENDWHILE
=largest_tem%
:
REM  «  »
DEF PROCreceive(q%)
  CASE q%!16 OF
    WHEN 0
      PROCfinishandquit
    WHEN 1
      IF q%!20<>save% THEN
        !q%=60
        q%!12=q%!8
        q%!16=2
        q%!36=-1
        $(q%+44)="<Wimp$Scrap>"+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$+" <ChangeFSI$Dir>.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)="<Wimp$S" F$="JPEGImage"
      WHEN 1
        SYS &2002E,&10d,sar%,pixtrans%,255,1
        n$=FNZS(pixtrans%)
        SYS &2002E,&128,sar%,n$ TO ,,,x,y,,m
        IF (m<256 AND SGN(m)<>-1) THEN$adsm%=STR$ m ELSE$adsm%="&"+STR$~m
        $adsname%=n$
        $adsbytes%= STR$ sar%!12
        SYS &35,m,4 TO ,,nx
        x=x<<nx
        SYS &35,m,5 TO ,,ny
        y=y<<ny
        PROCgetmodeinfo
        $adsavesprite%="file_ff9"
        IF LEFT$(F$,7)="<Wimp$S" F$="SpriteFile"
      WHEN 2
        IF pngmono% THEN
          $adsname%="PNGMONO"
          $adsm%="Greyscale"
        ELSE
          $adsm%="Colour"
          $adsname%="PNG"
        ENDIF
        $adsbytes%=STR$ pngsize%
        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_b60"
        IF LEFT$(F$,7)="<Wimp$S" F$="PNGImage"
        SYS &2002E,&10d,sar%,pixtrans%,255,1
        n$=FNZS(pixtrans%)
        PROCgetmodeinfo
    ENDCASE
    !q%=save%
    q%!4=0
    q%!8=0
    q%!12=0
    SYS SetI,,q%
    $adran%=range$
    $adsrc%=info$+" "+FNmsg1("Proc",STR$(cputime% DIV 100)+decimal_point$+RIGHT$("0"+ STR$(cputime%MOD 100),2))
    saved%= FALSE
    sprite%= TRUE
    REM Get the leafname of F$ for the save box (so you don't overwrite the source),but have the full path in the title bar
    A%=LEN F$
    WHILE MID$("."+F$,A%,1)<>"."
      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<<dest%) AND 1
  spropt%=dest% AND 1
  pngopt%=(dest%>>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%)<<I%
          NEXT
          FOR I%=10 TO 13
            statescale%+=FNgeticonstate(scalew%,I%+6)<<I%
          NEXT
          stateproc%=0
          FOR I%=0 TO 7
            stateproc%+=FNgeticonstate(proc%,I%)<<I%
          NEXT
          stateoutput%=0
          FOR I%=0 TO 26
            stateoutput%+=FNgeticonstate(output%,I%)<<I%
          NEXT
          statejpeg%=0
          FOR I%=0 TO 3
            statejpeg%+=FNgeticonstate(jpego%,I%)<<I%
          NEXT
          pngstate%=0
          FOR I%=2 TO 15
            pngstate%+=FNgeticonstate(pngo%,I%)<<I%
          NEXT
          OSCLI"CDIR <Choices$Write>.ChangeFSI"
          A%= OPENOUT"<Choices$Write>.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%<<modexshift%
  topscr%=topscr%<<modeyshift%
  PROCgetw(handle%)
  IF isopen% THEN
    REM It's already open,so remember its top left corner
    xo%=isopen% AND &FFFF
    yo%=isopen% >>>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