Topic: User Coordinates and Tetris Framework 
Date: Nov. 9, 2009
Number: 22
Examples: DrawX.hs, ShapeX.hs, RegionEX.hs, PictureEX.hs, TetrisFramework.hs

-- User coordinates --

A student pointed out when we looked at Draw that converting a unit 
to 100 pixels (an inch, supposedly) with the origin in the center is 
not very convenient.  It would be better to be able to define your 
OWN coordinateds for any window.

DrawX.hs allows you to do this.  You have used it with the clustering 
program to plot, but never had to look at it.  We look at it now.  
Two changes:

-- 1) Allows arbitrary x and y ranges for the user coordinates 
-- 2) Draws Polyline shapes, defined in the expanded Shapes.hs

We create a new type called a UserWindow.

  -- Holds the information needed to plot in user coordinates
  data UserWindow = WinData {win :: Window, 
                             userXmin :: Float, userXrange :: Float,
                             userYmax :: Float, userYrange :: Float, 
                             xWin :: Int, yWin :: Int}

Why userXmin and userYmax?  Reduces the work in some later 
computations that happen frequently.  Create this by calling:

  -- Opens a graphics window and stores information about user range 
  -- and window range in a UserWindow data structure, 
  -- which is returned.
  openUserWindow :: Float -> Float -> Float -> Float -> Int -> Int -> 
                    String -> IO UserWindow
  openUserWindow uXmin uXmax uYmin uYmax winX winY title =
    do
      w <- openWindow title (winX, winY)
      return (WinData w uXmin (uXmax - uXmin) uYmax (uYmax - uYmin) 
              winX winY)
  
Just opens a window size winX x winY, and saves away the rest of the 
information.  Given this, we now aren't limited to inchToPixel and 
its like:
  
  userXtoWin     :: UserWindow -> Float -> Int
  userXtoWin uw x  = round (intToFloat (xWin uw) * 
                           (x - userXmin uw)/userXrange uw)

  userYtoWin     :: UserWindow -> Float -> Int
  userYtoWin uw y = round (intToFloat (yWin uw) * 
                          (userYmax uw - y)/userYrange uw)

  winXtoUser     :: UserWindow -> Int -> Float
  winXtoUser uw x = userXrange uw * intToFloat x / intToFloat (xWin uw) 
                    + userXmin uw

  winYtoUser     :: UserWindow -> Int -> Float
  winYtoUser uw y = userYmax uw - userYrange uw * 
                    intToFloat y / intToFloat (yWin uw)
  
So can convert both ways.  One drawback - need uw as a parameter.  So 
it will get passed around in all of our drawing routines, and a bunch 
of others.  Can't really be helped.

Often want to convert a vertex to a point, or list of them:

  -- Translate a single vertex from user coordinates to 
  -- window coordinates
  trans :: UserWindow -> Vertex -> Point
  trans uw (x,y)   = ( userXtoWin uw x, userYtoWin uw y )

  -- Translate a list of vertices from user coordinates to 
  -- window coordinates
  transList :: UserWindow -> [Vertex] -> [Point]
  transList uw = map (trans uw)

Latter could be useful for converting say a polygon.  

And now our code for converting shapes to graphics is the same, but 
uses the new conversion functions:

  -- Convert a Shape type into an equivalent Graphic type
  shapeToGraphic :: UserWindow -> Shape -> Graphic
  shapeToGraphic uw (Rectangle s1 s2)
    = let s12 = s1/2
          s22 = s2/2
      in polygon 
           (transList uw [(-s12,-s22),(-s12,s22),
                          (s12,s22),(s12,-s22)])
  shapeToGraphic uw (Ellipse r1 r2)
    = ellipse (trans uw (-r1,-r2)) (trans uw (r1,r2)) 
  shapeToGraphic uw (RtTriangle s1 s2)
    = polygon (transList uw [(0,0),(s1,0),(0,s2)])
  shapeToGraphic uw (Polygon pts)
    = polygon (transList uw pts)
  shapeToGraphic uw (Polyline pts)
    = polyline (transList uw pts)

