From 225c49509903040755895cd5989d48b00f081439 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 4 Aug 2008 21:13:14 -0500 Subject: [PATCH 1/3] cfdg: Use OpenGL display lists --- extra/cfdg/cfdg.factor | 54 +++++++++++++++++++++++++++++++++++------- 1 file changed, 46 insertions(+), 8 deletions(-) diff --git a/extra/cfdg/cfdg.factor b/extra/cfdg/cfdg.factor index d821b7c180..866400c9bc 100644 --- a/extra/cfdg/cfdg.factor +++ b/extra/cfdg/cfdg.factor @@ -130,7 +130,7 @@ VAR: threshold ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: recursive ( quot -- ) iterate? swap when ; +: recursive ( quot -- ) iterate? swap when ; inline : multi ( seq -- ) random-weighted* call ; @@ -155,6 +155,28 @@ VAR: start-shape : set-initial-color ( -- ) T{ hsva f 0 0 0 1 } clone >self ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: dlist + +! : build-model-dlist ( -- ) +! 1 glGenLists dlist set +! dlist get GL_COMPILE_AND_EXECUTE glNewList +! start-shape> call +! glEndList ; + +: build-model-dlist ( -- ) + 1 glGenLists dlist set + dlist get GL_COMPILE_AND_EXECUTE glNewList + + set-initial-color + + self> set-color + + start-shape> call + + glEndList ; + : display ( -- ) GL_PROJECTION glMatrixMode @@ -172,15 +194,31 @@ VAR: start-shape init-modelview-matrix-stack init-color-stack - set-initial-color + dlist get not + [ build-model-dlist ] + [ dlist get glCallList ] + if ; - self> set-color - - start-shape> call ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : cfdg-window* ( -- ) - [ display ] closed-quot - { 500 500 } over set-slate-pdim + C[ display ] + { 500 500 } >>pdim + C[ dlist get [ dlist get 1 glDeleteLists ] when ] >>ungraft dup "CFDG" open-window ; -: cfdg-window ( -- ) [ cfdg-window* ] with-ui ; \ No newline at end of file +: cfdg-window ( -- ) [ cfdg-window* ] with-ui ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: ( -- slate ) + C[ display ] + { 500 500 } >>pdim + C[ dlist get [ dlist get 1 glDeleteLists ] when ] >>ungraft ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +USE: fry + +: cfdg-window. ( quot -- ) + '[ [ @ "CFDG" open-window ] with-scope ] with-ui ; \ No newline at end of file From 5dac9657e637b39fad02bc883ccc982f5e82da48 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 4 Aug 2008 21:14:53 -0500 Subject: [PATCH 2/3] Update many cfdg models --- extra/cfdg/models/aqua-star/aqua-star.factor | 13 +++++++------ extra/cfdg/models/chiaroscuro/chiaroscuro.factor | 13 +++++++------ extra/cfdg/models/flower6/flower6.factor | 13 +++++++------ extra/cfdg/models/game1-turn6/game1-turn6.factor | 13 +++++++------ extra/cfdg/models/lesson/lesson.factor | 13 +++++++------ extra/cfdg/models/rules08/rules08.factor | 7 ++++--- extra/cfdg/models/sierpinski/sierpinski.factor | 16 +++++++--------- extra/cfdg/models/snowflake/snowflake.factor | 13 +++++++------ extra/cfdg/models/spirales/spirales.factor | 7 ++++--- 9 files changed, 57 insertions(+), 51 deletions(-) diff --git a/extra/cfdg/models/aqua-star/aqua-star.factor b/extra/cfdg/models/aqua-star/aqua-star.factor index f692328515..dbb7eb5ed0 100644 --- a/extra/cfdg/models/aqua-star/aqua-star.factor +++ b/extra/cfdg/models/aqua-star/aqua-star.factor @@ -25,11 +25,12 @@ iterate? [ ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: run ( -- ) -[ -1 b ] >background -{ -60 140 -120 140 } viewport set -0.1 threshold set -[ anemone-begin ] start-shape set -cfdg-window ; +: init ( -- ) + [ -1 b ] >background + { -60 140 -120 140 } >viewport + 0.1 >threshold + [ anemone-begin ] >start-shape ; + +: run ( -- ) [ init ] cfdg-window. ; MAIN: run diff --git a/extra/cfdg/models/chiaroscuro/chiaroscuro.factor b/extra/cfdg/models/chiaroscuro/chiaroscuro.factor index 31f78c459e..1034f1527b 100644 --- a/extra/cfdg/models/chiaroscuro/chiaroscuro.factor +++ b/extra/cfdg/models/chiaroscuro/chiaroscuro.factor @@ -29,11 +29,12 @@ DEFER: white ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: run ( -- ) -[ -0.5 b ] >background -{ -3 6 -2 6 } viewport set -0.01 threshold set -[ chiaroscuro ] start-shape set -cfdg-window ; +: init ( -- ) + [ -0.5 b ] >background + { -3 6 -2 6 } >viewport + 0.01 >threshold + [ chiaroscuro ] >start-shape ; + +: run ( -- ) [ init ] cfdg-window. ; MAIN: run diff --git a/extra/cfdg/models/flower6/flower6.factor b/extra/cfdg/models/flower6/flower6.factor index b77968c863..91fecd7fe5 100644 --- a/extra/cfdg/models/flower6/flower6.factor +++ b/extra/cfdg/models/flower6/flower6.factor @@ -18,12 +18,13 @@ iterate? [ ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: run ( -- ) -[ ] >background -{ -1 2 -1 2 } viewport set -0.01 threshold set -[ flower6 ] start-shape set -cfdg-window ; +: init ( -- ) + [ ] >background + { -1 2 -1 2 } >viewport + 0.01 >threshold + [ flower6 ] >start-shape ; + +: run ( -- ) [ init ] cfdg-window. ; MAIN: run diff --git a/extra/cfdg/models/game1-turn6/game1-turn6.factor b/extra/cfdg/models/game1-turn6/game1-turn6.factor index 0cd65242fb..3e0994112a 100644 --- a/extra/cfdg/models/game1-turn6/game1-turn6.factor +++ b/extra/cfdg/models/game1-turn6/game1-turn6.factor @@ -37,11 +37,12 @@ DEFER: start ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: run ( -- ) -[ 66 hue 0.4 sat 0.5 b ] >background -{ -5 10 -5 10 } viewport set -0.001 >threshold -[ start ] >start-shape -cfdg-window ; +: init ( -- ) + [ 66 hue 0.4 sat 0.5 b ] >background + { -5 10 -5 10 } >viewport + 0.001 >threshold + [ start ] >start-shape ; + +: run ( -- ) [ init ] cfdg-window. ; MAIN: run \ No newline at end of file diff --git a/extra/cfdg/models/lesson/lesson.factor b/extra/cfdg/models/lesson/lesson.factor index 287e572929..5902c121ae 100644 --- a/extra/cfdg/models/lesson/lesson.factor +++ b/extra/cfdg/models/lesson/lesson.factor @@ -96,12 +96,13 @@ iterate? [ ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: run ( -- ) -[ ] >background -{ -5 25 -15 25 } viewport set -0.03 threshold set -[ toc ] start-shape set -cfdg-window ; +: init ( -- ) + [ ] >background + { -5 25 -15 25 } >viewport + 0.03 >threshold + [ toc ] >start-shape ; + +: run ( -- ) [ init ] cfdg-window. ; MAIN: run diff --git a/extra/cfdg/models/rules08/rules08.factor b/extra/cfdg/models/rules08/rules08.factor index d14aa04fb1..20099d225a 100644 --- a/extra/cfdg/models/rules08/rules08.factor +++ b/extra/cfdg/models/rules08/rules08.factor @@ -51,12 +51,13 @@ DEFER: line ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: run ( -- ) +: init ( -- ) [ -1 b ] >background { -20 40 -20 40 } viewport set [ centre ] >start-shape - 0.0001 >threshold - cfdg-window ; + 0.0001 >threshold ; + +: run ( -- ) [ init ] cfdg-window. ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/cfdg/models/sierpinski/sierpinski.factor b/extra/cfdg/models/sierpinski/sierpinski.factor index 1acee8309a..2333506f29 100644 --- a/extra/cfdg/models/sierpinski/sierpinski.factor +++ b/extra/cfdg/models/sierpinski/sierpinski.factor @@ -26,14 +26,12 @@ iterate? [ ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: run ( -- ) -[ ] >background -{ -4 8 -4 8 } viewport set -0.01 >threshold -[ top ] >start-shape -cfdg-window ; - -MAIN: run - +: init ( -- ) + [ ] >background + { -4 8 -4 8 } >viewport + 0.01 >threshold + [ top ] >start-shape ; +: run ( -- ) [ init ] cfdg-window. ; +MAIN: run \ No newline at end of file diff --git a/extra/cfdg/models/snowflake/snowflake.factor b/extra/cfdg/models/snowflake/snowflake.factor index 951f449e68..9efb3352fa 100644 --- a/extra/cfdg/models/snowflake/snowflake.factor +++ b/extra/cfdg/models/snowflake/snowflake.factor @@ -25,12 +25,13 @@ spike ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: run ( -- ) -[ ] >background -{ -40 80 -40 80 } viewport set -0.1 threshold set -[ snowflake ] start-shape set -cfdg-window ; +: init ( -- ) + [ ] >background + { -40 80 -40 80 } >viewport + 0.1 >threshold + [ snowflake ] >start-shape ; + +: run ( -- ) [ init ] cfdg-window. ; MAIN: run diff --git a/extra/cfdg/models/spirales/spirales.factor b/extra/cfdg/models/spirales/spirales.factor index 60e4384fe0..985c21643e 100644 --- a/extra/cfdg/models/spirales/spirales.factor +++ b/extra/cfdg/models/spirales/spirales.factor @@ -29,12 +29,13 @@ DEFER: line ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: run ( -- ) +: init ( -- ) [ -1 b ] >background { -20 40 -20 40 } viewport set [ line ] >start-shape - 0.03 >threshold - cfdg-window ; + 0.03 >threshold ; + +: run ( -- ) [ init ] cfdg-window. ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 085a9b9ff44ac81e8da39e7ebd07395a04fd7b42 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 4 Aug 2008 21:44:01 -0500 Subject: [PATCH 3/3] cfdg: Click in the window to regenerate model --- extra/cfdg/cfdg.factor | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/extra/cfdg/cfdg.factor b/extra/cfdg/cfdg.factor index 866400c9bc..6cbbc51786 100644 --- a/extra/cfdg/cfdg.factor +++ b/extra/cfdg/cfdg.factor @@ -4,7 +4,8 @@ USING: kernel alien.c-types combinators namespaces arrays math math.functions math.vectors math.trig opengl.gl opengl.glu opengl ui ui.gadgets.slate vars colors self self.slots - random-weighted colors.hsv cfdg.gl accessors ; + random-weighted colors.hsv cfdg.gl accessors + ui.gadgets.handler ui.gestures assocs ui.gadgets ; IN: cfdg @@ -201,20 +202,32 @@ SYMBOL: dlist ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: delete-dlist ( -- ) dlist get [ dlist get 1 glDeleteLists dlist off ] when ; + : cfdg-window* ( -- ) C[ display ] - { 500 500 } >>pdim - C[ dlist get [ dlist get 1 glDeleteLists ] when ] >>ungraft + { 500 500 } >>pdim + C[ delete-dlist ] >>ungraft dup "CFDG" open-window ; : cfdg-window ( -- ) [ cfdg-window* ] with-ui ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +SYMBOL: the-slate + +: rebuild ( -- ) delete-dlist the-slate get relayout-1 ; + : ( -- slate ) C[ display ] + dup the-slate set { 500 500 } >>pdim - C[ dlist get [ dlist get 1 glDeleteLists ] when ] >>ungraft ; + C[ dlist get [ dlist get 1 glDeleteLists ] when ] >>ungraft + + H{ } clone + T{ key-down f f "ENTER" } C[ drop rebuild ] swap pick set-at + T{ button-down } C[ drop rebuild ] swap pick set-at + >>table ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!