Sorry your browser is not supported!

` This code was downloaded from The Game Creators
` It is reproduced here with full permission
` http://www.thegamecreators.com

#constant MAX_PLAYERS   8
#constant MAX_MESSAGES  25

#constant COL_INFO      rgb(255,255,0)
#constant COL_ERROR     rgb(255,0,0)
#constant COL_USER      rgb(255,255,255)
#constant COL_MESSAGE   rgb(255,255,255)

` Storage for player name info, so that we don't have to keep interrogating the system
type PlayerCache_t
   PlayerID as integer
   PlayerName as string
endtype
dim PlayerCache(MAX_PLAYERS) as PlayerCache_t

` Storage for the last 20 messages
type Message_t
   MessageText as string
   Colour as dword
endtype
dim Messages(MAX_MESSAGES) as Message_t

` Local storage
Name as string
UserMessage as string

` Make DBPro play nice with the system
sync off

input "Enter your name : ", Name
clear entry buffer

` Make up a random name for now
if Name = ""
   randomize timer()
   Name = "Unknown " + str$( rnd(32767) )
endif

` Lets get online
ConnectToChat( Name )

` Keep going until the escape key is pressed
disable escapekey
while escapekey() = 0

   WelcomeNewPlayers()
   GoodbyeToDeadPlayers()

   ReceiveMessage()

   DisplayMessages()

   ` If the user gives us a complete message to send, forward it on
   UserMessage = InputUserMessage()
   if UserMessage <> ""
      if left$(UserMessage,1) = "/"
         CarryoutUserCommand(UserMessage)
      else
         SendMessage(UserMessage)
      endif
   endif

endwhile

` All done
ExitChat()
end


function ConnectToChat(Name as string)
   local PlayerNumber as integer

   ` Connect to the chat session
   AddMessage("Attempting to connect to the chat session", COL_INFO)
   DisplayMessages()
   PlayerNumber = default net game("chat", Name, MAX_PLAYERS, 2)
   AddMessage("", 0)
   AddMessage("Connected as " + Name, COL_INFO)

   ` Ensure that we have everyones name
   RefreshPlayerCache()
endfunction

function RefreshPlayerCache()
   local i as integer

   ` Clear the current list of names
   for i = 1 to MAX_PLAYERS
      PlayerCache(i).PlayerID = 0
   next i

   ` Query for the new list
   perform checklist for net players

   ` Copy the names and ID's to our cache
   for i = 1 to checklist quantity()
      PlayerCache(i).PlayerID = checklist value a(i)
      PlayerCache(i).PlayerName = checklist string$(i)
   next i

endfunction

function GetPlayerName(PlayerNumber)
   local i as integer

   ` Search for the player ID in the cache and return the name
   for i = 1 to MAX_PLAYERS

      if PlayerCache(i).PlayerID = PlayerNumber
         exitfunction PlayerCache(i).PlayerName
      endif

   next i

endfunction "Unknown"

function WelcomeNewPlayers()
   local NewPlayer as integer

   ` If a new player joins we detect it here
   NewPlayer = net player created()
   if NewPlayer > 0

      ` Get the latest list of players
      RefreshPlayerCache()

      ` If we are the main server, send a welcome message
      if net game now hosting()
         send net message string NewPlayer, "Welcome to the chat"
      endif

      ` and notify that someone just joined
      AddMessage( GetPlayerName( NewPlayer ) + " : Just joined", COL_INFO )
   endif
endfunction

function GoodbyeToDeadPlayers()
   local DeadPlayer as integer

   ` If someone leaves we detect it here
   DeadPlayer = net player destroyed()
   if DeadPlayer > 0

      ` and let everyone know.
      ink rgb(255,0,0), 0
      AddMessage("Just left : " + GetPlayerName(DeadPlayer), COL_INFO)
   endif
endfunction

function ReceiveMessage()
   local Result as string

   ` Check for new messages and loop until we got them all
   get net message
   while net message exists() > 0
      ` Only accepting strings for the moment - anything else is illegal
      if net message type() = 3
         ink rgb(255,255,255), 0
         AddMessage(GetPlayerName( net message player from() ) + " : " + net message string$(), COL_MESSAGE)
      else
         ink rgb(255,0,0), 0
         AddMessage("Illegal message type received from " + GetPlayerName( net message player from() ), COL_ERROR)
      endif

      get net message
   endwhile

endfunction Result

function SendMessage(UserMessage as string)
   AddMessage("ME : " + UserMessage, COL_USER)
   send net message string 0, UserMessage
endfunction

global CurrentInput as string

function InputUserMessage()
   local Result as string
   local Char as string
   local i as integer

   ` If anything is in the keyboard entry buffer we add the characters one by one to the current input string
   if entry$() <> ""
      for i = 1 to len( entry$() )
         Char = mid$( entry$(), i )

         ` If it's a backspace, remove the last character
         if Char = chr$( 8 )
            if CurrentInput <> "" then CurrentInput = left$( CurrentInput, len(CurrentInput)-1 )
         else
            ` If it's a valid character add it to the buffer
            if asc( Char ) >= 32 && asc( Char ) < 128 then CurrentInput = CurrentInput + Char

            ` If it's a return, pass on what we got and start again
            if asc( Char ) = 13
               Result = CurrentInput
               CurrentInput = ""
            endif
         endif
      next i

      ` Clear out the buffer
      clear entry buffer
   endif
endfunction Result

function AddMessage(UserMessage as string, Colour as dword)
   local i as integer

   ` Scroll up all messages 1 line
   for i=1 to MAX_MESSAGES-1
      Messages(i) = Messages(i+1)
   next i

   ` Record the current message
   Messages(MAX_MESSAGES).MessageText = UserMessage
   Messages(MAX_MESSAGES).Colour = Colour
endfunction

function DisplayMessages()
   local i as integer

   ` Clear the screen
   cls

   ` Output all messages
   for i=1 to MAX_MESSAGES
      ink Messages(i).Colour, 0
      text 0, (i-1)*15, Messages(i).MessageText
   next i

   ` Output what the user has typed so far
   ink COL_USER, 0
   text 0, 400, "> " + CurrentInput + "_"
endfunction

function CarryoutUserCommand(UserMessage as string)
   UserMessage = lower$( right$( UserMessage, len(UserMessage)-1 ) )
   select UserMessage
      case "help"    : DisplayHelp()                                                   : endcase
      case "quit"    : ExitChat()                                                      : endcase
      case "who"     : DisplayUsers()                                                  : endcase
      case default   : AddMessage("Unknown user command : " + UserMessage, COL_ERROR)  : endcase
   endselect
endfunction

function ExitChat()
   free net game
   end
endfunction

function DisplayUsers()
   local i as integer

   ` Display the cached list of users
   AddMessage("Who's logged on:", COL_INFO)
   for i=1 to MAX_PLAYERS
      if PlayerCache(i).PlayerID > 0
         AddMessage("    " + PlayerCache(i).PlayerName, rgb(128,255,128))
      endif
   next i
endfunction

function DisplayHelp()
   AddMessage("HELP:", COL_INFO)
   AddMessage("    /help      This help", COL_INFO)
   AddMessage("    /quit      Exit chat", COL_INFO)
   AddMessage("    /who       List currently connected users", COL_INFO)
endfunction