[REBOL] Right mouse button popup-menu for all my REBOl apps.
From: rebolview:y:ahoo at: 27-Feb-2004 14:02
Dear all,
Excuse me for this long mail but i think someone here can help me.
I'm working on this popup-menu for long time and i have a serious matter
with the Garbage Colector but i can't reproduce the problem
with a little console example like :
loop 100 [view/new layout [ ...] unview ]
So if someone can run this %menu.r and tell me what it is thinking about ?
Many thanks for your help and informations...
-yos
REBOL []
; For me it is impossible to write a rock stable menu :
; Please find below some parts of an application
; do this %menu.r script and press very quikly the "menu" button
; by selecting "item1" or "item2"
; in less than 20 secondes the Garbage Colector will crash (windows, amiga)
; sysr is a part of my %sys.r library
; i use this functions for many months
; and i don't think the problem is about them.
sysr: get in context
[ do-word: get in context
[ do-word: func
[ {
}
'Word
/make
]
[ either make
[ compose/deep
[ (Word)
[ new/user-data: make new/user-data
[ (to-set-word Word) make (Word) second args]
next args
]
]
]
[ compose/deep
[ (Word)
[ new/user-data: make new/user-data
[ (to-set-word Word) second args]
next args
]
]
]
]
] 'do-word
do-init: get in context
[ do-init: func
[ {
}
Face
/with Rwith
]
[ Face/init: any [Face/init copy []]
Face/init: head insert head Face/init
[ user-data: make user-data []
user-data/face: :self
if user-data/styles
[ user-data/styles: stylize user-data/styles
user-data/layout: head insert head user-data/layout compose
[ styles
( in context [styles-word: get in user-data 'styles]
'styles-word
)
]
]
if user-data/layout
[ user-data/layout: layout user-data/layout
pane: get in user-data/layout 'pane
size: 2 * edge/size + user-data/layout/size
]
]
if with [Face/init: head insert head Face/init Rwith]
]
] 'do-init
user-data: get in context
[ user-data: context
[ face: none
styles: none
layout: none
menu: none
]
] 'user-data
] 'self
; stylesr is my %styles.r library
stylesr: stylize
[ item: face 75x25 silver
with
[ init: copy []
words: load compose
[ (sysr/do-word on-up)]
user-data: make sysr/user-data
[ on-up: none]
sysr/do-init self
]
font
[ valign: 'middle align: 'center
color: black
style: none
shadow: 0x0
]
feel
[ over: func [face over? position]
[ if face/text
[ either over?
[ face/color: aqua
face/font: make face/font [color: white]
show face
]
[ face/color: silver
face/font: make face/font [color: black]
show face
]
]
]
engage: func [face action event /local uv]
[ switch action
[ up
[ uv: last system/view/screen-face/pane
unview
do face/user-data/on-up
]
]
]
]
]
; show-menu the function maybe wrong for the Garbage Colector ...
show-menu: get in context
[ show-menu: func
[ {
}
Menu
Mouse-offset
/local
menu-face
]
[ menu-face: copy
[ styles stylesr
origin 0x0 space 0x0
]
foreach [s b] Menu
[ append menu-face reduce
[ 'item 100x25 s 'on-up b]
]
menu-face: layout menu-face
menu-face: make menu-face
[ options: copy [no-border no-title]
user-data: context
[ over: true
face: get in menu-face 'self
]
edge: make edge [size: 2x2 effect: 'bevel]
size: 2 * edge/size + size
]
view/new/offset menu-face Mouse-offset - (menu-face/size / 2)
menu-face/feel: make menu-face/feel
[ detect: func first :detect head insert head second :detect
[ switch event/type
[ move
[ if (face/user-data/over xor within? event/offset 1x1 face/size - 3x3)
[ either face/user-data/over
[ ; print "away"
unview
]
[ ; print "over"
]
face/user-data/over: not face/user-data/over
]
]
]
]
]
do-events
]
] 'show-menu
menu: copy
[ "item 1" [print "item1"]
"item 2" [print "item2"]
]
view layout
[ button "menu"
[ show-menu menu (face/size / 2 + screen-offset? face)
]
]
=09
