-- John Garvin
-- CS 429 Final Project
-- April 24, 2001

import Picture
import Model (model, iter)
import Random

epsilon :: Float
epsilon = 0.2

collides :: Position -> Position -> Bool
collides (Pos (x1,y1)) (Pos (x2,y2)) = abs (x2 - x1) < epsilon && abs (y2 - y1) < epsilon

newtype Position = Pos (Float, Float)
    deriving Show
newtype Velocity = Vel (Float, Float)
    deriving Show

data Thing = Particle Particle
	   | Surface Surface
	     deriving Show

data Particle = Part {pos :: Position,
		      vel :: Velocity}
		deriving Show

-- e = elasticity

data Surface = HLine {e :: Float, ypos :: Float}
	     | VLine {e :: Float, xpos :: Float}
	     -- | Line {e :: Float, xfact :: Float, yfact :: Float}
	     | HSeg {e :: Float, ypos :: Float,
		     min_x :: Float, max_x :: Float}
	     | VSeg {e :: Float, xpos :: Float,
		     min_y :: Float, max_y :: Float}
	     --| Seg {e :: Float, xfact :: Float, yfact :: Float,
	     --    min_x :: Float, max_x :: Float}
	       deriving Show

drawThing :: Thing -> Region
drawThing (Particle p) = 
    let Pos c = pos p
	in Translate c (Shape (Ellipse 0.05 0.05))
drawThing (Surface HLine {ypos = y, e = _}) =
    Shape (Polygon [(-5, y+0.05), (5, y+0.05), (5, y-0.05), (-5, y-0.05)])
drawThing (Surface VLine {xpos = x, e = _}) =
    Shape (Polygon [(x+0.05, -5), (x+0.05, 5), (x-0.05, 5), (x-0.05, -5)])
drawThing (Surface HSeg {e = _, ypos = y, min_x = min_x, max_x = max_x}) =
    Shape (Polygon [(min_x, y+0.05), (max_x, y+0.05), (max_x, y-0.05), (min_x, y-0.05)])
drawThing (Surface VSeg {e = _, xpos = x, min_y = min_y, max_y = max_y}) =
    Shape (Polygon [(x+0.05, min_y), (x+0.05, max_y), (x-0.05, max_y), (x-0.05, min_y)])

drawThing _ = error "drawThing fell thru!"

neg_x, neg_y :: Velocity -> Velocity
neg_y (Vel (x,y)) = Vel (x,-y)
neg_x (Vel (x,y)) = Vel (-x,y)

bounce :: Particle -> Thing -> (Velocity -> Velocity)
bounce p (Particle _) = id      -- ignore other particles
bounce p (Surface HLine {ypos = y, e = e}) = 
    let Pos (_,y1) = pos p
        Pos (_,y2) = move (vel p) (pos p)
	in if (y1 > y && y >= y2) || (y1 < y && y <= y2) then (\v -> neg_y (vscale v e)) else id
bounce p (Surface VLine {xpos = x, e = e}) = 
    let Pos (x1,_) = pos p
        Pos (x2,_) = move (vel p) (pos p)
	in if (x1 > x && x >= x2) || (x1 < x && x <= x2) then (\v -> neg_x (vscale v e)) else id
bounce p (Surface HSeg {e = e, ypos = y, min_x = min_x, max_x = max_x}) =
    let Pos (_,y1) = pos p
	Pos (x,y2) = move (vel p) (pos p)
	in if ((y1 > y && y >= y2) || (y1 < y && y <= y2)) && min_x < x && x <= max_x
	   then (\v -> neg_y (vscale v e)) else id
bounce p (Surface VSeg {e = e, xpos = x, min_y = min_y, max_y = max_y}) =
    let Pos (x1,_) = pos p
	Pos (x2,y) = move (vel p) (pos p)
	in if ((x1 > x && x >= x2) || (x1 < x && x <= x2)) && min_y < y && y <= max_y
	   then (\v -> neg_x (vscale v e)) else id
bounce _ _ = error "Bounce fell thru!"

