[Sahcui-svn] SF.net SVN: sahcui: [3] trunk
Status: Planning
Brought to you by:
afriggeri
Menu
▾
▴
[Sahcui-svn] SF.net SVN: sahcui: [3] trunk
|
From: <afr...@us...> - 2007-09-24 15:54:54
|
Revision: 3
http://sahcui.svn.sourceforge.net/sahcui/?rev=3&view=rev
Author: afriggeri
Date: 2007-09-24 08:52:24 -0700 (Mon, 24 Sep 2007)
Log Message:
-----------
proprification
Modified Paths:
--------------
trunk/Makefile
Removed Paths:
-------------
trunk/layout.ml
trunk/printer.ml
Modified: trunk/Makefile
===================================================================
--- trunk/Makefile 2007-07-22 18:12:31 UTC (rev 2)
+++ trunk/Makefile 2007-09-24 15:52:24 UTC (rev 3)
@@ -1,5 +1,5 @@
RESULT = test
-SOURCES = layout.ml printer.ml
+SOURCES = command.ml #layout.ml printer.ml
PACKS = graphics
Deleted: trunk/layout.ml
===================================================================
--- trunk/layout.ml 2007-07-22 18:12:31 UTC (rev 2)
+++ trunk/layout.ml 2007-09-24 15:52:24 UTC (rev 3)
@@ -1,250 +0,0 @@
-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)
-
Deleted: trunk/printer.ml
===================================================================
--- trunk/printer.ml 2007-07-22 18:12:31 UTC (rev 2)
+++ trunk/printer.ml 2007-09-24 15:52:24 UTC (rev 3)
@@ -1,66 +0,0 @@
-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.
|