[REBOL] Re: [VID//menu]
From: info:id-net:ch at: 2-Jun-2004 1:20
While the Cyphre 's code is not released, I publish here the result of an
old effort to have a cascaded menu style.
There's still some bugs, specially sometimes when a cascaded menu pane is
displayed and a clik is made on a menu header.
I appreciate any help to finish the job, because I cant' find the problem...
Philippe Oehler
REBOL [
title: "View Menu"
authors: "Frank Sievertsen (version 1.0.0) & Philippe Oehler (v.2.0.0)"
date:22-5-04/14:39
version: 2.0.0
purpose: "Adds a grafical menu to a window or a face + Cascaded-menu"
]
;/*****************************************/ Needed to run the script well,
with new version of View
flag-face?: func [
"Checks a flag in a VID face."
face [object!] 'flag
][all [in face 'flags face/flags find face/flags flag]]
;/*****************************************/
ao2: :print ; a function, that I actually activates/deactivates, to be
simple, here : ao2: : print
;/*****************************************/head of the object!
CONTEXT [
;/*****************************************/
; LOCAL PARSE - VARS
t1: t2: none
name: none
out-block: none
out-face: none
SUB-out-face: none
;SUB-out-block: COPY []
offset: 0x0
direction: 0x1
menu: none
degree-from-top-face: ""
;/*****************************************/
;[STYLIZE];/*****************************************/;
MENU-I-STYLES: stylize [
;[STYLE : MENU-ITEM];/*****************************************/;
menu-item:
txt bold font-name "verdana" black "" font-size 10 with [
pane-size: 900x900
colors: reduce [[gradient 1x1 167.163.179 167.163.179] none];colors:
reduce [167.163.179 none]
Append init [state: no]
state: no
menu-description: none ;its text' block
menu-action: none ;its behavior
title-of-submenu?: none
menu-number: 0
parent-name: ""
path-from-system-for-Cascaded-Menu: "" ; to be a private data, shared
into different funcs
init: [
size: 900x900
size: (size-text self) + para/origin + para/margin
]
para: make para [ margin: origin: 4x2 ]
]
feel [
redraw: func [face][
face/color: pick face/colors face/state
]
over: func [face action event][
face/state: action
show face
]
engage: func [face action event][
switch action [
down [ ;ao2 "normal action of the basic style"
;ao2 "CALL unview-menu"
unview-menu ;effacement du menu d=E9roul=E9
face/menu-action face ;call the menu' menu-action with its argument
face
IF face/menu-description [ ;if there's something in the block's
menu-descritption.
unview-menu ;time 1 : unview of the menu displayed
view-menu face ;time 2 : 'redraw'
]
]
away [
over face no event ;calling of the function 'over with false (no)
as 2nd argument
]
over [
over face yes event ;calling of the function 'over with true (yes)
as 2nd argument
] ] ] ]
;/*****************************************/ end of MENU-ITEM
] ;/*****************************************/;
;[/STYLIZE]
;/*****************************************/; Menu-Functions
Unview-menu: func [][
ao2 "ENTR UNVIEW-MENU"
IF menu [
;ao2 "Menu activated!"
remove find menu/parent-face/pane menu
show menu/parent-face
menu: none
]
IF error? try [
IF Cascaded-menu [
;ao2 "mark 161"
unview-Cascaded-menu
Cascaded-menu: none
]
][]
]
;/*****************************************/
Unview-Cascaded-menu: func [/only][
;ao2 "ENTR Unview-Cascaded-menu"
nb-Cascaded-menu: 0
IF Cascaded-menu [
;AO2 "Cascaded-menu activated!!!"
remove find Path-from-system-for-Cascaded-Menu Cascaded-menu
show Path-from-system-for-Cascaded-Menu
Cascaded-menu: none
]
IF Not only [
IF menu [
;ao2 "CALL unview-Cascaded-menu"
unview-menu
menu: none
] ]
;ao2 "DONE Unview-Cascaded-menu"
]
;/*****************************************/
view-Cascaded-menu: func [
bk
/minimize
][
ao2 "ENTR view-Cascaded-menu"
len-bk: length? bk
offs: sub-offset ;private variable of the object!
either global-affichage-old-school
[ path-from-system-for-Cascaded-Menu:
system/view/screen-face/pane/1/pane/8/pane/pane ]
[ path-from-system-for-Cascaded-Menu:
ystem/view/screen-face/pane/1/pane ]
Append path-from-system-for-Cascaded-Menu Cascaded-menu: make
system/words/face [
dirty?: yes
flags: [on-unfocus]
]
Cascaded-menu/edge: make Cascaded-menu/edge [ effect: 'bevel color:
200.200.200 size: 2x1 ]
Cascaded-menu/color: 212.212.212
;Cascaded-menu/effect: [ merge gradmul 1x1 212.212.212 212.212.212];
120.255.195
Cascaded-menu/pane: copy []
EITHER Not minimize [
size-x: 0
forEach item bk [ ;calcul de la longueur maximale du sous-menu
size-text-x: (my-size-text item/text) + 8x0
size-x: max size-x (size-text-x/x)
]
][ size-x: 0 ]
o: 0x0
forEach item bk [
item/colors: reduce [[gradient 1x1 167.163.179 167.163.179] none]
item/offset/y: o/y
item/size: To-pair (join size-x "x18")
item/feel/redraw: func [face][
face/effect: pick face/colors face/state
]
item/feel/over: func [face action event][
EITHER all [(face/parent-name = "")(Not face/title-of-submenu?) ] [
unview-Cascaded-menu/only isCascaded-menu-visible?: false
unfocus
system/view/focal-face: menu
][
view-Cascaded-menu-procedure
]
face/state: action ; true or false
show face
]
Append Cascaded-menu/pane item
o/y: o/y + 18
]
Cascaded-menu/offset: offs
Cascaded-menu/size/y: 18 * len-bk
Cascaded-menu/size/x: size-x
;alert faceOne/parent-face/text
show path-from-system-for-Cascaded-Menu ; Those line is important !! the
path depends on where is the menu related the system path
unfocus
;system/view/focal-face: Cascaded-menu ; I remove this line, producing the
right action of items that are Not in a Cascaded-menu
;/*****************************************/;
Cascaded-menu/action: func [face value][
unview-Cascaded-menu
]
;/*****************************************/;
ao2 "DONE view-Cascaded-menu"
]
; not necessary, those function doesn't the right job. If someone can make
this function right.
;/*****************************************/;
Set-degree-from-top-face: func [face /local i][
the-path: face/parent-face
;print mold "lll"
;print mold face/var
i: 1
if not none? the-path [
i: 2
the-path: face/parent-face/parent-face
if not none? the-path [
i: 3
the-path: face/parent-face/parent-face/parent-face
if not none? the-path [
i: 4
the-path: face/parent-face/parent-face/parent-face/parent-face
if not none? the-path [
i: 5
the-path: face/parent-face/parent-face/parent-face/parent-face
if not none? the-path [
i: 6
the-path: face/parent-face/parent-face/parent-face/parent-face
]
]
]
]
]
return i
]
isCascaded-menu-visible?: false
;/*****************************************/;
view-Cascaded-menu-procedure: does [
IF Not isCascaded-menu-visible? [view-Cascaded-menu Cascaded-menu-block
isCascaded-menu-visible?: true]
]
Cascaded-menu-block: copy []
sub-offset: 0x0
;/*****************************************/;
View-menu: func [face /local tmp][
ao2 "ENTR view-menu"
;the object 'menu is added to the system' words
;ao2 mold face/parent-face/parent-face/pane
Set-degree-from-top-face face; call of this function, but it doesn't work
yet
; The next 2 lines are specific to the place where the menu is placed
related to the system root
MyPath-pane: face/parent-face/parent-face/pane
;MyPath-pane: face/parent-face/pane
MyPath: face/parent-face/parent-face
;MyPath: face/parent-face
clear Cascaded-menu-block
Append face/parent-face/parent-face/pane menu: make system/words/face [
;append the menu to the main pane (layout) where is the menu
dirty?: yes
flags: [on-unfocus]
]
menu/edge: make menu/edge [ effect: 'bevel color: 200.200.200 size: 2x1]
menu/offset: face/offset + 0x18 + face/parent-face/offset
menu/color: none
menu/effect: [
gradient 1x1 212.212.212 212.212.212
;;;;;6-merge gradmul 0x8 97.99.135 97.99.135; 120.255.195
;merge gradmul 0x1 115.115.195 120.120.195
;multiply 85.85.85
;merge gradcol 0x1 250.250.250 250.250.250
]
build-menu/below menu face/menu-description ; actually the parsing of the
dialect is called
menu/size: 1x1
menu/size/x: face/size/x
has-OneCascade-InPane?: false
offs: 1x1
IF menu/pane/1 [une-hauteur: menu/pane/1/size/y]
menu-pane-temp: copy menu/pane ; variable temp is used to remove find
menu/pane item because it's hard to make it in the foreach loop
forEach item menu-pane-temp [
SUB?: false
IF error? try [
IF item/user-data <> none [SUB?: has-OneCascade-InPane?: true]
][]
EITHER SUB? = FALSE [ ;normal case
menu/size: max menu/size item/offset + item/size
item/size/x: menu/size/x
offs/x: menu/offset/x + item/size/x + 2
IF face/title-of-submenu? [
;ao2 ["title-of-submenu?" face/text ]
]
][
Append/only Cascaded-menu-block item ;ao2 menu/offset/x
offs/y: menu/offset/y + item/size/y ; ao2 ["--->" length? menu/pane]
remove find menu/pane item ; ao2 ["--->" length? menu/pane]
] ]
;IF face/title-of-submenu? [ao2 face/text ]
menu/size: menu/size + 2x2
show myPath
unfocus
system/view/focal-face: menu
menu/action: func [face value][ unview-menu ao2 "2-unview" ]
print has-OneCascade-InPane?
IF has-OneCascade-InPane? [
offs/y: offs/y - une-hauteur
sub-offset: offs
;;;;6-view-Cascaded-menu/minimize Cascaded-menu-block ; args 1 : la face
(le sous-sous-menu) ; arg 2 : l'offset
view-Cascaded-menu Cascaded-menu-block ; args 1 : la face (le
sous-sous-menu) ; arg 2 : l'offset
]
]
;/*****************************************/;
Build-menu: func [face [object!] descr [block!] /below "without 'below, the
menu's elements are horizontal"][
face/pane: out-block: copy []
direction: EITHER below [0x1][1x0]
IF Not parse Compose descr [menu-data][
;make error! "menu-parse error"
]
]
;/*****************************************/;
;===============
; PARSE - RULES
menu-data: [
(offset: 0x0)
any menu-item
]
menu-counter: 0
; Second rule of parsing
menu-item: [
set name string! ;used for titles of menu + its elements but not
for cascaded menu's elements
(out-face: make menu-i-styles/menu-item []) ;out-face become a style
element, then some specifities will be append
(out-face/text: copy name) ;out-face/text will be titles of the menu
(out-face/offset: offset) ; its offset
any menu-options ; second block of parsing rules (cf. below)
(do out-face/init) ;call of the init function of the style
(offset: out-face/size * direction + offset) ; the offset is *saved* to
later use
(Append out-block out-face) ; all infos (style + new infos) are added
to a larger block
| ; or, reading of the splitting and graphic creation of the
splitting line
'--- (
Append out-block t1: make face [
size: 10x3 edge: make edge [
effect: 'ibevel
size: 1x1
color: none
color: 200.200.200
] ]
t1/offset: offset
offset: t1/size * direction + offset
)
]
reference-menu-name: ""
; begin with the name, then either it's a SUB, or a block
menu-options: [
'SUB set t1 block! (
menu-counter: menu-counter + 1
out-face/menu-description: t1
out-face/font/color: 72.132.167
out-face/menu-number: menu-counter
;ao2 out-face/menu-number
)
| set t1 block! (
out-face/menu-action: func [face] t1
)
|
'SUB-SUB set t2 block!
(GLOBAL-existence-de-Cascaded-menu?: true)
(out-face/title-of-submenu?: true) ;it works
(reference-menu-name: out-face/text)
;(out-face/menu-number: menu-counter)
;;;;;6-(ao2 out-face/menu-number)
(parse t2 menu-SUB-options) ;when it encounters SUB-SUB then block
parsing du block that follows
]
; what is after the | is something that I added (Philippe)
; Rules for sub-options
menu-SUB-options: [
any [
set SUB-name string! ; the Name of SubMenu is set
(SUB-out-face: make menu-i-styles/menu-item []) ; sub-out-face become a
menu-item and has its style now
(SUB-out-face/text: copy SUB-name) ; get-copy of the sub-name
(sub-out-face/parent-name: reference-menu-name)
(SUB-out-face/effect: menu/effect) ; get the main effect
set t2 block! ; le block
(
SUB-out-face/menu-description: t2
SUB-out-face/menu-action: func [face] t2
SUB-out-face/user-data: true ; if <> none then the face will be a
Cascaded-menu
)
(do SUB-out-face/init)
(Append out-block SUB-out-face);out-block is actually a face/pane! (a
kind of pointeur)
]
]
;/*****************************************/;
system/words/menu-styles: stylize [
menu: box 1x1 with [
Append init: init [
size: 1x1
build-menu self second :action
]
words: [
SUB [
;ao2 "SUB"
]
SUB-SUB []
]
] feel [
engage: none
redraw: func [face][
face/offset: -1x-1
face/size: face/parent-face/size + 10x1
face/size/y: 19 ; starting menu height
]
]
edge [effect: 'bevel size: 1x1 color: 200.200.200]
]
]
;[END OF CONTEXT]
; EXAMPLE :
;win: compose [ backdrop 212.212.212 origin 0x4 styles menu-styles]
myMenu: Compose/deep [
menu [
"File |" sub [
"Save As" [save-as]
---
]
"Edit |" sub [
"Delete -->" sub-sub [
"Word" [delete-word]
("Line" [delete-line]
]
---
"Cut" []
"Copy" []
"Paste" []
---
]
]
]
Append win Compose [Menu2: (myMenu)]
