[gsharp-cvs] CVS gsharp

[rstrandh]

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

Modified Files:
	bezier.lisp fontview.lisp 
Log Message:
Moved things around a bit inside bezier.lisp to make it easier
to render to an array from the font viewer.

Implemented pixel viewing in the font viewer.  Initial results
indicate that the G-clef is pretty good, and there must be something
wrong either with the way the pixmap gets generated or with the way it
gets copied to the pane (it is too far down).  Initial result also
indicate that the C-clef is completely wrong and incredibly ugly at
sizes above 6.



--- /project/gsharp/cvsroot/gsharp/bezier.lisp	2006/05/30 02:13:26	1.2
+++ /project/gsharp/cvsroot/gsharp/bezier.lisp	2006/06/01 04:55:37	1.3
@@ -662,23 +662,25 @@
 	  repeat (nb-lines lines)
 	  do (render-scan-lines array pixel-value i (crossings lines i) min-x min-y))))
 
-(defun render-to-array (positive-areas negative-areas min-x min-y max-x max-y)
-  (setf min-x (* 4 (floor min-x))
-	min-y (* 4 (floor min-y))
-	max-x (* 4 (ceiling max-x))
-	max-y (* 4 (ceiling max-y)))
-  (let ((result (make-array (list (- max-y min-y) (- max-x min-x))
-			    :element-type 'bit :initial-element 1))
-	(transformation (make-scaling-transformation* 4 4)))
-    (loop for area in positive-areas
-	  do (let* ((transformed-area (transform-region transformation area))
-		    (polygon (polygonalize transformed-area)))
-	       (render-polygon result polygon 0 min-x min-y)))
-    (loop for area in negative-areas
-	  do (let* ((transformed-area (transform-region transformation area))
-		    (polygon (polygonalize transformed-area)))
-	       (render-polygon result polygon 1 min-x min-y)))
-    result))
+(defun render-to-array (positive-areas negative-areas)
+  (multiple-value-bind (min-x min-y max-x max-y)
+      (bounding-rectangle-of-areas positive-areas)
+    (setf min-x (* 4 (floor min-x))
+	  min-y (* 4 (floor min-y))
+	  max-x (* 4 (ceiling max-x))
+	  max-y (* 4 (ceiling max-y)))
+    (let ((result (make-array (list (- max-y min-y) (- max-x min-x))
+			      :element-type 'bit :initial-element 1))
+	  (transformation (make-scaling-transformation* 4 4)))
+      (loop for area in positive-areas
+	    do (let* ((transformed-area (transform-region transformation area))
+		      (polygon (polygonalize transformed-area)))
+		 (render-polygon result polygon 0 min-x min-y)))
+      (loop for area in negative-areas
+	    do (let* ((transformed-area (transform-region transformation area))
+		      (polygon (polygonalize transformed-area)))
+		 (render-polygon result polygon 1 min-x min-y)))
+      result)))
 
 (defparameter *x* 0)
 (defparameter *y* 0)
@@ -699,12 +701,12 @@
 		      (+ (* a 1.0) (* 1-a b))))))
 
 (defun render-through-pixmap (design medium positive-areas negative-areas)
-  (multiple-value-bind (min-x min-y max-x max-y)
-      (bounding-rectangle-of-areas positive-areas)
+  (multiple-value-bind (min-x min-y)
+      (bounding-rectangle* design)
     (let ((pixmap (gethash (list (medium-sheet medium) (resolve-ink medium) design)
 			   *pixmaps*)))
       (when (null pixmap)
-	(let* ((picture (render-to-array positive-areas negative-areas min-x min-y max-x max-y))
+	(let* ((picture (render-to-array positive-areas negative-areas))
 	       (height (array-dimension picture 0))
 	       (width (array-dimension picture 1))
 	       (reduced-picture (make-array (list (/ height 4) (/ width 4)) :initial-element 16)))
@@ -741,6 +743,20 @@
   (multiple-value-bind (*x* *y*) (transform-position (translation design) 0 0)
     (medium-draw-design* medium (original-region design))))
 
+(defgeneric render-design-to-array (design))
+
+(defmethod render-design-to-array ((design bezier-area))
+  (render-to-array (list design) '()))
+
+(defmethod render-design-to-array ((design bezier-union))
+  (render-to-array (areas design) '()))
+
+(defmethod render-design-to-array ((design bezier-difference))
+  (render-to-array (positive-areas design) (negative-areas design)))
+
+(defmethod render-design-to-array ((design translated-region))
+  (render-design-to-array (original-region design)))
+
 (defmethod draw-design (sheet design &rest args &key &allow-other-keys)
   (climi::with-medium-options (sheet args)
     (medium-draw-design* medium design)))
--- /project/gsharp/cvsroot/gsharp/fontview.lisp	2006/05/31 19:55:19	1.1
+++ /project/gsharp/cvsroot/gsharp/fontview.lisp	2006/06/01 04:55:37	1.2
@@ -8,10 +8,10 @@
 (define-application-frame fontview ()
   ((font :initform (make-instance 'sdl::font :staff-line-distance 6))
    (shape :initform :g-clef)
-   (grid :initform nil)
+   (grid :initform t)
    (staff :initform nil)
    (staff-offset :initform 0)
-   (view :initform :antialiased)
+   (view :initform :pixel)
    (zoom :initform 1)
    (hoffset :initform 300)
    (voffset :initform 300))
@@ -41,9 +41,39 @@
 				      (* 10 sld) (+ y down)))))))))
 
 (defun display-pixel-view (frame pane)
-  (declare (ignore pane))
   (with-slots (font shape grid zoom hoffset voffset) frame
-    nil))
+    (with-translation (pane hoffset voffset)
+      (let ((design (sdl::ensure-design font shape)))
+	(multiple-value-bind (min-x min-y max-x max-y) (bounding-rectangle* design)
+	  (setf min-x (* 4 (floor min-x))
+		min-y (* 4 (floor min-y))
+		max-x (* 4 (ceiling max-x))
+		max-y (* 4 (ceiling max-y)))
+	  (let ((array (climi::render-design-to-array design)))
+	    (loop for y from min-y below max-y
+		  for y-index from 0
+		  do (loop with x0 = nil
+			   for x from min-x below max-x
+			   for x-index from 0
+			   do (if (zerop (aref array y-index x-index))
+				  (when (null x0)
+				    (setf x0 x))
+				  (unless (null x0)
+				    (draw-rectangle* pane (* x0 zoom) (* y zoom) (* x zoom) (* (1+ y) zoom))
+				    (setf x0 nil)))
+			   finally (unless (null x0)
+				     (draw-rectangle* pane (* x0 zoom) (* y zoom) (* x zoom) (* (1+ y) zoom)))))
+	    (when grid
+	      (loop for y downfrom 0 above -300 by (* 4 zoom)
+		    do (draw-rectangle* pane -300 y 300 (1+ y) :ink +blue+))
+	      (loop for y from 0 below 300 by (* 4 zoom)
+		    do (draw-rectangle* pane -300 y 300 (1+ y) :ink +blue+))
+	      (loop for x downfrom 0 above -300 by (* 4 zoom)
+		    do (draw-rectangle* pane x -300 (1+ x) 300 :ink +blue+))
+	      (loop for x from 0 below 300 by (* 4 zoom)
+		    do (draw-rectangle* pane x -300 (1+ x) 300 :ink +blue+))
+	      (draw-rectangle* pane -300 0 300 1 :ink +red+)
+	      (draw-rectangle* pane 0 -300 1 300 :ink +red+))))))))
 
 (defun display-entry (frame pane)
   (with-slots (view) frame