1 ! Copyright (C) 2010 Erik Charlebois
2 ! See http:// factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types alien.data chipmunk.ffi
4 classes.struct game.loop game.worlds kernel literals locals
5 math method-chains opengl.gl random sequences specialized-arrays
6 ui ui.gadgets.worlds ui.pixel-formats ;
7 SPECIALIZED-ARRAY: void*
10 CONSTANT: image-width 188
11 CONSTANT: image-height 35
12 CONSTANT: image-row-length 24
14 CONSTANT: image-bitmap B{
15 15 -16 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7 -64 15 63 -32 -2 0 0 0 0 0 0 0
16 0 0 0 0 0 0 0 0 0 0 0 31 -64 15 127 -125 -1 -128 0 0 0 0 0 0 0 0 0 0 0 0 0 0
17 0 0 0 127 -64 15 127 15 -1 -64 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 -1 -64 15 -2
18 31 -1 -64 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 -1 -64 0 -4 63 -1 -32 0 0 0 0 0 0
19 0 0 0 0 0 0 0 0 0 0 1 -1 -64 15 -8 127 -1 -32 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
20 1 -1 -64 0 -8 -15 -1 -32 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 -31 -1 -64 15 -8 -32
21 -1 -32 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7 -15 -1 -64 9 -15 -32 -1 -32 0 0 0 0 0
22 0 0 0 0 0 0 0 0 0 0 31 -15 -1 -64 0 -15 -32 -1 -32 0 0 0 0 0 0 0 0 0 0 0 0 0
23 0 0 63 -7 -1 -64 9 -29 -32 127 -61 -16 63 15 -61 -1 -8 31 -16 15 -8 126 7 -31
24 -8 31 -65 -7 -1 -64 9 -29 -32 0 7 -8 127 -97 -25 -1 -2 63 -8 31 -4 -1 15 -13
25 -4 63 -1 -3 -1 -64 9 -29 -32 0 7 -8 127 -97 -25 -1 -2 63 -8 31 -4 -1 15 -13
26 -2 63 -1 -3 -1 -64 9 -29 -32 0 7 -8 127 -97 -25 -1 -1 63 -4 63 -4 -1 15 -13
27 -2 63 -33 -1 -1 -32 9 -25 -32 0 7 -8 127 -97 -25 -1 -1 63 -4 63 -4 -1 15 -13
28 -1 63 -33 -1 -1 -16 9 -25 -32 0 7 -8 127 -97 -25 -1 -1 63 -4 63 -4 -1 15 -13
29 -1 63 -49 -1 -1 -8 9 -57 -32 0 7 -8 127 -97 -25 -8 -1 63 -2 127 -4 -1 15 -13
30 -1 -65 -49 -1 -1 -4 9 -57 -32 0 7 -8 127 -97 -25 -8 -1 63 -2 127 -4 -1 15 -13
31 -1 -65 -57 -1 -1 -2 9 -57 -32 0 7 -8 127 -97 -25 -8 -1 63 -2 127 -4 -1 15 -13
32 -1 -1 -57 -1 -1 -1 9 -57 -32 0 7 -1 -1 -97 -25 -8 -1 63 -1 -1 -4 -1 15 -13 -1
33 -1 -61 -1 -1 -1 -119 -57 -32 0 7 -1 -1 -97 -25 -8 -1 63 -1 -1 -4 -1 15 -13 -1
34 -1 -61 -1 -1 -1 -55 -49 -32 0 7 -1 -1 -97 -25 -8 -1 63 -1 -1 -4 -1 15 -13 -1
35 -1 -63 -1 -1 -1 -23 -49 -32 127 -57 -1 -1 -97 -25 -1 -1 63 -1 -1 -4 -1 15 -13
36 -1 -1 -63 -1 -1 -1 -16 -49 -32 -1 -25 -1 -1 -97 -25 -1 -1 63 -33 -5 -4 -1 15
37 -13 -1 -1 -64 -1 -9 -1 -7 -49 -32 -1 -25 -8 127 -97 -25 -1 -1 63 -33 -5 -4 -1
38 15 -13 -1 -1 -64 -1 -13 -1 -32 -49 -32 -1 -25 -8 127 -97 -25 -1 -2 63 -49 -13
39 -4 -1 15 -13 -1 -1 -64 127 -7 -1 -119 -17 -15 -1 -25 -8 127 -97 -25 -1 -2 63
40 -49 -13 -4 -1 15 -13 -3 -1 -64 127 -8 -2 15 -17 -1 -1 -25 -8 127 -97 -25 -1
41 -8 63 -49 -13 -4 -1 15 -13 -3 -1 -64 63 -4 120 0 -17 -1 -1 -25 -8 127 -97 -25
42 -8 0 63 -57 -29 -4 -1 15 -13 -4 -1 -64 63 -4 0 15 -17 -1 -1 -25 -8 127 -97
43 -25 -8 0 63 -57 -29 -4 -1 -1 -13 -4 -1 -64 31 -2 0 0 103 -1 -1 -57 -8 127 -97
44 -25 -8 0 63 -57 -29 -4 -1 -1 -13 -4 127 -64 31 -2 0 15 103 -1 -1 -57 -8 127
45 -97 -25 -8 0 63 -61 -61 -4 127 -1 -29 -4 127 -64 15 -8 0 0 55 -1 -1 -121 -8
46 127 -97 -25 -8 0 63 -61 -61 -4 127 -1 -29 -4 63 -64 15 -32 0 0 23 -1 -2 3 -16
47 63 15 -61 -16 0 31 -127 -127 -8 31 -1 -127 -8 31 -128 7 -128 0 0 }
49 :: get-pixel ( x y -- z )
50 x -3 shift y image-row-length * + image-bitmap nth
51 x bitnot 7 bitand neg shift 1 bitand 1 = ;
53 :: make-ball ( x y -- shape )
54 cpBodyAlloc 1.0 NAN: 0 cpBodyInit
56 cpCircleShapeAlloc body 0.95 0 0 cpv cpCircleShapeInit
62 TUPLE: chipmunk-world < game-world
65 AFTER: chipmunk-world tick-game-world
66 space>> 1.0 60.0 / cpSpaceStep ;
68 SPECIALIZED-ARRAY: cpContact
69 M:: chipmunk-world draw-world* ( world -- )
71 GL_COLOR_BUFFER_BIT glClear
72 GL_PROJECTION glMatrixMode
74 -320 320 -240 240 -1 1 glOrtho
75 0.5 0.5 0 glTranslatef
76 GL_VERTEX_ARRAY glEnableClientState
78 world space>> :> space
84 [ num>> ] [ arr>> swap void* <c-direct-array> ] bi [
85 cpBody memory>struct p>> [ x>> ] [ y>> ] bi glVertex2f
93 [ num>> ] [ arr>> swap void* <c-direct-array> ] bi [
94 cpArbiter memory>struct
95 [ numContacts>> ] [ contacts>> >c-ptr swap cpContact <c-direct-array> ] bi [
96 p>> [ x>> ] [ y>> ] bi glVertex2f
101 M:: chipmunk-world begin-game-world ( world -- )
104 cpSpaceAlloc cpSpaceInit :> space
106 world space >>space drop
107 space 2.0 10000 cpSpaceResizeActiveHash
108 space 1 >>iterations drop
110 image-height iota [| y |
111 image-width iota [| x |
113 x image-width 2 / - 0.05 random-unit * + 2 *
114 image-height 2 / y - 0.05 random-unit * + 2 *
116 space shape shape>> body>> cpSpaceAddBody drop
117 space shape cpSpaceAddShape drop
122 space cpBodyAlloc NAN: 0 dup cpBodyInit cpSpaceAddBody :> body
123 body -1000 -10 cpv >>p drop
124 body 400 0 cpv >>v drop
126 space cpCircleShapeAlloc [ body 8 0 0 cpv cpCircleShapeInit cpSpaceAddShape drop ] keep
133 M: chipmunk-world end-game-world
135 [ cpSpaceFreeChildren ]
138 : chipmunk-demo ( -- )
142 { world-class chipmunk-world }
143 { title "Chipmunk Physics Demo" }
144 { pixel-format-attributes
145 { windowed double-buffered }
147 { pref-dim { 640 480 } }
148 { tick-interval-nanos $[ 60 fps ] }