TTT_Live.hs

Dateiinhalt

{-
  LIVE coded during Lecture "Fortgeschrittene Funktionale Programmierung", 28.01.2016
  Steffen Jost, LFE TCS, LMU Munich, Bavaria

-}

{-# LANGUAGE RecursiveDo #-}

import Data.Maybe
import qualified Data.Map as Map
import Data.IORef
import Control.Applicative
import Control.Monad
import Control.Concurrent
import Graphics.UI.Gtk

import TTT_Model
import TTT_AI

gameSize         = 7
winSize          = 5
startPlayer      = X
humanPlayer      = X
computerPlayer   = O
computerStrength = 3


data App = App { stateRef :: IORef State
               , buttons  :: Map.Map Pos Button
               , label    :: Label
               }

main :: IO ()
main = do
  putStrLn "Tic Tac Toe starting."
  let spiel = newGame gameSize winSize startPlayer
  
  initGUI
  window <- windowNew
  vbox   <- vBoxNew False 10
  label  <- labelNew (Just $ "Anfang")
  table  <- tableNew (size spiel) (size spiel) True
  set window [windowTitle := "Tic Tac Toe"
             ,windowDefaultWidth  := 270
             ,windowDefaultHeight := 270
             ,containerBorderWidth := 10
             ,containerChild := vbox ]
  boxPackStart vbox table PackGrow    10
  boxPackEnd vbox label PackNatural 10
  
  let positions = [Pos(x,y) | x<-[1..size spiel], y<-[1..size spiel] ]

  stateRef <- newIORef spiel
  let createButton app pos = do 
        b <- buttonNew
        set b [ buttonRelief := ReliefHalf ] 
        let Pos(x,y) = pos
        tableAttachDefaults table b (x-1) x (y-1) y
        onClicked b $ playerMove app pos 
        return b
  rec 
    let app = App { stateRef=stateRef, label=label, buttons=buttons }
    buttons <- foldM (\btns pos -> do
                                    b <- createButton app pos
                                    return $ Map.insert pos b btns
                                    
                      )  Map.empty positions 
  
  timeoutAddFull (yield >> return True) priorityDefaultIdle 100 
  onDestroy window mainQuit
  widgetShowAll window
  mainGUI

  
-- Spieler hat gedrückt 
playerMove app pos = do
  registerMove app (humanPlayer,pos)
  moveComputer app    
     
registerMove app move@(player,pos) = do
  state <- readIORef $ stateRef app
  case makeMove state move of
    Nothing -> putStrLn "Illegal Move"
    (Just moveok) -> do
      let btn = fromJust $ Map.lookup pos $ buttons app 
      set btn [ buttonLabel := show player]
      writeIORef (stateRef app) moveok
      set (label app) [ labelLabel := (showStatus moveok) ]
      
moveComputer app = do
  state <- readIORef $ stateRef app 
  if (turn state /= Just computerPlayer) 
     then return ()
     else
      case computerMove computerStrength state of
        Nothing -> putStrLn "No more computer moves"
        (Just m)-> registerMove app m
    
  
  -- computerMove :: Int -> State -> Maybe Move
  
  return ()