-- | Paper related functions and constants.
module Music.LilyPond.Light.Paper where

import Music.LilyPond.Light.Model

-- * Paper

a4_paper :: Paper
a4_paper =
    Paper {binding_offset = Length 0 MM
          ,bottom_margin = Length 6 MM
          ,indent = Length 15 MM
          ,inner_margin = Length 10 MM
          ,left_margin = Length 10 MM
          ,outer_margin = Length 20 MM
          ,paper_width = Length 210 MM
          ,paper_height = Length 297 MM
          ,ragged_right = False
          ,ragged_last = False
          ,ragged_bottom = False
          ,ragged_last_bottom = True
          ,right_margin = Length 10 MM
          ,top_margin = Length 5 MM
          ,two_sided = False
          ,print_page_number = True
          ,min_systems_per_page = Nothing
          ,max_systems_per_page = Nothing
          ,systems_per_page = Nothing
          ,systems_count = Nothing
          ,page_count = Nothing
          ,system_separator_markup = Nothing
          ,system_spacing_basic_distance = Nothing
          ,system_spacing_minimum_distance = Nothing
          }

b4_paper :: Paper
b4_paper = a4_paper {paper_width = Length 250 MM
                    ,paper_height = Length 353 MM}

-- | Set margins, ordering as for CSS, ie. clockwise from top.
paper_set_margins :: Length -> Length -> Length -> Length -> Paper -> Paper
paper_set_margins t r b l p =
    p {top_margin = t
      ,right_margin = r
      ,bottom_margin = b
      ,left_margin = l}

paper_set_margins_mm_generic :: Real n => n -> n -> n -> n -> Paper -> Paper
paper_set_margins_mm_generic t l b r =
    let mm x = Length (realToFrac x) MM
    in paper_set_margins (mm t) (mm l) (mm b) (mm r)

-- | Variant with margins given in /mm/.
paper_set_margins_mm :: Double -> Double -> Double -> Double -> Paper -> Paper
paper_set_margins_mm = paper_set_margins_mm_generic

length_scale :: Double -> Length -> Length
length_scale n (Length x u) = Length (n * x) u

paper_incr_size :: Paper -> Paper
paper_incr_size x =
    let wd = paper_width x
        ht = paper_height x
    in x {paper_width = ht, paper_height = length_scale 2 wd}

paper_decr_size :: Paper -> Paper
paper_decr_size x =
    let wd = paper_width x
        ht = paper_height x
    in x {paper_width = length_scale 0.5 ht, paper_height = wd}

a3_paper :: Paper
a3_paper = paper_incr_size a4_paper

a2_paper :: Paper
a2_paper = paper_incr_size a3_paper

b5_paper :: Paper
b5_paper = paper_decr_size b4_paper

landscape :: Paper -> Paper
landscape x =
    let wd = paper_width x
        ht = paper_height x
    in x {paper_width = ht, paper_height = wd}

mk_fragment_paper :: Double -> Double -> Paper
mk_fragment_paper w h =
    Paper {binding_offset = Length 0 MM
          ,bottom_margin = Length 0 MM
          ,indent = Length 0 MM
          ,inner_margin = Length 0 MM
          ,left_margin = Length 0 MM
          ,outer_margin = Length 0 MM
          ,paper_width = Length w MM
          ,paper_height = Length h MM
          ,ragged_right = True
          ,ragged_last = True
          ,ragged_bottom = True
          ,ragged_last_bottom = True
          ,right_margin = Length 0 MM
          ,top_margin = Length 0 MM
          ,two_sided = False
          ,print_page_number = False
          ,min_systems_per_page = Nothing
          ,max_systems_per_page = Nothing
          ,systems_per_page = Nothing
          ,systems_count = Nothing
          ,page_count = Nothing
          ,system_separator_markup = Nothing
          ,system_spacing_basic_distance = Nothing
          ,system_spacing_minimum_distance = Nothing
          }