unmaintained/jamshred/gl/gl.factor

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