 
 : 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


! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: recursive ( quot -- ) iterate? swap when ;

: multi ( seq -- ) random-weighted* call ;


  init-modelview-matrix-stack
  init-color-stack

  dlist get not
    [ build-model-dlist ]
    [ dlist get glCallList ]
  if ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: cfdg-window* ( -- )
  C[ display ] <slate>
    { 500 500 } >>pdim
    C[ dlist get [ dlist get 1 glDeleteLists ] when ] >>ungraft
  dup "CFDG" open-window ;

: cfdg-window ( -- ) [ cfdg-window* ] with-ui ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: <cfdg-gadget> ( -- slate )
  C[ display ] <slate>
    { 500 500 } >>pdim
    C[ dlist get [ dlist get 1 glDeleteLists ] when ] >>ungraft ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

USE: fry

: cfdg-window. ( quot -- )
  '[ [ @ <cfdg-gadget> "CFDG" open-window ] with-scope ] with-ui ;