path: root/progs/demo/X11/gobang/gobang.hs

module Gobang where

import Xlib
import Utilities
import Redraw
import Weights

getXInfo :: String -> IO XInfo
getXInfo host = 
  xOpenDisplay host `thenIO` \ display ->
  let (screen:_) = xDisplayRoots display 
      fg_pixel = xScreenBlackPixel screen
      bg_pixel = xScreenWhitePixel screen
      root = xScreenRoot screen
  in 
  xCreateWindow root
                (XRect 0 0 900 600)
                [XWinBackground bg_pixel, 
                 XWinEventMask (XEventMask [XButtonPress, 
                                            XKeyPress, 
                                            XExposure])]
                 `thenIO` \ window ->
  xSetWmName window "Gobang" `thenIO` \() ->
  xMapWindow window `thenIO` \() ->
  xOpenFont display "10x20" `thenIO`  \ playerfont ->
  xOpenFont display "6x13" `thenIO` \ genericfont ->
  xCreateGcontext (XDrawWindow window)
                  [XGCBackground bg_pixel,      
                   XGCForeground fg_pixel] `thenIO` \ gcontext  ->
  xCreateGcontext (XDrawWindow window)
                  [XGCBackground fg_pixel,
                   XGCForeground bg_pixel,
                   XGCFont       genericfont] `thenIO` \ gcontext2 ->
  xCreateGcontext (XDrawWindow window)
                  [XGCBackground bg_pixel,
                   XGCForeground fg_pixel,
                   XGCFont       playerfont] `thenIO` \ gcontextp ->
  returnIO (XInfo display window gcontext gcontext2 gcontextp)

demo = main

main = getEnv "DISPLAY" exit $ \ host ->
       xHandleError (\(XError msg) -> appendChan stdout msg exit done) $
       gobang host

gobang :: String -> IO ()
gobang host =
  getXInfo host `thenIO` \ xinfo ->
  xMArrayCreate [1..361] `thenIO` \ board ->
  xMArrayCreate [1..361] `thenIO` \ weight1 ->
  xMArrayCreate [1..361] `thenIO` \ weight2 ->
  xMArrayCreate [1..722] `thenIO` \ steps ->
  xMArrayCreate [""] `thenIO` \ player1 ->
  xMArrayCreate [""] `thenIO` \ player2 ->
  xMArrayCreate [1..4] `thenIO`  \ time ->
  xMArrayCreate [1] `thenIO` \ numbersteps ->
  xMArrayCreate [""] `thenIO` \ promptString ->
  xMArrayCreate [1] `thenIO` \ next_player ->
  let state = GameState player1 player2 board steps weight1 weight2 time
                        numbersteps promptString next_player
  in
  initGame xinfo state `thenIO` \ _ ->
  promptPlayers xinfo state `thenIO` \ _ ->
  playGame xinfo state

promptPlayers xinfo state = 
  let (XInfo display window gcontext gcontext2 gcontextp) = xinfo
      (GameState player1 player2 board steps weight1 weight2 time
                 numbersteps promptString next_player) = state
  in
  promptFor "player 1:" xinfo state `thenIO` \ player1_name ->
  xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 710 65) player1_name
  `thenIO` \ _ ->
  xMArrayUpdate player1 0 player1_name `thenIO` \ _ ->
  promptFor "player 2:" xinfo state `thenIO` \ player2_name ->
  xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 710 205) player2_name
  `thenIO` \ _ ->
  xMArrayUpdate player2 0 player2_name `thenIO` \ _ ->
  clearCmd xinfo state

initGame :: XInfo -> GameState -> IO ()
initGame xinfo 
         state@(GameState player1 player2 board steps weight1 weight2 time
                          numbersteps promptString next_player) =
          getTime `thenIO` \ curtime ->
          initArray time 0 2 0 `thenIO` \() ->
          initArray time 2 4 curtime `thenIO` \() ->
          initArray numbersteps 0 1 0 `thenIO` \() ->
          initArray board 0 361 0 `thenIO` \() ->
          initArray weight1 0 361 0 `thenIO` \() ->
          initArray weight2 0 361 0 `thenIO` \ () ->
          initArray next_player 0 1 1 `thenIO` \ () ->
          clearCmd xinfo state `thenIO` \ () ->
          redraw xinfo state
 

