ui.theme: updates to color scheme.

[factor.git] / basis / ui / gadgets / presentations / presentations.factor

diff --git a/basis/ui/gadgets/presentations/presentations.factor b/basis/ui/gadgets/presentations/presentations.factor
index 93a585e3308086228616938d8231dc60a74bda49..b65ca9d074410310e0eadb718a7a2b76b99ed81c 100644 (file)
--- a/basis/ui/gadgets/presentations/presentations.factor
+++ b/basis/ui/gadgets/presentations/presentations.factor
@@ -1,14 +1,15 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays accessors definitions hashtables io kernel sequences
-strings words math models namespaces quotations ui.gadgets
+USING: accessors kernel memoize namespaces ui.commands ui.gadgets
 ui.gadgets.borders ui.gadgets.buttons ui.gadgets.buttons.private
-ui.gadgets.labels ui.gadgets.menus ui.gadgets.worlds
-ui.gadgets.status-bar ui.commands ui.operations ui.gestures ;
+ui.gadgets.glass ui.gadgets.menus ui.gadgets.status-bar
+ui.gadgets.worlds ui.gestures ui.operations ui.pens.solid ui.theme ;
 IN: ui.gadgets.presentations
 
 TUPLE: presentation < button object hook ;
 
+TUPLE: presentation-menu < border presentation ;
+
 : invoke-presentation ( presentation command -- )
     [ [ dup hook>> call( presentation -- ) ] [ object>> ] bi ] dip
     invoke-command ;
@@ -25,8 +26,8 @@ TUPLE: presentation < button object hook ;
     [ [ object>> ] keep show-summary ] [ button-update ] bi ;
 
 : <presentation> ( label object -- button )
-    swap [ invoke-primary ] presentation new-button
-        swap >>object
+    [ [ invoke-primary ] presentation new-button ] dip
+        >>object
         [ drop ] >>hook
         roll-button-theme ;
 
@@ -34,9 +35,26 @@ M: presentation ungraft*
     dup hand-gadget get-global child? [ dup hide-status ] when
     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 -- )
+    setup-presentation dup
     [ ] [ 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{
     { T{ button-down f f 3 } [ show-presentation-menu ] }