{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Diagrams.Backend.Canvas.CmdLine
(
mainWith
, defaultMain
, multiMain
, Canvas
, B
) where
import Diagrams.Backend.Canvas
import Diagrams.Backend.CmdLine hiding (height, width)
import Diagrams.Prelude hiding (height, option, value, width)
import qualified Graphics.Blank as BC
import Data.Data
import Options.Applicative
data DiaOpts = DiaOpts
{ _width :: Maybe Int
, _height :: Maybe Int
, _port :: Int
} deriving (Show, Data, Typeable)
makeLenses ''DiaOpts
diaOpts :: Parser DiaOpts
diaOpts = DiaOpts
<$> (optional . option auto)
(long "width" <> short 'w'
<> metavar "WIDTH"
<> help "Desired WIDTH of the output image")
<*> (optional . option auto)
(long "height" <> short 'h'
<> metavar "HEIGHT"
<> help "Desired HEIGHT of the output image")
<*> option auto
(long "port" <> short 'p'
<> value 3000
<> metavar "PORT"
<> help "Port on which to satrt the web server (default 3000)")
instance Parseable DiaOpts where
parser = diaOpts
defaultMain :: QDiagram Canvas V2 Double Any -> IO ()
defaultMain = mainWith
instance Mainable (QDiagram Canvas V2 Double Any) where
type MainOpts (QDiagram Canvas V2 Double Any) = DiaOpts
mainRender = canvasRender
canvasRender :: DiaOpts -> QDiagram Canvas V2 Double Any -> IO ()
canvasRender opts d = BC.blankCanvas (fromIntegral (opts^.port)) (canvasDia opts d)
canvasDia :: DiaOpts -> QDiagram Canvas V2 Double Any -> BC.DeviceContext -> IO ()
canvasDia opts d context =
BC.send context $
renderDia
Canvas
(CanvasOptions
(fromIntegral <$> mkSizeSpec2D
(opts^.width)
(opts^.height)))
d
multiMain :: [(String, QDiagram Canvas V2 Double Any)] -> IO ()
multiMain = mainWith
instance Mainable [(String, QDiagram Canvas V2 Double Any)] where
type MainOpts [(String, QDiagram Canvas V2 Double Any)] =
(MainOpts (QDiagram Canvas V2 Double Any), DiagramMultiOpts)
mainRender = defaultMultiMainRender