~alcinnz/CatTrap

ref: 18b54a4e3965573a2106ae1c30a6e7b9004490cd CatTrap/Graphics/Layout/Box.hs -rw-r--r-- 3.7 KiB
18b54a4e — Adrian Cochrane Fix type error, confusing paddedboxes for borders. 1 year, 7 months ago
                                                                                
09970dfc Adrian Cochrane
ca995b39 Adrian Cochrane
aef40617 Adrian Cochrane
09970dfc Adrian Cochrane
272852e8 Adrian Cochrane
09970dfc Adrian Cochrane
4c05e6f6 Adrian Cochrane
eae2c200 Adrian Cochrane
b47a0b46 Adrian Cochrane
09970dfc Adrian Cochrane
272852e8 Adrian Cochrane
09970dfc Adrian Cochrane
c06fd552 Adrian Cochrane
b47a0b46 Adrian Cochrane
c06fd552 Adrian Cochrane
272852e8 Adrian Cochrane
09970dfc Adrian Cochrane
272852e8 Adrian Cochrane
09970dfc Adrian Cochrane
272852e8 Adrian Cochrane
c06fd552 Adrian Cochrane
09970dfc Adrian Cochrane
c06fd552 Adrian Cochrane
6d1a719d Adrian Cochrane
b47a0b46 Adrian Cochrane
15ad59db Adrian Cochrane
b47a0b46 Adrian Cochrane
9b5c291c Adrian Cochrane
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
{-# LANGUAGE RecordWildCards #-}
module Graphics.Layout.Box(Border(..), mapX, mapY,
        Size(..), mapSizeX, mapSizeY,
        PaddedBox(..), zeroBox, lengthBox, mapX', mapY',
        width, height, minWidth, minHeight, maxWidth, maxHeight,
        Length(..), mapAuto, lowerLength, Zero(..), CastDouble(..)) where

data Border m n = Border {
    top :: m, bottom :: m, left :: n, right :: n
}
mapX :: (n -> nn) -> Border m n -> Border m nn
mapY :: (m -> mm) -> Border m n -> Border mm n
mapX cb self = self { left = cb $ left self, right = cb $ right self }
mapY cb self = self { top = cb $ top self, bottom = cb $ bottom self }

data Size m n = Size {inline :: n, block :: m} deriving (Eq, Show)
mapSizeY cb self = Size (inline self) (cb $ block self)
mapSizeX cb self = Size (cb $ inline self) (block self)

data PaddedBox m n = PaddedBox {
    min :: Size m n,
    max :: Size m n,
    size :: Size m n,
    padding :: Border m n,
    border :: Border m n,
    margin :: Border m n
}
zeroBox :: PaddedBox Double Double
zeroBox = PaddedBox {
    min = Size 0 0,
    max = Size 0 0,
    size = Size 0 0,
    padding = Border 0 0 0 0,
    border = Border 0 0 0 0,
    margin = Border 0 0 0 0
  }
lengthBox = PaddedBox {
    min = Size Auto Auto,
    max = Size Auto Auto,
    size = Size Auto Auto,
    padding = Border zero zero zero zero,
    border = Border zero zero zero zero,
    margin = Border zero zero zero zero
  }

mapX' :: (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' cb PaddedBox {..} = PaddedBox {
    min = Size (cb $ inline min) (block min),
    size = Size (cb $ inline size) (block size),
    max = Size (cb $ inline max) (block max),
    padding = mapX cb padding,
    border = mapX cb border,
    margin = mapX cb margin
  }
mapY' :: (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' cb PaddedBox {..} = PaddedBox {
    min = Size (inline min) (cb $ block min),
    size = Size (inline size) (cb $ block size),
    max = Size (inline max) (cb $ block max),
    padding = mapY cb padding,
    border = mapY cb border,
    margin = mapY cb margin
  }

width PaddedBox {..} = left margin + left border + left padding +
    inline size + right padding + right border + right margin
height PaddedBox {..} = top margin + top border + top padding +
    block size + bottom padding + bottom border + bottom margin
minWidth PaddedBox {..} = left margin + left border + left padding +
    inline min + right padding + right border + right margin
minHeight PaddedBox {..} = top margin + top border + top padding +
    block min + bottom padding + bottom border + bottom margin
maxWidth PaddedBox {..} = left margin + left border + left padding +
    inline max + right padding + right border + right margin
maxHeight PaddedBox {..} = top margin + top border + top padding +
    block max + bottom padding + bottom border + bottom margin

data Length = Pixels Double | Percent Double | Auto | Preferred | Min deriving Eq

lowerLength :: Double -> Length -> Double
lowerLength _ (Pixels x) = x
lowerLength outerwidth (Percent x) = x * outerwidth
lowerLength _ _ = 0

mapAuto x Auto = Pixels x
mapAuto x Preferred = Pixels x
mapAuto x Min = Pixels x
mapAuto _ x = x

class Zero a where
    zero :: a

instance Zero Double where zero = 0
instance Zero Length where zero = Pixels 0
instance (Zero m, Zero n) => Zero (PaddedBox m n) where
    zero = PaddedBox {
        min = Size zero zero,
        max = Size zero zero,
        size = Size zero zero,
    padding = Border zero zero zero zero,
    border = Border zero zero zero zero,
    margin = Border zero zero zero zero
    }

class CastDouble a where
    fromDouble :: Double -> a

instance CastDouble Double where fromDouble = id
instance CastDouble Length where fromDouble = Pixels