/unmaintained/jamshred/gl/gl.factor

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