File: Clipping.sml

package info (click to toggle)
polyml 5.7.1-5
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, sid
  • size: 40,616 kB
  • sloc: cpp: 44,142; ansic: 26,963; sh: 22,002; asm: 13,486; makefile: 602; exp: 525; python: 253; awk: 91
file content (85 lines) | stat: -rw-r--r-- 3,727 bytes parent folder | download | duplicates (5)
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
(*
    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 Clipping :
  sig
    type HDC and HRGN
    type RECT = { top: int, left: int, bottom: int, right: int }
    type POINT = { x: int, y: int }
    type RegionOperation = Region.RegionOperation
    type ResultRegion = Region.ResultRegion

    val ExcludeClipRect : HDC * RECT -> ResultRegion
    val ExtSelectClipRgn : HDC * HRGN * RegionOperation -> ResultRegion
    val GetClipBox : HDC -> ResultRegion * RECT
    val GetClipRgn : HDC * HRGN -> unit
    val GetMetaRgn : HDC * HRGN -> unit
    val IntersectClipRect : HDC * RECT -> ResultRegion
    val OffsetClipRgn : HDC * int * int -> ResultRegion
    val PtVisible : HDC * POINT -> bool
    val RectVisible : HDC * RECT -> bool
    val SelectClipPath : HDC * RegionOperation -> unit
    val SelectClipRgn : HDC * HRGN -> unit
    val SetMetaRgn : HDC -> unit
  end =
struct
    local
        open Foreign Base GdiBase
    in
        type RegionOperation = RegionOperation and ResultRegion = ResultRegion
        type RECT = RECT and HDC = HDC and HRGN = HRGN and POINT = POINT
        
        val ExtSelectClipRgn           = winCall3(gdi "ExtSelectClipRgn") (cHDC,cHRGN,REGIONOPERATION) RESULTREGION
        val GetClipRgn                 = winCall2(gdi "GetClipRgn") (cHDC,cHRGN) (successState "GetClipRgn")
        val GetMetaRgn                 = winCall2(gdi "GetMetaRgn") (cHDC,cHRGN) (successState "GetMetaRgn")
        val OffsetClipRgn              = winCall3(gdi "OffsetClipRgn") (cHDC,cInt,cInt) RESULTREGION
        val RectVisible                = winCall2(gdi "RectVisible") (cHDC,cConstStar cRect) cBool
        val SelectClipPath             = winCall2(gdi "SelectClipPath") (cHDC,REGIONOPERATION) (successState "SelectClipPath")
        val SelectClipRgn              = winCall2(gdi "SelectClipRgn") (cHDC,cHRGN) (successState "SelectClipRgn")
        val SetMetaRgn                 = winCall1(gdi "SetMetaRgn") (cHDC) (successState "SetMetaRgn")
        
        local
            val ptVisible = winCall3(gdi "PtVisible") (cHDC,cInt,cInt) cBool
        in
            fun PtVisible(hd, {x, y}) = ptVisible(hd, x, y)
        end

        local
            val excludeClipRect = winCall5 (gdi "ExcludeClipRect") (cHDC,cInt,cInt,cInt,cInt) RESULTREGION
        in
            fun ExcludeClipRect (h,{left,top,right,bottom}) = excludeClipRect(h,left,top,right,bottom)
        end

        local
            val intersectClipRect =
                winCall5 (gdi "IntersectClipRect") (cHDC,cInt,cInt,cInt,cInt) RESULTREGION
        in
            fun IntersectClipRect (h,{left,top,right,bottom}: RECT) =
               intersectClipRect(h,left,top,right,bottom)
        end

        local
            val getClipBox = winCall2 (gdi "GetClipBox") (cHDC, cStar cRect) RESULTREGION
            val zeroRect = { top=0, bottom=0, left=0, right=0}
        in
            fun GetClipBox hdc =
                let val v = ref zeroRect val res = getClipBox(hdc, v) in (res, !v) end
        end

    end
end;