[gsharp-cvs] CVS update: gsharp/sdl.lisp gsharp/gf.lisp

[Robert Strandh]

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*))))