life.hoon

:: Conway's game of life: http://urbit.org/docs/hoon/exercises/life/
:: Solution up to prompt 7.
!:
::
=<  |=  times/@
    (life times)
::
=>  |%
    ++  spot   {r/@ c/@}
    ++  row    (list ?)
    ++  board  {n/@ b/(list row)}
    --
::
|%
++  life
  |=  times/@
  =+  board=(create-board 10)
  =+  next=board
  |-  ^-  tang
  ?:  (lte times 0)
    ~(print bo next)
  $(next (~(step bo board) next), board next, times (dec times))
::
++  create-board
  |=  n/@
  =+  moves=(limo ~[(spot 1 2) (spot 2 3) (spot 3 1) (spot 3 2) (spot 3 3)]) :: starting configuration
  =+  b=[(dec n) (reap n (reap n |))]
  |-  ^-  board
  ?~  moves
    b
  $(b (toggle b i.moves), moves t.moves)
::
:::: Board Operations
::
++  bo
  |_  b/board
  ::
  ++  step                                              :: iterate each spot
    |=  new/board                                       :: new board to build
    =+  r=0                                             :: row
    =+  c=0                                             :: column
    |-  ^-  board                                       :: loop
    =+  s=(spot r c)
    ?:  &((gte r n.b) (gte c n.b))
      new
    ?.  =(~(next so s) (get s))
      $(new (toggle new s), r ?:((gte c n.b) +(r) r), c ?:((gte c n.b) 0 +(c)))
    $(r ?:((gte c n.b) +(r) r), c ?:((gte c n.b) 0 +(c)))
  ::
  ++  get  |=(s/spot (snag c.s (snag r.s b.b)))
  ::
  ::: Spot Operations
  ::
  ++  so
    |_  cc/spot
    ++  next
      =+  l=(skid adj |=(a/? a))
      ?.  (get cc)                                     :: if not alive (if dead)
        =(3 (lent p.l))                                :: dead -> alive
      |(=(3 (lent p.l)) =(2 (lent p.l)))               :: alive -> still alive
    ::
    ++  adj                                             :: list of adjacent
      (limo ~[nw nc ne cw ce sw sc se])
    ::
    ::: adjacent sides
    ::
    ++  nw
      ?:  |((lte r.cc 0) (lte c.cc 0))  |
      (get (spot (dec r.cc) (dec c.cc)))
    ++  nc
      ?:((lte r.cc 0) | (get (spot (dec r.cc) c.cc)))
    ++  ne
      ?:  |((lte r.cc 0) (gte +(c.cc) n.b))  |
        (get (spot (dec r.cc) +(c.cc)))
    ++  cw
      ?:((lte c.cc 0) | (get (spot r.cc (dec c.cc))))
    ++  ce
      ?:((gte +(c.cc) n.b) | (get (spot r.cc +(c.cc))))
    ++  sw
      ?:  |((gte +(r.cc) n.b) (lte c.cc 0))  |
        (get (spot +(r.cc) (dec c.cc)))
    ++  sc
      ?:((gte +(r.cc) n.b) | (get (spot +(r.cc) c.cc)))
    ++  se
      ?:  |((gte +(r.cc) n.b) (gte +(c.cc) n.b))  |
        (get (spot +(r.cc) +(c.cc)))
    --
  ::
  ++  print
    ^-  tang
    %+  turn  (flop b.b)
    |=  row/(list ?)
    :-  %leaf
    ^-  tape
    %+  turn  row
    |=  space/?
    ?:  space
      '# '
    '. '
  --
::
::
:: I'm not satisfied with `toggle` and `ro` below. I think there is probably a
:: better way to both:
::
:: a) implement the functionality of `toggle`, and
:: b) structure the code, i.e. not have it seem orphaned from the rest of the
::    board logic above
::
++  toggle
  |=  {b/board here/spot}
  ^-  board
  =+  r=(snag r.here b.b)
  =+  h=(scag r.here b.b)
  =+  t=(slag +(r.here) b.b)
  =+  u=(limo ~[(~(toggle ro r) c.here)])
  [n.b (weld (weld h u) t)]
::
:::: Row Operations
::
++  ro
  |_  r/row
  ++  toggle
    |=  c/@
    ^-  row
    =+  h=(scag c r)                                    :: head
    =+  t=(slag +(c) r)                                 :: tail
    =+  u=(limo ~[!(snag c r)])                         :: updated row
    (weld (weld h u) t)
  --
--
::