And drawing is similar, but must get real window from uw:

  shs :: ColoredShapes
  shs  = [(Red,sh1),(Blue,sh2),(Yellow,sh3),(Magenta,sh4), 
          (Cyan, sh5)]

  drawShapes :: UserWindow -> ColoredShapes -> IO ()
  drawShapes uw [] 
    = return ()
  drawShapes uw ((c,s):cs)
    = do drawInWindow (win uw) (withColor c (shapeToGraphic uw s))
         drawShapes uw cs

  main1
    = runGraphics (
      do uw <- openUserWindow (-3) 3 (-3) 3 600 600 "Drawing Shapes" 
         drawShapes uw shs
         spaceClose (win uw)
     )


-- RegionEX --

We also have new Region code.  It uses the new Shape (polyline) 
supplied by ShapeX, but the main difference is adding RotateL to 
rotate 90 degrees ccw.  So changes:

data Region = Shape Shape		        -- primitive shape
            | Translate Vector Region   -- translated region
            | Scale      Vector Region  -- scaled region
 ->         | RotateL Region            -- Rotate 90 degrees
            | Complement Region         -- inverse of region
            | Region `Union` Region     -- union of regions
            | Region `Intersect` Region -- intersection of regions
            | Region `Xor` Region       -- XOR of regions
            | Empty                     -- empty region
     deriving Show

Change Region data def.

Then change containsR to handle rotations:

  containsR :: Region -> Coordinate -> Bool

  (Shape s) `containsR` p
     = s `containsS` p
  (Translate (u,v) r) `containsR` (x,y)
     = let p = (x-u,y-v) in r `containsR` p
  (Scale (u,v) r) `containsR` (x,y)
     = let p = (x/u,y/v) in r `containsR` p
  (RotateL r) `containsR` (x,y)       - Rotate in opposite direction
     = let p = (y,-x) in r `containsR` p
  (Complement r) `containsR` p 
     = not (r `containsR` p)
  (r1 `Union` r2)     `containsR` p
     = r1 `containsR` p || r2 `containsR` p
  (r1 `Intersect` r2) `containsR` p
     = r1 `containsR` p && r2 `containsR` p
  (r1 `Xor` r2) `containsR` p
     = let a = r1 `containsR` p
           b = r2 `containsR` p
       in (a || b) && not (a && b)
  Empty `containsR` p 
     = False
     
Same idea as always.  Instead of rotating shape, rotate point in 
opposite direction.  rotateL (x,y) = (-y,x)  Plug in (y, -x) and 
get (x,y), the identity.
 
So updating regions to handle rotations was easy.  Picture.hs is 
harder.  
 
First, almost everything now takes a UserWindow uw.  For example:
 
   -- Draws a Picture onto the user-coordinates window uw.
  drawPic                 :: UserWindow -> Picture -> IO ()
  drawPic uw (Region c r)   = drawRegionInWindow uw c r
  drawPic uw (p1 `Over` p2) = do drawPic uw p2; drawPic uw p1
  drawPic uw EmptyPic       = return ()

This is relatively minor.  But regToGReg is not so simple to convert. 
It was going to be a SA, but then I discovered that it took me a 
while to get it right (using `div` instead of `mod` one place didn't 
help).  So I will just give it to you.

First thing, is we now need 3 accumulators to collect the information 
as we pass down.  Third is for rotations.  When we get to the final 
shape, we do rotations first, then scaling, and finally translation.
Will look only at what changes:

  -- Converts a Region to a G.Region.  
  -- User window uw is needed by regToGReg, so is passed.
  regionToGRegion :: UserWindow -> Region -> G.Region
  regionToGRegion uw r = regToGReg uw (0,0) (1,1) 0 r

For Shape basically unchanged, except needs uw and number of rotations
to pass to shapeToGRegion:

  regToGReg :: UserWindow -> Vector -> Vector -> Int -> Region 
               -> G.Region
  regToGReg uw loc sca rot (Shape s) 
    = shapeToGRegion uw loc sca rot s

