App  FunMenus
In   -
Out  FunMenus
Type Module
Ver  1.01h

Define Workspace
 Name    MenuItem
 Default r2
  `mflags    !      menu item flags
  `submenu   !      sub-menu pointer
  `iflags    !      icon flags
  `string    $12    menu text

 Name    MenuBlock
 Default r1
  `title     $12    menu title
  `tfore     %      title foreground and frame colour
  `tback     %      title background colour
  `wfore     %      workarea foreground colour
  `wback     %      workarea background colour
  `width     !      width of menu items
  `height    !      height of menu items
  `gap       !      gap between items
  `data      ^MenuItem   items of data

 Name     Module
 Default  r12
  `colour    !      next colour offset
  `menu      !      pointer to last menu structure
End Workspace

End Workspace
Define Module
 Name      FunMenus
 Author    Justin Fletcher
 Workspace *`len_Module
 WimpSWIs
  SWI   Wimp_CreateMenu
  Pre   swi_createmenu

  SWI   Wimp_CreateSubMenu
  Pre   swi_createsubmenu
 End WimpSWIs
 PostFilter
  Name   Fun menus
  Task   -
  Code   filter_post
  Accept Message
  Accept MessageRec
  Accept MenuSelection
 End PostFilter
End Module

#REM OFF
.filter_post
   STMFD   (sp)!,{r1-r5,link}            ; Stack registers
   CMP     r0,#17
   CMPNE   r0,#18
   BEQ     message
   CMP     r0,#9
   BEQ     menuselection
.exit_filter
   LDMFD   (sp)!,{r1-r5,pc}              ; Return from call

.menuselection
   BL      findentry
   CMN     r2,#1                         ; is this really a shaded option ?
   STREQ   r2,[r1]                       ; if so, mark as such
   BEQ     exit_filter                   ; and exit
   LDRW    r2,`iflags                    ; otherwise, get icon flags
   AND     r2,r2,#15<<24                 ; leave just the foreground
   CMP     r2,#0                         ; if 0 then is shaded
   MVNEQ   r2,#NOT -1                    ; so get -1 ...
   STREQ   r2,[r1]                       ; ... and store in selection block
   BEQ     exit_filter                   ; and exit

.message
   LDR     r2,[r1,#16]                   ; get message code
   SUB     r2,r2,#&40000                 ; is it equal to &400C0
   CMP     r2,#&C0                       ; ?
   BNE     exit_filter
   STMFD   (sp)!,{r0}
   ADD     r1,r1,#32                     ; offset to selection list
   LDR     r0,[r1]
   REM     "%c04Submenu opening, option %r0"
   BL      findentry                     ; find the entry and return in r2
   REM     "Is option %r2"
   LDRW    r3,`mflags                    ; get menu flags
   TST     r3,#1<<30                     ; is send message set ?
   BNE     $notshaded
   LDRW    r3,`iflags                    ; get icon flags
   AND     r3,r3,#15<<24                 ; get foreground colour
   CMP     r3,#0                         ; is it white ?
   BNE     $notshaded                    ; if not then bypass
   REM     "Is shaded"
   LDRW    r3,`mflags                    ; get menu flags
   TST     r3,#1<<4                      ; can it be opened when greyed ?
   BNE     $canopen                      ; if it can then it can open
$taskseesnothing
   REM     "Task sees nothing"
   ADD     sp,sp,#4                      ; increment stack to remove reason
   MOV     r0,#0                         ; can't open, so no sub-menu
   B       exit_filter                   ; so exit the filter

$canopen
   REM     "Can be opened if grey"
   SUB     r1,r1,#12                     ; move pointer back to sub-menu ptr
;    BL      checkwindow                   ; is it a window ?
;    BEQ     $taskseesnothing              ; if so, exit
   LDMIA   r1,{r1,r2,r3}                 ; read pointer, and locations
   REM     "Opening menu at %&1"
   SWI     "Wimp_CreateSubMenu"          ; and create the sub-menu
   B       $taskseesnothing
