From ef93ec59bb8aef38efdace21f86da55e2dc7cd6d Mon Sep 17 00:00:00 2001 From: jsancho Date: Fri, 26 Aug 2011 11:51:39 +0000 Subject: [PATCH] --- game.lisp | 33 --------- game_GL.lisp | 68 ------------------ game_test.lisp | 18 ----- games/asteroids/asteroids.scm | 38 ++++++++-- .../tetris/fondo_tetris.png | Bin lazy.ttf => games/tetris/lazy.ttf | Bin gacela_tetris.scm => games/tetris/tetris.scm | 0 7 files changed, 32 insertions(+), 125 deletions(-) delete mode 100755 game.lisp delete mode 100755 game_GL.lisp delete mode 100755 game_test.lisp rename fondo_tetris.png => games/tetris/fondo_tetris.png (100%) rename lazy.ttf => games/tetris/lazy.ttf (100%) rename gacela_tetris.scm => games/tetris/tetris.scm (100%) diff --git a/game.lisp b/game.lisp deleted file mode 100755 index 4431257..0000000 --- a/game.lisp +++ /dev/null @@ -1,33 +0,0 @@ -;(show-mob (make-mob :x 0 :y 0 :image (filled-rect 5 420) :tags '(wall))) -;(show-mob (make-mob :x 635 :y 0 :image (filled-rect 5 420) :tags '(wall))) -;(show-mob (make-mob :x 0 :y 0 :image (filled-rect 640 5) :tags '(wall))) - -;(show-mob (make-mob :x 280 :y 420 :image (filled-rect 80 20) :tags '(wall) -; :logic (movement-with-cursors :xvel 200 :yvel 0))) - -;(let ((xvel 100) (yvel -100)) -; (show-mob (make-mob :x 300 :y 200 :image (filled-circle 7) -; :logic (progn -; (cond ((> y 480) (setq x 300 y 200 xvel 100 yvel -100)) -; (t (let ((c (collision '(wall)))) -; (cond ((null c) nil) -; ((= c (neg (/ pi 2))) (setq yvel (neg (- yvel 10)))) -; ((= c (/ pi 2)) (setq yvel (neg (+ yvel 10)))) -; ((= c 0) (setq xvel (neg (+ xvel 10)))) -; ((= c pi) (setq xvel (neg (- xvel 10)))))))) -; (movement :xvel xvel :yvel yvel))))) - -;(run-game) -;(quit-game) - -(let ((r 0)) - (gacela::makemob cuadrado - :render (lambda () - (gacela::rotate 0 0 r) - (incf r 5) - (gacela::draw-cube :size 40)))) - -;(cuadrado :on) -(gacela::start-skin-client 1984) - -(gacela::run-game "Prueba Mobs") diff --git a/game_GL.lisp b/game_GL.lisp deleted file mode 100755 index d717a81..0000000 --- a/game_GL.lisp +++ /dev/null @@ -1,68 +0,0 @@ -(let ((rtri 0) (rquad 0)) - (defun game () - (glTranslatef -1.5 0 -10) - (glRotatef rtri 0 1 0) - (draw '((1 0 0) (0 1 0)) '((0 1 0) (-1 -1 1)) '((0 0 1) (1 -1 1))) - (draw '((1 0 0) (0 1 0)) '((0 0 1) (1 -1 1)) '((0 1 0) (1 -1 -1))) - (draw '((1 0 0) (0 1 0)) '((0 1 0) (1 -1 -1)) '((0 0 1) (-1 -1 -1))) - (draw '((1 0 0) (0 1 0)) '((0 0 1) (-1 -1 -1)) '((0 1 0) (-1 -1 1))) - - (glTranslatef 3 0 0) - (glRotatef rquad 1 0 0) - (draw-color '(0 1 0)) - (draw '(1 1 -1) '(-1 1 -1) '(-1 1 1) '(1 1 1)) - (draw-color '(1 0.5 0)) - (draw '(1 -1 1) '(-1 -1 1) '(-1 -1 -1) '(1 -1 -1)) - (draw-color '(1 0 0)) - (draw '(1 1 1) '(-1 1 1) '(-1 -1 1) '(1 -1 1)) - (draw-color '(1 1 0)) - (draw '(1 -1 -1) '(-1 -1 -1) '(-1 1 -1) '(1 1 -1)) - (draw-color '(0 0 1)) - (draw '(-1 1 1) '(-1 1 -1) '(-1 -1 -1) '(-1 -1 1)) - (draw-color '(1 0 1)) - (draw '(1 1 -1) '(1 1 1) '(1 -1 1) '(1 -1 -1)) - - (incf rtri 0.2) - (incf rquad -0.15))) - -(let ((rquad 0) (texture (load-texture "../nehe/lesson06/data/nehe.bmp"))) - (defun cube-texture () - (glTranslatef -1.5 0 -10) - (glRotatef rquad 0 1 0) - (draw-quad '(1 1 -1) '(-1 1 -1) '(-1 1 1) '(1 1 1) :texture texture) - (draw-quad '(1 -1 1) '(-1 -1 1) '(-1 -1 -1) '(1 -1 -1) :texture texture) - (draw-quad '(1 1 1) '(-1 1 1) '(-1 -1 1) '(1 -1 1) :texture texture) - (draw-quad '(1 -1 -1) '(-1 -1 -1) '(-1 1 -1) '(1 1 -1) :texture texture) - (draw-quad '(-1 1 1) '(-1 1 -1) '(-1 -1 -1) '(-1 -1 1) :texture texture) - (draw-quad '(1 1 -1) '(1 1 1) '(1 -1 1) '(1 -1 -1) :texture texture) - (incf rquad 0.2))) - -(let ((xrot 0) (yrot 0) (zrot 0) - (texture (load-texture "../nehe/lesson07/data/crate.bmp")) - (light (add-light :light '(1 1 1 1) :position '(0 0 2 1) :ambient '(0.5 0.5 0.5 1)))) - (defun quad () - (glLoadIdentity) - (glColor3f 1 1 1) - (glEnable GL_TEXTURE_2D) - (glTranslatef -2 0 -13) - (rotate xrot yrot zrot) - (draw-cube :size 1 :texture texture) - (incf xrot 0.3) - (incf yrot 0.2) - (incf zrot 0.4))) - -(let ((xrot 0) (yrot 0) (zrot 0) - (texture (load-texture "../nehe/lesson08/data/glass.bmp"))) - (defun quad2 () - (glLoadIdentity) - (glColor3f 1 1 1) - (glEnable GL_TEXTURE_2D) - (glTranslatef 2 0 -13) - (rotate xrot yrot zrot) - (draw-cube :size 1 :texture texture) - (incf xrot -0.3) - (incf yrot -0.2) - (incf zrot -0.4))) - -(run-game "GL Test" (quad) (quad2)) -(quit-game) diff --git a/game_test.lisp b/game_test.lisp deleted file mode 100755 index 280ef76..0000000 --- a/game_test.lisp +++ /dev/null @@ -1,18 +0,0 @@ -(show-mob (make-mob :x 0 :y 0 :image (filled-rect 5 420) :tags '(wall) - :logic (cond ((key 'up) (incf x 5)) - ((key 'down) (decf x 5))))) - -(show-mob (make-mob :x 635 :y 0 :image (filled-rect 5 420) :tags '(wall) - :logic (cond ((key 'up) (decf x 5)) - ((key 'down) (incf x 5))))) - -(let ((xvel 100) (yvel 0)) - (show-mob (make-mob :x 300 :y 200 :image (filled-circle 7) - :logic (progn - (cond ((key 'plus) (if (> xvel 0) (incf xvel 10) (decf xvel 10))) - ((key 'minus) (if (> xvel 0) (decf xvel 10) (incf xvel 10)))) - (cond ((collision '(wall)) (setq xvel (neg xvel)))) - (movement :xvel xvel :yvel yvel))))) - -(run-game) -(quit-game) diff --git a/games/asteroids/asteroids.scm b/games/asteroids/asteroids.scm index a1e23f6..6d477e5 100644 --- a/games/asteroids/asteroids.scm +++ b/games/asteroids/asteroids.scm @@ -1,5 +1,10 @@ (set-game-properties! #:title "Gacela Asteroids") +(define max-x (/ (cdr (assoc 'width (get-game-properties))) 2)) +(define min-x (- max-x)) +(define max-y (/ (cdr (assoc 'height (get-game-properties))) 2)) +(define min-y (- max-y)) + (define draw-asteroid (let ((asteroid (load-texture "Asteroid.png"))) (lambda (a) @@ -11,13 +16,34 @@ (let* ((x (car a)) (y (cadr a)) (vx (caddr a)) (vy (cadddr a)) (nx (+ x vx)) (ny (+ y vy))) - (cond ((> nx 320) (set! vx -1)) - ((< nx -320) (set! vx 1))) - (cond ((> ny 240) (set! vy -1)) - ((< ny -240) (set! vy 1))) + (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))) -(let ((asteroids '((100 100 1 1) (-100 -100 -1 1)))) +(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)))) + +(define (move-ship s) + (let ((x (car s)) (y (cadr s)) + (angle (caddr s)) + (vx (cadddr s)) (vy (cadddr (cdr s)))) + (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))) + +(let ((asteroids '((100 100 1 1) (-100 -100 -1 1))) + (ship '(0 0 0 0 0))) (run-game (set! asteroids (map move-asteroid asteroids)) - (for-each draw-asteroid asteroids))) + (set! ship (move-ship ship)) + (for-each draw-asteroid asteroids) + (draw-ship ship))) diff --git a/fondo_tetris.png b/games/tetris/fondo_tetris.png similarity index 100% rename from fondo_tetris.png rename to games/tetris/fondo_tetris.png diff --git a/lazy.ttf b/games/tetris/lazy.ttf similarity index 100% rename from lazy.ttf rename to games/tetris/lazy.ttf diff --git a/gacela_tetris.scm b/games/tetris/tetris.scm similarity index 100% rename from gacela_tetris.scm rename to games/tetris/tetris.scm -- 2.39.2