mk_reader_page.ml 6.15 KB
Newer Older
huet's avatar
huet committed
1 2 3 4 5 6
(**************************************************************************)
(*                                                                        *)
(*                     The Sanskrit Heritage Platform                     *)
(*                                                                        *)
(*                              Gérard Huet                               *)
(*                                                                        *)
7
(* ©2020 Institut National de Recherche en Informatique et en Automatique *)
huet's avatar
huet committed
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
(**************************************************************************)

(* This program creates the page [reader_page] (Sanskrit Reader Interface) 
   invoking the CGI sktreader alias reader. Invoked without language argument,
   it is itself the CGI [skt_heritage] invokable separately. *)

(*i module Mk_reader_page = struct i*)

open Html;
open Web; (* ps pl abort etc. *)
open Cgi; (* [create_env get] *)
 
value back_ground = background Chamois
;
value out_mode = ref None
;
value set_cho () = Arg.parse 
  [ ("-fr", Arg.Unit (fun () -> out_mode.val:=Some French), "French")
  ; ("-en", Arg.Unit (fun () -> out_mode.val:=Some English), "English")
27
  ; ("",    Arg.Unit (fun () -> out_mode.val:=None), "default language for cgi")
huet's avatar
huet committed
28 29 30 31 32
  ]
  (fun s -> raise (Arg.Bad s)) 
  "Usage: mk_reader_page -en or mk_reader_page -fr or mk_reader_page"
;
value print_cache_policy cache_active = do
33
  { " Cache " |> ps 
huet's avatar
huet committed
34 35 36 37
  ; let options = 
      [ (" On ","t",cache_active="t")  (* Cache active *)
      ; (" Off ","f",cache_active="f") (* Ignore cache *)
      ] in
38
    option_select_default "cache" options |> pl
huet's avatar
huet committed
39 40
  }
;
41 42 43 44 45 46
value sanskrit_font_switch_default dft id =
  option_select_default_id id "font" 
       [ ("Devanagari","deva",dft="deva")  (* Devanagari UTF-8 *)
       ; ("   IAST   ","roma",dft="roma")  (* Indological romanisation in UTF-8 *)
       ]
;
huet's avatar
huet committed
47 48 49 50 51 52 53 54 55
value reader_input_area_default =
  text_area "text" 1 screen_char_length 
