;;; -*- Mode:LISP; Package:GREY; Base:8 -*-
;; this file is obsolete

;; Copyright LISP Machine, Inc. 1984
;;    See filename "Copyright" for
;; licensing and release information.


;; For now, this is as a patch-file, to redefine compatibly
;; the functions in COLOR which are referenced by the HACKS:DEMO
;; and as requested by users. 6/05/84 23:43:01 -GJC

;; These things should be done as methods and users encoraged to
;; call the methods, so that when we add the high-resolution
;; color device, or have more than one color device,
;; everybody will win.



(DEFUN COLOR:COLOR-EXISTS-P (&OPTIONAL (SCREEN NIL SCREENP))
  "T if this machine has color screen hardware. return NIL if called on
an argument which is not the grey-screen, e.g. calls to this function
from obsolete :EXPOSE methods of the old color screen code."
  (LET ((GS (IF (BOUNDP 'GREY-SCREEN) GREY-SCREEN)))
    ;; HANDLE the case of not having initialized the grey code but still
    ;; being called at cold boot time by the old color code.
    (IF SCREENP
	(AND (EQ SCREEN GS)
	     (grey-exists-and-if-so-downloaded-p))
      (grey-exists-and-if-so-downloaded-p))))

(deff COLOR:write-color-map  #'write-color-map)

;; color:clear already kosher due to color:color-screen forwarding hack.

;; COLOR:random-color-map already good because we bash write-color map.

(deff COLOR:read-color-map #'read-color-map)

(DEFUN COLOR:BLT-COLOR-MAP (ARRAY &OPTIONAL (SCREEN GREY-SCREEN))
    "Write the entire color map of SCREEN from ARRAY (a #o400 by 3 array).
ARRAY could be a saved copy of HARDWARE-COLOR-MAP. The array size and possibly
other things are incompatible with the old color code."
    (CHECK-ARG ARRAY (AND (EQ #O400 (ARRAY-DIMENSION ARRAY 0))
			  (>= (ARRAY-DIMENSION ARRAY 1) 3))
	       "a #o400 by >=3 array")
  (send screen ':BLT-COLOR-MAP array))


;; color:color-bitblt wins too, if we hack this array to account for
;; the 8 bits per pixels vs. the 4 bits in the old board.


(defun HARDWARE-COLOR-MAP (&optional (screen color:color-screen))
  (GET (LOCF (TV:SCREEN-PROPERTY-LIST SCREEN))
       ':HARDWARE-COLOR-MAP))

(DEFUN HARDWARE-COLOR-MAP-DIMENSION (&optional (screen color:color-screen) (N 0))
  (ARRAY-DIMENSION (HARDWARE-COLOR-MAP SCREEN) N))

(PROGN 'COMPILE

COLOR:
(DEFUN SPECTRUM-COLOR-MAP ()
  "Fill the color map with a spectrum."
  (DO ((I 1 (1+ I))
       (OFFSET 0 (COND ((= I 7) 1) ((= I 16) 2) (T OFFSET))))
      ((= I (GREY:HARDWARE-COLOR-MAP-DIMENSION)))
    (WRITE-COLOR-MAP I (* (LDB 0001 (+ I OFFSET)) COLOR-MAP-ON)
		     (* (LDB 0101 (+ I OFFSET)) COLOR-MAP-ON)
		     (* (LDB 0201 (+ I OFFSET)) COLOR-MAP-ON))))

COLOR:
(DEFUN RANDOM-COLOR-MAP (&OPTIONAL (START 1) (SYNCHRONIZE NIL) (SCREEN COLOR-SCREEN))
  "Fill the color map from START through with random colors."
       (DO ((I START (1+ I)))
	   ((= I (GREY:HARDWARE-COLOR-MAP-DIMENSION)))
           (WRITE-COLOR-MAP I (RANDOM (1+ COLOR-MAP-ON)) (RANDOM (1+ COLOR-MAP-ON))
			    (RANDOM (1+ COLOR-MAP-ON)) SYNCHRONIZE SCREEN)
	   (SETQ SYNCHRONIZE NIL)))

)


;; Make appropriate menu entries
(OR (ASSOC "Color Window" TV:*SYSTEM-MENU-WINDOWS-COLUMN*)
    (SETQ TV:*SYSTEM-MENU-WINDOWS-COLUMN*
	  (APPEND TV:*SYSTEM-MENU-WINDOWS-COLUMN*
		  (NCONS '("Color Window"
			   :EVAL (TV:SYSTEM-MENU-CREATE-WINDOW COLOR:COLOR-SCREEN)
			   :DOCUMENTATION "Create a window on the color screen")))))