[gsharp-cvs] CVS gsharp

[rstrandh]

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

Modified Files:
	sdl.lisp 
Log Message:
Introduced a cache for beam segment designs.  This code is not yet
used, but it will be I hope.



--- /project/gsharp/cvsroot/gsharp/sdl.lisp	2006/06/05 18:43:56	1.27
+++ /project/gsharp/cvsroot/gsharp/sdl.lisp	2006/06/06 20:52:32	1.28
@@ -108,7 +108,8 @@
    (beam-offset-down)
    (beam-offset-up)
    (beam-hang-sit-offset :reader beam-hang-sit-offset)
-   (designs :initform (make-hash-table :test #'eq))))
+   (designs :initform (make-hash-table :test #'eq))
+   (beam-designs :initform (make-hash-table :test #'eql))))
   
 (defmethod initialize-instance :after ((font font) &rest initargs &key &allow-other-keys)
   (declare (ignore initargs))
@@ -295,6 +296,25 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
+;;; Beams
+
+(defun ensure-beam-segment-design (font direction width)
+  (with-slots ((sld staff-line-distance)) font
+    (let* ((key (* (if (eq direction :down) 1 -1) width))
+	   (thickness (/ sld 2)))
+      (or (gethash key (slot-value font 'beam-designs))
+	  (setf (gethash width (slot-value font 'beam-designs))
+		(climi::close-path 
+		 (if (eq direction :down)
+		     (mf #c(0 0) -- (complex width 1) --
+			 (complex width (+ thickness 1)) --
+			 (complex 0 thickness) -- #c(0 0))
+		     (mf #c(0 0) -- (complex width -1) --
+			 (complex width (- (- thickness) 1)) --
+			 (complex 0 (- thickness)) -- #c(0 0)))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
 ;;; Clefs
 
 ;;;                                 w