Procedural Planet raytracer in Hoon

planetppm.hoon

|=  dim=@ud  ^-  (list @t)
=/  dx  (div:rs .1 (sun:rs dim))
=/  white  [.1 .1 .1]
=<  (genppm dim)
|%
++  min
    |=  [x=@rs y=@rs]  ^-  @rs
    ?:  (lth:rs x y)  x  y
++  max
    |=  [x=@rs y=@rs]  ^-  @rs
    ?:  (lth:rs x y)  y  x
++  maxv
    |=  [x=(list @rs) y=@rs]  ^-  (list @rs)
    (turn x |=(u=@rs (max u y)))
++  neg
    |=  x=@rs  ^-  @rs
    (sub:rs .0 x)
++  abs
    |=  x=@rs  ^-  @rs
    ?:  (lth:rs x .0)  (neg x)  x
++  sqr
    |=  x=@rs  ^-  @rs
    (mul:rs x x)
++  pow
    |=  [x=@rs y=@rs]  ^-  @rs
    =/  prec  .0.001
    |-  ^-  @rs
    ?:  (lth:rs y .0)
        (div:rs .1 $(y (neg y)))
    ?:  (gte:rs y .10)
        (sqr $(y (mul:rs y .0.5), prec (mul:rs prec .0.5)))
    ?:  (gte:rs y .1)
        (mul:rs x $(y (sub:rs y .1)))
    ?:  (gte:rs prec .1)
        (sqt:rs x)
    (sqt:rs $(y (mul:rs y .2), prec (mul:rs prec .2)))
++  gain
    |=  [x=@rs k=@rs]  ^-  @rs
    =/  a  (mul:rs .0.5 (pow (mul:rs .2 ?:((lth:rs x .0.5) x (sub:rs .1 x))) k))
    ?:((lth:rs x .0.5) a (sub:rs .1 a))
++  clamp
    |=  [x=@rs a=@rs b=@rs]  ^-  @rs
    (min (max x a) b)
++  saturate
    |=  x=@rs  ^-  @rs
    (clamp x .0 .1)
++  smoothstep
    |=  [a=@rs b=@rs x=@rs]  ^-  @rs
    =/  t  (saturate (div:rs (sub:rs x a) (sub:rs b a)))
    (mul:rs t (mul:rs t (sub:rs .3 (mul:rs .2 t))))
++  binopv
    |=  [x=(list @rs) y=(list @rs) f=$-([@rs @rs] @rs)]  ^-  (list @rs)
    p:(spin x y |=([u=@rs v=(list @rs)] ?~(v !! [(f u i.v) t.v])))
++  addv
    |=  [x=(list @rs) y=(list @rs)]  ^-  (list @rs)
    (binopv x y add:rs)
++  subv
    |=  [x=(list @rs) y=(list @rs)]  ^-  (list @rs)
    (binopv x y sub:rs)
++  mulv
    |=  [x=(list @rs) y=(list @rs)]  ^-  (list @rs)
    (binopv x y mul:rs)
++  dot
    |=  [x=(list @rs) y=(list @rs)]  ^-  @rs
    (roll (mulv x y) add:rs)
++  mag
    |=  x=(list @rs)  ^-  @rs
    (sqt:rs (dot x x))
++  muls
    |=  [x=(list @rs) y=@rs]  ^-  (list @rs)
    (turn x |=(u=@rs (mul:rs u y)))
++  lerpv
    |=  [x=(list @rs) y=(list @rs) t=@rs]  ^-  (list @rs)
    (addv (muls x (sub:rs .1 t)) (muls y t))
++  norm
    |=  x=(list @rs)  ^-  (list @rs)
    =/  m  (mag x)
    =/  mi  (div:rs .1 m)
    (muls x mi)
++  rtz
    |=  x=@rs  ^-  @rs
    (san:rs (fall (toi:rs x) --0))
++  floor
    |=  x=@rs  ^-  @rs
    ?:((lth x .0) (sub:rs (rtz x) .1) (rtz x))
++  floorv
    |=  x=(list @rs)  ^-  (list @rs)
    (turn x floor)
++  frac
    |=  x=@rs  ^-  @rs
    (sub:rs x (floor x))
++  fracv
    |=  x=(list @rs)  ^-  (list @rs)
    (turn x frac)
++  xv
    |=  x=(list @rs)  ^-  @rs
    (snag 0 x)
++  yv
    |=  x=(list @rs)  ^-  @rs
    (snag 1 x)
++  zv
    |=  x=(list @rs)  ^-  @rs
    (snag 2 x)
