julia-function5.lsp

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

;;;==========================
;;;Julia算法函数(带参数)     
;;;==========================
(defun Julia (J1 J2 J3 X0 Y0 X1 Y1 X2 Y2 col0 G1 R2 R3 P3 S1 / 
	      Pw Ph dx dy i j rez imz count TmpReZ TmpImZ absZ 
	      nclr nH nS nL nR nG nB HSL0 colRGB ncolor TH TS TL TR)
  (type_putpixel P3 colobj)
  (choose_distance R3)
  (choose_fun S1)
  (setq HSL0 (RGB->HSL (car col0) (cadr col0) (caddr col0)))
  (setq TH (atoi (nth 0 R2)))
  (setq TS (atoi (nth 1 R2)))
  (setq TL (atoi (nth 2 R2)))
  (setq TR (atoi (nth 3 R2)))
  (setq Pw (car J2) Ph (cadr J2))
  (setq dx (/ (- X2 X1) Pw))
  (setq dy (/ (- Y2 Y1) Ph))
  (setq i 0)
  (setq k 0)
  (repeat Pw
    (setq j 0)
    (repeat Ph
      (setq reZ (+ X1 (* i dx)))                                   ;迭代原点实部
      (setq imZ (+ Y1 (* j dy)))                                   ;迭代原点虚部
      (setq count 0)                                               ;计数器归零
      (while (<= count J1)                                         ;如果小于最大迭代次数
	;;(setq TmpReZ (+ (* reZ reZ) (* imZ imZ -1) X0))          ;新的实部
	;;(setq TmpImZ (+ (* 2 reZ imZ) Y0))                       ;新的虚部
	(setq tmprez (fx rez imz x0))
	(setq tmpimz (fy rez imz y0))	
	(setq absZ (dist TmpReZ TmpImZ))                           ;距离函数
	(if (> absZ J3)                                            ;如果距离大于逃逸半径
	  (progn
	    (setq nclr (* G1 count))                               ;渐变层次或函数
	    (setq nH (rem (+ (* TH nclr) (car   HSL0)) 361))       ;色泽度渐变
	    (setq nS (rem (+ (* TS nclr) (cadr  HSL0)) 101))       ;饱和度渐变
	    (setq nL (rem (+ (* TL nclr) (caddr HSL0)) 101))       ;明暗度渐变
	    (setq colRGB (HSL->RGB nH nS nL))                      ;色彩转换
	    (setq nR (rem (+ (* TR nclr) (car   colRGB)) 256)      ;红蓝绿渐变
                  nG (rem (+ (* TR nclr) (cadr  colRGB)) 256)
	          nB (rem (+ (* TR nclr) (caddr colRGB)) 256)
                  colRGB (list nR nG nB)
	    )
            (putpixel i j colRGB)                                      ;画像素点
	    (setq count J1)                                        ;终止迭代
	  )
	  (setq rez TmpReZ imz TmpImZ)                             ;用新的迭代
	)
	(setq count (1+ count))
      )
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )
)
;;;==========================
;;;Mandelbrot算法函数(带参数)
;;;==========================
(defun Mandelbrot (J1 J2 J3 X0 Y0 X1 Y1 X2 Y2 col0 G1 R2 R3 P3 S1 /  Pw Ph
		   dx dy i j rePart imPart rez imz absZ TmpReZ TmpImZ count 
		   nclr nH nS nL nR nG nB HSL0 colRGB ncolor TH TS TL TR)
  (type_putpixel P3 colobj)
  (choose_distance R3)
  (choose_fun S1)
  (setq HSL0 (RGB->HSL (car col0) (cadr col0) (caddr col0)))
  (setq TH (atoi (nth 0 R2)))
  (setq TS (atoi (nth 1 R2)))
  (setq TL (atoi (nth 2 R2)))
  (setq TR (atoi (nth 3 R2)))
  (setq Pw (car J2) Ph (cadr J2))
  (setq dx (/ (- X2 X1) Pw))
  (setq dy (/ (- Y2 Y1) Ph))
  (setq i 0)
  (repeat Pw
    (setq j 0)
    (repeat Ph
      (setq rePart (+ X1 (* i dx)))                                ;实部
      (setq imPart (+ Y1 (* j dy)))                                ;虚部
      (setq reZ 0 imZ 0)                                           ;迭代原点(本可以取X0,Y0的)
      (setq count 0)
      (while (<= count J1)                                         ;如果小于最大迭代次数
	;;(setq TmpReZ (+ (* reZ reZ) (* imZ imZ -1) rePart))      ;新的实部
	;;(setq TmpImZ (+ (* 2 reZ imZ) imPart))                   ;新的虚部
	(setq tmprez (fx rez imz repart))
	(setq tmpimz (fy rez imz impart))
	(setq absZ (dist TmpReZ TmpImZ))                           ;距离函数
	(if (> absZ J3)                                            ;如果距离大于逃逸半径
	  (progn                                                   ;则
	    (setq nclr (* G1 count))                               ;渐变层次或函数
	    (setq nH (rem (+ (* TH nclr) (car   HSL0)) 361))       ;色泽度渐变
	    (setq nS (rem (+ (* TS nclr) (cadr  HSL0)) 101))       ;饱和度渐变
	    (setq nL (rem (+ (* TL nclr) (caddr HSL0)) 101))       ;明暗度渐变
	    (setq colRGB (HSL->RGB nH nS nL))                      ;色彩转换
	    (setq nR (rem (+ (* TR nclr) (car   colRGB)) 256)      ;红蓝绿渐变
                  nG (rem (+ (* TR nclr) (cadr  colRGB)) 256)
	          nB (rem (+ (* TR nclr) (caddr colRGB)) 256)
                  colRGB (list nR nG nB)
	    )
            (putpixel i j colRGB)                                      ;画像素点
	    (setq count J1)                                        ;终止迭代
	  )                                                        ;否则
	  (setq rez TmpReZ imz TmpImZ)                             ;用新的迭代
	)
	(setq count (1+ count))
      )
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )
)
;;;==========================
;;;逃逸函数(也可自己定义逃逸)
;;;==========================
(defun choose_distance (vv)
  (cond
    ;;标准逃逸
    ( (= vv "T3")           
      (defun dist (a b)
        (+ (* a a) (* b b))
      )
    )
    ;;X逃逸
    ( (= vv "T4")
      (defun dist (a b)
        (* a a)
      )
    )
    ;;Y逃逸
    ( (= vv "T5")
      (defun dist (a b)
        (* b b)
      )
    )
    ;;斑纹
    ( (= vv "T6")
      (defun dist (a b)
        (* a b)
      )
    )
    ;;自定义
    ( (= vv "T7")
      (defun dist (a b)
        (- (* a a) (* b b))
      )
    )
  )
)
;;;==========================
;;;复数迭代次方(越高时间越长)
;;;==========================
(defun choose_fun (nn)
  (cond
    ( (= nn "2")
      (defun FX (x y Cx0)
	(+ (* x x) (* y y -1) Cx0)
      )
      (defun FY (x y Cy0)
	(+ (* 2 x y) Cy0)
      )
    )
    ( (= nn "3")
      (defun FX (x y Cx0)
	(+ (* x x x)   (* -3 x y y) Cx0)
      )
      (defun FY (x y Cy0)
	(+ (* 3 x x y) (* -1 y y y) Cy0)
      )
    )
    ( (= nn "4")
      (defun FX (x y Cx0)
	(+ (* x x x x) (* -6 x x y y) (* y y y y) Cx0)
      )
      (defun FY (x y Cy0)
	(+ (* 4 x x x y) (* -4 x y y y) Cy0)
      )
    )
    ( (= nn "5")
      (defun FX (x y Cx0)
	(+ (* x x x x x) (* -10 x x x y y) (* 5 x y y y y) Cx0)
      )
      (defun FY (x y Cy0)
	(+ (* y y y y y) (* -10 x x y y y) (* 5 x x x x y) Cy0)
      )
    )
    ( (= nn "6")
      (defun FX (x y Cx0)
	(+ (* x x x x x x) (* -1 y y y y y y) (* -15 x x x x y y) (* 15 x x y y y y) Cx0)
      )
      (defun FY (x y Cy0)
	(+ (* 6 x x x x x y) (* -20 x x x y y y) (* 6 x y y y y y) Cy0)
      )
    )
  )
)