<\/div>'; +} + + +function mkDivIe(x, y, w, h) +{ + this.htm += '%%'+this.color+';'+x+';'+y+';'+w+';'+h+';'; +} + + +function mkDivPrt(x, y, w, h) +{ + this.htm += '

<\/div>'; +} + + +function mkLyr(x, y, w, h) +{ + this.htm += '<\/layer>\n'; +} + + +var regex = /%%([^;]+);([^;]+);([^;]+);([^;]+);([^;]+);/g; +function htmRpc() +{ + return this.htm.replace( + regex, + '

\n'); +} + + +function htmPrtRpc() +{ + return this.htm.replace( + regex, + '

\n'); +} + + +function mkLin(x1, y1, x2, y2) +{ + if (x1 > x2) + { + var _x2 = x2; + var _y2 = y2; + x2 = x1; + y2 = y1; + x1 = _x2; + y1 = _y2; + } + var dx = x2-x1, dy = Math.abs(y2-y1), + x = x1, y = y1, + yIncr = (y1 > y2)? -1 : 1; + + if (dx >= dy) + { + var pr = dy<<1, + pru = pr - (dx<<1), + p = pr-dx, + ox = x; + while ((dx--) > 0) + { + ++x; + if (p > 0) + { + this.mkDiv(ox, y, x-ox, 1); + y += yIncr; + p += pru; + ox = x; + } + else p += pr; + } + this.mkDiv(ox, y, x2-ox+1, 1); + } + + else + { + var pr = dx<<1, + pru = pr - (dy<<1), + p = pr-dy, + oy = y; + if (y2 <= y1) + { + while ((dy--) > 0) + { + if (p > 0) + { + this.mkDiv(x++, y, 1, oy-y+1); + y += yIncr; + p += pru; + oy = y; + } + else + { + y += yIncr; + p += pr; + } + } + this.mkDiv(x2, y2, 1, oy-y2+1); + } + else + { + while ((dy--) > 0) + { + y += yIncr; + if (p > 0) + { + this.mkDiv(x++, oy, 1, y-oy); + p += pru; + oy = y; + } + else p += pr; + } + this.mkDiv(x2, oy, 1, y2-oy+1); + } + } +} + + +function mkLin2D(x1, y1, x2, y2) +{ + if (x1 > x2) + { + var _x2 = x2; + var _y2 = y2; + x2 = x1; + y2 = y1; + x1 = _x2; + y1 = _y2; + } + var dx = x2-x1, dy = Math.abs(y2-y1), + x = x1, y = y1, + yIncr = (y1 > y2)? -1 : 1; + + var s = this.stroke; + if (dx >= dy) + { + if (s-3 > 0) + { + var _s = (s*dx*Math.sqrt(1+dy*dy/(dx*dx))-dx-(s>>1)*dy) / dx; + _s = (!(s-4)? Math.ceil(_s) : Math.round(_s)) + 1; + } + else var _s = s; + var ad = Math.ceil(s/2); + + var pr = dy<<1, + pru = pr - (dx<<1), + p = pr-dx, + ox = x; + while ((dx--) > 0) + { + ++x; + if (p > 0) + { + this.mkDiv(ox, y, x-ox+ad, _s); + y += yIncr; + p += pru; + ox = x; + } + else p += pr; + } + this.mkDiv(ox, y, x2-ox+ad+1, _s); + } + + else + { + if (s-3 > 0) + { + var _s = (s*dy*Math.sqrt(1+dx*dx/(dy*dy))-(s>>1)*dx-dy) / dy; + _s = (!(s-4)? Math.ceil(_s) : Math.round(_s)) + 1; + } + else var _s = s; + var ad = Math.round(s/2); + + var pr = dx<<1, + pru = pr - (dy<<1), + p = pr-dy, + oy = y; + if (y2 <= y1) + { + ++ad; + while ((dy--) > 0) + { + if (p > 0) + { + this.mkDiv(x++, y, _s, oy-y+ad); + y += yIncr; + p += pru; + oy = y; + } + else + { + y += yIncr; + p += pr; + } + } + this.mkDiv(x2, y2, _s, oy-y2+ad); + } + else + { + while ((dy--) > 0) + { + y += yIncr; + if (p > 0) + { + this.mkDiv(x++, oy, _s, y-oy+ad); + p += pru; + oy = y; + } + else p += pr; + } + this.mkDiv(x2, oy, _s, y2-oy+ad+1); + } + } +} + + +function mkLinDott(x1, y1, x2, y2) +{ + if (x1 > x2) + { + var _x2 = x2; + var _y2 = y2; + x2 = x1; + y2 = y1; + x1 = _x2; + y1 = _y2; + } + var dx = x2-x1, dy = Math.abs(y2-y1), + x = x1, y = y1, + yIncr = (y1 > y2)? -1 : 1, + drw = true; + if (dx >= dy) + { + var pr = dy<<1, + pru = pr - (dx<<1), + p = pr-dx; + while ((dx--) > 0) + { + if (drw) this.mkDiv(x, y, 1, 1); + drw = !drw; + if (p > 0) + { + y += yIncr; + p += pru; + } + else p += pr; + ++x; + } + if (drw) this.mkDiv(x, y, 1, 1); + } + + else + { + var pr = dx<<1, + pru = pr - (dy<<1), + p = pr-dy; + while ((dy--) > 0) + { + if (drw) this.mkDiv(x, y, 1, 1); + drw = !drw; + y += yIncr; + if (p > 0) + { + ++x; + p += pru; + } + else p += pr; + } + if (drw) this.mkDiv(x, y, 1, 1); + } +} + + +function mkOv(left, top, width, height) +{ + var a = width>>1, b = height>>1, + wod = width&1, hod = (height&1)+1, + cx = left+a, cy = top+b, + x = 0, y = b, + ox = 0, oy = b, + aa = (a*a)<<1, bb = (b*b)<<1, + st = (aa>>1)*(1-(b<<1)) + bb, + tt = (bb>>1) - aa*((b<<1)-1), + w, h; + while (y > 0) + { + if (st < 0) + { + st += bb*((x<<1)+3); + tt += (bb<<1)*(++x); + } + else if (tt < 0) + { + st += bb*((x<<1)+3) - (aa<<1)*(y-1); + tt += (bb<<1)*(++x) - aa*(((y--)<<1)-3); + w = x-ox; + h = oy-y; + if (w&2 && h&2) + { + this.mkOvQds(cx, cy, -x+2, ox+wod, -oy, oy-1+hod, 1, 1); + this.mkOvQds(cx, cy, -x+1, x-1+wod, -y-1, y+hod, 1, 1); + } + else this.mkOvQds(cx, cy, -x+1, ox+wod, -oy, oy-h+hod, w, h); + ox = x; + oy = y; + } + else + { + tt -= aa*((y<<1)-3); + st -= (aa<<1)*(--y); + } + } + this.mkDiv(cx-a, cy-oy, a-ox+1, (oy<<1)+hod); + this.mkDiv(cx+ox+wod, cy-oy, a-ox+1, (oy<<1)+hod); +} + + +function mkOv2D(left, top, width, height) +{ + var s = this.stroke; + width += s-1; + height += s-1; + var a = width>>1, b = height>>1, + wod = width&1, hod = (height&1)+1, + cx = left+a, cy = top+b, + x = 0, y = b, + aa = (a*a)<<1, bb = (b*b)<<1, + st = (aa>>1)*(1-(b<<1)) + bb, + tt = (bb>>1) - aa*((b<<1)-1); + + if (s-4 < 0 && (!(s-2) || width-51 > 0 && height-51 > 0)) + { + var ox = 0, oy = b, + w, h, + pxl, pxr, pxt, pxb, pxw; + while (y > 0) + { + if (st < 0) + { + st += bb*((x<<1)+3); + tt += (bb<<1)*(++x); + } + else if (tt < 0) + { + st += bb*((x<<1)+3) - (aa<<1)*(y-1); + tt += (bb<<1)*(++x) - aa*(((y--)<<1)-3); + w = x-ox; + h = oy-y; + + if (w-1) + { + pxw = w+1+(s&1); + h = s; + } + else if (h-1) + { + pxw = s; + h += 1+(s&1); + } + else pxw = h = s; + this.mkOvQds(cx, cy, -x+1, ox-pxw+w+wod, -oy, -h+oy+hod, pxw, h); + ox = x; + oy = y; + } + else + { + tt -= aa*((y<<1)-3); + st -= (aa<<1)*(--y); + } + } + this.mkDiv(cx-a, cy-oy, s, (oy<<1)+hod); + this.mkDiv(cx+a+wod-s+1, cy-oy, s, (oy<<1)+hod); + } + + else + { + var _a = (width-((s-1)<<1))>>1, + _b = (height-((s-1)<<1))>>1, + _x = 0, _y = _b, + _aa = (_a*_a)<<1, _bb = (_b*_b)<<1, + _st = (_aa>>1)*(1-(_b<<1)) + _bb, + _tt = (_bb>>1) - _aa*((_b<<1)-1), + + pxl = new Array(), + pxt = new Array(), + _pxb = new Array(); + pxl[0] = 0; + pxt[0] = b; + _pxb[0] = _b-1; + while (y > 0) + { + if (st < 0) + { + st += bb*((x<<1)+3); + tt += (bb<<1)*(++x); + pxl[pxl.length] = x; + pxt[pxt.length] = y; + } + else if (tt < 0) + { + st += bb*((x<<1)+3) - (aa<<1)*(y-1); + tt += (bb<<1)*(++x) - aa*(((y--)<<1)-3); + pxl[pxl.length] = x; + pxt[pxt.length] = y; + } + else + { + tt -= aa*((y<<1)-3); + st -= (aa<<1)*(--y); + } + + if (_y > 0) + { + if (_st < 0) + { + _st += _bb*((_x<<1)+3); + _tt += (_bb<<1)*(++_x); + _pxb[_pxb.length] = _y-1; + } + else if (_tt < 0) + { + _st += _bb*((_x<<1)+3) - (_aa<<1)*(_y-1); + _tt += (_bb<<1)*(++_x) - _aa*(((_y--)<<1)-3); + _pxb[_pxb.length] = _y-1; + } + else + { + _tt -= _aa*((_y<<1)-3); + _st -= (_aa<<1)*(--_y); + _pxb[_pxb.length-1]--; + } + } + } + + var ox = 0, oy = b, + _oy = _pxb[0], + l = pxl.length, + w, h; + for (var i = 0; i < l; i++) + { + if (typeof _pxb[i] != "undefined") + { + if (_pxb[i] < _oy || pxt[i] < oy) + { + x = pxl[i]; + this.mkOvQds(cx, cy, -x+1, ox+wod, -oy, _oy+hod, x-ox, oy-_oy); + ox = x; + oy = pxt[i]; + _oy = _pxb[i]; + } + } + else + { + x = pxl[i]; + this.mkDiv(cx-x+1, cy-oy, 1, (oy<<1)+hod); + this.mkDiv(cx+ox+wod, cy-oy, 1, (oy<<1)+hod); + ox = x; + oy = pxt[i]; + } + } + this.mkDiv(cx-a, cy-oy, 1, (oy<<1)+hod); + this.mkDiv(cx+ox+wod, cy-oy, 1, (oy<<1)+hod); + } +} + + +function mkOvDott(left, top, width, height) +{ + var a = width>>1, b = height>>1, + wod = width&1, hod = height&1, + cx = left+a, cy = top+b, + x = 0, y = b, + aa2 = (a*a)<<1, aa4 = aa2<<1, bb = (b*b)<<1, + st = (aa2>>1)*(1-(b<<1)) + bb, + tt = (bb>>1) - aa2*((b<<1)-1), + drw = true; + while (y > 0) + { + if (st < 0) + { + st += bb*((x<<1)+3); + tt += (bb<<1)*(++x); + } + else if (tt < 0) + { + st += bb*((x<<1)+3) - aa4*(y-1); + tt += (bb<<1)*(++x) - aa2*(((y--)<<1)-3); + } + else + { + tt -= aa2*((y<<1)-3); + st -= aa4*(--y); + } + if (drw) this.mkOvQds(cx, cy, -x, x+wod, -y, y+hod, 1, 1); + drw = !drw; + } +} + + +function mkRect(x, y, w, h) +{ + var s = this.stroke; + this.mkDiv(x, y, w, s); + this.mkDiv(x+w, y, s, h); + this.mkDiv(x, y+h, w+s, s); + this.mkDiv(x, y+s, s, h-s); +} + + +function mkRectDott(x, y, w, h) +{ + this.drawLine(x, y, x+w, y); + this.drawLine(x+w, y, x+w, y+h); + this.drawLine(x, y+h, x+w, y+h); + this.drawLine(x, y, x, y+h); +} + + +function jsgFont() +{ + this.PLAIN = 'font-weight:normal;'; + this.BOLD = 'font-weight:bold;'; + this.ITALIC = 'font-style:italic;'; + this.ITALIC_BOLD = this.ITALIC + this.BOLD; + this.BOLD_ITALIC = this.ITALIC_BOLD; +} +var Font = new jsgFont(); + + +function jsgStroke() +{ + this.DOTTED = -1; +} +var Stroke = new jsgStroke(); + + +function jsGraphics(id, wnd) +{ + this.setColor = new Function('arg', 'this.color = arg.toLowerCase();'); + + this.setStroke = function(x) + { + this.stroke = x; + if (!(x+1)) + { + this.drawLine = mkLinDott; + this.mkOv = mkOvDott; + this.drawRect = mkRectDott; + } + else if (x-1 > 0) + { + this.drawLine = mkLin2D; + this.mkOv = mkOv2D; + this.drawRect = mkRect; + } + else + { + this.drawLine = mkLin; + this.mkOv = mkOv; + this.drawRect = mkRect; + } + }; + + + this.setPrintable = function(arg) + { + this.printable = arg; + if (jg_fast) + { + this.mkDiv = mkDivIe; + this.htmRpc = arg? htmPrtRpc : htmRpc; + } + else this.mkDiv = jg_n4? mkLyr : arg? mkDivPrt : mkDiv; + }; + + + this.setFont = function(fam, sz, sty) + { + this.ftFam = fam; + this.ftSz = sz; + this.ftSty = sty || Font.PLAIN; + }; + + + this.drawPolyline = this.drawPolyLine = function(x, y, s) + { + for (var i=0 ; i>1, b = (h -= 1)>>1, + wod = (w&1)+1, hod = (h&1)+1, + cx = left+a, cy = top+b, + x = 0, y = b, + ox = 0, oy = b, + aa2 = (a*a)<<1, aa4 = aa2<<1, bb = (b*b)<<1, + st = (aa2>>1)*(1-(b<<1)) + bb, + tt = (bb>>1) - aa2*((b<<1)-1), + pxl, dw, dh; + if (w+1) while (y > 0) + { + if (st < 0) + { + st += bb*((x<<1)+3); + tt += (bb<<1)*(++x); + } + else if (tt < 0) + { + st += bb*((x<<1)+3) - aa4*(y-1); + pxl = cx-x; + dw = (x<<1)+wod; + tt += (bb<<1)*(++x) - aa2*(((y--)<<1)-3); + dh = oy-y; + this.mkDiv(pxl, cy-oy, dw, dh); + this.mkDiv(pxl, cy+oy-dh+hod, dw, dh); + ox = x; + oy = y; + } + else + { + tt -= aa2*((y<<1)-3); + st -= aa4*(--y); + } + } + this.mkDiv(cx-a, cy-oy, w+1, (oy<<1)+hod); + }; + + + +/* fillPolygon method, implemented by Matthieu Haller. +This javascript function is an adaptation of the gdImageFilledPolygon for Walter Zorn lib. +C source of GD 1.8.4 found at http://www.boutell.com/gd/ + +THANKS to Kirsten Schulz for the polygon fixes! + +The intersection finding technique of this code could be improved +by remembering the previous intertersection, and by using the slope. +That could help to adjust intersections to produce a nice +interior_extrema. */ + this.fillPolygon = function(array_x, array_y) + { + var i; + var y; + var miny, maxy; + var x1, y1; + var x2, y2; + var ind1, ind2; + var ints; + + var n = array_x.length; + + if (!n) return; + + + miny = array_y[0]; + maxy = array_y[0]; + for (i = 1; i < n; i++) + { + if (array_y[i] < miny) + miny = array_y[i]; + + if (array_y[i] > maxy) + maxy = array_y[i]; + } + for (y = miny; y <= maxy; y++) + { + var polyInts = new Array(); + ints = 0; + for (i = 0; i < n; i++) + { + if (!i) + { + ind1 = n-1; + ind2 = 0; + } + else + { + ind1 = i-1; + ind2 = i; + } + y1 = array_y[ind1]; + y2 = array_y[ind2]; + if (y1 < y2) + { + x1 = array_x[ind1]; + x2 = array_x[ind2]; + } + else if (y1 > y2) + { + y2 = array_y[ind1]; + y1 = array_y[ind2]; + x2 = array_x[ind1]; + x1 = array_x[ind2]; + } + else continue; + + // modified 11. 2. 2004 Walter Zorn + if ((y >= y1) && (y < y2)) + polyInts[ints++] = Math.round((y-y1) * (x2-x1) / (y2-y1) + x1); + + else if ((y == maxy) && (y > y1) && (y <= y2)) + polyInts[ints++] = Math.round((y-y1) * (x2-x1) / (y2-y1) + x1); + } + polyInts.sort(integer_compare); + + for (i = 0; i < ints; i+=2) + { + w = polyInts[i+1]-polyInts[i] + this.mkDiv(polyInts[i], y, polyInts[i+1]-polyInts[i]+1, 1); + } + } + }; + + + this.drawString = function(txt, x, y) + { + this.htm += '

