Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv30061 Modified Files: sdl.lisp gf.lisp Log Message: Make it possible for the gf file loader to handle fonts with more than 256 characters. Date: Fri Mar 26 09:24:11 2004 Author: rstrandh Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.3 gsharp/sdl.lisp:1.4 --- gsharp/sdl.lisp:1.3 Thu Feb 19 00:57:22 2004 +++ gsharp/sdl.lisp Fri Mar 26 09:24:11 2004 @@ -168,9 +168,9 @@ *fonts-directory*))) (maxchar (reduce #'max (gf-font-chars gf-font) :key #'gf-char-no)) (glyphs (make-array (list (1+ maxchar)) :initial-element nil))) - (loop for char in (gf-font-chars gf-font) do - (setf (aref glyphs (gf-char-no char)) - (make-instance 'glyph :gf-char char))) + (loop for char in (gf-font-chars gf-font) + do (setf (aref glyphs (gf-char-no char)) + (make-instance 'glyph :gf-char char))) (make-instance 'font :staff-line-distance staff-line-distance :gf-font gf-font Index: gsharp/gf.lisp diff -u gsharp/gf.lisp:1.1.1.1 gsharp/gf.lisp:1.2 --- gsharp/gf.lisp:1.1.1.1 Mon Feb 16 10:46:11 2004 +++ gsharp/gf.lisp Fri Mar 26 09:24:11 2004 @@ -78,9 +78,10 @@ (paint-command d)) (defun boc-command (char-no prev-char min-m max-m min-n max-n) - (declare (ignore prev-char)) (push (make-instance 'gf-char - :char-no char-no + :char-no (if (= prev-char -1) + char-no + (+ 256 (gf-char-no (find char-no *chars* :key #'gf-char-no)))) :min-m min-m :max-m max-m :min-n min-n :max-n max-n) *chars*) (setf *current-matrix* (make-array `(,(1+ (- max-n min-n)) ,(1+ (- max-m min-m))) @@ -178,10 +179,10 @@ (defun parse-gf-stream (*gf-stream*) (let ((*current-font* nil) (*chars* '())) - (loop for command-code = (u1) then (u1) do - (cond ((<= command-code 63) (paint-command command-code)) - ((<= 74 command-code 238) (new-row-command command-code)) - (t (funcall (aref *commands* command-code)))) + (loop for command-code = (u1) then (u1) + do (cond ((<= command-code 63) (paint-command command-code)) + ((<= 74 command-code 238) (new-row-command command-code)) + (t (funcall (aref *commands* command-code)))) until (= command-code 249) finally (return *current-font*))))