(* Linear-time (?) algebraic two-dimensional layout.  Example:

* =====================================================================
- |Chapters                                                       Page|
* |-------------------------------------------------------------------|
  | 0.|The unchained desert of the singing perfume. .  .  .  .  .    1|
* | 1.|La brisa ilusa de la neblina abandonada. .  .  .  .  .  .    43|
- | 2.|The smiling murder within her young daughters. .  .  .  .    80|
* | 3.|Un miedo exuberante de la manzana digna gritando. .  .  .    96|
  | 4.|False villages of the foolish monks. .  .  .  .  .  .  .  . 114|
* | 5.|La ternura insepulta de su odisea sangrienta y apacible. .  124|
- | 6.|The brazen river of his filthy, fallen ivory. .  .  .  .  . 166|
* | 7.|The laughing monster of his humble scream. .  .  .  .  .  . 203|
  | 8.|The rough tattoo of his unchained abomination. .  .  .  .   219|
* | 9.|Una viuda viva de aquella capucha inmunda y desmoronada. .  237|
- |10.|The sweet tower of the smooth fire. .  .  .  .  .  .  .  .  247|
* =====================================================================

 * This was 65 lines of Python (alglayout.py) but is only 38 lines of OCaml,
 * which runs 500 times as fast as the Python version and 10 times as fast
 * as printf.
 *
 * But it doesn’t support Unicode, and the example layout is twice as much
 * code.  And the apparent compression may just be a matter of being
 * written with wider lines.
 *
 * Compiled with ocamlopt for amd64, this takes 451,190 instructions
 * to produce those 1080 bytes of output, according to cachegrind.  A
 * hello-world OCaml program takes 303,486, so two thirds of these
 * instructions are in program startup (mostly ld.so stuff), and
 * 147,704 instructions are in this actual code, 137 per output byte.
 * (Compiled instead with `ocamlopt -fno-PIC -ccopt -static alglayout.ml`
 * it takes 188,638 instructions, reinforcing the above estimate.)
 * An earlier version of the program using printf took 1,750,143,
 * 1340 instructions per byte.
 *)

type box = box' * (int * int)      (* the ints are width and height *)
and box' = 
| Hbox of box * box * int     (* includes horizontal divider pos *)
| Vbox of box * box * int     (* includes vertical divider pos *)
| Tile of box                 (* one or more repetitions in X and Y *)
| String of string            (* A leafnode *)

let width (_, (w, _): box): int = w and height (_, (_, h): box): int = h

let sbox (s: string): box = String s, (String.length s, 1)

let tile (b: box): box = Tile b, (width b, height b)

(* Horizontal composition with an Hbox, stacking boxes left to right *)
let (<:>) (left: box) (right: box): box =
  Hbox(left, right, width left),
  (width left + width right, max (height left) (height right))

(* Vertical composition with a Vbox, stacking boxes top to bottom *)
let (<..>) (top: box) (bottom: box): box =
  Vbox(top, bottom, height top),
  (max (width top) (width bottom), height top + height bottom)

(* Pad s out to w bytes with space on the left, or truncate it if necessary *)
let leftpad (w: int) (s: string) (tail: string list): string list =
  let n = w - String.length s in
  if n >= 0 then String.make n ' ' :: s :: tail else String.sub s 0 w :: tail

(* Returns a single line of text (line #y) from the layout with “tail”
   to its right.  “w” specifies how wide the output should be; negative
   values are interpreted as 0. *)
let rec scan ((b, (w, h)) as this: box) y w (tail: string list): string list =
  match b with
  | String s -> leftpad (if w > 0 then w else 0) (if y > 0 then "" else s) tail

  | Hbox(left, right, off) ->
    scan left y (if w < off then w else off) (scan right y (w - off) tail)

  | Vbox(top, _, off) when y < off -> scan top y w tail
  | Vbox(_, bottom, off) -> scan bottom (y - off) w tail

  | Tile c ->
    let w' = min w (width c) and y = y mod height c in
    if w' <= 0 then tail else scan c y w' (scan this y (w - w') tail)

let draw (chan: out_channel) (b: box) (ymin: int) (ymax: int) (w: int): unit =
  for y = ymin to ymax do List.iter (output_string chan) (scan b y w ["\n"])
  done

let show (chan: out_channel) (b: box): unit =
  draw chan b 0 (height b - 1) (width b)

let rec stack (combiner: box -> box -> box): box list -> box = function
  | [] -> raise (Failure "Empty stack")
  | [item] -> item
  | item::items -> combiner item (stack combiner items)

let vstack = stack (<..>) and hstack = stack (<:>)


(* Example data: *)

let titles = ["The unchained desert of the singing perfume.";
              "La brisa ilusa de la neblina abandonada.";
              "The smiling murder within her young daughters.";
              "Un miedo exuberante de la manzana digna gritando.";
              "False villages of the foolish monks.";
              "La ternura insepulta de su odisea sangrienta y apacible.";
              "The brazen river of his filthy, fallen ivory.";
              "The laughing monster of his humble scream.";
              "The rough tattoo of his unchained abomination.";
              "Una viuda viva de aquella capucha inmunda y desmoronada.";
              "The sweet tower of the smooth fire.";
              ]

(* Example data includes generated chapter numbers and “random” page numbers. *)
let rec chap n tl =
  if n = 0 then tl else chap (n - 1) ((string_of_int (n - 1) ^ ".") :: tl)
and num n p = if n = 0 then [] else p :: num (n - 1) (p + 6 + p * 77 mod 41)
let pnos = num (List.length titles) 1 and chapnos = chap (List.length titles) []

(* Example layout for it: *)

(* Use multi-character sections for horizontal rules as a micro-optimization *)
let vr = tile(sbox "|") and hr = tile(sbox "----") and dhr = tile(sbox "======")
(* This is another micro-optimization: by constructing a Tile backed by several
 * copies of the filler string, we speed up output, but must override the
 * width.  This speeds the program up by about 10%.
 *)
let dots = Tile (sbox " .  .  . "), (3, 1)

let titlecol = vstack (List.map (fun s -> sbox s <:> dots) titles) 
let chaptable = vstack (List.map sbox chapnos) <:> vr <:> titlecol
let left = sbox "Chapters" <:> sbox "" <..> hr <..> chaptable
let pagecol = vstack (List.map sbox (List.map string_of_int pnos))
let pages = sbox "Page" <..> hr <..> pagecol
let decor = tile(vstack(List.map sbox ["*"; "-"; "*"; ""])) <:> sbox " "
let table = decor <:> (dhr <..> (vr <:> left <:> pages <:> vr) <..> dhr)

;;

show stdout table