handleButton :: XPoint -> XInfo -> GameState -> GameCont -> IO ()
handleButton (XPoint x y) 
             xinfo
             state@(GameState player1 player2 board steps weight1 weight2 time
                              numbersteps promptString next_player)
             cont 
       | buttonPress 700 330 x y  = initArray player1 0 1 "" `thenIO` \ _ ->
                                    initArray player2 0 1 "" `thenIO` \ _ ->
                                    initGame xinfo state `thenIO` \ _ ->
                                    promptPlayers xinfo state `thenIO` \ _ ->
                                    playGame xinfo state
       | buttonPress 700 360 x y  = initGame xinfo state `thenIO` \ _ ->
                                    playGame xinfo state
       | buttonPress 700 390 x y  = undoGame xinfo state cont
       | buttonPress 700 420 x y  = loadGame xinfo state cont
       | buttonPress 700 450 x y  = saveGame xinfo state `thenIO` \ () ->
                                    cont xinfo state
       | buttonPress 700 480 x y  = quitGame xinfo state cont
       | ishelp x y          = helpGame xinfo state `thenIO` \ () ->
                               cont xinfo state
       | otherwise           = cont xinfo state

when :: Bool -> IO () -> IO ()
when cond action = if cond then action else returnIO ()

undoGame xinfo@(XInfo display window gcontext gcontext2 gcontextp)
         state@(GameState player1 player2 board steps weight1 weight2 time
                          numbersteps promptString next_player)
         cont =
  xMArrayLookup next_player 0 `thenIO` \ next_p ->
  xMArrayLookup player1 0 `thenIO` \ name1 ->
  xMArrayLookup player2 0 `thenIO` \ name2 ->
  let undoStep n =
        xMArrayLookup steps (2*n) `thenIO` \ x ->
        xMArrayLookup steps (2*n+1) `thenIO` \ y ->
        xMArrayUpdate board ((x-1)*19 + y-1) 0 `thenIO` \ _ ->
        (if (name1 == "computer" || name2 == "computer") 
            then draw_unit board weight1 weight2 x y 
            else returnIO ()) `thenIO` \ _ ->
       xDrawRectangle (XDrawWindow window) gcontext2 
                      (XRect (x*30-15) (y*30-15) 30 30) True 
       `thenIO` \() ->
--        drawBoard xinfo `thenIO` \ _ ->
--        drawPieces 1 1 board xinfo `thenIO` \ _ ->
        let x30 = x * 30
            y30 = y * 30
            c = XPoint x30 y30
            w = XPoint (x30-15) y30
            e = XPoint (x30+15) y30
            no = XPoint x30 (y30-15)
            s = XPoint x30 (y30+15)
            m = XArc (x30-3) (y30-3) 6 6 (-1.0) 6.283
        in
        when (x > 1) (xDrawLine (XDrawWindow window) gcontext w c) 
        `thenIO` \ _ ->
        when (x < 19) (xDrawLine (XDrawWindow window) gcontext c e) 
        `thenIO` \ _ ->
        when (y > 1) (xDrawLine (XDrawWindow window) gcontext no c) 
        `thenIO` \ _ ->
        when (y < 19) (xDrawLine (XDrawWindow window) gcontext c s) 
        `thenIO` \ _ ->
        when ((x `elem` [4,10,16]) && (y `elem` [4,10,16]))
             (xDrawArc (XDrawWindow window) gcontext m True) 
        `thenIO` \ _ ->
        xDisplayForceOutput display `thenIO` \ _ ->
        xMArrayUpdate numbersteps 0 n `thenIO` \ _ ->
        xMArrayLookup next_player 0 `thenIO` \ next_p ->
        xMArrayUpdate next_player 0 (if next_p == 1 then 2 else 1) 

      cur_name = if next_p == 1 then name1 else name2
      last_name = if next_p == 1 then name2 else name1
  in
  xMArrayLookup numbersteps 0 `thenIO` \ n ->
  if n==0 then drawCmd "No more steps to undo!" xinfo state `thenIO` \ _ ->
               cont xinfo state
  else 
  if cur_name == "computer" then cont xinfo state
  else
  (undoStep (n-1) `thenIO` \_ ->
   if (last_name == "computer" && n /= 1) then undoStep (n-2)
   else
   returnIO ()) `thenIO` \ _ ->
  playGame xinfo state
    



promptFile xinfo state cont =
  promptFor "File name:" xinfo state `thenIO` \ name ->
  readFile name 
           (\ _ -> drawCmd ("Can't read file:" ++ name) xinfo state 
                   `thenIO` \ _ -> 
		   cont XNull)
           (\ content -> cont (XSome content))

loadGame xinfo state cont =
  promptFile xinfo state $ \ file ->
  case file of
    XNull -> cont xinfo state
    XSome file_content ->
     readGameState file_content `thenIO` \ new_state ->
     let (GameState _ _ _ _ _ _ time _ _ _) = new_state
     in
     getTime `thenIO` \ curtime ->
     initArray time 2 4 curtime `thenIO` \() ->
     redraw xinfo new_state `thenIO` \ _ ->
     playGame xinfo new_state

saveGame :: XInfo -> GameState -> IO ()
saveGame xinfo state =
  promptFor "File name:" xinfo state `thenIO` \ name ->
  showGameState state `thenIO` \ str ->
  writeFile name str
            (\ _ -> drawCmd ("Can't write file: " ++ name) xinfo state)
	    done

quitGame :: XInfo -> GameState -> GameCont -> IO ()
quitGame xinfo state cont =
  let (XInfo display window gcontext gcontext2 gcontextp) = xinfo
  in
  promptFor "Are you sure? (y/n)" xinfo state `thenIO` \ reps ->
  if (reps == "y" || reps == "Y") then xCloseDisplay display
                                  else clearCmd xinfo state `thenIO` \ _ ->
                                       cont xinfo state

playGame :: XInfo -> GameState -> IO ()
playGame xinfo state =
     let             
        (XInfo display window gcontext gcontext2 gcontextp) = xinfo
        (GameState player1 player2 board steps weight1 weight2 time
                   numbersteps promptString next_player) = state
     in
     xMArrayLookup numbersteps 0 `thenIO` \ x ->
     (\cont -> if x == 361 
               then drawCmd "It's a tie!" xinfo state `thenIO` \ _ ->
                    let loop xinfo state = waitButton xinfo state (\ _ -> loop)
                    in loop xinfo state
               else cont) $        
     xMArrayLookup next_player 0 `thenIO` \ next_player_num ->
     getTime `thenIO` \ curtime ->
     xMArrayLookup time 0 `thenIO` \ lstm0 ->
     xMArrayLookup time 1 `thenIO` \ lstm1 ->
     xMArrayLookup time 2 `thenIO` \ lstm2 ->
     xMArrayLookup time 3 `thenIO` \ lstm3 ->
     drawCmd ("Waiting for player # " ++ (show next_player_num)) xinfo state 
     `thenIO` \() ->
     if (next_player_num == 1)
        then xDrawGlyph (XDrawWindow window) gcontextp (XPoint 850 70)
                   '<' `thenIO` \(trash) ->
             xDrawRectangle (XDrawWindow window) gcontext2 
	                    (XRect 840 180 40 40) True `thenIO` \() ->
             xMArrayUpdate time 2 curtime `thenIO` \() ->
             xMArrayUpdate time 1 (lstm1+curtime-lstm3) `thenIO` \() ->
             showtime 705 270 (lstm1+curtime-lstm3) xinfo `thenIO` \() ->
             xMArrayLookup player1 0 `thenIO` \ x ->
             if (x == "computer") 
                   then computerplay xinfo state
                   else humanplay xinfo state
        else xDrawGlyph (XDrawWindow window) gcontextp (XPoint 850 210)
                    '<' `thenIO` \(trash) ->
             xDrawRectangle (XDrawWindow window) gcontext2 
	                    (XRect 840 40 40 40)  True `thenIO` \() ->
             xMArrayUpdate time 3 curtime `thenIO` \() ->
             xMArrayUpdate time 0 (lstm0+curtime-lstm2) `thenIO` \() ->
             showtime 705 130 (lstm0+curtime-lstm3) xinfo `thenIO` \() ->
             xMArrayLookup player2 0 `thenIO` \ x ->
             if (x == "computer") 
                   then computerplay xinfo state
                   else humanplay xinfo state

