module Main where

import qualified Graphics.UI.SDL as SDL
import qualified Graphics.UI.SDL.TTF as TTF

import Control.Concurrent
import Control.Monad

import Data.Char
import qualified Data.Map as M
import Data.Word
import System.Random

main::IO()
main= do
      gd<-initGraphics
      r<-getStdGen
      let gs=newChar $ GameState 0 100 2000 M.empty r 0 0 lives
      tcks<-SDL.getTicks 
      drawloop gs tcks gd
      endGraphics gd
      
checkEvent :: GameState -> SDL.Event -> (GameState ,Bool)   
checkEvent gs SDL.Quit = (gs,True)
checkEvent gs@GameState{gs_shown,gs_score} (SDL.KeyDown ks)    = 
        let c=toUpper $ SDL.symUnicode ks
        in ((if M.member c gs_shown
                        then gs{gs_shown=M.delete c gs_shown,gs_score=gs_score+1}
                        else gs),False)
                 
checkEvent gs _    = (gs,False)

drawloop :: GameState
                                    -> Data.Word.Word32
                                    -> GraphicsData
                                    -> IO ()
drawloop gs oldTicks gd@GraphicsData{gd_mainSurf}=do
        e<-SDL.pollEvent
        let (gs1,shouldStop)=checkEvent gs e
        if shouldStop
                then return ()
                else if gs_lives gs1 > 0
                 then do
                        newTicks<-SDL.getTicks
                        let d=newTicks-oldTicks
                        -- update game state
                        let mvs=(gs_moves gs1)+(fromIntegral d)
                        let gsInc=speedup gs1{gs_moves=mvs}
                        let gsMoved=if (mod mvs (gs_movespeed gsInc )) == 0 then moveDown gsInc else gsInc
                        let alive=gs_lives gsMoved > 0
                        SDL.fillRect gd_mainSurf (Just (SDL.Rect 0 0 width height)) (SDL.Pixel 0)
                        let gsNew=if alive 
                                then if (mod mvs (gs_newspeed gsMoved)) == 0 then newChar gsMoved else gsMoved
                                else gsMoved
                               
                        -- draw screen
                        SDL.fillRect gd_mainSurf (Just (SDL.Rect 0 0 width height)) (SDL.Pixel 0)
                        if alive 
                                then do
                                        mapM_ (drawChar gd) (M.assocs $ gs_shown gsNew)
                                        drawScore gd gsNew
                                else do
                                        gameOver gd gsNew
                        SDL.flip gd_mainSurf                
                             
                        newTicks'<-SDL.getTicks
                        let d'=newTicks'-oldTicks
                        when (d'<16) (threadDelay (fromIntegral d'))
                        drawloop gsNew newTicks gd   
                else  drawloop gs oldTicks gd
        
data GraphicsData = GraphicsData {
        gd_font :: TTF.Font
        , gd_mainSurf :: SDL.Surface
        }
 
data GameState = GameState {
        gs_moves :: Int
        , gs_movespeed :: Int
        , gs_newspeed :: Int
        , gs_shown :: M.Map Char (Int,Int)
        , gs_rand :: StdGen
        , gs_score :: Int
        , gs_score_beforespeed :: Int
        , gs_lives :: Int
        } 
 
speedup :: GameState -> GameState
speedup gs@GameState{gs_moves,gs_score,gs_movespeed,gs_newspeed,gs_score_beforespeed}=let
        speed=1 - (1 / (log $ ((fromIntegral gs_score)::Double) ^ (2::Int)))
        (ratio,sc)=if (gs_score-gs_score_beforespeed)>5 && (mod gs_moves 1000)==0 then (speed,gs_score) else (1,gs_score_beforespeed)
        in gs{gs_movespeed=round ((fromIntegral gs_movespeed)*ratio),gs_newspeed=round ((fromIntegral gs_newspeed)*ratio),gs_score_beforespeed=sc}


newChar :: GameState -> GameState
newChar gs@GameState{gs_rand,gs_shown}=let
        (c,r')=randomR ('A','Z') gs_rand
        (s',r'')=if not (M.member c gs_shown)
                then 
                        let (x,r2)=randomR (1,(div width 10)-2) r'
                        in (M.insert c (x*10,20) gs_shown,r2)
                else (gs_shown,r')
        in gs{gs_rand=r'',gs_shown=s'}
    
moveDown :: GameState -> GameState
moveDown gs@GameState{gs_shown,gs_lives}=let
        (dead,s')=M.foldWithKey  (\c (x,y) (b,m)->
                let y'=y+1
                in if (y'>(height-20)) 
                        then (True,m)
                        else (b,M.insert c (x,y') m)
                ) (False,M.empty) gs_shown
        d'=if dead then gs_lives-1 else gs_lives
        in gs{gs_shown=s',gs_lives=d'}
      
drawChar :: GraphicsData -> (Char,(Int,Int)) -> IO()
drawChar GraphicsData{gd_font,gd_mainSurf} (c,(x,y))=do
         let r = Just (SDL.Rect x y 10 10)
         txtS<-TTF.renderUTF8Solid gd_font [c] (SDL.Color 255 255 255)
         SDL.blitSurface txtS Nothing gd_mainSurf r
         SDL.freeSurface txtS
   
drawScore :: GraphicsData -> GameState -> IO()
drawScore GraphicsData{gd_font,gd_mainSurf} GameState{gs_score,gs_lives}=do
        let half= (div width 2)
        let r1 = Just (SDL.Rect 0 0 half 10)
        let r2 = Just (SDL.Rect (half+1) 0 half 10)
        txtS1<-TTF.renderUTF8Solid gd_font ("Lives:" ++ (show gs_lives) ++ "/" ++ (show lives)) (SDL.Color 255 20 20)
        SDL.blitSurface txtS1 Nothing gd_mainSurf r1
        SDL.freeSurface txtS1
        txtS2<-TTF.renderUTF8Solid gd_font ("Score:" ++ show gs_score) (SDL.Color 255 20 20)
        SDL.blitSurface txtS2 Nothing gd_mainSurf r2
        SDL.freeSurface txtS2
     
gameOver :: GraphicsData -> GameState -> IO()
gameOver GraphicsData{gd_font,gd_mainSurf} GameState{gs_score}=do
        let halfH=(div height 2)
        let halfW=(div width 2)
        let x=halfW-40
        let r1 = Just (SDL.Rect x (halfH-20) 200 10)
        let r2 = Just (SDL.Rect x (halfH+10) 200 10)
        txtS1<-TTF.renderUTF8Solid gd_font ("Game Over!") (SDL.Color 255 20 20)
        SDL.blitSurface txtS1 Nothing gd_mainSurf r1
        SDL.freeSurface txtS1
        txtS2<-TTF.renderUTF8Solid gd_font ("Score:" ++ show gs_score) (SDL.Color 255 20 20)
        SDL.blitSurface txtS2 Nothing gd_mainSurf r2
        SDL.freeSurface txtS2
        
width :: Int        
width = 640
    
height :: Int        
height =  480

lives :: Int
lives = 3

initGraphics :: IO(GraphicsData)
initGraphics = do
        SDL.init [SDL.InitEverything]
        TTF.init
        SDL.enableUnicode True
        SDL.setVideoMode width height 32 []
        SDL.setCaption "TypeClass: the typing game" "TypeClass"
        font<-TTF.openFont "FreeSansBold.ttf" 24
        mainSurf <- SDL.getVideoSurface
        return $ GraphicsData font mainSurf

endGraphics :: GraphicsData -> IO()
endGraphics GraphicsData{gd_font=font}=do
        TTF.closeFont font
        TTF.quit
        SDL.quit