++  hash2d
    |=  x=(list @rs)  ^-  (list @rs)
    =/  k  ~[.0.3183099 .0.3678794]
    =/  y  (addv (mulv x k) (flop k))
    =/  a  (mul:rs .16 (frac (mul:rs (mul:rs (xv y) (yv y)) (add:rs (xv y) (yv y)))))
    (addv ~[.-1 .-1] (muls (fracv (muls k a)) .2))
++  noise2dd
    |=  p=(list @rs)  ^-  (list @rs)
    =/  i  (floorv p)
    =/  f  (fracv p)
    =/  u  (mulv f (mulv f (mulv f (addv (mulv f (subv (muls f .6) ~[.15 .15])) ~[.10 .10]))))
    =/  ga  (hash2d (addv i ~[.0 .0]))
    =/  gb  (hash2d (addv i ~[.1 .0]))
    =/  gc  (hash2d (addv i ~[.0 .1]))
    =/  gd  (hash2d (addv i ~[.1 .1]))
    =/  va  (dot ga (subv f ~[.0 .0]))
    =/  vb  (dot gb (subv f ~[.1 .0]))
    =/  vc  (dot gc (subv f ~[.0 .1]))
    =/  vd  (dot gd (subv f ~[.1 .1]))
    =/  t4  (mul:rs (xv u) (mul:rs (yv u) (add:rs (sub:rs (sub:rs va vb) vc) vd)))
    =/  t3  (mul:rs (yv u) (sub:rs vc va))
    =/  t2  (mul:rs (xv u) (sub:rs vb va))
    =/  v  (add:rs (add:rs va t2) (add:rs t3 t4))
    ~[v .0 .0]
++  fbm2dd
    |=  p=(list @rs)  ^-  (list @rs)
    =/  n  0
    =/  w  .0.66
    =/  acc  (limo ~[.0 .0 .0])
    |-  ^-  (list @rs)
    =/  nois  (muls (noise2dd p) w)
    ?:(=(n 6) acc $(n +(n), p (muls p .2), w (mul:rs w .0.5), acc (addv nois acc)))
++  len2
    |=  x=(list @rs)  ^-  @rs
    (dot x x)
++  minelem
    |=  x=(list @rs)  ^-  @rs
    =/  d=@rs  .1e30
    |-
    ?~  x
        d
    $(d (min d i.x), x t.x)
++  worley
    |=  p=(list @rs)  ^-  @rs
    =/  offs  ~[~[.-1 .-1] ~[.0 .-1] ~[.1 .-1] ~[.-1 .0] ~[.0 .0] ~[.1 .0] ~[.-1 .1] ~[.0 .1] ~[.1 .1]]
    =/  f  |=  off=(list @rs)  ^-  @rs
           =/  tp  (addv (floorv p) off)
           (len2 (subv (subv p tp) (hash2d tp)))
    =/  ds=(list @rs)  (turn offs f)
    =/  d  (minelem (limo ds))
    (mul:rs .3 (pow .2.718 (mul:rs .-4 (abs (sub:rs (mul:rs d .2) .1)))))
++  fworley
    |=  p=(list @rs)  ^-  @rs
    =/  n  0
    =/  off=(list @rs)  ~[.2.5 .2.5]
    =/  r=@rs  .1
    |-  ^-  @rs
    =/  worl=@rs  (worley (addv p off))
    =/  newp=(list @rs)  (muls p .2)
    =/  newoff=(list @rs)  (addv (muls off .0.5) ~[.1.173 .1.173])
    ?:(=(n 6) (sqt:rs (sqt:rs (sqt:rs r))) $(n +(n), p newp, off newoff, r (mul:rs worl r)))
