Topic: Drawing Regions using Picture Module
Date: Nov. 6, 2009
Number: 21
Examples: Picture.hs
Reading: Chapter 10, Chapter 13 through 13.3 only

-- Drawing  regions

We now want to see how to draw regions.  The simple graphics routines 
that we have been using won't work very efficiently for doing things 
like intersections, but the SOE Graphics library provides another 
option.  There is a type called Region in SOE Graphics.  Unfortunately 
that name conflicts with our own Region.  So we get around that by: 

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

The import hidings says not to import Region.  Then the next import 
says to import it "qualified".  That means that you have to use the 
module name in order to refer to the Graphics.SOE.Gtk.Region.  This 
is too much, so we say "as" to give it the name G, so G.Region is 
sufficient.  So G.xxx is a type or method from Graphics.SOE.Gtk.Region;
other graphics routines are from Graphics.SOE.Gtk

The ones that matter:

  createRectangle :: Point -> Point -> G.Region
  createEllipse   :: Point -> Point -> G.Region
  createPolygon   :: [Point] -> G.Region
  
  andRegion       :: G.Region -> G.Region -> G.Region
  orRegion        :: G.Region -> G.Region -> G.Region
  xorRegion       :: G.Region -> G.Region -> G.Region
  diffRegion      :: G.Region -> G.Region -> G.Region
  
  drawRegion       :: G.Region -> Graphic
  
  
SOE then introduces the idea of a Picture, defined:

  data Picture = Region Color Region
               | Picture `Over` Picture
               | EmptyPic
       deriving Show

So a picture is a collection of colored Regions.  The `Over` is sort 
of like a Union, but it keeps track of which picture is on top.  
There is also an EmptyPic.  So if we had a "drawRegionInWindow" 
function, it would be easy to draw a Picture:

  drawPic                 :: Window -> Picture -> IO ()
  drawPic w (Region c r)   = drawRegionInWindow w c r
  drawPic w (p1 `Over` p2) = do drawPic w p2; drawPic w p1
  drawPic w EmptyPic       = return ()

Nothing to draw for the empty region; draw the region with the correct 
color if you know how to draw a region.  For `Over` do the one BEHIND 
first, then the one on top.  That way the one on top covers the one 
below.  All we need is how to drawRegionInWindow.  Will use drawRegion 
from above.  But need to worry about how to tranform shapes!  

Want a function

  regionToGRegion :: Region -> G.Region

Then can draw using:

  drawRegionInWindow :: Window -> Color -> Region -> IO ()
  drawRegionInWindow w c r 
    = drawInWindow w 
        (withColor c 
           (drawRegion (regionToGRegion r)))

So how do we create regionToGRegion?  Easy for shapes, but what about
translated and scaled regions?

Problem - easy to scale or translate points or Shapes as we work out 
(saw this with the point inclusion test).  But once a Shape has been 
converted to a G.Region, it can't be easily scaled or translated.  
(G.Region supplies functions for and'ing, or'ing, xor'ing G.Regions,
but none for translating or scaling G.Regions.)  So we have to 
"work in" to figure out how the scalings and translations will affect 
the primitive Shapes.

Option 1:

Build up the operations by modifying the parameters to the calls that 
create the G.Regions from simple shapes by "passing through" the 
effects of one operation to inner operations.  Book gives a (to
me) strange way of doing this using only scaling and Rectangles.
It passes the outermost scaling through all of the inner scalings
until it finally modifies the inner rectangle.  This won't work
directly with translations and scaling mixed.  Furthermore, it
turns out to be slow.  Each operation passes through and all of 
the operations nested inside of it.  Takes O(n^2) time.

Option 2:  Accumulate scaling and translation operations as traverse 
regions from outermost to innermost, and when get to a primitive shape 
transform it once.  We do this final operation by FIRST scaling and 
SECOND translating.  (The order matters!)

Demostrate this by considering:

  Scale (2,2) (Translate (1,1) (Rectangle (2,2)))

vs

  Translate (1,1) (Scale (2,2) (Rectangle (2,2)))

The first leads to corner points at (0,0) and (4,4).  The second
leads to corner points at (-1,-1) and (3,3).

So:

  regionToGRegion :: Region -> G.Region
  regionToGRegion r = regToGReg (0,0) (1,1) r

