]> git.jsancho.org Git - gacela.git/commitdiff
(no commit message)
authorjsancho <devnull@localhost>
Sat, 3 Sep 2011 16:41:33 +0000 (16:41 +0000)
committerjsancho <devnull@localhost>
Sat, 3 Sep 2011 16:41:33 +0000 (16:41 +0000)
games/asteroids/asteroids.scm

index c36ae0569b90ab23f200a7cedd41834960b44d76..27265f7a57716b069702a8f24370bfe6b35cb566 100644 (file)
 (define (killed-ship? s a)
   (cond ((null? a) #f)
        (else
-        (or (< (sqrt (+ (expt (- (assoc-ref s 'x) (assoc-ref (car a) 'x)) 2)
-                        (expt (- (assoc-ref s 'y) (assoc-ref (car a) 'y)) 2)))
+        (or (< (distance-between-points (list (assoc-ref s 'x) (assoc-ref s 'y))
+                                        (list (assoc-ref (car a) 'x) (assoc-ref (car a) 'y)))
                (assoc-ref (car a) 'size))
             (killed-ship? s (cdr a))))))
 
 (define (kill-asteroids s a)
-  (cond ((or (null? s) (null? a)) (values s a))
+  (define (f1 s1 a)
+    (cond ((null? a)
+          (values a #f))
+         (else
+          (let ((a1 (car a)))
+            (cond ((< (distance-between-points (list (assoc-ref s1 'x) (assoc-ref s1 'y))
+                                               (list (assoc-ref a1 'x) (assoc-ref a1 'y)))
+                      (assoc-ref a1 'size))
+                   (values (cdr a) #t))
+                  (else
+                   (receive (an k) (f1 s1 (cdr a))
+                            (values (cons a1 an) k))))))))
+
+  (cond ((null? s)
+        (values s a))
        (else
-        (let ((s1 (car s)) (a1 (car a)))
-          (cond ((or (< (sqrt (+ (expt (- (assoc-ref 
+        (let ((s1 (car s)))
+          (receive (an k) (f1 s1 a)
+                   (cond (k
+                          (kill-asteroids (cdr s) an))
+                         (else
+                          (receive (sn an) (kill-asteroids (cdr s) an)
+                                   (values (cons s1 sn) an)))))))))
+                          
 
 (let ((asteroids #f) (ship #f) (shots #f))
   (define (new-game n)
   (run-game
    (cond ((killed-ship? ship asteroids)
          (new-game 2)))
+   (receive (s a) (kill-asteroids shots asteroids)
+           (set! shots s)
+           (set! asteroids a))
    (set! asteroids (map move-asteroid asteroids))
    (set! ship (move-ship ship))
    (let ((shot (ship-shot ship)))