; 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
        AcceptLoosePointer_NegOrZero R0,nullptr
        CMP     R0,#nullptr             ; any window selected?
        BEQ     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
        MOV     R14,#nullptr
        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'

        AcceptLoosePointer_NegOrZero R0,nullptr
        CMP     R0,#nullptr     ; CLR V ; no caret at all
        BEQ     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,#sc_red                      ; 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)
        ADRL    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
        EntryS  "R0,R2,R3"

        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, #Proc_RegOffset]
        EXIT
        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
        EXITS

;..............................................................................

SWIWimp_GetCaretPosition
        MyEntry "GetCaretPosition"
      [ CnP
        LDR     R14, taskidentifier4
        TEQ     R2, R14                 ; = "TASK" ?
        MOVEQ   R14, #0
        STREQ   R14, [sp, #1*4]         ; R2 on exit = 0
        MOVNE   R0, #0                  ; always return caret data if not special

        TEQ     R0, #1
        BEQ     int_get_ghost_caret_position
        TEQ     R0, #2
        BEQ     int_get_selection_position
        TEQ     R0, #0
        BNE     ExitWimp
int_get_caret_poition
      ]
        ADR     R14,caretdata
        LDMIA   R14,{R0-R5}
        STMIA   userblk,{R0-R5}
        B       ExitWimp

      [ CnP
int_get_ghost_caret_position
        ADRL    R14, ghostcaretdata
        LDMIA   R14, {R0-R5}
        STMIA   userblk, {R0-R5}
        B       ExitWimp

int_get_selection_position
        CMP     R3, #nullptr
        MOVNE   handle, R3
        LDREQ   handle, selectionwindow

        CMP     handle, #nullptr        ; no unshaded selection?
        STREQ   handle, [userblk]
        BEQ     ExitWimp

        BL      checkhandle_iconbar
        BVS     ExitWimp

        MOV     R0, R3
        ADD     handle, handle, #w_seldata
        LDMIA   handle, {R1-R7}
        CMP     R1, #nullptr            ; no selected icon in this window?
        MOVEQ   R0, R1
        STMIA   userblk, {R0-R7}
        B       ExitWimp

taskidentifier4 DCB     "TASK"
      ]

;-----------------------------------------------------------------------------
; Send a message to the relevant task whenever the caret window changes
;-----------------------------------------------------------------------------

send_losecaret
        EntryS  "R0-R2,handle"
        MOV     R0,#Lose_Caret
        B       %FT01

send_gaincaret
        ALTENTRY
        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
        EXITS                                   ; 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,#nullptr
        MOVEQ   PC,LR
        CMP     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
        MOVVS   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,#nullptr             ; forget it if not inside an icon
        MOVEQ   PC,LR
        CMP     R1,#0
        MOVLT   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

      [ UTF8
        Push    "R2"
      ]
      [ CnP
        MOV     R7, #nullptr
      ]
        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

      [ UTF8
; R4 = number of *characters*, we want *byte* index into *original* string to put in R5

        Pull    "R7"        ; get pointer to original icon text pushed above
        Push    "R2"        ; we will be corrupting R2

        BL      read_current_alphabet
        MOVNE   R5, R4
        BNE     %FT01       ; in non-UTF-8 alphabets, 1 character = 1 byte

        MOV     R6, #bignum ; we're not expecting to reach the end anyway
        MOV     R2, R7

03      CMP     R4, #0
        BLE     %FT02
        BL      skipcharR
        SUB     R4, R4, #1
        B       %BT03

02      SUB     R5, R2, R7
01
        Pull    "R2"
      |
        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

        AcceptLoosePointer_NegOrZero R0,nullptr
        CMP     R0,#nullptr             ; can't do it if no icon
        MOVEQ   PC,LR
        CMP     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"
      [ CnP
        MOV     R7, #nullptr
      ]
        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 bytes) to a
        ;       string index

      [ UTF8
        ; R5 = bytes into original string
        ; We need R5 = bytes into pushed string
        ; In addition to skipping font-setting commands, we now also have to contend with cases
        ; where the same characters are different sizes in the two strings (ie when passworded)
        Push    "R2-R4,R6"
        ADD     R4, R2, R5              ; -> caret position in original string
        MOV     R3, #-1                 ; character count
        MOV     R6, #6                  ; not bothered about buffer space
        ; Count characters in original string
01      CMP     R2, R4
        BGT     %FT02                   ; past the caret point? don't count the partial character (matches font mgr)
        ADD     R3, R3, #1
        BEQ     %FT02                   ; at the caret point?
        LDRB    R14, [R2]               ; reached terminator before byte count?
        CMP     R14, #' '               ;   yes, don't increment R3 any more (avoids infinite loop here in UTF8 case
        BLO     %FT02                   ;   and running off the top of the SVC stack below in non-UTF8 case)
        BL      skipcharR
        B       %BT01
02      ; Now have R3 = printable character count, find that byte index into pushed string
        LDRB    R2, alphabet
        MOV     R5, #0                  ; start at index 0
01      CMP     R3, #0
        BLE     %FT02                   ; break if we've got to the right position
        TEQ     R2, #ISOAlphabet_UTF8
        MOVNE   R4, #1                  ; \ non UTF-8 read
        LDRNEB  R6, [R1, R5]            ; /
        MOVEQ   R4, #6                  ; \.
        ADDEQ   R6, R1, R5              ;  > UTF-8 read
        BLEQ    convert_UTF8_to_UCS4    ; /
        CMP     R6, #26                 ; font change command?
        ADDEQ   R5, R5, #2              ; skip 2 bytes of pushed string if so
      [ CnP
        CMP     R6, #19                 ; colour change command?
        ADDEQ   R5, R5, #8              ; skip 8 bytes of pushed string if so
;        CMP     R6, #19
        CMPNE   R6, #26
      ]
        ADDNE   R5, R5, R4              ; else skip character in pushed string, and decrement character count
        SUBNE   R3, R3, #1
        B       %BT01
02      ; R5 now correctly set
        Pull    "R2-R4,R6"

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

        Debug   key,"ProcessKey:",R6

      [ :LNOT: UTF8
        ADR     R14,caretdata
        LDMIA   R14,{R0-R5}
      ]  ; not needed, because we won't be calling WriteableKey directly any more

        LDR     R14,singletaskhandle    ; don't muck about if single task
        CMP     R14,#nullptr
        BNE     defaultkey

        LDR     R14,hotkeyptr
        Debug   key,"HotKeyPtr",R14

        CMP     R14,#0
        BGT     sendhotkey              ; try hot keys if hotkeyptr is already set up

      [ true ; BJGA bugfix: don't crash if lowest iconised window calls Wimp_ProcessKey
        CMP     R14, #nullptr
        BEQ     defaultkey
      ]

      [ UTF8
        ; No Key_Pressed/ProcessKey sequence currently active => task is initiating keypress
        ; We now need to cache these, and let the trykeys code validate them during Wimp_Poll
        ; This also provides the advantage that Wimp_ProcessKey 13 can activate writable menu items at last!
        CMP     R6, #0
        CMPNE   R6, #&100
        MOVLO   R0, #1
        MOVHS   R0, #2
        ANDHS   R5, R6, #&FF
        MOVHS   R6, #0
        ; R0 = number of bytes to insert into keyprocess_buffer
        ; R6 = first byte
        ; R5 = second byte (if applicable)
        LDRB    R3, keyprocess_buflen
        RSB     R4, R3, #?keyprocess_buffer  ; R4 = space in buffer
        CMP     R4, R0
        Pull    "R1-R6,handle,PC", LO   ; bail out if it won't fit

        ADR     R4, keyprocess_buffer
        ADD     R4, R4, R3              ; -> position to insert byte(s) at
        TEQ     R0, #2
        STRB    R6, [R4], #1            ; insert byte(s)
        STREQB  R5, [R4], #1
        ADD     R3, R3, R0
        STRB    R3, keyprocess_buflen   ; update byte count
        Pull    "R1-R6,handle,PC"

      |

        MOV     handle,R0
        CMP     handle,#nullptr
        BL      topmost_window
        STR     R0,hotkeyptr
        BEQ     sendhotkey              ; if no input focus, just try hot keys

        CMP     R1,#0
        BLT     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

      ]

      [ UTF8
        ADRL    R14, savedcaretdata
      |
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 (R1 corrupted)
;        R2 always corrupted
        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,#nullptr
        BEQ     %FT01

        BL      checkhandle             ; handle -> window block
      [ PoppingIconBar :LAND: :LNOT: OldStyleIconBar
        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,#nullptr            ; (if the caret is in a writable icon)
        BEQ     %FT01
        LDR     R14,caretdata+4
        CMP     R14,#0
        BGE     %FT02
01
        Pull    "R1-R6,handle,PC"
02
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
      [ UTF8
        ; Again, this now needs to be fed through the cacheing and validating routines in trykeys
        ; This is done by copying into keystring_buffer, but substituting each null byte with two null bytes
        TEQ     R2, #0
        BEQ     %FT99
        ADD     R2, R1, R2              ; end of source
        ADR     R3, keystring_buffer    ; start of dest buffer
        ADD     R4, R3, #?keystring_buffer ; end of dest buffer
01      LDRB    R0, [R1], #1
        TEQ     R0, #0
        MOVEQ   R0, #&100               ; STRBs the same as 0, but flagged as first of two
02      STRB    R0, [R3], #1
        CMP     R3, R4
        BGE     %FT03                   ; break if we reach the end of dest buffer
        TEQ     R0, #&100
        MOVEQ   R0, #0
        BEQ     %BT02                   ; if first of two, jump back into middle of loop for next byte
        CMP     R1, R2
        BLT     %BT01                   ; loop if there's still stuff left

03      ADR     R14, keystring_buffer
        SUB     R3, R3, R14             ; number of bytes put into keystring_buffer
        STRB    R3, keystring_buflen

      |
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 (internal Wimp keycode)
;-----------------------------------------------------------------------------

processkey
        Debug   key,"processkey: window, icon",R0,R1

        BL      WriteableKey
        BVS     ExitPoll

      [ UTF8
        TEQ     R0, #No_Reason          ; key already processed
        BEQ     trykeys                 ; softkey expansion means there may well be more characters to process

        TEQ     R0, #Key_Pressed
        ADREQL  R14, savedcaretdata
        LDMEQIA R14, {R0-R5}
        BEQ     keypressed              ; validation string requires this to be returned to input focus owner

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

      [ :LNOT: UTF8
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

      [ UTF8
        BLVC    read_current_alphabet
      ]
        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
; R2 --> string
; R3 --> validation string (<=0 ==> none)
; R4 --> end of string + 1
; R5 = index to current caret position
; R6 = internal keycode to process
; R7 = max buffer size

      [ :LNOT: UTF8  ; done in trykeys now
        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

        TEQ     R6,#&0D
        BEQ     isreturn

        CMP     R6,#32
        BCC     passbacktouser
      [ UTF8
        TST     R6, #1:SHL:31
        BEQ     isachar

        BIC     R14, R6, #1:SHL:31
      |
        CMP     R6,#&100
        BCC     isachar

        SUB     R14,R6,#&100
      ]

        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)

        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
        BLO     %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
        BLO     %BT10                           ; if not then we need to loop back again

        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

;..............................................................................

; 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
        BHS     %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
        MOVLO   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)

        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
        BLO     %BT10                           ; if not then we need to loop back again

        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

        B       movecarettofield                ; posn the caret in the icon



; insert character into buffer, unless validation string forbids it

isachar
; Entry: R1  = icon handle
;        R2 -> icon's text buffer
;        R3 -> validation string
;        R4 -> byte after terminator
;        R5  = current caret index
;        R6  = internal keycode
;        R7  = buffer length
      [ UTF8
        LDRB    R14, alphabet
        TEQ     R14, #ISOAlphabet_UTF8
        ; If not UTF-8, then internal keycode is treated as one byte
        STRNEB  R6, tempworkspace
        MOVNE   R1, R4
        MOVNE   R4, #1
        BNE     %FT01
        ; Else do it the hard way
        Push    "R4,R5"
        ADR     R5, tempworkspace
        BL      convert_UCS4_to_UTF8    ; R4 = bytes used by character in UTF-8 form
        Pull    "R1,R5"

        ; Check buffer space
01      ADD     R0, R2, R7
        SUB     R0, R0, R1              ; R0 = space left in buffer
        CMP     R0, R4                  ; would the character fit?
        BLO     exitprocess

        ; Check character count
        Push    "R1-R3,R6"
        AcceptLoosePointer_NegOrZero R3,-1
        CMP     R3, R3, ASR #31         ; is there a validation string?
        BEQ     %FT04
        MOV     R2, #WimpValidation_CharLimit  ; find "U" command, if any
        BL      findcommand
        BNE     %FT04
        MOV     R0, #10
        MOV     R1, R3                  ; R2 is fine as it is
        SWI     XOS_ReadUnsigned
        BVS     %FT04
        MOV     R7, R2
        MOV     R0, #0                  ; character count
        pullx   "R1,R2"                 ; retrieve R1 and R2 from stack
        SUB     R1, R1, #1              ; -> terminator character
        MOV     R6, #6                  ; no limit to bytes to consider, we're checking terminator ourselves
02      CMP     R2, R1
        BGE     %FT03                   ; break if we've reached terminator
        BL      skipcharR               ; move R2 to next character boundary
        ADD     R0, R0, #1              ; increment count
        B       %BT02
03      CMP     R0, R7                  ; are characters already at or above character limit?
        Pull    "R1-R3, R6", GE
        BGE     exitprocess
04
        Pull    "R1-R3,R6"

        ; Check allowed in this icon
        BL      checkvalid              ; Z set --> char is valid
        BNE     backtouser              ; always report characters masked out by (A)llow command

        ; All okay - insert byte(s)
        ; R1 -> byte after terminator
        ; R2 -> icon's text buffer
        ; R4  = number of bytes to insert
        ; R5  = current caret index
        ADD     R5, R2, R5              ; -> insertion point
        SUB     R1, R1, #1
        ADD     R1, R1, R4              ; -> "after" position of terminator
inslp1  LDRB    R0, [R1, -R4]
        STRB    R0, [R1], #-1           ; copy byte up
        CMP     R1, R5
        BGT     inslp1

        MOV     R6, R4                  ; remember number of bytes inserted
        ADR     R3, tempworkspace
inslp2  LDRB    R0, [R3], #1
        STRB    R0, [R5], #1            ; copy byte over
        SUBS    R4, R4, #1
        BGT     inslp2

      |
        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]
        AcceptLoosePointer_NegOrZero R3,-1
        CMP     R3,R3,ASR #31
        BEQ     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]
      [ UTF8
        MOV     R0,#Key_Pressed
      |
        MOV     R0,#Key_PressedOldData
      ]
        Pull    "PC"

; unreachable code!
;        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"


isreturn
        Push    "R1-R7"
        AcceptLoosePointer_NegOrZero R3,-1
        CMP     R3,R3,ASR #31
        BEQ     %FT02                   ; 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
02      CMP     pc,#0                   ; clear Z
        B       %BT01

downarrow
        Push    "R1-R7"                 ; balance with Pull in checkmenuupdown
 [ KeyboardMenus
        MOV     r6, #138
        BL      checkmenuupdown         ; will not return if key handled
 ]
        AcceptLoosePointer_NegOrZero R3,-1
        CMP     R3,R3,ASR #31
        BEQ     %FT02                   ; 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
02      CMP     pc,#0                   ; clear Z
        B       %BT01

uparrow
        Push    "R1-R7"                 ; balance with Pull in checkmenuupdown
 [ KeyboardMenus
        MOV     r6, #139
        BL      checkmenuupdown         ; will not return if key handled
 ]
        AcceptLoosePointer_NegOrZero R3,-1
        CMP     R3,R3,ASR #31
        BEQ     %FT02                   ; 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
02      CMP     pc,#0                   ; clear Z
        B       %BT01

 [ 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"
        AcceptLoosePointer_NegOrZero R3,-1
        CMP     R3,R3,ASR #31
        BEQ     %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"
        AcceptLoosePointer_NegOrZero R3,-1
        CMP     R3,R3,ASR #31
        BEQ     %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
      [ UTF8
        CMP     R5, #0
        BLE     exitprocess             ; if already at start, do nothing

        Push    "R6"
        MOV     R6, R5
        ADD     R2, R2, R5
        MOV     R7, R2                  ; remember original pointer
        BL      skipcharL
        SUB     R7, R2, R7              ; distance to copy down by (negative)

dellp   LDRB    R0, [R2, -R7]           ; copy down
        STRB    R0, [R2], #1
        CMP     R0, #' '
        BGE     dellp

        Push    "R0-R5"
        MOV     R6, R7                  ; move caret back by appropriate number of bytes
      |
        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

        Push    "R0-R6"
        MOV     R6,#-1                  ; move back 1 char
      ]
        BL      int_donechar
        LDMIA   SP,{R0-R6}
        Debug   val,"donechar"
        AcceptLoosePointer_NegOrZero R3,-1
        CMP     R3,R3,ASR #31
        BEQ     %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


; delete (forwards)


iscopy
      [ false
        LDR     R14,writeabledir
        CMP     R14,#0
        BNE     int_isdelete
      ]
int_iscopy
      [ UTF8
        Push    "R6"
        SUB     R6, R4, R2              ; index just past terminator
        SUB     R6, R6, #1              ; length of the string
        SUBS    R6, R6, R5              ; distance to end of string - if any
        Pull    "R6", LE
        BLE     exitprocess             ; do nothing if we're at the end already

        ADD     R2, R2, R5
        MOV     R7, R2                  ; remember original pointer
        BL      skipcharR
        SUB     R2, R2, R7              ; distance to copy down by (positive)

dellp2  LDRB    R0, [R7, R2]            ; copy down
        STRB    R0, [R7], #1
        CMP     R0, #' '
        BGE     dellp2

        Push    "R0-R5"
      |
        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

        Push    "R0-R6"
      ]
        MOV     R6,#0                   ; no movement
        BL      int_donechar
        LDMIA   SP,{R0-R6}
        AcceptLoosePointer_NegOrZero R3,-1
        CMP     R3,R3,ASR #31
        BEQ     %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

shiftcopy
        ADD     R7,R2,R5                ; remember old position
        LDRB    R0,[R7]
        CMP     R0,#32
      [ true  ; I think this should be exitprocess, to match the others - BJGA 16-Oct-1998
        BCC     exitprocess
      |
        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
        Push    "R0-R6"
        MOV     R6,#0                   ; no movement
        BL      int_donechar
        LDMIA   SP,{R0-R6}
        AcceptLoosePointer_NegOrZero R3,-1
        CMP     R3,R3,ASR #31
        BEQ     %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

ctrlU
        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
        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
        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
        Push    "R0-R5"
        BL      int_donechar            ; R6 set up earlier
        LDMIA   SP,{R0-R6}
        AcceptLoosePointer_NegOrZero R3,-1
        CMP     R3,R3,ASR #31
        BEQ     %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


; move left

isleftarrow
        LDR     R14,writeabledir
        CMP     R14,#0
        BNE     int_isrightarrow

int_isleftarrow
    [ UTF8
        MOVS    R6, R5                  ; if already at start, don't try to move caret left
        BEQ     %FT01
        MOV     R7, R2                  ; remember start of buffer
        ADD     R2, R2, R5
        BL      skipcharL
        SUB     R5, R2, R7              ; convert back to offset
        B       donearrow

01
      [ KeyboardMenus
        LDR     r0, menuSP
        SUBS    r0, r0, #4
        BLGE    closemenus
      ]
        B       exitprocess
    |
        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
      [ true  ; I think this should be exitprocess, to match the others - BJGA 16-Oct-1998
        BEQ     exitprocess
      |
        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)
      [ UTF8
        SUB     R6, R6, #1              ; length of the string
        SUBS    R6, R6, R5              ; distance to end of string - if any
        BLE     exitprocess
        MOV     R7, R2                  ; remember start of buffer
        ADD     R2, R2, R5
        BL      skipcharR
        SUB     R5, R2, R7              ; convert back to offset
        B       donearrow
      |
        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
      [ true  ; I think this should be exitprocess, to match the others - BJGA 16-Oct-1998
        BCC     exitprocess
      |
        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


 [ DotsAsWordSeparators
skipwordR
        LDRB    R0,[R2,R5]              ; skip non-space and not '.'
        CMP     R0,#' '
	MOVLO	PC,LR

	TEQNE	R0,#'.'
        ADDNE   R5,R5,#1
        BNE     skipwordR

skipwordR2
        LDRB    R0,[R2,R5]
        CMP     R0,#' '
	MOVLO	PC,LR

	TEQNE	R0,#'.'
        ADDEQ   R5,R5,#1                ; stop on first non-space char
        BEQ     skipwordR2
        MOV     PC,LR

skipwordL
        TEQ     R5,#0			; skip spaces and dots left
        MOVEQ   PC,LR                   ; done
        SUB     R5,R5,#1
        LDRB    R0,[R2,R5]
        TEQ     R0,#' '
	TEQNE	R0,#'.'
        BEQ     skipwordL

skipwordL2
        TEQ     R5,#0			; skip non space non dot left
        MOVEQ   PC,LR
        SUB     R5,R5,#1
        LDRB    R0,[R2,R5]
        TEQ     R0,#' '
	TEQNE	R0,#'.'
        BNE     skipwordL2
        ADDEQ   R5,R5,#1                ; back to last non-space char
        MOV     PC,LR
 |
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
 ]


      [ UTF8
; Routines to skip a character right or left
; Entry: R2 -> starting position
;        R6 = max byte distance allowed (always +ve)
;        alphabet = alphabet number
; Exit:  R2 updated

skipcharL
        Entry   "R0,R1,R3-R6"
        ; Deal with trivial cases first
        CMP     R6, #0
        EXIT    LE
        LDRB    R0, alphabet
        TEQ     R0, #ISOAlphabet_UTF8
        SUBNE   R2, R2, #1
        EXIT    NE

        SUB     R5, R2, R6    ; buffer limit
        SUB     R5, R5, #1    ; 1 byte before it (compensates for writeback)
        MOV     R6, R2        ; remember starting position

        MOV     R3, #1:SHL:31 ; top byte is initial byte we'd expect at current position
        MOV     R4, #&3F      ; to mask out data bits of the initial byte we'd expect here

01      LDRB    R0, [R2, #-1]!
        CMP     R2, R5        ; if we reached the beginning of the buffer
        TSTNE   R0, #&80      ; or an ASCII byte
        TEQNE   R0, #&FE      ; or special cases &FE and &FF (both 1-byte wide malformed characters)
        TEQNE   R0, #&FF
        SUBEQ   R2, R6, #1
        EXIT    EQ            ; then we only step back one byte from where we started

        AND     R1, R0, #&C0
        TEQ     R1, #&80      ; was is a continuation byte?
        MOVEQ   R3, R3, ASR#1
        MOVEQ   R4, R4, LSR#1
        BEQ     %BT01         ; loop if so

        BIC     R1, R0, R4
        CMP     R3, R1, LSL#24
        SUBHI   R2, R6, #1    ; if the character doesn't stretch to our starting point, only step back one byte

        EXIT                  ; otherwise leave R2 where it is

skipcharR
        Entry   "R0,R1,R6"
        ; Deal with trivial cases first
        CMP     R6, #0
        EXIT    LE
        LDRB    R0, alphabet
        TEQ     R0, #ISOAlphabet_UTF8
        ADDNE   R2, R2, #1
        EXIT    NE

        ; Determine maximum character size, according to first byte
        LDRB    R0, [R2]
        BL      estimate_UTF8_char_len
        CMP     R1, R6
        MOVLT   R6, R1        ; R6 = min (R1, R6)

        CMP     R6, #1
        ADDLE   R2, R2, R6
        EXIT    LE            ; 0- and 1-byte cases require no further checks

        SUB     R6, R6, #1    ; now holds the expected number of continuation bytes
01      LDRB    R0, [R2, #1]!
        AND     R0, R0, #&C0
        TEQ     R0, #&80      ; is it a continuation byte?
        EXIT    NE
        SUBS    R6, R6, #1
        BNE     %BT01
        ADD     R2, R2, #1
        EXIT                  ; stop at the end of our continuation bytes, regardless

; What UTF-8 character length is suggested by a particular header byte?
; Entry: R0 holds the byte
; Exit:  R1 holds the expected character length
estimate_UTF8_char_len
        Entry
        CMP     R0, #' '
        MOVLT   R1, #0        ; control characters given 0 length
        EXIT    LT
        TST     R0, #&80      ; ASCII chars,
        TSTNE   R0, #&40      ; orphaned continuation bytes,
        TEQNE   R0, #&FE      ; and special cases &FE
        TEQNE   R0, #&FF      ; and &FF
        MOV     R1, #1        ; are all 1 byte characters
        EXIT    EQ
        MOVS    R14, R0, LSL#25 ; shift bit 6 into sign bit
01      ADDMI   R1, R1, #1
        MOVMIS  R14, R14, LSL#1 ; shift next bit into sign bit
        BMI     %BT01
        EXIT                  ; R1 holds number of sequential 1-bits

; Read one UTF-8 sequence from memory and translate into UCS-4 form
; Entry: R6 -> UTF-8 sequence
;        R4 = max number of bytes to consider
; Exit:  R6 = UCS-4 character, or -1 if malformed
;        R4 = number of bytes used for character
convert_UTF8_to_UCS4
        EntryS  "R0-R3"
        LDRB    R0, [R6]
        CMP     R0, #&80
        MOVLT   R6, R0
        MOVLT   R4, #1
        EXITS   LT            ; top-bit-clear bytes are all valid 1-byte characters

        CMP     R0, #&FE
        CMPNE   R0, #&FF
        CMPNE   R0, #&BF
        MOVLE   R6, #-1
        MOVLE   R4, #1
        EXITS   LE            ; &FE, &FF and orphaned continuation bytes are invalid 1-byte characters

        BL      estimate_UTF8_char_len
        CMP     R4, R1
        MOVLT   R6, #-1
        EXITS   LT            ; if the character isn't all there, it's one malformed character

        MOV     R2, #&FF00
        BIC     R0, R0, R2, LSR R1 ; strip out the leading 1s from header byte

        MOV     R2, #1        ; index of first continuation byte
01      LDRB    R3, [R6, R2]
        AND     R14, R3, #&C0
        TEQ     R14, #&80
        BNE     %FT09         ; handle non-continuation bytes
        BIC     R3, R3, #&C0
        MOV     R0, R0, LSL#6
        ORR     R0, R0, R3
        ADD     R2, R2, #1
        CMP     R2, R1
        BLT     %BT01

        ; Now check that the character was encoded in the correct number of bytes
        ADR     R14, UTF8_encoding_boundaries
        SUB     R1, R2, #1
        LDR     R14, [R14, R1, LSL#2] ; get the lowest UCS-4 character that needed this many UTF-8 bytes
        CMP     R0, R14
        MOVLT   R6, #-1       ; malformed if wasteful!
        MOVGE   R6, R0
        MOV     R4, R2        ; length is the same either way
        EXITS

09      MOV     R6, #-1
        MOV     R4, R2
        EXITS                 ; sequence contained a non-continuation byte - ie it's a short malformed character

UTF8_encoding_boundaries
        DCD            &0
        DCD           &80
        DCD          &800
        DCD        &10000
        DCD       &200000
        DCD      &4000000
        DCD     &80000000

; Convert a UCS-4 character into UTF-8 form, stored in the requested buffer
; Entry: R6 = UCS-4 character
;        R5 -> 6-byte buffer
; Exit:  buffer filled
;        R4 = number of bytes used
convert_UCS4_to_UTF8
        Entry   "R0,R1,R5"
        ; Is it ASCII?
        CMP     R6, #&80
        STRLOB  R6, [R5]
        MOVLO   R4, #1
        EXIT    LO
        ; Is it illegal? (Shouldn't ever be, but just in case...)
        TST     R6, #1:SHL:31
        MOVNE   R4, #0
        EXIT    NE

        MOV     R0, R6        ; holds successive shifted values
        MOV     R1, #&40      ; holds successive thresholds below which the value can fit into the header byte
        MOV     R4, #5        ; index into buffer to store in temporarily
01
        STRB    R0, [R5, R4]  ; don't worry about top bits yet
        CMP     R0, R1
        BLT     %FT02         ; break from loop if we've done all bytes
        MOV     R0, R0, LSR #6
        MOV     R1, R1, LSR #1
        SUB     R4, R4, #1
        B       %BT01
02
        MOV     R1, R4        ; distance to copy down by
        RSB     R4, R4, #6    ; number of bytes used

        LDRB    R0, [R5, R1]
        MOV     R14, #&FF00
        ORR     R0, R0, R14, LSR R4  ; construct header byte
        ADD     R14, R5, R4   ; points to copied-down position of byte after last byte
03
        STRB    R0, [R5], #1
        CMP     R5, R14
        EXIT    GE
        LDRB    R0, [R5, R1]
        BIC     R0, R0, #&C0
        ORR     R0, R0, #&80  ; construct continuation byte
        B       %BT03

; General get-alphabet routine
; On exit:  Z set => current alphabet is UTF-8
;           alphabet updated to hold current alphabet
read_current_alphabet
        Entry   "R0-R2"
        MOV     R0, #71
        MOV     R1, #127 ; read alphabet
        SWI     XOS_Byte
        STRB    R1, alphabet
        TEQ     R1, #ISOAlphabet_UTF8 ; leaves V unchanged
        EXIT
      ]

; checkvalid - scan validation string to see if char is acceptable
; Entry:  R3 -> validation string (<=0 ==> none)
;         R6 = char under consideration
;         [alphabet] = current alphabet
;       [ SpacesInFilenames
;       [ UTF8
;         R4 = length of character (string form)
;         [tempworkspace] = char under consideration (string form)
;       ]
;         [savedcharcode] = char under consideration (word form)
;       ]
; Exit:   Z set ==> char is OK
;         Z unset ==> pass back to user instead
;       [ SpacesInFilenames
;         R4, [tempworkspace], R6, [savedcharcode] may be updated (R6 only used in non-UTF8 case)
;       ]


;   R7 = 0/1 char is OK/not OK so far
;   R8 = 0/1 we are trying to in/exclude characters

checkvalid
      [ SpacesInFilenames
        TEQ     R6,#' '
        BEQ     checkvalid_convertspace
checkvalid_lateentry
      ]
        AcceptLoosePointer_NegOrZero R3,-1
        CMP     R3,R3,ASR #31
        MOVEQ   PC,LR           ; Z set ==> char ok

      [ UTF8
        Push    "R1-R10,LR"
      |
        Push    "R2-R8,LR"
      ]

        MOV     R7,#0           ; char ok if command not found
        MOV     R2,#WimpValidation_Allow
        BL      findcommand
        BNE     exitcheck
        BVS     exitcheck

      [ UTF8
        BL      checkvalid_getchar      ; quick check for initial state
        TEQ     R10, #"~"
      |
        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
      [ UTF8
        BL      checkvalid_getchar
        MOV     R4, R10
        ADD     R3, R3, R9
      |
        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,#"\\"
      [ UTF8
        BLEQ    checkvalid_getchar
        MOVEQ   R4, R10
        ADDEQ   R3, R3, R9

        BL      checkvalid_getchar
        MOV     R5, R10
        ADD     R3, R3, R9
      |
        LDREQB  R4,[R3],#1              ; 'escaped' char

        LDRB    R5,[R3],#1
      ]
        TEQ     R5,#"-"
        BNE     check_single            ; R4 = char to check for

      [ UTF8
        BL      checkvalid_getchar
        MOV     R5, R10
        ADD     R3, R3, R9
      |
        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,#"\\"
      [ UTF8
        BLEQ    checkvalid_getchar
        MOVEQ   R5, R10
        ADDEQ   R3, R3, R9
      |
        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
      [ UTF8
        SUB     R3,R3,R9                ; we've read 1 too many chars!
      |
        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
      [ UTF8
        Pull    "R1-R10,PC"
      |
        Pull    "R2-R8,PC"
      ]
        MakeErrorBlock WimpBadSyntax

      [ UTF8
checkvalid_getchar   ; also used in interpreting WimpValidation_Display
; Entry: R3 -> next character
;        alphabet = current alphabet
; Exit:  R10 = character (as appropriate to current alphabet; malformed UTF-8 sequences skipped)
;        R9  = number of bytes read
        EntryS  "R4,R6"
        LDRB    R14, alphabet
        TEQ     R14, #ISOAlphabet_UTF8
        ; non-UTF-8 code
        LDRNEB  R10, [R3]
        MOVNE   R9, #1
        EXITS   NE
        ; UTF-8 code
        MOV     R9, #0                  ; byte count
01      MOV     R4, #6                  ; try to get as many bytes as possible
        ADD     R6, R3, R9
        BL      convert_UTF8_to_UCS4
        ADD     R9, R9, R4
        CMP     R6, #-1
        BEQ     %BT01
        MOV     R10, R6
        EXITS
      ]

      [ SpacesInFilenames
checkvalid_convertspace
        Entry
        BL      checkvalid_lateentry
        EXIT    EQ                      ; space is already OK
        MOV     R6, #&A0
        BL      checkvalid_lateentry
        MOVNE   R6, #' '                ; hard space not allowed either, so put back soft space
        EXIT    NE
        STR     R6, savedcharcode
      [ UTF8
        LDRB    R14, alphabet
        TEQ     R14, #ISOAlphabet_UTF8
        STRNEB  R6, tempworkspace       ; change string to &A0 if not UTF-8
        MOVEQ   R14, #&C2
        STREQB  R14, tempworkspace      ; change string to &C2 &A0 if UTF-8
        STREQB  R6, tempworkspace+1
        MOVEQ   R4, #2
        TEQNE   R0, R0                  ; restore EQ condition
      ]
        EXIT
      ]


; 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

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

        BLEQ    getmenuroot             ; R14 = current root in [menudata]
        TEQEQ   R1,R14                  ; or the root node is different,
        BLNE    menusdeleted            ; send Message_MenusDeleted to old owner

        EXITS                           ; must preserve flags

; In    [menudata] = current menu root
; Out   R14 = menu root pointer (or dbox window handle)

getmenuroot
      [ No32bitCode
        Entry
      |
        Entry   "R0"
        MRS     R0,CPSR
      ]
        LDR     R14,menudata            ; if menu owner changing,
        TST     R14,#3
        SUBEQ   R14,R14,#m_header       ; correct for header if menu ptr
      [ No32bitCode
        EXITS
      |
        MSR     CPSR_f,R0
        EXIT
      ]

; 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
        EntryS  "R0-R4"

        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

        EXITS                           ; 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
        AcceptLoosePointer_NegOrZero R1,-1
        CMP     R1,R1,ASR #31
        BLNE    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

 [ ThreeDPatch
CheckForColourMenu
	ROUT
	Push	"r0,userblk,lr"

	MOV	r0,#0

00	LDR	lr,[userblk,#mi_iflags]
	AND	lr,lr,#if_bcol
	TEQ	lr,#0
	MOVNE	r0,#1
	BNE	%FT01

	LDR	lr,[userblk,#mi_mflags]
	TST	lr,#mif_lastone
	ADDEQ	userblk,userblk,#mi_size
	BEQ	%BT00

01	STR	r0,MenuIsColourMenu

	Pull	"r0,userblk,pc"
 ]
; create new sub-menu

	ROUT
createsubmenu TraceL sc
        ADRL    userblk,menuwindow      ; window 'template'
        MOV     R14, #-1                ; created window will be 'owned' by the Wimp
        STR     R14, createwindowtaskhandle
        BL      int_create_window
        MOV     R14, #1                 ; subsequent windows are 'owned' by their creators
        STR     R14, createwindowtaskhandle
        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
        ]

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
        ]

 [ True
        ; Sneaky fast menu creation by filling the window with enough deleted icons such that
        ; the Wimp won't need to hammer the RMA to continually extend the icon data structure
        Push    "R5-R9, userblk"
        LDR     R4, [userblk, #m_header]! ; get flags of first item, point userblk at it
        MOV     R3, #3                    ; number of items in the menu we are going to create
countmenuiconlp
        TST     R4, #mif_lastone
        LDREQ   R4, [userblk, #mi_size]! ; get flags of next item
        ADDEQ   R3, R3, #3
        BEQ     countmenuiconlp
        BL      int_create_multiple_icons ; ensures R3 icons in window icon block
        BVS     exitcountmenucode
        ; R2 points to new icon data - wallop in the new settings
        MOV     R0,#0
        MOV     R1,#0
        MOV     R4,#0
        MOV     R5,#0
        MOV     R6,#is_deleted
        MOV     R7,#0
        MOV     R8,#0
        MOV     R9,#0
countmenuinitlp
        STMIA   R2!,{R0,R1,R4,R5,R6,R7,R8,R9}
        SUBS    R3, R3, #1
        BNE     countmenuinitlp
exitcountmenucode
        Pull    "R5-R9, userblk"
        Pull    "R1-R4,userblk,PC",VS    ; memory error
 ]

 [ 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

 [ MinimumMenuHeight
	CMP	R3,#44
	MOVLO	R3,#44
 ]

 [ :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
 |
  [ ThreeDPatch
	LDR	r14,ThreeDFlags
	TST	r14,#ThreeDFlags_Use3DBorders
  	MOVNE	y1,#-4			; leave space at the top for the 3D border
 	MOVEQ	y1,#0
      [ true
        BL      CheckForColourMenu
      |
	TST	r14,#ThreeDFlags_TexturedMenus
	BLNE	CheckForColourMenu
      ]
  |
        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
      [ ThreeDPatch
        LDRB    x1,arrowIconWidth
      |
        MOV     x1,#24
      ]
        LDR     R1,reversedmenu         ; Is it a reversed menu?
        CMP     R1,#"\\"
        LDREQ   x0,menuiconwidth        ; Put it where the arrow is
      [ ThreeDPatch
        LDREQB  R1,arrowIconWidth
        ADDEQ   x0,x0,R1                ; supposed to be.
        ADDEQ   x1,x0,R1
      |
        ADDEQ   x0,x0,#24               ; supposed to be.
        ADDEQ   x1,x0,#24
      ]

        LDR     R1,menutickflags
 [ OldStyleColourMenus
	LDR	R14,MenuIsColourMenu
	TEQ	R14,#0
	ORRNE	R1,R1,#if_filled
 ]
        LDR     R14,[userblk]           ; flags of middle icon
        TST     R14,#if_fancyfont
        MOVNE   R2,#(sc_white:SHL:ib_bcol):OR:(sc_black: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, #sc_lightgrey: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
  [ :LNOT: ThreeDPatch
        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

 [ ThreeDPatch
	LDR	r14,ThreeDFlags
	TST	r14,#ThreeDFlags_TexturedMenus
	ORREQ	r1,r1,#if_filled	; if we're not using textures then make sure the icons are filled
	BEQ	%FT90

	LDR	r14,MenuIsColourMenu
	TEQ	r14,#0
	ORRNE	r1,r1,#if_filled
	BNE	%FT90

      [ true
        ; EOR inversion is only used for icons that are non-sprite, unfilled and unshaded.
        ; All other icons need to be filled so that the whole icon is visibly changed when selected
        ; and then the unselected version special-cased in iconfilledCheckMenu.
        ; Since we never select shaded icons in menus, the appropriate test here is just for if_sprite.
        ; This allows the !Draw line pattern menu to work.
        TST     r1,#if_sprite
      | ; 4.02 code
	TST	r1,#if_text
	TSTNE	r1,#if_sprite		; if text+sprite icon
      ]
	ORRNE	r1,r1,#if_filled	; then fill it so inverting works
	BICEQ	r1,r1,#if_bcol
	BICEQ	r1,r1,#if_filled	; else clear the background and unfill it
90
 ]

        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

 [ ThreeDPatch
	LDR	r14,ThreeDFlags
	TST	r14,#ThreeDFlags_TexturedMenus
	BEQ	%FT90

        AND     R14,R1,#if_buttontype
	CMP     R14,#14 :SHL: 12        ; check for either type of writable
	ORRGE	r1,r1,#if_filled	; fill the icon
	BGE	%FT90

	TST	r1,#if_sprite
	LDREQ	r14,MenuIsColourMenu
	TEQEQ	r14,#0
	ORREQ	r1,r1,#sc_black :SHL: ib_bcol	; if the icon doesn't have a sprite then set the bg col to black
90
 ]
;        BIC     R1,R1,#if_buttontype

;        ORR     R1,R1,#13:SHL:ib_esg    ; set esg 13
      [ ThreeDPatch
        LDRB    x0,arrowIconWidth
      |
        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
      [ ThreeDPatch
        LDRB    R1,arrowIconWidth
        ADD     x1,x0,R1                ; width of arrow icon
      |
        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
      [ ThreeDPatch
        LDREQB  x1,arrowIconWidth
      |
        MOVEQ   x1,#24
      ]
        LDR     R1,menuarrowflags
 [ OldStyleColourMenus
	LDR	R14,MenuIsColourMenu
	TEQ	R14,#0
	ORRNE	R1,R1,#if_filled
 ]
        LDR     R14,[R13,#4]            ; skip one stack item - get shaded bit
        ORR     R1,R1,R14               ; shade arrow too
        AcceptLoosePointer_NegOrZero R5,-1
        CMP     R5,R5,ASR #31           ; if ptr <= 0, don't put arrow in
        MOV     R2,#cr:SHL:8            ; null text
        ORRNE   R2,R2,#&89              ; right-arrow
        BICEQ   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
      [ ThreeDPatch
        LDRB    R14,arrowIconWidth
        ADD     x0,x0,R14
        ADD     x1,x0,R14
       |
        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

 [ ThreeDPatch
	LDR	r14,ThreeDFlags
	TST	r14,#ThreeDFlags_Use3DBorders
	SUBNE	y1,y1,#4
 ]
        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
 [ RO4
; [ ThreeDPatch :LAND: OldStyleColourMenus
;	ADDNE	cx0,cx0,#4
;	ADDNE	cx1,cx1,#4
;	SUBEQ	cx0,cx0,#4
;	SUBEQ	cx1,cx1,#4
; ]
 ]
        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]
        ADRL    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
        SavePSR R3
        MOV     R4, R0
        LDRVS   R0, menuhandle
        BLVS    int_delete_window
        MOVVC   R0, R4
        RestPSR R3,VC,f

        Pull    "R1-R4,userblk,PC"
;...........................................................................
        [       outlinefont
fixupmenuwidth TraceL menuw

; Entry
;       userblk -> menu block
; Exit
;       all registers preserved
;       [userblk, #m_width] updated (in place!)

        EntryS  "R0-R9"

        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

      [ CnP
        MOV     R7, #nullptr
      ]
        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

      [ CnP
        MOV     R7, #nullptr
      ]
        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, #18 ; add 16 OSU for space round text, and 2 OSU to compensate for Font_ConverttoOS
                            ; rounding down to pixel boundaries (we need to round up so that keyboard
                            ; shortcuts are right-justified outside any long menu items)
        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

        EXITS

fixupmenuwidth_vdu TraceL menuw

; Entry
;       userblk -> menu block
; Exit
;       all registers preserved
;       [userblk, #m_width] updated (in place!)

        EntryS  "R0-R9"

        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

        EXITS

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
  |
   [ ThreeDPatch
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
        BHI     %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?
        LDRHS   R14,[handle,#w_flags]

        [ StickyMenus
        ORRHS   R14,R14,#wf_icon3 :OR:wf_icon2
        |
        ORRHS   R14,R14,#wf_icon3
        ]

        STRHS   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
        LDRHS   R14,[handle,#w_flags]

        [ StickyMenus
        ORRHS   R14,R14,#wf_icon3 :OR:wf_icon2
        |
        ORRHS   R14,R14,#wf_icon3
        ]

        STRHS   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

        EXIT

;..............................................................................

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
        [       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]
 [ MinimumMenuHeight
	CMP	R2,#44
	MOVLO	R2,#44
 ]
        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
 [ ThreeDPatch
	LDR	r14,ThreeDFlags
	TST	r14,#ThreeDFlags_Use3DBorders
	TSTNE	R14,#ThreeDFlags_TexturedMenus
	BEQ	%FT90
	Push	"r0-r4,x0-y1"

	ldr	r0,dy
	sub	r0,r0,#1
	add	y1,y1,#4			; move y coord up to the bottom of the separator bar
	add	y1,y1,r0
	bic	y1,y1,r0			; round y coord up to nearest whole number of pixels

	ldr	r0,dy
	sub	x1,x1,r0,LSL #1			; convert maxx to inclusive coords and move left my one pixel
	add	x0,x0,r0			; move minx one pixel right
	sub	r0,r0,#1
	bic	x0,x0,r0			; round minx down to nearest pixel
	add	x1,x1,r0
	bic	x1,x1,r0			; round maxx up to nearest pixel

		; bottom half of separator

	LDR	r0,ThreeDFlags
	TST	r0,#ThreeDFlags_UseAlternateMenuTexture
	LDRNE	r0,truemenuborderfacecolour
	LDREQ	r0,truewindowborderfacecolour
	LDR	r3,ditheringflag
	MOV	r4,#0
	SWI	XColourTrans_SetGCOL

	mov	r0,#96+4
	sub	r1,x0,#16			; ensure it overlaps the left
	add	r2,y1,#0
	swi	XOS_Plot

	mov	r0,#96+5
	sub	r1,x1,#4
	add	r2,y1,#3
	swi	XOS_Plot

	mov	r0,#80+0
	mov	r1,#4
	mov	r2,#0
	swi	XOS_Plot

	mov	r0,#80+1
	mov	r1,#-3
	mov	r2,#-3
	swi	XOS_Plot

		; top half of separator

	LDR	r0,ThreeDFlags
	TST	r0,#ThreeDFlags_UseAlternateMenuTexture
	LDRNE	r0,truemenuborderoppcolour
	LDREQ	r0,truewindowborderoppcolour
	LDR	r3,ditheringflag
	MOV	r4,#0
	SWI	XColourTrans_SetGCOL

	mov	r0,#96+4
	add	r1,x1,#16			; ensure the left edge overlaps
	add	r2,y1,#7
	swi	XOS_Plot

	mov	r0,#96+5
	add	r1,x0,#4
	add	r2,y1,#4
	swi	XOS_Plot

	mov	r0,#80+0
	mov	r1,#-4
	mov	r2,#0
	swi	XOS_Plot

	mov	r0,#80+1
	mov	r1,#3
	mov	r2,#3
	swi	XOS_Plot

	Pull	"r0-r4,x0-y1"
	B	%FT91
90
 ]
	Push	"R1-R2"
        Plot    &04,x0,y0
        Plot    &15,x1,y0               ; draw dotted line
	Pull	"R1-R2"
 [ ThreeDPatch
91
 ]
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,#nullptr            ; unless it's a menu icon, remember it
        ADREQL  R14,caretdata
        LDMEQIA R14,{R0-R5}
        ADREQL  R14,oldcaretdata
        STMEQIA 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
        ADRL    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
        ADRL    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
        ADRL    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!!
        CMP     handle, #nullptr        ; another bugfix: make sure handle isn't null (eg when adjust-clicking on
        Pull    "R0-R4,PC", EQ          ; a submenu with a writable item) - someday, work out why this happens...

        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
        EntryS  "R0-R4"

        LDR     R0,mousexpos
        LDR     R4,mouseypos
        LDR     R2,mousebuttons
        LDR     R3,timeblk
        MOV     R1,#Service_MouseTrap
        SWI     XOS_ServiceCall

        EXITS                           ; 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
      [ ChildWindows
        Push    "R3,LR"
        ; Step up parents until we reach the ancestor
        Abs     R3,R3
01      LDR     R14,[R3,#w_parent]
        CMP     R14,#nullptr
        MOVNE   R3,R14
        BNE     %BT01
        Rel     R3,R3
      |
        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
      [ ChildWindows
        Pull    "R3,PC"                 ; on exit, Z set ==> found
      |
        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,#nullptr             ; is this a real window?
        MOVNE   R4,#-1                  ; Fake system icon, to force task swap.
        BLNE    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

        ADRL    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

        LDR     R14, oldbuttons
        BICS    R14, R2, R14            ; if a click has occurred,
        BNE     %FT06                   ; ignore the inactivity timeout
        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
06

        SUBS    R14,R0,R4               ; if we've changed row, then definitely close submenu
        BMI     %FT01
        CMP     R14,#2
        BGT     %FT01

      [ ClickSubmenus
        LDRB    R14, submenuopenedbyclick
        TEQ     R14, #0                 ; if we've opened a submenu using a click
        BNE     notinamenu              ; then we want it to stay open
      ]

        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                  ; has the menu been opened for them?
        Pull    "R0"
        BHI     notinamenu
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

      [ ClickSubmenus
        LDRB    R2, submenuopenedbyclick; if this is nonzero, then last time round someone clicked on
        TEQ     R2, #0                  ; a menu item leading to a submenu, so we need to open it immediately
        Push    "R0,R14", NE
        BNE     %FT00
      ]

        LDRB    R2,sysflags
        TST     R2,#sysflags_automenu
        BEQ     exitscanmenu            ; if not auto menus then exit

        Push    "R0,R14"
        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
00
        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
        AcceptLoosePointer_NegOrZero R4,0,NE,R14
        CMPNE   R4,R4,ASR #31
        BEQ     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!)
        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..
      [ true
        LDR     R14,[R14,R5,LSL #i_shift]       ; right-hand side of current icon is the way it alway used to be done
      |
        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
 ]
 [ ThreeDPatch
	LDR	r14,ThreeDFlags
	TST	r14,#ThreeDFlags_Use3DBorders
	ADDNE	r3,r3,#4			; adjust for 3D 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
;
        EntryS  "r0-r5"

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

        EXITS

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

        ADRL    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

      [ ClickSubmenus
        LDRB    R14, clicksubmenuenable
        TEQ     R14, #0                 ; if not configured
        BEQ     notasubmenuclick        ; then use traditional behaviour
        ASSERT  (mi_size=24)
        ADR     R0, menudata
        LDR     R0, [R0, R1]            ; R0 -> menu data structure for current menu
        ADD     R0, R0, R4, LSL #3      ; add on R4*8, ie selection * 24
        LDR     R14, [R0, #mi_submenu]
        AcceptLoosePointer_NegOrZero R14,0
        CMP     R14, R14, ASR #31       ; check that there is a submenu attached to this item
        BEQ     notasubmenuclick        ; if not, then proceed as normal
        LDR     R14, [R0, #mi_mflags]
        LDR     R0, [R0, #mi_iflags]
        AND     R14, R14, #mif_traverse
        TST     R0, #is_shaded          ; if unshaded
        TEQNE   R14, #mif_traverse      ; or traversable
        MOVEQ   R0, #1
        STREQB  R0, submenuopenedbyclick; then trigger an immediate auto-open next time round
        Pull    "R0-R4"
        B       leavescan
notasubmenuclick
      ]

        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
        ADRL    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,#nullptr
        MOV     R0,#-4                  ; mark temporary (Poll kills menus)
        STREQ   R0,menus_temporary
        BLNE    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
        ADRL    R14,menuselections
        STR     R0,[R14,R1]
        B       gomenuselect

woggleicon
        Push    "R3,LR"

 [ ThreeDPatch
	LDR	R0,ThreeDFlags
	TST	R0,#ThreeDFlags_TexturedMenus
	BEQ	%FT01
	Push	"R1-R4"
	MOV	R0,R4
	MOV	R1,#&07000000
	ORR	R1,R1,#if_filled
	MOV	R2,#&FF000000
	ORR	R2,R2,#if_filled
	BL	int_set_icon_state
	Pull	"R1-R4"
01
 ]
        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
        ADRL    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.

      [ UTF8
        Push    "R0, R3-R6, LR"
        BL      read_current_alphabet
        LDRB    R6, alphabet
      |
        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, #" "
      [ UTF8
        ADDNE   R3, R3, #1
        BNE     fixupfontstring_loop
        MOV     R5, R3 ;remember last space

        TEQ     R6, #ISOAlphabet_UTF8
        BNE     %FT01
        BL      fixupfontstring_moveup
        MOV     R4, #&C2 ; first byte of UTF-8 sequence for hard space (&C2 &A0)
        STRB    R4, [R1, R3]
        ADD     R3, R3, #1
01      MOV     R4, #&A0 ; hard space (or second byte of UTF-8 sequence for hard space)
        STRB    R4, [R1, R3]
        ADD     R3, R3, #1
        B       fixupfontstring_loop
      |
        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
      [ UTF8
        TEQ     R6, #ISOAlphabet_UTF8
        BLEQ    fixupfontstring_movedown
      ]
        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]
      [ ThreeDPatch
        LDR     R14, arrowIconWidth
        SUB     R1, R1, #16 - 6 ; portion of excess text icon width on right
        SUB     R1, R1, R14
      |
        SUB     R1, R1, #24 + (16 - 6) ;width of arrow + portion of excess text icon width on right
      ]
        TraceK  menuw, "fixupfontstring: moving to ("
        TraceD  menuw, R1
        TraceK  menuw, ", "
        TraceD  menuw, R2
        TraceK  menuw, ")"
        TraceNL menuw
        SWI     XOS_Plot
        Pull    R1
fixupfontstring_finish

      [ :LNOT: UTF8
        Pull    "R0, R3-R5, PC"
      |
        Pull    "R0, R3-R6, PC"

fixupfontstring_moveup
; Entry: R1+R3 points to null-terminated string to move up by one byte (inserted byte is garbage)
; Exit: preserve all registers
        Entry   "R0-R2"
        ADD     R2, R1, R3
01      LDRB    R1, [R2]
        STRB    R0, [R2], #1
        MOVS    R0, R1
        BNE     %BT01
        STRB    R0, [R2]
        EXIT

fixupfontstring_movedown
; Entry: R1+R5 points to byte to delete - following null-terminated string is moved down by one byte
; Exit: preserve all registers
        Entry   "R0,R2"
        ADD     R2, R1, R5
01      LDRB    R0, [R2, #1]
        STRB    R0, [R2], #1
        TEQ     R0, #0
        BNE     %BT01
        EXIT
      ]
;---------------------------------------------------------------------------
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