regToGReg is helper function that will keep track of translation 
(originally (0,0)) and scaling (originally (1,1)).  So:

  regToGReg :: Vector -> Vector -> Region -> G.Region
  type Vector = (Float,Float)

The application to a shape is simple, if we have a way to translate 
and scale a simple Shape.  Just do it.

  regToGReg loc sca (Shape s) 
    = shapeToGRegion loc sca s

More confusing problem is how to combine these things.  What if I have
accumulated a scaling of (sx, sy) and apply it to Scale?  If 
originally scale by 2, then 3, effect it to scale by 6 = 2*3.  So:

regToGReg loc (sx,sy) (Scale (u,v) r)
  = regToGReg loc (sx*u,sy*v) r

Note I eliminate the Scale this way, combine it with the accumulated 
scaling.

On the other hand, if I have accumulated a translation, it is 
unchanged.  I am working in, while function application would work 
out.  So any accumulated translation occurs AFTER the scaling that I 
am about to do.  Because I will eventually scale first and then 
translate, the accumulated translation is not affected by the scaling.

Translation a bit trickier.  The problem is that if I first translate 
by (u,v) and then scale, the translation should get scaled also.  But 
the scale will be accumulated (working out to in) before I get to the 
translation.  So: 

  regToGReg (lx,ly) (sx,sy) (Translate (u,v) r) 
    = regToGReg (lx+u*sx,ly+v*sy) (sx,sy) r

So this way the accumulated scaling (which would be applied AFTER the 
translation in the normal evaluation order) is used to scale the 
amounts of translation before it is added to the accumulated 
translation.

Show how this applies to the two examples above.

After I have collapsed the translations and scales into a loc and sca, 
then I have to draw the things.  What are the choices?

No Empty in the Graphics library, so make a 0-area rectangle:

  regToGReg loc sca Empty
    = createRectangle (0,0) (0,0)

For the binary operations (Union, Intersect, Xor, Complement will
have very similar pattern: translate each sub-piece, then combine
using an appropriate operation.  So extract out:

  primGReg loc sca r1 r2 op
    = let gr1 = regToGReg loc sca r1
          gr2 = regToGReg loc sca r2
      in  op gr1 gr2
      
Given this:

  regToGReg loc sca (r1 `Union` r2)
    = primGReg loc sca r1 r2 orRegion


  regToGReg loc sca (r1 `Intersect` r2)
    = primGReg loc sca r1 r2 andRegion

  regToGReg loc sca (r1 `Xor` r2)
    = primGReg loc sca r1 r2 xorRegion

  regToGReg loc sca (Complement  r)
    = primGReg loc sca winRect r diffRegion

where

  winRect :: Region
  winRect = Shape (Rectangle 
                    (pixelToInch xWin) (pixelToInch yWin))

covers whole window.

------

Now how to actually do the shapeToGRegion function?  Define:

xWin2 = xWin `div` 2 
yWin2 = yWin `div` 2 

(This is because the (0,0) point is at the center of the screen.)


  shapeToGRegion :: Vector -> Vector -> Shape -> G.Region

  shapeToGRegion (lx,ly) (sx,sy) s
    = case s of
        Rectangle s1 s2     -- Remember these are side lengths
          -> createRectangle (trans (-s1/2,-s2/2)) 
                             (trans (s1/2,s2/2))
        Ellipse r1 r2       -- Remember these are radii
          -> 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) = ( xWin2 + inchToPixel (lx+x*sx), 
                            yWin2 - inchToPixel (ly+y*sy) )

Note how trans works.  First scale the x and y by the scale factors.  
This is scaling centered at origin.  Then translate.

So a general function  to draw a picture is:

  draw :: String -> Picture -> IO ()
  draw s p
    = runGraphics $
      do w <- openWindow s (xWin,yWin)
         drawPic w p
         spaceClose w


Defines an exclusive union:

  xUnion :: Region -> Region -> Region
  p1 `xUnion` p2 = (p1 `Intersect` Complement p2) `Union`
                   (p2 `Intersect` Complement p1)

Then plays with pictures.

  r1 = Shape (Rectangle 3 2)
  r2 = Shape (Ellipse 1 1.5)
  r3 = Shape (RtTriangle 3 2)
  r4 = Shape (Polygon [(-2.5,2.5), (-3.0,0), (-1.7,-1.0),
                       (-1.1,0.2), (-1.5,2.0)])

  reg1 = r3 `xUnion` (r1 `Intersect` Complement r2 `Union` r4)
  pic1 = Region Blue reg1

