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 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 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%"*" 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",,".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 ****** 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 wsend%=ws%+1024:stackend%=stack%+1024:stackptr%=stack% quit%=FALSE 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 VDU 7 ENDPROC : DEFPROCmenus REM create menus and attach submenus and dialogue boxes PROCmain_menu PROCattach(mainmenu%,0,info%) 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 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 :