1 (* Copyright (C) 2000, Luca Padovani <luca.padovani@cs.unibo.it>.
3 * This file is part of lablgtkmathview, the Ocaml binding
4 * for the GtkMathView widget.
6 * lablgtkmathview is free software; you can redistribute it and/or
7 * modify it under the terms of the GNU General Public License
8 * as published by the Free Software Foundation; either version 2
9 * of the License, or (at your option) any later version.
11 * lablgtkmathview is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 * GNU General Public License for more details.
16 * You should have received a copy of the GNU General Public License
17 * along with lablgtkmathview; if not, write to the Free Software
18 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
20 * For details, send a mail to the author.
23 (******************************************************************************)
24 (* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
27 (* This is a simple test for the OCaml (LablGtk indeed) binding of the *)
29 (******************************************************************************)
32 let selection_changed mathview (element : Gdome.element option) =
33 print_endline ("selection_changed: " ^
35 None -> "selection_changed on nothing"
36 | Some element -> element#get_tagName#to_string
39 mathview#set_selection element;
43 let element_changed mathview (element : Gdome.element option) =
44 print_endline ("element_changed: " ^
46 None -> "element_changed on nothing"
47 | Some element -> element#get_tagName#to_string
53 let rec jump (element : Gdome.element) =
54 let module G = Gdome in
55 let attr = (element#getAttribute ~name:(G.domString "href"))#to_string in
57 match element#get_parentNode with
61 jump (new Gdome.element_of_node p)
63 GdomeInit.DOMCastException _ ->
64 print_string "jump: NO HREF FOR THIS NODE\n" ;
68 | None -> assert false (* every element has a parent *)
71 print_endline ("jump: " ^ attr) ;
77 let clicked (mathview : GMathView.math_view) (element : Gdome.element) =
78 let module G = Gdome in
79 if not (jump element) then
80 match mathview#get_action with
82 mathview#action_toggle ;
83 print_string ("current action selection: " ^
84 string_of_int mathview#action_get_selected ^ "\n") ;
87 print_string ("mouse is on: " ^
88 (match (mathview#get_element : Gdome.element option) with
89 Some e -> e#get_tagName#to_string
90 | None -> "NO ELEMENT!\n"
92 print_endline ("clicked: " ^ element#get_tagName#to_string) ;
97 let activate_t1 (mathview : GMathView.math_view) () =
98 mathview#set_font_manager_type `font_manager_t1;
99 print_string "WIDGET SET WITH T1 FONTS\n" ;
103 let activate_gtk (mathview : GMathView.math_view) () =
104 mathview#set_font_manager_type `font_manager_gtk ;
105 print_string "WIDGET SET WITH GTK FONTS\n" ;
109 let get_font_manager_type mathview () =
110 print_string "CURRENT FONT MANAGER TYPE: ";
112 match mathview#get_font_manager_type with
113 | `font_manager_t1 -> print_string "T1"
114 | `font_manager_gtk -> print_string "GTK"
120 let get_transparency mathview () =
121 print_string ("CURRENT TRANSPARENCY: " ^
122 (if mathview#get_transparency then "ON" else "OFF") ^ "\n") ;
126 let set_transparency mathview () =
127 mathview#set_transparency (not mathview#get_transparency) ;
128 print_string "TRANSPARENCY CHANGED\n" ;
133 let load (mathview : GMathView.math_view) () =
134 mathview#load "test.xml" ;
135 print_string "load: SEEMS TO WORK\n" ;
139 let load_dom (mathview : GMathView.math_view) () =
140 mathview#load_tree ((Gdome.domImplementation ())#createDocumentFromURI ~uri:"test.xml" ~mode:0) ;
141 print_string "load from DOM: SEEMS TO WORK\n" ;
145 let get_selection (mathview : GMathView.math_view) () =
147 match mathview#get_selection with
148 Some element -> element#get_tagName#to_string
149 | None -> "no selection!"
151 print_string ("get_selection: " ^ selection ^ "\n") ;
155 let set_selection (mathview : GMathView.math_view) () =
157 match mathview#get_selection with
160 match element#get_parentNode with
164 mathview#set_selection (Some (new Gdome.element_of_node p));
165 print_string "set selection: SEEMS TO WORK\n"
167 GdomeInit.DOMCastException _ ->
168 print_string "EXCEPTION: no parent\n"
170 | None -> assert false (* every element has a parent *)
173 mathview#set_selection None;
174 print_string "no selection\n"
179 let unload mathview () =
181 print_string "unload: SEEMS TO WORK\n" ;
185 let get_width mathview () =
186 print_string ("get_width: " ^ string_of_int (mathview#get_width) ^ "\n") ;
190 let get_height mathview () =
191 print_string ("get_height: " ^ string_of_int (mathview#get_height) ^ "\n") ;
195 let get_top mathview () =
196 let (x,y) = mathview#get_top in
197 print_string ("get_top: ("^ string_of_int x ^ "," ^ string_of_int y ^ ")\n") ;
201 let set_top mathview () =
202 mathview#set_top 0 0;
203 print_string "set_top: SEEM TO WORK\n" ;
207 let set_adjustments mathview () =
208 let adj1 = GData.adjustment () in
209 let adj2 = GData.adjustment () in
210 mathview#set_adjustments adj1 adj2 ;
211 adj1#set_value ((adj1#lower +. adj1#upper) /. 2.0) ;
212 adj2#set_value ((adj2#lower +. adj2#upper) /. 2.0) ;
213 print_string "set_adjustments: SEEM TO WORK\n" ;
217 let get_hadjustment mathview () =
218 let adj = mathview#get_hadjustment in
219 adj#set_value ((adj#lower +. adj#upper) /. 2.0) ;
220 print_string "get_hadjustment: SEEM TO WORK\n" ;
224 let get_vadjustment mathview () =
225 let adj = mathview#get_vadjustment in
226 adj#set_value ((adj#lower +. adj#upper) /. 2.0) ;
227 print_string "get_vadjustment: SEEM TO WORK\n" ;
231 let get_buffer mathview () =
232 let buffer = mathview#get_buffer in
233 Gdk.Draw.rectangle buffer (Gdk.GC.create buffer) ~x:0 ~y:0
234 ~width:50 ~height:50 ~filled:true () ;
235 print_string "get_buffer: SEEMS TO WORK (hint: force the widget redrawing)\n";
239 let get_frame mathview () =
240 let frame = mathview#get_frame in
241 frame#set_shadow_type `NONE ;
242 print_string "get_frame: SEEMS TO WORK\n" ;
246 let set_font_size mathview () =
247 mathview#set_font_size 24 ;
248 print_string "set_font_size: FONT IS NOW 24\n" ;
252 let get_font_size mathview () =
253 print_string ("get_font_size: " ^ string_of_int (mathview#get_font_size) ^ "\n") ;
257 let set_anti_aliasing mathview () =
258 mathview#set_anti_aliasing true ;
259 print_string "set_anti_aliasing: ON\n" ;
263 let get_anti_aliasing mathview () =
264 print_string ("get_anti_aliasing: " ^
265 (match mathview#get_anti_aliasing with true -> "ON" | false -> "OFF") ^
270 let set_kerning mathview () =
271 mathview#set_kerning true ;
272 print_string "set_kerning: ON\n" ;
276 let get_kerning mathview () =
277 print_string ("get_kerning: " ^
278 (match mathview#get_kerning with true -> "ON" | false -> "OFF") ^
283 let set_log_verbosity mathview () =
284 mathview#set_log_verbosity 3 ;
285 print_string "set_log_verbosity: NOW IS 3\n" ;
289 let get_log_verbosity mathview () =
290 print_string ("get_log_verbosity: " ^
291 string_of_int mathview#get_log_verbosity ^
296 let export_to_postscript (mathview : GMathView.math_view) () =
297 mathview#export_to_postscript ~filename:"test.ps" ();
298 print_string "expor_to_postscript: SEEMS TO WORK (hint: look at test.ps)\n";
302 (* Widget creation *)
303 let main_window = GWindow.window ~title:"GtkMathView test" () in
304 let vbox = GPack.vbox ~packing:main_window#add () in
305 let sw = GBin.scrolled_window ~width:50 ~height:50 ~packing:vbox#pack () in
306 let mathview= GMathView.math_view ~packing:sw#add ~width:50 ~height:50 () in
307 let table = GPack.table ~rows:6 ~columns:5 ~packing:vbox#pack () in
308 let button_gtk=GButton.button ~label:"activate Gtk fonts" ~packing:(table#attach ~left:0 ~top:0) () in
309 let button_load = GButton.button ~label:"load" ~packing:(table#attach ~left:1 ~top:0) () in
310 let button_unload = GButton.button ~label:"unload" ~packing:(table#attach ~left:2 ~top:0) () in
311 let button_get_selection = GButton.button ~label:"get_selection" ~packing:(table#attach ~left:3 ~top:0) () in
312 let button_set_selection = GButton.button ~label:"set_selection" ~packing:(table#attach ~left:4 ~top:0) () in
313 let button_get_width = GButton.button ~label:"get_width" ~packing:(table#attach ~left:0 ~top:1) () in
314 let button_get_height = GButton.button ~label:"get_height" ~packing:(table#attach ~left:1 ~top:1) () in
315 let button_get_top = GButton.button ~label:"get_top" ~packing:(table#attach ~left:2 ~top:1) () in
316 let button_set_top = GButton.button ~label:"set_top" ~packing:(table#attach ~left:3 ~top:1) () in
317 let button_set_adjustments = GButton.button ~label:"set_adjustments" ~packing:(table#attach ~left:4 ~top:1) () in
318 let button_get_hadjustment = GButton.button ~label:"get_hadjustment" ~packing:(table#attach ~left:0 ~top:2) () in
319 let button_get_vadjustment = GButton.button ~label:"get_vadjustment" ~packing:(table#attach ~left:1 ~top:2) () in
320 let button_get_buffer = GButton.button ~label:"get_buffer" ~packing:(table#attach ~left:2 ~top:2) () in
321 let button_get_frame = GButton.button ~label:"get_frame" ~packing:(table#attach ~left:3 ~top:2) () in
322 let button_set_font_size = GButton.button ~label:"set_font_size" ~packing:(table#attach ~left:4 ~top:2) () in
323 let button_get_font_size = GButton.button ~label:"get_font_size" ~packing:(table#attach ~left:0 ~top:3) () in
324 let button_set_anti_aliasing = GButton.button ~label:"set_anti_aliasing" ~packing:(table#attach ~left:1 ~top:3) () in
325 let button_get_anti_aliasing = GButton.button ~label:"get_anti_aliasing" ~packing:(table#attach ~left:2 ~top:3) () in
326 let button_set_kerning = GButton.button ~label:"set_kerning" ~packing:(table#attach ~left:3 ~top:3) () in
327 let button_get_kerning = GButton.button ~label:"get_kerning" ~packing:(table#attach ~left:4 ~top:3) () in
328 let button_set_log_verbosity = GButton.button ~label:"set_log_verbosity" ~packing:(table#attach ~left:0 ~top:4) () in
329 let button_get_log_verbosity = GButton.button ~label:"get_log_verbosity" ~packing:(table#attach ~left:1 ~top:4) () in
330 let button_export_to_postscript = GButton.button ~label:"export_to_postscript" ~packing:(table#attach ~left:2 ~top:4) () in
331 let button_t1 = GButton.button ~label:"activate T1 fonts" ~packing:(table#attach ~left:3 ~top:4) () in
332 let button_get_font_manager_type = GButton.button ~label:"get_font_manager" ~packing:(table#attach ~left:4 ~top:4) () in
333 let button_get_transparency = GButton.button ~label:"get_transparency" ~packing:(table#attach ~left:0 ~top:5) () in
334 let button_set_transparency = GButton.button ~label:"set_transparency" ~packing:(table#attach ~left:1 ~top:5) () in
335 let button_load_dom = GButton.button ~label:"load from DOM" ~packing:(table#attach ~left:2 ~top:5) () in
336 (* Signals connection *)
337 ignore(button_gtk#connect#clicked (activate_gtk mathview)) ;
338 ignore(button_load#connect#clicked (load mathview)) ;
339 ignore(button_unload#connect#clicked (unload mathview)) ;
340 ignore(button_get_selection#connect#clicked (get_selection mathview)) ;
341 ignore(button_set_selection#connect#clicked (set_selection mathview)) ;
342 ignore(button_get_width#connect#clicked (get_width mathview)) ;
343 ignore(button_get_height#connect#clicked (get_height mathview)) ;
344 ignore(button_get_top#connect#clicked (get_top mathview)) ;
345 ignore(button_set_top#connect#clicked (set_top mathview)) ;
346 ignore(button_set_adjustments#connect#clicked (set_adjustments mathview)) ;
347 ignore(button_get_hadjustment#connect#clicked (get_hadjustment mathview)) ;
348 ignore(button_get_vadjustment#connect#clicked (get_vadjustment mathview)) ;
349 ignore(button_get_buffer#connect#clicked (get_buffer mathview)) ;
350 ignore(button_get_frame#connect#clicked (get_frame mathview)) ;
351 ignore(button_set_font_size#connect#clicked (set_font_size mathview)) ;
352 ignore(button_get_font_size#connect#clicked (get_font_size mathview)) ;
353 ignore(button_set_anti_aliasing#connect#clicked (set_anti_aliasing mathview)) ;
354 ignore(button_get_anti_aliasing#connect#clicked (get_anti_aliasing mathview)) ;
355 ignore(button_set_kerning#connect#clicked (set_kerning mathview)) ;
356 ignore(button_get_kerning#connect#clicked (get_kerning mathview)) ;
357 ignore(button_set_log_verbosity#connect#clicked (set_log_verbosity mathview)) ;
358 ignore(button_get_log_verbosity#connect#clicked (get_log_verbosity mathview)) ;
359 ignore(button_export_to_postscript#connect#clicked (export_to_postscript mathview)) ;
360 ignore(button_t1#connect#clicked (activate_t1 mathview)) ;
361 ignore(button_get_font_manager_type#connect#clicked (get_font_manager_type mathview)) ;
362 ignore(button_get_transparency#connect#clicked (get_transparency mathview)) ;
363 ignore(button_set_transparency#connect#clicked (set_transparency mathview)) ;
364 ignore(mathview#connect#clicked (clicked mathview)) ;
365 ignore(mathview#connect#selection_changed (selection_changed mathview)) ;
366 ignore(mathview#connect#element_changed (element_changed mathview)) ;
367 ignore(button_load_dom#connect#clicked (load_dom mathview)) ;
369 main_window#show () ;