home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 6.img / BONUS1.LIB / CHROMA.LSP < prev    next >
Encoding:
Text File  |  1993-02-09  |  3.2 KB  |  116 lines
  1. ;;;   CHROMA.lsp
  2. ;;;   ¬⌐┼v (C) 1991  Autodesk ñ╜Ñq
  3. ;;;
  4. ;;;   Ñ╗│n┼ΘºK╢O¿╤▒z╢iªµÑ⌠ª≤Ñ╬│~╗▌¿D¬║½■¿⌐íB¡╫º∩ñ╬╡oªµ, ª²¼O░╚╜╨┐φ┤`ñU¡z
  5. ;;;   ¡∞½h :
  6. ;;;
  7. ;;;   1)  ñWªC¬║¬⌐┼v│qºi░╚╗▌ÑX▓{ªb¿Cñ@Ñ≈½■¿⌐∙╪íC
  8. ;;;   2)  ¼█├÷¬║╗í⌐·ñσÑ≤ñ]Ñ▓╢╖⌐·╕ⁿ¬⌐┼v│qºiñ╬Ñ╗╢╡│\Ñi│qºiíC
  9. ;;;
  10. ;;;   Ñ╗│n┼Θ╢╚┤ú¿╤º@¼░└│Ñ╬ñW¬║░╤ª╥, ª╙Ñ╝┴n⌐·⌐╬┴⌠ºtÑ⌠ª≤½O├╥; ╣∩⌐≤Ñ⌠ª≤»S«φ
  11. ;;;   Ñ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºtÑX¿π¬║½O├╥, ªbª╣ñ@╖ºñ⌐ÑHº_╗{íC
  12. ;;;
  13. ;;;
  14. ;;;----------------------------------------------------------------------------
  15. ;;;   DESCRIPTION
  16. ;;;
  17. ;;;     Chromatic Pallete style color selection dialog.
  18. ;;;
  19. ;;;     Globals:
  20. ;;;
  21. ;;;          chroma_color - Integer color index.  The last value selected
  22. ;;;              by the user in chroma dialog.  It is not cleared or reset
  23. ;;;              by a cancel.  Only used for communication between callback
  24. ;;;              functions and the (chroma) funciton.
  25. ;;;
  26. ;;;     Depends on the definitions for the dialog provided in chroma.dcl.
  27. ;;;
  28.  
  29. ;;;
  30. ;;; C:COLOR -- Replacement for built-in command COLOR
  31. ;;;            Uses the chroma pallete style color selector.
  32. ;;;
  33. (defun c:color (/ co_oce clrx co_err co_oer)
  34.   (setq co_oer *error* *error* co_err)
  35.   (setq co_oce (getvar "cmdecho"))
  36.   (setvar "cmdecho" 0)
  37.   ;;
  38.   ;; Internal error handler defined locally
  39.   ;;
  40.  
  41.   (defun co_err (s)                     ; error catcher
  42.     (if (/= s "Function cancelled")
  43.         (if (= s "quit / exit abort")
  44.             (princ)
  45.           (princ (strcat "\n┐∙╗~: " s))))
  46.     (if co_oer                          ; If an old error routine exists
  47.         (setq *error* co_oer))          ; then, reset it
  48.  
  49.     ;; Reset command echoing on error
  50.     (if co_oce (setvar "cmdecho" co_oce))
  51.     (if term (term_dialog))
  52.     (princ)
  53.   )
  54.  
  55.   (graphscr)
  56.  
  57.   ;; Call the dialog here...
  58.   (setq clr (acad_colordlg (cstoci (getvar "cecolor"))))
  59.  
  60.   (if clr
  61.       (command "_.COLOR" (citocs clr)))
  62.  
  63.   (setq *error* co_oer)
  64.   (setvar "cmdecho" co_oce)
  65.   (princ)
  66. )
  67.  
  68. ;;;
  69. ;;; CSTOCI -- Color string to color index
  70. ;;;   Convert an arbitrary case string into a color index.
  71. ;;;   Returns nil if string is not a valid color.
  72. ;;;
  73. (defun cstoci (str)
  74.   (setq str (strcase str))
  75.   (cond
  76.    ((= str "RED")        1)
  77.    ((= str "YELLOW")     2)
  78.    ((= str "GREEN")      3)
  79.    ((= str "CYAN")       4)
  80.    ((= str "BLUE")       5)
  81.    ((= str "MAGENTA")    6)
  82.    ((= str "WHITE")      7)
  83.    ((= str "BYLAYER")  256)
  84.    ((= str "BYBLOCK")    0)
  85.    ((= str "BY LAYER") 256)
  86.    ((= str "BY BLOCK")   0)
  87.    ((and (< 0 (atoi str)) (> 256 (atoi str))) (atoi str))
  88.    (nil))
  89. )
  90.  
  91.  
  92. ;;;
  93. ;;; CITOCS -- Convert color index into standard color name.
  94. ;;;    Will return the standard and logical color names as text
  95. ;;;    strings.  Returns nil for out-of-range color indicies.
  96. ;;;
  97. (defun citocs(i)
  98.   (cond
  99.    ((= i 0)   "BYBLOCK")
  100.    ((= i 1)   "red")
  101.    ((= i 2)   "yellow")
  102.    ((= i 3)   "green")
  103.    ((= i 4)   "cyan")
  104.    ((= i 5)   "blue")
  105.    ((= i 6)   "magenta")
  106.    ((= i 7)   "white")
  107.    ((= i 256) "BYLAYER")
  108.    ((and (< 0 i) (> 256 i)) (itoa i))
  109.    (nil))
  110. )
  111.  
  112. (command "_.UNDEFINE" "COLOR")
  113. (defun c:co () (c:color))
  114. (princ "\n\tíuC:COlorívñw╕ⁿñJ; ╜╨┴ΣñJ CO ⌐╬ COLOR ¿╙┐∩╛▄├CªΓíC")
  115. (princ)
  116.