From 4e987026148fe65c323afbc93cd560c07bf06b3f Mon Sep 17 00:00:00 2001 From: Yale AI Dept Date: Wed, 14 Jul 1993 13:08:00 -0500 Subject: Import to github. --- progs/demo/X11/gobang/gobang.hs | 364 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 364 insertions(+) create mode 100644 progs/demo/X11/gobang/gobang.hs (limited to 'progs/demo/X11/gobang/gobang.hs') diff --git a/progs/demo/X11/gobang/gobang.hs b/progs/demo/X11/gobang/gobang.hs new file mode 100644 index 0000000..f4844dc --- /dev/null +++ b/progs/demo/X11/gobang/gobang.hs @@ -0,0 +1,364 @@ +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 + + + + -- cgit v1.2.3