jamshred fixes, but still has an endless recursion bug
Alex Chapman
parent
ea903a67ba
commit
f02bbb6f4b
|
|
@ -6,8 +6,8 @@ math.functions math.vectors opengl opengl.gl opengl.glu
|
|||
opengl.demo-support sequences specialized-arrays.float ;
|
||||
IN: jamshred.gl
|
||||
|
||||
: min-vertices 6 ; inline
|
||||
: max-vertices 32 ; inline
|
||||
: min-vertices ( -- n ) 6 ; inline
|
||||
: max-vertices ( -- n ) 32 ; inline
|
||||
|
||||
: n-vertices ( -- n ) 32 ; inline
|
||||
|
||||
|
|
@ -55,7 +55,7 @@ IN: jamshred.gl
|
|||
: draw-segment ( next-segment segment -- )
|
||||
GL_QUAD_STRIP [
|
||||
[ draw-vertex-pair ] 2curry
|
||||
n-vertices equally-spaced-radians F{ 0.0 } append swap each
|
||||
n-vertices equally-spaced-radians float-array{ 0.0 } append swap each
|
||||
] do-state ;
|
||||
|
||||
: draw-segments ( segments -- )
|
||||
|
|
@ -68,15 +68,13 @@ IN: jamshred.gl
|
|||
: draw-tunnel ( player -- )
|
||||
segments-to-render draw-segments ;
|
||||
|
||||
: init-graphics ( width height -- )
|
||||
: init-graphics ( -- )
|
||||
GL_DEPTH_TEST glEnable
|
||||
GL_SCISSOR_TEST glDisable
|
||||
1.0 glClearDepth
|
||||
0.0 0.0 0.0 0.0 glClearColor
|
||||
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
|
||||
GL_PROJECTION glMatrixMode glLoadIdentity
|
||||
dup 0 = [ 2drop ] [ / >float 45.0 swap 0.1 100.0 gluPerspective ] if
|
||||
GL_MODELVIEW glMatrixMode glLoadIdentity
|
||||
GL_PROJECTION glMatrixMode glPushMatrix
|
||||
GL_MODELVIEW glMatrixMode glPushMatrix
|
||||
GL_LEQUAL glDepthFunc
|
||||
GL_LIGHTING glEnable
|
||||
GL_LIGHT0 glEnable
|
||||
|
|
@ -89,11 +87,26 @@ IN: jamshred.gl
|
|||
GL_LIGHT0 GL_DIFFUSE float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv
|
||||
GL_LIGHT0 GL_SPECULAR float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv ;
|
||||
|
||||
: cleanup-graphics ( -- )
|
||||
GL_DEPTH_TEST glDisable
|
||||
GL_SCISSOR_TEST glEnable
|
||||
GL_MODELVIEW glMatrixMode glPopMatrix
|
||||
GL_PROJECTION glMatrixMode glPopMatrix
|
||||
GL_LIGHTING glDisable
|
||||
GL_LIGHT0 glDisable
|
||||
GL_FOG glDisable
|
||||
GL_COLOR_MATERIAL glDisable ;
|
||||
|
||||
: pre-draw ( width height -- )
|
||||
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
|
||||
GL_PROJECTION glMatrixMode glLoadIdentity
|
||||
dup 0 = [ 2drop ] [ / >float 45.0 swap 0.1 100.0 gluPerspective ] if
|
||||
GL_MODELVIEW glMatrixMode glLoadIdentity ;
|
||||
|
||||
: player-view ( player -- )
|
||||
[ location>> ]
|
||||
[ [ location>> ] [ forward>> ] bi v+ ]
|
||||
[ up>> ] tri gl-look-at ;
|
||||
|
||||
: draw-jamshred ( jamshred width height -- )
|
||||
init-graphics jamshred-player [ player-view ] [ draw-tunnel ] bi ;
|
||||
|
||||
pre-draw jamshred-player [ player-view ] [ draw-tunnel ] bi ;
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
! Copyright (C) 2007, 2008 Alex Chapman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants math.geometry.rect math.vectors namespaces sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render ;
|
||||
USING: accessors arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants math.rectangles math.vectors namespaces sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render ;
|
||||
IN: jamshred
|
||||
|
||||
TUPLE: jamshred-gadget < gadget { jamshred jamshred } last-hand-loc ;
|
||||
|
||||
: <jamshred-gadget> ( jamshred -- gadget )
|
||||
jamshred-gadget new-gadget swap >>jamshred ;
|
||||
jamshred-gadget new swap >>jamshred ;
|
||||
|
||||
: default-width ( -- x ) 800 ;
|
||||
: default-height ( -- y ) 600 ;
|
||||
|
|
@ -15,7 +15,7 @@ M: jamshred-gadget pref-dim*
|
|||
drop default-width default-height 2array ;
|
||||
|
||||
M: jamshred-gadget draw-gadget* ( gadget -- )
|
||||
[ jamshred>> ] [ rect-dim first2 draw-jamshred ] bi ;
|
||||
[ jamshred>> ] [ dim>> first2 draw-jamshred ] bi ;
|
||||
|
||||
: jamshred-loop ( gadget -- )
|
||||
dup jamshred>> quit>> [
|
||||
|
|
@ -23,7 +23,7 @@ M: jamshred-gadget draw-gadget* ( gadget -- )
|
|||
] [
|
||||
[ jamshred>> jamshred-update ]
|
||||
[ relayout-1 ]
|
||||
[ 10 milliseconds sleep yield jamshred-loop ] tri
|
||||
[ 100 milliseconds sleep jamshred-loop ] tri
|
||||
] if ;
|
||||
|
||||
: fullscreen ( gadget -- )
|
||||
|
|
@ -36,10 +36,11 @@ M: jamshred-gadget draw-gadget* ( gadget -- )
|
|||
[ fullscreen? not ] keep set-fullscreen* ;
|
||||
|
||||
M: jamshred-gadget graft* ( gadget -- )
|
||||
[ jamshred-loop ] curry in-thread ;
|
||||
[ find-gl-context init-graphics ]
|
||||
[ [ jamshred-loop ] curry in-thread ] bi ;
|
||||
|
||||
M: jamshred-gadget ungraft* ( gadget -- )
|
||||
jamshred>> t swap (>>quit) ;
|
||||
dup find-gl-context cleanup-graphics jamshred>> t swap (>>quit) ;
|
||||
|
||||
: jamshred-restart ( jamshred-gadget -- )
|
||||
<jamshred> >>jamshred drop ;
|
||||
|
|
@ -49,16 +50,15 @@ M: jamshred-gadget ungraft* ( gadget -- )
|
|||
|
||||
: x>radians ( x gadget -- theta )
|
||||
#! translate motion of x pixels to an angle
|
||||
rect-dim first pix>radians neg ;
|
||||
dim>> first pix>radians neg ;
|
||||
|
||||
: y>radians ( y gadget -- theta )
|
||||
#! translate motion of y pixels to an angle
|
||||
rect-dim second pix>radians ;
|
||||
dim>> second pix>radians ;
|
||||
|
||||
: (handle-mouse-motion) ( jamshred-gadget mouse-motion -- )
|
||||
over jamshred>> >r
|
||||
[ first swap x>radians ] 2keep second swap y>radians
|
||||
r> mouse-moved ;
|
||||
dupd [ first swap x>radians ] [ second swap y>radians ] 2bi
|
||||
rot jamshred>> mouse-moved ;
|
||||
|
||||
: handle-mouse-motion ( jamshred-gadget -- )
|
||||
hand-loc get [
|
||||
|
|
@ -84,11 +84,11 @@ jamshred-gadget H{
|
|||
{ T{ key-down f f "LEFT" } [ jamshred>> 1 jamshred-roll ] }
|
||||
{ T{ key-down f f "RIGHT" } [ jamshred>> -1 jamshred-roll ] }
|
||||
{ T{ key-down f f "q" } [ quit ] }
|
||||
{ T{ motion } [ handle-mouse-motion ] }
|
||||
{ T{ mouse-scroll } [ handle-mouse-scroll ] }
|
||||
{ motion [ handle-mouse-motion ] }
|
||||
{ mouse-scroll [ handle-mouse-scroll ] }
|
||||
} set-gestures
|
||||
|
||||
: jamshred-window ( -- gadget )
|
||||
[ <jamshred> <jamshred-gadget> dup "Jamshred" open-window ] with-ui ;
|
||||
: jamshred-window ( -- )
|
||||
[ <jamshred> <jamshred-gadget> "Jamshred" open-window ] with-ui ;
|
||||
|
||||
MAIN: jamshred-window
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007, 2008 Alex Chapman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays float-arrays kernel locals math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ;
|
||||
USING: accessors arrays kernel locals math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ;
|
||||
IN: jamshred.oint
|
||||
|
||||
! An oint is a point with three linearly independent unit vectors
|
||||
|
|
@ -12,7 +12,7 @@ TUPLE: oint location forward up left ;
|
|||
C: <oint> oint
|
||||
|
||||
: rotation-quaternion ( theta axis -- quaternion )
|
||||
swap 2 / dup cos swap sin rot n*v first3 rect> >r rect> r> 2array ;
|
||||
swap 2 / dup cos swap sin rot n*v first3 rect> [ rect> ] dip 2array ;
|
||||
|
||||
: rotate-vector ( q qrecip v -- v )
|
||||
v>q swap q* q* q>v ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007, 2008 Alex Chapman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors colors combinators float-arrays jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices sequences shuffle strings system ;
|
||||
USING: accessors colors.constants combinators jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices sequences shuffle specialized-arrays.float strings system ;
|
||||
IN: jamshred.player
|
||||
|
||||
TUPLE: player < oint
|
||||
|
|
@ -16,11 +16,11 @@ TUPLE: player < oint
|
|||
: max-speed ( -- speed ) 30.0 ;
|
||||
|
||||
: <player> ( name sounds -- player )
|
||||
[ F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] 2dip
|
||||
[ float-array{ 0 0 5 } float-array{ 0 0 -1 } float-array{ 0 1 0 } float-array{ -1 0 0 } ] 2dip
|
||||
f f 0 default-speed player boa ;
|
||||
|
||||
: turn-player ( player x-radians y-radians -- )
|
||||
>r over r> left-pivot up-pivot ;
|
||||
[ over ] dip left-pivot up-pivot ;
|
||||
|
||||
: roll-player ( player z-radians -- )
|
||||
forward-pivot ;
|
||||
|
|
@ -134,4 +134,4 @@ TUPLE: player < oint
|
|||
[ update-time ] [ distance-to-move ] [ (move-player) 2drop ] tri ;
|
||||
|
||||
: update-player ( player -- )
|
||||
[ move-player ] [ nearest-segment>> white swap (>>color) ] bi ;
|
||||
[ move-player ] [ nearest-segment>> "white" named-color swap (>>color) ] bi ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Alex Chapman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors io.files kernel openal sequences ;
|
||||
USING: accessors io.pathnames kernel openal sequences ;
|
||||
IN: jamshred.sound
|
||||
|
||||
TUPLE: sounds bang ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007, 2008 Alex Chapman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays float-arrays jamshred.oint jamshred.tunnel kernel math.vectors sequences tools.test ;
|
||||
USING: accessors arrays jamshred.oint jamshred.tunnel kernel math.vectors sequences specialized-arrays.float tools.test ;
|
||||
IN: jamshred.tunnel.tests
|
||||
|
||||
[ 0 ] [ T{ segment f { 0 0 0 } f f f 0 }
|
||||
|
|
@ -14,7 +14,7 @@ IN: jamshred.tunnel.tests
|
|||
|
||||
[ 3 ] [ <straight-tunnel> T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward number>> ] unit-test
|
||||
|
||||
[ F{ 0 0 0 } ] [ <straight-tunnel> T{ oint f { 0 0 -0.25 } } over first nearest-segment location>> ] unit-test
|
||||
[ float-array{ 0 0 0 } ] [ <straight-tunnel> T{ oint f { 0 0 -0.25 } } over first nearest-segment location>> ] unit-test
|
||||
|
||||
: test-segment-oint ( -- oint )
|
||||
{ 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> ;
|
||||
|
|
|
|||
|
|
@ -1,8 +1,6 @@
|
|||
! Copyright (C) 2007, 2008 Alex Chapman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays colors combinators float-arrays kernel
|
||||
locals math math.constants math.matrices math.order math.ranges
|
||||
math.vectors math.quadratic random sequences vectors jamshred.oint ;
|
||||
USING: accessors arrays colors combinators kernel locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences specialized-arrays.float vectors jamshred.oint ;
|
||||
IN: jamshred.tunnel
|
||||
|
||||
: n-segments ( -- n ) 5000 ; inline
|
||||
|
|
@ -26,20 +24,20 @@ C: <segment> segment
|
|||
|
||||
: (random-segments) ( segments n -- segments )
|
||||
dup 0 > [
|
||||
>r dup peek random-segment over push r> 1- (random-segments)
|
||||
[ dup peek random-segment over push ] dip 1- (random-segments)
|
||||
] [ drop ] if ;
|
||||
|
||||
: default-segment-radius ( -- r ) 1 ;
|
||||
|
||||
: initial-segment ( -- segment )
|
||||
F{ 0 0 0 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 }
|
||||
float-array{ 0 0 0 } float-array{ 0 0 -1 } float-array{ 0 1 0 } float-array{ -1 0 0 }
|
||||
0 random-color default-segment-radius <segment> ;
|
||||
|
||||
: random-segments ( n -- segments )
|
||||
initial-segment 1vector swap (random-segments) ;
|
||||
|
||||
: simple-segment ( n -- segment )
|
||||
[ F{ 0 0 -1 } n*v F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] keep
|
||||
[ float-array{ 0 0 -1 } n*v float-array{ 0 0 -1 } float-array{ 0 1 0 } float-array{ -1 0 0 } ] keep
|
||||
random-color default-segment-radius <segment> ;
|
||||
|
||||
: simple-segments ( n -- segments )
|
||||
|
|
@ -58,12 +56,12 @@ C: <segment> segment
|
|||
|
||||
: nearer-segment ( segment segment oint -- segment )
|
||||
#! return whichever of the two segments is nearer to the oint
|
||||
>r 2dup r> tuck distance >r distance r> < -rot ? ;
|
||||
[ 2dup ] dip tuck distance [ distance ] dip < -rot ? ;
|
||||
|
||||
: (find-nearest-segment) ( nearest next oint -- nearest ? )
|
||||
#! find the nearest of 'next' and 'nearest' to 'oint', and return
|
||||
#! t if the nearest hasn't changed
|
||||
pick >r nearer-segment dup r> = ;
|
||||
pick [ nearer-segment dup ] dip = ;
|
||||
|
||||
: find-nearest-segment ( oint segments -- segment )
|
||||
dup first swap rest-slice rot [ (find-nearest-segment) ] curry
|
||||
|
|
@ -78,9 +76,9 @@ C: <segment> segment
|
|||
: nearest-segment ( segments oint start-segment -- segment )
|
||||
#! find the segment nearest to 'oint', and return it.
|
||||
#! start looking at segment 'start-segment'
|
||||
number>> over >r
|
||||
[ nearest-segment-forward ] 3keep
|
||||
nearest-segment-backward r> nearer-segment ;
|
||||
number>> over [
|
||||
[ nearest-segment-forward ] 3keep nearest-segment-backward
|
||||
] dip nearer-segment ;
|
||||
|
||||
: get-segment ( segments n -- segment )
|
||||
over sequence-index-range clamp-to-range swap nth ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue