; 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