initial import of gl bindings into contrib/gl. simple-gl doesn't work yet...
Alex Chapman
parent
f7889958d9
commit
2e393becfe
|
|
@ -0,0 +1,62 @@
|
|||
IN: gl-internals
|
||||
USING: alien kernel sequences stdio math test parser namespaces lists strings words compiler ;
|
||||
|
||||
! usage of 'LIBRARY:' and 'FUNCTION:' :
|
||||
!
|
||||
! LIBRARY: gl
|
||||
! FUNCTION: void glTranslatef ( GLfloat x, GLfloat y, GLfloat z ) ;
|
||||
!
|
||||
! should be the same as doing:
|
||||
!
|
||||
! : glTranslatef ( x y z -- )
|
||||
! "void" "gl" "glTranslatef" [ "GLfloat" "GLfloat" "GLfloat" ] alien-invoke ;
|
||||
! \ glTranslatef compile
|
||||
!
|
||||
! other forms:
|
||||
!
|
||||
! FUNCTION: void glEnd ( ) ; -> : glEnd ( -- ) "void" "gl" "glEnd" [ ] alien-invoke ;
|
||||
!
|
||||
! FUNCTION: TODO: something with a return...
|
||||
|
||||
: LIBRARY: scan "c-library" set ; parsing
|
||||
|
||||
: compile-function-call ( type lib func types stack-effect -- )
|
||||
>r over create-in >r
|
||||
[ alien-invoke ] cons cons cons cons r> swap define-compound
|
||||
word r> "stack-effect" set-word-prop
|
||||
word compile ;
|
||||
|
||||
: (list-split) ( list1 list2 quot -- list1 list2 )
|
||||
dup >r >r dup
|
||||
[ unswons dup r> call
|
||||
[ r> 2drop ]
|
||||
[ rot cons swap r> (list-split) ] ifte ]
|
||||
[ r> r> 2drop ] ifte ;
|
||||
|
||||
: list-split ( list quot -- list1 list2 )
|
||||
#! split the list at the first element where 'elem quot call' is t, removing that element.
|
||||
#! if no elements return true, return 'list [ ]'
|
||||
[ ] -rot (list-split) >r reverse r> ;
|
||||
|
||||
: unpair ( list -- list1 list2 )
|
||||
[ uncons uncons unpair rot swons >r cons r> ]
|
||||
[ f f ] ifte* ;
|
||||
|
||||
: remove-trailing-char ( str ch -- str )
|
||||
>r dup length 1 - swap 2dup nth r> =
|
||||
[ head ]
|
||||
[ nip ] ifte ;
|
||||
|
||||
: join-stack-effect ( lst -- str )
|
||||
[ CHAR: , remove-trailing-char " " append ] map " " swons concat ;
|
||||
|
||||
: parse-stack-effect ( lst -- types stack-effect )
|
||||
[ "--" = ] list-split >r unpair r> "--" swons append join-stack-effect ;
|
||||
|
||||
: (function) ( type lib func function-args -- )
|
||||
unswons drop reverse unswons drop reverse
|
||||
parse-stack-effect compile-function-call ;
|
||||
|
||||
: FUNCTION:
|
||||
scan "c-library" get scan string-mode on
|
||||
[ string-mode off (function) ] [ ] ; parsing
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,253 @@
|
|||
! Copyright (C) 2005 Alex Chapman.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: gl
|
||||
USING: alien gl-internals gl ;
|
||||
|
||||
! These are defined as structs in glu.h, but we only ever use pointers to them
|
||||
ALIAS: void* GLUnurbs*
|
||||
ALIAS: void* GLUquadric*
|
||||
ALIAS: void* GLUtesselator*
|
||||
ALIAS: char* GLubyte* ! is this right?
|
||||
ALIAS: void* GLUfuncptr ! will this work?
|
||||
|
||||
! StringName
|
||||
: GLU_VERSION 100800 ;
|
||||
: GLU_EXTENSIONS 100801 ;
|
||||
|
||||
! ErrorCode
|
||||
: GLU_INVALID_ENUM 100900 ;
|
||||
: GLU_INVALID_VALUE 100901 ;
|
||||
: GLU_OUT_OF_MEMORY 100902 ;
|
||||
: GLU_INCOMPATIBLE_GL_VERSION 100903 ;
|
||||
: GLU_INVALID_OPERATION 100904 ;
|
||||
|
||||
! NurbsDisplay
|
||||
: GLU_OUTLINE_POLYGON 100240 ;
|
||||
: GLU_OUTLINE_PATCH 100241 ;
|
||||
|
||||
! NurbsCallback
|
||||
: GLU_NURBS_ERROR 100103 ;
|
||||
: GLU_ERROR 100103 ;
|
||||
: GLU_NURBS_BEGIN 100164 ;
|
||||
: GLU_NURBS_BEGIN_EXT 100164 ;
|
||||
: GLU_NURBS_VERTEX 100165 ;
|
||||
: GLU_NURBS_VERTEX_EXT 100165 ;
|
||||
: GLU_NURBS_NORMAL 100166 ;
|
||||
: GLU_NURBS_NORMAL_EXT 100166 ;
|
||||
: GLU_NURBS_COLOR 100167 ;
|
||||
: GLU_NURBS_COLOR_EXT 100167 ;
|
||||
: GLU_NURBS_TEXTURE_COORD 100168 ;
|
||||
: GLU_NURBS_TEX_COORD_EXT 100168 ;
|
||||
: GLU_NURBS_END 100169 ;
|
||||
: GLU_NURBS_END_EXT 100169 ;
|
||||
: GLU_NURBS_BEGIN_DATA 100170 ;
|
||||
: GLU_NURBS_BEGIN_DATA_EXT 100170 ;
|
||||
: GLU_NURBS_VERTEX_DATA 100171 ;
|
||||
: GLU_NURBS_VERTEX_DATA_EXT 100171 ;
|
||||
: GLU_NURBS_NORMAL_DATA 100172 ;
|
||||
: GLU_NURBS_NORMAL_DATA_EXT 100172 ;
|
||||
: GLU_NURBS_COLOR_DATA 100173 ;
|
||||
: GLU_NURBS_COLOR_DATA_EXT 100173 ;
|
||||
: GLU_NURBS_TEXTURE_COORD_DATA 100174 ;
|
||||
: GLU_NURBS_TEX_COORD_DATA_EXT 100174 ;
|
||||
: GLU_NURBS_END_DATA 100175 ;
|
||||
: GLU_NURBS_END_DATA_EXT 100175 ;
|
||||
|
||||
! NurbsError
|
||||
: GLU_NURBS_ERROR1 100251 ;
|
||||
: GLU_NURBS_ERROR2 100252 ;
|
||||
: GLU_NURBS_ERROR3 100253 ;
|
||||
: GLU_NURBS_ERROR4 100254 ;
|
||||
: GLU_NURBS_ERROR5 100255 ;
|
||||
: GLU_NURBS_ERROR6 100256 ;
|
||||
: GLU_NURBS_ERROR7 100257 ;
|
||||
: GLU_NURBS_ERROR8 100258 ;
|
||||
: GLU_NURBS_ERROR9 100259 ;
|
||||
: GLU_NURBS_ERROR10 100260 ;
|
||||
: GLU_NURBS_ERROR11 100261 ;
|
||||
: GLU_NURBS_ERROR12 100262 ;
|
||||
: GLU_NURBS_ERROR13 100263 ;
|
||||
: GLU_NURBS_ERROR14 100264 ;
|
||||
: GLU_NURBS_ERROR15 100265 ;
|
||||
: GLU_NURBS_ERROR16 100266 ;
|
||||
: GLU_NURBS_ERROR17 100267 ;
|
||||
: GLU_NURBS_ERROR18 100268 ;
|
||||
: GLU_NURBS_ERROR19 100269 ;
|
||||
: GLU_NURBS_ERROR20 100270 ;
|
||||
: GLU_NURBS_ERROR21 100271 ;
|
||||
: GLU_NURBS_ERROR22 100272 ;
|
||||
: GLU_NURBS_ERROR23 100273 ;
|
||||
: GLU_NURBS_ERROR24 100274 ;
|
||||
: GLU_NURBS_ERROR25 100275 ;
|
||||
: GLU_NURBS_ERROR26 100276 ;
|
||||
: GLU_NURBS_ERROR27 100277 ;
|
||||
: GLU_NURBS_ERROR28 100278 ;
|
||||
: GLU_NURBS_ERROR29 100279 ;
|
||||
: GLU_NURBS_ERROR30 100280 ;
|
||||
: GLU_NURBS_ERROR31 100281 ;
|
||||
: GLU_NURBS_ERROR32 100282 ;
|
||||
: GLU_NURBS_ERROR33 100283 ;
|
||||
: GLU_NURBS_ERROR34 100284 ;
|
||||
: GLU_NURBS_ERROR35 100285 ;
|
||||
: GLU_NURBS_ERROR36 100286 ;
|
||||
: GLU_NURBS_ERROR37 100287 ;
|
||||
|
||||
! NurbsProperty
|
||||
: GLU_AUTO_LOAD_MATRIX 100200 ;
|
||||
: GLU_CULLING 100201 ;
|
||||
: GLU_SAMPLING_TOLERANCE 100203 ;
|
||||
: GLU_DISPLAY_MODE 100204 ;
|
||||
: GLU_PARAMETRIC_TOLERANCE 100202 ;
|
||||
: GLU_SAMPLING_METHOD 100205 ;
|
||||
: GLU_U_STEP 100206 ;
|
||||
: GLU_V_STEP 100207 ;
|
||||
: GLU_NURBS_MODE 100160 ;
|
||||
: GLU_NURBS_MODE_EXT 100160 ;
|
||||
: GLU_NURBS_TESSELLATOR 100161 ;
|
||||
: GLU_NURBS_TESSELLATOR_EXT 100161 ;
|
||||
: GLU_NURBS_RENDERER 100162 ;
|
||||
: GLU_NURBS_RENDERER_EXT 100162 ;
|
||||
|
||||
! NurbsSampling
|
||||
: GLU_OBJECT_PARAMETRIC_ERROR 100208 ;
|
||||
: GLU_OBJECT_PARAMETRIC_ERROR_EXT 100208 ;
|
||||
: GLU_OBJECT_PATH_LENGTH 100209 ;
|
||||
: GLU_OBJECT_PATH_LENGTH_EXT 100209 ;
|
||||
: GLU_PATH_LENGTH 100215 ;
|
||||
: GLU_PARAMETRIC_ERROR 100216 ;
|
||||
: GLU_DOMAIN_DISTANCE 100217 ;
|
||||
|
||||
! NurbsTrim
|
||||
: GLU_MAP1_TRIM_2 100210 ;
|
||||
: GLU_MAP1_TRIM_3 100211 ;
|
||||
|
||||
! QuadricDrawStyle
|
||||
: GLU_POINT 100010 ;
|
||||
: GLU_LINE 100011 ;
|
||||
: GLU_FILL 100012 ;
|
||||
: GLU_SILHOUETTE 100013 ;
|
||||
|
||||
! QuadricNormal
|
||||
: GLU_SMOOTH 100000 ;
|
||||
: GLU_FLAT 100001 ;
|
||||
: GLU_NONE 100002 ;
|
||||
|
||||
! QuadricOrientation
|
||||
: GLU_OUTSIDE 100020 ;
|
||||
: GLU_INSIDE 100021 ;
|
||||
|
||||
! TessCallback
|
||||
: GLU_TESS_BEGIN 100100 ;
|
||||
: GLU_BEGIN 100100 ;
|
||||
: GLU_TESS_VERTEX 100101 ;
|
||||
: GLU_VERTEX 100101 ;
|
||||
: GLU_TESS_END 100102 ;
|
||||
: GLU_END 100102 ;
|
||||
: GLU_TESS_ERROR 100103 ;
|
||||
: GLU_TESS_EDGE_FLAG 100104 ;
|
||||
: GLU_EDGE_FLAG 100104 ;
|
||||
: GLU_TESS_COMBINE 100105 ;
|
||||
: GLU_TESS_BEGIN_DATA 100106 ;
|
||||
: GLU_TESS_VERTEX_DATA 100107 ;
|
||||
: GLU_TESS_END_DATA 100108 ;
|
||||
: GLU_TESS_ERROR_DATA 100109 ;
|
||||
: GLU_TESS_EDGE_FLAG_DATA 100110 ;
|
||||
: GLU_TESS_COMBINE_DATA 100111 ;
|
||||
|
||||
! TessContour
|
||||
: GLU_CW 100120 ;
|
||||
: GLU_CCW 100121 ;
|
||||
: GLU_INTERIOR 100122 ;
|
||||
: GLU_EXTERIOR 100123 ;
|
||||
: GLU_UNKNOWN 100124 ;
|
||||
|
||||
! TessProperty
|
||||
: GLU_TESS_WINDING_RULE 100140 ;
|
||||
: GLU_TESS_BOUNDARY_ONLY 100141 ;
|
||||
: GLU_TESS_TOLERANCE 100142 ;
|
||||
|
||||
! TessError
|
||||
: GLU_TESS_ERROR1 100151 ;
|
||||
: GLU_TESS_ERROR2 100152 ;
|
||||
: GLU_TESS_ERROR3 100153 ;
|
||||
: GLU_TESS_ERROR4 100154 ;
|
||||
: GLU_TESS_ERROR5 100155 ;
|
||||
: GLU_TESS_ERROR6 100156 ;
|
||||
: GLU_TESS_ERROR7 100157 ;
|
||||
: GLU_TESS_ERROR8 100158 ;
|
||||
: GLU_TESS_MISSING_BEGIN_POLYGON 100151 ;
|
||||
: GLU_TESS_MISSING_BEGIN_CONTOUR 100152 ;
|
||||
: GLU_TESS_MISSING_END_POLYGON 100153 ;
|
||||
: GLU_TESS_MISSING_END_CONTOUR 100154 ;
|
||||
: GLU_TESS_COORD_TOO_LARGE 100155 ;
|
||||
: GLU_TESS_NEED_COMBINE_CALLBACK 100156 ;
|
||||
|
||||
! TessWinding
|
||||
: GLU_TESS_WINDING_ODD 100130 ;
|
||||
: GLU_TESS_WINDING_NONZERO 100131 ;
|
||||
: GLU_TESS_WINDING_POSITIVE 100132 ;
|
||||
: GLU_TESS_WINDING_NEGATIVE 100133 ;
|
||||
: GLU_TESS_WINDING_ABS_GEQ_TWO 100134 ;
|
||||
|
||||
LIBRARY: glu
|
||||
|
||||
FUNCTION: void gluBeginCurve ( GLUnurbs* nurb ) ;
|
||||
FUNCTION: void gluBeginPolygon ( GLUtesselator* tess ) ;
|
||||
FUNCTION: void gluBeginSurface ( GLUnurbs* nurb ) ;
|
||||
FUNCTION: void gluBeginTrim ( GLUnurbs* nurb ) ;
|
||||
! FUNCTION: GLint gluBuild1DMipmapLevels ( GLenum target, GLint internalFormat, GLsizei width, GLenum format, GLenum type, GLint level, GLint base, GLint max, const void *data -- error? ) ;
|
||||
! FUNCTION: GLint gluBuild1DMipmaps ( GLenum target, GLint internalFormat, GLsizei width, GLenum format, GLenum type, const void *data ) ;
|
||||
! FUNCTION: GLint gluBuild2DMipmapLevels ( GLenum target, GLint internalFormat, GLsizei width, GLsizei height, GLenum format, GLenum type, GLint level, GLint base, GLint max, const void *data ) ;
|
||||
! FUNCTION: GLint gluBuild2DMipmaps ( GLenum target, GLint internalFormat, GLsizei width, GLsizei height, GLenum format, GLenum type, const void *data ) ;
|
||||
! FUNCTION: GLint gluBuild3DMipmapLevels ( GLenum target, GLint internalFormat, GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLenum type, GLint level, GLint base, GLint max, const void *data ) ;
|
||||
! FUNCTION: GLint gluBuild3DMipmaps ( GLenum target, GLint internalFormat, GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLenum type, const void *data ) ;
|
||||
! FUNCTION: GLboolean gluCheckExtension ( const GLubyte *extName, GLubyte* extString ) ; -- check return for GL_TRUE or GL_FALSE
|
||||
FUNCTION: void gluCylinder ( GLUquadric* quad, GLdouble base, GLdouble top, GLdouble height, GLint slices, GLint stacks ) ;
|
||||
FUNCTION: void gluDeleteNurbsRenderer ( GLUnurbs* nurb ) ;
|
||||
FUNCTION: void gluDeleteQuadric ( GLUquadric* quad ) ;
|
||||
FUNCTION: void gluDeleteTess ( GLUtesselator* tess ) ;
|
||||
FUNCTION: void gluDisk ( GLUquadric* quad, GLdouble inner, GLdouble outer, GLint slices, GLint loops ) ;
|
||||
FUNCTION: void gluEndCurve ( GLUnurbs* nurb ) ;
|
||||
FUNCTION: void gluEndPolygon ( GLUtesselator* tess ) ;
|
||||
FUNCTION: void gluEndSurface ( GLUnurbs* nurb ) ;
|
||||
FUNCTION: void gluEndTrim ( GLUnurbs* nurb ) ;
|
||||
FUNCTION: GLubyte* gluErrorString ( GLenum error -- str ) ;
|
||||
! FUNCTION: void gluGetNurbsProperty ( GLUnurbs* nurb, GLenum property, GLfloat* data ) ;
|
||||
FUNCTION: GLubyte* gluGetString ( GLenum name ) ;
|
||||
! FUNCTION: void gluGetTessProperty ( GLUtesselator* tess, GLenum which, GLdouble* data ) ;
|
||||
! FUNCTION: void gluLoadSamplingMatrices ( GLUnurbs* nurb, const GLfloat *model, const GLfloat *perspective, const GLint *view ) ;
|
||||
FUNCTION: void gluLookAt ( GLdouble eyeX, GLdouble eyeY, GLdouble eyeZ, GLdouble centerX, GLdouble centerY, GLdouble centerZ, GLdouble upX, GLdouble upY, GLdouble upZ ) ;
|
||||
FUNCTION: GLUnurbs* gluNewNurbsRenderer ( -- nurbs ) ;
|
||||
FUNCTION: GLUquadric* gluNewQuadric ( -- quadric ) ;
|
||||
FUNCTION: GLUtesselator* gluNewTess ( -- tess ) ;
|
||||
FUNCTION: void gluNextContour ( GLUtesselator* tess, GLenum type ) ;
|
||||
FUNCTION: void gluNurbsCallback ( GLUnurbs* nurb, GLenum which, GLUfuncptr CallBackFunc ) ;
|
||||
FUNCTION: void gluNurbsCallbackData ( GLUnurbs* nurb, GLvoid* userData ) ;
|
||||
FUNCTION: void gluNurbsCallbackDataEXT ( GLUnurbs* nurb, GLvoid* userData ) ;
|
||||
FUNCTION: void gluNurbsCurve ( GLUnurbs* nurb, GLint knotCount, GLfloat *knots, GLint stride, GLfloat *control, GLint order, GLenum type ) ;
|
||||
FUNCTION: void gluNurbsProperty ( GLUnurbs* nurb, GLenum property, GLfloat value ) ;
|
||||
! FUNCTION: void gluNurbsSurface ( GLUnurbs* nurb, GLint sKnotCount, GLfloat* sKnots, GLint tKnotCount, GLfloat* tKnots, GLint sStride, GLint tStride, GLfloat* control, GLint sOrder, GLint tOrder, GLenum type ) ;
|
||||
FUNCTION: void gluOrtho2D ( GLdouble left, GLdouble right, GLdouble bottom, GLdouble top ) ;
|
||||
FUNCTION: void gluPartialDisk ( GLUquadric* quad, GLdouble inner, GLdouble outer, GLint slices, GLint loops, GLdouble start, GLdouble sweep ) ;
|
||||
FUNCTION: void gluPerspective ( GLdouble fovy, GLdouble aspect, GLdouble zNear, GLdouble zFar ) ;
|
||||
FUNCTION: void gluPickMatrix ( GLdouble x, GLdouble y, GLdouble delX, GLdouble delY, GLint *viewport ) ;
|
||||
! FUNCTION: GLint gluProject ( GLdouble objX, GLdouble objY, GLdouble objZ, const GLdouble *model, const GLdouble *proj, const GLint *view, GLdouble* winX, GLdouble* winY, GLdouble* winZ ) ;
|
||||
! FUNCTION: void gluPwlCurve ( GLUnurbs* nurb, GLint count, GLfloat* data, GLint stride, GLenum type ) ;
|
||||
FUNCTION: void gluQuadricCallback ( GLUquadric* quad, GLenum which, GLUfuncptr CallBackFunc ) ;
|
||||
FUNCTION: void gluQuadricDrawStyle ( GLUquadric* quad, GLenum draw ) ;
|
||||
FUNCTION: void gluQuadricNormals ( GLUquadric* quad, GLenum normal ) ;
|
||||
FUNCTION: void gluQuadricOrientation ( GLUquadric* quad, GLenum orientation ) ;
|
||||
FUNCTION: void gluQuadricTexture ( GLUquadric* quad, GLboolean texture ) ;
|
||||
! FUNCTION: GLint gluScaleImage ( GLenum format, GLsizei wIn, GLsizei hIn, GLenum typeIn, const void *dataIn, GLsizei wOut, GLsizei hOut, GLenum typeOut, GLvoid* dataOut -- error? ) ;
|
||||
FUNCTION: void gluSphere ( GLUquadric* quad, GLdouble radius, GLint slices, GLint stacks ) ;
|
||||
FUNCTION: void gluTessBeginContour ( GLUtesselator* tess ) ;
|
||||
FUNCTION: void gluTessBeginPolygon ( GLUtesselator* tess, GLvoid* data ) ;
|
||||
FUNCTION: void gluTessCallback ( GLUtesselator* tess, GLenum which, GLUfuncptr CallBackFunc ) ;
|
||||
FUNCTION: void gluTessEndContour ( GLUtesselator* tess ) ;
|
||||
FUNCTION: void gluTessEndPolygon ( GLUtesselator* tess ) ;
|
||||
FUNCTION: void gluTessNormal ( GLUtesselator* tess, GLdouble valueX, GLdouble valueY, GLdouble valueZ ) ;
|
||||
FUNCTION: void gluTessProperty ( GLUtesselator* tess, GLenum which, GLdouble data ) ;
|
||||
FUNCTION: void gluTessVertex ( GLUtesselator* tess, GLdouble *location, GLvoid* data ) ;
|
||||
! FUNCTION: GLint gluUnProject ( GLdouble winX, GLdouble winY, GLdouble winZ, const GLdouble *model, const GLdouble *proj, const GLint *view, GLdouble* objX, GLdouble* objY, GLdouble* objZ ) ;
|
||||
! FUNCTION: GLint gluUnProject4 ( GLdouble winX, GLdouble winY, GLdouble winZ, GLdouble clipW, const GLdouble *model, const GLdouble *proj, const GLint *view, GLdouble nearVal, GLdouble farVal, GLdouble* objX, GLdouble* objY, GLdouble* objZ, GLdouble* objW ) ;
|
||||
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
IN: gl
|
||||
USING: alien parser sequences kernel ;
|
||||
|
||||
"gl" "libGL.so" "stdcall" add-library
|
||||
"glu" "libGLU.so" "stdcall" add-library
|
||||
[ "gl-internals.factor" "sdl-gl.factor" "gl.factor" "glu.factor" ] [ "contrib/gl/" swap append run-file ] each
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
IN: sdl
|
||||
|
||||
USING: alien compiler ;
|
||||
|
||||
: SDL_GL_SwapBuffers ( -- )
|
||||
"void" "sdl" "SDL_GL_SwapBuffers" [ ] alien-invoke ;
|
||||
|
||||
\ SDL_GL_SwapBuffers compile
|
||||
|
||||
|
|
@ -0,0 +1,62 @@
|
|||
! Copyright (C) 2005 Alex Chapman.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: simple-gl
|
||||
USING: kernel sdl gl glu math words sequences namespaces ;
|
||||
|
||||
: colour-depth 16 ; inline
|
||||
: fov 60.0 ; inline
|
||||
: near 0.1 ; inline
|
||||
: far 100.0 ; inline
|
||||
|
||||
SYMBOL: theta
|
||||
|
||||
: flags ( lst -- enum )
|
||||
[ execute ] map 0 swap [ bitor ] each ;
|
||||
|
||||
: resize ( width height -- )
|
||||
2dup colour-depth [ SDL_OPENGL SDL_RESIZABLE SDL_HWSURFACE SDL_DOUBLEBUF ] flags init-screen
|
||||
GL_PROJECTION glMatrixMode
|
||||
glLoadIdentity
|
||||
/f fov swap near far gluPerspective
|
||||
GL_MODELVIEW glMatrixMode
|
||||
glLoadIdentity ;
|
||||
|
||||
: render ( -- )
|
||||
GL_COLOR_BUFFER_BIT glClear
|
||||
GL_MODELVIEW glMatrixMode
|
||||
glLoadIdentity
|
||||
0.0 0.0 -2.0 glTranslatef
|
||||
theta get 0.0 1.0 0.0 glRotatef
|
||||
GL_TRIANGLES glBegin
|
||||
0.0 0.5 0.0 glVertex3f
|
||||
-0.5 0.0 0.0 glVertex3f
|
||||
0.5 0.0 0.0 glVertex3f
|
||||
glEnd
|
||||
SDL_GL_SwapBuffers ;
|
||||
|
||||
: event-loop ( event -- )
|
||||
theta [ 1 + ] change
|
||||
render
|
||||
dup SDL_PollEvent [
|
||||
dup quit-event? [
|
||||
drop
|
||||
] [
|
||||
dup resize-event? [
|
||||
dup resize-event-w resize-event-h resize ! broken
|
||||
] when
|
||||
event-loop
|
||||
] ifte
|
||||
] [
|
||||
event-loop
|
||||
] ifte ;
|
||||
|
||||
: simple-gl
|
||||
800 600 colour-depth [ SDL_OPENGL SDL_RESIZABLE SDL_HWSURFACE SDL_DOUBLEBUF ] flags [
|
||||
0 theta set
|
||||
800 600 resize
|
||||
GL_FLAT glShadeModel
|
||||
0.0 0.0 0.0 0.0 glClearColor
|
||||
1.0 0.0 0.0 glColor3f
|
||||
<event> event-loop
|
||||
] with-screen ;
|
||||
|
||||
Loading…
Reference in New Issue