-- <PRE>

import Draw
import Region
import SOEGraphics hiding (Region)
import qualified SOEGraphics as G (Region)


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


-- The Color type is imported from SOEGraphics
-- and Exported from Picture
-- data Color = Black | Blue | Green | Cyan
--            | Red | Magenta | Yellow | White

------ Changes here --------

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

----------- End Changes ------------------

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


-- First a little side trip

data NewRegion = Rect Side Side  -- Abstracts G.Region

regToNReg1 :: Region -> NewRegion
regToNReg1 (Shape (Rectangle sx sy))
      = Rect sx sy
regToNReg1 (Scale (x,y) r)
      = regToNReg1 (scaleReg (x,y) r)
  where scaleReg (x,y) (Shape (Rectangle sx sy))
             = Shape (Rectangle (x*sx) (y*sy))
        scaleReg (x,y) (Scale s r)
             = Scale s (scaleReg (x,y) r)

reverse1 [] = []
reverse1 (x:xs) = (reverse1 xs) ++ [x]
  where [] ++ zs = zs
        (y:ys) ++ zs = y : (ys ++ zs)

reverse2 xs = revhelp xs []
  where revhelp [] zs = zs
        revhelp (x:xs) zs = revhelp xs (x:zs)

regToNReg2 :: Region -> NewRegion
regToNReg2 r = rToNR (1,1) r
  where rToNR :: (Float,Float) -> Region -> NewRegion
        rToNR (x1,y1) (Shape (Rectangle sx sy))
               = Rect (x1*sx) (y1*sy)
        rToNR (x1,y1) (Scale (x2,y2) r)
               = rToNR (x1*x2,y1*y2) r


--- Return from side trip

regToGReg1 :: Vector -> Vector -> Region -> G.Region
regToGReg1 trans sca (Shape s) = shapeToGRegion trans sca s
regToGReg1 (x,y) sca (Translate (u,v) r)
  = regToGReg1 (x+u, y+v) sca r
regToGReg1 trans (x,y) (Scale (u,v) r)
  = regToGReg1 trans (x*u, y*v) r
regToGReg1 trans sca Empty = createRectangle (0,0) (0,0)
regToGReg1 trans sca (r1 `Union` r2)
  = let gr1 = regToGReg1 trans sca r1
        gr2 = regToGReg1 trans sca r2
    in orRegion gr1 gr2


---------- Changes here ------------

primGReg trans sca r1 r2 op
  = let gr1 = regToGReg trans sca r1
        gr2 = regToGReg trans sca r2
    in op gr1 gr2

regToGReg :: Vector -> Vector -> Region -> G.Region
regToGReg (trans @ (x,y)) (sca @ (a,b)) shape =
  case shape of
    (Shape s) -> shapeToGRegion trans sca s
    (Translate (u,v) r) -> regToGReg (x+u, y+v) sca r
    (Scale (u,v) r) -> regToGReg trans (a*u, b*v) r
    (Empty) -> createRectangle (0,0) (0,0)
    (r1 `Union` r2) -> primGReg trans sca r1 r2 orRegion
    (r1 `Intersect` r2) -> primGReg trans sca r1 r2 andRegion
    (Complement  r) -> primGReg trans sca winRect r diffRegion
       where  winRect :: Region
              winRect = Shape (Rectangle
                        (pixelToInch xWin) (pixelToInch yWin))

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

----------- End Changes -----------------


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

shapeToGRegion1
  :: Vector -> Vector -> Shape -> G.Region
shapeToGRegion1 (lx,ly) (sx,sy) (Rectangle s1 s2)
  = createRectangle (trans(-s1/2,-s2/2)) (trans (s1/2,s2/2))
   where trans (x,y) = ( xWin2 + inchToPixel ((x+lx)*sx),
                         yWin2 - inchToPixel ((y+ly)*sy) )
shapeToGRegion1 (lx,ly) (sx,sy) (Ellipse r1 r2)
  = createEllipse (trans (-r1,-r2)) (trans ( r1, r2))
    where trans (x,y) =
            ( xWin2 + inchToPixel ((x+lx)*sx),
              yWin2 - inchToPixel ((y+ly)*sy) )
