[Sahcui-svn] SF.net SVN: sahcui: [2] trunk

[<afr...@us...>]

Revision: 2
          http://sahcui.svn.sourceforge.net/sahcui/?rev=2&view=rev
Author:   afriggeri
Date:     2007-07-22 11:12:31 -0700 (Sun, 22 Jul 2007)

Log Message:
-----------
debut de tabs

Modified Paths:
--------------
    trunk/Makefile

Added Paths:
-----------
    trunk/layout.ml
    trunk/printer.ml

Removed Paths:
-------------
    trunk/src/

Modified: trunk/Makefile
===================================================================
--- trunk/Makefile	2007-07-22 17:22:06 UTC (rev 1)
+++ trunk/Makefile	2007-07-22 18:12:31 UTC (rev 2)
@@ -1,5 +1,5 @@
 RESULT = test
-SOURCES = src/layout.ml src/printer.ml
+SOURCES = layout.ml printer.ml
 
 PACKS = graphics
 

Added: trunk/layout.ml
===================================================================
--- trunk/layout.ml	                        (rev 0)
+++ trunk/layout.ml	2007-07-22 18:12:31 UTC (rev 2)
@@ -0,0 +1,250 @@
+let debug = print_endline
+type dir = H | V | N
+
+type window = {
+  name:string
+}
+
+type 'a ziplist = 'a list * 'a list
+
+type 'a node = 
+  {
+    id:int list;
+    split:dir;
+    mutable is_splitted:bool;
+    mutable item:'a ziplist; 
+    mutable x:int;
+    mutable y:int;
+    mutable width:int;
+    mutable height:int;
+    mutable up:'a node list;
+    mutable down:'a node list;
+    mutable left:'a node list;
+    mutable right:'a node list
+}
+
+type 'a graph = 
+  (int list, 'a node) Hashtbl.t
+
+let common_edge s n1 n2 = 
+  match s with
+    V -> 
+      (min (n1.x + n1.width) (n2.x + n2.width)) - (max n1.x n2.x)
+  | H ->
+      (min (n1.y + n1.height) (n2.y + n2.height)) - (max n1.y n2.y)
+  | N -> 0
+let compare_nodes common s n n' = 
+  compare (common_edge s common n')(common_edge s common n) 
+let update_neigh n = 
+  List.iter ( fun neigh -> neigh.right <- List.sort (compare_nodes neigh H) (n::neigh.right)) n.left;
+  List.iter ( fun neigh -> neigh.left <- List.sort (compare_nodes neigh H) (n::neigh.left)) n.right;
+  List.iter ( fun neigh -> neigh.up <- List.sort (compare_nodes neigh V) (n::neigh.up)) n.down;
+  List.iter ( fun neigh -> neigh.down <- List.sort (compare_nodes neigh V) (n::neigh.down)) n.up
+
+let delete_neigh n =
+  let rec delete n = function
+    [] -> []
+    | t::q -> if t == n then delete n q else t::(delete n q)
+  in
+  List.iter (fun neigh -> neigh.right <- delete n neigh.right) n.left;
+  List.iter (fun neigh -> neigh.left <- delete n neigh.left) n.right;
+  List.iter (fun neigh -> neigh.up <- delete n neigh.up) n.down;
+  List.iter (fun neigh -> neigh.down <- delete n neigh.down) n.up
+
+let split g d n = 
+  let rec neighbours n s = function
+    []   -> []
+    | t::q -> 
+        if common_edge s n t > 0 then 
+          t::(neighbours n s q) 
+    else 
+      (neighbours n s q)
+  in
+  (* top zone *)
+  let n1 = 
+    {
+      id=0::n.id;
+      split=d;
+      is_splitted=false;
+      item=n.item;
+      x=0;
+      y=0;
+      width=0;
+      height=0;
+      up=[];
+      down=[];
+      left=[];
+      right=[]
+    }
+  and n2 = 
+    {
+      id=1::n.id;
+      split=d;
+      is_splitted=false;
+      item=[],[];
+      x=0;
+      y=0;
+      width=0;
+      height=0;
+      up=[];
+      down=[];
+      left=[];
+      right=[]
+    }
+  in
+  Hashtbl.add g (n1.id) n1;
+  Hashtbl.add g (n2.id) n2;
+  begin
+    match d with
+    H ->
+      begin
+        n1.width <- n.width;
+        n1.height <- (n.height+1)/2;
+        n1.x <- n.x;
+        n1.y <- n.y;
+        n2.width <- n.width;
+        n2.height <- n.height/2;
+        n2.x <- n.x;
+        n2.y <- n.y + n1.height;
+
+        n1.up <- n.up;
+        n2.up <- [n1];
+
+        n1.down <- [n2];
+        n2.down <- n.down;
+
+        n1.left <- List.sort (compare_nodes n1 H) (neighbours n1 H n.left);
+        n2.left <- List.sort (compare_nodes n2 H) (neighbours n2 H n.left);
+        n1.right <- List.sort (compare_nodes n1 H) (neighbours n1 H n.right);
+        n2.right <- List.sort (compare_nodes n2 H) (neighbours n2 H n.right);
+
+      end
+  | V ->
+      begin
+        n1.width <- (n.width+1)/2;
+        n1.height <- n.height;
+        n1.x <- n.x;
+        n1.y <- n.y;
+        n2.width <- n.width/2;
+        n2.height <- n.height;
+        n2.x <- n.x + n1.width;
+        n2.y <- n.y;
+
+        n1.left <- n.left;
+        n2.left <- [n1];
+
+        n1.right <- [n2];
+        n2.right <- n.right;
+
+        n1.up <- List.sort (compare_nodes n1 V) (neighbours n1 V n.up);
+        n2.up <- List.sort (compare_nodes n2 V) (neighbours n2 V n.up);
+        n1.down <- List.sort (compare_nodes n1 V) (neighbours n1 V n.down);
+        n2.down <- List.sort (compare_nodes n2 V) (neighbours n2 V n.down);
+
+      end;
+   | N -> ()
+  end;
+  update_neigh n2;
+  update_neigh n1;
+  n.is_splitted <- true;
+  delete_neigh n;
+  n1
+
+let rec merge g n =
+  let double i = abs (1-i) in
+  let unique l =
+    let rec unique fait = function
+      [] -> []
+    | t::q -> if List.mem t fait then unique fait q else unique (t::fait) q
+    in
+    unique [] l
+  in
+  match n.id with
+    [] -> n
+  | t::q -> 
+      begin
+        let n' = Hashtbl.find g ((double t)::q) in
+        if n'.is_splitted then
+          ignore (merge g (Hashtbl.find g (0::(double t)::q)));
+        let parent = Hashtbl.find g q in
+        parent.x <- min n.x n'.x;
+        parent.y <- min n.y n'.y;
+        begin
+          match n.split with
+            V ->
+              begin
+                parent.width <- n.width + n'.width;
+                parent.height <- n.height;
+              end
+          | H -> 
+              begin
+                parent.width <- n.width;
+                parent.height <- n.height + n'.height;
+              end
+          | N -> ()
+        end;
+        parent.up <- List.sort (compare_nodes parent V) (unique (n.up@n'.up));
+        parent.down <- List.sort (compare_nodes parent V) (unique (n.down@n'.down));
+        parent.left <- List.sort (compare_nodes parent V) (unique (n.left@n'.left));
+        parent.right <- List.sort (compare_nodes parent V) (unique (n.right@n'.right));
+        let (b,a) = n.item and (b',a') = n'.item in
+        parent.item <- (b, a@(List.rev b')@a);
+        update_neigh parent;
+        delete_neigh n;
+        delete_neigh n';
+        Hashtbl.remove g (t::q);
+        Hashtbl.remove g ((double t)::q);
+        parent.is_splitted <- false;
+        parent
+      end
+
+
+
+
+let go_down n = match n.down with
+   [] -> n
+  |t::q -> t
+
+let go_up n = match n.up with
+   [] -> n
+  |t::q -> t
+
+let go_left n = match n.left with
+   [] -> n
+  |t::q -> t
+
+let go_right n = match n.right with
+   [] -> n
+  |t::q -> t
+
+let newtab n =
+  let (b,a) = n.item in
+  n.item <- (b,""::a)
+
+let nextab n =
+  match n.item with
+    b, [] -> ()
+  | b,t::[] -> n.item <- ([], List.rev (t::b))
+  | b, t::a -> n.item <- (t::b, a)
+
+let create w h = 
+  let g = Hashtbl.create 251 in
+  let n0 = 
+  {
+    id=[]; 
+    split=N; 
+    is_splitted=false;
+    item=([],[]); 
+    x=0; 
+    y=0; 
+    width=w;
+    height=h;
+    up=[];
+    down=[];
+    left=[];
+    right=[]
+  }
+  in
+  Hashtbl.add g [] n0;
+  (n0, g)
+

Added: trunk/printer.ml
===================================================================
--- trunk/printer.ml	                        (rev 0)
+++ trunk/printer.ml	2007-07-22 18:12:31 UTC (rev 2)
@@ -0,0 +1,66 @@
+let _ = 
+  Graphics.open_graph ""
+  
+let sizex= Graphics.size_x () and sizey = Graphics.size_y ()
+
+let rectangle x y w h color = 
+  let realx = x and realy = sizey - y - h in
+  Graphics.set_color color;
+  Graphics.draw_rect realx realy (w-1) (h-1)
+
+let frectangle x y w h color color2 = 
+  let realx = x and realy = sizey - y - h in
+  Graphics.set_color color;
+  Graphics.fill_rect realx realy (w-1) (h-1);
+  Graphics.set_color color2;
+  Graphics.draw_rect realx realy (w-1) (h-1)
+
+let print_tabs n focused = 
+  let (b,a) = n.Layout.item in
+  let nb = (List.length b + List.length a) in
+  let height = 20 in
+  if nb <> 0 then
+    begin
+      let width = n.Layout.width / nb in
+      let nextx = List.fold_left (fun xstart tab ->
+        frectangle xstart n.Layout.y width height Graphics.green (if focused then Graphics.red else Graphics.blue);
+        xstart+width) n.Layout.x b in
+      match a with
+        [] -> ()
+      | t::q -> 
+          begin
+            frectangle nextx n.Layout.y width height Graphics.yellow (if focused then Graphics.red else Graphics.blue);
+            ignore(List.fold_left (fun xstart tab ->
+              frectangle xstart n.Layout.y width height Graphics.green (if focused then Graphics.red else Graphics.blue);
+              xstart+width) (nextx+width) q)
+          end
+    end
+
+let print_focus n =
+  rectangle n.Layout.x n.Layout.y n.Layout.width n.Layout.height Graphics.red;
+  print_tabs n true
+
+let print focus g = 
+  Graphics.clear_graph ();
+  Hashtbl.iter (fun id n -> print_tabs n false; rectangle n.Layout.x n.Layout.y n.Layout.width n.Layout.height Graphics.blue) g;
+  print_focus focus
+
+let _ = 
+  let (focused,g) = Layout.create sizex sizey in
+  let foc = ref focused in
+  while true do
+    print !foc g;
+    let c = Graphics.read_key () in
+    match c with
+      'q' -> exit 0
+    | 'h' -> foc := Layout.go_left !foc 
+    | 'j' -> foc := Layout.go_down !foc 
+    | 'k' -> foc := Layout.go_up !foc 
+    | 'l' -> foc := Layout.go_right !foc 
+    | 'm' -> foc := Layout.merge g !foc
+    | 's' -> foc := Layout.split g Layout.H !foc
+    | 'v' -> foc := Layout.split g Layout.V !foc
+    | 'c' -> Layout.newtab !foc
+    | 'n' -> Layout.nextab !foc
+    | _ -> ()
+  done


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.