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
[]
) ::
[])
]