++  col
    |=  [x=@rs y=@rs]  ^-  [@rs @rs @rs]
    =/  xt  (mul:rs (sub:rs x .0.5) .2)
    =/  yt  (mul:rs (sub:rs y .0.5) .2)
    =/  ro  ~[.0 .0 .2.5]
    =/  rd  (norm ~[xt yt .-2])
    =/  b  (dot ro rd)
    =/  c  (sub:rs (dot ro ro) .1)
    =/  h  (sub:rs (mul:rs b b) c)
    ?:  (gth:rs h .0)
        =/  t  (sub:rs (neg b) (sqt:rs h))
        =/  pos  (addv ro (muls rd t))
        =/  n  pos
        =/  dif  (max (add:rs (mul:rs (snag 0 n) .2) (snag 2 n)) .0)
        ::[dif dif dif]
        =/  zlus1  (add:rs (zv n) .1)
        =/  nc  (muls (addv ~[(div:rs (xv n) zlus1) (div:rs (yv n) zlus1)] ~[.1 .1]) .3)
        =/  nois  (fbm2dd nc)
        =/  wateramt  .0.5
        =/  wateramtv  (sub:rs (mul:rs wateramt .2) .1)
        =/  nv  (saturate (xv nois))
        =/  albt  (smoothstep wateramtv (add:rs wateramtv .0.01) nv)
        =/  alb  (lerpv (limo ~[.0.05 .0.27 .0.44]) (lerpv (limo ~[.0.4 .0.45 .0.32]) (limo ~[.0.3 .0.2 .0.1]) nv) albt)
        =/  spe  (saturate (dot n (norm ~[.0.4 .-0.3 .1])))
        =/  spev  (mul:rs (pow spe .64) (sub:rs .1 albt))
        =/  cityamt  (mul:rs (smoothstep .0.0 dif .0.2) albt)
        =/  fwor  ?:((gth:rs cityamt .0) (fworley nc) .0)
        =/  city  (pow fwor .2.5)
        =/  emm  (maxv (muls ~[.1.8 (mul:rs .1.8 city) .0.5] city) .0)
        =/  cloud  (gain (smoothstep .-0.15 .0.3 (xv (fbm2dd (addv nc ~[.3.7 .9.6])))) .1.5)
        =/  albc  (lerpv alb ~[.1.2 .1.2 .1.2] cloud)
        =/  lit  (addv (addv (muls albc (add:rs .0.08 (mul:rs dif .0.75))) ~[spev spev spev]) (muls emm cityamt))
        :: [cityamt cityamt cityamt]
        [(xv lit) (yv lit) (zv lit)]
        :: [nv nv nv]
    [.0.1 .0.1 .0.1]
++  rs-to-byte
    |=  x=@rs  ^-  @ud
    `@ud`(abs:si (fall (toi:rs (mul:rs (saturate x) .255)) --0))
++  pix
    |=  [px=@ py=@]  ^-  [@ud @ud @ud]
    =/  x=@rs  (sub:rs .1 (div:rs (sun:rs px) (sun:rs (dec dim))))
    =/  y=@rs  (sub:rs .1 (div:rs (sun:rs py) (sun:rs (dec dim))))
    =/  c  (col x y)
    [(rs-to-byte -:c) (rs-to-byte +<:c) (rs-to-byte +>:c)]
++  genrow
    |=  y=@ud  ^-  tape
    =/  x=@ud  0
    =/  acc  ""
    |-  ^-  tape
    ?:  =(x dim)  acc
    =/  col  (pix x y)
    $(x +(x), acc (weld "{<-:col>} {<+<:col>} {<+>:col>} " acc))
++  genimg
    |=  dim=@ud  ^-  (list @t)
    =/  y=@ud  0
    =/  acc=(list @t)  ~
    |-  ^-  (list @t)
    ?:  =(y dim)  acc
    ~&  "Row: {<y>}"
    =/  row  `@t`(crip (genrow y))
    $(y +(y), acc [row acc])
++  genppm
    |=  dim=@ud  ^-  (list @t)
    =/  header  ~['P3' (crip "{<dim>} {<dim>}") '255']
    (weld header (genimg dim))
--

@0x70b1a5 most of the techniques are fairly standard stuff that you'll find used in Shadertoy shaders. I actually prototyped this in Shadertoy and the Hoon version is a pretty direct translation of the GLSL there, some of the functions being mostly ripped off from other Shadertoy shaders.

Everything up to the ++hash2d arm is fairly standard math functions, 2D and 3D vectors are just lists of Hoon floats and then vector ops like addv are implemented using the binopv utility function to map Hoon floating point binary operations over those lists. ++hash2d is a hoon version of a Shadertoy 2D floating point hash function - given a 2D floating point vector it returns a pseudo-random 2D floating point value between -1 and 1. The arms down to ++col are implementations of 2D Perlin noise and Worley noise and their 'fractal' variants - 'Fractal Brownian Motion' just sums up octaves of Perlin noise and ++fworley does the same sort of thing with Worley noise.

The ++col arm then does a very hard coded ray/sphere intersection generating a normal and a 2D texture coordinate for the planet surface and then uses the noise functions to build up color and material values for the water, land, clouds and 'city lights' and feeds those into a simple lighting formula with a hard coded light position to generate a final pixel color.

The remainder of the code is just generating rays at each pixel and calling ++col to get the resulting color value, then converting from floating point colors to 24 bit RGB and generating a list of tapes representing the image in PPM format.

If you have specific questions about any parts of the code let me know and I'll do my best to answer or point you at more info on the techniques used.