From 07881295c535c17429c714dea54de565d648c413 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 14 Jul 2008 17:16:51 -0500 Subject: [PATCH 1/8] ui.gadgets.slots: rewrite --- extra/ui/gadgets/slots/slots.factor | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/extra/ui/gadgets/slots/slots.factor b/extra/ui/gadgets/slots/slots.factor index 2c2831a2ee..7d488c727b 100755 --- a/extra/ui/gadgets/slots/slots.factor +++ b/extra/ui/gadgets/slots/slots.factor @@ -69,15 +69,13 @@ M: value-ref finish-editing } define-command : ( ref -- gadget ) - { 0 1 } slot-editor new-track - swap >>ref - [ - toolbar, - g-> set-slot-editor-text - 1 track, - ] make-gadget + { 0 1 } slot-editor new-track + swap >>ref + dup f track-add* + >>text + dup text>> 1 track-add* dup revert ; - + M: slot-editor pref-dim* call-next-method { 600 200 } vmin ; M: slot-editor focusable-child* text>> ; From 7a5199d01067be647f74307c5fdd00e4cca79459 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 14 Jul 2008 17:19:44 -0500 Subject: [PATCH 2/8] ui.gadgets.buttons: remove 'toolbar,' --- extra/ui/gadgets/buttons/buttons.factor | 2 -- 1 file changed, 2 deletions(-) diff --git a/extra/ui/gadgets/buttons/buttons.factor b/extra/ui/gadgets/buttons/buttons.factor index 4c4efec20f..8fa0e65a29 100755 --- a/extra/ui/gadgets/buttons/buttons.factor +++ b/extra/ui/gadgets/buttons/buttons.factor @@ -230,5 +230,3 @@ M: radio-control model-changed swap "toolbar" over class command-map commands>> swap [ -rot add-gadget ] curry assoc-each ; - -: toolbar, ( -- ) g f track, ; From 4809a69d7fbecfc6677d34ca2fa7c9ebdc681f2c Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 14 Jul 2008 17:33:03 -0500 Subject: [PATCH 3/8] ui.tools.listener: rewrite --- extra/ui/tools/listener/listener.factor | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/extra/ui/tools/listener/listener.factor b/extra/ui/tools/listener/listener.factor index f6d9f54efd..c34061cf43 100755 --- a/extra/ui/tools/listener/listener.factor +++ b/extra/ui/tools/listener/listener.factor @@ -12,9 +12,9 @@ IN: ui.tools.listener TUPLE: listener-gadget < track input output stack ; -: listener-output, ( -- ) - g-> set-listener-gadget-output - "Output" 1 track, ; +: listener-output, ( listener -- listener ) + >>output + dup output>> "Output" 1 track-add* ; : listener-streams ( listener -- input output ) [ input>> ] [ output>> ] bi ; @@ -22,10 +22,12 @@ TUPLE: listener-gadget < track input output stack ; : ( listener -- gadget ) output>> ; -: listener-input, ( -- ) - g g-> set-listener-gadget-input +: listener-input, ( listener -- listener ) + dup >>input + dup input>> { 0 100 } - "Input" f track, ; + "Input" + f track-add* ; : welcome. ( -- ) "If this is your first time with Factor, please read the " print @@ -169,10 +171,11 @@ M: stack-display tool-scroller f swap set-listener-gadget-stack ; : ( -- gadget ) - { 0 1 } listener-gadget new-track + { 0 1 } listener-gadget new-track dup init-listener - [ listener-output, listener-input, ] make-gadget ; - + listener-output, + listener-input, ; + : listener-help ( -- ) "ui-listener" help-window ; \ listener-help H{ { +nullary+ t } } define-command From 779dbb9ee69a822c30c64a45838b877ebb700eb2 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 14 Jul 2008 17:48:21 -0500 Subject: [PATCH 4/8] ui.gadgets.grids: grid-add* --- extra/ui/gadgets/grids/grids.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/extra/ui/gadgets/grids/grids.factor b/extra/ui/gadgets/grids/grids.factor index 474e6b95c0..f934ae5fa6 100644 --- a/extra/ui/gadgets/grids/grids.factor +++ b/extra/ui/gadgets/grids/grids.factor @@ -24,6 +24,8 @@ grid >r >r 2dup swap add-gadget drop r> r> 3dup grid-child unparent rot grid>> nth set-nth ; +: grid-add* ( grid child i j -- grid ) >r >r dupd swap r> r> grid-add ; + : grid-remove ( grid i j -- ) >r >r >r r> r> r> grid-add ; From 199a7580d6af52ce823c6512d60bf3b22f0420e1 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 14 Jul 2008 17:48:59 -0500 Subject: [PATCH 5/8] ui.gadgets.scrollers: rewrite new-scroller --- extra/ui/gadgets/scrollers/scrollers.factor | 30 ++++++++------------- 1 file changed, 11 insertions(+), 19 deletions(-) diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/extra/ui/gadgets/scrollers/scrollers.factor index 1fe3c606bb..f45f40c805 100755 --- a/extra/ui/gadgets/scrollers/scrollers.factor +++ b/extra/ui/gadgets/scrollers/scrollers.factor @@ -29,30 +29,22 @@ scroller H{ { T{ mouse-scroll } [ do-mouse-scroll ] } } set-gestures -: viewport, ( child -- ) - g model>> - g-> set-scroller-viewport @center frame, ; - : ( -- model ) 0 0 0 0 0 0 0 0 2array ; -: x-model ( -- model ) g model>> dependencies>> first ; - -: y-model ( -- model ) g model>> dependencies>> second ; - : new-scroller ( gadget class -- scroller ) - new-frame - t >>root? - >>model - faint-boundary - [ - x-model g-> set-scroller-x @bottom frame, - y-model g-> set-scroller-y @right frame, - viewport, - ] make-gadget ; + new-frame + t >>root? + >>model + faint-boundary -: ( gadget -- scroller ) - scroller new-scroller ; + dup model>> dependencies>> first >>x dup x>> @bottom grid-add* + dup model>> dependencies>> second >>y dup y>> @right grid-add* + + swap over model>> >>viewport + dup viewport>> @center grid-add* ; + +: ( gadget -- scroller ) scroller new-scroller ; : scroll ( value scroller -- ) [ From 595b40b5063e44b3a45045a97a240bdb50663a29 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 14 Jul 2008 18:00:29 -0500 Subject: [PATCH 6/8] ui.gadgets.tabs: rewrite --- extra/ui/gadgets/tabs/tabs.factor | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/extra/ui/gadgets/tabs/tabs.factor b/extra/ui/gadgets/tabs/tabs.factor index ce7e68c622..d9e322eed3 100755 --- a/extra/ui/gadgets/tabs/tabs.factor +++ b/extra/ui/gadgets/tabs/tabs.factor @@ -48,9 +48,13 @@ DEFER: (del-page) [ names>> index ] 2keep (del-page) ; : ( assoc -- tabbed ) - tabbed new-frame - [ g 0 >>model - 1 >>fill [ >>toggler ] keep swap @left grid-add - [ keys >vector g swap >>names ] - [ values g model>> [ >>content ] keep swap @center grid-add ] bi - g redo-toggler g ] with-gadget ; + tabbed new-frame + 0 >>model + 1 >>fill >>toggler + dup toggler>> @left grid-add* + swap + [ keys >vector >>names ] + [ values over model>> >>content dup content>> @center grid-add* ] + bi + dup redo-toggler ; + From 18d19fec928189a19aa8e36c5a7e9be44fd15495 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 14 Jul 2008 18:20:44 -0500 Subject: [PATCH 7/8] ui.tools-tests: fix test --- extra/ui/tools/tools-tests.factor | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/extra/ui/tools/tools-tests.factor b/extra/ui/tools/tools-tests.factor index 47b0d51705..0120ecb92f 100755 --- a/extra/ui/tools/tools-tests.factor +++ b/extra/ui/tools/tools-tests.factor @@ -5,12 +5,10 @@ ui.gadgets.labelled ui.gadgets.presentations ui.gadgets.scrollers vocabs tools.test.ui ui ; IN: ui.tools.tests +[ f ] [ - [ f ] [ - 0 [ set-gadget-model ] keep gadget set - gadget-children empty? - ] unit-test -] with-scope + 0 >>model children>> empty? +] unit-test [ ] [ "w" set ] unit-test [ ] [ "w" get com-scroll-up ] unit-test From c7ed4dd67932fb97cedd4d2735fcbcfa62f865b0 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 14 Jul 2008 18:24:55 -0500 Subject: [PATCH 8/8] ui.gadgets.sliders: refactor --- extra/ui/gadgets/sliders/sliders.factor | 33 ++++++++++--------------- 1 file changed, 13 insertions(+), 20 deletions(-) diff --git a/extra/ui/gadgets/sliders/sliders.factor b/extra/ui/gadgets/sliders/sliders.factor index 641883e7e1..7904a9ab66 100755 --- a/extra/ui/gadgets/sliders/sliders.factor +++ b/extra/ui/gadgets/sliders/sliders.factor @@ -138,10 +138,11 @@ M: elevator layout* [ swap find-slider slide-by-line ] curry [ set-gadget-orientation ] keep ; -: elevator, ( orientation -- ) - dup g-> set-slider-elevator - swap g-> set-slider-thumb add-gadget - @center frame, ; +: elevator, ( gadget orientation -- gadget ) + tuck >>elevator + swap >>thumb + dup elevator>> over thumb>> add-gadget + @center grid-add* ; : ( -- button ) { 0 1 } arrow-left -1 ; @@ -149,26 +150,12 @@ M: elevator layout* : ( -- button ) { 0 1 } arrow-right 1 ; -: build-x-slider ( slider -- slider ) - [ - @left frame, - { 0 1 } elevator, - @right frame, - ] make-gadget ; inline - : ( -- button ) { 1 0 } arrow-up -1 ; : ( -- button ) { 1 0 } arrow-down 1 ; -: build-y-slider ( slider -- slider ) - [ - @top frame, - { 1 0 } elevator, - @bottom frame, - ] make-gadget ; inline - : ( range orientation -- slider ) slider new-frame swap >>orientation @@ -176,10 +163,16 @@ M: elevator layout* 32 >>line ; : ( range -- slider ) - { 1 0 } build-x-slider ; + { 1 0 } + @left grid-add* + { 0 1 } elevator, + @right grid-add* ; : ( range -- slider ) - { 0 1 } build-y-slider ; + { 0 1 } + @top grid-add* + { 1 0 } elevator, + @bottom grid-add* ; M: slider pref-dim* dup call-next-method