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 Transform: 20 sig 21 type HDC (*= Base.HDC*) 22 type HWND (*= Base.HWND*) 23 type POINT = { x: int, y: int } 24 type SIZE = { cx: int, cy: int } 25 datatype Fraction = Fraction of {num: int, denom: int} 26 27 datatype 28 MapMode = 29 MM_ANISOTROPIC 30 | MM_HIENGLISH 31 | MM_HIMETRIC 32 | MM_ISOTROPIC 33 | MM_LOENGLISH 34 | MM_LOMETRIC 35 | MM_TEXT 36 | MM_TWIPS 37 val MM_MAX : MapMode 38 val MM_MAX_FIXEDSCALE : MapMode 39 val MM_MIN : MapMode 40 41 type XForm = { m11: real, m12: real, m21: real, m22: real, dx: real, dy: real } 42 43 type XFormType 44 val MWT_IDENTITY : XFormType 45 val MWT_LEFTMULTIPLY : XFormType 46 val MWT_MAX : XFormType 47 val MWT_MIN : XFormType 48 val MWT_RIGHTMULTIPLY : XFormType 49 50 type GraphicsMode 51 val GM_ADVANCED : GraphicsMode 52 val GM_COMPATIBLE : GraphicsMode 53 val GM_ERROR : GraphicsMode 54 55 val ClientToScreen : HWND * POINT -> POINT 56 val CombineTransform : XForm * XForm -> XForm 57 val DPtoLP : HDC * POINT list -> POINT list 58 val GetCurrentPositionEx : HDC -> POINT 59 val GetGraphicsMode : HDC -> GraphicsMode 60 val GetMapMode : HDC -> MapMode 61 val GetViewportExtEx : HDC -> SIZE 62 val GetViewportOrgEx : HDC -> POINT 63 val GetWindowExtEx : HDC -> SIZE 64 val GetWindowOrgEx : HDC -> POINT 65 val GetWorldTransform : HDC -> XForm 66 val LPtoDP : HDC * POINT list -> POINT list 67 val MapWindowPoints : HWND * HWND * POINT list -> POINT list 68 val ModifyWorldTransform : HDC * XForm * XFormType -> unit 69 val OffsetViewportOrgEx : HDC * int * int -> POINT 70 val OffsetWindowOrgEx : HDC * int * int -> POINT 71 val ScaleViewportExtEx : HWND * Fraction * Fraction -> SIZE 72 val ScaleWindowExtEx : HWND * Fraction * Fraction -> SIZE 73 val ScreenToClient : HWND * POINT -> POINT 74 val SetGraphicsMode : HDC * GraphicsMode -> GraphicsMode 75 val SetMapMode : HDC * MapMode -> MapMode 76 val SetViewportExtEx : HDC * int * int -> SIZE 77 val SetViewportOrgEx : HDC * int * int -> POINT 78 val SetWindowExtEx : HDC * int * int -> SIZE 79 val SetWindowOrgEx : HDC * int * int -> POINT 80 val SetWorldTransform : HDC * XForm -> unit 81 82 end = 83struct 84 local 85 open Foreign Base GdiBase 86 in 87 type HDC = Base.HDC and HWND = Base.HWND 88 type POINT = POINT and SIZE = SIZE 89 90 open GdiBase 91 92 (* COORDINATE SPACES AND TRANSFORMATIONS *) 93 local 94 datatype GraphicsMode = W of int 95 in 96 type GraphicsMode = GraphicsMode 97 val GRAPHICSMODE = absConversion {abs = W, rep = fn W n => n} cInt 98 99 val GM_ERROR (* ???? *) = W 0 100 val GM_COMPATIBLE = W (1) 101 val GM_ADVANCED = W (2) 102 end 103 104 105 (* An XFORM is a struct of six floats. Wrap this as an ML record for clarity *) 106 type XForm = { m11: real, m12: real, m21: real, m22: real, dx: real, dy: real } 107 108 local 109 fun breakXForm {m11,m12,m21,m22,dx,dy} = (m11,m12,m21,m22,dx,dy) 110 fun mkXForm (m11,m12,m21,m22,dx,dy) = {m11=m11,m12=m12,m21=m21,m22=m22,dx=dx,dy=dy} 111 in 112 val XFORM = 113 absConversion {abs=mkXForm, rep=breakXForm} 114 (cStruct6 (cFloat,cFloat,cFloat,cFloat,cFloat,cFloat)) 115 end 116 117 local 118 datatype XFormType = W of int 119 in 120 type XFormType = XFormType 121 val XFORMTYPE = absConversion {abs = W, rep = fn W n => n} cDWORD 122 123 val MWT_IDENTITY = W (1) 124 val MWT_LEFTMULTIPLY = W (2) 125 val MWT_RIGHTMULTIPLY = W (3) 126 val MWT_MIN = MWT_IDENTITY 127 val MWT_MAX = MWT_RIGHTMULTIPLY 128 end 129 130 datatype Fraction = Fraction of {num:int, denom:int} 131 132 local 133 val clientToScreen = winCall2(user "ClientToScreen") (cHWND, cStar cPoint) (successState "ClientToScreen") 134 val combineTransform = winCall3(gdi "CombineTransform") (cStar XFORM, cConstStar XFORM, cConstStar XFORM) (successState "CombineTransform") 135 val getCurrentPositionEx = winCall2(gdi "GetCurrentPositionEx") (cHDC, cStar cPoint) (successState "GetCurrentPositionEx") 136 val getViewportExtEx = winCall2(gdi "GetViewportExtEx") (cHDC, cStar cSize) (successState "GetViewportExtEx") 137 val getViewportOrgEx = winCall2(gdi "GetViewportOrgEx") (cHDC, cStar cPoint) (successState "GetViewportOrgEx") 138 val getWindowExtEx = winCall2(gdi "GetWindowExtEx") (cHDC, cStar cSize) (successState "GetWindowExtEx") 139 val getWindowOrgEx = winCall2(gdi "GetWindowOrgEx") (cHDC, cStar cPoint) (successState "GetWindowOrgEx") 140 val getWorldTransform = winCall2(gdi "GetWorldTransform") (cHDC, cStar XFORM) (successState "GetWorldTransform") 141 val offsetViewportOrgEx = winCall4(gdi "OffsetViewportOrgEx") (cHDC, cInt, cInt, cStar cPoint) (successState "OffsetViewportOrgEx") 142 val offsetWindowOrgEx = winCall4(gdi "OffsetWindowOrgEx") (cHDC, cInt, cInt, cStar cPoint) (successState "OffsetWindowOrgEx") 143 val screenToClient = winCall2(user "ScreenToClient") (cHWND, cStar cPoint) (successState "ScreenToClient") 144 val setViewportExtEx = winCall4(gdi "SetViewportExtEx") (cHDC, cInt, cInt, cStar cSize) (successState "SetViewportExtEx") 145 val setViewportOrgEx = winCall4(gdi "SetViewportOrgEx") (cHDC, cInt, cInt, cStar cPoint) (successState "SetViewportOrgEx") 146 val setWindowExtEx = winCall4(gdi "SetWindowExtEx") (cHDC, cInt, cInt, cStar cSize) (successState "SetWindowExtEx") 147 val setWindowOrgEx = winCall4(gdi "SetWindowOrgEx") (cHDC, cInt, cInt, cStar cPoint) (successState "SetWindowOrgEx") 148 val scaleViewportExtEx = 149 winCall6 (gdi "ScaleViewportExtEx") (cHWND,cInt,cInt,cInt,cInt,cStar cSize) (successState "ScaleViewportExtEx") 150 val scaleWindowExtEx = 151 winCall6 (gdi "ScaleWindowExtEx") (cHWND,cInt,cInt,cInt,cInt,cStar cSize) (successState "ScaleWindowExtEx") 152 153 val zeroXFORM: XForm = { m11=0.0, m12=0.0, m21=0.0, m22=0.0, dx=0.0, dy=0.0 } 154 val zeroPoint: POINT = { x = 0, y = 0 } 155 val zeroSize: SIZE = { cx = 0, cy = 0 } 156 157 in 158 fun ClientToScreen(w, p) = let val r = ref p in clientToScreen(w, r); !r end 159 and CombineTransform(a, b) = let val r = ref zeroXFORM in combineTransform(r, a, b); ! r end 160 and GetCurrentPositionEx hdc = let val p = ref zeroPoint in getCurrentPositionEx(hdc, p); !p end 161 and GetViewportExtEx hdc = let val s = ref zeroSize in getViewportExtEx(hdc, s); !s end 162 and GetViewportOrgEx hdc = let val p = ref zeroPoint in getViewportOrgEx(hdc, p); !p end 163 and GetWindowExtEx hdc = let val s = ref zeroSize in getWindowExtEx(hdc, s); !s end 164 and GetWindowOrgEx hdc = let val p = ref zeroPoint in getWindowOrgEx(hdc, p); !p end 165 and GetWorldTransform hdc = let val r = ref zeroXFORM in getWorldTransform(hdc, r); !r end 166 and OffsetViewportOrgEx (hdc, x, y) = 167 let val p = ref zeroPoint in offsetViewportOrgEx(hdc, x, y, p); !p end 168 and OffsetWindowOrgEx (hdc, x, y) = 169 let val p = ref zeroPoint in offsetWindowOrgEx(hdc, x, y, p); !p end 170 and ScreenToClient(hw, p) = let val r = ref p in screenToClient(hw, r); !r end 171 and SetViewportExtEx (hdc, x, y) = 172 let val p = ref zeroSize in setViewportExtEx(hdc, x, y, p); !p end 173 and SetViewportOrgEx (hdc, x, y) = 174 let val p = ref zeroPoint in setViewportOrgEx(hdc, x, y, p); !p end 175 and SetWindowExtEx (hdc, x, y) = 176 let val p = ref zeroSize in setWindowExtEx(hdc, x, y, p); !p end 177 and SetWindowOrgEx (hdc, x, y) = 178 let val p = ref zeroPoint in setWindowOrgEx(hdc, x, y, p); !p end 179 and ScaleViewportExtEx (h,Fraction{num=n1,denom=d1},Fraction{num=n2,denom=d2}) = 180 let val p = ref zeroSize in scaleViewportExtEx(h,n1,d1,n2,d2,p); !p end 181 and ScaleWindowExtEx (h,Fraction{num=n1,denom=d1},Fraction{num=n2,denom=d2}) = 182 let val p = ref zeroSize in scaleWindowExtEx(h,n1,d1,n2,d2,p); !p end 183 end 184 185 val ModifyWorldTransform = winCall3(gdi "ModifyWorldTransform") (cHDC, cConstStar XFORM, XFORMTYPE) (successState "ModifyWorldTransform") 186 val SetWorldTransform = winCall2(gdi "SetWorldTransform") (cHDC, cConstStar XFORM) (successState "SetWorldTransform") 187 188 189 val GetMapMode = winCall1(gdi "GetMapMode") (cHDC) cMAPMODE 190 val SetMapMode = winCall2(gdi "SetMapMode") (cHDC,cMAPMODE) cMAPMODE 191 (* Should check the result is non-zero. *) 192 val GetGraphicsMode = winCall1 (gdi "GetGraphicsMode") (cHDC) GRAPHICSMODE 193 val SetGraphicsMode = winCall2 (gdi "SetGraphicsMode") (cHDC, GRAPHICSMODE) GRAPHICSMODE 194 195 local 196 val dPtoLP = winCall3 (gdi "DPtoLP") (cHDC,cPointer,cInt) (successState "DPtoLP") 197 and lPtoDP = winCall3 (gdi "LPtoDP") (cHDC,cPointer,cInt) (successState "LPtoDP") 198 (* The result is the bits added in each direction to make the mapping or is 199 zero if there is an error. The caller is supposed to call SetLastError and 200 check GetLastError because the result could legitimately be zero. *) 201 and mapWindowPoints = winCall4 (user "MapWindowPoints") (cHWND,cHWND,cPointer,cInt) cInt 202 203 val {load=fromPt, store=toPt, ctype={size=sizePt, ...}, ...} = breakConversion cPoint 204 205 fun mapPts call pts = 206 let 207 val count = List.length pts 208 open Memory 209 infix 6 ++ 210 val mem = malloc(Word.fromInt count * sizePt) 211 val _ = List.foldl (fn (p,n) => (ignore(toPt(n, p)); n ++ sizePt)) mem pts 212 val _ = call(mem, count) handle ex => (free mem; raise ex) 213 in 214 List.tabulate(count, fn i => fromPt(mem ++ (Word.fromInt i * sizePt))) 215 before free mem 216 end 217 in 218 fun DPtoLP(h,pts) = mapPts(fn (mem, count) => dPtoLP(h, mem, count)) pts 219 and LPtoDP(h,pts) = mapPts(fn (mem, count) => lPtoDP(h, mem, count)) pts 220 and MapWindowPoints (h1,h2,pts) = mapPts(fn (mem, count) => mapWindowPoints(h1, h2, mem, count)) pts 221 end 222 end 223end; 224