Add slate-examples
wayo.cavazos
parent
cd31550a72
commit
d089ba25c1
|
|
@ -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 ;
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -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
|
||||
|
|
@ -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 ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue