puzzle-draw-cmdline (empty) → 0.1.0.0
raw patch · 5 files changed
+264/−0 lines, 5 filesdep +aesondep +basedep +diagrams-cairosetup-changed
Dependencies added: aeson, base, diagrams-cairo, diagrams-lib, filepath, optparse-applicative, puzzle-draw, yaml
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- puzzle-draw-cmdline.cabal +41/−0
- src/Diagrams/Puzzles/CmdLineSized.hs +59/−0
- src/tools/drawpuzzle.hs +142/−0
+ LICENSE view
@@ -0,0 +1,20 @@+The MIT License (MIT)++Copyright (c) 2014 Robert Vollmert++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ puzzle-draw-cmdline.cabal view
@@ -0,0 +1,41 @@+name: puzzle-draw-cmdline+version: 0.1.0.0+synopsis: Creating graphics for pencil puzzles, command line tools.+description: Companion executable to puzzle-draw. Separate to keep+ the dependency on diagrams-cairo out of the library.+license: MIT+license-file: LICENSE+author: Robert Vollmert+maintainer: rfvollmert@gmail.com+category: Graphics+build-type: Simple+cabal-version: >=1.8+Source-repository head+ type: git+ location: http://github.com/robx/puzzle-draw-cmdline.git++library+ -- Modules exported by the library.+ exposed-modules: Diagrams.Puzzles.CmdLineSized++ -- Other library packages from which modules are imported.+ build-depends: base >= 4.2 && < 4.8,+ diagrams-lib >= 1.0 && <= 1.2,+ optparse-applicative >= 0.7 && < 0.9,+ filepath >= 1.3 && < 1.4,+ diagrams-cairo >= 1.0 && < 1.2+ hs-source-dirs: src+ ghc-options: -Wall++executable drawpuzzle+ main-is: drawpuzzle.hs+ hs-source-dirs: src/tools+ build-depends: base >= 4.2 && < 4.8,+ puzzle-draw >= 0.1.0 && < 0.1.1,+ diagrams-lib >= 1.0 && < 1.2,+ diagrams-cairo >= 1.0 && < 1.2,+ yaml >= 0.8 && < 0.9,+ optparse-applicative >= 0.7 && < 0.9,+ aeson >= 0.7 && < 0.8,+ filepath >= 1.3 && < 1.4+ ghc-options: -Wall
+ src/Diagrams/Puzzles/CmdLineSized.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE TypeFamilies #-}++module Diagrams.Puzzles.CmdLineSized where++import Diagrams.Prelude hiding ((<>), option, value)+import Diagrams.Backend.Cairo+import Diagrams.Backend.Cairo.CmdLine ()+import Diagrams.Backend.CmdLine+import Diagrams.BoundingBox++import Data.Maybe (fromMaybe)++import System.FilePath (splitExtension)++import Options.Applicative++data SizedOpts = SizedOpts+ { _scale :: Maybe Double+ , _outp :: String+ }++sizedOpts :: Parser SizedOpts+sizedOpts = SizedOpts+ <$> (optional . option)+ (long "scale" <> short 's'+ <> metavar "FACTOR"+ <> help "Desired scaling factor relative to default size")+ <*> strOption+ (long "output" <> short 'o'+ <> metavar "FILE"+ <> help "Desired output file")++instance Parseable SizedOpts where+ parser = sizedOpts++cmtopoint :: Double -> Double+cmtopoint = (* 28.3464567)++newtype M = M (Diagram Cairo R2)++instance Mainable M where+ type MainOpts M = SizedOpts++ mainRender opts (M x) = do+ let w = fst . unr2 . boxExtents . boundingBox $ x+ w' = fromMaybe 1 (_scale opts) * w+ (_, ext) = splitExtension (_outp opts)+ w'' = case ext of+ ".png" -> round (40 * w')+ _ -> round . cmtopoint $ w'+ dopts = DiagramOpts (Just w'') Nothing (_outp opts)+ lopts = DiagramLoopOpts False Nothing 0+ mainRender (dopts, lopts) x++instance ToResult M where+ type Args M = ()+ type ResultOf M = M++ toResult d _ = d
+ src/tools/drawpuzzle.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE FlexibleContexts #-}++module Main where++import Diagrams.Prelude hiding (value, option, (<>), Result)+import Diagrams.Backend.Cairo.CmdLine+import Diagrams.BoundingBox+import Diagrams.Backend.CmdLine++import Text.Puzzles.Puzzle+import Data.Puzzles.Compose+import Diagrams.Puzzles.Draw+import Data.Puzzles.PuzzleTypes++import Options.Applicative+import Control.Monad+import Data.Maybe++import System.FilePath+import System.Environment (getProgName)+import System.Exit++import qualified Data.Yaml as Y++data PuzzleOpts = PuzzleOpts+ { _format :: String+ , _type :: Maybe String+ , _puzzle :: Bool+ , _solution :: Bool+ , _example :: Bool+ , _input :: FilePath+ }++puzzleOpts :: Parser PuzzleOpts+puzzleOpts = PuzzleOpts+ <$> strOption+ (long "format" <> short 'f'+ <> value "png"+ <> metavar "FMT"+ <> help "Desired output format by file extension")+ <*> (optional . strOption $+ (long "type" <> short 't'+ <> metavar "TYPE"+ <> help "Puzzle type, overriding type in input file"))+ <*> switch+ (long "puzzle" <> short 'p'+ <> help "Render puzzle (to base.ext")+ <*> switch+ (long "solution" <> short 's'+ <> help "Render solution (to base-sol.ext)")+ <*> switch+ (long "example" <> short 'e'+ <> help "Render example (to base.ext)")+ <*> argument str+ (metavar "INPUT"+ <> help "Puzzle file in .pzl format")++instance Parseable PuzzleOpts where+ parser = puzzleOpts++cmtopoint :: Double -> Double+cmtopoint = (* 28.3464567)++outputSuffix :: OutputChoice -> String+outputSuffix DrawPuzzle = ""+outputSuffix DrawSolution = "-sol"+outputSuffix DrawExample = ""++toDiagramOpts :: OutputChoice -> Double -> PuzzleOpts -> DiagramOpts+toDiagramOpts oc w opts =+ DiagramOpts (Just w') Nothing out+ where+ f = _format opts+ w' = case f of "png" -> round (40 * w)+ _ -> round . cmtopoint $ (0.8 * w)+ base = takeBaseName (_input opts)+ out = addExtension (base ++ outputSuffix oc) f++renderPuzzle :: PuzzleOpts -> (OutputChoice -> Maybe (Diagram B R2)) ->+ (OutputChoice, Bool) -> IO ()+renderPuzzle opts r (oc, req) = do+ let x = r oc+ if req && isNothing x+ then exitErr ("failed to render (no solution?): " ++ show oc)+ else return ()+ when (isJust x) $ do+ let Just x' = x+ w = fst . unr2 . boxExtents . boundingBox $ x'+ dopts = toDiagramOpts oc w opts+ lopts = DiagramLoopOpts False Nothing 0+ mainRender (dopts, lopts) x'++defaultOpts :: Parser a -> IO a+defaultOpts optsParser = do+ prog <- getProgName+ let p = info (helper <*> optsParser)+ (fullDesc+ <> progDesc "Command-line diagram generation."+ <> header prog)+ execParser p++checkOutput :: PuzzleOpts -> IO [(OutputChoice, Bool)]+checkOutput opts+ | (p || s) && e = exitErr "example output conflicts with puzzle/solution"+ | e = return . map req $ [DrawExample]+ | p && s = return . map req $ [DrawPuzzle, DrawSolution]+ | p = return . map req $ [DrawPuzzle]+ | s = return . map req $ [DrawSolution]+ | otherwise = return [req DrawPuzzle, opt DrawSolution]+ where+ p = _puzzle opts+ s = _solution opts+ e = _example opts+ req x = (x, True)+ opt x = (x, False)++checkType :: Maybe String -> IO PuzzleType+checkType mt = do+ t <- maybe errno return mt+ maybe (errunk t) return (lookupType t)+ where+ errno = exitErr $ "no puzzle type given"+ errunk t = exitErr $ "unknown puzzle type: " ++ t++readPuzzle :: FilePath -> IO (Either Y.ParseException TypedPuzzle)+readPuzzle = Y.decodeFileEither++exitErr :: String -> IO a+exitErr e = putStrLn e >> exitFailure++main :: IO ()+main = do+ opts <- defaultOpts puzzleOpts+ ocs <- checkOutput opts+ mp <- readPuzzle (_input opts)+ TP mt pv msv <- case mp of Left e -> exitErr $+ "parse failure: " ++ show e+ Right p -> return p+ t <- checkType $ _type opts `mplus` mt+ let ps = Y.parseEither (handle drawPuzzleMaybeSol t) (pv, msv)+ case ps of Right ps' -> mapM_ (renderPuzzle opts (draw ps')) ocs+ Left e -> exitErr e