'+ + txt + + '<\/div>'; + } + + + this.drawImage = function(imgSrc, x, y, w, h) + { + this.htm += '

'+ + '

'+ + '<\/div>'; + } + + + this.clear = function() + { + this.htm = ""; + if (this.cnv) this.cnv.innerHTML = this.defhtm; + }; + + + this.mkOvQds = function(cx, cy, xl, xr, yt, yb, w, h) + { + this.mkDiv(xr+cx, yt+cy, w, h); + this.mkDiv(xr+cx, yb+cy, w, h); + this.mkDiv(xl+cx, yb+cy, w, h); + this.mkDiv(xl+cx, yt+cy, w, h); + }; + + this.setStroke(1); + this.setFont('verdana,geneva,helvetica,sans-serif', String.fromCharCode(0x31, 0x32, 0x70, 0x78), Font.PLAIN); + this.color = '#000000'; + this.htm = ''; + this.wnd = wnd || window; + + if (!(jg_ie || jg_dom || jg_ihtm)) chkDHTM(); + if (typeof id != 'string' || !id) this.paint = pntDoc; + else + { + this.cnv = document.all? (this.wnd.document.all[id] || null) + : document.getElementById? (this.wnd.document.getElementById(id) || null) + : null; + this.defhtm = (this.cnv && this.cnv.innerHTML)? this.cnv.innerHTML : ''; + this.paint = jg_dom? pntCnvDom : jg_ie? pntCnvIe : jg_ihtm? pntCnvIhtm : pntCnv; + } + + this.setPrintable(false); +} + + + +function integer_compare(x,y) +{ + return (x < y) ? -1 : ((x > y)*1); +} + diff --git a/scripts/.depend b/scripts/.depend index 52b42f7..f4503cf 100644 --- a/scripts/.depend +++ b/scripts/.depend @@ -216,6 +216,8 @@ upload_image_form.cmo: cocanwiki.cmo cocanwiki_template.cmi upload_image_form.cmx: cocanwiki.cmx cocanwiki_template.cmx users.cmo: cocanwiki.cmo cocanwiki_date.cmo cocanwiki_template.cmi users.cmx: cocanwiki.cmx cocanwiki_date.cmx cocanwiki_template.cmx +visualise_links.cmo: cocanwiki.cmo cocanwiki_files.cmo cocanwiki_template.cmi +visualise_links.cmx: cocanwiki.cmx cocanwiki_files.cmx cocanwiki_template.cmx what_links_here.cmo: cocanwiki.cmo cocanwiki_template.cmi what_links_here.cmx: cocanwiki.cmx cocanwiki_template.cmx wikilib.cmo: cocanwiki_strings.cmo wikilib.cmi diff --git a/scripts/Makefile b/scripts/Makefile index c4c23a5..1008ebf 100644 --- a/scripts/Makefile +++ b/scripts/Makefile @@ -1,5 +1,5 @@ # Makefile for COCANWIKI. -# $Id: Makefile,v 1.30 2004/09/28 11:51:38 rich Exp $ +# $Id: Makefile,v 1.31 2004/09/29 09:44:52 rich Exp $ include ../Makefile.config @@ -107,6 +107,9 @@ OBJS := change_password.cmo \ users.cmo \ what_links_here.cmo +# Not working: +# visualise_links.cmo + ADMIN_OBJS := \ admin/admin.cmo \ admin/create_host.cmo \ diff --git a/scripts/visualise_links.ml b/scripts/visualise_links.ml new file mode 100644 index 0000000..fe5de8d --- /dev/null +++ b/scripts/visualise_links.ml @@ -0,0 +1,205 @@ +(* COCANWIKI - a wiki written in Objective CAML. + * Written by Richard W.M. Jones . + * Copyright (C) 2004 Merjis Ltd. + * $Id: visualise_links.ml,v 1.1 2004/09/29 09:44:52 rich Exp $ + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place - Suite 330, + * Boston, MA 02111-1307, USA. + *) + +open Apache +open Registry +open Cgi +open Printf + +open ExtList + +open Cocanwiki +open Cocanwiki_template +open Cocanwiki_files + +let rec takepairs = function + | [] -> [] + | [x] -> invalid_arg "takepairs: odd number of elements in list" + | x :: y :: xs -> (x, y) :: takepairs xs + +let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = + let template = get_template dbh hostid "visualise_links.html" in + + (* This function generates a layout using the 'dot' program, part of + * GraphViz. + *) + let gv_layout () = + let sth = dbh#prepare_cached "select from_url, to_url from links + where hostid = ?" in + sth#execute [`Int hostid]; + + let edges = sth#map (function [`String from_url; `String to_url] -> + from_url, to_url + | _ -> assert false) in + + let dotfile = + String.concat "" + ([ "digraph t {\n"; + " fill=\"auto\";\n"; + " center=1;\n"; ] @ + (List.map (fun (node1, node2) -> + sprintf " \"%s\" -> \"%s\";\n" node1 node2) + edges) @ + [ "}\n" ]) in + + let filename = output_tempfile dotfile in + let cmd = sprintf "dot -Tplain %s" filename in + + let lines = pget cmd in + unlink filename; + + (* For documentation of the output format of 'dot -Tplain', please see: + * http://www.research.att.com/%7Eerg/graphviz/info/output.html#d:plain + *) + (* Split each line up into fields. Unfortunately some fields are + * quoted (if they contain spaces or other special characters) so we + * have to deal with that. + *) + let split line = + let n = String.length line in + let rec skip_spaces i = + if i < n && line.[i] = ' ' then skip_spaces (i+1) else i + in + let rec find i c = + if i >= n then -1 + else if line.[i] = c then i + else find (i+1) c + in + let rec loop i acc = + if i >= n then acc + else ( + let c = line.[i] in + if c = '"' then ( (* quoted field *) + let j = find (i+1) '"' in + let field, i = + if i < j then String.sub line i (j-i), skip_spaces (j+1) + else String.sub line i (n-i), n in + loop i (field :: acc) + ) else ( (* ordinary field *) + let j = find (i+1) ' ' in + let field, i = + if i < j then String.sub line i (j-i), skip_spaces j + else String.sub line i (n-i), n in + loop i (field :: acc) + ) + ) + in + List.rev (loop 0 []) + in + let lines = List.map split lines in + + (* First line is 'graph'. *) + let graph_line, lines = List.hd lines, List.tl lines in + let width, height = + match graph_line with + [ "graph"; _; width; height ] -> + float_of_string width, float_of_string height + | _ -> assert false in + + (* Get the nodes and edges. *) + let is_node = function "node" :: _ -> true | _ -> false in + let is_edge = function "edge" :: _ -> true | _ -> false in + let nodes, edges = List.filter is_node lines, List.filter is_edge lines in + + (* Process the nodes and edges. *) + let process_node = function + "node" :: url :: x :: y :: width :: height :: _ -> + url, (float_of_string x, float_of_string y, + float_of_string width, float_of_string height) + | _ -> assert false + in + let nodes = List.map process_node nodes in + + let process_edge = function + "edge" :: node1 :: node2 :: n :: rest -> + let n = int_of_string n in + let points = + List.map (fun (x, y) -> float_of_string x, float_of_string y) + (takepairs (List.take (n*2) rest)) in + node1, node2, points + | _ -> assert false + in + let edges = List.map process_edge edges in + + (* Scale the whole thing to 1000x1000 pixel coordinates. *) + let wscale = 1000. /. width in + let hscale = 1000. /. height in + + let process_node (url, (x, y, width, height)) = + url, (x *. wscale, y *. hscale, width *. wscale, height *. hscale) + in + let nodes = List.map process_node nodes in + + let process_edge (node1, node2, points) = + let process_point (x, y) = x *. wscale, y *. hscale in + node1, node2, List.map process_point points + in + let edges = List.map process_edge edges in + + (* Return the layout. *) + let layout = nodes, edges in + layout + in + + (* XXX In future we are able to load this from the database. *) + let nodes, edges = gv_layout () in + + let table = + List.map (fun (url, (x, y, width, height)) -> + [ "url", Template.VarString url; + "x", Template.VarString (string_of_float x); + "y", Template.VarString (string_of_float y); + "width", Template.VarString (string_of_float width); + "height", Template.VarString (string_of_float height) ]) + nodes in + + template#table "nodes" table; + + let table = + List.map (fun (node1, node2, points) -> + let xpoints, ypoints = List.split points in + let xpoints = + List.map (fun x -> + [ "x", Template.VarString (string_of_float x) ]) + xpoints in + let ypoints = + List.map (fun y -> + [ "y", Template.VarString (string_of_float y) ]) + ypoints in + + [ "node1", Template.VarString node1; + "node2", Template.VarString node2; + "xpoints", Template.VarTable xpoints; + "ypoints", Template.VarTable ypoints; ]) + edges in + + template#table "edges" table; + + + + + + + + q#template template + +let () = + register_script ~restrict:[CanEdit] run diff --git a/templates/visualise_links.html b/templates/visualise_links.html new file mode 100644 index 0000000..b37992c --- /dev/null +++ b/templates/visualise_links.html @@ -0,0 +1,40 @@ + + + +Visualise links + + + + + + + +

Visualise links

+ + + +

+::table(nodes)::

::end:: +

+ +

+ + + +

+ + + + + \ No newline at end of file