$notshaded
   LDMFD   (sp)!,{r0}                    ; not shaded so restore reason
   B       exit_filter                   ; and pass back to task

.swi_createmenu
   STMFD   (sp)!,{r0-r5,link}            ; Stack registers
   STRW    r1,`menu
   BL      scanstructure
   LDMFD   (sp)!,{r0-r5,pc}              ; Return from call

.swi_createsubmenu
   STMFD   (sp)!,{r0-r5,link}            ; Stack registers
   BL      scanstructure
   LDMFD   (sp)!,{r0-r5,pc}              ; Return from call

; checkwindow - tests to see if menu pointer is invalid (EQ if so)
; > r1 = menu pointer
; < EQ if window
.checkwindow
   STMFD   (sp)!,{r0-r5,link}            ; Stack registers
   CMN     r1,#1                         ; -1 if close menu
   CMPNE   r1,#0                         ; or if 0 don't process
   BEQ     $exit                         ; y = exit
   MOV     r0,r1                         ; r0=menu address
   BIC     r0,r0,#3                      ; word align
   ADD     r1,r0,#28+24                  ; end of block
   SWI     "XOS_ValidateAddress"         ; check exists
   BCS     $exitwitheq                   ; if not valid exit
   BVS     $exitwitheq                   ; if error exit
   SUB     r1,r1,#28+24                  ; restore block address
   LDR     r0,[r1]                       ; get first word
   LDR     r2,$`windtext                 ; get word Wind
   CMP     r0,r2                         ; if same then a window block
                                         ; EQ status is returned
$exit
   LDMFD   (sp)!,{r0-r5,pc}              ; Return from call
$exitwitheq
   CMP     r0,r0                         ; sets EQ status
   LDMFD   (sp)!,{r0-r5,pc}              ; Return from call

$`windtext
   EQUS    "Wind"

.scanstructure
   STMFD   (sp)!,{r0-r5,link}            ; Stack registers
   BL      checkwindow
   BEQ     $exit
   ADRW    r2,`data                      ; get pointer to menu items
   LDRW    r0,`colour                    ; get colour counter
   ADR     r4,$`colours                  ; get address into colour block
