gameServer/stresstest2.hs
author dag10 <gottlieb.drew@gmail.com>
Wed, 16 Jan 2013 18:34:43 -0500
changeset 8393 85bd6c7b2641
parent 4932 f11d80bac7ed
child 10460 8dcea9087d75
permissions -rw-r--r--
Can now change theme for static and mission maps. Fixed mission map descriptions that had commas which broke them. Now, you must escape commas in map descriptions. Made bgwidget repaint on animation tick to avoid buffer-not-clearing issue with widgets that change overtop the background leaving a ghost image of the widget's previous state. Generated map is now the default map in the mapconfig widget.
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 System.IO
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import Control.Concurrent
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Network
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
     8
import Control.OldException
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import Control.Monad
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import System.Random
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
import System.Posix
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    16
session1 nick room = ["NICK", nick, "", "PROTO", "32", ""]
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    17
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    18
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    19
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    20
testing = Control.OldException.handle print $ do
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    21
    putStrLn "Start"
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    22
    sock <- connectTo "127.0.0.1" (PortNumber 46631)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    24
    num1 <- randomRIO (70000::Int, 70100)
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    25
    num2 <- randomRIO (0::Int, 2)
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    26
    num3 <- randomRIO (0::Int, 5)
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    27
    let nick1 = 'n' : show num1
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    28
    let room1 = 'r' : show num2
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    29
    mapM_ (\x -> hPutStrLn sock x >> hFlush sock >> randomRIO (300::Int, 590) >>= threadDelay) $ session1 nick1 room1
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    30
    mapM_ (\x -> hPutStrLn sock x >> hFlush sock) $ concatMap (\x -> ["CHAT_MSG", show x, ""]) [1..]
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    31
    hClose sock
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    32
    putStrLn "Finish"
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    33
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    34
forks = testing
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
#if !defined(mingw32_HOST_OS)
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    38
    installHandler sigPIPE Ignore Nothing;
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
#endif
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    40
    forks