gameServer/stresstest2.hs
author nemo
Sun, 10 Oct 2010 16:51:40 -0400
changeset 3949 4c4c0a2507cc
parent 3947 709fdb89f76c
child 4242 5e3c5fe2cb14
permissions -rw-r--r--
Add the standard delay (1.25 seconds) between attacks on inf attack mode, as well as checks for damage and win. There is probably some better way to do this. Weapons still need fixing.
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
3947
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
     9
import Control.OldException
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
3947
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    17
session1 nick room = ["NICK", nick, "", "PROTO", "32", ""]
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    18
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    19
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    20
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    21
testing = Control.OldException.handle print $ do
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    22
    putStrLn "Start"
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    23
    sock <- connectTo "127.0.0.1" (PortNumber 46631)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
3947
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    25
    num1 <- randomRIO (70000::Int, 70100)
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    26
    num2 <- randomRIO (0::Int, 2)
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    27
    num3 <- randomRIO (0::Int, 5)
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    28
    let nick1 = 'n' : show num1
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    29
    let room1 = 'r' : show num2
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    30
    mapM_ (\x -> hPutStrLn sock x >> hFlush sock >> randomRIO (300::Int, 590) >>= threadDelay) $ session1 nick1 room1
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    31
    mapM_ (\x -> hPutStrLn sock x >> hFlush sock) $ concatMap (\x -> ["CHAT_MSG", show x, ""]) [1..]
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    32
    hClose sock
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    33
    putStrLn "Finish"
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    34
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    35
forks = testing
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
#if !defined(mingw32_HOST_OS)
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    39
    installHandler sigPIPE Ignore Nothing;
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
#endif
3947
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 2948
diff changeset
    41
    forks