From 1a9b38627cb8c67a32293d0463a02566ebf7ba27 Mon Sep 17 00:00:00 2001 From: =wolfram= Date: Fri, 18 Sep 2015 16:24:05 +0200 Subject: [PATCH 1/2] First file. --- swimunit.README | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 swimunit.README diff --git a/swimunit.README b/swimunit.README new file mode 100644 index 0000000..0675621 --- /dev/null +++ b/swimunit.README @@ -0,0 +1,12 @@ +Directory Structure +------------------- + + src Sources for Diagrams.Swimunit library + + drv Sources for development and example drivers + + tst Sources for automatized tests + + output/drv Diagrams produced by drivers + + output/tst Diagrams produced by automatized tests From e85c0ed9d7ced1436cf40beda2ca73345637fa9c Mon Sep 17 00:00:00 2001 From: =wolfram= Date: Fri, 18 Sep 2015 16:41:39 +0200 Subject: [PATCH 2/2] First check in and upload. --- CHANGES.markdown | 16 + CONTRIBUTORS | 1 + drv/BaseDriver.sh | 19 + drv/Diagrams/Swimunit/BaseDriver.hs | 33 + .../Swimunit/DotmatrixDarkAlphabetDriver.hs | 120 +++ .../Swimunit/DotmatrixModuleNameDriver.hs | 44 + .../Swimunit/SwimunitModuleNameDriver.hs | 44 + drv/Diagrams/Swimunit/VGridDriver.hs | 72 ++ drv/Diagrams/Swimunit/VPlotDriver.hs | 86 ++ drv/DotmatrixDarkAlphabetDriver.sh | 18 + drv/ModuleNameDriver.sh | 20 + drv/VGridDriver.sh | 18 + drv/VPlotDriver.sh | 18 + src/Diagrams/Swimunit/Axis.hs | 91 ++ src/Diagrams/Swimunit/Base.hs | 60 ++ src/Diagrams/Swimunit/Dotmatrix.hs | 843 ++++++++++++++++++ src/Diagrams/Swimunit/Grid.hs | 38 + src/Diagrams/Swimunit/Plot.hs | 36 + swimunit.README | 14 +- 19 files changed, 1589 insertions(+), 2 deletions(-) create mode 100644 drv/BaseDriver.sh create mode 100644 drv/Diagrams/Swimunit/BaseDriver.hs create mode 100644 drv/Diagrams/Swimunit/DotmatrixDarkAlphabetDriver.hs create mode 100644 drv/Diagrams/Swimunit/DotmatrixModuleNameDriver.hs create mode 100644 drv/Diagrams/Swimunit/SwimunitModuleNameDriver.hs create mode 100644 drv/Diagrams/Swimunit/VGridDriver.hs create mode 100644 drv/Diagrams/Swimunit/VPlotDriver.hs create mode 100644 drv/DotmatrixDarkAlphabetDriver.sh create mode 100644 drv/ModuleNameDriver.sh create mode 100644 drv/VGridDriver.sh create mode 100644 drv/VPlotDriver.sh create mode 100644 src/Diagrams/Swimunit/Axis.hs create mode 100644 src/Diagrams/Swimunit/Base.hs create mode 100644 src/Diagrams/Swimunit/Dotmatrix.hs create mode 100644 src/Diagrams/Swimunit/Grid.hs create mode 100644 src/Diagrams/Swimunit/Plot.hs diff --git a/CHANGES.markdown b/CHANGES.markdown index aa33c94..167206f 100644 --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,3 +1,19 @@ +1.3.6.7 (18 September 2015) +--------------------------- + +* **New features** + +- included package "swimunit". + "swimunit" will be a very versatile plotting library. + As one of its main design goals will be that every part + of the plot can be put together like playing with lego. + In addition error messages are displayed as diagrams in + the plot. + As a goodi "swimunit" comes with a function that generates + a diagram that renders text like beeing displayed on an old + dotmatrix panel. + + 1.3.0.6 (17 September 2015) --------------------------- diff --git a/CONTRIBUTORS b/CONTRIBUTORS index 35834af..3553fdf 100644 --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -9,3 +9,4 @@ Michael Sloan Dominic Steinitz Ryan Yates Brent Yorgey +Wolfram Herkendell diff --git a/drv/BaseDriver.sh b/drv/BaseDriver.sh new file mode 100644 index 0000000..b06bca7 --- /dev/null +++ b/drv/BaseDriver.sh @@ -0,0 +1,19 @@ +# + +if [[ -z $SWIMUNIT_ROOT ]] +then + echo "[FATAL] Environment variable SWIMUNIT_ROOT is not set." + echo " Remedy: Set SWIMUNIT_ROOT to directory of Swimunit sources." + exit -1 +fi + +OUTPUT=$SWIMUNIT_ROOT/output/drv +XRES=999 +YRES=999 + + +cabal run BaseDriver -- --width $XRES --height $YRES --output $OUTPUT/Base.svg + + ## +#### + ## diff --git a/drv/Diagrams/Swimunit/BaseDriver.hs b/drv/Diagrams/Swimunit/BaseDriver.hs new file mode 100644 index 0000000..ead39d0 --- /dev/null +++ b/drv/Diagrams/Swimunit/BaseDriver.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +{-| + + -} +module Main +where + +import Diagrams.Prelude +import Diagrams.Backend.SVG.CmdLine + +import Diagrams.Swimunit.Base + +{-| + MAIN method. Call 'main' to produce output. + -} +main :: IO () +main = mainWith ( + error1 + ) + +error1 :: Diagram B +error1 = errord ( + "[ERROR]{TEST}: " + ++ "<° " + ++ "Victor j@gt zw*lf Boxk#mpfer quer " + ++ "^ber den gro|en Sylter Deich." + ++ " °>" + ) + + -- +---- + -- diff --git a/drv/Diagrams/Swimunit/DotmatrixDarkAlphabetDriver.hs b/drv/Diagrams/Swimunit/DotmatrixDarkAlphabetDriver.hs new file mode 100644 index 0000000..d3259dc --- /dev/null +++ b/drv/Diagrams/Swimunit/DotmatrixDarkAlphabetDriver.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +{-| + + -} +module Main +where + +import Diagrams.Prelude +import Diagrams.Backend.SVG.CmdLine + +import Diagrams.Swimunit.Dotmatrix + +{-| + MAIN method. Call 'main' to produce output. + -} +main :: IO () +main = mainWith ( + let alphabet = ( + withoutDarkDots -- print without panel + === + ( + withoutDarkDots -- print without panel + <> + darkDots -- print panel + ) + ) # centerXY + in alphabet + <> + backgroundrect 1.1 alphabet + # centerXY -- center background + ) + +{-| + Render testing alphabet dotmatrix. + -} +withoutDarkDots :: Diagram B +withoutDarkDots = ( + dotmatrix defdot dotfont_B6x9 line1 # fc blue # lc aqua + === + dotmatrix defdot dotfont_B6x9 line2 # fc blue # lc aqua + === + dotmatrix defdot dotfont_B6x9 line3 # fc blue # lc aqua + === + dotmatrix defdot dotfont_B6x9 line4 # fc blue # lc aqua + === + dotmatrix defdot dotfont_B6x9 line5 # fc blue # lc aqua + === + dotmatrix defdot dotfont_B6x9 line6 # fc blue # lc aqua + === + dotmatrix defdot dotfont_B6x9 line7 # fc blue # lc aqua + === + dotmatrix defdot dotfont_B6x9 "" # fc blue # lc aqua + === + dotmatrix defdot dotfont_B6x9 "" # fc blue # lc aqua + ) + +{-| + Render background panel of testing alphabet. + -} +darkDots :: Diagram B +darkDots = ( + notdotmatrix defdot dotfont_B6x9 line1 # fc black # lc darkslategray + === + notdotmatrix defdot dotfont_B6x9 line2 # fc black # lc darkslategray + === + notdotmatrix defdot dotfont_B6x9 line3 # fc black # lc darkslategray + === + notdotmatrix defdot dotfont_B6x9 line4 # fc black # lc darkslategray + === + notdotmatrix defdot dotfont_B6x9 line5 # fc black # lc darkslategray + === + notdotmatrix defdot dotfont_B6x9 line6 # fc black # lc darkslategray + === + notdotmatrix defdot dotfont_B6x9 line7 # fc black # lc darkslategray + === + notdotmatrix defdot dotfont_B6x9 "" # fc black # lc darkslategray + === + notdotmatrix defdot dotfont_B6x9 "" # fc black # lc darkslategray + ) + +{-| + Define testing alphabet. + -} +line1 :: String +line1 = "ABCDEFGHIJ" -- fully implemented + +line2 :: String +line2 = "KLMNOPQRST" -- fully implemented + +line3 :: String +line3 = "UVWXYZ ÄÖÜ" -- fully implemented + +line4 :: String +line4 = "1234567890" -- fully implemented + +line5 :: String +line5 = "#:,;.+-_!=" -- fully implemented + +line6 :: String +line6 = "&*{}[]'<|>" + +line7 :: String +line7 = "^°~@$%/()?" + +defdot :: Diagram B +defdot = circle 1.0 + +{-| + Define dark background rectangle. + -} +backgroundrect :: Double + -> Diagram B + -> Diagram B +backgroundrect scl diagram = rect ((width diagram) * scl) ((height diagram) * scl) + # lc gray + # fc black + -- +---- + -- diff --git a/drv/Diagrams/Swimunit/DotmatrixModuleNameDriver.hs b/drv/Diagrams/Swimunit/DotmatrixModuleNameDriver.hs new file mode 100644 index 0000000..9a42061 --- /dev/null +++ b/drv/Diagrams/Swimunit/DotmatrixModuleNameDriver.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +{-| + + -} +module Main +where + +import Diagrams.Prelude +import Diagrams.Backend.SVG.CmdLine + +import Diagrams.Swimunit.Dotmatrix + +{-| + MAIN method. Call 'main' to produce output. + -} +main :: IO () +main = mainWith ( + let mname = ( + dotmatrix defdot dotfont_B6x9 "SWIMUNIT.DOTMATRIX" # fc aqua # lc dodgerblue + <> + notdotmatrix defdot dotfont_B6x9 "SWIMUNIT.DOTMATRIX" # fc black # lc darkslategray + ) # centerXY + in mname + <> + backgroundrect 1.1 mname + # centerXY -- center background + ) + +defdot :: Diagram B +defdot = circle 1.0 + +{-| + Define dark background rectangle. + -} +backgroundrect :: Double + -> Diagram B + -> Diagram B +backgroundrect scl diagram = rect ((width diagram) * scl) ((height diagram) * scl) + # lc gray + # fc black + -- +---- + -- diff --git a/drv/Diagrams/Swimunit/SwimunitModuleNameDriver.hs b/drv/Diagrams/Swimunit/SwimunitModuleNameDriver.hs new file mode 100644 index 0000000..1277e5f --- /dev/null +++ b/drv/Diagrams/Swimunit/SwimunitModuleNameDriver.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +{-| + + -} +module Main +where + +import Diagrams.Prelude +import Diagrams.Backend.SVG.CmdLine + +import Diagrams.Swimunit.Dotmatrix + +{-| + MAIN method. Call 'main' to produce output. + -} +main :: IO () +main = mainWith ( + let mname = ( + dotmatrix defdot dotfont_B6x9 "SWIMUNIT" # fc aqua # lc dodgerblue + <> + notdotmatrix defdot dotfont_B6x9 "SWIMUNIT" # fc black # lc darkslategray + ) # centerXY + in mname + <> + backgroundrect 1.1 mname + # centerXY -- center background + ) + +defdot :: Diagram B +defdot = circle 1.0 + +{-| + Define dark background rectangle. + -} +backgroundrect :: Double + -> Diagram B + -> Diagram B +backgroundrect scl diagram = rect ((width diagram) * scl) ((height diagram) * scl) + # lc gray + # fc black + -- +---- + -- diff --git a/drv/Diagrams/Swimunit/VGridDriver.hs b/drv/Diagrams/Swimunit/VGridDriver.hs new file mode 100644 index 0000000..eb118a4 --- /dev/null +++ b/drv/Diagrams/Swimunit/VGridDriver.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +{- | + +-} +module Main +where + +import Diagrams.Prelude +import Diagrams.Backend.SVG.CmdLine + +import Diagrams.Swimunit.Axis +import Diagrams.Swimunit.Grid + +{-| + MAIN method. Call 'main' to produce output. + -} +main :: IO () +main = mainWith ( + gridplot + <> + backgroundrect 1.1 gridplot + # centerXY -- center background + ) + +gridplot :: Diagram B +gridplot = ( vplot + # centerXY -- center plot + ) + +vplot :: Diagram B +vplot = ( verticlabel vml1 0.3 + # fc aqua + ||| ( + verticticks vmt1 0.2 0.0 + # lc lightblue + <> + verticticks vnt1 0.1 (-1.0) + # lc lightblue + ) + ||| + verticgrid vmt1 8.2 + # lc aqua + ||| + verticticks vmt1 0.2 1.0 + # lc lime + ) + +vmt1 :: [Double] +vmt1 = [ 0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0 ] + +{- Minor ticks. -} +vnt1 :: [Double] +vnt1 = [ 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9 + , 2.1, 2.2, 2.3, 2.4, 2.5, 2.6, 2.7, 2.8, 2.9 + , 4.1, 4.2, 4.3, 4.4, 4.5, 4.6, 4.7, 4.8, 4.9 + , 6.1, 6.2, 6.3, 6.4, 6.5, 6.6, 6.7, 6.8, 6.9 ] + +vml1 :: [String] +vml1 = [ "2", "4", "6", "8" ] + +backgroundrect :: Double + -> Diagram B + -> Diagram B +backgroundrect scl diagram = rect ((width diagram) * scl) + ((height diagram) * scl) + # lc green + # fc black + + -- +---- + -- diff --git a/drv/Diagrams/Swimunit/VPlotDriver.hs b/drv/Diagrams/Swimunit/VPlotDriver.hs new file mode 100644 index 0000000..f5b4950 --- /dev/null +++ b/drv/Diagrams/Swimunit/VPlotDriver.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +{-| + +-} +module Main +where + +import Diagrams.Prelude +import Diagrams.Backend.SVG.CmdLine + +import Diagrams.Swimunit.Axis +import Diagrams.Swimunit.Grid +import Diagrams.Swimunit.Plot + + +{-| + MAIN method. Call 'main' to produce output. + -} +main :: IO () +main = mainWith ( + let result = ( + plot + # centerXY -- center + <> + grid + # centerXY + ) + in result + <> + backgroundrect 1.1 result + # centerXY -- center background + ) + +grid :: Diagram B +grid = ( + verticlabel vml1 0.3 # fc lime + ||| ( + verticticks vmt1 0.4 ( 0.0) # lc lime + <> + verticticks vit1 0.2 (-1.0) # lc green + <> + verticaxis 8.5 # lc white + ) ||| + verticgrid vmt1 8.5 # lc blue + ) + +plot :: Diagram B +plot = ( + ploticon xy1 (circle 0.1 # fc blue # lc aqua) + <> + plotline xy1 # lc aqua + ) + +vmt1 :: [Double] +vmt1 = [0.0, 2.0, 4.0, 6.0, 8.0] + +vit1 :: [Double] +vit1 = [ 0.5, 1.0, 1.5, 2.5, 3.0, 3.5, 4.5, 5.0, 5.5, 6.5, 7.0, 7.5 ] + +vml1 :: [String] +vml1 = [ "2", "4", "6", "8" ] + +xy1 :: [(Double, Double)] +xy1 = [(1.0,1.0), + (2.0,3.5), + (3.0,7.1), + (3.5,6.9), + (4.0,2.9), + (4.5,1.1), + (5.0,5.0), + (6.0,5.0), + (7.0,1.3), + (7.5,7.0), + (8.0,8.0)] + +backgroundrect :: Double + -> Diagram B + -> Diagram B +backgroundrect scl diagram = rect ((width diagram) * scl) ((height diagram) * scl) + # lc gray + # fc black + + -- +---- + -- diff --git a/drv/DotmatrixDarkAlphabetDriver.sh b/drv/DotmatrixDarkAlphabetDriver.sh new file mode 100644 index 0000000..c35b1f1 --- /dev/null +++ b/drv/DotmatrixDarkAlphabetDriver.sh @@ -0,0 +1,18 @@ +# + +if [[ -z $SWIMUNIT_ROOT ]] +then + echo "[FATAL] Environment variable SWIMUNIT_ROOT is not set." + echo " Remedy: Set SWIMUNIT_ROOT to directory of Swimunit sources." + exit -1 +fi + +OUTPUT=$SWIMUNIT_ROOT/output/drv +XRES=999 +YRES=999 + +cabal run DotmatrixDarkAlphabetDriver -- --width $XRES --height $YRES --output $OUTPUT/DotmatrixDarkAlphabet.svg + + ## +#### + ## diff --git a/drv/ModuleNameDriver.sh b/drv/ModuleNameDriver.sh new file mode 100644 index 0000000..862acd1 --- /dev/null +++ b/drv/ModuleNameDriver.sh @@ -0,0 +1,20 @@ +# + +if [[ -z $SWIMUNIT_ROOT ]] +then + echo "[FATAL] Environment variable SWIMUNIT_ROOT is not set." + echo " Remedy: Set SWIMUNIT_ROOT to directory of Swimunit sources." + exit -1 +fi + +OUTPUT=$SWIMUNIT_ROOT/output/drv + +XRES=999 +YRES=999 + +cabal run SwimunitModuleNameDriver -- --width $XRES --height $YRES --output $OUTPUT/SwimunitModuleName.svg +cabal run DotmatrixModuleNameDriver -- --width $XRES --height $YRES --output $OUTPUT/DotmatrixModuleName.svg + + ## +#### + ## diff --git a/drv/VGridDriver.sh b/drv/VGridDriver.sh new file mode 100644 index 0000000..54a8c80 --- /dev/null +++ b/drv/VGridDriver.sh @@ -0,0 +1,18 @@ +# + +if [[ -z $SWIMUNIT_ROOT ]] +then + echo "[FATAL] Environment variable SWIMUNIT_ROOT is not set." + echo " Remedy: Set SWIMUNIT_ROOT to directory of Swimunit sources." + exit -1 +fi + +OUTPUT=$SWIMUNIT_ROOT/output/drv +XRES=999 +YRES=999 + +cabal run VGridDriver -- --width $XRES --height $YRES --output $OUTPUT/VGrid.svg + + ## +#### + ## diff --git a/drv/VPlotDriver.sh b/drv/VPlotDriver.sh new file mode 100644 index 0000000..a5d9930 --- /dev/null +++ b/drv/VPlotDriver.sh @@ -0,0 +1,18 @@ +# + +if [[ -z $SWIMUNIT_ROOT ]] +then + echo "[FATAL] Environment variable SWIMUNIT_ROOT is not set." + echo " Remedy: Set SWIMUNIT_ROOT to directory of Swimunit sources." + exit -1 +fi + +OUTPUT=$SWIMUNIT_ROOT/output/drv +XRES=999 +YRES=999 + +cabal --config-file=$SWIMUNIT_ROOT/swimunit.cabal run VPlotDriver -- --width $XRES --height $YRES --output $OUTPUT/VPlot.svg + + ## +#### + ## diff --git a/src/Diagrams/Swimunit/Axis.hs b/src/Diagrams/Swimunit/Axis.hs new file mode 100644 index 0000000..1c2d3b6 --- /dev/null +++ b/src/Diagrams/Swimunit/Axis.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +module Diagrams.Swimunit.Axis +where + +import Diagrams.Prelude +import Diagrams.Backend.SVG.CmdLine + +import Diagrams.Swimunit.Base + +{-| + Constructs the vertical baseline of height height. + -} +verticaxis :: Double + -> Diagram B +verticaxis hght = vrule hght + -- Setting line color here would override color setting of resulting diagram. + -- # lc lime + # alignX (-1.00) + # alignY (-1.00) + +{-| + Constructs the horizontal baseline of width width. + -} +horizaxis :: Double + -> Diagram B +horizaxis wdth = hrule wdth + -- Setting line color here would override color setting of resulting diagram. + -- # lc lime + # alignX (-1.00) + # alignY (-1.00) + +{-| + Constructs horizontal ticks for the vertical axis. + -} +verticticks :: [Double] -- ^ List of y-values for ticks. + -> Double -- ^ Horizontal width covered by each tick. + -> Double -- ^ -1.0 fully in ... 0.0 centered ... +1.0 fully out. + -> Diagram B -- ^ Resulting diagram. +verticticks ylist wdth inout = ( + if (length ylist > 0) + then position (zip (map (\y -> p2(0.0, y)) ylist) + (repeat (hrule wdth # alignX inout)) + ) + else emptyd + ) + +{- + Constructs vertical labels. + -} +verticlabel :: [String] -- ^ List of y-labels. + -> Double -- ^ Text size. + -> Diagram B -- ^ Resulting diagram. +verticlabel ylabel sze = ( + verticlabel' ylabel -- list of y-labels + (map (\s -> p2(0.0, read s)) ylabel) -- list of P2-positions from y-labels + sze -- size + ) + +{-| + Constructs vertical labels from position and string. + -} +verticlabel' :: [String] -- ^ List of y-labels. + -> [P2 Double] -- ^ List of positions. + -> Double -- ^ Text size. + -> Diagram B -- ^ Resulting diagram. +verticlabel' ylabel xypos sze = ( + if (length ylabel > 0) + then position (zip xypos -- list of P2-positions + (map (\s -> (verticlabeltext s sze)) ylabel) -- list of labeling diagrams + ) + else emptyd + ) + +{-| + Constructs the visual representation of one vertical grid label. + -} +verticlabeltext :: String -- ^ List of y-labels. + -> Double -- ^ Text size. + -> Diagram B -- ^ Resulting diagram. +verticlabeltext label sze = ( + alignedText 1.0 0.5 label + # scale sze + <> + hrule sze + ) + + + -- +---- + -- diff --git a/src/Diagrams/Swimunit/Base.hs b/src/Diagrams/Swimunit/Base.hs new file mode 100644 index 0000000..0a0617b --- /dev/null +++ b/src/Diagrams/Swimunit/Base.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +module Diagrams.Swimunit.Base +where + +import Diagrams.Prelude +import Diagrams.Backend.SVG.CmdLine + +import Diagrams.Swimunit.Dotmatrix + +loglevel :: Int +loglevel = debugll + +{-| + 0 Fatal + 1 Error + 2 Warning + 3 Info + 4 Debug + 5 Trace + -} +debugll :: Int +debugll = 4 + +errordot :: Diagram B +errordot = circle 1.0 + +errordotfont :: Dotfont +errordotfont = dotfont_B6x9 + +{-| + Constructs a rectangle with an error message passed as argument. + A medium gray background should offer enough contrast for both light and + dark themes. + -} +errord :: String + -> Diagram B +errord errmsg = ( + dotmatrix errordot errordotfont errmsg + # lc magenta + # fc magenta + <> + rect 1.0 1.0 + # lc magenta + # fc gray + ) + +{-| + This defines an empty diagram which is used almost everytime + when error occurs but the diagram should be rendered anyhow. + + Note that setting this to something visible may help debugging + diagrams produced by swimunit. +-} +emptyd :: Diagram B +emptyd = circle 0.0 + + -- +---- + -- diff --git a/src/Diagrams/Swimunit/Dotmatrix.hs b/src/Diagrams/Swimunit/Dotmatrix.hs new file mode 100644 index 0000000..fd9a019 --- /dev/null +++ b/src/Diagrams/Swimunit/Dotmatrix.hs @@ -0,0 +1,843 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +module Diagrams.Swimunit.Dotmatrix +where + +import qualified Data.Map as Map + +import Diagrams.Prelude +import Diagrams.Backend.SVG.CmdLine + +{-| + Renders list of characters to a diagram where the characters + are shown as if displayed by an old dotmatrix panel. + Only the light emitting dots are shown. + + This function maps a list of n characters passed as third argument + to n dotmatrix characters. + -} +dotmatrix :: Diagram B -- ^ Diagram to show a 'dot'. + -> Dotfont -- ^ The Dotfont to be used. + -> String -- ^ List of characters to be rendered in dotmatrix. + -> Diagram B -- ^ Resulting diagram. +dotmatrix dt fnt txt = dotmatrix' dt fnt False txt + +{-| + Renders list of characters to a diagram where the characters + are shown as if displayed by an old dotmatrix panel. + Only the dark dots are shown. This function is usually used to render + the back panel. + + Function is calling dotmatrix. + -} +notdotmatrix :: Diagram B -- ^ Diagram to show a 'dot'. + -> Dotfont -- ^ The Dotfont to be used. + -> String -- ^ List of characters to be rendered in dotmatrix. + -> Diagram B -- ^ Resulting diagram. +notdotmatrix dt fnt txt = dotmatrix' dt fnt True txt + +{-| + Renders list of characters to a diagram where the characters + are shown as if displayed by an old dotmatrix panel. + Whether light emitting dots or backpanel dots are shown is controlled by third + argument. + + This function maps a list of n characters passed as fourth argument + to n dotmatrix characters. The third argument decides whether the + dots of the font or the dots of the backplane are rendered. + + Devnote: Function loops over list of characters in fourth argument. + -} +dotmatrix' :: Diagram B -- ^ Diagram to show a 'dot'. + -> Dotfont -- ^ The Dotfont to be used. + -> Bool -- ^ True if inverse of font is returned. + -> String -- ^ List of characters to be rendered in dotmatrix. + -> Diagram B -- ^ Resulting diagram. +dotmatrix' dt fnt rev txt = hcat (map (dotcharblock dt fnt rev) txt) + +{-| + Vertically stacks a number of lines of dots prepared by function dotline + to a block of dots representing a Dotchar. + -} +dotcharblock :: Diagram B -- ^ Diagram to show a 'dot'. + -> Dotfont -- ^ The Dotfont to be used. + -> Bool -- ^ If true comparison is inverted. + -> Char -- ^ Character to be mapped to a Dotchar. + -> Diagram B -- ^ Resulting diagram. +dotcharblock dt fnt rev c = vcat (map (dotcharline dt rev) + (dotcharlistoflistsofchars(dotcharmap fnt c)) + ) + +{-| + Maps sequence of Char to a horizontal sequence of dots. + Devnote: Due to partial application the line has to be the last argument. + -} +dotcharline :: Diagram B -- ^ Diagram to show a 'dot'. + -> Bool -- ^ If true comparison is inverted. + -> [Char] -- ^ Squence of characters. + -> Diagram B -- ^ Resulting diagram. +dotcharline dt rev ln = hcat (map (dotornotdot dt rev) ln) + +{-| + Maps a Char to a Dotchar. + If Char has no associated entry the undefined Dotchar is returned. Note that + therefore the mapping to the undefined character has always to be present. + -} +dotcharmap :: Dotfont -- ^ The Dotfont to be used. + -> Char -- ^ Character to be mapped to a bunch of dots. + -> Dotchar -- ^ Resulting dot matrix character. +dotcharmap fnt c = case (Map.lookup c fnt) of + Just x -> x + Nothing -> case (Map.lookup '\0' fnt) of + Just y -> y + Nothing -> Dotchar [[]] + + + +{-| + Function decides whether a character (passed as third argument) + in a character definition is interpreted as a dot or not. + If it is a dot the diagram passed as first argument is rendered + otherwise the phantom of the diagram is returned. + + To make the rendering of the back panel easier the second argument + can invert the decision. + + Devnote: Due to partial application of this function the character deciding + must be the last argument. + -} +dotornotdot :: Diagram B -- ^ Diagram to show a 'dot'. + -> Bool -- ^ If true comparison is inverted. + -> Char -- ^ Character to control generation of 'dot' or empty space ('notdot'). + -> Diagram B -- ^ Resulting diagram. +dotornotdot dt rev c = + if rev + then + if c == ' ' -- add more conditions here + then dt + else (phantom dt) + else + if c /= ' ' -- add more conditions here + then dt + else (phantom dt) + +{-| + A character for Dotmatrix consists of a number of lines of characters. + All characters for a given character set should have the same width and height. + -} +data Dotchar = Dotchar { + dotcharlistoflistsofchars :: [[Char]] + } + +{-| + Defines a font for Dotmatrix which is nothing more than a collection + of Dotcharacters with a map than combines ASCII characters to Dotcharacters. + -} +type Dotfont = Map.Map Char Dotchar + + +{-| + This is the concrete mapping of Char to Dotchar for font B6x9. + -} +dotfont_B6x9 :: Map.Map Char Dotchar +dotfont_B6x9 = Map.fromList ([ + (' ' , dotchar_Blank_B6x9) + , ('#' , dotchar_Hash_B6x9) + , (':' , dotchar_Colon_B6x9) + , (',' , dotchar_Comma_B6x9) + , (';' , dotchar_Semicolon_B6x9) + , ('.' , dotchar_Point_B6x9) + , ('+' , dotchar_Plus_B6x9) + , ('-' , dotchar_Minus_B6x9) + , ('_' , dotchar_Underscore_B6x9) + , ('!' , dotchar_Exclamation_B6x9) + , ('=' , dotchar_Equals_B6x9) + , ('0' , dotchar_0__B6x9) + , ('1' , dotchar_1__B6x9) + , ('2' , dotchar_2__B6x9) + , ('3' , dotchar_3__B6x9) + , ('4' , dotchar_4__B6x9) + , ('5' , dotchar_5__B6x9) + , ('6' , dotchar_6__B6x9) + , ('7' , dotchar_7__B6x9) + , ('8' , dotchar_8__B6x9) + , ('9' , dotchar_9__B6x9) + , ('A' , dotchar_A__B6x9) + , ('a' , dotchar_A__B6x9) + , ('B' , dotchar_B__B6x9) + , ('b' , dotchar_B__B6x9) + , ('C' , dotchar_C__B6x9) + , ('c' , dotchar_C__B6x9) + , ('D' , dotchar_D__B6x9) + , ('d' , dotchar_D__B6x9) + , ('E' , dotchar_E__B6x9) + , ('e' , dotchar_E__B6x9) + , ('F' , dotchar_F__B6x9) + , ('f' , dotchar_F__B6x9) + , ('G' , dotchar_G__B6x9) + , ('g' , dotchar_G__B6x9) + , ('H' , dotchar_H__B6x9) + , ('h' , dotchar_H__B6x9) + , ('I' , dotchar_I__B6x9) + , ('i' , dotchar_I__B6x9) + , ('J' , dotchar_J__B6x9) + , ('j' , dotchar_J__B6x9) + , ('K' , dotchar_K__B6x9) + , ('k' , dotchar_K__B6x9) + , ('L' , dotchar_L__B6x9) + , ('l' , dotchar_L__B6x9) + , ('M' , dotchar_M__B6x9) + , ('m' , dotchar_M__B6x9) + , ('N' , dotchar_N__B6x9) + , ('n' , dotchar_N__B6x9) + , ('O' , dotchar_O__B6x9) + , ('o' , dotchar_O__B6x9) + , ('P' , dotchar_P__B6x9) + , ('p' , dotchar_P__B6x9) + , ('Q' , dotchar_Q__B6x9) + , ('q' , dotchar_Q__B6x9) + , ('R' , dotchar_R__B6x9) + , ('r' , dotchar_R__B6x9) + , ('S' , dotchar_S__B6x9) + , ('s' , dotchar_S__B6x9) + , ('T' , dotchar_T__B6x9) + , ('t' , dotchar_T__B6x9) + , ('U' , dotchar_U__B6x9) + , ('u' , dotchar_U__B6x9) + , ('V' , dotchar_V__B6x9) + , ('v' , dotchar_V__B6x9) + , ('W' , dotchar_W__B6x9) + , ('w' , dotchar_W__B6x9) + , ('X' , dotchar_X__B6x9) + , ('x' , dotchar_X__B6x9) + , ('Y' , dotchar_Y__B6x9) + , ('y' , dotchar_Y__B6x9) + , ('Z' , dotchar_Z__B6x9) + , ('z' , dotchar_Z__B6x9) + , ('\0' , dotchar_Unmapped_B6x9) -- Only mapping that unconditionally has to be present. + ]) + +dotchar_Hash_B6x9 :: Dotchar +dotchar_Hash_B6x9 = Dotchar + [" " + ," # # " + ," # # " + ,"##### " + ," # # " + ,"##### " + ," # # " + ," # # " + ," "] + +dotchar_Blank_B6x9 :: Dotchar +dotchar_Blank_B6x9 = Dotchar + [" " + ," " + ," " + ," " + ," " + ," " + ," " + ," " + ," "] + +dotchar_Colon_B6x9 :: Dotchar +dotchar_Colon_B6x9 = Dotchar + [" " + ," " + ," " + ," :: " + ," :: " + ," " + ," :: " + ," :: " + ," "] + +dotchar_Comma_B6x9 :: Dotchar +dotchar_Comma_B6x9 = Dotchar + [" " + ," " + ," " + ," " + ," " + ," ,, " + ," ,, " + ," ,, " + ," ,, "] + +dotchar_Semicolon_B6x9 :: Dotchar +dotchar_Semicolon_B6x9 = Dotchar + [" " + ," " + ," " + ," ;; " + ," " + ," ;; " + ," ;; " + ," ;; " + ," ;; "] + +dotchar_Point_B6x9 :: Dotchar +dotchar_Point_B6x9 = Dotchar + [" " + ," " + ," " + ," " + ," " + ," " + ," .. " + ," .. " + ," "] + +dotchar_Plus_B6x9 :: Dotchar +dotchar_Plus_B6x9 = Dotchar + [" " + ," " + ," + " + ," + " + ,"+++++ " + ," + " + ," + " + ," " + ," "] + +dotchar_Minus_B6x9 :: Dotchar +dotchar_Minus_B6x9 = Dotchar + [" " + ," " + ," " + ," " + ,"----- " + ," " + ," " + ," " + ," "] + +dotchar_Equals_B6x9 :: Dotchar +dotchar_Equals_B6x9 = Dotchar + [" " + ," " + ," " + ,"===== " + ," " + ,"===== " + ," " + ," " + ," "] + +dotchar_Underscore_B6x9 :: Dotchar +dotchar_Underscore_B6x9 = Dotchar + [" " + ," " + ," " + ," " + ," " + ," " + ," " + ," " + ,"_____ "] + +dotchar_Exclamation_B6x9 :: Dotchar +dotchar_Exclamation_B6x9 = Dotchar + [" " + ," ! " + ," ! " + ," ! " + ," ! " + ," ! " + ," " + ," ! " + ," "] + +dotchar_0__B6x9 :: Dotchar +dotchar_0__B6x9 = Dotchar + [" " + ," 000 " + ,"0 0 " + ,"00 0 " + ,"0 0 0 " + ,"0 00 " + ,"0 0 " + ," 000 " + ," "] + +dotchar_1__B6x9 :: Dotchar +dotchar_1__B6x9 = Dotchar + [" " + ," 1 " + ," 11 " + ,"1 1 " + ," 1 " + ," 1 " + ," 1 " + ,"1111 " + ," "] + +dotchar_2__B6x9 :: Dotchar +dotchar_2__B6x9 = Dotchar + [" " + ," 222 " + ,"2 2 " + ," 2 " + ," 2 " + ," 2 " + ," 2 " + ,"22222 " + ," "] + +dotchar_3__B6x9 :: Dotchar +dotchar_3__B6x9 = Dotchar + [" " + ,"33333 " + ," 3 " + ," 3 " + ," 333 " + ," 3 " + ," 3 " + ,"3333 " + ," "] + +dotchar_4__B6x9 :: Dotchar +dotchar_4__B6x9 = Dotchar + [" " + ," 44 " + ," 4 4 " + ," 4 4 " + ,"44444 " + ," 4 " + ," 4 " + ," 4 " + ," "] + +dotchar_5__B6x9 :: Dotchar +dotchar_5__B6x9 = Dotchar + [" " + ,"55555 " + ,"5 " + ,"5 " + ,"5555 " + ," 5 " + ,"5 5 " + ," 555 " + ," "] + +dotchar_6__B6x9 :: Dotchar +dotchar_6__B6x9 = Dotchar + [" " + ," 666 " + ,"6 " + ,"6 " + ,"6666 " + ,"6 6 " + ,"6 6 " + ," 666 " + ," "] + +dotchar_7__B6x9 :: Dotchar +dotchar_7__B6x9 = Dotchar + [" " + ,"77777 " + ," 7 " + ," 7 " + ," 7 " + ," 7 " + ," 7 " + ," 7 " + ," "] + +dotchar_8__B6x9 :: Dotchar +dotchar_8__B6x9 = Dotchar + [" " + ," 888 " + ,"8 8 " + ,"8 8 " + ," 888 " + ,"8 8 " + ,"8 8 " + ," 888 " + ," "] + +dotchar_9__B6x9 :: Dotchar +dotchar_9__B6x9 = Dotchar + [" " + ," 999 " + ,"9 9 " + ,"9 9 " + ," 9999 " + ," 9 " + ," 9 " + ," 999 " + ," "] + +dotchar_A__B6x9 :: Dotchar +dotchar_A__B6x9 = Dotchar + [" " + ," AAA " + ,"A A " + ,"A A " + ,"AAAAA " + ,"A A " + ,"A A " + ,"A A " + ," "] + + +{- +dotchar_AE_B6x9 :: Dotchar +dotchar_AE_B6x9 = Dotchar + [" Ä Ä " + ," " + ," ÄÄÄ " + ,"Ä Ä " + ,"Ä Ä " + ,"ÄÄÄÄÄ " + ,"Ä Ä " + ,"Ä Ä " + ," "] +-} + +dotchar_B__B6x9 :: Dotchar +dotchar_B__B6x9 = Dotchar + [" " + ,"BBBB " + ," B B " + ," B B " + ," BBB " + ," B B " + ," B B " + ,"BBBB " + ," "] + +dotchar_C__B6x9 :: Dotchar +dotchar_C__B6x9 = Dotchar + [" " + ," CCC " + ,"C C " + ,"C " + ,"C " + ,"C " + ,"C C " + ," CCC " + ," "] + +dotchar_D__B6x9 :: Dotchar +dotchar_D__B6x9 = Dotchar + [" " + ,"DDDD " + ," D C " + ," D D " + ," D D " + ," D D " + ," D D " + ,"DDDD " + ," "] + +dotchar_E__B6x9 :: Dotchar +dotchar_E__B6x9 = Dotchar + [" " + ,"EEEEE " + ,"E " + ,"E " + ,"EEEE " + ,"E " + ,"E " + ,"EEEEE " + ," "] + +dotchar_F__B6x9 :: Dotchar +dotchar_F__B6x9 = Dotchar + [" " + ,"FFFFF " + ,"F " + ,"F " + ,"FFFF " + ,"F " + ,"F " + ,"F " + ," "] + +dotchar_G__B6x9 :: Dotchar +dotchar_G__B6x9 = Dotchar + [" " + ," GGGG " + ,"G " + ,"G " + ,"G 66G " + ,"G G " + ,"G G " + ," GGG " + ," "] + +dotchar_H__B6x9 :: Dotchar +dotchar_H__B6x9 = Dotchar + [" " + ,"H H " + ,"H H " + ,"H H " + ,"HHHHH " + ,"H H " + ,"H H " + ,"H H " + ," "] + +dotchar_I__B6x9 :: Dotchar +dotchar_I__B6x9 = Dotchar + [" " + ," III " + ," I " + ," I " + ," I " + ," I " + ," I " + ," III " + ," "] + +dotchar_J__B6x9 :: Dotchar +dotchar_J__B6x9 = Dotchar + [" " + ," JJJ " + ," J " + ," J " + ," J " + ," J " + ,"J J " + ," JJ " + ," "] + +dotchar_K__B6x9 :: Dotchar +dotchar_K__B6x9 = Dotchar + [" " + ,"K K " + ,"K K " + ,"K K " + ,"KK " + ,"K K " + ,"K K " + ,"K K " + ," "] + +dotchar_L__B6x9 :: Dotchar +dotchar_L__B6x9 = Dotchar + [" " + ,"L " + ,"L " + ,"L " + ,"L " + ,"L " + ,"L " + ,"LLLLL " + ," "] + + +dotchar_M__B6x9 :: Dotchar +dotchar_M__B6x9 = Dotchar + [" " + ,"M M " + ,"MM MM " + ,"MM MM " + ,"W M M " + ,"M M " + ,"M M " + ,"M M " + ," "] + +dotchar_N__B6x9 :: Dotchar +dotchar_N__B6x9 = Dotchar + [" " + ,"N N " + ,"N N " + ,"NN N " + ,"N N N " + ,"N NN " + ,"N NN " + ,"N N " + ," "] + +dotchar_O__B6x9 :: Dotchar +dotchar_O__B6x9 = Dotchar + [" " + ," OOO " + ,"O O " + ,"O O " + ,"O O " + ,"O O " + ,"O O " + ," OOO " + ," "] + + +{- +dotchar_OE_B6x9 :: Dotchar +dotchar_OE_B6x9 = Dotchar + [" Ö Ö " + ," " + ," ÖÖÖ " + ,"Ö Ö " + ,"Ö Ö " + ,"Ö Ö " + ,"Ö Ö " + ," ÖÖÖ " + ," "] +-} + +dotchar_P__B6x9 :: Dotchar +dotchar_P__B6x9 = Dotchar + [" " + ,"PPPP " + ,"P P " + ,"P P " + ,"PPPP " + ,"P " + ,"P " + ,"P " + ," "] + +dotchar_Q__B6x9 :: Dotchar +dotchar_Q__B6x9 = Dotchar + [" " + ," QQQ " + ,"Q Q " + ,"Q Q " + ,"Q Q " + ,"Q Q Q " + ,"Q QQ " + ," QQQQ " + ," Q"] + +dotchar_R__B6x9 :: Dotchar +dotchar_R__B6x9 = Dotchar + [" " + ,"RRRR " + ,"R R " + ,"R R " + ,"RRRR " + ,"R R " + ,"R R " + ,"R R " + ," "] + +dotchar_S__B6x9 :: Dotchar +dotchar_S__B6x9 = Dotchar + [" " + ," SSS " + ,"S S " + ,"S " + ," SSS " + ," S " + ,"S S " + ," SSS " + ," "] + +dotchar_T__B6x9 :: Dotchar +dotchar_T__B6x9 = Dotchar + [" " + ,"TTTTT " + ," T " + ," T " + ," T " + ," T " + ," T " + ," T " + ," "] + +dotchar_U__B6x9 :: Dotchar +dotchar_U__B6x9 = Dotchar + [" " + ,"U U " + ,"U U " + ,"U U " + ,"U U " + ,"U U " + ,"U U " + ," UUU " + ," "] + +{- +dotchar_UE_B6x9 :: Dotchar +dotchar_UE_B6x9 = Dotchar + [" Ü Ü " + ," " + ,"Ü Ü " + ,"Ü Ü " + ,"Ü Ü " + ,"Ü Ü " + ,"Ü Ü " + ," ÜÜÜ " + ," "] +-} + +dotchar_V__B6x9 :: Dotchar +dotchar_V__B6x9 = Dotchar + [" " + ,"V V " + ,"V V " + ,"V V " + ,"V V " + ," V V " + ," V V " + ," V " + ," "] + +dotchar_W__B6x9 :: Dotchar +dotchar_W__B6x9 = Dotchar + [" " + ,"W W " + ,"W W " + ,"W W " + ,"W W W " + ,"W W W " + ,"WW WW " + ,"W W " + ," "] + +dotchar_X__B6x9 :: Dotchar +dotchar_X__B6x9 = Dotchar + [" " + ,"X X " + ,"X X " + ," X X " + ," X " + ," X X " + ,"X X " + ,"X X " + ," "] + +dotchar_Y__B6x9 :: Dotchar +dotchar_Y__B6x9 = Dotchar + [" " + ,"Y Y " + ,"Y Y " + ," Y Y " + ," Y " + ," Y " + ," Y " + ," Y " + ," "] + +dotchar_Z__B6x9 :: Dotchar +dotchar_Z__B6x9 = Dotchar + [" " + ,"ZZZZZ " + ," Z " + ," Z " + ," Z " + ," Z " + ,"Z " + ,"ZZZZZ " + ," "] + +dotchar_Unmapped_B6x9 :: Dotchar +dotchar_Unmapped_B6x9 = Dotchar + [" " + ,"+ + + " + ," + + " + ,"+ + + " + ," + + " + ,"+ + + " + ," + + " + ,"+ + + " + ," "] + + -- +---- + -- diff --git a/src/Diagrams/Swimunit/Grid.hs b/src/Diagrams/Swimunit/Grid.hs new file mode 100644 index 0000000..4d7560c --- /dev/null +++ b/src/Diagrams/Swimunit/Grid.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +module Diagrams.Swimunit.Grid +where + +import Diagrams.Prelude +import Diagrams.Backend.SVG.CmdLine + +import Diagrams.Swimunit.Base + +{- + Constructs the vertical grid without baseline. + -} +verticgrid :: [Double] -- ^ List of y-values for gridlines. + -> Double -- ^ Horizontal width covered by this grid. + -> Diagram B -- ^ Resulting diagram. +verticgrid ylist wdth = ( + if (length ylist > 0) + then position (zip (map (\y -> p2(0.0, y)) ylist) (repeat (hrule wdth))) + else emptyd + ) + +{- + Constructs the horizontal grid without baseline. + -} +horizgrid :: [Double] -- ^ List of x-values for gridlines. + -> Double -- ^ Vertical height covered by this grid. + -> Diagram B -- ^ Resulting diagram. +horizgrid xlist hght = ( + if (length xlist > 0) + then position (zip (map (\x -> p2(x, 0.0)) xlist) (repeat (vrule hght))) + else emptyd + ) + + + -- +---- + -- diff --git a/src/Diagrams/Swimunit/Plot.hs b/src/Diagrams/Swimunit/Plot.hs new file mode 100644 index 0000000..bdf51fb --- /dev/null +++ b/src/Diagrams/Swimunit/Plot.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +module Diagrams.Swimunit.Plot +where + +import Diagrams.Prelude +import Diagrams.Backend.SVG.CmdLine + +import Diagrams.Swimunit.Base + +{- + Constructs the vertical grid. + -} +plotline :: [(Double, Double)] -- ^ List of (x,y)-values for lines. + -> Diagram B -- ^ Resulting diagram. +plotline xy = ( + if (length xy > 0) + then strokeLocLine ( fromVertices (map p2 xy) ) + else emptyd + ) + +ploticon' :: [(Double, Double)] -- ^ List of (x,y)-values for lines. + -> [Diagram B] -- ^ List of Diagrams to be used as icons for each point. + -> Diagram B -- ^ Resulting diagram. +ploticon' xy icons = if (length xy > 0) + then position (zip (map p2 xy) icons) + else emptyd + +ploticon :: [(Double, Double)] -- ^ List of (x,y)-values for lines. + -> Diagram B -- ^ A Diagram to be used as an icon for the point. + -> Diagram B -- ^ Resulting diagram. +ploticon xy icon = ploticon' xy (repeat icon) + + -- +---- + -- diff --git a/swimunit.README b/swimunit.README index 0675621..18e335b 100644 --- a/swimunit.README +++ b/swimunit.README @@ -1,5 +1,15 @@ -Directory Structure -------------------- +Work In Progress +---------------- + +* Lowercase letters for Dotmatrix +* Horizontal grid +* Enhanced plot +* Barplot +* More and better documentation + + +Directory Structure of Swimunit +------------------------------- src Sources for Diagrams.Swimunit library