From 525863904e8cb1ce62bbbf407262e5305d6bbc6f Mon Sep 17 00:00:00 2001 From: Jedidiah Barber 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