X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=gacela.lisp;h=31fe8abada40e5140ebbe26211e557660dbe5995;hb=fd0956a0072b3db8808880bd3d4dbf17d941265d;hp=a7045cee8dfa718a17c0ff5eedfd9e9d7d69a40c;hpb=41c9fd5f4de137f599da657390fd53372ee06b05;p=gacela.git diff --git a/gacela.lisp b/gacela.lisp index a7045ce..31fe8ab 100644 --- a/gacela.lisp +++ b/gacela.lisp @@ -15,16 +15,18 @@ ;;; along with this program. If not, see . -(in-package :gacela :nicknames '(gg)) +(eval-when (compile load) (make-package 'gacela :nicknames '(gg) :use '(lisp))) + +(eval-when (compile load eval) + (when (not (find-package 'gacela)) (make-package 'gacela :nicknames '(gg) :use '(lisp))) + (in-package 'gacela :nicknames '(gg) :use '(lisp))) + ;;; Default values for Gacela (defvar *width-screen* 640) (defvar *height-screen* 480) (defvar *bpp-screen* 32) -(defvar *title-screen* "Happy Hacking!!") (defvar *frames-per-second* 20) -(defvar *transparent-color* '(:red 0 :green 0 :blue 0)) -(defvar *background-color* '(:red 0 :green 0 :blue 0)) ;;; SDL Initialization Subsystem (let (initialized) @@ -38,11 +40,9 @@ ;;; Video Subsystem -(defstruct surface address clip-w clip-h shape) +(let (screen flags (current-width *width-screen*) (current-height *height-screen*) current-bpp) -(let (screen flags) - - (defun init-video-mode (&key (width *width-screen*) (height *height-screen*) (bpp *bpp-screen*)) + (defun init-video-mode (&key (width current-width) (height current-height) (bpp *bpp-screen*)) (cond ((null screen) (init-sdl) (SDL_GL_SetAttribute SDL_GL_DOUBLEBUFFER 1) @@ -51,31 +51,43 @@ (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 current-bpp bpp)) (t t))) - (defun resize-screen (width height bpp) - (setq screen (SDL_SetVideoMode width height bpp flags)) - (resize-screen-GL width height)) + (defun resize-screen (width height &optional (bpp current-bpp)) + (cond (screen (setq screen (SDL_SetVideoMode width height bpp flags)) + (resize-screen-GL width height))) + (setq current-width width current-height 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 apply-mode-change () + (resize-screen-GL current-width current-height)) (defun quit-video-mode () (setq screen nil))) +(defun set-2d-mode () + (cond ((not (3d-mode?)) + (init-video-mode) + (glDisable GL_DEPTH_TEST) + (apply-mode-change)))) + +(defun set-3d-mode () + (cond ((3d-mode?) + (init-video-mode) + (glClearDepth 1) + (glEnable GL_DEPTH_TEST) + (glDepthFunc GL_LEQUAL) + (apply-mode-change)))) + +(defun 3d-mode? () + (eq (getf (get-game-properties) :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,11 +98,11 @@ (glEnable GL_LIGHTING)) (defun resize-screen-GL (width height) - (cond ((3d-mode?) (glViewPort 0 0 width height))) + (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))) + (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) @@ -121,26 +133,12 @@ (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)) (defun init-audio () - (cond ((null audio) (progn (init-sdl) (setq audio (Mix_OpenAudio 22050 2 4096)))) + (cond ((null audio) (progn (init-sdl) (setq audio (Mix_OpenAudio 22050 MIX_DEFAULT_FORMAT 2 4096)))) (t audio))) (defun quit-audio () @@ -204,19 +202,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")))) - - (defun eval-from-skin () - (when (si::listen socket) - (secure-block socket (eval (read socket))))) - - (defun stop-skin-client () - (when socket - (si::close socket) - (setq socket nil)))) +;;; Connection with Gacela Clients +(let (server-socket clients) + (defun start-server (port) + (cond ((null server-socket) (setq server-socket (si::socket port :server #'check-connections))))) + + (defun check-connections () + (cond ((and server-socket (listen server-socket)) (setq clients (cons (si::accept server-socket) clients))))) + + (defun eval-from-clients () + (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-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 @@ -233,10 +246,27 @@ (SDL_Delay (- time-per-frame frame-time))))))) -(defmacro run-game (title &body code) +(let ((ptitle "") (pwidth *width-screen*) (pheight *height-screen*) (pbpp *bpp-screen*) (pfps *frames-per-second*) (pmode '2d)) + (defun set-game-properties (&key title width height bpp fps mode) + (init-video-mode) + (when title (progn (setq ptitle title) (SDL_WM_SetCaption title ""))) + (when (or width height bpp) + (progn + (when width (setq pwidth width)) + (when height (setq pheight height)) + (when bpp (setq pbpp bpp)) + (resize-screen pwidth pheight pbpp))) + (when fps (progn (setq pfps fps) (set-frames-per-second fps))) + (when mode (progn (setq pmode mode) (if (eq mode '3d) (set-3d-mode) (set-2d-mode)))) + (get-game-properties)) + + (defun get-game-properties () + (list :title ptitle :width pwidth :height pheight :bpp pbpp :fps pfps :mode pmode))) + + +(defmacro run-game (&body code) `(let ((game-function (lambda () ,@code))) (init-video-mode) - (SDL_WM_SetCaption ,title "") (set-game-code game-function) (cond ((not (game-running?)) (init-frame-time) @@ -248,12 +278,13 @@ (setq running t) (do () ((quit?)) (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT)) - (glLoadIdentity) + (to-origin) (when (functionp game-code) (funcall game-code)) (SDL_GL_SwapBuffers) (delay-frame) (init-frame-time) - (eval-from-skin) + (check-connections) + (eval-from-clients) (process-events)) (setq running nil)) @@ -265,7 +296,7 @@ (defun quit-game () (free-all-resources) -; (quit-audio) + (quit-audio) (quit-video-mode) (quit-all-mobs) ; (clear-events)