open Utils open Data open Xhtml open Date type entry = { name : string ; date : range; category : string; title : xml list; title_plain_text: string; text : xml list; links: (string * string * string option) list; own_page: bool; hidden: bool; } let compare_entries_date e1 e2 = compare_range e2.date e1.date let tag_category cat = let cattext = category_text cat in let mcattext = String.capitalize cattext in [text "Category: "; a ~href:(loc_of_name cattext) ~title:("All entries on " ^ mcattext) [text mcattext]] let footer_entry cat = match cat with | None -> [] | Some cat -> tag_category cat let link_entry ?(anchor=false) e = let cattext = category_text e.category in let a = a ~title:e.title_plain_text in if anchor then a ~name:e.name e.title else a ~href:((loc_of_name cattext) ^ "#" ^ e.name) e.title let entry_xml e ~cat = let cat = option_if cat (div ~nclass:"category" (tag_category e.category)) and date_creation = map_option (fun s -> div ~nclass:"creation-date" [text s]) (end_range e.date) in let infos = match cat *::- (date_creation *::- []) with | [] -> [] | l -> [div ~nclass:"infos" l] in div ~nclass:("entry" ^ " " ^ e.category) [h3 ~nclass:"date" [text (start_range e.date)]; div ~nclass:"container" ( h3 [span ~nclass:"underline" [link_entry ~anchor:true e]] :: infos @ div ~nclass:"body" e.text :: Links.links_entry e.links) ] let rec entries_xml ~cat = function | [] -> [] | e :: q -> if e.hidden then entries_xml ~cat q else entry_xml e cat :: entries_xml ~cat q let header = div ~id:"header" ~nclass:"main-col box top first-line" [] let titles = div ~id:"title" ~nclass:"col box top first-line" [ h1 [a ~href:"http://www.yakobowski.org" ~title:"To the root of this website" [text "Boris Yakobowski"]]; div ~id:"subheader" [text "research and other interests"]; ] let footer_page = input_template "footer.htmlt" let rec find_remove n l = match l with | [] -> assert false | t :: q -> if n = 0 then t, q else let r, l = find_remove (n-1) q in r, t :: l let _ = Random.self_init () let pick l = find_remove (Random.int (List.length l)) l let pick_photo (photos : OutputPhotos.all_photos) = let (dir, loc, dir_photos), photos = pick photos in let photo, rem = pick dir_photos in (dir, loc, photo, (rem = [])), photos let gen_photos () = let l = ref [] and photos = ref (!OutputPhotos.photos) in for i = 1 to 6 do let photo, rem = pick_photo !photos in l := photo :: !l; photos := rem; done; !l let photo = let n = ref 0 in fun (dir, loc, photo, single) -> let href, img_ = match loc with | OutputPhotos.Local -> Printf.sprintf "photos/%s/%s.html" dir (if single then "index" else photo), Printf.sprintf "photos/%s/thumbs/%s" dir photo | OutputPhotos.Distant subdir -> Printf.sprintf "http://boris.yakobowski.free.fr/%s" dir, Printf.sprintf "http://boris.yakobowski.free.fr/%s/%s/%s" dir subdir photo in incr n; let n = string_of_int !n in a ~href ~nclass:"photo" [ img ~nclass:"thumb" ~id:("thumb" ^ n) ~src:"/" ~alt:"Thumbnail" () ], Printf.sprintf "document.getElementById('thumb%s').src = '%s';" n img_ let fullpage ~title ~nav ?entries_class ?search ?(buttons=`Third) ?recent ?other_menu text = let thumbs, js = List.split (List.map photo (gen_photos ())) in let js = Printf.sprintf "" (String.concat "\n" js) in Header.page_xml ~ie:true ~head:Header.head_entries ~title [div ~id:"container" ~nclass:"normal" ( header :: titles :: div ~id:"photo" ~nclass:"col2 box first-line" [ img ~id:"me" ~src:"css/images/me.png" ~alt:"Me" ()] :: div ~id:"main" ~nclass:"main-col box second-line" ( nav :: h2 ~id:"title-entries" [Xhtml.text "Entries"] :: div ~id:"entries" ?nclass:entries_class text :: footer_page) :: div ~id:"menu" ~nclass:"col box second-line" ( GenMenu.menu ?search ~buttons:(buttons=`Second) ?recent ?others:other_menu ()) :: div ~id:"photos" ~nclass:"col2 box second-line" ( div ~nclass:"fake-nav" [] :: div ~id:"thumbs-title" ~nclass:"menu-entry" [ h3 [Xhtml.text "Random photographs"]; ] :: div ~id:"thumbs" thumbs :: Xhtml.text js :: if buttons = `Third then [GenMenu.section_buttons] else [] ) :: []) ]