extra/jamshred/gl/gl.factor

   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
  11 CONSTANT: min-vertices 6
  12 CONSTANT: max-vertices 32
  13
  14 CONSTANT: n-vertices 32
  15
  16 ! render enough of the tunnel that it looks continuous
  17 CONSTANT: n-segments-ahead 60
  18 CONSTANT: n-segments-behind 40
  19
  20 ! so that we can't see through the wall, we draw it a bit further away
  21 CONSTANT: 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 ;