games/asteroids/asteroids.scm

   1 (set-game-properties! #:title "Gacela Asteroids")
   2
   3 (define max-x (/ (assoc-ref (get-game-properties) 'width) 2))
   4 (define min-x (- max-x))
   5 (define max-y (/ (assoc-ref (get-game-properties) 'height) 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 (assoc-ref a 'x) (assoc-ref a 'y))
  13       (rotate (assoc-ref a 'angle))
  14       (draw-texture asteroid))))
  15
  16 (define (move-asteroid a)
  17   (let* ((x (assoc-ref a 'x)) (y (assoc-ref a 'y))
  18          (angle (assoc-ref a 'angle))
  19          (vx (assoc-ref a 'vx)) (vy (assoc-ref a 'vy))
  20          (nx (+ x vx)) (ny (+ y vy)))
  21     (cond ((> nx max-x) (set! vx -1))
  22           ((< nx min-x) (set! vx 1)))
  23     (cond ((> ny max-y) (set! vy -1))
  24           ((< ny min-y) (set! vy 1)))
  25     (set! angle (+ angle 1))
  26     `((x . ,(+ x vx)) (y . ,(+ y vy)) (angle . ,angle) (vx . ,vx) (vy . ,vy))))
  27
  28 (define draw-ship
  29   (let ((ship1 (load-texture "Ship1.png"))
  30         (ship2 (load-texture "Ship2.png")))
  31     (lambda (s)
  32       (to-origin)
  33       (translate (assoc-ref s 'x) (assoc-ref s 'y))
  34       (rotate (assoc-ref s 'angle))
  35       (let ((ship (if (assoc-ref s 'moving) ship2 ship1)))
  36         (draw-texture ship)))))
  37
  38 (define (move-ship s)
  39   (let ((x (assoc-ref s 'x)) (y (assoc-ref s 'y))
  40         (angle (assoc-ref s 'angle))
  41         (moving (assoc-ref s 'moving)))
  42     (cond ((key? 'left) (set! angle (+ angle 5)))
  43           ((key? 'right) (set! angle (- angle 5))))
  44     (cond ((key? 'up)
  45            (let ((r (degrees-to-radians (- angle))))
  46              (set! x (+ x (* 4 (sin r))))
  47              (set! y (+ y (* 4 (cos r)))))
  48            (cond ((> x max-x) (set! x min-x))
  49                  ((< x min-x) (set! x max-x)))
  50            (cond ((> y max-y) (set! y min-y))
  51                  ((< y min-y) (set! y max-y)))
  52            (set! moving #t))
  53           (else
  54            (set! moving #f)))
  55     `((x . ,x) (y . ,y) (angle . ,angle) (moving . ,moving))))
  56
  57 (define (make-asteroids n)
  58   (define (xy n r)
  59     (let ((n2 (- (random (* n 2)) n)))
  60       (cond ((and (< n2 r) (>= n2 0)) r)
  61             ((and (> n2 (- r)) (< n2 0)) (- r))
  62             (else n2))))
  63
  64   (cond ((= n 0) '())
  65         (else
  66          (cons `((x . ,(xy max-x 20)) (y . ,(xy max-y 20)) (angle . 0) (vx . 1) (vy . 1)) (make-asteroids (- n 1))))))
  67
  68 (let ((asteroids (make-asteroids 2))
  69       (ship '((x . 0) (y . 0) (angle . 0) (moving . #f)))
  70       (shots '())
  71   (run-game
  72    (set! asteroids (map move-asteroid asteroids))
  73    (set! ship (move-ship ship))
  74    (set! shots (ship-shots
  75    (for-each draw-asteroid asteroids)
  76    (draw-ship ship)))