Add slate-examples

diff --git a/contrib/slate-examples/cube.factor b/contrib/slate-examples/cube.factor
new file mode 100644 (file)
index 0000000..d146639
--- /dev/null
+++ b/contrib/slate-examples/cube.factor
@@ -0,0 +1,52 @@
+REQUIRES: contrib/slate ;
+USING: kernel namespaces math sequences opengl slate ;
+IN: redbook-cube
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! cube.c from the red book calls glutWireCube to create the
+! model. Factor doesn't come with bindings to the GLUT library so we
+! whip up wire-cube word here.
+
+:  p dup , ;
+: -p dup neg , ;
+
+: wire-cube ( side-length -- )
+2.0 /
+[ -p -p -p
+   p -p -p
+   p  p -p
+  -p  p -p ] { } make 3 group draw-line-loop
+[ -p -p  p
+   p -p  p
+   p  p  p
+  -p  p  p ] { } make 3 group draw-line-loop
+[ -p  p -p   -p  p  p
+   p  p -p    p  p  p
+  -p -p -p   -p -p  p
+   p -p -p    p -p  p ] { } make 3 group draw-lines
+drop ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: go ( -- )
+
+slate-window
+
+{ 0 0 0 0 } gl-clear-color
+GL_FLAT gl-shade-model
+
+GL_PROJECTION gl-matrix-mode
+gl-load-identity
+-1 1 -1 1 1.5 20 gl-frustum
+GL_MODELVIEW gl-matrix-mode
+
+GL_COLOR_BUFFER_BIT gl-clear
+{ 1 1 1 1 } gl-color
+gl-load-identity
+{ 0 0 5 } { 0 0 0 } { 0 1 0 } glu-look-at
+{ 1 2 1 } gl-scale
+1 wire-cube
+
+flush-dlist
+flush-slate ;
\ No newline at end of file

diff --git a/contrib/slate-examples/golden-section.factor b/contrib/slate-examples/golden-section.factor
new file mode 100644 (file)
index 0000000..127be13
--- /dev/null
+++ b/contrib/slate-examples/golden-section.factor
@@ -0,0 +1,47 @@
+
+USING: kernel math arrays sequences namespaces opengl slate slate-2d ;
+
+IN: golden-section
+
+! Usage:
+! USE: golden-section
+! go
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: circle ( center radius -- )
+gl-push-matrix
+swap 0 add gl-translate   dup 0 3array gl-scale   draw-circle
+gl-pop-matrix ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: phi ( -- phi ) 5 sqrt 1 + 2 / 1 - ;
+
+: omega ( i -- omega ) phi * 2 * pi * ;
+
+: x ( i -- x ) dup omega cos * 0.5 * ;
+
+: y ( i -- y ) dup omega sin * 0.5 * ;
+
+: center ( i -- point ) dup x swap y 2array ;
+
+: radius ( i -- radius ) pi * 720 / sin 10 * ;
+
+: color ( i -- color ) 360.0 / dup 0.25 1 4array ;
+
+: rim ( i -- ) black gl-color dup center swap radius 1.5 * circle ;
+
+: inner ( i -- ) dup color gl-color dup center swap radius circle ;
+
+: dot ( i -- ) dup rim inner ;
+
+: golden-section ( -- ) 720 [ dot ] each ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: setup-window ( -- )
+slate-window 1000000 capacity set reset-slate -400 400 -400 400 init-2d
+GL_COLOR_BUFFER_BIT gl-clear ;
+
+: go ( -- ) setup-window golden-section flush-dlist flush-slate ;
\ No newline at end of file

diff --git a/contrib/slate-examples/hello.factor b/contrib/slate-examples/hello.factor
new file mode 100644 (file)
index 0000000..0681967
--- /dev/null
+++ b/contrib/slate-examples/hello.factor
@@ -0,0 +1,17 @@
+
+IN: redbook-hello
+
+: go ( -- )
+slate-window
+black gl-clear-color
+GL_PROJECTION gl-matrix-mode   gl-load-identity   0 1 0 1 -1 1 gl-ortho
+GL_MODELVIEW gl-matrix-mode   gl-load-identity
+GL_COLOR_BUFFER_BIT gl-clear
+white gl-color
+{ { 0.25 0.25 0.0 }
+  { 0.75 0.25 0.0 }
+  { 0.75 0.75 0.0 }
+  { 0.25 0.75 0.0 } }
+draw-polygon
+flush-dlist
+flush-slate ;
\ No newline at end of file

