gameServer/stresstest2.hs
author nemo
Fri, 05 Nov 2010 18:56:12 -0400
changeset 4140 1563b216f243
parent 3947 709fdb89f76c
child 4242 5e3c5fe2cb14
permissions -rw-r--r--
revert attempts to block switching weapon while targetting in infinite attack mode. just getting too messy. probably best to allow any weapon to be targetted, and store the target in the gear and draw it there instead of uworld, but I'm leaving this alone
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