vsum :: [Velocity] -> Velocity
vsum vs = Vel (foldr (\(x1,y1) (x2,y2) -> (x1+x2,y1+y2)) (0,0) (map (\(Vel v) -> v) vs))

vscale :: Velocity -> Float -> Velocity
vscale (Vel (x,y)) c = Vel (c*x,c*y)

move :: Velocity -> Position -> Position
move (Vel (vx,vy)) (Pos (px,py)) = Pos (px + vx, py + vy)

gravity :: Velocity
gravity = Vel (0,-0.01)

oneStep :: Thing -> [Thing] -> [Thing]
oneStep (Surface s) ts = [Surface s]
oneStep (Particle p) ts = let new_v = vsum [gravity, 
					    (foldr (.) id $ map (bounce p) ts) (vel p)]
			      in [Particle Part {pos = move new_v (pos p),
						 vel = new_v}]
oneStep _ _ = error "oneStep fell thru!"

data1 = [Particle Part {pos = Pos (0,0),
			vel = Vel (0.101, 0.201)},
	 Particle Part {pos = Pos (0,0),
			vel = Vel (-0.3, -0.1)},
	 Surface HLine {e = 1,
			ypos = 2},
	 Surface HLine {e = 1,
			ypos = -2},
	 Surface HSeg {e = 1,
		       ypos = 0,
		       min_x = -1,
		       max_x = 1},
	 Surface VLine {e = 1,
			xpos = -2},
	 Surface VLine {e = 1,
			xpos = 2}]

box = [Surface HLine {e = 1,
		      ypos = -2},
       Surface HLine {e = 1,
		      ypos = 2},
       Surface VLine {e = 1,
		      xpos = -3},
       Surface VLine {e = 1,
		      xpos = 3},
       Surface VSeg {e = 1,
		     xpos = 0,
		     min_y = -2,
		     max_y = 0},
       Surface VSeg {e = 1,
		     xpos = 0,
		     min_y = 0.5,
		     max_y = 2}]

rr n (min,max) = (n * (max - min)) + min

diff_parts r n = 
    let gen (v1:v2:v3:v4:vs) = Particle Part {pos = Pos (rr v1 (-3,0), rr v2 (-2,2)),
					      vel = Vel (rr v3 (-0.2,0.2), rr v4 (-0.2,0.2))}
			       : gen vs
	in take n $ gen $ randoms $ StdGen r r

game seed = [Surface HLine {e=1,
			    ypos = 2},
	     Surface VLine {e=1,
			    xpos = -2},
	     Surface VLine {e=1,
			    xpos = 2},
	     Surface HSeg {e=1,
			   ypos = -2,
			   min_x = -2,
			   max_x = -0.4},
	     Surface HSeg {e=1,
			   ypos = -2,
			   min_x = 0.4,
			   max_x = 2},
	     Surface HSeg {e=1.5,
			   ypos = -1.5,
			   min_x = -1.3,
			   max_x = -0.7},
	     Surface HSeg {e=1.5,
			   ypos = -1.5,
			   min_x = 0.7,
			   max_x = 1.3},
	     Surface HSeg {e=1.5,
			   ypos = -1,
			   min_x = -1.8,
			   max_x = -1.2},
	     Surface HSeg {e=1.5,
			   ypos = -1,
			   min_x = 1.2,
			   max_x = 1.8},
	    Surface VSeg {e=0.5,
			 xpos = -1.5,
			 min_y = 0.5,
			 max_y = 1.5},
	    Surface VSeg {e=0.5,
			 xpos = 1.5,
			 min_y = 0.5,
			 max_y = 1.5},
	    Particle Part {pos = Pos (n1,n2),
			   vel = Vel (n3,n4)}]
    where v1:v2:v3:v4:_ = randoms (StdGen seed seed)
	  n1 = rr v1 (-3,2)
	  n2 = rr v2 (0, 2)
	  n3 = rr v3 (-0.1,0.1)
	  n4 = rr v4 (-0.1,0.1)

test1 = model drawThing oneStep data1

test2 seed = model drawThing oneStep (box ++ diff_parts seed 20)

test3 seed = model drawThing oneStep (game seed)