From 35a7daf7aa1daee7c0f7cb98d54304f4c932ae42 Mon Sep 17 00:00:00 2001 From: slava Date: Tue, 10 Oct 2006 05:07:11 +0000 Subject: [PATCH] Presentation cleanup --- TODO.FACTOR.txt | 1 - doc/handbook/ui/tools.facts | 2 +- library/ui/gadgets/presentations.factor | 60 +++++++++++-------------- library/ui/gestures.factor | 2 - library/ui/load.factor | 3 +- library/ui/test/presentations.factor | 15 +++++++ library/ui/tools/dataflow.factor | 6 +-- library/ui/ui.factor | 2 +- library/ui/world.factor | 2 + 9 files changed, 51 insertions(+), 42 deletions(-) create mode 100644 library/ui/test/presentations.factor diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index a1ae42f290..b51c04905d 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -4,7 +4,6 @@ + ui: -- command presentation shouldn't really be a presentation at all - completion is not ideal: eg, search for "buttons" - live search: timer delay would be nice - some way of intercepting all gestures diff --git a/doc/handbook/ui/tools.facts b/doc/handbook/ui/tools.facts index 52ce942427..c69ad0d148 100644 --- a/doc/handbook/ui/tools.facts +++ b/doc/handbook/ui/tools.facts @@ -12,7 +12,7 @@ $terpri $terpri "Clicking and holding the right mouse button on a presentation displays a popup menu listing available operations." $terpri -"Presentation gadgets can be constructed directly using the " { $link } " word, and they can also be written to " { $link pane } " gadgets using the " { $link write-object } " word." ; +"Presentation gadgets can be constructed directly using the " { $link } " word, and they can also be written to " { $link pane } " gadgets using the " { $link write-object } " word." ; ARTICLE: "ui-listener" "UI listener" "The graphical listener is based around the terminal listener (" { $link "listener" } ") and adds the following features:" diff --git a/library/ui/gadgets/presentations.factor b/library/ui/gadgets/presentations.factor index 1351162a9c..d4cb6a58a2 100644 --- a/library/ui/gadgets/presentations.factor +++ b/library/ui/gadgets/presentations.factor @@ -11,36 +11,10 @@ generic hashtables tools io kernel prettyprint sequences strings styles words help math models namespaces ; ! Clickable objects -TUPLE: presentation object command ; - -C: presentation ( button object command -- button ) - [ set-presentation-command ] keep - [ set-presentation-object ] keep - [ set-gadget-delegate ] keep ; - -: ( gadget object -- button ) - >r f r> f ; - -: ( target command -- button ) - dup command-name f -rot ; - -: ( target commands -- gadget ) - [ hand-clicked get find-world hide-glass ] modify-operations - [ ] map-with - make-pile 1 over set-pack-fill ; - -: operations-menu ( presentation -- gadget ) - dup presentation-command [ - drop - ] [ - dup presentation-object - dup object-operations - swap show-menu - ] if ; +TUPLE: presentation object ; : invoke-presentation ( presentation -- ) - dup presentation-object swap presentation-command - [ dup default-operation ] unless* + dup presentation-object dup default-operation invoke-command ; : show-mouse-help ( presentation -- ) @@ -52,17 +26,37 @@ C: presentation ( button object command -- button ) M: presentation ungraft* ( presentation -- ) dup hide-mouse-help delegate ungraft* ; +C: presentation ( gadget object -- button ) + [ set-presentation-object ] keep + swap [ invoke-presentation ] + over set-gadget-delegate ; + +: ( target command -- button ) + dup command-name -rot + [ invoke-command drop ] curry curry + ; + +: ( target commands -- gadget ) + [ hand-clicked get find-world hide-glass ] modify-operations + [ ] map-with + make-pile 1 over set-pack-fill ; + +: operations-menu ( presentation -- gadget ) + dup presentation-object + dup object-operations + swap show-menu ; + presentation H{ - { T{ button-up } [ [ invoke-presentation ] if-clicked ] } - { T{ button-down f f 3 } [ [ operations-menu ] if-clicked ] } + { T{ button-down f f 3 } [ operations-menu ] } { T{ mouse-leave } [ dup hide-mouse-help button-update ] } { T{ motion } [ dup show-mouse-help button-update ] } } set-gestures ! Presentation help bar : ( model -- gadget ) - [ [ presentation-object summary ] [ "" ] if* ] - dup reverse-video-theme ; + [ + [ presentation-object summary ] [ "" ] if* + ] dup reverse-video-theme ; : ( gadget quot -- button ) [ call-listener ] curry ; @@ -87,7 +81,7 @@ presentation H{ over specified-font over set-label-font ; : apply-presentation-style ( style gadget -- style gadget ) - presented [ ] apply-style ; + presented [ ] apply-style ; : apply-quotation-style ( style gadget -- style gadget ) quotation [ ] apply-style ; diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor index d77689de18..44c8d96772 100644 --- a/library/ui/gestures.factor +++ b/library/ui/gestures.factor @@ -152,8 +152,6 @@ SYMBOL: scroll-direction hand-gadget get-global hand-clicked set-global hand-loc get-global hand-click-loc set-global ; -SYMBOL: menu-mode? - : move-hand ( loc world -- ) dup hand-world set-global under-hand >r over hand-loc set-global diff --git a/library/ui/load.factor b/library/ui/load.factor index ba14d4096d..a14c525d11 100644 --- a/library/ui/load.factor +++ b/library/ui/load.factor @@ -49,6 +49,7 @@ PROVIDE: library/ui { "tools/operations.factor" "text/editor.facts" } { + "test/editor.factor" "test/gadgets.factor" "test/models.factor" "test/document.factor" @@ -57,7 +58,7 @@ PROVIDE: library/ui { "test/rectangles.factor" "test/commands.factor" "test/panes.factor" - "test/editor.factor" + "test/presentations.factor" "test/search.factor" "test/sliders.factor" "test/tracks.factor" diff --git a/library/ui/test/presentations.factor b/library/ui/test/presentations.factor new file mode 100644 index 0000000000..217a2b39ee --- /dev/null +++ b/library/ui/test/presentations.factor @@ -0,0 +1,15 @@ +IN: temporary +USING: math gadgets-presentations gadgets generic test +prettyprint gadgets-buttons io kernel ; + +[ t ] [ + "Hi" \ + [ gadget? ] is? +] unit-test + +[ "+" ] [ + [ + \ + + "Test" f [ pprint ] + dup button-quot call + ] string-out +] unit-test diff --git a/library/ui/tools/dataflow.factor b/library/ui/tools/dataflow.factor index 5965b08450..9851fd5a9a 100644 --- a/library/ui/tools/dataflow.factor +++ b/library/ui/tools/dataflow.factor @@ -106,12 +106,12 @@ M: #push node-presents >#push< first ; [ length ] keep [ >r number>string "Child " swap append