RISC OS S.V.R. S&T Department RISC OS
http://www.svrsig.org/ software/SoftCon.htm

Software conversion - using BBC Basic for Windows

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 TIME derived from WM_TIMER messages
  • ON CLOSE derived from WM_CLOSE messages
  • ON MOUSE derived from WM_LBUTTONDOWN, WM_LBUTTONDBLCLK, WM_MBUTTONDOWN, WM_MBUTTONDBLCLK, WM_RBUTTONDOWN and WM_RBUTTONDBLCLK messages
  • ON MOVE derived from WM_MOVE, WM_SIZE, WM_VSCROLL and WM_HSCROLL messages
  • ON SYS derived from WM_COMMAND messages

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