games/asteroids/asteroids.scm

   1 (set-game-properties! #:title "Gacela Asteroids")
   2
   3 (define max-x (/ (cdr (assoc 'width (get-game-properties))) 2))
   4 (define min-x (- max-x))
   5 (define max-y (/ (cdr (assoc 'height (get-game-properties))) 2))
   6 (define min-y (- max-y))
   7
   8 (define draw-asteroid
   9   (let ((asteroid (load-texture "Asteroid.png")))
  10     (lambda (a)
  11       (to-origin)
  12       (translate (car a) (cadr a))
  13       (draw-texture asteroid))))
  14
  15 (define (move-asteroid a)
  16   (let* ((x (car a)) (y (cadr a))
  17          (vx (caddr a)) (vy (cadddr a))
  18          (nx (+ x vx)) (ny (+ y vy)))
  19     (cond ((> nx max-x) (set! vx -1))
  20           ((< nx min-x) (set! vx 1)))
  21     (cond ((> ny max-y) (set! vy -1))
  22           ((< ny min-y) (set! vy 1)))
  23     (list (+ x vx) (+ y vy) vx vy)))
  24
  25 (define draw-ship
  26   (let ((ship1 (load-texture "Ship1.png"))
  27         (ship2 (load-texture "Ship2.png")))
  28     (lambda (s)
  29       (to-origin)
  30       (translate (car s) (cadr s))
  31       (rotate (caddr s))
  32       (draw-texture ship1))))
  33
  34 (define (move-ship s)
  35   (let ((x (car s)) (y (cadr s))
  36         (angle (caddr s))
  37         (vx (cadddr s)) (vy (cadddr (cdr s))))
  38     (cond ((key? 'left) (set! angle (+ angle 5)))
  39           ((key? 'right) (set! angle (- angle 5))))
  40     (cond ((key? 'up) (set! y (+ y 3))))
  41     (list x y angle vx vy)))
  42
  43 (let ((asteroids '((100 100 1 1) (-100 -100 -1 1)))
  44       (ship '(0 0 0 0 0)))
  45   (run-game
  46    (set! asteroids (map move-asteroid asteroids))
  47    (set! ship (move-ship ship))
  48    (for-each draw-asteroid asteroids)
  49    (draw-ship ship)))