module GTKQuadTree where

import qualified Graphics.UI.Gtk as G
import qualified Graphics.Rendering.Cairo as C
import qualified QuadTree2 as QT
import GTypes
import AStar
import Debug.Trace

testWindow :: QT.QuadTree -> [Point] -> IO ()
testWindow qt path = do
    G.unsafeInitGUIForThreadedRTS
    -- G.initGUI
    window <- G.windowNew
    canvas <- G.drawingAreaNew
    G.widgetSetSizeRequest window 700 700
    G.onKeyPress window $ const (do G.widgetDestroy window; return True)
    G.onDestroy window G.mainQuit
    G.onExpose canvas $ const (updateCanvas canvas qt path)
    G.set window [G.containerChild G.:= canvas]
    G.widgetShowAll window
    G.mainGUI

updateCanvas :: G.DrawingArea -> QT.QuadTree -> [Point] -> IO Bool
updateCanvas canvas qt path = do
    win <- G.widgetGetDrawWindow canvas
    (width, height) <- G.widgetGetSize canvas
    let drect = (0,0,fromIntegral width,fromIntegral height)
    G.renderWithDrawable win $ do
       C.setSourceRGB 0 0 0
       C.paint                                
       C.setLineWidth 1
       renderQT drect qt
       C.setSourceRGB 1 0 0
       renderPath drect (QT.boundingRect qt) path
       return ()
    return True
 

renderQT :: Rect -> QT.QuadTree -> C.Render ()
renderQT r (QT.Value _ False ) = do
    C.setSourceRGB 1 1 1
    pathRect r
    C.stroke
renderQT r (QT.Value _ True ) = do
    C.setSourceRGB 0.5 0.5 0.5
    pathRect r
    C.fill
    C.setSourceRGB 1 1 1
    pathRect r
    C.stroke
renderQT r (QT.Partition _ q1 q2 q3 q4) = do
    renderQT r1 q1
    renderQT r2 q2
    renderQT r3 q3
    renderQT r4 q4
  where
    (r1,r2,r3,r4) = qsplit r

renderPath :: Rect -> Rect -> [Point] -> C.Render ()
renderPath _ _ [] = return ()
renderPath (dx1,dy1,dx2,dy2) (mx1,my1,mx2,my2) ps = do
    C.newPath
    uncurry C.moveTo mp0
    mapM_ (uncurry C.lineTo) mps
    C.stroke
  where
    (mp0:mps) = map fixCoords ps
    fixCoords (x,y) = ( dx1 + (x - mx1) / (mx2-mx1) * (dx2-dx1),
                        dy1 + (y - my1) / (my2-my1) * (dy2-dy1) )


pathRect (x1,y1,x2,y2) = do
    C.newPath
    C.moveTo x1 y1
    C.lineTo x1 y2
    C.lineTo x2 y2
    C.lineTo x2 y1


test1 = testWindow (QT.empty (0,0,100,100)) [ (10,10), (90,90) ]

test2 c n = testWindow qt p
  where
    qt = QT.insertCircle c ((45,41.3),10) $
         QT.insertCircle c ((55,30),10) $
         QT.empty (0,0,100,100)
    (Just p) = findPath qt start end n
    start = (10,10)
    end = (90,90)

test3 c n = case findPath qt start end n of
    Just p -> testWindow qt p
    Nothing -> putStrLn "No path found"
  where
    qt = QT.insertCircle c ((45,45),10) $
         QT.insertCircle c ((65,45),10) $
         QT.insertCircle c ((55,55),10) $
         QT.insertCircle c ((50,80),10) $
         QT.insertCircle c ((80,70),10) $
         QT.insertCircle c ((90,10),30) $
         QT.empty (0,0,100,100)
    (Just p) = findPath qt start end n
    start = (10,10)
    end = (90,90)


test4 c n = case findPath qt start end n of
    Just p -> testWindow qt p
    Nothing -> putStrLn "No path found"
  where
    qt = QT.insertCircle c ((0,0),20) $
         QT.empty (-100,-100,100,100)
    (Just p) = findPath qt start end n
    start = (-90,-90)
    end = (90,90)

test5 c n = case findPath qt start end n of
    Just p -> testWindow qt p
    Nothing -> putStrLn "No path found"
  where
    qt = QT.insertCircle c ((100,100),20) $
         QT.empty (0,0,200,200)
    (Just p) = findPath qt start end n
    start = (10,10)
    end = (190,190)