From: jsancho <devnull@localhost>
Date: Wed, 3 Aug 2011 18:26:39 +0000 (+0000)
Subject: (no commit message)
X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=09fa5781bfe3e7b8406a4cee4eb24923e14527b0;p=gacela.git

---

diff --git a/gacela_misc.lisp b/gacela_misc.lisp
deleted file mode 100755
index e19f3a2..0000000
--- a/gacela_misc.lisp
+++ /dev/null
@@ -1,230 +0,0 @@
-;;; Gacela, a GNU Common Lisp extension for fast games development
-;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; 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 <http://www.gnu.org/licenses/>.
-
-
-(eval-when (compile load eval)
-	   (when (not (find-package 'gacela)) (make-package 'gacela :nicknames '(gg) :use '(lisp)))
-	   (in-package 'gacela :nicknames '(gg) :use '(lisp)))
-
-
-(defconstant INFINITY MOST-POSITIVE-LONG-FLOAT)
-
-(defun append-if (new test tree &key (key #'first) (test-if #'equal))
-  (cond ((atom tree) tree)
-	(t (append-if-1
-	    new
-	    test
-	    (mapcar (lambda (x) (append-if new test x :key key :test-if test-if)) tree)
-	    :key key
-	    :test-if test-if))))
-
-(defun append-if-1 (new test tree &key (key #'first) (test-if #'equal))
-  (cond ((funcall test-if (funcall key tree) test) (append tree new))
-	(t tree)))
-
-(defun car+ (var)
-  (if (listp var) (car var) var))
-
-(defun avg (&rest numbers)
-  (let ((total 0))
-    (dolist (n numbers) (incf total n))
-    (/ total (length numbers))))
-
-(defun neg (num)
-  (* -1 num))
-
-(defun signum+ (num)
-  (let ((sig (signum num)))
-    (cond ((= sig 0) 1)
-	  (t sig))))
-
-(defmacro destructure (destructuring-list &body body)
-  (let ((lambda-list nil) (exp-list nil))
-    (dolist (pair destructuring-list)
-      (setq exp-list (cons (car pair) exp-list))
-      (setq lambda-list (cons (cadr pair) lambda-list)))
-    `(destructuring-bind ,lambda-list ,(cons 'list exp-list) ,@body)))
-
-(defun match-pattern (list pattern)
-  (cond ((and (null list) (null pattern)) t)
-	((and (consp list) (consp pattern))
-	 (and (match-pattern (car list) (car pattern)) (match-pattern (cdr list) (cdr pattern))))
-	((and (atom list) (atom pattern))
-	 (cond ((or (numberp list) (numberp pattern)) (and (numberp list) (numberp pattern)))
-	       (t t)))))
-
-(defun nearest-power-of-two (n)
-  (labels ((power (p n)
-		  (cond ((> (* p 2) n) p)
-			(t (power (* p 2) n)))))
-	  (power 1 n)))
-
-(defmacro secure-block (output-stream &rest forms)
-  (let ((error-handler #'si::universal-error-handler))
-    `(block secure
-       (defun si::universal-error-handler (error-name correctable function-name continue-format-string error-format-string &rest args)
-	 ,(when output-stream
-	    `(write-line
-	      (cond ((eq error-name :WRONG-TYPE-ARGUMENT) (string error-name))
-		    (t error-format-string))
-	      ,output-stream))
-	 (setf (symbol-function 'si::universal-error-handler) ,error-handler)
-	 (return-from secure))
-       (let (result-eval)
-	 (setq result-eval (progn ,@forms))
-	 (setf (symbol-function 'si::universal-error-handler) ,error-handler)
-	 result-eval))))
-
-(defmacro persistent-let (name vars &rest forms)
-  (labels ((get-vars (vars)
-		     (cond ((null vars) nil)
-			   (t (cons (if (consp (car vars)) (caar vars) (car vars))
-				    (get-vars (cdr vars)))))))
-   
-	  `(let ,(cond ((functionp name)
-			(let ((old-vars (funcall name)))
-			  (cond ((equal (get-vars vars) (get-vars old-vars)) old-vars)
-				(t vars))))
-		       (t vars))
-	     (defun ,name ()
-	       ,(let ((lvars (get-vars vars)))
-		  `(mapcar (lambda (x y) (list x y)) ',lvars ,(cons 'list lvars))))
-	     ,@forms)))
-
-;Geometry
-(defun dotp (dot)
-  (match-pattern dot '(0 0)))
-
-(defun vectorp (vector)
-  (match-pattern vector '(0 0)))
-
-(defun circlep (circle)
-  (match-pattern circle '((0 0) 0)))
-
-(defun polygonp (polygon)
-  (cond ((consp polygon)
-	 (and (dotp (car polygon))
-	      (if (null (cdr polygon)) t (polygonp (cdr polygon)))))))
-
-(defun make-dot (x y)
-  `(,x ,y))
-
-(defun make-vector (x y)
-  `(,x ,y))
-
-(defun make-line (dot1 dot2)
-  `(,dot1 ,dot2))
-
-(defun make-rectangle (x1 y1 x2 y2)
-  `((,x1 ,y1) (,x2 ,y1) (,x2 ,y2) (,x1 ,y2)))
-
-(defun polygon-center (polygon)
-  (apply #'mapcar #'avg polygon))
-
-(defun dots-distance (dot1 dot2)
-  (destructure ((dot1 (x1 y1))
-		(dot2 (x2 y2)))
-	       (sqrt (+ (expt (- x2 x1) 2)
-			(expt (- y2 y1) 2)))))
-
-(defun dot-line-distance (dot line)
-  (destructure ((line ((ax ay) (bx by)))
-		(dot (cx cy)))
-	       (let* ((r-numerator (+ (* (- cx ax) (- bx ax)) (* (- cy ay) (- by ay))))
-		      (r-denomenator (+ (expt (- bx ax) 2) (expt (- by ay) 2)))
-		      (r (/ r-numerator r-denomenator)))
-		 (values
-		  (* (abs (/ (- (* (- ay cy) (- bx ax)) (* (- ax cx) (- by ay)))
-			     r-denomenator))
-		     (sqrt r-denomenator))
-		  r))))
-
-(defun dot-segment-distance (dot segment)
-  (multiple-value-bind
-   (dist r) (dot-line-distance dot segment)
-	(cond ((and (>= r 0) (<= r 1)) dist)
-	      (t (let ((dist1 (dots-distance dot (car segment)))
-		       (dist2 (dots-distance dot (cadr segment))))
-		   (if (< dist1 dist2) dist1 dist2))))))
-
-(defun perpendicular-line (dot line)
-  (destructure ((line ((ax ay) (bx by))))
-	       (multiple-value-bind
-		(dist r) (dot-line-distance dot line)
-		(make-line dot
-			   (make-dot (+ ax (* r (- bx ax)))
-				     (+ ay (* r (- by ay))))))))
-
-(defun line-angle (line)
-  (destructure ((line ((ax ay) (bx by))))
-	       (let ((x (- bx ax)) (y (- by ay)))
-		 (if (and (= x 0) (= y 0)) 0 (atan y x)))))
-
-(defun inverse-angle (angle)
-  (cond ((< angle pi) (+ angle pi))
-	(t (- angle pi))))
-
-(defun translate-dot (dot dx dy)
-  (destructure ((dot (x y)))
-	       (list (+ x dx) (+ y dy))))
-
-(defun translate-circle (circle dx dy)
-  (destructure ((circle (center radius)))
-	       (list (translate-dot center dx dy) radius)))
-
-(defun translate-polygon (pol dx dy)
-  (mapcar (lambda (dot)
-	    (translate-dot dot dx dy))
-	  pol))
-
-(defun polygon-edges (pol)
-  (mapcar (lambda (v1 v2) (list v1 v2))
-	  pol
-	  (union (cdr pol) (list (car pol)))))
-
-(defun polygon-dot-intersection (polygon dot)
-;Eric Haines algorithm
-  (let ((edges (polygon-edges
-		(translate-polygon polygon (neg (car dot)) (neg (cadr dot)))))
-	(counter 0))
-    (dolist (edge edges)
-      (destructure ((edge ((x1 y1) (x2 y2))))
-		   (cond ((/= (signum+ y1) (signum+ y2))
-			  (cond ((and (> x1 0) (> x2 0)) (incf counter))
-				((and (or (> x1 0) (> x2 0))
-				      (> (- x1 (* y1 (/ (- x2 x1) (- y2 y1)))) 0))
-				 (incf counter)))))))
-    (not (evenp counter))))
-
-(defun circle-segment-intersection (circle segment)
-  (destructure ((circle (center radius)))
-	       (<= (dot-segment-distance center segment) radius)))
-
-(defun circle-edges-intersection (circle polygon)
-  (let ((edges (polygon-edges polygon))
-	(edges-i nil))
-    (dolist (edge edges)
-      (cond ((circle-segment-intersection circle edge) (setq edges-i (cons edge edges-i)))))
-    edges-i))
-
-(defun circle-polygon-intersection (circle polygon)
-  (or (polygon-dot-intersection polygon (car circle))
-      (circle-edges-intersection circle polygon)))
-
-(defun circle-circle-intersection (circle1 circle2)
-  (destructure ((circle1 (center1 radius1))
-		(circle2 (center2 radius2)))
-	       (<= (dots-distance center1 center2) (+ r1 r2))))
diff --git a/gacela_objects.lisp b/gacela_objects.lisp
deleted file mode 100755
index 178c4ac..0000000
--- a/gacela_objects.lisp
+++ /dev/null
@@ -1,113 +0,0 @@
-;;; Gacela, a GNU Common Lisp extension for fast games development
-;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; 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 <http://www.gnu.org/licenses/>.
-
-
-(eval-when (compile load eval)
-	   (when (not (find-package 'gacela)) (make-package 'gacela :nicknames '(gg) :use '(lisp)))
-	   (in-package 'gacela :nicknames '(gg) :use '(lisp)))
-
-
-;;; Behaviours of objects
-
-(defmacro make-behaviour (name attr &rest code)
-  `(defun ,(get-behaviour-fun-name name) (object-attr)
-     (let ,(mapcar #'attribute-definition attr)
-       ,@code
-       ,(cons 'progn (mapcar #'attribute-save (reverse attr)))
-       object-attr)))
-
-(defun get-behaviour-fun-name (name)
-  (intern (concatenate 'string "BEHAVIOUR-" (string-upcase (string name))) 'gacela))
-
-(defun attribute-name (attribute)
-  (intern (string attribute) 'keyword))
-
-(defun attribute-definition (attribute)
-  (let* ((name (cond ((listp attribute) (car attribute))
-		     (t attribute)))
-	 (pname (attribute-name name))
-	 (value (cond ((listp attribute) (cadr attribute)))))
-    `(,name (getf object-attr ,pname ,value))))
-
-(defun attribute-save (attribute)
-  (let* ((name (cond ((listp attribute) (car attribute))
-		     (t attribute)))
-	 (pname (attribute-name name)))
-    `(setf (getf object-attr ,pname) ,name)))
-
-
-
-;;; Objects Factory
-
-(let (active-objects objects-to-add objects-to-kill)
-  (defun add-object (object)
-    (pushnew object objects-to-add))
-
-  (defun kill-object (object)
-    (pushnew object objects-to-kill))
-
-  (defun kill-all-objects ()
-    (setq active-objects nil objects-to-add nil objects-to-kill nil))
-
-  (defun refresh-active-objects ()
-    (cond (objects-to-add
-	   (setq active-objects (union active-objects objects-to-add))
-	   (setq objects-to-add nil)))
-    (cond (objects-to-kill
-	   (setq active-objects (reverse (set-difference active-objects objects-to-kill)))
-	   (setq objects-to-kill nil))))
-
-  (defun bhv-objects ()
-    (dolist (o active-objects) (funcall o :action)))
-
-  (defun render-objects ()
-    (dolist (o active-objects) (funcall o :render))))
-
-
-(defmacro make-object (name attr bhv &body look)
-  `(progn
-     (let ((attr ,(cond (attr (cons 'list (make-object-attributes attr)))))
-	   (bhv ,(cond (bhv (cons 'list (make-object-behaviour bhv))))))
-       (defun ,name (option &rest param)
-	 (case option
-	       (:action (dolist (b bhv t) (setq attr (funcall (get-behaviour-fun-name b) attr))))
-	       (:get-attr attr)
-	       (:get-bhv bhv)
-	       (:set-bhv (setq bhv (car param)))
-	       (:render (glPushMatrix)
-			,@(mapcar (lambda (x) (if (stringp x) `(draw-image ,x) x)) look)
-			(glPopMatrix)))))
-     (add-object ',name)
-     ',name))
-
-(defun make-object-attributes (attr)
-  (cond ((or (null attr) (atom attr)) nil)
-	(t (let ((rest (make-object-attributes (cdr attr)))
-		 (this (object-attribute-definition (car attr))))
-	     (setf (getf rest (car this)) (cadr this))
-	     rest))))
-
-(defun object-attribute-definition (attribute)
-  (let* ((name (cond ((listp attribute) (car attribute))
-		     (t attribute)))
-	 (pname (attribute-name name))
-	 (value (cond ((listp attribute) (cadr attribute)))))
-    `(,pname ,value)))
-
-(defun make-object-behaviour (bhv)
-  (cond ((null bhv) nil)
-	((atom bhv) (list bhv))
-	(t bhv)))
diff --git a/gacela_procs.lisp b/gacela_procs.lisp
deleted file mode 100755
index ce58974..0000000
--- a/gacela_procs.lisp
+++ /dev/null
@@ -1,71 +0,0 @@
-(defmacro defproc (name type variables init logic motion)
-  `(let ((make-name ',(intern (concatenate 'string "MAKE-" (string name)))))
-     (setf (symbol-function make-name)
-	   (make-proc-constructor ,type ,variables ,init ,logic ,motion))
-     make-name))
-
-(defmacro make-proc-constructor (type variables init logic motion)
-  `(lambda
-     ,(if (null variables) () (cons '&key variables))
-     (proc-structure ,type ,variables ,init ,logic ,motion)))
-
-(defmacro proc-structure (type variables init logic motion)
-  `(list
-    :type ,type
-    :init (lambda () ,init)
-    :logic (lambda () ,logic)
-    :motion (lambda () ,motion)
-    :context (lambda ()
-	       ,(if variables
-		    `(mapcar #'list
-			     ',(mapcar #'car+ variables)
-			     (multiple-value-list
-			      (values-list ,(cons 'list (mapcar #'car+ variables)))))
-		  nil))))
-
-(defun proc-value (proc label)
-  (car (cdr (assoc label (funcall (getf proc :context))))))
-
-(defun proc-type (proc)
-  (getf proc :type))
-
-(defun init-proc (proc)
-  (funcall (getf proc :init)))
-
-(defun logic-proc (proc)
-  (funcall (getf proc :logic)))
-
-(defun motion-proc (proc)
-  (funcall (getf proc :motion)))
-
-(let ((active-procs nil) (procs-to-add nil) (procs-to-quit nil))
-
-  (defun add-proc (proc)
-    (push proc procs-to-add))
-
-  (defun logic-procs ()
-    (dolist (proc active-procs) (logic-proc proc)))
-
-  (defun motion-procs ()
-    (dolist (proc active-procs) (motion-proc proc)))
-
-  (defun funcall-procs (func)
-    (dolist (proc active-procs) (funcall func proc)))
-
-  (defun filter-procs (test)
-    (intersection (mapcar (lambda (p) (cond ((funcall test p) p))) active-procs) active-procs))
-
-  (defun quit-proc (proc)
-    (push proc procs-to-quit))
-
-  (defun refresh-active-procs ()
-    (do ((proc (pop procs-to-add) (pop procs-to-add))) ((null proc))
-	(push proc active-procs)
-	(init-proc proc))
-    (do ((proc (pop procs-to-quit) (pop procs-to-quit))) ((null proc))
-	(setq active-procs (reverse (set-difference active-procs (list proc) :test #'equal)))))
-
-  (defun quit-all-procs ()
-    (setq active-procs nil)
-    (setq procs-to-add nil)
-    (setq procs-to-quit nil)))
diff --git a/gacela_sound.lisp b/gacela_sound.lisp
deleted file mode 100644
index e1b2a1e..0000000
--- a/gacela_sound.lisp
+++ /dev/null
@@ -1,90 +0,0 @@
-;;; Gacela, a GNU Common Lisp extension for fast games development
-;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; 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 <http://www.gnu.org/licenses/>.
-
-
-(eval-when (compile load eval)
-	   (when (not (find-package 'gacela)) (make-package 'gacela :nicknames '(gg) :use '(lisp)))
-	   (in-package 'gacela :nicknames '(gg) :use '(lisp)))
-
-
-;;; Sound
-
-(defun load-sound (filename &key static)
-  (let ((key (make-resource-sound :filename filename)))
-    (cond ((get-resource key) key)
-	  (t (true-load-sound filename static)))))
-
-(defun true-load-sound (filename static)
-  (init-audio)
-  (let ((key (make-resource-sound :filename filename))
-	(sound (Mix_LoadWAV filename)))
-    (cond ((/= sound 0)
-	   (set-resource key
-			 `(:id-sound ,sound)
-			 (lambda () (true-load-sound filename static))
-			 (lambda () (Mix_FreeChunk sound))
-			 :static static)
-	   key))))
-
-(defun play-sound (sound &optional (loops 0))
-  (let ((id-sound (getf (get-resource sound) :id-sound)))
-    (/= (Mix_PlayChannel -1 id-sound loops) -1)))
-
-
-;;; Music
-
-(defun load-music (filename &key static)
-  (let ((key (make-resource-music :filename filename)))
-    (cond ((get-resource key) key)
-	  (t (true-load-music filename static)))))
-
-(defun true-load-music (filename static)
-  (init-audio)
-  (let ((key (make-resource-music :filename filename))
-	(music (Mix_LoadMUS filename)))
-    (cond ((/= music 0)
-	   (set-resource key
-			 `(:id-music ,music)
-			 (lambda () (true-load-music filename static))
-			 (lambda () (Mix_FreeMusic music))
-			 :static static)
-	   key))))
-
-(defun playing-music? ()
-  (/= (Mix_PlayingMusic) 0))
-
-(defun paused-music? ()
-  (/= (Mix_PausedMusic) 0))
-
-(defun play-music (music &optional (loops -1))
-  (cond ((not (playing-music?))
-	 (let ((id-music (getf (get-resource music) :id-music)))
-	   (/= (Mix_PlayMusic id-music loops) -1)))))
-
-(defun pause-music ()
-  (cond ((and (playing-music?) (not (paused-music?)))
-	 (Mix_PauseMusic)
-	 t)))
-
-(defun resume-music ()
-  (cond ((and (playing-music?) (paused-music?))
-	 (Mix_ResumeMusic)
-	 t)))
-
-(defun halt-music ()
-  (cond ((playing-music?)
-	 (Mix_HaltMusic)
-	 t)))
diff --git a/gacela_widgets.lisp b/gacela_widgets.lisp
deleted file mode 100755
index 8ff79ec..0000000
--- a/gacela_widgets.lisp
+++ /dev/null
@@ -1,48 +0,0 @@
-;;; Gacela, a GNU Common Lisp extension for fast games development
-;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; 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 <http://www.gnu.org/licenses/>.
-
-
-(eval-when (compile load eval)
-	   (when (not (find-package 'gacela)) (make-package 'gacela :nicknames '(gg) :use '(lisp)))
-	   (in-package 'gacela :nicknames '(gg) :use '(lisp)))
-
-
-;;; Timers
-
-(defstruct timer (start 0) (paused 0) (state 'stopped))
-
-(defun start-timer (timer)
-  (setf (timer-start timer) (SDL_GetTicks))
-  (setf (timer-state timer) 'running))
-
-(defun stop-timer (timer)
-  (setf (timer-state timer) 'stopped))
-
-(defun get-time (timer)
-  (cond ((eq (timer-state timer) 'stopped) 0)
-        ((eq (timer-state timer) 'paused) (timer-paused timer))
-        (t (- (SDL_GetTicks) (timer-start timer)))))
-
-(defun pause-timer (timer)
-  (cond ((eq (timer-state timer) 'running)
-         (setf (timer-paused timer) (- (SDL_GetTicks) (timer-start timer)))
-         (setf (timer-state timer) 'paused))))
-
-(defun resume-timer (timer)
-  (cond ((eq (timer-state timer) 'paused)
-         (setf (timer-start timer) (- (SDL_GetTicks) (timer-paused timer)))
-         (setf (timer-state timer) 'running))))
-
diff --git a/src/gacela.c b/src/gacela.c
index a75fe73..2f82d72 100644
--- a/src/gacela.c
+++ b/src/gacela.c
@@ -204,14 +204,6 @@ load_scheme_files (char *path)
   scm_primitive_load_path (scm_from_locale_string ("gacela_loader.scm"));
 }
 
-void
-start_single ()
-{
-  char *argv = "guile";
-
-  scm_shell (1, &argv);
-}
-
 void
 start_server (int port)
 {
@@ -245,7 +237,7 @@ int
 main (int argc, char *argv[])
 {
   char *arg;
-  int mode = 0;   // shell: 1, server: 2, client: 3
+  int mode = 0;   // playing: 1, server: 2, client: 3
   char *host;
   int port = 0;
   int i;
@@ -254,7 +246,7 @@ main (int argc, char *argv[])
 
   // Checking arguments
   for (i = 1; i < argc; i++) {
-    if (strcmp (argv[i], "--shell-mode") == 0)
+    if (strcmp (argv[i], "--playing") == 0)
       mode = 1;
     else if (strncmp (argv[i], "--server", 8) == 0) {
       mode = 2;
@@ -279,18 +271,6 @@ main (int argc, char *argv[])
   scm_init_guile ();
 
   if (mode == 1) {
-    scm_with_guile (&init_gacela, NULL);
-    load_scheme_files (dirname (argv[0]));
-    start_single ();
-  }
-  else if (mode == 2 && port != 0) {
-    scm_with_guile (&init_gacela, NULL);
-    load_scheme_files (dirname (argv[0]));
-    start_server (port);
-  }
-  else if (mode == 3 && port != 0)
-    start_remote_client (host, port);
-  else {
     fd1 = scm_pipe ();
     fd2 = scm_pipe ();
     pid = fork ();
@@ -309,4 +289,16 @@ main (int argc, char *argv[])
       kill (pid, SIGKILL);
     }
   }
+  else if (mode == 2 && port != 0) {
+    scm_with_guile (&init_gacela, NULL);
+    load_scheme_files (dirname (argv[0]));
+    start_server (port);
+  }
+  else if (mode == 3 && port != 0)
+    start_remote_client (host, port);
+  else {
+    scm_with_guile (&init_gacela, NULL);
+    load_scheme_files (dirname (argv[0]));
+    scm_shell (argc, argv);
+  }
 }
diff --git a/src/gacela_loader.scm b/src/gacela_loader.scm
index c5f97fa..23b0951 100644
--- a/src/gacela_loader.scm
+++ b/src/gacela_loader.scm
@@ -22,3 +22,4 @@
 (primitive-load-path "gacela_mobs.scm")
 (primitive-load-path "gacela_misc.scm")
 (primitive-load-path "gacela_server.scm")
+(primitive-load-path "gacela_widgets.scm")
diff --git a/src/gacela_widgets.scm b/src/gacela_widgets.scm
new file mode 100755
index 0000000..a0e0223
--- /dev/null
+++ b/src/gacela_widgets.scm
@@ -0,0 +1,43 @@
+;;; Gacela, a GNU Guile extension for fast games development
+;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+
+;;; Timers
+
+(defstruct timer (start 0) (paused 0) (state 'stopped))
+
+(defun start-timer (timer)
+  (setf (timer-start timer) (SDL_GetTicks))
+  (setf (timer-state timer) 'running))
+
+(defun stop-timer (timer)
+  (setf (timer-state timer) 'stopped))
+
+(defun get-time (timer)
+  (cond ((eq (timer-state timer) 'stopped) 0)
+        ((eq (timer-state timer) 'paused) (timer-paused timer))
+        (t (- (SDL_GetTicks) (timer-start timer)))))
+
+(defun pause-timer (timer)
+  (cond ((eq (timer-state timer) 'running)
+         (setf (timer-paused timer) (- (SDL_GetTicks) (timer-start timer)))
+         (setf (timer-state timer) 'paused))))
+
+(defun resume-timer (timer)
+  (cond ((eq (timer-state timer) 'paused)
+         (setf (timer-start timer) (- (SDL_GetTicks) (timer-paused timer)))
+         (setf (timer-state timer) 'running))))
+