X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20001129-0.1.0%2Fexamples%2Ffixed_editor.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20001129-0.1.0%2Fexamples%2Ffixed_editor.ml;h=0000000000000000000000000000000000000000;hb=3ef089a4c58fbe429dd539af6215991ecbe11ee2;hp=1cde124c7320d28208de463839dbc02b5fc42e96;hpb=1c7fb836e2af4f2f3d18afd0396701f2094265ff;p=helm.git diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/examples/fixed_editor.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/examples/fixed_editor.ml deleted file mode 100644 index 1cde124c7..000000000 --- a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/examples/fixed_editor.ml +++ /dev/null @@ -1,279 +0,0 @@ -open Gdk -open Gtk -open GObj -open GMain - -let dnd_source_window () = - let window = GWindow.window ~position:`MOUSE () in - let vbx = GPack.vbox ~border_width:10 ~packing:window#add () - in - let evb = GBin.event_box ~border_width:0 ~packing:vbx#add () in - let frm = GBin.frame ~shadow_type:`OUT ~packing:evb#add () in - let lbl = GMisc.label ~text:"hello" ~packing:frm#add () in - let lbl2 = GMisc.label ~text:"drag from here!" ~packing:vbx#add () in - let targets = [ { target = "STRING"; flags = []; info = 0} ] in - begin - window#show (); - evb#drag#source_set targets ~modi:[`BUTTON1] ~actions:[`COPY]; - evb#drag#connect#data_get ~callback: begin - fun _ data ~info ~time:_ -> - data#set ~typ:data#target ~format:0 ~data:"hello! " - end - end - -let corner_width = 7 -let corner_height = 7 - -type drag_action_type = - GB_DRAG_NONE - | GB_MIDDLE - | GB_TOP - | GB_BOTTOM - | GB_LEFT - | GB_RIGHT - | GB_TOP_LEFT - | GB_TOP_RIGHT - | GB_BOTTOM_LEFT - | GB_BOTTOM_RIGHT - -let get_position_in_widget w ~x ~y ~width ~height = - if (x <= corner_width) then - if (y <= corner_height) then - GB_TOP_LEFT - else if (y >= height-corner_width) then - GB_BOTTOM_LEFT - else GB_LEFT - else if (x >= width-corner_width) then - if (y <= corner_height) then - GB_TOP_RIGHT - else if (y >= height-corner_width) then - GB_BOTTOM_RIGHT - else GB_RIGHT - else if (y <= corner_height) then - GB_TOP - else if (y >= height-corner_width) then - GB_BOTTOM - else GB_MIDDLE - -class drag_info = object - val mutable drag_action = GB_DRAG_NONE - val mutable drag_offset = (0, 0) - val mutable toimen = (0, 0) - val mutable drag_widget = None - method drag_action = drag_action - method drag_offset = drag_offset - method toimen = toimen (* coord. of opposite corner *) - method set_drag_widget (w : GObj.widget) = begin - match drag_widget with - None -> begin - GMain.Grab.add w; - drag_widget <- Some w; - () - end - | Some w -> () - end - method unset_drag_widget () = begin - match drag_widget with - Some w -> begin - GMain.Grab.remove w; - drag_widget <- None; - () - end - | None -> () - end - method set_drag_offset ~x ~y = drag_offset <- (x, y) - method set_drag_action (w : Gdk.window) ~x ~y = - begin - let (x0, y0) = Window.get_position w in - let (width, height) = Window.get_size w in - drag_action <- get_position_in_widget w ~x ~y ~width ~height; - let (x1, y1) = (x0+width, y0+height) in - toimen <- - match drag_action with - GB_TOP_LEFT -> (x1, y1) - | GB_BOTTOM_LEFT -> (x1, y0) - | GB_TOP_RIGHT -> (x0, y1) - | GB_BOTTOM_RIGHT -> (x0, y0) - | GB_TOP -> (x0, y1) - | GB_BOTTOM -> (x0, y0) - | GB_LEFT -> (x1, y0) - | GB_RIGHT -> (x0, y0) - | _ -> (-1, -1) - end - method unset_drag_action () = drag_action <- GB_DRAG_NONE -end - - -let to_grid g x = x - (x mod g) - -let to_grid2 g (x, y) = (to_grid g x, to_grid g y) - -class fix_editor ~width ~height ~packing = - let info = new drag_info in - let fix = GPack.fixed ~width ~height ~packing () in - let _ = fix#misc#realize () in - let fix_window = fix#misc#window in - let fix_drawing = new GDraw.drawable fix_window in - - object (self) - inherit GObj.widget fix#as_widget - val mutable grid = 1 - method set_grid g = - if (grid != g) then begin - let pix = - GDraw.pixmap ~window:fix ~width:g ~height:g ~mask:true () in - let c = fix#misc#style#bg `NORMAL in - pix#set_foreground (`COLOR c); - pix#rectangle ~filled:true ~x:0 ~y:0 ~width:g ~height:g (); - pix#set_foreground `BLACK; - pix#point ~x:0 ~y:0; - Gdk.Window.set_back_pixmap (fix#misc#window) (`PIXMAP pix#pixmap) - end; - grid <- g - - method new_child ~name ~x ~y ~width ~height ~callback = - let evb = GBin.event_box ~border_width:0 ~packing:fix#add () in - let lbl = GMisc.label ~text:name ~width ~height ~packing:evb#add () in - evb#misc#realize (); - evb#misc#set_geometry ~x ~y (); - self#connect_signals ~ebox:evb ~widget:lbl#coerce ~callback; - () - - method private connect_signals - ~ebox:(ebox : GBin.event_box) ~widget:(widget : widget) ~callback:cbfun = - let drawing = new GDraw.drawable (ebox#misc#window) in - let draw_id = ref None in - let exps_id = ref None in - let on_paint _ = - let (width, height) = Window.get_size (ebox#misc#window) in begin - drawing#set_foreground `BLACK; - drawing#rectangle ~filled:true ~x:0 ~y:0 - ~width:corner_width ~height:corner_height (); - drawing#rectangle ~filled:true ~x:(width-corner_width) ~y:0 - ~width:corner_width ~height:corner_height (); - drawing#rectangle ~filled:true - ~x:(width-corner_width) - ~y:(height-corner_height) - ~width:corner_width ~height:corner_height (); - drawing#rectangle ~filled:true - ~x:0 - ~y:(height-corner_height) - ~width:corner_width ~height:corner_height (); - drawing#rectangle ~filled:false - ~x:0 ~y:0 ~width:(width-1) ~height:(height-1) (); - end - in - ebox#event#connect#button_press ~callback: - begin fun ev -> - let bx = int_of_float (GdkEvent.Button.x ev) in - let by = int_of_float (GdkEvent.Button.y ev) in - info#set_drag_action (ebox#misc#window) ~x:bx ~y:by; - info#set_drag_offset ~x:bx ~y:by; - true - end; - ebox#event#connect#motion_notify ~callback: - begin fun ev -> - info#set_drag_widget ebox#coerce; - let action = info#drag_action in - let (mx, my) = fix#misc#pointer in - let (ox, oy) = info#drag_offset in - begin match action with - GB_MIDDLE -> - let (nx, ny) = to_grid2 grid (mx-ox, my-oy) in - ebox#misc#set_geometry ~x:nx ~y:ny (); - if cbfun ~x:nx ~y:ny ~width:(-2) ~height:(-2) then - () - else (* should we undo ? *) () - | GB_DRAG_NONE -> () (* do nothing *) - | GB_TOP_LEFT | GB_BOTTOM_LEFT - | GB_TOP_RIGHT | GB_BOTTOM_RIGHT -> - let (toi_x, toi_y) = info#toimen in - let (mx, my) = to_grid2 grid (mx, my) in - let (lx, rx) = - if mx - let (lx, toi_y) = info#toimen in - let my = to_grid grid my in - let (ty, by) = if my - let (toi_x, ty) = info#toimen in - let mx = to_grid grid mx in - let (lx, rx) = if mx - info#unset_drag_action (); - info#unset_drag_widget (); - true - end; - exps_id := Some (ebox#event#connect#after#expose - ~callback:(fun _ -> on_paint(); false)); - draw_id := Some (ebox#misc#connect#draw ~callback:on_paint); - () - initializer - fix#drag#dest_set ~actions:[`COPY] - [ { target = "STRING"; flags = []; info = 0} ]; - fix#drag#connect#data_received ~callback: begin - fun context ~x ~y data ~info ~time -> - let name = data#data in - let _ = self#new_child ~name ~x ~y ~width:32 ~height:32 - ~callback:(fun ~x ~y ~width ~height -> true) in -(* Printf.printf "%s %d %d\n" (data#data) x y; - flush stdout; *) - context#finish ~success:true ~del:false ~time; - end; - () - end - -(* the following is for test only *) -let window1 () = - let window = GWindow.window () in - let _ = window#connect#destroy ~callback: Main.quit in - let fix = new fix_editor ~width:640 ~height:480 ~packing:window#add in - fix#set_grid 5; - let setter = fix#new_child ~name:"hello" ~x:100 ~y:200 ~width:32 ~height:32 - ~callback:begin fun ~x ~y ~width ~height -> - (* Printf.printf "name=%s, x=%d, y=%d, width=%d, height=%d\n" - "hello" x y width height; - flush stdout; *) - true - end in - window#show (); - () - - - -let main () = - window1 (); - dnd_source_window (); - Main.main () - -let _ = main () - -(* Todo - - change mouse cursor - resize fixed itself - remove_child - (drag and) drop - -*)