INblobs-0.1.1: src/Palette.hs

module Palette where

import Data.List (nub, (\\), deleteBy)
import Shape
import Math
import Text.Parse as Parse
import Ports


type ShapeName = String
data Palette a = Palette [ (ShapeName, (Shape, Ports, Maybe a)) ]
  deriving (Eq, Show, Read)

shapes :: Palette a -> [ (ShapeName,(Shape, Ports, Maybe a)) ]
shapes (Palette p) = p

join :: Eq a => Palette a -> Palette a -> Palette a
join (Palette p) (Palette q) = Palette (nub (p++q))

delete :: Eq a => Palette a -> Palette a -> Palette a
delete (Palette p) (Palette q) = Palette (p\\q)

deleteShape :: String -> Palette a -> Palette a
deleteShape name (Palette p) = Palette $ deleteBy equal (name, undefined) p
  where equal (name1,_) (name2,_) = name1 == name2

-- cannot be completely empty, always one default shape
empty :: Palette a
empty = Palette [("circle", (Shape.circle, [], Nothing))]

shapesNames :: Palette a -> [ShapeName]
shapesNames = map fst . shapes

instance Functor Palette where
    fmap _ (Palette p) = Palette (map (\ (n,(s,a,_))-> (n,(s,a,Nothing))) p)

instance Parse a => Parse (Palette a) where
    parse = do{ isWord "Palette"; fmap Palette $ parse }

getSymbol :: ShapeName -> Palette a -> Maybe (Shape, Ports, Maybe a)
getSymbol shapeName = lookup shapeName . shapes