X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=games%2Fasteroids%2Fasteroids.scm;h=902fd549bec2825b5b5d52961b601510c1f33edb;hb=12725e0c889f28354fc75cfb34683f9323dd04dd;hp=283333fbd89f698a1e390babd2b5c2daa67bbbd4;hpb=e99551161b1199fcd068dce0f7b0fd2f3927e771;p=gacela.git diff --git a/games/asteroids/asteroids.scm b/games/asteroids/asteroids.scm index 283333f..902fd54 100644 --- a/games/asteroids/asteroids.scm +++ b/games/asteroids/asteroids.scm @@ -1,70 +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 draw-asteroid - (let ((asteroid (load-texture "Asteroid.png"))) - (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)) - (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))) - (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 (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 (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))))) - (set! moving #t)) - (else - (set! moving #f))) - `((x . ,x) (y . ,y) (angle . ,angle) (moving . ,moving)))) - -(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)) - (for-each draw-asteroid asteroids) - (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))))