factor/extra/nehe/4/4.factor

75 lines
1.7 KiB
Factor
Raw Normal View History

2007-09-20 18:09:08 -04:00
USING: arrays kernel math opengl opengl.gl opengl.glu ui
2008-08-30 22:59:00 -04:00
ui.gadgets ui.render threads accessors ;
2007-09-20 18:09:08 -04:00
IN: nehe.4
2008-07-12 02:29:25 -04:00
TUPLE: nehe4-gadget < gadget rtri rquad thread quit? ;
2007-09-20 18:09:08 -04:00
: width 256 ;
: height 256 ;
: redraw-interval 10 ;
: <nehe4-gadget> ( -- gadget )
2008-07-12 02:29:25 -04:00
nehe4-gadget new-gadget
2008-08-30 22:59:00 -04:00
0.0 >>rtri
0.0 >>rquad ;
2007-09-20 18:09:08 -04:00
M: nehe4-gadget pref-dim* ( gadget -- dim )
drop width height 2array ;
M: nehe4-gadget draw-gadget* ( gadget -- )
GL_PROJECTION glMatrixMode
glLoadIdentity
45.0 width height / >float 0.1 100.0 gluPerspective
GL_MODELVIEW glMatrixMode
glLoadIdentity
GL_SMOOTH glShadeModel
0.0 0.0 0.0 0.0 glClearColor
1.0 glClearDepth
GL_DEPTH_TEST glEnable
GL_LEQUAL glDepthFunc
GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST glHint
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
glLoadIdentity
-1.5 0.0 -6.0 glTranslatef
2008-09-02 13:14:54 -04:00
dup rtri>> 0.0 1.0 0.0 glRotatef
2007-12-08 03:21:40 -05:00
2007-09-20 18:09:08 -04:00
GL_TRIANGLES [
1.0 0.0 0.0 glColor3f
0.0 1.0 0.0 glVertex3f
0.0 1.0 0.0 glColor3f
-1.0 -1.0 0.0 glVertex3f
0.0 0.0 1.0 glColor3f
1.0 -1.0 0.0 glVertex3f
] do-state
glLoadIdentity
1.5 0.0 -6.0 glTranslatef
2008-09-02 13:35:14 -04:00
dup rquad>> 1.0 0.0 0.0 glRotatef
2007-09-20 18:09:08 -04:00
0.5 0.5 1.0 glColor3f
GL_QUADS [
-1.0 1.0 0.0 glVertex3f
1.0 1.0 0.0 glVertex3f
1.0 -1.0 0.0 glVertex3f
-1.0 -1.0 0.0 glVertex3f
2007-12-08 03:21:40 -05:00
] do-state
2008-08-30 22:59:00 -04:00
[ 0.2 + ] change-rtri
[ 0.15 - ] change-rquad drop ;
2007-12-08 03:21:40 -05:00
: nehe4-update-thread ( gadget -- )
2008-08-30 22:59:00 -04:00
dup quit?>> [ drop ] [
2007-12-08 03:21:40 -05:00
redraw-interval sleep
dup relayout-1
nehe4-update-thread
] if ;
2007-09-20 18:09:08 -04:00
M: nehe4-gadget graft* ( gadget -- )
2008-08-30 22:59:00 -04:00
f >>quit?
2008-09-11 16:36:42 -04:00
[ nehe4-update-thread ] curry in-thread ;
2007-09-20 18:09:08 -04:00
M: nehe4-gadget ungraft* ( gadget -- )
2008-08-30 22:59:00 -04:00
t >>quit? drop ;
2007-09-20 18:09:08 -04:00
: run4 ( -- )
<nehe4-gadget> "NeHe Tutorial 4" open-window ;