steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

improve noise/terrain performance

db4
Joe Groff 2009-10-15 22:37:31 -05:00
parent 4d0f9744a4
commit 7142139cf7
3 changed files with 191 additions and 169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

195
extra/noise/noise.factor
View File

@ -1,41 +1,96 @@
USING: accessors arrays byte-arrays combinators USING: accessors alien.data.map byte-arrays combinators combinators.short-circuit
combinators.short-circuit fry hints images kernel locals math fry generalizations images kernel locals math math.constants math.functions
math.affine-transforms math.functions math.order math.polynomials math.libm math.matrices.simd math.vectors math.vectors.conversion math.vectors.simd
math.vectors random random.mersenne-twister sequences memoize random random.mersenne-twister sequences sequences.private specialized-arrays
sequences.private sequences.product ; 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 IN: noise
: <perlin-noise-table> ( -- table )
256 iota >byte-array randomize dup append ; inline
: with-seed ( seed quot -- ) : with-seed ( seed quot -- )
[ <mersenne-twister> ] dip with-random ; inline [ <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' ) : (random-float-4) ( -- v )
[ { 0.0 0.0 0.0 10.0 -15.0 6.0 } polyval* ] tri@ ; 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' ) : normal-random-float-4 ( mean sigma -- n )
first3 (fade) 3array ; inline 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 ) : float-map>byte-map ( floats: float-array scale: float bias: float -- bytes: byte-array )
hash 8 bitand zero? [ x ] [ y ] if '[
:> u [ _ 255.0 * v*n _ 255.0 * v+n float-4 int-4 vconvert ] 4 napply
hash 12 bitand zero? [ int-4 short-8 vconvert ] 2bi@
[ y ] [ hash 13 bitand 12 = [ x ] [ z ] if ] if short-8 uchar-16 vconvert
:> v ] data-map( float-4[4] -- uchar-16 ) ; inline
hash 1 bitand zero? [ u ] [ u neg ] if TYPED:: float-map>image ( floats: float-array dim scale: float bias: float -- image: image )
hash 2 bitand zero? [ v ] [ v neg ] if + ; 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 ) : uniform-noise-image ( seed dim -- image )
[ floor 256 rem ] map ; [ 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 ) :: hashes ( table x y z -- aaa baa aba bba aab bab abb bbb )
x table nth-unsafe y + :> a x table nth-unsafe y + :> a
x 1 + table nth-unsafe y + :> b x 1 + table nth-unsafe y + :> b
@ -54,79 +109,41 @@ HINTS: grad { fixnum float float float } ;
ab 1 + table nth-unsafe ab 1 + table nth-unsafe
bb 1 + table nth-unsafe ; inline 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 ) hash 1 bitand zero? [ u ] [ u neg ] if
[ 255.0 * >fixnum ] B{ } map-as ; hash 2 bitand zero? [ v ] [ v neg ] if + ; inline
: >image ( bytes dim -- image ) TYPED:: perlin-noise ( table: byte-array point: float-4 -- value: float )
image new point floor-vector :> _point_
swap >>dim _point_ unit-cubed :> cube
swap >>bitmap point _point_ v- :> gradients
L >>component-order
ubyte-components >>component-type ;
:: perlin-noise-unsafe ( table point -- value )
point unit-cube :> cube
point dup vfloor v- :> gradients
gradients fade :> faded gradients fade :> faded
table cube first3 hashes { table cube first3 hashes {
[ gradients first3 grad ] [ gradients grad ]
[ gradients first3 [ 1.0 - ] [ ] [ ] tri* grad ] [ gradients float-4{ 1.0 0.0 0.0 0.0 } v- grad ]
[ gradients first3 [ ] [ 1.0 - ] [ ] tri* grad ] [ gradients float-4{ 0.0 1.0 0.0 0.0 } v- grad ]
[ gradients first3 [ 1.0 - ] [ 1.0 - ] [ ] tri* grad ] [ gradients float-4{ 1.0 1.0 0.0 0.0 } v- grad ]
[ gradients first3 [ ] [ ] [ 1.0 - ] tri* grad ] [ gradients float-4{ 0.0 0.0 1.0 0.0 } v- grad ]
[ gradients first3 [ 1.0 - ] [ ] [ 1.0 - ] tri* grad ] [ gradients float-4{ 1.0 0.0 1.0 0.0 } v- grad ]
[ gradients first3 [ ] [ 1.0 - ] [ 1.0 - ] tri* grad ] [ gradients float-4{ 0.0 1.0 1.0 0.0 } v- grad ]
[ gradients first3 [ 1.0 - ] [ 1.0 - ] [ 1.0 - ] tri* grad ] [ gradients float-4{ 1.0 1.0 1.0 0.0 } v- grad ]
} spread } spread
faded trilerp ; 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 ) TYPED:: perlin-noise-map ( table: byte-array transform: matrix4 coords: float-4-array -- map: float-array )
dup { [ byte-array? ] [ length 512 >= ] } 1&& coords [| coord | table transform coord m4.v perlin-noise ] data-map( float-4 -- c:float )
[ invalid-perlin-noise-table ] unless ; byte-array>float-array ;
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 ;
: perlin-noise-image ( table transform dim -- image ) : 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 ;