diff --git a/contrib/slate-examples/quadric.factor b/contrib/slate-examples/quadric.factor
new file mode 100644 (file)
index 0000000..90fddce
--- /dev/null
+++ b/contrib/slate-examples/quadric.factor
@@ -0,0 +1,113 @@
+REQUIRES: contrib/slate ;
+USING: kernel io math alien namespaces sequences opengl slate ;
+IN: redbook-quadric
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: (error-callback) ( GLenum -- )
+gluErrorString "Quadratic Error: " swap append print ;
+
+: error-callback ( -- alien )
+"void" { "GLenum" } [ (error-callback) ] alien-callback ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYMBOL: start-list
+SYMBOL: qobj
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: init ( -- )
+
+4 glGenLists start-list set
+start-list get [ start-list set ] curry add-dlist
+
+[
+    gluNewQuadric qobj set
+
+    qobj get GLU_ERROR error-callback gluQuadricCallback
+
+    qobj get GLU_FILL gluQuadricDrawStyle
+    qobj get GLU_SMOOTH gluQuadricNormals
+    start-list get GL_COMPILE glNewList
+    qobj get 0.75 15 10 gluSphere
+    glEndList
+
+    qobj get GLU_FILL gluQuadricDrawStyle
+    qobj get GLU_FLAT gluQuadricNormals
+    start-list get 1 + GL_COMPILE glNewList
+    qobj get 0.5 0.3 1.0 15 5 gluCylinder
+    glEndList
+
+    qobj get GLU_LINE gluQuadricDrawStyle
+    qobj get GLU_NONE gluQuadricNormals
+    start-list get 2 + GL_COMPILE glNewList
+    qobj get 0.25 1.0 20 4 gluDisk
+    glEndList
+
+    qobj get GLU_SILHOUETTE gluQuadricDrawStyle
+    qobj get GLU_NONE gluQuadricNormals
+    start-list get 3 + GL_COMPILE glNewList
+    qobj get 0.0 1.0 20 4 0.0 225.0 gluPartialDisk
+    glEndList
+] add-dlist ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: build-dlist ( -- )
+
+GL_FRONT GL_AMBIENT { 0.5 0.5 0.5 1.0 } gl-material-fv
+GL_FRONT GL_SPECULAR { 1.0 1.0 1.0 1.0 } gl-material-fv
+GL_FRONT GL_SHININESS { 50.0 } gl-material-fv
+
+GL_LIGHT0 GL_POSITION { 1.0 1.0 1.0 0.0 } gl-light-fv
+
+GL_LIGHT_MODEL_AMBIENT { 0.5 0.5 0.5 1.0 } gl-light-model-fv
+
+{ 0 0 0 0 } gl-clear-color
+
+GL_LIGHTING gl-enable
+GL_LIGHT0 gl-enable
+GL_DEPTH_TEST gl-enable
+
+GL_PROJECTION gl-matrix-mode gl-load-identity
+-2.5 2.5 -2.5 2.5 -10.0 10.0 gl-ortho
+GL_MODELVIEW gl-matrix-mode gl-load-identity
+
+GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor gl-clear
+
+gl-push-matrix
+GL_LIGHTING gl-enable
+GL_SMOOTH gl-shade-model
+{ -1.0 -1.0 0.0 } gl-translate
+start-list get gl-call-list
+
+GL_FLAT gl-shade-model
+{ 0 2 0 } gl-translate
+gl-push-matrix
+300 { 1 0 0 } gl-rotate
+start-list get 1 + gl-call-list
+gl-pop-matrix
+
+GL_LIGHTING gl-disable
+{ 0.0 1.0 1.0 1.0 } gl-color
+{ 2.0 -2.0 0.0 } gl-translate
+start-list get 2 + gl-call-list
+
+{ 1 1 0 1 } gl-color
+{ 0 2 0 } gl-translate
+start-list get 3 + gl-call-list
+
+gl-pop-matrix ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+USE: threads
+
+: go ( -- )
+slate-window
+init flush-dlist flush-slate 1000 sleep reset-slate
+build-dlist flush-dlist flush-slate ;
+
+! USE: redbook-examples-quadric
+! go
\ No newline at end of file

diff --git a/contrib/slate.factor b/contrib/slate.factor
index 57c54743a65e9f9a4b8d57f14fcff171a85e1528..3ae8eb184358ae8b7b3952394726188ba8facfeb 100644 (file)
--- a/contrib/slate.factor
+++ b/contrib/slate.factor
@@ -76,6 +76,8 @@ SYMBOL: capacity
 
 : gl-ortho ( left right bottom top near far -- ) [ glOrtho ] curry6 add-dlist ;
 
+: gl-frustum ( left right bottom top near far -- ) [ glFrustum ] curry6 add-dlist ;
+
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : gl-vertex2 ( vec -- ) first2 [ glVertex2f ] curry2 add-dlist ;
@@ -165,6 +167,8 @@ SYMBOL: capacity
 
 : draw-line ( a b --- ) GL_LINES gl-begin gl-vertex gl-vertex gl-end ;
 
+: draw-lines ( seq -- ) GL_LINES gl-begin [ gl-vertex ] each gl-end ;
+
 : draw-line-strip ( seq -- ) GL_LINE_STRIP gl-begin [ gl-vertex ] each gl-end ;
 
 : draw-line-loop ( seq -- ) GL_LINE_LOOP gl-begin [ gl-vertex ] each gl-end ;