gameServer/stresstest2.hs
author Xeli
Sat, 04 Feb 2012 16:22:46 +0100
changeset 6622 01889d5bc79b
parent 4932 f11d80bac7ed
child 10460 8dcea9087d75
permissions -rw-r--r--
Rewrote the Ammomenu: Added landscape ammomenu At the moment MOBILE indicates landscape, but we could just as easily make a variable out of it Draw to texture once uVariables.AmmoMenuInvalidated indicates a new ammo menu needs to be drawn, see uTeams and uAmmos Slot/Cellsize is dependent on uConsts.AMSlotSize this should make it easier to scale the ammo menu on smaller screens AmmoRect AmmoRect indicates where and how big the ammo menu is, this makes positioning a bit easier imo, because you only need to change the position at one single point needs testing on the iphone (and other systems as well ofcourse..)
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