(* 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 ()