Multi-window code cleanups

slava 2006-03-25 03:58:03 +00:00
parent 38602d63b9
commit 3f77d6eb65
10 changed files with 23 additions and 21 deletions

View File

@ -171,7 +171,7 @@ IN: gadgets
: redraw-world ( handle -- )
world-handle 1 [setNeedsDisplay:] ;
: in-window ( world title -- )
: open-window* ( world title -- )
>r <FactorView> r> <ViewWindow> [contentView] [release] ;
: select-gl-context ( handle -- )

View File

@ -8,14 +8,14 @@ H{ } clone components set-global
: get-components ( class -- assoc )
components get-global hash [ { } ] unless*
{ "Slots" [ describe ] } append ;
{ "Slots" [ describe ] } add ;
{
{ "Definition" [ help ] }
{ "Calls in" [ usage. ] }
{ "Calls out" [ uses. ] }
} word components get-global set-hash
} \ word components get-global set-hash
{
{ "Documentation" [ help ] }
} link components get-global set-hash
} \ link components get-global set-hash

View File

@ -5,7 +5,7 @@ DEFER: draw-world ! defined in world.factor
: redraw-world ( world -- ) draw-world ;
DEFER: in-window ( world title -- )
DEFER: open-window* ( world title -- )
DEFER: select-gl-context ( handle -- )

View File

@ -3,7 +3,7 @@
IN: gadgets-browser
USING: arrays components gadgets gadgets-buttons gadgets-labels
gadgets-layouts gadgets-panes gadgets-scrolling gadgets-theme
hashtables help inspector kernel lists math namespaces
generic hashtables help inspector kernel lists math namespaces
prettyprint sequences words ;
TUPLE: book page pages ;
@ -17,8 +17,7 @@ TUPLE: book page pages ;
C: book ( pages -- book )
dup delegate>gadget
[ set-book-pages ] 2keep
[ >r first r> show-page ] keep
[ show-page ] keep ;
[ >r first first r> show-page ] keep ;
M: book pref-dim* ( book -- dim )
book-pages { 0 0 0 } [ second pref-dim vmax ] reduce ;
@ -27,7 +26,7 @@ M: book layout* ( book -- )
dup rect-dim swap book-page set-gadget-dim ;
: component-pages ( obj -- assoc )
dup get-components
dup class get-components
[ first2 swapd make-pane <scroller> 2array ] map-with ;
: <tab> ( name book -- button )
@ -65,8 +64,7 @@ C: browser ( obj -- browser )
TUPLE: browser-button object ;
: browser-window ( obj -- )
<browser> "Browser" simple-window ;
: browser-window ( obj -- ) <browser> "Browser" open-window ;
: browser-button-action ( button -- )
[ browser-button-object ] keep find-browser

View File

@ -35,5 +35,5 @@ hashtables kernel math namespaces queues sequences threads ;
: <status-bar> ( -- gadget ) "" <label> dup highlight-theme ;
: simple-window ( gadget title -- )
>r <status-bar> <world> dup prefer r> in-window ;
: open-window ( gadget title -- )
>r <status-bar> <world> dup prefer r> open-window* ;

View File

@ -91,7 +91,7 @@ M: gadget focusable-child* drop t ;
: focusable-child ( gadget -- gadget )
dup focusable-child*
dup t = [ drop ] [ nip focusable-child ] if ;
dup t eq? [ drop ] [ nip focusable-child ] if ;
IN: gadgets-layouts

View File

@ -9,8 +9,8 @@ namespaces sequences ;
make-pile 1 over set-pack-fill { 5 5 0 } over set-pack-gap
<default-border> dup highlight-theme ;
: scratch-window ( quot -- )
make-pane <scroller> "Scratch" simple-window ;
: pane-window ( quot title -- )
>r make-pane <scroller> r> open-window ;
: handbook-window ( -- )
T{ link f "handbook" } browser-window ;
@ -23,12 +23,12 @@ namespaces sequences ;
{ "Listener" [ listener-window ] }
{ "Documentation" [ handbook-window ] }
{ "Tutorial" [ tutorial-window ] }
{ "Vocabularies" [ [ vocabs. ] scratch-window ] }
{ "Vocabularies" [ [ vocabs. ] "Vocabularies" pane-window ] }
{ "Globals" [ global browser-window ] }
{ "Memory" [ [ heap-stats. terpri room. ] scratch-window ] }
{ "Memory" [ [ heap-stats. terpri room. ] "Memory" pane-window ] }
{ "Save image" [ save ] }
{ "Exit" [ 0 exit ] }
} <launchpad> ;
: launchpad-window ( -- )
default-launchpad "Factor" simple-window ;
default-launchpad "Factor" open-window ;

View File

@ -53,5 +53,8 @@ C: listener-gadget ( -- gadget )
M: listener-gadget pref-dim* drop { 600 600 0 } ;
M: listener-gadget focusable-child* ( listener -- gadget )
listener-gadget-pane ;
: listener-window ( -- )
<listener-gadget> "Listener" simple-window ;

View File

@ -27,7 +27,8 @@ C: world ( gadget status -- world )
t over set-gadget-root?
H{ } clone over set-world-fonts
[ add-status ] keep
[ @center frame-add ] keep ;
[ @center frame-add ] 2keep
swap request-focus ;
GENERIC: find-world ( gadget -- world )

View File

@ -110,7 +110,7 @@ M: world client-event ( event world -- )
IN: gadgets
: in-window ( world title -- ) swap gadget-window set-title ;
: open-window* ( world title -- ) swap gadget-window set-title ;
: select-gl-context ( handle -- )
dpy get swap first2 glXMakeCurrent