module FMP.Types (
HasMed(..), HasDefault(..),
Dir(..), Pen(..), Pattern(..),
Equation(..), Boolean(..), BoolRelat(..),
Point(..), Numeric(..),
FunPPP(..), FunPN(..), FunNN(..), FunNNN(..), FunNsN(..),
HasRelax(..), HasCond(..),
penSquare, penCircle,
dashed, dotted, dashPattern, dashPattern',
boolean, equations,
vec, dir, xy, (.*),
pi, exp, log, sqrt, (**) ,
sin, cos, tan,
asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh,
pythAdd, xpart, ypart, angle, minimum', maximum',
width, height, xdist, ydist, dist,
(.=), (.==), (./=), (.<) , (.<=), equal,
whatever,
Name(..), global ,ref, var, (<+), (<*),
IsName(..)
) where
import Prelude ( Real(..), Enum(..), Floating(..), Fractional(..), Num(..), Ord(..)
, takeWhile, map, iterate, fromIntegral, (.), Read(..), Show(..)
, Eq(..), Double, Int, id, Char, error, otherwise, Bool(..), (||)
, String, Integral(..)
)
infixr 0 <+, <*
infixr 5 .=
infixr 7 .*
class HasWhatever a where
whatever :: a
class HasRelax a where
relax :: a
class HasMed a where
med :: Numeric -> a -> a-> a
class HasCond a where
cond :: Boolean -> a -> a -> a
class HasDefault a where
default' :: a
data Dir = C | N | NE | E | SE | S | SW | W | NW
deriving (Eq, Read, Show, Enum, Ord)
instance Num Dir where
a + b = toEnum (fromEnum a + fromEnum b)
a b = toEnum (fromEnum a fromEnum b)
a * b = toEnum (fromEnum a * fromEnum b)
negate C = C
negate d = toEnum (if i >= 5
then mod (i+5) 9
else mod (i+4) 9)
where i = fromEnum d
abs = id
signum C = C
signum _ = N
fromInteger a = toEnum (mod (fromInteger a) 9)
data Pen = DefaultPen
| PenSquare (Numeric, Numeric) Numeric
| PenCircle (Numeric, Numeric) Numeric
deriving (Eq, Show, Read)
instance Num Pen where
PenCircle (a1, b1) c1 + PenCircle (a2, b2) c2
= PenCircle (a1 + a2, b1 + b2) ((c1+c2)/2)
a + _ = a
PenCircle (a1, b1) c1 PenCircle (a2, b2) c2
= PenCircle (a1 a2, b1 b2) ((c1+c2)/2)
a _ = a
PenCircle (a1, b1) c1 * PenCircle (a2, b2) c2
= PenCircle (a1 * a2, b1 * b2) ((c1+c2)/2)
a * _ = a
negate a = a
abs a = a
signum _ = 1
fromInteger a = PenCircle (fromInteger a, fromInteger a) 0
instance Fractional Pen where
PenCircle (a1, b1) c1 / PenCircle (a2, b2) c2
= PenCircle (a1 / a2, b1 / b2) ((c1+c2)/2)
a / _ = a
recip (PenCircle (a, b) c)
= PenCircle (1 / a, 1 / b) c
recip a = 1 / a
fromRational a = PenCircle (fromRational a, fromRational a) 0
instance HasDefault Pen where
default' = DefaultPen
penSquare :: (Numeric, Numeric) -> Numeric -> Pen
penSquare = PenSquare
penCircle :: (Numeric, Numeric) -> Numeric -> Pen
penCircle = PenCircle
data Pattern = DefaultPattern
| DashPattern [Double]
deriving (Eq, Show, Read)
instance HasDefault Pattern where
default' = DefaultPattern
dashPattern :: [Double] -> Pattern
dashPattern = DashPattern
dashPattern' :: [Double] -> Pattern
dashPattern' p = dashPattern (1:p)
dashed :: Pattern
dashed = DashPattern [3, 3]
dotted :: Pattern
dotted = DashPattern [1, 1, 0, 1]
class IsEquation a where
(.=) :: a -> a -> Equation
equal :: [a] -> Equation
class IsBoolean a where
(.==) :: a -> a -> Boolean
(./=) :: a -> a -> Boolean
(.<) :: a -> a -> Boolean
(.<=) :: a -> a -> Boolean
data Equation = NEquations [Numeric]
| PEquations [Point]
| Equations [Equation]
| EquationCond Boolean Equation Equation
deriving (Eq, Show, Read)
data Boolean = Boolean Bool
| BoolNum Numeric BoolRelat Numeric
| BoolPnt Point BoolRelat Point
| BoolOr Boolean Boolean
| BoolAnd Boolean Boolean
| BoolNot Boolean
deriving (Eq, Show, Read, Ord)
data BoolRelat = BoolEQ | BoolL | BoolLE | BoolNE
deriving (Eq, Show, Read, Ord)
instance IsEquation Numeric where
n1 .= n2 = NEquations [n1, n2]
equal = NEquations
instance IsEquation Point where
p1 .= p2 = PEquations [p1, p2]
equal = PEquations
instance IsBoolean Numeric where
n1 .== n2 = BoolNum n1 BoolEQ n2
n1 ./= n2 = BoolNum n1 BoolNE n2
n1 .< n2 = BoolNum n1 BoolL n2
n1 .<= n2 = BoolNum n1 BoolLE n2
instance IsBoolean Point where
p1 .== p2 = BoolPnt p1 BoolEQ p2
p1 ./= p2 = BoolPnt p1 BoolNE p2
p1 .< p2 = BoolPnt p1 BoolL p2
p1 .<= p2 = BoolPnt p1 BoolLE p2
instance Num Boolean where
a + b = BoolOr a b
a b = a * (b)
a * b = BoolAnd a b
negate a = BoolNot a
abs _ = Boolean True
signum a = a
fromInteger a = Boolean (a>0)
instance HasCond Equation where
cond b t e = EquationCond b t e
boolean :: Bool -> Boolean
boolean = Boolean
equations :: [Equation] -> Equation
equations = Equations
data Name = NameInt Int
| NameStr String
| NameDir Dir
| Hier Name Name
| Global Name
deriving (Show, Read, Eq, Ord)
global :: (IsName a) => a -> Name
global = Global . removeGlobals . toName
hasGlobal :: Name -> Bool
hasGlobal (Global _) = True
hasGlobal (Hier a b) = hasGlobal a || hasGlobal b
hasGlobal _ = False
globalToFront :: Name -> Name
globalToFront a
| hasGlobal a = Global (removeGlobals a)
| otherwise = a
removeGlobals :: Name -> Name
removeGlobals (Global a) = removeGlobals a
removeGlobals (Hier a b) = Hier (removeGlobals a) (removeGlobals b)
removeGlobals a = a
class IsName a where
toName :: a -> Name
toNameList :: [a] -> Name
toNameList [] = error "toNameList undefined for []"
toNameList [l] = toName l
toNameList (l:ls) = Hier (toName l) (toNameList ls)
(<+) :: (IsName a, IsName b) => a -> b -> Name
a <+ b = globalToFront (Hier (toName a) (toName b))
(<*) :: (IsName a) => Int -> a -> Name
a <* b = a <+ b
instance IsName Int where
toName n = NameInt (fromIntegral n)
instance IsName Char where
toName n = NameStr [n]
toNameList = NameStr
instance IsName Dir where
toName = NameDir
instance (IsName a) => IsName [a] where
toName = toNameList
instance IsName Name where
toName = id
ref :: IsName a => a -> Point
ref = PointVar . toName
var :: IsName a => a -> Numeric
var = NumericVar . toName
data Point = PointPic' Int Dir
| PointVar' Int Int
| PointVarArray' Int Int
| PointTrans' Point [Int]
| PointVar Name
| PointVec (Numeric, Numeric)
| PointMediate Numeric Point Point
| PointDirection Numeric
| PointWhatever
| PointPPP FunPPP Point Point
| PointNMul Numeric Point
| PointNeg Point
| PointCond Boolean Point Point
deriving (Eq, Show, Read, Ord)
data FunPPP = PPPAdd
| PPPSub
| PPPDiv
deriving (Eq, Show, Read, Ord)
instance HasCond Point where
cond b t e = PointCond b t e
instance Num Point where
a + b = addPoint a b
a b = subPoint a b
a * b = mulPoint a b
negate a = negPoint a
abs a = absPoint a
signum 0 = 0
signum _ = 1
fromInteger a = PointVec (fromInteger a, fromInteger a)
(.*) :: Numeric -> Point -> Point
n .* PointVec (a1, a2) = PointVec (n*a1, n*a2)
n .* p = PointNMul n p
addPoint :: Point -> Point -> Point
addPoint (PointVec (a1,a2)) (PointVec (b1,b2))
= PointVec (a1+b1, a2+b2)
addPoint a b = PointPPP PPPAdd a b
subPoint :: Point -> Point -> Point
subPoint (PointVec (a1,a2)) (PointVec (b1,b2))
= PointVec (a1b1, a2b2)
subPoint a b = PointPPP PPPSub a b
mulPoint :: Point -> Point -> Point
mulPoint (PointVec (a1,a2)) (PointVec (b1,b2))
= PointVec (a1*b1, a2*b2)
mulPoint p PointWhatever = PointNMul NumericWhatever p
mulPoint PointWhatever p = PointNMul NumericWhatever p
mulPoint a b = PointVec (xpart a*xpart b, ypart a*ypart b)
negPoint :: Point -> Point
negPoint (PointVec (a1,a2)) = PointVec (a1, a2)
negPoint a = PointNeg a
absPoint :: Point -> Point
absPoint (PointVec (a1,a2)) = PointVec (abs a1, abs a2)
absPoint a = a
vec :: (Numeric, Numeric) -> Point
vec = PointVec
dir :: Numeric -> Point
dir a = vec (cos a, sin a)
xy :: Point -> Point -> Point
xy p1 p2 = vec (xpart p1, ypart p2)
instance HasMed Point where
med = PointMediate
instance HasWhatever Point where
whatever = PointWhatever
data Numeric = NumericVar' Int Int
| NumericArray' Int Int
| NumericVar Name
| Numeric Double
| NumericWhatever
| NumericDist Point Point
| NumericMediate Numeric Numeric Numeric
| NumericPN FunPN Point
| NumericNN FunNN Numeric
| NumericNNN FunNNN Numeric Numeric
| NumericNsN FunNsN [Numeric]
| NumericCond Boolean Numeric Numeric
deriving (Eq, Show, Read, Ord)
data FunPN = PNXPart
| PNYPart
| PNAngle
deriving (Eq, Show, Read, Ord)
data FunNN = NNSinD
| NNCosD
| NNSqrt
| NNExp
| NNLog
| NNRound
| NNCeil
| NNFloor
| NNNeg
deriving (Eq, Show, Read, Ord)
data FunNNN = NNNAdd
| NNNSub
| NNNMul
| NNNDiv
| NNNPyth
| NNNPower
deriving (Eq, Show, Read, Ord)
data FunNsN = NsNMin
| NsNMax
deriving (Eq, Show, Read, Ord)
instance HasCond Numeric where
cond b t e = NumericCond b t e
instance Num Numeric where
a + b = addNumeric a b
a b = subNumeric a b
a * b = mulNumeric a b
negate a = negNumeric a
abs a = absNumeric a
signum 0 = 0
signum _ = 1
fromInteger a = Numeric (fromInteger a)
addNumeric :: Numeric -> Numeric -> Numeric
addNumeric (Numeric a) (Numeric b)
= Numeric (a+b)
addNumeric a b = NumericNNN NNNAdd a b
subNumeric :: Numeric -> Numeric -> Numeric
subNumeric (Numeric a) (Numeric b)
= Numeric (ab)
subNumeric a b = NumericNNN NNNSub a b
mulNumeric :: Numeric -> Numeric -> Numeric
mulNumeric (Numeric a) (Numeric b)
= Numeric (a*b)
mulNumeric a b = NumericNNN NNNMul a b
negNumeric :: Numeric -> Numeric
negNumeric (Numeric a) = Numeric (a)
negNumeric a = NumericNN NNNeg a
absNumeric :: Numeric -> Numeric
absNumeric (Numeric a) = Numeric (abs a)
absNumeric a = cond (a .<0) (1*a) (a)
radAngle :: (Numeric, Numeric) -> Numeric
radAngle p = angle (PointVec p) * pi/180
instance Fractional Numeric where
Numeric n1 / Numeric n2 = Numeric (n1 / n2)
n1 / n2 = NumericNNN NNNDiv n1 n2
recip (Numeric a) = Numeric (recip a)
recip n = 1 / n
fromRational = Numeric . fromRational
instance Floating Numeric where
pi = Numeric pi
exp (Numeric a) = Numeric (exp a)
exp a = NumericNN NNExp a
log (Numeric a) = Numeric (log a)
log a = NumericNN NNLog a
sqrt (Numeric a) = Numeric (sqrt a)
sqrt a = NumericNN NNSqrt a
(**) a b = NumericNNN NNNPower a b
sin (Numeric a) = Numeric (sin a)
sin a = NumericNN NNSinD (a*180/pi)
cos (Numeric a) = Numeric (cos a)
cos a = NumericNN NNCosD (a*180/pi)
tan (Numeric a) = Numeric (tan a)
tan a = sin a / cos a
asin a = radAngle (sqrt (1a*a), a)
acos a = radAngle (a, sqrt (1a*a))
atan a = radAngle (1, a)
sinh a = (exp a exp (a)) / 2
cosh a = (exp a + exp (a)) / 2
tanh a = (exp a exp (a)) / (exp a + exp (a))
asinh a = log (sqrt (a*a+1) + a)
acosh a = log (sqrt (a*a1) + a)
atanh a = (log (1+a) log (1a)) / 2
instance Enum Numeric where
toEnum = Numeric . fromIntegral
fromEnum (Numeric a) = fromEnum a
fromEnum _ = 0
enumFrom a = enumFromThen a (a+1)
enumFromThen a b = iterate (+(ba)) a
enumFromTo a@(Numeric _) c@(Numeric _)
= takeWhile (<=c) (enumFrom a)
enumFromThenTo (Numeric a) (Numeric b) (Numeric c)
= map Numeric
(takeWhile (if b >= a then (<=c) else (>=c))
(enumFromThen a b))
instance Real Numeric where
toRational (Numeric a) = toRational a
toRational _ = 0
pythAdd :: Numeric -> Numeric -> Numeric
pythAdd = NumericNNN NNNPyth
xpart :: Point -> Numeric
xpart (PointVec (a, _)) = a
xpart a = NumericPN PNXPart a
ypart :: Point -> Numeric
ypart (PointVec (_, a)) = a
ypart a = NumericPN PNYPart a
angle :: Point -> Numeric
angle = NumericPN PNAngle
width :: IsName a => a -> Numeric
width s = xpart (ref (s <+ E))
xpart (ref (s <+ W))
height :: IsName a => a -> Numeric
height s = ypart (ref (s <+ N))
ypart (ref (s <+ S))
xdist :: Point -> Point -> Numeric
xdist p1 p2 = xpart p1 xpart p2
ydist :: Point -> Point -> Numeric
ydist p1 p2 = ypart p1 ypart p2
dist :: Point -> Point -> Numeric
dist p1 p2 = NumericDist p1 p2
maximum' :: [Numeric] -> Numeric
maximum' [a] = a
maximum' as = NumericNsN NsNMax as
minimum' :: [Numeric] -> Numeric
minimum' [a] = a
minimum' as = NumericNsN NsNMin as
instance HasMed Numeric where
med = NumericMediate
instance HasWhatever Numeric where
whatever = NumericWhatever