15. User Interfaces

let verbose = ref false
let debug = ref false
let output = ref ""

let () =
  Arg.parse
    [
      "-v", Arg.Set verbose, "Verbose mode";
      "-D", Arg.Set debug, "Debug mode";
      "-o", Arg.Set_string output, "Specify output file";
    ]
    (fun s ->
       raise (Arg.Bad (Printf.sprintf "unexpected argument `%s'" s)))
    (Printf.sprintf "Usage: %s [-v] [-d] [-o file]" Sys.argv.(0))

let () =
  if !verbose then print_endline "Verbose mode";
  if !debug then print_endline "Debug mode";
  if !output <> "" then print_endline ("Writing output to " ^ !output);

#load "unix.cma";;

let i_am_interactive () =
  Unix.isatty Unix.stdin && Unix.isatty Unix.stdout

let () =
  try
    while true do
      if i_am_interactive ()
      then print_string "Prompt: ";
      let line = read_line () in
      if line = "" then raise End_of_file;
      (* do something with the line *)
    done
  with End_of_file -> ()

#load "unix.cma";;

(* Run the clear command to clear the screen. *)
let () = ignore (Sys.command "clear")

(* Save the output to a string to avoid running a process each time. *)
let clear =
  try
    let proc = Unix.open_process_in "clear" in
    try
      let chars = input_line proc in
      ignore (Unix.close_process_in proc);
      chars
    with e -> ignore (Unix.close_process_in proc); ""
  with _ -> ""
let () = print_string clear

#load "unix.cma";;

(* UNIX only, due to "stty". *)
let get_terminal_size () =
  let in_channel = Unix.open_process_in "stty size" in
  try
    begin
      try
        Scanf.fscanf in_channel "%d %d"
          (fun rows cols ->
             ignore (Unix.close_process_in in_channel);
             (rows, cols))
      with End_of_file ->
        ignore (Unix.close_process_in in_channel);
        (0, 0)
    end
  with e ->
    ignore (Unix.close_process_in in_channel);
    raise e

(* Display a textual bar chart as wide as the console. *)
let () =
  let (height, width) = get_terminal_size () in
  if width < 10
  then (prerr_endline "You must have at least 10 characters";
        exit 255);
  let max_value = List.fold_left max 0.0 values in
  let ratio = (float width -. 10.0) /. max_value in
  List.iter
    (fun value ->
       Printf.printf "%8.1f %s\n"
         value
         (String.make (int_of_float (ratio *. value)) '*'))
    values

