]> git.jsancho.org Git - gacela.git/commitdiff
(no commit message)
authorjsancho <devnull@localhost>
Fri, 26 Aug 2011 11:51:39 +0000 (11:51 +0000)
committerjsancho <devnull@localhost>
Fri, 26 Aug 2011 11:51:39 +0000 (11:51 +0000)
fondo_tetris.png [deleted file]
gacela_tetris.scm [deleted file]
game.lisp [deleted file]
game_GL.lisp [deleted file]
game_test.lisp [deleted file]
games/asteroids/asteroids.scm
games/tetris/fondo_tetris.png [new file with mode: 0644]
games/tetris/lazy.ttf [new file with mode: 0644]
games/tetris/tetris.scm [new file with mode: 0644]
lazy.ttf [deleted file]

diff --git a/fondo_tetris.png b/fondo_tetris.png
deleted file mode 100644 (file)
index c2530d0..0000000
Binary files a/fondo_tetris.png and /dev/null differ
diff --git a/gacela_tetris.scm b/gacela_tetris.scm
deleted file mode 100644 (file)
index d27a086..0000000
+++ /dev/null
@@ -1,192 +0,0 @@
-(set-game-properties! #:title "Gacela Tetris" #:fps 15)
-
-(define (tetramine-i)
-  (let ((color '(1 0 0)))
-    `((,color ,color ,color ,color))))
-
-(define (tetramine-j)
-  (let ((color '(1 0.5 0)))
-    `((,color ,color ,color)
-      (#f #f ,color))))
-
-(define (tetramine-l)
-  (let ((color '(1 0 1)))
-    `((#f #f ,color)
-      (,color ,color ,color))))
-
-(define (tetramine-o)
-  (let ((color '(0 0 1)))
-    `((,color ,color)
-      (,color ,color))))
-
-(define (tetramine-s)
-  (let ((color '(0 1 0)))
-    `((#f ,color ,color)
-      (,color ,color #f))))
-
-(define (tetramine-t)
-  (let ((color '(0.5 0 0)))
-    `((,color ,color ,color)
-      (#f ,color #f))))
-
-(define (tetramine-z)
-  (let ((color '(0 1 1)))
-    `((,color ,color #f)
-      (#f ,color ,color))))
-
-(define (random-tetramine)
-  (let ((n (random 7)))
-    (cond ((= n 0) (tetramine-i))
-         ((= n 1) (tetramine-j))
-         ((= n 2) (tetramine-l))
-         ((= n 3) (tetramine-o))
-         ((= n 4) (tetramine-s))
-         ((= n 5) (tetramine-t))
-         ((= n 6) (tetramine-z)))))
-
-(define (draw-cell cell)
-  (cond ((and cell (not (null? cell)))
-        (with-color cell (draw-square #:size 20)))))
-
-(define (draw-row row)
-  (for-each (lambda (cell) (draw-cell cell) (translate 23 0)) row))
-
-(define (draw-grid grid)
-  (for-each (lambda (row) (draw-row row) (translate (* -23 (length row)) -23)) grid))
-
-(define* (join-rows source destination #:optional (offset 0))
-  (cond ((null? source) destination)
-       ((null? destination) '())
-       ((> offset 0) (cons (car destination) (join-rows source (cdr destination) (- offset 1))))
-       (else (cons (or (car source) (car destination))
-                   (join-rows (cdr source) (cdr destination) offset)))))
-
-(define* (join-grids source destination #:optional (x 0) (y 0))
-  (cond ((null? source) destination)
-       ((null? destination) '())
-       ((> y 0) (cons (car destination)
-                      (join-grids source (cdr destination) x (- y 1))))
-       (else (cons (join-rows (car source) (car destination) x)
-                   (join-grids (cdr source) (cdr destination) x y)))))
-
-(define* (collide-rows row1 row2 #:optional (offset 0))
-  (cond ((or (null? row1) (null? row2)) #f)
-       ((> offset 0) (collide-rows row1 (cdr row2) (- offset 1)))
-       (else (or (and (car row1) (car row2)) (collide-rows (cdr row1) (cdr row2))))))
-
-(define* (collide-grids grid1 grid2 #:optional (x 0) (y 0))
-  (cond ((or (null? grid1) (null? grid2)) #f)
-       ((> y 0) (collide-grids grid1 (cdr grid2) x (- y 1)))
-       (else (or (collide-rows (car grid1) (car grid2) x)
-                 (collide-grids (cdr grid1) (cdr grid2) x y)))))
-
-(define (rotate-tetramine grid)
-  (define (rot grid res)
-    (cond ((null? grid) res)
-         (else (rot (cdr grid) (map cons (car grid) res)))))
-  (rot grid (make-list (length (car grid)))))
-
-(define (row-completed row)
-  (cond ((null? row) #t)
-       (else (and (car row) (row-completed (cdr row))))))
-
-(define (remove-rows-completed grid)
-  (let ((res (filter (lambda (x) (not (row-completed x))) grid)))
-    (define (fill grid n)
-      (cond ((< n 1) grid)
-           (else (fill (cons (make-list 14 #f) grid) (- n 1)))))
-    (inc-points (- (length grid) (length res)))
-    (fill res (- 20 (length res)))))
-
-(define get-points #f)
-(define get-lines #f)
-(define inc-points #f)
-
-(let ((points 0) (lines 0))
-  (set! get-points
-       (lambda ()
-         points))
-
-  (set! get-lines
-       (lambda ()
-         lines))
-
-  (set! inc-points
-       (lambda (l)
-         (define (more-lines-better n)
-           (cond ((= n 0) n)
-                 (else (+ n (more-lines-better (- n 1))))))
-         (set! points (+ points (* (more-lines-better l) 10)))
-         (set! lines (+ lines l)))))
-
-(define game #f)
-(define display-game-over #f)
-(define tetramine #f)
-
-(let ((current-tetramine (random-tetramine)) (x 6) (y 0)
-      (next (random-tetramine))
-      (timer (make-timer))
-      (grid (make-list 20 (make-list 14 #f)))
-      (background (load-texture "fondo_tetris.png"))
-      (font (load-font "lazy.ttf" #:size 20))
-      (game-over #f))
-
-  (set! game
-       (lambda ()
-         (if game-over (display-game-over) (tetramine))))
-
-  (set! display-game-over
-       (lambda ()
-         (translate -100 0)
-         (render-text "Game Over" font #:size 50)))
-
-  (set! tetramine
-       (lambda ()
-         (cond ((eq? (get-state timer) 'stopped) (start-timer timer)))
-
-         (cond ((key? 'right)
-                (cond ((not (collide-grids current-tetramine grid (+ x 1) y))
-                       (set! x (+ x 1))))))
-         (cond ((key? 'left)
-                (cond ((not (collide-grids current-tetramine grid (- x 1) y))
-                       (set! x (- x 1))))))
-         (cond ((< x 0) (set! x 0))
-               ((> (+ x (length (car current-tetramine))) 14) (set! x (- 14 (length (car current-tetramine))))))
-
-         (cond ((key-pressed? 'up)
-                (let ((t1 (rotate-tetramine current-tetramine)))
-                  (cond ((not (collide-grids t1 grid x y))
-                         (set! current-tetramine t1))))))
-
-         (cond ((or (key? 'down) (> (get-time timer) 5000))
-                (cond ((or (collide-grids current-tetramine grid x (+ y 1))
-                           (> (+ y 1 (length current-tetramine)) 20))
-                       (set! grid (remove-rows-completed (join-grids current-tetramine grid x y)))
-                       (set! current-tetramine next)
-                       (set! x 6)
-                       (set! y 0)
-                       (cond ((collide-grids current-tetramine grid x y) (set! game-over #t)))
-                       (set! next (random-tetramine)))
-                      (else
-                       (set! y (+ y 1))
-                       (start-timer timer)))))
-         (draw-texture background)
-         (translate -288 218)
-         (draw-grid (join-grids current-tetramine grid x y))
-         (translate 440 440)
-         (draw-grid next)
-         (translate -40 -100)
-         (render-text (format #f "Points: ~a" (get-points)) font)
-         (translate 0 -30)
-         (render-text (format #f "Lines: ~a" (get-lines)) font))))
-
-(let ((frame 0.0) (fps (make-timer)) (update (make-timer)))
-  (start-timer update)
-  (start-timer fps)
-  (run-game
-   (game)
-   (set! frame (+ frame 1))
-   (cond ((> (get-time update) 1000)
-         (display (/ frame (/ (get-time fps) 1000.0)))
-         (newline)
-         (start-timer update)))))
diff --git a/game.lisp b/game.lisp
deleted file mode 100755 (executable)
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 (executable)
index d717a81..0000000
+++ /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 (executable)
index 280ef76..0000000
+++ /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)
index a1e23f6d599c99bb7548c28ee13e67af664d3d1f..6d477e5bedc35ee5982a53560f2e16b2057c5844 100644 (file)
@@ -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)
   (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/games/tetris/fondo_tetris.png b/games/tetris/fondo_tetris.png
new file mode 100644 (file)
index 0000000..c2530d0
Binary files /dev/null and b/games/tetris/fondo_tetris.png differ
diff --git a/games/tetris/lazy.ttf b/games/tetris/lazy.ttf
new file mode 100644 (file)
index 0000000..eb1000b
Binary files /dev/null and b/games/tetris/lazy.ttf differ
diff --git a/games/tetris/tetris.scm b/games/tetris/tetris.scm
new file mode 100644 (file)
index 0000000..d27a086
--- /dev/null
@@ -0,0 +1,192 @@
+(set-game-properties! #:title "Gacela Tetris" #:fps 15)
+
+(define (tetramine-i)
+  (let ((color '(1 0 0)))
+    `((,color ,color ,color ,color))))
+
+(define (tetramine-j)
+  (let ((color '(1 0.5 0)))
+    `((,color ,color ,color)
+      (#f #f ,color))))
+
+(define (tetramine-l)
+  (let ((color '(1 0 1)))
+    `((#f #f ,color)
+      (,color ,color ,color))))
+
+(define (tetramine-o)
+  (let ((color '(0 0 1)))
+    `((,color ,color)
+      (,color ,color))))
+
+(define (tetramine-s)
+  (let ((color '(0 1 0)))
+    `((#f ,color ,color)
+      (,color ,color #f))))
+
+(define (tetramine-t)
+  (let ((color '(0.5 0 0)))
+    `((,color ,color ,color)
+      (#f ,color #f))))
+
+(define (tetramine-z)
+  (let ((color '(0 1 1)))
+    `((,color ,color #f)
+      (#f ,color ,color))))
+
+(define (random-tetramine)
+  (let ((n (random 7)))
+    (cond ((= n 0) (tetramine-i))
+         ((= n 1) (tetramine-j))
+         ((= n 2) (tetramine-l))
+         ((= n 3) (tetramine-o))
+         ((= n 4) (tetramine-s))
+         ((= n 5) (tetramine-t))
+         ((= n 6) (tetramine-z)))))
+
+(define (draw-cell cell)
+  (cond ((and cell (not (null? cell)))
+        (with-color cell (draw-square #:size 20)))))
+
+(define (draw-row row)
+  (for-each (lambda (cell) (draw-cell cell) (translate 23 0)) row))
+
+(define (draw-grid grid)
+  (for-each (lambda (row) (draw-row row) (translate (* -23 (length row)) -23)) grid))
+
+(define* (join-rows source destination #:optional (offset 0))
+  (cond ((null? source) destination)
+       ((null? destination) '())
+       ((> offset 0) (cons (car destination) (join-rows source (cdr destination) (- offset 1))))
+       (else (cons (or (car source) (car destination))
+                   (join-rows (cdr source) (cdr destination) offset)))))
+
+(define* (join-grids source destination #:optional (x 0) (y 0))
+  (cond ((null? source) destination)
+       ((null? destination) '())
+       ((> y 0) (cons (car destination)
+                      (join-grids source (cdr destination) x (- y 1))))
+       (else (cons (join-rows (car source) (car destination) x)
+                   (join-grids (cdr source) (cdr destination) x y)))))
+
+(define* (collide-rows row1 row2 #:optional (offset 0))
+  (cond ((or (null? row1) (null? row2)) #f)
+       ((> offset 0) (collide-rows row1 (cdr row2) (- offset 1)))
+       (else (or (and (car row1) (car row2)) (collide-rows (cdr row1) (cdr row2))))))
+
+(define* (collide-grids grid1 grid2 #:optional (x 0) (y 0))
+  (cond ((or (null? grid1) (null? grid2)) #f)
+       ((> y 0) (collide-grids grid1 (cdr grid2) x (- y 1)))
+       (else (or (collide-rows (car grid1) (car grid2) x)
+                 (collide-grids (cdr grid1) (cdr grid2) x y)))))
+
+(define (rotate-tetramine grid)
+  (define (rot grid res)
+    (cond ((null? grid) res)
+         (else (rot (cdr grid) (map cons (car grid) res)))))
+  (rot grid (make-list (length (car grid)))))
+
+(define (row-completed row)
+  (cond ((null? row) #t)
+       (else (and (car row) (row-completed (cdr row))))))
+
+(define (remove-rows-completed grid)
+  (let ((res (filter (lambda (x) (not (row-completed x))) grid)))
+    (define (fill grid n)
+      (cond ((< n 1) grid)
+           (else (fill (cons (make-list 14 #f) grid) (- n 1)))))
+    (inc-points (- (length grid) (length res)))
+    (fill res (- 20 (length res)))))
+
+(define get-points #f)
+(define get-lines #f)
+(define inc-points #f)
+
+(let ((points 0) (lines 0))
+  (set! get-points
+       (lambda ()
+         points))
+
+  (set! get-lines
+       (lambda ()
+         lines))
+
+  (set! inc-points
+       (lambda (l)
+         (define (more-lines-better n)
+           (cond ((= n 0) n)
+                 (else (+ n (more-lines-better (- n 1))))))
+         (set! points (+ points (* (more-lines-better l) 10)))
+         (set! lines (+ lines l)))))
+
+(define game #f)
+(define display-game-over #f)
+(define tetramine #f)
+
+(let ((current-tetramine (random-tetramine)) (x 6) (y 0)
+      (next (random-tetramine))
+      (timer (make-timer))
+      (grid (make-list 20 (make-list 14 #f)))
+      (background (load-texture "fondo_tetris.png"))
+      (font (load-font "lazy.ttf" #:size 20))
+      (game-over #f))
+
+  (set! game
+       (lambda ()
+         (if game-over (display-game-over) (tetramine))))
+
+  (set! display-game-over
+       (lambda ()
+         (translate -100 0)
+         (render-text "Game Over" font #:size 50)))
+
+  (set! tetramine
+       (lambda ()
+         (cond ((eq? (get-state timer) 'stopped) (start-timer timer)))
+
+         (cond ((key? 'right)
+                (cond ((not (collide-grids current-tetramine grid (+ x 1) y))
+                       (set! x (+ x 1))))))
+         (cond ((key? 'left)
+                (cond ((not (collide-grids current-tetramine grid (- x 1) y))
+                       (set! x (- x 1))))))
+         (cond ((< x 0) (set! x 0))
+               ((> (+ x (length (car current-tetramine))) 14) (set! x (- 14 (length (car current-tetramine))))))
+
+         (cond ((key-pressed? 'up)
+                (let ((t1 (rotate-tetramine current-tetramine)))
+                  (cond ((not (collide-grids t1 grid x y))
+                         (set! current-tetramine t1))))))
+
+         (cond ((or (key? 'down) (> (get-time timer) 5000))
+                (cond ((or (collide-grids current-tetramine grid x (+ y 1))
+                           (> (+ y 1 (length current-tetramine)) 20))
+                       (set! grid (remove-rows-completed (join-grids current-tetramine grid x y)))
+                       (set! current-tetramine next)
+                       (set! x 6)
+                       (set! y 0)
+                       (cond ((collide-grids current-tetramine grid x y) (set! game-over #t)))
+                       (set! next (random-tetramine)))
+                      (else
+                       (set! y (+ y 1))
+                       (start-timer timer)))))
+         (draw-texture background)
+         (translate -288 218)
+         (draw-grid (join-grids current-tetramine grid x y))
+         (translate 440 440)
+         (draw-grid next)
+         (translate -40 -100)
+         (render-text (format #f "Points: ~a" (get-points)) font)
+         (translate 0 -30)
+         (render-text (format #f "Lines: ~a" (get-lines)) font))))
+
+(let ((frame 0.0) (fps (make-timer)) (update (make-timer)))
+  (start-timer update)
+  (start-timer fps)
+  (run-game
+   (game)
+   (set! frame (+ frame 1))
+   (cond ((> (get-time update) 1000)
+         (display (/ frame (/ (get-time fps) 1000.0)))
+         (newline)
+         (start-timer update)))))
diff --git a/lazy.ttf b/lazy.ttf
deleted file mode 100644 (file)
index eb1000b..0000000
Binary files a/lazy.ttf and /dev/null differ