X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=games%2Fasteroids%2Fasteroids.scm;h=a12c1def86f7a0b0aa43a523d2f9b6218cae1e5d;hb=2eee3eb546a25305d548fcb331769be84fd3a38f;hp=92b03c406c8a93ca506b906e5dc512311cad454c;hpb=91dd14e8cb97624a3f7e0515afbff4d7143f514e;p=gacela.git diff --git a/games/asteroids/asteroids.scm b/games/asteroids/asteroids.scm index 92b03c4..a12c1de 100644 --- a/games/asteroids/asteroids.scm +++ b/games/asteroids/asteroids.scm @@ -1,3 +1,11 @@ +#!/usr/bin/guile \ +-e gacela-script -s +!# + +(use-modules (gacela gacela) + (gacela math)) +(init-gacela) + (set-game-properties! #:title "Gacela Asteroids") (define max-x (/ (assoc-ref (get-game-properties) 'width) 2)) @@ -5,77 +13,118 @@ (define max-y (/ (assoc-ref (get-game-properties) 'height) 2)) (define min-y (- max-y)) + +;;; Asteroids + +(define-checking-mobs (asteroid-shots x y size) (shot (sx x) (sy y)) + (if (< (distance-between-points (list sx sy) (list x y)) size) 1 0)) + +(define (asteroid-killed? x y size) + (> (apply + (asteroid-shots x y size)) 0)) + (define-mob (asteroid (image (load-texture "Asteroid.png")) - (x 0) (y 0) (angle 0) - (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)) - ((< y min-y) (set! vy 1))) + (x 0) (y 0) (angle 0) (dir 0) (size 100)) + (cond ((asteroid-killed? x y size) + (kill-me)) + (else + (let ((r (degrees-to-radians (- dir)))) + (set! x (+ x (sin r))) + (set! y (+ y (cos r)))) + (set! angle (+ angle 1)) + + (cond ((or (> x max-x) (< x min-x)) + (set! dir (* -1 dir)))) + (cond ((or (> y max-y) (< y min-y)) + (set! dir (- 180 dir)))))) (translate x y) (rotate angle) (draw-texture image)) + +;;; Ship + (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)))) + ((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))) + (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))) (cond ((key-pressed? 'space) - (show-mob (make-shot #:x x #:y y #:angle angle)))) + (show-mob (make-shot #:x x #:y y #:angle angle)))) (translate x y) (rotate angle) (draw-texture (if moving ship2 ship1))) + +;;; Shots + +(define-checking-mobs (impacted-shots x y) (asteroid (ax x) (ay y) (size size)) + (if (< (distance-between-points (list ax ay) (list x y)) size) 1 0)) + +(define (shot-killed? x y) + (> (apply + (impacted-shots x y)) 0)) + (define-mob (shot (x 0) (y 0) (angle 0)) - (let ((r (degrees-to-radians (- angle)))) - (set! x (+ x (* 10 (sin r)))) - (set! y (+ y (* 10 (cos r)))) - (cond ((or (> x max-x) - (< x min-x) - (> y max-y) - (< y min-y)) - (kill-me)))) + (cond ((shot-killed? x y) + (kill-me)) + (else + (let ((r (degrees-to-radians (- angle)))) + (set! x (+ x (* 10 (sin r)))) + (set! y (+ y (* 10 (cos r)))) + (cond ((or (> x max-x) + (< x min-x) + (> y max-y) + (< y min-y)) + (kill-me)))))) (translate x y) (rotate angle) (draw-line 10)) -(show-mob (make-asteroid)) +;;; Game + +(define (init-asteroids n) + (cond ((> n 0) + (let ((x (- (random (* max-x 2)) max-x)) + (y (- (random (* max-y 2)) max-y))) + (cond ((< (distance-between-points (list x y) '(0 0)) 120) + (init-asteroids n)) + (else + (let ((angle (random 360)) (dir (- (random 360) 180))) + (show-mob (make-asteroid #:x x #:y y #:angle angle #:dir dir))) + (init-asteroids (- n 1)))))))) + + +(init-asteroids 2) (show-mob (make-ship)) + +(let ((font (load-font "../tetris/lazy.ttf" #:size 20))) + (game + (render-text (format #f "Mobs: ~a" (length (get-active-mobs))) font))) -;; (define (make-asteroids n) -;; (define (xy n r) -;; (let ((n2 (- (random (* n 2)) n))) -;; (cond ((and (< n2 r) (>= n2 0)) r) -;; ((and (> n2 (- r)) (< n2 0)) (- r)) -;; (else n2)))) -;; (cond ((= n 0) '()) -;; (else -;; (cons `((x . ,(xy max-x 20)) (y . ,(xy max-y 20)) (angle . 0) (vx . 1) (vy . 1) (size . 95)) -;; (make-asteroids (- n 1)))))) +;; (define (new-game n) +;; (set! asteroids (make-asteroids n)) +;; (set! ship '((x . 0) (y . 0) (angle . 0) (moving . #f))) +;; (set! shots '())) + +;; (new-game 2) ;; (define (killed-ship? s a) ;; (cond ((null? a) #f) @@ -85,39 +134,8 @@ ;; (assoc-ref (car a) 'size)) ;; (killed-ship? s (cdr a)))))) -;; (define (kill-asteroids 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))) -;; (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) -;; (set! asteroids (make-asteroids n)) -;; (set! ship '((x . 0) (y . 0) (angle . 0) (moving . #f))) -;; (set! shots '())) - -;; (new-game 2) ;; (run-game ;; (cond ((killed-ship? ship asteroids)