;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-(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)
;;; Video Subsystem
-(let (screen flags current-width current-height)
+(let (screen flags (current-width *width-screen*) (current-height *height-screen*) current-bpp)
- (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)
(setq screen (SDL_SetVideoMode width height bpp flags))
(init-GL)
(resize-screen-GL width height)
- (setq current-width width current-height 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 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 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 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 ()
(glShadeModel GL_SMOOTH)
(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 ()
(defun make-resource-font (&key filename encoding)
`(:type font :filename ,filename :enconding ,encoding))
+(defun make-resource-sound (&key filename)
+ `(:type sound :filename ,filename))
+
+(defun make-resource-music (&key filename)
+ `(:type music :filename ,filename))
+
(defmacro get-rtime (key)
`(resource-time (gethash ,key resources-table)))
(maphash (lambda (key res) (free-resource key)) resources-table)))
-;;; Connection with Gacela Skin Clients
+;;; Connection with Gacela 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 start-server (port)
+ (cond ((null server-socket) (setq server-socket (si::socket port :server #'check-connections)))))
- (defun check-skin-connections ()
+ (defun check-connections ()
(cond ((and server-socket (listen server-socket)) (setq clients (cons (si::accept server-socket) clients)))))
- (defun eval-from-skin ()
+ (defun eval-from-clients ()
(labels ((eval-clients (cli-socks)
(cond (cli-socks
(let ((cli (car cli-socks)))
(cons cli (eval-clients (cdr cli-socks))))))))))
(setq clients (eval-clients clients))))
- (defun stop-skin-server ()
+ (defun stop-server ()
(cond (server-socket (si::close server-socket) (setq server-socket nil)))
(cond (clients
(labels ((close-clients (cli-socks)
(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)
- (process-events)
(game-loop)))))
(let (running game-code)
(defun game-loop ()
(setq running t)
(do () ((quit?))
- (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
- (glLoadIdentity)
-;(gluLookAt 0 0 50 0 0 0 0 1 0)
- (when (functionp game-code) (funcall game-code))
- (SDL_GL_SwapBuffers)
- (delay-frame)
(init-frame-time)
- (check-skin-connections)
- (eval-from-skin)
- (process-events))
+ (check-connections)
+ (eval-from-clients)
+ (process-events)
+ (cond ((not (quit?))
+ (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
+ (to-origin)
+ (refresh-active-objects)
+ (when (functionp game-code) (funcall game-code))
+ (render-objects)
+ (SDL_GL_SwapBuffers)
+ (delay-frame))))
(setq running nil))
(defun game-running? ()
(defun quit-game ()
(free-all-resources)
-; (quit-audio)
+ (quit-audio)
(quit-video-mode)
- (quit-all-mobs)
+; (quit-all-mobs)
+ (kill-all-objects)
; (clear-events)
; (quit-events)
(quit-sdl))
projects / gacela.git / blobdiff