(* This ML program generates html files for the tower of hanoi *)
(* A few gif pictures are required as well *)
(* Check out http://www.dcs.napier.ac.uk/a.cumming *)
(* These are general utilities that come in handy *)
(* repl(l, i, x) returns list l with item i replced
   by x. The first item is 0 *)
fun repl(h::t, 0, x) = x::t
|   repl(h::t, n, x) = h::repl(t,n-1,x);
(* upto n m returns the list [n, n+1,...m] *)
fun upto n m = if n=m then [n] else n::upto (n+1) m;
(* C switches the order of the arguements *)
fun C f a b = f b a;
fun I x = x;
(* Turns a function of a tuple into a curried function *)
fun curry f a b = f(a,b);
(* member x l is true iff x occurs in l *)
fun member x nil = false|member x (h::t) = x=h orelse member x t;
(* Turn the number 1 into the string "1" *)
val num = (chr o curry (op +) 48);
(* flatten a list of lists *)
fun flatten l = fold (op @) l nil;
(* return n copies of string s *)
fun listcp 0 i = nil| listcp n i = i::listcp (n-1) i;
fun strcp n s = implode(listcp n s);
fun pad n x l = listcp (n - List.length l) x @ l;

(* The real stuff starts here *)
	val nDisk = 4
	val internal = true (* create only one file with internal links*)
	type tower = int list list;
	(* mv (x,y) t
	   takes tower t and returns the tower with a ring moved
	   from pin x to pin y. If the move is invalid, because
	   pin x is empty or has a small top ring than pin y's
	   top ring then return t - i.e. do nothing *)
	fun mv(x,y) t:tower = let
		val xv = nth(t, x) val yv = nth(t, y)
		in if null xv orelse (not(null yv)andalso hd yv<hd xv) then
			(* Attempted invalid move *) t else
	   		repl(repl(t,x,tl xv),y,(hd xv)::yv) end
	val init = [upto 1 nDisk,[],[]]
	fun fname t = let
	  val name =implode(map((curry (op ^) "_") o implode o(map num))t)
		in if internal then name else
		 name^".html" end;
	val clickables = 
		[[(0,2,"bg_rt.gif"),(1,2,"sm_rt.gif"),(2,0,"bg_lt.gif")],
		 [(0,1,"sm_rt.gif"),(1,0,"sm_lt.gif"),(2,1,"sm_lt.gif")]]
	(* This structure is a list of lines of moves together with
	   the name of the file depicting that move, thus the move 1 to 2
	   is depicted by a small arrow to the right on the first line *)
	fun clickstr t = (* This returns the string which represents
			    the clickable arrows at the top *)
	let fun pictbox(x,y,p) = "<a href=\""^
		(if internal then "#" else "") ^
		 fname(mv(x,y) t) ^ "\">" ^
		 "<img src = \""^ p ^"\"></a>\n"
	in implode(map ((C (curry op ^) "<br>") o implode o map pictbox)
			clickables) end
	(* This function returns the string that draws the picture
	   of the tower in state t *)
	fun pegstr t = let
	  val pins = (strcp 3 "<img src = \"pin.gif\">")^"<br>\n";
	  val pt = map (pad nDisk 0)t 
	  fun r(nil::_) = ""
	  |   r x = implode (map (fn x=>"<img src = \"disk"^x ^".gif\">")
		(map num(map hd x))) ^ "<br>\n" ^
		r (map tl x) 
	  in pins ^ r pt end
	fun towerstr t = "<center>"^clickstr t^
			(pegstr t)^"<img src = \"base.gif\"></center>"^
			(if t=init then
 "<h1>The Tower of Hanoi</h1>Move all of the rings to the right most "^
 "peg. You may only move one ring at a time, you must never allow "^
 "a large ring to rest on a smaller ring." else
			if t=rev init then
 "<h1>Congratulations</h1>You have completed the Tower of Hanoi . "^
 "Return to <a href=\"http://www.dcs.napier.ac.uk/a.cumming\">Andrew's"^
 "</a> home page." else "");



	fun mkfile t = let
		val fs = open_out( fname t )
		val w=output(fs,"<Title>Tower of Hanoi</Title>"^
			towerstr t)
		in close_out(fs) end;
	fun addfile fs t = let
		val w=output(fs,"<a name=\"" ^ fname t ^ "\">.</a><br>"^
			towerstr t ^
			strcp 8 ".<P>\n")
		in () end;
(* closure generates the transative closure of items with respect to
   the operations in opns *)
fun closure(items, opns) = let
	fun cl(nil, acc) = acc
	|   cl(h::t, acc) = if member h acc then cl(t,acc) else
		cl((map (C I h) opns) @ t, h::acc) in
			   cl(items, nil) end;
val allt =rev(closure([init],[mv(0,1),mv(1,2),mv(2,0)]));
	(* There are 6 operations but they can be generated from these 3 *)
if internal then let
	val fs=open_out "index.html"
	val w = app (addfile fs)  allt
	in close_out fs end
else	let
	val waste = app mkfile allt 
	(* Now make a comment in the first and last file *)
	val fh = open_append(fname init)
	in () end;