-- Основной файл
-- подключем библиотеку графики:
import Graphics.UI.WX
-- для обработки исключений:
import Control.Concurrent
-- для связи между потоками:
import Control.Concurrent.Chan
-- созданые нами модули
import Netmoduleimport DialogCF
main = do
-- создаём чаны для обещия между потоками
chanD <- newChan
chanN <- newChan
-- и запускаем поток с сетью
netFork <- forkOS $ mainNet chanD chanN
-- а так же диалоговое окно
firstD chanD chanN
-- по завершению надо убить поток для сети
killThread netFork
-- Gui
module DialogCF where
import Graphics.UI.WX
import Graphics.UI.WXCore
import Control.Concurrent
import Control.Concurrent.Chan
import Data.List
import Text.Regex.Posix ((=~))
setSize xs s = [ take s x | x <- take s xs ]
firstD chanD chanN = do
start $ do
f <- frame [text := "Game"]
p <- panel f []
ip <- textEntry p [text := "", alignment := AlignRight]
let clabels = ["3","4","5","20"]
sizeField <- choice p [tooltip := "unsorted choices", sorted := False, items := clabels, selection := 0]
mp <- panel f []
status <- staticText f [ text := "" ]
set f [ layout := container mp $ margin 10 $ column 1 [ widget status ] ]
set mp [ visible := False ]
mainp <- panel f []
let sizeL = 20
bList <- buttonList mainp (sizeL * sizeL)
let grL = groupM sizeL bList
butList <- varCreate grL
gameStatus <- staticText mainp [ text := "Start!" ]
mapM_ ((x, y) -> set x [ on command := do
txt <- get x text
case txt of
"" -> do
forkOS $ do
set x [ text := "X" ]
bl <- varGet butList
resCheck <- check bl
case resCheck of
"Full" -> do
writeChan chanD $ "f" ++ show y
infoDialog f "Info" "Draw"
mapM_ (mapM_ (x -> set x [ text := ""])) bl
"True" -> do
writeChan chanD $ "w" ++ show y
infoDialog f "Info" "You win"
mapM_ (mapM_ (x -> set x [ text := ""])) bl
"False" -> do
writeChan chanD $ show y
set gameStatus [ text := "Waiting..." ]
messageChan <- readChan chanN
case head messageChan of
'f' -> do
set (bList !! (-1 + read (tail messageChan) :: Int)) [ text := "O" ]
infoDialog f "Info" "Draw"
mapM_ (mapM_ (x -> set x [ text := ""])) bl
'w' -> do
set (bList !! (-1 + read (tail messageChan) :: Int)) [ text := "O" ]
infoDialog f "Info" "You lose"
mapM_ (mapM_ (x -> set x [ text := ""])) bl
'd' -> do
infoDialog f "Info" "Opponent disconnected"
close f
_ -> do
set (bList !! (-1 + read messageChan :: Int)) [ text := "O" ]
set mainp [ enabled := True ]
set gameStatus [ text := "Your move" ]
set mainp [ enabled := False ]
"X" -> infoDialog f "Info" "Here is already coming, nselect another cell"
"O" -> infoDialog f "Info" "Here is already coming, nselect another cell"
]) (zip bList [1..(sizeL*sizeL)])
set mainp [ visible := False ]
connect <- button p [text := "Connect", on command := do
message <- get ip text
if (1 /= length (message =~ "[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}" :: [[String]]))
then infoDialog f "Info" "Invalid IP"
else do
set status [ text := ("Connect to " ++ message) ]
set p [ visible := False ]
set status [ visible := True ]
forkOS $ do
message <- readChan chanN
set status [ visible := False ]
if ("discon" == message)
then do
set p [ visible := True ]
infoDialog f "Info" "Connection failed"
else do
let sizeM = read message :: Int
let bListAtSize = take (sizeM * sizeM) bList
varSet butList $ groupM sizeM bListAtSize
mapM_ (x -> set x [ visible := True ]) bListAtSize
let gr = groupM sizeM $ map widget bListAtSize
set gameStatus [ text := "Your move" ]
set f [layout := container mainp $ margin 10 $ column 1 [ (grid 5 5 gr)
,hfill $ minsize (sz 20 80) $ widget gameStatus]]
set mainp [ visible := True ]
set f [ clientSize := sz (20 + sizeM * 20) (20 + sizeM * 20)]
writeChan chanD $ "c" ++ message
]
run <- button p [text := "Run server", on command := do
message <- get sizeField text
set status [ text := "Awaiting connection." ]
set p [ visible := False ]
set status [ visible := True ]
forkOS $ do
message <- readChan chanN
set status [ visible := False ]
let sizeM = read message :: Int
let bListAtSize = take (sizeM * sizeM) bList
mapM_ (x -> set x [ visible := True ]) bListAtSize
varSet butList $ groupM sizeM bListAtSize
let gr = groupM sizeM $ map widget bListAtSize
set gameStatus [ text := "Waiting..." ]
set f [layout := container mainp $ margin 10 $ column 1 [ (grid 5 5 gr)
,hfill $ minsize (sz 20 80) $ widget gameStatus]]
set mainp [ visible := True, enabled := False ]
set f [ clientSize := sz (20 + sizeM * 20) (20 + sizeM * 20)]
messageChan <- readChan chanN
if ("discon" == messageChan)
then do
infoDialog f "Info" "Opponent disconnected"
close f
else do
set gameStatus [ text := "Your move" ]
set (bList !! (-1 + read messageChan :: Int)) [ text := "O" ]
set mainp [ enabled := True ]
writeChan chanD $ "r" ++ message
]
set f [ layout := container p $
margin 10 $
column 5 [ boxed "Client" (grid 5 5 [ [label "Server ip:", hfill $ widget ip]
,[widget connect]])
,boxed "Server" (grid 5 5 [ [label "Field size:", hfill $ widget sizeField]
,[widget run]])]
]
groupM _ [] = []
groupM y xs = (take y xs):(groupM y $ drop y xs)
-- textAtButton::[Button ()]-> IO [Bool]
textAtButton [] = return []
textAtButton (x:xs) = do
t <- get x text
nextList <- textAtButton xs
return $ t:nextList
-- textAtButtonM::[[Button ()]]-> IO [[Bool]]
textAtButtonM [] = return []
textAtButtonM (x:xs) = do
t <- textAtButton x
nextList <- textAtButtonM xs
return $ t:nextList
check''' [] a@(x:xs) = if (3 > length x)
then False
else check''' (map tail a) (map tail a)
check''' (("X":a):(_:"X":b):(_:_:"X":c):xs) _ = True
check''' ((_:_:"X":a):(_:"X":b):("X":c):xs) _ = True
check''' (("X":a):("X":b):("X":c):xs) _ = True
check''' (("X":"X":"X":a):xs) _ = True
check''' (x:xs) a = check''' xs a
checkOfFull (x:xs) = not $ elem True (map (elem "") xs)
check xs = do
t <- textAtButtonM xs
if (checkOfFull t)
then return "Full"
else if (check''' t t)
then return "True"
else return "False"
buttonList _ 0 = return []
buttonList p a = do
b <- button p [ text := "", clientSize := sz 15 15, visible := False ]
nextList <- buttonList p $ a - 1
return $ b : nextList
--и net-модуль взят из интернета немного переделан
module Netmodule where
import Network
import System.IO (hGetLine,hClose,hPutStrLn,hSetBuffering,BufferMode(..),Handle,stdout)
import Control.Concurrent
import Control.Concurrent.Chan
port = 8001
mainNet chanD chanN = withSocketsDo $ do
input <- readChan chanD
case head input of
'r' -> server chanD chanN input
`catch` (const $ writeChan chanN "discon" >> mainNet chanD chanN)
'c' -> do
client chanD chanN input
`catch` (const $ writeChan chanN "discon" >> mainNet chanD chanN)
_ -> putStrLn "game net fork: stop"
while2 x y = ifM x (return ()) $ ifM y (return ()) $ while2 x y
ifM p t f = p >>= (p' -> if p' then t else f)
client chanD chanN input = do
h <- connectTo (tail input) (PortNumber port)
hSetBuffering h LineBuffering
while2 (receive h chanN) (send h chanD)
hClose h
server chanD chanN input = do
sock <- listenOn (PortNumber port)
(h,host,port) <- accept sock
hSetBuffering h LineBuffering
hPutStrLn h $ tail input
writeChan chanN $ tail input
while2 (receive h chanN) (send h chanD)
hClose h
sClose sock
Комментарии
Отправить комментарий