fractal-utility5.lsp

关于分形的lisp程序.是曼氏分形和Julia分形的合集.

;;;===============
;;;HSL值转RGB值   
;;;返回RGB值的列表
;;;===============
;;;Hue转RGB       
(defun Hue->rgb (v1 v2 vHue / vH)
  (cond
    ((< vHue 0) (setq vH (1+ vHue)))
    ((> vHue 1) (setq vH (1- vHue)))
    (t (setq vH vHue))
  )
  (cond
    ((< (* 6 vH) 1) (+ v1 (* (- v2 v1) 6 vH)))
    ((< (* 2 vH) 1) v2)
    ((< (* 3 vH) 2) (+ v1 (* (- v2 v1) 6 (- 0.66666667 vH))))
    (t v1)
  ) 
)
(defun Hsl->rgb (Hue Saturation Light / h s l r g b var2 var1)
  (setq h (/ Hue 360.0)
	s (/ Saturation 100.0)
	l (/ Light 100.0)
  )
  (if (= s 0)
    (setq r (* l 255)
	  g (* l 255)
	  b (* l 255)
    )
    (setq var2 (if (< l 0.5)
		 (* l (1+ s))
		 (+ l s (* s l -1))
	       )
          var1 (- (* 2 l) var2)
          r (* 255 (Hue->RGB var1 var2 (+ h 0.33333333)))
          g (* 255 (Hue->RGB var1 var2 h))
          b (* 255 (Hue->RGB var1 var2 (- h 0.33333333)))
    )
  )
  (list (fix r) (fix g) (fix b))
)
;;;===============
;;;RGB值转HSL值   
;;;返回HSL值的列表
;;;===============
(defun RGB->HSL(R G B / var_R var_G var_B var_min var_max
		        del_max del_R del_G del_B H L S)
  (setq var_R (/ R 255.0))
  (setq var_G (/ G 255.0))
  (setq var_B (/ B 255.0))
  (setq var_min (min var_R var_G var_B))
  (setq var_max (max var_R var_G var_B))
  (setq del_max (- var_max var_min))
  (setq L (/ (+ var_max var_min) 2))
  (if (= del_max 0)
    (setq H 0 S 0)
    (progn 
      (setq S (if (< L 0.5)
                (/ del_max (+ var_max var_min))
                (/ del_max (- 2 var_max var_min))
              )
	    del_R (/ (+ (/ (- var_max var_R) 6)  (/ del_Max 2 )) del_max)
	    del_G (/ (+ (/ (- var_max var_G) 6)  (/ del_Max 2 )) del_max)
	    del_B (/ (+ (/ (- var_max var_B) 6)  (/ del_Max 2 )) del_max)
      )
      (cond
	( (= var_R var_max)
	  (setq H (- del_B del_G))
	)
	( (= var_G var_max)
	  (setq H (+ (/ 1.0 3) del_R (- del_B)))
	)
        ( (= var_B var_max)
	  (setq H (+ (/ 2.0 3) del_G (- del_R)))
	)
      )
      (cond
	( (< H 0) (setq  H (1+ H)))
	( (> H 1) (setq  H (1- H)))
      )
    )
  )
  (setq h (* 360 H)
	S (* 100 S)
	l (* 100 l) 
  )
  (list (fix H) (fix S) (fix L))
)
;;;===============
;;;把truecolordlg 
;;;420构成的数值返
;;;回RGB列表.     
;;;===============
(defun Number->RGB (C)
  (list (lsh C -16)
        (lsh (lsh C 16) -24)
        (lsh (lsh C 24) -24)
  )
)
;;;===============
;;;把truecolordlg 
;;;420构成的数值返
;;;回RGB列表.     
;;;===============
(defun RGB->Number (lst)
  (+ (lsh (car lst) 16) (lsh (cadr lst) 8) (caddr lst))
)
;;;===============
;;;RGB转化成索引号
;;;===============
(defun RGB->Index (colorObj colRGB / )
  (vla-setRGB colorobj (car colRGB) (cadr colRGB) (caddr colRGB)) 
  (vla-get-ColorIndex colorobj)
)
;;;===============
;;;索引号转化成RGB
;;;===============
(defun Index->RGB (colorobj ci / )
  (vla-put-ColorIndex  colorobj ci)
  (list (vla-get-red   colorobj)
        (vla-get-green colorobj)
        (vla-get-blue  colorobj)
  )
)
;;;=========================
;;;用entmake方法画像素点函数
;;;=========================
(defun type_putpixel (P3 colobj)
  (if (= P3 1)
    (defun putpixel (a b c / color)
      (setq color (RGB->Index colobj c))
      (fill_image a b 1 1 color)
    )
    (defun putpixel (a b c / color)
      (setq color (RGB->Number c)) 
      (entmake
	(list
	  '(0 . "LWPOLYLINE")
	  '(100 . "AcDbEntity")
	  '(100 . "AcDbPolyline")
	  '(90 . 2)
	  '(43 . 1.0)
	  (cons 420 color)
	  (cons 10 (list a b))
	  (cons 10 (list (1+ a) b))
	)
      )
    )
  )
)
;;;=========================
;;;随机函数(返回0-1的浮点值)
;;;=========================
(defun rnd (rMin rMax / ) 
  (vla-eval
    (vlax-get-acad-object)
    "Randomize : ThisDrawing.setVariable \"USERR5\" ,CDbl((Rnd))"
  )
  (if (= 'INT (type rmin) (type rmax))
    (fix (+ rMin (* (getvar "USERR5") (- rMax rMin -1))))
    (+ rMin (* (getvar "USERR5") (- rMax rMin)))
  )
)
;;;=========================
;;;列表中的字符串转化为列表 
;;;=========================
(defun string->list (x)
  (while (Wcmatch x "*\n*")
    (setq x (vl-string-subst "\"\"" "\n" x))
  )
  (read (strcat "(\"" x "\")"))
)