; Next available MSG number is    15 
; MODULE_ID CHROMA_LSP_
;;;
;;;    chroma.lsp
;;;    
;;;    Copyright (C) 1990, 1991, 1992, 1993, 1994 by Autodesk, Inc.
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;;    UNINTERRUPTED OR ERROR FREE.
;;;
;;;    Use, duplication, or disclosure by the U.S. Government is subject to
;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii) 
;;;    (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;.
;;;
;;;----------------------------------------------------------------------------
;;;   DESCRIPTION
;;;     
;;;     Chromatic Pallete style color selection dialog.
;;;    
;;;     Globals:
;;;    
;;;          chroma_color - Integer color index.  The last value selected
;;;              by the user in chroma dialog.  It is not cleared or reset
;;;              by a cancel.  Only used for communication between callback
;;;              functions and the (chroma) funciton.
;;;    
;;;     Depends on the definitions for the dialog provided in chroma.dcl.
;;;    

;;;
;;; C:COLOR -- Replacement for built-in command COLOR
;;;            Uses the chroma pallete style color selector.
;;;
(defun c:color (/ co_oce clrx co_err co_oer lay_clr)
  (setq co_oer *error* *error* co_err)
  (setq co_oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  ;;
  ;; Internal error handler defined locally
  ;;

  (defun co_err (s)                     ; error catcher
    (if (/= s "Function cancelled")
        (if (= s "quit / exit abort")
            (princ)
          (princ (strcat "\nError: " s))))
    (if co_oer                          ; If an old error routine exists
        (setq *error* co_oer))          ; then, reset it 
    
    ;; Reset command echoing on error
    (if co_oce (setvar "cmdecho" co_oce))      
    (if term (term_dialog))
    (princ)
  )
  
  (graphscr)
  
  ;; Get the color of the current layer, for possible BYLAYER color swatch.
  (setq lay_clr (cdr (assoc 62 (tblsearch ;|MSG0|;"layer" (getvar "clayer")))))

  ;; Call the dialog here...
  (setq clr (acad_colordlg (cstoci (getvar "cecolor")) T lay_clr))

  (if clr
      (command "_.COLOR" (citocs clr)))

  (setq *error* co_oer)
  (setvar "cmdecho" co_oce)
  (princ)
)

;;;
;;; CSTOCI -- Color string to color index
;;;   Convert an arbitrary case string into a color index.
;;;   Returns nil if string is not a valid color.
;;;
(defun cstoci (str)
  (setq str (strcase str))
  (cond
   ((= str "RED")        1)
   ((= str "YELLOW")     2)
   ((= str "GREEN")      3)
   ((= str "CYAN")       4)
   ((= str "BLUE")       5)
   ((= str "MAGENTA")    6)
   ((= str "WHITE")      7)
   ((= str "BYLAYER")  256)
   ((= str "BYBLOCK")    0)
   ((= str "BY LAYER") 256)
   ((= str "BY BLOCK")   0)
   ((and (< 0 (atoi str)) (> 256 (atoi str))) (atoi str))
   (nil))
)


;;;
;;; CITOCS -- Convert color index into standard color name.
;;;    Will return the standard and logical color names as text
;;;    strings.  Returns nil for out-of-range color indicies.
;;;
(defun citocs(i)
  (cond
   ((= i 0)   ;|MSG0|;"_BYBLOCK")
   ((= i 1)   ;|MSG0|;"_red")
   ((= i 2)   ;|MSG0|;"_yellow")
   ((= i 3)   ;|MSG0|;"_green")
   ((= i 4)   ;|MSG0|;"_cyan")
   ((= i 5)   ;|MSG0|;"_blue")
   ((= i 6)   ;|MSG0|;"_magenta")
   ((= i 7)   ;|MSG0|;"_white")
   ((= i 256) ;|MSG0|;"_BYLAYER")
   ((and (< 0 i) (> 256 i)) (itoa i))
   (nil))
)

(command "_.UNDEFINE" "_COLOR")
(defun c:co () (c:color))
(princ "\n\tC:COlor loaded.  Type CO or COLOR to select a color.")
(princ)
