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))
--

This is so cool! Is there a seed or something that could be changed to generate different planets? It would be cool to use your urbit planet name as a seed to get your own personalized planet.

This is so cool! Is there a seed or something that could be changed to generate different planets? It would be cool to use your urbit planet name as a seed to get your own personalized planet.

@philipcmonk I'd like to extend it to generate a random planet from your urbit planet name as a seed yeah, that was actually my original idea but I got sidetracked just getting something decent rendering. I need to come up with a good way to incorporate the seed into the hashing but would definitely like to do that when I get time. The long term plan is actually to have a variety of different planet types (Earth-like, Mars-like, Jupiter-like, Saturn-like, Cybertron-like) that are randomly picked between and then randomize the generation but might take me a while to get to that :)

So pretty! and such a concise little math tools library!

What I wouldn't give for some comments in this beast! Is there some way to study the concepts behind this code to figure out what's going on? Or should I just read it... 😅

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