From 525863904e8cb1ce62bbbf407262e5305d6bbc6f Mon Sep 17 00:00:00 2001
From: Jedidiah Barber <contact@jedbarber.id.au>
Date: Mon, 7 Nov 2022 03:31:07 +1300
Subject: visualwall now fully working
---
makefile | 4 +-
src/dialog.ml | 297 ++++++++++++++++++++++++++++++++++++++++++
src/dialog.mli | 26 ++++
src/visualwall.ml | 382 +++++++++++++++++++++++++++++++++++++++---------------
src/wall.ml | 6 +
src/wall.mli | 2 +
6 files changed, 613 insertions(+), 104 deletions(-)
create mode 100644 src/dialog.ml
create mode 100644 src/dialog.mli
diff --git a/makefile b/makefile
index d502225..dc4cc96 100644
--- a/makefile
+++ b/makefile
@@ -30,8 +30,10 @@ visualwall:
ocamlfind opt -g -linkpkg -I ${SOURCEDIR} \
-o ${OUTPUTDIR}/visualwall \
-package lablgtk2,zarith \
- ${SOURCEDIR}/sequence.mli ${SOURCEDIR}/sequence.ml \
+ ${SOURCEDIR}/util.mli ${SOURCEDIR}/util.ml \
${SOURCEDIR}/wall.mli ${SOURCEDIR}/wall.ml \
+ ${SOURCEDIR}/sequence.mli ${SOURCEDIR}/sequence.ml \
+ ${SOURCEDIR}/dialog.mli ${SOURCEDIR}/dialog.ml \
${SOURCEDIR}/visualwall.ml
wallgen:
diff --git a/src/dialog.ml b/src/dialog.ml
new file mode 100644
index 0000000..826d280
--- /dev/null
+++ b/src/dialog.ml
@@ -0,0 +1,297 @@
+
+
+(* Programmed by Jedidiah Barber *)
+(* Licensed under the Sunset License v1.0 *)
+
+
+let license_text =
+ "SUNSET LICENSE\n" ^
+ "Version 1.0, June 2017\n" ^
+ "\n" ^
+ "1. You may copy, modify, use, sell, or distribute this work, verbatim or\n" ^
+ "modified, for any purpose.\n" ^
+ "\n" ^
+ "2. If you sell or distribute this work, whether verbatim or modified, you must\n" ^
+ "include a copy of this license, and you must make the source code available for\n" ^
+ "no extra charge.\n" ^
+ "\n" ^
+ "3. A modified version of this work must be clearly labeled as such.\n" ^
+ "\n" ^
+ "4. Derivative works must also be licensed under this license or a license of\n" ^
+ "equivalent terms. As an exception, linking this work with another, whether\n" ^
+ "statically or dynamically, does not impose any license requirements on the\n" ^
+ "other work.\n" ^
+ "\n" ^
+ "5. If a minimum of 15 years have passed since the date of first publishing for\n" ^
+ "a part of this work, then that part is placed into the public domain and you\n" ^
+ "may do whatever you want with it, regardless of all other clauses.\n"
+
+
+
+let new_wall () =
+ let newer =
+ GWindow.dialog
+ ~title:"Create New Wall - Number Wall Viewer" () in
+ let dialog_box =
+ GPack.vbox
+ ~border_width:10
+ ~packing:newer#vbox#add () in
+ let frame =
+ GBin.frame
+ ~label:"New Wall"
+ ~packing:dialog_box#add () in
+ let frame_box =
+ GPack.vbox
+ ~border_width:5
+ ~packing:frame#add () in
+ let seq_box =
+ GPack.hbox
+ ~border_width:5
+ ~packing:frame_box#add () in
+ let _ =
+ GMisc.label
+ ~text:"Sequence : "
+ ~packing:seq_box#add () in
+ let seq_combo =
+ GEdit.combo
+ ~popdown_strings:["Pagoda";"Random"]
+ ~allow_empty:false
+ ~case_sensitive:false
+ ~enable_arrow_keys:true
+ ~packing:seq_box#add () in
+ let adj_box =
+ GPack.hbox
+ ~border_width:5
+ ~packing:frame_box#add () in
+ let x_adj =
+ GData.adjustment
+ ~value:200.0
+ ~lower:10.0
+ ~upper:10000.0
+ ~step_incr:1.0
+ ~page_incr:100.0
+ ~page_size:0.0 () in
+ let y_adj =
+ GData.adjustment
+ ~value:200.0
+ ~lower:10.0
+ ~upper:10000.0
+ ~step_incr:1.0
+ ~page_incr:100.0
+ ~page_size:0.0 () in
+ let _ =
+ GMisc.label
+ ~text:"X : "
+ ~packing:adj_box#add () in
+ let _ =
+ GEdit.spin_button
+ ~adjustment:x_adj
+ ~rate:0.0
+ ~digits:0
+ ~wrap:false
+ ~packing:adj_box#add () in
+ let _ =
+ GMisc.label
+ ~text:" Y : "
+ ~packing:adj_box#add () in
+ let _ =
+ GEdit.spin_button
+ ~adjustment:y_adj
+ ~rate:0.0
+ ~digits:0
+ ~wrap:false
+ ~packing:adj_box#add () in
+ newer#add_button_stock `CANCEL `CANCEL;
+ newer#add_button_stock `NEW `NEW;
+ let code = newer#run () in
+ let result = (int_of_float x_adj#value, int_of_float y_adj#value, seq_combo#entry#text) in
+ newer#destroy ();
+ if code = `NEW then Some result else None
+
+
+
+let open_file ?(folder = "") () =
+ let chooser =
+ GWindow.file_chooser_dialog
+ ~action:`OPEN
+ ~title:"Open Sequence - Number Wall Viewer" () in
+ chooser#add_button_stock `CANCEL `dialog;
+ chooser#add_select_button_stock `OPEN `filechooser;
+ ignore (chooser#set_current_folder folder);
+ let code = chooser#run () in
+ let maybe_result = chooser#filename in
+ chooser#destroy ();
+ if code <> `filechooser then None else maybe_result
+
+
+
+let overwrite_check ~filename =
+ if not (Sys.file_exists filename) then
+ true
+ else
+ (let asker =
+ GWindow.dialog
+ ~title:"Confirm Overwrite"
+ ~resizable:false
+ ~width:380 ~height:130 () in
+ let box =
+ GPack.hbox
+ ~packing:asker#vbox#add () in
+ ignore (GMisc.image
+ ~stock:`DIALOG_ERROR
+ ~packing:box#add ());
+ let message =
+ GMisc.label
+ ~text:("Error: " ^ filename ^ " already exists.")
+ ~packing:box#add () in
+ message#set_line_wrap true;
+ asker#add_button "Cancel" `dialog;
+ asker#add_button "Overwrite" `filechooser;
+ let code = asker#run () in
+ asker#destroy ();
+ code = `filechooser)
+
+let save_export_file ~title ?(folder = "") ?(name = "") () =
+ let chooser =
+ GWindow.file_chooser_dialog
+ ~action:`SAVE
+ ~title:title () in
+ chooser#add_button_stock `CANCEL `dialog;
+ chooser#add_select_button_stock `SAVE `filechooser;
+ chooser#set_current_name name;
+ ignore (chooser#set_current_folder folder);
+ let rec get_result chooser =
+ let code = chooser#run () in
+ let choice = chooser#filename in
+ if code <> `filechooser then
+ None
+ else
+ if Option.is_none choice ||
+ overwrite_check ~filename:(Option.get choice)
+ then
+ choice
+ else
+ get_result chooser in
+ let result = get_result chooser in
+ chooser#destroy ();
+ result
+
+let save_file ?(folder = "") ?(name = "") () =
+ save_export_file ~title:"Save Sequence - Number Wall Viewer" ~folder ~name ()
+
+let export_file ?(folder = "") ?(name = "") () =
+ save_export_file ~title:"Export Image - Number Wall Viewer" ~folder ~name ()
+
+
+
+let colors ~fore ~back =
+ let colormap = Gdk.Color.get_system_colormap () in
+ let fore_color = Gdk.Color.alloc ~colormap (`RGB fore) in
+ let back_color = Gdk.Color.alloc ~colormap (`RGB back) in
+ let kaleidoscope =
+ GWindow.dialog
+ ~title:"Change Colors - Number Wall Viewer" () in
+ let dialog_box =
+ GPack.vbox
+ ~border_width:10
+ ~packing:kaleidoscope#vbox#add () in
+ let frame =
+ GBin.frame
+ ~label:"Colors"
+ ~packing:dialog_box#add () in
+ let frame_box =
+ GPack.vbox
+ ~border_width:5
+ ~packing:frame#add () in
+ let fg_box =
+ GPack.hbox
+ ~packing:frame_box#add () in
+ let _ =
+ GMisc.label
+ ~text:"Foreground : "
+ ~packing:fg_box#add () in
+ let fg_button =
+ GButton.color_button
+ ~color:fore_color
+ ~title:"Change Foreground Color"
+ ~packing:fg_box#add () in
+ let bg_box =
+ GPack.hbox
+ ~packing:frame_box#add () in
+ let _ =
+ GMisc.label
+ ~text:"Background : "
+ ~packing:bg_box#add () in
+ let bg_button =
+ GButton.color_button
+ ~color:back_color
+ ~title:"Change Background Color"
+ ~packing:bg_box#add () in
+ kaleidoscope#add_button_stock `CANCEL `CANCEL;
+ kaleidoscope#add_button_stock `APPLY `APPLY;
+ let code = kaleidoscope#run () in
+ let (new_fg, new_bg) = (fg_button#color, bg_button#color) in
+ kaleidoscope#destroy ();
+ let fg_r = Gdk.Color.red new_fg in
+ let fg_g = Gdk.Color.green new_fg in
+ let fg_b = Gdk.Color.blue new_fg in
+ let bg_r = Gdk.Color.red new_bg in
+ let bg_g = Gdk.Color.green new_bg in
+ let bg_b = Gdk.Color.blue new_bg in
+ if code = `APPLY then Some ((fg_r, fg_g, fg_b), (bg_r, bg_g, bg_b)) else None
+
+
+
+let modulus ~current =
+ let changer =
+ GWindow.dialog
+ ~title:"Set Modulus - Number Wall Viewer" () in
+ let dialog_box =
+ GPack.vbox
+ ~border_width:10
+ ~packing:changer#vbox#add () in
+ let frame =
+ GBin.frame
+ ~label:"Modulus"
+ ~packing:dialog_box#add () in
+ let frame_box =
+ GPack.vbox
+ ~border_width:5
+ ~packing:frame#add () in
+ let adj =
+ GData.adjustment
+ ~value:(float_of_int current)
+ ~lower:2.0
+ ~upper:10001.0
+ ~step_incr:1.0
+ ~page_incr:100.0
+ ~page_size:0.0 () in
+ let _ =
+ GEdit.spin_button
+ ~adjustment:adj
+ ~rate:0.0
+ ~digits:0
+ ~wrap:false
+ ~packing:frame_box#add () in
+ changer#add_button_stock `CANCEL `CANCEL;
+ changer#add_button_stock `APPLY `APPLY;
+ let code = changer#run () in
+ let maybe_result = adj#value in
+ changer#destroy ();
+ if code = `APPLY then Some (int_of_float maybe_result) else None
+
+
+
+let about () =
+ let about_window =
+ GWindow.about_dialog
+ ~authors:["Jedidiah Barber"]
+ ~comments:"A simple program to generate and visualise number walls."
+ ~license:license_text
+ ~title:"About - Number Wall Viewer"
+ ~modal:true () in
+ let destroy_me button = about_window#destroy () in
+ ignore (about_window#connect#response ~callback:destroy_me);
+ about_window#show ()
+
+
diff --git a/src/dialog.mli b/src/dialog.mli
new file mode 100644
index 0000000..29bcf12
--- /dev/null
+++ b/src/dialog.mli
@@ -0,0 +1,26 @@
+
+
+(* Programmed by Jedidiah Barber *)
+(* Licensed under the Sunset License v1.0 *)
+
+
+val license_text : string
+
+
+
+val new_wall : unit -> (int * int * string) option
+
+val open_file : ?folder:string -> unit -> string option
+
+val save_file : ?folder:string -> ?name:string -> unit -> string option
+
+val export_file : ?folder:string -> ?name:string -> unit -> string option
+
+val colors : fore:(int * int * int) -> back:(int * int * int) ->
+ ((int * int * int) * (int * int * int)) option
+
+val modulus : current:int -> int option
+
+val about : unit -> unit
+
+
diff --git a/src/visualwall.ml b/src/visualwall.ml
index 3c07363..773f226 100644
--- a/src/visualwall.ml
+++ b/src/visualwall.ml
@@ -4,29 +4,56 @@
(* 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
+ 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 main_vbox =
+ GPack.vbox
+ ~packing:window#add () in
+
+ let menubar =
+ GMenu.menu_bar
+ ~packing:(main_vbox#pack ~expand:false) () 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 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 context = statusbar#new_context ~name:"Program status" in
let set_status ~msg =
context#pop ();
@@ -34,130 +61,261 @@ let main () =
- let choose_open_file ~title ?(folder = "") () =
- let chooser = GWindow.file_chooser_dialog
- ~action:`OPEN
- ~title:title () in
- chooser#add_button_stock `CANCEL `dialog;
- chooser#add_select_button_stock `OPEN `filechooser;
- ignore (chooser#set_current_folder folder);
- let code = chooser#run () in
- let maybe_result = chooser#filename in
- chooser#destroy ();
- match maybe_result with
- | None -> ""
- | Some result -> if code = `filechooser then result else "" in
-
- let choose_save_file ~title ?(folder = "") ?(name = "") () =
- let chooser = GWindow.file_chooser_dialog
- ~action:`SAVE
- ~title:title () in
- chooser#add_button_stock `CANCEL `dialog;
- chooser#add_select_button_stock `SAVE `filechooser;
- chooser#set_current_name name;
- ignore (chooser#set_current_folder folder);
- let code = chooser#run () in
- let maybe_result = chooser#filename in
- chooser#destroy ();
- match maybe_result with
- | None -> ""
- | Some result -> if code = `filechooser then result else "" 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
+ if not (Sys.file_exists testname) then
+ testname
+ else
+ checker (num + 1) in
checker 1 in
- let overwrite_check ~filename =
- if not (Sys.file_exists filename) then true else
- (let asker = GWindow.dialog
- ~title:"Confirm Overwrite"
- ~resizable:false
- ~width:380 ~height:130 () in
- let box = GPack.hbox
- ~packing:asker#vbox#add () in
- let _ = GMisc.image
- ~stock:`DIALOG_ERROR
- ~packing:box#add () in
- let message = GMisc.label
- ~text:("Error: " ^ filename ^ " already exists.")
- ~packing:box#add () in
- message#set_line_wrap true;
- asker#add_button "Cancel" `dialog;
- asker#add_button "Overwrite" `filechooser;
- let code = asker#run () in
- asker#destroy ();
- code = `filechooser) 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 () =
- print_endline "New..." in
+ 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 filename = choose_open_file
- ~title:"Open Sequence - Number Wall Viewer"
- ~folder:(Sys.getcwd ()) () in
- if filename != "" then
- (set_status ~msg:("Opened " ^ filename);
- print_endline filename)
+ 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 filename = choose_save_file
- ~title:"Save Sequence - Number Wall Viewer"
- ~folder:(Sys.getcwd ())
- ~name:(generate_unused ~basename:"sequence" ~extension:"txt") () in
- if filename != "" && overwrite_check ~filename then
- (set_status ~msg:("Saved sequence to " ^ filename);
- print_endline filename)
+ 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 filename = choose_save_file
- ~title:"Export Image - Number Wall Viewer"
- ~folder:(Sys.getcwd ())
- ~name:(generate_unused ~basename:"image" ~extension:"png") () in
- if filename != "" && overwrite_check ~filename then
- (set_status ~msg:("Exported image to " ^ filename);
- print_endline filename)
+ 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 () =
- print_endline "Discard" in
+ 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 () =
- print_endline "Color..." in
+ 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 () =
- print_endline "Modulus..." in
+ 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 () =
- let about_window = GWindow.about_dialog
- ~authors:["Jedidiah Barber"]
- ~comments:"A simple program to generate and visualise number walls."
- ~license:"Sunset License v1.0"
- ~title:"About - Number Wall Viewer"
- ~modal:true () in
- let destroy_me button = about_window#destroy () in
- ignore (about_window#connect#response ~callback:destroy_me);
- about_window#show () in
+ Dialog.about () in
@@ -177,6 +335,13 @@ let main () =
`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
@@ -184,13 +349,24 @@ let main () =
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 in
-
- ignore (create_menu ~label:"File" ~bar:menubar ~entries:file_menu_entries);
- ignore (create_menu ~label:"Options" ~bar:menubar ~entries:option_menu_entries);
- ignore (create_menu ~label:"Help" ~bar:menubar ~entries:help_menu_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 ();
diff --git a/src/wall.ml b/src/wall.ml
index 94043dc..6c11939 100644
--- a/src/wall.ml
+++ b/src/wall.ml
@@ -22,6 +22,7 @@ module type S =
sig
type element
type wall
+ val empty : wall
val create : dimx:int -> dimy:int -> init:element array -> wall
val x_length : wall -> int
val y_length : wall -> int
@@ -281,6 +282,11 @@ module Make (A : Algebra) =
with Exit ->
result
+ (* The empty wall isn't truly empty because every wall has *)
+ (* a row of ones at the very top, regardless of the input sequence. *)
+ let empty =
+ Array.make_matrix 1 1 (Some A.one)
+
let get wall ~x ~y =
diff --git a/src/wall.mli b/src/wall.mli
index 59d8edb..dc96218 100644
--- a/src/wall.mli
+++ b/src/wall.mli
@@ -26,6 +26,8 @@ module type S =
type element
type wall
+ val empty : wall
+
val create : dimx:int -> dimy:int -> init:element array -> wall
val x_length : wall -> int
--
cgit