Hi,
If anyone is interested, here is the fixed-point version of Paul Graham’s ray
tracer from “ANSI Common Lisp”:
~~~
# P.Graham: "ANSI Common Lisp"
# ray tracer
#
(gc 256)
(scl 4)
(de sq (X) (*/ X X 1.0))
(de mag (X Y Z)
(sqrt (+ (* X X) (* Y Y) (* Z Z))) )
(de make-point (X Y Z)
(list X Y Z) )
(de unit-vector (X Y Z)
(let M (mag X Y Z)
(list (*/ 1.0 X M) (*/ 1.0 Y M) (*/ 1.0 Z M))) )
(setq x car)
(setq y cadr)
(setq z caddr)
(de quasi-distance (P1 P2)
(+
(abs (- (x P1) (x P2)))
(abs (- (y P1) (y P2)))
(abs (- (z P1) (z P2))) ) )
(de minroot2 (A B C Disc)
(if (=0 A)
(*/ (- C) 1.0 B)
(let DiscRt (sqrt Disc)
(*/ (min (- DiscRt B)
(- (- B) DiscRt) )
(* 2 A) ) ) ) )
(class +Surface)
# color
(dm T (C)
(=: color (or C 0)) )
(dm intersect> (Pt R))
(dm normal> (Pt))
(setq *world* NIL)
(setq eye (list 0 0 200.0))
(de raytrace (Path Res)
(out Path
(setq Res (or Res 1))
(println 'P2 (* 100 Res) (* 100 Res) 255)
(let Inc (*/ 1.0 Res)
(let Y -50.0
(loop
(let X -50.0
(loop
(println (color-at X Y))
(inc 'X Inc)
(T (< (- 50.0 X) Inc)) ) )
(inc 'Y Inc)
(T (< (- 50.0 Y) Inc)) ) ) ) ) )
(de color-at (X Y)
(let ((Xr Yr Zr) (unit-vector (- X (x eye))
(- Y (y eye))
(- 0 (z eye)) ) )
(/ (+ 0.5 (* (sendray eye Xr Yr Zr) 255)) 1.0) ) )
(de sendray (Pt Xr Yr Zr)
(let ((S Int) (first-hit Pt Xr Yr Zr))
(if S
(*/ (lambert S Int Xr Yr Zr) (; S color) 1.0)
0) ) )
(de first-hit (Pt Xr Yr Zr)
(let (Surface NIL Hit NIL Dist 10.0)
(for S *world*
(let H (intersect> S Pt Xr Yr Zr)
(when H
(let D (quasi-distance H Pt)
(when (< D Dist)
(setq Surface S Hit H Dist D) ) ) ) ) )
(list Surface Hit) ) )
(de lambert (S Int Xr Yr Zr)
(let ((Xn Yn Zn) (normal> S Int))
(max 0 (+ (*/ Xr Xn 1.0) (*/ Yr Yn 1.0) (*/ Zr Zn 1.0))) ) )
# (/ (max 0 (+ (* Xr Xn) (* Yr Yn) (* Zr Zn))) 1.0) ) ) # pil21
(class +Sphere +Surface)
# radius center dx dy dz pc
(dm T (R P C)
(super C)
(=: radius (or R 0))
(=: center (or P (make-point 0 0 0
(de defsphere (X Y Z R C)
(let S (new '(+Sphere) R (make-point X Y Z) C)
(push '*world* S)
S ) )
(dm intersect> (Pt Xr Yr Zr)
(let (Px (x Pt)
Py (y Pt)
Pz (z Pt)
C (: center)
Dx (- Px (x C))
Dy (- Py (y C))
Dz (- Pz (z C))
A (+ (sq Xr) (sq Yr) (sq Zr))
B (*/ 2 (+ (* Dx Xr)
(* Dy Yr)
(* Dz Zr)) 1.0)
C (- (+ (sq Dx) (sq Dy) (sq Dz)) (sq (: radius
(let (B2 (* B B)
AC4 (* 4 A C) )
(if (>= B2 AC4)
(let (N (minroot2 A B C (- B2 AC4)))
(list
(+ Px (* N Xr))
(+ Py (* N Yr))
(+ Pz (* N Zr)) ) ) ) ) ) )
(dm normal> (Pt)
(let C (: center)
(unit-vector
(- (x C) (x Pt))
(- (y C) (y Pt))
(- (z C) (z Pt)) ) ) )
(de raytest (Res)
(setq Res (or Res 1))
(setq *world* NIL)
(defsphere 0 -300.0 -1200.0 200.0 0.8)
(defsphere -80.0 -150.0 -1200.0 200.0 0.7)
(defsphere 70.0 -100.0 -1200.0 200.0 0.9)
(for X (-2 -1 0 1 2)
(for Z (2 3 4 5 6 7)
(defsphere (* X 200.0) 300.0 (* Z -400.0) 40.0 0.75) ) )
(raytrace (pack "spheres" (format Res) ".pgm") Res) )
(de main ()
(for Res (1 2 4 8 16)
(gc)
(bench (raytest Res)) ) )
# vim:set ts=3 sw=3 et:
~~~
Regards,
pahihu
> On 2025. Mar 23., at 10:51, Alexander Burger wrote:
>
> On Sat, Mar 22, 2025 at 11:12:52PM -0700, Lindsay Lawrence wrote:
>> Not sure when it was added, but I just want to say that the added
>> annotation for fixed point values, when scl is set, is an amazingly useful
>> feature for the repl.
>
> Glad that you like it! This concept of REPL-comments is generalized via
> the 'remark' function
>
> https://software-lab.de/doc/refR.html#remark
>
> and was added in PicoLisp 24.12.
>
> It displays not only fixpoint values, but also dates, the namespaces of
> symbols (unless in 'pico' or 'priv'), and the classes of objects.
>
> Note that it is used not only for the REPL return values, but also in
> the 'show' function and in Vip's structure editing.
>
> ☺/ A!ex
>
> --
> UNSUBSCRIBE: mailto:picolisp@software-lab.de?subject=Unsubscribe
--
UNSUBSCRIBE: mailto:picolisp@software-lab.de?subject=Unsubscribe
