--------------------------------------------------------------------------------
module Smith where
import Complex
-- Plan9 plot Command Interface ------------------------------------------------
pInit = do putStrLn "o"
           putStrLn "ra -110 -110 110 110"
           putStrLn "e"
pColor :: String -> String
pColor colorcode = "co " ++ colorcode
pCircle :: Double ->Double ->Double -> String
pCircle xC yC radius = "ci " ++ show xC ++ " " ++ show yC ++ " " ++ show radius
pDisc xC yC radius = "di " ++ show xC ++ " " ++ show yC ++ " " ++ show radius
pLine x1 y1 x2 y2 = "li " ++ show x1 ++ " " ++ show y1 ++ " " 
                          ++ show x2 ++ " " ++ show y2
pArc x1 y1 x2 y2 xC yC radius = "a " ++ show x1 ++ " " ++ show y1 ++ " " 
                                     ++ show x2 ++ " " ++ show y2 ++ " "
                                     ++ show xC ++ " " ++ show yC ++ " "
                                     ++ show radius
pClose = "cl"

--------------------------------------------------------------------------------
-- Smith Chart Functions -------------------------------------------------------
-- Grids
---- Math functions and constants 
d1 x1 x2 y1 y2 = sqrt((x2 - x1)^2 + (y2 - y1)^2)
a1 x1 x2 r1 r2 d = (x2 + x1) / 2 + (((x2 - x1) * (r1^2 - r2^2)) / (2 * d^2))
b1 y1 y2 r1 r2 d = ((y2 - y1) / (2 * d^2)) 
                    * sqrt(((r1 + r2)^2 - d^2) * (d^2 - (r2 - r1)^2 ))
xInter1 x1 y1 x2 y2 r1 r2 = a1 x1 x2 r1 r2 d + b1 y1 y2 r1 r2 d
                              where d = d1 x1 x2 y1 y2
xInter2 x1 y1 x2 y2 r1 r2 = a1 x1 x2 r1 r2 d - b1 y1 y2 r1 r2 d
                              where d = d1 x1 x2 y1 y2
yInter1 x1 y1 x2 y2 r1 r2 = a1 y1 y2 r1 r2 d - b1 x1 x2 r1 r2 d
                              where d = d1 x1 x2 y1 y2
yInter2 x1 y1 x2 y2 r1 r2 = a1 y1 y2 r1 r2 d + b1 x1 x2 r1 r2 d
                              where d = d1 x1 x2 y1 y2
simX1 x y radius = xInter1 0 0 x y 100 radius
simY1 x y radius = yInter1 0 0 x y 100 radius
simX2 x y radius = xInter2 0 0 x y 100 radius
simY2 x y radius = yInter2 0 0 x y 100 radius

epsilon = 1.0e-100 -- A very small number
--------------------------------------------------------------------------------
xR r i | i < 0 = negative 
       | otherwise = positive
          where positive = xInter2 x1 y1 x2 y2 r1 r2
                negative = xInter1 x1 y1 x2 y2 r1 r2
                x1 = 100 * (r / (1 + r))
                y1 = 100 * 0
                r1 = 100 * (1 / (1 + r))
                x2 = 100 * 1
                y2 = 100 * 1 / (i + epsilon)
                r2 = abs(100 * 1 / (i + epsilon))

yR r i | i < 0 = negative
       | otherwise = positive
          where positive = yInter2 x1 y1 x2 y2 r1 r2
                negative = yInter1 x1 y1 x2 y2 r1 r2
                x1 = 100 * (r / (1 + r))
                y1 = 100 * 0
                r1 = 100 * (1 / (1 + r))
                x2 = 100 * 1
                y2 = 100 * 1 / (i + epsilon)
                r2 = abs(100 * 1 / (i + epsilon))                  
                   

lGrid = pLine (-108) 0 108 0

zGrid t (x:xs) = pCircle xC yC radius : zGrid t xs
                   where xC = (t * 100 * ( x / (1 + x))) 
                         yC = 0 
                         radius = (100 * (1 / (1 + x)))
zGrid t [] = []

xGrid t (x:xs) = pArc x1 y1 x2 y2 xC yC (-1 * abs r) : xGrid t xs
                   where x1 = simX1 xC yC (-1 * r)
                         y1 = simY1 xC yC (-1 * r)
                         x2 = simX2 xC yC (-1 * r)
                         y2 = simY2 xC yC (-1 * r)
                         xC = t * 1 * 100
                         yC = 100 * (1 / (x + epsilon))
                         r = 100 * (1 / (x + epsilon))
xGrid t [] = []

showSmithChart = do putStrLn $ pColor "0xFF9999FF"
                    putStrLn $ pCircle 0 0 100
                    --showGrid
                    putStrLn $ lGrid
                    mapM_ putStrLn $ zGrid (1) [0,1..5]
                    mapM_ putStrLn $ xGrid (1) [-5,-4..5]
                    --frame
                    putStrLn $ pColor "0xFFFFFFFF"
                    mapM_ putStrLn pFrame
                    putStrLn $ pColor "0xC1C1C100"
                    putStrLn $ pCircle 0 0 105
                    putStrLn $ pCircle 0 0 100
                      where pFrame = map (pCircle 0 0) [100.1,100.5..110]

plotSmith z = do putStrLn $ pDisc (xR (realPart z) (imagPart z)) 
                                  (yR (realPart z) (imagPart z)) 1

lineSmith :: [Complex Double] -> IO()
lineSmith (z:zs) = mapM_ putStrLn $ ll (z:zs)
                    where ll (z:zs) | length zs < 1 = [] 
                                    | otherwise = pLine x1 y1 x2 y2 : ll zs
                                        where x1 = xR (zReal z) (zImag z) 
                                              y1 = yR (zReal z) (zImag z)
                                              x2 = xR (zReal next) (zImag next)
                                              y2 = yR (zReal next) (zImag next)
                                              zReal i = realPart i
                                              zImag i = imagPart i 
                                              next = head zs