translation of fractal-code from common lisp

[HPW]

Taken from here:



http://groups.google.com/group/comp.lang.lisp/browse_thread/thread/b1f63504e8f3c484/c1c1e0935951b304#c1c1e0935951b304">http://groups.google.com/group/comp.lan ... 935951b304">http://groups.google.com/group/comp.lang.lisp/browse_thread/thread/b1f63504e8f3c484/c1c1e0935951b304#c1c1e0935951b304



Sample code from common lisp:

Code Select Expand


(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 Expand


(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 Expand


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


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

Code Select Expand


(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.