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/README | 66 +++++++ progs/demo/X11/gobang/gobang.hs | 364 +++++++++++++++++++++++++++++++++++++ progs/demo/X11/gobang/gobang.hu | 7 + progs/demo/X11/gobang/misc.hi | 7 + progs/demo/X11/gobang/misc.hu | 2 + progs/demo/X11/gobang/redraw.hs | 160 ++++++++++++++++ progs/demo/X11/gobang/redraw.hu | 4 + progs/demo/X11/gobang/utilities.hs | 305 +++++++++++++++++++++++++++++++ progs/demo/X11/gobang/utilities.hu | 6 + progs/demo/X11/gobang/weights.hs | 323 ++++++++++++++++++++++++++++++++ progs/demo/X11/gobang/weights.hu | 4 + 11 files changed, 1248 insertions(+) create mode 100644 progs/demo/X11/gobang/README create mode 100644 progs/demo/X11/gobang/gobang.hs create mode 100644 progs/demo/X11/gobang/gobang.hu create mode 100644 progs/demo/X11/gobang/misc.hi create mode 100644 progs/demo/X11/gobang/misc.hu create mode 100644 progs/demo/X11/gobang/redraw.hs create mode 100644 progs/demo/X11/gobang/redraw.hu create mode 100644 progs/demo/X11/gobang/utilities.hs create mode 100644 progs/demo/X11/gobang/utilities.hu create mode 100644 progs/demo/X11/gobang/weights.hs create mode 100644 progs/demo/X11/gobang/weights.hu (limited to 'progs/demo/X11/gobang') diff --git a/progs/demo/X11/gobang/README b/progs/demo/X11/gobang/README new file mode 100644 index 0000000..d5634a4 --- /dev/null +++ b/progs/demo/X11/gobang/README @@ -0,0 +1,66 @@ +gobang Weiming Wu & Niping Wu + + +Introduction + +Our final project is to design and implement a Gobang game under +X-Window3.2 environment, using the Haskell programming language. Users +can play the game human-vs-human. The program also provides a robot +player with whom the user can play the game with. We wrote altogether +ten modules which were saved in different files to control the whole +game. + + +About Gobang + +The checkerboard of Gobang consists of 19 vertical lines and 19 +horizontal lines. Two players in turn place a unit on the +checkerboard. Each unit should be put on an unoccupied intersection +of a vertical and a horizontal line. The winner is the player who +first makes five consecutive units on either vertical, horizontal or +diagonal direction. + +The program is able to perform the following tasks: 1) Use a new +window under X-Window interface to display the checkerboard. Players +will use a mouse to place units onto the chessboard, where a unit is a +circle with the color black or white. 2) Prompt for the names of both +players and display them. 3) Calculate the time both players have +used up. 4) Supervise the progress of the game, declare winner and +end the game once one player wins. 5) At each point of the game, +store the progress of the game, so players can review each step during +the game. 6) There are five buttons on the screen which would provide +some special services such as starting a new game, quitting the game, +saving the game, importing the saved game, or reviewing the game as +soon as the user selects the corresponding buttons. 7) Provide a +moderately well robot player for that game (using minimum-maximum +algorithm). + + +Running Gobang + +A window titled "gobang" will appear on the screen. On it is a +checkerboard, clocks and buttons. There will be an instruction saying +"Please enter the name of player-1". The user can do two things: +either enter the name of a player or choose the "import" button. Once +the "import" button is selected, an unfinished game, which was saved +in the file "###go.bhs###" will be imported. Please notice that the +character "@" is reserved for the robot player, so if the user types +in @ as the name of the first player, it is assumed that player-1 is +the robot player. Then the name of player 2 is prompted. The game +starts and at each turn an instruction like "Please enter your play." +would appear on the screen. The user should put a unit onto the +checkerboard. If the button is clicked on a wrong place or a unit is +put onto an occupied position, an error message saying "Wrong Point. +Please reenter." will appear on the screen and the user should reenter +his play. The marker next to the name of a player indicates whose +turn it is. At any point of the game the user can choose the other +four buttons. If the "new" button is selected, the present game will +be terminated and a new blank checkerboard will be displayed on the +screen; if the "review" button is selected, one step of the previous +plays will be displayed each time after the user hits any key; if the +"save" button is selected, the steps so far will be saved into the +file "###go.bhs###"; if the "quit" button is selected, the game will +be terminated. + + + 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 + + + + diff --git a/progs/demo/X11/gobang/gobang.hu b/progs/demo/X11/gobang/gobang.hu new file mode 100644 index 0000000..d228bb2 --- /dev/null +++ b/progs/demo/X11/gobang/gobang.hu @@ -0,0 +1,7 @@ +:o= foldr inline constant +$HASKELL_LIBRARY/X11/xlib.hu +gobang.hs +misc.hi +utilities.hs +redraw.hs +weights.hs diff --git a/progs/demo/X11/gobang/misc.hi b/progs/demo/X11/gobang/misc.hi new file mode 100644 index 0000000..29a29be --- /dev/null +++ b/progs/demo/X11/gobang/misc.hi @@ -0,0 +1,7 @@ +interface Misc where + +random :: Int -> IO Int + +{-# +random :: LispName("lisp:random") +#-} \ No newline at end of file diff --git a/progs/demo/X11/gobang/misc.hu b/progs/demo/X11/gobang/misc.hu new file mode 100644 index 0000000..42a9c68 --- /dev/null +++ b/progs/demo/X11/gobang/misc.hu @@ -0,0 +1,2 @@ +misc.hi + diff --git a/progs/demo/X11/gobang/redraw.hs b/progs/demo/X11/gobang/redraw.hs new file mode 100644 index 0000000..9ec772f --- /dev/null +++ b/progs/demo/X11/gobang/redraw.hs @@ -0,0 +1,160 @@ +module Redraw where + +import Xlib +import Utilities + +may_redraw :: Bool -> XInfo -> GameState -> IO () +may_redraw ok xinfo state = if ok then redraw xinfo state else returnIO () + +redraw :: XInfo -> GameState -> IO () + +redraw xinfo state = + let (XInfo display window gcontext gcontext2 gcontextp) = xinfo + in + xDrawRectangle (XDrawWindow window) gcontext2 (XRect 0 0 900 600) True + `thenIO` \ _ -> + drawBoard xinfo `thenIO` \ () -> + xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 610 65) "Player 1" + `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 620 125) "Clock 1" + `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 610 205) "Player 2" + `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 620 265) "Clock 2" + `thenIO` \ _ -> + xDrawRectangle (XDrawWindow window) gcontext (XRect 700 45 130 30) False + `thenIO` \ () -> + xDrawRectangle (XDrawWindow window) gcontext (XRect 700 105 90 30) False + `thenIO` \ () -> + xDrawRectangle (XDrawWindow window) gcontext (XRect 700 185 130 30) False + `thenIO` \() -> + xDrawRectangle (XDrawWindow window) gcontext (XRect 700 245 90 30) False + `thenIO` \() -> + button 700 330 "New players" xinfo `thenIO` \() -> + button 700 360 "New game" xinfo `thenIO` \() -> + button 700 390 "Undo" xinfo `thenIO` \() -> + button 700 420 "Load" xinfo `thenIO` \() -> + button 700 450 "Save" xinfo `thenIO` \() -> + button 700 480 "Quit" xinfo `thenIO` \() -> + helpButton xinfo `thenIO` \ _ -> + xDrawRectangle (XDrawWindow window) gcontext (XRect 615 535 250 30) False + `thenIO` \ _ -> + let (GameState player1 player2 board steps weight1 weight2 time + numbersteps promptString next_player) = state + in + xMArrayLookup time 0 `thenIO` \ lstm0 -> + xMArrayLookup time 1 `thenIO` \ lstm1 -> + showtime 705 270 (lstm1) xinfo `thenIO` \() -> + showtime 705 130 (lstm0) xinfo `thenIO` \() -> + xMArrayLookup player1 0 `thenIO` \ player1_name -> + xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 710 65) player1_name + `thenIO` \ _ -> + xMArrayLookup player2 0 `thenIO` \ player2_name -> + xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 710 205) player2_name + `thenIO` \ _ -> + xMArrayLookup promptString 0 `thenIO` \ ps -> + xDrawGlyphs (XDrawWindow window) gcontext (XPoint 620 550) ps + `thenIO` \ _ -> + xMArrayLookup next_player 0 `thenIO` \ next_player_num -> + (if (next_player_num == 1) + then xDrawGlyph (XDrawWindow window) gcontextp (XPoint 850 70) '<' + else xDrawGlyph (XDrawWindow window) gcontextp (XPoint 850 210) '<') + `thenIO` \ _ -> + drawPieces 1 1 board xinfo `thenIO` \ _ -> + returnIO () + +drawHelp (XInfo display window gcontext gcontext2 gcontextp) = + xDrawRectangle (XDrawWindow window) gcontext2 (XRect 100 100 300 200) True + `thenIO` \ _ -> + xDrawRectangle (XDrawWindow window) gcontext (XRect 100 100 300 200) False + `thenIO` \ _ -> + xDrawRectangle (XDrawWindow window) gcontext (XRect 102 102 296 196) False + `thenIO` \ _ -> + xDrawRectangle (XDrawWindow window) gcontext (XRect 200 230 100 60) False + `thenIO` \ _ -> + xDrawRectangle (XDrawWindow window) gcontext (XRect 202 232 96 56) False + `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 240 265) "OK" + `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontext (XPoint 120 120) + "Two players in turn place black and white" + `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontext (XPoint 120 135) + "pieces on the board. The winner is the" + `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontext (XPoint 120 150) + "player who first makes five consecutive" + `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontext (XPoint 120 165) + "pieces in either vertical, horizontal or" + `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontext (XPoint 120 180) + "diagonal directions." + `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontext (XPoint 120 200) + "To play with a robot, type \"computer\" as" + `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontext (XPoint 120 215) + "the name of another player." + + +drawBoard (XInfo display window gcontext gcontext2 gcontextp) = + drawvlines 30 30 1 `thenIO` \() -> + drawhlines 30 30 1 `thenIO` \() -> + drawmarks where + + drawvlines :: Int -> Int -> Int -> IO () + drawvlines x y z + | z <= 19 + = xDrawLine (XDrawWindow window) gcontext + (XPoint x y) (XPoint x (y+30*18)) `thenIO` \() -> + drawvlines (x+30) y (z+1) + | otherwise + = returnIO () + + drawhlines :: Int -> Int -> Int -> IO () + drawhlines x y z + | z <= 19 + = xDrawLine (XDrawWindow window) gcontext + (XPoint x y) (XPoint (x+30*18) y) `thenIO` \() -> + drawhlines x (y+30) (z+1) + | otherwise + = returnIO () + + drawmarks :: IO () + drawmarks = + map2IO (\x y -> + xDrawArc (XDrawWindow window) gcontext + (XArc x y 6 6 (-1.0) 6.283) True) + (map (\x -> 30 + x*30-3) [3,9,15,3,9,15,3,9,15]) + (map (\x -> 30 + x*30-3) [3,3,3,9,9,9,15,15,15]) + `thenIO` \ _ -> returnIO () + +map2IO :: (a -> b -> IO c) -> [a] -> [b] -> IO [c] + +map2IO f [] [] = returnIO [] +map2IO f (x:xs) (z:zs) = f x z `thenIO` \ y -> + map2IO f xs zs `thenIO` \ ys -> + returnIO (y:ys) + +drawPieces 20 _ board xinfo = returnIO () +drawPieces x 20 board xinfo = drawPieces (x+1) 1 board xinfo +drawPieces x y board xinfo = + xMArrayLookup board ((x-1)*19 + y-1) `thenIO` \ piece -> + (if (piece == 1 || piece == 2) + then drawPiece x y xinfo (piece == 1) + else returnIO ()) `thenIO` \ _ -> + drawPieces x (y+1) board xinfo + +drawPiece x y (XInfo display window gcontext gcontext2 _ ) is_black = + (if is_black then returnIO () + else xDrawArc (XDrawWindow window) gcontext2 + (XArc (30*x-10) (30*y-10) 20 20 + (-1.0) 6.283) + True) `thenIO` \ _ -> + xDrawArc (XDrawWindow window) gcontext + (XArc (30*x-10) (30*y-10) 20 20 + (-1.0) 6.283) + is_black `thenIO` \ _ -> + xDisplayForceOutput display + diff --git a/progs/demo/X11/gobang/redraw.hu b/progs/demo/X11/gobang/redraw.hu new file mode 100644 index 0000000..7d5aa14 --- /dev/null +++ b/progs/demo/X11/gobang/redraw.hu @@ -0,0 +1,4 @@ +:o= all +$HASKELL_LIBRARY/X11/xlib.hu +redraw.hs +utilities.hs diff --git a/progs/demo/X11/gobang/utilities.hs b/progs/demo/X11/gobang/utilities.hs new file mode 100644 index 0000000..fe2483b --- /dev/null +++ b/progs/demo/X11/gobang/utilities.hs @@ -0,0 +1,305 @@ +module Utilities where + +import Xlib +import Weights +import Redraw +import Misc + +data XInfo = XInfo XDisplay XWindow XGcontext XGcontext XGcontext +data GameState = GameState (XMArray String) (XMArray String) (XMArray Int) + (XMArray Int) (XMArray Int) (XMArray Int) + (XMArray Integer) (XMArray Int) + (XMArray String) (XMArray Int) + +type GameCont = XInfo -> GameState -> IO () + +xMArrayToList :: XMArray a -> IO [a] +xMArrayToList a = + let la = xMArrayLength a + loop i a = if i == la then returnIO [] + else xMArrayLookup a i `thenIO` \ x -> + loop (i+1) a `thenIO` \ xs -> + returnIO (x:xs) + in + loop 0 a + + +readGameState str = + let + [(board_lst, r1)] = reads str + [(weight1_lst, r2)] = reads r1 + [(weight2_lst, r3)] = reads r2 + [(steps_lst, r4)] = reads r3 + [(player1_lst, r5)] = reads r4 + [(player2_lst, r6)] = reads r5 + [(time_lst, r7)] = reads r6 + [(numbersteps_lst, r8)] = reads r7 + [(promptString_lst, r9)] = reads r8 + [(next_player_lst, [])] = reads r9 + in + xMArrayCreate board_lst `thenIO` \ board -> + xMArrayCreate weight1_lst `thenIO` \ weight1 -> + xMArrayCreate weight2_lst `thenIO` \ weight2 -> + xMArrayCreate steps_lst `thenIO` \ steps -> + xMArrayCreate player1_lst `thenIO` \ player1 -> + xMArrayCreate player2_lst `thenIO` \ player2 -> + xMArrayCreate time_lst `thenIO` \ time -> + xMArrayCreate numbersteps_lst `thenIO` \ numbersteps -> + xMArrayCreate promptString_lst `thenIO` \ promptString -> + xMArrayCreate next_player_lst `thenIO` \ next_player -> + returnIO (GameState player1 player2 board steps weight1 weight2 time + numbersteps promptString next_player) + +showGameState (GameState player1 player2 board steps weight1 weight2 time + numbersteps promptString next_player) = + xMArrayToList board `thenIO` \ board_lst -> + xMArrayToList weight1 `thenIO` \ weight1_lst -> + xMArrayToList weight2 `thenIO` \ weight2_lst -> + xMArrayToList steps `thenIO` \ steps_lst -> + xMArrayToList player1 `thenIO` \ player1_lst -> + xMArrayToList player2 `thenIO` \ player2_lst -> + xMArrayToList time `thenIO` \ time_lst -> + xMArrayToList numbersteps `thenIO` \ numbersteps_lst -> + xMArrayToList promptString `thenIO` \ promptString_lst -> + xMArrayToList next_player `thenIO` \ next_player_lst -> + let + str =(shows board_lst . + shows weight1_lst . + shows weight2_lst . + shows steps_lst . + shows player1_lst . + shows player2_lst . + shows time_lst . + shows numbersteps_lst . + shows promptString_lst . + shows next_player_lst) [] + in + returnIO str + + +xMod :: Int -> Int -> Int +xMod x y | x >= y = xMod (x-y) y + | otherwise = x + +xRes :: Int -> Int -> Int -> Int +xRes x y z | x >= y = xRes (x-y) y (z+1) + | otherwise = z + +drawCmd :: String -> XInfo -> GameState -> IO () +drawCmd a (XInfo display window gcontext gcontext2 gcontextp) + (GameState _ _ _ _ _ _ _ _ str _) + = xDrawRectangle (XDrawWindow window) gcontext2 + (XRect 616 536 248 28) True `thenIO` \ () -> + xDrawGlyphs (XDrawWindow window) gcontext + (XPoint 620 550) a `thenIO` \ _ -> + xMArrayUpdate str 0 a `thenIO` \ _ -> + xDisplayForceOutput display + +clearCmd :: XInfo -> GameState -> IO () +clearCmd (XInfo display window gcontext gcontext2 gcontextp) + (GameState _ _ _ _ _ _ _ _ str _) + = xDrawRectangle (XDrawWindow window) gcontext2 + (XRect 616 536 248 28) True `thenIO` \() -> + xMArrayUpdate str 0 "" `thenIO` \ _ -> + xDisplayForceOutput display + +xPosition :: Int -> XPoint +xPosition a = (XPoint (xRes a 19 1) (1+ (xMod a 19))) + +initArray :: XMArray a -> Int -> Int -> a -> IO () +initArray mary x y z | x + initArray mary (x+1) y z + | otherwise = returnIO () + +getposition :: Int -> Int -> XMaybe (Int, Int) +getposition x y = let x1 = round ((fromIntegral x) / 30.0) + y1 = round ((fromIntegral y) / 30.0) + in + if (x1 < 1 || x1 > 19 || y1 < 1 || y1 > 19) then XNull + else XSome (x1, y1) + +addZero :: Int -> String +addZero a | a < 10 = "0" + | otherwise = "" + +printTime :: Int -> Int -> [Int] -> XInfo -> IO() +printTime x y zs (XInfo display window gcontext gcontext2 gcontextp) + = let s = head zs + m = head (tail zs) + h = head (tail (tail zs)) + in xDrawRectangle (XDrawWindow window) gcontext2 + (XRect (x-4) (y-24) 88 28) True `thenIO` \() -> + xDrawGlyphs (XDrawWindow window) gcontextp (XPoint x y) + ((addZero h)++(show h)++":"++(addZero m)++(show m)++ + ":"++(addZero s)++(show s)) + `thenIO` \(trash) -> + xDisplayForceOutput display + +showtime :: Int -> Int -> Integer -> XInfo -> IO() +showtime x y z a = + let (curtm, c) = (decodeTime z (WestOfGMT 0)) + in printTime x y curtm a + +helpButton :: XInfo -> IO () +helpButton (XInfo display window gcontext gcontext2 gcontextp) = + xDrawRectangle (XDrawWindow window) gcontext (XRect 800 420 70 70) + False `thenIO` \ _ -> + xDrawRectangle (XDrawWindow window) gcontext (XRect 802 422 66 66) + False `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 810 450) "About" + `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontext (XPoint 820 470) "Gobang" + `thenIO` \ _ -> + returnIO () + +ishelp :: Int -> Int -> Bool +ishelp x y = (x > 800 && x < 870 && y > 420 && y < 490) + +button :: Int -> Int -> String -> XInfo -> IO() +button x y a (XInfo display window gcontext gcontext2 gcontextp) = + xDrawArc (XDrawWindow window) gcontext + (XArc (x-40) (y-10) 20 20 1.5708 4.7124) True `thenIO` \() -> + xDrawRectangle (XDrawWindow window) gcontext + (XRect (x-30) (y-10) 60 20) True `thenIO` \() -> + xDrawArc (XDrawWindow window) gcontext + (XArc (x+20) (y-10) 20 20 (-1.0) 6.283) True `thenIO` \() -> + xDrawGlyphs (XDrawWindow window) gcontext2 + (XPoint (x-(length a * 3)) (y+4)) a `thenIO` \(trash) -> + xDisplayForceOutput display + +-- a b are the location of the button, c d are the point where we press the +-- button. + +buttonPress :: Int -> Int -> Int -> Int -> Bool +buttonPress a b c d | (abs (c-a))<=30 && (abs (d-b))<=10 = True + | (c-a+30)*(c-a+30)+(d-b)*(d-b)<=100 = True + | (c-a-30)*(c-a-30)+(d-b)*(d-b)<=100 = True + | otherwise = False + + + +randmax :: XMArray Int -> Int -> Int -> [Int] -> IO Int +randmax a ind max mi | ind > 360 = + let lmi = length mi + in case lmi of + 0 -> returnIO (-1) + 1 -> returnIO (head mi) + _ -> random lmi `thenIO` \ i -> + returnIO (mi !! i) + | otherwise = xMArrayLookup a ind `thenIO` \ tt3 -> + if (tt3 > max) + then randmax a (ind+1) tt3 [ind] + else if (tt3 == max) + then randmax a (ind+1) max (ind:mi) + else randmax a (ind+1) max mi + +robot :: XMArray Int -> XMArray Int -> XMArray Int -> IO XPoint +robot numbersteps weight1 weight2 + = xMArrayLookup numbersteps 0 `thenIO` \(tt5) -> + if (tt5 == 0) + then returnIO (XPoint 10 10) + else + randmax weight1 0 0 [] `thenIO` \ tmp1 -> + randmax weight2 0 0 [] `thenIO` \ tmp2 -> + xMArrayLookup weight1 tmp1 `thenIO` \ tmp3 -> + xMArrayLookup weight2 tmp2 `thenIO` \ tmp4 -> + if (tmp3 >= 200) + then returnIO (xPosition tmp1) + else if (tmp3 > tmp4) + then returnIO (xPosition tmp1) + else returnIO (xPosition tmp2) + + +promptFor prompt xinfo state = + let (GameState player1 player2 board steps weight1 weight2 time + numbersteps promptString next_player) = state + (XInfo display window gcontext gcontext2 gcontextp) = xinfo + in + xDrawRectangle (XDrawWindow window) gcontext2 + (XRect 616 536 248 28) True `thenIO` \() -> + xMArrayUpdate promptString 0 prompt `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontext (XPoint 620 550) prompt + `thenIO` \ _ -> + xDisplayForceOutput display `thenIO` \ _ -> + let h_base = (length prompt + 1) * 6 + 620 + getString :: Int -> String -> IO String + getString h_pos sofar = + xGetEvent display `thenIO` \event -> + case (xEventType event) of + XButtonPressEvent -> + let (XPoint x y) = xEventPos event + in + (if ishelp x y then helpGame xinfo state + else xBell display 0) + `thenIO` \ _ -> + getString h_pos sofar + XExposureEvent -> + may_redraw (xEventCount event == 0) xinfo state `thenIO` \ _ -> + xDrawGlyphs (XDrawWindow window) gcontext (XPoint h_base 550) sofar + `thenIO` \ _ -> + xDrawRectangle (XDrawWindow window) gcontext + (XRect (h_base + 6 * h_pos) (550-10) 6 13) True + `thenIO` \ _ -> getString h_pos sofar + XKeyPressEvent -> + let code = xEventCode event + state = xEventState event + bs = if (sofar == "") then getString h_pos sofar + else xDrawRectangle (XDrawWindow window) gcontext2 + (XRect (h_base + 6 * h_pos) + (550-10) 6 13) + True `thenIO` \ _ -> + xDrawRectangle (XDrawWindow window) gcontext + (XRect (h_base + 6 * (h_pos - 1)) + (550-10) 6 13) + True `thenIO` \ _ -> + getString (h_pos-1) (take (length sofar - 1) sofar) + in + xKeycodeCharacter display code state `thenIO` \ char -> + case char of + (XSome '\r') -> returnIO sofar + (XSome '\DEL') -> bs + (XSome '\BS') -> bs + XNull -> getString h_pos sofar + (XSome c) -> xDrawRectangle (XDrawWindow window) gcontext2 + (XRect (h_base + 6 * h_pos) + (550-10) 6 13) + True `thenIO` \ _ -> + xDrawGlyph (XDrawWindow window) gcontext + (XPoint (h_base + 6 * h_pos) 550) c + `thenIO` \ _ -> + xDrawRectangle (XDrawWindow window) gcontext + (XRect (h_base + 6 * (h_pos + 1)) + (550-10) 6 13) + True `thenIO` \ _ -> + getString (h_pos + 1) (sofar ++ [c]) + + in + xDrawRectangle (XDrawWindow window) gcontext + (XRect h_base (550-10) 6 13) True + `thenIO` \ _ -> + getString 0 "" + + +helpGame xinfo@(XInfo display window gcontext gcontext2 gcontextp) state = + drawHelp xinfo `thenIO` \ _ -> + let + loop xinfo state = + xGetEvent display `thenIO` \ event -> + case (xEventType event) of + XExposureEvent -> may_redraw (xEventCount event == 0) xinfo state + `thenIO` \ _ -> + drawHelp xinfo `thenIO` \ _ -> + loop xinfo state + XButtonPressEvent -> + let (XPoint x y) = xEventPos event + in + if (x > 200 && x < 300 && y > 230 && y < 290) + then redraw xinfo state `thenIO` \ _ -> + returnIO () + else loop xinfo state + _ -> xBell display 0 `thenIO` \ _ -> + loop xinfo state + in + loop xinfo state + + diff --git a/progs/demo/X11/gobang/utilities.hu b/progs/demo/X11/gobang/utilities.hu new file mode 100644 index 0000000..bfccbfe --- /dev/null +++ b/progs/demo/X11/gobang/utilities.hu @@ -0,0 +1,6 @@ +:o= all +$HASKELL_LIBRARY/X11/xlib.hu +utilities.hs +weights.hs +redraw.hs +misc.hi diff --git a/progs/demo/X11/gobang/weights.hs b/progs/demo/X11/gobang/weights.hs new file mode 100644 index 0000000..1b55553 --- /dev/null +++ b/progs/demo/X11/gobang/weights.hs @@ -0,0 +1,323 @@ +module Weights where + +import Xlib +import Utilities + +xlookup :: XMArray Int -> Int -> Int -> IO Int +xlookup keyboard x y = + if (x < 1 || x > 19 || y < 1 || y > 19) + then returnIO (-2) + else xMArrayLookup keyboard ((x-1)*19+(y-1)) + + +draw_unit :: XMArray Int -> XMArray Int -> XMArray Int -> Int -> Int -> IO() +draw_unit keyboard weight1 weight2 x y = + let + update_weight :: XMArray Int->Int->Int->Int->Int->Int->Int->IO() + update_weight weight counter player x y incr_x incr_y + | x>=1 && x<=19 && y>=1 && y<=19 && counter<=4 = + cpt_weight x y player `thenIO` \wt -> + xMArrayUpdate weight ((x-1)*19+(y-1)) wt `thenIO` \() -> + update_weight weight (counter+1) player (x+incr_x) (y+incr_y) + incr_x incr_y + | otherwise = returnIO () +---------------------------------------------------------------------------- + + pattern0 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool + pattern0 a b c d e p | a==p && b==p && c==p && d==p && e==p = True + | otherwise = False +---------------------------------------------------------------------------- + + pattern1 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Bool + pattern1 a b c d e f p | (a==0) && (b==p) && (c==p) && (d==p) && (e==p) && + (f==0) = True + | otherwise = False +---------------------------------------------------------------------------- + + pattern2 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool + pattern2 a b c d e p | (a==0 && b==p && c==p && d==p && e==p)|| + (a==p && b==p && c==p && d==p && e==0) = True + | otherwise = False +---------------------------------------------------------------------------- + + pattern3 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool + pattern3 a b c d e p | (a==0 && b==p && c==p && d==p && e==0) = True + | otherwise = False +---------------------------------------------------------------------------- + + pattern4 :: Int -> Int -> Int -> Int -> Int -> Bool + pattern4 a b c d p | (a==0 && b==p && c==p && d==p) || + (a==p && b==p && c==p && d==0) = True + | otherwise = False +---------------------------------------------------------------------------- + + pattern5 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Bool + pattern5 a b c d e f p | (a==0 && b==p && c==p && d==0 && e==p && + f==0) || + (a==0 && b==p && c==0 && d==p && e==p && + f==0) = True + | otherwise = False +---------------------------------------------------------------------------- + + pattern6 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool + pattern6 a b c d e p | (a==0 && b==p && c==p && d==0 && e==p) || + (a==0 && b==p && c==0 && d==p && e==p) || + (a==p && b==p && c==0 && d==p && e==0) || + (a==p && b==0 && c==p && d==p && e==0) = True + | otherwise = False +---------------------------------------------------------------------------- + + pattern7 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int-> Bool + pattern7 a b c d e f g p | (a==0 && b==p && c==0 && d==p && e==0 && + f==p && g==0) = True + | otherwise = False +---------------------------------------------------------------------------- + + pattern8 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Bool + pattern8 a b c d e f p | (a==0 && b==p && c==0 && d==p && e==0 && + f==p) || + (a==p && b==0 && c==p && d==0 && e==p && + f==0) = True + | otherwise = False +---------------------------------------------------------------------------- + + pattern9 :: Int -> Int -> Int -> Int -> Int -> Bool + pattern9 a b c d p | (a==0 && b==p && c==p && d==0) = True + | otherwise = False +---------------------------------------------------------------------------- + + pattern10 :: Int -> Int -> Int -> Int -> Bool + pattern10 a b c p | (a==0 && b==p && c==p) || + (a==p && b==p && c==0) = True + | otherwise = False +---------------------------------------------------------------------------- + + pattern11 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool + pattern11 a b c d e p | (a==0 && b==p && c==0 && d==p && e==0) = True + | otherwise = False +---------------------------------------------------------------------------- + + pattern12 :: Int -> Int -> Int -> Int -> Int -> Bool + pattern12 a b c d p | (a==0 && b==p && c==0 && d==p) || + (a==p && b==0 && c==p && d==0) = True + | otherwise = False +---------------------------------------------------------------------------- + + direct1 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> + Int -> Int -> Int -> Int -> Int -> Int + direct1 x y pl ptN1 ptN2 ptN3 ptN4 ptN5 pt ptP1 ptP2 ptP3 ptP4 ptP5 + | (pattern0 ptN4 ptN3 ptN2 ptN1 pt pl) || + (pattern0 ptN3 ptN2 ptN1 pt ptP1 pl) || + (pattern0 ptN2 ptN1 pt ptP1 ptP2 pl) || + (pattern0 ptN1 pt ptP1 ptP2 ptP3 pl) || + (pattern0 pt ptP1 ptP2 ptP3 ptP4 pl) = 200 + | (pattern1 ptN4 ptN3 ptN2 ptN1 pt ptP1 pl) || + (pattern1 ptN3 ptN2 ptN1 pt ptP1 ptP2 pl) || + (pattern1 ptN2 ptN1 pt ptP1 ptP2 ptP3 pl) || + (pattern1 ptN1 pt ptP1 ptP2 ptP3 ptP4 pl) = 40 + | (pattern2 ptN4 ptN3 ptN2 ptN1 pt pl) || + (pattern2 ptN3 ptN2 ptN1 pt ptP1 pl) || + (pattern2 ptN2 ptN1 pt ptP1 ptP2 pl) || + (pattern2 ptN1 pt ptP1 ptP2 ptP3 pl) = 13 + | (pattern3 ptN3 ptN2 ptN1 pt ptP1 pl) || + (pattern3 ptN2 ptN1 pt ptP1 ptP2 pl) || + (pattern3 ptN1 pt ptP1 ptP2 ptP3 pl) = 10 + | (pattern4 ptN3 ptN2 ptN1 pt pl) || + (pattern4 ptN2 ptN1 pt ptP1 pl) || + (pattern4 ptN1 pt ptP1 ptP2 pl) = 8 + | (pattern5 ptN4 ptN3 ptN2 ptN1 pt ptP1 pl) || + (pattern5 ptN3 ptN2 ptN1 pt ptP1 ptP2 pl) || + (pattern5 ptN2 ptN1 pt ptP1 ptP2 ptP3 pl) || + (pattern5 ptN1 pt ptP1 ptP2 ptP3 ptP4 pl) = 9 + | (pattern6 ptN4 ptN3 ptN2 ptN1 pt pl) || + (pattern6 ptN3 ptN2 ptN1 pt ptP1 pl) || + (pattern6 ptN2 ptN1 pt ptP1 ptP2 pl) || + (pattern6 ptN1 pt ptP1 ptP2 ptP3 pl) = 7 + | (pattern7 ptN5 ptN4 ptN3 ptN2 ptN1 pt ptP1 pl) || + (pattern7 ptN4 ptN3 ptN2 ptN1 pt ptP1 ptP2 pl) || + (pattern7 ptN3 ptN2 ptN1 pt ptP1 ptP2 ptP3 pl) || + (pattern7 ptN2 ptN1 pt ptP1 ptP2 ptP3 ptP4 pl) || + (pattern7 ptN1 pt ptP1 ptP2 ptP3 ptP4 ptP5 pl) = 6 + | (pattern8 ptN5 ptN4 ptN3 ptN2 ptN1 pt pl) || + (pattern8 ptN4 ptN3 ptN2 ptN1 pt ptP1 pl) || + (pattern8 ptN3 ptN2 ptN1 pt ptP1 ptP2 pl) || + (pattern8 ptN2 ptN1 pt ptP1 ptP2 ptP3 pl) || + (pattern8 ptN1 pt ptP1 ptP2 ptP3 ptP4 pl) || + (pattern8 pt ptP1 ptP2 ptP3 ptP4 ptP5 pl) = 5 + | (pattern9 ptN2 ptN1 pt ptP1 pl) || + (pattern9 ptN1 pt ptP1 ptP2 pl) = 4 + | (pattern10 ptN2 ptN1 pt pl) || + (pattern10 ptN1 pt ptP1 pl) || + (pattern10 pt ptP1 ptP2 pl) = 2 + | (pattern11 ptN3 ptN2 ptN1 pt ptP1 pl) || + (pattern11 ptN2 ptN1 pt ptP1 ptP2 pl) || + (pattern11 ptN1 pt ptP1 ptP2 ptP3 pl) = 3 + | (pattern12 ptN3 ptN2 ptN1 pt pl) || + (pattern12 ptN2 ptN1 pt ptP1 pl) || + (pattern12 ptN1 pt ptP1 ptP2 pl) || + (pattern12 pt ptP1 ptP2 ptP3 pl) = 1 + | otherwise = 0 +---------------------------------------------------------------------------- + + direct2 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> + Int -> Int -> Int -> Int -> Int -> Int + direct2 x y pl ptN1 ptN2 ptN3 ptN4 ptN5 pt ptP1 ptP2 ptP3 ptP4 ptP5 + | (pattern0 ptN4 ptN3 ptN2 ptN1 pt pl) || + (pattern0 ptN3 ptN2 ptN1 pt ptP1 pl) || + (pattern0 ptN2 ptN1 pt ptP1 ptP2 pl) || + (pattern0 ptN1 pt ptP1 ptP2 ptP3 pl) || + (pattern0 pt ptP1 ptP2 ptP3 ptP4 pl) = 200 + | otherwise = 0 +----------------------------------------------------------------------------- + + cpt_weight :: Int -> Int -> Int -> IO Int + cpt_weight x y player = + xMArrayLookup keyboard ((x-1)*19+(y-1)) `thenIO` \(unit) -> + if (unit /= 0) + then returnIO (-1) + else xlookup keyboard x (y-1) `thenIO` \(xyN1) -> + xlookup keyboard x (y-2) `thenIO` \(xyN2) -> + xlookup keyboard x (y-3) `thenIO` \(xyN3) -> + xlookup keyboard x (y-4) `thenIO` \(xyN4) -> + xlookup keyboard x (y-5) `thenIO` \(xyN5) -> + xlookup keyboard x (y+1) `thenIO` \(xyP1) -> + xlookup keyboard x (y+2) `thenIO` \(xyP2) -> + xlookup keyboard x (y+3) `thenIO` \(xyP3) -> + xlookup keyboard x (y+4) `thenIO` \(xyP4) -> + xlookup keyboard x (y+5) `thenIO` \(xyP5) -> + xlookup keyboard (x-1) y `thenIO` \(xN1y) -> + xlookup keyboard (x-2) y `thenIO` \(xN2y) -> + xlookup keyboard (x-3) y `thenIO` \(xN3y) -> + xlookup keyboard (x-4) y `thenIO` \(xN4y) -> + xlookup keyboard (x-5) y `thenIO` \(xN5y) -> + xlookup keyboard (x+1) y `thenIO` \(xP1y) -> + xlookup keyboard (x+2) y `thenIO` \(xP2y) -> + xlookup keyboard (x+3) y `thenIO` \(xP3y) -> + xlookup keyboard (x+4) y `thenIO` \(xP4y) -> + xlookup keyboard (x+5) y `thenIO` \(xP5y) -> + xlookup keyboard (x-1) (y-1) `thenIO` \(xN1yN1)-> + xlookup keyboard (x-2) (y-2) `thenIO` \(xN2yN2) -> + xlookup keyboard (x-3) (y-3) `thenIO` \(xN3yN3) -> + xlookup keyboard (x-4) (y-4) `thenIO` \(xN4yN4) -> + xlookup keyboard (x-5) (y-5) `thenIO` \(xN5yN5) -> + xlookup keyboard (x+1) (y+1) `thenIO` \(xP1yP1) -> + xlookup keyboard (x+2) (y+2) `thenIO` \(xP2yP2) -> + xlookup keyboard (x+3) (y+3) `thenIO` \(xP3yP3) -> + xlookup keyboard (x+4) (y+4) `thenIO` \(xP4yP4) -> + xlookup keyboard (x+5) (y+5) `thenIO` \(xP5yP5) -> + xlookup keyboard (x-1) (y+1) `thenIO` \(xN1yP1) -> + xlookup keyboard (x-2) (y+2) `thenIO` \(xN2yP2) -> + xlookup keyboard (x-3) (y+3) `thenIO` \(xN3yP3) -> + xlookup keyboard (x-4) (y+4) `thenIO` \(xN4yP4) -> + xlookup keyboard (x-5) (y+5) `thenIO` \(xN5yP5) -> + xlookup keyboard (x+1) (y-1) `thenIO` \(xP1yN1) -> + xlookup keyboard (x+2) (y-2) `thenIO` \(xP2yN2) -> + xlookup keyboard (x+3) (y-3) `thenIO` \(xP3yN3) -> + xlookup keyboard (x+4) (y-4) `thenIO` \(xP4yN4) -> + xlookup keyboard (x+5) (y-5) `thenIO` \(xP5yN5) -> + returnIO ( (direct1 x y player xyN1 xyN2 xyN3 xyN4 xyN5 player + xyP1 xyP2 xyP3 xyP4 xyP5) + + (direct1 x y player xN1y xN2y xN3y xN4y xN5y player + xP1y xP2y xP3y xP4y xP5y) + + (direct1 x y player xN1yN1 xN2yN2 xN3yN3 xN4yN4 + xN5yN5 player xP1yP1 xP2yP2 xP3yP3 xP4yP4 + xP5yP5) + + (direct1 x y player xN1yP1 xN2yP2 xN3yP3 xN4yP4 + xN5yP5 player xP1yN1 xP2yN2 xP3yN3 xP4yN4 + xP5yN5) ) +----------------------------------------------------------------------------- + +-- | 1111 && no_block = 20 +-- | 1111 && one_block = 13 +-- | 111 && no_block = 10 +-- | 111 && one_block = 8 +-- | 11 1 or 1 11 && no_block = 9 +-- | 11 1 or 1 11 && one_block =7 +-- | 1 1 1 && no_block = 6 +-- | 1 1 1 && one_block= 5 +-- | 11 && no_block = 4 +-- | 11 && one_block =2 +-- | 1 1 && no_block =3 +-- | 1 1 && one_block=1 + + in + update_weight weight1 0 1 x y 1 1 `thenIO` \() -> + update_weight weight2 0 2 x y 1 1 `thenIO` \() -> + update_weight weight1 0 1 x y 1 (-1) `thenIO` \() -> + update_weight weight2 0 2 x y 1 (-1) `thenIO` \() -> + update_weight weight1 0 1 x y (-1) (-1) `thenIO` \() -> + update_weight weight2 0 2 x y (-1) (-1) `thenIO` \() -> + update_weight weight1 0 1 x y (-1) 1 `thenIO` \() -> + update_weight weight2 0 2 x y (-1) 1 `thenIO` \() -> + update_weight weight1 0 1 x y 0 1 `thenIO` \() -> + update_weight weight2 0 2 x y 0 1 `thenIO` \() -> + update_weight weight1 0 1 x y 0 (-1) `thenIO` \() -> + update_weight weight2 0 2 x y 0 (-1) `thenIO` \() -> + update_weight weight1 0 1 x y (-1) 0 `thenIO` \() -> + update_weight weight2 0 2 x y (-1) 0 `thenIO` \() -> + update_weight weight1 0 1 x y 1 0 `thenIO` \() -> + update_weight weight2 0 2 x y 1 0 `thenIO` \() -> + returnIO () + + +human_unit :: XMArray Int -> Int -> Int -> IO(Bool) +human_unit keyboard x y = + let + pattern0 :: Int -> Int -> Int -> Int -> Int -> Bool + pattern0 a b c d e | a==b && b==c && c==d && d==e = True + | otherwise = False + + direct3 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> + Int + direct3 ptN1 ptN2 ptN3 ptN4 pt ptP1 ptP2 ptP3 ptP4 + | (pattern0 ptN4 ptN3 ptN2 ptN1 pt) || + (pattern0 ptN3 ptN2 ptN1 pt ptP1) || + (pattern0 ptN2 ptN1 pt ptP1 ptP2) || + (pattern0 ptN1 pt ptP1 ptP2 ptP3) || + (pattern0 pt ptP1 ptP2 ptP3 ptP4) = 200 + | otherwise = 0 + in + xlookup keyboard x y `thenIO` \(xy) -> + xlookup keyboard x (y-1) `thenIO` \(xyN1) -> + xlookup keyboard x (y-2) `thenIO` \(xyN2) -> + xlookup keyboard x (y-3) `thenIO` \(xyN3) -> + xlookup keyboard x (y-4) `thenIO` \(xyN4) -> + xlookup keyboard x (y+1) `thenIO` \(xyP1) -> + xlookup keyboard x (y+2) `thenIO` \(xyP2) -> + xlookup keyboard x (y+3) `thenIO` \(xyP3) -> + xlookup keyboard x (y+4) `thenIO` \(xyP4) -> + xlookup keyboard (x-1) y `thenIO` \(xN1y) -> + xlookup keyboard (x-2) y `thenIO` \(xN2y) -> + xlookup keyboard (x-3) y `thenIO` \(xN3y) -> + xlookup keyboard (x-4) y `thenIO` \(xN4y) -> + xlookup keyboard (x+1) y `thenIO` \(xP1y) -> + xlookup keyboard (x+2) y `thenIO` \(xP2y) -> + xlookup keyboard (x+3) y `thenIO` \(xP3y) -> + xlookup keyboard (x+4) y `thenIO` \(xP4y) -> + xlookup keyboard (x-1) (y-1) `thenIO` \(xN1yN1)-> + xlookup keyboard (x-2) (y-2) `thenIO` \(xN2yN2) -> + xlookup keyboard (x-3) (y-3) `thenIO` \(xN3yN3) -> + xlookup keyboard (x-4) (y-4) `thenIO` \(xN4yN4) -> + xlookup keyboard (x+1) (y+1) `thenIO` \(xP1yP1) -> + xlookup keyboard (x+2) (y+2) `thenIO` \(xP2yP2) -> + xlookup keyboard (x+3) (y+3) `thenIO` \(xP3yP3) -> + xlookup keyboard (x+4) (y+4) `thenIO` \(xP4yP4) -> + xlookup keyboard (x-1) (y+1) `thenIO` \(xN1yP1) -> + xlookup keyboard (x-2) (y+2) `thenIO` \(xN2yP2) -> + xlookup keyboard (x-3) (y+3) `thenIO` \(xN3yP3) -> + xlookup keyboard (x-4) (y+4) `thenIO` \(xN4yP4) -> + xlookup keyboard (x+1) (y-1) `thenIO` \(xP1yN1) -> + xlookup keyboard (x+2) (y-2) `thenIO` \(xP2yN2) -> + xlookup keyboard (x+3) (y-3) `thenIO` \(xP3yN3) -> + xlookup keyboard (x+4) (y-4) `thenIO` \(xP4yN4) -> + xlookup keyboard (x+1) y `thenIO` \(xP1y) -> + xlookup keyboard (x+2) y `thenIO` \(xP2y) -> + xlookup keyboard (x+3) y `thenIO` \(xP3y) -> + xlookup keyboard (x+4) y `thenIO` \(xP4y) -> + if ((direct3 xyN1 xyN2 xyN3 xyN4 xy xyP1 xyP2 xyP3 xyP4) + + (direct3 xN1y xN2y xN3y xN4y xy xP1y xP2y xP3y xP4y) + + (direct3 xN1yN1 xN2yN2 xN3yN3 xN4yN4 xy xP1yP1 xP2yP2 xP3yP3 xP4yP4) + + (direct3 xN1yP1 xN2yP2 xN3yP3 xN4yP4 xy xP1yN1 xP2yN2 xP3yN3 xP4yN4)) + >=200 + then returnIO (True) + else returnIO (False) \ No newline at end of file diff --git a/progs/demo/X11/gobang/weights.hu b/progs/demo/X11/gobang/weights.hu new file mode 100644 index 0000000..f13aba0 --- /dev/null +++ b/progs/demo/X11/gobang/weights.hu @@ -0,0 +1,4 @@ +:o= all +$HASKELL_LIBRARY/X11/xlib.hu +weights.hs +utilities.hs -- cgit v1.2.3