module Graph  where

import Parse
import StdLib
import PSlib
import GRIP

paperX = 280::Int
paperY = 190::Int

-- partain: renamed from "fromInt"
my_fromInt :: Num a => Int -> a
my_fromInt = fromInteger . toInteger

gspostscript str = initialise stdheader ++ portrait ++ str ++ "showpage\n"
postscript str = initialise stdheader ++ landscape ++ str ++ "showpage\n"

ePostscript (reqdx,reqdy) str = initialise (stdheader++
	"%%BoundingBox: 0 0 "++show (cms2pts reqdx)++" "++show (cms2pts reqdy)++"\n"
			++ "%%EndComments\n")
	++ scale (my_fromInt reqdx*10/my_fromInt paperX) (my_fromInt reqdy*10/my_fromInt paperY) ++ str ++
	showpage

initGraph title pedata (topX,topY) (xlabel,ylabel) keys = 
	drawBox (Pt 0 0) paperX paperY ++  -- setup graphwindow
	drawBox (Pt 1 1) (paperX-2) 5 ++ 
	drawBox (Pt 1 (paperY-7)) (paperX-2) 6 ++
	setfont "BOLD" ++ moveto (Pt (paperX `div` 2) (paperY-6)) ++ cjustify (title) ++
	setfont "NORM" ++
	placePEs pedata ++
	translate 20 25 ++			-- set origin
	newpath ++ moveto (Pt 0 (-5)) ++ lineto (Pt 0 dimY) ++  -- print axis
        moveto (Pt (-5) 0) ++ lineto (Pt dimX 0) ++ stroke ++   -- x and y
	setfont "SMALL" ++
	markXAxis dimX topX++
	markYAxis dimY topY++
	moveto (Pt 0 (dimY+4)) ++ rjustify ylabel ++ stroke ++
	moveto (Pt dimX (-8)) ++ rjustify xlabel ++ stroke ++
	setfont "NORM" ++
	dokeys dimX keys 

placePEs (pes,on) | checkPEs (tail pes) on = 
		showActive (length pes) (length used) ++
		showUsed pes used ++ setfont "NORM"
		where used = if on==[] then tail pes else on
		

cms2pts :: Int -> Int
cms2pts x = round (28.4584 * my_fromInt x)

plotCurve ::  Int -> [Point] -> Postscript
plotCurve x pts = setgray x ++ fillObject pts

plot :: [Point] -> Postscript
plot points = plotCurve 5 (Pt 0 0:points)

dokeys left keys = concat (map2 format (places 0) keys)
	where
	format pt@(Pt x y) (col,tex,pc) = fillBox pt 16 9 col ++ stroke ++ moveto (Pt (x+17) (y+3))
					++ text tex ++ stroke ++ moveto (Pt (x+8) (y+3)) ++
					inv col ++ setfont "BOLD" ++ cjustify (pc) ++ 
					stroke ++ setfont "NORM" ++ setgray 10 
	no=left `div` length keys
	places n | n == no = []
	places n = (Pt (n*no) (-17)):places (n+1)

showActive t f = 
		setfont "LARGE" ++ moveto (Pt 10 16) ++ cjustify (show f) ++
		setfont "SMALL" ++ moveto (Pt 10 12) ++ cjustify "PE(s)" ++ stroke ++ 
		setfont "SMALL" ++ moveto (Pt 10 8) ++ cjustify "displayed" ++ stroke ++ 
		setfont "NORM"

showUsed (m:pes) on = moveto (Pt 2 2) ++ setfont "SMALL" ++ text "Configuration:" ++
		 	dopes (paperX-27) (("SMALLITALIC",showPE m):map f pes) ++ stroke
	where
	f pe | elem pe on = ("SMALLBOLD",showPE pe)
	     | otherwise = ("SMALL",showPE pe)

dopes left pes = concat (map2 format (places 0) pes)
        where
        format pt@(Pt x y) (font,tex) = setfont font ++ moveto pt  ++ text tex ++ stroke
        no=left `div` ((length pes*2)+1)
	f x = (no*((x*2)+1)) + 27
        places n | n>2*no = []
        places n = (Pt (f n) 2):places (n+1)



checkPEs pes [] = True
checkPEs pes (p:ps) | elem p pes = checkPEs pes ps
		    | otherwise = error ("Attempt to gather information from inactive PE - "++ showPE p)

showPE :: PElement -> String
showPE (PE str no) = str++"."++show no

inv x | x>=5 = setgray 0
      | otherwise = setgray 10

dimX = paperX-30
dimY = paperY-40

markXAxis :: Int -> Int -> Postscript
markXAxis dimX maxX = label 10 ++ markOnX 100
	where
	label 0 = ""
	label x = newpath ++ moveto (Pt (notch x) 0) ++ rlineto 0 (-2) ++ 
		  moveto (Pt (notch x) (-5)) ++ 
		  cjustify (printFloat (t x)) ++ stroke ++ label (x-1)
	t x = my_fromInt x*(my_fromInt maxX / my_fromInt 10) 
	notch x = x*(dimX `div` 10)

markOnX n = mapcat notches [1..n] ++ stroke
	where
	notches n = movetofloat (m*my_fromInt n) 0 ++  (rlineto 0 (-1)) ++ stroke
	m = my_fromInt dimX/my_fromInt n


markYAxis :: Int -> Int -> Postscript
markYAxis dimY maxY = label 10 ++ markOnY (calibrate maxY)
	where
	label 0 = ""
	label x = newpath ++ moveto (Pt 0 (notch x)) ++ rlineto (-2) 0 ++ 
		  moveto (Pt (-3) (notch x)) ++ 
		  rjustify (printFloat (t x)) ++ stroke ++ label (x-1)
	t x = my_fromInt x*(my_fromInt maxY / my_fromInt 10) 
	notch x = x*(dimY `div` 10)

calibrate x | x<=1 = 1
	    | x<=100 = x
	    | otherwise = calibrate (x `div` 10)

markOnY n = mapcat notches [1..n] ++ stroke
	where
	notches n = movetofloat 0 (m*my_fromInt n) ++  (rlineto (-1) 0) 
	m = my_fromInt dimY/my_fromInt n

movetofloat x y = show x ++ " " ++ show y ++ " moveto\n"


determineScale :: [Point] -> (Int,Int)
determineScale pts = (axisScale x, axisScale y)
	where	(min,Pt x y) = minandmax pts

axisScale :: Int -> Int
axisScale x = axisScale' x 1
axisScale' x m	| x <= m = m
		| x <= m*2 = m*2
		| x <= m*5 = m*5
		| x <= m*10 = m*10
		| otherwise = axisScale' x (m*10) 

minandmax :: [Point] -> (Point,Point)
minandmax [] = error "No points"
minandmax (p:ps) = f (p,p) ps
	where
	f p [] = p
	f (Pt minx miny,Pt maxx maxy) (Pt x y:ps) = f (Pt minx' miny',Pt maxx' maxy') ps
			where 	minx' = min x minx
				miny' = min y miny
				maxx' = max x maxx
				maxy' = max y maxy


printFloat :: Float -> String
printFloat x = f (show (round (x*10)))
		where
		f "0" = "0"
		f r | x<1 = "0."++r
		f (r:"0") | x<10 = [r]
		f (r:m) | x<10 = r:'.':m
		f _ = show (round x)