gameServer/stresstest2.hs
author nemo
Sun, 26 Dec 2010 00:28:23 -0500
changeset 4686 3682db294dae
parent 4568 f85243bf890e
child 4905 7842d085acf4
permissions -rw-r--r--
remove all screwing about with uLandGraphics - have not found a way to properly handle LandBackTex through despeckling or fill checks that does not result in ugly fire damage or wiped out landbacktex. Would rather some snowflakes lines than that.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
{-# LANGUAGE CPP #-}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
module Main where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import IO
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import System.IO
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Control.Concurrent
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Network
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
     9
import Control.Exception
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import Control.Monad
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import System.Random
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
import System.Posix
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    17
testing = Control.Exception.handle print $ do
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    18
    delay <- randomRIO (100::Int, 300)
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    19
    threadDelay delay
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    20
    sock <- connectTo "127.0.0.1" (PortNumber 46631)
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    21
    hClose sock
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    23
forks i = do
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    24
    delay <- randomRIO (50::Int, 190)
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    25
    if i `mod` 10 == 0 then putStr (show i) else putStr "."
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    26
    hFlush stdout
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    27
    threadDelay delay
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    28
    forkIO testing
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    29
    forks (i + 1)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
#if !defined(mingw32_HOST_OS)
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    33
    installHandler sigPIPE Ignore Nothing;
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
#endif
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    35
    forks 1