; Copyright 1996 Acorn Computers Ltd
;
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
;
; http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
; See the License for the specific language governing permissions and
; limitations under the License.
;
; > s.Wimp05
;;----------------------------------------------------------------------------
;; Code for dealing with writable icons
;;----------------------------------------------------------------------------
SWIWimp_SetCaretPosition
MyEntry "SetCaretPosition"
; next bit turned off as they've changed their mind AGAIN!!!
[ false
; in 16/32 bit modes ReadPalette EOR trick doesn't work, so make sure
; that wimp colour 11 is used.
LDR R14,log2bpp
CMP R14,#3
[ false
BICGT R4,R4,#(1 :SHL: 26)
|
; alternatively, assume colour is a wimp colour number
BICGT R4,R4,#(1:SHL:27)
]
]
BL int_set_caret_position
B ExitWimp
; Entry: R0,R1 = window/icon handles
; R2,R3 = x,y coords (relative to window)
; R4 = caret height/flags
; R5 = index of caret (if in a writable icon)
; [caretdata .. caretdata+20] = old caret data
; [caretscrollx] = scroll offset within current icon
; Exit: old caret removed from screen
; new caret replotted
; if old/new text icon had to scroll, it will be redrawn
; Actions on new caret data:
; R0<=0 ==> just turn caret off
; R1<0 ==> R4>=0, R5 ignored
; R4>=0 and R5>=0 ==> recompute R2 from R5 (R3,R4 preserved)
; R5<0 ==> recompute R4,R5 from R0,R1,R2,R3
; R4<0 ==> recompute R2,R3,R4 from R0,R1,R5
MACRO
$label TraceCaretData
$label TraceK sc, "w "
TraceX sc, R0
TraceK sc, ", i "
TraceD sc, R1
TraceK sc, ", (x, y) ("
TraceD sc, R2
TraceK sc, ", "
TraceD sc, R3
TraceK sc, "), height "
TraceD sc, R4
TraceK sc, ", index "
TraceD sc, R5
TraceNL sc
MEND
int_set_caret_position TraceL sc
Push "R6-R7,LR" ; R6,R7 are used as temporaries
LDR R6,taskhandle ; preserve calling task
Push "R0-R6" ; save caret data + taskhandle
TraceK sc, "int_set_caret_position: "
TraceCaretData
CheckAllWindows "int_set_caret_position (before)"
LDR R14,caretdata
STR R14,oldcaretwindow
TEQ R0,R14 ; are we going to the same window?
BLNE send_losecaret ; [caretdata] contains data
MOV R14,#-bignum
STR R14,leftborder ; in case any redrawing needs doing
ADR R14,caretdata
LDMIA R14,{R0-R6} ; R6 = previous caretscrollx
TraceK sc, "Old caret data: "
TraceCaretData
MOV R14,#0
STR R14,caretdata+24
CMP R0,#nullptr ; any window selected?
BLE notwindow1 ; if not, caretscrollx must = 0
CMP R1,#0
BLT noticon1 ; this isn't an icon
STR R6,caretdata+24 ; that value was indeed valid
; if icon scrolls because the caret leaves, it must be redrawn
; [caretdata+24] updated to reflect state of icon to receive the caret
LDR R14,[sp,#0]
TEQ R14,R0
LDREQ R14,[sp,#4]
TEQEQ R14,R1
TEQNE R6,#0 ; NE ==> we must redraw the icon
BEQ noticon1
MOV R14,#0
STR R14,caretdata+24 ; 'old caretscrollx' = 0 for sure now
STR R14,caretdata+0 ; CARET IS DEFINITELY NOT NOW HERE
BL pageinicontask ; Swap to task if icon indirected
Trace sc, "int_set_caret_position: psr ", X, PC
BLVC redrawtexticon ; R1 = icon handle
B notwindow1
noticon1 TraceL sc
BL upcaret
notwindow1 TraceL sc
MOVVS R14,#nullptr ; no caret if error
STRVS R14,caretdata+0
STRVS R0,[sp]
Pull "R0-R5" ; report errors when removing caret
BVS exitsetcaret
; now do the new caret:
TraceK sc, "New caret data: "
TraceCaretData
MOV R14,#0 ; will be 0 unless find/setcaret called
STR R14,caretscrollx
MOV handle,R0
BL checkhandle
MOVVS R0,#nullptr ; treat as null window if deleted
; decide whether we're going into an icon, or if this is a 'user caret'
CMP R0,#0 ; CLR V ; no caret at all
BLE notwindow2
CMP R1,#0
BLT noticon2
; now, if R4 and R5 valid, compute R2 from R5, to cope with scrolling
; NB: R5<0 overrides R4<0 (ie. findcaret is preferred to setcaretcoords)
LDR R14,[handle,#w_taskhandle]
Task R14,,"SetCaret" ; this will be reset on exit from Wimp!
Push "R3,R4" ; these are valid, so save them
CMP R4,#0
CMPPL R5,#0
BLPL setcaretcoords ; must recompute [caretscrollx]
Pull "R3,R4"
CMP R5,#0 ; if R5<0 then R4,R5 <-- R0,R1,R2,R3
BLMI findcaret
CMP R4,#0 ; if R4<0 then R2,R3,R4 <-- R0,R1,R5
BLMI setcaretcoords
TraceK sc, "Modified caret data: "
TraceCaretData
ADR R14,caretdata
STMIA R14,{R0-R5} ; processed values
LDR R6,caretdata+24 ; R6 = old value
LDR R14,caretscrollx
STR R14,caretdata+24 ; new value = R14 = caretscrollx
Debug sc,"Old/New caretscrollx =",R6,R14
TEQ R14,R6 ; is this different from last time?
BEQ noticon2
BL redrawtexticon ; handle,R1 = window,icon handles
B notwindow2 ; caret was drawn as well
noticon2 TraceL sc
BL upcaret
notwindow2 TraceL sc
BVS gained_caret
TraceK sc, "Storing new caret data: "
TraceCaretData
ADR R14,caretdata ; relevant only if R0<=0 or R1<0
STMIA R14,{R0-R5}
; update window borders
LDR R0,oldcaretwindow
LDR R14,caretdata
TEQ R0,R14
BLNE focusoff ; preserves flags
BVS gained_caret
BLNE send_gaincaret ; [caretdata] contains data
LDRNE R0,caretdata
BLNE focuson
gained_caret TraceL sc
MOVVS R14,#nullptr ; no caret if error
STRVS R14,caretdata+0
exitsetcaret TraceL sc
CheckAllWindows "int_set_caret_position (after)"
Pull "R14" ; taskhandle is remembered
Task R14,,"Restoring after SetCaret"
Pull "R6-R7,PC"
; Entry: R0,R1 = handle,icon
; R2,R3 = caret coords (rel. to window origin)
; R4,R5 = caret height/index
upcaret TraceL sc
TST R4,#crf_invisible
MOVNE PC,LR
Push "R0-R5,LR"
Debug child,"upcaret called"
MOV handle,R0
BL checkhandle
BVS %FT99
MOV R4,R4,LSL #16 ; remove flags
MOV R4,R4,LSR #16
LDR R14,dx
SUB x0,R2,R14
SUB x0,x0,R14,LSL #1 ; x0 <- R2 - 3*dx
ADD x1,R2,R14,LSL #2 ; x1 <- R2 + 4*dx
MOV y0,R3
ADD y1,R3,R4 ; just above top of caret
ADD y1,y1,R14 ; +dx for luck
Push "R1-R5"
MOV R0,#getrect_firstrect:OR:getrect_updating:OR:getrect_noicons
BL int_update_window2
ADD R14,handle,#w_wax0
LDMIA R14,{R1-R6}
SUB x1,R1,R5 ; get x origin
SUB y1,R4,R6 ; get y origin
Pull "R1-R5"
LDR R1,[sp,#4*4] ; caret height (OS coords) + flags
ADD R4,y1,R3 ; y coord of caret
ADD R3,x1,R2 ; x coord of caret
MOV R2,#&10 ; use OS coords
upcarlp
Push "R1-R4"
BL int_get_rectangle
Pull "R1-R4"
TEQ R0,#0 ; doesn't affect V flag
BEQ %FT99
BLVC plotcaret
BVC upcarlp
99
Debug child,"upcaret exitting"
STRVS R0,[sp]
Pull "R0-R5,PC"
; Plot caret
; Entry: R1 = height of caret (plus funny bits)
; crf_vdu5caret ==> don't use font manager
; crf_invisible ==> don't actually draw caret
; crf_usercolour ==> bits 16-23 are colour to use
; crf_realcolour ==> don't use colour lookup table
; R3,R4 = caret position
; handle --> window definition
plotcaret ROUT
TST R1,#crf_invisible
MOVNE PC,LR
Push "R0-R3,R5,LR"
TST R1,#crf_usercolour
MOVEQ R0,#11 ; default caret colour
MOVNE R0,R1,LSR #crb_colourshift
ANDNE R0,R0,#&FF
TSTNE R1,#crf_realcolour ; was it a Wimp colour?
BNE %FT10 ; no, it was a real colour so ignore this lookup
BL getpalpointer ; R14 -> physical colour table (fifteen entries)
AND R0,R0,#&F ; range from 0..15
LDR R0,[R14,R0,LSL #2]
LDR R5,[R14,#0] ; get caret physical and background physical
SWI XColourTrans_ReturnGCOL ; = caret colour to use
Push "R0"
MOVVC R0,R5 ; = background colour to apply
SWIVC XColourTrans_ReturnGCOL
Pull "R5" ; translate the colours
BVS upfancyfont_leave
; R0 = logical background colour
; R5 = logical foreground colour
EOR R0,R5,R0 ; R0 = ((colour 11) EOR (colour 0))
10 TST R1,#crf_vdu5caret
MOV R1,R1,LSL #32-crb_colourshift ; bottom 16 bits are height
MOV R1,R1,ASR #32-crb_colourshift
BEQ upfancyfont
Push "R3-R4"
MOV R3,#&00 ; logic mode 3, EOR
MOV R4,#&03
SWI XColourTrans_SetColour
Pull "R3-R4" ; must preserve R2..R4
BVS upfancyfont_leave
SUB R1,R1,#1 ; make inclusive (not nec. aligned!)
MOV R5,R1
Plot &04,R3,R4 ; draw vertical bar
Plot &01,#0,R5
caret_stroke * 2
caret_cross * 3*caret_stroke ; width of cross-pieces (OS units)
Plot &00,#(caret_stroke-caret_cross)/2,#0 ; draw upper cross-piece
Plot &01,#caret_cross-2,#0
SUB R1,R3,#(caret_cross-caret_stroke)/2
Plot &04,R1,R4 ; draw lower cross-piece
Plot &01,#caret_cross-2,#0
Pull "R0-R3,R5,PC"
upfancyfont
LDR R14,log2bpp
TEQ R14,#3
SWIEQ XColourTrans_GCOLToColourNumber
MOV R2,#&14 ; use OS units
TraceK sc, "upfancyfont: colour "
TraceD sc, R0
TraceK sc, ", height "
TraceD sc, R1
TraceK sc, ", flags "
TraceX sc, R2
TraceK sc, ", (x, y) ("
TraceD sc, R3
TraceK sc, ", "
TraceD sc, R4
TraceK sc, ")"
TraceNL sc
SWI XFont_Caret
upfancyfont_leave
STRVS R0,[sp]
Pull "R0-R3,R5,PC"
; if updating and drawing icons, we must remove/replace the caret!
forcecaret
Push "R1,cx0,cy0,cx1,cy1,LR"
Rel R0,handle
LDR R14,caretdata ; window handle
CMP R0,R14 ; same one?
Pull "R1,cx0,cy0,cx1,cy1,PC",NE
; draw caret (having already drawn the icons)
ADD R14,handle,#w_wax0
LDMIA R14,{R0,R1,cx0,cy0,cx1,cy1}
SUB cx1,R0,cx1 ; cx1 <- x0-scx
SUB cy1,cy0,cy1 ; cy1 <- y1-scy
ASSERT (cx1=R4)
ADR R14,caretdata+8
LDMIA R14,{R0,R1,R2} ; x,y coords and height
ADD R3,cx1,R0 ; x coord of caret
ADD R4,cy1,R1 ; y coord of caret
MOV R1,R2 ; caret height (OS coords)
BL plotcaret
Pull "R1,cx0,cy0,cx1,cy1,PC"
;-----------------------------------------------------------------------------
; Set up appropriate input focus (highlight window)
; Entry: R0 = (relative) window handle
; R1 = state of ws_hasfocus bit to set
;-----------------------------------------------------------------------------
focusoff TraceL sc
MOV R1,#0
B setfocus
focuson TraceL sc
MOV R1,#ws_hasfocus
setfocus TraceL sc
Push "R0,R2,R3,LR"
CMP R0,#nullptr
BEQ exitsetfocus
; Find window with handle R0 in active stack
[ ChildWindows
MOV handle,R0
BL checkhandle_iconbar ; allow caret in iconbar now
BVS errbadstack
ADD R2,handle,#w_active_link
01 LDR R14,[handle,#w_flags]
TST R14,#ws_open
BEQ errbadstack ; window (and all its parents) must be open
LDR handle,[handle,#w_parent]
CMP handle,#nullptr
BNE %BT01
SUB handle,R2,#w_active_link ; go back to original window
setfocus_loop
|
LDR R2,activewinds+lh_forwards
getfoclp1
LDR R3,[R2,#ll_forwards]
CMP R3,#nullptr
BEQ errbadstack
SUB R14,R2,#w_active_link
Rel R14,R14
TEQ R14,R0
MOVNE R2,R3
BNE getfoclp1
]
; Drop through any panes
getfoclp2
LDR R3,[R2,#ll_forwards]
CMP R3,#nullptr
BEQ errbadstack ; NB: windows with pane bit must still find a sibling to pass it on to
LDR R14,[R2,#w_flags-w_active_link]
TST R14,#wf_isapane
MOVNE R2,R3
BNE getfoclp2
; Convert to an Abs handle
SUB handle,R2,#w_active_link
B gotfoc
; urg - no suitable input focus window found
errbadstack
MyXError WimpFocus
errexitf
STRVS R0,[R13]
Pull "R0,R2,R3,PC"
MakeErrorBlock WimpFocus
; handle -> window to receive the focus
; R14 = current window flags of this window
; R1 = ws_hasfocus bit setting
gotfoc
[ ChildWindows
AND R0,R14,#ws_hasfocus
TEQ R0,R1
BEQ %FT10
BIC R14,R14,#ws_hasfocus
ORR R14,R14,R1
STR R14,[handle,#w_flags]
Debug child,"ws_setfocus on/off for window",handle
BL int_mark_window_opening ; open window stuff will deal with redrawing the window borders
MOV R0,#3
Push "R1"
BL int_force_redraw_border ; redraw title bar, in case caller is trying to force a redraw
Pull "R1"
10 LDR handle,[handle,#w_parent]
CMP handle,#nullptr
ADDNE R2,handle,#w_active_link
BNE setfocus_loop ; mark all parents of this window as well
|
BIC R14,R14,#ws_hasfocus
ORR R14,R14,R1
STR R14,[handle,#w_flags]
[ Twitter
BL visibleoutertwitter
BL checktwitter
|
BL visibleouterportion
]
ADD R14,handle,#w_wax0
LDMIA R14,{cx0,cy0,cx1,cy1}
[ Twitter
SUBNE cy0, cy0, #2
ADDNE cy1, cy1, #2
]
MOV R0,#windowrects
MOV R1,R0
BL subrect
BL markinvalidrects
BL losewindowrects
]
exitsetfocus
Pull "R0,R2,R3,LR"
MOVS PC,LR
;..............................................................................
SWIWimp_GetCaretPosition
MyEntry "GetCaretPosition"
ADR R14,caretdata
LDMIA R14,{R0-R5}
STMIA userblk,{R0-R5}
B ExitWimp
;-----------------------------------------------------------------------------
; Send a message to the relevant task whenever the caret window changes
;-----------------------------------------------------------------------------
send_losecaret
Push "R0-R2,handle,LR"
MOV R0,#Lose_Caret
B %FT01
send_gaincaret
Push "R0-R2,handle,LR"
MOV R0,#Gain_Caret
01
ADR R1,caretdata
LDR handle,caretdata
BL checkhandle ; error if handle -1
BVS %FT99
LDR R2,[handle,#w_taskhandle]
CMP R2,#0 ; menus are owned by Wimp
BLGT int_sendmessage_fromwimp
99
Pull "R0-R2,handle,PC",,^ ; ignore errors
;-----------------------------------------------------------------------------
; Deal with a mouse click on a writable icon
; Entry: R0,R1 = mouse coords
; R2 = mouse button state
; R6 = button flags for this icon
; handle,R3,R4 = window/icon handles
; R14 = link address
;-----------------------------------------------------------------------------
clickonwriteable
Push "R0-R6,LR"
MOV R0,R3 ; window handle
MOV R1,R4 ; icon handle
LDR R2,mousexrel ; x,y coords
LDR R3,mouseyrel
MOV R5,#-1 ; calculate R4,R5 from R2,R3
BLVC int_set_caret_position
Pull "R0-R6,PC",VC
Pull "R1-R7,LR"
B ExitWimp
;-----------------------------------------------------------------------------
; Find caret position given coords
; Entry: R0,R1,R2,R3 = window/icon handles and x,y coords (relative)
; Exit : R4,R5 set up as well (unless icon null)
;-----------------------------------------------------------------------------
findcaret TraceL sc
CMP R0,#1
CMPGE R1,#0
MOVLT PC,LR ; can't do anything with this
Push "R0-R3,LR" ; save window/icon handles etc.
LDR R14,caretdata+0
EORS R14,R14,R0
LDREQ R14,caretdata+4
EOREQS R14,R14,R1
STR R14,hascaret ; 0 ==> this icon had the caret already
; ; [caretdata+20] = caret index
MOV handle,R0
BL checkhandle
Pull "R0-R3,LR",VS
MOVVS R0,#nullptr ; if window does not exist, forget it
MOVVSS PC,LR
; find origin of text given OLD status of icon (with or without caret)
LDR R2,[handle,#w_icons]
;;ADD R2,R2,#i_bbx0 ???
ADD R2,R2,R1,ASL #i_shift
LDMIA R2!,{x0,y0,x1,y1} ; set up x0,y0,x1,y1 (relative)
Push "R0-R3"
LDR R1,[R2] ; get the icon flags
LDR R3,[R2,#8] ; get the pointer to the validation string
; if text+indirected then R3 is validation string, else store zero
TST R1,#if_text
TSTNE R1,#if_indirected
MOVEQ R3,#0
STR R3,validationstring ;320nk
BL getborder
BL adjustforborder ; attempt to adjust for border specified
Pull "R0-R3"
LDR R1,[R2] ; set up R1,R2 (was 4)
ADD R2, R2, #4 ; R2 -> icon data (was absent)
TST R1,#if_indirected
LDRNE R2,[R2] ; pointer is indirected
ASSERT :INDEX:tempworkspace = 0
STMIA wsptr,{R1,R2,x0,y0,x1,y1} ; icon flags/data, bbox
; NB [caretx] = offset of caret from previous time
BL findtextorigin ; cx1,cy1 = x,y coords
LDR R14,writeabledir
Push "x0"
LDR x0,[wsptr]
TST x0,#if_numeric
MOVNE R14,#0
Pull "x0"
TEQ R14,#0
SUBNE R14,cx1,x0
SUBNE cx1,x1,R14
MOV x0,cx1
MOV y0,cy1 ; x0,y0 = old text origin
Pull "R3,R4,x1,y1" ; x1,y1 click coordinates
Pull "PC",VS
BL findcaretx0y0 ; R2,R3 = offset, R4,R5 set up
STR R2,caretx ; needed for next call
Push "R0-R5"
MOV R14,#0 ; compute new positions
STR R14,hascaret ; Icon has caret
LDMIA wsptr,{R1,R2,x0,y0,x1,y1} ; icon flags/text ptr, box
BL findtextorigin ; do it again ==> NEW coords
Pull "R0-R3"
Push "r0"
LDR R14,writeabledir
LDR r0,[wsptr]
TST r0,#if_numeric
MOVNE R14,#0
TEQ R14,#0
Pull "r0"
SUBNE R14,cx1,x0
SUBNE cx1,x1,R14
ASSERT cx1=R4
ADDEQ R2,cx1,R2 ; add to origin
SUBNE R2,cx1,R2
ADD R3,cy1,R3
Pull "R4-R5,LR" ; drop through to shrinkcaret
; Entry: R0,R1 = window/icon handles of caret
; R2,R3 = coordinates of bottom of caret
; R4,R5 = caret height/index
; handle --> window definition
; Exit: R3,R4 = adjusted so that the caret is within the icon
shrinkcaret
CMP R0,#0 ; forget it if not inside an icon
CMPGT R1,#-1
MOVLE PC,LR
Push "y0,y1,LR"
LDR R14,[handle,#w_icons] ; R14 --> icon list
ADD R14,R14,R1,LSL #i_shift ; R14 --> icon R1
LDR y0,[R14,#i_flags]
TST y0,#if_border
LDR y0,[R14,#i_bby0] ; y0,y1 = bottom/top of icon
LDR y1,[R14,#i_bby1]
[ false
LDRNE R14,dy
ADDNE y0,y0,R14 ; allow for border (1 pixel)
SUBNE y1,y1,R14
|
Push "r0-r3"
LDR r1,[R14,#i_flags]
LDR r3,[R14,#i_data+4] ; validation string pointer
TST R1,#if_text
TSTNE R1,#if_indirected
MOVEQ R3,#0
STR R3,validationstring
BL getborder
BL adjustforborder
Pull "r0-r3"
]
CMP R3,y0 ; move base of caret up if nec.
MOVLT R3,y0
MOV R14,R4,LSL #32-crb_colourshift
ADD R14,R3,R14,ASR #32-crb_colourshift ; R14 = coords of top
SUBS R14,y1,R14
ADDLT R4,R4,R14 ; reduce caret height if nec.
Pull "y0,y1,PC"
; Find offset to nearest character position
; Entry: R1,R2 = icon flags/text
; R3,R4 = window/icon handles
; x0,y0 = text origin
; x1,y1 = coords of mouse click
; Exit: R0,R1 = window/icon handles (R3,R4 on entry)
; R2,R3 = offset from x0,y0
; R4,R5 = caret height/index
findcaretx0y0 TraceL sc
Push "R3,R4,LR" ; R3,R4 go into R0,R1 on exit
TraceK sc, "findcaretx0y0: icon flags "
TraceX sc, R1
TraceK sc, ", w "
TraceX sc, R3
TraceK sc, ", i "
TraceD sc, R4
TraceNL sc
[ outlinefont
LDR LR, systemfont
TEQ LR, #0
TSTEQ R1, #if_fancyfont
|
TST R1, #if_fancyfont
]
BNE findcaretx0y0_fancy
;System font case
MOV R3,#-32
MOV R4,#40
ORR R4,R4,#crf_vdu5caret ; don't call the Font manager!
LDR R14,writeabledir
TST R1,#if_numeric
MOVNE R14,#0
TEQ R14,#0
ADDEQ R14,x1,#8 ; round to nearest
SUBEQ R14,R14,x0
SUBNE R14,x1,#8
SUBNE R14,x0,R14
MOV R14,R14,ASR #4 ; divide by 16 (down to chars)
MOV R5,#0
srchlp CMP R5,R14
BGE srchdone
LDRB R0,[R2,R5]
CMP R0,#32
ADDCS R5,R5,#1
BCS srchlp
srchdone
MOV R2,R5,LSL #4
Pull "R0,R1,PC" ; R0,R1 = window/icon handles
;Outline font case
findcaretx0y0_fancy TraceL sc
; R1 = icon flags
; R2 -> icon text
; (R6, R7) = text origin
; (R8, R9) = click coords
Push R6-R9
TraceK sc, "findcaretx0y0_fancy: text origin ("
TraceD sc, R6
TraceK sc, ", "
TraceD sc, R7
TraceK sc, ") OSU"
TraceNL sc
TraceK sc, "findcaretx0y0_fancy: click coords ("
TraceD sc, R8
TraceK sc, ", "
TraceD sc, R9
TraceK sc, ") OSU"
TraceNL sc
SUB R8, R8, R6
CMP R8, #&100000
MOVGT R8, #&100000
SUB R9, R9, R7
CMP R9, #&100000
MOVGT R9, #&100000
; (R8, R9) = offset to caret (OSU)
TraceK sc, "findcaretx0y0_fancy: click coords ("
TraceD sc, R8
TraceK sc, ", "
TraceD sc, R9
TraceK sc, ") OSU"
TraceNL sc
;First get the index and x offset of the caret
[ outlinefont
TST R1, #if_fancyfont
LDREQ R3, systemfont
MOVNE R3, R1, LSR #ib_fontno ;get the correct font handle
|
MOV R3, R1, LSR #ib_fontno ;get the correct font handle
]
; R1 = icon flags
; R2 -> icon text
; R3 = handle for icon font
BL pushfontstring
; R1 -> font string
; R7 = stack change (word aligned)
MOV R0, R3
MOV R6, R1
; R0 = icon font handle
; R6 -> font string
MOV R1, R8
MOV R2, R9
; (R1, R2) = offset in OSU
SWI XFont_Converttopoints
; (R1, R2) = offset in mpt
MOV R3, R2
MOV R2, R1
MOV R1, R6
TraceK sc, "Font_FindCaret ("
TraceS sc, R1
TraceK sc, ", ("
TraceD sc, R2
TraceK sc, ", "
TraceD sc, R3
TraceK sc, ")mpt)"
TraceNL sc
SWI XFont_FindCaret
TraceError
ADD SP, SP, R7 ; align the stack as required
TraceK sc, "Font_FindCaret -> terminator '"
TracePC sc, R1
TraceK sc, "', (x, y) ("
TraceD sc, R2
TraceK sc, ", "
TraceD sc, R3
TraceK sc, "), printable count "
TraceD sc, R4
TraceK sc, ", index "
TraceD sc, R5
TraceNL sc
; (R2, R3) = offset to caret (mpt)
; R4 = number of printable characters
; R5 = index into string
MOV R5, R4
; R5 = index into original string (which consisted of printable characters only)
MOV R1, R2
MOV R2, R3
; (R1, R2) = offset in mpt
SWI XFont_ConverttoOS
MOV R8, R1
MOV R9, R2
; (R8, R9) = offset to caret (OSU)
SWI XFont_ReadInfo
; ((R1, R2), (R3, R4)) = bounding box (OSU)
SUB R4, R4, R2
; R4 = caret height
ADD R3, R9 ,R2 ; 320nk
ADD R2, R8, #2 ; KJB bodgery
; (R2, R3) = caret coords
TraceK sc, "findcaretx0y0_fancy: caret offset ("
TraceD sc, R2
TraceK sc, ", "
TraceD sc, R3
TraceK sc, ") OSU"
TraceNL sc
;Restore handles etc and return (parameters are right for SetCaret
; except that (R2, R3) are relative)
Pull R6-R9
Pull "R0-R1, PC"
;-----------------------------------------------------------------------------
; Find caret coords given position
;-----------------------------------------------------------------------------
setcaretcoords TraceL sc
; R0 = window handle
; R1 = icon handle
; R5 = position in string
TraceK sc, "setcaretcoords: w "
TraceX sc, R0
TraceK sc, ", i "
TraceD sc, R1
TraceK sc, ", index "
TraceD sc, R5
TraceNL sc
CMP R0,#1 ; can't do it if no icon
CMPGE R1,#0
MOVLT PC,LR
Push "LR"
MOV R14,#0 ; we want coords given caret IS here
STR R14,hascaret ; 0 ==> icon has the caret
MOV handle,R0
BL checkhandle
Pull "PC",VS
Trace sc, "setcaretcoords: index ", D, R5
Push "R0,R1,R5"
LDR R2,[handle,#w_icons]
;;ADD R2,R2,#i_bbx0 NOP!
ADD R2,R2,R1,ASL #i_shift
; R2 -> bbox of icon
LDMIA R2!,{x0,y0,x1,y1}
; (R6, R7, R8, R9) = relative coords of icon
; R2 -> icon flags
Push "R0-R3"
LDR R1,[R2]
LDR R3,[R2,#8]
TST R1,#if_text
TSTNE R1,#if_indirected
MOVEQ R3,#0
STR R3,validationstring ;320nk
; R1 = icon flags
; R3 -> validation string
BL getborder
BL adjustforborder
Pull "R0-R3" ; restore important registers
LDR R1,[R2],#4
; R1 = icon flags
; R2 -> icon data
TST R1,#if_indirected
LDRNE R2,[R2]
; R2 -> text
TraceK sc, "setcaretcoords: flags "
TraceX sc, R1
TraceK sc, ", text "
TraceS sc, R2
TraceK sc, ", index "
TraceD sc, R5
TraceNL sc
STMIA wsptr,{R1,R2} ; used later
[ outlinefont
TST R1, #if_fancyfont
MOVNE R3, R1, LSR #ib_fontno ; get the correct font handle
LDREQ R3, systemfont
TEQEQ R3, #0
BNE setcaretcoords_fancy
|
TST R1, #if_fancyfont
MOVNE R3, R1, LSR #ib_fontno ; get the correct font handle
BNE setcaretcoords_fancy
]
; work out R2,R3 = offset of caret from text origin
setcaretcoords_system TraceL sc
Pull "R0-R1,R5"
Trace sc, "setcaretcoords: index ", D, R5
MOV R2,R5,LSL #4
MOV R3,#-32
MOV R4,#40
ORR R4,R4,#crf_vdu5caret ; normal caret
B addinorigin
setcaretcoords_fancy TraceL sc
; R1 = icon flags
; R2 -> string
; R3 = font handle to use for text
Trace sc, "setcaretcoords: index ", D, R5
Push "R3,R7"
BL pushfontstring
; R1 -> string
; R7 = difference in stack (word aligned)
;;;LDR R5,[sp,#3*4] ; R5 = offset (grab it off the stack!)
;I think this is STILL in R5
[ outlinefont
;Convert the value in R5 (a count of PRINTABLE characters) to a
; string index
Push "R2-R4"
; R5 = number of printable character required
MOV R3, #0
MOV R4, #0
; R3 = count of printable characters
; R4 = index into string
B setcaretcoords_reinit
setcaretcoords_loop
; R2 = character under consideration
CMP R3, R5
BGE setcaretcoords_exit
TEQ R2, #26
ADDNE R3, R3, #1 ;increment printable count
ADDEQ R4, R4, #2 ; } go to next relevant character
ADDNE R4, R4, #1 ; }
setcaretcoords_reinit
LDRB R2, [R1, R4]
TEQ R2, #0
BNE setcaretcoords_loop
setcaretcoords_exit
MOV R5, R4
; R5 = index of printable character in string
Pull "R2-R4"
Trace sc, "setcaretcoords: an index now: ", D, R5
]
MOV R2,#bignum
MOV R3,#bignum
MOV R4,#-1
BL myFont_StringWidth
; Trace nk, "setcaret, width of string: ",D,R2
ADD SP, SP, R7 ; very important!
Pull "R3,R7"
; R3 = icon font handle
MOVVC R1,R2 ; x offset
SWIVC XFont_ConverttoOS ; (OS coords)
Push "R1" ; x offset
;;LDRVCB R0,[wsptr,#3] ?? ; R0 = top byte of flags
MOVVC R0, R3 ; get the right font for this icon
SWIVC XFont_ReadInfo ; get bounding box
TraceError sc
MOVVC R3,R2 ; R3 = y coord (at bottom)
SUBVC R4,R4,R2 ; R4 = height (OS coords)
Pull "R2" ; R2 = x offset
;;STRVS R0,[sp] ?? don't corrupt stacked window handle
Pull "R0-R1,R5" ; window/icon handles & offset
ADD R2,R2,#2
addinorigin TraceL sc
Trace sc, "setcaretcoords: index ", D, R5
Push "R0-R5" ; R2,R3 are relative coords
STR R2,caretx
MOV R14,#0
STR R14,hascaret ; caret is definitely here
LDMIA wsptr,{R1,R2} ; icon flags/text ptr
BL findtextorigin
Pull "R0-R3"
Push "r0"
LDR r0,writeabledir
LDR r14,[wsptr]
TST r14,#if_numeric
MOVNE r0,#0
CMP r0,#0
Pull "r0"
ADDEQ R2,cx1,R2 ; add in origin
SUBNE r14,cx1,x0
SUBNE r14,x1,r14
SUBNE r2,r14,r2
ADD R3,cy1,R3
Pull "R4-R5,LR"
B shrinkcaret ; ensure caret is within icon
;;----------------------------------------------------------------------------
;; myFont_StringWidth
;; Entry and Exit as Font_StringWidth SWI
;;----------------------------------------------------------------------------
myFont_StringWidth
Push "R6,R7,lr"
MOV R7,R5
MOV R4,R3
MOV R3,R2
[ true
LDR R2,writeabledir ;
TEQ R2,#0 ; This bit isn't ideal, but this stuff will all have to
MOV R2,#128 ; be rewritten anyway to cope with kerning
ORRNE R2,R2,#1<<10 ;
|
MOV R2,#128
]
SWI XFont_ScanString
MOV R2,R3
MOV R3,R4
Pull "R6,R7,PC"
;;----------------------------------------------------------------------------
;; Wimp_ProcessKey
;; Entry: R0 = character to process
;; [caretdata] indicates position of caret
;; [hotkeyptr] indicates how far down the chain we have gone
;; Exit: R0 = action (as returned from Wimp_Poll)
;; if R0 <> 0, the key was not accepted
;; The key is passed first to the input focus owner,
;; then to any windows with wf_grabkeys set
;; If not claimed by anybody, and caret is inside a writable icon,
;; then soft key expansion is performed
;;----------------------------------------------------------------------------
SWIWimp_ProcessKey
MyEntry "ProcessKey"
MOV R6,R0 ; R6 = key code on entry
BL int_processkey
B ExitWimp
int_processkey
Push "R1-R6,handle,LR"
ADR R14,caretdata
LDMIA R14,{R0-R5}
Debug key,"ProcessKey:",R6
LDR R14,singletaskhandle ; don't muck about if single task
CMP R14,#0
BGT defaultkey
LDR R14,hotkeyptr
Debug key,"HotKeyPtr",R14
CMP R14,#0
BGT sendhotkey ; try hot keys
[ true ; BJGA bugfix: don't crash if lowest iconised window calls Wimp_ProcessKey
CMP R14, #nullptr
BEQ defaultkey
]
SUBS handle,R0,#0
BL topmost_window
STR R0,hotkeyptr
BLE sendhotkey ; if no input focus, just try hot keys
CMP R1,#nullptr
BLE sendkey ; not in a writable icon
MOV R0,handle
BL WriteableKey ; R0-R5 set up on entry
TEQ R0,#No_Reason
Pull "R1-R6,handle,PC",EQ ; done
Debug key,"Writable icon returned reason",R0
TEQ R0,#Key_Pressed
TEQNE R0,#Key_PressedOldData
LDREQ handle,caretdata ; handle = (rel) input focus window
BEQ sendkey
; NB: menu icon CR comes here
; this is wrong, but hard to fix
sendhotkey
; Check the window's still around and open
LDR handle,hotkeyptr
BL checkhandle
BVS %FT01
[ ChildWindows
; check that the window *and* all the window's ancestors are still open
MOV R0, handle
00
LDR R14, [R0, #w_flags]
TST R14, #ws_open
BEQ %FT01
LDR R0, [R0, #w_parent]
CMP R0, #nullptr
BEQ %FT02
B %BT00
|
LDR R14,[handle,#w_flags]
TST R14,#ws_open
BNE %FT02
]
01
; 'Next' hotkey window disappeared or is closed so start from the top again
BL topmost_window
STR R0,hotkeyptr
; Just in case there're no windows (arrrrggghhh!)
TEQ R0,#0
BEQ defaultkey
Abs handle,R0
02
; Drop through the list of windows, checking for grabkey windows.
[ ChildWindows
MOV R1, handle
03
LDR R14, [R1, #w_flags]
TST R14, #wf_grabkeys
BNE %FT04 ; found the next grabkey window!
BL hotkey_nextwindow
BNE %BT03
BEQ defaultkey ; done all windows!
04
Rel handle, R1
; Now find hotkeyptr for next time
BL hotkey_nextwindow
MOVEQ R2, #nullptr
Rel R2, R1, NE
STR R2, hotkeyptr
|
ADD R3,handle,#w_active_link
03
LDR R2,[R3,#ll_forwards]
CMP R2,#nullptr
BEQ defaultkey ; We've run out of windows
LDR R14,[R3,#w_flags-w_active_link]
TST R14,#wf_grabkeys
MOVEQ R3,R2
BEQ %BT03
SUB handle,R3,#w_active_link
Rel handle,handle
; Set hotkeyptr to next window to try
LDR R14,[R2,#ll_forwards]
CMP R14,#nullptr
[ true ; BJGA bugfix: don't crash if lowest iconised window calls Wimp_ProcessKey
MOVEQ R2,#nullptr
|
MOVEQ R2,#0 ; Run out of windows
]
SUBNE R2,R2,#w_active_link
Rel R2,R2,NE
STR R2,hotkeyptr
]
sendkey
TEQ R0,#Key_PressedOldData
ADREQL R14,savedcaretdata
ADRNE R14,caretdata
LDMIA R14,{R0-R5} ; R6 already set up
Push "R0-R6"
MOV R1,sp
MOV R2,handle ; send to input focus/grab window
MOV R0,#Key_Pressed
Debug key,"SendKey: handle",R2
BL int_sendmessage_fromwimp
ADD sp,sp,#7*4
Pull "R1-R6,handle,PC"
[ ChildWindows
hotkey_nextwindow
; Entry: R1 = absolute window handle
; Exit: NE => R1 = next window to consider (down/across/up the window tree)
; EQ => no more windows
ENTRY
; First look for a child of the last window
LDR R2, [R1, #w_children + lh_forwards]
LDR R14, [R2, #ll_forwards]
CMP R14, #nullptr
SUBNE R1, R2, #w_active_link
EXIT NE
; Then try a sibling
01 LDR R2, [R1, #w_active_link + ll_forwards]
LDR R14, [R2, #ll_forwards]
CMP R14, #nullptr
SUBNE R1, R2, #w_active_link
EXIT NE
; Then try aunts, great-aunts and so on
LDR R1, [R1, #w_parent]
CMP R1, #nullptr
BNE %BT01
; Run out of ancestors - exit with Z set
EXIT
]
;..............................................................................
; not recognised by caret owner, or any hot-key handlers
; In R6 = key code
defaultkey
Debug key,"DefaultKey: code",R6
MOV R14,#0
STR R14,hotkeyptr ; reached the end of the road!
[ :LNOT: DisableShiftF12
; shift+f12 => toggle iconbar between front and back
; when at front, wf_backwindow is unset; when at back, it is set
LDR R14,=&1DC ; shift+f12
TEQ R6,R14
BNE %FT01
LDR handle,iconbarhandle
CMP handle,#0
BLE %FT01
BL checkhandle ; handle -> window block
[ PoppingIconBar
LDRVC R14, iconbar_pop_state
TEQ R14, #pop_Back
TEQNE R14, #pop_Delaying
MOVEQ R14, #pop_Front2
MOVNE R14, #pop_Back
STRVC R14, iconbar_pop_state
LDRVC R14, [handle, #w_flags]
|
BLVC calc_w_status ; set up flag word
LDRVC R14,[handle,#w_flags]
TSTVC R14,#ws_top ; is the window covered?
]
BICEQ R14,R14,#wf_backwindow ; not backwindow if coming to front
ORRNE R14,R14,#wf_backwindow ; backwindow if going to back
STRVC R14,[handle,#w_flags]
ADDVC R14,handle,#w_wax0
LDMVCIA R14,{R0-R3,R4,R5}
MOVEQ R6,#-1 ; EQ => bring window to front
[ HideIconBar
MOVNE R6,#-3 ; NE => send to back
|
MOVNE R6,#-2 ; NE => send to back
]
Push "R0-R6,R7-R11"
LDRVC R14,iconbarhandle ; relative window handle
Push "R14"
MOVVC userblk,sp
BLVC int_open_window ; this corrupts all registers!
ADD sp,sp,#8*4
Pull "R7-R11"
Pull "R1-R6,handle,PC"
01
]
; if caret is in a writable icon, expand soft key
LDR R14,caretdata+0 ; all we can do now is fn key expansion
CMP R14,#0 ; (if the caret is in a writable icon)
LDRGT R14,caretdata+4
CMPGT R14,#nullptr
Pull "R1-R6,handle,PC",LE
fnkeynamelen * 8 ; must be a multiple of 4
fnkeyexplen * 256 ; must be a multiple of 4
SUBS R14,R6,#&180
BCC notfnkey
CMP R14,#10 ; f0-f9
BCC %FT01
SUBS R14,R14,#&1CA-&180
BCC notfnkey
CMP R14,#3 ; f10-f12
BCS notfnkey
ADD R14,R14,#10
01
; R14 = function key code (0..12)
SUB sp,sp,#fnkeynamelen
MOV R0,R14
MOV R1,sp
LDR R14,keyd ; R14 = "Key$"
STR R14,[R1],#4
MOV R2,#fnkeynamelen-4
SWI XOS_ConvertCardinal1
MOVVC R0,sp
SUB sp,sp,#fnkeyexplen
MOV R1,sp
MOV R2,#fnkeyexplen
MOV R3,#0
MOV R4,#3
SWIVC XOS_ReadVarVal
BVS %FT99 ; no function key string
MOV R1,sp
01
TEQ R2,#0
BEQ %FT99
LDRB R6,[R1],#1
Debug val,"r0,r1,r2",r0,r1,r2
Push "R0,R1,R2"
Debug val,"R13 (1)",R13
Debug val,"Next key is ",r6
BL go_writeablekey
Debug val,"R0 on exit is ",r0
TEQ R0,#Key_Pressed ; should this be passed back?
ADREQ R14,caretdata
ADRNEL R14,savedcaretdata
TEQNE R0,#Key_PressedOldData
[ debugval
BNE %FT89
Debug val,"EQ !!!"
89
]
LDMEQIA R14,{R0-R5} ; R6 already set up
Push "R0-R6"
MOVEQ R1,sp
MOVEQ R2,R0 ; send to input focus window
MOVEQ R0,#Key_Pressed
BLEQ int_sendmessage_fromwimp
ADD sp,sp,#7*4
Debug val,"R13 (2)",R13
Pull "R0,R1,R2"
SUB R2,R2,#1
B %BT01
99
SUBS R0,R0,R0 ; R0=0, V clear (ignore errors)
ADD sp,sp,#fnkeyexplen + fnkeynamelen
notfnkey
Pull "R1-R6,handle,PC"
keyd DCB "Key$"
;-----------------------------------------------------------------------------
; Wimp_Poll entry to process key-press (caret is inside a writable icon)
; Entry: R0,R1 = window/icon handle
; R5 = index into string
; R6 = key pressed (on 0.18, key can be > 255)
;-----------------------------------------------------------------------------
processkey
Debug key,"processkey: window, icon",R0,R1
BL WriteableKey
BVS ExitPoll
TEQ R0,#No_Reason ; key already processed
BEQ nothing
TEQ R0,#Key_Pressed
ADREQ R14,caretdata
ADRNEL R14,savedcaretdata
TEQNE R0,#Key_PressedOldData
LDMEQIA R14,{R0-R5}
BEQ keypressed ; unknown - return to input focus owner
TEQ R0,#Menu_Select
MyXError WimpBadOp,NE,L
BVS ExitPoll ; shouldn't happen!
TEQ R6,#cr ; menus only understand <cr>
BEQ crmenuselection ; otherwise skip the input focus bit
B tryhotkeys ; (menu owner doesn't understand)
;-----------------------------------------------------------------------------
; Process key press (caret is on a writable icon)
; Entry: R0,R1 = window/icon handle
; R5 = index into string
; R6 = character
; Exit: R0 = return code (as for Poll_Wimp)
;-----------------------------------------------------------------------------
go_writeablekey
ADR R0,caretdata
LDMIA R0,{R0-R5}
WriteableKey
Push "LR"
LDR R14,writeabledir ; May be corrupted by
Push "R14"
BL int_WriteableKey
Pull "R14"
STR R14,writeabledir
Pull "PC"
int_WriteableKey
Push "LR"
Debug key,"WriteableKey: window, icon, index, char",R0,R1,R5,R6
BLVC pageinicontask ; R0,R1 = window/icon handles
DebugE key,"Bad task: "
Pull "PC",VS ; handle -> window defn
LDR R14,[handle,#w_nicons] ; check that it's a legal icon
CMP R1,R14
MyXError WimpFocus,CS,L
DebugE key,"Bad icon: "
Pull "PC",VS
LDR R2,[handle,#w_icons]
ADD R2,R2,#i_flags
ADD R2,R2,R1,ASL #i_shift ; add icon handle * icon size
MOV R14,R1
LDR R1,[R2],#4 ; R1 = flags
TST R1,#if_indirected ; indirected?
MOVEQ R3,#0
MOVEQ R7,#12 ; 12 bytes allowed if direct
LDMNEIA R2,{R2,R3,R7} ; R2 --> buffer, R7 = size
TST R1,#if_numeric
MOVNE R4,#0
STRNE R4,writeabledir ; will be restored on exit
MOV R4,R2 ; look for end of string
prk1 LDRB R0,[R4],#1
CMP R0,#32
BCS prk1
TST R1,#if_hcentred:OR:if_rjustify
MOV R1,R14
MOVNE R14,#-bignum
LDREQ R14,caretdata+8 ; get old cursor x coord
STR R14,leftborder ; for redrawing later
; now decide what to do with the character
; R1 = icon number (Version >= 292)
; R2 --> string
; R3 --> validation string (<=0 ==> none)
; R4 --> end of string + 1
; R5 = index to current caret position
; R7 = max buffer size
Push "r0-r5"
ADR R14,caretdata
LDMIA R14,{r0-r5}
ADRL R14,savedcaretdata
STMIA R14,{r0-r5}
Pull "r0-r5"
ADRL R14,savedvalidation
STR R3,[R14]
ADRL R14,savedcharcode
STR R6,[R14]
[ DeleteRight
TEQ r6, #&08
BEQ isdelete
TEQ r6, #&7F
BEQ iscopy
TEQ r6, #&1E
BEQ ctrlleftarrow
|
TEQ R6,#&7F ; Delete?
TEQNE R6,#&08 ; ASCII 8 is a synonym
BEQ isdelete
]
TEQ R6,#&15 ; Ctrl-U
BEQ ctrlU
[ Version >= 292
TEQ R6,#&0D
BEQ isreturn
]
CMP R6,#32
BCC passbacktouser
CMP R6,#&100
BCC isachar
SUB R14,R6,#&100
[ Version >= 292
TEQ R14,#&8F
BEQ uparrow
TEQ R14,#&8E
BEQ downarrow
TEQ R14,#&8A
BEQ tab
TEQ R14,#&9A
BEQ shifttab
]
TEQ R14,#&8B
[ DeleteRight
BEQ ctrlrightarrow
|
BEQ iscopy
]
TEQ R14,#&8C
BEQ isleftarrow
TEQ R14,#&8D
BEQ isrightarrow
TEQ R14,#&9B
BEQ shiftcopy
TEQ R14,#&9C
BEQ shiftleftarrow
TEQ R14,#&9D
BEQ shiftrightarrow
TEQ R14,#&AB
BEQ ctrlcopy
TEQ R14,#&AC
BEQ ctrlleftarrow
TEQ R14,#&AD
BEQ ctrlrightarrow
; if unrecognised, pass back to the user (unless it's a menu icon)
passbacktouser
LDR R3,caretdata
LDR R4,caretdata+4
Abs handle,R3 ; can't be a null window
BL findmenu ; must call this to set up [whichmenu]
BNE backtouser
LDR R14,[handle,#w_taskhandle]
CMP R14,#0
BLT menukey ; pass back if it's a dialogue menu
backtouser
MOV R0,#Key_Pressed
Pull "PC"
menukey
MOV R0,#Menu_Select
Pull "PC"
;------------------------------------------------------------------------------
; nextfield, find the next editable field within the icon list.
; in R1 = current icon number
; R2 = flags
; bit 0 set => don't wrap
; bit 1 set => retain same position, else move to first
; out Z set if field was found.
;------------------------------------------------------------------------------
findfield_nowrap * 1:SHL:0
findfield_sameposn * 1:SHL:1
nextfield ENTRY "R0-R6"
LDR R3,[handle,#w_nicons] ; maximum icon number
LDR R0,[handle,#w_icons]
ADD R0,R0,#i_flags ; pointer to icon structures (flags)
[ Version >= 317
LDR R6,[R0,R1,ASL #i_shift]
AND R6,R6,#if_esg2 ; extract the original ESG field
]
10
ADD R1,R1,#1 ; advance to the next field
CMP R1,R3
BLT %FT20 ; if still valid then ignore wrap checks
TST R2,#findfield_nowrap
EXIT NE ; if not allowed to wrap then exit
MOV R1,#0
20
LDR R14,[R0,R1,ASL #i_shift] ; get the flags for the icon
AND R4,R14,#if_buttontype
; MOV R4,R14,LSR #ib_buttontype
CMP R4,#14 :SHL: ib_buttontype ; if >= 14 then is editable so we have found one
BLT %BT10 ; if not then we need to loop back again
[ Version >= 317
AND R4,R14,#if_esg2
TEQ R4,R6 ; same esg?
TSTEQ R14,#is_shaded :OR: is_deleted ; is, so check to see if shaded/deleted
BNE %BT10
|
TST R14,#is_shaded
BNE %BT10 ; if shaded then ignore aswell
]
;..............................................................................
; Now a common piece of code used for positioning the caret within the editable
; field. This copes with keeping the caret in a sensible position as it
; tracks down the icons with the window (esp. when they are of variable
; length).
; in R0 -> icon defns (+ i_flags)
; R1 = field putting caret into
; R2 = flags for positioning
; R3 = nicons
; R4 = esg / button type
; R14 = flags as extracted from the icon
; assumes R0-R6,R14 are pushed to the stack for returning!
movecarettofield ROUT
ADD R0,R0,R1,ASL #i_shift ; point at the icon defn
TST R14,#if_indirected
ADDEQ R4,R0,#i_data -i_flags ; not indirected -> icon data
LDRNE R4,[R0,#(i_data -i_flags)] ; indirected -> pick up first word
MOV R5,R4 ; index into field
10
LDRB R6,[R4],#1
CMP R6,#32 ; is the character valid
BGE %BT10 ; looping whilst it is
SUB R5,R4,R5 ; calculate the length of the string
SUB R5,R5,#1 ; removing the terminating charactor
TST R2,#findfield_sameposn
BEQ %FT20 ; ignore posn if bit not set!
LDR R4,caretdata+5*4
CMP R4,R5 ; truncate the caret posn
MOVLT R5,R4
20
MOV R4,#-1
LDR R0,caretdata
BL int_set_caret_position ; force the caret position
CMP R0,R0
EXIT ; returning with Z set
;------------------------------------------------------------------------------
; Cycle the caret in a different direction, moving up rather than down!
; Same entry parameters as "nextfield" and assumed to be within the
; same code space as using "ALTENTRY" to push the entry registers.
;------------------------------------------------------------------------------
prevfield ALTENTRY
LDR R3,[handle,#w_nicons] ; maximum icon number
LDR R0,[handle,#w_icons]
ADD R0,R0,#i_flags ; pointer to icon structures (flags)
[ Version >= 317
LDR R6,[R0,R1,ASL #i_shift]
AND R6,R6,#if_esg2 ; extract the original ESG field
]
10
SUBS R1,R1,#1 ; advance to the previous field
BPL %FT20
TST R2,#findfield_nowrap
EXIT NE ; if not allowed to wrap then exit
SUB R1,R3,#1
20
LDR R14,[R0,R1,ASL #i_shift] ; get the flags for the icon
AND R4,R14,#if_buttontype ; 320nk bugfix
; MOV R4,R14,LSR #ib_buttontype
CMP R4,#14 :SHL: ib_buttontype ; if >= 14 then is editable so we have found one
BLT %BT10 ; if not then we need to loop back again
[ Version >= 317
AND R4,R14,#if_esg2
TEQ R4,R6 ; same esg?
TSTEQ R14,#is_shaded :OR: is_deleted ; is, so check to see if shaded
BNE %BT10
|
TST R14,#is_shaded
BNE %BT10 ; if shaded then ignore aswell
]
B movecarettofield ; posn the caret in the icon
; insert character into buffer, unless validation string forbids it
isachar
ADD R14,R2,R7 ; is buffer full?
CMP R4,R14
BCS exitprocess
BL checkvalid ; Z set --> char is valid
BNE backtouser
ADD R5,R2,R5
inslp LDRB R0,[R4,#-1] ; copy byte up
STRB R0,[R4],#-1 ; and move down one
CMP R4,R5
BHI inslp
STRB R6,[R4] ; put the char in
[ false
LDR R6,writeabledir
CMP R6,#0
MOVEQ R6,#1 ; English
MOVNE R6,#0 ; Hebrew
|
MOV R6,#1
]
; recalculate caret data
donechar
ADR R14,caretdata
LDMIA R14,{R0-R5}
ADD R5,R5,R6 ; move on by relevant amount
BL setcaretcoords
Pull "PC",VS
LDR R6,caretscrollx
LDR R14,caretdata+24
TEQ R6,R14
LDREQ R14,writeabledir
TEQEQ R14,#0
MOVNE R14,#-bignum ; redraw whole thing if it's moved
STRNE R14,leftborder
ADR R14,caretdata
STMIA R14,{R0-R6} ; just store it in (including scroll)
BL redrawtexticon ; R1 = icon handle, handle->blk
exitprocess
ADRL R3,savedvalidation
LDR R3,[R3]
CMP R3,#1
BLT exitprocessnoreason ; No validation string
MOV R2,#WimpValidation_Key
BL findcommand ; No "K" command
BNE exitprocessnoreason
MOV R2,#WimpValidationKey_Any
BL findKcommand
BNE exitprocessnoreason
ADRL R6,savedcaretdata
LDR R3,[R6]
LDR R4,[R6,#4]
ADRL R6,savedcharcode
LDR R6,[R6]
Abs handle,R3 ; can't be a null window
BL findmenu ; must call this to set up [whichmenu]
MOV R0,#Key_PressedOldData
Pull "PC"
LDR R14,[handle,#w_taskhandle]
CMP R14,#0
BLT menukey ; pass back if it's a dialogue menu
MOV R0,#Key_PressedOldData
Pull "PC"
exitprocessnoreason
MOVVC R0,#No_Reason
Pull "PC"
int_donechar
Push "LR"
B donechar
; Redraw text icon (and caret, if it is in the icon)
; Entry: R1 = icon handle
; handle --> window block
; [leftborder] = leftmost x-coordinate nec. to redraw
redrawtexticon TraceL sc
TraceK sc, "redrawtexticon: w "
TraceX sc, handle
TraceK sc, ", i "
TraceD sc, R1
TraceNL sc
Push "R0-R5,x0,y0,x1,y1,LR"
LDR R2,[handle,#w_icons]
ADD R2,R2,R1,ASL #i_shift ; -> icon defn
ADD R1,R2,#i_bbx0
LDMIA R1,{x0,y0,x1,y1} ; get the bounding box
LDR R1,[R2,#i_flags] ; get the flags
LDR R3,[R2,#i_data +4] ; -> validation string
Push "R1,R2"
ORR R1,R1,#if_filled
STR R1,[R2,#i_flags] ; ensure its always filled
BL getborder
BL adjustforborder ; adjust for border specified
LDR R14,leftborder ; don't update more than nec.
LDR R0,caretdata+8 ; x coordinate of caret
CMP R0,R14
MOVLT R14,R0 ; take leftmost cursor posn
SUB R14,R14,#20 ; just in case
CMP x0,R14
MOVLT x0,R14
BL int_update_window
rdiclp BLVC int_get_rectangle
BVS rdicend
TEQ R0,#0
BNE rdiclp
rdicend
Pull "R2,R14"
STR R2,[R14,#i_flags] ; restore the flags
STRVS R0,[sp]
Pull "R0-R5,x0,y0,x1,y1,PC"
[ Version >= 292
isreturn
Push "R1-R7"
CMP R3,#1
BLT %FT01 ; No validation string
MOV R2,#WimpValidation_Key
BL findcommand
BNE %FT01 ; No "K" command
Debug val,"K command found"
MOV R2,#WimpValidationKey_Return
BL findKcommand
BNE %FT01
Debug val,"KR command found"
MOV R2,#1 ; Don't wrap round
BL nextfield
01
Pull "R1-R7"
BNE passbacktouser
Debug val,"Return processed"
B exitprocess
downarrow
Push "R1-R7" ; balance with Pull in checkmenuupdown
[ KeyboardMenus
MOV r6, #138
BL checkmenuupdown ; will not return if key handled
]
CMP R3,#1
BLT %FT01 ; No validation string
MOV R2,#WimpValidation_Key
BL findcommand
BNE %FT01 ; No "K" command
Debug val,"K command found"
MOV R2,#WimpValidationKey_Arrow
BL findKcommand
BNE %FT01
Debug val,"KA command found"
; MOV R2,#2 ; Wrap round, retain same position
MOV R2,#0 ; Wrap round, goto end of field - style guide compliant
BL nextfield
01
Pull "R1-R7"
BNE passbacktouser
Debug val,"Down arrow processed"
B exitprocess
uparrow
Push "R1-R7" ; balance with Pull in checkmenuupdown
[ KeyboardMenus
MOV r6, #139
BL checkmenuupdown ; will not return if key handled
]
CMP R3,#1
BLT %FT01 ; No validation string
MOV R2,#WimpValidation_Key
BL findcommand
BNE %FT01 ; No "K" command
Debug val,"K command found"
MOV R2,#WimpValidationKey_Arrow
BL findKcommand
BNE %FT01
Debug val,"KA command found"
; MOV R2,#2 ; Wrap round, retain same position
MOV R2,#0 ; Wrap round, goto end of field - style guide compliant
BL prevfield
01
Pull "R1-R7"
BNE passbacktouser
Debug val,"Up arrow processed"
B exitprocess
[ KeyboardMenus
checkmenuupdown
; In: r6 = key pressed
;
; Will not return if key is handled.
;
LDR r4, menuSP
CMP r4, #0
MOVLT pc, lr ; Don't handle key if no menu open
ADR r5, menudata
LDR r5, [r5, r4]
TST r5, #3
MOVNE pc, lr ; Don't handle key if it's a dbox
ADR r1, menuselections
LDR r1, [r1, r4]
CMP r1, #0
MOVLT pc, lr ; Don't handle key if no selected menu item
BL trymenuupdown
Pull "r1-r7"
B exitprocess
]
shifttab
Push "R1-R7"
CMP R3,#1
BLT %FT01 ; No validation string
MOV R2,#WimpValidation_Key
BL findcommand
BNE %FT01 ; No "K" command
Debug val,"K command found"
MOV R2,#WimpValidationKey_Tab
BL findKcommand
BNE %FT01
Debug val,"KT command found"
MOV R2,#0 ; Wrap round, to start of icon.
BL prevfield
01
Pull "R1-R7"
BNE passbacktouser
Debug val,"Shift Tab processed"
B exitprocess
tab
Push "R1-R7"
CMP R3,#1
BLT %FT01 ; No validation string
MOV R2,#WimpValidation_Key
BL findcommand
BNE %FT01 ; No "K" command
Debug val,"K command found"
MOV R2,#WimpValidationKey_Tab
BL findKcommand
BNE %FT01
Debug val,"KT command found"
MOV R2,#0 ; Wrap round, to start of icon.
BL nextfield
01
Pull "R1-R7"
BNE passbacktouser
Debug val,"Tab processed"
B exitprocess
]
; delete (backwards)
isdelete
[ false
LDR R14,writeabledir
CMP R14,#0
BNE int_iscopy
]
int_isdelete
SUBS R5,R5,#1
BMI exitprocess
ADD R2,R2,R5
dellp LDRB R0,[R2,#1] ; copy down
STRB R0,[R2],#1
CMP R2,R4
BCC dellp
[ Version >= 292
Push "R0-R6"
MOV R6,#-1 ; move back 1 char
BL int_donechar
LDMIA SP,{R0-R6}
Debug val,"donechar"
CMP R3,#1
BLT %FT01 ; No validation string
MOV R2,#WimpValidation_Key
BL findcommand
BNE %FT01 ; No "K" command
Debug val,"K command found"
MOV R2,#WimpValidationKey_Edit
BL findKcommand
Debug val,"KD command found"
01
Pull "R0-R6"
BEQ passbacktouser
B exitprocess
|
MOV R6,#-1 ; move back 1 char
B donechar
]
; delete (forwards)
iscopy
[ false
LDR R14,writeabledir
CMP R14,#0
BNE int_isdelete
]
int_iscopy
LDRB R0,[R2,R5]!
CMP R0,#32
BCC exitprocess ; at end of string
dellp2 LDRB R0,[R2,#1] ; copy down
STRB R0,[R2],#1
CMP R2,R4
BCC dellp2
[ Version >= 292
Push "R0-R6"
MOV R6,#0 ; no movement
BL int_donechar
LDMIA SP,{R0-R6}
CMP R3,#1
BLT %FT01 ; No validation string
MOV R2,#WimpValidation_Key
BL findcommand
BNE %FT01 ; No "K" command
Debug val,"K command found"
MOV R2,#WimpValidationKey_Edit
BL findKcommand
Debug val,"KD command found"
01
Pull "R0-R6"
BEQ passbacktouser
B exitprocess
|
MOV R6,#0 ; no movement
B donechar
]
shiftcopy
ADD R7,R2,R5 ; remember old position
LDRB R0,[R7]
CMP R0,#32
BCC passbacktouser ; already at end of line
BL skipwordR ; R5 is reloaded later, so can corrupt!
ADD R14,R2,R5
dellp3
LDRB R0,[R14],#1
STRB R0,[R7],#1
CMP R0,#32
BCS dellp3
[ Version >= 292
Push "R0-R6"
MOV R6,#0 ; no movement
BL int_donechar
LDMIA SP,{R0-R6}
CMP R3,#1
BLT %FT01 ; No validation string
MOV R2,#WimpValidation_Key
BL findcommand
BNE %FT01 ; No "K" command
Debug val,"K command found"
MOV R2,#WimpValidationKey_Edit
BL findKcommand
Debug val,"KD command found"
01
Pull "R0-R6"
BEQ passbacktouser
B exitprocess
|
MOV R6,#0 ; no movement
B donechar
]
ctrlU
[ Version >= 292
Push "R6"
]
RSB R6,R5,#0 ; move to beginning of line afterwards
MOV R5,#0 ; delete from start of line
MOV R14,#-bignum
STR R14,leftborder
B %FT01
ctrlcopy
[ Version >= 292
Push "R6"
]
MOV R6,#0 ; no need to move caret for ctrlcopy
01
LDRB R0,[R2,R5] ; delete to end of line
CMP R0,#32
[ Version >292
Pull "R6",CC
]
BCC exitprocess ; at end of string
ADD R7,R2,R5
02 LDRB R0,[R7],#1 ; find terminator (at end of string)
CMP R0,#32
BCS %BT02
STRB R0,[R2,R5] ; preserve original terminator char
[ Version >= 292
Push "R0-R5"
BL int_donechar ; R6 set up earlier
LDMIA SP,{R0-R6}
CMP R3,#1
BLT %FT01 ; No validation string
MOV R2,#WimpValidation_Key
BL findcommand
BNE %FT01 ; No "K" command
Debug val,"K command found"
MOV R2,#WimpValidationKey_Edit
BL findKcommand
Debug val,"KD command found"
01
Pull "R0-R6"
BEQ passbacktouser
B exitprocess
|
B donechar ; R6 set up earlier
]
; move left
isleftarrow
LDR R14,writeabledir
CMP R14,#0
BNE int_isrightarrow
int_isleftarrow
SUBS R5,R5,#1
[ KeyboardMenus
BGE donearrow
LDR r0, menuSP
SUBS r0, r0, #4
BLGE closemenus
B exitprocess
|
BMI exitprocess
B donearrow
]
shiftleftarrow
LDR R14,writeabledir
CMP R14,#0
BNE int_shiftrightarrow
int_shiftleftarrow
TEQ R5,#0
BEQ passbacktouser
BL skipwordL
B donearrow
ctrlleftarrow
LDR R14,writeabledir
CMP R14,#0
BNE int_ctrlrightarrow
int_ctrlleftarrow
MOV R5,#0 ; set to lhs of string
B donearrow
; move right
isrightarrow
LDR R14,writeabledir
CMP R14,#0
BNE int_isleftarrow
int_isrightarrow
SUB R6,R4,R2 ; index (just past terminator)
ADD R5,R5,#1
CMP R5,R6 ; too big?
BHS exitprocess
B donearrow
shiftrightarrow
LDR R14,writeabledir
CMP R14,#0
BNE int_shiftleftarrow
int_shiftrightarrow
LDRB R0,[R2,R5]
CMP R0,#32
BCC passbacktouser ; notify application if eoln
BL skipwordR
B donearrow
ctrlrightarrow
LDR R14,writeabledir
CMP R14,#0
BNE int_ctrlleftarrow
int_ctrlrightarrow
SUB R5,R4,R2 ; set to rhs of string
SUB R5,R5,#1 ; before the terminator!!!
donearrow
ADR R14,caretdata ; load other params
LDMIA R14,{R0-R4} ; R2 will be recomputed from R5
BL int_set_caret_position ; may cause icon to be redrawn
B exitprocess
; Routines to skip a word right or left
; Exit: R5 updated appropriately
skipwordR
LDRB R0,[R2,R5] ; skip non-space
CMP R0,#32
ADDCS R5,R5,#1
BHI skipwordR
skipwordR2
LDRB R0,[R2,R5]
CMP R0,#32
ADDEQ R5,R5,#1 ; stop on first non-space char
BEQ skipwordR2
MOV PC,LR
skipwordL
TEQ R5,#0
MOVEQ PC,LR ; done
SUB R5,R5,#1
LDRB R0,[R2,R5]
CMP R0,#32
BEQ skipwordL
skipwordL2
TEQ R5,#0
MOVEQ PC,LR
SUB R5,R5,#1
LDRB R0,[R2,R5]
CMP R0,#32
BHI skipwordL2
ADDCS R5,R5,#1 ; back to last non-space char
MOV PC,LR
; checkvalid - scan validation string to see if char is acceptable
; Entry: R3 --> validation string (<=0 ==> none)
; R6 = char under consideration
; Exit: Z set ==> char is OK
; Z unset ==> pass back to user instead
; R7 = 0/1 char is OK/not OK so far
; R8 = 0/1 we are trying to in/exclude characters
checkvalid
CMP R3,#0
CMPLE R3,R3
MOVEQ PC,LR ; Z set ==> char ok
Push "R2-R8,LR"
MOV R7,#0 ; char ok if command not found
MOV R2,#WimpValidation_Allow
BL findcommand
BNE exitcheck
BVS exitcheck
LDRB R14,[R3] ; quick check for initial state
TEQ R14,#"~"
MOVNE R7,#1 ; 1 means char is not OK so far
MOV R8,#0 ; we're enabling chars so far
01
LDRB R4,[R3],#1 ; R4 = char
CMP R4,#32
BCC exitcheck ; terminator
TEQ R4,#";"
BEQ exitcheck ; separator
TEQ R4,#"~"
EOREQ R8,R8,#1 ; toggle in/excluding state
BEQ %BT01
TEQ R4,#"\"
LDREQB R4,[R3],#1 ; 'escaped' char
LDRB R5,[R3],#1
TEQ R5,#"-"
BNE check_single ; R4 = char to check for
LDRB R5,[R3],#1
CMP R5,#32
BCC errcheck
TEQ R5,#";"
TEQNE R5,#"-"
TEQNE R5,#"~"
BEQ errcheck ; can't allow non-escaped separator
TEQ R5,#"\"
LDREQB R5,[R3],#1 ; 'escaped' char
CMP R6,R4
SUBCSS R14,R5,R6 ; CS ==> char matches
EOR R7,R7,R8
MOVCS R7,#0 ; OK := OK or <match>
EOR R7,R7,R8
B %BT01
check_single
SUB R3,R3,#1 ; we've read 1 too many chars!
TEQ R6,R4 ; EQ ==> char matches
EOR R7,R7,R8
MOVEQ R7,#0 ; OK := OK or <match>
EOR R7,R7,R8
B %BT01
errcheck
MyXError WimpBadSyntax
exitcheck
TEQ R7,#0 ; doesn't affect V flag
Pull "R2-R8,PC"
MakeErrorBlock WimpBadSyntax
; Entry: R2 = command to find (upper-case)
; R3 --> validation string
; Exit: Z set, R3 --> character after relevant command
; Z unset ==> not found (R3 undefined)
findcommand
Push "LR"
01
LDRB R14,[R3],#1
CMP R14,#32
Pull "PC",CC ; not found (Z unset)
AND R14,R14,#&DF
TEQ R14,R2
Pull "PC",EQ
02
LDRB R14,[R3],#1
CMP R14,#32
Pull "PC",CC ; not found (Z unset)
TEQ R14,#";"
BEQ %BT01
TEQ R14,#"\"
BNE %BT02
LDRB R14,[R3],#1 ; skip 'escape'd char
CMP R14,#32
BCS %BT02
MyXError WimpBadSyntax
Pull "PC"
; Entry: R2 = K command to find (upper-case)
; R3 --> correct part of validation string
; Exit: Z set, R3 --> character after relevant command
; Z unset ==> not found (R3 undefined)
findKcommand
Push "LR"
01
LDRB R14,[R3],#1
CMP R14,#32
Pull "PC",CC ; not found (Z unset)
AND R14,R14,#&DF
TEQ R14,R2
Pull "PC",EQ
TEQ R14,#";" :AND: &DF
BNE %BT01
CMP R14,#0 ; not found (Z unset)
Pull "PC"
;-----------------------------------------------------------------------------
; Create_Menu - set up a menu chain, and get the Wimp to maintain it
; Entry: R1 --> user data (menu tree) - (userblk <- R1)
; R2,R3 = coords of top-left of window
; IF task_wimpver >= 306 THEN R4 =flags for title bar data
; Data must exist as long as the menus are around
; Exit : The current menu tree is matched to the proposed one
; If it doesn't match, it is cancelled
; Wimp_Poll (menu_select) returns if the user makes a selection
;-----------------------------------------------------------------------------
^ 0
m_title # 12
m_colours # 4
m_width # 4
m_height # 4
m_gap # 4
m_header # 0
^ 0
mi_mflags # 4
mi_submenu # 4
mi_iflags # 4
mi_idata # 12
mi_size # 0
mif_ticked * 2_00000001 ; entry is ticked
mif_dottedline * 2_00000010 ; dotted line under this icon
mif_writeable * 2_00000100 ; writable icon
mif_warning * 2_00001000 ; send warning when submenu selected
mif_traverse * 2_00010000 ; allow traversal even if grey (Wimp 2.52)
mif_lastone * 2_10000000 ; no more items after this one
mif_longtitle * 2_100000000 ; Title is indirected
; if this menu structure matches the current one (if any),
; try to open the same menus in the same places.
; NB: the menus should not have to be temporary for this to happen
keepit DCB "KEEP"
SWIWimp_CreateMenu
MyEntry "CreateMenu"
; try opening the windows in the same place as before,
; as long as the selection pointers are valid:
; a) not off the end
; b) unshaded
; c) pointing to the same menu data address as before
; close menus back to the last valid one found
Debug x1,"r1,r2,r3,r4",r1,r2,r3
MOV R14,#0
STR R14,menus_temporary ; not temporary any more
[ true
LDR R14,keepit
TEQ R1,R14
BEQ ExitWimp
]
MOV R14,#0
STR R14,reversedmenu
MOV R14,#1
STR R14,externalcreate ; flag as an external create of a menu
MOV R1,userblk ; original R1
MOV R5,#-4 ; menus known about so far
LDR R14,menutaskhandle ; don't scan menus if paged out!
LDR R0,taskhandle
TEQ R14,R0
BL trymenusdeleted ; calls menusdeleted if NE or R1 != [menudata]
STRNE R0,menutaskhandle ; new owner!
BNE foundallmenus
ADR R6,menuselections
ADR R7,menudata+4 ; NB allow for R5 = index - 4
01
LDR R14,menuSP
CMP R5,R14 ; if reached last menu, we've finished
BGE foundallmenus
LDR R14,[R7,R5] ; R14 --> next menu item in list
TST R14,#3
SUBEQ R14,R14,#m_header ; point back to main part
TEQ R1,R14
BNE foundallmenus ; if different, that's no good
ADD R5,R5,#4 ; menu will be included
; NB dialogue boxes have no sub-menus
LDR R4,[R6,R5] ; R4 = selection number (-1 ==> none)
CMP R4,#0
BLT foundallmenus ; no sub-menu
ADD R1,R1,#m_header ; R1 --> first item in current menu
02
BNE %FT03 ; more to go
LDR R14,[R1,#mi_iflags]
TST R14,#is_shaded ; can't go down here!
LDRNE R14,[R1,#mi_mflags] ; unless the 'traverse' bit is set
EORNE R14,R14,#mif_traverse
TSTNE R14,#mif_traverse
BNE foundallmenus
LDR R1,[R1,#mi_submenu]
B %BT01 ; try next one
03
ASSERT mi_mflags=0
LDR R8,[R1],#mi_size
TST R8,#mif_lastone
BNE foundallmenus ; gone off the end!
SUBS R4,R4,#1
BGE %BT02
; R5 = index of last menu still valid
; if R5 < 0, R1=menu ptr, else values are in [menudata]
foundallmenus
MOV R0,R5
BL closemenus ; close back to here
BVS ExitWimp
; step back through the list, accumulating the data & coordinates on the stack
CMP R5,#0
BLT justcreatemenu ; none of the old ones were any good!
MOV R1,#0 ; marker (last one) - must be ZERO!
Push "R1-R4,R14"
01
ADR R14,menuhandles
LDR handle,[R14,R5]
BL checkhandle ; handle --> window definition
BVS err_unwindstack
LDR R2,[handle,#w_wax0]
LDR R3,[handle,#w_way1]
ADR R14,menudata
LDR R1,[R14,R5]
TST R1,#3
SUBEQ R1,R1,#m_header ; recover header part
ADR R14,menuselections
LDR R4,[R14,R5]
LDR R14,[handle,#w_scy]
Push "R1-R4,R14"
SUBS R5,R5,#4
BGE %BT01
; close old menus, re-open the menus, and re-select the right icons
MOV R0,#-4
BL closemenus
01
MOV R1,#1 ; Fake an external open so that
STR R1,externalcreate ; menu does not move.
Pull "R1-R4,R14" ; R14 = initial scroll position
TEQ R1,#0 ; doesn't affect V flag
BEQ %FT02
STRVC R14,menuscrolly ; extra parameter
BLVC int_create_menu_withscroll ; keep unwinding stack after error
MOVVC R0,R4
BLVC menuhighlight
B %BT01
02
[ PoppingIconBar
LDR R1,iconbar_pop_state
TEQ R1,#pop_Front
MOVEQ R1,#pop_HeldByMenu
STREQ R1,iconbar_pop_state
]
MOV R1,#0 ; Restore menu state for any
STR R1,externalcreate ; future submenus.
B ExitWimp
err_unwindstack
Pull "R1-R4,R14"
TEQ R1,#0 ; doesn't affect V
BNE err_unwindstack
B ExitWimp ; report error
;.............................................................................
; In R1 -> new menu tree
; [menudata] -> old menu tree (if menuSP >= 0)
; NE => menu owner is changing
; Out menusdeleted called if NE on entry, or R1 != [menudata]
; All flags preserved
trymenusdeleted
Push "LR"
BLEQ getmenuroot ; R14 = current root in [menudata]
TEQEQ R1,R14 ; or the root node is different,
BLNE menusdeleted ; send Message_MenusDeleted to old owner
Pull "PC",,^ ; must preserve flags
; In [menudata] = current menu root
; Out R14 = menu root pointer (or dbox window handle)
getmenuroot
Push "LR"
LDR R14,menudata ; if menu owner changing,
TST R14,#3
SUBEQ R14,R14,#m_header ; correct for header if menu ptr
Pull "PC",,^
; In [menuSP] >= 0 => there is a menu tree
; [menudata] = root node pointer of tree
; [menutaskhandle] = task handle of menu owner
; Out If menus present, Message_MenusDeleted sent to menu owner
menusdeleted
Push "R0-R4,LR"
LDR R14,menuSP
CMP R14,#0
MOVGE R0,#ms_data+4 ; size
MOVGE R3,#0 ; your_ref = 0
LDRGE R4,=Message_MenusDeleted
BLGE getmenuroot ; R14 = menu root pointer
ASSERT ms_data+4 = 24 ; 6 registers needed
Push "R0-R4,R14"
MOVGE R0,#User_Message
MOVGE R1,sp
LDRGE R2,menutaskhandle
BLGE int_sendmessage_fromwimp
ADD sp,sp,#ms_data+4
Pull "R0-R4,PC",,^ ; must preserve flags
LTORG
;-----------------------------------------------------------------------------
; Create_SubMenu - add a menu to the current menu chain
; Entry: R1 --> user data (menu tree) - (userblk <- R1)
; R2,R3 = coords of top-left of window
; Data must exist as long as the menus are around
; Exit : the menu is appended to the existing menu tree
;-----------------------------------------------------------------------------
SWIWimp_CreateSubMenu
MyEntry CreateSubMenu
LDR R14,menutaskhandle
LDR R4,taskhandle
TEQ R4,R14
MyXError WimpBadSubMenu,NE
BVS ExitWimp
MOV R14,#0
STR R14,externalcreate ; flag as an external create of a menu
justcreatemenu
CMP R1,#0
BLGT int_create_menu ; <=0 ==> just close menus
LDR R14,menuSP
TEQ R14,#0 ; don't affect V flag
STRMI R14,menutaskhandle ; none left ==> no menu owner
MOV R14,#0
STR R14,externalcreate ; flag as an external create of a menu
B ExitWimp
MakeErrorBlock WimpBadSubMenu
MakeErrorBlock WimpTooMenus
; Entry: R1 --> data block (or dialogue window handle)
; R2,R3 = coords of top-left
; [menuscrolly] = appropriate y-scroll if menu being opened
int_create_menu
[ PoppingIconBar
LDR R0,iconbar_pop_state
TEQ R0,#pop_Front
MOVEQ R0,#pop_HeldByMenu
STREQ R0,iconbar_pop_state
]
MOV R0,#0 ; normally open with scrolly = 0
STR R0,menuscrolly
int_create_menu_withscroll
Push "R1-R4,userblk,LR"
LDR R14,menuSP
CMP R14,#4*(maxmenus-1)
MyXError WimpTooMenus,GE
BVS exitcrmenu
; check to see if we're creating a sub-menu or a dialogue box
TST R1,#3
BEQ createsubmenu ; menus are on word boundaries, windows aren't
STR R1,menuhandle
Push "handle"
MOV handle,R1
BL checkhandle
[ StickyMenus
LDR R14,[handle,#w_flags]
ORR R14,R14,#wf_icon2
STR R14,[handle,#w_flags]
]
ADD R14,handle,#w_wax0
Pull "handle"
BVS exitcrmenu
LDMIA sp,{R1,x1,y1} ; x1,y1 = coords of top-left
LDMIA R14,{cx0,cy0,cx1,cy1,x0,y0}
SUB R14,x1,cx0
ADD cx0,cx0,R14
ADD cx1,cx1,R14
SUB R14,y1,cy1
ADD cy1,cy1,R14
ADD cy0,cy0,R14
LDR R14,menuSP
ADD R14,R14,#:INDEX:(menudata+4)
LDR R1,menuhandle
STR R1,[wsptr,R14] ; menudata <= maxhandle for dialogue box
B goopenwindow
; create new sub-menu
createsubmenu TraceL sc
ADRL userblk,menuwindow ; window 'template'
BL int_create_window
STRVC R0,menuhandle
[ debug :LAND: debugmenuw
BVS createsubmenu_continue1
Trace menuw, "storing task handle -1 at w_taskhandle of window ", X, R0
createsubmenu_continue1
BVC createsubmenu_continue2
Trace menuw, "not storing task handle -1 at w_taskhandle of window ", X, R0
createsubmenu_continue2
]
MOVVC R14,#-1 ; menus have task handle -1
BIC R0, R0, #3 ;make sure R0 is word aligned ; }
STRVC R14, [R0, #w_taskhandle] ; } was STRVC R14, [handle, #w_taskhandle]
exitcrmenu
Pull "R1-R4,userblk,PC",VS ; error
LDR userblk,[sp,#0*4] ; original R1
[ outlinefont
LDR LR, systemfont
TEQ LR, #0
BLNE fixupmenuwidth
BLEQ fixupmenuwidth_vdu
]
[ False
LDR R0,taskhandle
LDR R0,[WsPtr,R0]
LDR R0,[R0,#task_wimpver] ; R0 = wimpver known
]
ASSERT (m_title =0)
LDR R4, [userblk, #m_header] ; Get 1st item's flags
LDMIA userblk!,{R1-R3}
BL createmenutitle ; attempt to create title for this menu (pass Wimp version)
ASSERT (m_colours=12)
LDMIA userblk!,{R1-R4} ; colours,width,height,spacing
Debug menuparam,"Menu colours,width,height,gap",R1,R2,R3,R4
[ :LNOT: NCMenus
STR R1,[handle,#w_tfcol] ; 4 colours
]
LDRB R14,[handle,#w_tbcol]
STRB R14,[handle,#w_tbcol2] ; for input focus
[ NCMenus
MOV y1, #-24
|
MOV y1,#0
SUB y1,y1,R4,ASR #1 ; subtract 1/2 gap
]
SUB y0,y1,R3
STR R2,menuiconwidth
STR R3,menuiconheight
STR R4,menuiconspacing
ADR R14,menudata+4
LDR R4,menuSP ; spare register
STR userblk,[R14,R4]
; create tick, menu item and arrow (in that order)
crmenuiconlp
LDMIA userblk!,{R4,R5} ; flags, sub-menu pointer
Debug menuparam,"menu flags, ptr",R4,R5
MOV x0,#0
MOV x1,#24
LDR R1,reversedmenu ; Is it a reversed menu?
CMP R1,#"\"
LDREQ x0,menuiconwidth ; Put it where the arrow is
ADDEQ x0,x0,#24 ; supposed to be.
ADDEQ x1,x0,#24
LDR R1,menutickflags
LDR R14,[userblk] ; flags of middle icon
TST R14,#if_fancyfont
MOVNE R2,#(0:SHL:ib_bcol):OR:(7:SHL:ib_fcol)
ANDEQ R2,R14,#if_fcol:OR:if_bcol
AND R14,R14,#is_shaded
ORR R14,R14,R2
Push "R14" ; same again for arrow
ORR R1,R1,R14 ; shade tick too if nec.
TST R4,#mif_ticked
MOV R2,#cr:SHL:8 ; null text
ORRNE R2,R2,#&80 ; tick
BICEQ R1,R1,#if_sprite ; isn't a sprite if no tick
BL createmenuicon ; #### check for errors!
ADDVS sp, sp, #4
BVS yugnasty
; menu item itself
Push "R4"
LDMIA userblk!,{R1-R4} ; icon data
Debug menuparam,"menu icon flags,data",R1,R2,R3,R4
[ NCMenus
ORR r1, r1, #2:SHL:ib_bcol
ORR r1, r1, #if_filled
|
TST R1,#if_filled ; if not filled,
LDREQB R14,[handle,#w_wbcol] ; put menu colour into icon colour
ANDEQ R14,R14,#if_bcol:SHR:ib_bcol
ORREQ R1,R1,R14,LSL #ib_bcol
ORREQ R1,R1,#if_filled ; then treat it as filled
]
LDR R14,[SP]
TST R14,#mif_writeable
;Make sure that the writable bit is copied from the menu flags
; word to the icon flags word (as button type 15).
BIC R1, R1, #15 :SHL: 12
ORRNE R1, R1, #15 :SHL: 12
Trace menuw, "icon flags word now shows whether writable ", X,R1
Trace menuw, "original menu flags ",X,LR
BNE %FT01
LDR x0,reversedmenu ; Is it a reversed menu ?
CMP x0,#"\"
ORRNE R1,R1,#if_numeric ; If not all icons are numeric.
BNE %FT01
TST R1,#if_numeric
ORRNE R1,R1,#if_rjustify
01
BIC R1,R1,#if_esg2
AND R14,R1,#if_buttontype ; before clearing the buttontype (needed for
; correct caret behaviour)
CMP R14,#14 :SHL: 12 ; check for either type of writable
ORRLT R1,R1,#12:SHL:ib_esg ; and set esg 12 for non-writable, and
ORRGE R1,R1,#13:SHL:ib_esg ; esg 13 for writable
BIC R1,R1,#if_buttontype
; ORR R1,R1,#13:SHL:ib_esg ; set esg 13
MOV x0,#24
LDR R14,menuiconwidth
ADD x1,x0,R14
Trace menuw, "crmenuiconlp: flags set to ", X, R1
BL createmenuicon ; uses x0,y0,x1,y1,R1-R4
ADDVS sp, sp, #8
BVS yugnasty
; arrow
MOV x0,x1
ADD x1,x0,#24 ; width of arrow icon
LDR R1,reversedmenu ; Is it a reversed menu?
CMP R1,#"\"
MOVEQ x0,#0 ; Put it where tick is supposed to be
MOVEQ x1,#24
LDR R1,menuarrowflags
LDR R14,[R13,#4] ; skip one stack item - get shaded bit
ORR R1,R1,R14 ; shade arrow too
CMP R5,#0 ; if ptr <= 0, don't put arrow in
MOV R2,#cr:SHL:8 ; null text
ORRGT R2,R2,#&89 ; right-arrow
BICLE R1,R1,#if_sprite ; Isn't a sprite if no arrow.
LDR R14,reversedmenu ; Is it a reversed menu?
CMP R14,#"\"
EOREQ R2,R2,#1 ; Make it a left arrow.
Debuga menuparam,"Create arrow @",x0,y0,x1,y1
Debug menuparam," flags",R1,R2,R3,R4
BL createmenuicon ; #### check for errors!
LDR x0,menuiconwidth
ADD x0,x0,#24
ADD x1,x0,#24
ADDVS sp, sp, #8
BVS yugnasty
; check for dotted line
Pull "R4,R14" ; pull extra item (not needed)
TST R4,#mif_dottedline
SUBNE y0,y0,#24 ; leave gap for dotted line
TST R4,#mif_lastone
LDR R14,menuiconspacing
[ NCMenus
SUBNE y1,y0,#24
|
SUBNE y1,y0,R14,ASR #1
]
SUBEQ y1,y0,R14 ; move to top of next icon
LDREQ R14,menuiconheight
SUBEQ y0,y1,R14
BEQ crmenuiconlp
; finished - work out window size and open it
LDMIA sp,{R1,cx0,cy1} ; cx0,cy1 = coords of top-left
ADD cy0,cy1,y1
ADD cx1,cx0,x1 ; coords of bottom-right
MOV x0,#0 ; scroll offsets
LDR y0,menuscrolly ; for re-opening menus
STR y1,[handle,#w_wey0] ; get extent right
LDR R14,scry1 ; add vertical scroll bar if needed
LDR R0,title_height
SUB R14,R14,R0
ADDS R14,R14,y1 ; y1 is -ve
LDRLE R14,[handle,#w_flags]
ORRLE R14,R14,#wf_icon5 ; new bit for vertical scroll
STRLE R14,[handle,#w_flags]
; now open the window (may be the dialogue window)
; Entry: cx0,cy0,cx1,cy1,x0,y0 = work area coords & scroll offsets
goopenwindow TraceL sc
LDR R14,externalcreate
TST R14,#1
BNE %FT05
LDR R14,reversedmenu ; is it in a reversed menu?
CMP R14,#"\"
LDR R14,dx
ADDNE cx0,cx0,R14
ADDNE cx1,cx1,R14
SUBEQ cx0,cx0,R14
SUBEQ cx1,cx1,R14
SUBEQ R14,cx1,cx0 ; if so, move left by width
SUBEQ cx1,cx1,R14
SUBEQ cx0,cx0,R14
MOV R14,#0
STR R14,externalcreate
05
MOV R14,#nullptr ; open at top
LDR R0,menuhandle
ADRL userblk,tempiconblk
STMIA userblk,{R0,cx0,cy0,cx1,cy1,x0,y0,R14}
; set windowflags bit to avoid menu going off-screen
Push "R0" ; relative window handle
MOV handle,R0 ; R0 = relative window handle
BL checkhandle
LDRVC R14,[handle,#w_flags] ; applies to submenus and dboxes
ORRVC R14,R14,#ws_onscreenonce ; allow it to go off later
STRVC R14,[handle,#w_flags]
BLVC int_open_window
Pull "R3" ; R3 = window handle (for setmenucaret)
BVS yugnasty
; if any icons are writable, set input focus to it
LDR R1,[handle,#w_nicons] ; handle set up by Open_Window
LDR R2,[handle,#w_icons]
ADD R2,R2,#i_flags
MOV R4,#-1
Debug omd,"Window has (icons) ",R1
findflp
ADD R4,R4,#1
CMP R4,R1
BGE nomenufocus
[ true
LDR R0, [R2], #i_size ; get flags for this icon
AND R14, R0, #if_buttontype
CMP R14, #14 :SHL: ib_buttontype ; type-14 icons are also allowed to gain caret
BLT findflp
TST R0, #is_shaded :OR: is_deleted ; don't set to a shaded or deleted icon!
BNE findflp
|
LDR R14,[R2],#i_size
AND R14,R14,#if_buttontype
TEQ R14,#if_buttontype
BNE findflp
]
Debug omd,"About to set focus to icon ",R4
BL setmenucaret
nomenufocus
Debug omd,"No menu focus found"
; put window in stack of menu handles
ADR R14,menuhandles
LDR R0,menuhandle
LDR R1,menuSP
ADD R1,R1,#4 ; -4 ==> no menus
STR R1,menuSP ; stack is full ascending
STR R0,[R14,R1]
ADR R14,menuselections ; selection is always -1 if dialogue
MOV R2,#-1
STR R2,[R14,R1]
[ KeyboardMenus
Push "r5,r6"
MOV r4, r1
ADR r5, menudata
LDR r5, [r5, r4]
TST r5, #3
BNE %FT10
LDR r14, menutaskhandle
Task r14,,"OpenMenu"
MOV r1, #-1
MOV r6, #138
BL trymenuupdown
10
Pull "r5,r6"
]
; [menuhandle] = handle of window just created
; we must delete the window if an error occurred afterwards
yugnasty
MOV R3, PC
MOV R4, R0
LDRVS R0, menuhandle
BLVS int_delete_window
MOVVC R0, R4
TEQVCP R3, #0
Pull "R1-R4,userblk,PC"
;...........................................................................
[ outlinefont
fixupmenuwidth TraceL menuw
; Entry
; userblk -> menu block
; Exit
; all registers preserved
; [userblk, #m_width] updated (in place!)
Push "R0-R9, LR"
Trace menuw, "fixupmenuwidth: menu block at ", X, userblk
;pushfontstring looks at validationstring - make sure this is 0
LDR R9, validationstring
MOV R0, #0
STR R0, validationstring
;Get the title.
MOV R1, #if_text
ORR R1, R1, #if_indirected
; R1 = flags for icon ("indirected text")
;Is it indirected?
LDR R0, [userblk, #m_header + mi_mflags]
TST R0, #mif_longtitle
ADDEQ R2, userblk, #m_title
LDRNE R2, [userblk, #m_title]
; R2 -> string to paint
Trace menuw, "fixupmenuwidth: title at ", X, R2
LDR R3, systemfont ;known to be non-0
; R3 = handle for icon font
BL pushfontstring
; R1 -> font string
; R7 = stack difference
MOV R2, #bignum
MOV R3, #bignum
MOV R4, #-1
MOV R5, #bignum
Trace menuw, "fixupmenuwidth: measuring ", S, R1
SWI XFont_StringWidth
; (R2, R3) = offset for string (mpt)
ADD SP, SP, R7
MOV R6, R2
; R6 = maximum width so far (mpt)
Trace menuw, "fixupmenuwidth: max so far ", D, R6
;Now start loop for the menu items
ADD R8, userblk, #m_header
; R8 -> first item
MOV R1,#0 ;320nk
STRB R1,auto_menu_flag
fixupmenuwidth_item_loop
LDRB R1,auto_menu_flag
CMP R1,#0
BNE %FT33
LDR R1,[R8]
TST R1,#4 ; is it writeable
STRNEB R1,auto_menu_flag
33
LDR R1, [R8, #mi_iflags]
TST R1,#if_text ; no text!
MOVEQ R2,#0
BEQ %FT45
; R1 = flags for icon
TST R1, #if_indirected
ADDEQ R2, R8, #mi_idata
LDRNE R2, [R8, #mi_idata]
; R2 -> string to paint
LDR R3, systemfont
; R3 = handle for icon font
BL pushfontstring
; R1 -> font string
; R7 = stack difference
MOV R2, #bignum
MOV R3, #bignum
MOV R4, #-1
MOV R5, #bignum
Trace menuw, "fixupmenuwidth: measuring ", S, R1
SWI XFont_StringWidth
; (R2, R3) = offset for string (mpt)
ADD SP, SP, R7
45
ORR R2,R2,#1 ; tell routine its mpt.
BL menu_checkforsprite
CMP R6, R2
MOVLT R6, R2
; R6 = maximum width so far (mpt)
Trace menuw, "fixupmenuwidth: max so far ", D, R6
;More items?
LDR R0, [R8, #mi_mflags]
TST R0, #mif_lastone
ADDEQ R8, R8, #mi_size
; R8 -> next item
BEQ fixupmenuwidth_item_loop
;Convert R6 to OSU and store it back in the menu definition
MOV R1, R6
SWI XFont_ConverttoOS
ADD R1, R1, #16 ;add 16 OSU for good luck
LDRB R6,auto_menu_flag
CMP R6, #0
LDRNE R6, [userblk, #m_width] ;320nk
CMP R1, R6
STRGT R1, [userblk, #m_width] ; only update width if larger
Trace menuw, "fixupmenuwidth: total width ", D, R1
;Put the validation string back
STR R9, validationstring
Pull "R0-R9, PC",, ^
fixupmenuwidth_vdu TraceL menuw
; Entry
; userblk -> menu block
; Exit
; all registers preserved
; [userblk, #m_width] updated (in place!)
Push "R0-R9, LR"
Trace menuw, "fixupmenuwidth_vdu: menu block at ", X, userblk
;Get the title.
MOV R1, #if_text
ORR R1, R1, #if_indirected
; R1 = flags for icon ("indirected text")
;Is it indirected?
LDR R0, [userblk, #m_header + mi_mflags]
TST R0, #mif_longtitle
ADDEQ R2, userblk, #m_title
LDRNE R2, [userblk, #m_title]
; R2 -> string to paint
Trace menuw, "fixupmenuwidth_vdu: title at ", X, R2
MOV R6,#0
01
LDRB R1,[R2],#1
CMP R1,#32
ADDGE R6,R6,#16 ; 16 OS units per char
BGE %BT01
; R6 = maximum width so far (mpt)
Trace menuw, "fixupmenuwidth_vdu: max so far ", D, R6
;Now start loop for the menu items
ADD R8, userblk, #m_header
; R8 -> first item
MOV R5,#0
fixupmenuwidth_vdu_item_loop
CMP R5,#0
BNE %FT33
LDR R1,[R8]
TST R1,#4 ; is it writeable
MOVNE R5,R1
33
LDR R1, [R8, #mi_iflags]
TST R1,#if_text
MOVEQ R2,#0
BEQ %FT45
; R1 = flags for icon
TST R1, #if_indirected
ADDEQ R2, R8, #mi_idata
LDRNE R2, [R8, #mi_idata]
; R2 -> string to paint
MOV R3,#0
05
LDRB R1,[R2],#1
CMP R1,#32
ADDGE R3,R3,#16 ; 16 OS units per char
BGE %BT05
MOV R2, R3
45
BIC R2,R2,#1 ; OSU
BL menu_checkforsprite
CMP R6, R2
MOVLT R6, R2
; R6 = maximum width so far (mpt)
Trace menuw, "fixupmenuwidth_vdu: max so far ", D, R6
;More items?
LDR R0, [R8, #mi_mflags]
TST R0, #mif_lastone
ADDEQ R8, R8, #mi_size
; R8 -> next item
BEQ fixupmenuwidth_vdu_item_loop
ADD R1, R6, #16 ;add 16 OSU for good luck
CMP R5,#0
LDRNE R5,[userblk,#m_width]
CMPNE R5,R1
MOVGT R1,R5 ; ok as if R5=0 then R5 not GT 0
STR R1, [userblk, #m_width]
Trace menuw, "fixupmenuwidth_vdu: total width ", D, R1
Pull "R0-R9, PC",, ^
menu_checkforsprite ENTRY "R0-R6"
; in R8 -> icon item , R2= width of text
; out R2 updated for vertically centred sprites only
LDR R0,[R8,#mi_iflags]
TST R0,#if_sprite
EXIT EQ
TST R0,#if_vcentred
EXIT EQ
TST R0,#if_indirected
ADDEQ R0,R8,#mi_idata
BEQ %FT05
TST R0,#if_text
BNE %FT01
[ false
LDR R0,[R8,#mi_idata] ; name/pointer of sprite
LDR R1,[R8,#mi_idata+4] ; sprite area
LDR R14,[R8,#mi_idata+8] ; name or pointer ?
TEQ R14,#0
MOV R2,R0
BEQ %FT07
TEQ R1,#1
BEQ %FT05 ; in wimp area
MOV R0,#24+256
SWI XOS_SpriteOp
B %FT07
|
; if just sprite then take supplied width.
TST R2,#1 ; treat like writeable
STRNEB R2,auto_menu_flag
MOVEQ R5,#1 ; VDU fixup routine uses R5
STREQ R5,[SP,#20]
EXIT
]
01
LDR R0,[R8,#mi_idata+4]
02
LDRB R1,[R0],#1
TEQ R1,#"s"
TEQNE R1,#"S"
MOVEQ R1,#1 ; use wimp sprite area
BEQ %FT05
CMP R1,#31
BGT %BT02
EXIT ; no sprite in validation string
05
STR R0,spritename
BL getspriteaddr
EXIT VS
07
[ SpritePriority
Push "R2"
CMP R1, #1 ; try any user area before either Wimp area
SETPSR V_bit, R0, EQ ; SETV will *not* do, it corrupts Z
MOVNE R0, #512+40 ; attempt to read sprite information
SWINE XOS_SpriteOp
MOVVS R0, #512+40
LDRVS R1, baseofhisprites
LDRVS R2, [SP]
SWIVS XOS_SpriteOp ; not there? try again within high-priority area
MOVVS R0, #512+40
LDRVS R1, baseoflosprites
LDRVS R2, [SP]
SWIVS XOS_SpriteOp ; not there? try again within low-priority area
Pull "R2" ; sprite op can stuff R2
|
TEQ R1,#1
LDREQ R1,baseofsprites ; area may be 1 from above
MOV R0,#40+512
SWI XOS_SpriteOp
LDRVS R1,baseofromsprites
MOVVS R0,#40+512
SWIVS XOS_SpriteOp
]
EXIT VS
; width in pixels now in R3, screen mode in R6
LDR R5,[SP,#8]
TST R5,#1
BEQ %FT08
MOV R1,R3
MOV R2,#0
SWI XFont_Converttopoints
MOV R3,R1
08
MOV R0,R6
MOV R1,#4
SWI XOS_ReadModeVariable
EXIT CS
ADD R2,R5, R3, LSL R2
STR R2,[sp,#8]
EXIT
]
;...........................................................................
createmenuicon
Push "R1-R5,x0,y0,x1,y1,userblk,LR"
ADRL userblk,tempiconblk ; construct icon data
ADD R14,userblk,#4
STMIA R14!,{x0,y0,x1,y1}
STMIA R14,{R1-R4}
BL int_create_icon ; uses handle, not [userblk]
Pull "R1-R5,x0,y0,x1,y1,userblk,PC"
[ {TRUE} ; LRust - V308 reverts to sprites
[ NCMenus
menutickflags DCD &000E001a ; ESG 14, tick is a sprite
menuarrowflags DCD &000F001a ; ESG 15
|
menutickflags DCD &000E003a ; ESG 14, tick is a sprite
menuarrowflags DCD &000F003a ; ESG 15
]
|
menutickflags DCD &000E0039 ; ESG 14, tick is text
menuarrowflags DCD &000F0039 ; ESG 15
]
;..............................................................................
; setup the title bars for this menu, checking for indirection and or
; reversed menus.
; in
; R4 = flags from 1st menu item
; R1,R2,R3 = 3 words in menu title
; userblk -> original entry R1
; handle -> window defn block for this window
; out R0,R1,R2,R3 can be disturbed!
createmenutitle ENTRY ""
Debug menu,"CreateMenuTitle: flags=",R4
[ False
LDR R14,=306 ; indirected menu titles added when?
CMP R14,R0
BGT %FT05 ; Jump if app doesn't know about indirected titles
]
TST R4, #mif_longtitle ; Title indirected?
BEQ %FT05 ; No then jump
Debug menu,"New style menu: string, validation, length =",R1,R2,R3
MOV R2, #0
MOV R3, #0 ; Ensure validation and sprite name strings are null
TEQ R1, #0 ; Valid ptr?
LDRNEB R0,[R1] ; Yes then get first character
BICEQ R4, R4, #mif_longtitle
MOVEQ R0, #0
[ debugmenu
BEQ %FT00
DebugS menu,"Indirected title:",R1
00
]
CMP R0,#32 ; is a title bar present?
LDRGE R14,[handle,#w_flags]
[ StickyMenus
ORRGE R14,R14,#wf_icon3 :OR:wf_icon2
|
ORRGE R14,R14,#wf_icon3
]
STRGE R14,[handle,#w_flags] ; flag as being present if required
TEQ R0,#"\" ; is it a reversed menu?
ADDEQ R1,R1,#1
B %FT10 ; and then we are finished.
; do old style menu data - R1,R2,R3 contains them there title bar data
05 AND R0,R1,#&FF ; get the first character
Debug menu,"old style menu: first char =",R0
CMP R0,#32
LDRGE R14,[handle,#w_flags]
[ StickyMenus
ORRGE R14,R14,#wf_icon3 :OR:wf_icon2
|
ORRGE R14,R14,#wf_icon3
]
STRGE R14,[handle,#w_flags] ; no, so remove it!
TEQ R0,#"\"
BICEQ R1,R1,#&FF
ORREQ R1,R1,#" " ; if reversed then remove first character
; Common code to mod title flags
10 STREQ R0,reversedmenu
15 ADD R14,handle,#w_title
STMIA R14,{R1,R2,R3} ; poke the title with suitable data
; and now modify the flags
LDR R0,[handle,#w_titleflags]
LDR R14,reversedmenu
TEQ R14,#"\"
ORRNE R0,R0,#if_numeric
TST R4, #mif_longtitle
ORRNE R0,R0,#if_indirected ; modify the title flags
BICEQ R0,R0,#if_indirected
STR R0,[handle,#w_titleflags]
Debug menu,"menu title flags =",R0
EXITS
;..............................................................................
menuwindow_internal
;Space for a copy of the WIMP's internal data for a window
% 4 ; guard word
DCD -1 ; task handle
% ll_size ; active link
% ll_size ; all link
% 4 ; icon block
[ Version >= 317 :LAND: togglebits
% 4 ; toggle width
% 4 ; toggle height
]
menuwindow
DCD 0 ; Open_Window data (x0,y0,x1,y1)
DCD 0
DCD 0
DCD 0
DCD 0 ; scroll x,y
DCD 0
DCD -1 ; bhandle
DCD &80000012 ; no borders, redrawn by wimp, moveable
[ NCMenus
DCB 1,0,7,1 ; colours - not overridden by user
|
DCD 0 ; colours - overridden by user
]
DCB 3,1,0,0 ; scroll outer, inner, not used
DCD 0 ; work area extent (x0)
DCD -bignum ; work area extent (y0)
DCD bignum ; work area extent (x1)
DCD 0 ; work area extent (y1)
DCD &0000002D ; title flags
DCD 0 ; work area button flags
DCD 1 ; sprite areaCBptr (system area?)
DCB 0,0,0,0 ; min x,y and 2 reserved bytes
% 12 ; title uninitialised
DCD 0 ; no of icons
ASSERT (.-menuwindow)=(w_cw1-w_cw0)
;------------------------------------------------------------------------------
; Draw dotted lines in body of a menu
; Entry: x0,y1 = origin of window (assume scx = 0)
; x1 = rhs of window on screen (for drawing dotted line across)
; handle --> window definition
redrawmenu
Push "R1,LR"
ADR R14,menuhandles
LDR R1,menuSP
rdrmlp1
CMP R1,#0
Pull "R1,PC",LT
LDR R0,[R14,R1]
Abs R0,R0
CMP R0,handle ; is it this one?
SUBNE R1,R1,#4 ; try again
BNE rdrmlp1
; get menu data and draw appropriate dotted lines
Push "R2-R4,y0,y1"
ADR R14,menudata
LDR R1,[R14,R1] ; get pointer to data (omits header)
TST R1,#3
BNE exitdottedlines ; it's probably a dbox
LDR R2,[R1,#m_height-m_header]
LDR R3,[R1,#m_gap-m_header]
LDRB R0,[handle,#w_wfcol]
BL foreground
MOV R0,#&F0
BL setdotdash
SUB y1,y1,R3,ASR #1 ; subtract 1/2 gap from top
rdrmlp2
SUB y1,y1,R2 ; subtract icon height
LDR R4,[R1,#mi_mflags]
MOV y0,y1 ; remember y1
SUB y1,y1,R3 ; subtract gap
TST R4,#mif_dottedline
BEQ nodtln
SUB y1,y1,#24 ; height of dotted line
ADD y0,y0,y1
MOV y0,y0,ASR #1 ; get average height
Push "R1-R2"
Plot &04,x0,y0
Plot &15,x1,y0 ; draw dotted line
Pull "R1-R2"
nodtln
TST R4,#mif_lastone
ADDEQ R1,R1,#mi_size
BEQ rdrmlp2
exitdottedlines
Pull "R2-R4,y0,y1"
Pull "R1,PC"
;-----------------------------------------------------------------------------
; Close menu(s) until menuSP = R0
closemenus
Push "R1-R5,handle,LR"
LDR R1,menuSP
closmlp
[ PoppingIconBar
CMP R1,#-4 ; done if less than 0!
BGT %FT01
LDR R1,iconbar_pop_state
TEQ R1,#pop_HeldByMenu
MOVEQ R1,#pop_Front
STREQ R1,iconbar_pop_state
MOV R1, #0
STR R1, menuhandle
Pull "R1-R5,handle,PC" ; done
1 CMP R1,R0
Pull "R1-R5,handle,PC",LE ; done
|
CMP R1,R0
CMPGT R1,#-4 ; done if less than 0!
Pull "R1-R5,handle,PC",LE ; done
]
Push "R0,R1"
ADR R14,menuhandles
LDR R0,[R14,R1] ; R0 = window handle
Push "R0-R5"
LDR R14,menucaretwindow ; if caret here, restore old data
TEQ R0,R14
BLEQ unsetmenucaret
STRVS R0,[sp]
Pull "R0-R5"
BVS closenext
LDR R14,draghandle ; if menu/dbox being dragged, stop it!
TEQ R14,R0
BLEQ nodragging
ADR R14,menudata
LDR R14,[R14,R1]
TST R14,#3
BEQ godeleteit ; if dbox, just close it
Push "handle"
MOV handle,R0
BL checkhandle
BLVC nocaret ; remember to lose input focus!
BLVC int_close_window
Pull "handle"
B closenext
godeleteit
BL int_delete_window
closenext
STRVS R0,[sp]
Pull "R0,R1"
SUBVC R1,R1,#4
STRVC R1,menuSP
BVC closmlp
Pull "R1-R5,handle,PC" ; error
;------------------------------------------------------------------------------
; Set up caret position, saving previous value
; Entry: R3,R4 = proposed new position
; Exit: [oldcaretdata] contains old position
; [caretdata] set up appropriately
setmenucaret TraceL sc
Push "R0-R5,LR"
LDR R14,menucareticon
TEQ R4,R14 ; same one?
LDR R14,menucaretwindow ; NB ensure R14 = menucaretwindow !!!
TEQEQ R3,R14
BEQ donemenucaret
CMP R14,#0 ; unless it's a menu icon, remember it
ADRLE R14,caretdata
LDMLEIA R14,{R0-R5}
ADRLE R14,oldcaretdata
STMLEIA R14,{R0-R5}
pullx "R0-R5"
STR R3,menucaretwindow
STR R4,menucareticon
MOV R0,R3 ; R0 = menu handle (relative)
MOV R1,R4 ; R1 = icon handle (middle one)
MOV R2,#bignum ; move to rhs of string
; MOV R4,#-1 ;320nk
MOV R5,#-1 ; calculate caret height and index
BL int_set_caret_position
TraceError sc
donemenucaret
STRVS R0,[R13]
Pull "R0-R5,PC"
unsetmenucaret TraceL sc
Push "R1-R5,handle,userblk,LR"
MOV R14,#nullptr
STR R14,menucaretwindow ; and cancel menu caret flag
ADR R14,oldcaretdata
LDMIA R14,{R0-R5} ; R2 will be recomputed if it's an icon
BL int_set_caret_position
Pull "R1-R5,handle,userblk,PC"
;------------------------------------------------------------------------------
; Entry: R0 = selection number to highlight
; handle -> window block for this menu
; [menuSP] indicates which is the top menu
; [menuselections,[menuSP]] = previous selection
; Exit: if selection is different, and not shaded, highlight the new one
; R14=0 => item was shaded (not selected)
trymenuhighlight
Push "R0-R4,LR"
LDR R1,menuSP
ADR R14,menuselections
LDR R1,[R14,R1] ; R1 = previous selection index
TEQ R0,R1
BEQ menuh_altentry ; must return with R14 = shaded flag
BL mousetrap ; only notify if changed
Pull "R0-R4,LR" ; drop through
menuhighlight
Push "R0-R4,LR"
LDR R1,menuSP ; must be in top menu
ADR R14,menuselections
LDR R4,[R14,R1]
STR R0,[R14,R1]
BL menuunhighlight ; unhighlight selection in R4
BVS %FT02
MOV R1,#-1 ; different selection index this time
; now R0 = new selection index, R1 = old selection index
menuh_altentry ; branched to from trymenuhighlight
CMP R0, #0 ;; BJGA bugfix: exit immediately if no new selection -
Pull "R0-R4,PC", LT ;; this is particularly important with a dialogue box!!
ADD R4,R0,R0,ASL #1 ; now multiply by 3 and add 1
ADD R4,R4,#1 ; R4 = middle icon
; if item shaded, set R14=0 and exit
LDR R14,[handle,#w_icons]
ADD R14,R14,#i_flags
LDR R14,[R14,R4,LSL #i_shift]
TST R14,#is_shaded ; impossible to have R14=0 now
MOVNE R14,#0 ; R14=0 => item was shaded
TEQ R14,#0 ; now exit if item shaded or already done
TEQNE R0,R1
BEQ %FT02
; check for writable menu icon (NB: R14 must end up non-zero after this lot)
ASSERT (mi_size=24)
Push "R4"
MOV R4,R4,ASL #3 ; * 8 = 24*item + 8
ADR R14,menudata ; doesn't include header info
LDR R1,menuSP
LDR R2,[R14,R1]
ADD R2,R2,R4 ; point to menu data (+8)
LDR R2,[R2,#mi_mflags-8] ; R2 = menu item flags
TST R2,#mif_writeable
Pull "R4"
BEQ %FT01
ADR R14,menuhandles
LDR R3,[R14,R1] ; R3 = window handle of this menu
BL setmenucaret
B %FT02
01
MOV R2,#button_left ; SELECT, not ADJUST!
BL selecticon ; select middle section
02
STRVS R0,[sp]
Pull "R0-R4,PC" ; on exit R14=0 => item was shaded
;..............................................................................
; Entry: R4 = selection number to unhighlight
; [menuSP] indicates which is the top menu
menuunhighlight
Push "R0-R4,LR"
CMP R4,#0 ; forget it if no previous selection
Pull "R0-R4,PC",LT
ADD R4,R4,R4,LSL #1 ; now multiply by 3 and add 1
ADD R4,R4,#1 ; R4 = middle icon
; check for writable menu icon
ASSERT (mi_size=24)
Push "R4"
MOV R4,R4,ASL #3 ; * 8 = 24*item + 8
ADR R14,menudata ; doesn't include header info
LDR R1,menuSP
LDR R2,[R14,R1]
ADD R2,R2,R4 ; point to menu data (+8)
LDR R2,[R2,#0-8] ; get menu item flags
TST R2,#mif_writeable
Pull "R4"
BEQ %FT01
BL unsetmenucaret
B %FT02
01
BL deselecticon
02
STRVS R0,[sp]
Pull "R0-R4,PC"
;..............................................................................
; Entry: [mousexpos..] = current mouse coordinates/buttons/time
; Exit: Service_MouseTrap issued to any interested modules
mousetrap
Push "R0-R4,LR"
LDR R0,mousexpos
LDR R4,mouseypos
LDR R2,mousebuttons
LDR R3,timeblk
MOV R1,#Service_MouseTrap
SWI XOS_ServiceCall
Pull "R0-R4,PC",,^ ; don't trust the wallies!
;-----------------------------------------------------------------------------
; Scan the menus, working out what to do next
; Entry: R0,R1,R2,oldbuttons = mouse coords/button state
; R3,R4,handle = relevant window/icon
; Exit : Z set ==> found, else not
;-----------------------------------------------------------------------------
findmenu
Push "LR"
LDR R1,menuSP
findmlp
STR R1,whichmenu ; used later (if mouse clicked)
CMP R1,#0
BLT foundm ; not in menu list - deselect top icon
ADR R14,menuhandles
LDR R0,[R14,R1]
CMP R0,R3
SUBNE R1,R1,#4 ; try again
BNE findmlp
foundm
Pull "PC" ; on exit, Z set ==> found
scanmenus
Push "R0-R5,LR"
LDR R1,menuSP
CMP R1,#-4
Pull "R0-R5,PC",LE ; no menus active
Push "R4"
CMP R3,#0 ; is this a real window?
MOVGT R4,#-1 ; Fake system icon, to force task swap.
BLGT pageinicontask_R3R4 ; takes note of iconbar
Pull "R4"
BL findmenu ; R1 = index of current menu
BNE notinamenu
[ KeyboardMenus
Push "r0,r1"
ADD r14, sp, #8
LDMIA r14, {r0,r1}
LDR r14, lastxpos
TEQ r14, r0
LDREQ r14, lastypos
TEQEQ r14, r1
STRNE r0, lastxpos
STRNE r1, lastypos
Pull "r0,r1"
BEQ exitscanmenu
]
LDR R14,menuSP
CMP R1,R14 ; in top menu?
BEQ intopmenu
ADD R0,R1,#4
BL closemenus ; close down to one above
BVS exitscanmenu
ADR R14,menuselections
LDR R0,[R14,R1]
ADD R0,R0,R0,ASL #1 ; R0 <- R0 * 3
ADD R0,R0,#2 ; right-arrow icon
TEQ R0,R4 ; are we on the same icon?
BEQ notinamenu
Push "R0"
SWI XOS_ReadMonotonicTime
LDR R14,automenu_inactivetimeout
CMP R0,R14 ; if in inactive period, ignore right arrows
Pull "R0" ; preserving R0
BLO notinamenu
SUBS R14,R0,R4 ; if not, check for timeout anyway
BMI %FT01
CMP R14,#2
BGT %FT01 ; errr nigel?!?!?
LDRB R14,sysflags
TST R14,#sysflags_automenu ; automatic-menu opening enabled?
BEQ %FT01 ; no, so ignore
Push "R0"
SWI XOS_ReadMonotonicTime
LDR R14,automenu_timeouttime
CMP R0,R14 ; should I open the menu for them? (retard!)
Pull "R0"
MOVHI R4,R0
BHI notinamenu ; fake an arrow if so!
01
MOV R0,R1 ; close that menu too if nec.
BL closemenus
; in top menu - is it a dialogue box?
intopmenu
ADR R14,menudata ; <= maxhandle for dialogue box
LDR R14,[R14,R1]
TST R14,#3
BNE exitscanmenu ; Stop at the first dbox
; find out which icon we're over
MOVS R5,R4 ; R5 = icon handle
BMI notinamenu
MOV R1,#3
Push "R5"
DivRem R0,R5,R1, R14 ; get (icon/3)
Pull "R5"
BLVC trymenuhighlight ; R0 = selection index, R14=0 => shaded
BVS exitscanmenu ; only re-highlighted if different
; check for right-arrow icon (if traversal is allowed)
ADD R4,R0,R0,LSL #1 ; multiply by 3 again
ADD R4,R4,#2 ; R4 --> right-arrow
TEQ R4,R5 ; are we on the right-arrow?
BEQ %FT01 ; if not check for timeout anyway
Push "R14"
LDRB R2,sysflags
TST R2,#sysflags_automenu
Pull "R14",EQ ; if not auto menus then exit
BEQ exitscanmenu
Push "R0"
LDR R2,automenu_timeouttime
SWI XOS_ReadMonotonicTime ; get the timeout and the time
CMP R0,R2
Pull "R0,R14",LO ; restore *ALL* pushed registers
BLO exitscanmenu ; if within the timeout then handle, else expire
SWI XOS_ReadMonotonicTime
LDR R2,menudragdelay
ADD R0,R0,R2
STR R0,automenu_inactivetimeout
Pull "R0,R14"
01
ASSERT (mi_size=24)
ADR R2,menudata ; doesn't include header info
LDR R1,menuSP
LDR R2,[R2,R1]
ADD R2,R2,R4,LSL #3 ; R2 += R4 * 8 = 24*item + 16
TEQ R14,#0 ; EQ => menu item was shaded
LDREQ R14,[R2,#mi_mflags-16] ; can still traverse if menu flag set
TSTEQ R14,#mif_traverse
LDRNE R4,[R2,#mi_submenu-16] ; look at sub-menu item
CMPNE R4,#0 ; now EQ or CC => no submenu
BLE exitscanmenu ; no sub-menu!
; notify the 'Demo' module that something interesting is happening
BL mousetrap ; send round the mouse coords/time
; find out position of current menu
ADRVC R14,menuhandles
LDRVC handle,[R14,R1] ; R1=menu SP
BLVC checkhandle
BVS exitscanmenu
MOV R1,R4 ; data ptr
LDR R4,[R2,#mi_mflags-16] ; R4 = flags (now!)
[ Version < 311
LDR R2,[handle,#w_wax1] ; start at right of this menu
LDR R3,reversedmenu
TEQ R3,#"\"
LDREQ R2,[handle,#w_wax0]
|
LDR R2,[handle,#w_wax0] ; LH edge of window
LDR R3,reversedmenu
TEQ R3,#"\"
LDREQ R2,[handle,#w_wax0]
LDRNE R14,[handle,#w_icons] ; If not reversed menu find RH edge of arrow
BEQ %FT06
ADD R14,R14,#i_bbx1 ; menus are 0 1 2 but for auto menus
; 3 4 5 R5 -> icon 1 or 4 etc., RHS is 2,5..
LDR R3,[handle,#w_nicons]
SUB R3,R3,#1 ; icons start at 0
TEQ R3,R5 ; bottom right menu entry? no more icons then
LDREQ R14,[R14,R5,ASL #i_shift] ; get right hand edge of icon
BEQ %FT05
LDR R3,[R14,R5,ASL #i_shift]! ; get right hand edge of icon
Push R3
LDR R3,[R14,#i_flags+i_size-i_bbx1]
TST R3,#is_deleted ; next icon doesn't really exist
Pull R14,NE
BNE %FT05
Pull R3
LDR R14,[R14,#i_size] ; next icon
CMP R3,R14
MOVGT R14,R3 ; further right
05
ADD R2,R2,R14 ; get x coord
06
]
LDR R14,[handle,#w_icons]
ADD R14,R14,#i_bby1
LDR R3,[R14,R5,ASL #i_shift] ; get y offset
LDR R14,[handle,#w_way1]
ADD R3,R3,R14 ; get y coord
LDR R14,[handle,#w_scy]
SUB R3,R3,R14 ; it might have scrolled!
[ NCMenus
ADD r3, r3, #24 ; adjust for NCMenus border
]
; if warning bit set, we can only send back a message at this stage
TST R4,#mif_warning
BEQ go_openmenu
; the menu will be opened when the application calls Wimp_CreateMenu
BL sendmenuwarning
B exitscanmenu
sendmenuwarning
; In: r1 = menu handle
; r2 = x co-ordinate
; r3 = y co-ordinate
;
Push "r0-r5,lr"
; Message block format:
; menu data ptr, x, y
; list of menu selections so far (terminated by -1)
MOV R14,#nullptr
Push "R14" ; terminator
LDR R4,menuSP ; copy menu selections
ADR R5,menuselections ; into block on stack
01
LDR R14,[R5,R4]
Push "R14"
SUBS R4,R4,#4
BPL %BT01
Push "R1,R2,R3" ; menu handle, x, y
LDR R14,menuSP
ADD R0,R14,#ms_data+(4*3)+4+4 ; size of block (inc. -1)
ASSERT ms_yourref = 4*3
MOV R3,#0 ; no 'yourref' field
ASSERT ms_action = 4*4
LDR R4,=Message_MenuWarning ; &400C0 - Wimp's SWI range
ASSERT ms_data = 4*5
Push "R0-R4"
MOV R0,#User_Message
MOV R1,sp ; R1 --> block
LDR R2,menutaskhandle ; task handle of owner
BL int_sendmessage_fromwimp ; sender = task 0
LDR R14,[sp]
ADD sp,sp,R14 ; correct stack
Pull "r0-r5,pc",,^
LTORG
go_openmenu
LDR R14,menutaskhandle ; retain original task handle!
Task R14,,"CreateMenu"
BL int_create_menu
B exitscanmenu
notinamenu
LDR R1,menuSP
ADR R14,menuhandles
LDR handle,[R14,R1]
BL checkhandle
BVS exitscanmenu
[ :LNOT: KeyboardMenus
ADR R14,menuselections
LDR R4,[R14,R1]
MOV R0,#-1
STR R0,[R14,R1] ; cancel selection
ADDS R4,R4,R4,ASL #1 ; multiply by 3
ADDPL R4,R4,#1
BLPL deselecticon ; middle icon only
]
exitscanmenu
STRVS R0,[sp]
Pull "R0-R5,PC",VS
; If thing hanging off menu is dbox, then leave
LDR R1,whichmenu
CMP R1,#0
BLT %FT01
ADR R14,menudata
LDR R14,[R14,R1]
TST R14,#3
Pull "R0-R5",NE
BNE leavescan
01
Pull "R0-R5"
LDR R14,oldbuttons
BICS R14,R2,R14 ; look for positive edges
BEQ leavescan
CMP R4,#nullptr2 ; if in system area, allow through
BNE gomenuselect
LDR R14,whichmenu
CMP R14,#-4
BNE leavescan ; only if it's a menu!
gomenuselect
; now we have a mouse selection, or a click outside the menu structure
Push "R0-R4"
LDR R4,taskhandle ; R4 = previous task
LDR R14,menutaskhandle
Task R14,,"MenuClick" ; page in correct task
LDR R1,whichmenu ; index of current menu
CMP R1,#-4
Task R4,EQ,"ClickOutsideMenu"
[ :LNOT: StickyMenus
BEQ exittopoll ; not a menu window
|
BNE %FT05
TST R2,#button_middle
BNE exittopoll
LDR R14,[sp,#12] ; R3
Abs R14,R14
LDR R14,[R14,#w_flags]
TST R14,#wf_backwindow
BNE exittopoll
LDR R14,taskhandle
LDR R0,menutaskhandle
TEQ R0,R14
BEQ exittopoll
Pull "R0-R4"
B leavescan
05
]
ADR R14,menuhandles
LDR handle,[R14,R1]
BL checkhandle ; get handle of 'whichmenu' window
BVS longjumpexit
ADR R14,menuselections ; get middle icon of trio
LDR R4,[R14,R1]
ADDS R4,R4,R4,ASL #1 ; multiply by 3
BMI clickongreyitem ; looks at button state
LDR R14,[handle,#w_icons]
ADD R14,R14,#i_flags
LDR R14,[R14,R4,LSL #i_shift]
TST R14,#is_shaded ; can't select grey items
BNE clickongreyitem
ADDPL R4,R4,#1 ; and add 1
BLPL woggleicon ; flashy graphics (if icon selected)
BVS longjumpexit
MOV R0,#0
ADR R14,menuselections
copymlp
LDR R2,[R14,R0]
STR R2,[userblk,R0]
ADD R0,R0,#4
CMP R0,R1
BLE copymlp
MOV R2,#-1
STR R2,[userblk,R0] ; stick terminator in at end
LDR R14,singletaskhandle
CMP R14,#0
MOV R0,#-4 ; mark temporary (Poll kills menus)
STRLE R0,menus_temporary
BLGT closemenus ; close immediately if old-style task!
longjumpexit
LDR R13,longjumpSP ; set up on entry to Wimp
MOVVC R0,#Menu_Select
B ExitPoll ; go for it!
; SELECT on grey item => close menu tree, suppressing mouse click
; ADJUST on grey item => do nothing
clickongreyitem
TST R2,#button_right
Pull "R0-R4",NE ; ignore right-clicks on grey items
BNE leavescan
MOV R14,#nullptr
STR R14,[sp,#3*4] ; fake window handle -1 to suppress click
;;;;;;;;B exittopoll ; then drop through
; when closing the menu tree, send Message_MenusDeleted
; R3 = relative handle of menu here
exittopoll
BLVC menusdeleted ; send Message_MenusDeleted
MOVVC R0,#-4
BLVC closemenus ; delete all menus
STRVS R0,[sp]
Pull "R0-R4"
leavescan
Debug xx,"Registers on exit from scanmenus =",R0,R1,R2,R3,R4
Pull "PC",VS
MOVS handle,R3 ; can't rely on absolute handle!
BLPL checkhandle
Pull "PC"
; extra entry point for <cr> in writable menu
crmenuselection
MOV R1,#3
Push "R4"
DivRem R0,R4,R1, R14 ; R0 = R4 (icon) / 3
Pull "R4"
BVS longjumpexit
LDR R1,whichmenu
ADR R14,menuselections
STR R0,[R14,R1]
B gomenuselect
woggleicon
Push "R3,LR"
MOV R3,#6 ; 6 times!
woglp
Push "R1-R4"
MOV R0,#19 ; wait for vsync
SWI XOS_Byte
SWIVC XOS_Byte ; (twice)
MOVVC R0,R4
MOVVC R1,#is_inverted
MOVVC R2,#0
BLVC int_set_icon_state
Pull "R1-R4"
Pull "R3,PC",VS ; error
SUBS R3,R3,#1
BNE woglp
Pull "R3,PC"
deselecticon
Push "R1-R4,LR"
MOV R0,R4
MOV R1,#0
MOV R2,#is_inverted
BL int_set_icon_state
Pull "R1-R4,PC"
;;----------------------------------------------------------------------------
;; Read current state of menu tree (or a subset)
;; Entry: R0 = 0 => return full state of menu tree
;; R0 = 1 => return menu tree up to specified window/icon
;; R1 -> buffer to contain result
;; R2 = window handle (if R0=1)
;; R3 = icon handle (if R0=1)
;; Exit: [R1..] = list of items selected (cf. Menu_Select event)
;; The tree is null if R1=1 and the window is not in the menu tree
;;----------------------------------------------------------------------------
; userblk = R1 on entry as well here
SWIWimp_GetMenuState
MyEntry "GetMenuState"
CMP R0,#1
BHI err_badR0 ; return error
MOVNE R2,#nullptr ; don't try to match if R0=0
; don't allow tasks other than the menu owner to see the list
LDR R4,taskhandle
LDR R5,menutaskhandle
TEQ R4,R5
BNE %FT03 ; this is the wrong task!
; translate icon handle -> selection index
ADR R4,menudata
LDR R5,menuSP
LDR R14,[R4,R5] ; if window = dbox,
TEQ R14,R2 ; icon is not a menu selection
MOVEQ R3,#-1
CMP R3,#0
MOVLT R5,#-1 ; system icon => no selection
BLT %FT01
MOV R4,#3
DivRem R5,R3,R4,R14 ; R5 = menu selection index of icon
01
; scan list of menus until the specified window is found
ADR R3,menuhandles
ADR R4,menuselections
LDR R6,menuSP
CMP R6,#0
BLT %FT03
02
LDR R14,[R3],#4 ; R14 = window handle for menu
TEQ R14,R2
STREQ R5,[R1],#4 ; selection index of icon
BEQ %FT03 ; found relevant window
LDR R14,[R4],#4 ; R14 = selection index
STR R14,[R1],#4
SUBS R6,R6,#4
BGE %BT02
TEQ R0,#1
MOVEQ R1,userblk ; window wasn't found
03
MOV R14,#-1
STR R14,[R1]
B ExitWimp
;;----------------------------------------------------------------------------
;; Give user some help in decoding menus
;; Entry: R1 --> menu structure
;; R2 --> list of items selected
;; R3 --> output buffer
;; Exit: R3 --> string of form <item>.<item>.<item> <cr>
;;----------------------------------------------------------------------------
SWIWimp_DecodeMenu
MyEntry "DecodeMenu"
MOV R4,R3 ; for testing for first item
decodemlp
LDR R0,[R2],#4 ; get item
CMP R0,#0
MOVMI R0,#cr
STRMIB R0,[R3]
BMI ExitWimp
ASSERT (mi_size=24)
ADD R0,R0,R0,ASL #1 ; R0 <-- R0 * 3
ADD R1,R1,#m_header+mi_submenu
ADD R1,R1,R0,ASL #3 ; R1 <-- R1+28+4+24*R0
LDR R14,[R1],#mi_iflags-mi_submenu ; R14 <-- submenu pointer
Push "R14"
LDR R14,[R1],#mi_idata-mi_iflags ; R14 <-- icon flag word
TST R14,#if_indirected
MOVEQ R5,#12-1 ; data size = 12 if not indirected
LDRNE R5,[R1,#8]
LDRNE R1,[R1] ; indirect if nec.
CMP R3,R4 ; first item?
MOVNE R14,#"."
STRNEB R14,[R3],#1 ; put in separator
cpdcmlp
LDRB R0,[R1],#1
CMP R0,#32
STRCSB R0,[R3],#1
SUBCSS R5,R5,#1 ; watch for max no of chars
BCS cpdcmlp
Pull "R1" ; submenu pointer
B decodemlp
[ outlinefont
;---------------------------------------------------------------------------
; Stuff for parsing menu entries and justifying the keyboad shortcut
;---------------------------------------------------------------------------
; menu_entry: character_sequence SPACE shortcut;
; shortcut: modifier_option keyname |
; modifier non_space_character |
; modifier;
fixupfontstring TraceL menuw
; Entry
; R1 -> string to be passed to Font_Paint (0-terminated with font-
; change sequences)
; R2 -> menu entry (the same text, but control-terminated with arrow
; characters)
; R3 = maximum index of menu entry
; Exit
; all preserved
; The Font_Paint string has had spaces replaced by hard spaces, where
; necessary.
; Replaces all the spaces in the Font_Paint string with hard spaces, except
; that if there is a shortcut present, the space before the shortcut is left
; alone. This allows Font_Paint to stretch that space only, and justify the
; text correctly.
Push "R0, R3-R5, LR"
BL isthereashortcut
; R0 != Null (if there is a shortcut)
; = Null (otherwise)
;Remember where the last space (that counts) was.
MOV R3, #0
MOV R5, #0
; R3 = index into string
; R5 = index of last space
fixupfontstring_loop
LDRB R4, [R1, R3]
; R4 = current character
TEQ R4, #:CHR: 0
BEQ fixupfontstring_end ;end of string
TEQ R4, #:CHR: 26 ;Font_CommandFont
ADDEQ R3, R3, #2 ;skip font change sequence
BEQ fixupfontstring_loop
TEQ R4, #" "
MOVEQ R5, R3 ;remember last space
MOVEQ R4, #&A0 ;hard space
STREQB R4, [R1, R3]
ADD R3, R3, #1
B fixupfontstring_loop
fixupfontstring_end
;If there was a shortcut in the menu entry, replace the last (hard)
; space in the Font_Paint string with a soft one, and also
; plot to the end of the string, so that Font_Paint works.
TEQ R0, #0
BEQ fixupfontstring_finish
MOV R0, #" "
STRB R0, [R1, R5]
Push R1
MOV R0, #4 ;Move to
LDR R1, redrawhandle
BIC R1, R1, #3
LDR R1, [R1, #w_x1]
SUB R1, R1, #24 + 16 ;width of arrow + fudge factor
TraceK menuw, "fixupfontstring: moving to ("
TraceD menuw, R1
TraceK menuw, ", "
TraceD menuw, R2
TraceK menuw, ")"
TraceNL menuw
SWI XOS_Plot
Pull R1
fixupfontstring_finish
Pull "R0, R3-R5, PC",, ^
;---------------------------------------------------------------------------
isthereashortcut TraceL menuw
; Entry
; R2 -> icon text
; R3 = maximum index of menu entry
; Exit
; R0 -> SPACE (if there is a shortcut)
; = Null (otherwise)
; all others preserved
Trace menuw, "isthereashortcut: ", S, R2
Trace menuw, "max index is ", D, R3
Push "R1-R6, LR"
;Find the last space in the text
MOV R0, #0
MOV R4, #0
; R0 -> last space found (Null if none found)
; R4 = index into string
isthereashortcut_loop ;what an astonishing piece of code
CMP R3, R4
LDRGEB R6, [R2, R4]
; R6 = current character in icon
CMPGE R6, #" "
ADDEQ R0, R2, R4
ADDGE R4, R4, #1
BGE isthereashortcut_loop
; R0 -> last space in icon text
; R4 = length of text
;Any spaces at all?
TEQ R0, #0
BEQ isthereashortcut_exit
;Find longest modifer at R0
MOV R5, R0
; R5 -> last space in icon text
ADD R0, R0, #1
; R0 -> shortcut candidate (we just skipped the space)
;R3 := R2 + R4 - R0
ADD R3, R2, R4
SUB R3, R3, R0
; R3 = length of shortcut candidate
;The parser
ADR R1, isthereashortcut_modifiers
BL spanlongestelement
ADR R1, isthereashortcut_keynames
BEQ isthereashortcut_modifier_present
BL spanlongestelement
TEQEQ R3, #0
B isthereashortcut_parsed
isthereashortcut_modifier_present
[ false ; MED-01910, Z already set
TEQ R3, #0
TEQNE R3, #1
TEQNE R3, #2
]
BEQ isthereashortcut_parsed
BL spanlongestelement
TEQEQ R3, #0
isthereashortcut_parsed
;Z is set iff shortcut is (Modifier, KeyName), KeyName, Modifier or
; (Modifier, character).
MOVNE R0, #0
MOVEQ R0, R5
; R0 -> space before shortcut (if there was one)
; = Null (otherwise)
isthereashortcut_exit
Trace menuw, "isthereashortcut: returns space pointer ", X, R0
Pull "R1-R6, PC",, ^
isthereashortcut_modifiers
= "Modifiers", 0
isthereashortcut_keynames
= "KeyNames", 0
ALIGN
;---------------------------------------------------------------------------
spanlongestelement
; Entry
; R0 -> shortcut candidate
; R1 -> MessageTrans token
; R3 = shortcut length
; Exit (if a match was found)
; Z set ("EQ")
; R0 -> text after token
; R3 = remaining length
; all others preserved
; (otherwise)
; Z clear ("NE")
; all preserved
Push "R1-R2, R4-R7, LR"
;Translate R1
Push "R0, R3"
BL GetMessages
; R0 -> 16-byte block for MessageTrans
MOV R2, #0
MOV R3, #0
MOV R4, #0
MOV R5, #0
MOV R6, #0
MOV R7, #0
SWI XMessageTrans_Lookup
MOV R1, R2
Pull "R0, R3"
; R1 -> list of allowable tokens
MOV R2, #0
; R2 = best length so far
;Loop over each of the tokens in the list.
spanlongestelement_loop
; R1 -> token to check for (terminated by space or control character)
MOV R4, #0
MOV R5, #TRUE
; R4 = index into token and shortcut
; R5 = whether strings match so far
;Loop over the characters in the token
spanlongestelement_loop1
CMP R4, R3
BGE spanlongestelement_end1 ;shortcut length exceeded
LDRB R6, [R1, R4]
; R6 = current character in current token
CMP R6, #" "
BLE spanlongestelement_end1 ;list exhausted
LDRB R7, [R0, R4]
; R7 = current character in shortcut
TEQ R6, R7 ;this gives a case-sensitive search
MOVNE R5, #FALSE
BNE spanlongestelement_end1 ;no match
ADD R4, R4, #1
B spanlongestelement_loop1
spanlongestelement_end1
;We are interested only in cases where the complete token is
; matched.
LDRB R6, [R1, R4]
CMP R6, #" "
MOVGT R5, #FALSE
CMP R5, #FALSE
CMPNE R2, R4
MOVLT R2, R4 ;set the max length if this is the longest so far
;Move on to the next token in the list. First, skip the characters
; of the token.
spanlongestelement_loop2
LDRB R6, [R1, #0]
; R6 = current character
CMP R6, #" "
ADDGT R1, R1, #1
BGT spanlongestelement_loop2
;Then skip the spaces that follow it.
spanlongestelement_loop3
LDRB R6, [R1, #0]
; R6 = current character
CMP R6, #" "
ADDEQ R1, R1, #1
BEQ spanlongestelement_loop3
;If the character R6 is a control character, the list is exhausted.
; Otherwise, try the next token in the list
BGT spanlongestelement_loop
;Set up exit conditions.
ADD R0, R0, R2
SUB R3, R3, R2
;Set Z depending on R2, but the other way up.
TEQ R2, #0
MOVNE R2, #0
MOVEQ R2, #1
TEQ R2, #0
;good grief!
TraceK menuw, "spanlongestelement: returning pointer to "
TraceS menuw, R0
TraceK menuw, ", length "
TraceD menuw, R3
TraceNL menuw
Pull "R1-R2, R4-R7, PC"
]
END