A step-by-step description of the conversion process | |
Acorn programme segment | Windows programme segment |
The multi-tasking kernel This is the part of the programme that is cycled through whenever the operating system allows the application to have some processor resource. On the Acorn, the multi-tasking is cooperative, the application giving control back to the operating system by calling Wimp_Poll which returns with a reason code indicating what operation the operating system is demanding (or a code of zero which means that no operation is required). Under Windows there are two interactions: a 'window procedure' which receives calls very similar to the Acorn 'reason code' and a 'message procedure' which receives messages very similar to reason code events User_Message (17) and User_Message_Recorded (18) on the Acorn - these indicate a user intervention such as a mouse click, a menu selection, moving or resizing of the window, a keypress or closure of a window. The other interactions with the operating system, in both cases, are by means of Operating System calls which are made using the BASIC keyword 'SYS'. The principal difference under Windows is that each window must have a machine code routine at a nominated address which is called by the Operating System whereas on the Acorn each application calls the Operating System. To enable the whole application to be written in BASIC, BBC Basic for Windows therefore maintains the window procedure for the BASIC output window itself, responds to 'redraw' requests because it knows what you have drawn onto its own internal 1600 by 1200 (maximum) bitmap and generates an 'interrupt' when a specific action is required using the following form: 'ON xxx <statement>:RETURN as follows:
On the Acorn side a key press generates a 'reason code' event of Key_Pressed (8) for the task 'which has the input focus' whereas under Windows you would use the INKEY command to examine the input buffer and could make a check that your task was the active one. Dragging or resizing a window produces a reason code of Open_Window_Request (2) on the Acorn and an ON MOVE call under BBCBASIC. Clicking on the 'close' icon of a window produces a reason code of Close_Window_Request (3) on the Acorn and an ON SYS call under BBCBASIC as if a menu selection had been made with an item number of 2. Making a menu selection produces a reason code of Menu_Selection (9) on the Acorn - the task must remember the menu it last opened as no menu handles are used - returning the absolute item number selected at each level of the menu down to the selection itself. Under BBCBASIC an ON SYS call is made with an item number corresponding to the item number allocated to that menu item on creation. On the Acorn enabling or ticking a menu item is easily performed by either remembering where the flag is stored in the user memory block where the menu structure was created or just recreating the menu structure again in the same place with the different flags. Under Windows the memory for the menu structure is allocated by the Operating System so you send messages to say 'enable menu item 55' rather than destroying and recreating the menu structure. When the task terminates any such memory allocations are NOT automatically released by Windows and must be manually released by the task. That is why many Windows applications cause 'memory leakage' as each block of memory not released is lost until Windows is rebooted. Interactive help is built in to the Acorn so that a separate a task is responsible for displaying help text and generates messages (reason code User_Message (17)) of type Message_HelpRequest (&502) to see if the task has any help text to offer for the current mouse position (if so, it replies with a Message_HelpReply message (&503)). Under Windows this is built in only for task buttons, not generally, and a tool tip window is produced with the help text on a yellow background. The Acorn functionality would therefore be created by interrogating the mouse position, checking which window was on top and producing a small dialogue box with some text on a yellow background, as appropriate. Let's look at an example. | |
quit%=FALSE REM General error procedure, falls through into main loop ON ERROR PROCerror : mask%=0:REM always multi-task pause%=TRUE SYS "Hourglass_Off" : REM Now the main loop REM WHILE quit%=0 SYS "Wimp_Poll",mask%,block% TO reason% CASE reason% OF WHEN 2:SYS "Wimp_OpenWindow",,block% : PROCautoscroll : WHEN 6:PROCbuttons(block%) : : WHEN 9:PROCmenuselect(block%) : : WHEN 8:PROCkeypress(block%) : : WHEN 3:SYS "Wimp_CloseWindow",,block% : WHEN 0:IF sb_open% THEN PROCsvise WHEN 1:IF sb_open% THEN PROCredraw WHEN 7:PROCboxdragend WHEN 10:REMPROCscrollrequest(block%) WHEN 17,18:PROCreceive(block%) ENDCASE ENDWHILE SYS "Wimp_CloseDown" END |
quit%=FALSE REM General error procedure, falls through into main loop ON ERROR PROCerror pause%=TRUE : ON MOVE wm_move%=TRUE : RETURN ON MOUSE wm_mse%() = @msg%,@wparam%,@lparam% : RETURN ON SYS wm_sys%() = @msg%,@wparam%,@lparam% : RETURN ON CLOSE wm_close%() = @msg%,@wparam%,@lparam% : RETURN : REM Now the main loop REM WHILE quit%=0 REM ON xxx command used to set flags REM which are tested below IF wm_move% THEN PROCnewpos:wm_move%=0 MOUSE ws_x%,ws_y%,bb% PROCautoscroll IF wh_on% THEN PROCcontexthelp(ws_x%,ws_y%) wm_tmse%()=0,0,0 SWAP wm_tmse%(),wm_mse%() IF wm_tmse%(0) THEN PROCmouseclick(wm_tmse%(0),wm_tmse%(1),wm_tmse%(2)) wm_tsys%()=0,0,0 SWAP wm_tsys%(),wm_sys%() IF wm_tsys%(0) THEN PROCmenuselect(wm_tsys%(0),wm_tsys%(1),wm_tsys%(2)) wk_key%=INKEY(2) IF INKEY(-3) AND INKEY(-74) THEN wk_key%=999:REM ALT-ENTER IF wk_key%<>-1 THEN PROCkeypress wm_tclose%() = 0,0,0 SWAP wm_tclose%(),wm_close%() IF wm_tclose%(0) THEN PROCclose PROCsvise IF BellOn%(1)<TIME AND BellOn%(1)<>0 THEN PROCsendsound REM redraw done by BBCBASIC REM boxdragend is Acorn-specific REM scroll request is done within ON MOVE REM other messages cannot be intercepted easily : ENDWHILE PROCclose QUIT |
Notes on the above As BBCBASIC looks after the redraw window requirements from Windows, then the routine on the Acorn which responds to the Redraw_Window_Request (1) reason code needs to be converted and separated into 'initialise BASIC output screen' (i.e. set variables for the default zoom and scroll position, create bitmaps, device contexts to hold everything, load bitmaps into memory etc.) implemented as here as PROCscreen and 'refresh BASIC output screen' (i.e. display bitmaps, DRAW, PLOT etc. for the desired zoom and scroll position) implemented as PROCnewzoom, PROCnewpos and PROCrefresh. Any other screen interactions which rely upon 'Wimp_ForceRedraw' for all or part of the screen then either need to be converted into routines more appropriate to 'Wimp_UpdateWindow' and used directly or call PROCrefesh and update the whole screen. This appears more complicated than necessary but this is because the screen window on the Acorn in this application has a work area significantly larger than 1600x1200 (the maximum allowed by BBCBASIC if it is to handle the scroll and display routines itself is 1920 by 1440 but this could be increased by selecting a larger bitmap into BASIC's memory device context - if I get anywhere with this I might simplify this bit). An outline of the PROCscreen routine is given below: | |
Nothing required - everything is done by Redraw_Window_Request The only corresponding 'initialisation' is to create the icon bar menu. |
DEFPROCscreen SYS "CreateCompatibleDC",0 TO n_context% SYS "CreateCompatibleBitmap",@memhdc%,800,800 TO bitmap_h% : REM Check desktop window resolution SYS "GetSystemMetrics",0 TO ws_wid% SYS "GetSystemMetrics",1 TO ws_ht% IF ws_wid%>1600 THEN ws_wid%=1600 IF ws_ht%>1200 THEN ws_ht%=1200 VDU 23,22,ws_wid%;ws_ht%;8,16,16,0 : REM Create any pop up menus and sub class the window procedure REM Windows demands messy machine code (undocumented feature REM is that TrackPopupMenu will not work unless it's run REM from the same thread as the main window procedure, or REM possible the message loop, normally the same). Yuk! DIM mnup% 8 mnup%=(mnup%+3) AND -4 SYS "CreatePopupMenu" TO hPopup% SYS "CreatePopupMenu" TO hpop4% SYS "CreatePopupMenu" TO hpop5% wh_s%=0:wh_f%=0 : [OPT 2 ; .K% mov eax,[esp+12] mov ebx,[esp+16] push 0 push @hwnd% push 0 push ebx push eax push &2 push dword [mnup%] call "TrackPopupMenu" ret 16 ; .M% cmp dword [esp+8],&500 jz K% jmp [wm_old%] ] SYS "SetWindowLong", @hwnd%, -4, M% TO !wm_old% : REM Create any title bar menus SYS "CreatePopupMenu" TO hpop1% SYS "AppendMenu", hpop1%, 0, 10, "50%" SYS "AppendMenu", hpop1%, 0, 12, "62%" SYS "AppendMenu", hpop1%, 0, 4, "78%" SYS "AppendMenu", hpop1%, MF_CHECKED%, 7, "100%" SYS "AppendMenu", hpop1%, 0, 8, "122%" SYS "AppendMenu", hpop1%, 0, 9, "150%" SYS "AppendMenu", hpop1%, 0, 51, "Large levers" SYS "AppendMenu", hpop1%, 0, 52, "Medium levers" SYS "AppendMenu", hpop1%, MF_CHECKED%, 53, "Small levers" : SYS "EnableMenuItem", hpop1%, 51, 0 SYS "EnableMenuItem", hpop1%, 52, 0 SYS "EnableMenuItem", hpop1%, 53, 1 SYS "EnableMenuItem", hpop1%, 10, 0 SYS "EnableMenuItem", hpop1%, 12, 0 SYS "EnableMenuItem", hpop1%, 4, 0 SYS "EnableMenuItem", hpop1%, 7, 1 SYS "EnableMenuItem", hpop1%, 8, 0 SYS "EnableMenuItem", hpop1%, 9, 0 : SYS "CreatePopupMenu" TO hpop2% SYS "AppendMenu", hpop2%, 0, 20, "f1 - Help &Information" SYS "AppendMenu", hpop2%, MF_CHECKED%, 3, "f5 - Help O&n" SYS "AppendMenu", hpop2%, 0, 5, "f5 - Help O&ff" SYS "AppendMenu", hpop2%, 0, 21, "f8 - &Technical Documentation (web)" : SYS "CreatePopupMenu" TO hpop3% SYS "AppendMenu", hpop3%, 0, 6, "&Full Screen" SYS "AppendMenu", hpop3%, 0, 50, "f4 - &Save Train Register" : SYS "CreateMenu" TO hmenu% SYS "AppendMenu", hmenu%, 16, hpop1%, "Select &Zoom" SYS "AppendMenu", hmenu%, 16, hpop3%, "&Options" SYS "AppendMenu", hmenu%, 16, hpop2%, "&Help" SYS "SetMenu", @hwnd%, hmenu% SYS "DrawMenuBar", @hwnd% VDU 26 : zoom=1 wm_fh$=wm_path$+wm_box$+"_100.BMP" PROCnewzoom PROCnewpos PROCrefresh ENDPROC |
Menu selection from title bar menu An example is to select a new zoom setting. This illustrates both how a menu selection is made and how the Redraw_Window_Request routines have been converted. | |
The purpose of the example is to show how the screen is drawn under Windows. See below for menu selection in general: the icon bar menu under Acorn has a handle of -2. |
DEFPROCmenuselect(wm_a%,wm_sel%,wm_b%) REM Menuselect values are as follows: REM 1 - OK (reserved) REM 2 - Close (reserved) REM 4 - Zoom 78% REM 7 - Zoom 100% REM 8 - Zoom 122% REM 9 - Zoom 150% REM 10 - Zoom 50% REM 12 - Zoom 62% CASE wm_sel% OF WHEN 10 zoom=0.5 wm_fh$=wm_path$+wm_box$+"_050.BMP" WHEN 12 zoom=0.62 wm_fh$=wm_path$+wm_box$+"_062.BMP" WHEN 4 zoom=0.78 wm_fh$=wm_path$+wm_box$+"_078.BMP" WHEN 7 zoom=1 wm_fh$=wm_path$+wm_box$+"_100.BMP" WHEN 8 zoom=1.22 wm_fh$=wm_path$+wm_box$+"_122.BMP" WHEN 9 zoom=1.5 wm_fh$=wm_path$+wm_box$+"_150.BMP" ENDCASE CASE wm_sel% OF WHEN 10,12,4,7,8,9 PROCnewzoom PROCnewpos PROCrefresh ENDCASE ENDPROC : DEFPROCnewzoom SYS "CheckMenuItem", hpop1%, 10, -8*(zoom=0.5) SYS "CheckMenuItem", hpop1%, 12, -8*(zoom=0.62) SYS "CheckMenuItem", hpop1%, 4, -8*(zoom=0.78) SYS "CheckMenuItem", hpop1%, 7, -8*(zoom=1) SYS "CheckMenuItem", hpop1%, 8, -8*(zoom=1.22) SYS "CheckMenuItem", hpop1%, 9, -8*(zoom=1.5) SYS "EnableMenuItem", hpop1%, 10, -1*(zoom=0.5) SYS "EnableMenuItem", hpop1%, 12, -1*(zoom=0.62) SYS "EnableMenuItem", hpop1%, 4, -1*(zoom=0.78) SYS "EnableMenuItem", hpop1%, 7, -1*(zoom=1) SYS "EnableMenuItem", hpop1%, 8, -1*(zoom=1.22) SYS "EnableMenuItem", hpop1%, 9, -1*(zoom=1.5) wm_fh%=OPENIN (wm_fh$) IF wm_fh%=0 THEN ERROR 402,"No widgets" SYS "ReadFile",@hfile%(wm_fh%),wm_bits%,26,wm_temp%,0 wm_flen%=wm_bits%!2 bm_wid%=wm_bits%!18 bm_ht%=wm_bits%!22 CLOSE#wm_fh% wm_fh%=OPENIN (wm_fh$) IF wm_fh%=0 THEN ERROR 402,"No widgets" IF wm_flen%>wm_size% THEN DIM wm_bits% wm_flen%:wm_size%=wm_flen% SYS "ReadFile",@hfile%(wm_fh%),wm_bits%,wm_flen%,wm_temp%,0 CLOSE#wm_fh% bs_sx%=0 bs_sy%=0 ws_xmax%=ws_wid% IF ws_xmax%<bm_wid% THEN ws_xmax%=bm_wid% ENDPROC |
Window resizing etc. On the Acorn the Wimp_OpenWindow call displays the window in its new position. Calls must also be initiated to display any child windows that move with the main window (of which there are none in this application, only dialogue boxes). Under Windows just reset a few BASIC variables and check the new window size is suitable. This call is also generated if the Windows screen mode is changed - for example from 1024x768 to 1600x1200. | |
None required, everything is done in the 'Redraw_Window_Request' reason code. |
DEFPROCnewpos REM Check new size and constrain if too big REM Assuming work area is greater than 1600x1200 then REM scroll has to be done manually. Recreate screen REM if scroll offset has changed due to resizing. DEFPROCnewpos REM On entry check windows screen size to see if changed: SYS "GetSystemMetrics",0 TO X% SYS "GetSystemMetrics",1 TO Y% IF X%>1600 THEN X%=1600 IF Y%>1200 THEN Y%=1200 IF X%<>ws_wid% OR Y%<>ws_ht% THEN ws_wid%=X% ws_ht%=Y% VDU 23,22,ws_wid%;ws_ht%;8,16,16,0 bs_sx%=0 bs_sy%=0 VDU 26 SYS "GetClientRect",@hwnd%,^V% ws_xmax%=X% IF ws_xmax%<bm_wid% THEN ws_xmax%=bm_wid% ENDIF IF ww_style%=0 THEN VDU 26 REM In BBC BASIC, MOUSE x,y returns the mouse position relative to REM ORIGIN, counting y positive upwards where 2 units=1 pixel REM Windows full screen is from top left, with y positive downwards REM Client area coords are relative to the top left (excludes menu bar) REM The BASIC screen window extends from top left, inc. title bar REM At zero scroll, the bitmap aligns with LH and TOP of basic window REM Scroll bound is 0<bs_sx%<ws_xmax%-bs_wid% REM and 0>bs_sy%>bs_ht%-sf*ws_ht%/2-bm_ht% REM Dimensions of bitmap is bm_wid%,bm_ht% REM Dimensions of lever box is ws_xmax%,sf*ws_ht%/2 REM where ws_xmax%=MAX(ws_wid%,bm_wid%) : SYS "GetWindowRect",@hwnd%,^V% bs_wx%=X% bs_wy%=Y% bs_wid%=X%-V% bs_ht%=Y%-W% SYS "GetClientRect",@hwnd%,^V% bs_wx%-=X% bs_wy%-=Y% CASE TRUE OF WHEN X%>ws_xmax% AND ww_style%=0 REM Shrink size of window, not full screen bs_wid%-=X%-ws_xmax% SYS "SetWindowPos",@hwnd%,0,0,0,bs_wid%,bs_ht%,6 SYS "GetWindowRect",@hwnd%,^V% bs_wx%=X% bs_wy%=Y% SYS "GetClientRect",@hwnd%,^V% bs_wx%-=X% bs_wy%-=Y% WHEN Y%<sf*ws_ht%/2+bm_ht% AND ww_style%<>0 REM Full screen - expand window - ws_wid%,ws_ht% is full screen size bs_wy%=ws_ht% IF bs_wy%>sf*ws_ht%/2+bm_ht% THEN bs_wy%=sf*ws_ht%/2+bm_ht% bs_ht%=bs_wy% SYS "SetWindowPos",@hwnd%,0,0,0,ws_wid%,bs_ht%,6 SYS "GetWindowRect",@hwnd%,^V% bs_wx%=X% bs_wy%=Y% SYS "GetClientRect",@hwnd%,^V% bs_wx%-=X% bs_wy%-=Y% WHEN Y%>sf*ws_ht%/2+bm_ht% REM Shrink size of window REM either because it's too big REM or because block shelf stuff would not be wide enough REM because zoom takes its value from lever height REM (half screen) and makes instruments wider bs_ht%-=Y%-sf*ws_ht%/2-bm_ht% SYS "SetWindowPos",@hwnd%,0,0,0,bs_wid%,bs_ht%,6 SYS "GetWindowRect",@hwnd%,^V% bs_wx%=X% bs_wy%=Y% SYS "GetClientRect",@hwnd%,^V% bs_wx%-=X% bs_wy%-=Y% ENDCASE bs_wid%=X% bs_ht%=Y% VDU 26 : ws_dx%=0 ws_dy%=0 IF bs_sx%<0 THEN bs_sx%=-bs_sx% IF bs_sy%>0 THEN ws_dy%=-bs_sy% IF bs_sx%>ws_xmax%-bs_wid% THEN ws_dx%=ws_xmax%-bs_wid%-bs_sx% IF bs_sy%<-bm_ht%-sf*ws_ht%/2+bs_ht% THEN ws_dy%=-bm_ht%-sf*ws_ht%/2+bs_ht%-bs_sy% ORIGIN -2*bs_sx%,-2*bm_ht%+2*bs_ht%-2*bs_sy%-1-sf*ws_ht% IF ws_dx%<>0 OR ws_dy%<>0 THEN bs_sx%+=ws_dx%:bs_sy%+=ws_dy%:PROCrefresh : ENDPROC |
Force update of a part of the window On the Acorn this is done by using the 'Wimp_ForceRedraw' call - which simply calls the necessary Redraw_Window_Request reason codes - which will draw the necessary changes, assuming that any flags which say what you want drawn differently have been updated. Although similar under Windows, BBCBASIC maintains its own output window. Most of the work is therefore done for you - all you have to do is to update the bit you are interested in (or, of course, draw the whole screen again). The example below illustrates a complete screen redraw. It also illustrates how to paint fonts onto the BASIC output window ensuring Windows demands the relevant parts of the BASIC output window to be redrawn (as BASIC will not know that a 'TextOut' call has been made). The previous Acorn form is also shown. | |
Nothing required - all done in the Redraw_Window_Request reason code. |
DEFPROCrefresh ORIGIN -2*bs_sx%,2*bs_ht%-2*bm_ht%-2*bs_sy% OSCLI"MDisplay "+STR$~wm_bits% ws_xmax%=bm_wid%:IF ws_xmax%<ws_wid% THEN ws_xmax%=ws_wid% REM Set origin back to bottom left ORIGIN -2*bs_sx%,-2*bm_ht%+2*bs_ht%-2*bs_sy%-1-sf*ws_ht% REM Now draw lines, blocks and text COLOUR 1,60,60,60 GCOL 1 REM Fill space to right of bitmap RECTANGLE FILL 2*bm_wid%,sf*ws_ht%,2*ws_xmax%-2*bm_wid%,2*bm_ht% COLOUR 1,120,120,120 GCOL 1 REM Fill the lever box space RECTANGLE FILL 0,0,2*ws_xmax%+100,sf*ws_ht% sb_h=sf*ws_ht%/530 sb_w=sb_h sb_Z%=-150 cx%=0 cy%=sf*ws_ht% : COLOUR 1,&D1,&80,&21 REM SYS "ColourTrans_SetGCOL",&2180D100 GCOL 1 REM Block shelf itself: RECTANGLE FILL 2*ws%+cx%,sb_Z%*sb_h+cy%-10*sb_h,2*ws_xmax%-4*ws%,-30*sb_h COLOUR 1,&E0,&9F,&70 REM SYS "ColourTrans_SetGCOL",&709FE000 GCOL 1 REM Slung under block shelf: RECTANGLE FILL 2*ws%+cx%,sb_Z%*sb_h+cy%-40*sb_h,2*ws_xmax%-4*ws%,-58*sb_h GCOL 7 VDU 5 RECTANGLE 2*ws%+cx%,sb_Z%*sb_h+cy%-10*sb_h,2*ws_xmax%-4*ws%,-30*sb_h : x%=2*ws_xmax%+cx%-2*ws% y%=sb_Z%*sb_h+cy% xq%=x%-300*sb_w-192*sb_w -20*sb_w*((BlSecT%(sim%) OR 3)- (BlSecF%(sim%) AND &FC)+4) COLOUR 1,&FF,&CC,0 GCOL 1 REM SYS "ColourTrans_SetGCOL",&00CCFF00 RECTANGLE FILL xq%-145*sb_w,y%-12*sb_w,70*sb_w,-26*sb_w GCOL 7:REM SYS "Wimp_SetColour",7 RECTANGLE xq%-145*sb_w,y%-12*sb_w,70*sb_w,-26*sb_w cl%=0 PROCFont(xq%-137*sb_w,y%-30*sb_w,"Score",12) REM SYS "Font_SetFont",font4% REM SYS "ColourTrans_SetFontColours",0,&00CCFF00,0,14 REM SYS "Font_Paint",,"Score",&10,xq%-137,y%-30 : PROCcalclever FOR i%=1 TO sl%(sbox%+1)-sl%(sbox%) ii%=i% ij%=i%+sl%(sbox%) IF LevName$(ij%)<>"Space" THEN PROCdrawlever(ij%) NEXT i% : PROCdrawscore PROCdrawclock(TRUE) ENDPROC : DEFPROCFont(fx%,fy%,fs$,fz%) !fptr%=-fz% fptr%!4=0 fptr%!8=0:REM angle fptr%!12=0:REM rotation fptr%!16=700:REM weight fptr%?20=0:REM italic? fptr%?21=0:REM underline? fptr%?22=0:REM strikeout? fptr%?23=0:REM charset fptr%?24=0:REM precision fptr%?25=0:REM clipping fptr%?26=0:REM quality fptr%?27=&22:REM pitch family $(fptr%+28)="Arial"+CHR$0 SYS "CreateFontIndirect",fptr% TO fhan1% SYS "SetTextAlign",@memhdc%,24:REM Align baseline;left SYS "SelectObject",@memhdc%,fhan1% TO old_f% $chars%=fs$ SYS "SetBkMode",@memhdc%,1 :REM opaque=2, transparent=1 SYS "SetTextColor",@memhdc%,cl%:REM &00bbggrr SYS "GetTextExtentPoint32",@memhdc%,chars%,LEN(fs$),rect% SYS "TextOut",@memhdc%,fx%/2-bs_sx% ,sf*ws_ht%/2+bs_sy%+bm_ht%-fy%/2,chars%,LEN(fs$) SYS "SelectObject",@memhdc%,old_f% SYS "DeleteObject",fhan1% rect%!8=fx%/2-bs_sx%+rect%!0 rect%!12=sf*ws_ht%/2+bs_sy%+bm_ht%-fy%/2+10 rect%!0=fx%/2-bs_sx% rect%!4=sf*ws_ht%/2+bs_sy%+bm_ht%-fy%/2-rect%!4 SYS "InvalidateRect",@hwnd%,rect%,0 SYS "UpdateWindow",@hwnd% ENDPROC |
Mouse pointer nears edge of window In each case the procedure 'PROCautoscroll' checks whether the mouse is near the edge of the screen and, if so, it scrolls the window left, right, up or down as appropriate. | |
DEFPROCautoscroll REM Check whether mouse pointer over edge of the main window SYS "Wimp_GetPointerInfo",,block% mx%=!block% my%=block%!4 win%=block%!12 ic%=block%!16 but%=block%!8 IF win%=sb_main%(sbox%) AND ic%=-1 AND but%=0 THEN CASE FNwhereamI(win%,mx%,my%,but%) OF WHEN 31:REM LH edge sb_main IF block%!20>0 THEN sx%=block%!20-mc%:IF sx%<0 THEN sx%=0 block%!20=sx%:SYS "Wimp_OpenWindow",,block% ENDIF WHEN 32:REM RH IF block%!20<block%!52-block%!44+block%!4-block%!12 THEN sxmax%=block%!52-block%!44+block%!4-block%!12 sx%=block%!20+mc% IF sx%>sxmax% THEN sx%=sxmax% block%!20=sx% SYS "Wimp_OpenWindow",,block% ENDIF WHEN 33:REM TOP IF block%!24<0 THEN sy%=block%!24+mc%:IF sy%>0 THEN sy%=0 block%!24=sy% SYS "Wimp_OpenWindow",,block% ENDIF WHEN 34:REM Btm IF block%!24>block%!16-block%!8-block%!56+block%!48 THEN symax%=block%!16-block%!8-block%!56+block%!48 sy%=block%!24-mc% IF sy%<symax% THEN sy%=symax% block%!24=sy% SYS "Wimp_OpenWindow",,block% ENDIF ENDCASE ENDPROC |
DEFPROCautoscroll IF ws_x%>2*bs_sx%-10 AND ws_x%<2*bs_sx%+2*bs_wid%+10 AND ws_y%>+2*bm_ht%+sf*ws_ht%+2*bs_sy%-2*bs_ht%-10 AND ws_y%<+2*bm_ht%+sf*ws_ht%+2*bs_sy%+10 THEN ws_dx%=0 ws_dy%=0 IF ws_x%<2*bs_sx%+30 THEN ws_dx%=-2*bs_sx%-30+ws_x%:IF bs_sx%+ws_dx%<0 THEN ws_dx%=-bs_sx% IF ws_x%>2*bs_sx%+2*bs_wid%-30 THEN ws_dx%=ws_x%-2*bs_sx%-2*bs_wid%+30 IF bs_sx%+ws_dx%>ws_xmax%-bs_wid% THEN ws_dx%=ws_xmax%-bs_wid%-bs_sx% ENDIF IF ws_y%>+2*bm_ht%+sf*ws_ht%+2*bs_sy%-30 THEN ws_dy%=ws_y%-2*bm_ht%-sf*ws_ht%-2*bs_sy%+30:IF bs_sy%+ws_dy%>0 THEN ws_dy%=-bs_sy% IF ws_y%<+2*bm_ht%+sf*ws_ht%+2*bs_sy%-2*bs_ht%+30 THEN ws_dy%=ws_y%-2*bm_ht%-sf*ws_ht%-2*bs_sy%+2*bs_ht%-30 IF bs_sy%+ws_dy%<-bm_ht%-sf*ws_ht%/2+bs_ht% THEN ws_dy%=-bm_ht%-sf*ws_ht%/2+bs_ht%-bs_sy% ENDIF IF ws_dx%<>0 OR ws_dy%<>0 THEN bs_sx%+=ws_dx% bs_sy%+=ws_dy% REM Note that refresh moves ORIGIN by -2*bs_sx%,-2*bs_sy% IF ws_dx%>0 OR ws_dy%>0 THEN PROCmouseto(ws_x%-0.1*(9+ws_dx%),ws_y%-0.1*(9+ws_dy%)) ELSE PROCmouseto(ws_x%-0.1*(-19+ws_dx%),ws_y%-0.1*(-19+ws_dy%)) ENDIF PROCrefresh ENDIF ENDIF ENDPROC |
Mouse click over a point or signal In each case the task has to identify what is underneath the mouse. | |
DEFPROCbuttons(b%) : REM !b is the mouse position in absolute screen coordinates (X) REM b!4 is the mouse position in absolute screen coordinates (Y) REM b!8 is 1 - adjust 2 - menu 4 - select REM 1 then 16 - drag with adjust 4 then 64 - drag with select REM b!12 is the window handle or -1 for background or -2 for icon bar REM b!16 is the icon handle of -1 for work area background : LOCAL mx% , my% , but% , win% , ic% mx%=!b% my%=b%!4 but%=b%!8 win%=b%!12 ic%=b%!16 : CASE win% OF WHEN sb_main%(sbox%) IF ic%=-1 THEN REM Click over work area of window: but% AND 7 is 1/2/4 (button) zoom=zoomval(sbox%) PROCsboxclick(mx%,my%,but%,win%) ENDIF ENDCASE ENDPROC : DEFPROCsboxclick(mx%,my%,but%,win%) zzz%=FNwhereamI(win%,mx%,my%,but%) CASE zzz% OF WHEN 19,20,21,22 CASE TRUE OF WHEN isec%<>0 AND ilev%<>0 REM Click over a point - try to operate its lever 'ilev%' WHEN isec%<>0 REM Click over a piece of track WHEN ilev%<>0 REM Click over a signal - try to operate its lever 'ilev%' ENDCASE ENDCASE ENDPROC : DEFFNwhereamI(w%,mx%,my%,but%) LOCAL yy%,i%,j%,minsize%,size%,ij% CASE w% OF WHEN sb_main%(sbox%) !block%=w% SYS "Wimp_GetWindowInfo",,block% x%=mx%-block%!4+block%!20 y%=my%-block%!16+block%!24 ibut%=0 isec%=0 ilev%=0 pq%=0 zoom=zoomval(sbox%) CASE TRUE OF WHEN .. REM Set pq% for x%,y% other than point or signal (if any) pq%=.. OTHERWISE minsize%=9999 FOR i%=1 TO sn%(sbox%+1)-sn%(sbox%)-1 ddp%=ddSec%(sn%(sbox%)+i%) IF ddp%>&8000 THEN x3c%=(ddp%!8)/256*zoom y3c%=((ddp%!12)/256-drawoffset%)*zoom x4c%=(ddp%!16)/256*zoom y4c%=((ddp%!20)/256-drawoffset%)*zoom size%=x4c%-x3c%+y4c%-y3c% IF x%>=x3c% AND x%<=x4c% AND y%>=y3c% AND y%<=y4c% AND size%<minsize% THEN minsize%=size%:isec%=i%:pq%=21 ENDIF NEXT i% IF minsize%=9999 THEN FOR i%=1 TO sl%(sbox%+1)-sl%(sbox%) ij%=i%+sl%(sbox%) IF sm%(sbox%)=0 THEN ij%-=1 IF sm%(sbox%)=0 AND i%=1 THEN ij%=sl%(sbox%+1) FOR j%=0 TO 1 ddp%=ddLev%(ij%,j%) IF ddp%>&8000 THEN x3c%=(ddp%!8)/256*zoom y3c%=((ddp%!12)/256-drawoffset%)*zoom x4c%=(ddp%!16)/256*zoom y4c%=((ddp%!20)/256-drawoffset%)*zoom size%=x4c%-x3c%+y4c%-y3c% IF x%>=x3c% AND x%<=x4c% AND y%>=y3c% AND y%<=y4c% AND size%<minsize% THEN minsize%=size%:ilev%=i%:pq%=22 ENDIF NEXT j% NEXT i% ENDIF ENDCASE ENDCASE =pq% : |
DEFPROCmouseclick(a%,wm_par%,b%) REM this could be a menu click etc. or a click over a lever select%=0:adjust%=0 IF (wm_par% AND 2)<>0 THEN adjust%=TRUE IF (wm_par% AND 1)<>0 THEN select%=TRUE IF select% OR adjust% THEN REM Select/Adjust button click REM - get cursor position to determine action SYS "GetCursorPos", ^X% REM Set x% and y% to value from mouse click REM (should already be set from MOUSE x%,y%) V%=b% AND &FFFF W%=b%>>16 x%= (V%<<1)-@vdu%!0 y%= (((@vdu%!212)-1-W%)<<1)-@vdu%!4 : pq%=FNubi(x%,y%) CASE pq% OF WHEN 19,20,21,22 CASE TRUE OF WHEN isec%<>0 AND ilev%<>0 AND select% REM Click over a point - try the lever ilev% WHEN isec%<>0 REM Click over track WHEN ilev%<>0 REM Click over a signal - try lever ilev% ENDCASE ENDCASE ENDIF : DEFFNubi(wh_tx%,wh_ty%) LOCAL x%,y% SYS "GetCursorPos", ^V% REM V%,W% are mouse position SYS "WindowFromPoint",V%,W% TO winh% pq%=0 IF winh%<>0 THEN IF winh%=@hwnd% THEN pq%=93 ENDIF IF pq%=93 THEN IF wh_ty%>sf*ws_ht% THEN REM Box diagram pq%=0 x%=wh_tx% y%=wh_ty%-sf*ws_ht%-2*bm_ht% pq%=94 minsize%=9999 FOR i%=1 TO sn%(sbox%+1)-sn%(sbox%)-1 ddp%=ddSec%(sn%(sbox%)+i%) IF ddp%>&8000 THEN x3c%=(ddp%!8)/256*zoom y3c%=((ddp%!12)/256-drawoffset%)*zoom x4c%=(ddp%!16)/256*zoom y4c%=((ddp%!20)/256-drawoffset%)*zoom size%=x4c%-x3c%+y4c%-y3c% IF x%>=x3c% AND x%<=x4c% AND y%>=y3c% AND y%<=y4c% AND size%<minsize% THEN minsize%=size%:isec%=i%:pq%=21 ENDIF NEXT i% FOR i%=1 TO sl%(sbox%+1)-sl%(sbox%) ij%=i%+sl%(sbox%) FOR j%=0 TO 1 ddp%=ddLev%(ij%,j%) IF ddp%>&8000 THEN x3c%=(ddp%!8)/256*zoom y3c%=((ddp%!12)/256-drawoffset%)*zoom x4c%=(ddp%!16)/256*zoom y4c%=((ddp%!20)/256-drawoffset%)*zoom size%=x4c%-x3c%+y4c%-y3c% IF x%>=x3c% AND x%<=x4c% AND y%>=y3c% AND y%<=y4c% AND size%<minsize% THEN minsize%=size%:ilev%=i%:pq%=22 ENDIF NEXT j% NEXT i% ENDIF ENDIF =pq% |
Key press In each case a 'key press' routine handles the necessary action | |
DEFPROCkeypress(b%) CASE TRUE OF WHEN b%!24=&184:REM f4 SYS "OS_File",10,"<SB$Dir>.TRegister" ,&AFF,,ddReg%,ddWTT% OTHERWISE SYS "Wimp_ProcessKey",b%!24 REM ie. pass on key code in R0 ENDCASE ENDPROC |
DEFPROCkeypress CASE wk_key% OF WHEN 148:REM F4 REM Save Train Register PROCsaveasbmp(bitmap_r%,wm_path$+"TrainReg.bmp") WHEN 27:REM Escape ENDCASE ENDPROC : DEFPROCsaveasbmp(hbm%,file$) LOCAL bmp%, width%, height%, size%, data%, res% REM. Find the bitmap dimensions and file size: DIM bmp% LOCAL 26 bmp% = (bmp% + 3) AND -4 SYS "GetObject", hbm%, 24, bmp% TO res% IF res%=0 ERROR 100, "GetObject failed" width% = bmp%!4 height% = bmp%!8 size% = 54 + height%*((width%*3 + 3) AND -4) : REM. Allocate and zero memory for BMP file: SYS "GlobalAlloc", &40, size% TO data% IF data%=0 ERROR 100, "GlobalAlloc failed" REM. Store file and bitmap headers: data%?0 = ASC"B" data%?1 = ASC"M" data%!2 = size% data%!10 = 54 data%!14 = 40 data%!18 = width% data%!22 = height% data%!26 = &180001 : REM. Copy the image into the DIB: SYS "GetDIBits", @memhdc%, hbm%, 0, height%, data%+54, data%+14, 0 TO res% IF res%<>height% ERROR 100, "GetDIBits failed" : REM. Save the output file: DIM of% 75, ff% 27, fn% 255 !of%=76 of%!4=@hwnd% of%!12=ff% of%!28=fn% of%!32=256 of%!52=6 $ff%="BMP files"+CHR$0+"TrainReg.BMP"+CHR$0+CHR$0 SYS "GetSaveFileName",of% TO result% IF result% THEN filename$=FNnulterm$(fn%) IF ASC(RIGHT$(filename$,4))<>ASC(".") THEN filename$+=".bmp" ELSE RIGHT$(filename$,4)=".bmp" DIM temp% 3 file%=OPENUP(filename$):IF file%=0 THEN file%=OPENOUT(filename$) SYS "WriteFile",@hfile%(file%),data%,size%,temp%,0 CLOSE#file% ENDIF : SYS "GlobalFree", data% ENDPROC |
Clicking the 'close' icon of a window On the Acorn this generates a reason code of Close_WindowRequest (3) and under Windows a menu select (ON SYS) with an item number of 2. | |
REM Nothing extra required, window is removed from the REM list of those to be displayed and anything below it is redrawn. |
DEFPROCmenuselect(wm_a%,wm_sel%,wm_b%) CASE wm_sel% OF WHEN 2 REM Only intercept this if additional action is required REM when dialogue boxes etc. are closed WHEN .. ENDCASE ENDPROC : DEFPROCclose REM BASIC main output window closed - exit tidily REM Test and close any open window REM Release any memory claimed quit%=TRUE ok%+=0:IF ok%<>0 THEN PROC_exitsprites SYS "WinHelp",@hwnd%,0,2,0 ENDPROC |
Context-sensitive (or 'popup') menu creation Clicking the middle mouse button on the Acorn when over the work area of a window produces a 'pop up' menu snsitive to context. Clicking the right button under Windows does the same thing. | |
DEFPROCbuttons(b%) : REM !b is the mouse position in absolute screen coordinates (X) REM b!4 is the mouse position in absolute screen coordinates (Y) REM b!8 is 1 - adjust 2 - menu 4 - select REM 1 then 16 - drag with adjust 4 then 64 - drag with select REM b!12 is the window handle or -1 for background or -2 for icon bar REM b!16 is the icon handle of -1 for work area background : LOCAL mx% , my% , but% , win% , ic% mx%=!b% my%=b%!4 but%=b%!8 win%=b%!12 ic%=b%!16 : CASE win% OF : WHEN sb_main%(sbox%) IF ic%=-1 THEN REM Click over work area of window: but% AND 7 is 1/2/4 (button) zoom=zoomval(sbox%) PROCsboxclick(mx%,my%,but%,win%) ENDIF ENDCASE ENDPROC : DEFPROCsboxclick(mx%,my%,but%,win%) zzz%=FNwhereamI(win%,mx%,my%,but%) CASE zzz% OF WHEN 16,17,18 CASE TRUE OF WHEN (but% AND 7)<>0 REM Any button clicked over block instrument PROCmenusecsig(mx%,my%,sss%) ENDCASE ENDCASE ENDPROC : DEFPROCmenusecsig(mx%,my%,bsec%) LOCAL bs% mbls%=bsec% ita%=BlockState%(abls%) itb%=BlockState%(bbls%) mss0$=BoxName$(SBox%(bsec% EOR 1)) mss1$="1 - Call Attention" mss2$=" Is Line Clear" mss3$="2 - Train entering section" mss4$="2-1 - Train out of section" mss5$="3-5 - Cancelling" mss6$="3-3 - Blocking back" mss7$="2-3-3 - Wrong road move" mss8$="2-4-2 - Ack. line occupied acceptance" IF ita%=12 THEN mss8$="3-5-5 - Ack. warning acceptance" IF ita%=3 THEN mss7$="2-3-3 - Ack. wrong road move" IF itb%=3 AND STmr%(bbls%)>0 THEN mss1$="1 - Call attn. (refuse train offered)" IF itb%=1 OR ita%=1 THEN mss1$="1 - Ack. call attention" IF itb%=3 AND ita%<>11 THEN mss2$=" Ack. is line clear" IF itb%=4 THEN mss2$="3-3-5 - Now clear reg. 4" IF BC%(bbls%)=&20303 AND (ita%=11 OR ita%=33 OR ita%=34 OR ita%=36 OR ita%=37) THEN mss4$="2-5 - Cancel wrong road move" IF itb%=7 THEN mss3$=" Ack. train entering" IF BC%(abls%)=&20103 THEN mss5$="3-2-3 - Train drawn back" IF BC%(abls%)=&30302 THEN mss5$="8 - Cancel shunt" IF BC%(abls%)=&20303 THEN mss5$="5-2 - Wrong road move complete" IF (itb%=8 OR itb%=9) AND BC%(bbls%)=&20303 THEN mss5$="5-2 - Ack. wrong road move complete" menu_secsig%=FNdrawmenu(mss0$+":,"+mss1$+","+mss2$+","+mss3$+","+mss4$ +","+mss5$+","+mss6$+","+mss7$+","+mss8$,mnuptr%,indptr%) PROCgray(itb%<>3 OR STmr%(bbls%)<=0,menu_secsig%,mss1$) PROCgray(itb%<>3 AND ita%<>11 AND itb%<>4 AND (ita%<>37 OR (abls%<>toT% AND abls%<>toR% AND abls%<>toM%)),menu_secsig%,mss2$) PROCgray(itb%<>7 AND ((ita%<>13 AND ita%<>14 AND ita%<>33 AND ita%<>34 AND ita%<>19 AND ita%<>39) OR abls%=toG%),menu_secsig%,mss3$) PROCgray((itb%<>7 AND itb%<>8) OR bbls%=exG% OR (BC%(bbls%)=&20303 AND ita%<>11 AND ita%<>33 AND ita%<>34 AND ita%<>36 AND ita%<>37),menu_secsig%,mss4$) PROCgray(ita%<>33 AND ita%<>34 AND ita%<>36 AND ita%<>37 AND ita%<>39 AND ita%<>8 AND itb%<>9,menu_secsig%,mss5$) PROCgray((ita%<>11 AND ita%<>33 AND ita%<>34 AND ita%<>36 AND ita%<>37 AND ita%<>38 AND ita%<>39) OR abls%=bbls% OR (itb%<>0 AND itb%<>1 AND itb%<>3),menu_secsig%,mss6$) PROCgray((ita%<>3 AND ita%<>11 AND ita%<>33 AND ita%<>34 AND ita%<>36 AND ita%<>37) OR abls%=bbls% OR (ita%<>3 AND itb%<>0 AND itb%<>1 AND itb%<>3),menu_secsig%,mss7$) IF itb%<>4 OR ita%=11 OR (ita%=37 AND (abls%=toR% OR abls%=toT% OR abls%=toM%)) OR ita%=12 THEN menu_secsig1%= FNdrawsubspmenu(menu_secsig%,mss2$,"Description:",mnuptr%,indptr%,bsec%) REM line above was IF itb%<>4 THEN .. IF itb%=3 THEN PROCgray(toff%(bsec%)=&30302 ,menu_secsig1%," 3-5-5 Accept Reg. 5 ") PROCgray((ita%<>18 AND ita%<>12) OR STmr%(abls%)>=0,menu_secsig%,mss8$) SYS "Wimp_CreateMenu",,menu%+4,mx%,my% whichmenu%=3 ENDPROC |
DEFPROCmouseclick(a%,wm_par%,b%) REM this could be a menu click etc. or a click over a lever select%=0:adjust%=0 IF (wm_par% AND 2)<>0 THEN adjust%=TRUE IF (wm_par% AND 1)<>0 THEN select%=TRUE IF select% OR adjust% THEN REM Select/Adjust button click - get cursor position to determine action SYS "GetCursorPos", ^X% REM Set x% and y% to value from mouse click REM (should already be set from MOUSE x%,y%) V%=b% AND &FFFF W%=b%>>16 x%= (V%<<1)-@vdu%!0 y%= (((@vdu%!212)-1-W%)<<1)-@vdu%!4 : pq%=FNubi(x%,y%) CASE pq% OF WHEN 18 sss%=xxx% PROCmenupop(3,x%,y%,sss%) ENDCASE ENDIF ENDPROC : DEFPROCmenupop(mnu%,x%,y%,bbs%) WHILE wh_s%<wh_f% REM Check which menu item appears in CASE wh_s% OF WHEN 23 SYS "RemoveMenu",hpop4%,1,&400:REM Delete 23/sub menu item SYS "DeleteMenu",hpop4%,22,0 WHEN 24,25,26,27,28,29 SYS "DeleteMenu",hpop4%,wh_s%,0 WHEN 30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49 SYS "DeleteMenu",hPopup%,wh_s%,0 WHEN 90,91,92,93,94,95,96,97,98,99 SYS "DeleteMenu",hpop5%,wh_s%,0 ENDCASE wh_s%+=1 ENDWHILE CASE mnu% OF WHEN 3 REM Menu secsig mbls%=bbs% abls%=bbs% AND &FC ita%=BlockState%(abls%) itb%=BlockState%(bbls%) mss0$=BoxName$(SBox%(bbs% EOR 1)) mss1$="1 - Call Attention" mss2$=" Is Line Clear" mss3$="2 - Train entering section" mss4$="2-1 - Train out of section" mss5$="3-5 - Cancelling" mss6$="3-3 - Blocking back" mss7$="2-3-3 - Wrong road move" mss8$="2-4-2 - Ack. line occupied acceptance" IF ita%=12 THEN mss8$="3-5-5 - Ack. warning acceptance" IF ita%=3 THEN mss7$="2-3-3 - Ack. wrong road move" IF itb%=3 AND STmr%(bbls%)>0 THEN mss1$="1 - Call attn. (refuse train offered)" IF itb%=1 OR ita%=1 THEN mss1$="1 - Ack. call attention" IF itb%=3 AND ita%<>11 THEN mss2$=" Ack. is line clear" IF itb%=4 THEN mss2$="3-3-5 - Now clear reg. 4" IF BC%(bbls%)=&20303 AND (ita%=11 OR ita%=33 OR ita%=34 OR ita%=36 OR ita%=37) THEN mss4$="2-5 - Cancel wrong road move" IF itb%=7 THEN mss3$=" Ack. train entering" IF BC%(abls%)=&20103 THEN mss5$="3-2-3 - Train drawn back" IF BC%(abls%)=&30302 THEN mss5$="8 - Cancel shunt" IF BC%(abls%)=&20303 THEN mss5$="5-2 - Wrong road move complete" IF (itb%=8 OR itb%=9) AND BC%(bbls%)=&20303 THEN mss5$="5-2 - Ack. wrong road move complete" SYS "AppendMenu", hPopup%, 0, 30, "'A' 4 Express pass'r" SYS "AppendMenu", hPopup%, 0, 31, "'A' 4-2 Express DMU" SYS "AppendMenu", hPopup%, 0, 32, "'A' 3-3-3 Diner" SYS "AppendMenu", hPopup%, 0, 33, "'B' 3-1 Ord. pass'r" SYS "AppendMenu", hPopup%, 0, 34, "'B' 3-1-2 DMU" SYS "AppendMenu", hPopup%, 0, 35, "'B' 1-3 Brch. pass'r" SYS "AppendMenu", hPopup%, 0, 36, "'C' 2-2-1 ECS" SYS "AppendMenu", hPopup%, 0, 37, "'C' 2-2-1-2 EDMU" SYS "AppendMenu", hPopup%, 0, 38, "'C' 5 Pcls, Fitted frt" SYS "AppendMenu", hPopup%, 0, 39, "'D' 1-2-2 Exp fitted frt" SYS "AppendMenu", hPopup%, 0, 40, " " SYS "AppendMenu", hPopup%, 0, 41, "'F' 3-2 Frt not calling" SYS "AppendMenu", hPopup%, 0, 42, "'F' 3-2-1-5 Frt non stop" SYS "AppendMenu", hPopup%, 0, 43, "'G' 2-3 Light engine" SYS "AppendMenu", hPopup%, 0, 44, "'G' 1-1-3 Engine & brake" SYS "AppendMenu", hPopup%, 0, 45, "'H' 1-4 Frt calling" SYS "AppendMenu", hPopup%, 0, 46, "'H' 2-1-6 Out of gauge" SYS "AppendMenu", hPopup%, 0, 47, "'K' 1-2 Branch frt" IF itb%=3 THEN SYS "AppendMenu", hPopup%, 0, 48, " 3-5-5 Accept Reg. 5 " ELSE SYS "AppendMenu", hPopup%, 0, 48, "'K' 2-2-3 Stop in section" ENDIF IF itb%=3 AND toff%(bbs%)<>&30302 THEN SYS "AppendMenu", hPopup%, 0, 49," 2-2-2 Accept Reg. 4A " ELSE SYS "AppendMenu", hPopup%, 0, 49," 3-3-2 Shunt into fwd. section" ENDIF SYS "AppendMenu", hpop4%, 0, 22, mss1$ IF ita%=11 OR (ita%=37 AND (abls%=toR% OR abls%=toT% OR abls%=toM%)) OR itb%=3 THEN SYS "AppendMenu", hpop4%, 16, hPopup%, mss2$ ELSE SYS "AppendMenu", hpop4%, 0, 23, mss2$ ENDIF SYS "AppendMenu", hpop4%, 0, 24, mss3$ SYS "AppendMenu", hpop4%, 0, 25, mss4$ SYS "AppendMenu", hpop4%, 0, 26, mss5$ SYS "AppendMenu", hpop4%, 0, 27, mss6$ SYS "AppendMenu", hpop4%, 0, 28, mss7$ SYS "AppendMenu", hpop4%, 0, 29, mss8$ SYS "EnableMenuItem", hpop4%, 22, 1+(itb%=3 AND STmr%(bbls%)>0) IF ita%<>11 AND (ita%<>37 OR (abls%<>toR% AND abls%<>toT% AND abls%<>toM%)) AND itb%<>3 THEN SYS "EnableMenuItem", hpop4%, 23, 1+(itb%=3) SYS "EnableMenuItem", hpop4%, 24, 1+(itb%=7 OR ((ita%=13 OR ita%=14 OR ita%=33 OR ita%=34 OR ita%=19 OR ita%=39) AND abls%<>toG%)) SYS "EnableMenuItem", hpop4%, 25, 1+((itb%=7 OR itb%=8) AND bbls%<>exG% AND (BC%(bbls%)<>&20303 OR ita%=11 OR ita%=33 OR ita%=34 OR ita%=36 OR ita%=37)) SYS "EnableMenuItem", hpop4%, 26, 1+(ita%=33 OR ita%=34 OR ita%=36 OR ita%=37 OR ita%=39 OR ita%=8 OR itb%=9) SYS "EnableMenuItem", hpop4%, 27, 1+((ita%=11 OR ita%=33 OR ita%=34 OR ita%=36 OR ita%=37 OR ita%=38 OR ita%=39) AND abls%<>bbls% AND (itb%=0 OR itb%=1 OR itb%=3)) SYS "EnableMenuItem", hpop4%, 28, 1+((ita%=3 OR ita%=11 OR ita%=33 OR ita%=34 OR ita%=36 OR ita%=37) AND abls%<>bbls% AND (ita%=3 OR itb%=0 OR itb%=1 OR itb%=3)) SYS "EnableMenuItem", hpop4%, 29, 1+((ita%=18 OR ita%=12) AND STmr%(abls%)<0) SYS "EnableMenuItem", hPopup%, 48, 1+(itb%<>3) wh_s%=22 wh_f%=50 !mnup%=hpop4% SYS "SendMessage", @hwnd%, &500, X%, Y% ENDCASE ENDPROC |
Menu selection These are treated similarly on both machines - the Acorn has a menu structure with absolute item numbers from zero stored recursively - under Windows you can use item 'handle' numbers allocated when the menu is created. | |
DEF PROCmenuselect(b%) LOCAL mnux% , mnuy% SYS "Wimp_GetPointerInfo",,mbk% mnux%=!mbk% mnuy%=mbk%!4 IF (mbk%!8) AND 1 THEN adj%=TRUE ELSE adj%=FALSE CASE whichmenu% OF WHEN -2 REM Icon bar menu IF !b%=0 AND b%!4=-1 THEN REM click on first item directly ENDIF IF !b%=1 AND b%!4=2 AND b%!8=-1 THEN REM click on the third item in the sub menu from item two ENDIF WHEN 3:REM secsig abls%=mbls% AND &FC ita%=BlockState%(abls%) itb%=BlockState%(bbls%) CASE !b% OF WHEN 0 REM Call attention WHEN 2 REM Train entering section WHEN 3 REM Train out of section ENDCASE ENDCASE ENDPROC |
DEFPROCmenuselect(wm_a%,wm_sel%,wm_b%) CASE wm_sel% OF WHEN 23,24,25,26,27,28,29:REM secsig abls%=mbls% AND &FC ita%=BlockState%(abls%) itb%=BlockState%(bbls%) CASE wm_sel% OF WHEN 22 REM Call attention WHEN 24 REM Train entering section WHEN 25 REM Train out of section ENDCASE ENDCASE ENDPROC |
Context-sensitive help On the Acorn this is done by an external application, just requiring a response to messages. Tasks are required to respond to a Help_Request message with a text string in a reply message. The external application can then display text in a thought bubble emanating from the mouse wherever it is. Under Windows the standard help utility WinHelp can open a help manual at any point but similar functionality to the Acorn has to be done manually. | |
DEF PROCreceive(b%) myr%=b%!8 CASE b%!16 OF WHEN &502:PROChelprequest(b%) ENDCASE ENDPROC : DEFPROChelprequest(b%) REM myr%=b%!8 myr is my_ref of sender REM th% is task handle of sender but%=0 win%=b%!32 ic%=b%!36 mx%=b%!20 my%=b%!24 th%=b%!4 !block%=win% : CASE win% OF WHEN -2:REM icon bar PROChrply("This is the icon of 'SignalBox'",myr%,th%) WHEN sb_main%(sbox%):REM work area CASE FNwhereamI(win%,mx%,my%,but%) OF WHEN .. PROChrply("Relevant text",myr%,th%) ENDCASE ENDCASE ENDPROC : DEFPROChrply(help$, rf%, to%) block%!0 = 256 block%!12 = rf% block%!16 = &503 $(block%+20) = help$ ?(block%+20+LEN(help$))=0 SYS "Wimp_SendMessage", 17, block%, to% ENDPROC |
DEFPROCcontexthelp(wh_tx%,wh_ty%) REM Calculate help text pq%=FNubi(wh_tx%,wh_ty%) A$="" CASE pq% OF WHEN ... A$="Relevant text" OTHERWISE A$="Unknown" ENDCASE IF ABS(wh_tx%-wh_x%)+ABS(wh_ty%-wh_y%)>10 THEN wh_x%=wh_tx% wh_y%=wh_ty% wh_tim%=TIME IF wm_dia1% THEN PROC_closedialog(wm_dia1%): PROC_closedialog(wm_dia2%):PROC_closedialog(wm_dia3%) ELSE IF wh_tim%<TIME-100 AND (wm_dia1%=0 OR !wm_dia1%=0) AND pq%<>0 THEN pt%=12 wh_tx1%=2+(wh_tx%-2*bs_sx%)/4.5 wh_ty1%=2+((-wh_ty%+2*bm_ht%+2*bs_sy%+sf*ws_ht%)/5) wh_tx2%=wh_tx1%+1 wh_ty2%=wh_ty1%+1 wh_tx3%=wh_tx1%+3 wh_ty3%=wh_ty1%+3 wh_right%=(2*ws_wid%-bs_wx%-wh_tx%+2*bs_sx%)/4.5 wh_btm%=(-bs_wy%+wh_ty%-2*bm_ht%+(2-sf)*ws_ht%-2*bs_sy%)/5 PROChelppaint(A$) w_w%=2+w_w%/4.5:REM was 165 w_h%=2+w_h%/5:REM was 50 IF wh_right%<w_w%+3 THEN wh_tx1%-=8:wh_tx2%-=12:wh_tx3%-=12+w_w% IF wh_btm%<w_h%+60 THEN wh_ty1%-=8:wh_ty2%-=12:wh_ty3%-=12+w_h% IF wm_dia1%=0 THEN wm_dia1%=FN_newdialog("",X%,Y%,2,2,12,6000) IF wm_dia2%=0 THEN wm_dia2%=FN_newdialog("",X%,Y%,4,4,12,6000) IF wm_dia3%=0 THEN wm_dia3%=FN_newdialog("",X%,Y%,w_w%,w_h%,12,6000) db_dia%=wm_dia3%!12 PROC_static(wm_dia3%,"",27,0,0,w_w%,w_h%,14) ENDIF : wm_dia3%!30=(w_h% << 16) OR w_w% wm_dia3%!26=wh_tx3% OR ((wh_ty3%)<<16) wm_dia3%!16=(wm_dia3%!16) AND &FF7FFFFF wm_dia1%!26=wh_tx1% OR ((wh_ty1%)<<16) wm_dia1%!16=(wm_dia1%!16) AND &FF7FFFFF wm_dia2%!26=wh_tx2% OR ((wh_ty2%)<<16) wm_dia2%!16=(wm_dia2%!16) AND &FF7FFFFF ptr%=db_dia%:WHILE (ptr% AND 3) ptr%+=1:ENDWHILE ptr%!8=0 ptr%!12=(w_h% << 16) OR w_w% PROC_showdialog(wm_dia1%) PROC_showdialog(wm_dia2%) PROC_showdialog(wm_dia3%) SYS "SendDlgItemMessage",!wm_dia3%,27,&172,0,bitmap_h2% SYS "SetForegroundWindow",@hwnd% ENDIF ENDIF ENDPROC : DEFPROChelppaint(A$) !fptr%=-12 fptr%!4=0 fptr%!8=0:REM angle fptr%!12=0:REM rotation fptr%!16=700:REM weight fptr%?20=0:REM italic? fptr%?21=0:REM underline? fptr%?22=0:REM strikeout? fptr%?23=0:REM charset fptr%?24=0:REM precision fptr%?25=0:REM clipping fptr%?26=0:REM quality fptr%?27=&22:REM pitch family $(fptr%+28)="Arial"+CHR$0 SYS "CreateFontIndirect",fptr% TO fhan% SYS "SelectObject",m_context%,fhan% TO old_f% xwid%=0 yp%=0 DA$=A$ REPEAT WHILE ASC(DA$)=32 DA$=MID$(DA$,2) ENDWHILE i%=INSTR(DA$+" "," ") j%=INSTR(DA$+"|M","|M") IF j%<i% THEN i%=j%:j%=TRUE ELSE j%=FALSE ii%=i%+INSTR(MID$(DA$,i%+1)+" "," ") jj%=i%+INSTR(MID$(DA$,i%+1)+"|M","|M") IF jj%<ii% THEN ii%=jj%:jj%=TRUE ELSE jj%=FALSE SYS "GetTextExtentPoint32",n_context%,LEFT$(DA$,ii%-1),LEN(LEFT$(DA$,ii%-1)),rect% xp%=(rect%!0)*2 y10%=(rect%!4)*2 WHILE xp%<160*4.5 AND i%<=LEN(DA$) AND j%=0 i%=ii% j%=jj% ii%=i%+INSTR(MID$(DA$,i%+1)+" "," ") jj%=i%+INSTR(MID$(DA$,i%+1)+"|M","|M") IF jj%<ii% THEN ii%=jj%:jj%=TRUE ELSE jj%=FALSE SYS "GetTextExtentPoint32",n_context%,LEFT$(DA$,ii%-1),LEN(LEFT$(DA$,ii%-1)),rect% xp%=(rect%!0)*2 y10%=(rect%!4)*2 ENDWHILE DB$=LEFT$(DA$,i%-1) DA$=MID$(DA$,i%+1-j%) IF DB$<>"" THEN SYS "GetTextExtentPoint32",n_context%,DB$,LEN(DB$),rect% : xp%=(rect%!0)*2 y10%=(rect%!4)*2 IF xwid%<xp% THEN xwid%=xp% yp%+=y10%/2.4 ENDIF IF j% AND DA$<>"" THEN yp%+=6 ENDIF UNTIL DA$="" w_w%=14+xwid%:REM was 165*4.5 w_h%=2*(yp%+3):REM was 50*5 SYS "SelectObject",n_context%,bitmap_h% TO old_h% SYS "BitBlt",n_context%,0,0,1000,1000,0,0,0,&42 opcode%=&CC0020 SYS "CreateSolidBrush",&DDDDDD TO brush% SYS "GetStockObject",8 TO hpen% SYS "SelectObject",n_context%,hpen% TO old_p% SYS "SelectObject",n_context%,brush% TO old_b% SYS "Rectangle",n_context%,0,0,w_w%,w_h% : SYS "GetStockObject",7 TO hpen% SYS "SelectObject",n_context%,old_p% SYS "SelectObject",n_context%,hpen% TO old_p% SYS "CreateSolidBrush",&CCFFFF TO brush% REM &CCFFFF is yellow help SYS "SelectObject",n_context%,old_b% SYS "SelectObject",n_context%,brush% TO old_b% SYS "Rectangle",n_context%,0,0,w_w%/2,w_h%/2:REM 54,60 SYS "SelectObject",n_context%,old_b% SYS "SelectObject",n_context%,old_p% REM Rectangle formed REM -- SYS "SetBkMode",n_context%,1 :REM opaque=2, transparent=1 xwid%=0 yp%=0 DA$=A$ REPEAT WHILE ASC(DA$)=32 DA$=MID$(DA$,2) ENDWHILE i%=INSTR(DA$+" "," ") j%=INSTR(DA$+"|M","|M") IF j%<i% THEN i%=j%:j%=TRUE ELSE j%=FALSE ii%=i%+INSTR(MID$(DA$,i%+1)+" "," ") jj%=i%+INSTR(MID$(DA$,i%+1)+"|M","|M") IF jj%<ii% THEN ii%=jj%:jj%=TRUE ELSE jj%=FALSE SYS "GetTextExtentPoint32",n_context%,LEFT$(DA$,ii%-1),LEN(LEFT$(DA$,ii%-1)),rect% xp%=(rect%!0)*2 y10%=(rect%!4)*2 WHILE xp%<160*4.5 AND i%<=LEN(DA$) AND j%=0 i%=ii% j%=jj% ii%=i%+INSTR(MID$(DA$,i%+1)+" "," ") jj%=i%+INSTR(MID$(DA$,i%+1)+"|M","|M") IF jj%<ii% THEN ii%=jj%:jj%=TRUE ELSE jj%=FALSE SYS "GetTextExtentPoint32",n_context%,LEFT$(DA$,ii%-1),LEN(LEFT$(DA$,ii%-1)),rect% xp%=(rect%!0)*2 y10%=(rect%!4)*2 ENDWHILE DB$=LEFT$(DA$,i%-1) DA$=MID$(DA$,i%+1-j%) IF DB$<>"" THEN SYS "GetTextExtentPoint32",n_context%,DB$,LEN(DB$),rect% xp%=(rect%!0)*2 y10%=(rect%!4)*2 IF xwid%<xp% THEN xwid%=xp% $chars%=DB$ SYS "TextOut",n_context%,5,yp%,chars%,LEN(DB$) yp%+=y10%/2.4 ENDIF IF j% AND DA$<>"" THEN yp%+=6 ENDIF UNTIL DA$="" SYS "SelectObject",n_context%,old_f% SYS "DeleteObject",fhan% SYS "SelectObject",n_context%,old_h% ENDPROC |
Sound On the Acorn the SOUND command allows a sound to be added to the queue to sound after a defined delay. Under Windows it is more complicated. The procedure PROCbell(&303,bellnumber) causes a sound of 3 beats, pause 3 beats to be added to the queue. A web site devoted to an investigation into the sound and tuning of church bells proved most useful in crraring bell-like sounds under Windows. | |
VOICE 2,"UserLib_Bell" DEFPROCbell(i%,sbel%) LOCAL j% IF TIME>btim%+bdel% THEN j%=0 ELSE j%=btim%+bdel%-TIME CASE sbel% AND &FC OF WHEN 2 AND &FC :belc%=2:belt%=120 WHEN toW% AND &FC :belc%=2:belt%=120 WHEN toSR% AND &FC:belc%=2:belt%=20 WHEN toG% AND &FC :belc%=2:belt%=10 WHEN toR% AND &FC :belc%=3:belt%=100 WHEN toT% AND &FC :belc%=1:belt%=60 WHEN toM% AND &FC :belc%=1:belt%=5 ENDCASE j%+=10+RND(20) BellOn%(sbel% DIV 4)=TIME+j% bdel%=FNbelldelay(i%,j%) BellOff%(sbel% DIV 4)=bdel% btim%=TIME alloff%=btim%+bdel% ENDPROC : DEFFNbelldelay(i%,j%) LOCAL jj% jj%=0 WHILE (i% DIV &1000000)>0 SOUND belc%,-15,belt%,40,j% j%+=20 jj%=20 i%-=&1000000 ENDWHILE j%+=jj% WHILE (i% DIV &10000)>0 SOUND belc%,-15,belt%,40,j% j%+=20 jj%=20 i%-=&10000 ENDWHILE j%+=jj% WHILE (i% DIV &100)>0 SOUND belc%,-15,belt%,40,j% j%+=20 jj%=20 i%-=&100 ENDWHILE j%+=jj% WHILE i%>0 SOUND belc%,-15,belt%,40,j% j%+=20 i%-=1 ENDWHILE =j% : |
DEFPROCbell(i%,sbel%) REM Add bell sound to queue to be played REM at BellOn%(i),BellBeat%(i),BellOff%(i),BellBlock%(i) REM i=nextbell% is next empty item in queue, at end of queue REM i=1 is next item to be played ; i=0 is current playing REM REM alloff% is TIME when all sounds in queue should have been played IF alloff%<TIME THEN alloff%=TIME BellOn%(nextbell%)=alloff% IF (i% DIV &1000000)>0 THEN alloff%+=21 IF (i% DIV &10000)>0 THEN alloff%+=21 IF (i% DIV &100)>0 THEN alloff%+=21 alloff%+=16*((i% DIV &1000000)+((i% AND &FFFFFF) DIV &10000) +((i% AND &FFFF) DIV &100)+(i% AND &FF)) alloff%+=80 BellOff%(nextbell%)=alloff% BellBeat%(nextbell%)=i% BellBlock%(nextbell%)=sbel% AND &FC nextbell%+=1:IF nextbell%>29 THEN nextbell%=29 ENDPROC : DEFPROCsendsound REM Read single beat into memory REM SYS "PlaySound",0,0,1 will terminate any playing sound REM SYS "PlaySound",0|sound,0,&2000 will terminate any playing sound SYS "PlaySound",0,0,1 CASE BellBlock%(1) AND &FC OF WHEN 2 AND &FC :wm_bell$="bell9.wav":wm_so%=48 WHEN toW% AND &FC :wm_bell$="bell2.wav":wm_so%=48 WHEN toSR% AND &FC:wm_bell$="bell3.wav":wm_so%=48 WHEN toG% AND &FC :wm_bell$="bell4.wav":wm_so%=48 WHEN toR% AND &FC :wm_bell$="bell5.wav":wm_so%=48 WHEN toT% AND &FC :wm_bell$="bell6.wav":wm_so%=48 WHEN toM% AND &FC :wm_bell$="bell7.wav":wm_so%=48 WHEN -1 AND &FC :wm_bell$="TYPE.wav":wm_so%=44 OTHERWISE :wm_bell$="bell8.wav":wm_so%=48 ENDCASE : wm_fh%=OPENIN (wm_path$+wm_bell$) IF wm_fh%=0 THEN ERROR 402,"File "+wm_path$+wm_bell$+" containing sound data not found." wm_len%=EXT#wm_fh% : PTR#wm_fh%=0 SYS "ReadFile",@hfile%(wm_fh%),wm_sound%+wm_soundlen%-wm_len%-20000,wm_len%,wm_temp%,0 CLOSE#wm_fh% REM FOR j%=0 TO 20000 REM wm_sound%?(wm_soundlen%-20000+j%)=0 REM NEXT j% beat%=wm_sound%+wm_soundlen%-wm_len%+wm_so%-20000 nextbeat%=beat% FOR j%=0 TO wm_so%-1 wm_sound%?j%=beat%?(j%-wm_so%) NEXT j% durn%=0 REM nextbeat% points to start of next beat in memory REM ndat% is number of bytes next beat occupies REM sampling is at 22050 Hz i%=BellBeat%(1) beatlen%=220*16*2:REM 16cs pauselen%=220*21*2:REM 21cs : jj%=i% AND &FF WHILE jj%>0 FOR j%=0 TO durn%-1 nextbeat%?j%=beat%?j% NEXT j% durn%=beatlen% nextbeat%-=durn% jj%-=1 ENDWHILE : jj%=(i% AND &FFFF) DIV &100 IF jj%>0 THEN nextbeat%-=pauselen%:durn%+=pauselen% WHILE jj%>0 FOR j%=0 TO durn%-1 nextbeat%?j%=beat%?j% NEXT j% durn%=beatlen% nextbeat%-=durn% jj%-=1 ENDWHILE : jj%=(i% AND &FFFFFF) DIV &10000 IF jj%>0 THEN nextbeat%-=pauselen%:durn%+=pauselen% WHILE jj%>0 FOR j%=0 TO durn%-1 nextbeat%?j%=beat%?j% NEXT j% durn%=beatlen% nextbeat%-=beatlen% jj%-=1 ENDWHILE : jj%=i% DIV &1000000 IF jj%>0 THEN nextbeat%-=pauselen%:durn%+=pauselen% WHILE jj%>0 FOR j%=0 TO durn%-1 nextbeat%?j%=beat%?j% NEXT j% durn%=beatlen% nextbeat%-=beatlen% jj%-=1 ENDWHILE : nextbeat%+=beatlen% nextbeat%-=wm_so% FOR j%=0 TO wm_so%-1 nextbeat%?j%=wm_sound%?j% NEXT j% ndat%=nextbeat%!(wm_so%-4) ndat%+=beat%-nextbeat%-wm_so% nextbeat%!(wm_so%-4)=ndat% nextbeat%!4=ndat%+wm_so%-8 SYS "PlaySound",nextbeat%,0,5 FOR i%=1 TO nextbell% BellOn%(i%-1)=BellOn%(i%) BellOff%(i%-1)=BellOff%(i%) BellBlock%(i%-1)=BellBlock%(i%) BellBeat%(i%-1)=BellBeat%(i%) NEXT i% nextbell%-=1:IF nextbell%<1 THEN nextbell%=1:BellOn%(1)=0 ENDPROC |