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 Path : 20 sig 21 type HDC and HRGN 22 type POINT = {x: int, y: int} 23 datatype PointType = datatype Line.PointType 24 25 val AbortPath : HDC -> unit 26 val BeginPath : HDC -> unit 27 val CloseFigure : HDC -> unit 28 val EndPath : HDC -> unit 29 val FillPath : HDC -> unit 30 val FlattenPath : HDC -> unit 31 val GetMiterLimit : HDC -> real 32 val GetPath : HDC -> (PointType * POINT) list 33 val PathToRegion : HDC -> HRGN 34 val SetMiterLimit : HDC * real -> real 35 val StrokeAndFillPath : HDC -> unit 36 val StrokePath : HDC -> unit 37 val WidenPath : HDC -> unit 38 39 end = 40struct 41 local 42 open Foreign Base 43 in 44 type HDC = HDC and POINT = POINT and HRGN = HRGN 45 datatype PointType = datatype Line.PointType 46 47 (* PATHS *) 48 val AbortPath = winCall1(gdi "AbortPath") (cHDC) (successState "AbortPath") 49 val BeginPath = winCall1(gdi "BeginPath") (cHDC) (successState "BeginPath") 50 val CloseFigure = winCall1(gdi "CloseFigure") (cHDC) (successState "CloseFigure") 51 val EndPath = winCall1(gdi "EndPath") (cHDC) (successState "EndPath") 52 val FillPath = winCall1(gdi "FillPath") (cHDC) (successState "FillPath") 53 val FlattenPath = winCall1(gdi "FlattenPath") (cHDC) (successState "FlattenPath") 54 val PathToRegion = winCall1(gdi "PathToRegion") (cHDC) cHRGN 55 val StrokeAndFillPath = winCall1(gdi "StrokeAndFillPath") (cHDC) (successState "StrokeAndFillPath") 56 val StrokePath = winCall1(gdi "StrokePath") (cHDC) (successState "StrokePath") 57 val WidenPath = winCall1(gdi "WidenPath") (cHDC) (successState "WidenPath") 58 59 local 60 val getMiterLimit = winCall2(gdi "GetMiterLimit") (cHDC, cStar cFloat) (successState "GetMiterLimit") 61 and setMiterLimit = winCall3(gdi "SetMiterLimit") (cHDC, cFloat, cStar cFloat) (successState "SetMiterLimit") 62 in 63 fun GetMiterLimit hdc = let val v = ref 0.0 in getMiterLimit(hdc, v); !v end 64 and SetMiterLimit(hdc, m) = let val v = ref 0.0 in setMiterLimit(hdc, m, v); !v end 65 end 66 67 local 68 val getPath = winCall4 (gdi "GetPath") (cHDC, cPointer, cPointer, cInt) cInt 69 val {load=fromPt, ctype={size=sizePt, ...}, ...} = breakConversion cPoint 70 val {load=fromTy, ...} = breakConversion GdiBase.cPOINTTYPE 71 in 72 fun GetPath h = 73 let 74 open Memory 75 infix 6 ++ 76 (* Passing 0 as the size will retrieve the number of points. *) 77 val count = getPath(h, null, null, 0) 78 val _ = checkResult(count >= 0) 79 80 val ptarr = malloc(Word.fromInt count * sizePt) 81 val farr = malloc(Word.fromInt count) 82 val _ = getPath(h, ptarr, farr, count) handle ex => (free ptarr; free farr; raise ex) 83 fun getElement n = 84 (fromTy(farr ++ Word.fromInt n), fromPt(ptarr ++ Word.fromInt n * sizePt)) 85 in 86 List.tabulate(count, getElement) before (free ptarr; free farr) 87 end 88 end 89 90 end 91end; 92