[gsharp-cvs] CVS gsharp
rstrandh
rstrandh at common-lisp.net
Thu Jun 8 18:54:47 UTC 2006
Update of /project/gsharp/cvsroot/gsharp
In directory clnet:/tmp/cvs-serv13576
Modified Files:
score-pane.lisp
Log Message:
Removed code that is no longer necessary because of the new font-rendering
system.
The class `score-pane' should probably be moved to gui.lisp, and the
:score-pane package and the score-pane.lisp file should probably be
renamed. Alternatively, the code could be moved elsewhere.
--- /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/06/07 22:40:26 1.34
+++ /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/06/08 18:54:47 1.35
@@ -2,29 +2,15 @@
(defclass score-view (view) ())
-(defclass score-pane (esa-pane-mixin application-pane)
- ((darker-gray-progressions :initform (make-array 10 :initial-element nil :adjustable t)
- :reader darker-gray-progressions)
- (lighter-gray-progressions :initform (make-array 10 :initial-element nil :adjustable t)
- :reader lighter-gray-progressions)))
+(defclass score-pane (esa-pane-mixin application-pane) ())
(defmethod initialize-instance :after ((pane score-pane) &rest args)
(declare (ignore args))
(setf (stream-default-view pane) (make-instance 'score-view)))
-(defparameter *light-glyph* nil)
(defparameter *font* nil)
(defparameter *fonts* (make-array 100 :initial-element nil))
-;;; Map integer levels of white, represented by the number of white pixels in
-;;; a 4x4 pixel grid, to CLIM inks.
-(defparameter *gray-levels*
- (loop with result = (make-array '(17))
- for i from 0 to 16 do
- (setf (aref result i) (make-gray-color (/ i 16)))
- finally (return result)))
-
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; output recording
@@ -384,89 +370,6 @@
(multiple-value-bind (down up) (beam-offsets *font*)
(draw-rectangle* medium x1 (+ y up) x2 (+ y down))))
-(defvar *darker-gray-progressions*)
-(defvar *lighter-gray-progressions*)
-
-;;; don't delete this yet, since I don't know how the other one will work out.
-;; (defun ensure-gray-progressions (index)
-;; (unless (aref *darker-gray-progressions* index)
-;; (setf (aref *darker-gray-progressions* index)
-;; (with-output-to-pixmap (medium *pane* :height 1 :width index)
-;; (loop for i from 0 below index
-;; for gray-level from 16 by (- (/ 16 index)) do
-;; (draw-point* medium i 0 :ink (aref *gray-levels* (ceiling gray-level)))))))
-;; (unless (aref *lighter-gray-progressions* index)
-;; (setf (aref *lighter-gray-progressions* index)
-;; (with-output-to-pixmap (medium *pane* :height 1 :width index)
-;; (loop for i from 0 below index
-;; for gray-level from 0 by (/ 16 index) do
-;; (draw-point* medium i 0 :ink (aref *gray-levels* (floor gray-level))))))))
-
-;;; this version should be faster for long beam segments. It is also
-;;; more correct in its colors, but the visual impession is no better.
-(defun ensure-gray-progressions (pane-medium index)
- (when (< (length *darker-gray-progressions*) (1+ index))
- (adjust-array *darker-gray-progressions* (1+ index) :initial-element nil))
- (unless (aref *darker-gray-progressions* index)
- (setf (aref *darker-gray-progressions* index)
- (with-output-to-pixmap (medium (medium-sheet pane-medium) :height 1 :width index)
- ;; start by filling it with black
- (draw-rectangle* medium 0 0 index 1 :ink (aref *gray-levels* 0))
- (loop for start = 0 then end
- for end from (- (/ index 32) 1/2) by (/ index 16)
- for gray-level from 16 above 0
- do (unless (= start end)
- (draw-rectangle* medium start 0 end 1
- :ink (aref *gray-levels* gray-level)))))))
- (when (< (length *lighter-gray-progressions*) (1+ index))
- (adjust-array *lighter-gray-progressions* (1+ index) :initial-element nil))
- (unless (aref *lighter-gray-progressions* index)
- (setf (aref *lighter-gray-progressions* index)
- (with-output-to-pixmap (medium (medium-sheet pane-medium) :height 1 :width index)
- ;; start by filling it with white
- (draw-rectangle* medium 0 0 index 1 :ink (aref *gray-levels* 16))
- (loop for start = 0 then end
- for end from (- (/ index 32) 1/2) by (/ index 16)
- for gray-level from 0 below 16
- do (unless (= start end)
- (draw-rectangle* medium start 0 end 1
- :ink (aref *gray-levels* gray-level))))))))
-
-(defun draw-segment (medium x1 y x2 thickness progression1 progression2)
- ;; make it a bit thicker to cover either the upper or the lower pixmap
- (let ((extra (if *light-glyph* (- x2 x1) 0)))
- (medium-draw-rectangle* medium x1 y x2 (- y thickness) t)
- (ensure-gray-progressions medium (+ extra (- x2 x1)))
- (copy-from-pixmap (aref progression1 (+ extra (- x2 x1)))
- (if (eq progression1 *lighter-gray-progressions*) extra 0)
- 0
- (- x2 x1) 1
- medium x1 y)
- (copy-from-pixmap (aref progression2 (+ extra (- x2 x1)))
- (if (eq progression2 *lighter-gray-progressions*) extra 0)
- 0
- (- x2 x1) 1
- medium x1 (- y thickness))))
-
-(defun draw-downward-beam-segment (medium x1 y x2 thickness)
- (draw-segment medium x1 (1+ y) x2 thickness
- *darker-gray-progressions* *lighter-gray-progressions*))
-
-(defun draw-upward-beam-segment (medium x1 y x2 thickness)
- (draw-segment medium x1 y x2 thickness
- *lighter-gray-progressions* *darker-gray-progressions*))
-
-(defun draw-downward-beam (medium x1 y1 y2 thickness inverse-slope)
- (loop for y from y1 below y2
- for x from x1 by inverse-slope do
- (draw-downward-beam-segment medium (round x) y
- (round (+ x inverse-slope)) thickness)))
-
-(defun draw-upward-beam (medium x1 y1 y2 thickness inverse-slope)
- (loop for y from y1 above y2
- for x from x1 by inverse-slope do
- (draw-upward-beam-segment medium (round x) y
- (round (+ x inverse-slope)) thickness)))
(defclass downward-beam-output-record (beam-output-record)
())
@@ -671,12 +574,9 @@
, at body))
(defmacro with-score-pane (pane &body body)
- (let ((n-pane (gensym "PANE")))
- `(let* ((,n-pane ,pane)
- (*lighter-gray-progressions* (lighter-gray-progressions ,n-pane))
- (*darker-gray-progressions* (darker-gray-progressions ,n-pane)))
- (clear-output-record (stream-output-history pane))
- , at body)))
+ `(progn
+ (clear-output-record (stream-output-history ,pane))
+ , at body))
(defmacro with-vertical-score-position ((pane yref) &body body)
`(with-translation (,pane 0 ,yref)
@@ -692,6 +592,5 @@
, at body))))
(defmacro with-light-glyphs (pane &body body)
- `(let ((*light-glyph* t))
- (with-drawing-options (,pane :ink +gray50+)
- , at body)))
+ `(with-drawing-options (,pane :ink +gray50+)
+ , at body))
More information about the Gsharp-cvs
mailing list