~alcinnz/CatTrap

ca995b3993984cc2d9395a63051b2ecb1bc974a4 — Adrian Cochrane 1 year, 3 months ago a226a88
Define public APIs.
M Graphics/Layout.hs => Graphics/Layout.hs +5 -1
@@ 1,5 1,9 @@
{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
module Graphics.Layout where
module Graphics.Layout(LayoutItem(..),
        layoutGetBox, layoutGetChilds, layoutGetInner,
        boxMinWidth, boxMaxWidth, boxNatWidth, boxWidth,
        boxNatHeight, boxMinHeight, boxMaxHeight, boxHeight,
        boxSplit, boxPaginate, boxPosition, boxLayout, glyphsPerFont) where

import Data.Text.ParagraphLayout (Paragraph(..), ParagraphOptions(..), Fragment(..))


M Graphics/Layout/Arithmetic.hs => Graphics/Layout/Arithmetic.hs +2 -1
@@ 1,5 1,6 @@
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Layout.Arithmetic where
module Graphics.Layout.Arithmetic(Opcode(..), parseCalc, verifyCalc,
        evalCalc, mapCalc) where

import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Data.Scientific (toRealFloat)

M Graphics/Layout/Box.hs => Graphics/Layout/Box.hs +5 -1
@@ 1,5 1,9 @@
{-# LANGUAGE RecordWildCards #-}
module Graphics.Layout.Box where
module Graphics.Layout.Box(Border(..), mapX, mapY,
        Size(..), mapSizeX, mapSizeY,
        PaddedBox(..), zeroBox, lengthBox, mapX', mapY',
        width, height, minWidth, minHeight, maxWidth, maxHeight,
        Length(..), lowerLength, Zero(..), CastDouble(..)) where

data Border m n = Border {
    top :: m, bottom :: m, left :: n, right :: n

M Graphics/Layout/Flow.hs => Graphics/Layout/Flow.hs +3 -1
@@ 1,4 1,6 @@
module Graphics.Layout.Flow where
module Graphics.Layout.Flow(flowMinWidth, flowNatWidth, flowMaxWidth, flowWidth,
        flowNatHeight, flowMinHeight, flowMaxHeight, flowHeight,
        positionFlow, layoutFlow) where

import Graphics.Layout.Box as B


M Graphics/Layout/Grid.hs => Graphics/Layout/Grid.hs +5 -1
@@ 1,5 1,9 @@
{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
module Graphics.Layout.Grid where
module Graphics.Layout.Grid(Grid(..), GridItem(..), Alignment(..), Name,
        buildGrid, setCellBox, enumerate,
        gridEstWidth, gridNatWidths, gridMinWidths, gridMaxWidths, gridWidths,
        gridNatHeights, gridMinHeights, gridMaxHeights, gridHeights,
        gridPosition, gridLayout) where

import Data.Either (fromRight)
import Data.Text (Text)

M Graphics/Layout/Inline.hs => Graphics/Layout/Inline.hs +2 -1
@@ 1,5 1,6 @@
{-# LANGUAGE TupleSections #-}
module Graphics.Layout.Inline where
module Graphics.Layout.Inline(inlineMinWidth, inlineNatWidth, inlineHeight,
    inlineSize, inlineChildren, fragmentSize, fragmentSize', fragmentPos) where

import Data.Text.ParagraphLayout (Paragraph(..), ParagraphOptions(..),
                                    SpanLayout(..), Fragment(..),