home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / progs / demo / X11 / gobang / gobang.hs next >
Encoding:
Text File  |  1994-09-27  |  14.0 KB  |  165 lines  |  [TEXT/YHS2]
  1. module Gobang where
  2.  
  3. import Xlib
  4. import Utilities
  5. import Redraw
  6. import Weights
  7.  
  8. getXInfo :: String -> IO XInfo
  9. getXInfo host = 
  10.   xOpenDisplay host >>= \ display ->
  11.   let (screen:_) = xDisplayRoots display 
  12.       fg_pixel = xScreenBlackPixel screen
  13.       bg_pixel = xScreenWhitePixel screen
  14.       root = xScreenRoot screen
  15.   in 
  16.   xCreateWindow root
  17.                 (XRect 0 0 900 600)
  18.                 [XWinBackground bg_pixel, 
  19.                  XWinEventMask (XEventMask [XButtonPress, 
  20.                          cond then action else return ()
  21.  
  22. undoGame xinfo@(XInfo display window gcontext gcontext2 gcontextp)
  23.          state@(GameState player1 player2 board steps weight1 weight2 time
  24.                           numbersteps promptString next_player)
  25.          cont =
  26.   xMArrayLookup next_player 0 >>= \ next_p ->
  27.   xMArrayLookup player1 0 >>= \ name1 ->
  28.   xMArrayLookup player2 0 >>= \ name2 ->
  29.   let undoStep n =
  30.         xMArrayLookup steps (2*n) >>= \ x ->
  31.         xMArrayLookup steps (2*n+1) >>= \ y ->
  32.         xMArrayUpdate board ((x-1)*19 + y-1) 0 >>
  33.         (if (name1 == "computer" || name2 == "computer") 
  34.             then draw_unit board weight1 weight2 x y 
  35.             else return ()) >>
  36.        xDrawRectangle (XDrawWindow window) gcontext2 
  37.                       (XRect (x*30-15) (y*30-15) 30 30) True >>
  38. --        drawBoard xinfo >>
  39. --        drawPieces 1 1 board xinfo >>
  40.         let x30 = x * 30
  41.             y30 = y * 30
  42.             c = XPoint x30 y30
  43.             w = XPoint (x30-15) y30
  44.             e = XPoint (x30+15) y30
  45.             no = XPoint x30 (y30-15)
  46.             s = XPoint x30 (y30+15)
  47.             m = XArc (x30-3) (y30-3) 6 6 (-1.0) 6.283
  48.         in
  49.         when (x > 1) (xDrawLine (XDrawWindow window) gcontext w c) >>
  50.         when (x < 19) (xDrawLine (XDrawWindow window) gcontext c e) >>
  51.         when (y > 1) (xDrawLine (XDrawWindow window) gcontext no c) >>
  52.         when (y < 19) (xDrawLine (XDrawWindow window) gcontext c s) >>
  53.         when ((x `elem` [4,10,16]) && (y `elem` [4,10,16]))
  54.              (xDrawArc (XDrawWindow window) gcontext m True) >>
  55.         xDisplayForceOutput display >>
  56.         xMArrayUpdate numbersteps 0 n >>
  57.         xMArrayLookup next_player 0 >>= \ next_p ->
  58.         xMArrayUpdate next_player 0 (if next_p == 1 then 2 else 1) 
  59.  
  60.       cur_name = if next_p == 1 then name1 else name2
  61.       last_name = if next_p == 1 then name2 else name1
  62.   in
  63.   xMArrayLookup numbersteps 0 >>= \ n ->
  64.   if n==0 then drawCmd "No more steps to undo!" xinfo state >>
  65.                cont xinfo state
  66.   else 
  67.   if cur_name == "computer" then cont xinfo state
  68.   else
  69.   (undoStep (n-1) >>
  70.    if (last_name == "computer" && n /= 1) then undoStep (n-2)
  71.    else
  72.    return ()) >>
  73.   playGame xinfo state
  74.     
  75.  
  76.  
  77.  
  78. promptFile xinfo state cont =
  79.   promptFor "File name:" xinfo state >>= \ name ->
  80.   try (readFile name >>= (\ content -> cont (XSome content)))
  81.       (\ _ -> drawCmd ("Can't read file:" ++ name) xinfo state >>
  82.           cont XNull)
  83.            
  84.  
  85. loadGame xinfo state cont =
  86.   promptFile xinfo state $ \ file ->
  87.   case file of
  88.     XNull -> cont xinfo state
  89.     XSome file_content ->
  90.      readGameState file_content >>= \ new_state ->
  91.      let (GameState _ _ _ _ _ _ time _ _ _) = new_state
  92.      in
  93.      getTime >>= \ curtime ->
  94.      initArray time 2 4 curtime >>
  95.      redraw xinfo new_state >>
  96.      playGame xinfo new_state
  97.  
  98. saveGame :: XInfo -> GameState -> IO ()
  99. saveGame xinfo state =
  100.   promptFor "File name:" xinfo state >>= \ name ->
  101.   showGameState state >>= \ str ->
  102.   try (writeFile name str)
  103.       (\ _ -> drawCmd ("Can't write file: " ++ name) xinfo state)
  104.  
  105. quitGame :: XInfo -> GameState -> GameCont -> IO ()
  106. quitGame xinfo state cont =
  107.   let (XInfo display window gcontext gcontext2 gcontextp) = xinfo
  108.   in
  109.   promptFor "Are you sure? (y/n)" xinfo state >>= \ reps ->
  110.   if (reps == "y" || reps == "Y") then xCloseDisplay display
  111.                                   else clearCmd xinfo state >>
  112.                                        cont xinfo state
  113.  
  114. playGame :: XInfo -> GameState -> IO ()
  115. playGame xinfo state =
  116.      let             
  117.         (XInfo display window gcontext gcontext2 gcontextp) = xinfo
  118.         (GameState player1 player2 board steps weight1 weight2 time
  119.                    numbersteps promptString next_player) = state
  120.      in
  121.      xMArrayLookup numbersteps 0 >>= \ x ->
  122.      (\cont -> if x == 361 
  123.                then drawCmd "It's a tie!" xinfo state >>
  124.                     let loop xinfo state = waitButton xinfo state (\ _ -> loop)
  125.                     in loop xinfo state
  126.                else cont) $        
  127.      xMArrayLookup next_player 0 >>kup next_player 0 >>= \ next_player_num ->
  128.             drawPiece x y xinfo (next_player_num == 1) >>
  129.             updateboard xinfo state x y
  130.  
  131. humanplay :: XInfo -> GameState -> IO ()
  132. humanplay xinfo state =  waitButton xinfo state choice
  133.  
  134. computerplay :: XInfo -> GameState -> IO ()
  135. computerplay xinfo@(XInfo display window gcontext gcontext2 gcontextp)
  136.              state = 
  137.     let process_events xinfo state cont =
  138.           xEventListen display >>= \ n_event ->
  139.           if n_event == 0 then cont xinfo state
  140.           else xGetEvent display >>= \ event ->
  141.                case (xEventType event) of
  142.                  XButtonPressEvent -> 
  143.                             handleButton (xEventPos event) xinfo state cont
  144.                  XExposureEvent    -> 
  145.                             may_redraw (xEventCount event == 0)
  146.                                        xinfo state 
  147.                             >>
  148.                             process_events xinfo state cont
  149.                  XKeyPressEvent    ->
  150.                             process_events xinfo state cont
  151.     in
  152.     process_events xinfo state $ 
  153.     \ xinfo@(XInfo display window gcontext gcontext2 gcontextp)              
  154.       state@(GameState _ _ _ _ weight1 weight2 _ numbersteps _ next_player) ->
  155.     robot numbersteps weight1 weight2 >>= \pt ->
  156.     let (XPoint x y) = pt
  157.     in 
  158.     xMArrayLookup next_player 0 >>= \ next_player_num ->
  159.     drawPiece x y xinfo (next_player_num == 1) >>
  160.     updateboard xinfo state x y
  161.  
  162.  
  163.  
  164.  
  165.