steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Show persistent border on right clicking presentation gadgets

db4
Sankaranarayanan Viswanathan 2015-11-02 22:24:36 -05:00 committed by John Benediktsson
parent fc7b70a17e
commit 4ce72ddbfb
1 changed files with 25 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
basis/ui/gadgets/presentations/presentations.factor
View File

@ -1,13 +1,16 @@
! Copyright (C) 2005, 2009 Slava Pestov. ! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel namespaces ui.commands ui.gadgets USING: accessors kernel memoize namespaces ui.commands ui.gadgets
ui.gadgets.buttons ui.gadgets.buttons.private ui.gadgets.menus ui.gadgets.borders ui.gadgets.buttons ui.gadgets.buttons.private
ui.gadgets.status-bar ui.gadgets.worlds ui.gestures ui.gadgets.glass ui.gadgets.menus ui.gadgets.status-bar
ui.operations ; ui.gadgets.theme ui.gadgets.worlds ui.gestures
ui.operations ui.pens.solid ;
IN: ui.gadgets.presentations IN: ui.gadgets.presentations
TUPLE: presentation < button object hook ; TUPLE: presentation < button object hook ;
TUPLE: presentation-menu < border presentation ;
: invoke-presentation ( presentation command -- ) : invoke-presentation ( presentation command -- )
[ [ dup hook>> call( presentation -- ) ] [ object>> ] bi ] dip [ [ dup hook>> call( presentation -- ) ] [ object>> ] bi ] dip
invoke-command ; invoke-command ;
@ -33,9 +36,26 @@ M: presentation ungraft*
dup hand-gadget get-global child? [ dup hide-status ] when dup hand-gadget get-global child? [ dup hide-status ] when
call-next-method ; call-next-method ;
MEMO: selected-pen-boundary ( -- button-pen )
roll-button-rollover-border <solid> dup dup f f <button-pen> ;
<PRIVATE
: setup-presentation ( presentation -- presentation )
selected-pen-boundary >>boundary ;
PRIVATE>
: <presentation-menu> ( presentation target hook -- menu )
<operations-menu> presentation-menu new-border
swap >>presentation
{ 0 0 } >>size ;
: show-presentation-menu ( presentation -- ) : show-presentation-menu ( presentation -- )
setup-presentation dup
[ ] [ object>> ] [ dup hook>> curry ] tri [ ] [ object>> ] [ dup hook>> curry ] tri
show-operations-menu ; <presentation-menu> show-menu ;
M: presentation-menu hide-glass-hook
presentation>> button-pen-boundary >>boundary drop ;
presentation H{ presentation H{
{ T{ button-down f f 3 } [ show-presentation-menu ] } { T{ button-down f f 3 } [ show-presentation-menu ] }