Merge branch 'master' of git://factorcode.org/git/factor

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
 
@@ -130,7 +131,7 @@ VAR: threshold
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: recursive ( quot -- ) iterate? swap when ;
+: recursive ( quot -- ) iterate? swap when ; inline
 
 : multi ( seq -- ) random-weighted* call ;
 
@@ -155,6 +156,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 +195,43 @@ 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 ;
+: delete-dlist ( -- ) dlist get [ dlist get 1 glDeleteLists dlist off ] when ;
 
 : cfdg-window* ( -- )
-  [ display ] closed-quot <slate>
-  { 500 500 } over set-slate-pdim
+  C[ display ] <slate>
+    { 500 500 }       >>pdim
+    C[ delete-dlist ] >>ungraft
   dup "CFDG" open-window ;
 
-: cfdg-window ( -- ) [ cfdg-window* ] with-ui ;
+: cfdg-window ( -- ) [ cfdg-window* ] with-ui ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYMBOL: the-slate
+
+: rebuild ( -- ) delete-dlist the-slate get relayout-1 ;
+
+: <cfdg-gadget> ( -- slate )
+  C[ display ] <slate>
+    dup the-slate set
+    { 500 500 } >>pdim
+    C[ dlist get [ dlist get 1 glDeleteLists ] when ] >>ungraft
+  <handler>
+    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 ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+USE: fry
+
+: cfdg-window. ( quot -- )
+  '[ [ @ <cfdg-gadget> "CFDG" open-window ] with-scope ] with-ui ;

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

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

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
 

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

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
 

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. ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

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

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
 

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. ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!