;
value reader_input_area = reader_input_area_default ""
;
value reader_page () = do
  { set_cho ()
  ; let (lang,query) = match out_mode.val with
      [ Some lang -> do 
56
        { open_html_file (reader_page lang) reader_meta_title; (lang,"") }
huet's avatar
huet committed
57
      | None -> do
58
        { reader_prelude ""; (default_language, Sys.getenv "QUERY_STRING") }
huet's avatar
huet committed
59 60 61 62 63 64
      ] in try 
    let env = create_env query in
    let url_encoded_input = get "text" env "" 
    and url_encoded_mode  = get "mode" env "g"
    and url_encoded_topic = get "topic" env ""
    and st = get "st" env "t" (* default vaakya rather than isolated pada *)
65
(* [and cp = get "cp" env default_mode TODO: dead code ] *)
huet's avatar
huet committed
66 67
    and us = get "us" env "f" (* default input sandhied *)
    and cache_active = get "cache" env cache_active.val
68 69
    and translit = get "t" env Paths.default_transliteration 
    and font = get "font" env Paths.default_display_font in
huet's avatar
huet committed
70 71
    (* Contextual information from past discourse *)
    let topic_mark = decode_url url_encoded_topic 
72
    and text = decode_url url_encoded_input in
73 74

    (* Corpus parameters *)
75
    let corpus_permission = Cgi.decoded_get Params.corpus_permission "" env in
76
    let corpus_dir = Cgi.decoded_get Params.corpus_dir "" env in
77
    let sentence_no = Cgi.decoded_get Params.sentence_no "" env in do
78

79
  { body_begin back_ground |> pl 
huet's avatar
huet committed
80
  ; print_title (Some lang) reader_title
81
  ; h3_begin C3 |> pl
82 83
  ; if Web_corpus.(permission_of_string corpus_permission = Annotator) then
      "Corpus annotator permission - " ^ corpus_dir |> pl
84
    else ()
85
  ; h3_end |> pl
86 87
  ; center_begin |> pl
  ; cgi_reader_begin reader_cgi "convert" |> pl
huet's avatar
huet committed
88 89
  ; print_lexicon_select (lexicon_of lang)
  ; if cache_allowed then print_cache_policy cache_active else ()
90 91 92
  ; html_break |> pl
  ; "Text " |> pl 
  ; option_select_default "st" 
huet's avatar
huet committed
93 94
        [ (" Sentence ","t",st="t") 
        ; ("   Word   ","f",st="f")  
95 96 97
        ] |> pl 
  ; " Format " |> pl
  ; option_select_default "us" 
huet's avatar
huet committed
98 99
        [ (" Unsandhied ","t",us="t") 
        ; ("  Sandhied  ","f",us="f") 
100
        ] |> pl
101 102
(* option Simple deprecated TODO
 [; pl " Parser strength "
huet's avatar
huet committed
103 104 105
  ; pl (option_select_default "cp"
        [ ("  Full  ","t",cp="t") 
        ; (" Simple ","f",cp="f")
106
        ])] *)
107 108 109 110 111 112 113 114 115 116
(* Sanskrit printer deva/roma *)
  ; " Sanskrit display font" |> pl
  ; sanskrit_font_switch_default font "font" |> ps
  ; html_break |> pl  
  ; reader_input_area_default text |> ps
  ; html_break |> pl 
  ; "Input convention " |> ps
  ; transliteration_switch_default translit "trans" |> ps
  ; " Optional topic " |> pl (* For the moment assumed singular *)
  ; option_select_default "topic"
huet's avatar
huet committed
117 118 119 120
        [ (" Masculine ","m",topic_mark="m")  
        ; (" Feminine  ","f",topic_mark="f")  
        ; ("  Neuter   ","n",topic_mark="n")
        ; ("   Void    ","" ,topic_mark="") 
121 122 123 124
        ] |> pl
  ; " Mode " |> pl
  ; option_select_default_id "mode_id" "mode"
      (interaction_modes_default url_encoded_mode) |> pl
125 126

  (* Corpus parameters *)
127
  ; hidden_input Params.corpus_permission corpus_permission |> pl
128 129
  ; hidden_input Params.corpus_dir corpus_dir |> pl
  ; hidden_input Params.sentence_no sentence_no |> pl
130

131 132 133 134 135
  ; html_break |> pl 
  ; submit_input "Read" |> pl
  ; reset_input "Reset" |> pl
  ; cgi_end |> pl
  ; center_end |> pl 
huet's avatar
huet committed
136 137
  ; match out_mode.val with
    [ Some lang -> close_html_file lang True 
138
    | None ->
139
      do { close_page_with_margin (); page_end default_language True }
huet's avatar
huet committed
140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
    ]
  }
    with 
    [ Sys_error s         -> abort lang Control.sys_err_mess s (* file pb *)
    | Stream.Error s      -> abort lang Control.stream_err_mess s (* file pb *)
    | Exit (* Sanskrit *) -> abort lang "Wrong character in input" "" 
    | Invalid_argument s  -> abort lang Control.fatal_err_mess s (* sub *)
    | Failure s           -> abort lang Control.fatal_err_mess s (* anomaly *)
    | End_of_file         -> abort lang Control.fatal_err_mess "EOF" (* EOF *)
    | Not_found           -> let s = "You must choose a parsing option" in
                             abort lang "Unset button in form - " s
    | Control.Fatal s     -> abort lang Control.fatal_err_mess s (* anomaly *)
    | Control.Anomaly s   -> abort lang Control.fatal_err_mess ("Anomaly: " ^ s)
    | _ -> abort lang Control.fatal_err_mess "Unexpected anomaly" 
    ]
 }
;

reader_page ()
;

(*i end; i*)