diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,6 +2,36 @@ Functions for rendering diagrams to Braille. -## TODO +``` +⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣠⠴⠚⠉⠉⠉⠉⠉⠓⠦⣄⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀ +⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣠⠞⠁⠀⠀⠀⠀⠀⠀⠀⠀⠀⠈⠳⣄⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀ +⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢰⠃⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠘⡆⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀ +⠀⠀⠀⠀⣀⣠⠤⠤⠤⠤⢤⣀⣏⣠⠤⠤⠤⠤⢤⣀⣀⣀⡤⠤⠤⠤⠤⣄⣹⣀⡤⠤⠤⠤⠤⣄⣀⠀⠀⠀⠀ +⠀⢀⡴⠚⠁⠀⠀⠀⠀⠀⣠⠞⣟⠦⡀⠀⠀⠀⣠⠖⠉⠲⣄⠀⠀⠀⢀⡴⣻⠳⣄⠀⠀⠀⠀⠀⠈⠓⢦⡀⠀ +⢠⠞⠀⠀⠀⠀⠀⠀⢀⡞⠁⠀⢹⡀⠙⣆⠀⡼⠁⠀⠀⠀⠈⢧⠀⣰⠋⢠⡏⠀⠈⢳⡀⠀⠀⠀⠀⠀⠀⠳⡄ +⡟⠀⠀⠀⠀⠀⠀⠀⡼⠀⠀⠀⠀⠹⣄⠘⣾⠁⠀⠀⠀⠀⠀⠈⣷⠃⣠⠏⠀⠀⠀⠀⢧⠀⠀⠀⠀⠀⠀⠀⢳ +⡇⠀⠀⠀⠀⠀⠀⣠⡷⠒⠋⠉⠉⠉⠛⣳⣿⣒⡋⠉⠉⠉⠙⣒⣿⣞⠛⠉⠉⠉⠙⠒⢾⣄⠀⠀⠀⠀⠀⠀⢸ +⡇⠀⠀⠀⠀⣠⠞⠁⢧⠀⠀⠀⠀⢠⠞⢁⣿⠉⢯⡉⠉⢉⡝⠉⣿⡈⠳⡄⠀⠀⠀⠀⣼⠈⠳⣄⠀⠀⠀⠀⢸ +⠹⡄⠀⠀⣰⠃⠀⠀⠘⣆⠀⠀⢠⠏⢀⡼⠈⢧⠀⢹⣀⡏⠀⡼⠁⢧⡀⠹⡄⠀⠀⣰⠃⠀⠀⠘⣆⠀⠀⢠⠏ +⠀⠘⢦⡀⣇⣀⣤⠤⠤⢬⣧⣄⣟⣠⣾⠤⠤⠬⣷⣄⣿⣠⣾⠥⠤⠤⣷⣄⣻⣀⣼⡥⠤⠤⢤⣀⣸⢀⡴⠋⠀ +⠀⠀⣠⠟⡟⠦⠤⣤⣤⡤⣤⠟⡟⢷⡤⢤⣤⡤⢤⠾⣿⠷⡤⢤⣤⣤⢤⡾⢻⠻⣦⢤⣤⣤⠤⠴⢻⠻⣄⠀⠀ +⢀⡞⠁⠀⢳⠀⠀⠀⢀⡼⠁⠀⢹⡀⠙⣆⠀⡴⠋⢠⠿⡄⠙⢦⠀⣰⠋⢀⡏⠀⠈⢧⡀⠀⠀⠀⡾⠀⠈⢳⡀ +⡞⠀⠀⠀⠈⢣⡀⠀⡼⠁⠀⠀⠀⠳⡄⠸⣾⠁⣠⠏⠀⠹⣄⠈⣷⠇⢠⠞⠀⠀⠀⠀⢧⠀⢀⡜⠁⠀⠀⠀⢳ +⡇⠀⠀⠀⠀⠀⠙⠦⣇⡀⠀⠀⠀⠀⠈⣲⣿⡞⠓⠋⠉⠙⠚⢳⣽⣖⠁⠀⠀⠀⠀⢀⣸⠴⠋⠀⠀⠀⠀⠀⢸ +⡇⠀⠀⠀⠀⠀⠀⠀⣇⠉⠙⠓⠒⢛⡽⢉⣷⠉⠉⠓⠒⠚⠉⠉⣾⡙⢫⡛⠒⠚⠋⠉⣸⠀⠀⠀⠀⠀⠀⠀⢸ +⠹⡄⠀⠀⠀⠀⠀⠀⠸⣄⠀⠀⢠⠏⠀⡼⠙⣆⠀⠀⠀⠀⠀⣰⠋⢧⠀⠹⡄⠀⠀⣠⠇⠀⠀⠀⠀⠀⠀⢠⠏ +⠀⠙⢦⡀⠀⠀⠀⠀⠀⠘⢦⡀⡞⣠⠞⠁⠀⠈⠣⣀⠀⣠⠜⠁⠀⠈⠳⣄⢳⢀⡴⠃⠀⠀⠀⠀⠀⢀⡴⠋⠀ +⠀⠀⠀⠙⠲⠤⣤⣀⣀⣠⡤⠽⡟⠧⣤⣀⣀⣀⡤⠼⠛⠧⢤⣀⣀⣀⣤⠼⢻⠯⢤⣄⣀⣀⣠⠤⠖⠋⠀⠀⠀ +⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢻⡀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⡏⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀ +⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢳⡀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⡞⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀ +⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠙⠦⣄⠀⠀⠀⠀⠀⠀⢀⣠⠴⠋⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀ +⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠈⠉⠓⠒⠒⠒⠚⠉⠁⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀ +``` -Render text as true ASCII. +This package provides a backend for Diagrams to render tactile Braille graphics. +Additionally, a small frontend command-line program called brldia is +provided which allows to create diagrams from a number of primitive +functions and optional arguments. It basically exports a minimal +version of diagrams-lib to the command-line. See ``brldia --help`` for details. + + diff --git a/app/Clock.hs b/app/Clock.hs deleted file mode 100644 --- a/app/Clock.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeFamilies #-} -module Main where - -import Diagrams.Prelude -import Diagrams.Coordinates -import Diagrams.Backend.Braille.CmdLine -import Data.Time - -clock :: UTCTime -> Diagram B -clock t = circle 0.35 # fc silver # lwG 0 - <> bigHand # f 12 h <> littleHand # f 60 m - <> circle 1 # fc black # lwG 0 - <> circle 11 # lwG 1.5 # lc slategray -- # fc lightsteelblue - where - s = realToFrac $ utctDayTime t :: Double - m = s / 60 - h = m / 60 - bigHand = (0 ^& (-1.5)) ~~ (0 ^& 7.5) # lwG 0.5 - littleHand = (0 ^& (-2)) ~~ (0 ^& 9.5) # lwG 0.2 - f n v = rotate (- v / n @@ turn) - -main = mainWith $ clock <$> getCurrentTime diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -4,25 +4,99 @@ module Main where import Diagrams.Backend.Braille.CmdLine -import Diagrams.Prelude +import Diagrams.Backend.CmdLine (Parseable(..)) +import Diagrams.Prelude hiding (option, value) +import Options.Applicative d = f 1 `atop` f (sqrt 2 / 2) `atop` f (sqrt 2 * (sqrt 2 / 2) / 2) where f x = circle x `atop` square (x * sqrt 2) -main = multiMain [ - ("a", vcat $ [text "Hello" <> rect 5 2, text "World!" <> rect 6 2]) - , ("b", atPoints (rotateBy (1/24) (dodecagon 1)) (map (baselineText.show) $ reverse $ take 12 $ drop 4 $ cycle [0..11]) <> rotateBy (1/24) (dodecagon 1.2)) - , ("d", d) - , ("triangle", triangle 1) - , ("square", square 1) - , ("pentagon", pentagon 1) - , ("hexagon", hexagon 1) - , ("heptagon", heptagon 1) - , ("octagon", octagon 1) - , ("nonagon", nonagon 1) - , ("decagon", decagon 1) - , ("hendecagon", hendecagon 1) - , ("dodecagon", dodecagon 1) - , ("ellipse", ellipse 0.5) - , ("circle", circle 1) - ] +sol = circle 1 <> atPoints (hexagon 1) (repeat $ circle 1) +fol = circle 1 <> atPoints (hexagon 1) (map (`rotateBy` pedal) [0, 1/6 ..]) +pedal = circle 1 <> circle 1 # translateX 1 # rotateBy (-1/3) + +clock h m = circle 0.35 # fc silver # lwG 0 + <> bigHand # f 12 h <> littleHand # f 60 m + <> circle 1 # fc black # lwG 0 + <> circle 11 # lwG 1.5 # lc slategray -- # fc lightsteelblue + where + bigHand = (0 ^& (-1.5)) ~~ (0 ^& 7.5) # lwG 0.5 + littleHand = (0 ^& (-2)) ~~ (0 ^& 9.5) # lwG 0.2 + f n v = rotate (- v / n @@ turn) + +hilbert 0 = mempty +hilbert n = hilbert' (n-1) # reflectY <> vrule 1 + <> hilbert (n-1) <> hrule 1 + <> hilbert (n-1) <> vrule (-1) + <> hilbert' (n-1) # reflectX + where hilbert' = rotateBy (1/4) . hilbert + +newtype Opts = Opts { draw :: Diagram B } + +instance Parseable Opts where + parser = fmap (Opts . mconcat) $ some $ hsubparser $ mconcat [ + commandGroup "Diagrams" + , cmd "hrule" "A centered horizontal (L-R) line of the given length." $ + hrule <$> arg (metavar "LENGTH") + , cmd "vrule" "A centered vertical (T-B) line of the given length." $ + vrule <$> arg (metavar "LENGTH") + , cmd "triangle" "An equilateral triangle, with sides of the given length and base parallel to the x-axis." $ + triangle <$> arg (metavar "LENGTH") + , cmd "rect" "An axis-aligned rectangle of the given width and height, centered at the origin." $ + rect <$> arg (metavar "WIDTH") + <*> arg (metavar "HEIGHT") + , cmd "roundedRect" "An axis-aligned rectangle with the given width and height with circular rounded corners of radius, centered at the origin." $ + roundedRect <$> arg (metavar "WIDTH") + <*> arg (metavar "HEIGHT") + <*> arg (metavar "RADIUS") + , cmd "square" "A square with its center at the origin and sides of the given length, oriented parallel to the axes." $ + square <$> arg (metavar "LENGTH") + , cmd "pentagon" "A regular pentagon, with sides of the given length and base parallel to the x-axis." $ + pentagon <$> arg (metavar "LENGTH") + , cmd "hexagon" "A regular hexagon, with sides of the given length and base parallel to the x-axis." $ + hexagon <$> arg (metavar "LENGTH") + , cmd "heptagon" "A regular heptagon, with sides of the given length and base parallel to the x-axis." $ + heptagon <$> arg (metavar "LENGTH") + , cmd "octagon" "A regular octagon, with sides of the given length and base parallel to the x-axis." $ + octagon <$> arg (metavar "LENGTH") + , cmd "nonagon" "A regular nonagon, with sides of the given length and base parallel to the x-axis." $ + nonagon <$> arg (metavar "LENGTH") + , cmd "decagon" "A regular decagon, with sides of the given length and base parallel to the x-axis." $ + decagon <$> arg (metavar "LENGTH") + , cmd "hendecagon" "A regular hendecagon, with sides of the given length and base parallel to the x-axis." $ + hendecagon <$> arg (metavar "LENGTH") + , cmd "dodecagon" "A regular dodecagon, with sides of the given length and base parallel to the x-axis." $ + dodecagon <$> arg (metavar "LENGTH") + , cmd "circle" "A circle of the given radius, centered at the origin." $ + circle <$> arg (metavar "RADIUS") + , cmd "text" "Print text." $ text <$> strArgument (metavar "STRING") + , cmd "baselineText" "Print text." $ baselineText <$> strArgument (metavar "STRING") + , cmd "clock" "A clock showing the time given in hours and minutes." $ + clock <$> arg (metavar "HOUR") + <*> arg (metavar "MINUTE") + , cmd "flower-of-life" "The \"flower of life\"." $ + pure fol + , cmd "hilbert" "A hilbert curve of the given order." $ + strokeT . hilbert <$> arg (metavar "ORDER") + , cmd "seed-of-life" "The \"seed of life\"." $ pure sol + ] where cmd s d p = command s $ info (foldr ($) <$> p <*> many modifier) $ + progDesc d + arg = argument auto + +modifier = flag' alignL (long "alignL") <|> flag' alignR (long "alignR") + <|> flag' alignT (long "alignT") <|> flag' alignB (long "alignB") + <|> flag' centerX (long "centerX" <> help "Center the local origin along the X-axis.") + <|> flag' centerY (long "centerY" <> help "Center the local origin along the Y-axis.") + <|> flag' centerXY (long "centerXY" <> help "Center along both the X- and Y-axes.") + <|> (named :: String -> Diagram B -> Diagram B) <$> option auto (long "named" <> metavar "NAME") + <|> flag' reflectX (long "reflectX" <> help "Flip a diagram from left to right, i.e. send the point (x,y) to (-x,y).") + <|> flag' reflectY (long "reflectY" <> help "Flip a diagram from top to bottom, i.e. send the point (x,y) to (x,-y).") + <|> flag' reflectXY (long "reflectXY" <> help "Flips the diagram about x=y, i.e. send the point (x,y) to (y,x).") + <|> rotateBy <$> option auto (long "rotateBy") + <|> scaleX <$> option auto (long "scaleX" <> metavar "FACTOR" <> help "Scale a diagram by the given factor in the x (horizontal) direction.") + <|> scaleY <$> option auto (long "scaleY" <> metavar "FACTOR" <> help "Scale a diagram by the given factor in the y (vertical) direction.") + <|> flag' showOrigin (long "showOrigin") + <|> translateX <$> option auto (long "translateX") + <|> translateY <$> option auto (long "translateY") + +main = mainWith draw diff --git a/diagrams-braille.cabal b/diagrams-braille.cabal --- a/diagrams-braille.cabal +++ b/diagrams-braille.cabal @@ -1,11 +1,11 @@ --- This file has been generated from package.yaml by hpack version 0.28.1. +-- This file has been generated from package.yaml by hpack version 0.20.0. -- -- see: https://github.com/sol/hpack -- --- hash: d35b54cd3cd4751fa2c9d9535295b092ea3f3f2bc9a36ff8a287769bac717dc3 +-- hash: 9465bc70f6e2bb819638c30b903cd5a923b59057a28e760f4c910062967ff50c name: diagrams-braille -version: 0.1.0.0 +version: 0.1.0.1 synopsis: Braille diagrams with plain text description: Please see the README on Github at category: Graphics @@ -18,6 +18,7 @@ license-file: LICENSE build-type: Simple cabal-version: >= 1.10 + extra-source-files: README.md @@ -26,11 +27,6 @@ location: https://github.com/mlang/diagrams-braille library - exposed-modules: - Diagrams.Backend.Braille - Diagrams.Backend.Braille.CmdLine - other-modules: - Paths_diagrams_braille hs-source-dirs: src build-depends: @@ -47,30 +43,11 @@ , mtl , optparse-applicative , time - default-language: Haskell2010 - -executable brlclock - main-is: Clock.hs + exposed-modules: + Diagrams.Backend.Braille + Diagrams.Backend.Braille.CmdLine other-modules: - Main Paths_diagrams_braille - hs-source-dirs: - app - build-depends: - JuicyPixels - , Rasterific - , base >=4.7 && <5 - , containers - , diagrams-braille - , diagrams-core >=1.4 && <1.5 - , diagrams-lib >=1.4 && <1.5 - , diagrams-rasterific >=1.4 && <1.5 - , filepath - , hashable - , lens - , mtl - , optparse-applicative - , time default-language: Haskell2010 executable brldia @@ -93,4 +70,6 @@ , mtl , optparse-applicative , time + other-modules: + Paths_diagrams_braille default-language: Haskell2010 diff --git a/src/Diagrams/Backend/Braille.hs b/src/Diagrams/Backend/Braille.hs --- a/src/Diagrams/Backend/Braille.hs +++ b/src/Diagrams/Backend/Braille.hs @@ -3,10 +3,12 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} ------------------------------------------------------------------------------- @@ -114,20 +116,17 @@ type RenderM n = ReaderT (Style V2 n) (Writer Draw) newtype Draw = Draw (R.Drawing PixelRGBA8 (), [((Int, Int), String)]) - -instance Monoid Draw where - mempty = Draw (pure (), mempty) - Draw (m1, l1) `mappend` Draw (m2, l2) = Draw (m1 >> m2, l1 <> l2) + deriving (Monoid) tellR :: R.Drawing PixelRGBA8 () -> RenderM n () -tellR r = tell $ Draw (r, mempty) +tellR = tell . Draw . (,mempty) tellT :: Int -> Int -> String -> RenderM n () tellT x y t = tell $ Draw (pure (), [((x, y), t)]) runRenderM :: TypeableFloat n => RenderM n a -> Draw runRenderM = execWriter . (`runReaderT` sty) where - sty = mempty # recommendFillColor transparent + sty = mempty # recommendFillColor transparent # recommendFontSize (output 4) instance TypeableFloat n => Backend Braille V2 n where newtype Render Braille V2 n = R (RenderM n ())