shapeToGRegion1 (lx,ly) (sx,sy) (Polygon pts)
  = createPolygon (map trans pts)
    where trans (x,y) =
                ( xWin2 + inchToPixel ((x+lx)*sx),
                  yWin2 - inchToPixel ((y+ly)*sy) )
shapeToGRegion1 (lx,ly) (sx,sy) (RtTriangle s1 s2)  =
   createPolygon (map trans [(0,0),(s1,0),(0,s2)])
       where trans (x,y) =
                  ( xWin2 + inchToPixel ((x+lx)*sx),
                    yWin2 - inchToPixel ((y+ly)*sy) )


shapeToGRegion (lx,ly) (sx,sy) 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 pts -> createPolygon (map trans pts)
       RtTriangle s1 s2  -> createPolygon
                             (map trans [(0,0),
                                         (s1,0),
                                         (0,s2)])
   where trans (x,y) = ( xWin2 + inchToPixel ((x+lx)*sx),
                         yWin2 - inchToPixel ((y+ly)*sy) )
   -- IMPORTANT that the WHERE be indented less than the patterns
   -- of the case. Because it then attaches to the last clause of
   -- the case rather than the defining equation. Since the Draw
   -- defines a trans function (with the right type) but the wrong
   -- functionality, the other clauses of the case appear well defined
   -- but do very strange things.

draw :: Picture -> IO ()
draw p
   = runGraphics (
     do w <- openWindow "Region Test" (xWin,yWin)
        drawPic w p
        spaceClose w
     )


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            `Union`     --RtTriangle
       r1            `Intersect` -- Rectangle
       Complement r2 `Union`     -- Ellispe
       r4                        -- Polygon
pic1 = Region Cyan reg1

main1 = draw pic1

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

main2 = draw pic2

pic3 = pic2 `Over` pic1

main3 = draw pic3

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

pic4 = Region Magenta (Scale (0.25,0.25) fiveCircles)

main4 = draw pic4

x0 = Region Magenta oneCircle
x1 = Region Magenta (Scale (0.25,0.25) oneCircle)

---- Ordering Pictures

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

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


pic6 = pic4 `Over` pic2 `Over` pic1 `Over` pic3
zz = pictToList pic6
-- [(Magenta,?), (yellow,?),(Cyan,?),(Cyan,?)]


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

adjust []           p = (Nothing, [])
adjust ((c,r):regs) p =
     if r `containsR` p
        then (Just (c,r), regs)
        else let (hit, rs) = adjust regs p
             in  (hit, (c,r) : rs)

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


loop :: Window -> [(Color,Region)] -> IO ()
loop w regs =
 do clearWindow w
    sequence [ drawRegionInWindow w c r |
                 (c,r) <- reverse regs ]
    (x,y) <- getLBP w
    print "Before adjust\n"
    case (adjust2 regs (pixelToInch (x - xWin2),
                       pixelToInch (yWin2 - y) )) of
       (Nothing,  _      ) -> do { print "Nothing"; closeWindow w }
       (Just hit, newRegs) -> do { print "after adjust"
                                 ; loop w (hit : newRegs) }

draw2 :: Picture -> IO ()
draw2 pic
  = runGraphics (
    do w <- openWindow "Picture demo" (xWin,yWin)
       loop w (pictToList pic))


p1,p2,p3,p4 :: Picture
p1 = Region Magenta r1
p2 = Region Cyan r2
p3 = Region Green r3
p4 = Region Yellow r4

pic :: Picture
pic = foldl Over EmptyPic [p1,p2,p3,p4]

main5 = draw2 pic


loop2 w regs
    = do clearWindow w
         sequence [ drawRegionInWindow w c r |
                    (c,r) <- reverse regs ]
         (x,y) <- getLBP w
         let aux (_,r) = r `containsR`
                     ( pixelToInch (x-xWin2),
                       pixelToInch (yWin2-y) )
         case (break aux regs) of
           (_,[])        -> closeWindow w
           (top,hit:bot) -> loop w (hit : (top++bot))

draw3 :: Picture -> IO ()
draw3 pic
  = runGraphics (
    do w <- openWindow "Picture demo" (xWin,yWin)
       loop2 w (pictToList pic) )

main6 = draw3 pic



-- </PRE>