[Toss-devel-svn] SF.net SVN: toss:[1727] trunk/Toss/Client
Status: Beta
Brought to you by:
lukaszkaiser
Menu
▾
▴
[Toss-devel-svn] SF.net SVN: toss:[1727] trunk/Toss/Client
|
From: <luk...@us...> - 2012-06-17 23:30:48
|
Revision: 1727
http://toss.svn.sourceforge.net/toss/?rev=1727&view=rev
Author: lukaszkaiser
Date: 2012-06-17 23:30:42 +0000 (Sun, 17 Jun 2012)
Log Message:
-----------
Drawing using HTML canvas in formula evaluator.
Modified Paths:
--------------
trunk/Toss/Client/JsEval.ml
trunk/Toss/Client/Style.css
trunk/Toss/Client/eval.html
Added Paths:
-----------
trunk/Toss/Client/Drawing.ml
Added: trunk/Toss/Client/Drawing.ml
===================================================================
--- trunk/Toss/Client/Drawing.ml (rev 0)
+++ trunk/Toss/Client/Drawing.ml 2012-06-17 23:30:42 UTC (rev 1727)
@@ -0,0 +1,98 @@
+(* Drawing structures, with compilation to HTML5 canvas through JS. *)
+
+type point = { x : float; y : float }
+
+(* Operations on points. *)
+let add_points p1 p2 = { x = p1.x +. p2.x ; y = p1.y +. p2.y }
+let sub_points p1 p2 = { x = p1.x -. p2.x ; y = p1.y -. p2.y }
+let mul_points p1 p2 = { x = p1.x *. p2.x ; y = p1.y *. p2.y }
+let div_points p1 p2 = { x = p1.x /. p2.x ; y = p1.y /. p2.y }
+let ( +: ) = add_points
+let ( -: ) = sub_points
+let ( *: ) = mul_points
+let ( /: ) = div_points
+let sc_add_point p s = { x = p.x +. s ; y = p.y +. s }
+let sc_sub_point p s = { x = p.x -. s ; y = p.y -. s }
+let sc_mul_point p s = { x = p.x *. s ; y = p.y *. s }
+let sc_div_point p s = { x = p.x /. s ; y = p.y /. s }
+let ( +! ) = sc_add_point
+let ( -! ) = sc_sub_point
+let ( *! ) = sc_mul_point
+let ( /! ) = sc_div_point
+
+
+(* Change coordinates from one system to another (given mid-point and size). *)
+let change_coords (m1, s1) (m2, s2) p = (((p -: m1) /: s1) *: s2) +: m2
+
+(* Distance between two points. *)
+let dist p1 p2 = ((p1.x -. p2.x) ** 2. +. (p1.y -. p2.y) ** 2.) ** 0.5
+
+(* Rotate the point [p] around [start] by [angle]. *)
+let rotate start angle p =
+ let q, a = p -: start, (angle /. 45.) *. (atan 1.0) in
+ let sina, cosa = sin a, cos a in
+ { x = q.x *. cosa -. q.y *. sina ; y = q.x *. sina +. q.y *. cosa } +: start
+
+
+(* Various shapes. *)
+type shapes =
+ | Circle of point * float (* circle, given middle and radius *)
+ | Rectangle of point * point (* rectangle, given middle and width-height *)
+ | Line of point * point (* line, given from and to *)
+
+(* Create an arrow from x to y assuming circle of radius [rad] *)
+let arrow rad x y =
+ let len = dist x y in
+ if len < 0.1 then [] else
+ let d = (y -: x) *! (rad /. len) in
+ let q, p = x +: d, y -: d in
+ let arr = p -: (d *! 0.5) in
+ [ Line (q, p); Line (p, rotate p 30. arr); Line (p, rotate p (-30.) arr) ]
+
+(* Draw the structure [struc] as a sequence of shapes.
+ The first four parameters are the width, height and margins of canvas,
+ the third and fourth one are min and max of structure coordinates. *)
+let draw_struc cwidth cheight cmarginx cmarginy minp maxp struc =
+ let elems = Structure.elements struc in
+ let rad = (* radius for elements *)
+ min 45. (max 5. (450. /. float (List.length elems))) in
+ let get_pos e = (* Canvas positions count "from up" on y, thus -1. *)
+ (Structure.fun_val struc "x" e, -1. *. Structure.fun_val struc "y" e) in
+ let positions = List.map get_pos elems in
+ let minp = match minp with Some p -> p | None ->
+ let (posx, posy) = List.split positions in
+ { x = List.fold_left min (List.hd posx) posx;
+ y = List.fold_left min (List.hd posy) posy } in
+ let maxp = match maxp with Some p -> p | None ->
+ let (posx, posy) = List.split positions in
+ { x = List.fold_left max (List.hd posx) posx;
+ y = List.fold_left max (List.hd posy) posy } in
+ let diffp = { x= max (maxp.x -. minp.x) 1.; y= max (maxp.y -. minp.y) 1. } in
+ let coordC = ({ x= cwidth/.2. +. cmarginx; y= cheight/.2. +. cmarginy},
+ { x= cwidth; y= cheight }) in
+ let coordS = ((maxp +: minp) /: {x = 2.; y = 2.}, diffp) in
+ let circ (x, y) = Circle (change_coords coordS coordC {x=x; y=y}, rad) in
+ let elem_drawings = List.map circ positions in
+ (* drawing relations *)
+ let pos e = let (x,y) = get_pos e in change_coords coordS coordC {x=x; y=y} in
+ let draw_rel (rel, arity) =
+ if arity = 2 then
+ let tuples = Structure.Tuples.elements (Structure.rel_graph rel struc) in
+ Aux.concat_map (fun a -> arrow rad (pos a.(0)) (pos a.(1))) tuples
+ else [] in
+ elem_drawings @ (Aux.concat_map draw_rel (Structure.rel_signature struc))
+
+(* Compile the shape to a JavaScript program drawing the shape on 'ctx'. *)
+let shape_to_canvas = function
+ | Circle (p, r) ->
+ let s = Printf.sprintf "ctx.arc(%F,%F,%F,0,2*Math.PI,false); " p.x p.y r in
+ "ctx.beginPath(); " ^ s ^ "ctx.fill(); ctx.stroke(); "
+ | Rectangle (m, wh) ->
+ Printf.sprintf "ctx.fillRect(%F,%F,%F,%F); " m.x m.y wh.x wh.y
+ | Line (f, t) ->
+ let fs = Printf.sprintf "ctx.moveTo(%F,%F); " f.x f.y in
+ let ts = Printf.sprintf "ctx.lineTo(%F,%F); " t.x t.y in
+ "ctx.beginPath(); " ^ fs ^ ts ^ "ctx.stroke(); "
+
+let shapes_to_canvas l =
+ Js.string (String.concat " " (List.rev (List.rev_map shape_to_canvas l)))
Modified: trunk/Toss/Client/JsEval.ml
===================================================================
--- trunk/Toss/Client/JsEval.ml 2012-06-16 17:01:17 UTC (rev 1726)
+++ trunk/Toss/Client/JsEval.ml 2012-06-17 23:30:42 UTC (rev 1727)
@@ -25,47 +25,6 @@
(* --- Main part: communication with JS and evaluation --- *)
-(* Translate a structure into an "info_obj" format used by State.js. *)
-let js_of_struc struc =
- let elems = Structure.elements struc in
- LOG 0 "js_of_struc: preparing structure elements...";
- let get_pos e = Structure.fun_val struc "x" e,Structure.fun_val struc "y" e in
- let minx, maxx, miny, maxy =
- let (posx, posy) = List.split (List.map get_pos elems) in
- let mkfl f l = List.fold_left f (List.hd l) (List.tl l) in
- let (minl, maxl, suml) = (mkfl min, mkfl max, mkfl (+.)) in
- minl posx, maxl posx, minl posy, maxl posy in
- (* elems in JS are arrays of element name and position *)
- let elems = Array.of_list (List.map (fun e ->
- let e0 = Js.string (Structure.elem_name struc e) in
- let x, y = get_pos e in
- Js.array [|js_any e0; js_any (Js.float x); js_any (Js.float y)|]
- ) elems) in
- (* rels in JS are arrays of element names, with additional "name" field *)
- let num = Js.number_of_float in
- LOG 0 "js_of_struc: preparing relations...";
- let rels_all =
- (Aux.concat_map
- (fun (rel, _) ->
- let tups = Structure.Tuples.elements
- (Structure.rel_graph rel struc) in
- let tups = List.map
- (fun args -> Js.array
- (Array.map (fun e-> Js.string (Structure.elem_name struc e)) args))
- tups in
- List.map (fun args -> (args, Js.string rel)) tups)
- (Structure.rel_signature struc)) in
- let rels, rel_names = List.split rels_all in
- let info_obj = jsnew js_object () in
- let js = Js.string in
- Js.Unsafe.set info_obj (js"maxx") (num maxx);
- Js.Unsafe.set info_obj (js"minx") (num minx);
- Js.Unsafe.set info_obj (js"maxy") (num maxy);
- Js.Unsafe.set info_obj (js"miny") (num miny);
- Js.Unsafe.set info_obj (js"elems") (Js.array elems);
- Js.Unsafe.set info_obj (js"rels") (Js.array (Array.of_list rels));
- Js.Unsafe.set info_obj (js"rel_names") (Js.array (Array.of_list rel_names));
- info_obj
(* Parse a formula. *)
let formula_of_string s = FormulaParser.parse_formula Lexer.lex
@@ -78,12 +37,12 @@
| Arena.StartStruc struc -> struc
| _ -> failwith "not a structure"
-(* Parse a structure from a JS string and return in "info_obj" format. *)
-let info_obj_of_string s = js_of_struc (structure_of_string (Js.to_string s))
+let draw_struc_js struc_s =
+ let st = structure_of_string (Js.to_string struc_s) in
+ Drawing.shapes_to_canvas (Drawing.draw_struc 1000. 1000. 50. 50. None None st)
-let _ = set_handle "info_obj" info_obj_of_string
+let _ = set_handle "draw_struc" draw_struc_js
-
(* The Formula evaluation and registration in JS. *)
let js_eval phi struc =
let (phi, struc) = (Js.to_string phi, Js.to_string struc) in
Modified: trunk/Toss/Client/Style.css
===================================================================
--- trunk/Toss/Client/Style.css 2012-06-16 17:01:17 UTC (rev 1726)
+++ trunk/Toss/Client/Style.css 2012-06-17 23:30:42 UTC (rev 1727)
@@ -999,6 +999,11 @@
border: 1px solid #260314;
}
+#canvas {
+ width: 30em;
+ height: 30em;
+ border: 2px solid #260314;
+}
/* SVG styling */
#svg {
Modified: trunk/Toss/Client/eval.html
===================================================================
--- trunk/Toss/Client/eval.html 2012-06-16 17:01:17 UTC (rev 1726)
+++ trunk/Toss/Client/eval.html 2012-06-17 23:30:42 UTC (rev 1727)
@@ -1,5 +1,5 @@
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml" xmlns:svg="http://www.w3.org/2000/svg" xml:lang="en" lang="en">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<meta http-equiv="Content-Type" content="text/xhtml+xml; charset=UTF-8" />
<title>Toss Formula Evaluator</title>
@@ -7,7 +7,6 @@
<meta http-equiv="X-UA-Compatible" content="chrome=1" />
<link rel="icon" type="image/vnd.microsoft.icon" href="favicon.ico" />
<link rel="stylesheet" type="text/css" href="Style.css" media="screen" title="Default"/>
- <script type="text/javascript" src="State.js"> </script>
<script type="text/javascript">
<!--
var worker = new Worker ("JsEval.js");
@@ -29,12 +28,20 @@
console.log ("[ASYNCH] " + action_name + " (" + action_args + ")");
}
-function eval () {
+function eval_it () {
var phi = document.getElementById ("formula").value;
var struc = document.getElementById ("structure").value;
- ASYNCH ("info_obj", [struc], function (obj) {
- var struc = new State ("nogame", obj, 0);
- struc.draw_model ("nogame");
+ ASYNCH ("draw_struc", [struc], function (s) {
+ canvas = document.getElementById("canvas");
+ ctx = canvas.getContext("2d");
+ ctx.setTransform(1, 0, 0, 1, 0, 0);
+ ctx.clearRect(0, 0, canvas.width, canvas.height);
+ ctx.fillStyle = "#ffe4aa";
+ ctx.strokeStyle = "#260314";
+ ctx.lineWidth = 5;
+ ctx.lineCap = "round";
+ ctx.lineJoin = "round";
+ eval(s);
})
document.getElementById ("result").innerHTML = "Evaluating...";
ASYNCH ("eval", [phi, struc], function (resp) {
@@ -49,7 +56,7 @@
document.getElementById ("formula").value = "P(x)";
document.getElementById ("structure").value = "[ 1 - 10 | | - ] with " +
"\nP(z) = &z > 1 and all x, y \n (&x * &y = &z -> (&x = 1 or &y = 1))";
- eval ();
+ eval_it ();
}
function example_tc () {
@@ -58,7 +65,7 @@
"[ 1 - 3 | | - ] with " +
"\nE(x, y) = &y = &x + 1;" +
"\nS(x, y) = x != y and tc x, y E(x, y)";
- eval ();
+ eval_it ();
}
function example_3col () {
@@ -70,7 +77,7 @@
"[ | E { (a, b); (b, c); (c, a) } | " +
"\n x { a -> 1, b -> 2, c -> 3 }; " +
"\n y { a -> 0, b -> -1, c -> 0 } ]";
- eval ();
+ eval_it ();
}
//-->
</script>
@@ -93,11 +100,11 @@
E(x, y)</textarea>
<textarea id="structure" rows="3" cols="40">
-[ 1 - 5 | | - ] with
-E(x, y) = &x = &y + 1
-with :y(a) = -10 * &a</textarea>
+[ 1 - 15 | | - ] with
+E(x, y) = &y = &x + 1
+with :y(a) = 10 * &a * (10 - &a)</textarea>
-<button onclick="eval()">Eval and Draw</button>
+<button onclick="eval_it()">Eval and Draw</button>
Examples:
@@ -109,9 +116,14 @@
<p id="result"> </p>
-<div id="board"> </div>
+<div id="board">
+<canvas id="canvas" height="1100" width="1100">
+This text is displayed if your browser does not support HTML5 Canvas.
+</canvas>
</div>
+</div>
+
<div id="bottom">
<div id="bottomright">
<a href="http://toss.sourceforge.net" id="toss-link">Contact</a>
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
