signature TORSOR =
sig
 type t
 val tor : real -> t
 val ratio : t * t -> real
 val max : t * t -> t
 val + : t * t -> t
end

structure Torsor :> TORSOR =
struct
 type t = real
 fun tor x = 20.0 * x
 fun ratio (x:real, y) = x / y
 fun max (x, y) = Real.max (x, y)
 fun op+ (x, y) = Real.+ (x, y)
end

structure Comp =
struct

val tor = Torsor.tor
fun r2s r = if r < 0.0 then "-" ^ Real.toString (~r) else Real.toString r

datatype diag = Cell 
	      | Concat of diag list

fun single 0 = Concat[Cell]
  | single n = Concat[Cell, single (n-1), Cell]
fun horizontal n = Concat[Cell, single n, Cell, single n, Cell]
fun nwrap 0 c = c
  | nwrap n c = Concat[Cell, nwrap (n-1) c, Cell] 

type mag = real
type glue = mag * Torsor.t (* extent, stretch *)
type xy = mag * mag
datatype layout = Hbox of Torsor.t * layout list (* t is stretchiness *)
		| Vbox of Torsor.t * layout list
		| Prim of (xy -> xy -> string) * glue * glue (* SVG, xglue, yglue *) (* SVG takes pos, size *)

fun sum l = foldl op+ 0.0 l
fun foldx f [] = raise Match
  | foldx f [x] = x
  | foldx f (h::tl) = f (h,foldx f tl)
fun gplus ((m:real,s),(m',s')) = (m + m', Torsor.+(s, s'))
fun fst (x,y) = x
fun gsum l = foldl gplus (0.0, tor 0.0) l
fun gmaxs l = foldx Real.max (map fst l)

fun ljoin sep [] = [sep]
  | ljoin sep [x] = [sep, x, sep]
  | ljoin sep (h::tl) = sep :: h :: ljoin sep tl

val HSTRETCH = tor 50.0
val VSTRETCH = tor 50.0
val VXGLUE = (2.0, tor 50.0)
val VYGLUE = (2.0, tor 0.0)
val HXGLUE = (2.0, tor 0.0)
val HYGLUE = (2.0, tor 50.0)

val HSEP = Prim ((fn x => fn y => ""), (1.5, tor 5.0), (0.0, tor 0.0))
val VSEP = Prim ((fn x => fn y => ""), (0.0, tor 0.0), (1.5, tor 5.0))

fun marker 1 = ""
  | marker n = "marker-end=\"url(#Triangle)\""
fun dc (false, dimension) (px,py) (sx,sy) =
     "<line x1=\"" ^ r2s (px + sx/2.0) ^ "\" x2 = \"" ^ r2s (px + sx/2.0) ^ "\" y1=\"" 
    ^ r2s py ^ "\" y2=\"" ^ r2s (py + sy) ^ "\" style=\"file:none;stroke:black;\" " ^ marker dimension ^ " />\n" 
  | dc (true, dimension) (px, py) (sx, sy) = 
     "<line y1=\"" ^ r2s (py + sy/2.0) ^ "\" y2 = \"" ^ r2s (py + sy/2.0) ^ "\" x1=\"" 
    ^ r2s px ^ "\" x2=\"" ^ r2s (px + sx) ^ "\" style=\"file:none;stroke:black;\" " ^ marker dimension ^ "/>\n" 
fun drawcell (p, d) pos size = dc (p, d) pos size ^ "\n" ^ dc (p, 1) pos size

fun layout c =
    let
	fun go true n Cell = Prim (drawcell (true, n), VXGLUE, VYGLUE)
	  | go false n Cell = Prim (drawcell (false, n), HXGLUE, HYGLUE)
	  | go true n (Concat ds) = Hbox (HSTRETCH, ljoin HSEP (map (go false (n+1)) ds))
	  | go false n (Concat ds) = Vbox (VSTRETCH, ljoin VSEP (map (go true (n+1)) ds))
    in 
	go true 0 c
    end

fun xextent (Hbox (st, ls)) = gsum (map xextent ls)
  | xextent (Vbox (st, ls)) = (gmaxs (map xextent ls), st)
  | xextent (Prim (svg, xg, yg)) = xg
fun yextent (Hbox (st, ls)) = (gmaxs (map yextent ls), st)
  | yextent (Vbox (st, ls)) = gsum (map yextent ls)
  | yextent (Prim (svg, xg, yg)) = yg

(* distribute takes the amount of slack, and the total amount of stretch
   and a glue and computes the size of an item *)
fun distribute sl pst (m : real, st) = m + sl * Torsor.ratio(st, pst)

fun render (px,py) (sx,sy) (l as Hbox (s, ls)) = 
    let
	val (mx,stx) = xextent l
	val (my,sty) = yextent l 
	(* its is a list of pairs of items and extents *) 
	val its = map (fn it => (it, (distribute (sx - mx) stx (xextent it)))) ls
	fun addone ((item, sx'), (px', str)) = (px' + sx', str ^ render (px', py) (sx', sy) item)
	val (_, str) = foldl addone (px, "") its
    in
	str
    end
  | render (px,py) (sx,sy) (l as Vbox (s, ls)) = 
    let
	val (mx,stx) = xextent l
	val (my,sty) = yextent l 
	(* its is a list of pairs of items and extents *) 
	val its = map (fn it => (it, (distribute (sy - my) sty (yextent it)))) ls
	fun addone ((item, sy'), (py', str)) = (py' + sy', str ^ render (px, py') (sx, sy') item)
	val (_, str) = foldl addone (py, "") its
    in
	str
    end
  | render pos size (Prim (svg, xg, yg)) = svg pos size 

fun xml s = 
    "<?xml version=\"1.0\" standalone=\"no\"?>\n" ^
    "<svg width=\"100%\" height=\"100%\" version=\"1.1\" " ^
    "xmlns=\"http://www.w3.org/2000/svg\">\n" ^ (StringUtil.readfile "defs") ^
    s ^ "\n</svg>"

val size = (100.0, 100.0) 
fun row ~1 n pos = ""
  | row m n (px, py) = render (px,py) size (layout (nwrap m (horizontal n))) ^
		  row (m-1) (n+1) (px + 120.0, py)

fun diag 0 (px, py) = row 0 0 (px, py)
  | diag n (px, py) = row n 0 (px, py) ^ diag (n-1) (px + 60.0, py - 120.0)

fun go () =
    let
	val s = xml (diag 7 (0.0,0.0))
    in
	StringUtil.writefile "/home/jcreed/desktop/diagram.svg" s
    end
end