Import to github.

11 files changed, 1248 insertions, 0 deletions

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<y       = xMArrayUpdate mary x z `thenIO` \() ->
+                                   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