extra/nehe/5/5.factor

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