home *** CD-ROM | disk | FTP | other *** search
/ Windows 95 v2.4 Fix / W95-v2.4fix.iso / ACADWIN / SAMPLE / CHROMA.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1995-02-08  |  4.2 KB  |  133 lines
  1. ; Next available MSG number is    15 
  2. ; MODULE_ID CHROMA_LSP_
  3. ;;;
  4. ;;;    chroma.lsp
  5. ;;;    
  6. ;;;    Copyright (C) 1990, 1991, 1992, 1993, 1994 by Autodesk, Inc.
  7. ;;;
  8. ;;;    Permission to use, copy, modify, and distribute this software
  9. ;;;    for any purpose and without fee is hereby granted, provided
  10. ;;;    that the above copyright notice appears in all copies and
  11. ;;;    that both that copyright notice and the limited warranty and
  12. ;;;    restricted rights notice below appear in all supporting
  13. ;;;    documentation.
  14. ;;;
  15. ;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
  16. ;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
  17. ;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
  18. ;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
  19. ;;;    UNINTERRUPTED OR ERROR FREE.
  20. ;;;
  21. ;;;    Use, duplication, or disclosure by the U.S. Government is subject to
  22. ;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
  23. ;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii) 
  24. ;;;    (Rights in Technical Data and Computer Software), as applicable.
  25. ;;;
  26. ;;;.
  27. ;;;
  28. ;;;----------------------------------------------------------------------------
  29. ;;;   DESCRIPTION
  30. ;;;     
  31. ;;;     Chromatic Pallete style color selection dialog.
  32. ;;;    
  33. ;;;     Globals:
  34. ;;;    
  35. ;;;          chroma_color - Integer color index.  The last value selected
  36. ;;;              by the user in chroma dialog.  It is not cleared or reset
  37. ;;;              by a cancel.  Only used for communication between callback
  38. ;;;              functions and the (chroma) funciton.
  39. ;;;    
  40. ;;;     Depends on the definitions for the dialog provided in chroma.dcl.
  41. ;;;    
  42.  
  43. ;;;
  44. ;;; C:COLOR -- Replacement for built-in command COLOR
  45. ;;;            Uses the chroma pallete style color selector.
  46. ;;;
  47. (defun c:color (/ co_oce clrx co_err co_oer lay_clr)
  48.   (setq co_oer *error* *error* co_err)
  49.   (setq co_oce (getvar "cmdecho"))
  50.   (setvar "cmdecho" 0)
  51.   ;;
  52.   ;; Internal error handler defined locally
  53.   ;;
  54.  
  55.   (defun co_err (s)                     ; error catcher
  56.     (if (/= s "Funciā‰¤n cancelada")
  57.         (if (= s "quitar/salir abandonar")
  58.             (princ)
  59.           (princ (strcat "\nError: " s))))
  60.     (if co_oer                          ; If an old error routine exists
  61.         (setq *error* co_oer))          ; then, reset it 
  62.     
  63.     ;; Reset command echoing on error
  64.     (if co_oce (setvar "cmdecho" co_oce))      
  65.     (if term (term_dialog))
  66.     (princ)
  67.   )
  68.   
  69.   (graphscr)
  70.   
  71.   ;; Get the color of the current layer, for possible BYLAYER color swatch.
  72.   (setq lay_clr (cdr (assoc 62 (tblsearch ;|MSG0|;"layer" (getvar "clayer")))))
  73.  
  74.   ;; Call the dialog here...
  75.   (setq clr (acad_colordlg (cstoci (getvar "cecolor")) T lay_clr))
  76.  
  77.   (if clr
  78.       (command "_.COLOR" (citocs clr)))
  79.  
  80.   (setq *error* co_oer)
  81.   (setvar "cmdecho" co_oce)
  82.   (princ)
  83. )
  84.  
  85. ;;;
  86. ;;; CSTOCI -- Color string to color index
  87. ;;;   Convert an arbitrary case string into a color index.
  88. ;;;   Returns nil if string is not a valid color.
  89. ;;;
  90. (defun cstoci (str)
  91.   (setq str (strcase str))
  92.   (cond
  93.    ((= str "ROJO")        1)
  94.    ((= str "AMARILLO")     2)
  95.    ((= str "VERDE")      3)
  96.    ((= str "CIANO")       4)
  97.    ((= str "AZUL")       5)
  98.    ((= str "MAGENTA")    6)
  99.    ((= str "BLANCO")      7)
  100.    ((= str "BYLAYER")  256)
  101.    ((= str "BYBLOCK")    0)
  102.    ((= str "PORCAPA") 256)
  103.    ((= str "PORBLOQUE")   0)
  104.    ((and (< 0 (atoi str)) (> 256 (atoi str))) (atoi str))
  105.    (nil))
  106. )
  107.  
  108.  
  109. ;;;
  110. ;;; CITOCS -- Convert color index into standard color name.
  111. ;;;    Will return the standard and logical color names as text
  112. ;;;    strings.  Returns nil for out-of-range color indicies.
  113. ;;;
  114. (defun citocs(i)
  115.   (cond
  116.    ((= i 0)   ;|MSG0|;"_BYBLOCK")
  117.    ((= i 1)   ;|MSG0|;"_red")
  118.    ((= i 2)   ;|MSG0|;"_yellow")
  119.    ((= i 3)   ;|MSG0|;"_green")
  120.    ((= i 4)   ;|MSG0|;"_cyan")
  121.    ((= i 5)   ;|MSG0|;"_blue")
  122.    ((= i 6)   ;|MSG0|;"_magenta")
  123.    ((= i 7)   ;|MSG0|;"_white")
  124.    ((= i 256) ;|MSG0|;"_BYLAYER")
  125.    ((and (< 0 i) (> 256 i)) (itoa i))
  126.    (nil))
  127. )
  128.  
  129. (command "_.UNDEFINE" "_COLOR")
  130. (defun c:co () (c:color))
  131. (princ "\n\tC:COlor cargada. Escriba CO o COLOR para seleccionar un color.")
  132. (princ)
  133.