translation of fractal-code from common lisp

[HPW]

Taken from here:

http://groups.google.com/group/comp.lan ... 935951b304

Sample code from common lisp:

Code: Select all

(defun calcular-color (valor) 
  (round (* (expt 2 24) valor))) 


(defun saltarín (&key (máximo 100000) (a -1000) (b 0.1) (c -10) 
                      (x0 -1500.0) (y0 -1500.0) (x1 500.0) (y1 500.0)) 
  (clc:show-canvas 500 500) 
  (let ((ancho (/ clc:*width*  (- x1 x0))) 
        (alto  (/ clc:*height* (- y1 y0)))) 
    (do ((x           0 (- y (* (signum x) (sqrt (abs (- (* b x) 
                                                         c)))))) 
         (y           0 (- a x)) 
         (iteraciones 0 (1+ iteraciones))) 
        ((= iteraciones máximo)) 
      (clc:set-pixel (round (+ (* ancho (- x x0)))) 
                  (round (+ (* alto  (- y y0)))) 
                  (calcular-color (/ iteraciones máximo)))) 
    (clc:repaint))) 

My newLISP translation:

Code: Select all

(define (round roundnum roundret)
	(if (float? roundnum)
	 (if (<=(sub roundnum (floor roundnum)) 0.5)
		(setq roundret (integer(floor roundnum)))
		(setq roundret (integer(ceil roundnum)))
	 )
	)
	(if (integer? roundnum)
		(setq roundret roundnum)
	)
roundret
)

(define (calcularcolor valor)
  (round (* (pow 2 24) valor))
)

(define (signum svalue sret)
	(cond
		((= svalue 0.0)
		(setq sret 0)
		)
		((< svalue 0.0)
		(setq sret -1)
		)
		((> svalue 0.0)
		(setq sret 1)
		)
	)
)

(define (saltarin a b c x0 y0 x1 y1 maximo)
  (let ((ancho (div 500 (sub x1 x0)))
        (alto  (div 400 (sub y1 y0)))
        (x     0)
        (y     0)
        (iteraciones 0)
        )
    (do-until (= iteraciones maximo)
         (begin
         (setq x (sub y (mul (signum x) (sqrt(abs(sub (mul b x)c))))))
         (setq y (sub a x))
         (setq iteraciones (+ iteraciones 1))

;;        This section should draw on a 500*400 neobook image
;         (hpwImagePixels "RImage1"
;                       (round (add (mul ancho (sub x x0))))
;                       (round (add (mul alto  (sub y y0))))
;                       (calcularcolor (/ iteraciones maximo))
;         )

         )
    )
  )
)

Any comments if translation is correct?

[Lutz]

in 'roundnum' and in 'signum' you don't need those 'ret'- variables. Instead much shorter:

Code: Select all

(define (signum svalue)
  (if (< svalue 0) -1
      (> svalue 0) 1 
      0)
)

'roundnum'c an also made be shorter in several ways:

Code: Select all

(define (roundnum num) 
    (if (> num 0) 
        (int (add num 0.5)) 
        (int (sub num 0.5)))
)

Lutz

[HPW]

Thanks for the code. As always much shorter and more lispy.

But I was not sure if I translate the 'let' and 'do' structure right from common lisp. And since I have not understand the original code completly I am not sure that I get the right coordinates for the drawing code. Have to further test.