Index: trunk/omega/src/thoGMenu.mli =================================================================== --- trunk/omega/src/thoGMenu.mli (revision 8859) +++ trunk/omega/src/thoGMenu.mli (revision 8860) @@ -1,92 +0,0 @@ -(* thoGMenu.mli -- - - Copyright (C) 1999-2023 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - with contributions from - Christian Speckner - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* Lists of possible particles can be pretty long. Therefore it is - beneficial to present the choices hierarchically. *) - -type 'a menu_tree = - | Leafs of (string * 'a) list - | Branches of (string * 'a menu_tree) list - -val submenu_tree : ('a -> unit) -> 'a menu_tree -> GMenu.menu -val tree_of_nested_lists : ('a -> string) -> (string * 'a list) list -> 'a menu_tree - -class virtual ['a] menu_button : Gtk.button Gtk.obj * GMisc.label -> - ('a -> string) -> 'a -> 'a menu_tree -> - object - inherit ['a] ThoGButton.stateful_button - method virtual set_menu : 'a menu_tree -> unit - end - -class type ['a] menu_button_type = - object - inherit ['a] menu_button - method set_menu : 'a menu_tree -> unit - end - -class ['a] menu_button_immediate : Gtk.button Gtk.obj * GMisc.label -> - ('a -> string) -> 'a -> 'a menu_tree -> ['a] menu_button_type - -class ['a] menu_button_delayed : Gtk.button Gtk.obj * GMisc.label -> - ('a -> string) -> 'a -> 'a menu_tree -> ['a] menu_button_type - -val menu_button : ('a -> string) -> 'a -> 'a menu_tree -> - ?border_width:int -> ?width:int -> ?height:int -> - ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> - 'a menu_button_delayed - -class ['a] tensor_menu : ('a -> string) -> 'a -> 'a menu_tree -> int -> - ?label:string -> ?tooltip_maker:(int -> string) -> - ?border_width:'b -> ?width:int -> ?height:int -> - ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> - object - val mutable active : int - val mutable buttons : 'a menu_button array - val frame : GBin.frame - method frame : GBin.frame - method set_active : int -> unit - method set_menu : 'a menu_tree -> unit - method states : 'a array - end - -(* This is the same as [GMenu.factory] but with the ability to - add right justified menus; for Motif-style `Help' menus, for - example. *) - -class ['a] factory : ?accel_group:Gtk.accel_group -> - ?accel_modi:Gdk.Tags.modifier list -> - ?accel_flags:Gtk.Tags.accel_flag list -> 'a -> - object - inherit ['a] GMenu.factory - method add_submenu_right : - ?key:Gdk.keysym -> string -> GMenu.menu - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: trunk/omega/src/thoGMenu.ml =================================================================== --- trunk/omega/src/thoGMenu.ml (revision 8859) +++ trunk/omega/src/thoGMenu.ml (revision 8860) @@ -1,148 +0,0 @@ -(* thoGMenu.ml -- - - Copyright (C) 1999-2023 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - with contributions from - Christian Speckner - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* Lists of possible particles can be pretty long. Therefore it is - beneficial to present the choices hierarchically. *) - -type 'a menu_tree = - | Leafs of (string * 'a) list - | Branches of (string * 'a menu_tree) list - -let rec submenu_tree accept = function - | Leafs choices -> - let menu = GMenu.menu () in - List.iter (fun (label, choice) -> - let item = GMenu.menu_item ~label ~packing:menu#append () in - ignore (item#connect#activate - ~callback:(fun () -> accept choice))) choices; - menu - | Branches choices -> - let menu = GMenu.menu () in - List.iter (fun (label, choices') -> - let item = GMenu.menu_item ~label ~packing:menu#append () in - item#set_submenu (submenu_tree accept choices')) choices; - menu - -let tree_of_nested_lists format nested = - Branches (List.map (fun (label, sub_menus) -> - (label, Leafs (List.map (fun o -> (format o, o)) sub_menus))) nested) - -(* We can either build the menus at startup (or immediately after - model selection) or build them when the button is clicked. There - appears to be no noticeable performance difference. *) - -class virtual ['a] menu_button widgets format state menu = - object (self) - inherit ['a] ThoGButton.stateful_button widgets format state - method virtual set_menu : 'a menu_tree -> unit - initializer self#set_menu menu - end - -class type ['a] menu_button_type = - object - inherit ['a] menu_button - method set_menu : 'a menu_tree -> unit - end - -(* \begin{dubious} - [class type ['a] menu_button_type = ['a] ThoGMenu.menu_button_type] does - \emph{not} work! - \end{dubious} *) - -class ['a] menu_button_immediate widgets format inistate menu = - object (self) - inherit ['a] menu_button widgets format inistate menu - method set_menu menu = - let m = submenu_tree self#set_state menu in - self#connect#clicked ~callback:(fun () -> m#popup ~button:3 ~time:0); - () - end - -class ['a] menu_button_delayed widgets format state menu = - object (self) - inherit ['a] menu_button widgets format state menu - method set_menu menu = - self#connect#clicked ~callback:(fun () -> - let m = submenu_tree self#set_state menu in - m#popup ~button:3 ~time:0); - () - end - -let menu_button format state menu - ?border_width ?width ?height ?packing ?show () = - new menu_button_delayed (ThoGButton.mutable_button_raw - ?border_width ?width ?height ?packing ?show ()) - format state menu - -(* Select tuples of similar objects. *) - -class ['a] tensor_menu format state menu n ?label ?tooltip_maker - ?border_width ?width ?height ?packing ?show () = - let frame = GBin.frame ?label ?packing ?show () in - let hbox = GPack.hbox ~packing:frame#add ?show () in - let tooltips = - match tooltip_maker with - | None -> None - | Some maker -> Some (GData.tooltips (), maker) in - let buttons = - Array.init n (fun i -> - let mb = menu_button format state menu - ?width ?height ~packing:(hbox#pack ~expand:false) ?show () in - begin match tooltips with - | None -> () - | Some (widget, maker) -> widget#set_tip mb#coerce ~text:(maker i) - end; - mb) in - object (self) - val frame = frame - val mutable buttons : 'a menu_button array = buttons - val mutable active = n - method frame = frame - method set_menu menu = - Array.iter (fun b -> b#set_menu menu) buttons - method set_active n = - active <- n; - Array.iteri (fun i b -> b#misc#set_sensitive (i < active)) buttons - method states = - Array.map (fun b -> b#state) (Array.sub buttons 0 active) - end - -class ['a] factory ?accel_group ?accel_modi ?accel_flags menu_shell = - object (self) - inherit ['a] GMenu.factory - ?accel_group ?accel_modi ?accel_flags menu_shell - method add_submenu_right ?key label = - let item = GMenu.menu_item ~label () in - item#right_justify (); - self#bind item ?key; - GMenu.menu ~packing:item#set_submenu () -end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: trunk/omega/src/thoGWindow.ml =================================================================== --- trunk/omega/src/thoGWindow.ml (revision 8859) +++ trunk/omega/src/thoGWindow.ml (revision 8860) @@ -1,41 +0,0 @@ -(* thoGWindow.ml -- - - Copyright (C) 1999-2023 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - with contributions from - Christian Speckner - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Misc.~Windows} *) - -let message ?justify ?title ~text () = - let w = GWindow.window ?title ~border_width:5 () in - let v = GPack.vbox ~spacing:8 ~packing:w#add () in - GMisc.label ~xpad:5 ~ypad:5 ?justify ~text ~packing:v#add (); - let b = GButton.button ~label:"OK" ~packing:v#add () in - b#connect#clicked ~callback:w#destroy; - w#show () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: trunk/omega/src/thoGWindow.mli =================================================================== --- trunk/omega/src/thoGWindow.mli (revision 8859) +++ trunk/omega/src/thoGWindow.mli (revision 8860) @@ -1,36 +0,0 @@ -(* thoGWindow.mli -- - - Copyright (C) 1999-2023 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - with contributions from - Christian Speckner - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Misc.~Windows} *) - -val message : ?justify:Gtk.Tags.justification -> - ?title:string -> text:string -> unit -> unit - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: trunk/omega/src/thoGButton.mli =================================================================== --- trunk/omega/src/thoGButton.mli (revision 8859) +++ trunk/omega/src/thoGButton.mli (revision 8860) @@ -1,62 +0,0 @@ -(* thoGButton.mli -- - - Copyright (C) 1999-2023 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - with contributions from - Christian Speckner - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* Plain [GButton.button]s have an immutable label. We can remedy this - situation by adding an explicit label and exporting its [set_text] - method. *) - -class mutable_button : Gtk.button Gtk.obj * GMisc.label -> - object - inherit GButton.button - method set_text : string -> unit - end - -val mutable_button_raw : - ?text:string -> ?border_width:int -> ?width:int -> ?height:int -> - ?packing:(GObj.widget -> unit) -> - ?show:bool -> unit -> Gtk.button Gtk.obj * GMisc.label - -val mutable_button : - ?text:string -> ?border_width:int -> ?width:int -> ?height:int -> - ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> mutable_button - -class ['a] stateful_button : Gtk.button Gtk.obj * GMisc.label -> - ('a -> string) -> 'a -> - object - inherit mutable_button - method state : 'a - method set_state : 'a -> unit - end - -val stateful_button : ('a -> string) -> 'a -> - ?text:string -> ?border_width:int -> ?width:int -> ?height:int -> - ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> 'a stateful_button - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: trunk/omega/src/thoGDraw.ml =================================================================== --- trunk/omega/src/thoGDraw.ml (revision 8859) +++ trunk/omega/src/thoGDraw.ml (revision 8860) @@ -1,753 +0,0 @@ -(* thoGDraw.ml -- - - Copyright (C) 1999-2023 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - with contributions from - Christian Speckner - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Tracking Display Sizes} *) - -class type resizeable = - object - method size_allocate : callback:(Gtk.rectangle -> unit) -> GtkSignal.id - end - -class size signals= - object (self) - - val mutable width = -1 - val mutable height = -1 - - method width = width - method height = height - - method private resize w h = - width <- w; - height <- h - - initializer - let (_ : GtkSignal.id) = signals#size_allocate - ~callback:(fun evt -> self#resize evt.Gtk.width evt.Gtk.height) in - () - end - -class type ['a, 'b] window = - object - method window : 'a Gdk.drawable - method realize : unit -> unit - method connect : 'b - constraint 'b = #resizeable - end - -(* \thocwmodulesection{Coordinate Systems} *) - -(* We could try to jump through hoops and inherit from [size], but it is much - simpler just to repeat the few lines of code. *) - -class coordinates ?(margins = 0) - ?(xrange = (0.0, 1.0)) ?(yrange = (0.0, 1.0)) signals = - object (self) - -(* ``Input'' parameters: *) - val mutable width = -1 - val mutable height = -1 - - val mutable x_min = fst xrange - val mutable x_max = snd xrange - val mutable y_min = fst yrange - val mutable y_max = snd yrange - - val mutable left_margin = margins - val mutable right_margin = margins - val mutable bottom_margin = margins - val mutable top_margin = margins - -(* Derived parameters: *) - val mutable x_min_pxl = 0 - val mutable x_max_pxl = 100 - val mutable x_delta_pxl = 100 - val mutable y_min_pxl = 0 - val mutable y_max_pxl = 100 - val mutable y_delta_pxl = 100 - - val mutable x_delta = 1.0 - val mutable y_delta = 1.0 - - val mutable x_pxl_per_unit = 100.0 - val mutable y_pxl_per_unit = 100.0 - - method private update = - x_min_pxl <- left_margin; - x_max_pxl <- width - right_margin; - x_delta_pxl <- x_max_pxl - x_min_pxl; - x_delta <- x_max -. x_min; - x_pxl_per_unit <- float x_delta_pxl /. x_delta; - y_min_pxl <- top_margin; - y_max_pxl <- height - bottom_margin; - y_delta_pxl <- y_max_pxl - y_min_pxl; - y_delta <- y_max -. y_min; - y_pxl_per_unit <- float y_delta_pxl /. y_delta - -(* The [resize] method is only called from signal handlers that - respond to external size changes. *) - - method private resize w h = - width <- w; height <- h; - self#update - - method left_margin m = - left_margin <- m; - self#update - - method right_margin m = - right_margin <- m; - self#update - - method bottom_margin m = - bottom_margin <- m; - self#update - - method top_margin m = - top_margin <- m; - self#update - - method margins m = - left_margin <- m; - right_margin <- m; - bottom_margin <- m; - top_margin <- m; - self#update - - method xrange x0 x1 = - x_min <- x0; x_max <- x1; - self#update - - method yrange y0 y1 = - y_min <- y0; y_max <- y1; - self#update - - method private x_pxl_per_unit = - x_pxl_per_unit - - method private y_pxl_per_unit = - y_pxl_per_unit - - method private project_x x = - x_min_pxl + truncate (x_pxl_per_unit *. (x -. x_min)) - - method private project_y y = - y_max_pxl - truncate (y_pxl_per_unit *. (y -. y_min)) - - method private project (x, y) = - (self#project_x x, self#project_y y) - - initializer - let (_ : GtkSignal.id) = signals#size_allocate - ~callback:(fun evt -> self#resize evt.Gtk.width evt.Gtk.height) in - self#update - end - -(* \thocwmodulesection{Viewports} *) - -let config_file_name = ".ogiga" - -let default_font_name = - "-*-*-*-r-*-*-*-120-*-*-m-*-*-*" - -let out_comment oc comment = - Printf.fprintf oc "(* %s *)\n" comment - -let out_string_parameter oc name value = - Printf.fprintf oc "%s = \"%s\"\n" name value - -let out_int_parameter oc name value = - Printf.fprintf oc "%s = %d\n" name value - -class decoration_context = - object (self) - - val mutable font_name = default_font_name - val mutable font = Gdk.Font.load default_font_name - val mutable line_width = 2 - val mutable arrowhead_tip = 8 - val mutable arrowhead_base = 5 - val mutable arrowhead_width = 4 - val mutable wiggle_amp = 3 - val mutable wiggle_len = 10 - val mutable wiggle_res = 1 - val mutable curl_amp = 5 - val mutable curl_len = 10 - val mutable curl_res = 1 - - method font = font - method font_name = font_name - method line_width = line_width - method arrowhead_tip = arrowhead_tip - method arrowhead_base = arrowhead_base - method arrowhead_width = arrowhead_width - method wiggle_amp = wiggle_amp - method wiggle_len = wiggle_len - method wiggle_res = wiggle_res - method curl_amp = curl_amp - method curl_len = curl_len - method curl_res = curl_res - - method set_font name = - font_name <- name; - font <- Gdk.Font.load font_name - method set_line_width n = line_width <- n - method set_arrowhead_tip n = arrowhead_tip <- n - method set_arrowhead_base n = arrowhead_base <- n - method set_arrowhead_width n = arrowhead_width <- n - method set_wiggle_amp n = wiggle_amp <- n - method set_wiggle_len n = wiggle_len <- n - method set_wiggle_res n = wiggle_res <- n - method set_curl_amp n = curl_amp <- n - method set_curl_len n = curl_len <- n - method set_curl_res n = curl_res <- n - - method to_channel oc = - out_comment oc "O'Giga decoration options"; - out_string_parameter oc "font" font_name; - out_int_parameter oc "line_width" line_width; - out_int_parameter oc "arrowhead_tip" arrowhead_tip; - out_int_parameter oc "arrowhead_base" arrowhead_base; - out_int_parameter oc "arrowhead_width" arrowhead_width; - out_int_parameter oc "wiggle_amp" wiggle_amp; - out_int_parameter oc "wiggle_len" wiggle_len; - out_int_parameter oc "wiggle_res" wiggle_res; - out_int_parameter oc "curl_amp" curl_amp; - out_int_parameter oc "curl_len" curl_len; - out_int_parameter oc "curl_res" curl_res - - method save () = - let oc = open_out config_file_name in - self#to_channel oc; - close_out oc - - method of_stream stream = - let tokens = Genlex.make_lexer ["="] stream in - let junk3 () = - Stream.junk tokens; - Stream.junk tokens; - Stream.junk tokens in - let rec process () = - match Stream.npeek 3 tokens with - | [] -> () - | [Genlex.Ident name; Genlex.Kwd "="; Genlex.String value] -> - begin match name with - | "font" -> self#set_font value - | _ -> invalid_arg "invalid string variable in configuration file" - end; - junk3 (); - process () - | [Genlex.Ident name; Genlex.Kwd "="; Genlex.Int value] -> - begin match name with - | "line_width" -> self#set_line_width value - | "arrowhead_tip" -> self#set_arrowhead_tip value - | "arrowhead_base" -> self#set_arrowhead_base value - | "arrowhead_width" -> self#set_arrowhead_width value - | "wiggle_amp" -> self#set_wiggle_amp value - | "wiggle_len" -> self#set_wiggle_len value - | "wiggle_res" -> self#set_wiggle_res value - | "curl_amp" -> self#set_curl_amp value - | "curl_len" -> self#set_curl_len value - | "curl_res" -> self#set_curl_res value - | _ -> invalid_arg "invalid integer variable in configuration file" - end; - junk3 (); - process () - | _ -> invalid_arg "parse error in configuration file" in - process () - - method restore () = - if Sys.file_exists config_file_name then - let ic = open_in config_file_name in - self#of_stream (Stream.of_channel ic); - close_in ic - - initializer - self#restore () - - end - -type horiz = HCenter | Left of int | Right of int -type vert = VCenter | Below of int | Above of int - -let align_horiz align w x = - match align with - | Right dx -> x + dx - | Left dx -> x - w - dx - | HCenter -> x - w / 2 - -let align_vert align h y = - match align with - | Above dy -> y - dy - | Below dy -> y + h + dy - | VCenter -> y + h / 2 - -let align_box (horiz, vert) (w, h) (x,y) = - (align_horiz horiz w x, align_vert vert h y) - -let pixels ~pos (x0, y0) (x1, y1) (along, perp) = - let dx = float (x1 - x0) - and dy = float (y1 - y0) in - let d = sqrt (dx *. dx +. dy *. dy) in - let along' = pos +. float along /. d - and perp' = float perp /. d in - (x0 + truncate (along' *. dx -. perp' *. dy), - y0 + truncate (along' *. dy +. perp' *. dx)) - -let pixel_shape ~pos (x0, y0) (x1, y1) shape = - List.map (pixels ~pos:0.5 (x0, y0) (x1, y1)) shape - -let two_pi = 4.0 *. asin 1.0 - -class ['a] decorations ?colormap (dc : decoration_context) obj = - object (self) - - val mutable dc = dc - - inherit ['a] GDraw.drawable ?colormap obj as drawable - - method decoration_context = dc - method set_decoration_context dc' = dc <- dc' - - method aligned_string ?(font = dc#font) - ?(align = (HCenter, VCenter)) s xy = - let x', y' = - align_box align - (Gdk.Font.string_width font s, Gdk.Font.string_height font s) xy in - self#string s ~font ~x:x' ~y:y' - - method arrowhead (x0, y0) (x1, y1) = - self#polygon ~filled:true - (pixel_shape ~pos:0.5 (x0, y0) (x1, y1) - [(dc#arrowhead_tip, 0); - (-dc#arrowhead_base, dc#arrowhead_width); - (-dc#arrowhead_base, -dc#arrowhead_width)]) - - method double (x0, y0) (x1, y1) = - let gc = drawable#gc_values in - let w = gc.Gdk.GC.line_width in - self#polygon ~filled:false - [pixels ~pos:0.0 (x0, y0) (x1, y1) (0, w); - pixels ~pos:1.0 (x0, y0) (x1, y1) (0, w); - pixels ~pos:1.0 (x0, y0) (x1, y1) (0, -w); - pixels ~pos:0.0 (x0, y0) (x1, y1) (0, -w)] - - method wiggles (x0, y0) (x1, y1) = - let amplitude = dc#wiggle_amp - and step = dc#wiggle_len in - let dx = float (x1 - x0) - and dy = float (y1 - y0) in - let d = sqrt (dx *. dx +. dy *. dy) in - let num_steps = ceil (d /. float step) in - let step = d /. num_steps in - let amplitude = float amplitude in - let xy along perp = - let along' = along /. d - and perp' = perp *. amplitude /. d in - (x0 + truncate (along' *. dx -. perp' *. dy), - y0 + truncate (along' *. dy +. perp' *. dx)) in - let rec wiggles' t = - if t <= 0.0 then - [xy 0.0 0.0] - else - xy t (sin (t *. two_pi /. step)) :: wiggles' (t -. step /. 10.0) in - self#lines (wiggles' d) - - method curls (x0, y0) (x1, y1) = - let amplitude = dc#curl_amp - and step = dc#curl_len in - let dx = float (x1 - x0) - and dy = float (y1 - y0) in - let d = sqrt (dx *. dx +. dy *. dy) in - let num_steps = ceil (d /. float step) in - let step = d /. num_steps in - let amplitude = float amplitude in - let xy along perp = - let along' = along /. d - and perp' = perp *. amplitude /. d in - (x0 + truncate (along' *. dx -. perp' *. dy), - y0 + truncate (along' *. dy +. perp' *. dx)) in - let rec curls' t = - if t <= 0.0 then - [xy 0.0 0.0] - else - xy (t +. step /. 2.0 *. cos (t *. two_pi /. step)) (sin (t *. two_pi /. step)) - :: curls' (t -. step /. 10.0) in - self#lines (curls' d) - - end - -class ['a] drawable ?colormap dc misc = - let () = misc#realize () in - object (self) - - inherit ['a] decorations ?colormap dc misc#window as drawable - val size = new size misc#connect - - method clear ?(color = `WHITE) () = - drawable#set_foreground color; - drawable#rectangle ~filled:true - ~x:0 ~y:0 ~width:size#width ~height:size#height () - - end - -type direction = - | Forward - | Backward - -type line_style = - | Plain - | Double - | Wiggles - | Curls - | Dashes - | Dots - | Arrow of direction - | Name of string - -class ['a] viewport ?colormap ?margins ?xrange ?yrange dc misc = - let () = misc#realize () in - object (self) - - inherit coordinates ?margins ?xrange ?yrange misc#connect - - val drawable = new drawable ?colormap dc misc - - method drawable = (drawable : 'a drawable) - - method arc ?filled ?start ?angle (width, height) (x, y) = - drawable#arc - ~x:(self#project_x x - width/2) ~y:(self#project_y y - height/2) - ~width ~height ?filled ?start ?angle () - - method point (x, y) = - drawable#point ~x:(self#project_x x) ~y:(self#project_y y) - - method points xy = - drawable#points (List.map self#project xy) - - method line (x0, y0) (x1, y1) = - drawable#line - ~x:(self#project_x x0) ~y:(self#project_y y0) - ~x:(self#project_x x1) ~y:(self#project_y y1) - - method lines xy = - drawable#lines (List.map self#project xy) - - method segments xyxy = - drawable#segments - (List.map (fun (xy0, xy1) -> (self#project xy0, self#project xy1)) xyxy) - - method polygon ?filled xy = - drawable#polygon ?filled (List.map self#project xy) - - method string ?font ?align s xy = - drawable#aligned_string ?font ?align s (self#project xy) - - method propagator line_style (x0, y0 as xy0) (x1, y1 as xy1) = - match line_style with - | Arrow Forward -> - self#line xy0 xy1; - drawable#arrowhead (self#project xy0) (self#project xy1) - | Arrow Backward -> - self#line xy0 xy1; - drawable#arrowhead (self#project xy1) (self#project xy0) - | Plain -> - self#line xy0 xy1 - | Double -> - drawable#double (self#project xy0) (self#project xy1) - | Wiggles -> - drawable#wiggles (self#project xy0) (self#project xy1) - | Curls -> - drawable#curls (self#project xy0) (self#project xy1) - | Dashes -> - self#line xy0 xy1; - drawable#set_foreground (`NAME "red"); - self#string "dashes" (0.5 *. (x0 +. x1), 0.5 *. (y0 +. y1)) - | Dots -> - self#line xy0 xy1; - drawable#set_foreground (`NAME "red"); - self#string "dots" (0.5 *. (x0 +. x1), 0.5 *. (y0 +. y1)) - | Name name -> - self#line xy0 xy1; - drawable#set_foreground (`NAME "red"); - self#string name (0.5 *. (x0 +. x1), 0.5 *. (y0 +. y1)) - - end - -(* \thocwmodulesection{Diagram Displays} *) - -let to_string format tree = - Tree.to_string (Tree.map format (fun _ -> "") tree) - -let layout2 nodes2edge conjugate wf2 tree = - Tree.layout (Tree.left_to_right 2 - (Tree.graph_of_tree nodes2edge conjugate wf2 tree)) - -class ['a, 'edge, 'node] diagram_display - ~node_to_string ~conjugate ~cross ~nodes2edge ~line_style - ?label ?width ?height ?packing dc = - let event_box = GBin.event_box ~border_width:0 ?packing () in - let frame = GBin.frame ?label ~packing:event_box#add () in - let area = GMisc.drawing_area ?width ?height ~packing:frame#add () in - let vp = new viewport dc area#misc in - let _ = - vp#left_margin 50; - vp#right_margin 50; - vp#bottom_margin 10; - vp#top_margin 10 in - object (self) - - val mutable diagram : - ('node * ('node, 'node) Tree.t * (unit, 'node) Color.amplitude) option = None - - val mutable label = - match label with - | Some s -> s - | None -> "" - - method set_label s = - label <- s; - frame#set_label label - - method viewport = (vp : 'a viewport) - method event = event_box#event - - method redraw () = - vp#drawable#clear (); - begin match diagram with - | Some (wf2, t, c) -> - let d = layout2 nodes2edge cross wf2 t in - vp#drawable#set_line_attributes - ~width:vp#drawable#decoration_context#line_width (); - vp#drawable#set_foreground `BLACK; - Tree.iter_edges - (fun flavor xy0 xy1 -> vp#propagator (line_style flavor) xy0 xy1) d; - vp#drawable#set_foreground `BLACK; - Tree.iter_internal (vp#arc ~filled:true (6, 6)) d; - Tree.iter_incoming (fun (ext, x, y) -> - vp#string ~align:(Left 5, VCenter) - (node_to_string ext) (x, y)) d; - Tree.iter_outgoing (fun (ext, x, y) -> - vp#string ~align:(Right 5, VCenter) - (node_to_string (conjugate ext)) (x, y)) d - | None -> () - end - - method private popup evt = - begin match diagram with - | Some (wf2, t, c) -> - begin match GdkEvent.Button.button evt with - | 2 -> - ThoGWindow.message ~title:"O'Giga Color Diagram" ~justify:`LEFT - ~text:(label ^ ":\n\n" ^ - Color.to_string (fun () -> "") node_to_string c) () - | 3 -> - ThoGWindow.message ~title:"O'Giga Diagram" ~justify:`LEFT - ~text:(label ^ ":\n\n" ^ to_string node_to_string t) () - | _ -> () - end - | None -> () - end - - method clear_diagram () = - diagram <- None; - self#redraw () - - method set_diagram d = - diagram <- (Some d); - self#redraw () - - initializer - area#event#connect#expose ~callback:(fun evt -> self#redraw (); true); - self#event#connect#button_press ~callback:(fun evt -> self#popup evt; true); - self#redraw () - - end - -(* \thocwmodulesection{Preferences} *) - -class ['a] demo_diagram_display ~line_style ?label ?width ?height ?packing dc = - let frame = GBin.frame ?label ?packing () in - let area = GMisc.drawing_area ?width ?height ~packing:frame#add () in - let vp = new viewport ~margins:10 dc area#misc in - object (self) - - val xy0 = (0.0, 0.5) - val xy1 = (1.0, 0.5) - - method redraw () = - vp#drawable#clear (); - vp#drawable#set_line_attributes ~width:dc#line_width (); - vp#drawable#set_foreground `BLACK; - vp#propagator line_style xy0 xy1; - vp#arc ~filled:true (6, 6) xy0; - vp#arc ~filled:true (6, 6) xy1 - - initializer - area#event#connect#expose ~callback:(fun evt -> self#redraw (); true); - self#redraw () - - end - -let int_adjustment value (lower, upper) = - GData.adjustment ~value:(float value) - ~lower:(float lower) ~upper:(float upper) ~step_incr:1.0 - ~page_incr:10.0 ~page_size:5.0 () - -let notebook_page text (notebook : GPack.notebook) = - GPack.table ~rows:4 ~columns:4 ~row_spacings:8 ~col_spacings:8 - ~packing:(notebook#append_page ~tab_label:(GMisc.label ~text ())#coerce) () - -let int_edit ?width ?changed text value range (table : GPack.table) row = - GMisc.label ?width ~justify:`RIGHT ~text:(text ^ ":") - ~packing:(table#attach ~left:1 ~top:row ~expand:`X) (); - let spin_button = - GEdit.spin_button - ~adjustment:(int_adjustment value range) ~numeric:true ~digits:0 - ~packing:(table#attach ~left:2 ~top:row ~expand:`NONE) () in - begin match changed with - | None -> () - | Some f -> - ignore (spin_button#connect#changed - ~callback:(fun () -> f spin_button#value_as_int)) - end; - spin_button - -let edit_preferences dc = - - let window = - GWindow.window ~title:"O'Giga Preferences" ~border_width:5 () in - let hbox = GPack.hbox ~spacing:8 ~packing:window#add () in - let input = GPack.vbox ~spacing:8 ~packing:hbox#add () in - let monitor = GPack.vbox ~spacing:8 ~packing:hbox#add () in - - let width = 150 - and height = 30 in - let fermion = - new demo_diagram_display ~line_style:(Arrow Forward) - ~label:"Dirac fermions" ~width ~height ~packing:monitor#add dc in - let antifermion = - new demo_diagram_display ~line_style:(Arrow Backward) - ~label:"Dirac antifermions" ~width ~height ~packing:monitor#add dc in - let photon = - new demo_diagram_display ~line_style:Wiggles - ~label:"Color singlet gauge bosons" ~width ~height ~packing:monitor#add dc in - let gluon = - new demo_diagram_display ~line_style:Curls - ~label:"Gluons" ~width ~height ~packing:monitor#add dc in - let heavy = - new demo_diagram_display ~line_style:Double - ~label:"Heavy gauge bosons" ~width ~height ~packing:monitor#add dc in - let redraw () = - fermion#redraw (); - antifermion#redraw (); - photon#redraw (); - gluon#redraw (); - heavy#redraw () in - - let notebook = GPack.notebook ~scrollable:true ~homogeneous_tabs:true - ~packing:(input#pack ~expand:true) () in - - let general = notebook_page "General" notebook in - let line_width = - int_edit ~changed:(fun n -> dc#set_line_width n; redraw ()) - "line width" dc#line_width (1, 10) general 1 in - GMisc.label ~justify:`RIGHT ~text:("font:") - ~packing:(general#attach ~left:1 ~top:2 ~expand:`X) (); - let font_selection_button = - GButton.button ~label:"Change" - ~packing:(general#attach ~left:2 ~top:2 ~expand:`NONE) () in - font_selection_button#connect#clicked - ~callback:(fun evt -> - let fsd = GWindow.font_selection_dialog ~title:"O'Giga Font Selection" () in - fsd#selection#set_font_name dc#font_name; - fsd#cancel_button#connect#clicked ~callback:fsd#destroy; - fsd#ok_button#connect#clicked - ~callback:(fun evt -> - begin match fsd#selection#font_name with - | Some name -> dc#set_font name - | None -> () - end; - fsd#destroy evt); - fsd#show ()); - - let arrows = notebook_page "Arrows" notebook in - let ah_tip = - int_edit ~changed:(fun n -> dc#set_arrowhead_tip n; redraw ()) - "arrowhead tip" dc#arrowhead_tip (1, 50) arrows 1 in - let ah_base = - int_edit ~changed:(fun n -> dc#set_arrowhead_base n; redraw ()) - "arrowhead base" dc#arrowhead_base (1, 40) arrows 2 in - let ah_width = - int_edit ~changed:(fun n -> dc#set_arrowhead_width n; redraw ()) - "arrowhead width" dc#arrowhead_width (1, 30) arrows 3 in - - let wiggles = notebook_page "Wiggles" notebook in - let w_amp = - int_edit ~changed:(fun n -> dc#set_wiggle_amp n; redraw ()) - "wiggle amplitude" dc#wiggle_amp (0, 20) wiggles 1 in - let w_len = - int_edit ~changed:(fun n -> dc#set_wiggle_len n; redraw ()) - "wiggle length" dc#wiggle_len (1, 50) wiggles 2 in - let w_res = - int_edit ~changed:(fun n -> dc#set_wiggle_res n; redraw ()) - "wiggle resolution" dc#wiggle_res (1, 50) wiggles 3 in - - let curls = notebook_page "Curls" notebook in - let c_amp = - int_edit ~changed:(fun n -> dc#set_curl_amp n; redraw ()) - "curl amplitude" dc#curl_amp (0, 20) curls 1 in - let c_len = - int_edit ~changed:(fun n -> dc#set_curl_len n; redraw ()) - "curl length" dc#curl_len (1, 50) curls 2 in - let c_res = - int_edit ~changed:(fun n -> dc#set_curl_res n; redraw ()) - "curl resolution" dc#curl_res (1, 50) curls 3 in - - let buttons = - GPack.hbox ~spacing:8 ~packing:(input#pack ~expand:false) () in - let ok_button = - GButton.button ~label:"OK" ~packing:buttons#add () in - let accept_button = - GButton.button ~label:"Accept" ~packing:buttons#add () in - let cancel_button = - GButton.button ~label:"Cancel" ~packing:buttons#add () in - cancel_button#connect#clicked ~callback:window#destroy; - accept_button#connect#clicked - ~callback:(fun evt -> ()); - ok_button#connect#clicked - ~callback:(fun evt -> - dc#save (); - window#destroy evt); - - window#show () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: trunk/omega/src/ogiga.ml =================================================================== --- trunk/omega/src/ogiga.ml (revision 8859) +++ trunk/omega/src/ogiga.ml (revision 8860) @@ -1,345 +0,0 @@ -(* ogiga.ml -- - - Copyright (C) 1999-2023 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - with contributions from - Christian Speckner - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* NB: this module \emph{must} be compiled with \verb+-labels+, - since \verb+labltk+ doesn't appear to work in classic mode. *) - -(* \begin{dubious} - Keep in mind that \texttt{ocamlweb} doesn't work properly with - O'Caml~3 yet. The colons in label declarations are typeset with - erroneous white space. - \end{dubious} *) - -(* \thocwmodulesection{Windows} *) - -let window = - GWindow.window ~width:550 ~height:500 ~title: - "O'Giga: O'Mega Graphical Interface for Generation and Analysis" () -let vbox = GPack.vbox ~packing:window#add () - -let menubar = GMenu.menu_bar ~packing:(vbox#pack ~expand:false) () -let factory = new ThoGMenu.factory menubar -let accel_group = factory#accel_group -let file_menu = factory#add_submenu "File" -let edit_menu = factory#add_submenu "Edit" -let exec_menu = factory#add_submenu "Exec" -let help_menu = factory#add_submenu_right "Help" -let hbox = GPack.hbox ~packing:(vbox#pack ~expand:false) () - -let about () = - ThoGWindow.message ~justify:`LEFT - ~text:(String.concat "\n" - ([ "This is the skeleton for a graphical interface"; - "for O'Mega."; ""; - "There is almost no functionality implemented yet."; - "I'm still trying to learn GTK+ and LablGTK."]) () - - -(* \thocwmodulesection{Main Program} *) - -module O = Omega.Make -module F = Fusion -module T = Targets -module M = Models - -module SM = M.SM(M.SM) -module SM_ac = M.SM(M.SM_anomalous) - -module O1a = O(F.Mixed23)(T.Fortran)(SM) -module O1b = O(F.Mixed23_Majorana)(T.Fortran_Majorana)(SM) - -module O2a = O(F.Binary)(T.Fortran)(SM_ac) -module O2b = O(F.Binary_Majorana)(T.Fortran_Majorana)(SM_ac) - -module O3a = O(F.Binary)(T.Fortran)(M.QED) -module O3b = O(F.Binary_Majorana)(T.Fortran_Majorana)(M.QED) -module O3c = O(F.Binary)(T.Helas)(M.QED) - -module O4a = O(F.Binary)(T.Fortran)(M.YM) -module O4b = O(F.Binary_Majorana)(T.Fortran_Majorana)(M.YM) -module O4c = O(F.Binary)(T.Helas)(M.YM) - -module O5a = O(F.Binary)(T.Fortran)(M.SM_Rxi) -module O5b = O(F.Binary_Majorana)(T.Fortran_Majorana)(M.SM_Rxi) - -module O6a = O(F.Binary)(T.Fortran)(M.SM_clones) -module O6b = O(F.Binary_Majorana)(T.Fortran_Majorana)(M.SM_clones) - -(*i -module O6 = O(F.Binary_Majorana)(T.Fortran_Majorana)(M.MSSM(M.MSSM_no_goldstone)) -i*) - -let flavors = SM.external_flavors -let flavor_to_string = SM.flavor_to_string -let flavors_tree = ThoGMenu.tree_of_nested_lists flavor_to_string (flavors ()) - -let particle_menu button = - ThoGMenu.submenu_tree button#set_state flavors_tree - -let process incoming outgoing = - let in1 = incoming.(0) - and in2 = incoming.(1) - and incoming = Array.to_list incoming - and outgoing = Array.to_list outgoing in - let s = - String.concat " " (List.map SM.flavor_to_string incoming) ^ " -> " ^ - String.concat " " (List.map SM.flavor_to_string outgoing) in - O1a.diagrams in1 in2 outgoing - -let font = - Gdk.Font.load "-*-helvetica-medium-r-normal--*-120-*-*-*-*-iso8859-1" - -let conjugate (f, p) = (SM.conjugate f, p) -let cross (f, p) = (SM.conjugate f, Momentum.Default.neg p) - -let node_to_string (f, p) = - Printf.sprintf "%s[%s]" - (SM.flavor_to_string f) - (String.concat "" (List.map string_of_int (Momentum.Default.to_ints p))) - -let create_linear_rectangle n1 n2 f = - Array.init (n1 * n2) (fun n -> f n (n mod n1) (n / n1)) - -let rows = 4 -let columns = 3 - -class ['a] menu_button_custom widgets accept format state menu = - object (self) - inherit ['a] ThoGMenu.menu_button widgets format state menu as super - method set_menu menu = - self#connect#clicked ~callback:(fun () -> - let m = ThoGMenu.submenu_tree (fun s -> self#set_state s; accept s) - menu in - m#popup ~button:3 ~time:0); - () - end - -let menu_button_custom accept format state menu - ?border_width ?width ?height ?packing ?show () = - new menu_button_custom (ThoGButton.mutable_button_raw - ?border_width ?width ?height ?packing ?show ()) - accept format state menu - -let line_style flavor = - match SM.propagator flavor with - | Coupling.Prop_Scalar | Coupling.Aux_Scalar -> - ThoGDraw.Plain - | Coupling.Prop_Spinor | Coupling.Aux_Spinor -> - ThoGDraw.Arrow ThoGDraw.Forward - | Coupling.Prop_ConjSpinor | Coupling.Aux_ConjSpinor -> - ThoGDraw.Arrow ThoGDraw.Backward - | Coupling.Prop_Majorana | Coupling.Aux_Majorana -> - ThoGDraw.Name "majorana" - | Coupling.Prop_Feynman | Coupling.Prop_Gauge _ -> - begin match SM.color flavor with - | Color.Singlet -> ThoGDraw.Wiggles - | Color.AdjSUN _ -> ThoGDraw.Curls - | Color.SUN _ -> ThoGDraw.Name ("???: " ^ SM.flavor_to_string flavor) - end - | Coupling.Prop_Unitarity | Coupling.Prop_Rxi _ - | Coupling.Aux_Vector | Coupling.Aux_Tensor_1 -> - ThoGDraw.Double - | Coupling.Only_Insertion -> - ThoGDraw.Name (SM.flavor_to_string flavor ^ " insertion") - -let main () = - window#connect#destroy ~callback:GMain.Main.quit; - let factory = new GMenu.factory file_menu ~accel_group in - factory#add_item "Open..." ~key:GdkKeysyms._O - ~callback:(fun () -> prerr_endline "open ..."); - factory#add_item "Save" ~key:GdkKeysyms._S - ~callback:(fun () -> prerr_endline "save"); - factory#add_item "Save as..." - ~callback:(fun () -> prerr_endline "save as"); - factory#add_separator (); - factory#add_item "Quit" ~key:GdkKeysyms._Q ~callback:window#destroy; - let factory = new GMenu.factory edit_menu ~accel_group in - let dc' = new ThoGDraw.decoration_context in - factory#add_item "Preferences" ~key:GdkKeysyms._E - ~callback:(fun () -> ThoGDraw.edit_preferences dc'); - let factory = new GMenu.factory help_menu ~accel_group in - factory#add_item "About" ~key:GdkKeysyms._A ~callback:about; - let tooltips = GData.tooltips () in - let default_flavor = List.hd (snd (List.hd (flavors ()))) in - let hbox = GPack.hbox ~packing:(vbox#pack ~expand:false) () in - let tip2 = - " (left mouse button, SPACE or RET will pop up a menu;" ^ - " right button will select)" in - let incoming = - new ThoGMenu.tensor_menu flavor_to_string default_flavor flavors_tree 2 - ~tooltip_maker:(fun i -> - "incoming particle #" ^ string_of_int (succ i) ^ tip2) - ~label:"incoming" ~width:50 ~packing:hbox#pack () in - let smt = ThoGMenu.Leafs (List.map (fun n -> (string_of_int n, n)) - (ThoList.range 2 8)) in - let n_outgoing_frame = GBin.frame ~label:"#" ~packing:hbox#pack () in - let outgoing = - new ThoGMenu.tensor_menu flavor_to_string default_flavor flavors_tree 8 - ~tooltip_maker:(fun i -> - "outgoing particle #" ^ string_of_int (succ i) ^ tip2) - ~label:"outgoing" ~width:50 ~packing:hbox#pack () in - let n_outgoing = - menu_button_custom (fun n -> outgoing#set_active n) string_of_int 4 smt - ~width:30 ~packing:n_outgoing_frame#add () in - outgoing#set_active 4; - let dds = GPack.table ~rows ~columns ~homogeneous:true - ~packing:(vbox#pack ~expand:true) () in - let dc = new ThoGDraw.decoration_context in - let dd = create_linear_rectangle columns rows - (fun n n1 n2 -> new ThoGDraw.diagram_display - ~label:(string_of_int (succ n)) - ~node_to_string ~conjugate ~cross - ~nodes2edge:(fun n _ -> fst n) ~line_style - ~packing:(dds#attach ~left:n1 ~top:n2 ~expand:`BOTH) dc) in - let factory = new GMenu.factory exec_menu ~accel_group in - let diagrams = ref [| |] in - let num_diagrams = ref 0 in - let offset = ref 0 - and min_offset = ref 0 - and max_offset = ref 0 - and num_squares = rows * columns in - let clamp o = max !min_offset (min !max_offset o) in - let redraw () = - let last = pred (min !num_diagrams num_squares) in - for i = 0 to last do - dd.(i)#viewport#drawable#set_decoration_context dc'; - let i' = i + !offset in - dd.(i)#set_diagram !diagrams.(i'); - dd.(i)#set_label - (Printf.sprintf "diagram #%d (of %d)" (succ i') !num_diagrams) - done; - for i = succ last to pred num_squares do - dd.(i)#clear_diagram (); - dd.(i)#set_label "no diagram" - done in - factory#add_item "Execute" ~key:GdkKeysyms._X - ~callback:(fun () -> - diagrams := Array.of_list (process incoming#states outgoing#states); - num_diagrams := Array.length !diagrams; - min_offset := 0; - max_offset := !num_diagrams - num_squares; - offset := !min_offset; - redraw ()); - window#add_accel_group accel_group; - window#event#connect#key_press ~callback:(fun evt -> - let old_offset = !offset in - let k = GdkEvent.Key.keyval evt in - if k = GdkKeysyms._b then - offset := clamp (pred !offset) - else if k = GdkKeysyms._f then - offset := clamp (succ !offset) - else if k = GdkKeysyms._p then - offset := clamp (!offset - columns) - else if k = GdkKeysyms._n then - offset := clamp (!offset + columns); - if old_offset <> !offset then - redraw (); - -(*i - Printf.eprintf "key = %s: %d (%d, %d) => %d\n" - (GdkEvent.Key.string evt) old_offset !min_offset !max_offset !offset; - flush stderr; -i*) - true); - window#show (); - GMain.Main.main () - -let _ = Printexc.print main () - -(*i - begin - let fancy = "omega_logo_fancy.xpm" - and plain = "omega_logo.xpm" in - if Sys.file_exists fancy then - let pixmap = GDraw.pixmap_from_xpm ~file:fancy ~window () in - ignore (GMisc.pixmap pixmap ~packing:vbox#pack ()) - else if Sys.file_exists plain then - let pixmap = GDraw.pixmap_from_xpm ~file:plain ~window () in - ignore (GMisc.pixmap pixmap ~packing:vbox#pack ()) - end; -i*) - -module type Integers = - Model.Mutable with type flavor = int - and type constant = int and type gauge = int - -module Model_Loader (Mutable : Integers) - (Static : Model.T with type constant = int and type gauge = int) = - struct - - let kludge_flavor = List.hd (Static.flavors ()) - let kludge_flavor_int = 0 - let kludge_constant = 0 - let kludge_gauge = 0 - - let kludge_vertices = - fun () -> ([], [], []) - let kludge_fuse = - ((fun _ _ -> []), (fun _ _ _ -> []), (fun _ -> [])) - let int_to_flavor f = kludge_flavor - let int_of_flavor f = kludge_flavor_int - let int_to_constant c = kludge_constant - let int_to_gauge g = kludge_gauge - - let lift_flavor fct f = fct (int_to_flavor f) - let lift_constant fct c = fct (int_to_constant c) - let lift_gauge fct g = fct (int_to_gauge g) - - let load () = - Mutable.setup - ~color:(lift_flavor Static.color) - ~pdg:(lift_flavor Static.pdg) - ~lorentz:(lift_flavor Static.lorentz) - ~propagator:(lift_flavor Static.propagator) - ~width:(lift_flavor Static.width) - ~goldstone:(fun f -> - match Static.goldstone (int_to_flavor f) with - | None -> None - | Some (f', phase') -> Some (int_of_flavor f', phase')) - ~conjugate:(fun f -> - int_of_flavor (Static.conjugate (int_to_flavor f))) - ~fermion:(lift_flavor Static.fermion) - ~max_degree:(Static.max_degree ()) - ~vertices:kludge_vertices - ~fuse:kludge_fuse - ~flavors:(List.map (fun (s, fl) -> - (s, List.map int_of_flavor fl)) (Static.external_flavors ())) - ~parameters:(Static.parameters) - ~flavor_of_string:(fun s -> - int_of_flavor (Static.flavor_of_string s)) - ~flavor_to_string:(lift_flavor Static.flavor_to_string) - ~flavor_symbol:(lift_flavor Static.flavor_symbol) - ~gauge_symbol:(lift_gauge Static.gauge_symbol) - ~mass_symbol:(lift_flavor Static.mass_symbol) - ~width_symbol:(lift_flavor Static.width_symbol) - ~constant_symbol:(lift_constant Static.constant_symbol) - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: trunk/omega/src/thoGDraw.mli =================================================================== --- trunk/omega/src/thoGDraw.mli (revision 8859) +++ trunk/omega/src/thoGDraw.mli (revision 8860) @@ -1,248 +0,0 @@ -(* thoGDraw.mli -- - - Copyright (C) 1999-2023 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - with contributions from - Christian Speckner - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Tracking Display Sizes} *) - -(* Tracking [size_allocate] signals is required for drawing methods that need to - know the size of the drawable in question. *) -class type resizeable = - object - method size_allocate : callback:(Gtk.rectangle -> unit) -> GtkSignal.id - end - -class size : #resizeable -> - object - method width : int - method height : int - end - -(* The need for the type parameter ['b] in the following is ever so - slightly nonintuitive. If it were absent - (i.\,e.~[method connect : #resizeable]), the free [..] in - [#resizeable] would be unbound. *) -class type ['a, 'b] window = - object - method window : 'a Gdk.drawable - method realize : unit -> unit - method connect : 'b - constraint 'b = #resizeable - end - -(* \thocwmodulesection{Coordinate Systems} *) - -(* \begin{figure} - \begin{center} - \begin{picture}(120,60) - \put( 0, 0){\framebox(120,60){}} - \put( 20,20){\framebox(80,20){}} - \put( 20,20){\thocwmakebox{0}{0}{bl}{[(x_min,y_min)]}} - \put(100,20){\thocwmakebox{0}{0}{br}{[(x_max,y_min)]}} - \put(100,40){\thocwmakebox{0}{0}{tr}{[(x_max,y_max)]}} - \put( 20,40){\thocwmakebox{0}{0}{tl}{[(x_min,y_max)]}} - \put( 60,40){\thocwmakebox{0}{0}{b}{[x_delta_pxl]}} - \put( 20,40){\thocwmakebox{0}{0}{bl}{[x_min_pxl]}} - \put(100,40){\thocwmakebox{0}{0}{br}{[x_max_pxl]}} - \put(100,30){\thocwmakebox{0}{0}{l}{[y_delta_pxl]}} - \put(100,40){\thocwmakebox{0}{0}{tl}{[y_min_pxl]}} - \put(100,20){\thocwmakebox{0}{0}{bl}{[y_max_pxl]}} - \put( 20,10){\thocwmakebox{0}{0}{r}{[left_margin]}} - \put(100,10){\thocwmakebox{0}{0}{l}{[right_margin]}} - \put( 60,10){\thocwmakebox{0}{0}{c}{[bottom_margin]}} - \put( 60,50){\thocwmakebox{0}{0}{c}{[top_margin]}} - \end{picture} - \end{center} - \caption{\label{fig:coord}% - Coordinate systems.} - \end{figure} - The tracking of [size_allocate] signals is even more important for mapping - world (abstract) coordinates to device (pixel) coordinates. See - figure~\ref{fig:coord} for the semantics of the device (pixel) and - logical (floating point) coordinates. Note that the logical - coordinates follow mathematical conventions instead of the computer - graphics conventions. *) - -class coordinates : ?margins:int -> - ?xrange:(float * float) -> ?yrange:(float * float) -> #resizeable -> - object - method left_margin : int -> unit - method right_margin : int -> unit - method bottom_margin : int -> unit - method top_margin : int -> unit - method margins : int -> unit - method xrange : float -> float -> unit - method yrange : float -> float -> unit - end - -(* There are more private methods, that are in fact more interesting. In - particular [project_x], [project_x], and [project] that map from logical - to device coordinates. *) - -(* \thocwmodulesection{Viewports} *) - -(* Useful string drawing requires flexible facilities for specifying the - alignment. Here, we can either center the string or specify distances - from a reference point in pixels. *) -type horiz = HCenter | Left of int | Right of int -type vert = VCenter | Below of int | Above of int - -class decoration_context : - object - method font : Gdk.font - method font_name : string - method line_width : int - method arrowhead_tip : int - method arrowhead_base : int - method arrowhead_width : int - method wiggle_amp : int - method wiggle_len : int - method wiggle_res : int - method curl_amp : int - method curl_len : int - method curl_res : int - method set_font : string -> unit - method set_line_width : int -> unit - method set_arrowhead_tip : int -> unit - method set_arrowhead_base : int -> unit - method set_arrowhead_width : int -> unit - method set_wiggle_amp : int -> unit - method set_wiggle_len : int -> unit - method set_wiggle_res : int -> unit - method set_curl_amp : int -> unit - method set_curl_len : int -> unit - method set_curl_res : int -> unit - method to_channel : out_channel -> unit - method of_stream : char Stream.t -> unit - method save : unit -> unit - method restore : unit -> unit - end - -class ['a] decorations : ?colormap:Gdk.colormap -> - decoration_context -> 'a Gdk.drawable -> - object - inherit ['a] GDraw.drawable - method decoration_context : decoration_context - method set_decoration_context : decoration_context -> unit - method aligned_string : ?font:Gdk.font -> ?align:(horiz * vert) -> - string -> int * int -> unit - method arrowhead : int * int -> int * int -> unit - method double : int * int -> int * int -> unit - method wiggles : int * int -> int * int -> unit - method curls : int * int -> int * int -> unit - end - -(* When we keep track of the size, we can easily provide an extension - of [GDraw.drawable] that knows how to clear itself to a given background - color. *) - -class ['a] drawable : ?colormap:Gdk.colormap -> - decoration_context -> ('a, 'b) #window -> - object - inherit ['a] decorations - method clear : ?color:GDraw.color -> unit -> unit - end - -(* \begin{dubious} - Conceptually, [['a] decorations] and [['a] decorations] should be - orthogonal and be implemented by aggregation. Unfortunately, - using [GDraw.drawable] with aggregation is complicated by - the fact that each object has its own graphics context [Gdk.GC]. - \end{dubious} *) - -(* The ['a viewport] (where ['a] will mostly be [[`window]], but can - also be [[`pixmap]] or [[`bitmap]]) is an abstraction of ['a drawable], - with both coordinates running in $0\ldots1$ instead of physical - pixel numbers. *) - -type direction = - | Forward - | Backward - -type line_style = - | Plain - | Double - | Wiggles - | Curls - | Dashes - | Dots - | Arrow of direction - | Name of string - -class ['a] viewport : ?colormap:Gdk.colormap -> ?margins:int -> - ?xrange:(float * float) -> ?yrange:(float * float) -> - decoration_context -> ('a, 'b) #window -> - object - inherit coordinates - method drawable : 'a drawable - method point : float * float -> unit - method points : (float * float) list -> unit - method arc : ?filled:bool -> ?start:float -> ?angle:float -> - int * int -> float * float -> unit - method line : float * float -> float * float -> unit - method lines : (float * float) list -> unit - method segments : ((float * float) * (float * float)) list -> unit - method polygon : ?filled:bool -> (float * float) list -> unit - method string : ?font:Gdk.font -> ?align:(horiz * vert) -> - string -> float * float -> unit - method propagator : line_style -> float * float -> float * float -> unit - end - -(* \thocwmodulesection{Diagram Displays} *) - -class ['a, 'edge, 'node] diagram_display : - node_to_string:('node -> string) -> - conjugate:('node -> 'node) -> cross:('node -> 'node) -> - nodes2edge:('node -> 'node -> 'edge) -> - line_style:('edge -> line_style) -> - ?label:string -> ?width:int -> ?height:int -> - ?packing:(GObj.widget -> unit) -> decoration_context -> - object - method viewport : 'a viewport - method event : GObj.event_ops - method set_label : string -> unit - method set_diagram : - 'node * ('node, 'node) Tree.t * - (unit, 'node) Color.amplitude -> unit - method clear_diagram : unit -> unit - method redraw : unit -> unit - end - -(* \thocwmodulesection{Preferences} *) - -class ['a] demo_diagram_display : - line_style:line_style -> ?label:string -> - ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> - decoration_context -> - object - method redraw : unit -> unit - end - -val edit_preferences : decoration_context -> unit - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: trunk/omega/src/thoGButton.ml =================================================================== --- trunk/omega/src/thoGButton.ml (revision 8859) +++ trunk/omega/src/thoGButton.ml (revision 8860) @@ -1,83 +0,0 @@ -(* thoGButton.ml -- - - Copyright (C) 1999-2023 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - with contributions from - Christian Speckner - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \begin{dubious} - Multiple inheritance from [GButton.button] and [GMisc.label] won't - typecheck because [GButton.button_signals] and [GObj.widget_signals] - don't match. - \end{dubious} - \begin{dubious} - Instead of [GtkBase.Object.try_cast], we could use - [GtkBase.Object.unsafe_cast] - \end{dubious} *) - -class mutable_button (button, label) = - object (self) - inherit GButton.button button - val label : GMisc.label = label - method set_text = label#set_text - end - -(* It remains to provide the semantics. Ask \texttt{GTK+} to create a - pair consisting of a button and \emph{included} label. *) - -let mutable_button_raw ?text ?border_width ?width ?height ?packing ?show () = - let button = GButton.button ?border_width ?width ?height ?packing ?show () in - let hbox = GPack.hbox ~packing:button#add () in - let label = GMisc.label ?text ~packing:(hbox#pack ~expand:true) () in - (GtkBase.Object.unsafe_cast button#as_widget, label) - -(* Finally, wrap it in the object. *) - -let mutable_button ?text ?border_width ?width ?height ?packing ?show () = - new mutable_button - (mutable_button_raw - ?text ?border_width ?width ?height ?packing ?show ()) - -(* If we need more state then just a changing label, we can do this - polymorphically by inheritance. *) - -class ['a] stateful_button widgets format state = - object (self) - inherit mutable_button widgets - val mutable state : 'a = state - method private update_text = self#set_text (format state) - method state = state - method set_state s = (state <- s; self#update_text) - initializer self#update_text - end - -let stateful_button format state - ?text ?border_width ?width ?height ?packing ?show () = - new stateful_button (mutable_button_raw - ?text ?border_width ?width ?height ?packing ?show ()) - format state - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: trunk/omega/src/omega.tex =================================================================== --- trunk/omega/src/omega.tex (revision 8859) +++ trunk/omega/src/omega.tex (revision 8860) @@ -1,1201 +1,1188 @@ % omega.tex -- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \NeedsTeXFormat{LaTeX2e} \RequirePackage{ifpdf} \ifpdf \documentclass[a4paper,notitlepage,chapters]{flex} \usepackage{type1cm} \usepackage[pdftex,colorlinks]{hyperref} \usepackage[pdftex]{graphicx,feynmp,emp} \DeclareGraphicsRule{*}{mps}{*}{} \else \documentclass[a4paper,notitlepage,chapters]{flex} \usepackage[T1]{fontenc} % \usepackage[hypertex]{hyperref} \usepackage{graphicx,feynmp,emp} \fi \usepackage{verbatim,array,amsmath,amssymb} \usepackage{url,thophys,thohacks} \usepackage{pgf} \usepackage{ytableau} \setlength{\unitlength}{1mm} \empaddtoTeX{\usepackage{amsmath,amssymb}} \empaddtoTeX{\usepackage{thophys,thohacks}} \empaddtoprelude{input graph;} \empaddtoprelude{input boxes;} \IfFileExists{geometry.sty}% {\usepackage{geometry}% \geometry{a4paper,margin=2cm}}% {\relax} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% This should be part of flex.cls and/or thopp.sty \makeatletter \@ifundefined{frontmatter}% {\def\frontmatter{\pagenumbering{roman}}% \def\mainmatter{\cleardoublepage\pagenumbering{arabic}}} {} \makeatother %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% \makeatletter %%% %%% Italic figure captions to separate them visually from the text %%% %%% (this should be supported by flex.cls): %%% \makeatletter %%% \@secpenalty=-1000 %%% \def\fps@figure{t} %%% \def\fps@table{b} %%% \long\def\@makecaption#1#2{% %%% \vskip\abovecaptionskip %%% \sbox\@tempboxa{#1: \textit{#2}}% %%% \ifdim\wd\@tempboxa>\hsize %%% #1: \textit{#2}\par %%% \else %%% \global\@minipagefalse %%% \hb@xt@\hsize{\hfil\box\@tempboxa\hfil}% %%% \fi %%% \vskip\belowcaptionskip} %%% \makeatother \widowpenalty=4000 \clubpenalty=4000 \displaywidowpenalty=4000 %%% \pagestyle{headings} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \allowdisplaybreaks \renewcommand{\topfraction}{0.8} \renewcommand{\bottomfraction}{0.8} \renewcommand{\textfraction}{0.2} \setlength{\abovecaptionskip}{.5\baselineskip} \setlength{\belowcaptionskip}{\baselineskip} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% allow VERY overfull hboxes \setlength{\hfuzz}{5cm} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \usepackage{noweb} %%% \usepackage{nocondmac} \setlength{\nwmarginglue}{1em} \noweboptions{smallcode,noidentxref}%%%{webnumbering} %%% Saving paper: \def\nwendcode{\endtrivlist\endgroup} \nwcodepenalty=0 \let\nwdocspar\relax %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\ttfilename}[1]{\texttt{\detokenize{#1}}} \usepackage[noweb,bypages]{ocamlweb} \empaddtoTeX{\usepackage[noweb,bypages]{ocamlweb}} \renewcommand{\ocwinterface}[1]{\section{Interface of \ocwupperid{#1}}} \renewcommand{\ocwmodule}[1]{\section{Implementation of \ocwupperid{#1}}} \renewcommand{\ocwinterfacepart}{\relax} \renewcommand{\ocwcodepart}{\relax} \renewcommand{\ocwbeginindex}{\begin{theindex}} \newcommand{\thocwmodulesection}[1]{\subsection{#1}} \newcommand{\thocwmodulesubsection}[1]{\subsubsection{#1}} \newcommand{\thocwmoduleparagraph}[1]{\paragraph{#1}} \renewcommand{\ocwindent}[1]{\noindent\ignorespaces} \renewcommand{\ocwbegincode}{\renewcommand{\ocwindent}[1]{\noindent\kern##1}} \renewcommand{\ocwendcode}{\renewcommand{\ocwindent}[1]{\noindent\ignorespaces}} \renewcommand{\ocweol}{\setlength\parskip{0pt}\par} \makeatletter \renewcommand{\@oddfoot}{\reset@font\hfil\thepage\hfil} \let\@evenfoot\@oddfoot \def\@evenhead{\leftmark{} \hrulefill}% \def\@oddhead{\hrulefill{} \rightmark}% \let\@mkboth\markboth \renewcommand{\chaptermark}[1]{\markboth{\hfil}{\hfil}}% \renewcommand{\sectionmark}[1]{\markboth{#1}{#1}} \renewcommand{\chapter}{% \clearpage\global\@topnum\z@\@afterindentfalse \secdef\@chapter\@schapter} \makeatother \newcommand{\signature}[1]{% \InputIfFileExists{#1.interface}{}% {\begin{dubious}\textit{Interface \ttfilename{#1.mli} unavailable!}\end{dubious}}} \newcommand{\application}[1]{% \InputIfFileExists{#1.implementation}{}% {\begin{dubious}\textit{Application \ttfilename{#1.ml} unavailable!}\end{dubious}}} \newcommand{\module}[1]{% \label{mod:#1}% \InputIfFileExists{#1.interface}{}% {\begin{dubious}\textit{Interface \ttfilename{#1.mli} unavailable!}\end{dubious}}% \InputIfFileExists{#1.implementation}{}% {\begin{dubious}\textit{Implementation \ttfilename{#1.ml} unavailable!}\end{dubious}}} \newcommand{\lexer}[1]{\application{#1_lexer}} \renewcommand{\ocwlexmodule}[1]{\relax} \newcommand{\parser}[1]{\application{#1_parser}} \renewcommand{\ocwyaccmodule}[1]{\relax} \newcommand{\thocwincludegraphics}[2]{\includegraphics[#1]{#2}} \ifpdf \newcommand{\thocwdefref}[1]{\textbf{\pageref{#1}}}% \newcommand{\thocwuseref}[1]{\textrm{\pageref{#1}}}% \renewcommand{\ocwrefindexentry}[5]% {\item #1,\quad\let\ref\thocwdefref{#4}, used: \let\ref\thocwuseref{#5}} \fi \newcommand{\thocwmakebox}[4]{\makebox(#1,#2)[#3]{#4}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newenvironment{modules}[1]% {\begin{list}{}% {\setlength{\leftmargin}{3em}% \setlength{\rightmargin}{2em}% \setlength{\itemindent}{-1em}% \setlength{\listparindent}{0pt}% %%%\setlength{\itemsep}{0pt}% \settowidth{\labelwidth}{\textbf{\ocwupperid{#1}:}}% \renewcommand{\makelabel}[1]{\ocwupperid{##1:}}}}% {\end{list}} \newenvironment{JR}% {\begin{dubious}\textit{JR sez' (regarding the Majorana Feynman rules):}} {\textit{(JR's probably right, but I need to check myself \ldots)} \end{dubious}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \DeclareMathOperator{\tr}{tr} \newcommand{\dd}{\mathrm{d}} \newcommand{\ii}{\mathrm{i}} \newcommand{\ee}{\mathrm{e}} \renewcommand{\Re}{\text{Re}} \renewcommand{\Im}{\text{Im}} \newcommand{\ketbra}[2]{\ket{#1}\!\bra{#2}} \newcommand{\Ketbra}[2]{\Ket{#1}\!\Bra{#2}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \makeindex \begin{document} \begin{fmffile}{\jobname pics} \fmfset{arrow_ang}{10} \fmfset{curly_len}{2mm} \fmfset{wiggly_len}{3mm} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \fmfcmd{% numeric joindiameter; joindiameter := 7thick;} \fmfcmd{% vardef sideways_at (expr d, p, frac) = save len; len = length p; (point frac*len of p) shifted ((d,0) rotated (90 + angle direction frac*len of p)) enddef; secondarydef p sideways d = for frac = 0 step 0.01 until 0.99: sideways_at (d, p, frac) .. endfor sideways_at (d, p, 1) enddef; secondarydef p choptail d = subpath (ypart (fullcircle scaled d shifted (point 0 of p) intersectiontimes p), infinity) of p enddef; secondarydef p choptip d = reverse ((reverse p) choptail d) enddef; secondarydef p pointtail d = fullcircle scaled d shifted (point 0 of p) intersectionpoint p enddef; secondarydef p pointtip d = (reverse p) pointtail d enddef; secondarydef pa join pb = pa choptip joindiameter .. pb choptail joindiameter enddef; vardef cyclejoin (expr p) = subpath (0.5*length p, infinity) of p join subpath (0, 0.5*length p) of p .. cycle enddef;} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \fmfcmd{% style_def double_line_arrow expr p = save pi, po; path pi, po; pi = reverse (p sideways thick); po = p sideways -thick; cdraw pi; cdraw po; cfill (arrow pi); cfill (arrow po); enddef;} \fmfcmd{% style_def double_line_arrow_beg expr p = save pi, po, pc; path pi, po, pc; pc = p choptail 7thick; pi = reverse (pc sideways thick); po = pc sideways -thick; cdraw pi .. p pointtail 5thick .. po; cfill (arrow pi); cfill (arrow po); enddef;} \fmfcmd{% style_def double_line_arrow_end expr p = save pi, po, pc; path pi, po, pc; pc = p choptip 7thick; pi = reverse (pc sideways thick); po = pc sideways -thick; cdraw po .. p pointtip 5thick .. pi; cfill (arrow pi); cfill (arrow po); enddef;} \fmfcmd{% style_def double_line_arrow_both expr p = save pi, po, pc; path pi, po, pc; pc = p choptip 7thick choptail 7thick; pi = reverse (pc sideways thick); po = pc sideways -thick; cdraw po .. p pointtip 5thick .. pi .. p pointtail 5thick .. cycle; cfill (arrow pi); cfill (arrow po); enddef;} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \fmfcmd{vardef middir (expr p, ang) = dir (angle direction length(p)/2 of p + ang) enddef;} \fmfcmd{style_def arrow_left expr p = shrink (.7); cfill (arrow p shifted (4thick * middir (p, 90))); endshrink enddef;} \fmfcmd{style_def arrow_right expr p = shrink (.7); cfill (arrow p shifted (4thick * middir (p, -90))); endshrink enddef;} \fmfcmd{style_def warrow_left expr p = shrink (.7); cfill (arrow p shifted (8thick * middir (p, 90))); endshrink enddef;} \fmfcmd{style_def warrow_right expr p = shrink (.7); cfill (arrow p shifted (8thick * middir (p, -90))); endshrink enddef;} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\threeexternal}[3]{% \fmfsurround{d1,e1,d2,e2,d3,e3}% \fmfv{label=$#1$,label.ang=0}{e1}% \fmfv{label=$#2$,label.ang=180}{e2}% \fmfv{label=$#3$,label.ang=0}{e3}} \newcommand{\Threeexternal}[3]{% \fmfsurround{d1,e1,d3,e3,d2,e2}% \fmfv{label=$#1$,label.ang=0}{e1}% \fmfv{label=$#2$,label.ang=0}{e2}% \fmfv{label=$#3$,label.ang=180}{e3}} \newcommand{\Fourexternal}[4]{% \fmfsurround{d2,e2,d1,e1,d4,e4,d3,e3}% \fmfv{label=$#1$,label.ang=180}{e1}% \fmfv{label=$#2$,label.ang=0}{e2}% \fmfv{label=$#3$,label.ang=0}{e3}% \fmfv{label=$#4$,label.ang=180}{e4}} \newcommand{\Fiveexternal}[5]{% \fmfsurround{d2,e2,d1,e1,d5,e5,d4,e4,d3,e3}% \fmfv{label=$#1$,label.ang=180}{e1}% \fmfv{label=$#2$,label.ang=0}{e2}% \fmfv{label=$#3$,label.ang=0}{e3}% \fmfv{label=$#4$,label.ang=0}{e4}% \fmfv{label=$#5$,label.ang=180}{e5}} \newcommand{\twoincoming}{% \fmfdot{v}% \fmffreeze% \fmf{warrow_right}{e1,v}% \fmf{warrow_right}{e2,v}% \fmf{warrow_right}{v,e3}} \newcommand{\threeincoming}{% \fmfdot{v}% \fmffreeze% \fmf{warrow_right}{e1,v}% \fmf{warrow_right}{e2,v}% \fmf{warrow_right}{e3,v}} \newcommand{\threeoutgoing}{% \fmfdot{v}% \fmffreeze% \fmf{warrow_right}{v,e1}% \fmf{warrow_right}{v,e2}% \fmf{warrow_right}{v,e3}} \newcommand{\fouroutgoing}{% \threeoutgoing% \fmf{warrow_right}{v,e4}} \newcommand{\fiveoutgoing}{% \fouroutgoing% \fmf{warrow_right}{v,e5}} \newcommand{\setupthreegluons}{% \fmftop{g3} \fmfbottom{g1,g2} \fmf{phantom}{v,g1} \fmf{phantom}{v,g2} \fmf{phantom}{v,g3} \fmffreeze \fmfipair{v,g[],a[],b[]} \fmfiset{g1}{vloc (__g1)} \fmfiset{g2}{vloc (__g2)} \fmfiset{g3}{vloc (__g3)} \fmfiset{v}{vloc (__v)} \fmfiset{a1}{g1 shifted (-3thin,0)} \fmfiset{b1}{g1 shifted (+1thin,-2thin)} \fmfiset{a2}{g2 shifted (0,-3thin)} \fmfiset{b2}{g2 shifted (0,+3thin)} \fmfiset{a3}{g3 shifted (+1thin,+2thin)} \fmfiset{b3}{g3 shifted (-3thin,0)}} \begin{empfile} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \frontmatter \title{ O'Mega:\\ Optimal~Monte-Carlo\\ Event~Generation~Amplitudes} \author{% Thorsten Ohl\thanks{% \texttt{ohl@physik.uni-wuerzburg.de}, \texttt{http://physik.uni-wuerzburg.de/ohl}}\\ \hfil\\ Institut f\"ur Theoretische~Physik und Astrophysik\\ Julius-Maximilians-Universit\"at~W\"urzburg\\ Emil-Hilb-Weg 22, 97074~W\"urzburg, Germany\\ \hfil\\ J\"urgen Reuter\thanks{\texttt{juergen.reuter@desy.de}}\\ \hfil\\ DESY Theory Group, Notkestr. 85, 22603 Hamburg, Germany\\ \hfil\\ Wolfgang Kilian${}^{c,}$\thanks{\texttt{kilian@physik.uni-siegen.de}}\\ \hfil\\ Theoretische Physik 1\\ Universit\"at Siegen\\ Walter-Flex-Str.~3, 57068 Siegen, Germany\\ \hfil\\ with contributions from Christian Speckner${}^{d,}$\thanks{\texttt{cnspeckn@googlemail.com}}\\ as well as Christian Schwinn et al.} \date{\textbf{unpublished draft, printed \timestamp}} \maketitle \begin{abstract} \ldots \end{abstract} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newpage \begin{quote} Copyright \textcopyright~1999-2017 by \begin{itemize} \item Wolfgang~Kilian ~\texttt{} \item Thorsten~Ohl~\texttt{} \item J\"urgen~Reuter~\texttt{} \end{itemize} \end{quote} \begin{quote} WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. \end{quote} \begin{quote} WHIZARD is distributed in the hope that it will be useful, but \emph{without any warranty}; without even the implied warranty of \emph{merchantability} or \emph{fitness for a particular purpose}. See the GNU General Public License for more details. \end{quote} \begin{quote} You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. \end{quote} \setcounter{tocdepth}{2} \tableofcontents \mainmatter %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Introduction} \label{sec:intro} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Complexity} \label{sec:complexity} \begin{table} \begin{center} \begin{tabular}{r|r|r} $n$ & $P(n)$& $F(n)$ \\\hline 4 & 3 & 3 \\ 5 & 10 & 15 \\ 6 & 25 & 105 \\ 7 & 56 & 945 \\ 8 & 119 & 10395 \\ 9 & 246 & 135135 \\ 10 & 501 & 2027025 \\ 11 & 1012 & 34459425 \\ 12 & 2035 & 654729075 \\ 13 & 4082 & 13749310575 \\ 14 & 8177 & 316234143225 \\ 15 & 16368 & 7905853580625 \\ 16 & 32751 & 213458046676875 \end{tabular} \end{center} \caption{\label{tab:P(n),F(n)} The number of $\phi^3$ Feynman diagrams~$F(n)$ and independent poles~$P(n)$.} \end{table} There are \begin{equation} P(n) = \frac{2^n-2}{2} - n = 2^{n-1} - n - 1 \end{equation} independent internal momenta in a $n$-particle scattering amplitude~\cite{ALPHA:1997}. This grows much slower than the number \begin{equation} F(n) = (2n-5)!! = (2n-5)\cdot(2n-7)\cdot\ldots\cdot3\cdot1 \end{equation} of tree Feynman diagrams in vanilla $\phi^3$ (see table~\ref{tab:P(n),F(n)}). There are no known corresponding expressions for theories with more than one particle type. However, empirical evidence from numerical studies~\cite{ALPHA:1997,HELAC:2000} as well as explicit counting results from O'Mega suggest \begin{equation} P^*(n) \propto 10^{n/2} \end{equation} while he factorial growth of the number of Feynman diagrams remains unchecked, of course. The number of independent momenta in an amplitude is a better measure for the complexity of the amplitude than the number of Feynman diagrams, since there can be substantial cancellations among the latter. Therefore it should be possible to express the scattering amplitude more compactly than by a sum over Feynman diagrams. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Ancestors} \label{sec:ancestors} Some of the ideas that O'Mega is based on can be traced back to HELAS~\cite{HELAS}. HELAS builts Feynman amplitudes by recursively forming off-shell `wave functions' from joining external lines with other external lines or off-shell `wave functions'. The program Madgraph~\cite{MADGRAPH:1994} automatically generates Feynman diagrams and writes a Fortran program corresponding to their sum. The amplitudes are calculated by calls to HELAS~\cite{HELAS}. Madgraph uses one straightforward optimization: no statement is written more than once. Since each statement corresponds to a collection of trees, this optimization is very effective for up to four particles in the final state. However, since the amplitudes are given as a sum of Feynman diagrams, this optimization can, by design, \emph{not} remove the factorial growth and is substantially weaker than the algorithms of~\cite{ALPHA:1997,HELAC:2000} and the algorithm of O'Mega for more particles in the final state. Then ALPHA~\cite{ALPHA:1997} (see also the slightly modified variant~\cite{HELAC:2000}) provided a numerical algorithm for calculating scattering amplitudes and it could be shown empirically, that the calculational costs are rising with a power instead of factorially. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Architecture} \label{sec:architecture} \begin{figure} \begin{center} \includegraphics[width=\textwidth]{modules} %includegraphics[height=.8\textheight]{modules} \end{center} \caption{\label{fig:modules}% Module dependencies in O'Mega.} %% The diamond shaped nodes are abstract signatures defininng functor %% domains and co-domains. The rectangular boxes are modules and %% functors and oval boxes are examples for applications. \end{figure} \subsection{General purpose libraries} Functions that are not specific to O'Mega and could be part of the O'Caml standard library \begin{modules}{} \item[ThoList] (mostly) simple convenience functions for lists that are missing from the standard library module \ocwupperid{List} (section~\ref{sec:tholist}, p.~\pageref{sec:tholist}) \item[Product] effcient tensor products for lists and sets (section~\ref{sec:product}, p.~\pageref{sec:product}) \item[Combinatorics] combinatorical formulae, sets of subsets, etc. (section~\ref{sec:combinatorics}, p.~\pageref{sec:combinatorics}) \end{modules} \subsection{O'Mega} The non-trivial algorithms that constitute O'Mega: \begin{modules}{} \item[DAG] Directed Acyclical Graphs (section~\ref{sec:DAG}, p.~\pageref{sec:DAG}) \item[Topology] unusual enumerations of unflavored tree diagrams (section~\ref{sec:topology}, p.~\pageref{sec:topology}) \item[Momentum] finite sums of external momenta (section~\ref{sec:momentum}, p.~\pageref{sec:momentum}) \item[Fusion] off shell wave functions (section~\ref{sec:fusion}, p.~\pageref{sec:fusion}) \item[Omega] functor constructing an application from a model and a target (section~\ref{sec:omega}, p.~\pageref{sec:omega}) \end{modules} \subsection{Abstract interfaces} The domains and co-domains of functors (section~\ref{sec:coupling}, p.~\pageref{sec:coupling}) \begin{modules}{} \item[Coupling] all possible couplings (not comprensive yet) \item[Model] physical models \item[Target] target programming languages \end{modules} \subsection{Models} (section~\ref{sec:models}, p.~\pageref{sec:models}) \begin{modules}{} \item[Modellib_SM.QED] Quantum Electrodynamics \item[Modellib_SM.QCD] Quantum Chromodynamics (not complete yet) \item[Modellib_SM.SM] Minimal Standard Model (not complete yet) \end{modules} etc. \subsection{Targets} Any programming language that supports arithmetic and a textual representation of programs can be targeted by O'Caml. The implementations translate the abstract expressions derived by \ocwupperid{Fusion} to expressions in the target (section~\ref{sec:targets}, p.~\pageref{sec:targets}). \begin{modules}{} \item[Targets.Fortran] Fortran95 language implementation, calling subroutines \end{modules} Other targets could come in the future: \texttt{C}, \texttt{C++}, O'Caml itself, symbolic manipulation languages, etc. \subsection{Applications} (section~\ref{sec:omega}, p.~\pageref{sec:omega}) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{The Big To Do Lists} \label{sec:TODO} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Required} All features required for leading order physics applications are in place. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Useful} \begin{enumerate} \item select allowed helicity combinations for massless fermions \item Weyl-Van der Waerden spinors \item speed up helicity sums by using discrete symmetries \item general triple and quartic vector couplings \item diagnostics: count corresponding Feynman diagrams more efficiently for more than ten external lines \item recognize potential cascade decays ($\tau$, $b$, etc.) \begin{itemize} \item warn the user to add additional \item kill fusions (at runtime), that contribute to a cascade \end{itemize} \item complete standard model in $R_\xi$-gauge \item groves (the simple method of cloned generations works) \end{enumerate} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Future Features} \begin{enumerate} \item investigate if unpolarized squared matrix elements can be calculated faster as traces of densitiy matrices. Unfortunately, the answer apears to be \emph{no} for fermions and \emph{up to a constant factor} for massive vectors. Since the number of fusions in the amplitude grows like~$10^{n/2}$, the number of fusions in the squared matrix element grows like~$10^n$. On the other hand, there are $2^{\#\text{fermions}+\#\text{massless vectors}} \cdot3^{\#\text{massive vectors}}$ terms in the helicity sum, which grows \emph{slower} than~$10^{n/2}$. The constant factor is probably also not favorable. However, there will certainly be asymptotic gains for sums over gauge (and other) multiplets, like color sums. \item compile Feynman rules from Lagrangians \item evaluate amplitues in O'Caml by compiling it to three address code for a virtual machine \begin{flushleft} \ocwkw{type}~$\ocwlowerid{mem}~=~\ocwlowerid{scalar}~$\ocwbt{array}~$% \times{}~\ocwlowerid{spinor}~$\ocwbt{array}~$% \times{}~\ocwlowerid{spinor}~$\ocwbt{array}~$% \times{}~\ocwlowerid{vector}~$\ocwbt{array}\\ \ocwkw{type}~$\ocwlowerid{instr}~=$\\ \qquad|~$\ocwupperid{VSS}~$\ocwkw{of}~\ocwbt{int}~$% \times{}~$\ocwbt{int}~$\times{}~$\ocwbt{int}\\ \qquad|~$\ocwupperid{SVS}~$\ocwkw{of}~\ocwbt{int}~$% \times{}~$\ocwbt{int}~$\times{}~$\ocwbt{int}\\ \qquad|~$\ocwupperid{AVA}~$\ocwkw{of}~\ocwbt{int}~$% \times{}~$\ocwbt{int}~$\times{}~$\ocwbt{int}\\ \qquad\ldots \end{flushleft} this could be as fast as~\cite{ALPHA:1997} or~\cite{HELAC:2000}. \item a virtual machine will be useful for for other target as well, because native code appears to become to large for most compilers for more than ten external particles. Bytecode might even be faster due to improved cache locality. \item use the virtual machine in O'Giga \end{enumerate} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Science Fiction} \begin{enumerate} \item numerical and symbolical loop calculations with \textsc{O'Tera: O'Mega Tool for Evaluating Renormalized Amplitudes} \end{enumerate} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Tuples and Polytuples} \label{sec:tuple} \module{tuple} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Topologies} \label{sec:topology} \module{topology} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Directed Acyclical Graphs} \label{sec:DAG} \module{DAG} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Momenta} \label{sec:momentum} \module{momentum} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Cascades} \label{sec:cascades} \module{cascade_syntax} \section{Lexer} \lexer{cascade} \section{Parser} \parser{cascade} \module{cascade} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Color} \label{sec:color} \module{color} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Fusions} \label{sec:fusion} \module{fusion} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Lorentz Representations, Couplings, Models and Targets} \label{sec:coupling} \signature{coupling} \signature{model} \module{dirac} \module{vertex} \signature{target} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Conserved Quantum Numbers} \label{sec:charges} \module{charges} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Colorization} \label{sec:colorize} \module{colorize} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Processes} \label{sec:process} \module{process} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Model Files} \label{sec:model-files} \module{vertex_syntax} \section{Lexer} \lexer{vertex} \section{Parser} \parser{vertex} \module{vertex} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{UFO Models} \label{sec:ufo} \module{UFOx_syntax} \section{Expression Lexer} \lexer{UFOx} \section{Expression Parser} \parser{UFOx} \module{UFOx} \module{UFO_syntax} \section{Lexer} \lexer{UFO} \section{Parser} \parser{UFO} \module{UFO_Lorentz} \module{UFO} \section{Targets} \module{UFO_targets} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Hardcoded Targets} \label{sec:targets} \module{format_Fortran} \module{targets} \module{targets_Kmatrix} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Phase Space} \label{sec:phasespace} \module{phasespace} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Whizard} \label{sec:whizard} Talk to~\cite{Kilian:WHIZARD}. \module{whizard} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Applications} \label{sec:omega} \section{Sample} {\small\verbatiminput{sample.prc}} \module{omega} %application{omega_Phi3} %application{omega_Phi3h} %application{omega_Phi4} %application{omega_Phi4h} \application{omega_QED} %application{omega_QCD} %application{omega_SM3} %application{omega_SM3_ac} \application{omega_SM} \application{omega_SYM} %application{omega_SM_ac} %application{f90Maj_SM} %application{f90Maj_SM4} %application{omega_MSSM} %application{omega_MSSM_g} %application{omega_SM_Rxi} %application{omega_SM_clones} %application{omega_THDM} %application{omega_SMh} %application{omega_SM4h} %application{helas_QED} %application{helas_QCD} %application{helas_SM} -%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% \chapter{O'Giga: O'Mega Graphical Interface for Generation and Analysis} -%%% \label{sec:ogiga} -%%% {\itshape NB: The code in this chapter \emph{must} be compiled with -%%% \verb+-labels+, since \verb+lablgtk+ doesn't appear to work in classic mode.} -%%% \begin{dubious} -%%% Keep in mind that \texttt{ocamlweb} doesn't work properly with -%%% O'Caml~3 yet. The colons in label declarations are typeset with -%%% erroneous white space. -%%% \end{dubious} -%%% -%%% \application{ogiga} - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter*{Acknowledgements} We thank Mauro Moretti for fruitful discussions of the ALPHA algorithm~\cite{ALPHA:1997}, that inspired our solution of the double counting problem. We thank Wolfgang Kilian for providing the WHIZARD environment that turns our numbers into real events with unit weight. Thanks to the ECFA/DESY workshops and their participants for providing a showcase. Thanks to Edward Boos for discussions in Kaluza-Klein gravitons. This research is supported by Bundesministerium f\"ur Bildung und Forschung, Germany, (05\,HT9RDA) and Deutsche Forschungsgemeinschaft (MA\,676/6-1). Thanks to the Caml and Objective Caml teams from INRIA for the development and the lean and mean implementation of a programming language that does not insult the programmer's intelligence. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \begin{thebibliography}{10} \bibitem{ALPHA:1997} F. Caravaglios, M. Moretti, Z.{} Phys.{} \textbf{C74} (1997) 291. \bibitem{HELAC:2000} A. Kanaki, C. Papadopoulos, DEMO-HEP-2000/01, hep-ph/0002082, February 2000. \bibitem{Ler97} Xavier Leroy, \textit{The Objective Caml system, documentation and user's guide}, Technical Report, INRIA, 1997. \bibitem{Okasaki:1998:book} Chris Okasaki, \textit{Purely Functional Data Structures}, Cambridge University Press, 1998. \bibitem{HELAS} H. Murayama, I. Watanabe, K. Hagiwara, KEK Report 91-11, January 1992. \bibitem{MADGRAPH:1994} T. Stelzer, W.F. Long, Comput.{} Phys.{} Commun.{} \textbf{81} (1994) 357. \bibitem{Denner:Majorana} A. Denner, H. Eck, O. Hahn and J. K\"ublbeck, Phys.{} Lett.{} \textbf{B291} (1992) 278; Nucl.{} Phys.{} \textbf{B387} (1992) 467. \bibitem{Barger/etal:1992:color} V.~Barger, A.~L.~Stange, R.~J.~N.~Phillips, Phys.~Rev.~\textbf{D45}, (1992) 1751. \bibitem{Ohl:LOTR} T. Ohl, \textit{Lord of the Rings}, (Computer algebra library for O'Caml, unpublished). \bibitem{Ohl:bocages} T. Ohl, \textit{Bocages}, (Feynman diagram library for O'Caml, unpublished). \bibitem{Kilian:WHIZARD} W. Kilian, \textit{\texttt{WHIZARD}}, University of Karlsruhe, 2000. \bibitem{Boos/Ohl:groves} E.\,E. Boos, T. Ohl, Phys.\ Rev.\ Lett.\ \textbf{83} (1999) 480. \bibitem{Han/Lykken/Zhang:1999:Kaluza-Klein} T.~Han, J.~D.~Lykken and R.~Zhang, %``On Kaluza-Klein states from large extra dimensions,'' Phys.{} Rev.{} \textbf{D59} (1999) 105006 [hep-ph/9811350]. %%CITATION = HEP-PH 9811350;%% \bibitem{PTVF92} William H. Press, Saul A. Teukolsky, William T. Vetterling, Brian P. Flannery, \textit{Numerical Recipes: The Art of Scientific Computing}, Second Edition, Cambridge University Press, 1992. \bibitem{Cvi76} P.~Cvitanovi\'c, % author={Predrag Cvitanovi\'c}, % title={Group Theory for {Feynman} Diagrams in Non-{Abelian} % Gauge Theories}, Phys.{} Rev.{} \textbf{D14} (1976) 1536. %%%\bibitem{Kleiss/etal:Color-Monte-Carlo} %%% \begin{dubious} %%% ``\texttt{Kleiss/etal:Color-Monte-Carlo}'' %%% \end{dubious} %\cite{Kilian:2012pz} \bibitem{Kilian:2012pz} W.~Kilian, T.~Ohl, J.~Reuter and C.~Speckner, %``QCD in the Color-Flow Representation,'' JHEP \textbf{1210} (2012) 022 [arXiv:1206.3700 [hep-ph]]. %%CITATION = doi:10.1007/JHEP10(2012)022;%% %37 citations counted in INSPIRE as of 23 Apr 2019 %\cite{Degrande:2011ua} \bibitem{Degrande:2011ua} C.~Degrande, C.~Duhr, B.~Fuks, D.~Grellscheid, O.~Mattelaer and T.~Reiter, %``UFO - The Universal FeynRules Output,'' Comput.{} Phys.{} Commun.{} \textbf{183} (2012), 1201-1214 doi:10.1016/j.cpc.2012.01.022 [arXiv:1108.2040 [hep-ph]]. \end{thebibliography} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \appendix %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Autotools} \label{sec:autotools} \module{config} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Textual Options} \label{sec:options} \module{options} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Progress Reports} \label{sec:progress} \module{progress} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{More on Filenames} \label{sec:thoFilename} \module{thoFilename} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Cache Files} \label{sec:cache} \module{cache} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{More On Lists} \label{sec:tholist} \module{thoList} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{More On Arrays} \label{sec:thoarray} \module{thoArray} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{More On Strings} \label{sec:thostring} \module{thoString} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Polymorphic Maps} \label{sec:pmap} From~\cite{Ohl:LOTR}. \module{pmap} \module{partial} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Tries} \label{sec:trie} From~\cite{Okasaki:1998:book}, extended for~\cite{Ohl:LOTR}. \module{trie} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Tensor Products} \label{sec:product} From~\cite{Ohl:LOTR}. \module{product} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{(Fiber) Bundles} \label{sec:bundle} \module{bundle} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Power Sets} \label{sec:powSet} \module{powSet} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Combinatorics} \label{sec:combinatorics} \module{combinatorics} \module{permutation} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Partitions} \label{sec:partition} \module{partition} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Young Diagrams and Tableaux} \label{sec:young} \module{young} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Trees} \label{sec:tree} From~\cite{Ohl:bocages}: Trees with one root admit a straightforward recursive definition \begin{equation} \label{eq:trees} T(N,L) = L \cup N\times T(N,L)\times T(N,L) \end{equation} that is very well adapted to mathematical reasoning. Such recursive definitions are useful because they allow us to prove properties of elements by induction \begin{multline} \label{eq:tree-induction} \forall l\in L: p(l) \land (\forall n\in N: \forall t_1,t_2\in T(N,L): p(t_1) \land p(t_2) \Rightarrow p(n\times t_1\times t_2)) \\ \Longrightarrow \forall t\in T(N,L): p(t) \end{multline} i.\,e.~establishing a property for all leaves and showing that a node automatically satisfies the property if it is true for all children proves the property for \emph{all} trees. This induction is of course modelled after standard mathematical induction \begin{equation} p(1) \land (\forall n\in \mathbf{N}: p(n) \Rightarrow p(n+1)) \Longrightarrow \forall n\in \mathbf{N}: p(n) \end{equation} The recursive definition~(\ref{eq:trees}) is mirrored by the two tree construction functions\footnote{To make the introduction more accessible to non-experts, I avoid the `curried' notation for functions with multiple arguments and use tuples instead. The actual implementation takes advantage of curried functions, however. Experts can read $\alpha\to\beta\to\gamma$ for $\alpha\times\beta\to\gamma$.} \begin{subequations} \begin{align} \ocwlowerid{leaf}:\;& \nu\times\lambda \to(\nu,\lambda) T \\ \ocwlowerid{node}:\;& \nu\times(\nu,\lambda)T \times(\nu,\lambda)T \to(\nu,\lambda)T \end{align} \end{subequations} Renaming leaves and nodes leaves the structure of the tree invariant. Therefore, morphisms~$L\to L'$ and~$N\to N'$ of the sets of leaves and nodes induce natural homomorphisms~$T(N,L)\to T(N',L')$ of trees \begin{equation} \ocwlowerid{map}:\; (\nu\to\nu')\times(\lambda\to\lambda') \times(\nu,\lambda)T \to(\nu',\lambda') T \end{equation} The homomorphisms constructed by \ocwlowerid{map} are trivial, but ubiquitous. More interesting are the morphisms \begin{equation} \begin{aligned} \ocwlowerid{fold}:\;& (\nu\times\lambda\to\alpha) \times(\nu\times\alpha\times\alpha\to\alpha) \times(\nu,\lambda)T \to\alpha \\ & (f_1,f_2,l\in L) \mapsto f_1(l) \\ & (f_1,f_2,(n,t_1,t_2)) \mapsto f_2(n,\ocwlowerid{fold}(f_1,f_2,t_1), \ocwlowerid{fold}(f_1,f_2,t_2)) \end{aligned} \end{equation} and \begin{equation} \begin{aligned} \ocwlowerid{fan}:\;& (\nu\times\lambda\to\{\alpha\}) \times(\nu\times\alpha\times\alpha\to\{\alpha\}) \times(\nu,\lambda)T \to\{\alpha\} \\ & (f_1,f_2,l\in L) \mapsto f_1(l) \\ & (f_1,f_2,(n,t_1,t_2)) \mapsto f_2(n, \ocwlowerid{fold}(f_1,f_2,t_1) \otimes\ocwlowerid{fold}(f_1,f_2,t_2)) \end{aligned} \end{equation} where the tensor product notation means that~$f_2$ is applied to all combinations of list members in the argument: \begin{equation} \phi(\{x\}\otimes \{y\}) = \left\{ \phi(x,y) | x\in\{x\} \land y\in\{y\} \right\} \end{equation} But note that due to the recursive nature of trees, \ocwlowerid{fan} is \emph{not} a morphism from $T(N,L)$ to $T(N\otimes N,L)$.\par If we identify singleton sets with their members, \ocwlowerid{fold} could be viewed as a special case of \ocwlowerid{fan}, but that is probably more confusing than helpful. Also, using the special case~$\alpha=(\nu',\lambda')T$, the homomorphism \ocwlowerid{map} can be expressed in terms of \ocwlowerid{fold} and the constructors \begin{equation} \begin{aligned} \ocwlowerid{map}:\;& (\nu\to\nu')\times(\lambda\to\lambda') \times(\nu,\lambda)T \to(\nu',\lambda')T \\ &(f,g,t) \mapsto \ocwlowerid{fold} (\ocwlowerid{leaf}\circ (f\times g), \ocwlowerid{node}\circ (f\times\ocwlowerid{id} \times\ocwlowerid{id}), t) \end{aligned} \end{equation} \ocwlowerid{fold} is much more versatile than \ocwlowerid{map}, because it can be used with constructors for other tree representations to translate among different representations. The target type can also be a mathematical expression. This is used extensively below for evaluating Feynman diagrams.\par Using \ocwlowerid{fan} with~$\alpha=(\nu',\lambda')T$ can be used to construct a multitude of homomorphic trees. In fact, below it will be used extensively to construct all Feynman diagrams~$\{(\nu,\{p_1,\ldots,p_n\})T\}$ of a given topology~$t\in (\emptyset,\{1,\ldots,n\})T$. \begin{dubious} The physicist in me guesses that there is another morphism of trees that is related to \ocwlowerid{fan} like a Lie-algebra is related to the it's Lie-group. I have not been able to pin it down, but I guess that it is a generalization of \ocwlowerid{grow} below. \end{dubious} \module{tree} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Dependency Trees} \label{sec:tree2} \module{tree2} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Consistency Checks} \label{sec:count} \application{count} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Complex Numbers} \label{sec:complex} \module{complex} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Algebra} \label{sec:algebra} \module{algebra} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Simple Linear Algebra} \label{sec:linalg} \module{linalg} %application{test_linalg} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Partial Maps} \label{sec:partial} \module{partial} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Talk To The WHiZard \ldots} \label{sec:whizard_tool} Talk to~\cite{Kilian:WHIZARD}. \begin{dubious} Temporarily disabled, until, we implement some conditional weaving\ldots \end{dubious} %application{whizard_tool} %%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% \chapter{Widget Library and Class Hierarchy for O'Giga} %%% \label{sec:thogtk} %%% {\itshape NB: The code in this chapter \emph{must} be compiled with %%% \verb+-labels+, since \verb+lablgtk+ doesn't appear to work in classic mode.} %%% \begin{dubious} %%% Keep in mind that \texttt{ocamlweb} doesn't work properly with %%% O'Caml~3 yet. The colons in label declarations are typeset with %%% erroneous white space. %%% \end{dubious} %%% %%% \section{Architecture} %%% In \texttt{lablgtk}, O'Caml objects are typically constructed in %%% parallel to constructors for \texttt{GTK+} widgets. The objects %%% provide inheritance and all that, while the constructors implement the %%% semantics. %%% %%% \subsection{Inheritance vs.~Aggregation} %%% We have two mechanisms for creating new widgets: inheritance and %%% aggregation. Inheritance makes it easy to extend a given widget with %%% new methods or to combine orthogonal widgets (\emph{multiple %%% inheritance}). Aggregation is more suitable for combining %%% non-orthogonal widgets (e.\,g.~multiple instances of the same widget). %%% %%% The problem with inheritance in \texttt{lablgtk} is, that it is a %%% \emph{bad} idea to implement the semantics in the objects. In a %%% multi-level inheritance hierarchy, O'Caml can evaluate class functions %%% more than once. Since functions accessing \texttt{GTK+} change the %%% state of \texttt{GTK+}, we could accidentally violate invariants. %%% Therefore inheritance forces us to use the two-tiered approach of %%% \texttt{lablgtk} ourselves. It is not really complicated, but tedious %%% and it appears to be a good idea to use aggregation whenever in doubt. %%% %%% Nevertheless, there are examples (like %%% \ocwupperid{ThoGButton.mutable\_button} below, where just one new %%% method is added), that cry out for inheritance for the benefit of the %%% application developer. %%% %%% \module{thoGWindow} %%% \module{thoGButton} %%% \module{thoGMenu} %%% \module{thoGDraw} %%% %%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% \chapter{O'Mega Virtual Machine} %%% \label{sec:ovm} %%% \module{OVM} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{\texttt{Fortran} Libraries} \label{sec:fortran} \input{omegalib} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \begin{raggedright} \ifpdf \chapter{Index} \let\origtwocolumn\twocolumn \def\twocolumn[#1]{\origtwocolumn}% This index has been generated automatically and might not be 100\%ly accurate. In particular, hyperlinks have been observed to be off by one page. \fi \input{index.tex} \end{raggedright} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \end{empfile} \end{fmffile} \end{document} \endinput Local Variables: mode:latex indent-tabs-mode:nil page-delimiter:"^%%%%%.*\n" End: