← Back to branch summary

~ubuntu-branches/ubuntu/wily/hedgewars/wily

« back to all changes in this revision

Viewing changes to gameServer/stresstest3.hs

  • Committer: Package Import Robot
  • Author(s): Dmitry E. Oboukhov
  • Date: 2011-09-23 10:16:55 UTC
  • mfrom: (1.2.11 upstream)
  • Revision ID: package-import@ubuntu.com-20110923101655-3977th2gc5n0a3pv
Tags: 0.9.16-1
* New upstream version.
 + Downloadable content! Simply click to install any content.
   New voices, hats, maps, themes, translations, music, scripts...
   Hedgewars is now more customisable than ever before! As time goes
   by we will be soliciting community content to feature on this page,
   so remember to check it from time to time. If you decide you want
   to go back to standard Hedgewars, just remove the Data directory
   from your Hedgewars config directory.
 + 3-D rendering! Diorama-like rendering of the game in a variety
   of 3D modes. Let us know which ones work best for you, we didn't
   really have the equipment to test them all.
 + Resizable game window.
 + New utilities! The Time Box will remove one of your hedgehogs
   from the game for a while, protecting from attack until it returns,
   somewhere else on the map. Land spray will allow you to build bridges,
   seal up holes, or just make life unpleasant for your enemies.
 + New single player: Bamboo Thicket, That Sinking Feeling, Newton and
   the Tree and multi-player: The Specialists, Space Invaders,
   Racer - scripts! And a ton more script hooks for scripters
 + New twists on old weapons. Drill strike, seduction and fire have
   been adjusted. Defective mines have been added, rope can attach to
   hogs/crates/barrels again, grenades now have variable bounce (use
   precise key + 1-5). Portal gun is now more usable in flight and
   all game actions are a lot faster.
 + New theme - Golf, dozens of new community hats and a new
   localised Default voice, Ukranian.

Show diffs side-by-side

added added

removed removed

Lines of Context:
gameServer/stresstest3.hs
 
1
{-# LANGUAGE CPP #-}
 
2
 
 
3
module Main where
 
4
 
 
5
import System.IO
 
6
import System.IO.Error
 
7
import Control.Concurrent
 
8
import Network
 
9
import Control.OldException
 
10
import Control.Monad
 
11
import System.Random
 
12
import Control.Monad.State
 
13
import Data.List
 
14
 
 
15
#if !defined(mingw32_HOST_OS)
 
16
import System.Posix
 
17
#endif
 
18
 
 
19
type SState = Handle
 
20
io = liftIO
 
21
 
 
22
readPacket :: StateT SState IO [String]
 
23
readPacket = do
 
24
    h <- get
 
25
    io $ hGetPacket h []
 
26
    where
 
27
    hGetPacket h buf = do
 
28
        l <- hGetLine h
 
29
        if not $ null l then hGetPacket h (buf ++ [l]) else return buf
 
30
 
 
31
waitPacket :: String -> StateT SState IO Bool
 
32
waitPacket s = do
 
33
    p <- readPacket
 
34
    return $ head p == s
 
35
 
 
36
sendPacket :: [String] -> StateT SState IO ()
 
37
sendPacket s = do
 
38
    h <- get
 
39
    io $ do
 
40
        mapM_ (hPutStrLn h) s
 
41
        hPutStrLn h ""
 
42
        hFlush h
 
43
 
 
44
emulateSession :: StateT SState IO ()
 
45
emulateSession = do
 
46
    n <- io $ randomRIO (100000::Int, 100100)
 
47
    waitPacket "CONNECTED"
 
48
    sendPacket ["NICK", "test" ++ show n]
 
49
    waitPacket "NICK"
 
50
    sendPacket ["PROTO", "31"]
 
51
    waitPacket "PROTO"
 
52
    b <- waitPacket "LOBBY:JOINED"
 
53
    --io $ print b
 
54
    sendPacket ["QUIT", "BYE"]
 
55
    return ()
 
56
 
 
57
testing = Control.OldException.handle print $ do
 
58
    putStr "+"
 
59
    sock <- connectTo "127.0.0.1" (PortNumber 46631)
 
60
    evalStateT emulateSession sock
 
61
    --hClose sock
 
62
    putStr "-"
 
63
    hFlush stdout
 
64
 
 
65
forks = forever $ do
 
66
    delay <- randomRIO (0::Int, 80000)
 
67
    threadDelay delay
 
68
    forkIO testing
 
69
 
 
70
main = withSocketsDo $ do
 
71
#if !defined(mingw32_HOST_OS)
 
72
    installHandler sigPIPE Ignore Nothing;
 
73
#endif
 
74
    forks