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 Line : 20 sig 21 type HDC 22 type RECT = { top: int, left: int, bottom: int, right: int } 23 type POINT = { x: int, y: int } 24 25 datatype PointType = 26 PT_BEZIERTO 27 | PT_BEZIERTOANDCLOSE 28 | PT_LINETO 29 | PT_LINETOANDCLOSE 30 | PT_MOVETO 31 32 eqtype ArcDirection 33 val AD_CLOCKWISE : ArcDirection 34 val AD_COUNTERCLOCKWISE : ArcDirection 35 36 val AngleArc : HDC * int * int * int * real * real -> unit 37 val Arc : HDC * int * int * int * int * int * int * int * int -> unit 38 val ArcTo : HDC * int * int * int * int * int * int * int * int -> unit 39 val GetArcDirection : HDC -> ArcDirection 40 val LineTo : HDC * POINT -> unit 41 val MoveToEx : HDC * POINT -> POINT 42 val PolyBezier : HDC * POINT list -> unit 43 val PolyBezierTo : HDC * POINT list -> unit 44 val PolyDraw : HDC * (PointType * POINT) list -> unit 45 val Polyline : HDC * POINT list -> unit 46 val PolylineTo : HDC * POINT list -> unit 47 val SetArcDirection : HDC * ArcDirection -> ArcDirection 48 49 end = 50struct 51 local 52 open Foreign Base GdiBase 53 54 val zeroPoint: POINT = {x=0, y=0} 55 in 56 type HDC = HDC and POINT = POINT and RECT = RECT 57 58 datatype PointType = datatype PointType 59 60 local 61 datatype ArcDirection = 62 W of int 63 in 64 type ArcDirection = ArcDirection 65 val ARCDIRECTION = absConversion {abs = W, rep = fn W n => n} cInt 66 67 val AD_COUNTERCLOCKWISE = W(1) 68 val AD_CLOCKWISE = W(2) 69 end; 70 71 val AngleArc = winCall6(gdi "AngleArc") (cHDC,cInt,cInt,cDWORD,cFloat,cFloat) (successState "AngleArc") 72 val Arc = winCall9(gdi "Arc") (cHDC,cInt,cInt,cInt,cInt,cInt,cInt,cInt,cInt) (successState "Arc") 73 val ArcTo = winCall9(gdi "ArcTo") (cHDC,cInt,cInt,cInt,cInt,cInt,cInt,cInt,cInt) (successState "ArcTo") 74 val GetArcDirection = winCall1(gdi "GetArcDirection") (cHDC) ARCDIRECTION 75 val SetArcDirection = winCall2(gdi "SetArcDirection") (cHDC,ARCDIRECTION) ARCDIRECTION 76 77 local 78 val lineTo = winCall3 (gdi "LineTo") (cHDC,cInt,cInt) (successState "LineTo") 79 in 80 fun LineTo (h,({x,y}:POINT)) = lineTo (h,x,y) 81 end 82 83 local 84 val moveToEx = winCall4 (gdi "MoveToEx") (cHDC, cInt, cInt, cStar cPoint) (successState "MoveToEx") 85 in 86 fun MoveToEx(h, ({x,y}:POINT)) = 87 let val p = ref zeroPoint in moveToEx(h, x, y, p); !p end 88 end 89 90 local 91 val polyBezier = winCall3 (gdi "PolyBezier") (cHDC,cPointer,cDWORD) (successState "PolyBezier") 92 and polyBezierTo = winCall3 (gdi "PolyBezierTo") (cHDC,cPointer,cDWORD) (successState "PolyBezierTo") 93 and polyDraw = winCall4 (gdi "PolyDraw") (cHDC,cPointer,cPointer, cInt) (successState "PolyDraw") 94 and polyLine = winCall3 (gdi "Polyline") (cHDC,cPointer,cInt) (successState "Polyline") 95 and polyLineTo = winCall3 (gdi "PolylineTo") (cHDC,cPointer,cDWORD) (successState "PolylineTo") 96 97 val ptList = list2Vector cPoint 98 val pTypeList = list2Vector cPOINTTYPE 99 in 100 fun PolyBezier (h, pts) = 101 let 102 val (ptarr, count) = ptList pts 103 in 104 polyBezier(h, ptarr, count) handle ex => (Memory.free ptarr; raise ex); 105 Memory.free ptarr 106 end 107 108 and PolyBezierTo (h, pts) = 109 let 110 val (ptarr, count) = ptList pts 111 in 112 polyBezierTo(h, ptarr, count) handle ex => (Memory.free ptarr; raise ex); 113 Memory.free ptarr 114 end 115 116 and PolyDraw (h, tplist: (PointType * POINT) list) = 117 let 118 val (typeList, pl) = ListPair.unzip tplist 119 val (ptarr, count) = ptList pl 120 val (farr, _) = pTypeList typeList 121 in 122 polyDraw(h, ptarr, farr,count) handle ex => (Memory.free ptarr; Memory.free farr; raise ex); 123 Memory.free ptarr; Memory.free farr 124 end 125 126 and Polyline (h, pts: POINT list) = 127 let 128 val (ptarr, count) = ptList pts 129 in 130 polyLine(h, ptarr, count) handle ex => (Memory.free ptarr; raise ex); 131 Memory.free ptarr 132 end 133 134 and PolylineTo (h, pts: POINT list) = 135 let 136 val (ptarr, count) = ptList pts 137 in 138 polyLineTo(h, ptarr, count) handle ex => (Memory.free ptarr; raise ex); 139 Memory.free ptarr 140 end 141 end 142 143 (* 144 Other Line and Curve functions: 145 LineDDA 146 LineDDAProc 147 PolyPolyline 148 *) 149 150 end 151end; 152