extra/nehe/4/4.factor

   1 USING: arrays kernel math opengl opengl.gl opengl.glu
   2 opengl.demo-support ui ui.gadgets ui.render threads accessors ;
   3 IN: nehe.4
   4
   5 TUPLE: nehe4-gadget < gadget rtri rquad thread quit? ;
   6
   7 : width 256 ;
   8 : height 256 ;
   9 : redraw-interval 10 ;
  10
  11 : <nehe4-gadget> (  -- gadget )
  12   nehe4-gadget new-gadget
  13     0.0 >>rtri
  14     0.0 >>rquad ;
  15
  16 M: nehe4-gadget pref-dim* ( gadget -- dim )
  17   drop width height 2array ;
  18
  19 M: nehe4-gadget draw-gadget* ( gadget -- )
  20   GL_PROJECTION glMatrixMode
  21   glLoadIdentity
  22   45.0 width height / >float 0.1 100.0 gluPerspective
  23   GL_MODELVIEW glMatrixMode
  24   glLoadIdentity
  25   GL_SMOOTH glShadeModel
  26   0.0 0.0 0.0 0.0 glClearColor
  27   1.0 glClearDepth
  28   GL_DEPTH_TEST glEnable
  29   GL_LEQUAL glDepthFunc
  30   GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST glHint
  31   GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
  32   glLoadIdentity
  33   -1.5 0.0 -6.0 glTranslatef
  34   dup rtri>> 0.0 1.0 0.0 glRotatef
  35
  36   GL_TRIANGLES [
  37     1.0 0.0 0.0 glColor3f
  38     0.0 1.0 0.0 glVertex3f
  39     0.0 1.0 0.0 glColor3f
  40     -1.0 -1.0 0.0 glVertex3f
  41     0.0 0.0 1.0 glColor3f
  42     1.0 -1.0 0.0 glVertex3f
  43   ] do-state
  44
  45   glLoadIdentity
  46
  47   1.5 0.0 -6.0 glTranslatef
  48   dup rquad>> 1.0 0.0 0.0 glRotatef
  49   0.5 0.5 1.0 glColor3f
  50   GL_QUADS [
  51     -1.0 1.0 0.0 glVertex3f
  52     1.0 1.0 0.0 glVertex3f
  53     1.0 -1.0 0.0 glVertex3f
  54     -1.0 -1.0 0.0 glVertex3f
  55   ] do-state
  56   [ 0.2 + ] change-rtri
  57   [ 0.15 - ] change-rquad drop ;
  58
  59 : nehe4-update-thread ( gadget -- )
  60   dup quit?>> [ drop ] [
  61     redraw-interval sleep
  62     dup relayout-1
  63     nehe4-update-thread
  64   ] if ;
  65
  66 M: nehe4-gadget graft* ( gadget -- )
  67   f >>quit?
  68   [ nehe4-update-thread ] curry in-thread ;
  69
  70 M: nehe4-gadget ungraft* ( gadget -- )
  71   t >>quit? drop ;
  72
  73 : run4 ( -- )
  74   <nehe4-gadget> "NeHe Tutorial 4" open-window ;