-- | The beginning of an implementation of the classic game Breakout
-- (slighly buggy)
module Breakout(
       World(..),initialWorld,startBall,animateWorld,movePaddle,
       ballRadius,paddleWidth,paddleHeight,worldWidth,worldHeight,
       ) where
import Data.Maybe
import Data.List
import Debug.Trace

data World = World {ball::Ball, paddle::Paddle, bricks::[Brick]}
             deriving Show

type Ball = (Point,Vector) -- position & speed
type Paddle = Point -- position
type Brick = Rect

type Rect = (Point,Size)
type Vector = Point
type Size = Point
type Point = (Double,Double)

initialWorld = World (ballPos,speed) paddlePos
                     [((40*x,20*y),(35,15))|x<-[1..8],y<-[2..6]]
  where
    speed = (0,0)
    ballPos = (worldWidth/2,snd paddlePos-ballRadius)
    paddlePos = (worldWidth/2-paddleWidth/2,worldHeight-2*paddleHeight)

worldWidth,worldHeight,paddleWidth,paddleHeight,ballRadius :: Num a => a
worldWidth = 400
worldHeight = 300
paddleWidth = 50
paddleHeight = 12

ballRadius = 8

--------------------------------------------------------------------------------

movePaddle :: Point -> World -> World
movePaddle (x,y) (World ball@((_,by),v) (px,py) bricks) =
    World ball' (px',py) bricks
  where
    ball' = if v==0 then ((x,by),v) else ball
    
    px' = x - paddleWidth/2

startBall (World (p,v) paddle bricks) = World (p,v') paddle bricks
  where v' = if v==0 then (-3,-5) else v

animateWorld :: World -> World
animateWorld (World ball paddle bricks) =
  case bs2 of
    (b,e:_):bs2 -> World (bounce ball e) paddle (map fst (bs1++bs2)) -- hmm
    _           -> World (moveBall ball) paddle (map fst bs1)
  where
    (bs1,bs2) = partition (null.snd) $
                zip bricks (map (intersectBrick ball) bricks)

    moveBall ball@(p@(_,by),v) =
      case hitWall ball++hitPaddle ball paddle of
        [] -> if by>worldHeight
              then (paddle+(paddleWidth/2,-ballRadius),0)
              else (p+v,v)
        e:_ -> traceShow (ball,ball') ball'
          where ball' = bounce ball e

hitPaddle ball paddle =
  intersectRect ball (growRect ballRadius (paddle,(paddleWidth,paddleHeight)))
  
hitWall ball = intersectEdges ball walls

walls = init (rectEdges (growRect (-ballRadius) worldRect))

worldRect :: Rect
worldRect = (0,(worldWidth,worldHeight))


-- | Move the ball, bounce at the edges of the world
move2d :: Ball -> (Point,Point) -> Ball
move2d ((x,y),(dx,dy)) ((xmin,ymin),(xmax,ymax)) = ((x',y'),(dx',dy'))
  where
    (x',dx') = move1d x dx xmin xmax
    (y',dy') = move1d y dy ymin ymax

    move1d x dx min max | dx>0 && x'>=max = (2*max-x',-dx)
                        | dx<0 && x'<min  = (2*min-x',-dx)
                        | otherwise       = (x',dx)
      where x' = x+dx

-- | The new position of the ball after bouncing off an edge
bounce :: Ball -> Edge -> Ball
bounce (p,v@(dx,dy)) e =
  case e of
    H (_,y1) _ -> ((x,2*y1-y),(dx,-dy))
    V (x1,_) _ -> ((2*x1-x,y),(-dx,dy))
  where (x,y) = p+v

-- | Which edges of a brick has the ball hit?
intersectBrick :: Ball -> Brick -> [Edge]
intersectBrick ball brick = intersectRect ball (growRect ballRadius brick)

intersectRect :: Ball -> Rect -> [Edge]
intersectRect b r = intersectEdges b (rectEdges r)

intersectEdges (p,v) es = filter (isJust.intersectEdge p p') es
  where p' = p+v

growRect :: Vector -> Rect -> Rect
growRect v (pos,size) = (pos-v,size+2*v)

-- | Horizontal and vertical edges
data Edge = H Point Double | V Point Double deriving Show

-- | The four edges of a rectangle
rectEdges :: Rect -> [Edge]
rectEdges ((x,y),(w,h)) = [H (x,y) w,V (x,y) h,V (x+w,y) h,H (x,y+h) w]

-- | Where does the line between two points intersect an edge?
intersectEdge :: Point -> Point -> Edge -> Maybe Point
intersectEdge (x1,y1) (x2,y2) e =
  case e of
    H (x,y) w -> case between y y1 y2 of
                   Just p | x<=x' && x'<=x+w -> Just (x',y)
                     where x' = x1+p*(x2-x1)
                   _ -> Nothing
    V (x,y) h -> case between x x1 x2 of
                   Just p | y<=y' && y'<=y+h -> Just (x,y')
                     where y' = y1+p*(y2-y1)
                   _ -> Nothing

-- | Is y between y1 and y2?
-- @Nothing@ means then y is not between y1 and y2.
-- @Just p@ means that y == y1+p*(y2-y1) and p is between 0 and 1
between :: Double -> Double -> Double -> Maybe Double
between y y1 y2 | y1/=y2 && 0<p && p<=1 = Just p
                | otherwise = Nothing
  where p = (y-y1)/(y2-y1)

-- | Numeric operations on pairs of numbers (2D vectors)
instance (Num a,Num b) => Num (a,b) where
  (x1,y1)+(x2,y2) = (x1+x2,y1+y2)
  (x1,y1)*(x2,y2) = (x1*x2,y1*y2)
  negate (x,y) = (-x,-y)
  fromInteger x = (fromInteger x,fromInteger x)
  abs (x,y) = (abs x,abs y)
  signum (x,y) = (signum x,signum y)