From 2dd62c9397803ff96e72f9e27f138b58273b5976 Mon Sep 17 00:00:00 2001 From: jsancho Date: Wed, 14 Sep 2011 15:24:22 +0000 Subject: [PATCH] --- games/asteroids/asteroids.scm | 91 ++++++++++++++++++----------------- 1 file changed, 48 insertions(+), 43 deletions(-) diff --git a/games/asteroids/asteroids.scm b/games/asteroids/asteroids.scm index a0268f8..b18b7f6 100644 --- a/games/asteroids/asteroids.scm +++ b/games/asteroids/asteroids.scm @@ -11,6 +11,8 @@ (vx 1) (vy 1)) (set! x (+ x vx)) (set! y (+ y vy)) + (set! angle (+ angle 1)) + (cond ((> x max-x) (set! vx -1)) ((< x min-x) (set! vx 1))) (cond ((> y max-y) (set! vy -1)) @@ -20,51 +22,54 @@ (rotate angle) (draw-texture image)) -(show-mob (make-asteroid)) +(define-mob (ship + (ship1 (load-texture "Ship1.png")) + (ship2 (load-texture "Ship2.png")) + (x 0) (y 0) (angle 0) + (moving #f)) + (cond ((key? 'left) (set! angle (+ angle 5))) + ((key? 'right) (set! angle (- angle 5)))) + (cond ((key? 'up) + (let ((r (degrees-to-radians (- angle)))) + (set! x (+ x (* 4 (sin r)))) + (set! y (+ y (* 4 (cos r))))) + (cond ((> x max-x) (set! x min-x)) + ((< x min-x) (set! x max-x))) + (cond ((> y max-y) (set! y min-y)) + ((< y min-y) (set! y max-y))) + (set! moving #t)) + (else + (set! moving #f))) -;; (define (move-asteroid a) -;; (let ((x (assoc-ref a 'x)) (y (assoc-ref a 'y)) -;; (angle (assoc-ref a 'angle)) -;; (vx (assoc-ref a 'vx)) (vy (assoc-ref a 'vy))) -;; (set! x (+ x vx)) -;; (set! y (+ y vy)) -;; (cond ((> x max-x) (set! vx -1)) -;; ((< x min-x) (set! vx 1))) -;; (cond ((> y max-y) (set! vy -1)) -;; ((< y min-y) (set! vy 1))) - -;; (assoc-multiple-set! a 'x x 'y y 'angle (+ angle 1) 'vx vx 'vy vy))) - -;; (define draw-ship -;; (let ((ship1 (load-texture "Ship1.png")) -;; (ship2 (load-texture "Ship2.png"))) -;; (lambda (s) -;; (to-origin) -;; (translate (assoc-ref s 'x) (assoc-ref s 'y)) -;; (rotate (assoc-ref s 'angle)) -;; (let ((ship (if (assoc-ref s 'moving) ship2 ship1))) -;; (draw-texture ship))))) - -;; (define (move-ship ship) -;; (let* ((s ship) -;; (x (assoc-ref s 'x)) (y (assoc-ref s 'y)) -;; (angle (assoc-ref s 'angle)) -;; (moving (assoc-ref s 'moving))) -;; (cond ((key? 'left) (set! angle (+ angle 5))) -;; ((key? 'right) (set! angle (- angle 5)))) -;; (cond ((key? 'up) -;; (let ((r (degrees-to-radians (- angle)))) -;; (set! x (+ x (* 4 (sin r)))) -;; (set! y (+ y (* 4 (cos r))))) -;; (cond ((> x max-x) (set! x min-x)) -;; ((< x min-x) (set! x max-x))) -;; (cond ((> y max-y) (set! y min-y)) -;; ((< y min-y) (set! y max-y))) -;; (set! moving #t)) -;; (else -;; (set! moving #f))) + (translate x y) + (rotate angle) + (draw-texture (if moving ship2 ship1))) + +(define-mob (shot (x 0) (y 0) (angle 0)) + (translate x y) + (rotate angle) + (draw-line 10)) + +;; (define (move-shots shots) +;; (cond ((null? shots) '()) +;; (else +;; (let* ((sh (car shots)) +;; (x (assoc-ref sh 'x)) (y (assoc-ref sh 'y)) +;; (angle (assoc-ref sh 'angle)) +;; (r (degrees-to-radians (- angle)))) +;; (set! x (+ x (* 10 (sin r)))) +;; (set! y (+ y (* 10 (cos r)))) +;; (cond ((and (<= x max-x) +;; (>= x min-x) +;; (<= y max-y) +;; (>= y min-y)) +;; (cons `((x . ,x) (y . ,y) (angle . ,angle)) +;; (move-shots (cdr shots)))) +;; (else +;; (move-shots (cdr shots)))))))) -;; (assoc-multiple-set! s 'x x 'y y 'angle angle 'moving moving))) +(show-mob (make-asteroid)) +(show-mob (make-ship)) ;; (define (ship-shot s) ;; (cond ((key-pressed? 'space) -- 2.39.5