From: jsancho Date: Fri, 26 Aug 2011 17:34:06 +0000 (+0000) Subject: (no commit message) X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=e99551161b1199fcd068dce0f7b0fd2f3927e771;p=gacela.git --- diff --git a/games/asteroids/Ship2.png b/games/asteroids/Ship2.png index 2a36096..87189e6 100644 Binary files a/games/asteroids/Ship2.png and b/games/asteroids/Ship2.png differ diff --git a/games/asteroids/asteroids.scm b/games/asteroids/asteroids.scm index 6d477e5..283333f 100644 --- a/games/asteroids/asteroids.scm +++ b/games/asteroids/asteroids.scm @@ -1,8 +1,8 @@ (set-game-properties! #:title "Gacela Asteroids") -(define max-x (/ (cdr (assoc 'width (get-game-properties))) 2)) +(define max-x (/ (assoc-ref (get-game-properties) 'width) 2)) (define min-x (- max-x)) -(define max-y (/ (cdr (assoc 'height (get-game-properties))) 2)) +(define max-y (/ (assoc-ref (get-game-properties) 'height) 2)) (define min-y (- max-y)) (define draw-asteroid @@ -10,38 +10,59 @@ (lambda (a) (to-origin) (translate (car a) (cadr a)) + (rotate (caddr a)) (draw-texture asteroid)))) (define (move-asteroid a) (let* ((x (car a)) (y (cadr a)) - (vx (caddr a)) (vy (cadddr a)) + (angle (caddr a)) + (vx (cadddr a)) (vy (cadddr (cdr a))) (nx (+ x vx)) (ny (+ y vy))) (cond ((> nx max-x) (set! vx -1)) ((< nx min-x) (set! vx 1))) (cond ((> ny max-y) (set! vy -1)) ((< ny min-y) (set! vy 1))) - (list (+ x vx) (+ y vy) vx vy))) + (set! angle (+ angle 1)) + (list (+ x vx) (+ y vy) angle vx vy))) (define draw-ship (let ((ship1 (load-texture "Ship1.png")) (ship2 (load-texture "Ship2.png"))) (lambda (s) (to-origin) - (translate (car s) (cadr s)) - (rotate (caddr s)) - (draw-texture ship1)))) + (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 s) - (let ((x (car s)) (y (cadr s)) - (angle (caddr s)) - (vx (cadddr s)) (vy (cadddr (cdr s)))) + (let ((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) (set! y (+ y 3)))) - (list x y angle vx vy))) + (cond ((key? 'up) + (let ((r (degrees-to-radians (- angle)))) + (set! x (+ x (* 4 (sin r)))) + (set! y (+ y (* 4 (cos r))))) + (set! moving #t)) + (else + (set! moving #f))) + `((x . ,x) (y . ,y) (angle . ,angle) (moving . ,moving)))) -(let ((asteroids '((100 100 1 1) (-100 -100 -1 1))) - (ship '(0 0 0 0 0))) +(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 (list (xy max-x 20) (xy max-y 20) 0 1 1) (make-asteroids (- n 1)))))) + +(let ((asteroids (make-asteroids 2)) + (ship '((x . 0) (y . 0) (angle . 0) (moving . #f)))) (run-game (set! asteroids (map move-asteroid asteroids)) (set! ship (move-ship ship)) diff --git a/src/gacela_misc.scm b/src/gacela_misc.scm index 42c8841..9dc10aa 100644 --- a/src/gacela_misc.scm +++ b/src/gacela_misc.scm @@ -21,6 +21,11 @@ (use-modules (srfi srfi-1)) +;;; Constants + +(define *pi* (* (asin 1) 2)) + + ;;; Functions (define (nearest-power-of-two n) @@ -29,6 +34,12 @@ (else (power (* p 2) n)))) (power 1 n)) +(define (degrees-to-radians angle) + (/ (* angle *pi*) 180)) + +(define (radians-to-degrees angle) + (/ (* angle 180) *pi*)) + (define-macro (pushnew elem list) `(cond ((not (find (lambda (e) (eq? e ,elem)) ,list)) (set! ,list (cons ,elem ,list)))))