X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=gacela.lisp;h=8a1c2c8f598d20fbb2347629594d902350c3e929;hb=d89eeb0212cedfe8480e080d32db0644dceb7985;hp=d5d28525a2f56718f986c9704f302937858eee39;hpb=4cb43f867b6a2fcf40ced44ac937d8930005d01e;p=gacela.git

diff --git a/gacela.lisp b/gacela.lisp
index d5d2852..8a1c2c8 100644
--- a/gacela.lisp
+++ b/gacela.lisp
@@ -38,9 +38,7 @@
 
 
 ;;; Video Subsystem
-(defstruct surface address clip-w clip-h shape)
-
-(let (screen flags)
+(let (screen flags current-width current-height)
 
   (defun init-video-mode (&key (width *width-screen*) (height *height-screen*) (bpp *bpp-screen*))
     (cond ((null screen)
@@ -51,31 +49,50 @@
 			  (if (= (getf (SDL_GetVideoInfo) :blit_hw) 0) 0 SDL_HWACCEL)))
 	   (setq screen (SDL_SetVideoMode width height bpp flags))
 	   (init-GL)
-	   (resize-screen-GL width height))
+	   (resize-screen-GL width height)
+	   (setq current-width width current-height height))
 	  (t t)))
 
   (defun resize-screen (width height bpp)
     (setq screen (SDL_SetVideoMode width height bpp flags))
-    (resize-screen-GL width height))
+    (resize-screen-GL width height)
+    (setq current-width width current-height height))
+
+  (defun apply-mode-change ()
+    (resize-screen-GL current-width current-height))
 
   (defun fill-screen (color)
     (init-video-mode)
     (fill-surface screen (getf color :red) (getf color :green) (getf color :blue)))
 
-  (defun flip ()
-    (cond ((null screen) nil)
-	  (t (SDL_Flip screen))))
-
   (defun quit-video-mode ()
     (setq screen nil)))
 
+(let ((mode '2d))
+  (defun set-2d-mode ()
+    (cond ((3d-mode?)
+	   (setq mode '2d)
+	   (init-video-mode)
+	   (glDisable GL_DEPTH_TEST)
+	   (apply-mode-change))))
+
+  (defun set-3d-mode ()
+    (cond ((not (3d-mode?))
+	   (setq mode '3d)
+	   (init-video-mode)
+	   (glClearDepth 1)
+	   (glEnable GL_DEPTH_TEST)
+	   (glDepthFunc GL_LEQUAL)
+	   (apply-mode-change))))
+
+  (defun 3d-mode? ()
+    (eq mode '3d)))
 
 (defun init-GL ()
-  (2d-mode)
   (glShadeModel GL_SMOOTH)
   (glClearColor 0 0 0 0)
-  (glClearDepth 1)
-  (glDepthFunc GL_LEQUAL)
+;  (glClearDepth 1)
+;  (glDepthFunc GL_LEQUAL)
 ;  (glEnable GL_BLEND)
 ;  (glBlendFunc GL_SRC_ALPHA GL_ONE)
   (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST)
@@ -86,16 +103,16 @@
   (glEnable GL_LIGHTING))
 
 (defun resize-screen-GL (width height)
-  (let ((ratio (if (= height 0) width (/ width height))))
-;    (glViewPort 0 0 width height)
-    (glMatrixMode GL_PROJECTION)
-    (glLoadIdentity)
-    (let* ((w (/ width 2)) (-w (neg w)) (h (/ height 2)) (-h (neg h)))
-      (glOrtho -w w -h h 0 1))
-;    (gluPerspective 45 ratio 0.1 100)
-    (glMatrixMode GL_MODELVIEW)
-    (glLoadIdentity)
-    t))
+  (glViewPort 0 0 width height)
+  (glMatrixMode GL_PROJECTION)
+  (glLoadIdentity)
+  (cond ((3d-mode?) (let ((ratio (if (= height 0) width (/ width height))))
+		      (gluPerspective 45 ratio 0.1 100))) ;0.1
+	(t (let* ((w (/ width 2)) (-w (neg w)) (h (/ height 2)) (-h (neg h)))
+	     (glOrtho -w w -h h 0 1))))
+  (glMatrixMode GL_MODELVIEW)
+  (glLoadIdentity)
+  t))
 
 (let ((current-color '(1 1 1 1)))
   (defun get-current-color ()
@@ -121,20 +138,6 @@
 						     (caddr transparent-color)))
 			optimized-image)))))))
 
-(defun load-image2 (image-file &key (transparent-color nil))
-  (let ((address-image (load-image image-file :transparent-color transparent-color)))
-    (list
-     (lambda (x y) (print-surface x y address-image))
-     (lambda () (SDL_FreeSurface address-image)))))
-
-(defun clean-screen ()
-  (fill-screen *background-color*))
-
-(defun refresh-screen ()
-  (clean-screen)
-  (funcall-procs #'print-mob)
-  (flip))
-
 
 ;;; Audio Subsystem
 (let ((audio nil))
@@ -204,19 +207,34 @@
     (maphash (lambda (key res) (free-resource key)) resources-table)))
 
 
-;;; Connection with Gacela Skin
-(let (socket)
-  (defun start-skin-client (port)
-    (when (null socket) (setq socket (si::socket port :host "localhost"))))
+;;; Connection with Gacela Skin Clients
+(let (server-socket clients)
+  (defun start-skin-server (port)
+    (cond ((null server-socket) (setq server-socket (si::socket port :server #'check-skin-connections)))))
 
-  (defun eval-from-skin ()
-    (when (si::listen socket)
-      (secure-block socket (eval (read socket)))))
+  (defun check-skin-connections ()
+    (cond ((and server-socket (listen server-socket)) (setq clients (cons (si::accept server-socket) clients)))))
 
-  (defun stop-skin-client ()
-    (when socket
-      (si::close socket)
-      (setq socket nil))))
+  (defun eval-from-skin ()
+    (labels ((eval-clients (cli-socks)
+			   (cond (cli-socks
+				  (let ((cli (car cli-socks)))
+				    (cond ((si::listen cli)
+					   (secure-block cli (eval (read cli)))
+					   (si::close cli)
+					   (eval-clients (cdr cli-socks)))
+					  (t
+					   (cons cli (eval-clients (cdr cli-socks))))))))))
+	    (setq clients (eval-clients clients))))
+
+  (defun stop-skin-server ()
+    (cond (server-socket (si::close server-socket) (setq server-socket nil)))
+    (cond (clients
+	   (labels ((close-clients (cli-socks)
+				   (si::close (car cli-socks))
+				   (close-clients (cdr cli-socks))))
+		   (close-clients clients))
+	   (setq clients nil)))))
 
 
 ;;; GaCeLa Functions
@@ -253,6 +271,7 @@
 	(SDL_GL_SwapBuffers)
 	(delay-frame)
 	(init-frame-time)
+	(check-skin-connections)
 	(eval-from-skin)
 	(process-events))
     (setq running nil))