X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=games%2Fasteroids%2Fasteroids.scm;h=902fd549bec2825b5b5d52961b601510c1f33edb;hb=e435ee14c06537860a24930e8d8372c77bc96b4d;hp=84c0ac4d795c65ec9cfa97ff1d2304bb4932889d;hpb=9f1a815198eb124e64ce742342c46d6ec11e0cf2;p=gacela.git diff --git a/games/asteroids/asteroids.scm b/games/asteroids/asteroids.scm index 84c0ac4..902fd54 100644 --- a/games/asteroids/asteroids.scm +++ b/games/asteroids/asteroids.scm @@ -1,148 +1,44 @@ -(set-game-properties! #:title "Gacela Asteroids") - -(define max-x (/ (assoc-ref (get-game-properties) 'width) 2)) -(define min-x (- max-x)) -(define max-y (/ (assoc-ref (get-game-properties) 'height) 2)) -(define min-y (- max-y)) - -(define-mob (asteroid - (image (load-texture "Asteroid.png")) - (x 0) (y 0) (angle 0) (dir 0)) - (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)) - -(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))) - (cond ((key-pressed? 'space) - (show-mob (make-shot #:x x #:y y #:angle angle)))) - - (translate x y) - (rotate angle) - (draw-texture (if moving ship2 ship1))) - -(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)))) - - (translate x y) - (rotate angle) - (draw-line 10)) - - -(define (init-asteroids n) - (define (xy n m) - (let ((n2 (- (random (* (- n m) 2)) (- n m)))) - (if (> n2 0) (+ n2 m) (- n2 m)))) - - (cond ((> n 0) - (let ((x (xy max-x 100)) (y (xy max-y 100)) - (angle (random 360)) (dir (- (random 360) 180))) - (show-mob (make-asteroid #:x x #:y y #:angle angle #:dir dir))) - (init-asteroids (- n 1))))) - -;(show-mob (make-asteroid)) -(init-asteroids 2) -(show-mob (make-ship)) - -;; (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) -;; (else -;; (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) -;; (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)) - -;; (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 (alist-copy ship))) -;; (let ((shot (ship-shot ship))) -;; (cond (shot -;; (set! shots (cons shot shots))))) -;; (set! shots (move-shots shots)) -;; (for-each draw-asteroid asteroids) -;; (for-each draw-shot shots) -;; (draw-ship ship))) +;;; Gacela, a GNU Guile extension for fast games development +;;; Copyright (C) 2014 by Javier Sancho Fernandez +;;; +;;; This program is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see . + + +(define-module (gacela examples asteroids)) +; #:use-module (gacela game)) + + +(define asteroids (game "Asteroids")) +(define player (entity)) +(set! player (add-component player (name "player"))) +(set! player (add-component player (transform))) +(set! player (add-component player (mesh))) +(set! asteroids (add-entity asteroids player)) +(define rock (entity)) +(set! rock (add-component rock (name "rock"))) +(set! rock (add-component rock (transform))) +(set! rock (add-component rock (mesh))) +(set! asteroids (add-entity asteroids rock)) + + +(define asteroids + (game "Asteroids" + (entity + (name "player") + (transform) + (mesh)) + (entity + (name "rock") + (transform) + (mesh))))