waitButton xinfo@(XInfo display _ _ _ _) state cont = 
  let
    loop xinfo state = 
      xGetEvent display `thenIO` \ event ->
      case (xEventType event) of
        XExposureEvent -> may_redraw (xEventCount event == 0) xinfo state 
                          `thenIO` \ _ ->
                          loop xinfo state
        XButtonPressEvent -> 
                          let pos = xEventPos event
                          in 
                          handleButton pos xinfo state (cont pos)
        _              -> xBell display 0 `thenIO` \ _ ->
                          loop xinfo state
  in
  loop xinfo state

updateboard :: XInfo -> GameState -> Int -> Int -> IO ()
updateboard xinfo state x y = 
            let (GameState player1 player2 board steps weight1 weight2 time
                           numbersteps promptString next_player) = state
                (XInfo display window gcontext gcontext2 gcontextp) = xinfo
            in
            xMArrayLookup next_player 0 `thenIO` \ next_player_num ->
            xMArrayUpdate next_player 0 (if next_player_num == 1 then 2 else 1)
            `thenIO` \ _ -> 
            xMArrayLookup numbersteps 0 `thenIO` \ z ->
            xMArrayUpdate numbersteps 0 (z+1) `thenIO` \() ->
            xMArrayUpdate steps (2*z) x `thenIO` \() ->
            xMArrayUpdate steps (2*z+1) y `thenIO` \() ->
            xMArrayLookup player1 0 `thenIO` \ name1 ->
            xMArrayLookup player2 0 `thenIO` \ name2 ->
            xMArrayUpdate board (19*(x-1)+y-1) next_player_num 
            `thenIO` \() ->
            human_unit board x y `thenIO` \ win ->
            if win 
            then drawCmd ("Player " ++ (show next_player_num) ++ " has won!")
                         xinfo state `thenIO` \ _ ->
                 let loop xinfo state = waitButton xinfo state (\ _ -> loop)
                 in loop xinfo state
            else if (name1 == "computer" || name2 == "computer")
                 then draw_unit board weight1 weight2 x y `thenIO` \() ->
                      xMArrayUpdate weight1 (19*(x-1)+y-1) (-1) `thenIO` \() ->
                      xMArrayUpdate weight2 (19*(x-1)+y-1) (-1) `thenIO` \() ->
                      playGame xinfo state
                 else playGame xinfo state

choice :: XPoint -> XInfo -> GameState -> IO ()
choice (XPoint x y) xinfo@(XInfo display _ _ _ _) state =
   let (GameState player1 player2 board steps weight1 weight2 time
                  numbersteps promptString next_player) = state
   in
   case (getposition x y) of
     XNull -> humanplay xinfo state
     XSome (x, y) -> 
       xMArrayLookup board (19*(x-1)+y-1) `thenIO` \ z ->
       if (z>0)
       then xBell display 0 `thenIO` \ _ ->
            drawCmd "Wrong point, please re-enter" xinfo state `thenIO` \() ->
            humanplay xinfo state
       else xMArrayLookup next_player 0 `thenIO` \ next_player_num ->
            drawPiece x y xinfo (next_player_num == 1) `thenIO` \() ->
            updateboard xinfo state x y

humanplay :: XInfo -> GameState -> IO ()
humanplay xinfo state =  waitButton xinfo state choice

computerplay :: XInfo -> GameState -> IO ()
computerplay xinfo@(XInfo display window gcontext gcontext2 gcontextp)
             state = 
    let process_events xinfo state cont =
          xEventListen display `thenIO` \ n_event ->
          if n_event == 0 then cont xinfo state
          else xGetEvent display `thenIO` \ event ->
               case (xEventType event) of
                 XButtonPressEvent -> 
                            handleButton (xEventPos event) xinfo state cont
                 XExposureEvent    -> 
                            may_redraw (xEventCount event == 0)
                                       xinfo state 
                            `thenIO` \ _ ->
                            process_events xinfo state cont
                 XKeyPressEvent    ->
                            process_events xinfo state cont
    in
    process_events xinfo state $ 
    \ xinfo@(XInfo display window gcontext gcontext2 gcontextp)              
      state@(GameState _ _ _ _ weight1 weight2 _ numbersteps _ next_player) ->
    robot numbersteps weight1 weight2 `thenIO` \pt ->
    let (XPoint x y) = pt
    in 
    xMArrayLookup next_player 0 `thenIO` \ next_player_num ->
    drawPiece x y xinfo (next_player_num == 1) `thenIO` \() ->
    updateboard xinfo state x y