| 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 :
