{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.GCode.Pretty(ppGCode, ppGCodeLine, ppGCodeCompact, ppGCodeLineCompact) where
import Data.ByteString.Char8 (pack, unpack)
import qualified Data.Text as T
import qualified Data.Map.Strict as M
import Data.Maybe
import Text.PrettyPrint.ANSI.Leijen
import Data.GCode.Types
import Data.GCode.Utils
import Data.Double.Conversion.Text
ppGCode :: GCode -> String
ppGCode = ppGCodeStyle defaultStyle
ppGCodeStyle :: Style -> GCode -> String
ppGCodeStyle style res = displayS (renderPretty 0.4 80 (ppGCode' style res)) ""
ppGCodeLine :: Code -> String
ppGCodeLine = ppGCodeLineStyle defaultStyle
ppGCodeLineStyle :: Style -> Code -> String
ppGCodeLineStyle style res = displayS (renderPretty 0.4 80 (ppCode style res)) ""
ppGCodeCompact :: GCode -> String
ppGCodeCompact = ppGCodeCompactStyle defaultStyle
ppGCodeCompactStyle :: Style -> GCode -> String
ppGCodeCompactStyle style res = displayS (renderCompact (ppGCode' style res)) ""
ppGCodeLineCompact :: Code -> String
ppGCodeLineCompact = ppGCodeLineCompactStyle defaultStyle
ppGCodeLineCompactStyle :: Style -> Code -> String
ppGCodeLineCompactStyle style res = displayS (renderCompact (ppCode style res)) ""
ppList pp x = hsep $ map pp x
ppGCode' style = vsep . map (ppCode style)
ppMaybe pp (Just x) = pp x
ppMaybe pp Nothing = empty
ppMaybeClass = ppMaybe ppClass
ppClass G = yellow $ text "G"
ppClass M = red $ text "M"
ppClass T = magenta $ text "T"
ppClass StP = red $ text "P"
ppClass StF = red $ text "F"
ppClass StS = red $ text "S"
ccMaybes (Just cls) (Just num) = cc cls num
ccMaybes _ _ = id
cc G 0 = dullyellow
cc G 1 = yellow
cc _ _ = red
ppAxis style (des, val) =
bold (axisColor des $ text $ show des)
<> cyan (text $ T.unpack $ toPrecision (stylePrecision style) val)
axisColor X = red
axisColor Y = green
axisColor Z = yellow
axisColor A = red
axisColor B = green
axisColor C = blue
axisColor E = magenta
ppAxes _ [] = empty
ppAxes style x = space <> ppList (ppAxis style) x
ppParam style (des, val) =
bold (blue $ text $ show des)
<> white (text $ T.unpack $ toPrecision (stylePrecision style) val)
ppParams _ [] = empty
ppParams style x = space <> ppList (ppParam style) x
ppComment "" = empty
ppComment c = space <> ppComment' c
ppComment' "" = empty
ppComment' c = dullwhite $ parens $ text $ unpack c
ppCode style Code{..} =
ccMaybes codeCls codeNum ( bold $ ppMaybeClass codeCls)
<> ccMaybes codeCls codeNum ( ppMaybe (text . show) codeNum)
<> ppAxes style (M.toList codeAxes)
<> ppParams style (M.toList codeParams)
<> ppComment codeComment
ppCode _ (Comment x) = ppComment' x
ppCode _ (Other x) = dullred $ text $ unpack x
ppCode _ (Empty) = empty
{-# INLINE ppCode #-}