improve noise/terrain performance
Joe Groff
parent
4d0f9744a4
commit
7142139cf7
|
|
@ -1,41 +1,96 @@
|
|||
USING: accessors arrays byte-arrays combinators
|
||||
combinators.short-circuit fry hints images kernel locals math
|
||||
math.affine-transforms math.functions math.order math.polynomials
|
||||
math.vectors random random.mersenne-twister sequences
|
||||
sequences.private sequences.product ;
|
||||
USING: accessors alien.data.map byte-arrays combinators combinators.short-circuit
|
||||
fry generalizations images kernel locals math math.constants math.functions
|
||||
math.libm math.matrices.simd math.vectors math.vectors.conversion math.vectors.simd
|
||||
memoize random random.mersenne-twister sequences sequences.private specialized-arrays
|
||||
typed ;
|
||||
QUALIFIED-WITH: alien.c-types c
|
||||
SIMDS: c:float c:int c:short c:uchar ;
|
||||
SPECIALIZED-ARRAYS: c:float c:uchar float-4 uchar-16 ;
|
||||
IN: noise
|
||||
|
||||
: <perlin-noise-table> ( -- table )
|
||||
256 iota >byte-array randomize dup append ; inline
|
||||
|
||||
: with-seed ( seed quot -- )
|
||||
[ <mersenne-twister> ] dip with-random ; inline
|
||||
|
||||
<PRIVATE
|
||||
: random-int-4 ( -- v )
|
||||
16 random-bytes underlying>> int-4 boa ; inline
|
||||
|
||||
: (fade) ( x y z -- x' y' z' )
|
||||
[ { 0.0 0.0 0.0 10.0 -15.0 6.0 } polyval* ] tri@ ;
|
||||
: (random-float-4) ( -- v )
|
||||
random-int-4 int-4 float-4 vconvert ; inline
|
||||
|
||||
HINTS: (fade) { float float float } ;
|
||||
! XXX redundant add
|
||||
: uniform-random-float-4 ( min max -- n )
|
||||
(random-float-4) (random-float-4)
|
||||
2.0 31 ^ v+n 2.0 32 ^ v*n v+
|
||||
[ over - 2.0 -64 ^ * ] dip n*v n+v ; inline
|
||||
|
||||
: fade ( point -- point' )
|
||||
first3 (fade) 3array ; inline
|
||||
: normal-random-float-4 ( mean sigma -- n )
|
||||
0.0 1.0 uniform-random-float-4
|
||||
0.0 1.0 uniform-random-float-4
|
||||
[ 2 pi * v*n [ fcos ] map ]
|
||||
[ 1.0 swap n-v [ flog ] map -2.0 v*n vsqrt ]
|
||||
bi* v* n*v n+v ; inline
|
||||
|
||||
:: grad ( hash x y z -- gradient )
|
||||
hash 8 bitand zero? [ x ] [ y ] if
|
||||
:> u
|
||||
hash 12 bitand zero?
|
||||
[ y ] [ hash 13 bitand 12 = [ x ] [ z ] if ] if
|
||||
:> v
|
||||
: float-map>byte-map ( floats: float-array scale: float bias: float -- bytes: byte-array )
|
||||
'[
|
||||
[ _ 255.0 * v*n _ 255.0 * v+n float-4 int-4 vconvert ] 4 napply
|
||||
[ int-4 short-8 vconvert ] 2bi@
|
||||
short-8 uchar-16 vconvert
|
||||
] data-map( float-4[4] -- uchar-16 ) ; inline
|
||||
|
||||
hash 1 bitand zero? [ u ] [ u neg ] if
|
||||
hash 2 bitand zero? [ v ] [ v neg ] if + ;
|
||||
TYPED:: float-map>image ( floats: float-array dim scale: float bias: float -- image: image )
|
||||
image new
|
||||
dim >>dim
|
||||
floats scale bias float-map>byte-map >>bitmap
|
||||
L >>component-order
|
||||
ubyte-components >>component-type ;
|
||||
|
||||
HINTS: grad { fixnum float float float } ;
|
||||
TYPED: uniform-noise-map ( seed: integer dim -- map: float-array )
|
||||
'[
|
||||
_ product 4 / [ 0.0 1.0 uniform-random-float-4 ]
|
||||
float-4-array{ } replicate-as
|
||||
byte-array>float-array
|
||||
] with-seed ;
|
||||
|
||||
: unit-cube ( point -- cube )
|
||||
[ floor 256 rem ] map ;
|
||||
: uniform-noise-image ( seed dim -- image )
|
||||
[ uniform-noise-map ] [ 1.0 0.0 float-map>image ] bi ; inline
|
||||
|
||||
TYPED: normal-noise-map ( seed: integer sigma: float dim -- map: float-array )
|
||||
swap '[
|
||||
_ product 4 / [ 0.5 _ normal-random-float-4 ]
|
||||
float-4-array{ } replicate-as
|
||||
byte-array>float-array
|
||||
] with-seed ;
|
||||
|
||||
: normal-noise-image ( seed sigma dim -- image )
|
||||
[ normal-noise-map ] [ 1.0 0.0 float-map>image ] bi ; inline
|
||||
|
||||
ERROR: invalid-perlin-noise-table table ;
|
||||
|
||||
: <perlin-noise-table> ( -- table )
|
||||
256 iota >byte-array randomize dup append ; inline
|
||||
|
||||
: validate-table ( table -- table )
|
||||
dup { [ byte-array? ] [ length 512 >= ] } 1&&
|
||||
[ invalid-perlin-noise-table ] unless ;
|
||||
|
||||
! XXX doesn't work for NaNs or very large floats
|
||||
: floor-vector ( v -- v' )
|
||||
[ float-4 int-4 vconvert int-4 float-4 vconvert ]
|
||||
[ [ v> -1.0 float-4-with vand ] curry keep v+ ] bi ; inline
|
||||
|
||||
: unit-cubed ( floats -- ints )
|
||||
float-4 int-4 vconvert 255 int-4-with vbitand ; inline
|
||||
|
||||
: fade ( gradient -- gradient' )
|
||||
{
|
||||
[ drop 6.0 ]
|
||||
[ n*v -15.0 v+n ]
|
||||
[ v* 10.0 v+n ]
|
||||
[ v* ]
|
||||
[ v* ]
|
||||
[ v* ]
|
||||
} cleave ; inline
|
||||
|
||||
:: hashes ( table x y z -- aaa baa aba bba aab bab abb bbb )
|
||||
x table nth-unsafe y + :> a
|
||||
x 1 + table nth-unsafe y + :> b
|
||||
|
|
@ -54,79 +109,41 @@ HINTS: grad { fixnum float float float } ;
|
|||
ab 1 + table nth-unsafe
|
||||
bb 1 + table nth-unsafe ; inline
|
||||
|
||||
HINTS: hashes { byte-array fixnum fixnum fixnum } ;
|
||||
:: grad ( hash v -- gradient )
|
||||
hash 8 bitand zero? [ v first ] [ v second ] if
|
||||
:> u
|
||||
hash 12 bitand zero?
|
||||
[ v second ] [ hash 13 bitand 12 = [ v first ] [ v third ] if ] if
|
||||
:> v
|
||||
|
||||
: >byte-map ( floats -- bytes )
|
||||
[ 255.0 * >fixnum ] B{ } map-as ;
|
||||
hash 1 bitand zero? [ u ] [ u neg ] if
|
||||
hash 2 bitand zero? [ v ] [ v neg ] if + ; inline
|
||||
|
||||
: >image ( bytes dim -- image )
|
||||
image new
|
||||
swap >>dim
|
||||
swap >>bitmap
|
||||
L >>component-order
|
||||
ubyte-components >>component-type ;
|
||||
|
||||
:: perlin-noise-unsafe ( table point -- value )
|
||||
point unit-cube :> cube
|
||||
point dup vfloor v- :> gradients
|
||||
TYPED:: perlin-noise ( table: byte-array point: float-4 -- value: float )
|
||||
point floor-vector :> _point_
|
||||
_point_ unit-cubed :> cube
|
||||
point _point_ v- :> gradients
|
||||
gradients fade :> faded
|
||||
|
||||
table cube first3 hashes {
|
||||
[ gradients first3 grad ]
|
||||
[ gradients first3 [ 1.0 - ] [ ] [ ] tri* grad ]
|
||||
[ gradients first3 [ ] [ 1.0 - ] [ ] tri* grad ]
|
||||
[ gradients first3 [ 1.0 - ] [ 1.0 - ] [ ] tri* grad ]
|
||||
[ gradients first3 [ ] [ ] [ 1.0 - ] tri* grad ]
|
||||
[ gradients first3 [ 1.0 - ] [ ] [ 1.0 - ] tri* grad ]
|
||||
[ gradients first3 [ ] [ 1.0 - ] [ 1.0 - ] tri* grad ]
|
||||
[ gradients first3 [ 1.0 - ] [ 1.0 - ] [ 1.0 - ] tri* grad ]
|
||||
[ gradients grad ]
|
||||
[ gradients float-4{ 1.0 0.0 0.0 0.0 } v- grad ]
|
||||
[ gradients float-4{ 0.0 1.0 0.0 0.0 } v- grad ]
|
||||
[ gradients float-4{ 1.0 1.0 0.0 0.0 } v- grad ]
|
||||
[ gradients float-4{ 0.0 0.0 1.0 0.0 } v- grad ]
|
||||
[ gradients float-4{ 1.0 0.0 1.0 0.0 } v- grad ]
|
||||
[ gradients float-4{ 0.0 1.0 1.0 0.0 } v- grad ]
|
||||
[ gradients float-4{ 1.0 1.0 1.0 0.0 } v- grad ]
|
||||
} spread
|
||||
faded trilerp ;
|
||||
|
||||
ERROR: invalid-perlin-noise-table table ;
|
||||
MEMO: perlin-noise-map-coords ( dim -- coords )
|
||||
first2 [| x y | x [ y 0.0 0.0 float-4-boa ] float-4-array{ } map-as ] with map concat ;
|
||||
|
||||
: validate-table ( table -- table )
|
||||
dup { [ byte-array? ] [ length 512 >= ] } 1&&
|
||||
[ invalid-perlin-noise-table ] unless ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: perlin-noise ( table point -- value )
|
||||
[ validate-table ] dip perlin-noise-unsafe ; inline
|
||||
|
||||
: normalize-0-1 ( sequence -- sequence' )
|
||||
[ supremum ] [ infimum [ - ] keep ] [ ] tri
|
||||
[ swap - ] with map [ swap / ] with map ;
|
||||
|
||||
: clamp-0-1 ( sequence -- sequence' )
|
||||
[ 0.0 max 1.0 min ] map ;
|
||||
|
||||
: perlin-noise-map ( table transform dim -- map )
|
||||
[ validate-table ] 2dip
|
||||
[ iota ] map [ a.v 0.0 suffix perlin-noise-unsafe ] with with product-map ;
|
||||
|
||||
: perlin-noise-byte-map ( table transform dim -- map )
|
||||
perlin-noise-map normalize-0-1 >byte-map ;
|
||||
TYPED:: perlin-noise-map ( table: byte-array transform: matrix4 coords: float-4-array -- map: float-array )
|
||||
coords [| coord | table transform coord m4.v perlin-noise ] data-map( float-4 -- c:float )
|
||||
byte-array>float-array ;
|
||||
|
||||
: perlin-noise-image ( table transform dim -- image )
|
||||
[ perlin-noise-byte-map ] [ >image ] bi ;
|
||||
[ perlin-noise-map-coords perlin-noise-map ] [ 5/7. 0.5 float-map>image ] bi ;
|
||||
|
||||
: uniform-noise-map ( seed dim -- map )
|
||||
[ product [ 0.0 1.0 uniform-random-float ] replicate ]
|
||||
curry with-seed ;
|
||||
|
||||
: uniform-noise-byte-map ( seed dim -- map )
|
||||
uniform-noise-map >byte-map ;
|
||||
|
||||
: uniform-noise-image ( seed dim -- image )
|
||||
[ uniform-noise-byte-map ] [ >image ] bi ;
|
||||
|
||||
: normal-noise-map ( seed sigma dim -- map )
|
||||
swap '[ _ product [ 0.5 _ normal-random-float ] replicate ]
|
||||
with-seed ;
|
||||
|
||||
: normal-noise-byte-map ( seed sigma dim -- map )
|
||||
normal-noise-map clamp-0-1 >byte-map ;
|
||||
|
||||
: normal-noise-image ( seed sigma dim -- image )
|
||||
[ normal-noise-byte-map ] [ >image ] bi ;
|
||||
|
|
|
|||
|
|
@ -1,38 +1,50 @@
|
|||
USING: accessors arrays byte-arrays combinators
|
||||
USING: accessors alien.data.map arrays byte-arrays combinators
|
||||
combinators.smart fry grouping images kernel math
|
||||
math.affine-transforms math.order math.vectors noise random
|
||||
sequences ;
|
||||
math.matrices.simd math.order math.vectors noise random
|
||||
sequences math.vectors.simd ;
|
||||
FROM: alien.c-types => float uchar ;
|
||||
SIMDS: float uchar ;
|
||||
IN: terrain.generation
|
||||
|
||||
CONSTANT: terrain-segment-size { 512 512 }
|
||||
CONSTANT: terrain-big-noise-scale { 0.002 0.002 }
|
||||
CONSTANT: terrain-small-noise-scale { 0.05 0.05 }
|
||||
CONSTANT: terrain-segment-size-vector { 512.0 512.0 1.0 1.0 }
|
||||
CONSTANT: terrain-big-noise-scale float-4{ 0.002 0.002 0.002 0.002 }
|
||||
CONSTANT: terrain-small-noise-scale float-4{ 0.05 0.05 0.05 0.05 }
|
||||
|
||||
TUPLE: terrain big-noise-table small-noise-table tiny-noise-seed ;
|
||||
TUPLE: terrain
|
||||
{ big-noise-table byte-array }
|
||||
{ small-noise-table byte-array }
|
||||
{ tiny-noise-seed integer } ;
|
||||
|
||||
: <terrain> ( -- terrain )
|
||||
<perlin-noise-table> <perlin-noise-table>
|
||||
32 random-bits terrain boa ;
|
||||
|
||||
: seed-at ( seed at -- seed' )
|
||||
first2 [ + ] dip [ 32 random-bits + ] curry with-seed ;
|
||||
first2 [ >integer ] bi@ [ + ] dip [ 32 random-bits + ] curry with-seed ;
|
||||
|
||||
: big-noise-segment ( terrain at -- map )
|
||||
[ big-noise-table>> terrain-big-noise-scale first2 <scale> ] dip
|
||||
terrain-segment-size [ v* <translation> a. ] keep perlin-noise-byte-map ;
|
||||
: small-noise-segment ( terrain at -- map )
|
||||
[ small-noise-table>> terrain-small-noise-scale first2 <scale> ] dip
|
||||
terrain-segment-size [ v* <translation> a. ] keep perlin-noise-byte-map ;
|
||||
: tiny-noise-segment ( terrain at -- map )
|
||||
: big-noise-segment ( terrain at -- bytes )
|
||||
[ big-noise-table>> terrain-big-noise-scale scale-matrix4 ] dip
|
||||
terrain-segment-size-vector v* translation-matrix4 m4.
|
||||
terrain-segment-size perlin-noise-image bitmap>> ; inline
|
||||
: small-noise-segment ( terrain at -- bytes )
|
||||
[ small-noise-table>> terrain-small-noise-scale scale-matrix4 ] dip
|
||||
terrain-segment-size-vector v* translation-matrix4 m4.
|
||||
terrain-segment-size perlin-noise-image bitmap>> ; inline
|
||||
: tiny-noise-segment ( terrain at -- bytes )
|
||||
[ tiny-noise-seed>> ] dip seed-at 0.1
|
||||
terrain-segment-size normal-noise-byte-map ;
|
||||
|
||||
terrain-segment-size normal-noise-image bitmap>> ; inline
|
||||
: padding ( terrain at -- padding )
|
||||
2drop terrain-segment-size product 255 <repetition> ;
|
||||
2drop terrain-segment-size product 255 <repetition> >byte-array ; inline
|
||||
|
||||
TUPLE: segment image ;
|
||||
|
||||
: <terrain-image> ( bytes -- image )
|
||||
: fold-rgba-planes ( r g b a -- rgba )
|
||||
[ vmerge-transpose vmerge-transpose ]
|
||||
data-map( uchar-16 uchar-16 uchar-16 uchar-16 -- uchar-16[4] ) ;
|
||||
|
||||
: <terrain-image> ( big small tiny padding -- image )
|
||||
fold-rgba-planes
|
||||
<image>
|
||||
swap >>bitmap
|
||||
RGBA >>component-order
|
||||
|
|
@ -40,14 +52,12 @@ TUPLE: segment image ;
|
|||
terrain-segment-size >>dim ;
|
||||
|
||||
: terrain-segment ( terrain at -- image )
|
||||
[
|
||||
{
|
||||
[ big-noise-segment ]
|
||||
[ small-noise-segment ]
|
||||
[ tiny-noise-segment ]
|
||||
[ padding ]
|
||||
} 2cleave
|
||||
] output>array flip B{ } concat-as <terrain-image> ;
|
||||
{
|
||||
[ big-noise-segment ]
|
||||
[ small-noise-segment ]
|
||||
[ tiny-noise-segment ]
|
||||
[ padding ]
|
||||
} 2cleave <terrain-image> ;
|
||||
|
||||
: 4max ( a b c d -- max )
|
||||
max max max ; inline
|
||||
|
|
|
|||
|
|
@ -1,42 +1,47 @@
|
|||
! (c)2009 Joe Groff, Doug Coleman. bsd license
|
||||
USING: accessors arrays combinators game.input game.loop
|
||||
game.input.scancodes grouping kernel literals locals
|
||||
math math.constants math.functions math.matrices math.order
|
||||
math math.constants math.functions math.order
|
||||
math.vectors opengl opengl.capabilities opengl.gl
|
||||
opengl.shaders opengl.textures opengl.textures.private
|
||||
sequences sequences.product specialized-arrays
|
||||
terrain.generation terrain.shaders ui ui.gadgets
|
||||
terrain.generation terrain.shaders typed ui ui.gadgets
|
||||
ui.gadgets.worlds ui.pixel-formats game.worlds method-chains
|
||||
math.affine-transforms noise ui.gestures combinators.short-circuit
|
||||
destructors grid-meshes ;
|
||||
FROM: alien.c-types => float ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
math.matrices.simd noise ui.gestures combinators.short-circuit
|
||||
destructors grid-meshes math.vectors.simd ;
|
||||
QUALIFIED-WITH: alien.c-types c
|
||||
SPECIALIZED-ARRAY: c:float
|
||||
SIMD: c:float
|
||||
IN: terrain
|
||||
|
||||
CONSTANT: FOV $[ 2.0 sqrt 1 + ]
|
||||
CONSTANT: NEAR-PLANE $[ 1.0 1024.0 / ]
|
||||
CONSTANT: NEAR-PLANE 1/1024.
|
||||
CONSTANT: FAR-PLANE 2.0
|
||||
CONSTANT: PLAYER-START-LOCATION { 0.5 0.51 0.5 }
|
||||
CONSTANT: VELOCITY-MODIFIER-NORMAL { 1.0 1.0 1.0 }
|
||||
CONSTANT: VELOCITY-MODIFIER-FAST { 2.0 1.0 2.0 }
|
||||
CONSTANT: PLAYER-HEIGHT $[ 1.0 256.0 / ]
|
||||
CONSTANT: GRAVITY $[ 1.0 4096.0 / ]
|
||||
CONSTANT: JUMP $[ 1.0 1024.0 / ]
|
||||
CONSTANT: MOUSE-SCALE $[ 1.0 10.0 / ]
|
||||
CONSTANT: MOVEMENT-SPEED $[ 1.0 16384.0 / ]
|
||||
CONSTANT: FRICTION { 0.95 0.99 0.95 }
|
||||
CONSTANT: COMPONENT-SCALE { 0.5 0.01 0.0005 0.0 }
|
||||
CONSTANT: PLAYER-START-LOCATION float-4{ 0.5 0.51 0.5 1.0 }
|
||||
CONSTANT: VELOCITY-MODIFIER-NORMAL float-4{ 1.0 1.0 1.0 0.0 }
|
||||
CONSTANT: VELOCITY-MODIFIER-FAST float-4{ 2.0 1.0 2.0 0.0 }
|
||||
CONSTANT: PLAYER-HEIGHT 1/256.
|
||||
CONSTANT: GRAVITY float-4{ 0.0 -1/4096. 0.0 0.0 }
|
||||
CONSTANT: JUMP 1/1024.
|
||||
CONSTANT: MOUSE-SCALE 1/10.
|
||||
CONSTANT: MOVEMENT-SPEED 1/16384.
|
||||
CONSTANT: FRICTION float-4{ 0.95 0.99 0.95 1.0 }
|
||||
CONSTANT: COMPONENT-SCALE float-4{ 0.5 0.01 0.0005 0.0 }
|
||||
CONSTANT: SKY-PERIOD 1200
|
||||
CONSTANT: SKY-SPEED 0.0005
|
||||
|
||||
CONSTANT: terrain-vertex-size { 512 512 }
|
||||
|
||||
TUPLE: player
|
||||
location yaw pitch velocity velocity-modifier
|
||||
{ location float-4 }
|
||||
{ yaw float }
|
||||
{ pitch float }
|
||||
{ velocity float-4 }
|
||||
{ velocity-modifier float-4 }
|
||||
reverse-time ;
|
||||
|
||||
TUPLE: terrain-world < game-world
|
||||
player
|
||||
{ player player }
|
||||
sky-image sky-texture sky-program
|
||||
terrain terrain-segment terrain-texture terrain-program
|
||||
terrain-mesh
|
||||
|
|
@ -47,7 +52,7 @@ TUPLE: terrain-world < game-world
|
|||
PLAYER-START-LOCATION >>location
|
||||
0.0 >>yaw
|
||||
0.0 >>pitch
|
||||
{ 0.0 0.0 0.0 } >>velocity
|
||||
float-4{ 0.0 0.0 0.0 1.0 } >>velocity
|
||||
VELOCITY-MODIFIER-NORMAL >>velocity-modifier ;
|
||||
|
||||
M: terrain-world tick-length
|
||||
|
|
@ -68,48 +73,40 @@ M: terrain-world tick-length
|
|||
[ location>> vneg first3 glTranslatef ] tri ;
|
||||
|
||||
: degrees ( deg -- rad )
|
||||
pi 180.0 / * ;
|
||||
pi 180.0 / * ; inline
|
||||
|
||||
:: eye-rotate ( yaw pitch v -- v' )
|
||||
yaw degrees neg :> y
|
||||
pitch degrees neg :> p
|
||||
y cos :> cosy
|
||||
y sin :> siny
|
||||
p cos :> cosp
|
||||
p sin :> sinp
|
||||
|
||||
cosy 0.0 siny neg 3array
|
||||
siny sinp * cosp cosy sinp * 3array
|
||||
siny cosp * sinp neg cosy cosp * 3array 3array
|
||||
v swap v.m ;
|
||||
TYPED: eye-rotate ( yaw: float pitch: float v: float-4 -- v': float-4 )
|
||||
[ float-4{ 0.0 -1.0 0.0 0.0 } swap degrees rotation-matrix4 ]
|
||||
[ float-4{ -1.0 0.0 0.0 0.0 } swap degrees rotation-matrix4 m4. ]
|
||||
[ m4.v ] tri* float-4{ t t t f } vand ;
|
||||
|
||||
: forward-vector ( player -- v )
|
||||
yaw>> 0.0
|
||||
${ 0.0 0.0 MOVEMENT-SPEED } vneg eye-rotate ;
|
||||
float-4{ 0.0 0.0 $ MOVEMENT-SPEED 1.0 } vneg eye-rotate ; inline
|
||||
: rightward-vector ( player -- v )
|
||||
yaw>> 0.0
|
||||
${ MOVEMENT-SPEED 0.0 0.0 } eye-rotate ;
|
||||
float-4{ $ MOVEMENT-SPEED 0.0 0.0 1.0 } eye-rotate ; inline
|
||||
: clamp-pitch ( pitch -- pitch' )
|
||||
-90.0 90.0 clamp ;
|
||||
-90.0 90.0 clamp ; inline
|
||||
|
||||
: walk-forward ( player -- )
|
||||
dup forward-vector [ v+ ] curry change-velocity drop ;
|
||||
dup forward-vector [ v+ ] curry change-velocity drop ; inline
|
||||
: walk-backward ( player -- )
|
||||
dup forward-vector [ v- ] curry change-velocity drop ;
|
||||
dup forward-vector [ v- ] curry change-velocity drop ; inline
|
||||
: walk-leftward ( player -- )
|
||||
dup rightward-vector [ v- ] curry change-velocity drop ;
|
||||
dup rightward-vector [ v- ] curry change-velocity drop ; inline
|
||||
: walk-rightward ( player -- )
|
||||
dup rightward-vector [ v+ ] curry change-velocity drop ;
|
||||
dup rightward-vector [ v+ ] curry change-velocity drop ; inline
|
||||
: jump ( player -- )
|
||||
[ ${ 0.0 JUMP 0.0 } v+ ] change-velocity drop ;
|
||||
[ float-4{ 0.0 $ JUMP 0.0 0.0 } v+ ] change-velocity drop ; inline
|
||||
: rotate-leftward ( player x -- )
|
||||
[ - ] curry change-yaw drop ;
|
||||
[ - ] curry change-yaw drop ; inline
|
||||
: rotate-rightward ( player x -- )
|
||||
[ + ] curry change-yaw drop ;
|
||||
[ + ] curry change-yaw drop ; inline
|
||||
: look-horizontally ( player x -- )
|
||||
[ + ] curry change-yaw drop ;
|
||||
[ + ] curry change-yaw drop ; inline
|
||||
: look-vertically ( player x -- )
|
||||
[ + clamp-pitch ] curry change-pitch drop ;
|
||||
[ + clamp-pitch ] curry change-pitch drop ; inline
|
||||
|
||||
|
||||
: rotate-with-mouse ( player mouse -- )
|
||||
|
|
@ -155,7 +152,7 @@ terrain-world H{
|
|||
FRICTION v* ;
|
||||
|
||||
: apply-gravity ( velocity -- velocity' )
|
||||
1 over [ GRAVITY - ] change-nth ;
|
||||
GRAVITY v+ ;
|
||||
|
||||
: clamp-coords ( coords dim -- coords' )
|
||||
[ { 0 0 } vmax ] dip { 2 2 } v- vmin ;
|
||||
|
|
@ -206,11 +203,9 @@ terrain-world H{
|
|||
drop ;
|
||||
|
||||
: tick-player ( world player -- )
|
||||
dup reverse-time>> [
|
||||
tick-player-reverse
|
||||
] [
|
||||
tick-player-forward
|
||||
] if ;
|
||||
dup reverse-time>>
|
||||
[ tick-player-reverse ]
|
||||
[ tick-player-forward ] if ;
|
||||
|
||||
M: terrain-world tick*
|
||||
[ dup focused?>> [ handle-input ] [ drop ] if ]
|
||||
|
|
@ -236,11 +231,11 @@ BEFORE: terrain-world begin-world
|
|||
GL_VERTEX_ARRAY glEnableClientState
|
||||
<player> >>player
|
||||
V{ } clone >>history
|
||||
<perlin-noise-table> 0.01 0.01 <scale> { 512 512 } perlin-noise-image
|
||||
<perlin-noise-table> 0.01 float-4-with scale-matrix4 { 512 512 } perlin-noise-image
|
||||
[ >>sky-image ] keep
|
||||
make-texture [ set-texture-parameters ] keep >>sky-texture
|
||||
<terrain> [ >>terrain ] keep
|
||||
{ 0 0 } terrain-segment [ >>terrain-segment ] keep
|
||||
float-4{ 0.0 0.0 0.0 1.0 } terrain-segment [ >>terrain-segment ] keep
|
||||
make-texture [ set-texture-parameters ] keep >>terrain-texture
|
||||
sky-vertex-shader sky-pixel-shader <simple-gl-program>
|
||||
>>sky-program
|
||||
|
|
@ -282,7 +277,7 @@ M: terrain-world draw-world*
|
|||
] with-gl-program ]
|
||||
} cleave gl-error ;
|
||||
|
||||
M: terrain-world pref-dim* drop { 640 480 } ;
|
||||
M: terrain-world pref-dim* drop { 1024 768 } ;
|
||||
|
||||
: terrain-window ( -- )
|
||||
[
|
||||
|
|
|
|||
Loading…
Reference in New Issue