steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Added gluDisk, misc gl stuff, and a draw-circle word

darcs
wayo.cavazos 2006-09-14 22:03:39 +00:00
parent bc8752e514
commit cfc8c57b49
1 changed files with 32 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
contrib/slate.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2006 Eduardo Cavazos. ! Copyright (C) 2006 Eduardo Cavazos.
REQUIRES: contrib/math contrib/alien ; REQUIRES: contrib/math ;
USING: alien-contrib kernel namespaces math sequences vectors USING: kernel namespaces math sequences vectors arrays opengl
arrays opengl math-contrib gadgets ; math-contrib gadgets ;
IN: slate IN: slate
@ -54,6 +54,8 @@ SYMBOL: capacity
: curry4 ( a b c d quot -- quot ) 4 [ curry ] times ; : curry4 ( a b c d quot -- quot ) 4 [ curry ] times ;
: curry5 ( a b c d e quot -- quot ) 5 [ curry ] times ;
: curry6 ( a b c d e f quot -- quot ) 6 [ curry ] times ; : curry6 ( a b c d e f quot -- quot ) 6 [ curry ] times ;
: curry9 ( a b c d e f g h i quot -- quot ) 9 [ curry ] times ; : curry9 ( a b c d e f g h i quot -- quot ) 9 [ curry ] times ;
@ -108,6 +110,18 @@ SYMBOL: capacity
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: gl-enable ( cap -- ) [ glEnable ] curry add-dlist ;
: gl-disable ( cap -- ) [ glDisable ] curry add-dlist ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: gl-call-list ( list -- ) [ glCallList ] curry add-dlist ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: gl-shade-model ( mode -- ) [ glShadeModel ] curry add-dlist ;
: gl-light-fv ( light pname params -- ) : gl-light-fv ( light pname params -- )
>float-array [ glLightfv ] curry3 add-dlist ; >float-array [ glLightfv ] curry3 add-dlist ;
@ -154,6 +168,14 @@ SYMBOL: capacity
: draw-circle ( -- ) : draw-circle ( -- )
100 [ 100 / 360 * deg>rad dup cos swap sin 0 3array ] map draw-polygon ; 100 [ 100 / 360 * deg>rad dup cos swap sin 0 3array ] map draw-polygon ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Slate GLU commands
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: glu-new-quadric ( -- ) [ gluNewQuadric ] add-dlist ;
: glu-disk ( qobj innner outer slices loops -- ) [ gluDisk ] curry5 add-dlist ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Slate 2d utilities ! Slate 2d utilities
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -162,6 +184,11 @@ IN: slate-2d
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
VAR: qobj
: slate-window ( -- )
new-slate "Slate" open-titled-window gluNewQuadric >qobj ;
: init-2d ( left right bottom top -- ) : init-2d ( left right bottom top -- )
GL_PROJECTION gl-matrix-mode gl-load-identity -1 1 gl-ortho GL_PROJECTION gl-matrix-mode gl-load-identity -1 1 gl-ortho
GL_MODELVIEW gl-matrix-mode gl-load-identity ; GL_MODELVIEW gl-matrix-mode gl-load-identity ;
@ -173,6 +200,8 @@ GL_MODELVIEW gl-matrix-mode gl-load-identity ;
: draw-line-strip ( seq -- ) : draw-line-strip ( seq -- )
GL_LINE_STRIP gl-begin [ gl-vertex2 ] each gl-end ; GL_LINE_STRIP gl-begin [ gl-vertex2 ] each gl-end ;
: draw-circle ( -- ) qobj> 0 1 100 5 glu-disk ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: set-coordinates ( left right bottom top -- ) : set-coordinates ( left right bottom top -- )