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