From: jsancho Date: Fri, 9 Dec 2011 19:24:03 +0000 (+0000) Subject: Gacela as Guile modules. X-Git-Url: https://git.jsancho.org/?p=gacela.git;a=commitdiff_plain;h=fd6032e61930e10fc10b41e43acf98674998288a Gacela as Guile modules. --- diff --git a/src/audio.scm b/src/audio.scm index 41207f4..8b1e146 100644 --- a/src/audio.scm +++ b/src/audio.scm @@ -33,5 +33,6 @@ (set! quit-audio (lambda () - (Mix_CloseAudio) - (set! audio #f)))) + (cond (audio + (Mix_CloseAudio) + (set! audio #f)))))) diff --git a/src/events.scm b/src/events.scm new file mode 100644 index 0000000..d1962da --- /dev/null +++ b/src/events.scm @@ -0,0 +1,177 @@ +;;; Gacela, a GNU Guile extension for fast games development +;;; Copyright (C) 2009 by Javier Sancho Fernandez +;;; +;;; 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 . + + +(define-module (gacela events) + #:use-module (gacela sdl) + #:export (process-events + quit? + key? + key-pressed? + key-released?)) + + +(define (get-event events types) + (cond ((null? events) '()) + (else + (let ((res (get-event (cdr events) types)) + (event (car events))) + (cond ((member (assoc-ref event 'type) types) (cons event res)) + (else res)))))) + +(define (poll-events) + (let ((event (SDL_PollEvent))) + (cond ((null? event) '()) + (else (cons event (poll-events)))))) + +(define (process-events) + (let ((events (poll-events))) + (quit! (not (null? (get-event events `(,SDL_QUIT))))) + (clear-key-state) + (process-keyboard-events (get-event events `(,SDL_KEYDOWN ,SDL_KEYUP))))) + +(define quit? #f) +(define quit! #f) + +(let ((quit #f)) + (set! quit? + (lambda () + quit)) + + (set! quit! + (lambda (value) + (set! quit value)))) + +(define (process-keyboard-events events) + (cond ((not (null? events)) + (let ((event (car events))) + (cond ((= (assoc-ref event 'type) SDL_KEYDOWN) (key-press (assoc-ref event 'key.keysym.sym))) + ((= (assoc-ref event 'type) SDL_KEYUP) (key-release (assoc-ref event 'key.keysym.sym))))) + (process-keyboard-events (cdr events))))) + +(define key? #f) +(define key-pressed? #f) +(define key-released? #f) +(define key-press #f) +(define key-release #f) +(define clear-keymap #f) +(define clear-key-state #f) + +(let ((keymap (make-hash-table)) + (pressed (make-hash-table)) + (released (make-hash-table))) + (set! key? + (lambda (key) + (hash-ref keymap (get-keycode key)))) + + (set! key-pressed? + (lambda (key) + (hash-ref pressed (get-keycode key)))) + + (set! key-released? + (lambda (key) + (hash-ref released (get-keycode key)))) + + (set! key-press + (lambda (key-code) + (hash-set! keymap key-code #t) + (hash-set! pressed key-code #t) + (hash-set! released key-code #f))) + + (set! key-release + (lambda (key-code) + (hash-set! keymap key-code #f) + (hash-set! pressed key-code #f) + (hash-set! released key-code #t))) + + (set! clear-keymap + (lambda () + (hash-clear! keymap))) + + (set! clear-key-state + (lambda () + (hash-clear! pressed) + (hash-clear! released)))) + +(define get-keycode #f) +(define get-keyname #f) + +(let* ((keys + '((8 . backspace) + (9 . tab) + (12 . clear) + (13 . return) + (19 . pause) + (27 . escape) + (32 . space) + (33 . exclaim) + (34 . quotedbl) + (35 . hash) + (36 . dollar) + (38 . ampersand) + (39 . quote) + (40 . leftparen) + (41 . rightparen) + (42 . asterisk) + (43 . plus) + (44 . comma) + (45 . minus) + (46 . period) + (47 . slash) + (48 . 0) + (49 . 1) + (50 . 2) + (51 . 3) + (52 . 4) + (53 . 5) + (54 . 6) + (55 . 7) + (56 . 8) + (57 . 9) + (58 . colon) + (59 . semicolon) + (60 . less) + (61 . equals) + (62 . greater) + (63 . question) + (64 . at) + (269 . kp-minus) + (270 . kp-plus) + (273 . up) + (274 . down) + (275 . right) + (276 . left) + (282 . f1) + (283 . f2) + (284 . f3) + (285 . f4) + (286 . f5) + (287 . f6) + (288 . f7) + (289 . f8) + (290 . f9) + (291 . f10) + (292 . f11) + (293 . f12))) + (keynames (map (lambda (k) (cons (cdr k) (car k))) keys))) + + (set! get-keycode + (lambda (keyname) + (assoc-ref keynames keyname))) + + (set! get-keyname + (lambda (keycode) + (assoc-ref keys keycode)))) diff --git a/src/gacela.scm b/src/gacela.scm index a45337a..52b0442 100644 --- a/src/gacela.scm +++ b/src/gacela.scm @@ -15,6 +15,14 @@ ;;; along with this program. If not, see . +(define-module (gacela gacela) + #:use-module (gacela events) + #:use-module (gacela video) + #:use-module (gacela audio) + #:use-module (ice-9 optargs) + #:export ()) + + ;;; Default values for Gacela (define *title* "Gacela") @@ -41,6 +49,10 @@ (lambda (key res) (hash-set! resources-cache key res)))) +(define-macro (use-cache-with-procedure proc-name) + `(begin + (define ,(string->symbol (string-concatenate (list (symbol->string proc-name) "-without-cache"))) ,proc-name))) + ;;; GaCeLa Functions diff --git a/src/gacela_events.scm b/src/gacela_events.scm deleted file mode 100644 index 56099b3..0000000 --- a/src/gacela_events.scm +++ /dev/null @@ -1,168 +0,0 @@ -;;; Gacela, a GNU Guile extension for fast games development -;;; Copyright (C) 2009 by Javier Sancho Fernandez -;;; -;;; 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 . - - -(define (get-event events types) - (cond ((null? events) '()) - (else - (let ((res (get-event (cdr events) types)) - (event (car events))) - (cond ((member (assoc-ref event 'type) types) (cons event res)) - (else res)))))) - -(define (poll-events) - (let ((event (SDL_PollEvent))) - (cond ((null? event) '()) - (else (cons event (poll-events)))))) - -(define (process-events) - (let ((events (poll-events))) - (quit! (not (null? (get-event events `(,SDL_QUIT))))) - (clear-key-state) - (process-keyboard-events (get-event events `(,SDL_KEYDOWN ,SDL_KEYUP))))) - -(define quit? #f) -(define quit! #f) - -(let ((quit #f)) - (set! quit? - (lambda () - quit)) - - (set! quit! - (lambda (value) - (set! quit value)))) - -(define (process-keyboard-events events) - (cond ((not (null? events)) - (let ((event (car events))) - (cond ((= (assoc-ref event 'type) SDL_KEYDOWN) (key-press (assoc-ref event 'key.keysym.sym))) - ((= (assoc-ref event 'type) SDL_KEYUP) (key-release (assoc-ref event 'key.keysym.sym))))) - (process-keyboard-events (cdr events))))) - -(define key? #f) -(define key-pressed? #f) -(define key-released? #f) -(define key-press #f) -(define key-release #f) -(define clear-keymap #f) -(define clear-key-state #f) - -(let ((keymap (make-hash-table)) - (pressed (make-hash-table)) - (released (make-hash-table))) - (set! key? - (lambda (key) - (hash-ref keymap (get-keycode key)))) - - (set! key-pressed? - (lambda (key) - (hash-ref pressed (get-keycode key)))) - - (set! key-released? - (lambda (key) - (hash-ref released (get-keycode key)))) - - (set! key-press - (lambda (key-code) - (hash-set! keymap key-code #t) - (hash-set! pressed key-code #t) - (hash-set! released key-code #f))) - - (set! key-release - (lambda (key-code) - (hash-set! keymap key-code #f) - (hash-set! pressed key-code #f) - (hash-set! released key-code #t))) - - (set! clear-keymap - (lambda () - (hash-clear! keymap))) - - (set! clear-key-state - (lambda () - (hash-clear! pressed) - (hash-clear! released)))) - -(define get-keycode #f) -(define get-keyname #f) - -(let* ((keys - '((8 . backspace) - (9 . tab) - (12 . clear) - (13 . return) - (19 . pause) - (27 . escape) - (32 . space) - (33 . exclaim) - (34 . quotedbl) - (35 . hash) - (36 . dollar) - (38 . ampersand) - (39 . quote) - (40 . leftparen) - (41 . rightparen) - (42 . asterisk) - (43 . plus) - (44 . comma) - (45 . minus) - (46 . period) - (47 . slash) - (48 . 0) - (49 . 1) - (50 . 2) - (51 . 3) - (52 . 4) - (53 . 5) - (54 . 6) - (55 . 7) - (56 . 8) - (57 . 9) - (58 . colon) - (59 . semicolon) - (60 . less) - (61 . equals) - (62 . greater) - (63 . question) - (64 . at) - (269 . kp-minus) - (270 . kp-plus) - (273 . up) - (274 . down) - (275 . right) - (276 . left) - (282 . f1) - (283 . f2) - (284 . f3) - (285 . f4) - (286 . f5) - (287 . f6) - (288 . f7) - (289 . f8) - (290 . f9) - (291 . f10) - (292 . f11) - (293 . f12))) - (keynames (map (lambda (k) (cons (cdr k) (car k))) keys))) - - (set! get-keycode - (lambda (keyname) - (assoc-ref keynames keyname))) - - (set! get-keyname - (lambda (keycode) - (assoc-ref keys keycode)))) diff --git a/src/gacela_loader.scm b/src/gacela_loader.scm deleted file mode 100644 index 23b0951..0000000 --- a/src/gacela_loader.scm +++ /dev/null @@ -1,25 +0,0 @@ -;;; Gacela, a GNU Guile extension for fast games development -;;; Copyright (C) 2009 by Javier Sancho Fernandez -;;; -;;; 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 . - - -(primitive-load-path "gacela.scm") -(primitive-load-path "gacela_events.scm") -(primitive-load-path "gacela_draw.scm") -(primitive-load-path "gacela_ttf.scm") -(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/video.scm b/src/video.scm index 92d1ca8..fbd98b7 100644 --- a/src/video.scm +++ b/src/video.scm @@ -98,9 +98,10 @@ (set! quit-video (lambda () - (SDL_FreeSurface screen) - (set! screen #f) - (SDL_Quit)))) + (cond (screen + (SDL_FreeSurface screen) + (set! screen #f) + (SDL_Quit)))))) (define (clear-screen) (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT)))