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