[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