1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
(*
Copyright (c) 2001, 2015
David C.J. Matthews
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License version 2.1 as published by the Free Software Foundation.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*)
structure Line :
sig
type HDC
type RECT = { top: int, left: int, bottom: int, right: int }
type POINT = { x: int, y: int }
datatype PointType =
PT_BEZIERTO
| PT_BEZIERTOANDCLOSE
| PT_LINETO
| PT_LINETOANDCLOSE
| PT_MOVETO
eqtype ArcDirection
val AD_CLOCKWISE : ArcDirection
val AD_COUNTERCLOCKWISE : ArcDirection
val AngleArc : HDC * int * int * int * real * real -> unit
val Arc : HDC * int * int * int * int * int * int * int * int -> unit
val ArcTo : HDC * int * int * int * int * int * int * int * int -> unit
val GetArcDirection : HDC -> ArcDirection
val LineTo : HDC * POINT -> unit
val MoveToEx : HDC * POINT -> POINT
val PolyBezier : HDC * POINT list -> unit
val PolyBezierTo : HDC * POINT list -> unit
val PolyDraw : HDC * (PointType * POINT) list -> unit
val Polyline : HDC * POINT list -> unit
val PolylineTo : HDC * POINT list -> unit
val SetArcDirection : HDC * ArcDirection -> ArcDirection
end =
struct
local
open Foreign Base GdiBase
val zeroPoint: POINT = {x=0, y=0}
in
type HDC = HDC and POINT = POINT and RECT = RECT
datatype PointType = datatype PointType
local
datatype ArcDirection =
W of int
in
type ArcDirection = ArcDirection
val ARCDIRECTION = absConversion {abs = W, rep = fn W n => n} cInt
val AD_COUNTERCLOCKWISE = W(1)
val AD_CLOCKWISE = W(2)
end;
val AngleArc = winCall6(gdi "AngleArc") (cHDC,cInt,cInt,cDWORD,cFloat,cFloat) (successState "AngleArc")
val Arc = winCall9(gdi "Arc") (cHDC,cInt,cInt,cInt,cInt,cInt,cInt,cInt,cInt) (successState "Arc")
val ArcTo = winCall9(gdi "ArcTo") (cHDC,cInt,cInt,cInt,cInt,cInt,cInt,cInt,cInt) (successState "ArcTo")
val GetArcDirection = winCall1(gdi "GetArcDirection") (cHDC) ARCDIRECTION
val SetArcDirection = winCall2(gdi "SetArcDirection") (cHDC,ARCDIRECTION) ARCDIRECTION
local
val lineTo = winCall3 (gdi "LineTo") (cHDC,cInt,cInt) (successState "LineTo")
in
fun LineTo (h,({x,y}:POINT)) = lineTo (h,x,y)
end
local
val moveToEx = winCall4 (gdi "MoveToEx") (cHDC, cInt, cInt, cStar cPoint) (successState "MoveToEx")
in
fun MoveToEx(h, ({x,y}:POINT)) =
let val p = ref zeroPoint in moveToEx(h, x, y, p); !p end
end
local
val polyBezier = winCall3 (gdi "PolyBezier") (cHDC,cPointer,cDWORD) (successState "PolyBezier")
and polyBezierTo = winCall3 (gdi "PolyBezierTo") (cHDC,cPointer,cDWORD) (successState "PolyBezierTo")
and polyDraw = winCall4 (gdi "PolyDraw") (cHDC,cPointer,cPointer, cInt) (successState "PolyDraw")
and polyLine = winCall3 (gdi "Polyline") (cHDC,cPointer,cInt) (successState "Polyline")
and polyLineTo = winCall3 (gdi "PolylineTo") (cHDC,cPointer,cDWORD) (successState "PolylineTo")
val ptList = list2Vector cPoint
val pTypeList = list2Vector cPOINTTYPE
in
fun PolyBezier (h, pts) =
let
val (ptarr, count) = ptList pts
in
polyBezier(h, ptarr, count) handle ex => (Memory.free ptarr; raise ex);
Memory.free ptarr
end
and PolyBezierTo (h, pts) =
let
val (ptarr, count) = ptList pts
in
polyBezierTo(h, ptarr, count) handle ex => (Memory.free ptarr; raise ex);
Memory.free ptarr
end
and PolyDraw (h, tplist: (PointType * POINT) list) =
let
val (typeList, pl) = ListPair.unzip tplist
val (ptarr, count) = ptList pl
val (farr, _) = pTypeList typeList
in
polyDraw(h, ptarr, farr,count) handle ex => (Memory.free ptarr; Memory.free farr; raise ex);
Memory.free ptarr; Memory.free farr
end
and Polyline (h, pts: POINT list) =
let
val (ptarr, count) = ptList pts
in
polyLine(h, ptarr, count) handle ex => (Memory.free ptarr; raise ex);
Memory.free ptarr
end
and PolylineTo (h, pts: POINT list) =
let
val (ptarr, count) = ptList pts
in
polyLineTo(h, ptarr, count) handle ex => (Memory.free ptarr; raise ex);
Memory.free ptarr
end
end
(*
Other Line and Curve functions:
LineDDA
LineDDAProc
PolyPolyline
*)
end
end;
|
