   init-modelview-matrix-stack
   init-color-stack
 
-  initial-color >color
+  set-initial-color
 
   color> gl-set-hsba
 
   start-shape> call ;
 
 : cfdg-window* ( -- )
-[ display ] closed-quot <slate>
+  [ display ] closed-quot <slate>
   { 500 500 } over set-slate-dim
   dup "CFDG" open-window ;
 

USING: kernel alien.c-types combinators namespaces arrays
       sequences sequences.lib namespaces.lib splitting
       math math.functions math.vectors math.trig
       opengl.gl opengl.glu ui ui.gadgets.slate vars mortar slot-accessors
       random-weighted cfdg.hsv cfdg.gl ;

IN: cfdg

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

SYMBOL: <hsba>

<hsba>
  { "hue" "saturation" "brightness" "alpha" } accessors
define-independent-class

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

: hsv>rgb* ( h s v -- r g b ) 3array hsv>rgb first3 ;

: gl-set-hsba ( color -- ) object-values first4 >r hsv>rgb* r> glColor4d ;

: gl-clear-hsba ( color -- ) object-values first4 >r hsv>rgb* r> glClearColor ;

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

VAR: color

: init-color ( -- ) 0 0 0 1 <hsba> new >color ;

: hue ( num -- ) color> tuck $hue + 360 mod >>hue drop ;

: h ( num -- ) hue ;

! if (adjustment < 0)
!   base + base * adjustment


! column major order

: gl-flip ( angle -- ) deg>rad dup dup dup
  [ 2 * cos ,   2 * sin ,       0 ,   0 ,
    2 * sin ,	2 * cos neg ,   0 ,   0 ,
          0 ,             0 ,   1 ,   0 , 
	  0 ,		  0 ,	0 ,   1 , ]
  { } make >c-double-array glMultMatrixd ;

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

: circle ( -- )
  color> gl-set-hsba
  gluNewQuadric dup 0 0.5 20 10 gluDisk gluDeleteQuadric ;

: triangle ( -- )
  color> gl-set-hsba
  GL_POLYGON glBegin
    0    0.577 glVertex2d
    0.5 -0.289 glVertex2d
   -0.5 -0.289 glVertex2d
  glEnd ;

: square ( -- )
  color> gl-set-hsba
  GL_POLYGON glBegin
    -0.5  0.5 glVertex2d
     0.5  0.5 glVertex2d
     0.5 -0.5 glVertex2d
    -0.5 -0.5 glVertex2d
  glEnd ;

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

: size ( scale -- ) dup 1 glScaled ;

: size* ( scale-x scale-y -- ) 1 glScaled ;

: rotate ( angle -- ) 0 0 1 glRotated ;

: x ( x -- ) 0 0 glTranslated ;

: y ( y -- ) 0 swap 0 glTranslated ;

: flip ( angle -- ) gl-flip ;

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

: s  size ;
: s* size* ;
: r  rotate ;
: f  flip ;

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

: do ( quot -- )
  push-modelview-matrix
  push-color
  call
  pop-modelview-matrix
  pop-color ; inline

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

