{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module Data.GCode.Types (
Class(..)
, AxisDesignator(..)
, ParamDesignator(..)
, Axes
, Params
, Limits
, ParamLimits
, Code(..)
, GCode
, codecls
, axis
, axis'
, param
, param'
, CodeMod
, cls
, num
, sub
, axes
, params
, comment
, appmod
, eval
, emptyCode
, defaultPrec
, Style(..)
, defaultStyle
) where
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Semigroup hiding (option)
import Control.Monad.State.Strict
import Control.Applicative
import qualified Data.Map.Strict as M
data Class =
G
| M
| T
| StP
| StF
| StS
deriving (Show, Enum, Eq, Ord)
data AxisDesignator =
X
| Y
| Z
| A
| B
| C
| E
| L
deriving (Show, Enum, Eq, Ord)
data ParamDesignator =
S
| P
| F
| R
deriving (Show, Enum, Eq, Ord)
codecls :: Char -> Class
codecls 'G' = G
codecls 'M' = M
codecls 'T' = T
codecls 'P' = StP
codecls 'F' = StF
codecls 'S' = StS
axis :: Char -> AxisDesignator
axis 'X' = X
axis 'Y' = Y
axis 'Z' = Z
axis 'A' = A
axis 'B' = B
axis 'C' = C
axis 'E' = E
axis 'L' = L
param :: Char -> ParamDesignator
param 'S' = S
param 'P' = P
param 'F' = F
param 'R' = R
type Axes = M.Map AxisDesignator Double
type Limits = M.Map AxisDesignator (Double, Double)
type Params = M.Map ParamDesignator Double
type ParamLimits = M.Map ParamDesignator (Double, Double)
type GCode = [Code]
data Code =
Code {
codeCls :: Maybe Class
, codeNum :: Maybe Int
, codeSub :: Maybe Int
, codeAxes :: Axes
, codeParams :: Params
, codeComment :: B.ByteString
}
| Comment B.ByteString
| Empty
| Other B.ByteString
deriving (Show, Eq, Ord)
newtype CodeMod = CodeMod
{ applyCodeMod :: Code -> Code }
instance Monoid CodeMod where
mempty = CodeMod id
mappend = (<>)
instance Semigroup CodeMod where
m1 <> m2 = CodeMod $ applyCodeMod m1 . applyCodeMod m2
cls :: Class -> CodeMod
cls x = CodeMod $ \c -> c { codeCls = Just x}
num :: Int -> CodeMod
num x = CodeMod $ \c -> c { codeNum = Just x}
sub :: Int -> CodeMod
sub x = CodeMod $ \c -> c { codeSub = Just x}
axes :: Axes -> CodeMod
axes x = CodeMod $ \c -> c { codeAxes = x}
axis' :: AxisDesignator -> Double -> CodeMod
axis' des val = CodeMod $ \c -> c { codeAxes = M.insert des val $ codeAxes c }
params :: Params -> CodeMod
params x = CodeMod $ \c -> c { codeParams = x}
param' :: ParamDesignator -> Double -> CodeMod
param' des val = CodeMod $ \c -> c { codeParams = M.insert des val $ codeParams c }
comment :: B.ByteString -> CodeMod
comment x = CodeMod $ \c -> c { codeComment = x}
appmod :: CodeMod -> Code -> Code
appmod m c = applyCodeMod m c
eval = undefined
emptyCode = Code Nothing Nothing Nothing M.empty M.empty ""
data Style =
Style {
stylePrecision :: Int
, styleColorful :: Bool
} deriving (Show)
defaultPrec :: Int
defaultPrec = 6
defaultStyle = Style defaultPrec False