(* Requires the ANSITerminal library by Christophe Troestler,
   available at http://math.umh.ac.be/an/software.php#x4-80007 *)

#load "ANSITerminal.cma";;
open ANSITerminal

let () =
  print_string [red] "Danger Will Robinson!\n";
  print_string [] "This is just normal text.\n";
  print_string [Blink] "<BLINK>Do you hurt yet?</BLINK>\n"

(*-----------------------------*)

let () =
  set_autoreset false;
  (* rhyme for the deadly coral snake *)
  print_string [red; on_black] "venom lack\n";
  print_string [red; on_yellow] "kill that fellow\n";
  print_string [green; on_cyan; Blink] "garish!\n";
  print_string [Reset] ""

(*-----------------------------*)

let () =
  set_autoreset true;
  List.iter
    (print_string [red; on_white; Bold; Blink])
    ["This way\n";
     "each line\n";
     "has its own\n";
     "attribute set.\n"]

#load "unix.cma";;

let with_cbreak f x =
  let term_init = Unix.tcgetattr Unix.stdin in
  let term_cbreak = { term_init with Unix.c_icanon = false } in
  Unix.tcsetattr Unix.stdin Unix.TCSANOW term_cbreak;
  try
    let result = f x in
    Unix.tcsetattr Unix.stdin Unix.TCSADRAIN term_init;
    result
  with e ->
    Unix.tcsetattr Unix.stdin Unix.TCSADRAIN term_init;
    raise e

let key = with_cbreak input_char stdin

(*-----------------------------*)

(* sascii - Show ASCII values for keypresses *)
let sascii () =
  while true do
    let char = Char.code (input_char stdin) in
    Printf.printf " Decimal: %d\tHex: %x\n" char char;
    flush stdout
  done
let () =
  print_endline
    "Press keys to see their ASCII values.  Use Ctrl-C to quit.";
  with_cbreak sascii ()

(* OCaml doesn't recognize '\a'; instead use '\007'. *)
let () = print_endline "\007Wake up!"

(* Use the "tput" command to produce a visual bell. *)
let () = ignore (Sys.command "tput flash")

#!/usr/bin/ocaml
(* demo POSIX termios *)

#load "unix.cma";;

let uncontrol c =
  if c >= '\128' && c <= '\255'
  then Printf.sprintf "M-%c" (Char.chr (Char.code c land 127))
  else if (c >= '\000' && c < '\031') || c = '\127'
  then Printf.sprintf "^%c" (Char.chr (Char.code c lxor 64))
  else String.make 1 c

let term = Unix.tcgetattr Unix.stdin
let erase = term.Unix.c_verase
let kill = term.Unix.c_vkill

let () =
  Printf.printf "Erase is character %d, %s\n"
    (Char.code erase)
    (uncontrol erase);
  Printf.printf "Kill is character %d, %s\n"
    (Char.code kill)
    (uncontrol kill)

let () =
  term.Unix.c_verase <- '#';
  term.Unix.c_vkill <- '@';
  Unix.tcsetattr Unix.stdin Unix.TCSANOW term;
  Printf.printf "erase is #, kill is @; type something: %!";
  let line = input_line stdin in
  Printf.printf "You typed: %s\n" line;
  term.Unix.c_verase <- erase;
  term.Unix.c_vkill <- kill;
  Unix.tcsetattr Unix.stdin Unix.TCSANOW term

(*-----------------------------*)

module HotKey :
sig
  val cbreak : unit -> unit
  val cooked : unit -> unit
  val readkey : unit -> char
end =
struct
  open Unix

  let oterm = {(tcgetattr stdin) with c_vtime = 0}
  let noecho = {oterm with
                  c_vtime = 1;
                  c_echo = false;
                  c_echok = false;
                  c_icanon = false}

  let cbreak () = tcsetattr stdin TCSANOW noecho
  let cooked () = tcsetattr stdin TCSANOW oterm

  let readkey () =
    cbreak ();
    let key = input_char (Pervasives.stdin) in
    cooked ();
    key

  let () = cooked ()
end

#load "unix.cma";;

let () =
  Unix.set_nonblock Unix.stdin;
  try
    let char = with_cbreak input_char stdin in
    (* input was waiting and it was char *)
    ()
  with Sys_blocked_io ->
    (* no input was waiting *)
    ()

#load "unix.cma";;

(* Thanks to David Mentre, Remi Vanicat, and David Brown's posts on
   caml-list. Works on Unix only, unfortunately, due to tcsetattr. *)
let read_password () =
  let term_init = Unix.tcgetattr Unix.stdin in
  let term_no_echo = { term_init with Unix.c_echo = false } in
  Unix.tcsetattr Unix.stdin Unix.TCSANOW term_no_echo;
  try
    let password = read_line () in
    print_newline ();
    Unix.tcsetattr Unix.stdin Unix.TCSAFLUSH term_init;
    password
  with e ->
    Unix.tcsetattr Unix.stdin Unix.TCSAFLUSH term_init;
    raise e

let () =
  print_string "Enter your password: ";
  let password = read_password () in
  Printf.printf "You said: %s\n" password

(* ledit is a pure-OCaml readline clone by Daniel de Rauglaudre.
   Source is available here: http://pauillac.inria.fr/~ddr/ledit/

   It is designed to be used as a command-line wrapper, but it
   can also be embedded in another program by building it normally
   and copying cursor.cmo, ledit.cmi, ledit.cmo, and ledit.mli into
   your project.

   A guide to compiling and embedding ledit can be found on the
   OCaml Tutorial Wiki: http://www.ocaml-tutorial.org/ledit
   At present, this guide applies to ledit 1.11. This recipe uses
   ledit 1.15, which is slightly different due to the addition of
   Unicode support (Ledit.input_char now returns a string instead
   of a char). *)

#load "unix.cma";;
#load "cursor.cmo";;
#load "ledit.cmo";;

let readline prompt =
  Ledit.set_prompt prompt;
  let buffer = Buffer.create 256 in
  let rec loop = function
    | "\n" ->
        Buffer.contents buffer
    | string ->
        Buffer.add_string buffer string;
        loop (Ledit.input_char stdin) in
  loop (Ledit.input_char stdin)

let () =
  let prompt = "Prompt: " in
  let line = readline prompt in
  Printf.printf "You said: %s\n" line

(*-----------------------------*)

(* vbsh - very bad shell *)
let () =
  try
    while true do
      let cmd = readline "$ " in
      begin
        match Unix.system cmd with
          | Unix.WEXITED _ -> ()
          | Unix.WSIGNALED signal_num ->
              Printf.printf "Program killed by signal %d\n"
                signal_num
          | Unix.WSTOPPED signal_num ->
              Printf.printf "Program stopped by signal %d\n"
                signal_num
      end;
      flush stdout
    done
  with End_of_file -> ()

#!/usr/bin/ocaml
(* rep - screen repeat command *)

#load "unix.cma";;

(* http://www.nongnu.org/ocaml-tmk/ *)
#directory "+curses";;
#load "curses.cma";;

let timeout = 10.0

let (timeout, command) =
  match Array.length Sys.argv with
    | 0 | 1 -> (timeout, [| |])
    | len ->
        if Sys.argv.(1) <> "" && Sys.argv.(1).[0] = '-'
        then (float_of_string
                (String.sub Sys.argv.(1)
                   1 (String.length Sys.argv.(1) - 1)),
              Array.sub Sys.argv 2 (len - 2))
        else (timeout, Array.sub Sys.argv 1 (len - 1))

let () =
  if Array.length command = 0
  then (Printf.printf "usage: %s [ -timeout ] cmd args\n" Sys.argv.(0);
        exit 255)

let window = Curses.initscr ()          (* start screen *)
let _ = Curses.noecho ()
let _ = Curses.cbreak ()
let _ = Curses.nodelay window true      (* so getch() is non-blocking *)

let done' s _ = Curses.endwin (); print_endline s; exit 0
let () = Sys.set_signal Sys.sigint (Sys.Signal_handle (done' "Ouch!"))

let cols, lines = Curses.getmaxyx window

let days = [| "Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat" |]
let months = [| "Jan"; "Feb"; "Mar"; "Apr"; "May"; "Jun";
                "Jul"; "Aug"; "Sep"; "Oct"; "Nov"; "Dec" |]

let format_time time =
  let tm = Unix.localtime time in
  Printf.sprintf "%s %s %2d %02d:%02d:%02d %04d"
    days.(tm.Unix.tm_wday)
    months.(tm.Unix.tm_mon)
    tm.Unix.tm_mday
    tm.Unix.tm_hour
    tm.Unix.tm_min
    tm.Unix.tm_sec
    (tm.Unix.tm_year + 1900)

let time = fst (Unix.mktime {Unix.tm_sec=50; tm_min=45; tm_hour=3;
                             tm_mday=18; tm_mon=0; tm_year=73;
                             tm_wday=0; tm_yday=0; tm_isdst=false})

let () =
  while true do
    let key = ref (-1) in
    while key := Curses.getch (); !key <> -1 do
      if !key = Char.code 'q' then done' "See ya" ()
    done;

    let in_channel =
      Unix.open_process_in (String.concat " " (Array.to_list command)) in
    begin
      try
        for i = 0 to lines - 1 do
          let line = input_line in_channel in
          ignore (Curses.mvaddstr i 0 line);

          Curses.standout ();
          ignore (Curses.mvaddstr (lines - 1) (cols - 24)
                    (format_time (Unix.time ())));
          Curses.standend ();

          ignore (Curses.move 0 0);
          ignore (Curses.refresh ());
        done;
        ignore (Unix.close_process_in in_channel)
      with End_of_file ->
        ignore (Unix.close_process_in in_channel)
    end;

    ignore (Unix.select [Unix.stdin] [] [] timeout)
  done

(*-----------------------------*)

let err = Curses.keypad window true     (* enable keypad mode *)
let key = Curses.getch ()
let () =
  if (key = (Char.code 'k') ||          (* vi mode *)
      key = 16 ||                       (* emacs mode *)
      key = Curses.Key.up)              (* arrow mode *)
  then
    begin
      (* do something *)
    end