From 95ebd2d6acfa744c5e93287cc6385f4f1359376e Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Sun, 30 Oct 2022 03:42:11 +1300 Subject: wallgen and wallsolve working, visualwall partially done, license added --- src/visualwall.ml | 203 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 203 insertions(+) create mode 100644 src/visualwall.ml (limited to 'src/visualwall.ml') 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 () + + -- cgit