diff options
Diffstat (limited to 'progs/demo/X11/gobang/utilities.hs')
| -rw-r--r-- | progs/demo/X11/gobang/utilities.hs | 305 |
1 files changed, 305 insertions, 0 deletions
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 + + |