-- | Paper sizes.
-- For ISO sizes see <http://www.cl.cam.ac.uk/~mgk25/iso-paper.html>.
module Graphics.PS.Paper where

-- | Paper size data type.
data Paper = Paper {width :: Int
                   ,height :: Int}
             deriving (Eq,Show)

-- | BoundingBox for an EPSF file with an optional HiResBoundingBox
data BBox = BBox {llx :: Int -- ^ lower left x (x-min)
                 ,lly :: Int -- ^ lower left y (y-min)
                 ,urx :: Int -- ^ upper right x (x-max)
                 ,ury :: Int -- ^ upper right y (y-max)
                 }
          | HRBBox {llx :: Int
                   ,lly :: Int
                   ,urx :: Int
                   ,ury :: Int
                   ,hrllx :: Double -- ^ high resolution 'llx'
                   ,hrlly :: Double -- ^ high resolution 'lly'
                   ,hrurx :: Double -- ^ high resolution 'urx'
                   ,hrury :: Double -- ^ high resolution 'ury'
                   }
            deriving (Eq,Show)

-- | Swap width and height of 'Paper'.
landscape :: Paper -> Paper
landscape (Paper w h) = Paper h w

-- | A 'div' variant that rounds rather than truncates.
--
-- > let f (Paper _ h) = h `div` 2 == h `divRound` 2
-- > in all id (map f [b0,b1,b2,b3,b4,b5,b6,b7,b8,b9]) == False
divRound :: Int -> Int -> Int
divRound x y =
    let x' = (fromIntegral x)::Double
        y' = (fromIntegral y)::Double
    in round (x' / y')

-- | ISO size downscaling, ie. from @A0@ to @A1@.
--
-- > iso_down_scale a4 == a5
iso_down_scale :: Paper -> Paper
iso_down_scale (Paper w h) = Paper (h `divRound` 2) w

-- | ISO A sizes in millimeters.
--
-- > a4 == Paper 210 297
a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10 :: Paper
a0 = Paper 841 1189
a1 = iso_down_scale a0
a2 = iso_down_scale a1
a3 = iso_down_scale a2
a4 = iso_down_scale a3
a5 = iso_down_scale a4
a6 = iso_down_scale a5
a7 = iso_down_scale a6
a8 = iso_down_scale a7
a9 = iso_down_scale a8
a10 = iso_down_scale a9

-- | ISO B sizes in millimeters.
--
-- > b4 == Paper 250 354
b0,b1,b2,b3,b4,b5,b6,b7,b8,b9,b10 :: Paper
b0 = Paper 1000 1414
b1 = iso_down_scale b0
b2 = iso_down_scale b1
b3 = iso_down_scale b2
b4 = iso_down_scale b3
b5 = iso_down_scale b4
b6 = iso_down_scale b5
b7 = iso_down_scale b6
b8 = iso_down_scale b7
b9 = iso_down_scale b8
b10 = iso_down_scale b9

-- | ISO C sizes in millimeters.
--
-- > c4 == Paper 229 324
c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10 :: Paper
c0 = Paper 917 1297
c1 = iso_down_scale c0
c2 = iso_down_scale c1
c3 = iso_down_scale c2
c4 = iso_down_scale c3
c5 = iso_down_scale c4
c6 = iso_down_scale c5
c7 = iso_down_scale c6
c8 = iso_down_scale c7
c9 = iso_down_scale c8
c10 = iso_down_scale c9

-- | US Letter size in millimeters (ie 'Paper' @216 279@).
usLetter :: Paper
usLetter = Paper 216 279

-- | Newspaper sizes in millimeters.
-- See <http://www.papersizes.org/newspaper-sizes.htm>.
broadsheet,berliner,tabloid :: Paper
broadsheet = Paper 600 750
berliner = Paper 315 470
tabloid = Paper 280 430

-- | Proportion of 'Paper'.
--
-- > proportion broadsheet == 1.25
-- > map (round . (* 1e3) . proportion) [a0,b0,c0] == [1414,1414,1414]
-- > map proportion [usLetter,berliner,tabloid]
proportion :: Paper -> Double
proportion p =
    let f = fromIntegral
    in f (height p) / f (width p)