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