helm/DEVEL/lablgtk_gtkmathview/lablgtk-20000829_gtkmathview-0.2.1/test/test.ml

   1 (******************************************************************************)
   2 (*                Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>               *)
   3 (*                                 25/09/2000                                 *)
   4 (*                                                                            *)
   5 (*     This is a simple test for the OCaml (LablGtk indeed) binding of the    *)
   6 (*                             MathView widget                                *)
   7 (******************************************************************************)
   8
   9 (* Callbacks *)
  10 let jump (node : Ominidom.o_mDOMNode) =
  11  let module O = Ominidom in
  12   print_string ("jump: " ^
  13    (try
  14       let href = node#get_attribute (O.o_mDOMString_of_string "href") in
  15       href#get_string
  16     with
  17       O.Minidom_exception s -> "EXCEPTION: " ^ s
  18    ) ^ "\n");
  19   flush stdout
  20 ;;
  21
  22 let selection_changed mathview (node : Ominidom.o_mDOMNode option) =
  23  let module O = Ominidom in
  24   print_string ("selection_changed: " ^
  25    (match node with
  26        None ->
  27          mathview#reset_selection;
  28          "selection_changed on nothing"
  29      | Some node ->
  30         try
  31           mathview#set_selection node ;
  32           let node_name = node#get_name in
  33           node_name#get_string
  34         with
  35           O.Minidom_exception s -> "EXCEPTION: " ^ s
  36    ) ^ "\n");
  37   flush stdout
  38 ;;
  39
  40
  41 let clicked (node : Ominidom.o_mDOMNode) =
  42  let module O = Ominidom in
  43   print_string ("clicked: " ^
  44    (try
  45       let node_name = node#get_name in
  46       node_name#get_string
  47     with
  48       O.Minidom_exception s -> "EXCEPTION: " ^ s
  49    ) ^ "\n");
  50   flush stdout
  51 ;;
  52
  53
  54 let activate_t1 mathview () =
  55  mathview#set_font_manager_type GtkMathView.MathView.FontManagerT1;
  56  print_string "WIDGET SET WITH T1 FONTS\n" ;
  57  flush stdout
  58 ;;
  59
  60 let activate_gtk mathview () =
  61  mathview#set_font_manager_type GtkMathView.MathView.FontManagerGtk;
  62  print_string "WIDGET SET WITH GTK FONTS\n" ;
  63  flush stdout
  64 ;;
  65
  66 let get_font_manager_type mathview () =
  67  print_string "CURRENT FONT MANAGER TYPE: ";
  68  begin
  69   match mathview#get_font_manager_type with
  70   | GtkMathView.MathView.FontManagerT1 -> print_string "T1"
  71   | GtkMathView.MathView.FontManagerGtk -> print_string "GTK"
  72  end;
  73  print_newline();
  74  flush stdout
  75 ;;
  76
  77 let load mathview () =
  78  mathview#load "test.xml" ;
  79  print_string "load: SEEMS TO WORK\n" ;
  80  flush stdout
  81 ;;
  82
  83 let get_selection mathview () =
  84  let module O = Ominidom in
  85   let selection =
  86    if not mathview#has_selection then "nothing"
  87    else
  88      let node = mathview#get_selection in
  89      (try node#get_name#get_string
  90       with
  91         O.Minidom_exception s -> "EXCEPTION: " ^ s
  92      )
  93   in
  94    print_string ("get_selection: " ^ selection ^ "\n") ;
  95    flush stdout
  96 ;;
  97
  98 let set_selection mathview () =
  99  let module O = Ominidom in
 100   begin
 101    try
 102     let selected_node = mathview#get_selection in
 103     try
 104       let parent_node = selected_node#get_parent in
 105       mathview#set_selection parent_node;
 106       print_string "set selection: SEEMS TO WORK\n"
 107     with
 108       O.Minidom_exception s ->
 109         print_string ("EXCEPTION: " ^ s ^ "\n")
 110    with
 111     GtkMathView.MathView.NoSelection ->
 112      print_string "set_selection: YOU MUST PREVIOUSLY SELECT A NON-ROOT NODE\n"
 113   end ;
 114   flush stdout
 115 ;;
 116
 117 let reset_selection mathview () =
 118  mathview#reset_selection ;
 119  print_string "reset_selection: SEEMS TO WORK\n" ;
 120  flush stdout
 121 ;;
 122
 123 let unload mathview () =
 124  mathview#unload ;
 125  print_string "unload: SEEMS TO WORK\n" ;
 126  flush stdout
 127 ;;
 128
 129 let get_width mathview () =
 130  print_string ("get_width: " ^ string_of_int (mathview#get_width) ^ "\n") ;
 131  flush stdout
 132 ;;
 133
 134 let get_height mathview () =
 135  print_string ("get_height: " ^ string_of_int (mathview#get_height) ^ "\n") ;
 136  flush stdout
 137 ;;
 138
 139 let get_top mathview () =
 140  let (x,y) = mathview#get_top in
 141   print_string ("get_top: ("^ string_of_int x ^ "," ^ string_of_int y ^ ")\n") ;
 142   flush stdout
 143 ;;
 144
 145 let set_top mathview () =
 146  mathview#set_top 0 0;
 147  print_string "set_top: SEEM TO WORK\n" ;
 148  flush stdout
 149 ;;
 150
 151 let set_adjustments mathview () =
 152  let adj1 = GData.adjustment () in
 153  let adj2 = GData.adjustment () in
 154   mathview#set_adjustments adj1 adj2 ;
 155   adj1#set_value ((adj1#lower +. adj1#upper) /. 2.0) ;
 156   adj2#set_value ((adj2#lower +. adj2#upper) /. 2.0) ;
 157   print_string "set_adjustments: SEEM TO WORK\n" ;
 158   flush stdout
 159 ;;
 160
 161 let get_hadjustment mathview () =
 162  let adj = mathview#get_hadjustment in
 163   adj#set_value ((adj#lower +. adj#upper) /. 2.0) ;
 164   print_string "get_hadjustment: SEEM TO WORK\n" ;
 165   flush stdout
 166 ;;
 167
 168 let get_vadjustment mathview () =
 169  let adj = mathview#get_vadjustment in
 170   adj#set_value ((adj#lower +. adj#upper) /. 2.0) ;
 171   print_string "get_vadjustment: SEEM TO WORK\n" ;
 172   flush stdout
 173 ;;
 174
 175 let get_buffer mathview () =
 176  let buffer = mathview#get_buffer in
 177   Gdk.Draw.rectangle buffer (Gdk.GC.create buffer) ~x:0 ~y:0
 178    ~width:50 ~height:50 ~filled:true () ;
 179   print_string "get_buffer: SEEMS TO WORK (hint: force the widget redrawing)\n";
 180   flush stdout
 181 ;;
 182
 183 let get_frame mathview () =
 184  let frame = mathview#get_frame in
 185   frame#set_shadow_type `NONE ;
 186   print_string "get_frame: SEEMS TO WORK\n" ;
 187   flush stdout
 188 ;;
 189
 190 let set_font_size mathview () =
 191  mathview#set_font_size 24 ;
 192  print_string "set_font_size: FONT IS NOW 24\n" ;
 193  flush stdout
 194 ;;
 195
 196 let get_font_size mathview () =
 197  print_string ("get_font_size: " ^ string_of_int (mathview#get_font_size) ^ "\n") ;
 198  flush stdout
 199 ;;
 200
 201 let set_anti_aliasing mathview () =
 202  mathview#set_anti_aliasing true ;
 203  print_string "set_anti_aliasing: ON\n" ;
 204  flush stdout
 205 ;;
 206
 207 let get_anti_aliasing mathview () =
 208  print_string ("get_anti_aliasing: " ^
 209   (match mathview#get_anti_aliasing with true -> "ON" | false -> "OFF") ^
 210   "\n") ;
 211  flush stdout
 212 ;;
 213
 214 let set_kerning mathview () =
 215  mathview#set_kerning true ;
 216  print_string "set_kerning: ON\n" ;
 217  flush stdout
 218 ;;
 219
 220 let get_kerning mathview () =
 221  print_string ("get_kerning: " ^
 222   (match mathview#get_kerning with true -> "ON" | false -> "OFF") ^
 223   "\n") ;
 224  flush stdout
 225 ;;
 226
 227 let set_log_verbosity mathview () =
 228  mathview#set_log_verbosity 3 ;
 229  print_string "set_log_verbosity: NOW IS 3\n" ;
 230  flush stdout
 231 ;;
 232
 233 let get_log_verbosity mathview () =
 234  print_string ("get_log_verbosity: " ^
 235   string_of_int mathview#get_log_verbosity ^
 236   "\n") ;
 237  flush stdout
 238 ;;
 239
 240 let export_to_postscript mathview () =
 241  mathview#export_to_postscript 595 822 72 72 false "test.ps" ;
 242  print_string "expor_to_postscript: SEEMS TO WORK (hint: look at test.ps)\n";
 243  flush stdout
 244 ;;
 245
 246 (* Widget creation *)
 247 let main_window = GWindow.window ~title:"GtkMathView test" () in
 248 let vbox = GPack.vbox ~packing:main_window#add () in
 249 let sw = GBin.scrolled_window ~width:50 ~height:50 ~packing:vbox#pack () in
 250 let mathview= GMathView.math_view ~packing:sw#add ~width:50 ~height:50 () in
 251 let table = GPack.table ~rows:6 ~columns:5 ~packing:vbox#pack () in
 252 let button_gtk=GButton.button ~label:"activate Gtk fonts" ~packing:(table#attach ~left:0 ~top:0) () in
 253 let button_load = GButton.button ~label:"load" ~packing:(table#attach ~left:1 ~top:0) () in
 254 let button_unload = GButton.button ~label:"unload" ~packing:(table#attach ~left:2 ~top:0) () in
 255 let button_get_selection = GButton.button ~label:"get_selection" ~packing:(table#attach ~left:3 ~top:0) () in
 256 let button_set_selection = GButton.button ~label:"set_selection" ~packing:(table#attach ~left:4 ~top:0) () in
 257 let button_get_width = GButton.button ~label:"get_width" ~packing:(table#attach ~left:0 ~top:1) () in
 258 let button_get_height = GButton.button ~label:"get_height" ~packing:(table#attach ~left:1 ~top:1) () in
 259 let button_get_top = GButton.button ~label:"get_top" ~packing:(table#attach ~left:2 ~top:1) () in
 260 let button_set_top = GButton.button ~label:"set_top" ~packing:(table#attach ~left:3 ~top:1) () in
 261 let button_set_adjustments = GButton.button ~label:"set_adjustments" ~packing:(table#attach ~left:4 ~top:1) () in
 262 let button_get_hadjustment = GButton.button ~label:"get_hadjustment" ~packing:(table#attach ~left:0 ~top:2) () in
 263 let button_get_vadjustment = GButton.button ~label:"get_vadjustment" ~packing:(table#attach ~left:1 ~top:2) () in
 264 let button_get_buffer = GButton.button ~label:"get_buffer" ~packing:(table#attach ~left:2 ~top:2) () in
 265 let button_get_frame = GButton.button ~label:"get_frame" ~packing:(table#attach ~left:3 ~top:2) () in
 266 let button_set_font_size = GButton.button ~label:"set_font_size" ~packing:(table#attach ~left:4 ~top:2) () in
 267 let button_get_font_size = GButton.button ~label:"get_font_size" ~packing:(table#attach ~left:0 ~top:3) () in
 268 let button_set_anti_aliasing = GButton.button ~label:"set_anti_aliasing" ~packing:(table#attach ~left:1 ~top:3) () in
 269 let button_get_anti_aliasing = GButton.button ~label:"get_anti_aliasing" ~packing:(table#attach ~left:2 ~top:3) () in
 270 let button_set_kerning = GButton.button ~label:"set_kerning" ~packing:(table#attach ~left:3 ~top:3) () in
 271 let button_get_kerning = GButton.button ~label:"get_kerning" ~packing:(table#attach ~left:4 ~top:3) () in
 272 let button_set_log_verbosity = GButton.button ~label:"set_log_verbosity" ~packing:(table#attach ~left:0 ~top:4) () in
 273 let button_get_log_verbosity = GButton.button ~label:"get_log_verbosity" ~packing:(table#attach ~left:1 ~top:4) () in
 274 let button_export_to_postscript = GButton.button ~label:"export_to_postscript" ~packing:(table#attach ~left:2 ~top:4) () in
 275 let button_t1 = GButton.button ~label:"activate T1 fonts" ~packing:(table#attach ~left:3 ~top:4) () in
 276 let button_get_font_manager_type = GButton.button ~label:"get_font_manager" ~packing:(table#attach ~left:4 ~top:4) () in
 277 let button_reset_selection = GButton.button ~label:"reset_selection" ~packing:(table#attach ~left:0 ~top:5) () in
 278 (* Signals connection *)
 279 ignore(button_gtk#connect#clicked (activate_gtk mathview)) ;
 280 ignore(button_load#connect#clicked (load mathview)) ;
 281 ignore(button_unload#connect#clicked (unload mathview)) ;
 282 ignore(button_get_selection#connect#clicked (get_selection mathview)) ;
 283 ignore(button_set_selection#connect#clicked (set_selection mathview)) ;
 284 ignore(button_reset_selection#connect#clicked (reset_selection mathview)) ;
 285 ignore(button_get_width#connect#clicked (get_width mathview)) ;
 286 ignore(button_get_height#connect#clicked (get_height mathview)) ;
 287 ignore(button_get_top#connect#clicked (get_top mathview)) ;
 288 ignore(button_set_top#connect#clicked (set_top mathview)) ;
 289 ignore(button_set_adjustments#connect#clicked (set_adjustments mathview)) ;
 290 ignore(button_get_hadjustment#connect#clicked (get_hadjustment mathview)) ;
 291 ignore(button_get_vadjustment#connect#clicked (get_vadjustment mathview)) ;
 292 ignore(button_get_buffer#connect#clicked (get_buffer mathview)) ;
 293 ignore(button_get_frame#connect#clicked (get_frame mathview)) ;
 294 ignore(button_set_font_size#connect#clicked (set_font_size mathview)) ;
 295 ignore(button_get_font_size#connect#clicked (get_font_size mathview)) ;
 296 ignore(button_set_anti_aliasing#connect#clicked (set_anti_aliasing mathview)) ;
 297 ignore(button_get_anti_aliasing#connect#clicked (get_anti_aliasing mathview)) ;
 298 ignore(button_set_kerning#connect#clicked (set_kerning mathview)) ;
 299 ignore(button_get_kerning#connect#clicked (get_kerning mathview)) ;
 300 ignore(button_set_log_verbosity#connect#clicked (set_log_verbosity mathview)) ;
 301 ignore(button_get_log_verbosity#connect#clicked (get_log_verbosity mathview)) ;
 302 ignore(button_export_to_postscript#connect#clicked (export_to_postscript mathview)) ;
 303 ignore(button_t1#connect#clicked (activate_t1 mathview)) ;
 304 ignore(button_get_font_manager_type#connect#clicked (get_font_manager_type mathview)) ;
 305 ignore(mathview#connect#jump jump) ;
 306 ignore(mathview#connect#clicked clicked) ;
 307 ignore(mathview#connect#selection_changed (selection_changed mathview)) ;
 308 (* Main Loop *)
 309 main_window#show () ;
 310 GMain.Main.main ()
 311 ;;