summaryrefslogtreecommitdiff
path: root/progs/demo/X11/gobang/weights.hs
diff options
context:
space:
mode:
Diffstat (limited to 'progs/demo/X11/gobang/weights.hs')
-rw-r--r--progs/demo/X11/gobang/weights.hs323
1 files changed, 323 insertions, 0 deletions
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
generated by cgit v1.2.3 (git 2.46.0) at 2024-09-16 19:26:52 +0000