CLIM mail archive
[Prev][Next][Index][Thread]

draw-icon*

    Date: Thu, 17 Dec 1992 13:50 EST
    From: Gerd Herzog <flint@francesca.cs.uni-sb.de>

    Hi there,

    since I got no answer yet, I have to post this question again:

Despite the fact that many of us send bug reports to this mailing list,
and some of us reply to them (probably too often), CLIM@BBN.COM is
really not a mailing list for bug reports.  As more people start to use
CLIM, it will not be possible for CLIM developers to continue to respond
through this mailing list.  In the future, please contact your
appropriate support person, in this case, at Symbolics. 

      (draw-icon* my-stream (make-pattern #2A((1 1 1 1)
					      (1 0 0 1)
					      (1 0 0 1)
					      (1 1 1 1))
					  (list +background+ +foreground+))
		  0 0)

    works fine with Allegro 4.1 and Lucid 4.0.2 (CLIM 1.1), but generates no
    output on my Symbolics UX1200S, running Genera 8.1.1, CLIM 1.1 (V28.5).

    So what's wrong with draw-icon* on the Symbolics? 

Try patching the following three functions.  If this does not fix the
problem, contact a support person at Symbolics.  (By the way, this works
correctly in CLIM 2.0.)

(in-package :clim)

(defun draw-icon* (stream icon x y &key clipping-region transformation)
  (check-type icon pattern)
  (let ((width (pattern-width icon))
	(height (pattern-height icon)))
    (if (or clipping-region transformation)
	(with-drawing-options (stream :clipping-region clipping-region
				      :transformation transformation))
	(draw-rectangle* stream x y (+ x width) (+ y height)
			 :filled t :ink icon))))

(defmethod draw-rectangle-internal ((stream sheet-implementation-mixin) x-offset y-offset
				    left top right bottom ink line-style)
  (when (window-drawing-possible stream)
    (round-points left top right bottom)
    (translate-positions x-offset y-offset left top right bottom)
    (if (and (null line-style)
	     (typep ink 'pattern))
	;; Looks like this is DRAW-ICON*
	(draw-icon-internal stream left top right bottom ink)
	(with-appropriate-drawing-state stream ink line-style
	  #'(lambda (window alu)
	      (declare (sys:downward-function))
	      (if (null line-style)
		  (let ((width (abs (- right left)))
			(height (abs (- bottom top))))
		    (funcall window :draw-rectangle width height left top alu))
		  (scl:stack-let ((lines (vector right top left top
						 left top left bottom
						 left bottom right bottom
						 right bottom right top)))
		    (funcall window :draw-multiple-lines lines alu nil))))
	  #'(lambda (window)
	      (declare (sys:downward-function))
	      (funcall (flavor:generic graphics:draw-rectangle) window left top right bottom
		       :filled (null line-style)))))))

;; Fall back to DRAW-IMAGE.  INK will be a pattern.
;;--- We have to resort to this because Genera always tiles.  Sigh.
(defmethod draw-icon-internal ((stream sheet-implementation-mixin) left top right bottom ink)
  (with-slots (window ink-cache) stream
    (let* ((width  (- right left))
	   (height (- bottom top))
	   (alus (or (ink-cache-lookup ink-cache ink)
		     (ink-cache-replace ink-cache ink (sheet-decode-ink ink stream)))))
      (assert (= (length alus) 1) ()
	      "CLIM only supports bitmap icons under Genera sheets")
      (dolist (alu alus)
	(let ((image (pop alu)))
	  (graphics:draw-image image left top
			       :image-right width :image-bottom height
			       :stream window))))))

0,,
References:
Main Index | Thread Index