From 27179013416a932dde712630de0f167aef467b4a Mon Sep 17 00:00:00 2001 From: Johan Ceuppens Date: Mon, 16 Jan 2012 23:38:15 +0000 Subject: [PATCH] *** empty log message *** --- scsh/scgame/config.scm | 29 +++++++++++++++++++++++++++++ scsh/scgame/pkg-def.scm | 1 + scsh/scgame/scgame.scm | 29 +++++++++++++++++++---------- scsh/scgame/scgameutil.scm | 5 ++++- scsh/scgame/scgamewidgets.scm | 2 +- 5 files changed, 54 insertions(+), 12 deletions(-) create mode 100644 scsh/scgame/config.scm diff --git a/scsh/scgame/config.scm b/scsh/scgame/config.scm new file mode 100644 index 0000000..1dfdb3e --- /dev/null +++ b/scsh/scgame/config.scm @@ -0,0 +1,29 @@ +;;; config.scm - a scheme game library (needs a scx-0.2 or scheme48-fb) +;;; +;;; Copyright (c) 2011-2012 Johan Ceuppens +;;; +;;; All rights reserved. +;;; +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution. +;;; 3. The name of the authors may not be used to endorse or promote products +;;; derived from this software without specific prior written permission. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +;;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +;;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +;;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, +;;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +;;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(define SCGAMEDEBUG #t) \ No newline at end of file diff --git a/scsh/scgame/pkg-def.scm b/scsh/scgame/pkg-def.scm index a562ebb..ccaad72 100644 --- a/scsh/scgame/pkg-def.scm +++ b/scsh/scgame/pkg-def.scm @@ -9,6 +9,7 @@ (install-file "NEWS" 'doc) (install-string (COPYING) "COPYING" 'doc) (install-file "packages.scm" 'scheme) + (install-file "config.scm" 'scheme) (install-file "scgamedictionaries.scm" 'scheme) (install-file "scgameutil.scm" 'scheme) (install-file "scgamewidgets.scm" 'scheme) diff --git a/scsh/scgame/scgame.scm b/scsh/scgame/scgame.scm index 331d7dd..aa71f25 100644 --- a/scsh/scgame/scgame.scm +++ b/scsh/scgame/scgame.scm @@ -42,6 +42,13 @@ ;; interface 2 (define (coolness? x) (not (null? x))) ;; coolness +;; debugging vars + +(load "config.scm") +(define (display-msg msg) + (if SCGAMEDEBUG + (for-each display (list (aspectmsg) " " msg)))) + ;; override for scx-0.2 (define (putpixel x y colorname) (let ((gc (create-gc dpy win @@ -59,7 +66,7 @@ (define (make-scdraw2) (define (draw-line x0 y0 x1 y1 . w) ;; FIXME w == line width (let ((width (if (coolness? w)(if (number? (car w)) (car w) 1)))) - ;;(display "drawing line...") + (display-msg "drawing line...") ;;This should be optimized Bresenham (let ((steep (> (abs (- y1 y0)) (abs (- x1 x0)))) @@ -75,7 +82,7 @@ (do ((i y (+ i 1))) ((= y x) l) (set! l (append l (list i))))) - (else (display "range : x == y") + (else (display-msg "range : x == y") x))))) ) (if steep @@ -102,7 +109,7 @@ )))))))) (define (draw-lines l1 . w) - ;;(display "drawing lines...") + (display-msg "drawing lines...") (for-each draw-line l1) ) @@ -114,7 +121,7 @@ ;; color table out of xpm pre -(define (make-color-table) +(define (make-xpm-color-table) (let ((dict (make-dictionary))) (define (add! key color) (dictionary-add! dict key color)) @@ -139,7 +146,7 @@ (define (load-xpm-image filename) (let ((in (open-input-file filename)) (colorcharsdictionary (make-color-dictionary 8)) ;; - (colorcharstable (make-color-table)) + (colorcharstable (make-xpm-color-table)) ) (do ((str (read in) (read in))) ((string<=? "{" str)#t)) @@ -167,17 +174,19 @@ (define (load-image filename) ;; FIXME read in xpm or png - (display "loading image...") + (display-msg "loading image...") (cond ((string<=? ".xpm" filename) - (load-xpm-image filename) + (display-msg "loading xpm suffixed file..") + (load-xpm-image-scx filename) ) + (else #f))) (lambda (msg) - (cond ((eq? msg 'load-image)load-image) - (else (aspecterror)(display "scimage2")))) - )) + (cond ((eq? msg 'load-image) load-image) + (else (aspecterror)(display "scimage2")))))) ;; Give a #t as arg and have a nice interface + (define (make-scgame . tm) (cond ((not (null? tm) (let ((*scdraw (make-scdraw1)) diff --git a/scsh/scgame/scgameutil.scm b/scsh/scgame/scgameutil.scm index aee66f0..39045b2 100644 --- a/scsh/scgame/scgameutil.scm +++ b/scsh/scgame/scgameutil.scm @@ -29,7 +29,10 @@ ;; aspect-oriented features (define (aspecterror) - (display "Message not understood.")) + (display "::error:: Message not understood.")) + +(define (aspectmsg) + (display "::message:: ")) ;; FIX : use scsh regexp instead of these following 2 functions diff --git a/scsh/scgame/scgamewidgets.scm b/scsh/scgame/scgamewidgets.scm index 3adc0b7..cadd4a0 100644 --- a/scsh/scgame/scgamewidgets.scm +++ b/scsh/scgame/scgamewidgets.scm @@ -26,7 +26,7 @@ ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF ;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -(load "scgameutil.scm") +(load "scgame.scm") (define (make-scgamewidget) (lambda (msg)