summaryrefslogtreecommitdiff
path: root/src/visualwall.ml
diff options
context:
space:
mode:
authorJedidiah Barber <contact@jedbarber.id.au>2022-10-30 03:42:11 +1300
committerJedidiah Barber <contact@jedbarber.id.au>2022-10-30 03:42:11 +1300
commit95ebd2d6acfa744c5e93287cc6385f4f1359376e (patch)
tree87cea8951f3ef00b9ad53679c7fe70c208b0ec62 /src/visualwall.ml
parent3f290e0d6c3ef1435253095de2cf53016855840e (diff)
wallgen and wallsolve working, visualwall partially done, license added
Diffstat (limited to 'src/visualwall.ml')
-rw-r--r--src/visualwall.ml203
1 files changed, 203 insertions, 0 deletions
diff --git a/src/visualwall.ml b/src/visualwall.ml
new file mode 100644
index 0000000..3c07363
--- /dev/null
+++ b/src/visualwall.ml
@@ -0,0 +1,203 @@
+
+
+(* Programmed by Jedidiah Barber *)
+(* Licensed under the Sunset License v1.0 *)
+
+
+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 set_status ~msg =
+ context#pop ();
+ ignore (context#push msg) in
+
+
+
+ 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 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 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 new_cb () =
+ print_endline "New..." 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)
+ 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)
+ 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)
+ else
+ (set_status ~msg:"Canceled export") in
+
+
+
+ let discard_cb () =
+ print_endline "Discard" in
+
+
+
+ let color_cb () =
+ print_endline "Color..." in
+
+ let modulus_cb () =
+ print_endline "Modulus..." 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
+
+
+
+ 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 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 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);
+
+ set_status ~msg:"No wall loaded";
+ window#show ();
+ GMain.Main.main ()
+
+
+
+let _ = main ()
+
+