path: root/src/visualwall.ml

(* Programmed by Jedidiah Barber *)
(* Licensed under the Sunset License v1.0 *)


module My_Algebra =
  struct
    type t = Z.t
    let zero = Z.zero
    let one = Z.one
    let add = Z.add
    let sub = Z.sub
    let mul = Z.mul
    let div = Z.div
    let to_string = Z.to_string
  end

module My_Wall = Wall.Make (My_Algebra)



let main () =
  ignore (GtkMain.Main.init ());

  let window =
    GWindow.window
      ~title:"Number Wall Viewer"
      ~width:250 () in
  ignore (window#connect#destroy ~callback:GMain.quit);

  let main_vbox =
    GPack.vbox
      ~packing:window#add () in

  let menubar =
    GMenu.menu_bar
      ~packing:(main_vbox#pack ~expand:false) () in

  let wall_view =
    GBin.scrolled_window
      ~hpolicy:`AUTOMATIC
      ~vpolicy:`AUTOMATIC
      ~packing:(main_vbox#pack ~expand:true) () in

  let statusbar =
    GMisc.statusbar
      ~packing:(main_vbox#pack ~expand:false) () in

  let context =
    statusbar#new_context ~name:"Program status" in

  let system_colormap =
    Gdk.Color.get_system_colormap () in



  let set_status ~msg =
    context#pop ();
    ignore (context#push msg) in



  let number_wall = ref My_Wall.empty in
  let modulus = ref 2 in

  let magnify = ref 2 in

  (* Default to orange foreground, blue background. *)
  let foreground_color = ref (65535, 40447, 0) in
  let background_color = ref (11519, 21247, 65535) in

  let x_dim = ref 1 in
  let y_dim = ref 1 in
  let x_offset = ref 0 in

  let wall_loaded = ref false in



  let expose (drawitem:GMisc.drawing_area) (backing:GDraw.pixmap ref) event =
    let area = GdkEvent.Expose.area event in
    let x = Gdk.Rectangle.x area in
    let y = Gdk.Rectangle.y area in
    let width = Gdk.Rectangle.width area in
    let height = Gdk.Rectangle.height area in
    let drawing =
      drawitem#misc#realize ();
      new GDraw.drawable (drawitem#misc#window) in
    drawing#put_pixmap ~x ~y ~xsrc:x ~ysrc:y ~width ~height !backing#pixmap;
    false in

  let draw_area =
    GMisc.drawing_area
      ~packing:wall_view#add_with_viewport () in

  let pixmap_area = ref
   (GDraw.pixmap
      ~width:!x_dim
      ~height:!y_dim
      ~window:wall_view
      ~colormap:system_colormap ()) in

  ignore (draw_area#event#connect#expose ~callback:(expose draw_area pixmap_area));
  draw_area#event#add [`EXPOSURE];

  let redraw_pixmap () =
    for j = 0 to !y_dim - 1 do
      for i = !x_offset to !x_dim + !x_offset - 1 do
        if My_Wall.has_value !number_wall ~x:i ~y:j &&
          Z.rem (My_Wall.get !number_wall ~x:i ~y:j) (Z.of_int !modulus) <> My_Algebra.zero
        then
          !pixmap_area#set_foreground (`RGB !background_color)
        else
          !pixmap_area#set_foreground (`RGB !foreground_color);
        !pixmap_area#rectangle
          ~x:((i - !x_offset) * !magnify)
          ~y:(j * !magnify)
          ~width:!magnify
          ~height:!magnify
          ~filled:true ()
      done
    done;
    let update_rectangle =
      Gdk.Rectangle.create
        ~x:0 ~y:0
        ~width:(!x_dim * !magnify)
        ~height:(!y_dim * !magnify) in
    draw_area#misc#draw (Some update_rectangle) in

  let new_pixmap () =
    pixmap_area :=
      GDraw.pixmap
        ~width:(!x_dim * !magnify)
        ~height:(!y_dim * !magnify)
        ~window:wall_view
        ~colormap:system_colormap ();
    draw_area#misc#set_size_request
      ~width:(!x_dim * !magnify)
      ~height:(!y_dim * !magnify) () in



  let generate_unused ~basename ~extension =
    let rec checker num =
      let testname = basename ^ "-" ^ (string_of_int num) ^ "." ^ extension in
      if not (Sys.file_exists testname) then
        testname
      else
        checker (num + 1) in
    checker 1 in



  let menus = ref ([] : (string * GMenu.menu) list) in

  let disable_menu_items menu placelist =
    let disable nth = (List.nth menu#children nth)#misc#set_sensitive false in
    List.iter disable placelist in

  let enable_menu_items menu placelist =
    let enable nth = (List.nth menu#children nth)#misc#set_sensitive true in
    List.iter enable placelist in



  let new_cb () =
    let maybe_new = Dialog.new_wall () in
    if Option.is_some maybe_new then
     (let (x,y,s) = Option.get maybe_new in
      x_dim := x;
      y_dim := y;
      x_offset := y;
      let real_x_dim = x + 2 * y in
      let real_y_dim = y + x / 2 + 1 in
      if s = "Pagoda" then
        number_wall :=
          My_Wall.create
            ~dimx:real_x_dim
            ~dimy:real_y_dim
            ~init:(Sequence.pagoda ~len:real_x_dim)
      else
        number_wall :=
          My_Wall.create
            ~dimx:real_x_dim
            ~dimy:real_y_dim
            ~init:(Sequence.random ~len:real_x_dim);
      new_pixmap ();
      redraw_pixmap ();
      wall_loaded := true;
      enable_menu_items (List.assoc "file" !menus) [3;4;6];
      set_status ~msg:"New wall created")
    else
     (set_status ~msg:"Canceled new wall")in



  let open_cb () =
    let maybe_filename =
      Dialog.open_file
        ~folder:(Sys.getcwd ()) () in
    if Option.is_some maybe_filename then
     (let filename = Option.get maybe_filename in
      try
        let input_seq = Util.read_sequence_file filename in
        let real_x_dim = Array.length input_seq in
        x_dim := real_x_dim / 3;
        y_dim := !x_dim;
        let real_y_dim = !y_dim + !x_dim / 2 + 1 in
        x_offset := !y_dim;
        number_wall :=
          My_Wall.create
            ~dimx:real_x_dim
            ~dimy:real_y_dim
            ~init:input_seq;
        new_pixmap ();
        redraw_pixmap ();
        wall_loaded := true;
        enable_menu_items (List.assoc "file" !menus) [3;4;6];
        set_status ~msg:("Opened " ^ filename)
      with
        Util.Not_an_integer s ->
          set_status ~msg:("Error: " ^ s ^ " is not an integer"))
    else
     (set_status ~msg:"Canceled open") in

  let save_as_cb () =
    let maybe_filename =
      Dialog.save_file
        ~folder:(Sys.getcwd ())
        ~name:(generate_unused ~basename:"sequence" ~extension:"txt") () in
    if Option.is_some maybe_filename then
     (let filename = Option.get maybe_filename in
      let write channel =
        for i = 0 to My_Wall.x_length !number_wall - 2 do
          output_string channel (Z.to_string (My_Wall.get !number_wall ~x:i ~y:1) ^ ",");
        done;
        output_string channel (Z.to_string
          (My_Wall.get !number_wall ~x:(My_Wall.x_length !number_wall - 1) ~y:1) ^ "\n") in
      Util.call_with_open_output_file ~filename ~func:write;
      set_status ~msg:("Saved sequence to " ^ filename))
    else
     (set_status ~msg:"Canceled save") in

  let export_cb () =
    let maybe_filename =
      Dialog.export_file
        ~folder:(Sys.getcwd ())
        ~name:(generate_unused ~basename:"image" ~extension:"png") () in
    if Option.is_some maybe_filename then
     (let filename = Option.get maybe_filename in
      let buffer = GdkPixbuf.create
        ~width:(!x_dim * !magnify)
        ~height:(!y_dim * !magnify)
        ~has_alpha:false () in
      !pixmap_area#get_pixbuf
        ~dest_x:0 ~dest_y:0
        ~width:(!x_dim * !magnify)
        ~height:(!y_dim * !magnify)
        ~src_x:0 ~src_y:0
        buffer;
      GdkPixbuf.save
        ~filename
        ~typ:"png"
        buffer;
      set_status ~msg:("Exported image to " ^ filename))
    else
     (set_status ~msg:"Canceled export") in



  let discard_cb () =
    number_wall := My_Wall.empty;
    x_dim := 1;
    y_dim := 1;
    new_pixmap ();
    redraw_pixmap ();
    wall_loaded := false;
    disable_menu_items (List.assoc "file" !menus) [3;4;6];
    set_status ~msg:"Discarded sequence" in



  let color_cb () =
    let maybe_colors =
      Dialog.colors ~fore:!foreground_color ~back:!background_color in
    if Option.is_some maybe_colors then
     (foreground_color := fst (Option.get maybe_colors);
      background_color := snd (Option.get maybe_colors);
      if !wall_loaded then redraw_pixmap ();
      set_status ~msg:"Color change applied")
    else
     (set_status ~msg:"Canceled color change") in

  let modulus_cb () =
    let maybe_modulus =
      Dialog.modulus ~current:!modulus in
    if Option.is_some maybe_modulus then
     (modulus := Option.get maybe_modulus;
      if !wall_loaded then redraw_pixmap ();
      set_status ~msg:("Changed modulus to " ^ string_of_int !modulus))
    else
     (set_status ~msg:"Canceled modulus change") in



  let zoom_cb n active =
    if active then
     (magnify := n;
      if !wall_loaded then
       (new_pixmap ();
        redraw_pixmap ());
      set_status ~msg:("Zoom set to " ^ string_of_int n ^ "x")) in



  let about_cb () =
    Dialog.about () in



  let file_menu_entries = [
    `I ("New...", new_cb);
    `S;
    `I ("Open...", open_cb);
    `I ("Save As...", save_as_cb);
    `I ("Export...", export_cb);
    `S;
    `I ("Discard", discard_cb);
    `I ("Quit", GMain.quit)
  ] in

  let option_menu_entries = [
    `I ("Color...", color_cb);
    `I ("Modulus...", modulus_cb)
  ] in

  let zoom_menu_entries = [
    `R [ ("1x", false, (zoom_cb 1))
       ; ("2x", true,  (zoom_cb 2))
       ; ("3x", false, (zoom_cb 3))
       ; ("4x", false, (zoom_cb 4))]
  ] in

  let help_menu_entries = [
    `I ("About", about_cb)
  ] in



  let create_menu ~label ~bar ~entries =
    let item =
      GMenu.menu_item
        ~label
        ~packing:bar#append () in
    let menu =
      GMenu.menu
        ~packing:item#set_submenu () in
    GToolbox.build_menu menu ~entries;
    menu in

  let file_menu   = create_menu ~label:"File"    ~bar:menubar ~entries:file_menu_entries   in
  let option_menu = create_menu ~label:"Options" ~bar:menubar ~entries:option_menu_entries in
  let zoom_menu   = create_menu ~label:"Zoom"    ~bar:menubar ~entries:zoom_menu_entries   in
  let help_menu   = create_menu ~label:"Help"    ~bar:menubar ~entries:help_menu_entries   in

  menus := [("file",file_menu); ("option",option_menu); ("zoom",zoom_menu); ("help",help_menu)];

  disable_menu_items (List.assoc "file" !menus) [3;4;6];

  set_status ~msg:"No wall loaded";
  window#show ();
  GMain.Main.main ()



let _ = main ()