REM >!RunImage
 REM (C) Martyn Fox
 REM shape drawing program
 REM based on Wimp shell program v0.01
 version$="0.01 (date)"
 ON ERROR PROCclose:REPORT:PRINT" at line ";ERL:END
 SYS "Wimp_Initialise",200,&4B534154,"Shapes" TO ,task%
 PROCinit
 PROCcreateicon
 REPEAT
   PROCpoll
 UNTIL quit%
 PROCclose
 END
 :
 DEFPROCcreateicon
 REM creates the application's icon and puts it on the icon bar
 !b%=-1:b%!4=0:b%!8=0:b%!12=68:b%!16=68:b%!20=&3002
 $(b%+24)="!shapes":SYS"Wimp_CreateIcon",,b% TO i%
 ENDPROC
 :
 DEFPROCclose
 REM tells the Wimp to quit the application
 SYS "Wimp_CloseDown",task%,&4B534154
 ENDPROC
 :
 DEFPROCpoll
 REM main program Wimp polling loop
 SYS "Wimp_Poll",,b% TO r%
 CASE r% OF
   WHEN 1:PROCredraw(b%)
   WHEN 2:SYS "Wimp_OpenWindow",,b%
   WHEN 3:SYS "Wimp_CloseWindow",,b%
   WHEN 6:PROCmouseclick
   WHEN 8:PROCkeypress
   WHEN 9:PROCmenuclick
   WHEN 17,18:PROCreceive
 ENDCASE
 ENDPROC
 :
 DEFPROCmouseclick
 REM handles mouse clicks in response to Wimp_Poll reason code 6
 REM b%!0=mousex,b%!4=mousey:b%!8=buttons:b%!12=window handle (-2 for icon bar):b%!16=icon handle
 CASE b%!12 OF
   WHEN -2:CASE b%!8 OF
     WHEN 2:PROCshowmenu(mainmenu%,!b%-64,96+2*44):REM replace '2' with number of main menu items
     WHEN 4:!b%=main%:SYS "Wimp_GetWindowState",,b%:b%!28=-1:SYS "Wimp_OpenWindow",,b%
   ENDCASE
   WHEN main%:PROCwindow_click
   WHEN options%:PROCopt_box(b%!8,b%!16)
 ENDCASE
 ENDPROC
 :
 DEFPROCget_origin(handle%,RETURN xorig%,RETURN yorig%)
 REM returns coordinates of window work area origin
 LOCAL c%
 c%=FNstack(36)
 !c%=handle%
 SYS "Wimp_GetWindowState",,c%
 xorig%=c%!4-c%!20:yorig%=c%!16-c%!24
 PROCunstack(c%)
 ENDPROC
 :
 DEFFNstack(size%)
 REM allocates temporary memory from stack block
 REM stack must be cleared after use with PROCunstack
 IF stackptr%+size%>stackend%  ERROR 1,"No room in stack"
 stackptr%+=size%
 =stackptr%-size%
 :
 DEFPROCunstack(old_ptr%)
 REM removes temporary memory from stack
 stackptr%=old_ptr%
 IF stackptr%<stack% stackptr%=stack%
 ENDPROC
 :
 DEFFNmake_menu
 REM creates menu block from DATA statements
 LOCAL start%,title$,item$,ul%,tail$,writable%,buffer%,buflen%
 start%=menspc%
 READ title$
 $(start%)=title$
 start%?12=7:REM title foreground colour
 start%?13=2:REM title background colour
 start%?14=7:REM work area foreground colour
 start%?15=0:REM work area background colour
 start%!20=44:REM height of menu items
 start%!24=0:REM gap between items
 width%=LEN(title$)-3
 menspc%+=28
 REPEAT
   READ item$
   IF item$<>"*" THEN
     !menspc%=0
     writable%=FALSE
     ul%=INSTR(item$,"_")
     IF ul% THEN
       tail$=RIGHT$(item$,LEN(item$)-ul%)
       IF INSTR(tail$,"T") !menspc%=!menspc% OR 1:REM tick
       IF INSTR(tail$,"D") !menspc%=!menspc% OR 2:REM dotted line
       IF INSTR(tail$,"W") !menspc%=!menspc% OR 4:writable%=TRUE:READ buffer%:READ buflen%:REM writable icon
       IF INSTR(tail$,"M") !menspc%=!menspc% OR 8:REM generate message
       item$=LEFT$(item$,ul%-1)
     ENDIF
     IF LENitem$>width% width%=LENitem$
     menspc%!4=-1:REM submenu ptr
     IF writable% THEN
       menspc%!8=&0700F121:menspc%!12=buffer%:menspc%!16=-1:menspc%!20=buflen%:$buffer%=item$
       ELSE
       IF LENitem$<12 THEN
         menspc%!8=&07000021:$(menspc%+12)=item$
         ELSE
         menspc%!8=&07000121:menspc%!12=ws%:menspc%!16=-1:menspc%!20=LENitem$+1
         $ws%=item$:ws%+=LENitem$+1
       ENDIF
     ENDIF
     menspc%+=24
   ENDIF
 UNTIL item$="*"
 start%!16=width%*16+32
 !(menspc%-24)=!(menspc%-24) OR &80
 mptr%=menspc%
 =start%
 :
 DEFPROCload_templates
 REM opens window template file, loads and creates window
 SYS "Wimp_OpenTemplate",,"<Shapes$Dir>.Templates"
 REM ****** load and create Info box ******
 SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"progInfo",0 TO ,,ws%
 $stack%!(88+32*0+20)=version$
 SYS "Wimp_CreateWindow",,stack% TO info%
 REM ****** load and create main window ******
 SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"Main",0 TO ,,ws%
 SYS "Wimp_CreateWindow",,stack% TO main%
 REM ****** load and create Options dialogue box ******
 SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"Options",0 TO ,,ws%
 SYS "Wimp_CreateWindow",,stack% TO options%
 REM ****** end of window creation ******
 SYS "Wimp_CloseTemplate"
 ENDPROC
 :
 DEFPROCattach(menu%,item%,sub%)
 REM attach submenu or dialogue box to main menu
 !(menu%+28+item%*24+4)=sub%
 ENDPROC
 :
 DEFPROCinit
 REM initialisation before polling loop starts
 DIM b% 255,ws% 1023,menspc% 1023,stack% 1023,list% 1023
 wsend%=ws%+1024:stackend%=stack%+1024:stackptr%=stack%
 quit%=FALSE
 !list%=-1
 colsel%=7
 PROCload_templates
 PROCmenus
 !b%=main%:SYS "Wimp_GetWindowState",,b%:SYS "Wimp_OpenWindow",,b%
 ENDPROC
 :
 DEFPROCreceive
 REM handles messages received from the Wimp with reason codes 17 or 18
 CASE b%!16 OF
   WHEN 0:quit%=TRUE
 ENDCASE
 ENDPROC
 :
 DEFPROCkeypress
 REM processes keypresses in response to Wimp_Poll reason code 8
 IF b%!24=13 THEN
   ELSE
   SYS "Wimp_ProcessKey",b%!24
 ENDIF
 ENDPROC
 :
 DEFPROCwindow_click
 REM handles mouse clicks on window
 REM b%!0=mousex,b%!4=mousey:b%!8=buttons:b%!12=window handle (-2 for icon bar):b%!16=icon handle
 CASE b%!8 OF
   WHEN 2:PROCshowmenu(wmenu%,!b%,b%!4)
   WHEN 1:PROCdelete_item
   WHEN 4:PROCadd_item
 ENDCASE
 ENDPROC
 :
 DEFPROCmenus
 REM create menus and attach submenus and dialogue boxes
 PROCmain_menu
 PROCattach(mainmenu%,0,info%)
 PROCwindow_menu
 PROCattach(wmenu%,0,options%)
 ENDPROC
 :
 DEFPROCshowmenu(menu%,x%,y%)
 REM opens menu at given coordinates
 topmenu%=menu%:topx%=x%:topy%=y%
 SYS "Wimp_CreateMenu",,menu%,x%,y%
 ENDPROC
 :
 DEFPROCmenuclick
 REM handles mouse clicks on menu in response to Wimp_Poll reason code 9
 LOCAL c%,adj%
 c%=FNstack(20)
 SYS "Wimp_GetPointerInfo",,c%
 adj%=(c%!8 AND 1)
 SYS "Wimp_DecodeMenu",,topmenu%,b%,c%
 CASE $c% OF
   WHEN "Quit":quit%=TRUE
   WHEN "Clear":PROCclear
   WHEN "Load":PROCload
   WHEN "Save":PROCsave
 ENDCASE
 IF adj% PROCshowmenu(topmenu%,topx%,topy%)
 PROCunstack(c%)
 ENDPROC
 :
 DEFPROCmain_menu
 REM creates main menu, calling FNmake_menu
 RESTORE +1
 DATA Shapes,Info,Quit,*
 mainmenu%=FNmake_menu
 ENDPROC
 :
 DEFPROCredraw(b%)
 REM redraws window contents
 LOCAL xorig%,yorig%,more%
 PROCget_origin(!b%,xorig%,yorig%)
 SYS "Wimp_RedrawWindow",,b% TO more%
 WHILE more%
   PROCdraw(b%,xorig%,yorig%)
   SYS "Wimp_GetRectangle",,b% TO more%
 ENDWHILE
 ENDPROC
 :
 DEFPROCdraw(b%,xorig%,yorig%)
 REM called when all or part of window needs redrawing
 REM xorig% and yorig% are coordinates of work area origin (top left-hand corner of window work area)
 REM b% points to block:
 REM b%!0  : window handle
 REM b%!4  : visible area minimum x coordinate
 REM b%!8  : visible area minimum y coordinate
 REM b%!12 : visible area maximum x coordinate
 REM b%!16 : visible area maximum y coordinate
 REM b%!20 : scroll x offset relative to work area origin
 REM b%!24 : scroll y offset relative to work area origin
 REM b%!28 : current graphics window minimum x coordinate
 REM b%!32 : current graphics window minimum y coordinate
 REM b%!36 : current graphics window maximum x coordinate
 REM b%!40 : current graphics window maximum y coordinate
 LOCAL coords%,colour%,plot%
 MOVE xorig%,yorig%
 coords%=list%
 WHILE !coords%<>-1
   PROCplot_shape(!coords%,x%,y%,colour%,plot%)
   SYS "Wimp_SetColour",colour%
   PLOT plot%,xorig%+x%,yorig%-y%
   coords%+=4
 ENDWHILE
 ENDPROC
 :
 DEFPROCplot_shape(word%,RETURN x%,RETURN y%,RETURN colour%,RETURN plot%)
 REM returns parameters of object to be plotted, decoded from word%
 x%=(word% AND &3FF)*4:y%=(word%>>12) AND &FFC
 colour%=(word%>>10) AND &F
 plot%=(word%>>24) AND &FF
 ENDPROC
 :
 DEFPROCwindow_menu
 RESTORE +1
 DATA Shapes,Options,Clear_D,Load,Save,*
 wmenu%=FNmake_menu
 ENDPROC
 :
 DEFFNicon_state(window%,icon%)
 LOCAL c%
 c%=FNstack(40)
 !c%=window%
 c%!4=icon%
 SYS "Wimp_GetIconState",,c%
 PROCunstack(c%)
 =((c%!24) AND (1<<21))<>0
 :
 DEFPROCadd_item
 x%=!b%:y%=b%!4
 PROCget_origin(main%,xorig%,yorig%)
 coords%=FNend
 IF coords%<list%+1020 THEN
 CASE TRUE OF
   WHEN FNicon_state(options%,0):plot%=4:REM MOVE
   WHEN FNicon_state(options%,1):plot%=5:REM DRAW
   WHEN FNicon_state(options%,2):plot%=157:REM CIRCLE FILL
   WHEN FNicon_state(options%,3):plot%=101:REM RECTANGLE FILL
   OTHERWISE:plot%=4:REM MOVE - all icons deselected
 ENDCASE
 !coords%=(((x%-xorig%) AND &FFC) DIV 4)+((yorig%-y%) AND &FFC)*(1<<12)+(colsel% AND &F)*(1<<10)
 coords%?3=plot%
 coords%!4=-1
 PROCforce_redraw(main%)
 ENDIF
 ENDPROC
 :
 DEFFNend
 LOCAL n%
 n%=list%
 WHILE !n%<>-1
   n%+=4
 ENDWHILE
 =n%
 :
 DEFPROCforce_redraw(window%)
 LOCAL c%
 c%=FNstack(36)
 !c%=window%
 SYS "Wimp_GetWindowState",,c%
 SYS "Wimp_ForceRedraw",-1,c%!4,c%!8,c%!12,c%!16
 PROCunstack(c%)
 ENDPROC
 :
 DEFPROCdelete_item
 coords%=FNend
 IF coords%>list% coords%-=4:!coords%=-1 ELSE VDU 7
 PROCforce_redraw(main%)
 ENDPROC
 :
 DEFPROCopt_box(button%,icon%)
 CASE icon% OF
   WHEN 0,1,2,3:
   WHEN 5:
     !b%=options%:b%!4=4
     SYS "Wimp_GetIconState",,b%
     colsel%=(b%!24)>>28
     IF button%=4 SYS "Wimp_CreateMenu",,-1
   OTHERWISE
     !b%=options%:b%!4=icon%
     SYS "Wimp_GetIconState",,b%
     b%!4=4:b%!8=(b%!24) AND &F<<28:b%!12=&F<<28
     SYS "Wimp_SetIconState",,b%
 ENDCASE
 ENDPROC
 :
 DEFPROCclear
 !list%=-1
 PROCforce_redraw(main%)
 ENDPROC
 :
 DEFPROCload
 OSCLI ("LOAD Shapefile "+STR$~list%)
 PROCforce_redraw(main%)
 ENDPROC
 :
 DEFPROCsave
 n%=FNend+4
 OSCLI ("SAVE Shapefile "+STR$~list%+" "+STR$~n%)
 *SETTYPE Shapefile &012
 ENDPROC
 :