LMFL#!C(:PADDED T :HOST "SYS" :BACKUP-DATE 2773681967. :SYSTEM-TYPE :LOGICAL :VERSION 2. :TYPE "LISP" :NAME "COLOR-MODEL" :DIRECTORY ("REL3-2" "COLOR-MAP-EDITOR") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-2\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2769534400. :AUTHOR "REL3-2" :LENGTH-IN-BYTES 3446. :LENGTH-IN-BLOCKS 4. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ;;; -*- Mode:Common-Lisp; Package:COLOR; Base:10 -*-;;; (C) Texas Instruments May 1987(DEFFLAVOR color-model (namesidereadout1 range1   readout2 range2readout3 range3(column1 (make-column))(column2 (make-column))(column3 (make-column))color-editor-pointer     converter)      ()  (:documentation "This flavor represents a color model")  (:settable-instance-variables))(DEFMETHOD (color-model :after :init) (IGNORE)                       (CASE name    (:rgb (setf converter (MAKE-INSTANCE 'rgb-converter)))    (:hsv (setf converter (MAKE-INSTANCE 'hsv-converter)))))(DEFMETHOD (color-model :update-model-variables) ()              "Get the right converter for converting the readout variables  in the model from the current RGB's.  Send the model to update  its slide bars and numeric-readouts."  (MULTIPLE-VALUE-BIND  (val1 val2 val3)      (SEND converter         :convert-from-rgb    (SEND color-editor-pointer :current-red)    (SEND color-editor-pointer :current-green)    (SEND color-editor-pointer :current-blue))    (setf readout1 val1)    (setf readout2 val2)    (setf readout3 val3)    (SEND self :update-model-columns)    ))(DEFMETHOD (color-model :update-current-column) (new-val column)     "Update the slide bar and numeric readout in the current  column.  Update the current RGB in the color editor.  Send  a message to the other-model to update its columns."  (LET* (range readout-method col (col-num (column-of-model-column name column)) (other-model (CASE side(:left (SEND color-editor-pointer :right-model-instance))(:right (SEND color-editor-pointer :left-model-instance)))))    (case col-num      (1 (setq range range1       readout-method :set-readout1       col column1))      (2 (setq range range2       readout-method :set-readout2       col column2))      (3 (setq range range3       readout-method :set-readout3       col column3)))    ;; Test new-val to be sure it is in the correct range.    (cond ((< new-val 0) (setq new-val 0))  ((> new-val range) (setq new-val range)))    ;; Update the readout variable in the model    (SEND self readout-method new-val)    ;; Update the sibling slide-bar and numeric-readout    (send (column-slide-bar col) :update-slide-bar new-val)    (send (column-numeric-readout col) :update-readout new-val)    ;;Update current RGB    (MULTIPLE-VALUE-bind (r g b)                      (SEND converter :convert-to-rgb readout1 readout2 readout3)      (SEND color-editor-pointer :set-current-red r)      (SEND color-editor-pointer :set-current-green g)      (SEND color-editor-pointer :set-current-blue b)      (tv:write-color-map (SEND color-editor-pointer :color-map) (SEND color-editor-pointer :color-to-edit) r g b)      (tv:write-color-lut-buffer (SEND color-editor-pointer :color-to-edit) r g b (tv:current-color-lut-buffer))      (SEND other-model :update-model-variables))))(DEFMETHOD (color-model :update-model-columns) ()  "Update slide-bars and numeric-readouts"  (SEND (column-slide-bar column1) :update-slide-bar readout1)  (send (column-numeric-readout column1) :update-readout readout1)  (SEND (column-slide-bar column2) :update-slide-bar readout2)  (send (column-numeric-readout column2) :update-readout readout2)  (SEND (column-slide-bar column3) :update-slide-bar readout3)  (send (column-numeric-readout column3) :update-readout readout3))