~ubuntu-branches/ubuntu/wily/hedgewars/wily

« back to all changes in this revision

Viewing changes to gameServer/NetRoutines.hs

  • Committer: Package Import Robot
  • Author(s): Dmitry E. Oboukhov
  • Date: 2011-09-23 10:16:55 UTC
  • mfrom: (1.2.11 upstream)
  • Revision ID: package-import@ubuntu.com-20110923101655-3977th2gc5n0a3pv
Tags: 0.9.16-1
* New upstream version.
 + Downloadable content! Simply click to install any content.
   New voices, hats, maps, themes, translations, music, scripts...
   Hedgewars is now more customisable than ever before! As time goes
   by we will be soliciting community content to feature on this page,
   so remember to check it from time to time. If you decide you want
   to go back to standard Hedgewars, just remove the Data directory
   from your Hedgewars config directory.
 + 3-D rendering! Diorama-like rendering of the game in a variety
   of 3D modes. Let us know which ones work best for you, we didn't
   really have the equipment to test them all.
 + Resizable game window.
 + New utilities! The Time Box will remove one of your hedgehogs
   from the game for a while, protecting from attack until it returns,
   somewhere else on the map. Land spray will allow you to build bridges,
   seal up holes, or just make life unpleasant for your enemies.
 + New single player: Bamboo Thicket, That Sinking Feeling, Newton and
   the Tree and multi-player: The Specialists, Space Invaders,
   Racer - scripts! And a ton more script hooks for scripters
 + New twists on old weapons. Drill strike, seduction and fire have
   been adjusted. Defective mines have been added, rope can attach to
   hogs/crates/barrels again, grenades now have variable bounce (use
   precise key + 1-5). Portal gun is now more usable in flight and
   all game actions are a lot faster.
 + New theme - Golf, dozens of new community hats and a new
   localised Default voice, Ukranian.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
{-# LANGUAGE ScopedTypeVariables #-}
 
1
{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
2
2
module NetRoutines where
3
3
 
4
 
import Network
5
4
import Network.Socket
6
 
import System.IO
7
 
import Control.Concurrent
8
5
import Control.Concurrent.Chan
9
 
import Control.Concurrent.STM
10
6
import qualified Control.Exception as Exception
11
7
import Data.Time
 
8
import Control.Monad
 
9
import Data.Unique
12
10
-----------------------------
13
11
import CoreTypes
14
 
import ClientIO
15
12
import Utils
 
13
import RoomsAndClients
16
14
 
17
 
acceptLoop :: Socket -> Chan CoreMessage -> Int -> IO ()
18
 
acceptLoop servSock coreChan clientCounter = do
19
 
    Exception.handle
20
 
        (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
 
15
acceptLoop :: Socket -> Chan CoreMessage -> IO ()
 
16
acceptLoop servSock chan = forever $
21
17
        do
22
 
        (socket, sockAddr) <- Network.Socket.accept servSock
 
18
        (sock, sockAddr) <- Network.Socket.accept servSock
23
19
 
24
 
        cHandle <- socketToHandle socket ReadWriteMode
25
 
        hSetBuffering cHandle LineBuffering
26
20
        clientHost <- sockAddr2String sockAddr
27
21
 
28
22
        currentTime <- getCurrentTime
29
 
        
30
 
        sendChan <- newChan
 
23
 
 
24
        sendChan' <- newChan
 
25
 
 
26
        uid <- newUnique
31
27
 
32
28
        let newClient =
33
29
                (ClientInfo
34
 
                    nextID
35
 
                    sendChan
36
 
                    cHandle
 
30
                    uid
 
31
                    sendChan'
 
32
                    sock
37
33
                    clientHost
38
34
                    currentTime
39
35
                    ""
40
36
                    ""
41
37
                    False
42
38
                    0
43
 
                    0
44
 
                    0
45
 
                    False
46
 
                    False
47
 
                    False
48
 
                    undefined
49
 
                    undefined
 
39
                    lobbyId
 
40
                    0
 
41
                    False
 
42
                    False
 
43
                    False
 
44
                    Nothing
 
45
                    0
50
46
                    )
51
47
 
52
 
        writeChan coreChan $ Accept newClient
53
 
 
54
 
        forkIO $ clientRecvLoop cHandle coreChan nextID
55
 
        forkIO $ clientSendLoop cHandle coreChan sendChan nextID
 
48
        writeChan chan $ Accept newClient
56
49
        return ()
57
 
 
58
 
    acceptLoop servSock coreChan nextID
59
 
    where
60
 
        nextID = clientCounter + 1