Windows 95 v2.4 Fix/W95-v2.4fix.iso/ACADWIN/SUPPORT/DDCOLOR.LSP

Lisp/Scheme | 1995-02-08 | 6.0 KB | 190 lines

; Next available MSG number is    24
; MODULE_ID DDCOLOR_LSP_
;;;
;;;    ddcolor.lsp
;;;
;;;    Copyright (C) 1990, 1992, 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:DDCOLOR -- Dialogue front end to the CECOLOR sysvar.  Uses the chroma
;;; pallete style color selector.
;;;
;;; ===========================================================================
;;; ===================== load-time error checking ============================
;;;

  (defun ai_abort (app msg)
     (defun *error* (s)
        (if old_error (setq *error* old_error))
        (princ)
     )
     (if msg
       (alert (strcat " Error en la aplicaci≤n: "
                      app
                      " \n\n  "
                      msg
                      "  \n"
              )
       )
     )
     (exit)
  )

;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
;;;
;;; If it can't be found or it can't be loaded, then abort the
;;; loading of this file immediately, preserving the (autoload)
;;; stub function.

  (cond
     (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.

     (  (not (findfile "ai_utils.lsp"))                     ; find it
        (ai_abort "DDCOLOR"
                  (strcat "Imposible localizar el archivo AI_UTILS.LSP."
                          "\n Compruebe el directorio de soporte.")))

     (  (eq "failed" (load "ai_utils" "failed"))            ; load it
        (ai_abort "DDCOLOR" "Imposible cargar el archivo AI_UTILS.LSP"))
  )

  (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
      (ai_abort "DDCOLOR" nil)         ; a Nil <msg> supresses
  )                                    ; ai_abort's alert box dialog.

;;; ==================== end load-time operations ===========================

(defun c:ddcolor (/ co_oce clrx co_err co_oer lay_clr)

  ;; Main Color function, called by setup code.
  (defun ddcolor_main()

    (graphscr)

    ;; Get the color of the current layer, for possible BYLAYER color swatch.
    (setq lay_clr (cdr (assoc 62 (tblsearch "layer" (getvar "clayer")))))

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

    (if clr
      (setvar "CECOLOR" (citocs clr)))
  )

  ;;;
  ;;; 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 "ROJO")        1)
     ((= str "AMARILLO")     2)
     ((= str "VERDE")      3)
     ((= str "CIANO")       4)
     ((= str "AZUL")       5)
     ((= str "MAGENTA")    6)
     ((= str "BLANCO")      7)
     ((= str ;|MSG0|;"BYLAYER")  256)
     ((= str ;|MSG0|;"BYBLOCK")    0)
     ((= str "PORCAPA") 256)
     ((= str "PORBLOQUE")   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)   "PORBLOQUE")
     ((= i 1)   "rojo")
     ((= i 2)   "amarillo")
     ((= i 3)   "verde")
     ((= i 4)   "ciano")
     ((= i 5)   "azul")
     ((= i 6)   "magenta")
     ((= i 7)   "blanco")
     ((= i 256) "PORCAPA")
     ((and (< 0 i) (> 256 i)) (itoa i))
     (nil))
  )

  ;; Start of ddcolor
  (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
        old_error  *error*            ; save current error function
        *error* ai_error              ; new error function
  )

  (setvar "cmdecho" 0)

  (cond
     (  (not (ai_trans)))                        ; transparent OK
     (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?

     (t (if (and (/= 1 (logand 1 (getvar "cmdactive")))
                 (/= 8 (logand 8 (getvar "cmdactive")))
            )
         (ai_undo_push)
        )

        (ddcolor_main)                          ; proceed!

        (if (and (/= 1 (logand 1 (getvar "cmdactive")))
                 (/= 8 (logand 8 (getvar "cmdactive")))
            )
         (ai_undo_pop)
        )
     )
  )

  (setq *error* old_error)
  (setvar "cmdecho" old_cmd)
  (princ)

)

;;;----------------------------------------------------------------------------
(princ "  DDCOLOR cargado.  ")
(princ)