1(*
2    Copyright (c) 2001, 2015
3        David C.J. Matthews
4
5    This library is free software; you can redistribute it and/or
6    modify it under the terms of the GNU Lesser General Public
7    License version 2.1 as published by the Free Software Foundation.
8    
9    This library is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12    Lesser General Public License for more details.
13    
14    You should have received a copy of the GNU Lesser General Public
15    License along with this library; if not, write to the Free Software
16    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
17*)
18
19structure Rectangle :
20  sig
21    type POINT = { x: int, y: int }
22    type RECT = { top: int, left: int, bottom: int, right: int }
23
24    val EqualRect : RECT * RECT -> bool
25    val InflateRect : RECT * int * int -> RECT
26    val IntersectRect : RECT * RECT -> RECT option
27    val IsRectEmpty : RECT -> bool
28    val OffsetRect : RECT * int * int -> RECT
29    val PtInRect : RECT * POINT -> bool
30    val SetRect : int * int * int * int -> RECT
31    val SetRectEmpty : unit -> RECT
32    val SubtractRect : RECT * RECT -> RECT
33    val UnionRect : RECT * RECT -> RECT
34  end =
35struct
36    local
37        open Foreign Base
38(*        fun usercall_MII name CR (C1,C2,C3) (a1,a2,a3) =
39            let val (from1,to1,ctype1) = breakConversion C1
40                val (from2,to2,ctype2) = breakConversion C2
41                val (from3,to3,ctype3) = breakConversion C3
42                val (fromR,toR,ctypeR) = breakConversion CR
43                val va1 = address (to1 a1)
44                val va2 = to2 a2
45                val va3 = to3 a3
46                val res = calluser name [(Cpointer ctype1,va1),(ctype2,va2),(ctype3,va3)] ctypeR
47            in  (fromR res,from1 (deref va1))
48            end*)
49    in
50        type RECT = RECT and POINT = POINT
51        (* TODO: It would be a lot more efficient to implement these directly in ML. *)
52        
53        val zeroRect: RECT = {top=0, bottom=0, left=0, right=0}
54
55        (* RECTANGLES. *)
56        val EqualRect = winCall2 (user "EqualRect") (cConstStar cRect, cConstStar cRect) cBool
57        
58        local
59            val inflateRect = winCall3 (user "InflateRect")  (cStar cRect, cInt, cInt) (successState "InflateRect")
60        in
61            fun InflateRect(r, x, y) = let val v = ref r in inflateRect(v, x, y); !v end
62        end
63
64        local
65            val intersectRect = winCall3 (user "IntersectRect") (cStar cRect, cConstStar cRect, cConstStar cRect) cBool
66        in
67            fun IntersectRect(r1, r2) =
68                let val r = ref zeroRect in if intersectRect(r, r1, r2) then SOME(!r) else NONE end
69        end
70
71        local
72            val offsetRect = winCall3 (user "OffsetRect") (cStar cRect, cInt, cInt) (successState "OffsetRect")
73        in
74            fun OffsetRect(r, x, y) = let val v = ref r in offsetRect(v, x, y); !v end
75        end
76
77        val IsRectEmpty = winCall1(user "IsRectEmpty") (cConstStar cRect) cBool
78        val PtInRect = winCall2(user "PtInRect") (cConstStar cRect, cPoint) cBool
79
80        local
81            val setRect = winCall5 (user "SetRect") (cStar cRect, cInt, cInt, cInt, cInt) (successState "SetRect")
82        in
83            fun SetRect(a,b,c,d) : RECT = let val v = ref zeroRect in setRect(v, a,b,c,d); !v end
84        end
85        
86        fun SetRectEmpty () : RECT = zeroRect (* No need to call C to do this *)
87
88        local
89            val subtractRect =
90                winCall3 (user "SubtractRect") (cStar cRect, cConstStar cRect, cConstStar cRect) (successState "SubtractRect")
91            and unionRect =
92                winCall3 (user "UnionRect") (cStar cRect, cConstStar cRect, cConstStar cRect) (successState "UnionRect")
93        in
94            fun SubtractRect(r1, r2) = let val v = ref zeroRect in subtractRect(v, r1, r2); !v end
95            and UnionRect(r1, r2) = let val v = ref zeroRect in unionRect(v, r1, r2); !v end
96        end
97
98        (*
99            Other Rectangle functions:
100                CopyRect  
101        *)
102    end
103end;
104