From c314cb727fdccf726290ee0ff0bc0478d737365f Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 16 Jul 2008 22:10:09 -0500 Subject: [PATCH 1/6] display-stack: stack display with support for watched variables --- extra/display-stack/display-stack.factor | 41 ++++++++++++++++++++++++ 1 file changed, 41 insertions(+) create mode 100644 extra/display-stack/display-stack.factor diff --git a/extra/display-stack/display-stack.factor b/extra/display-stack/display-stack.factor new file mode 100644 index 0000000000..161cd6760d --- /dev/null +++ b/extra/display-stack/display-stack.factor @@ -0,0 +1,41 @@ + +USING: kernel namespaces sequences math + listener io prettyprint sequences.lib fry ; + +IN: display-stack + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: watched-variables + +: watch-var ( sym -- ) watched-variables get push ; + +: watch-vars ( sym -- ) watched-variables get [ push ] curry each ; + +: unwatch-var ( sym -- ) watched-variables get delete ; + +: print-watched-variables ( -- ) + watched-variables get length 0 > + [ + "----------" print + watched-variables get + watched-variables get [ unparse ] map longest length 2 + + '[ [ unparse ": " append , 32 pad-right write ] [ get . ] bi ] + each + + ] + when ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: display-stack ( -- ) + V{ } clone watched-variables set + [ + print-watched-variables + "----------" print + .s + "----------" print + retainstack reverse stack. + ] + listener-hook set ; + From c73264863df50c2bebf7636c189bae49932b5a01 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 17 Jul 2008 16:45:39 -0500 Subject: [PATCH 2/6] self.slots: syntax for accessing slots of an object stored in the self variable --- extra/self/slots/slots.factor | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 extra/self/slots/slots.factor diff --git a/extra/self/slots/slots.factor b/extra/self/slots/slots.factor new file mode 100644 index 0000000000..b07641a062 --- /dev/null +++ b/extra/self/slots/slots.factor @@ -0,0 +1,27 @@ + +USING: kernel words lexer parser sequences accessors self ; + +IN: self.slots + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: define-self-slot-reader ( slot -- ) + [ "->" append current-vocab create dup set-word ] + [ ">>" append search [ self> ] swap suffix ] bi + (( -- value )) define-declared ; + +: define-self-slot-writer ( slot -- ) + [ "->" prepend current-vocab create dup set-word ] + [ ">>" prepend search [ self> swap ] swap suffix [ drop ] append ] bi + (( value -- )) define-declared ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: define-self-slot-accessors ( class -- ) + "slots" word-prop + [ name>> ] map + [ [ define-self-slot-reader ] [ define-self-slot-writer ] bi ] each ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: SELF-SLOTS: scan-word define-self-slot-accessors ; parsing \ No newline at end of file From 897066f8a59911bc2f5aa6aefc4ebcace16ceb6a Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 17 Jul 2008 18:23:04 -0500 Subject: [PATCH 3/6] ui.gadgets.slate: slate inherits from gadget --- extra/ui/gadgets/slate/slate.factor | 31 +++++++++++++++++------------ 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/extra/ui/gadgets/slate/slate.factor b/extra/ui/gadgets/slate/slate.factor index ab2abeec5b..88437863df 100644 --- a/extra/ui/gadgets/slate/slate.factor +++ b/extra/ui/gadgets/slate/slate.factor @@ -1,29 +1,34 @@ -USING: kernel namespaces opengl ui.render ui.gadgets ; +USING: kernel namespaces opengl ui.render ui.gadgets accessors ; IN: ui.gadgets.slate -TUPLE: slate action dim graft ungraft +! TUPLE: slate action dim graft ungraft +! button-down +! button-up +! key-down +! key-up ; + +TUPLE: slate < gadget + action pdim graft ungraft button-down button-up key-down key-up ; : ( action -- slate ) - slate construct-gadget - tuck set-slate-action - { 100 100 } over set-slate-dim - [ ] over set-slate-graft - [ ] over set-slate-ungraft ; + slate new-gadget + swap >>action + { 100 100 } >>pdim + [ ] >>graft + [ ] >>ungraft ; -M: slate pref-dim* ( slate -- dim ) slate-dim ; +M: slate pref-dim* ( slate -- dim ) pdim>> ; -M: slate draw-gadget* ( slate -- ) - origin get swap slate-action with-translation ; +M: slate draw-gadget* ( slate -- ) origin get swap action>> with-translation ; -M: slate graft* ( slate -- ) slate-graft call ; - -M: slate ungraft* ( slate -- ) slate-ungraft call ; +M: slate graft* ( slate -- ) graft>> call ; +M: slate ungraft* ( slate -- ) ungraft>> call ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From d83fcea9935150234632bed4874e9d1a8dd43053 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 17 Jul 2008 18:29:58 -0500 Subject: [PATCH 4/6] display-stack: some improvements --- extra/display-stack/display-stack.factor | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/extra/display-stack/display-stack.factor b/extra/display-stack/display-stack.factor index 161cd6760d..8da252f294 100644 --- a/extra/display-stack/display-stack.factor +++ b/extra/display-stack/display-stack.factor @@ -10,10 +10,12 @@ SYMBOL: watched-variables : watch-var ( sym -- ) watched-variables get push ; -: watch-vars ( sym -- ) watched-variables get [ push ] curry each ; +: watch-vars ( seq -- ) watched-variables get [ push ] curry each ; : unwatch-var ( sym -- ) watched-variables get delete ; +: unwatch-vars ( seq -- ) watched-variables get [ delete ] curry each ; + : print-watched-variables ( -- ) watched-variables get length 0 > [ @@ -33,9 +35,9 @@ SYMBOL: watched-variables [ print-watched-variables "----------" print - .s + datastack [ . ] each "----------" print - retainstack reverse stack. + retainstack reverse [ . ] each ] listener-hook set ; From de09c1e2d9a6893afb3a093eb884ae29b7ac6951 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 17 Jul 2008 18:30:19 -0500 Subject: [PATCH 5/6] 'dim' slot of slate was renamed to 'pdim'. Update usages. --- extra/automata/ui/ui.factor | 2 +- extra/boids/ui/ui.factor | 2 +- extra/cfdg/cfdg.factor | 2 +- extra/golden-section/golden-section.factor | 2 +- extra/lsys/ui/ui.factor | 2 +- extra/springies/ui/ui.factor | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/extra/automata/ui/ui.factor b/extra/automata/ui/ui.factor index 78f1074eb8..808e476ffa 100644 --- a/extra/automata/ui/ui.factor +++ b/extra/automata/ui/ui.factor @@ -83,7 +83,7 @@ DEFER: automata-window @top grid-add C[ display ] - { 400 400 } >>dim + { 400 400 } >>pdim dup >slate @center grid-add diff --git a/extra/boids/ui/ui.factor b/extra/boids/ui/ui.factor index f45b1cc0ff..fff0e0d33b 100755 --- a/extra/boids/ui/ui.factor +++ b/extra/boids/ui/ui.factor @@ -102,7 +102,7 @@ VARS: population-label cohesion-label alignment-label separation-label ; C[ display ] >slate t slate> set-gadget-clipped? - { 600 400 } slate> set-slate-dim + { 600 400 } slate> set-slate-pdim C[ [ run ] in-thread ] slate> set-slate-graft C[ loop off ] slate> set-slate-ungraft diff --git a/extra/cfdg/cfdg.factor b/extra/cfdg/cfdg.factor index 63fd55a550..2dfa7fae8f 100644 --- a/extra/cfdg/cfdg.factor +++ b/extra/cfdg/cfdg.factor @@ -204,7 +204,7 @@ VAR: start-shape : cfdg-window* ( -- ) [ display ] closed-quot - { 500 500 } over set-slate-dim + { 500 500 } over set-slate-pdim dup "CFDG" open-window ; : cfdg-window ( -- ) [ cfdg-window* ] with-ui ; \ No newline at end of file diff --git a/extra/golden-section/golden-section.factor b/extra/golden-section/golden-section.factor index ef6f1ca4c2..354d4d9116 100644 --- a/extra/golden-section/golden-section.factor +++ b/extra/golden-section/golden-section.factor @@ -57,7 +57,7 @@ IN: golden-section : golden-section-window ( -- ) [ [ display ] - { 600 600 } over set-slate-dim + { 600 600 } over set-slate-pdim "Golden Section" open-window ] with-ui ; diff --git a/extra/lsys/ui/ui.factor b/extra/lsys/ui/ui.factor index f7ec181f61..6fd7b4bd40 100644 --- a/extra/lsys/ui/ui.factor +++ b/extra/lsys/ui/ui.factor @@ -158,7 +158,7 @@ DEFER: empty-model : lsys-viewer ( -- ) [ ] >slate -{ 400 400 } clone slate> set-slate-dim +{ 400 400 } clone slate> set-slate-pdim { diff --git a/extra/springies/ui/ui.factor b/extra/springies/ui/ui.factor index 365632e974..f2248ba6f2 100644 --- a/extra/springies/ui/ui.factor +++ b/extra/springies/ui/ui.factor @@ -51,7 +51,7 @@ DEFER: maybe-loop : springies-window* ( -- ) C[ display ] >slate - { 800 600 } slate> set-slate-dim + { 800 600 } slate> set-slate-pdim C[ { 500 500 } >world-size loop on [ run ] in-thread ] slate> set-slate-graft C[ loop off ] slate> set-slate-ungraft From c4665903ae2630fc693dc739091b0f0c982123ad Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 17 Jul 2008 18:45:06 -0500 Subject: [PATCH 6/6] ui.gadgets.slate: remove a bunch of old code --- extra/ui/gadgets/slate/slate.factor | 108 +--------------------------- 1 file changed, 1 insertion(+), 107 deletions(-) diff --git a/extra/ui/gadgets/slate/slate.factor b/extra/ui/gadgets/slate/slate.factor index 88437863df..2ef740e580 100644 --- a/extra/ui/gadgets/slate/slate.factor +++ b/extra/ui/gadgets/slate/slate.factor @@ -3,18 +3,7 @@ USING: kernel namespaces opengl ui.render ui.gadgets accessors ; IN: ui.gadgets.slate -! TUPLE: slate action dim graft ungraft -! button-down -! button-up -! key-down -! key-up ; - -TUPLE: slate < gadget - action pdim graft ungraft - button-down - button-up - key-down - key-up ; +TUPLE: slate < gadget action pdim graft ungraft ; : ( action -- slate ) slate new-gadget @@ -30,98 +19,3 @@ M: slate draw-gadget* ( slate -- ) origin get swap action>> with-translation ; M: slate graft* ( slate -- ) graft>> call ; M: slate ungraft* ( slate -- ) ungraft>> call ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: key-pressed-value - -: key-pressed? ( -- ? ) key-pressed-value get ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: mouse-pressed-value - -: mouse-pressed? ( -- ? ) mouse-pressed-value get ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: key-value - -: key ( -- key ) key-value get ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: button-value - -: button ( -- val ) button-value get ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USING: combinators ui.gestures accessors ; - -! M: slate handle-gesture* ( gadget gesture delegate -- ? ) -! drop nip -! { -! { -! [ dup key-down? ] -! [ - -! key-down-sym key-value set -! key-pressed-value on -! t -! ] -! } -! { [ dup key-up? ] [ drop key-pressed-value off t ] } -! { -! [ dup button-down? ] -! [ -! button-down-# mouse-button-value set -! mouse-pressed-value on -! t -! ] -! } -! { [ dup button-up? ] [ drop mouse-pressed-value off t ] } -! { [ t ] [ drop t ] } -! } -! cond ; - -M: slate handle-gesture* ( gadget gesture delegate -- ? ) - rot drop swap ! delegate gesture - { - { - [ dup key-down? ] - [ - key-down-sym key-value set - key-pressed-value on - key-down>> dup [ call ] [ drop ] if - t - ] - } - { - [ dup key-up? ] - [ - key-pressed-value off - drop - key-up>> dup [ call ] [ drop ] if - t - ] } - { - [ dup button-down? ] - [ - button-down-# button-value set - mouse-pressed-value on - button-down>> dup [ call ] [ drop ] if - t - ] - } - { - [ dup button-up? ] - [ - mouse-pressed-value off - drop - button-up>> dup [ call ] [ drop ] if - t - ] - } - { [ t ] [ 2drop t ] } - } - cond ; \ No newline at end of file