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/weights.hs | 323 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 323 insertions(+) create mode 100644 progs/demo/X11/gobang/weights.hs (limited to 'progs/demo/X11/gobang/weights.hs') 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 -- cgit v1.2.3