extra/chipmunk/demo/demo.factor

   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*
   8 IN: chipmunk.demo
   9
  10 CONSTANT: image-width      188
  11 CONSTANT: image-height     35
  12 CONSTANT: image-row-length 24
  13
  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 }
  48
  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 = ;
  52
  53 :: make-ball ( x y -- shape )
  54     cpBodyAlloc 1.0 NAN: 0 cpBodyInit
  55     x y cpv >>p :> body
  56     cpCircleShapeAlloc body 0.95 0 0 cpv cpCircleShapeInit
  57     dup shape>>
  58         0 >>e
  59         0 >>u
  60         drop ;
  61
  62 TUPLE: chipmunk-world < game-world
  63     space ;
  64
  65 AFTER: chipmunk-world tick-game-world
  66     space>> 1.0 60.0 / cpSpaceStep ;
  67
  68 SPECIALIZED-ARRAY: cpContact
  69 M:: chipmunk-world draw-world* ( world -- )
  70     1 1 1 0 glClearColor
  71     GL_COLOR_BUFFER_BIT glClear
  72     GL_PROJECTION glMatrixMode
  73     glLoadIdentity
  74     -320 320 -240 240 -1 1 glOrtho
  75     0.5 0.5 0 glTranslatef
  76     GL_VERTEX_ARRAY glEnableClientState
  77
  78     world space>> :> space
  79
  80     3 glPointSize
  81     0 0 0 glColor3f
  82     GL_POINTS glBegin
  83     space bodies>>
  84     [ num>> ] [ arr>> swap void* <c-direct-array> ] bi [
  85         cpBody memory>struct p>> [ x>> ] [ y>> ] bi glVertex2f
  86     ] each
  87     glEnd
  88
  89     2 glPointSize
  90     1 0 0 glColor3f
  91     GL_POINTS glBegin
  92     space arbiters>>
  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
  97         ] each
  98     ] each
  99     glEnd ;
 100
 101 M:: chipmunk-world begin-game-world ( world -- )
 102     cpInitChipmunk
 103
 104     cpSpaceAlloc cpSpaceInit :> space
 105
 106     world space >>space drop
 107     space 2.0 10000 cpSpaceResizeActiveHash
 108     space 1 >>iterations drop
 109
 110     image-height iota [| y |
 111         image-width iota [| x |
 112             x y get-pixel [
 113                 x image-width 2 / - 0.05 0.0 1.0 uniform-random-float * + 2 *
 114                 image-height 2 / y - 0.05 0.0 1.0 uniform-random-float * + 2 *
 115                 make-ball :> shape
 116                 space shape shape>> body>> cpSpaceAddBody drop
 117                 space shape cpSpaceAddShape drop
 118             ] when
 119         ] each
 120     ] each
 121
 122     space cpBodyAlloc NAN: 0 dup cpBodyInit cpSpaceAddBody :> body
 123     body -1000 -10 cpv >>p drop
 124     body 400 0 cpv >>v drop
 125
 126     space cpCircleShapeAlloc [ body 8 0 0 cpv cpCircleShapeInit cpSpaceAddShape drop ] keep
 127         :> shape
 128     shape shape>>
 129         0 >>e
 130         0 >>u
 131         drop ;
 132
 133 M: chipmunk-world end-game-world
 134     space>>
 135     [ cpSpaceFreeChildren ]
 136     [ cpSpaceFree ] bi ;
 137
 138 : chipmunk-demo ( -- )
 139     [
 140         f
 141         T{ game-attributes
 142            { world-class chipmunk-world }
 143            { title "Chipmunk Physics Demo" }
 144            { pixel-format-attributes
 145              { windowed double-buffered }
 146            }
 147            { pref-dim { 640 480 } }
 148            { tick-interval-nanos $[ 60 fps ] }
 149         }
 150         clone
 151         open-window
 152     ] with-ui ;
 153
 154 MAIN: chipmunk-demo