62
extra/terrain/generation/generation.factor
View File

@ -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 combinators.smart fry grouping images kernel math
math.affine-transforms math.order math.vectors noise random math.matrices.simd math.order math.vectors noise random
sequences ; sequences math.vectors.simd ;
FROM: alien.c-types => float uchar ;
SIMDS: float uchar ;
IN: terrain.generation IN: terrain.generation
CONSTANT: terrain-segment-size { 512 512 } CONSTANT: terrain-segment-size { 512 512 }
CONSTANT: terrain-big-noise-scale { 0.002 0.002 } CONSTANT: terrain-segment-size-vector { 512.0 512.0 1.0 1.0 }
CONSTANT: terrain-small-noise-scale { 0.05 0.05 } 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 ) : <terrain> ( -- terrain )
<perlin-noise-table> <perlin-noise-table> <perlin-noise-table> <perlin-noise-table>
32 random-bits terrain boa ; 32 random-bits terrain boa ;
: seed-at ( seed at -- seed' ) : 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-segment ( terrain at -- bytes )
[ big-noise-table>> terrain-big-noise-scale first2 <scale> ] dip [ big-noise-table>> terrain-big-noise-scale scale-matrix4 ] dip
terrain-segment-size [ v* <translation> a. ] keep perlin-noise-byte-map ; terrain-segment-size-vector v* translation-matrix4 m4.
: small-noise-segment ( terrain at -- map ) terrain-segment-size perlin-noise-image bitmap>> ; inline
[ small-noise-table>> terrain-small-noise-scale first2 <scale> ] dip : small-noise-segment ( terrain at -- bytes )
terrain-segment-size [ v* <translation> a. ] keep perlin-noise-byte-map ; [ small-noise-table>> terrain-small-noise-scale scale-matrix4 ] dip
: tiny-noise-segment ( terrain at -- map ) 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 [ 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 ) : padding ( terrain at -- padding )
2drop terrain-segment-size product 255 <repetition> ; 2drop terrain-segment-size product 255 <repetition> >byte-array ; inline
TUPLE: segment image ; 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> <image>
swap >>bitmap swap >>bitmap
RGBA >>component-order RGBA >>component-order
@ -40,14 +52,12 @@ TUPLE: segment image ;
terrain-segment-size >>dim ; terrain-segment-size >>dim ;
: terrain-segment ( terrain at -- image ) : terrain-segment ( terrain at -- image )
[ {
{ [ big-noise-segment ]
[ big-noise-segment ] [ small-noise-segment ]
[ small-noise-segment ] [ tiny-noise-segment ]
[ tiny-noise-segment ] [ padding ]
[ padding ] } 2cleave <terrain-image> ;
} 2cleave
] output>array flip B{ } concat-as <terrain-image> ;
: 4max ( a b c d -- max ) : 4max ( a b c d -- max )
max max max ; inline max max max ; inline

103
extra/terrain/terrain.factor
View File

@ -1,42 +1,47 @@
! (c)2009 Joe Groff, Doug Coleman. bsd license ! (c)2009 Joe Groff, Doug Coleman. bsd license
USING: accessors arrays combinators game.input game.loop USING: accessors arrays combinators game.input game.loop
game.input.scancodes grouping kernel literals locals 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 math.vectors opengl opengl.capabilities opengl.gl
opengl.shaders opengl.textures opengl.textures.private opengl.shaders opengl.textures opengl.textures.private
sequences sequences.product specialized-arrays 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 ui.gadgets.worlds ui.pixel-formats game.worlds method-chains
math.affine-transforms noise ui.gestures combinators.short-circuit math.matrices.simd noise ui.gestures combinators.short-circuit
destructors grid-meshes ; destructors grid-meshes math.vectors.simd ;
FROM: alien.c-types => float ; QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: c:float
SIMD: c:float
IN: terrain IN: terrain
CONSTANT: FOV $[ 2.0 sqrt 1 + ] CONSTANT: FOV $[ 2.0 sqrt 1 + ]
CONSTANT: NEAR-PLANE $[ 1.0 1024.0 / ] CONSTANT: NEAR-PLANE 1/1024.
CONSTANT: FAR-PLANE 2.0 CONSTANT: FAR-PLANE 2.0
CONSTANT: PLAYER-START-LOCATION { 0.5 0.51 0.5 } CONSTANT: PLAYER-START-LOCATION float-4{ 0.5 0.51 0.5 1.0 }
CONSTANT: VELOCITY-MODIFIER-NORMAL { 1.0 1.0 1.0 } CONSTANT: VELOCITY-MODIFIER-NORMAL float-4{ 1.0 1.0 1.0 0.0 }
CONSTANT: VELOCITY-MODIFIER-FAST { 2.0 1.0 2.0 } CONSTANT: VELOCITY-MODIFIER-FAST float-4{ 2.0 1.0 2.0 0.0 }
CONSTANT: PLAYER-HEIGHT $[ 1.0 256.0 / ] CONSTANT: PLAYER-HEIGHT 1/256.
CONSTANT: GRAVITY $[ 1.0 4096.0 / ] CONSTANT: GRAVITY float-4{ 0.0 -1/4096. 0.0 0.0 }
CONSTANT: JUMP $[ 1.0 1024.0 / ] CONSTANT: JUMP 1/1024.
CONSTANT: MOUSE-SCALE $[ 1.0 10.0 / ] CONSTANT: MOUSE-SCALE 1/10.
CONSTANT: MOVEMENT-SPEED $[ 1.0 16384.0 / ] CONSTANT: MOVEMENT-SPEED 1/16384.
CONSTANT: FRICTION { 0.95 0.99 0.95 } CONSTANT: FRICTION float-4{ 0.95 0.99 0.95 1.0 }
CONSTANT: COMPONENT-SCALE { 0.5 0.01 0.0005 0.0 } CONSTANT: COMPONENT-SCALE float-4{ 0.5 0.01 0.0005 0.0 }
CONSTANT: SKY-PERIOD 1200 CONSTANT: SKY-PERIOD 1200
CONSTANT: SKY-SPEED 0.0005 CONSTANT: SKY-SPEED 0.0005
CONSTANT: terrain-vertex-size { 512 512 } CONSTANT: terrain-vertex-size { 512 512 }
TUPLE: player TUPLE: player
location yaw pitch velocity velocity-modifier { location float-4 }
{ yaw float }
{ pitch float }
{ velocity float-4 }
{ velocity-modifier float-4 }
reverse-time ; reverse-time ;
TUPLE: terrain-world < game-world TUPLE: terrain-world < game-world
player { player player }
sky-image sky-texture sky-program sky-image sky-texture sky-program
terrain terrain-segment terrain-texture terrain-program terrain terrain-segment terrain-texture terrain-program
terrain-mesh terrain-mesh
@ -47,7 +52,7 @@ TUPLE: terrain-world < game-world
PLAYER-START-LOCATION >>location PLAYER-START-LOCATION >>location
0.0 >>yaw 0.0 >>yaw
0.0 >>pitch 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 ; VELOCITY-MODIFIER-NORMAL >>velocity-modifier ;
M: terrain-world tick-length M: terrain-world tick-length
@ -68,48 +73,40 @@ M: terrain-world tick-length
[ location>> vneg first3 glTranslatef ] tri ; [ location>> vneg first3 glTranslatef ] tri ;
: degrees ( deg -- rad ) : degrees ( deg -- rad )
pi 180.0 / * ; pi 180.0 / * ; inline
:: eye-rotate ( yaw pitch v -- v' ) TYPED: eye-rotate ( yaw: float pitch: float v: float-4 -- v': float-4 )
yaw degrees neg :> y [ float-4{ 0.0 -1.0 0.0 0.0 } swap degrees rotation-matrix4 ]
pitch degrees neg :> p [ float-4{ -1.0 0.0 0.0 0.0 } swap degrees rotation-matrix4 m4. ]
y cos :> cosy [ m4.v ] tri* float-4{ t t t f } vand ;
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 ;
: forward-vector ( player -- v ) : forward-vector ( player -- v )
yaw>> 0.0 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 ) : rightward-vector ( player -- v )
yaw>> 0.0 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' ) : clamp-pitch ( pitch -- pitch' )
-90.0 90.0 clamp ; -90.0 90.0 clamp ; inline
: walk-forward ( player -- ) : walk-forward ( player -- )
dup forward-vector [ v+ ] curry change-velocity drop ; dup forward-vector [ v+ ] curry change-velocity drop ; inline
: walk-backward ( player -- ) : walk-backward ( player -- )
dup forward-vector [ v- ] curry change-velocity drop ; dup forward-vector [ v- ] curry change-velocity drop ; inline
: walk-leftward ( player -- ) : walk-leftward ( player -- )
dup rightward-vector [ v- ] curry change-velocity drop ; dup rightward-vector [ v- ] curry change-velocity drop ; inline
: walk-rightward ( player -- ) : walk-rightward ( player -- )
dup rightward-vector [ v+ ] curry change-velocity drop ; dup rightward-vector [ v+ ] curry change-velocity drop ; inline
: jump ( player -- ) : 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 -- ) : rotate-leftward ( player x -- )
[ - ] curry change-yaw drop ; [ - ] curry change-yaw drop ; inline
: rotate-rightward ( player x -- ) : rotate-rightward ( player x -- )
[ + ] curry change-yaw drop ; [ + ] curry change-yaw drop ; inline
: look-horizontally ( player x -- ) : look-horizontally ( player x -- )
[ + ] curry change-yaw drop ; [ + ] curry change-yaw drop ; inline
: look-vertically ( player x -- ) : look-vertically ( player x -- )
[ + clamp-pitch ] curry change-pitch drop ; [ + clamp-pitch ] curry change-pitch drop ; inline
: rotate-with-mouse ( player mouse -- ) : rotate-with-mouse ( player mouse -- )
@ -155,7 +152,7 @@ terrain-world H{
FRICTION v* ; FRICTION v* ;
: apply-gravity ( velocity -- velocity' ) : apply-gravity ( velocity -- velocity' )
1 over [ GRAVITY - ] change-nth ; GRAVITY v+ ;
: clamp-coords ( coords dim -- coords' ) : clamp-coords ( coords dim -- coords' )
[ { 0 0 } vmax ] dip { 2 2 } v- vmin ; [ { 0 0 } vmax ] dip { 2 2 } v- vmin ;
@ -206,11 +203,9 @@ terrain-world H{
drop ; drop ;
: tick-player ( world player -- ) : tick-player ( world player -- )
dup reverse-time>> [ dup reverse-time>>
tick-player-reverse [ tick-player-reverse ]
] [ [ tick-player-forward ] if ;
tick-player-forward
] if ;
M: terrain-world tick* M: terrain-world tick*
[ dup focused?>> [ handle-input ] [ drop ] if ] [ dup focused?>> [ handle-input ] [ drop ] if ]
@ -236,11 +231,11 @@ BEFORE: terrain-world begin-world
GL_VERTEX_ARRAY glEnableClientState GL_VERTEX_ARRAY glEnableClientState
<player> >>player <player> >>player
V{ } clone >>history 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 [ >>sky-image ] keep
make-texture [ set-texture-parameters ] keep >>sky-texture make-texture [ set-texture-parameters ] keep >>sky-texture
<terrain> [ >>terrain ] keep <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 make-texture [ set-texture-parameters ] keep >>terrain-texture
sky-vertex-shader sky-pixel-shader <simple-gl-program> sky-vertex-shader sky-pixel-shader <simple-gl-program>
>>sky-program >>sky-program
@ -282,7 +277,7 @@ M: terrain-world draw-world*
] with-gl-program ] ] with-gl-program ]
} cleave gl-error ; } cleave gl-error ;
M: terrain-world pref-dim* drop { 640 480 } ; M: terrain-world pref-dim* drop { 1024 768 } ;
: terrain-window ( -- ) : terrain-window ( -- )
[ [