diff options
Diffstat (limited to 'src/dialog.ml')
| -rw-r--r-- | src/dialog.ml | 297 |
1 files changed, 297 insertions, 0 deletions
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 () + + |