Commit 3b0659ac authored by Peter Achten's avatar Peter Achten
Browse files

(PA) New version of TCP by Martin Wierich

parent dccad754
......@@ -23,7 +23,6 @@ CR :== '\xD' // carriage return
:: NoState
= NoState // The singleton data type
Start :: *World -> *World
Start world
= startIO SDI { sndChan=undef, nickname=""} initialize [ProcessWindowSize zero] world
......@@ -35,19 +34,23 @@ initialize ps
(buttonId, ps) = accPIO openId ps
// prompt for chat parameters nickname and server address
dDef = Dialog "Enter Chat Parameters"
( EditControl "" (PixelWidth 400) 1 [ControlId nicknameId, ControlPos (Right, zero)]
:+:TextControl "Nickname:" [ControlPos (LeftOfPrev, zero)]
:+:EditControl remote (PixelWidth 400) 1 [ControlId rmtsiteId, ControlPos (Right, zero)]
:+:TextControl "Chat Server:" [ControlPos (LeftOfPrev, zero)]
:+:ButtonControl "OK"
[ControlId buttonId,
ControlFunction (noLS1 ok (dialogId, nicknameId, rmtsiteId)),
ControlPos (Right, zero)]
) [WindowId dialogId, WindowOk buttonId]
dDef = Dialog "Enter Chat Parameters"
( TextControl "Type in below your nickname and the internet address of the server"
[]
:+:TextControl ("If there is no server running on the specified machine then this "
+++"program aborts.") [ControlPos (BelowPrev, zero)]
:+:EditControl "" (PixelWidth 400) 1 [ControlId nicknameId, ControlPos (Right, zero)]
:+:TextControl "Nickname:" [ControlPos (LeftOfPrev, zero)]
:+:EditControl remote (PixelWidth 400) 1 [ControlId rmtsiteId, ControlPos (Right, zero)]
:+:TextControl "Chat Server:" [ControlPos (LeftOfPrev, zero)]
:+:ButtonControl "OK"
[ControlId buttonId,
ControlFunction (noLS1 ok (dialogId, nicknameId, rmtsiteId)),
ControlPos (Right, zero)]
) [WindowId dialogId, WindowOk buttonId]
# ((errReport, _), ps) = openModalDialog NoState dDef ps
| errReport<>NoError
= abort "abort: can't open modal dialog"
= abort "can't open modal dialog"
# (_, ps) = openWindow NoState (Window "dummy" NilLS [WindowViewSize {w=100,h=30}]) ps
= ps
where
......@@ -65,7 +68,7 @@ initialize ps
= closeWindow dialogId ps
continuation :: !String !String (Maybe TCP_DuplexChannel) PState -> PState
continuation _ remoteSite Nothing ps
= abort ("CAN'T CONNECT with "+++remoteSite)
= abort ("ABORT: CAN'T CONNECT with "+++remoteSite)
continuation nickname _ (Just { sChannel, rChannel }) ps
// connection with server has been established.
# (dialogId, ps) = accPIO openId ps
......@@ -156,7 +159,7 @@ sReceiver Sendable ps=:{ls=ls=:{sndChan}, io}
# (sndChan, io) = flushBuffer_NB sndChan io
= { ps & ls={ ls & sndChan=sndChan}, io=io }
sReceiver Disconnected ps
= abort "CONNECTION DISRUPTED "
= abort "ABORT: CONNECTION DISRUPTED "
rReceiver :: !(ReceiveMsg ByteSeq) ((Id,Id),PState) -> ((Id,Id),PState)
// the function for the send channel's send notifier
......@@ -174,7 +177,7 @@ rReceiver (Received byteSeq) (ls=:(dialogId, outId), ps)
= str
rReceiver EOM _
= abort "CONNECTION DISRUPTED "
= abort "ABORT: CONNECTION DISRUPTED "
quit ps=:{ls=ls=:{sndChan}, io}
# io = closeChannel sndChan io
......
......@@ -84,7 +84,7 @@ loop listener channels console world
broadcastString :: !String ![ChanInfo] ![ChanInfo] !*World -> ([ChanInfo],!*World)
broadcastString string [] akku world
= (u_reverse akku, world)
= (reverse akku, world)
broadcastString string [channel=:{sndChan}:channels] akku world
# (sndChan, world) = send (toByteSeq string) sndChan world
= broadcastString string channels [{channel & sndChan=sndChan}:akku] world
......@@ -114,8 +114,3 @@ zip3 :: ![TCP_SChannel] ![!TCP_RChannel] ![String] -> [!ChanInfo]
zip3 [] [] [] = []
zip3 [sndChan:a] [rcvChan:b] [nickname:c]
= [{sndChan=sndChan, rcvChan=rcvChan, nickname=nickname} : zip3 a b c]
u_reverse list = reverse_ list []
where
reverse_ [hd:tl] list = reverse_ tl [hd:list]
reverse_ [] list = list
......@@ -39,7 +39,6 @@ Start world
#! console = fwrites (server+++" responded on port "+++toString port+++"\n")
console
{ sChannel=sc, rChannel=rc }= fromJust mbDuplexChan
// **************************************************************************************************
// send http command
......
......@@ -8,7 +8,7 @@ definition module StdChannels
from StdMaybe import Maybe
from StdOverloaded import ==, toString
from channelenv import ChannelEnv
from tcp import ChannelEnv
instance ChannelEnv World
......
......@@ -6,9 +6,9 @@ implementation module StdChannels
import StdEnv
import StdMaybe
import StdIOCommon, StdTime
import channelenv
import id
import commondef, iostate, receiverid, StdPStClass, StdReceiver
import commondef, iostate, receiverid, StdPStClass, StdReceiver
import tcp
instance ChannelEnv World
where
......
......@@ -3,7 +3,7 @@ implementation module StdEventTCP
// Clean Standard Object I/O library, version 1.2
import StdEnv
import /*StdChannelEnv,*/ StdChannels, StdTCPDef, StdTCPChannels
import StdChannels, StdTCPDef, StdTCPChannels
import StdReceiver
import StdPSt, StdPStClass
import tcp, ostcp, tcp_bytestreams
......@@ -515,9 +515,6 @@ Cast a
}
// MW11..
u_isNothing x=:(Just _) = (False, x)
u_isNothing x=:Nothing = (True, x)
getConnectedIds rAtts
# l = [ids \\ (ReceiverConnectedReceivers ids)<-rAtts]
| isEmpty l
......
......@@ -5,7 +5,7 @@ implementation module StdTCPChannels
import StdEnv
import StdTCPDef, StdChannels, StdTime
import StdIOCommon
import id, tcp, ostcp, channelenv, ostick, tcp_bytestreams
import id, tcp, ostcp, ostick, tcp_bytestreams
//////////////////////// Listeners ////////////////////////////////////
......
......@@ -3,7 +3,7 @@ definition module ostcp
import StdMaybe
import StdTCPDef
from StdChannels import Timeout, TimeoutReport
import tcp, channelenv
import tcp
os_eom :: !EndpointRef !*env
-> (!Bool, !*env)
......
......@@ -3,7 +3,7 @@ implementation module ostcp
import StdEnv, StdMaybe
import StdTCPDef
import StdChannels
import tcp, channelenv, ostick
import tcp, ostick
import code from "cTCP.obj", library "wsock_library"
os_eom :: !EndpointRef !*env
......
definition module tcp
from StdString import String
from id import Id
from StdString import String
from id import Id
from StdFile import FileEnv, Files
from StdTime import TimeEnv, Date, Tick, Time
from StdId import Ids, RId, R2Id
from id import Id
class ChannelEnv env | Ids env & TimeEnv env & FileEnv env
where
channelEnvKind :: !*env -> (!Int, !*env)
mb_close_inet_receiver_without_id :: !Bool !(!Int, !Int) !*env -> *env
/*
:: !Bool !(!EndpointRef, !InetReceiverCategory) !*env -> *env
mb_close_inet_receiver_without_id:
iff the Boolean is True, this function closes the receiver, which is identified through
the (!EndpointRef, !InetReceiverCategory) pair
*/
//channelEnvKind can return the following values:
WORLD :== 0
IOST :== 1
PST :== 2
IE_CONNECTREQUEST :== 0x0001
IE_RECEIVED :== 0x0004
......
implementation module tcp
import StdEnv
from id import Id
import StdFile
import id
import StdTime
from StdId import Ids
class ChannelEnv env | Ids env & TimeEnv env & FileEnv env
where
channelEnvKind :: !*env -> (!Int, !*env)
mb_close_inet_receiver_without_id :: !Bool !(!Int, !Int) !*env -> *env
//channelEnvKind can return the following values:
// (some C functions rely on these values)
WORLD :== 0
IOST :== 1
PST :== 2
IE_CONNECTREQUEST :== 0x0001
IE_RECEIVED :== 0x0004
......@@ -80,13 +94,13 @@ unpack_ipaddr i = i
close_listener :: !EndpointRef !*env -> *env
close_listener endpointRef env
#! env = setEndpointDataC endpointRef 0 False False True env
# env = setEndpointDataC endpointRef 0 False False True env
env = garbageCollectEndpointC endpointRef env
= env
close_tcprchan :: !EndpointRef !*env -> *env
close_tcprchan endpointRef env
#! ((referenceCount,_,hs,aborted),env)
# ((referenceCount,_,hs,aborted),env)
= getEndpointDataC endpointRef env
env = setEndpointDataC endpointRef (dec referenceCount) False hs aborted env
env = case (referenceCount, aborted) of
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment