--
-- Copyright (c) William Tennien Murphy 2011
--

module TextPlot
(TextPlot
,Plot(Plot)
,PlotParam(PlotParam)
,PlotPolar(PlotPolar)
,insertF
,insertParam
,insertPolar
,Draw
,printPlot
,export
,view
) where
import Data.List
import System.IO

type TextPlot = [[Char]]


-- | Specifies a set of functions to be graphed in Cartesian coordinates
data Plot = Plot {xminOf :: Double, -- ^ left x-bound of the graph
				  xmaxOf :: Double, -- ^ right x-bound of the graph
				  xDensityOf :: Int, -- ^ number of characters along the x-axis
				  yminOf :: Double,  -- ^ left y-bound of the graph
				  ymaxOf :: Double, --  right y-bound of the graph
				  yDensityOf :: Int, -- ^ number of characters along the y-axis
				  functionsOf :: [(Double -> Double)] -- ^ a list of functions of the form y = f(x)
				  }
				  
instance Show Plot where
	show plot = "Bounds: " ++ xmin ++ " < x < " ++ xmax ++ "\n" ++ 
				"        " ++ ymin ++ " < y < " ++ ymax ++ "\n" ++ 
				"X-axis Precision: " ++ xden ++ "\n" ++
				"Y-axis Precision: " ++ yden ++ "\n" ++
				"Functions Plotted: " ++ lenf
				where xmin = show . xminOf $ plot
				      xmax = show . xmaxOf $ plot
				      xden = show . xDensityOf $ plot
				      ymin = show . yminOf $ plot
				      ymax = show . ymaxOf $ plot
				      yden = show . yDensityOf $ plot
				      lenf = show . length . functionsOf $ plot


-- | Specifies a set of parametric functions to be graphed in Cartesian coordinates
data PlotParam = PlotParam {pxminOf :: Double, -- ^ left x-bound of the graph
							pxmaxOf :: Double, -- ^ right x-bound of the graph
							pxDensityOf :: Int, -- ^ number of characters along the x-axis
							pyminOf :: Double, -- ^ left y-bound of the graph
							pymaxOf :: Double, --  right y-bound of the graph
							pyDensityOf :: Int, -- ^ number of characters along the y-axis
							pfunctionsOf :: [(Double -> (Double,Double),Double,Double,Int)] 
							} 

instance Show PlotParam where
	show plot = "Bounds: " ++ xmin ++ " < x < " ++ xmax ++ "\n" ++ 
				"        " ++ ymin ++ " < y < " ++ ymax ++ "\n" ++ 
				"X-axis Precision: " ++ xden ++ "\n" ++
				"Y-axis Precision: " ++ yden ++ "\n" ++
				"Functions Plotted: " ++ lenf
				where xmin = show . pxminOf $ plot
				      xmax = show . pxmaxOf $ plot
				      xden = show . pxDensityOf $ plot
				      ymin = show . pyminOf $ plot
				      ymax = show . pymaxOf $ plot
				      yden = show . pyDensityOf $ plot
				      lenf = show . length . pfunctionsOf $ plot
	

-- | Specifies a set of functions to be graphed in polar coordinates
data PlotPolar = PlotPolar {plxminOf :: Double, -- ^ left x-bound of the graph
							plxmaxOf :: Double, -- ^ right x-bound of the graph
							plxDensityOf :: Int, -- ^ number of characters along the x-axis
							plyminOf :: Double, -- ^ left y-bound of the graph
							plymaxOf :: Double, --  right y-bound of the graph
							plyDensityOf :: Int, -- ^ number of characters along the y-axis
							plfunctionsOf :: [(Double -> Double,Double,Double,Int)] -- ^ a list of functions of the form r = f(theta)
							} 

instance Show PlotPolar where
	show plot = "Bounds: " ++ xmin ++ " < x < " ++ xmax ++ "\n" ++ 
				"        " ++ ymin ++ " < y < " ++ ymax ++ "\n" ++ 
				"X-axis Precision: " ++ xden ++ "\n" ++
				"Y-axis Precision: " ++ yden ++ "\n" ++
				"Functions Plotted: " ++ lenf
				where xmin = show . plxminOf $ plot
				      xmax = show . plxmaxOf $ plot
				      xden = show . plxDensityOf $ plot
				      ymin = show . plyminOf $ plot
				      ymax = show . plymaxOf $ plot
				      yden = show . plyDensityOf $ plot
				      lenf = show . length . plfunctionsOf $ plot

-- | adds a function to a @Plot@
insertF :: (Double -> Double) -> Plot -> Plot
insertF f plot = plot {functionsOf = f:(functionsOf plot)}

-- | adds a function to a @PlotParam@
insertParam :: ((Double -> (Double,Double)),Double,Double,Int) -> PlotParam -> PlotParam
insertParam f plot = plot {pfunctionsOf = f:(pfunctionsOf plot)}

-- | adds a function to a @PlotPolar@
insertPolar :: ((Double -> Double),Double,Double,Int) -> PlotPolar -> PlotPolar
insertPolar f plot = plot {plfunctionsOf = f:(plfunctionsOf plot)}

-- | 
class Draw a where 
	draw :: a -> TextPlot

instance Draw Plot where
	draw plot = transpose . subDraw $ (xminOf plot) 
		where row = replicate (yDensityOf plot) ' '
		      xmax = xmaxOf plot
		      xIncr = (xmaxOf plot - xminOf plot) / (fromIntegral (xDensityOf plot) - 1)
		      yIncr = (ymaxOf plot - yminOf plot) / (fromIntegral (yDensityOf plot) - 1)
		      fs = [ (\x -> round $ (f x - yminOf plot) / yIncr) | f <- functionsOf plot]
		      subDraw x
		      	| x > xmax = []
		      	| otherwise = reverse (replaces (map (\f -> f x) fs) '*' row) : subDraw (x + xIncr)

instance Draw PlotParam where
	draw plot = transpose . subDraw 0 $ points
		where row = replicate (pyDensityOf plot) ' '
		      xIncr  = (pxmaxOf plot - pxminOf plot) / (fromIntegral (pxDensityOf plot) - 1)
		      yIncr  = (pymaxOf plot - pyminOf plot) / (fromIntegral (pyDensityOf plot) - 1)
		      points = concat $ map each (pfunctionsOf plot)
				where each (f,tmin,tmax,tden) = [adjust (f t) | t <- [tmin,(tmin + tIncr)..tmax]]
					where adjust (x,y) = (round $ (x - pxminOf plot) / xIncr, round $ (y - pyminOf plot) / yIncr)
					      tIncr = (tmax - tmin) / (fromIntegral tden - 1)
		      subDraw x fs
		      	| x >= pxDensityOf plot = []
		      	| otherwise = reverse (replaces (fst $ rowPoints) '*' row) : subDraw (x + 1) (snd $ rowPoints)
				where rowPoints = foldl (\(toUse,rest) (a,b) -> if a == x then (b:toUse,rest) else (toUse,(a,b):rest)) ([],[]) fs


instance Draw PlotPolar where
	draw plot = transpose . subDraw 0 $ points
		where row = replicate (plyDensityOf plot) ' '
		      xIncr  = (plxmaxOf plot - plxminOf plot) / (fromIntegral (plxDensityOf plot) - 1)
		      yIncr  = (plymaxOf plot - plyminOf plot) / (fromIntegral (plyDensityOf plot) - 1)
		      points = concat $ map each (plfunctionsOf plot)
				where each (f,tmin,tmax,tden) = [adjust (t,(f t)) | t <- [tmin,(tmin + tIncr)..tmax]]
					where adjust (th,r) = (round $ (x - plxminOf plot) / xIncr, round $ (y - plyminOf plot) / yIncr)
							where x = r*cos th
							      y = r*sin th
					      tIncr = (tmax - tmin) / (fromIntegral tden - 1)
		      subDraw x fs
		      	| x >= plxDensityOf plot = []
		      	| otherwise = reverse (replaces (fst $ rowPoints) '*' row) : subDraw (x + 1) (snd $ rowPoints)
				where rowPoints = foldl (\(toUse,rest) (a,b) -> if a == x then (b:toUse,rest) else (toUse,(a,b):rest)) ([],[]) fs

-- | prints a @TextPlot@ to the terminal
printPlot :: TextPlot -> IO()
printPlot = mapM_ putStrLn 

-- | writes a @TextPlot@ to a specified file name
export ::  String -> TextPlot -> IO()
export name (first:rest) = do
	writeFile name first
	mapM_ (appendFile name . ("\n" ++)) rest

-- | prints the a @TextPlot@ from a file to the terminal
view :: String -> IO()
view name = do 
	contents <- readFile name 
	putStrLn contents

--example functions
bob = Plot 0 10 100 0 10 100 [(\x -> 3*sin(x/2) + 3),(\x -> x^5 / 16)]


--Utilities
replace :: Int -> a -> [a] -> [a]
replace n char xs = if 0 <= n && n <= length xs - 1 then (take n xs) ++ [char] ++ back else xs
	where back = reverse . take (length xs - 1 - n) . reverse $ xs

replaces :: [Int] -> a -> [a] -> [a]
replaces indices char original = subReplaces indices original
	where subReplaces (n:ns) xs = subReplaces ns $ replace n char xs
	      subReplaces [] xs = xs

replace2D :: Int -> Int -> a -> [[a]] -> [[a]]
replace2D x y char xs = replace x (replace y char $ xs !! x) xs