diff options
author | David Thompson <dthompson2@worcester.edu> | 2014-01-20 21:10:57 -0500 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2014-01-20 21:10:57 -0500 |
commit | 7c540f61a710847fd59033d3d2ee1dfc6364b928 (patch) | |
tree | acb4a04c277a72b81809e1779afeea3769cda914 /examples/pong.scm | |
parent | 5b81b48d3055a5be364cf3aa1a2b786c2daf65ab (diff) |
Remove obsolete examples.
Diffstat (limited to 'examples/pong.scm')
-rw-r--r-- | examples/pong.scm | 82 |
1 files changed, 0 insertions, 82 deletions
diff --git a/examples/pong.scm b/examples/pong.scm deleted file mode 100644 index 5ff1979..0000000 --- a/examples/pong.scm +++ /dev/null @@ -1,82 +0,0 @@ -(use-modules (srfi srfi-1) - (srfi srfi-9) - (2d color) - (2d game) - (2d keyboard) - (2d math) - (2d rect) - (2d signals) - (2d sprite) - (2d texture) - (2d time) - (2d vector2) - (2d window)) - -(define-record-type <paddle> - (%make-paddle y) - paddle? - (y paddle-y) - (speed paddle-speed)) - -(define-record-type <ball> - (make-ball position velocity) - ball? - (position ball-position) - (velocity ball-velocity)) - -(define window-width 640) -(define window-height 480) -(define half-width (/ window-width 2)) -(define half-height (/ window-height 2)) - -(with-window (make-window #:title "FRP is cool" - #:resolution (vector2 window-width - window-height) - #:fullscreen? #f) - (define paddle-texture (load-texture "images/paddleBlue.png")) - (define ball-texture (load-texture "images/ballBlue.png")) - - (define paddle-speed 5) - (define ball-speed 4) - (define ball-hitbox (make-rect -8 -8 16 16)) - - (define (move-paddle directions) - (signal-fold (lambda (new old) - (clamp 0 window-height (+ (* new paddle-speed) old))) - half-height - (signal-lift vy (time-every directions)))) - - (define player1-paddle (move-paddle key-wasd)) - (define player2-paddle (move-paddle key-arrows)) - - (define (wall-bounce position) - (let ((rect (rect-move ball-hitbox position))) - (cond ((> (rect-bottom rect) window-height) - (vector2 (vx position) - (- (vy position)))) - (else - position)))) - - (define ball (signal-fold (lambda (direction position) - (wall-bounce (v+ (vscale direction ball-speed) position))) - (vector2 half-width half-height) - (time-every (make-signal #:init (vector2 1 1))))) - - (define quit-on-esc - (signal-lift (lambda (down?) - (when down? - (quit-game))) - (key-down? 'escape))) - - (define draw - (let ((paddle-sprite (make-sprite paddle-texture)) - (ball-sprite (make-sprite ball-texture))) - (lambda () - (set-sprite-position! paddle-sprite (vector2 0 (signal-ref player1-paddle))) - (draw-sprite paddle-sprite) - (set-sprite-position! paddle-sprite (vector2 window-width (signal-ref player2-paddle))) - (draw-sprite paddle-sprite) - (set-sprite-position! ball-sprite ball) - (draw-sprite ball-sprite)))) - - (run-game #:draw draw)) |