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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
|
(**************************************************************************)
(* *)
(* 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. *)
(* *)
(**************************************************************************)
open Command
open Path
open Num
open Color
open Types
open Infix
(* Module implmentant une file avec deux listes *)
module Q = Misc.Q
let scale_radius r l=
List.map (fun (x,y) -> (multf x r,multf y r)) l
let scale_radius_2 r l =
List.map (scale_radius r) l
(* Calcule la liste des max des ime lments de chaque liste *)
let maxlist =function
|ml::ll->
List.fold_left (List.map2 max) ml ll
|[]-> failwith "Empty list"
type direction = Horizontal | Vertical | Other
(* Calcule les 2 points distance d de la droite de coefficient directeur a2_equ perpendiculaire l'axe de tc *)
let rec make_paths a2_equ tc d sens acc radius = match tc with
|(absc,ordo)::res ->
let (absc,ordo) = (multf absc radius,multf ordo radius) in
begin
match sens with
| Vertical -> (* Le long de l'axe des ordonnes *)
let absc2 = (+/) absc d in
let absc3 = (-/) absc d in
make_paths a2_equ res d sens ([(absc2,ordo);(absc3,ordo)]::acc) radius
| Horizontal -> (* Le long de l'axe des abscisses *)
let ordo2 = (+/) ordo d in
let ordo3 = (-/) ordo d in
make_paths a2_equ res d sens ([(absc,ordo2);(absc,ordo3)]::acc) radius
| Other ->
let b2_equ = (-/) ordo (( *./) a2_equ absc) in
let co = 1. /. (sqrt (1.+.a2_equ*.a2_equ)) in
let angle = if a2_equ>0. then 360 - (int_of_float ((acos co)*.180./.pi)) else int_of_float (acos(co)*.180./.pi) in
let absc2 = (+/) absc (( *./) (cos ((float angle)*.2.*.pi/.360.)) d) in
let ordo2 = (+/) (( *./) a2_equ absc2) b2_equ in
let angle2 = (angle+180) mod 360 in
let absc3 = (+/) absc (( *./) (cos ((float angle2)*.2.*.pi/.360.)) d) in
let ordo3 = (+/) (( *./) a2_equ absc3) b2_equ in
make_paths a2_equ res d sens ([(absc2,ordo2);(absc3,ordo3)]::acc) radius
end
|[]-> acc
(* Dessine les ticks le long de l'axe pass en paramtre *)
let draw_ticks ticks coords m d radius=
let (x,y) = List.hd (List.rev coords) in
let rec ticks_coords acc ticks i x y m =
if i<=m then ticks_coords ((x*.i/.m,y*.i/.m)::acc) ticks (i+.ticks) x y m
else acc
in
let tc = ticks_coords [] ticks ticks x y m in
let x = if (abs_float x < 10e-4) then 0. else x in
let y = if (abs_float y < 10e-4) then 0. else y in
let a2_equ,sens =
if x=0. then 0.,Vertical else if y=0. then 0.,Horizontal else ((-.x)/.y),Other
in
let p = make_paths a2_equ tc d sens [] radius in
iterl (fun x -> draw (pathn x)) p
(* *)
let draw_label pt lab radius =
let (x,y) = List.hd (List.rev pt) in
let angl = (acos (x /. (sqrt (x*.x +. y*.y))))*.180./.pi in
let angle = if y<0. then 360.-.angl else angl in
let placement =
if ((angle>315. && angle<360.) || (angle>=0. && angle<=45.)) then `East
else if (angle>45. && angle<=135.) then `North
else if (angle>135. && angle<=225.) then `West
else `South
in
Command.label ~pos:placement (Picture.tex lab) (Point.pt (multf x radius, multf y radius))
(* Dessine le radar vide *)
let rec draw_skeleton acc ?label ticks lmax skltn d radius=
let label = match label with
|None -> []
|Some i -> i
in
match skltn,lmax,label with
|x::res,m::lm,lab::labl -> let x2= scale_radius radius x in
draw_skeleton ((draw (pathn x2))
++(draw_ticks ticks x m d radius)
++(draw_label x lab radius)++acc) ~label:labl ticks lm res d radius
|x::res,m::lm,[] -> let x2= scale_radius radius x in
draw_skeleton ((draw (pathn x2))
++(draw_ticks ticks x m d radius)++acc) ~label:[] ticks lm res d radius
|[],[],[] -> acc
|_,_,_-> failwith "Different list sizes"
(* Fabrique une liste contenant les coordonnes des axes du radar *)
let empty_radar_coords nbr =
let delta = 360. /. (float nbr) in
let rec empty_radar acc nb diff angle =
if nb>0 then
empty_radar ([(0.,0.);(cos (angle*.2.*.pi/.360.), sin (angle*.2.*.pi/.360.) )]::acc)
(nb-1) diff (angle+.diff)
else List.rev acc
in
empty_radar [] nbr delta 0.
(* Fabrique la liste des coordonnes correspondant chaque valeur *)
let list_coord lmax l skeleton =
let rec fct lmax l skeleton acc =
match lmax,l,skeleton with
|x::res,y::res2,z::res3 ->
let (z1,z2) = List.hd (List.rev z) in
let x_coord = z1*.y/.x in
let y_coord = z2*.y/.x in
fct res res2 res3 ((x_coord,y_coord)::acc)
|[],[],[] -> List.rev acc
|_,_,_ -> failwith "Different list sizes"
in
fct lmax l skeleton []
(* Fabrique un radar associ au squelette de radar pass en paramtre *)
let radar color lmax l skeleton pen fill stl radius =
let coords = scale_radius radius (list_coord lmax l skeleton) in
let rec dots acc f c = match c with
|x::res ->
let col = if f then Color.black else color in
let cmd = draw ~pen:(Pen.scale (bp 3.) pen) ~color:col (pathn [x]) in
dots (cmd++acc) f res
|[]->acc
in
let dots_cmd = dots nop fill coords in
let clr = if fill then Color.black else color in
let path_cmd = draw (pathn ~style:jLine ~cycle:jLine coords) ~pen ~color:clr ~dashed:stl in
let path_filled = if fill then (Command.fill ~color:color (pathn ~style:jLine ~cycle:jLine coords)) else nop
in
path_filled++path_cmd++dots_cmd
let default_radius = bp (100.)
let default_style = [(Dash.pattern [Dash.on (bp 1.);Dash.off (bp 0.)])]
let default_pen = Pen.scale (bp 0.5) Pen.circle
let init radius ?scale l=
let ticks_size = divf (multf 3. radius) 100. in
let lesmax = match scale with
|None -> maxlist l
|Some l -> l in
let skeleton =
match l with
|x::_ -> empty_radar_coords (List.length x)
|[] -> failwith "No data" in
ticks_size,lesmax,skeleton
(* Fabrique des radars empils *)
let stack ?(radius=default_radius)
?(color=[black])
?(pen=default_pen)
?(style=default_style) ?(ticks=1.) ?label ?scale l =
let ticks_size,lesmax,skeleton = init radius ?scale l in
let rec radar_list col stl maxi li skltn acc = match li,col,stl with
|x::res,cq,sq ->
let c,cres = Q.pop cq in
let s,sres = Q.pop sq in
radar_list (Q.push c cres) (Q.push s sres) maxi res skltn
((radar c maxi x skltn pen false s radius)++acc)
|[],cq,sq-> acc
in Picture.make ((draw_skeleton nop ?label ticks lesmax skeleton ticks_size radius)
++(radar_list (Q.of_list color) (Q.of_list style) lesmax l skeleton nop))
(* Fabrique des radars comparatifs, renvoie la liste de Pictures reprsentant chaque radar *)
let compare ?(radius=default_radius)
?(color=[black])
?(fill=false)
?(pen=default_pen)
?(style=default_style) ?(ticks=1.) ?label ?scale l =
let ticks_size,lesmax,skeleton = init radius ?scale l in
let rec build_pictures skltn col stl maxi li tcks acc = match li,col,stl with
|x::res,cq,sq ->
let c,cres = Q.pop cq in
let s,sres = Q.pop sq in
let r = radar c maxi x skltn pen fill s radius in
let sk = draw_skeleton nop ?label tcks maxi skltn ticks_size radius in
let pic = Picture.make (r++sk) in
build_pictures skltn (Q.push c cres) (Q.push s sres) maxi res tcks (pic::acc)
|[],cq,sq-> List.rev acc
in
build_pictures skeleton (Q.of_list color) (Q.of_list style) lesmax l ticks []
|