So demo drawing pic1, explain what is happening.


  reg2 = let circle = Shape (Ellipse 0.5 0.5)
             square = Shape (Rectangle 1 1)
         in (Scale (2,2) circle)
            `Union` (Translate (1,0) square)
            `Union` (Translate (-1,0) square)
  pic2 = Region Yellow (Translate (0,-1) reg2)

  pic3 = pic2 `Over` pic1

Draw pic2, pic3, show what is happening.

  pic3book = pic3 `Over` Region White (Shape (Rectangle 6 5))

  r = Shape (Rectangle 2 2)
  pp1 = Region Red (Translate (1,1) (Scale (0.5,0.5) r))
  pp2 = Region Blue (Scale (0.5,0.5) (Translate (1,1) r))

Draw pp1, pp2, analyze.  (Do first, see if matches)

  oneCircle   = Shape (Ellipse 1 1)
  manyCircles = [ Translate (x,0) oneCircle | x <- [0,2..] ]
  fiveCircles = foldr Union Empty (take 5 manyCircles)
  fc = Region Red (Scale (0.25,0.25) fiveCircles)

Draw fc, after predicting what it does.  Infinite number of unit 
circles centered at (0,0), (2,0), (4,0), ....  So touching.  
Then 1/4 sized

  r5 = let c1 = Shape (Ellipse 0.5 0.5)
           c2 = Translate (1,0) c1
           cs = Translate (1,1) (c1 `Union` c2)
       in Scale (0.5,0.5) cs

So:  draw "r5" (Region Red r5)

  r6 = let c = Shape (Ellipse 0.5 0.5)
           s = Shape (Rectangle 1 1)
       in (Scale (2,2) c) `Union`
          ((Translate (2,0) s) `Union` 
           (Translate (-2,0) s))

So: draw "r6" (Region Green r6)

--- Example showing how we can interact with mouse.

First convert a picture into a list of regions, front to back.  Sort 
of a tree traversal.  Front lists appear before back lists.

  pictToList :: Picture -> [(Color,Region)]

  pictToList  EmptyPic      = []
  pictToList (Region c r)   = [(c,r)]  -- color and region
  pictToList (p1 `Over` p2) = pictToList p1 ++ pictToList p2


This adjust goes through the list, finds first thing that contains the
coordinate.  Splits into that thing, rest (that thing removed).  If 
can't find, Nothing.

  adjust :: [(Color,Region)] -> Coordinate -> 
            (Maybe (Color,Region), [(Color,Region)])


break stops the first time the predicate is true, splits list there.  
(We are using it for parsing Movie files.)  So "hit" is thing found.  
Pair of it and list appending stuff before and stuff after.

  adjust regs p
    = case (break (\(_,r) -> r `containsR` p) regs) of
        (top,hit:rest) -> (Just hit, top++rest)
        (_,[])         -> (Nothing, regs)

This loop gets mouse click location with function getLBP (left button 
push).  

Note- clearWindow not really needed.  Always draw back on top of what 
  was there.

Note 2 - reverse list so draw back to front.

  loop :: Window -> [(Color,Region)] -> IO ()

  loop w regs = 
      do clearWindow w
         sequence_ [ drawRegionInWindow w c r | (c,r) <- reverse regs ]
         (x,y) <- getLBP w
         case (adjust regs (pixelToInch (x - xWin2), 
                            pixelToInch (yWin2 - y) )) of
           (Nothing,  _      ) -> closeWindow w
           (Just hit, newRegs) -> loop w (hit : newRegs)

  draw2 :: String -> Picture -> IO ()
  draw2 s p
    = runGraphics $
      do w <- openWindow s (xWin,yWin)
         loop w (pictToList p)

  p1,p2,p3,p4 :: Picture
  p1 = Region Red r1
  p2 = Region Blue r2
  p3 = Region Green r3
  p4 = Region Yellow r4

  pic :: Picture 
  pic = foldl Over EmptyPic [p1,p2,p3,p4]
  main = draw2 "Picture Click Test" pic

Run main.  Tell them NOT to run mainbook - can't quit.

  p5 = Region White (Shape (Rectangle 6 5))
  mainbook = draw2 "Picture Click Test" (pic `Over` p5)