(* Format * Copyright 1996, 1998 Peter Sestoft.  
   Må kopieres og modificeres jvfr. GNU General Public License *)

open Basis
infix &&

val linielgd = ref 72;

fun udskriv bredde out ordsek =
    let fun loop Tom         rest = rest
          | loop (Str ",")   rest = (out ","; rest-1)
          | loop (Str ".")   rest = (out "."; rest-1)
          | loop (Str "\n")  rest = (out "\n"; bredde)
          | loop (Str w)     rest = 
            if rest <> bredde then (* allerede noget på linien *)
                 if size w + 1 <= rest then (out " "; out w; rest-size w-1)
                 else (out "\n"; out w; bredde-size w)
            else if size w <= rest then (out w; rest-size w)
                 else (out "\n"; out w; bredde-size w)
          | loop (s1 && s2) rest = loop s2 (loop s1 rest)
    in loop ordsek bredde; () end

val udskriv = fn out => fn ordsek => udskriv (!linielgd) out ordsek

fun printer ordsek = 
    let val os = TextIO.openOut "PRN"
        fun out s = TextIO.output(os, s)
    in
        udskriv out ordsek; out "\n\n";
        TextIO.closeOut os
    end 
    
fun skaerm ordsek = 
    (udskriv (fn s => TextIO.output(TextIO.stdOut, s)) ordsek;
     TextIO.output(TextIO.stdOut, "\n\n"))

fun begyndelse Tom = Tom
  | begyndelse (Str w) = 
    (case explode w of 
         #"æ" :: cr => Str (implode(#"Æ" :: cr))
       | #"ø" :: cr => Str (implode(#"Ø" :: cr))
       | #"å" :: cr => Str (implode(#"Å" :: cr))
       | c    :: cr => Str (implode(Char.toUpper c :: cr))
       | []         => Tom)
  | begyndelse (s1 && s2) = 
    case begyndelse s1 of
         Tom => begyndelse s2
       | s1' => s1' && s2

fun flatten ws = 
    let fun loop Tom          res = res
	  | loop (Str s)      res = " " :: s :: res
	  | loop (ws1 && ws2) res = loop ws1 (loop ws2 res)
    in concat (loop ws []) end
  
fun nom () = #3 (Led.nominal NONE)

fun mk n u f = 
    (List.tabulate(n, fn _ => u(f () && Str "\n")); ())

fun dato () =
    let open Date
        fun maaned Jan = "januar"
          | maaned Feb = "februar"
          | maaned Mar = "marts"
          | maaned Apr = "april"
          | maaned May = "maj"
          | maaned Jun = "juni"
          | maaned Jul = "juli"
          | maaned Aug = "august"
          | maaned Sep = "september"
          | maaned Oct = "oktober"
          | maaned Nov = "november"
          | maaned Dec = "december"
        val d = Date.fromTimeLocal (Time.now ())
    in
            Str (Date.fmt "%d." d) && 
            Str (maaned (month d)) &&
            Str (Date.fmt "%Y" d)
    end 


(* Html *)

fun para0 art indhold =
    Str (concat ["<", art, ">"])
    && indhold
    && Str (concat ["</", art, ">"])

fun para1 art parameter indhold =
    Str (concat ["<", art, " ", parameter, ">"])
    && indhold
    && Str (concat ["</", art, ">"])

fun href link indhold =
    para1 "a" (concat ["href=\"", link, "\""]) indhold

fun ul indhold = Str "\n" && para0 "ul" indhold && Str "\n"
fun li indhold = Str "\n" && para0 "li" indhold

fun afsnit () = Str "\n" && Str "<p>"

fun streg  () = Str "\n" && Str "<hr>"

fun hoved s = para0 "head" (para0 "title" s)

fun krop indhold = para1 "body" "bgcolor=#FFFFFF" indhold

fun overskrift0 indhold = Str "\n" && para0 "H1" indhold && Str "\n"
fun overskrift1 indhold = Str "\n" && para0 "H2" indhold && Str "\n"

val center = para0 "center"

fun billede url =
    Str (concat ["<img src=\"", url, "\" align=center>"])

local (* ankre af form anker1, anker2, ... *)
    val next = ref 0
    fun nytAnker () = (next := !next+1; "anker" ^ Int.toString (!next))
in
    fun lavAnker s = 
        let val anker = nytAnker ()
        in 
	    ("#" ^ anker, 
	     para1 "a" (concat ["name=\"", anker, "\""]) s) 
	end
end

fun html centernavn indhold = 
    Str "Content-type: text/html" 
    && Str "\n" && Str "\n"
    && para0 "html" (hoved centernavn 
		     && streg ()
		     && para0 "h1" centernavn
		     && streg ()
		     && krop indhold)