Reimport of source file

This is a text version of former !RunImage,ffb revision 4.1.1.1 so CVS can sensibly diff it.
Not tagged.

.gitattributes

+bas/** gitlab-language=bbcbasic linguist-language=bbcbasic linguist-detectable=true
 *,ffb gitlab-language=bbcbasic linguist-language=bbcbasic linguist-detectable=true

bas/!RunImage

+REM >!Chars.!RunImage
+
+REM Copyright 2015 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 !Chars
+REM Copyright  Acorn Computers 1989,1990,1991
+
+DIM q% 255, C$(8), CharDef 8, buffer% &200
+
+DIM wid% 1024 : REM added to allow centring of font chars in the grid
+              : REM if curf% > -1 then each wid%!(4*i%) holds the width in millipoints of character code i.
+FOR i% = 0 TO 255: wid%!i% = 0: NEXT i%
+
+PROCms_load("chars:messages")
+
+LM%=16:RM%=16:BM%=16:TM%=16
+MXSP%=24:MYSP%=44
+FOR X%=0 TO 31
+ IF X%<=15 THEN C$(0)+=FNCH(X%,0) ELSE C$(8)+=FNCH(X%,0)
+ FOR Y%=1 TO 7:C$(Y%)+=FNCH(X%,Y%):NEXT
+NEXT
+R$=CHR$23+CHR$32+STRING$(8,CHR$0):C$(3)+=R$:C$(8)+=R$
+font$=$sysfont%:curf%=-1
+HotKey%=-1:REM Shift key
+!q%=10:q%!4=&502:q%!8=&400c1:q%!12=0
+SYS"Wimp_Initialise",300,&4B534154,FNms_1("Tsk",""),q% TO wimpversion%,TaskHandle
+
+SYS"Wimp_OpenTemplate",,"Chars:Templates"
+LOCAL ERROR
+ON ERROR RESTORE ERROR:SYS"Wimp_CloseTemplate":PROCms_end:ERROR ERR, REPORT$
+SYS"Wimp_LoadTemplate",,q%+4,0,0,-1,"Characters",0
+RESTORE ERROR
+SYS"Wimp_CloseTemplate"
+
+DIM InputVars 3*4-1, OutputVars 2*4-1
+InputVars!0=4:InputVars!4=5:InputVars!8=-1:REM XEigFactor, YEigFactor
+PROCReadModeVars
+
+q%!12=q%!4+LM%+31*MXSP%+16+RM%
+q%!8=q%!16-TM%-7*MYSP%-32-BM%
+SYS"Wimp_CreateWindow",,q%+4 TO WindowHandle
+!q%=WindowHandle:q%!28=-1
+PROCOpenWindow
+Null=0:Redraw=1:Open=2:Close=3:PointerLeaving=4:PointerEntering=5:MouseChange=6
+MenuSelect=9:MessageA=17:MessageB=18
+PollFlags=1<<Null
+
+HIMEM=END+1024:END=HIMEM+8*1024:HIMEM=END+3072
+menudata%=HIMEM
+REPEAT
+ SYS "Wimp_Poll",PollFlags,q% TO reason
+ CASE reason OF
+ WHEN Null: PROCCheckHotKey
+ WHEN Redraw: PROCRedrawWindow
+ WHEN Open: PROCOpenWindow
+ WHEN Close: PROCCloseWindow
+ WHEN PointerLeaving: PROCPointerLeaving
+ WHEN PointerEntering: PROCPointerEntering
+ WHEN MouseChange: PROCCheckMouse(!q%,q%!4,q%!8,q%!12,q%!16,q%!20)
+ WHEN MenuSelect: PROCdomenu(FALSE)
+ WHEN MessageA, MessageB: PROCMessage
+ ENDCASE
+UNTIL FALSE
+END
+
+DEFPROCCheckHotKey
+IsDown%=INKEY HotKey%
+IF IsDown% AND NOT WasDown% THEN
+ SYS "Wimp_GetPointerInfo",,q%
+ PROCDoChar
+ENDIF
+WasDown%=IsDown%
+ENDPROC
+
+DEFPROCRedrawWindow
+LOCAL ch%,F%
+SYS "Wimp_RedrawWindow",,q% TO flag%
+IFcurf%>-1 THEN
+ SYS "XFont_SetFont",curf%:SYS "Wimp_SetFontColours",,0,7 TO ;F%
+ IF F% AND 1 PROCfonterror(FALSE): ENDPROC
+ELSE
+ VDU23,17,7,4,MXSP%>>XEIG%;MYSP%>>YEIG%;0;
+ENDIF
+WHILE flag%
+ StartX%=q%!4+LM%-q%!20:StartY%=q%!16-TM%-q%!24
+ IFcurf%>-1 THEN
+  ox0%=(q%!28-StartX%)DIVMXSP%:IFox0%>31 ox0%=31
+  ox1%=(q%!36-StartX%)DIVMXSP%:IFox1%>31 ox1%=31
+  FOR Y%=1 TO 7:CY%=StartY%-24-Y%*MYSP%
+   IF CY%<q%!40+MYSP% AND CY%+MYSP%>=q%!32 THEN
+    FORX%=ox0%TOox1%
+      ch% = Y%*32+X%
+      SYS "XFont_Paint",,CHR$(ch%),&14,StartX%+X%*MXSP% + MXSP%DIV2 -(wid%!(4*ch%) DIV 800),CY% TO ;F%
+      IF F% AND 1 PROCfonterror : ENDPROC
+    NEXT
+   ENDIF
+  NEXT
+ ELSE
+ FOR Y%=0 TO 7:CY%=StartY%-Y%*MYSP%
+  IF CY%<q%!40+31 AND CY%>=q%!32 THEN
+   MOVE StartX%,CY%:PRINT C$(Y%);:IF Y%=0 PRINT C$(8);
+  ENDIF
+ NEXT
+ ENDIF
+ SYS "Wimp_GetRectangle",,q% TO flag%
+ENDWHILE
+IF curf%>-1 THEN
+ELSE
+ VDU23,17,7,4,16>>XEIG%;32>>YEIG%;0;
+ENDIF
+ENDPROC
+
+DEFPROCOpenWindow
+SYS"Wimp_OpenWindow",,q%
+ENDPROC
+
+DEFPROCCloseWindow
+IFcurf%>-1 SYS "XFont_LoseFont",curf%:curf%=-1
+PROCms_end
+SYS"Wimp_CloseDown"
+END
+ENDPROC
+
+DEFPROCPointerLeaving
+PollFlags=PollFlags OR (1<<Null):REM No more null events
+ENDPROC
+
+DEFPROCPointerEntering
+PollFlags=PollFlags AND NOT (1<<Null):REM Enable null events
+WasDown%=INKEY HotKey%
+ENDPROC
+
+DEFPROCMessage
+CASE q%!16 OF
+WHEN 0:PROCCloseWindow
+WHEN 10: PROCsave_desktop_state
+WHEN &400C1:PROCReadModeVars
+WHEN &502:PROCDoHelp
+ENDCASE
+ENDPROC
+
+DEFFNCH(X%,Y%)
+C%=X%+Y%*32
+IF C%<32 OR C%=127 THEN
+ IF C%=127 THEN C%=ASC"?" ELSE C%=C% OR ASC"@"
+ CharDef?0=C%:SYS"OS_Word",10,CharDef
+ C$=CHR$23+CHR$32
+ FOR I%=1 TO 8
+  C$+=CHR$(CharDef?I% EOR &FF)
+ NEXT
+ C$+=" "
+ELSE
+ C$=CHR$C%
+ENDIF
+=C$
+
+DEFPROCReadModeVars
+LOCAL F%
+SYS"OS_ReadVduVariables",InputVars,OutputVars
+XEIG%=OutputVars!0:YEIG%=OutputVars!4
+IFcurf%>-1 THEN
+ SYS"XFont_LoseFont",curf%
+ SYS"XFont_FindFont",,a$,13*16,15*16 TO curf%; F%
+ IF F% AND 1 PROCfonterror: ENDPROC
+ENDIF
+ENDPROC
+
+DEFPROCCheckMouse(mousex%,mousey%,b%,handle%,icon%,ob%)
+IF b% AND 4 THEN
+ PROCDoChar
+ELSE
+ IF b% AND 2 THEN PROCpopupmenu
+ENDIF
+ENDPROC
+
+DEF PROCpopupmenu
+LOCAL A%
+SYS "Hourglass_On"
+SYS "Font_ListFonts",,0,7<<19,,0,,FNf(font$) TO ,,,size1%,,size2%
+SYS "Wimp_SlotSize",menudata%+size1%+size2%-&8000,-1 TO A%
+IF A%+&8000<menudata%+size1%+size2% THEN ERROR 224,FNms_1("MenuSpc","")
+menustrings%=menudata%+size1%
+SYS "Font_ListFonts",,menudata%,7<<19,size1%,menustrings%,size2%,FNf(font$)
+SYS "Hourglass_Off"
+A%=menudata%?12
+
+REM $menudata% = LEFT$(FNms_1("Menu",""),12)
+
+REM menudata%!(28+12)=sysfont%
+REM menudata%!16 = FNmax(menudata%!16,FNmax(LEN$menudata%-3,LEN$sysfont%)*16+12)
+REMmenudata%?12=A%
+SYS "Wimp_CreateMenu",,menudata%,mousex%-102,mousey%+64
+ENDPROC
+
+DEF FNmax(A%,B%) IF A%>B% THEN =A% ELSE =B%
+
+DEF FNf(font$) IF font$=$sysfont% THEN =1 ELSE =font$
+
+REM ** fake% = TRUE means that this call is not really in response
+REM ** to a menu hit.  We assume sysfont and ignore button 3 in this case.
+
+DEF PROCdomenu(fake%)
+LOCAL i%,w%,F%
+IF fake% OR !q%=0 THEN
+  a$=$sysfont%
+ELSE
+  SYS "Font_DecodeMenu",,menudata%,q%,STRING$(200,CHR$0),200 TO ,,,a$
+ENDIF
+IFa$<>"" AND a$<>font$ THEN
+  IFcurf%>-1 SYS "XFont_LoseFont",curf%:curf%=-1
+  font$=a$
+  IFa$<>$sysfont% THEN
+    SYS "XFont_FindFont",,a$,13*16,15*16 TO curf%; F%
+    IF F% AND 1 PROCfonterror: ENDPROC
+    REM set up the wid% array
+    SYS "Font_SetFont",curf%:SYS "Wimp_SetFontColours",,0,7
+    FOR i% = 32 TO 255
+      SYS "Font_StringWidth",,CHR$(i%),1000000,1000000,-1,1 TO ,,w%
+      wid%!(4*i%)=w%
+    NEXT i%
+  ENDIF
+  SYS "Wimp_ForceRedraw",WindowHandle,0,-1024,1280,0
+ENDIF
+IF NOT fake% THEN
+  SYS "Wimp_GetPointerInfo",,q%:IFq%?8AND1 PROCpopupmenu
+ENDIF
+ENDPROC
+
+DEFPROCDoChar
+IF q%!12=WindowHandle THEN
+ Char%=FNCoordsToChar(q%!0,q%!4)
+ IF Char%<>-1 THEN SYS"Wimp_ProcessKey",Char%
+ENDIF
+ENDPROC
+
+DEFPROCDoHelp
+MES$=""
+HisTaskHandle%=q%!4
+HisRef%=q%!8
+IF q%!32=WindowHandle THEN
+ Char%=FNCoordsToChar(q%!20,q%!24)
+ IF Char%<>-1 THEN
+  MES$=FNms_2("Help",STR$Char%,FNH(Char%))
+ ENDIF
+ELSE
+  IF wimpversion%>=218 AND q%!36<>-1 THEN MES$=FNms_1("MH","")
+ENDIF
+q%!0=((20+LENMES$+1)+3)ANDNOT3
+q%!12=HisRef%
+q%!16=&503
+$(q%+20)=MES$
+q%?(20+LENMES$)=0
+SYS"Wimp_SendMessage",MessageA,q%,HisTaskHandle%
+ENDPROC
+
+DEFFNCoordsToChar(MouseX%,MouseY%)
+!q%=WindowHandle
+SYS "Wimp_GetWindowState",,q%
+YOff%=(q%!16-TM%-q%!24+((MYSP%-32)>>1)-MouseY%)DIV MYSP%
+Char%=-1
+IF YOff%>=0 AND YOff%<=7 THEN
+ XOff%=(MouseX%-(q%!4+LM%-q%!20+((16-MXSP%)>>1)))DIV MXSP%
+ IF XOff%>=0 AND XOff%<=31 THEN
+  Char%=XOff%+YOff%*32
+ ENDIF
+ENDIF
+=Char%
+
+REM ** bodge alert
+REM ** get here if a Font_ swi returns an error.  Force return to
+REM ** system font with an error message.  We force any open menu shut
+REM ** because we don't know whether to re-encode our own menu (it may
+REM ** or may not be open -- can't tell!)
+
+DEF PROCfonterror
+LOCAL N$
+N$=FNms_1("Tsk","")
+SYS "XWimp_ReportError", FNms_1_error("FontErr","",999), 0, N$
+SYS "Wimp_CreateMenu", -1
+PROCdomenu(TRUE)
+ENDPROC
+
+DEFFNH(X%)=RIGHT$("0"+STR$~X%,2)
+
+DEF PROCms_load(name$)
+SYS "MessageTrans_FileInfo",,name$
+DIM ms_text% 256
+SYS "OS_Module",6,,,17+LEN(name$) TO ,,ms_desc%
+$(ms_desc%+16)=name$
+SYS "MessageTrans_OpenFile",ms_desc%,ms_desc%+16
+DIMsysfont% 28
+$sysfont% = FNms_1("Font","")
+ENDPROC
+
+DEF PROCms_end
+SYS "XMessageTrans_CloseFile",ms_desc%
+SYS "XOS_Module",7,,ms_desc%
+ENDPROC
+
+DEF FNms_1(tag$,arg1$)
+LOCAL L%
+REM non-X version; let it blow out with default message if token not found
+SYS "MessageTrans_Lookup",ms_desc%,tag$,ms_text%,256,arg1$ TO ,,,L%
+ms_text%?L%=13
+=$ms_text%
+
+DEF FNms_2(tag$,arg1$,arg2$)
+LOCAL L%
+REM non-X version; let it blow out with default message if token not found
+SYS "MessageTrans_Lookup",ms_desc%,tag$,ms_text%,256,arg1$,arg2$ TO ,,,L%
+ms_text%?L%=13
+=$ms_text%
+
+REM returns an error block instead
+DEF FNms_1_error(tag$,arg1$,errno%)
+LOCAL L%
+REM non-X version; let it blow out with default message if token not found
+SYS "MessageTrans_Lookup",ms_desc%,tag$,ms_text%+4,252,arg1$ TO ,,,L%
+ms_text%?(L%+4)=13
+!ms_text% = errno%
+=ms_text%
+
+DEFPROCsave_desktop_state
+LOCAL i%,l%
+LOCAL ERROR
+ON ERROR LOCAL q%!12=q%!8:SYS"Wimp_SendMessage",19,q%,q%!4:ENDPROC
+i%=q%!20
+SYS"XOS_ReadVarVal","Chars$Dir",buffer%,1024,0,3 TO ,,l%
+buffer%?l%=13
+BPUT#i%,"AddTinyDir "+$buffer%
+ENDPROC
+