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
|
(*
Copyright (c) 2001, 2015
David C.J. Matthews
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License version 2.1 as published by the Free Software Foundation.
This library 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*)
structure Rectangle :
sig
type POINT = { x: int, y: int }
type RECT = { top: int, left: int, bottom: int, right: int }
val EqualRect : RECT * RECT -> bool
val InflateRect : RECT * int * int -> RECT
val IntersectRect : RECT * RECT -> RECT option
val IsRectEmpty : RECT -> bool
val OffsetRect : RECT * int * int -> RECT
val PtInRect : RECT * POINT -> bool
val SetRect : int * int * int * int -> RECT
val SetRectEmpty : unit -> RECT
val SubtractRect : RECT * RECT -> RECT
val UnionRect : RECT * RECT -> RECT
end =
struct
local
open Foreign Base
(* fun usercall_MII name CR (C1,C2,C3) (a1,a2,a3) =
let val (from1,to1,ctype1) = breakConversion C1
val (from2,to2,ctype2) = breakConversion C2
val (from3,to3,ctype3) = breakConversion C3
val (fromR,toR,ctypeR) = breakConversion CR
val va1 = address (to1 a1)
val va2 = to2 a2
val va3 = to3 a3
val res = calluser name [(Cpointer ctype1,va1),(ctype2,va2),(ctype3,va3)] ctypeR
in (fromR res,from1 (deref va1))
end*)
in
type RECT = RECT and POINT = POINT
(* TODO: It would be a lot more efficient to implement these directly in ML. *)
val zeroRect: RECT = {top=0, bottom=0, left=0, right=0}
(* RECTANGLES. *)
val EqualRect = winCall2 (user "EqualRect") (cConstStar cRect, cConstStar cRect) cBool
local
val inflateRect = winCall3 (user "InflateRect") (cStar cRect, cInt, cInt) (successState "InflateRect")
in
fun InflateRect(r, x, y) = let val v = ref r in inflateRect(v, x, y); !v end
end
local
val intersectRect = winCall3 (user "IntersectRect") (cStar cRect, cConstStar cRect, cConstStar cRect) cBool
in
fun IntersectRect(r1, r2) =
let val r = ref zeroRect in if intersectRect(r, r1, r2) then SOME(!r) else NONE end
end
local
val offsetRect = winCall3 (user "OffsetRect") (cStar cRect, cInt, cInt) (successState "OffsetRect")
in
fun OffsetRect(r, x, y) = let val v = ref r in offsetRect(v, x, y); !v end
end
val IsRectEmpty = winCall1(user "IsRectEmpty") (cConstStar cRect) cBool
val PtInRect = winCall2(user "PtInRect") (cConstStar cRect, cPoint) cBool
local
val setRect = winCall5 (user "SetRect") (cStar cRect, cInt, cInt, cInt, cInt) (successState "SetRect")
in
fun SetRect(a,b,c,d) : RECT = let val v = ref zeroRect in setRect(v, a,b,c,d); !v end
end
fun SetRectEmpty () : RECT = zeroRect (* No need to call C to do this *)
local
val subtractRect =
winCall3 (user "SubtractRect") (cStar cRect, cConstStar cRect, cConstStar cRect) (successState "SubtractRect")
and unionRect =
winCall3 (user "UnionRect") (cStar cRect, cConstStar cRect, cConstStar cRect) (successState "UnionRect")
in
fun SubtractRect(r1, r2) = let val v = ref zeroRect in subtractRect(v, r1, r2); !v end
and UnionRect(r1, r2) = let val v = ref zeroRect in unionRect(v, r1, r2); !v end
end
(*
Other Rectangle functions:
CopyRect
*)
end
end;
|