Rotation surprisingly doesn't do anything but count rotations.  Note 
the mod 4 so don't work too hard later.

  regToGReg uw (lx,ly) (sx,sy) rot (RotateL r)
    = regToGReg uw (lx,ly) (sx,sy) ((rot+1) `mod` 4) r

So what happens for scaling?  Have to figure out WHICH WAY to scale. 
If even number of rotations have happened already on the way down,
scaling unchanged.  But odd number means that we need to swap the
axes as we scale, because the shape should be rotated AFTER it is 
scaled, while we will be doing the rotations BEFORE the scaling.  So 
if we rotate it first, then we need to also rotate the scalings to 
make things match.  We will need to swap the scaling to make sure it 
is all correct.

  regToGReg uw loc (sx,sy) rot (Scale (u,v) r)
    = let (u1,v1) = if rot `mod` 2 == 0 then (u,v) else (v,u)
      in regToGReg uw loc (sx*u1,sy*v1) rot r
      
Translation is trickiest.  Same basic idea - need to rotate the 
translation vector a number of times equal to the number of rotation 
seen on the way in.

  regToGReg uw (lx,ly) (sx,sy) rot (Translate (u,v) r) 
    = let (u1,v1) = rotL rot (u,v)
      in regToGReg uw (lx+u1*sx,ly+v1*sy) (sx,sy) rot r

And a helper function: 

  -- 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) 

One other change - in the complement we used to use a rectangle or 
xWin, yWin.  Now we have to compute using uw:

  -- Get rectangle that covers screen.  Note that you have to 
  -- translate the origin to the center of the window, because a 
  -- Rectangle is defined centered at the origin.
  winRect   :: UserWindow -> Region
  winRect uw = Translate (userXmin uw + (userXrange uw)/2 , 
                   userYmax uw - (userYrange uw)/2) 
                   (Shape (Rectangle (userXrange uw) (userYrange uw)))


How about shape conversion?  Note that all of the shapes are defined 
in terms of points, so just need to rotate the points.  trans does 
this.  First rotates the point the right amount, then scales the 
right amount, and finally translates.  (If we did these in a different 
order would change how regToGReg works.)

  -- Converts s into a G.Region after scaling by (sx,sy) and 
  -- translating by (lx,ly)
  -- Note that the translations all convert User coordinates (from uw)
  -- into Window coordinates.
  shapeToGRegion :: UserWindow -> Vector -> Vector -> Int -> Shape -> 
                    G.Region
  shapeToGRegion uw (lx,ly) (sx,sy) rot s
    = case s of
        Rectangle s1 s2  
          -> createRectangle (trans (-s1/2,-s2/2)) 
                             (trans (s1/2,s2/2))
        Ellipse r1 r2    
          -> createEllipse (trans (-r1,-r2))
                           (trans ( r1, r2))
        Polygon vs      
          -> createPolygon (map trans vs)
        RtTriangle s1 s2 
        -> createPolygon (map trans [(0,0),(s1,0),(0,s2)])
      where trans :: Vertex -> Point
            trans (x,y) = let (x1, y1) = rotL rot (x, y)
                          in ( userXtoWin uw (lx+x1*sx), 
                               userYtoWin uw (ly+y1*sy) )
          
Demo if time           

-- Tetris framework --

Can now use this to simplify Tetris setup:

Need random numbers.  Part of IO monad, so can return different values 
on different calls:

import Random
import DrawX
import Graphics.SOE.Gtk hiding (Region)
import qualified Graphics.SOE.Gtk as G (Region)
import PictureEX

Set up some values:

  dx = 1             -- Distance to move left or right when hit 'j' or 
                     -- 'l' key
  columns = 10       -- Columns in the board
  rows = 15          -- number of rows in the board
  squareSize = 30    -- Square side length in pixels
  winX = round (columns * squareSize)  -- Width of drawing window in 
                                       -- pixels
  winY = round (rows * squareSize)     -- Height of drawing window in 
                                       -- pixels
  speed = 500        -- speed/1000 is the number of seconds to move 
                     -- 1 unit in y.
  
