1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
(**************************************************************************)
(* *)
(* Copyright (C) Johannes Kanig, Stephane Lescuyer *)
(* Jean-Christophe Filliatre, Romain Bardou and Francois Bobot *)
(* *)
(* This software is free software; you can redistribute it and/or *)
(* modify it under the terms of the GNU Library General Public *)
(* License version 2.1, with the special exception on linking *)
(* described in file LICENSE. *)
(* *)
(* This software 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. *)
(* *)
(**************************************************************************)
module S = Point
open Types
module BaseDefs =
struct
type direction = Types.direction
let vec = mkVec
let curl = mkCurl
let noDir = mkNoDir
type joint = Types.joint
let jLine = mkJLine
let jCurve = mkJCurve
let jCurveNoInflex = mkJCurveNoInflex
let jTension = mkJTension
let jControls = mkJControls
type knot = Types.knot
(* the intention is to add new knots in front,
* i. e. the list has to be reversed for printing *)
let of_path p = mkMPAofPA p
let of_metapath p = mkPAofMPA p
let to_path = of_metapath
let to_metapath = of_path
let start k = mkMPAKnot k
let metacycle d j p = mkMPACycle d j p
let fullcircle = mkPAFullCircle
let halfcircle = mkPAHalfCircle
let quartercircle = mkPAQuarterCircle
let unitsquare = mkPAUnitSquare
let transform tr p = List.fold_left mkPATransformed p tr
let cut_after p1 p2 = mkPACutAfter p1 p2
let cut_before p1 p2 = mkPACutBefore p1 p2
let build_cycle l = mkPABuildCycle l
let subpath (f1: float) (f2: float) p = mkPASub (mkF f1) (mkF f2) p
let point (f: float) p = mkPTPointOf (mkF f) p
let direction (f: float) p = mkPTDirectionOf (mkF f) p
let pointn (n: num) p = mkPTPointOf n p
let directionn (n: num) p = mkPTDirectionOf n p
let subpathn (n1: num) (n2: num) p = mkPASub n1 n2 p
let length p = mkNLength p
let defaultjoint = jCurve
let defaultdir = noDir
end
include BaseDefs
type t = metapath
type path = Types.path
let knotp ?(l=defaultdir) ?(r=defaultdir) p = Types.mkKnot l p r
let knot ?(l) ?(r) ?(scale) p = knotp ?l (S.p ?scale p) ?r
let knotn ?(l) ?(r) p = knotp ?l (S.pt p) ?r
let knotlist = List.map (fun (x,y,z) -> Types.mkKnot x y z)
let cycle ?(dir=defaultdir) ?(style=defaultjoint) p = metacycle dir style p
let concat ?(style=defaultjoint) p k = mkMPAConcat k style p
(* construct a path with a given style from a knot list *)
let pathk ?(style) = function
| [] -> failwith "empty path is not allowed"
| (x::xs) ->
List.fold_left
(fun p knot -> concat ?style p knot) (start x) xs
let pathp ?(style) l =
pathk ?style
(List.map (knotp) l)
let pathn ?(style) l = pathp ?style (List.map (Point.pt) l)
let path ?(style) ?(scale) l =
let sc = S.ptlist ?scale in pathp ?style (sc l)
(* construct a path with knot list and joint list *)
let jointpathk lp lj =
try
List.fold_left2
(fun acc j k -> mkMPAConcat k j acc)
(start (List.hd lp)) lj (List.tl lp)
with Invalid_argument _ -> invalid_arg "jointpathk : the list of knot must \
be one more than the list of join"
let jointpathp lp lj = jointpathk (List.map (knotp) lp) lj
let jointpathn lp lj = jointpathk (List.map knotn lp) lj
let jointpath ?(scale) lp lj = jointpathk (List.map (knot ?scale) lp) lj
let append ?(style=defaultjoint) p1 p2 = mkMPAAppend p1 style p2
|
