diff --git a/Data/Kicad/PcbnewExpr/Parse.hs b/Data/Kicad/PcbnewExpr/Parse.hs --- a/Data/Kicad/PcbnewExpr/Parse.hs +++ b/Data/Kicad/PcbnewExpr/Parse.hs @@ -7,6 +7,7 @@ import Data.Maybe import Control.Applicative import Lens.Family2 (over) +import Data.List (intersperse) import Data.Kicad.SExpr hiding (parse) import qualified Data.Kicad.SExpr as SExpr (parse) @@ -55,6 +56,7 @@ KeyAngle -> PcbnewExprAttribute <$> asDouble PcbnewAngle sxs KeyThickness -> PcbnewExprAttribute <$> asDouble PcbnewThickness sxs KeyWidth -> PcbnewExprAttribute <$> asDouble PcbnewWidth sxs + KeyJustify -> PcbnewExprAttribute <$> asPcbnewJustifyT sxs KeyThermalGap -> PcbnewExprAttribute <$> asDouble PcbnewThermalGap sxs KeyThermalWidth @@ -67,6 +69,8 @@ -> PcbnewExprAttribute <$> asDouble PcbnewMaskMargin sxs KeyClearance -> PcbnewExprAttribute <$> asDouble PcbnewClearance sxs + KeySolderPasteRatio + -> PcbnewExprAttribute <$> asDouble PcbnewSolderPasteRatio sxs KeyFpLine -> PcbnewExprItem <$> asFp defaultPcbnewFpLine sxs KeyFpCircle @@ -120,18 +124,26 @@ Right (PcbnewExprAttribute (PcbnewAt at)) -> interpretRest xs fp_text {itemAt = at} _ -> expecting "'at' expression (e.g. '(at 1.0 1.0)')" a + interpretEffects [] fp_text = fp_text + interpretEffects (e:efs) fp_text = case e of + (PcbnewJustify j) -> + interpretEffects efs (over fpTextJustify (j:) fp_text) + (PcbnewFont size thickness italic) -> + interpretEffects efs + (fp_text + { itemSize = size + , fpTextThickness = thickness + , fpTextItalic = italic + } + ) + _ -> fp_text interpretRest [] fp_text = Right fp_text interpretRest (sx:sxs) fp_text = case fromSExpr sx of Left err -> Left ('\t':err) Right (PcbnewExprAttribute (PcbnewLayer layer)) -> interpretRest sxs (fp_text {itemLayer = layer}) - Right (PcbnewExprAttribute (PcbnewFpTextEffects - (PcbnewFont size thickness italic))) -> - interpretRest sxs (fp_text { itemSize = size - , fpTextThickness = thickness - , fpTextItalic = italic - } - ) + Right (PcbnewExprAttribute (PcbnewFpTextEffects effects)) -> + interpretRest sxs (interpretEffects effects fp_text) Right (PcbnewExprAttribute PcbnewHide) -> interpretRest sxs (fp_text {fpTextHide = True}) _ -> expecting "layer or effects expression or 'hide'" sx @@ -272,15 +284,20 @@ asPcbnewAt x = expecting' "two or three floats or an 'xyz' expression" x + asPcbnewEffects :: [SExpr] -> Either String PcbnewAttribute -asPcbnewEffects [e@(List _)] = - case fromSExpr e of - Left err -> Left ('\t':err) - Right (PcbnewExprAttribute font@(PcbnewFont {})) - -> Right $ PcbnewFpTextEffects font - _ -> expecting "font-expression" e -asPcbnewEffects x = expecting' "one effects-expression (e.g. font)" x +asPcbnewEffects xs = interpretRest xs [] + where + interpretRest [] effects = Right (PcbnewFpTextEffects effects) + interpretRest (sx:sxs) effects = case fromSExpr sx of + Left err -> Left ('\t':err) + Right (PcbnewExprAttribute justify@(PcbnewJustify _)) + -> interpretRest sxs (justify:effects) + Right (PcbnewExprAttribute font@(PcbnewFont _ _ _)) + -> interpretRest sxs (font:effects) + _ -> expecting "font or justify expression" sx + asPcbnewFont :: [SExpr] -> Either String PcbnewAttribute asPcbnewFont xs = interpretRest xs defaultPcbnewFont where @@ -372,6 +389,20 @@ interpretRest sxs model {pcbnewModelRotate = xyz} Right _ -> expecting "only at, scale and rotate" sx asPcbnewModel x = expecting' "model path, at, scale and rotate" x + + +justifyOneOf :: String +justifyOneOf = "one of '" + ++ concat (intersperse ", " (fmap justifyToString [minBound..])) + ++ "'" + + +asPcbnewJustifyT :: [SExpr] -> Either String PcbnewAttribute +asPcbnewJustifyT [sx@(AtomStr s)] = case strToJustify s of + Just j -> Right (PcbnewJustify j) + Nothing -> expecting justifyOneOf sx +asPcbnewJustifyT x = expecting' justifyOneOf x + expecting :: String -> SExpr -> Either String a expecting x y = diff --git a/Data/Kicad/PcbnewExpr/PcbnewExpr.hs b/Data/Kicad/PcbnewExpr/PcbnewExpr.hs --- a/Data/Kicad/PcbnewExpr/PcbnewExpr.hs +++ b/Data/Kicad/PcbnewExpr/PcbnewExpr.hs @@ -14,9 +14,11 @@ , PcbnewPadShapeT(..) , PcbnewPadTypeT(..) , PcbnewFpTextTypeT(..) +, PcbnewJustifyT(..) , PcbnewXyzT , V2Double -- * Lenses and other getters/setters +, fpTextJustify , moduleItems , moduleAttrs , itemLayers @@ -36,6 +38,8 @@ , fpPadShapeToStr , strToFpTextType , fpTextTypeToStr +, strToJustify +, justifyToString -- * Default (empty) instances , defaultPcbnewModule , defaultPcbnewFpText @@ -114,6 +118,7 @@ , itemSize :: V2Double , fpTextThickness :: Double , fpTextItalic :: Bool + , fpTextJustify_ :: [PcbnewJustifyT] } | PcbnewFpLine { itemStart :: V2Double , itemEnd :: V2Double @@ -179,14 +184,15 @@ instance SExpressable PcbnewItem where - toSExpr (PcbnewFpText t s a l h si th i) = + toSExpr (PcbnewFpText t s a l h si th i j) = List $ [ AtomKey KeyFpText , AtomStr $ fpTextTypeToStr t , AtomStr s , toSExpr (PcbnewAt a) , toSExpr (PcbnewLayer l) ] ++ [AtomStr "hide" | h] ++ - [toSExpr $ PcbnewFpTextEffects $ PcbnewFont si th i] + [toSExpr $ PcbnewFpTextEffects ([PcbnewFont si th i] + ++ (fmap PcbnewJustify j))] toSExpr (PcbnewFpLine s e l w) = List [ AtomKey KeyFpLine , toSExpr (PcbnewStart s) @@ -236,7 +242,8 @@ padAttributes f i = (\as -> i {padAttributes_ = as}) `fmap` f (padAttributes_ i) instance AEq PcbnewItem where - (PcbnewFpText t1 s1 a1 l1 h1 si1 th1 i1) ~== (PcbnewFpText t2 s2 a2 l2 h2 si2 th2 i2) = + (PcbnewFpText t1 s1 a1 l1 h1 si1 th1 i1 j1) + ~== (PcbnewFpText t2 s2 a2 l2 h2 si2 th2 i2 j2) = t1 == t2 && s1 == s2 && a1 ~== a2 @@ -245,6 +252,7 @@ && si1 ~== si2 && th1 ~== th2 && i1 == i2 + && j1 == j2 (PcbnewFpLine s1 e1 l1 w1) ~== (PcbnewFpLine s2 e2 l2 w2) = s1 ~== s2 && e1 ~== e2 @@ -285,6 +293,7 @@ , itemSize = (1.0, 1.0) , fpTextThickness = 1.0 , fpTextItalic = False + , fpTextJustify_ = [] } defaultPcbnewFpLine :: PcbnewItem @@ -355,7 +364,7 @@ | PcbnewLayers [PcbnewLayerT] | PcbnewDrill PcbnewDrillT | PcbnewRectDelta V2Double - | PcbnewFpTextEffects PcbnewAttribute + | PcbnewFpTextEffects [PcbnewAttribute] | PcbnewFont { pcbnewFontSize :: V2Double , pcbnewFontThickness :: Double , pcbnewFontItalic :: Bool @@ -374,6 +383,7 @@ | PcbnewXyz PcbnewXyzT | PcbnewCenter V2Double | PcbnewClearance Double + | PcbnewSolderPasteRatio Double | PcbnewMaskMargin Double | PcbnewPasteMargin Double | PcbnewPasteMarginRatio Double @@ -383,8 +393,11 @@ | PcbnewZoneConnect Int | PcbnewThermalWidth Double | PcbnewThermalGap Double + | PcbnewJustify PcbnewJustifyT deriving (Show, Eq) + + type PcbnewXyzT = (Double, Double, Double) instance SExpressable PcbnewAttribute where @@ -420,12 +433,13 @@ ++ [toSExpr (PcbnewOffset (fromJust off)) | isJust off] toSExpr (PcbnewXyz (x,y,z)) = List [AtomKey KeyXyz, AtomDbl x, AtomDbl y, AtomDbl z] - toSExpr (PcbnewFpTextEffects a) = List [AtomKey KeyEffects, toSExpr a] + toSExpr (PcbnewFpTextEffects l) = List $ [AtomKey KeyEffects] ++ fmap toSExpr l toSExpr (PcbnewFpTextType t) = AtomStr $ fpTextTypeToStr t toSExpr (PcbnewModelAt xyz) = List [AtomKey KeyAt , toSExpr xyz] toSExpr (PcbnewModelScale xyz) = List [AtomKey KeyScale , toSExpr xyz] toSExpr (PcbnewModelRotate xyz) = List [AtomKey KeyRotate, toSExpr xyz] toSExpr (PcbnewClearance d) = toSxD KeyClearance d + toSExpr (PcbnewSolderPasteRatio d) = toSxD KeySolderPasteRatio d toSExpr (PcbnewMaskMargin d) = toSxD KeySolderMaskMargin d toSExpr (PcbnewPasteMargin d) = toSxD KeySolderPasteMargin d toSExpr (PcbnewPasteMarginRatio d) = toSxD KeySolderPasteMarginRatio d @@ -451,6 +465,7 @@ toSExpr (PcbnewAutoplaceCost90 i) = toSxD KeyAutoplaceCost90 (fromIntegral i) toSExpr (PcbnewAutoplaceCost180 i) = toSxD KeyAutoplaceCost180 (fromIntegral i) toSExpr (PcbnewZoneConnect i) = toSxD KeyZoneConnect (fromIntegral i) + toSExpr (PcbnewJustify j) = toSxStr KeyJustify (justifyToString j) toSxD :: Keyword -> Double -> SExpr toSxD kw d = List [AtomKey kw, AtomDbl d] @@ -508,7 +523,7 @@ | BCu | BPaste | BMask | DwgsUser | CmtsUser | FAdhes | AllSilk | FandBCu | AllCu | AllMask | AllPaste | EdgeCuts | FCrtYd | BCrtYd | FFab - | BFab + | BFab | Margin | Eco1User | Eco2User | BAdhes | Inner1Cu | Inner2Cu | Inner3Cu | Inner4Cu | Inner5Cu | Inner6Cu | Inner7Cu | Inner8Cu | Inner9Cu | Inner10Cu | Inner11Cu | Inner12Cu | Inner13Cu | Inner14Cu | Inner15Cu @@ -531,6 +546,7 @@ , ("Dwgs.User" , DwgsUser) , ("Cmts.User" , CmtsUser) , ("F.Adhes" , FAdhes) + , ("B.Adhes" , BAdhes) , ("F&B.Cu" , FandBCu) , ("*.Cu" , AllCu ) , ("*.Mask" , AllMask) @@ -541,6 +557,9 @@ , ("F.Fab" , FFab) , ("B.Fab" , BFab) , ("Edge.Cuts" , EdgeCuts) + , ("Margin" , Margin) + , ("Eco1.User" , Eco1User) + , ("Eco2.User" , Eco2User) , ("Inner1.Cu" , Inner1Cu) , ("Inner2.Cu" , Inner2Cu) , ("Inner3.Cu" , Inner3Cu) @@ -619,6 +638,26 @@ fpPadShapeToStr :: PcbnewPadShapeT -> String fpPadShapeToStr t = fromMaybe "" $ lookup t $ map swap strToPadShapeMap +data PcbnewJustifyT = + JustifyLeft | JustifyRight | JustifyTop | JustifyBottom | JustifyMirror + deriving (Show, Eq, Enum, Bounded) + + +strToJustifyMap :: [(String, PcbnewJustifyT)] +strToJustifyMap = + [ ("left" , JustifyLeft) + , ("right" , JustifyRight) + , ("top" , JustifyTop) + , ("bottom", JustifyBottom) + , ("mirror", JustifyMirror) + ] + +strToJustify :: String -> Maybe PcbnewJustifyT +strToJustify s = lookup s strToJustifyMap + +justifyToString :: PcbnewJustifyT -> String +justifyToString t = fromMaybe "" $ lookup t $ map swap strToJustifyMap + data PcbnewAtT = PcbnewAtT { pcbnewAtPoint :: V2Double , pcbnewAtOrientation :: Double } @@ -631,6 +670,12 @@ defaultPcbnewAtT = PcbnewAtT { pcbnewAtPoint = (0,0) , pcbnewAtOrientation = 0 } + +fpTextJustify :: Functor f => LensLike' f PcbnewItem [PcbnewJustifyT] +fpTextJustify f (PcbnewFpText t s a l h si th i j) = + (\j' -> PcbnewFpText t s a l h si th i j') `fmap` f j +fpTextJustify f x = (\_ -> x) `fmap` f [] + atP :: Functor f => LensLike' f PcbnewAtT V2Double atP f (PcbnewAtT p o) = (\p' -> PcbnewAtT p' o) `fmap` f p diff --git a/Data/Kicad/SExpr/Parse.hs b/Data/Kicad/SExpr/Parse.hs --- a/Data/Kicad/SExpr/Parse.hs +++ b/Data/Kicad/SExpr/Parse.hs @@ -20,6 +20,7 @@ parseList :: Parser SExpr parseList = do + spaces char '(' spaces first <- parseKeyword diff --git a/Data/Kicad/SExpr/SExpr.hs b/Data/Kicad/SExpr/SExpr.hs --- a/Data/Kicad/SExpr/SExpr.hs +++ b/Data/Kicad/SExpr/SExpr.hs @@ -39,6 +39,7 @@ | KeyModel | KeyLayers | KeyLayer + | KeyJustify | KeyFpText | KeyFpPoly | KeyFpLine @@ -50,6 +51,7 @@ | KeyDrill | KeyDescr | KeyClearance + | KeySolderPasteRatio | KeyCenter | KeyAutoplaceCost90 | KeyAutoplaceCost180 diff --git a/kicad-data.cabal b/kicad-data.cabal --- a/kicad-data.cabal +++ b/kicad-data.cabal @@ -1,5 +1,5 @@ name: kicad-data -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Parser and writer for KiCad files. license: MIT license-file: LICENSE @@ -31,7 +31,7 @@ -- other-modules: -- other-extensions: build-depends: - base >=4.6 && <4.8 + base >=4.6 && <4.9 , parsec >=3.1 && <3.2 , parsec-numbers >= 0.1.0 && <0.2.0 , lens-family >= 1.1 && <1.2 @@ -49,7 +49,7 @@ main-is: Test.hs build-depends: - base >= 4 && < 5 + base >= 4.6 && < 4.9 , parsec >=3.1 && <3.2 , parsec-numbers >= 0.1.0 && <0.2.0 , lens-family >= 1.1 && <1.2