Allows various things (like number of rows or col.) to be changed and 
all else works.

For graphics there is a different type of window called a double 
buffered window.  Instead of drawing into screen memory (the bits that 
are transferred directly onto the screen) we draw in a different 
section of memory.  There are two such areas and  every 1/30 of a 
second the screen switches between them.  So stuff being displayed 
doesn't change.  Always write into the part NOT displayed.

Another change: drawing is cumulative.  So we need to clearWindow 
before we draw a new position for an animated object to erase the old. 
(setGraphic does clear and draw combined, but to use it we have to go 
into our Picture functions and change them!  Easier to clearWindow.)

Here is how we open this window, and establish user coord.:

-- Opens a buffered user window for animation using user coordinates.
-- Coordinates are min and max X, min and max Y in user coordinates
-- and width and height of the window in pixels.  Also widow title.
openUserWindowEx :: Float -> Float -> Float -> Float -> Int -> Int -> 
                  String -> IO UserWindow
openUserWindowEx uXmin uXmax uYmin uYmax winX winY title =
  do
    w <- openWindowEx title (Just (0,0)) (Just (winX,winY))
         drawBufferedGraphic
    return (WinData w uXmin (uXmax - uXmin) uYmax (uYmax - uYmin) 
            winX winY)
                  

Here is the main program.  Open the window.

  main = runGraphics $
    do uw <- openUserWindowEx 0.5 (columns + 0.5) 0.5 (rows + 0.5) 
             winX winY "Tetris"

Note the board boundaries.  The row and column boundaries are of the
form k + 0.5, where k is an integer.  This means that the centers of
the rows and columns are whole numbers.  This makes translation to
a given column easier, because it will be by a whole number.  Note
that the center of a Rectangle 1 1 is at (0,0), and the opposite 
corners are (-0.5,-0.5) and (0.5,0.5).

"new" starts dropping an ellipse.  Note saves the time it drops it.

     let new = do x <- randomRIO (1, columns)
                  let xRound = roundF x
                  stime <- timeGetTime
                  loop xRound stime (Shape (Ellipse 1 0.5))

loop is the main control loop.  Handles both commands and moving the 
ellipse down if no keyboad command given.  y coord. is function of 
time, returned by timeGetTime (in milliseconds since some "origin" 
time - what time this is depends on OS).  

         -- Loop to control the piece as it drops.  
         -- x is the current x coordinate, stime the starting time 
         -- when piece was dropped.  Motion controlled by the time 
         loop      :: Float -> Word32 -> Region -> IO ()
         loop x stime piece  = 
           do clearWindow (win uw)
              time <- timeGetTime    -- System time in milliseconds
              let y = rows + 1 - (intToFloat (time - stime))/speed
              drawPic uw (Region Blue (Translate (x, y) piece))
              e <- maybeGetWindowEvent (win uw)                      
              case e of 
                Just Closed -> return ()
                Just (Key 'q' True) -> closeWindow (win uw)
                Just (Key 'j' True) -> loop (left x) stime piece
                Just (Key 'k' True) -> loop x stime (rotateL piece)
                Just (Key 'l' True) -> loop (right x) stime piece
                Just (Key ' ' True) -> new  -- Drop the piece
                _                   -> if y < 0   -- Off the bottom?
                                       then new
                                       else loop x stime piece                       
        in new

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


Why left and right rather than just add?  So can prevent leaving 
screen (sort of).

-- Move left if there is space
left x   = if x-dx<1 then 1 else x-dx

-- Move right if there is space
right x  = if x+dx>columns then columns else x+dx


-- Rotate 90 degrees (so to the left)
rotateL (Shape (Ellipse r1 r2)) = Shape (Ellipse r2 r1)

Right now we do a simple rotation.  Your SA is to create several more
interesting pieces, pick one at random, and use RotateL constuctor in 
Region to rotate it as it falls.