├── .github └── workflows │ └── haskell-ci.yml ├── .gitignore ├── LICENSE ├── README.md ├── Setup.hs ├── app └── Main.hs ├── diagrams-braille.cabal ├── src └── Diagrams │ └── Backend │ ├── Braille.hs │ └── Braille │ └── CmdLine.hs └── stack.yaml /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci 'github' 'diagrams-braille.cabal' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.19.20250216 12 | # 13 | # REGENDATA ("0.19.20250216",["github","diagrams-braille.cabal"]) 14 | # 15 | name: Haskell-CI 16 | on: 17 | - push 18 | - pull_request 19 | jobs: 20 | linux: 21 | name: Haskell-CI - Linux - ${{ matrix.compiler }} 22 | runs-on: ubuntu-24.04 23 | timeout-minutes: 24 | 60 25 | container: 26 | image: buildpack-deps:jammy 27 | continue-on-error: ${{ matrix.allow-failure }} 28 | strategy: 29 | matrix: 30 | include: 31 | - compiler: ghc-9.12.1 32 | compilerKind: ghc 33 | compilerVersion: 9.12.1 34 | setup-method: ghcup 35 | allow-failure: false 36 | - compiler: ghc-9.10.1 37 | compilerKind: ghc 38 | compilerVersion: 9.10.1 39 | setup-method: ghcup 40 | allow-failure: false 41 | - compiler: ghc-9.8.2 42 | compilerKind: ghc 43 | compilerVersion: 9.8.2 44 | setup-method: ghcup 45 | allow-failure: false 46 | - compiler: ghc-9.6.5 47 | compilerKind: ghc 48 | compilerVersion: 9.6.5 49 | setup-method: ghcup 50 | allow-failure: false 51 | - compiler: ghc-9.4.8 52 | compilerKind: ghc 53 | compilerVersion: 9.4.8 54 | setup-method: ghcup 55 | allow-failure: false 56 | - compiler: ghc-9.2.8 57 | compilerKind: ghc 58 | compilerVersion: 9.2.8 59 | setup-method: ghcup 60 | allow-failure: false 61 | - compiler: ghc-9.0.2 62 | compilerKind: ghc 63 | compilerVersion: 9.0.2 64 | setup-method: ghcup 65 | allow-failure: false 66 | - compiler: ghc-8.10.7 67 | compilerKind: ghc 68 | compilerVersion: 8.10.7 69 | setup-method: ghcup 70 | allow-failure: false 71 | fail-fast: false 72 | steps: 73 | - name: apt-get install 74 | run: | 75 | apt-get update 76 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 77 | - name: Install GHCup 78 | run: | 79 | mkdir -p "$HOME/.ghcup/bin" 80 | curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup" 81 | chmod a+x "$HOME/.ghcup/bin/ghcup" 82 | - name: Install cabal-install 83 | run: | 84 | "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 85 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" 86 | - name: Install GHC (GHCup) 87 | if: matrix.setup-method == 'ghcup' 88 | run: | 89 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 90 | HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") 91 | HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') 92 | HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') 93 | echo "HC=$HC" >> "$GITHUB_ENV" 94 | echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" 95 | echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" 96 | env: 97 | HCKIND: ${{ matrix.compilerKind }} 98 | HCNAME: ${{ matrix.compiler }} 99 | HCVER: ${{ matrix.compilerVersion }} 100 | - name: Set PATH and environment variables 101 | run: | 102 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 103 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 104 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 105 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 106 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 107 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 108 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 109 | echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" 110 | echo "HEADHACKAGE=false" >> "$GITHUB_ENV" 111 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 112 | env: 113 | HCKIND: ${{ matrix.compilerKind }} 114 | HCNAME: ${{ matrix.compiler }} 115 | HCVER: ${{ matrix.compilerVersion }} 116 | - name: env 117 | run: | 118 | env 119 | - name: write cabal config 120 | run: | 121 | mkdir -p $CABAL_DIR 122 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 155 | echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - 156 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 157 | rm -f cabal-plan.xz 158 | chmod a+x $HOME/.cabal/bin/cabal-plan 159 | cabal-plan --version 160 | - name: checkout 161 | uses: actions/checkout@v4 162 | with: 163 | path: source 164 | - name: initial cabal.project for sdist 165 | run: | 166 | touch cabal.project 167 | echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project 168 | cat cabal.project 169 | - name: sdist 170 | run: | 171 | mkdir -p sdist 172 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 173 | - name: unpack 174 | run: | 175 | mkdir -p unpacked 176 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 177 | - name: generate cabal.project 178 | run: | 179 | PKGDIR_diagrams_braille="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/diagrams-braille-[0-9.]*')" 180 | echo "PKGDIR_diagrams_braille=${PKGDIR_diagrams_braille}" >> "$GITHUB_ENV" 181 | rm -f cabal.project cabal.project.local 182 | touch cabal.project 183 | touch cabal.project.local 184 | echo "packages: ${PKGDIR_diagrams_braille}" >> cabal.project 185 | echo "package diagrams-braille" >> cabal.project 186 | echo " ghc-options: -Werror=missing-methods" >> cabal.project 187 | cat >> cabal.project <> cabal.project.local 190 | cat cabal.project 191 | cat cabal.project.local 192 | - name: dump install plan 193 | run: | 194 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 195 | cabal-plan 196 | - name: restore cache 197 | uses: actions/cache/restore@v4 198 | with: 199 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 200 | path: ~/.cabal/store 201 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 202 | - name: install dependencies 203 | run: | 204 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 205 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 206 | - name: build w/o tests 207 | run: | 208 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 209 | - name: build 210 | run: | 211 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 212 | - name: cabal check 213 | run: | 214 | cd ${PKGDIR_diagrams_braille} || false 215 | ${CABAL} -vnormal check 216 | - name: haddock 217 | run: | 218 | $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 219 | - name: unconstrained build 220 | run: | 221 | rm -f cabal.project.local 222 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 223 | - name: save cache 224 | if: always() 225 | uses: actions/cache/save@v4 226 | with: 227 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 228 | path: ~/.cabal/store 229 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | *~ 3 | dist-newstyle/ -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2018 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # diagrams-braille 2 | 3 | Functions for rendering diagrams to Braille. 4 | 5 | ``` 6 | ⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣠⠴⠚⠉⠉⠉⠉⠉⠓⠦⣄⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀ 7 | ⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣠⠞⠁⠀⠀⠀⠀⠀⠀⠀⠀⠀⠈⠳⣄⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀ 8 | ⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢰⠃⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠘⡆⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀ 9 | ⠀⠀⠀⠀⣀⣠⠤⠤⠤⠤⢤⣀⣏⣠⠤⠤⠤⠤⢤⣀⣀⣀⡤⠤⠤⠤⠤⣄⣹⣀⡤⠤⠤⠤⠤⣄⣀⠀⠀⠀⠀ 10 | ⠀⢀⡴⠚⠁⠀⠀⠀⠀⠀⣠⠞⣟⠦⡀⠀⠀⠀⣠⠖⠉⠲⣄⠀⠀⠀⢀⡴⣻⠳⣄⠀⠀⠀⠀⠀⠈⠓⢦⡀⠀ 11 | ⢠⠞⠀⠀⠀⠀⠀⠀⢀⡞⠁⠀⢹⡀⠙⣆⠀⡼⠁⠀⠀⠀⠈⢧⠀⣰⠋⢠⡏⠀⠈⢳⡀⠀⠀⠀⠀⠀⠀⠳⡄ 12 | ⡟⠀⠀⠀⠀⠀⠀⠀⡼⠀⠀⠀⠀⠹⣄⠘⣾⠁⠀⠀⠀⠀⠀⠈⣷⠃⣠⠏⠀⠀⠀⠀⢧⠀⠀⠀⠀⠀⠀⠀⢳ 13 | ⡇⠀⠀⠀⠀⠀⠀⣠⡷⠒⠋⠉⠉⠉⠛⣳⣿⣒⡋⠉⠉⠉⠙⣒⣿⣞⠛⠉⠉⠉⠙⠒⢾⣄⠀⠀⠀⠀⠀⠀⢸ 14 | ⡇⠀⠀⠀⠀⣠⠞⠁⢧⠀⠀⠀⠀⢠⠞⢁⣿⠉⢯⡉⠉⢉⡝⠉⣿⡈⠳⡄⠀⠀⠀⠀⣼⠈⠳⣄⠀⠀⠀⠀⢸ 15 | ⠹⡄⠀⠀⣰⠃⠀⠀⠘⣆⠀⠀⢠⠏⢀⡼⠈⢧⠀⢹⣀⡏⠀⡼⠁⢧⡀⠹⡄⠀⠀⣰⠃⠀⠀⠘⣆⠀⠀⢠⠏ 16 | ⠀⠘⢦⡀⣇⣀⣤⠤⠤⢬⣧⣄⣟⣠⣾⠤⠤⠬⣷⣄⣿⣠⣾⠥⠤⠤⣷⣄⣻⣀⣼⡥⠤⠤⢤⣀⣸⢀⡴⠋⠀ 17 | ⠀⠀⣠⠟⡟⠦⠤⣤⣤⡤⣤⠟⡟⢷⡤⢤⣤⡤⢤⠾⣿⠷⡤⢤⣤⣤⢤⡾⢻⠻⣦⢤⣤⣤⠤⠴⢻⠻⣄⠀⠀ 18 | ⢀⡞⠁⠀⢳⠀⠀⠀⢀⡼⠁⠀⢹⡀⠙⣆⠀⡴⠋⢠⠿⡄⠙⢦⠀⣰⠋⢀⡏⠀⠈⢧⡀⠀⠀⠀⡾⠀⠈⢳⡀ 19 | ⡞⠀⠀⠀⠈⢣⡀⠀⡼⠁⠀⠀⠀⠳⡄⠸⣾⠁⣠⠏⠀⠹⣄⠈⣷⠇⢠⠞⠀⠀⠀⠀⢧⠀⢀⡜⠁⠀⠀⠀⢳ 20 | ⡇⠀⠀⠀⠀⠀⠙⠦⣇⡀⠀⠀⠀⠀⠈⣲⣿⡞⠓⠋⠉⠙⠚⢳⣽⣖⠁⠀⠀⠀⠀⢀⣸⠴⠋⠀⠀⠀⠀⠀⢸ 21 | ⡇⠀⠀⠀⠀⠀⠀⠀⣇⠉⠙⠓⠒⢛⡽⢉⣷⠉⠉⠓⠒⠚⠉⠉⣾⡙⢫⡛⠒⠚⠋⠉⣸⠀⠀⠀⠀⠀⠀⠀⢸ 22 | ⠹⡄⠀⠀⠀⠀⠀⠀⠸⣄⠀⠀⢠⠏⠀⡼⠙⣆⠀⠀⠀⠀⠀⣰⠋⢧⠀⠹⡄⠀⠀⣠⠇⠀⠀⠀⠀⠀⠀⢠⠏ 23 | ⠀⠙⢦⡀⠀⠀⠀⠀⠀⠘⢦⡀⡞⣠⠞⠁⠀⠈⠣⣀⠀⣠⠜⠁⠀⠈⠳⣄⢳⢀⡴⠃⠀⠀⠀⠀⠀⢀⡴⠋⠀ 24 | ⠀⠀⠀⠙⠲⠤⣤⣀⣀⣠⡤⠽⡟⠧⣤⣀⣀⣀⡤⠼⠛⠧⢤⣀⣀⣀⣤⠼⢻⠯⢤⣄⣀⣀⣠⠤⠖⠋⠀⠀⠀ 25 | ⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢻⡀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⡏⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀ 26 | ⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢳⡀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⡞⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀ 27 | ⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠙⠦⣄⠀⠀⠀⠀⠀⠀⢀⣠⠴⠋⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀ 28 | ⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠈⠉⠓⠒⠒⠒⠚⠉⠁⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀ 29 | ``` 30 | 31 | This package provides a backend for Diagrams to render tactile Braille graphics. 32 | Additionally, a small frontend command-line program called brldia is 33 | provided which allows to create diagrams from a number of primitive 34 | functions and optional arguments. It basically exports a minimal 35 | version of diagrams-lib to the command-line. See ``brldia --help`` for details. 36 | 37 | ## Usage 38 | 39 | ```shell 40 | brldia circle 1 41 | ``` 42 | 43 | ``` 44 | ⢠⠖⠋⠉⠉⠙⠲⡄ 45 | ⡏⠀⠀⠀⠀⠀⠀⢹ 46 | ⣇⠀⠀⠀⠀⠀⠀⣸ 47 | ⠘⠦⣄⣀⣀⣠⠴⠃ 48 | ``` 49 | 50 | You can also combine various shapes into a single diagram: 51 | 52 | ```shell 53 | brldia --width=32 circle 1 square 1.4 54 | ``` 55 | 56 | ``` 57 | ⠀⠀⢀⡤⠖⠋⠉⠉⠉⠉⠙⠲⢤⡀⠀⠀ 58 | ⠀⡴⡏⠉⠉⠉⠉⠉⠉⠉⠉⠉⠉⢹⢦⠀ 59 | ⡼⠁⡇⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢸⠈⢧ 60 | ⡇⠀⡇⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢸⠀⢸ 61 | ⡇⠀⡇⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢸⠀⢸ 62 | ⢳⡀⡇⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢸⢀⡞ 63 | ⠀⠳⣇⣀⣀⣀⣀⣀⣀⣀⣀⣀⣀⣸⠞⠀ 64 | ⠀⠀⠈⠓⠦⣄⣀⣀⣀⣀⣠⠴⠚⠁⠀⠀ 65 | ``` 66 | 67 | See ``--help`` for a full list of available commands and options. 68 | 69 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | -- A monoidal command line interface to some diagrams primitives 2 | {-# LANGUAGE NoMonomorphismRestriction #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | module Main where 6 | 7 | import Diagrams.Backend.Braille.CmdLine (B, mainWith) 8 | import Diagrams.Backend.CmdLine (Parseable(..)) 9 | import Diagrams.Prelude hiding (option) 10 | import Diagrams.TwoD.Text (Text) 11 | import Options.Applicative 12 | 13 | d = f 1 `atop` f (sqrt 2 / 2) `atop` f (sqrt 2 * (sqrt 2 / 2) / 2) where 14 | f x = circle x `atop` square (x * sqrt 2) 15 | 16 | sol = circle 1 <> atPoints (hexagon 1) (repeat $ circle 1) 17 | fol = circle 1 <> atPoints (hexagon 1) (map (`rotateBy` pedal) [0, 1/6 ..]) 18 | pedal = circle 1 <> circle 1 # translateX 1 # rotateBy (-1/3) 19 | 20 | clock h m = circle 0.35 # fc silver # lwG 0 21 | <> bigHand # f 12 h <> littleHand # f 60 m 22 | <> circle 1 # fc black # lwG 0 23 | <> circle 11 # lwG 1.5 # lc slategray -- # fc lightsteelblue 24 | where 25 | bigHand = (0 ^& (-1.5)) ~~ (0 ^& 7.5) # lwG 0.5 26 | littleHand = (0 ^& (-2)) ~~ (0 ^& 9.5) # lwG 0.2 27 | f n v = rotate (- v / n @@ turn) 28 | 29 | hilbert 0 = mempty 30 | hilbert n = hilbert' (n-1) # reflectY <> vrule 1 31 | <> hilbert (n-1) <> hrule 1 32 | <> hilbert (n-1) <> vrule (-1) 33 | <> hilbert' (n-1) # reflectX 34 | where hilbert' = rotateBy (1/4) . hilbert 35 | 36 | newtype Opts = Opts { draw :: Diagram B } 37 | instance Parseable Opts where parser = Opts . mconcat <$> some diagram 38 | 39 | diagram :: ( TypeableFloat n, Enum n, Read n 40 | , Renderable (Text n) b, Renderable (Path V2 n) b 41 | ) 42 | => Parser (QDiagram b V2 n Any) 43 | diagram = hsubparser $ mconcat [ 44 | commandGroup "Diagrams" 45 | , cmd "strut" "A diagram which produces no output, but with respect to alignment and envelope acts like a 1-dimensional segment oriented along the vector denoted by vx and vy, with local origin at its center." $ 46 | (\x y -> strut (V2 x y)) <$> arg (metavar "vx") <*> arg (metavar "vy") 47 | , cmd "hrule" "A centered horizontal (L-R) line of the given length." $ 48 | hrule <$> arg (metavar "LENGTH") 49 | , cmd "vrule" "A centered vertical (T-B) line of the given length." $ 50 | vrule <$> arg (metavar "LENGTH") 51 | , cmd "triangle" "An equilateral triangle, with sides of the given length and base parallel to the x-axis." $ 52 | triangle <$> arg (metavar "LENGTH") 53 | , cmd "rect" "An axis-aligned rectangle of the given width and height, centered at the origin." $ 54 | rect <$> arg (metavar "WIDTH") 55 | <*> arg (metavar "HEIGHT") 56 | , cmd "roundedRect" "An axis-aligned rectangle with the given width and height with circular rounded corners of radius, centered at the origin." $ 57 | roundedRect <$> arg (metavar "WIDTH") 58 | <*> arg (metavar "HEIGHT") 59 | <*> arg (metavar "RADIUS") 60 | , cmd "square" "A square with its center at the origin and sides of the given length, oriented parallel to the axes." $ 61 | square <$> arg (metavar "LENGTH") 62 | , cmd "pentagon" "A regular pentagon, with sides of the given length and base parallel to the x-axis." $ 63 | pentagon <$> arg (metavar "LENGTH") 64 | , cmd "hexagon" "A regular hexagon, with sides of the given length and base parallel to the x-axis." $ 65 | hexagon <$> arg (metavar "LENGTH") 66 | , cmd "heptagon" "A regular heptagon, with sides of the given length and base parallel to the x-axis." $ 67 | heptagon <$> arg (metavar "LENGTH") 68 | , cmd "octagon" "A regular octagon, with sides of the given length and base parallel to the x-axis." $ 69 | octagon <$> arg (metavar "LENGTH") 70 | , cmd "nonagon" "A regular nonagon, with sides of the given length and base parallel to the x-axis." $ 71 | nonagon <$> arg (metavar "LENGTH") 72 | , cmd "decagon" "A regular decagon, with sides of the given length and base parallel to the x-axis." $ 73 | decagon <$> arg (metavar "LENGTH") 74 | , cmd "hendecagon" "A regular hendecagon, with sides of the given length and base parallel to the x-axis." $ 75 | hendecagon <$> arg (metavar "LENGTH") 76 | , cmd "dodecagon" "A regular dodecagon, with sides of the given length and base parallel to the x-axis." $ 77 | dodecagon <$> arg (metavar "LENGTH") 78 | , cmd "circle" "A circle of the given radius, centered at the origin." $ 79 | circle <$> arg (metavar "RADIUS") 80 | , cmd "cubicSpline" "" $ 81 | cubicSpline <$> switch (long "closed") 82 | <*> some (curry p2 <$> arg (metavar "X") <*> arg (metavar "Y")) 83 | , cmd "arrowAt" "" $ 84 | (\a b c d -> arrowAt (p2 (a, b)) (V2 c d)) <$> arg (metavar "px") 85 | <*> arg (metavar "py") 86 | <*> arg (metavar "vx") 87 | <*> arg (metavar "vy") 88 | , cmd "text" "Print text." $ text <$> strArgument (metavar "STRING") 89 | , cmd "baselineText" "Print text." $ baselineText <$> strArgument (metavar "STRING") 90 | , cmd "clock" "A clock showing the time given in hours and minutes." $ 91 | clock <$> arg (metavar "HOUR") 92 | <*> arg (metavar "MINUTE") 93 | , cmd "flower-of-life" "The \"flower of life\"." $ 94 | pure fol 95 | , cmd "hilbert" "A hilbert curve of the given order." $ 96 | strokeT . hilbert <$> arg (metavar "ORDER") 97 | , cmd "seed-of-life" "The \"seed of life\"." $ pure sol 98 | ] where cmd s d p = command s $ info (foldr ($) <$> p <*> many modifier) $ 99 | progDesc d 100 | arg = argument auto 101 | 102 | modifier :: (Semigroup m, Monoid m, Read n, TypeableFloat n, Renderable (Path V2 n) b) 103 | => Parser (QDiagram b V2 n m -> QDiagram b V2 n m) 104 | modifier = flag' alignL (long "alignL" <> help "Align along the left edge, i.e. translate the diagram in a horizontal direction so that the local origin is on the left edge of the envelope.") 105 | <|> flag' alignR (long "alignR" <> help "Align along the right edge.") 106 | <|> flag' alignT (long "alignT" <> help "Align along the top edge.") 107 | <|> flag' alignB (long "alignB" <> help "Align along the bottom edge.") 108 | <|> flag' centerX (long "centerX" <> help "Center the local origin along the X-axis.") 109 | <|> flag' centerY (long "centerY" <> help "Center the local origin along the Y-axis.") 110 | <|> flag' centerXY (long "centerXY" <> help "Center along both the X- and Y-axes.") 111 | <|> frame <$> option auto (long "frame" <> metavar "SIZE" <> help "Increase the envelope of a diagram by an absolute amount SIZE, SIZE is in the local units of the diagram.") 112 | -- <|> (named :: String -> Diagram B -> Diagram B) <$> option auto (long "named" <> metavar "NAME") 113 | <|> pad <$> option auto (long "pad" <> metavar "FACTOR" <> help "\"pads\" a diagram, expanding its envelope by a FACTOR (factors between 0 and 1 can be used to shrink the envelope).") 114 | <|> flag' reflectX (long "reflectX" <> help "Flip a diagram from left to right, i.e. send the point (x,y) to (-x,y).") 115 | <|> flag' reflectY (long "reflectY" <> help "Flip a diagram from top to bottom, i.e. send the point (x,y) to (x,-y).") 116 | <|> flag' reflectXY (long "reflectXY" <> help "Flips the diagram about x=y, i.e. send the point (x,y) to (y,x).") 117 | <|> rotateBy <$> option auto (long "rotateBy") 118 | <|> scaleX <$> option auto (long "scaleX" <> metavar "FACTOR" <> help "Scale a diagram by the given factor in the x (horizontal) direction.") 119 | <|> scaleY <$> option auto (long "scaleY" <> metavar "FACTOR" <> help "Scale a diagram by the given factor in the y (vertical) direction.") 120 | <|> flag' showOrigin (long "showOrigin") 121 | <|> translateX <$> option auto (long "translateX") 122 | <|> translateY <$> option auto (long "translateY") 123 | 124 | main = mainWith draw 125 | -------------------------------------------------------------------------------- /diagrams-braille.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | name: diagrams-braille 3 | version: 0.1.2 4 | synopsis: Braille diagrams with plain text 5 | description: Please see the README at 6 | category: Graphics 7 | homepage: https://github.com/diagrams/diagrams-braille#readme 8 | bug-reports: https://github.com/diagrams/diagrams-braille/issues 9 | author: Mario Lang 10 | maintainer: mlang@blind.guru, byorgey@gmail.com 11 | copyright: 2018 Mario Lang 12 | license: BSD3 13 | license-file: LICENSE 14 | build-type: Simple 15 | extra-source-files: 16 | README.md 17 | tested-with: GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.5 || ==9.8.2 || ==9.10.1 || ==9.12.1 18 | 19 | source-repository head 20 | type: git 21 | location: https://github.com/diagrams/diagrams-braille 22 | 23 | library 24 | exposed-modules: 25 | Diagrams.Backend.Braille 26 | Diagrams.Backend.Braille.CmdLine 27 | other-modules: 28 | Paths_diagrams_braille 29 | hs-source-dirs: 30 | src 31 | build-depends: 32 | JuicyPixels 33 | , Rasterific >=0.7.4 && <0.8 34 | , base >=4.7 && <5 35 | , containers 36 | , diagrams-core >=1.4 && <1.6 37 | , diagrams-lib >=1.4 && <1.6 38 | , diagrams-rasterific >=1.4 && <1.6 39 | , filepath 40 | , hashable 41 | , lens 42 | , mtl 43 | , optparse-applicative 44 | , time 45 | default-language: Haskell2010 46 | 47 | executable brldia 48 | main-is: Main.hs 49 | other-modules: 50 | Paths_diagrams_braille 51 | hs-source-dirs: 52 | app 53 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 54 | build-depends: 55 | JuicyPixels 56 | , Rasterific >=0.7.4 && <0.8 57 | , base >=4.7 && <5 58 | , containers 59 | , diagrams-braille 60 | , diagrams-core >=1.4 && <1.6 61 | , diagrams-lib >=1.4 && <1.6 62 | , diagrams-rasterific >=1.4 && <1.6 63 | , filepath 64 | , hashable 65 | , lens 66 | , mtl 67 | , optparse-applicative 68 | , time 69 | default-language: Haskell2010 70 | -------------------------------------------------------------------------------- /src/Diagrams/Backend/Braille.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE ExistentialQuantification #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE GADTs #-} 6 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 7 | {-# LANGUAGE MultiParamTypeClasses #-} 8 | {-# LANGUAGE ScopedTypeVariables #-} 9 | {-# LANGUAGE TypeFamilies #-} 10 | {-# LANGUAGE TypeSynonymInstances #-} 11 | {-# LANGUAGE TupleSections #-} 12 | {-# LANGUAGE ViewPatterns #-} 13 | 14 | ------------------------------------------------------------------------------- 15 | -- | A rendering backend for Braille diagrams using Rasterific, 16 | -- implemented natively in Haskell (making it easy to use on any 17 | -- platform). 18 | -- 19 | -- To invoke the Braille backend, you have three options. 20 | -- 21 | -- * You can use the "Diagrams.Backend.Braille.CmdLine" module to create 22 | -- standalone executables which output images when invoked. 23 | -- 24 | -- * You can use the 'renderBraille' function provided by this module, 25 | -- which gives you more flexible programmatic control over when and 26 | -- how images are output (making it easy to, for example, write a 27 | -- single program that outputs multiple images, or one that outputs 28 | -- images dynamically based on user input, and so on). 29 | -- 30 | -- * For the most flexibility (/e.g./ if you want access to the 31 | -- resulting Braille value directly in memory without writing it to 32 | -- disk), you can manually invoke the 'renderDia' method from the 33 | -- 'Diagrams.Core.Types.Backend' instance for @Braille@. In particular, 34 | -- 'Diagrams.Core.Types.renderDia' has the generic type 35 | -- 36 | -- > renderDia :: b -> Options b v n -> QDiagram b v n m -> Result b v n 37 | -- 38 | -- (omitting a few type class constraints). @b@ represents the 39 | -- backend type, @v@ the vector space, @n@ the numeric field, and @m@ the type 40 | -- of monoidal query annotations on the diagram. 'Options' and 'Result' are 41 | -- associated data and type families, respectively, which yield the 42 | -- type of option records and rendering results specific to any 43 | -- particular backend. For @b ~ Braille@, @v ~ V2@, and @n ~ n@, we have 44 | -- 45 | -- > data Options Braille V2 n = BrailleOptions 46 | -- > { _size :: SizeSpec2D n -- ^ The requested size of the output 47 | -- > } 48 | -- 49 | -- @ 50 | -- type family Result Braille V2 n = String 51 | -- @ 52 | -- 53 | -- So the type of 'renderDia' resolves to 54 | -- 55 | -- @ 56 | -- renderDia :: Braille -> Options Braille V2 n -> QDiagram Braille V2 n m -> String 57 | -- @ 58 | -- 59 | -- which you could call like @renderDia Braille (BrailleOptions (mkWidth 80)) 60 | -- myDiagram@. 61 | -- 62 | ------------------------------------------------------------------------------- 63 | module Diagrams.Backend.Braille 64 | ( -- * Braille backend 65 | Braille(..) 66 | , B -- rendering token 67 | , Options(..) 68 | 69 | -- * Rendering 70 | , rasterBraille 71 | , renderBraille 72 | , size 73 | ) where 74 | 75 | import Codec.Picture 76 | import Codec.Picture.Types (convertImage, 77 | promoteImage) 78 | import Control.Lens hiding ((#), transform) 79 | import Control.Monad (when) 80 | import Control.Monad.Reader (ReaderT, runReaderT, ask, local) 81 | import Control.Monad.Writer (Writer, execWriter, tell) 82 | import Data.Bits (setBit) 83 | import Data.Char (chr) 84 | import Data.Foldable (foldMap) 85 | import Data.Hashable (Hashable(..)) 86 | import Data.Maybe (fromMaybe) 87 | import Data.Tree 88 | import Data.Typeable 89 | import Diagrams.Backend.Rasterific.Text 90 | import Diagrams.Core.Compile 91 | import Diagrams.Core.Transform (matrixHomRep) 92 | import Diagrams.Core.Types 93 | import Diagrams.Prelude hiding (local) 94 | import Diagrams.TwoD.Adjust (adjustDia2D) 95 | import Diagrams.TwoD.Text hiding (Font) 96 | import qualified Graphics.Rasterific as R 97 | import Graphics.Rasterific.Texture (Gradient, 98 | linearGradientTexture, 99 | radialGradientWithFocusTexture, 100 | transformTexture, 101 | uniformTexture, 102 | withSampler) 103 | import qualified Graphics.Rasterific.Transformations as R 104 | import System.FilePath (takeExtension) 105 | 106 | data Braille = Braille deriving (Eq, Ord, Read, Show, Typeable) 107 | 108 | type B = Braille 109 | 110 | type instance V Braille = V2 111 | type instance N Braille = Double 112 | 113 | -- | The custom monad in which intermediate drawing options take 114 | -- place; 'Graphics.Rasterific.Drawing' is Rasterific's own rendering 115 | -- monad. 116 | type RenderM n = ReaderT (Style V2 n) (Writer Draw) 117 | 118 | newtype Draw = Draw (R.Drawing PixelRGBA8 (), [((Int, Int), String)]) 119 | deriving (Semigroup, Monoid) 120 | 121 | tellR :: R.Drawing PixelRGBA8 () -> RenderM n () 122 | tellR = tell . Draw . (,mempty) 123 | 124 | tellT :: Int -> Int -> String -> RenderM n () 125 | tellT x y t = tell $ Draw (pure (), [((x, y), t)]) 126 | 127 | runRenderM :: TypeableFloat n => RenderM n a -> Draw 128 | runRenderM = execWriter . (`runReaderT` sty) where 129 | sty = mempty # recommendFillColor transparent # recommendFontSize (output 4) 130 | 131 | instance TypeableFloat n => Backend Braille V2 n where 132 | newtype Render Braille V2 n = R (RenderM n ()) 133 | type Result Braille V2 n = String 134 | data Options Braille V2 n = BrailleOptions 135 | { _sizeSpec :: SizeSpec V2 n -- ^ The requested size of the output 136 | } deriving (Show, Eq) 137 | 138 | renderRTree _ opts t = 139 | foldr drawText (img2brl $ R.renderDrawing (round w) (round h) bgColor r) txt 140 | where 141 | Draw (r, txt) = runRenderM . runR . fromRTree $ t 142 | V2 w h = specToSize 100 (opts^.sizeSpec) 143 | bgColor = PixelRGBA8 0 0 0 0 144 | 145 | adjustDia c opts d = adjustDia2D sizeSpec c opts (d # reflectY) 146 | 147 | drawText ((x, y), t) = unlines . flip (foldr $ uncurry f) (zip [x..] t) . lines 148 | where f x' = set $ element y . element x' 149 | 150 | fromRTree :: TypeableFloat n => RTree Braille V2 n Annotation -> Render Braille V2 n 151 | fromRTree (Node n rs) = case n of 152 | RPrim p -> render Braille p 153 | RStyle sty -> R $ local (<> sty) r 154 | _ -> R r 155 | where R r = foldMap fromRTree rs 156 | 157 | runR :: Render Braille V2 n -> RenderM n () 158 | runR (R r) = r 159 | 160 | instance Semigroup (Render Braille V2 n) where 161 | R rd1 <> R rd2 = R $ rd1 >> rd2 162 | 163 | instance Monoid (Render Braille V2 n) where 164 | mempty = R $ pure () 165 | 166 | instance Hashable n => Hashable (Options Braille V2 n) where 167 | hashWithSalt s (BrailleOptions sz) = s `hashWithSalt` sz 168 | 169 | sizeSpec :: Lens' (Options Braille V2 n) (SizeSpec V2 n) 170 | sizeSpec = lens _sizeSpec (\o s -> o {_sizeSpec = s}) 171 | 172 | rasterificStrokeStyle :: TypeableFloat n => Style v n 173 | -> (n, R.Join, (R.Cap, R.Cap), Maybe (R.DashPattern, n)) 174 | rasterificStrokeStyle s = (strokeWidth, strokeJoin, (strokeCap, strokeCap), strokeDash) 175 | where 176 | strokeWidth = views _lineWidthU (fromMaybe 1) s 177 | strokeJoin = views _lineJoin fromLineJoin s 178 | strokeCap = views _lineCap fromLineCap s 179 | strokeDash = views _dashingU (fmap fromDashing) s 180 | 181 | fromLineCap :: LineCap -> R.Cap 182 | fromLineCap LineCapButt = R.CapStraight 0 183 | fromLineCap LineCapRound = R.CapRound 184 | fromLineCap LineCapSquare = R.CapStraight 1 185 | 186 | fromLineJoin :: LineJoin -> R.Join 187 | fromLineJoin LineJoinMiter = R.JoinMiter 0 188 | fromLineJoin LineJoinRound = R.JoinRound 189 | fromLineJoin LineJoinBevel = R.JoinMiter 1 190 | 191 | fromDashing :: Real n => Dashing n -> (R.DashPattern, n) 192 | fromDashing (Dashing ds d) = (map realToFrac ds, d) 193 | 194 | fromFillRule :: FillRule -> R.FillMethod 195 | fromFillRule EvenOdd = R.FillEvenOdd 196 | fromFillRule _ = R.FillWinding 197 | 198 | rasterificColor :: SomeColor -> Double -> PixelRGBA8 199 | rasterificColor c o = PixelRGBA8 r g b a 200 | where 201 | (r, g, b, a) = (int r', int g', int b', int (o * a')) 202 | (r', g', b', a') = colorToSRGBA (toAlphaColour c) 203 | int x = round (255 * x) 204 | 205 | rasterificSpreadMethod :: SpreadMethod -> R.SamplerRepeat 206 | rasterificSpreadMethod GradPad = R.SamplerPad 207 | rasterificSpreadMethod GradReflect = R.SamplerReflect 208 | rasterificSpreadMethod GradRepeat = R.SamplerRepeat 209 | 210 | rasterificStops :: TypeableFloat n => [GradientStop n] -> Gradient PixelRGBA8 211 | rasterificStops = map fromStop 212 | where 213 | fromStop (GradientStop c v) = (realToFrac v, rasterificColor c 1) 214 | 215 | rasterificLinearGradient :: TypeableFloat n => LGradient n -> R.Texture PixelRGBA8 216 | rasterificLinearGradient g = transformTexture tr tx 217 | where 218 | tr = rasterificMatTransf (inv $ g^.lGradTrans) 219 | tx = withSampler spreadMethod (linearGradientTexture gradDef p0 p1) 220 | spreadMethod = rasterificSpreadMethod (g^.lGradSpreadMethod) 221 | gradDef = rasterificStops (g^.lGradStops) 222 | p0 = p2v2 (g^.lGradStart) 223 | p1 = p2v2 (g^.lGradEnd) 224 | 225 | rasterificRadialGradient :: TypeableFloat n => RGradient n -> R.Texture PixelRGBA8 226 | rasterificRadialGradient g = transformTexture tr tx 227 | where 228 | tr = rasterificMatTransf (inv $ g^.rGradTrans) 229 | tx = withSampler spreadMethod (radialGradientWithFocusTexture gradDef c (realToFrac r1) f) 230 | spreadMethod = rasterificSpreadMethod (g^.rGradSpreadMethod) 231 | c = p2v2 (g^.rGradCenter1) 232 | f = p2v2 (g^.rGradCenter0) 233 | gradDef = rasterificStops ss 234 | 235 | -- Adjust the stops so that the gradient begins at the perimeter of 236 | -- the inner circle (center0, radius0) and ends at the outer circle. 237 | r0 = g^.rGradRadius0 238 | r1 = g^.rGradRadius1 239 | stopFracs = r0 / r1 : map (\s -> (r0 + (s^.stopFraction) * (r1 - r0)) / r1) 240 | (g^.rGradStops) 241 | gradStops = case g^.rGradStops of 242 | [] -> [] 243 | xs@(x:_) -> x : xs 244 | ss = zipWith (\gs sf -> gs & stopFraction .~ sf ) gradStops stopFracs 245 | 246 | -- Convert a diagrams @Texture@ and opacity to a rasterific texture. 247 | rasterificTexture :: TypeableFloat n => Texture n -> Double -> R.Texture PixelRGBA8 248 | rasterificTexture (SC c) o = uniformTexture $ rasterificColor c o 249 | rasterificTexture (LG g) _ = rasterificLinearGradient g 250 | rasterificTexture (RG g) _ = rasterificRadialGradient g 251 | 252 | p2v2 :: Real n => P2 n -> R.Point 253 | p2v2 (P v) = r2v2 v 254 | {-# INLINE p2v2 #-} 255 | 256 | r2v2 :: Real n => V2 n -> R.Point 257 | r2v2 (V2 x y) = R.V2 (realToFrac x) (realToFrac y) 258 | {-# INLINE r2v2 #-} 259 | 260 | rv2 :: (Real n, Fractional n) => Iso' R.Point (P2 n) 261 | rv2 = iso (\(R.V2 x y) -> V2 (realToFrac x) (realToFrac y)) r2v2 . from _Point 262 | {-# INLINE rv2 #-} 263 | 264 | rasterificPtTransf :: TypeableFloat n => T2 n -> R.Point -> R.Point 265 | rasterificPtTransf t = over rv2 (papply t) 266 | 267 | rasterificMatTransf :: TypeableFloat n => T2 n -> R.Transformation 268 | rasterificMatTransf tr = R.Transformation a c e b d f 269 | where 270 | [[a, b], [c, d], [e, f]] = map realToFrac <$> matrixHomRep tr 271 | 272 | -- Note: Using view patterns confuses ghc to think there are missing patterns, 273 | -- so we avoid them here. 274 | renderSeg :: TypeableFloat n => Located (Segment Closed V2 n) -> R.Primitive 275 | renderSeg l = 276 | case viewLoc l of 277 | (p, Linear (OffsetClosed v)) -> 278 | R.LinePrim $ R.Line p' (p' + r2v2 v) 279 | where 280 | p' = p2v2 p 281 | (p, Cubic u1 u2 (OffsetClosed u3)) -> 282 | R.CubicBezierPrim $ R.CubicBezier q0 q1 q2 q3 283 | where 284 | (q0, q1, q2, q3) = (p2v2 p, q0 + r2v2 u1, q0 + r2v2 u2, q0 + r2v2 u3) 285 | 286 | renderPath :: TypeableFloat n => Path V2 n -> [[R.Primitive]] 287 | renderPath p = (map . map) renderSeg (pathLocSegments p) 288 | 289 | -- Stroke both dashed and solid lines. 290 | mkStroke :: TypeableFloat n => n -> R.Join -> (R.Cap, R.Cap) -> Maybe (R.DashPattern, n) 291 | -> [[R.Primitive]] -> R.Drawing PixelRGBA8 () 292 | mkStroke (realToFrac -> l) j c d primList = 293 | maybe (R.stroke l j c $ concat primList) 294 | (\(dsh, off) -> R.dashedStrokeWithOffset (realToFrac off) dsh l j c $ concat primList) 295 | d 296 | 297 | instance TypeableFloat n => Renderable (Path V2 n) Braille where 298 | render _ p = R $ do 299 | sty <- ask 300 | let f = sty ^. _fillTexture 301 | s = sty ^. _lineTexture 302 | o = sty ^. _opacity 303 | r = sty ^. _fillRule 304 | 305 | (l, j, c, d) = rasterificStrokeStyle sty 306 | canFill = anyOf (_head . located) isLoop p && (f ^? _AC) /= Just transparent 307 | rule = fromFillRule r 308 | 309 | -- For stroking we need to keep all of the contours separate. 310 | primList = renderPath p 311 | 312 | -- For filling we need to concatenate them into a flat list. 313 | prms = concat primList 314 | 315 | when canFill $ 316 | tellR (R.withTexture (rasterificTexture f o) $ R.fillWithMethod rule prms) 317 | 318 | tellR (R.withTexture (rasterificTexture s o) $ mkStroke l j c d primList) 319 | 320 | instance TypeableFloat n => Renderable (Text n) Braille where 321 | render _ (Text tr al str) = R $ do 322 | fs <- views _fontSizeU (fromMaybe 12) 323 | slant <- view _fontSlant 324 | fw <- view _fontWeight 325 | let fs' = R.PointSize (realToFrac fs) 326 | fnt = fromFontStyle slant fw 327 | bb = textBoundingBox fnt fs' str 328 | P (V2 x y) = transform tr $ case al of 329 | BaselineText -> 0 ^& 0 330 | BoxAlignedText xt yt -> case getCorners bb of 331 | Just (P (V2 xl yl), P (V2 xu yu)) -> (-lerp' xt xu xl) ^& lerp' yt yu yl 332 | Nothing -> 0 ^& 0 333 | tellT (round $ x / 2) (round $ y / 4) str 334 | where 335 | lerp' t u v = realToFrac $ t * u + (1 - t) * v 336 | 337 | toImageRGBA8 :: DynamicImage -> Image PixelRGBA8 338 | toImageRGBA8 (ImageRGBA8 i) = i 339 | toImageRGBA8 (ImageRGB8 i) = promoteImage i 340 | toImageRGBA8 (ImageYCbCr8 i) = promoteImage (convertImage i :: Image PixelRGB8) 341 | toImageRGBA8 (ImageY8 i) = promoteImage i 342 | toImageRGBA8 (ImageYA8 i) = promoteImage i 343 | toImageRGBA8 (ImageCMYK8 i) = promoteImage (convertImage i :: Image PixelRGB8) 344 | toImageRGBA8 _ = error "Unsupported Pixel type" 345 | 346 | instance TypeableFloat n => Renderable (DImage n Embedded) Braille where 347 | render _ (DImage iD w h tr) = R $ tellR 348 | (R.withTransformation 349 | (rasterificMatTransf (tr <> reflectionY)) 350 | (R.drawImage img 0 p)) 351 | where 352 | ImageRaster dImg = iD 353 | img = toImageRGBA8 dImg 354 | trl = moveOriginBy (r2 (fromIntegral w / 2, fromIntegral h / 2 :: n)) mempty 355 | p = rasterificPtTransf trl (R.V2 0 0) 356 | 357 | -- Saving files -------------------------------------------------------- 358 | 359 | rasterBraille sz = renderDia Braille (BrailleOptions sz) 360 | 361 | -- | Render a 'Braille' diagram to a file with the given size. The 362 | -- format is determined by the extension (@.png@, @.tif@, @.bmp@, @.jpg@ and 363 | -- @.pdf@ supported. 364 | renderBraille :: TypeableFloat n => FilePath -> SizeSpec V2 n 365 | -> QDiagram Braille V2 n Any -> IO () 366 | renderBraille outFile spec d = 367 | case takeExtension outFile of 368 | _ -> writeBrl outFile brl 369 | where 370 | brl = renderDia Braille (BrailleOptions spec) d 371 | 372 | writeBrl = writeFile 373 | 374 | img2brl = img2brl' 8 f where 375 | f (PixelRGBA8 _ _ _ a) | a > 20 = True 376 | f _ = False 377 | 378 | img2brl' dots c img = unlines $ 379 | map (\y -> map (f y) columnIndices) lineIndices where 380 | f y x = chr $ foldr ($) 0x2800 $ take dots $ zipWith ($) [ 381 | g y x True 382 | , let y' = y+1 in g y' x $ y' < h 383 | , let y'' = y+2 in g y'' x $ y'' < h 384 | , let x' = x+1 in g y x' $ x' < w 385 | , let {y' = y+1; x' = x+1} in g y' x' $ y' < h && x' < w 386 | , let {y'' = y+2; x' = x+1} in g y'' x' $ y'' < h && x' < w 387 | , let y''' = y+3 in g y''' x $ y''' < h 388 | , let {y''' = y+3; x' = x+1} in g y''' x' $ y''' < h && x' < w] [0..] 389 | g y x True b a | c $ pixelAt img x y = setBit a b 390 | g _ _ _ _ a = a 391 | lineIndices = [0, (dots `div` 2) .. h - 1] 392 | columnIndices = [0, 2 .. w - 1] 393 | (h, w) = (imageHeight img, imageWidth img) 394 | -------------------------------------------------------------------------------- /src/Diagrams/Backend/Braille/CmdLine.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE TypeFamilies #-} 4 | 5 | {-# OPTIONS_GHC -fno-warn-orphans #-} 6 | 7 | ----------------------------------------------------------------------------- 8 | -- | Convenient creation of command-line-driven executables for 9 | -- rendering diagrams to Braille. 10 | -- 11 | -- * 'defaultMain' creates an executable which can render a single 12 | -- diagram at various options. 13 | -- 14 | -- * 'multiMain' is like 'defaultMain' but allows for a list of 15 | -- diagrams from which the user can choose one to render. 16 | -- 17 | -- * 'mainWith' is a generic form that does all of the above but with 18 | -- a slightly scarier type. See "Diagrams.Backend.CmdLine". This 19 | -- form can also take a function type that has a suitable final result 20 | -- (any of arguments to the above types) and 'Parseable' arguments. 21 | -- 22 | -- For a tutorial on command-line diagram creation see 23 | -- . 24 | -- 25 | ----------------------------------------------------------------------------- 26 | module Diagrams.Backend.Braille.CmdLine ( 27 | -- * General form of @main@ 28 | -- $mainwith 29 | mainWith 30 | 31 | -- * Supported forms of @main@ 32 | , defaultMain 33 | , multiMain 34 | 35 | -- * Backend tokens 36 | , Braille 37 | , B 38 | ) where 39 | 40 | import Diagrams.Backend.CmdLine 41 | import Diagrams.Prelude hiding (height, interval, option, 42 | output, width) 43 | import Diagrams.Backend.Braille 44 | 45 | -- | 'mainWith' specialised to 'Diagram' 'Rasterific'. 46 | defaultMain :: Diagram B -> IO () 47 | defaultMain = mainWith 48 | 49 | instance TypeableFloat n => Mainable (QDiagram B V2 n Any) where 50 | type MainOpts (QDiagram B V2 n Any) = DiagramOpts 51 | 52 | mainRender opts d = chooseRender opts d 53 | 54 | chooseRender :: TypeableFloat n => DiagramOpts -> QDiagram B V2 n Any -> IO () -- -> QDiagram Rasterific V2 n Any -> IO () 55 | chooseRender opts d | null path = putStr $ rasterBraille sz d 56 | | otherwise = renderBraille path sz d 57 | where 58 | path = opts^.output 59 | sz = fromIntegral <$> mkSizeSpec2D (opts^.width) (opts^.height) 60 | 61 | -- | @multiMain@ takes a list of diagrams paired with names as input. 62 | -- The generated executable then takes a @--selection@ option 63 | -- specifying the name of the diagram that should be rendered. The 64 | -- list of available diagrams may also be printed by passing the 65 | -- option @--list@. 66 | multiMain :: [(String, Diagram B)] -> IO () 67 | multiMain = mainWith 68 | 69 | instance TypeableFloat n => Mainable [(String, QDiagram B V2 n Any)] where 70 | type MainOpts [(String, QDiagram B V2 n Any)] 71 | = (MainOpts (QDiagram B V2 n Any), DiagramMultiOpts) 72 | 73 | mainRender = defaultMultiMainRender 74 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-16.22 2 | packages: 3 | - . 4 | --------------------------------------------------------------------------------