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

fix up chipmunk.demo, add a MAIN:

db4
Joe Groff 2010-02-24 18:46:02 -08:00
parent 2e888f1ee7
commit 7de21ca8be
1 changed files with 15 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
extra/chipmunk/demo/demo.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2010 Erik Charlebois ! Copyright (C) 2010 Erik Charlebois
! See http:// factorcode.org/license.txt for BSD license. ! See http:// factorcode.org/license.txt for BSD license.
USING: accessors chipmunk.ffi classes.struct game.worlds kernel locals USING: accessors alien chipmunk.ffi classes.struct game.worlds kernel
math method-chains opengl.gl random sequences specialized-arrays locals math method-chains opengl.gl random sequences specialized-arrays
specialized-arrays.instances.alien.c-types.void* ui ui.gadgets.worlds specialized-arrays.instances.alien.c-types.void* ui ui.gadgets.worlds
ui.pixel-formats ; ui.pixel-formats ;
IN: chipmunk.demo IN: chipmunk.demo
@ -53,7 +53,10 @@ CONSTANT: image-bitmap B{
cpBodyAlloc 1.0 NAN: 0 cpBodyInit cpBodyAlloc 1.0 NAN: 0 cpBodyInit
x y cpv >>p :> body x y cpv >>p :> body
cpCircleShapeAlloc body 0.95 0 0 cpv cpCircleShapeInit cpCircleShapeAlloc body 0.95 0 0 cpv cpCircleShapeInit
[ shape>> 0 >>e ] [ shape>> 0 >>u ] bi drop ; dup shape>>
0 >>e
0 >>u
drop ;
TUPLE: chipmunk-world < game-world TUPLE: chipmunk-world < game-world
space ; space ;
@ -88,7 +91,7 @@ M:: chipmunk-world draw-world* ( world -- )
space arbiters>> space arbiters>>
[ num>> ] [ arr>> swap <direct-void*-array> ] bi [ [ num>> ] [ arr>> swap <direct-void*-array> ] bi [
cpArbiter memory>struct cpArbiter memory>struct
[ numContacts>> ] [ contacts>> swap <direct-cpContact-array> ] bi [ [ numContacts>> ] [ contacts>> >c-ptr swap <direct-cpContact-array> ] bi [
p>> [ x>> ] [ y>> ] bi glVertex2f p>> [ x>> ] [ y>> ] bi glVertex2f
] each ] each
] each ] each
@ -109,7 +112,7 @@ M:: chipmunk-world begin-game-world ( world -- )
x image-width 2 / - 0.05 0.0 1.0 uniform-random-float * + 2 * x image-width 2 / - 0.05 0.0 1.0 uniform-random-float * + 2 *
image-height 2 / y - 0.05 0.0 1.0 uniform-random-float * + 2 * image-height 2 / y - 0.05 0.0 1.0 uniform-random-float * + 2 *
make-ball :> shape make-ball :> shape
space shape body>> cpSpaceAddBody drop space shape shape>> body>> cpSpaceAddBody drop
space shape cpSpaceAddShape drop space shape cpSpaceAddShape drop
] when ] when
] each ] each
@ -119,10 +122,12 @@ M:: chipmunk-world begin-game-world ( world -- )
body -1000 -10 cpv >>p drop body -1000 -10 cpv >>p drop
body 400 0 cpv >>v drop body 400 0 cpv >>v drop
space cpCircleShapeAlloc body 8 0 0 cpv cpCircleShapeInit cpSpaceAddShape :> shape space cpCircleShapeAlloc [ body 8 0 0 cpv cpCircleShapeInit cpSpaceAddShape drop ] keep
shape :> shape
[ shape>> 0 >>e drop ] shape shape>>
[ shape>> 0 >>u drop ] bi ; 0 >>e
0 >>u
drop ;
M: chipmunk-world end-game-world M: chipmunk-world end-game-world
space>> space>>
@ -145,3 +150,4 @@ M: chipmunk-world end-game-world
open-window open-window
] with-ui ; ] with-ui ;
MAIN: chipmunk-demo