2005-03-01 22:19:26 -05:00
|
|
|
! Copyright (C) 2005 Slava Pestov.
|
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
|
IN: gadgets
|
2005-03-02 21:26:11 -05:00
|
|
|
USING: kernel memory namespaces stdio ;
|
2005-03-01 22:19:26 -05:00
|
|
|
|
|
|
|
|
SYMBOL: root-menu
|
|
|
|
|
|
|
|
|
|
: show-root-menu ( -- )
|
|
|
|
|
root-menu get <menu> show-menu ;
|
|
|
|
|
|
2005-03-02 21:26:11 -05:00
|
|
|
: <console> ( -- console )
|
2005-03-06 19:46:29 -05:00
|
|
|
<console-pane> <scroller> ;
|
2005-03-02 21:26:11 -05:00
|
|
|
|
2005-03-01 22:19:26 -05:00
|
|
|
[
|
2005-03-06 19:46:29 -05:00
|
|
|
[[ "Listener" [ <console> "Listener" <tile> world get add-gadget ] ]]
|
2005-03-01 22:19:26 -05:00
|
|
|
[[ "Globals" [ global inspect ] ]]
|
|
|
|
|
[[ "Save image" [ "image" get save-image ] ]]
|
|
|
|
|
[[ "Exit" [ f world get set-world-running? ] ]]
|
|
|
|
|
] root-menu set
|
|
|
|
|
|
2005-03-06 19:46:29 -05:00
|
|
|
world get [
|
|
|
|
|
! Note that we check if the user explicitly clicked the
|
|
|
|
|
! world, to avoid showing the root menu on gadgets that
|
|
|
|
|
! don't explicitly handle mouse clicks.
|
|
|
|
|
hand hand-clicked eq? [ show-root-menu ] when
|
|
|
|
|
] [ button-down 1 ] set-action
|
