extra/gpu/util/wasd/wasd.factor

   1 ! Copyright (C) 2009 Joe Groff.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays combinators.smart game.input
   4 game.input.scancodes game.loop game.worlds
   5 gpu.render gpu.state kernel literals
   6 locals math math.constants math.functions math.matrices
   7 math.matrices.extras math.order math.vectors opengl.gl
   8 sequences ui ui.gadgets.worlds specialized-arrays audio.engine ;
   9 FROM: alien.c-types => float ;
  10 SPECIALIZED-ARRAY: float
  11 IN: gpu.util.wasd
  12
  13 UNIFORM-TUPLE: mvp-uniforms
  14     { "mv_matrix"  mat4-uniform f }
  15     { "p_matrix"   mat4-uniform f } ;
  16
  17 CONSTANT: -pi/2 $[ pi -2.0 / ]
  18 CONSTANT:  pi/2 $[ pi  2.0 / ]
  19
  20 TUPLE: wasd-world < game-world location yaw pitch p-matrix ;
  21
  22 GENERIC: wasd-near-plane ( world -- near-plane )
  23 M: wasd-world wasd-near-plane drop 0.25 ;
  24
  25 GENERIC: wasd-far-plane ( world -- far-plane )
  26 M: wasd-world wasd-far-plane drop 1024.0 ;
  27
  28 GENERIC: wasd-movement-speed ( world -- speed )
  29 M: wasd-world wasd-movement-speed drop 1/16. ;
  30
  31 GENERIC: wasd-mouse-scale ( world -- scale )
  32 M: wasd-world wasd-mouse-scale drop 1/600. ;
  33
  34 GENERIC: wasd-pitch-range ( world -- min max )
  35 M: wasd-world wasd-pitch-range drop -pi/2 pi/2 ;
  36
  37 GENERIC: wasd-fly-vertically? ( world -- ? )
  38 M: wasd-world wasd-fly-vertically? drop t ;
  39
  40 : wasd-mv-matrix ( world -- matrix )
  41     [ { 1.0 0.0 0.0 } swap pitch>> <rotation-matrix4> ]
  42     [ { 0.0 1.0 0.0 } swap yaw>>   <rotation-matrix4> ]
  43     [ location>> vneg <translation-matrix4> ] tri mdot mdot ;
  44
  45 : wasd-mv-inv-matrix ( world -- matrix )
  46     [ location>> <translation-matrix4> ]
  47     [ {  0.0 -1.0 0.0 } swap yaw>>   <rotation-matrix4> ]
  48     [ { -1.0  0.0 0.0 } swap pitch>> <rotation-matrix4> ] tri
  49     mdot mdot ;
  50
  51 : wasd-p-matrix ( world -- matrix )
  52     p-matrix>> ;
  53
  54 : <mvp-uniforms> ( world -- uniforms )
  55     [ wasd-mv-matrix ] [ wasd-p-matrix ] bi mvp-uniforms boa ;
  56
  57 CONSTANT: fov 0.7
  58
  59 : wasd-fov-vector ( world -- fov )
  60     dim>> dup first2 min >float v/n fov v*n ; inline
  61
  62 :: generate-p-matrix ( world -- matrix )
  63     world wasd-near-plane :> near-plane
  64     world wasd-far-plane :> far-plane
  65
  66     world wasd-fov-vector near-plane v*n
  67     near-plane far-plane <frustum-matrix4> ;
  68
  69 :: wasd-pixel-ray ( world loc -- direction )
  70     loc world dim>> [ /f 0.5 - 2.0 * ] 2map
  71     world wasd-fov-vector v*
  72     first2 neg -1.0 0.0 4array
  73     world wasd-mv-inv-matrix swap mdotv ;
  74
  75 : set-wasd-view ( world location yaw pitch -- world )
  76     [ >>location ] [ >>yaw ] [ >>pitch ] tri* ;
  77
  78 :: eye-rotate ( yaw pitch v -- v' )
  79     yaw neg :> y
  80     pitch neg :> p
  81     y cos :> cosy
  82     y sin :> siny
  83     p cos :> cosp
  84     p sin :> sinp
  85
  86     cosy         0.0       siny        neg  3array
  87     siny sinp *  cosp      cosy sinp *      3array
  88     siny cosp *  sinp neg  cosy cosp *      3array 3array
  89     v swap vdotm ;
  90
  91 : ?pitch ( world -- pitch )
  92     dup wasd-fly-vertically? [ pitch>> ] [ drop 0.0 ] if ;
  93
  94 : forward-vector ( world -- v )
  95     [ yaw>> ] [ ?pitch ] [ wasd-movement-speed ] tri
  96     { 0.0 0.0 -1.0 } n*v eye-rotate ;
  97 : rightward-vector ( world -- v )
  98     [ yaw>> ] [ ?pitch ] [ wasd-movement-speed ] tri
  99     { 1.0 0.0 0.0 } n*v eye-rotate ;
 100
 101 M: wasd-world audio-position location>> ; inline
 102 M: wasd-world audio-orientation
 103     forward-vector { 0.0 1.0 0.0 } <audio-orientation-state> ; inline
 104
 105 : walk-forward ( world -- )
 106     dup forward-vector [ v+ ] curry change-location drop ;
 107 : walk-backward ( world -- )
 108     dup forward-vector [ v- ] curry change-location drop ;
 109 : walk-leftward ( world -- )
 110     dup rightward-vector [ v- ] curry change-location drop ;
 111 : walk-rightward ( world -- )
 112     dup rightward-vector [ v+ ] curry change-location drop ;
 113 : walk-upward ( world -- )
 114     dup wasd-movement-speed { 0.0 1.0 0.0 } n*v [ v+ ] curry change-location drop ;
 115 : walk-downward ( world -- )
 116     dup wasd-movement-speed { 0.0 1.0 0.0 } n*v [ v- ] curry change-location drop ;
 117
 118 : clamp-pitch ( world -- world )
 119     dup [ wasd-pitch-range clamp ] curry change-pitch ;
 120
 121 : rotate-with-mouse ( world mouse -- )
 122     [ [ dup wasd-mouse-scale ] [ dx>> ] bi* * [ + ] curry change-yaw ]
 123     [ [ dup wasd-mouse-scale ] [ dy>> ] bi* * [ + ] curry change-pitch clamp-pitch ] bi
 124     drop ;
 125
 126 :: wasd-keyboard-input ( world -- )
 127     read-keyboard keys>> :> keys
 128     key-w keys nth [ world walk-forward   ] when
 129     key-s keys nth [ world walk-backward  ] when
 130     key-a keys nth [ world walk-leftward  ] when
 131     key-d keys nth [ world walk-rightward ] when
 132     key-space keys nth [ world walk-upward ] when
 133     key-c keys nth [ world walk-downward ] when
 134     key-escape keys nth [ world close-window ] when ;
 135
 136 : wasd-mouse-input ( world -- )
 137     read-mouse rotate-with-mouse ;
 138
 139 M: wasd-world tick-game-world
 140     dup focused?>> [
 141         [ wasd-keyboard-input ] [ wasd-mouse-input ] bi
 142         reset-mouse
 143     ] [ drop ] if ;
 144
 145 M: wasd-world resize-world
 146     [ <viewport-state> set-gpu-state* ]
 147     [ dup generate-p-matrix >>p-matrix drop ] bi ;