$tryagain
   LDR     r3,[r4,r0,LSL #2]             ; get word from block
   CMN     r3,#1                         ; is it -1 ?
   MOVEQ   r0,#0                         ; if so restart...
   BEQ     $tryagain                     ; ...and get colour again
   ADD     r0,r0,#1                      ; increment counter
   STRW    r0,`colour                    ; and store back in block
   STRBW   r3,`wback                     ; store colour as background colour
$loop
   LDRW    r0,`iflags                    ; get flags
   LDRW    r4,`mflags                    ; get menu flags
   TST     r0,#1<<6                      ; is it anti-aliased ?
   BNE     $colouruntouched              ; don't touch colour if anti-aliased
   BIC     r0,r0,#1<<5                   ; clear filled flag
   BIC     r0,r0,#15<<28                 ; clear background colour
   ORR     r0,r0,r3,LSL #28              ; and replace with new colour
   TST     r4,#1<<31                     ; have we seen before ?
   BNE     $seenbefore                   ; if so, then don't mark if msg-sub
   TST     r4,#1<<3                      ; is there msg when sub-menu ?
   ORRNE   r4,r4,#1<<30                  ; if so, mark as such
   ORR     r4,r4,#1<<31                  ; anyway, mark as seen
$seenbefore
   BIC     r4,r4,#1<<3
   TST     r4,#1<<30                     ; does it really want a message ?
   ORRNE   r4,r4,#1<<3
   TST     r0,#1<<22                     ; unselectable ?
   BEQ     $isselectable
   BIC     r0,r0,#15<<24                 ; clear foreground colour
   BIC     r0,r0,#1<<22                  ; and clear unselectable bit
;    LDRW    r1,`submenu                   ; get submenu pointer
;    BL      checkwindow                   ; is it valid ?
   TST     r4,#1<<4                      ; is there sub-menu when grey ?
   ORRNE   r4,r4,#1<<3                   ; if so, add message when open
   B       $colouruntouched
$isselectable
   BIC     r0,r0,#15<<24                 ; clear foreground colour
   ORR     r0,r0,#7<<24                  ; and set to black instead
$colouruntouched
   STRW    r0,`iflags                    ; store back in buffer
   STRW    r4,`mflags
   TST     r4,#1<<3                      ; is msg when open sub set ?
   LDRWEQ  r1,`submenu                   ; n = get submenu pointer
   BLEQ    scanstructure                 ; n = scan the submenu for menus
   TST     r4,#1<<7                      ; is this last item ?
   ADDEQ   r2,r2,#`len_MenuItem          ; increment block pointer
   BEQ     $loop
$exit
   LDMFD   (sp)!,{r0-r5,pc}^             ; Return from call

$`colours
   EQUD    9
   EQUD    10
   EQUD    11
   EQUD    12
   EQUD    14
   EQUD    15
   EQUD    -1

; > r1 = selection block
; < r2 = pointer to menu item contained (or -1)
.findentry
   STMFD   (sp)!,{r0-r1,r3-r5,link}     ; Stack registers
   LDRW    r0,`menu                     ; get menu pointer
#MAPWS MenuBlock,r0
$nextlevel
   MOV     r2,r1                        ; store selection block in r2
   MOV     r1,r0                        ; r1=menu pointer
   BL      checkwindow                  ; is it valid ?
   BEQ     $exitnodata                  ; if not, exit with no entry data
   MOV     r1,r2                        ; restore selection block
   LDR     r3,[r1],#4                   ; get first offset and increment
   REM     "Finding item, option = %r3"
   CMN     r3,#1                        ; is it -1 ?
   BEQ     $exitnodata
   ADRW    r2,`data                     ; r2=address of data
$findloop
   SUBS    r3,r3,#1                     ; decrement menu selection
   BMI     $foundentry                  ; if -ve, then found
;    REM     "Items to check = %r3"
   LDRW    r0,`submenu
;    REM     "Sub menu = %&0"
   LDRW    r0,`mflags                   ; get menu flags
;    REM     "Menu flags = %&0"
   TST     r0,#1<<7                     ; last item ?
   BNE     $exitnodata                  ; if so then no data
   ADD     r2,r2,#`len_MenuItem         ; increment block
   B       $findloop

$foundentry
   LDRW    r0,`iflags                   ; get icon flags
   AND     r0,r0,#15<<24                ; get foreground colour
   CMP     r0,#0                        ; is it white (ie shaded)
   BNE     $notshaded                   ; if not, then jump
   REM     "Is shaded"
;    LDR     r3,[r1]                      ; get next selection entry
;    CMN     r3,#1                        ; is this last one ?
;    BEQ     $exit                        ; if so then exit with data
;    B       $exitnodata                  ; if not, exit with no block

$notshaded
   REM     "Not shaded"
   LDR     r3,[r1]                      ; get next selection entry
   CMN     r3,#1                        ; is this last one ?
   BEQ     $exit                        ; if so exit with data
   LDRW    r0,`submenu                  ; otherwise r0=sub menu pointer
   CMN     r0,#1                        ; is it -1 ?
   BEQ     $exitnodata                  ; if so, there are no more entries!
   B       $nextlevel                   ; otherwise go through it all again

$exitnodata
   REM     "Returning nothing"
   MVN     r2,#NOT -1                   ; no data, so return null pointer
$exit
   LDMFD   (sp)!,{r0-r1,r3-r5,pc}       ; Return from call

#Post
#Run <CODE>
REM *Run Resources:$.Apps.!Draw
*Filer_OpenDir Resources:$.Apps
*Key1Rmreinit filer|Mfx138,0,13|Mwimptask desktop|M
