extra/nehe/5/5.factor

   1 USING: accessors calendar kernel literals math
   2 opengl.demo-support opengl.gl opengl.glu threads ui ui.gadgets
   3 ui.pixel-formats ui.render ;
   4 IN: nehe.5
   5
   6 TUPLE: nehe5-gadget < gadget rtri rquad thread quit? ;
   7 CONSTANT: width 256
   8 CONSTANT: height 256
   9 : redraw-interval ( -- dt ) 10 milliseconds ;
  10
  11 : <nehe5-gadget> (  -- gadget )
  12     nehe5-gadget new
  13     0.0 >>rtri
  14     0.0 >>rquad ;
  15
  16 M: nehe5-gadget draw-gadget* ( gadget -- )
  17     GL_PROJECTION glMatrixMode
  18     glLoadIdentity
  19     45.0 width height / >float 0.1 100.0 gluPerspective
  20     GL_MODELVIEW glMatrixMode
  21     glLoadIdentity
  22     GL_SMOOTH glShadeModel
  23     0.0 0.0 0.0 0.0 glClearColor
  24     1.0 glClearDepth
  25     GL_DEPTH_TEST glEnable
  26     GL_LEQUAL glDepthFunc
  27     GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST glHint
  28     GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
  29     glLoadIdentity
  30     -1.5 0.0 -6.0 glTranslatef
  31     dup rtri>> 0.0 1.0 0.0 glRotatef
  32
  33     GL_TRIANGLES [
  34         1.0 0.0 0.0 glColor3f
  35         0.0 1.0 0.0 glVertex3f
  36         0.0 1.0 0.0 glColor3f
  37         -1.0 -1.0 1.0 glVertex3f
  38         0.0 0.0 1.0 glColor3f
  39         1.0 -1.0 1.0 glVertex3f
  40
  41         1.0 0.0 0.0 glColor3f
  42         0.0 1.0 0.0 glVertex3f
  43         0.0 0.0 1.0 glColor3f
  44         1.0 -1.0 1.0 glVertex3f
  45         0.0 1.0 0.0 glColor3f
  46         1.0 -1.0 -1.0 glVertex3f
  47
  48         1.0 0.0 0.0 glColor3f
  49         0.0 1.0 0.0 glVertex3f
  50         0.0 1.0 0.0 glColor3f
  51         1.0 -1.0 -1.0 glVertex3f
  52         0.0 0.0 1.0 glColor3f
  53         -1.0 -1.0 -1.0 glVertex3f
  54
  55         1.0 0.0 0.0 glColor3f
  56         0.0 1.0 0.0 glVertex3f
  57         0.0 0.0 1.0 glColor3f
  58         -1.0 -1.0 -1.0 glVertex3f
  59         0.0 1.0 0.0 glColor3f
  60         -1.0 -1.0 1.0 glVertex3f
  61     ] do-state
  62
  63     glLoadIdentity
  64
  65     1.5 0.0 -7.0 glTranslatef
  66     dup rquad>> 1.0 0.0 0.0 glRotatef
  67     GL_QUADS [
  68         0.0 1.0 0.0 glColor3f
  69         1.0 1.0 -1.0 glVertex3f
  70         -1.0 1.0 -1.0 glVertex3f
  71         -1.0 1.0 1.0 glVertex3f
  72         1.0 1.0 1.0 glVertex3f
  73
  74         1.0 0.5 0.0 glColor3f
  75         1.0 -1.0 1.0 glVertex3f
  76         -1.0 -1.0 1.0 glVertex3f
  77         -1.0 -1.0 -1.0 glVertex3f
  78         1.0 -1.0 -1.0 glVertex3f
  79
  80         1.0 0.0 0.0 glColor3f
  81         1.0 1.0 1.0 glVertex3f
  82         -1.0 1.0 1.0 glVertex3f
  83         -1.0 -1.0 1.0 glVertex3f
  84         1.0 -1.0 1.0 glVertex3f
  85
  86         1.0 1.0 0.0 glColor3f
  87         1.0 -1.0 -1.0 glVertex3f
  88         -1.0 -1.0 -1.0 glVertex3f
  89         -1.0 1.0 -1.0 glVertex3f
  90         1.0 1.0 -1.0 glVertex3f
  91
  92         0.0 0.0 1.0 glColor3f
  93         -1.0 1.0 1.0 glVertex3f
  94         -1.0 1.0 -1.0 glVertex3f
  95         -1.0 -1.0 -1.0 glVertex3f
  96         -1.0 -1.0 1.0 glVertex3f
  97
  98         1.0 0.0 1.0 glColor3f
  99         1.0 1.0 -1.0 glVertex3f
 100         1.0 1.0 1.0 glVertex3f
 101         1.0 -1.0 1.0 glVertex3f
 102         1.0 -1.0 -1.0 glVertex3f
 103     ] do-state
 104     [ 0.2 + ] change-rtri
 105     [ 0.15 - ] change-rquad drop ;
 106
 107 : nehe5-update-thread ( gadget -- )
 108     dup quit?>> [
 109         drop
 110     ] [
 111         redraw-interval sleep
 112         dup relayout-1
 113         nehe5-update-thread
 114     ] if ;
 115
 116 M: nehe5-gadget graft* ( gadget -- )
 117     f >>quit?
 118     [ nehe5-update-thread ] curry in-thread ;
 119
 120 M: nehe5-gadget ungraft* ( gadget -- )
 121     t >>quit? drop ;
 122
 123 MAIN-WINDOW: run5
 124     {
 125         { title "NeHe Tutorial 5" }
 126         { pref-dim { $ width $ height } }
 127         { pixel-format-attributes {
 128             windowed
 129             double-buffered
 130             T{ depth-bits { value 16 } }
 131         } }
 132     }
 133     <nehe5-gadget> >>gadgets ;