-- Represents a Tetris board as a list of rectangles.  When regions are unioned with
-- a board all transformations (translation, scaling, rotations) are performed and
-- they are split into rectangles of height 1.  This speeds up graphics by allowing Shape 
-- (rather than Region) graphics and "contains" operations by pre-computing all tranforms.

-- This module makes a very specific set of assumptions about the regions that can be 
-- inserted into a board.  The primitive shapes can only be rectangles (or rectangular 
-- polygons).  All coordinates must be of the form "n + 0.5", where n is an integer 
-- (so -1.5, 0.5, and 10.5 are all valid, but 1  and 2.25 are not).  By limiting the 
-- generality of the operations we are able to speed them up.

-- by Scot Drysdale on 11/10/07

module TetrisBoard(Board, Vector,
                   containsB, emptyB, bUnionB, rUnionB, boardToGraphic,
                   drawBoard, hSpan, translateB)
where

import DrawX
import PictureEX
import Graphics.SOE.Gtk hiding (Region)
import qualified Graphics.SOE.Gtk as G (Region)
import Data.List
import Data.Ord

type Board = [Shape]

-- returns an empty board
emptyB :: Board
emptyB = []

-- Determines if a point p is contained in the shapes in the Board b
containsB :: Board -> Vertex -> Bool
b `containsB` p = any (`containsS` p) b

-- Unions two boards.  Also goes through and combines adjacent 
-- rectangles in the same row to reduce the number of polygons
-- to be drawn and tested for inclusion.
-- Precondition -  All shapes are Polygons that are 1 high 
--   and all coordinates are of form n.5
bUnionB      :: Board -> Board -> Board
bUnionB b1 b2 = combineRects (sortBy compRects (b1 ++ b2)) 

-- Compares two Polygons based on lowest point (y-value), x breaking ties
compRects  :: Shape -> Shape -> Ordering
compRects = comparing (\p -> swap (leftVertex p)) 

-- Gets the leftmost vertex in a polygon, breaking ties on y (lowest leftmost)
-- For a rectangle this is the lower left corner.
leftVertex             :: Shape -> Vertex
leftVertex (Polygon vs) = minimum vs
leftVertex _            = error "non-Polygon in leftVertex"

-- Gets the rightmost vertex in a polygon, breaking ties on y (highest rightmost)
-- For a rectangle this is the upper right corner.
rightVertex             :: Shape -> Vertex
rightVertex (Polygon vs) = maximum vs
rightVertex _            = error "non-Polygon in rightVertex"

-- Swaps the values in an ordered pair
swap      :: (a,b) -> (b, a)
swap (x,y) = (y,x)

-- Combines adjacent rectangles in the same row.  
-- Precondition: all rectangles have height 1.
combineRects :: [Shape] -> [Shape]
combineRects (p1 : p2 : ps) =
  if fst (leftVertex p2) == fst (rightVertex p1) &&
     snd (leftVertex p2) == snd (rightVertex p1) -1 then
       let (lx, ly) = leftVertex p1
           (rx, ry) = rightVertex p2
       in combineRects (Polygon [(lx, ly), (rx, ly), (rx, ry), (lx, ry)] : ps)
   else p1 : combineRects (p2 : ps)   
combineRects p = p

-- Unions a Region r with a Board b
-- Precondition: r is built out of rectangles or rectangular polygons, and using
-- only Union, Translate, Scale, and RotateL.  All coordinates of rectangles are
-- of the form integer + 0.5.
rUnionB :: Region -> Board -> Board
rUnionB r b = 
  let rects = regionToRects r
  in if all isValidRect rects
      then  concat (map decomposeRect rects) `bUnionB` b
      else error ("A region added to board has a coordinate that is not integer + 0.5 " ++
                  " or which is not a rectangle")
                  
-- Tests to see if the input is a rectangle and all coordinates are of form integer + 0.5.
-- (Actually tests to see if it has 4 vertices; does not verify is rectangle)
isValidRect              :: Shape -> Bool
isValidRect (Polygon vs)  = 
  length vs == 4 && all (\(x,y) -> isIntPlusHalf x && isIntPlusHalf y) vs

-- Tests to see if a number is of the form integer + 0.5
isIntPlusHalf  :: Float -> Bool
isIntPlusHalf x = roundF x /= x && 2*x == roundF (2*x)

-- Round to integer, then convert back to float
roundF = intToFloat . round

