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