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