-- Decomposes a rectangle into a list of rectangles of height 1.
-- Input and output are Polgons with 4 vertices
decomposeRect  :: Shape -> [Shape]
decomposeRect r = 
  let (lx, ly) = leftVertex r
      (rx, ry) = rightVertex r
  in [Polygon [(lx, y), (rx, y), (rx, y+1), (lx, y+1)] | y <- [ly, ly+1..ry-1]]

-- Returns a list of Graphics representing the contents of a Board b, given a 
-- user window with information about how to convert user to window coordinates.
boardToGraphic     :: UserWindow -> Board -> [Graphic]
boardToGraphic uw b = map (shapeToGraphic uw) b

-- draws board b in color c on window uw
drawBoard       :: UserWindow -> Color -> Board -> IO ()
drawBoard uw c b = drawShapes uw (zip (repeat c) b)

-- Splits the board into rectangles above the horizontal split 
-- line at h and rectangles below the line at h.
-- Shapes crossing the line are split into rect above and rect below.
-- Returns an pair of (those below h, those above h).
-- * Precondition: h must be of form integer + 0.5.
--   That way no rectangles in the representation cross the line,
--   even though input rectangles may.
hSpan    :: Float -> Board -> (Board,Board)
hSpan h b = if isIntPlusHalf h
            then span (\p -> snd (rightVertex p) <= h) b
            else error ("horizontal line at " ++ show h ++ 
              " is not of form integer + 0.5")
        
  
-- Returns a Board with all items translated by vector v
-- Components of v must be integral
translateB    :: Vector -> Board -> Board
translateB v@(vx,vy) b = 
  if roundF vx == vx && roundF vy == vy 
   then concat (map (regToRects v (1,1) 0) (map Shape b))
   else error "non-integral translation in TranslateB"

-- Converts a Region whose component Shapes are all Rectangles or Polygons
-- to a list of Polygons which have been translated, rotated, etc.  The Region
-- cannot include Complement, Intersect, or Xor constructors.
regionToRects :: Region -> [Shape]
regionToRects r = regToRects (0,0) (1,1) 0 r

-- Converts Region to list of Polygons using three accumulators to accumulate
-- the total translation, total scaling, and total rotation.  

regToRects :: Vector -> Vector -> Int -> Region -> [Shape]

regToRects loc (sx,sy) rot (Scale (u,v) r)
  = let (u1,v1) = if rot `mod` 2 == 0 then (u,v) else (v,u)
    in regToRects loc (sx*u1,sy*v1) rot r

regToRects (lx,ly) (sx,sy) rot (Translate (u,v) r) 
  = let (u1,v1) = rotL rot (u,v)
    in regToRects (lx+u1*sx,ly+v1*sy) (sx,sy) rot r
  
regToRects loc sca rot (RotateL r)
  = regToRects loc sca ((rot+1) `mod` 4) r

regToRects loc sca rot Empty
  = []

regToRects loc sca rot (r1 `Union` r2)
  = regToRects loc sca rot r1 ++ regToRects loc sca rot r2

regToRects loc sca rot (Shape s)
  = [shapeToPoly loc sca rot s]
    
regToRects loc sca rot r = 
  error ("Invalid operand " ++ (show r) ++ " in regionToRects")


-- Converts s into a Polygon after scaling by (sx,sy) and translating by (lx,ly)
shapeToPoly :: Vector -> Vector -> Int -> Shape -> Shape
shapeToPoly (lx,ly) (sx,sy) rot s
  = case s of
      Rectangle s1 s2  
        -> let s12 = s1/2
               s22 = s2/2
           in Polygon (map trans [(-s12,-s22),(-s12,s22),
                        (s12,s22),(s12,-s22)])
      Ellipse r1 r2    
        -> error "Cannot convert an ellipse to a polygon"
        
      Polygon vs      
        -> Polygon (map trans vs)
        
      RtTriangle s1 s2 
        -> Polygon (map trans [(0,0),(s1,0),(0,s2)])
    where trans :: Vertex -> Vertex
          trans (x,y) = let (x1, y1) = rotL rot (x, y)
                        in (lx+x1*sx, ly+y1*sy) 

-- Rotate a vector k times to the left 90 degrees
rotL        :: Int -> Vector -> Vector
rotL 0 v     = v
rotL k (x,y) = rotL (k-1) (-y, x)