/unmaintained/jamshred/gl/gl.factor

http://github.com/abeaumont/factor · Factor · 114 lines · 88 code · 22 blank · 4 comment · 5 complexity · 1bf727447e12dd3b0f137ce7329d746f MD5 · raw file

  1. ! Copyright (C) 2007, 2008 Alex Chapman
  2. ! See http://factorcode.org/license.txt for BSD license.
  3. USING: accessors alien.c-types jamshred.game jamshred.oint
  4. jamshred.player jamshred.tunnel kernel math math.constants
  5. math.functions math.vectors opengl opengl.gl opengl.glu
  6. opengl.demo-support sequences specialized-arrays locals ;
  7. FROM: alien.c-types => float ;
  8. SPECIALIZED-ARRAY: float
  9. IN: jamshred.gl
  10. CONSTANT: min-vertices 6
  11. CONSTANT: max-vertices 32
  12. CONSTANT: n-vertices 32
  13. ! render enough of the tunnel that it looks continuous
  14. CONSTANT: n-segments-ahead 60
  15. CONSTANT: n-segments-behind 40
  16. ! so that we can't see through the wall, we draw it a bit further away
  17. CONSTANT: wall-drawing-offset 0.15
  18. : wall-drawing-radius ( segment -- r )
  19. radius>> wall-drawing-offset + ;
  20. : wall-up ( segment -- v )
  21. [ wall-drawing-radius ] [ up>> ] bi n*v ;
  22. : wall-left ( segment -- v )
  23. [ wall-drawing-radius ] [ left>> ] bi n*v ;
  24. : segment-vertex ( theta segment -- vertex )
  25. [
  26. [ wall-up swap sin v*n ] [ wall-left swap cos v*n ] 2bi v+
  27. ] [
  28. location>> v+
  29. ] bi ;
  30. : segment-vertex-normal ( vertex segment -- normal )
  31. location>> swap v- normalize ;
  32. : segment-vertex-and-normal ( segment theta -- vertex normal )
  33. swap [ segment-vertex ] keep dupd segment-vertex-normal ;
  34. : equally-spaced-radians ( n -- seq )
  35. #! return a sequence of n numbers between 0 and 2pi
  36. [ iota ] keep [ / pi 2 * * ] curry map ;
  37. : draw-segment-vertex ( segment theta -- )
  38. over color>> gl-color segment-vertex-and-normal
  39. gl-normal gl-vertex ;
  40. :: draw-vertex-pair ( theta next-segment segment -- )
  41. segment theta draw-segment-vertex
  42. next-segment theta draw-segment-vertex ;
  43. : draw-segment ( next-segment segment -- )
  44. GL_QUAD_STRIP [
  45. [ draw-vertex-pair ] 2curry
  46. n-vertices equally-spaced-radians float-array{ 0.0 } append swap each
  47. ] do-state ;
  48. : draw-segments ( segments -- )
  49. 1 over length pick subseq swap [ draw-segment ] 2each ;
  50. : segments-to-render ( player -- segments )
  51. dup nearest-segment>> number>> dup n-segments-behind -
  52. swap n-segments-ahead + rot tunnel>> sub-tunnel ;
  53. : draw-tunnel ( player -- )
  54. segments-to-render draw-segments ;
  55. : init-graphics ( -- )
  56. GL_DEPTH_TEST glEnable
  57. GL_SCISSOR_TEST glDisable
  58. 1.0 glClearDepth
  59. 0.0 0.0 0.0 0.0 glClearColor
  60. GL_PROJECTION glMatrixMode glPushMatrix
  61. GL_MODELVIEW glMatrixMode glPushMatrix
  62. GL_LEQUAL glDepthFunc
  63. GL_LIGHTING glEnable
  64. GL_LIGHT0 glEnable
  65. GL_FOG glEnable
  66. GL_FOG_DENSITY 0.09 glFogf
  67. GL_FRONT GL_AMBIENT_AND_DIFFUSE glColorMaterial
  68. GL_COLOR_MATERIAL glEnable
  69. GL_LIGHT0 GL_POSITION float-array{ 0.0 0.0 0.0 1.0 } underlying>> glLightfv
  70. GL_LIGHT0 GL_AMBIENT float-array{ 0.2 0.2 0.2 1.0 } underlying>> glLightfv
  71. GL_LIGHT0 GL_DIFFUSE float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv
  72. GL_LIGHT0 GL_SPECULAR float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv ;
  73. : cleanup-graphics ( -- )
  74. GL_DEPTH_TEST glDisable
  75. GL_SCISSOR_TEST glEnable
  76. GL_MODELVIEW glMatrixMode glPopMatrix
  77. GL_PROJECTION glMatrixMode glPopMatrix
  78. GL_LIGHTING glDisable
  79. GL_LIGHT0 glDisable
  80. GL_FOG glDisable
  81. GL_COLOR_MATERIAL glDisable ;
  82. : pre-draw ( width height -- )
  83. GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
  84. GL_PROJECTION glMatrixMode glLoadIdentity
  85. dup 0 = [ 2drop ] [ / >float 45.0 swap 0.1 100.0 gluPerspective ] if
  86. GL_MODELVIEW glMatrixMode glLoadIdentity ;
  87. : player-view ( player -- )
  88. [ location>> ]
  89. [ [ location>> ] [ forward>> ] bi v+ ]
  90. [ up>> ] tri gl-look-at ;
  91. : draw-jamshred ( jamshred width height -- )
  92. pre-draw jamshred-player [ player-view ] [ draw-tunnel ] bi ;