add me to mailing list, plus bug

[kent@cs.uoregon.edu]

I am Kent A. Stevens, a professor of computer science at the University of
Oregon.  Please add kent@cs.uoregon.edu to the mailing list for mcl.

I have a bug, my first to contribute, which seems to involve pmfore colors
and start-picture/get-picture sequences.  It showed up in a more
complicated
context, where some colors are re-mapped incorrectly compared to when the
pen was not hidden.  The following code sets up a color window.  It
requires
a second color device, which should be the second device on the list.  The
function (foo) will produce an L shape with both lines of pm color 100. 
However putting foo within a start-picture/get-picture (as done by
make-pict)
the color of the first line is inappropriately 255.  There are lots of
variations on this theme that produce the same effect, where the pmcolor is
not set correctly for the quickdraw command that just follows the
#_pmforecolor.   Thanks for looking at this.

Kent
;**************************************************************************
(if (not (find-package 'color)) (make-package 'color))

(in-package color)

(eval-when (eval compile load)
  (require 'traps)
  (require 'records)
  (require 'quickdraw))

(defparameter default-gdevice (_getgdevice :ptr))
(defparameter graphics-gdevice (_getnextdevice :ptr (_getgdevice :ptr)
:ptr))

(defconstant pane-width 640)
(defconstant pane-height 480)
(defconstant pane-x-max (1- pane-width))
(defconstant pane-y-max (1- pane-height))
(defvar color-window)
(defvar screen-palette)
(defvar clut)

(defclass color-window (window) ())

(setq color-window (make-instance 'color-window 
                                  :window-title "color window"
                                  :view-position (make-point 
                                        (rref (%get-ptr graphics-gdevice)
gdevice.gdrect.left :storage :pointer)
                                                    (rref (%get-ptr
graphics-gdevice) gdevice.gdrect.top :storage :pointer))
                                  :view-size (make-point pane-width
pane-height)
                                  :window-type :tool
                                  :color-p t
                                  :close-box-p nil))

(setq clut (_getctable :word 8 :ptr))

(setq screen-palette  (_newpalette :word 256 :ptr (%int-to-ptr 0) :word 8
:word 0 :ptr))

(_setpalette :ptr (wptr color-window) :ptr screen-palette :word 256)

(defmethod clear-window ((window color-window) &optional (color 0) (penmode
0))
  (with-port (wptr color-window)
    (_penmode :word penmode)
    (_pmforecolor :word color)
    (paint-rect window 0 0 *screen-width* *screen-height*)))

(defun make-pict (picture-function &rest rest-args)
  (start-picture color-window)
  (apply picture-function rest-args)
  (get-picture color-window))

(defun FOO ()
  (with-focused-view color-window
    (#_PenMode 0)
    (#_pmforecolor 100)
    (#_MoveTo 100 100)
    (#_LineTo 100 200)
    (#_LineTo 200 200)))

(defun linear-map (&optional (min-color 0) (max-color 255) (min-intensity
0) (max-intensity 65535)
                              &aux intensity intensity-increment)
  (with-dereferenced-handles ((ct clut))
    (setq intensity-increment (/ (- max-intensity min-intensity) (-
max-color min-color)))
    (do ((i min-color (1+ i))) ((> i max-color))
      (setq intensity (truncate (+ min-intensity (* i
intensity-increment))))
      (%put-word ct intensity (+ 10 (* i 8)))
      (%put-word ct intensity (+ 12 (* i 8)))
      (%put-word ct intensity (+ 14 (* i 8))))
    (_setgdevice :ptr graphics-gdevice)
    (rset ct :colortable.ctseed (_getctseed :long) :storage :pointer)
    (_setentries :word 0 :word 255 :ptr (rref ct :colortable.cttable
:storage :pointer))
    (_makeitable :ptr (%int-to-ptr 0) :ptr (%int-to-ptr 0) :word 5)
    (_setgdevice :ptr default-gdevice)))

; this should draw an "L" with both the vertical and horizontal legs both
pm color of 100.  Instead,
; the vertical leg (the first drawn after the moveto is 255.  This is a
simple version of an 
; insideous problem where the pmforecolor is not set correctly for the
first quickdraw command
; that follows it.

(defun TEST ()
  (draw-picture color-window (make-pict 'foo)))

; end of code 
;*************************************************************
; end of message