diff --git a/scsh/scgame/scgame.scm b/scsh/scgame/scgame.scm index 48ce3f0..331d7dd 100644 --- a/scsh/scgame/scgame.scm +++ b/scsh/scgame/scgame.scm @@ -1,4 +1,4 @@ -;;; scgame.scm - a scheme game library (needs a scx-0.2) +;;; scgame.scm - a scheme game library (needs a scx-0.2 or scheme48-fb) ;;; ;;; Copyright (c) 2011-2012 Johan Ceuppens ;;; @@ -48,6 +48,7 @@ (make-gc-value-alist (background (string->color 'White) (foreground (string->Color colorname))))))) (draw-point dpy win gc (inexact->exact x) (inexact->exact y)))) + (define (putpixel x y foregroundcolorname backgroundcolorname) (let ((gc (create-gc dpy win (make-gc-value-alist (background (string->color backgroundcolorname) diff --git a/scsh/scgame/scgamedictionaries.scm b/scsh/scgame/scgamedictionaries.scm index 6d28896..92d334c 100644 --- a/scsh/scgame/scgamedictionaries.scm +++ b/scsh/scgame/scgamedictionaries.scm @@ -27,6 +27,12 @@ ;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;; Dictionary ADT with ref,set!,add!,make public methods at the end +(load "scgameutil.scm") + +;; Usage : +;; (define d (make-color-dictionary 1024)) +;; (dictionary-ref d 'Navy) ;; returns "000080" + (define (make-dictionary1) ;; methods are FIFO (first fixed first out) (let ((*dict '())) @@ -34,8 +40,20 @@ (define (get key) ;; get key (do ((l *dict (cdr l))) ((eq? key (caar l)) - (cadr l));;returns value + (cadar l));;returns value )) + + (define (get-substring key) ;; get key + (do ((l *dict (cdr l))) + ((string<=? (if (symbol? key) + (symbol->string key) + (if (string? key) + key + (display "dictionary-get-substring : unknown key type"))) + (symbol->string (caar l))) + (cadr l));;returns value + )) + (define (add key value) (set! *dict (append *dict (list (list key value))))) @@ -43,20 +61,23 @@ (do ((l *dict (cdr l)) (res '() (append (list (car l) res)))) ((eq? key (caar l)) - (set! (cadr res) value) + (set-car! (cdr res) value) (set! *dict (append res (cdr l)))) )) (lambda (msg) (cond ((eq? msg 'get) get) + ((eq? msg 'get-substring) get-substring) ((eq? msg 'set) set) ((eq? msg 'add) add) (else (aspecterror)(display "make-dictionary")))) )) -(define (make-dictionary) (make-dictionary1)) +(define make-dictionary make-dictionary1) (define (dictionary-ref dict key) ((dict 'get) key)) +;; NOTE: dictionary-ref-substring: match key part with keys in dict +(define (dictionary-ref-substring dict key) ((dict 'get-substring) key)) (define (dictionary-set! dict key value) ((dict 'set) key value)) (define (dictionary-add! dict key value) ((dict 'add) key value)) @@ -272,5 +293,4 @@ (dictionary-add! dict 'Ivory "FFFFF0") (dictionary-add! dict 'White "FFFFFF") )) - - )) + dict)) diff --git a/scsh/scgame/scgameutil.scm b/scsh/scgame/scgameutil.scm index 26a54f6..aee66f0 100644 --- a/scsh/scgame/scgameutil.scm +++ b/scsh/scgame/scgameutil.scm @@ -43,8 +43,9 @@ (define (substring? needle haystack j) ;; (define (max? s1 s2 j) - (if (and (string? haystack)(string? needle)) - (let ((hs (string-cat haystack j))) - ((string>=? needle hs) hs)) - #f)) - + (if (and (string? haystack)(string? needle)) + (let ((hs (string-cat haystack j))) + (if (string<=? needle hs) + hs + #f)) + #f)) diff --git a/scsh/scgame/scgamewidgets.scm b/scsh/scgame/scgamewidgets.scm index 52a41c1..3adc0b7 100644 --- a/scsh/scgame/scgamewidgets.scm +++ b/scsh/scgame/scgamewidgets.scm @@ -1,4 +1,4 @@ -;;; scgamewidgets.scm - a scheme game library (needs scx-0.2) +;;; scgamewidgets.scm - a scheme game library (needs scx-0.2 or scheme48-fb) ;;; ;;; Copyright (c) 2011-2012 Johan Ceuppens ;;;