[gsharp-cvs] CVS gsharp

rstrandh rstrandh at common-lisp.net
Mon Jun 5 00:53:41 UTC 2006


Update of /project/gsharp/cvsroot/gsharp
In directory clnet:/tmp/cvs-serv8356

Modified Files:
	gsharp.asd packages.lisp score-pane.lisp sdl.lisp 
Removed Files:
	gf.lisp 
Log Message:
Removed references to old font system, including the file gf.lisp.


--- /project/gsharp/cvsroot/gsharp/gsharp.asd	2006/06/05 00:26:18	1.11
+++ /project/gsharp/cvsroot/gsharp/gsharp.asd	2006/06/05 00:53:40	1.12
@@ -23,7 +23,6 @@
 (gsharp-defsystem (:gsharp :depends-on (:mcclim :flexichain :esa))
    "packages"
    "utilities"
-   "gf"
    "bezier"
    "mf"
    "sdl"
--- /project/gsharp/cvsroot/gsharp/packages.lisp	2006/06/05 00:26:18	1.53
+++ /project/gsharp/cvsroot/gsharp/packages.lisp	2006/06/05 00:53:40	1.54
@@ -4,15 +4,6 @@
   (:export #:ninsert-element #:define-added-mixin
 	   #:unicode-to-char #:char-to-unicode))
 
-(defpackage :gf
-  (:use :common-lisp)
-  (:export #:parse-gf-file #:gf-font-comment #:gf-font-chars #:gf-font-design-size
-	   #:gf-font-checksum #:gf-font-horizontal-ratio #:gf-font-vertical-ratio
-	   #:gf-font-min-column #:gf-font-max-column 
-	   #:gf-font-min-row #:gf-font-max-row 
-	   #:gf-char-no #:gf-char-min-m #:gf-char-max-m
-	   #:gf-char-min-n #:gf-char-max-n #:gf-char-matrix))
-	   
 (defpackage :mf
   (:use :cl)
   (:export #:make-bezier-segment #:bezier-segment
@@ -34,12 +25,12 @@
 	   #:left #:right #:up #:down))
 
 (defpackage :sdl
-  (:use :common-lisp :gf :mf)
+  (:use :common-lisp :mf)
   (:export #:glyph #:staff-line-distance #:staff-line-offsets
 	   #:stem-offsets #:bar-line-offsets
 	   #:ledger-line-x-offsets #:ledger-line-y-offsets
 	   #:notehead-right-offsets #:notehead-left-offsets
-	   #:load-font #:glyph-offsets #:suspended-note-offset
+	   #:make-font #:glyph-offsets #:suspended-note-offset
 	   #:beam-offsets #:beam-hang-sit-offset))
 
 (defpackage :score-pane
--- /project/gsharp/cvsroot/gsharp/score-pane.lisp	2006/06/05 00:26:18	1.28
+++ /project/gsharp/cvsroot/gsharp/score-pane.lisp	2006/06/05 00:53:41	1.29
@@ -155,38 +155,6 @@
 (defun staff-step (n)
   (* n (/ (staff-line-distance *font*) 2)))
 
-;;; Given a pane, a glyph number, an x position (measured in pixels)
-;;; and a y position (measured in staff steps), draw the glyph
-;;; at the position in the pane. 
-;;; The font is organized so that the normal glyph is immediately
-;;; followed by a light version of the glyph.  Hence, we add 1
-;;; to the glyph number if a light version is desired. 
-;;; It appears that the resulting y-coordinate (in pixels) has the 
-;;; same sign as the staff-step argument, which suggests that this
-;;; function must be called with a negated staff-step.  It might be
-;;; better to have this function do the negation. 
-(defun draw-antialiased-glyph (pane glyph-no x staff-step)
-  (let* ((extra (if *light-glyph* 1 0))
-	 (matrix (glyph *font* (+ glyph-no extra)))
-	 (pixmap (pane-pixmap pane matrix)))
-    (multiple-value-bind (dx dy) (glyph-offsets *font* (+ glyph-no extra))
-      (let ((x1 (+ x dx))
-	    (y1 (- dy (staff-step staff-step))))
-	(draw-pixmap* pane pixmap x1 y1)))))
-
-;;;;;;;;;;;;;;;;;; helper macro
-
-;;; This macro is currently not used.  (And probably never will be
-;;; used, now that we raster our own bezier curves.)
-(defmacro define-pixmap-recording ((draw-name args) &body body)
-  `(defun ,draw-name (pane , at args x staff-step)
-     (let* ((extra (if *light-glyph* 1 0))
-	    (glyph-no , at body)
-	    (matrix (glyph *font* (+ glyph-no extra)))
-	    (pixmap (pane-pixmap pane matrix)))
-       (multiple-value-bind (dx dy) (glyph-offsets *font* (+ glyph-no extra))
-	 (draw-pixmap* pane pixmap (+ x dx) (- dy (staff-step staff-step)))))))
-
 ;;;;;;;;;;;;;;;;;; notehead
 
 (define-presentation-type notehead () :options (name x staff-step))
@@ -701,7 +669,7 @@
     `(let ((,size-var ,size))
       (unless (aref *fonts* ,size-var)
 	(setf (aref *fonts* ,size-var)
-	      (load-font ,size-var)))
+	      (make-font ,size-var)))
       (let ((*font* (aref *fonts* ,size-var)))
 	, at body))))  
 
--- /project/gsharp/cvsroot/gsharp/sdl.lisp	2006/06/03 22:03:08	1.25
+++ /project/gsharp/cvsroot/gsharp/sdl.lisp	2006/06/05 00:53:41	1.26
@@ -1,16 +1,5 @@
 (in-package :sdl)
 
-(defvar *fonts-directory*
-  (merge-pathnames (make-pathname :directory '(:relative "Fonts"))
-		   (make-pathname :directory (pathname-directory *load-truename*))))
-
-(defgeneric glyph (font glyph-no))
-(defgeneric glyph-offsets (font glyph-no)
-  (:documentation "Return two values, DX and DY to be added to the reference point of
-a glyph in order to obtain its upper-left corner.  If (as is usually the case) 
-the reference point is somewhere inside the bounding box of the glyph, this
-means that both the values returned are negative"))
-
 (defgeneric staff-line-distance (font))
 (defgeneric staff-line-offsets (font))
 (defgeneric stem-offsets (font))
@@ -33,8 +22,7 @@
 		   point of a hanging or sitting beam respectively"))
 
 (defclass font ()
-  ((gf-font :initarg :gf-font :reader gf-font)
-   ;; The distance in pixels between the upper edge of two 
+  (;; The distance in pixels between the upper edge of two 
    ;; adjacent staff lines. 
    (staff-line-distance :initarg :staff-line-distance :reader staff-line-distance)
    ;; An integer value indicating how many non-white pixels are 
@@ -120,8 +108,7 @@
    (beam-offset-down)
    (beam-offset-up)
    (beam-hang-sit-offset :reader beam-hang-sit-offset)
-   (designs :initform (make-hash-table :test #'eq))
-   (glyphs :initarg :glyphs :reader glyphs)))
+   (designs :initform (make-hash-table :test #'eq))))
   
 (defmethod initialize-instance :after ((font font) &rest initargs &key &allow-other-keys)
   (declare (ignore initargs))
@@ -200,53 +187,6 @@
 	  (let ((beam-thickness (- beam-offset-down beam-offset-up)))
 	    (/ (- beam-thickness staff-line-thickness) 2)))))
 
-(defgeneric gf-char (glyph))
-(defgeneric pixmap (glyph))
-(defgeneric (setf pixmap) (glyph pixmap))
-
-(defclass glyph ()
-  ((gf-char :initarg :gf-char :reader gf-char)
-   (x-offset)
-   (y-offset)
-   (pixmap :initform nil :initarg :pixmap :accessor pixmap)))
-
-(defmethod initialize-instance :after ((glyph glyph) &rest initargs &key &allow-other-keys)
-  (declare (ignore initargs))
-  (with-slots (gf-char x-offset y-offset) glyph
-    (setf x-offset (floor (gf-char-min-m gf-char) 4)
-	  ;; adding 1 to gv-char-max-n is necessary because
-	  ;; of a discrepancy between the GF documentation
-	  ;; and the GF file format
-	  y-offset (- (ceiling (1+ (gf-char-max-n gf-char)) 4)))))
-
-(defmethod glyph ((font font) glyph-no)
-  (with-slots (gf-char pixmap) (aref (glyphs font) glyph-no)
-    (let ((left (floor (gf-char-min-m gf-char) 4))
-	  (right (ceiling (1+ (gf-char-max-m gf-char)) 4))
-	  (down (floor (gf-char-min-n gf-char) 4))
-	  ;; adding 1 to gv-char-max-n is necessary because
-	  ;; of a discrepancy between the GF documentation
-	  ;; and the GF file format
-	  (up (ceiling (1+ (gf-char-max-n gf-char)) 4))
-	  (matrix (gf-char-matrix gf-char)))
-      (unless pixmap
-	(setf pixmap (make-array (list (- up down) (- right left))
-					:element-type '(unsigned-byte 8)
-					:initial-element 16))
-	(loop for r from 0 below (car (array-dimensions matrix))
-	      for y downfrom (gf-char-max-n gf-char) by 1 do
-	      (loop for c from 0 below (cadr (array-dimensions matrix))
-		    for x from (gf-char-min-m gf-char) do
-		    (decf (aref pixmap
-				(- up (ceiling (1+ y) 4))
-				(- (floor x 4) left))
-			  (aref matrix r c))))))
-    pixmap))
-
-(defmethod glyph-offsets ((font font) glyph-no)
-  (with-slots (x-offset y-offset) (aref (glyphs font) glyph-no)
-    (values x-offset y-offset)))
-
 ;;; the DOWN staff line offset is a nonnegative integer, and the UP
 ;;; staff line offset is a negative integer.  This way, both of them
 ;;; should be ADDED to a reference y value to obtain the lower and
@@ -294,19 +234,8 @@
   (with-slots (beam-offset-down beam-offset-up) font
     (values beam-offset-down beam-offset-up)))
 
-(defun load-font (staff-line-distance)
-  (let* ((gf-font (parse-gf-file (merge-pathnames
-				  (format nil "sdl~a.gf" staff-line-distance)
-				  *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)))
-    (make-instance 'font
-      :staff-line-distance staff-line-distance
-      :gf-font gf-font
-      :glyphs glyphs)))
+(defun make-font (staff-line-distance)
+  (make-instance 'font :staff-line-distance staff-line-distance))
 
 (defgeneric xyscale (thing kx ky))
 




More information about the Gsharp-cvs mailing list