basis/ui/gadgets/presentations/presentations.factor

   1 ! Copyright (C) 2005, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays accessors definitions hashtables io kernel sequences
   4 strings words math models namespaces quotations ui.gadgets
   5 ui.gadgets.borders ui.gadgets.buttons ui.gadgets.buttons.private
   6 ui.gadgets.labels ui.gadgets.menus ui.gadgets.worlds
   7 ui.gadgets.status-bar ui.commands ui.operations ui.gestures ;
   8 IN: ui.gadgets.presentations
   9
  10 TUPLE: presentation < button object hook ;
  11
  12 : invoke-presentation ( presentation command -- )
  13     [ [ dup hook>> call( presentation -- ) ] [ object>> ] bi ] dip
  14     invoke-command ;
  15
  16 : invoke-primary ( presentation -- )
  17     dup object>> primary-operation
  18     invoke-presentation ;
  19
  20 : invoke-secondary ( presentation -- )
  21     dup object>> secondary-operation
  22     invoke-presentation ;
  23
  24 : show-mouse-help ( presentation -- )
  25     [ [ object>> ] keep show-summary ] [ button-update ] bi ;
  26
  27 : <presentation> ( label object -- button )
  28     swap [ invoke-primary ] presentation new-button
  29         swap >>object
  30         [ drop ] >>hook
  31         roll-button-theme ;
  32
  33 M: presentation ungraft*
  34     dup hand-gadget get-global child? [ dup hide-status ] when
  35     call-next-method ;
  36
  37 : show-presentation-menu ( presentation -- )
  38     [ ] [ object>> ] [ dup hook>> curry ] tri
  39     show-operations-menu ;
  40
  41 presentation H{
  42     { T{ button-down f f 3 } [ show-presentation-menu ] }
  43     { mouse-leave [ [ hide-status ] [ button-update ] bi ] }
  44     { mouse-enter [ show-mouse-help ] }
  45     ! Responding to motion too allows nested presentations to
  46     ! display status help properly, when the mouse leaves a
  47     ! nested presentation and is still inside the parent, the
  48     ! parent doesn't receive a mouse-enter
  49     { motion [ show-mouse-help ] }
  50 } set-gestures