Beginner's Guide to WIMP
Programming
Martyn Fox

Appendix: Listing of the Final Version of the Shapes !RunImage File

   10 REM >!RunImage
   20 REM (C) Martyn Fox
   30 REM shape drawing program
   40 REM based on Wimp shell program v0.01
   50 version$="0.01 (date)"
   60 ON ERROR SYS "Wimp_CloseDown",task%,&4B534154:REPORT:PRINT" at line ";ERL:END
   70 SYS "Wimp_Initialise",200,&4B534154,"Shapes" TO ,task%
   80 PROCinit
   90 PROCcreateicon
  100 PROCcommand
  110 ON ERROR IF FNerror THEN PROCclose:END
  120 REPEAT
  130   PROCpoll
  140 UNTIL quit%
  150 PROCclose
  160 END
  170 :
  180 DEFPROCcreateicon
  190 REM creates the application's icon and puts it on the icon bar
  200 !b%=-1:b%!4=0:b%!8=0:b%!12=68:b%!16=68:b%!20=&3002
  210 $(b%+24)="!shapes":SYS"Wimp_CreateIcon",,b% TO i%
  220 ENDPROC
  230 :
  240 DEFPROCclose
  250 REM tells the Wimp to quit the application
  260 ON ERROR OFF
  270 PROClose_fonts
  280 SYS "Wimp_CloseDown",task%,&4B534154
  290 ENDPROC
  300 :
  310 DEFPROCpoll
  320 REM main program Wimp polling loop
  330 SYS "Wimp_Poll",&3831,b% TO r%
  340 CASE r% OF
  350   WHEN 1:PROCredraw(b%)
  360   WHEN 2:SYS "Wimp_OpenWindow",,b%
  370   WHEN 3:PROCclose_window
  380   WHEN 6:PROCmouseclick
  390   WHEN 7:PROCdragend
  400   WHEN 8:PROCkeypress
  410   WHEN 9:PROCmenuclick
  420   WHEN 17,18:PROCreceive
  430 ENDCASE
  440 ENDPROC
  450 :
  460 DEFPROCmouseclick
  470 REM handles mouse clicks in response to Wimp_Poll reason code 6
  480 REM b%!0=mousex,b%!4=mousey:b%!8=buttons:
      b%!12=window handle (-2 for icon bar):b%!16=icon handle
  490 CASE b%!12 OF
  500   WHEN -2:CASE b%!8 OF
  510     WHEN 2:PROCshowmenu(mainmenu%,!b%-64,96+2*44):
                 REM replace '2' with number of main menu items
  520     WHEN 4:!b%=main%:SYS "Wimp_GetWindowState",,b%:
                 b%!28=-1:SYS "Wimp_OpenWindow",,b%
  530   ENDCASE
  540   WHEN main%:PROCwindow_click
  550   WHEN options%:PROCopt_box(b%!8,b%!16)
  560   WHEN saveas%:PROCsavebox
  570   WHEN quitwind%:
  580     CASE b%!16 OF
  590       WHEN 0:IF shutdown%:PROCreply ELSE quit%=TRUE
  600     OTHERWISE
  610       SYS "Wimp_CreateMenu",,-1
  620     ENDCASE
  630 ENDCASE
  640 ENDPROC
  650 :
  660 DEFPROCget_origin(handle%,RETURN xorig%,RETURN yorig%)
  670 REM returns coordinates of window work area origin
  680 LOCAL c%
  690 c%=FNstack(36)
  700 !c%=handle%
  710 SYS "Wimp_GetWindowState",,c%
  720 xorig%=c%!4-c%!20:yorig%=c%!16-c%!24
  730 PROCunstack(c%)
  740 ENDPROC
  750 :
  760 DEFFNstack(size%)
  770 REM allocates temporary memory from stack block
  780 REM stack must be cleared after use with PROCunstack
  790 IF stackptr%+size%>stackend%  ERROR 1,"No room in stack"
  800 stackptr%+=size%
  810 =stackptr%-size%
  820 :
  830 DEFPROCunstack(old_ptr%)
  840 REM removes temporary memory from stack
  850 stackptr%=old_ptr%
  860 IF stackptr%<stack% stackptr%=stack%
  870 ENDPROC
  880 :
  890 DEFFNmake_menu
  900 REM creates menu block from DATA statements
  910 LOCAL start%,title$,item$,ul%,tail$,writable%,buffer%,buflen%
  920 start%=menspc%
  930 READ title$
  940 $(start%)=title$
  950 start%?12=7:REM title foreground colour
  960 start%?13=2:REM title background colour
  970 start%?14=7:REM work area foreground colour
  980 start%?15=0:REM work area background colour
  990 start%!20=44:REM height of menu items
 1000 start%!24=0:REM gap between items
 1010 width%=LEN(title$)-3
 1020 menspc%+=28
 1030 REPEAT
 1040   READ item$
 1050   IF item$<>"*" THEN
 1060     !menspc%=0
 1070     writable%=FALSE
 1080     ul%=INSTR(item$,"_")
 1090     IF ul% THEN
 1100       tail$=RIGHT$(item$,LEN(item$)-ul%)
 1110       IF INSTR(tail$,"T") !menspc%=!menspc% OR 1:REM tick
 1120       IF INSTR(tail$,"D") !menspc%=!menspc% OR 2:REM dotted line
 1130       IF INSTR(tail$,"W") !menspc%=!menspc% OR 4:
            writable%=TRUE:READ buffer%:READ buflen%:REM writable icon
 1140       IF INSTR(tail$,"M") !menspc%=!menspc% OR 8:REM generate message
 1150       item$=LEFT$(item$,ul%-1)
 1160     ENDIF
 1170     IF LENitem$>width% width%=LENitem$
 1180     menspc%!4=-1:REM submenu ptr
 1190     IF writable% THEN
 1200       menspc%!8=&0700F121:menspc%!12=buffer%:
            menspc%!16=-1:menspc%!20=buflen%:$buffer%=item$
 1210       ELSE
 1220       IF LENitem$<12 THEN
 1230         menspc%!8=&07000021:$(menspc%+12)=item$
 1240         ELSE
 1250         menspc%!8=&07000121:menspc%!12=ws%:menspc%!16=-1:menspc%!20=LENitem$+1
 1260         $ws%=item$:ws%+=LENitem$+1
 1270       ENDIF
 1280     ENDIF
 1290     menspc%+=24
 1300   ENDIF
 1310 UNTIL item$="*"
 1320 start%!16=width%*16+32
 1330 !(menspc%-24)=!(menspc%-24) OR &80
 1340 mptr%=menspc%
 1350 =start%
 1360 :
 1370 DEFPROCload_templates
 1380 REM opens window template file, loads and creates window
 1390 SYS "Wimp_OpenTemplate",,"<Shapes$Dir>.Templates"
 1400 REM ****** load and create Info box ******
 1410 SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"progInfo",0 TO ,,ws%
 1420 $stack%!(88+32*0+20)=version$
 1430 SYS "Wimp_CreateWindow",,stack% TO info%
 1440 REM ****** load and create main window ******
 1450 SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"Main",0 TO ,,ws%
 1460 titlebuf%=!(stack%+72):PROCterm(titlebuf%)
 1470 SYS "Wimp_CreateWindow",,stack% TO main%
 1480 REM ****** load and create Options dialogue box ******
 1490 SYS "Wimp_LoadTemplate",,menspc%,ws%,wsend%,-1,"Options",0 TO ,,ws%
 1500 textbuf%=!(menspc%+88+32*7+20)
 1510 SYS "Wimp_CreateWindow",,menspc% TO options%
 1520 REM ****** load and create Save box ******
 1530 SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"xfer_send",0 TO ,,ws%
 1540 savestr%=!(stack%+88+32*2+20)
 1550 SYS "Wimp_CreateWindow",,stack% TO saveas%
 1560 REM ****** load and create Quit dialogue box ******
 1570 SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"quit",0 TO ,,ws%
 1580 SYS "Wimp_CreateWindow",,stack% TO quitwind%
 1590 REM ****** end of window creation ******
 1600 SYS "Wimp_CloseTemplate"
 1610 ENDPROC
 1620 :
 1630 DEFPROCattach(menu%,item%,sub%)
 1640 REM attach submenu or dialogue box to main menu
 1650 !(menu%+28+item%*24+4)=sub%
 1660 ENDPROC
 1670 :
 1680 DEFPROCinit
 1690 REM initialisation before polling loop starts
 1700 DIM b% 255,ws% 2047,menspc% 2047,stack% 1023,list% 2047,ptsize% 12,fontname% 50
 1710 $ptsize%=""
 1720 $fontname%="Trinity.Medium"
 1730 wsend%=ws%+2048:stackend%=stack%+1024:stackptr%=stack%:
      menend%=menspc%+2048:fontlist%=list%+1024
 1740 quit%=FALSE:printing%=FALSE:changed%=FALSE
 1750 colsel%=7
 1760 PROCload_templates
 1770 !list%=-1:!fontlist%=-1
 1780 PROCmenus
 1790 !b%=main%:SYS "Wimp_GetWindowState",,b%:SYS "Wimp_OpenWindow",,b%
 1800 ENDPROC
 1810 :
 1820 DEFPROCreceive
 1830 REM handles messages received from the Wimp with reason codes 17 or 18
 1840 CASE b%!16 OF
 1850   WHEN 0:quit%=TRUE
 1860   WHEN 2:PROCsave
 1870   WHEN 3:PROCload
 1880   WHEN 5:PROCdata_open
 1890   WHEN 8:PROCprequit
 1900   WHEN &400C0:PROCmenu_message
 1910 ENDCASE
 1920 ENDPROC
 1930 :
 1940 DEFPROCwindow_click
 1950 REM handles mouse clicks on window
 1960 REM b%!0=mousex,b%!4=mousey:b%!8=buttons:
      b%!12=window handle (-2 for icon bar):b%!16=icon handle
 1970 CASE b%!8 OF
 1980   WHEN 2:PROCshowmenu(wmenu%,!b%,b%!4)
 1990   WHEN 1:PROCdelete_item
 2000   WHEN 4:PROCadd_item
 2010 ENDCASE
 2020 ENDPROC
 2030 :
 2040 DEFPROCmenus
 2050 REM create menus and attach submenus and dialogue boxes
 2060 PROCmain_menu
 2070 PROCattach(mainmenu%,0,info%)
 2080 PROCwindow_menu
 2090 PROCfont_size_menu
 2100 PROCattach(wmenu%,2,saveas%)
 2110 PROCattach(wmenu%,3,1)
 2120 PROCattach(wmenu%,4,fmenu%)
 2130 $savestr%="ShapeFile"
 2140 ENDPROC
 2150 :
 2160 DEFPROCshowmenu(menu%,x%,y%)
 2170 REM opens menu at given coordinates
 2180 topmenu%=menu%:topx%=x%:topy%=y%
 2190 SYS "Wimp_CreateMenu",,menu%,x%,y%
 2200 ENDPROC
 2210 :
 2220 DEFPROCmenuclick
 2230 REM handles mouse clicks on menu in response to Wimp_Poll reason code 9
 2240 LOCAL c%,adj%
 2250 c%=FNstack(36)
 2260 SYS "Wimp_GetPointerInfo",,c%
 2270 adj%=(c%!8 AND 1)
 2280 SYS "Wimp_DecodeMenu",,topmenu%,b%,c%
 2290 CASE $c% OF
 2300   WHEN "Quit":IF changed% shutdown%=FALSE:!c%=quitwind%:
                    SYS "Wimp_GetWindowState",,c%:
                    PROCshowmenu(quitwind%,c%!4,c%!16) ELSE quit%=TRUE
 2310   WHEN "Options...  F2":!c%=options%:SYS "Wimp_GetWindowState",,c%:
             SYS "Wimp_OpenWindow",,c%
 2320   WHEN "Clear":PROCclear
 2330   WHEN "Save        F3":PROCchecksave
 2340   WHEN "Print    PRINT":PROCprint
 2350   OTHERWISE
 2360     IF LEFT$($c%,5)="Font.":PROCpick_font
 2370 ENDCASE
 2380 IF adj% PROCshowmenu(topmenu%,topx%,topy%)
 2390 PROCunstack(c%)
 2400 ENDPROC
 2410 :
 2420 DEFPROCmain_menu
 2430 REM creates main menu, calling FNmake_menu
 2440 RESTORE +1
 2450 DATA Shapes,Info,Quit,*
 2460 mainmenu%=FNmake_menu
 2470 ENDPROC
 2480 :
 2490 DEFPROCredraw(b%)
 2500 REM redraws window contents
 2510 LOCAL xorig%,yorig%,more%
 2520 PROCget_origin(!b%,xorig%,yorig%)
 2530 SYS "Wimp_RedrawWindow",,b% TO more%
 2540 WHILE more%
 2550   PROCdraw(b%,xorig%,yorig%)
 2560   SYS "Wimp_GetRectangle",,b% TO more%
 2570 ENDWHILE
 2580 ENDPROC
 2590 :
 2600 DEFPROCdraw(b%,xorig%,yorig%)
 2610 REM called when all or part of window needs redrawing
 2620 REM xorig% and yorig% are coordinates of work area origin 
      (top left-hand corner of window work area)
 2630 REM b% points to block:
 2640 REM b%!0  : window handle
 2650 REM b%!4  : visible area minimum x coordinate
 2660 REM b%!8  : visible area minimum y coordinate
 2670 REM b%!12 : visible area maximum x coordinate
 2680 REM b%!16 : visible area maximum y coordinate
 2690 REM b%!20 : scroll x offset relative to work area origin
 2700 REM b%!24 : scroll y offset relative to work area origin
 2710 REM b%!28 : current graphics window minimum x coordinate
 2720 REM b%!32 : current graphics window minimum y coordinate
 2730 REM b%!36 : current graphics window maximum x coordinate
 2740 REM b%!40 : current graphics window maximum y coordinate
 2750 LOCAL coords%,colour%,plot%
 2760 MOVE xorig%,yorig%
 2770 coords%=list%
 2780 WHILE !coords%<>-1
 2790   PROCplot_shape(!coords%,x%,y%,colour%,plot%)
 2800   IF plot%=0 THEN
 2810     PROCtext(xorig%+x%,yorig%-y%,colour%,coords%)
 2820   ELSE
 2830     SYS "Wimp_SetColour",colour%
 2840     PLOT plot%,xorig%+x%,yorig%-y%
 2850     coords%+=4
 2860   ENDIF
 2870 ENDWHILE
 2880 ENDPROC
 2890 :
 2900 DEFPROCplot_shape(word%,RETURN x%,RETURN y%,RETURN colour%,RETURN plot%)
 2910 REM returns parameters of object to be plotted, decoded from word%
 2920 x%=(word% AND &3FF)*4:y%=(word%>>12) AND &FFC
 2930 colour%=(word%>>10) AND &F
 2940 plot%=(word%>>24) AND &FF
 2950 ENDPROC
 2960 :
 2970 DEFPROCwindow_menu
 2980 RESTORE +1
 2990 DATA Shapes,Options...  F2,Clear,Save        F3,Font_M,Font size,Print    PRINT,*
 3000 wmenu%=FNmake_menu
 3010 ENDPROC
 3020 :
 3030 DEFFNicon_state(window%,icon%)
 3040 LOCAL c%
 3050 c%=FNstack(40)
 3060 !c%=window%
 3070 c%!4=icon%
 3080 SYS "Wimp_GetIconState",,c%
 3090 PROCunstack(c%)
 3100 =((c%!24) AND (1<<21))<>0
 3110 :
 3120 DEFPROCadd_item
 3130 SYS "Wimp_SetCaretPosition",main%,-1,0,0,1<<25,-1
 3140 x%=!b%:y%=b%!4
 3150 PROCget_origin(main%,xorig%,yorig%)
 3160 coords%=FNend
 3170 IF coords%<list%+1020 THEN
 3180   CASE TRUE OF
 3190     WHEN FNicon_state(options%,0):plot%=4:REM MOVE
 3200     WHEN FNicon_state(options%,1):plot%=5:REM DRAW
 3210     WHEN FNicon_state(options%,2):plot%=157:REM CIRCLE FILL
 3220     WHEN FNicon_state(options%,3):plot%=101:REM RECTANGLE FILL
 3230     WHEN FNicon_state(options%,6):plot%=0:REM TEXT
 3240     OTHERWISE:plot%=4:REM MOVE - all icons deselected
 3250   ENDCASE
 3260   !coords%=(((x%-xorig%) AND &FFC) DIV 4)+((yorig%-y%) AND &FFC)*
        (1<<12)+(colsel% AND &F)*(1<<10)
 3270   coords%?3=plot%
 3280   IF plot%=0 PROCadd_text(coords%)
 3290   coords%!4=-1
 3300   PROCforce_redraw(main%)
 3310   PROCchanged
 3320 ENDIF
 3330 ENDPROC
 3340 :
 3350 DEFFNend
 3360 LOCAL n%
 3370 n%=list%
 3380 WHILE !n%<>-1
 3390   n%+=4
 3400 ENDWHILE
 3410 =n%
 3420 :
 3430 DEFPROCforce_redraw(window%)
 3440 LOCAL c%
 3450 c%=FNstack(36)
 3460 !c%=window%
 3470 SYS "Wimp_GetWindowState",,c%
 3480 SYS "Wimp_ForceRedraw",-1,c%!4,c%!8,c%!12,c%!16
 3490 PROCunstack(c%)
 3500 ENDPROC
 3510 :
 3520 DEFPROCdelete_item
 3530 SYS "Wimp_SetCaretPosition",main%,-1,0,0,1<<25,-1
 3540 coords%=FNend
 3550 IF coords%>list% THEN
 3560   coords%-=4
 3570   IF (!coords% AND &FF000000)=0 coords%-=!coords%:SYS "Font_LoseFont",coords%!4
 3580   !coords%=-1
 3590   PROCchanged
 3600 ELSE
 3610   VDU 7
 3620 ENDIF
 3630 PROCforce_redraw(main%)
 3640 ENDPROC
 3650 :
 3660 DEFPROCopt_box(button%,icon%)
 3670 CASE icon% OF
 3680   WHEN 0,1,2,3,6:
 3690   WHEN 5:
 3700     !b%=options%:b%!4=4
 3710     SYS "Wimp_GetIconState",,b%
 3720     colsel%=(b%!24)>>28
 3730     IF button%=4 SYS "Wimp_CloseWindow",,b%
 3740   WHEN 8:
 3750     !b%=options%:b%!4=4:b%!8=colsel%<<28:b%!12=&F<<28
 3760     SYS "Wimp_SetIconState",,b%
 3770     IF button%=4 SYS "Wimp_CloseWindow",,b%
 3780   OTHERWISE
 3790     !b%=options%:b%!4=icon%
 3800     SYS "Wimp_GetIconState",,b%
 3810     b%!4=4:b%!8=(b%!24) AND &F<<28:b%!12=&F<<28
 3820     SYS "Wimp_SetIconState",,b%
 3830 ENDCASE
 3840 ENDPROC
 3850 :
 3860 DEFPROCclear
 3870 PROClose_fonts
 3880 !list%=-1
 3890 PROCforce_redraw(main%)
 3900 ENDPROC
 3910 :
 3920 DEFFNerror
 3930 IF printing%:SYS "XPDriver_AbortJob",pfile%:SYS "Hourglass_Off":
      CLOSE#pfile%:printing%=FALSE
 3940 !b%=ERR
 3950 CASE !b% OF
 3960   WHEN 1<<30:err_str$="":box%=3
 3970   OTHERWISE:err_str$=" at line "+STR$ERL:box%=2
 3980 ENDCASE
 3990 $(b%+4)=REPORT$+err_str$+CHR$0
 4000 SYS "Wimp_ReportError",b%,box%,"Shapes" TO ,response%
 4010 =(response%=2)
 4020 :
 4030 DEFPROCload
 4040 IF b%!40<>&012 ERROR 1<<30,"Filetype not recognised"
 4050 PROCterm(b%+44)
 4060 PROClose_fonts
 4070 SYS "XOS_CLI","LOAD "+$(b%+44)+" "+STR$~list% TO err%;flags%
 4080 IF (flags% AND 1)<>0 !err%=1<<30:SYS "OS_GenerateError",err%
 4090 b%!12=b%!8
 4100 b%!16=4:REM Message_DataLoadAck
 4110 SYS "Wimp_SendMessage",17,b%,b%!4
 4120 $savestr%=$(b%+44)
 4130 PROCupdate_fonts
 4140 !b%=main%
 4150 SYS "Wimp_GetWindowState",,b%
 4160 IF ((b%!32) AND 1<<16)=0 THEN
 4170   SYS "Wimp_OpenWindow",,b%
 4180 ELSE
 4190   PROCforce_redraw(main%)
 4200 ENDIF
 4210 PROCunchanged
 4220 ENDPROC
 4230 :
 4240 DEFPROCterm(a%)
 4250 LOCAL n%
 4260 WHILE a%?n%>31
 4270   n%+=1
 4280 ENDWHILE
 4290 a%?n%=13
 4300 ENDPROC
 4310 :
 4320 DEFPROCsavebox
 4330 CASE b%!16 OF
 4340   WHEN 0:IF b%!8=1 OR b%!8=4 THEN PROCchecksave
 4350   WHEN 1:IF b%!8=16 OR b%!8=64 THEN PROCdrag(b%!12,1)
 4360 ENDCASE
 4370 ENDPROC
 4380 :
 4390 DEFPROCdrag(window%,icon%)
 4400 LOCAL c%
 4410 c%=FNstack(56)
 4420 PROCget_origin(window%,xorig%,yorig%)
 4430 !c%=window%:c%!4=icon%
 4440 SYS "Wimp_GetIconState",,c%
 4450 xmin%=xorig%+c%!8:ymin%=yorig%+c%!12:xmax%=xorig%+c%!16:ymax%=yorig%+c%!20
 4460 c%!4=5:REM drag type
 4470 c%!8=xmin%:REM coordinates of drag box
 4480 c%!12=ymin%
 4490 c%!16=xmax%
 4500 c%!20=ymax%
 4510 c%!24=0:REM screen min x
 4520 c%!28=0:REM screen min y
 4530 c%!32=4096:REM screen max x
 4540 c%!36=3072:REM screen max y
 4550 SYS "Wimp_DragBox",,c%
 4560 PROCunstack(c%)
 4570 ENDPROC
 4580 :
 4590 DEFPROCdragend
 4600 SYS "Wimp_GetPointerInfo",,b%
 4610 b%!20=b%!12:REM destination window handle
 4620 b%!24=b%!16:REM destination icon handle
 4630 b%!28=b%!0:REM destination x coordinate
 4640 b%!32=b%!4:REM destination y coordinate
 4650 b%!36=FNend+4-list%:REM length of data
 4660 a$=$savestr%:REM get leafname
 4670 WHILE INSTR(a$,".")<>0
 4680   n%=INSTR(a$,".")
 4690   a$=MID$(a$,n%+1)
 4700 ENDWHILE
 4710 $(b%+44)=a$:REM leafname of file
 4720 !b%=44+((LENa$+1) DIV 4)*4:REM length of block
 4730 IF ((LENa$+1) MOD 4)<>0 !b%+=4
 4740 b%!12=0:REM your_ref for original message
 4750 b%!16=1:REM Message_DataSave
 4760 SYS "Wimp_SendMessage",18,b%,b%!20
 4770 ENDPROC
 4780 :
 4790 DEFPROCsave
 4800 PROCterm(b%+44)
 4810 $savestr%=$(b%+44)
 4820 PROCsave2
 4830 b%!12=b%!8
 4840 b%!16=3:REM Message_DataLoad
 4850 SYS "Wimp_SendMessage",18,b%,b%!20
 4860 ENDPROC
 4870 :
 4880 DEFPROCsave2
 4890 n%=FNend2+4
 4900 SYS "XOS_CLI","SAVE "+$savestr%+" "+STR$~list%+" "+STR$~n% TO err%;flags%
 4910 IF (flags% AND 1)<>0 !err%=1<<30:SYS "OS_GenerateError",err%
 4920 SYS "XOS_CLI","SETTYPE "+$savestr%+" 012" TO err%;flags%
 4930 IF (flags% AND 1)<>0 !err%=1<<30:SYS "OS_GenerateError",err%
 4940 SYS "Wimp_CreateMenu",,-1
 4950 PROCunchanged
 4960 ENDPROC
 4970 :
 4980 DEFPROCchecksave
 4990 IF INSTR($savestr%,"::")<>0 AND INSTR($savestr%,"$.")<>0 THEN
 5000   PROCsave2
 5010 ELSE
 5020   SYS "Wimp_CreateMenu",,-1
 5030   ERROR 1<<30,"To save, drag the icon to a directory display"
 5040 ENDIF
 5050 ENDPROC
 5060 :
 5070 DEFPROCkeypress
 5080 REM processes keypresses in response to Wimp_Poll reason code 8
 5090 LOCAL key%
 5100 key%=b%!24
 5110 CASE key% OF
 5120   WHEN 13:
 5130     CASE TRUE OF
 5140       WHEN FNwind_open(saveas%):PROCpush(saveas%,0)
 5150       WHEN FNwind_open(options%):PROCpush(options%,5)
 5160     ENDCASE
 5170   WHEN 27:
 5180     CASE TRUE OF
 5190       WHEN FNwind_open(options%):!b%=options%:SYS "Wimp_CloseWindow",,b%
 5200     ENDCASE
 5210   WHEN &180:PROCprint
 5220   WHEN &182:!b%=options%:SYS "Wimp_GetWindowState",,b%:
                      SYS "Wimp_OpenWindow",,b%
 5230   WHEN &183:!b%=saveas%:SYS "Wimp_GetWindowState",,b%:
                      PROCshowmenu(saveas%,b%!4,b%!16)
 5240   OTHERWISE
 5250     SYS "Wimp_ProcessKey",key%
 5260 ENDCASE
 5270 ENDPROC
 5280 :
 5290 DEFPROCtext(x%,y%,col%,RETURN coords%)
 5300 fh%=coords%!4:coords%+=8
 5310 SYS "Font_SetFont",fh%
 5320 SYS "XFont_StringBBox",,coords% TO ,fminx%,fminy%,fmaxx%,fmaxy%
 5330 fminx%=(fminx% DIV 400)-1:fminy%=(fminy% DIV 400)-1:
      fmaxx%=(fmaxx% DIV 400)+1:fmaxy%=(fmaxy% DIV 400)+1
 5340 IF b%!28<=x%+fmaxx% AND b%!32<=y%+fmaxy% AND b%!36>=x%+fminx% AND b%!40>=y%+fminy% THEN
 5350   SYS "Wimp_SetFontColours",,1,col%
 5360   SYS "Font_Paint",,coords%,%10000,x%,y%
 5370 ENDIF
 5380 WHILE ?coords%>=32:coords%+=1:ENDWHILE
 5390 coords%+=1:WHILE (coords% MOD 4)<>0:coords%+=1:ENDWHILE
 5400 coords%+=4
 5410 ENDPROC
 5420 :
 5430 DEFPROCadd_text(RETURN coords%)
 5440 LOCAL n%,pt%,fonth%
 5450 PROCterm(textbuf%)
 5460 IF coords%+LEN$textbuf%>list%+984:VDU 7:coords%-=4:ENDPROC
 5470 pt%=VAL$ptsize%*16:IF pt%=0 pt%=14*16
 5480 SYS "Font_FindFont",,fontname%,pt%,pt% TO fonth%
 5490 PROCadd_font(fonth%,pt%)
 5500 coords%!4=fonth%
 5510 $(coords%+8)=$textbuf%
 5520 n%=LEN$textbuf%+8
 5530 coords%?n%=0
 5540 n%+=1
 5550 WHILE n% MOD 4<>0:n%+=1:ENDWHILE
 5560 coords%!n%=n%
 5570 coords%+=n%
 5580 ENDPROC
 5590 :
 5600 DEFPROCfont_size_menu
 5610 RESTORE+1
 5620 DATA Font size,_W,ptsize%,12,*
 5630 fmenu%=FNmake_menu
 5640 ENDPROC
 5650 :
 5660 DEFPROCmenu_message
 5670 CASE TRUE OF
 5680   WHEN topmenu%=wmenu% AND b%!32=3 AND b%!36=-1:PROCfont_list(b%!24,b%!28)
 5690 ENDCASE
 5700 ENDPROC
 5710 :
 5720 DEFPROCfont_list(menx%,meny%)
 5730 buf%=menspc%
 5740 SYS "Font_ListFonts",,0,%101<<19,,0,,0 TO ,,,bsize1%,,bsize2%
 5750 IF bsize1%>menend%-buf% ERROR 1<<30,"Not enough space to list all the fonts"
 5760 IF bsize2%>wsend%-ws% ERROR 1<<30,"Insufficient indirected workspace to list all fonts"
 5770 SYS "Font_ListFonts",,buf%,%101<<19,menend%-buf%,ws%,wsend%-ws%,fontname%
 5780 PROCattach(wmenu%,3,buf%)
 5790 SYS "Wimp_CreateSubMenu",,buf%,menx%,meny%
 5800 ENDPROC
 5810 :
 5820 DEFPROCpick_font
 5830 SYS "Wimp_DecodeMenu",,buf%,b%+4,fontname%
 5840 SYS "Font_ListFonts",,buf%,%101<<19,menend%-buf%,ws%,wsend%-ws%,fontname%
 5850 ENDPROC
 5860 :
 5870 DEFPROCadd_font(h%,p%)
 5880 LOCAL n%,found%
 5890 found%=FALSE
 5900 n%=fontlist%
 5910 WHILE !n%<>-1
 5920   IF !n%=h% found%=TRUE
 5930   n%+=8
 5940   WHILE ?n%>=32:n%+=1:ENDWHILE
 5950   n%+=1
 5960   WHILE n% MOD 4<>0 n%+=1:ENDWHILE
 5970 ENDWHILE
 5980 IF NOT found% THEN
 5990   !n%=h%:n%!4=p%:$(n%+8)=$fontname%
 6000   n%+=8
 6010   WHILE ?n%>=32:n%+=1:ENDWHILE
 6020   n%+=1
 6030   WHILE n% MOD 4<>0 n%+=1:ENDWHILE
 6040   !n%=-1
 6050 ENDIF
 6060 ENDPROC
 6070 :
 6080 DEFFNend2
 6090 LOCAL n%
 6100 n%=fontlist%
 6110 WHILE !n%<>-1
 6120   n%+=4
 6130 ENDWHILE
 6140 =n%
 6150 :
 6160 DEFPROCupdate_fonts
 6170 LOCAL n%
 6180 n%=fontlist%
 6190 WHILE !n%<>-1 AND n%<fontlist%+1024
 6200   oldh%=!n%
 6210   SYS "XFont_FindFont",,n%+8,n%!4,n%!4 TO newh%;flags%
 6220   IF (flags% AND 1)<>0:err%=newh%:!err%=1<<30:PROCclear:SYS "OS_GenerateError",err%
 6230   PROCupdate_plot_list(oldh%,newh%)
 6240   !n%=newh%
 6250   n%+=8
 6260   WHILE ?n%>=32:n%+=1:ENDWHILE
 6270   n%+=1
 6280   WHILE n% MOD 4<>0:n%+=1:ENDWHILE
 6290 ENDWHILE
 6300 ENDPROC
 6310 :
 6320 DEFPROCupdate_plot_list(old%,new%)
 6330 LOCAL n%
 6340 n%=FNend
 6350 WHILE n%>list%
 6360   IF (!n% AND &FF000000)<>0 THEN
 6370     n%-=4
 6380   ELSE
 6390     n%-=!n%
 6400     IF n%!4=old% n%!4=new%
 6410     IF n%>list% n%-=4
 6420   ENDIF
 6430 ENDWHILE
 6440 ENDPROC
 6450 :
 6460 DEFPROClose_fonts
 6470 LOCAL n%
 6480 n%=FNend
 6490 WHILE n%>list%
 6500   IF (!n% AND &FF000000)<>0 THEN
 6510     n%-=4
 6520   ELSE
 6530     n%-=!n%
 6540     SYS "Font_LoseFont",n%!4
 6550   IF n%>list% n%-=4
 6560   ENDIF
 6570 ENDWHILE
 6580 !fontlist%=-1
 6590 ENDPROC
 6600 :
 6610 DEFPROCprint
 6620 printxpos%=93675:printypos%=216855
 6630 transx_to_x%=1<<16:transx_to_y%=0
 6640 transy_to_x%=0:transy_to_y%=1<<16
 6650 SYS "XPDriver_Info" TO err%,,,fea%;flags%
 6660 IF (flags% AND 1)<>0 !err%=1<<30:SYS "OS_GenerateError",err%
 6670 SYS "Hourglass_On"
 6680 pfile%=OPENOUT"printer:"
 6690 printing%=TRUE
 6700 SYS "XPDriver_SelectJob",pfile% TO err%;flags%
 6710 IF (flags% AND 1)<>0 !err%=1<<30:SYS "OS_GenerateError",err%
 6720 IF (fea% AND 1<<29)<>0 PROCdeclare_fonts
 6730 xorig%=0:yorig%=0
 6740 !b%=xorig%:b%!4=yorig%-1020:b%!8=xorig%+1020:b%!12=yorig%
 6750 b%!16=transx_to_x%:b%!20=transx_to_y%
 6760 b%!24=transy_to_x%:b%!28=transy_to_y%
 6770 b%!32=printxpos%:b%!36=printypos%
 6780 SYS "XPDriver_GiveRectangle",0,b%,b%+16,b%+32,&FFFFFF00 TO err%;flags%
 6790 IF (flags% AND 1)<>0 !err%=1<<30:SYS "OS_GenerateError",err%
 6800 SYS "XPDriver_DrawPage",1,b%+28 TO more%;flags%
 6810 IF (flags% AND 1)<>0 !more%=1<<30:SYS "OS_GenerateError",more%
 6820 WHILE more%<>0
 6830   PROCdraw(b%,xorig%,yorig%)
 6840   SYS "XPDriver_GetRectangle",,b%+28 TO more%;flags%
 6850   IF (flags% AND 1)<>0 !more%=1<<30:SYS "OS_GenerateError",more%
 6860 ENDWHILE
 6870 SYS "XPDriver_EndJob",pfile% TO err%;flags%
 6880 IF (flags% AND 1)<>0 !err%=1<<30:SYS "OS_GenerateError",err%
 6890 printing%=FALSE
 6900 CLOSE#pfile%
 6910 SYS "Hourglass_Off"
 6920 ENDPROC
 6930 :
 6940 DEFPROCdeclare_fonts
 6950 LOCAL n%
 6960 n%=fontlist%
 6970 WHILE !n%<>-1 AND n%<fontlist%+1024
 6980   SYS "XPDriver_DeclareFont",0,n%+8,0 TO err%;flags%
 6990   IF (flags% AND 1)<>0 SYS "XPDriver_AbortJob",pfile%:
        !err%=1<<30:SYS "OS_GenerateError",err%
 7000   n%+=8
 7010   WHILE ?n%>=32:n%+=1:ENDWHILE
 7020   n%+=1
 7030   WHILE n% MOD 4<>0:n%+=1:ENDWHILE
 7040 ENDWHILE
 7050 SYS "XPDriver_DeclareFont",0,0,0 TO err%;flags%
 7060 IF (flags% AND 1)<>0 SYS "XPDriver_AbortJob",pfile%:!err%=1<<30:
      SYS "OS_GenerateError",err%
 7070 ENDPROC
 7080 :
 7090 DEFFNwind_open(h%)
 7100 LOCAL c%
 7110 c%=FNstack(36)
 7120 !c%=h%
 7130 SYS "Wimp_GetWindowState",,c%
 7140 PROCunstack(c%)
 7150 =(c%!32 AND 1<<16)<>0
 7160 :
 7170 DEFPROCpush(w%,i%)
 7180 LOCAL c%
 7190 PROCget_origin(w%,xorig%,yorig%)
 7200 c%=FNstack(56)
 7210 !c%=w%:c%!4=i%:SYS "Wimp_GetIconState",,c%
 7220 x%=xorig%+c%!8:y%=yorig%+c%!12
 7230 SYS "OS_ReadMonotonicTime" TO t%
 7240 SYS "OS_Byte",138,9,(x%+20) MOD 256
 7250 SYS "OS_Byte",138,9,(x%+20) DIV 256
 7260 SYS "OS_Byte",138,9,(y%+20) MOD 256
 7270 SYS "OS_Byte",138,9,(y%+20) DIV 256
 7280 SYS "OS_Byte",138,9,4
 7290 SYS "OS_Byte",138,9,t% MOD 256
 7300 SYS "OS_Byte",138,9,(t% DIV &100) MOD 256
 7310 SYS "OS_Byte",138,9,(t% DIV &10000) MOD 256
 7320 SYS "OS_Byte",138,9,(t% DIV &1000000) MOD 256
 7330 PROCunstack(c%)
 7340 ENDPROC
 7350 :
 7360 DEFPROCcommand
 7370 LOCAL ptr%
 7380 SYS "OS_GetEnv" TO com$
 7390 ptr%=INSTR(com$,"!RunImage")
 7400 WHILE ASC(MID$(com$,ptr%,1))>32:ptr%+=1:ENDWHILE
 7410 WHILE ASC(MID$(com$,ptr%,1))=32:ptr%+=1:ENDWHILE
 7420 IF ASC(MID$(com$,ptr%,1))>31 THEN
 7430   com$=MID$(com$,ptr%)
 7440   SYS "OS_CLI","Load "+com$+" "+STR$~list%
 7450   $savestr%=com$
 7460   PROCupdate_fonts
 7470   !b%=main%
 7480   SYS "Wimp_GetWindowState",,b%
 7490   IF ((b%!32) AND 1<<16)=0 THEN
 7500     SYS "Wimp_OpenWindow",,b%
 7510   ELSE
 7520     PROCforce_redraw(main%)
 7530   ENDIF
 7540   PROCunchanged
 7550 ENDIF
 7560 ENDPROC
 7570 :
 7580 DEFPROCdata_open
 7590 IF b%!40=&012 PROCload
 7600 ENDPROC
 7610 :
 7620 DEFPROCchanged
 7630 IF changed%=FALSE THEN
 7640   $titlebuf%+=" *"
 7650   changed%=TRUE
 7660   PROCupdate_titlebar
 7670 ENDIF
 7680 ENDPROC
 7690 :
 7700 DEFPROCupdate_titlebar
 7710 LOCAL c%,tbbottom%
 7720 c%=FNstack(36)
 7730 !c%=main%:SYS "Wimp_GetWindowState",,c%
 7740 tbbottom%=c%!16
 7750 SYS "Wimp_GetWindowOutline",,c%
 7760 SYS "Wimp_ForceRedraw",-1,c%!4,tbbottom%,c%!12,c%!16
 7770 PROCunstack(c%)
 7780 ENDPROC
 7790 :
 7800 DEFPROCunchanged
 7810 $titlebuf%=$savestr%
 7820 changed%=FALSE
 7830 PROCupdate_titlebar
 7840 ENDPROC
 7850 :
 7860 DEFPROCprequit
 7870 IF changed% THEN
 7880   b%!12=b%!8
 7890   sender%=b%!4
 7900   SYS "Wimp_SendMessage",19,b%,sender%
 7910   IF ((b%!20) AND 1)=0 shutdown%=TRUE ELSE shutdown%=FALSE
 7920   !b%=quitwind%:SYS "Wimp_GetWindowState",,b%:PROCshowmenu(quitwind%,b%!4,b%!16)
 7930 ENDIF
 7940 ENDPROC
 7950 :
 7960 DEFPROCreply
 7970 changed%=FALSE
 7980 SYS "Wimp_GetCaretPosition",,b%
 7990 b%!24=&1FC
 8000 SYS "Wimp_SendMessage",8,b%,sender%
 8010 ENDPROC
 8020 :
 8030 DEFPROCclose_window
 8040 LOCAL n%
 8050 SYS "Wimp_GetPointerInfo",,b%+4
 8060 SYS "Wimp_CloseWindow",,b%
 8070 IF (b%!12 AND 1)<>0 AND b%!16=main% AND b%!20=-3 AND 
      INSTR($savestr%,"::")<>0 AND INSTR($savestr%,"$.")<>0 THEN
 8080   n%=LEN$savestr%
 8090   WHILE savestr%?n%<>ASC"." n%-=1:ENDWHILE
 8100   OSCLI("Filer_OpenDir "+LEFT$($savestr%,n%))
 8110 ENDIF
 8120 ENDPROC
 8130 :

previousmain indexnext

 
© Martyn & Christine Fox 2004