Color and palette question

[Chris Hancock]

Hi. I'm working on an app which will run in 256 colors. How hard is it
to set up a different set of colors from the default, from MCL?

As a starting point, I have a pict file with the desired colors: I guess
I'd need some way to turn this into a structure representing the desired
palette. (Manually is fine-- this only has be done once. But what kind
of tool would one use??).

Then I guess I need to call some kind of routine to install the palette.
Does this routine need to be called again every time the app comes to
the front?

Also, how does the MCL color model interface with a different palette?
Will it still pick the nearest available color, or will it get confused?

Sorry if these are me Mac and media questions than MCL questions.
Perhaps there are some handy MCL-based tools or examples.

Thanks /Chris

[Alan Ruttenberg]

Here's some code I used to use. Haven't tried it in a while though. Hope this helps. I also have some code for doing the same thing for gworlds and for accessing the colortables of same, which is below. That code uses other code from my sheet package. If you think it will be helpful, I'll pull out what is necessary to make it self contained.

Hope this helps,
Alan

;; use the palette manager to make a window get exact colors. You need
;; to both set and draw in the colors in order for the window
;; system to get it through its thick skull.

(defmethod window-force-colors ((w window) colors)
(without-interrupts
(with-focused-view w
(let* ((pal (#_newpalette (length colors) (%null-ptr) #$pmtolerant 0)))
(loop for color in colors
for i from 0
do
(#_setentrycolor pal i (rgb color)))
(#_setpalette (wptr w) pal t)
(loop for i below (length colors)
do (#_pmforecolor i) (#_paintrect (rect 0 0 1 1)))
(#_activatepalette (wptr w))))))

This is the code that depends on sheets.

;; force window and gworlds to share some colors
(defmethod window-and-gworld-force-colors ((w window) colors &rest gworlds)
(window-force-colors w colors)
(with-colortable (cw w)
(loop for gworld in gworlds
do
(with-colortable (cg gworld)
(let ((gworld-colortable-size (#_gethandlesize (colortable-handle gworld))))
(if (= gworld-colortable-size (#_gethandlesize (colortable-handle w)))
(#_blockmove cw cg gworld-colortable-size)
(gworld-force-colors gworld colors)))))))

;; Force the gworld color table to have these colors. This forces the
;; colortable to be unique though, which may slow down copybits.

(defmethod gworld-force-colors ((g gworld) colors)
(with-colortable (cg g)
(assert (>= (pref cg colortable.ctsize)
(+ 1 (length colors)))
()
"You need at least a depth ~a gworld to accomodate this many colors. This one is only ~a."
(round (log (+ 2 (length colors)) 2)) (depth g))
(setf (pref cg colortable.ctseed) (#_getctseed))
(loop for color in colors
for i from 0
do
(color-to-rgb color (pref (pref cg (:colortable.cttable.array (1+ i))) colorspec.rgb)))))

[Alan Ruttenberg]

Missed some code you need to run window-force-colors:

(defvar *spare-rect-1* (#_newptr 8))
(defvar *spare-rgb* (#_newptr 6))

(defmacro rect-internal (rect size-or-topleft-or-top &optional bottomright-or-left bottom right)
(if size-or-topleft-or-top
(if (not bottomright-or-left)
`(progn
(setf (rref ,rect :rect.topleft) #@(0 0))
(setf (rref ,rect :rect.bottomright) ,size-or-topleft-or-top)
,rect)
(if bottom
`(progn
(setf (rref ,rect :rect.top) ,size-or-topleft-or-top)
(setf (rref ,rect :rect.bottom) ,bottom)
(setf (rref ,rect :rect.right) ,right)
(setf (rref ,rect :rect.left) ,bottomright-or-left)
,rect)
`(progn
(setf (rref ,rect :rect.topleft) ,size-or-topleft-or-top)
(setf (rref ,rect :rect.bottomright) ,bottomright-or-left)
,rect)))
rect))

(defmacro rect (&optional size-or-topleft-or-top bottomright-or-left bottom right)
`(rect-internal *spare-rect-1* ,size-or-topleft-or-top ,bottomright-or-left ,bottom ,right))

(defmacro rgb (color)
`(progn
(color-to-rgb ,color *spare-rgb*)
*spare-rgb*))