AlphaClient

by James Hall: L6 Age ~17

The AlphaClient Program

program AlphaClient;
{
    Copyright (c) 2011 James Hall

    Licensed under the Apache License, Version 2.0 (the "License"); you may not
    use this file except in compliance with the License, as described at
    http://www.apache.org/licenses/ and http://www.pp4s.co.uk/licenses/
}
  {$r+}
uses
  SDL, math, SDL_mixer, sdl_ttf, strutils, classes, Sysutils, sdl_net;
type
  Tinput = record
    left, right, up, down, space, enter, mousedown, mouseup, keydown : boolean;
    keyord : integer;
  end;

  Tplayer = record
    x, y : integer;
    speed, angle : real;
  end;

  Tclient = record
    name : string;
    live, templive : boolean;
    x, y : integer;
  end;

var
  Image, backgroundimage, fontface, display, overlay : Psdl_surface;
  Filename : PChar = 'images/koala.bmp';
  Filename2 : PChar = 'images/background.bmp';
  Filename3 : PChar = 'images/backtemplate.bmp';
  Filename6 : PChar = 'sounds/mariogalaxy2.mp3';
  Filename8 : PChar = 'sounds/laugh.wav';
  Fmt : PSDL_PixelFormat;
  WhiteKey : UInt32;
  MyEvent : TSDL_Event;
  gameinput : Tinput;
  mousex, mousey, i, oldx, oldy : Uint32;
  music : pMIX_MUSIC = nil;
  slaugh : pMIX_CHUNK = nil;
  soundchannel : integer;
  fontcolour1, fontcolour2 : psdl_color;
  loadedfont : pointer;
  Ipaddress : TIPaddress;
  socket : ptcpsocket;
  wait : boolean;
  tempstr : string;
  ipchar : pchar;
  namestr, mgstr : string;
  mgpchar : pchar;
  temprect : tsdl_rect;
  player : Tplayer;
  clients : array[1 .. 20] of Tclient;
  socketset : PSDLnet_socketset;
  temppchar : pchar;
  messages : array[1 .. 30] of string;

const
  AUDIO_FREQUENCY : INTEGER = 22050;
  AUDIO_FORMAT : WORD = AUDIO_S16;
  AUDIO_CHANNELS : INTEGER = 2;
  AUDIO_CHUNKSIZE : INTEGER = 4096;

procedure closeall;
begin
  sdlnet_tcp_close(socket);
  sdlnet_tcp_delsocket(socketset, socket);
  SDLNet_FreeSocketSet(SocketSet);
  SDL_ShowCursor(SDL_ENABLE);
  SDL_Freesurface(Image);
  SDL_Freesurface(BackgroundImage);
  MIX_HALTMUSIC;
  MIX_HALTCHANNEL(soundchannel);
  MIX_FREEMUSIC(music);
  MIX_FREECHUNK(slaugh);
  MIX_CLOSEAUDIO;
  DISPOSE(fontcolour1);
  DISPOSE(fontcolour2);
  TTF_CLOSEFONT(loadedfont);
  TTF_QUIT;
  sdlnet_quit;
  SDL_Quit;
  halt;
end;

procedure checkinput;
begin
  while SDL_PollEvent(@MyEvent) > 0 do
    begin
      if MyEvent.type_ = SDL_mousemotion then
        begin
          mousex := Myevent.motion.x;
          mousey := Myevent.motion.y;
        end;
      if MyEvent.type_ = SDL_mousebuttondown then
        begin
          gameinput.mousedown := true;
        end;
      if MyEvent.type_ = SDL_mousebuttonup then
        begin
          gameinput.mousedown := false;
        end;
      if MyEvent.type_ = SDL_KeyDown then //Trailing underscore because type is a keyword
        begin
          case MyEvent.key.keysym.sym of
            SDLK_ESCAPE : closeall;
            SDLK_a      : gameinput.left := true;
            SDLK_w      : gameinput.up := true;
            SDLK_s      : gameinput.down := true;
            SDLK_d      : gameinput.right := true;
            SDLK_SPACE  : gameinput.space := true;
            SDLK_return : gameinput.enter := true;
          end;
        end;
      if MyEvent.type_ = SDL_KeyUp then
        begin
          case MyEvent.key.keysym.sym of
            SDLK_a      : gameinput.left := false;
            SDLK_w      : gameinput.up := false;
            SDLK_s      : gameinput.down := false;
            SDLK_d      : gameinput.right := false;
            SDLK_SPACE  : gameinput.space := false;
            SDLK_return : gameinput.enter := false;
          end;
        end;
    end;
end;

procedure puttext(text : pchar; xx, yy : integer);
var
  fontrect : tsdl_rect;
begin
  //font bits
  new(fontcolour1);
  new(fontcolour2);
  fontcolour1^.r := 255;
  fontcolour1^.g := 50;
  fontcolour1^.b := 50;
  fontcolour2^.r := 255;
  fontcolour2^.g := 255;
  fontcolour2^.b := 255;
  fontface := TTF_RENDERTEXT_SOLID(loadedfont, text, fontcolour1^);
  with fontrect do
    begin
      w := fontface^.w;
      h := fontface^.h;
      x := xx - w div 2;
      y := yy - h div 2;
    end;
  SDL_BLITSURFACE(fontface, nil, display, @fontrect);
end;

procedure putmessage(text : pchar; xx, yy : integer);
//Same as puttext except for x and y assignments
var
  fontrect : tsdl_rect;
begin
  //font bits
  new(fontcolour1);
  new(fontcolour2);
  fontcolour1^.r := 255;
  fontcolour1^.g := 50;
  fontcolour1^.b := 50;
  fontcolour2^.r := 255;
  fontcolour2^.g := 255;
  fontcolour2^.b := 255;
  fontface := TTF_RENDERTEXT_SOLID(loadedfont, text, fontcolour1^);
  with fontrect do
    begin
      w := fontface^.w;
      h := fontface^.h;
      x := xx;
      y := yy;
    end;
  SDL_BLITSURFACE(fontface, nil, display, @fontrect);
end;

procedure sendnametosocket(str : string; Socket : PTCPSocket);
var
  tempstr : string;
  i : integer;
begin
  tempstr := inttostr(length(str));
  for i := 1 to 4 - length(inttostr(length(str))) do
    tempstr := '0' + tempstr;
  tempstr := 'nstr' + tempstr; //nstr is code for name
  writeln(tempstr);
  sdlnet_tcp_send(socket, @tempstr + 1, 8);
  writeln(str);
  sdlnet_tcp_send(socket, @str + 1, length(str));
end;

procedure sendcordstosocket(Socket : PTCPSocket);
//Sends code for co-ordinates then sends new co-ordinates of object as a string.
var
  tempstr : string;
begin
  tempstr := 'pdet0000';
  sdlnet_tcp_send(socket, @tempstr + 1, 8);
  tempstr := inttostr(100000000 + 10000 * player.x + player.y);
  sdlnet_tcp_send(socket, @tempstr + 2, length(tempstr) - 1);
end;

procedure addmess(newstr : string);
var
  i : integer;
begin
  for i := 1 to 29 do
    messages[31 - i] := messages[30 - i];
  messages[1] := newstr;
end;

function ReceivefromSocket(Socket: PTCPSocket): string;
const
  MAX_TIMEOUT = 10;
var
  i, j, k, num: integer;
  jagstr, leftjagstr : string; //for jag read "tag".
begin
  Result := '';
  try
    jagstr := 'aaaaaaaa';
    if SDLNet_CheckSockets(SocketSet, MAX_TIMEOUT) > 0 then
      begin
        if not SDLNet_SocketReady(PSDLNet_GenericSocket(Socket)) then
          Exit;
        if SDLNet_TCP_Recv(Socket, @jagstr + 1, 8) < 1 then
          begin
            Exit;
          end;
        leftjagstr := leftstr(jagstr, 4);
        writeln(jagstr);

        if leftjagstr = 'pcor' then  //player co-ordinates
          begin
            i := strtoint(rightstr(jagstr, 4));
            for k := 1 to 20 do
              clients[k].live := false;
            for j := 1 to i do
              begin
                tempstr := 'aa';
                SDLNet_TCP_Recv(Socket, @tempstr + 1, 2);
                num := strtoint(tempstr);
                clients[num].x := 0;
                clients[num].y := 0;
                clients[num].live := true;
                tempstr := 'aaa';
                SDLNet_TCP_Recv(Socket, @tempstr + 1, 3);
                clients[num].x := strtoint(tempstr);
                SDLNet_TCP_Recv(Socket, @tempstr + 1, 3);
                clients[num].y := strtoint(tempstr);
              end;
          end;

        if leftjagstr = 'pliv' then  //player becomes live
          begin
            i := strtoint(midstr(jagstr, 5, 2));
            k := strtoint(rightstr(jagstr, 2));
            tempstr := '';
            for j := 1 to k do
               tempstr := tempstr + 'a';
            SDLNet_TCP_Recv(Socket, @tempstr + 1, k);
            clients[i].live := true;
            clients[i].name := tempstr;
            tempstr := tempstr + ' has connected';
            addmess(tempstr);
            result := 'd';
          end;

         if leftjagstr = 'pdis' then //player disconnected
           begin
             k := strtoint(rightstr(jagstr, 4));
             clients[k].live := false;
             tempstr := clients[k].name + ' has disconnected';
             addmess(tempstr);
             result := 'd';
           end;

        if leftjagstr = 'pmes' then //player message
          begin
            k := strtoint(rightstr(jagstr, 4)); //number of characters in message
            tempstr := '';
            for j := 1 to k do
               tempstr := tempstr + 'a';
            SDLNet_TCP_Recv(Socket, @tempstr + 1, k);
            addmess(tempstr);
            result := 'd';
          end;
        exit;
      end;
  finally
  end;
end;

procedure addmessages;
var
  i, lineto, j : integer;
  tpchar : pchar;
const
  linemax = 25;
  linelength = 30;
begin
  i := 1;
  lineto := 0;
  while (messages[i] <> 'k') and (lineto < linemax) do
    begin
      lineto := lineto + (length(messages[i]) div linelength) + 2;
      j := 1;
      if (length(messages[i]) div linelength) >= 1 then
        repeat
          dec(lineto);
          tpchar := pchar(midstr(messages[i], (j - 1) * linelength + 1, linelength));
          if lineto < linemax then
            putmessage(tpchar, 590, 398 - lineto * 15);
          inc(j);
        until j > ((length(messages[i]) div linelength) - 1);
      dec(lineto);
      tpchar := pchar(rightstr(messages[i], (length(messages[i]) mod linelength)));
      if lineto < linemax then
        putmessage(tpchar, 590, 398 - lineto * 15);
      lineto := lineto + (length(messages[i]) div linelength);
      inc(i);
    end;
end;

begin
  //initialise images
  Image := SDL_LoadBMP(Filename);
  BackgroundImage := SDL_LoadBMP(Filename2);
  overlay := SDL_LoadBMP(Filename3);
  //initialise video
  SDL_Init(SDL_INIT_VIDEO);
  Display := SDL_SetVideoMode(BackgroundImage^.w, BackgroundImage^.h, 24, SDL_HWSURFACE or SDL_DOUBLEBUF);
  SDL_WM_SetCaption('Client', nil);
  SDL_ShowCursor(SDL_ENABLE);
  //Initialise audio
  SDL_Init(SDL_INIT_AUDIO);
  if MIX_OPENAUDIO(AUDIO_FREQUENCY, AUDIO_FORMAT, AUDIO_CHANNELS, AUDIO_CHUNKSIZE) <> 0 then
    HALT;
  music := MIX_LOADMUS(filename6);
  MIX_VOLUMEMUSIC(20);
  slaugh := MIX_LOADWAV(filename8);
  MIX_VOLUMECHUNK(slaugh, 10);
  //initialise text
  if TTF_INIT = -1 then
    HALT;
  loadedfont := TTF_OPENFONT('arial.ttf', 10);
  //Calculate WhiteKey, needed to set transparent colour
  Fmt := Image^.format;
  WhiteKey:= SDL_MapRGB(Fmt, 255, 255, 255);
  //Set transparent colour
  SDL_SetColorKey(Image, SDL_SRCCOLORKEY or SDL_RLEACCEL, WhiteKey);
  SDL_SetColorKey(Overlay, SDL_SRCCOLORKEY or SDL_RLEACCEL, WhiteKey);
  //network
  sdlnet_init;
  write('Host IP: ');
  readln(tempstr);
  write('Desired Name: ');
  readln(namestr);
  ipchar := pchar(@tempstr + 1);
  if SDLNet_ResolveHost(IPAddress, ipchar, 1479) <> 0 then
    closeall;
  Socket := SDLNet_TCP_Open(IPAddress);
  if socket = nil then
    closeall;
  wait := true;
  sendnametosocket(namestr, socket);

  SocketSet := SDLNet_AllocSocketSet(20);
  SDLNet_TCP_AddSocket(SocketSet, socket);

  player.x := 100;
  player.y := 100;
  player.speed := 0;
  player.angle := 0;
  oldx := 40;
  oldy := 100;
  for i := 1 to 20 do
    clients[i].live := false;
  for i := 1 to 30 do
    messages[i] := 'k';
  messages[1] := 'Welcome!';
  mgstr := namestr + ': ';
  gameinput.keydown := false;
  repeat
    //Inputs
    checkinput;
    if gameinput.left then
      begin
        if player.x > 50 then
          player.x := player.x - 4;
      end;
    if gameinput.right then
      begin
        if player.x < 550 - image^.w then
          player.x := player.x + 4;
      end;
    if gameinput.up then
      begin
        if player.y > 50 then
          player.y := player.y - 4;
      end;
    if gameinput.down then
      begin
        if player.y < 500 - image^.h then
          player.y := player.y + 4;
      end;
        { mix_haltmusic;
         mix_playmusic(gameovermusic,-1); //Starting the ending music   }
    if (oldx <> player.x) or (oldy <> player.y) then
      sendcordstosocket(socket);
    oldx := player.x;
    oldy := player.y;
    //copy background
    SDL_BlitSurface(BackgroundImage, nil, Display, nil);
    receivefromsocket(socket);
    temprect.h := image^.h;
    temprect.w := image^.w;
    for i := 1 to 20 do
      if clients[i].live then
        begin
          temprect.x := clients[i].x;
          temprect.y := clients[i].y;
          SDL_BlitSurface(Image, nil, Display, @temprect);
          temppchar := pchar(@clients[i].name + 1);
          puttext(temppchar, clients[i].x + image^.w div 2, clients[i].y - 7);
        end;

    if gameinput.keydown then
      begin
        //lower case character
        if (gameinput.keyord >= 97) and (gameinput.keyord <= 122) then
          begin
            if length(mgstr) < 20 then
              mgstr := mgstr + char(gameinput.keyord);
          end;
        if gameinput.keyord = 32 then
          mgstr := mgstr + ' ';
        if gameinput.keyord = 13 then
          begin
            addmess(mgstr);
            mgstr := namestr + ': ';
          end;
        if gameinput.keyord = 8 then //backspace
          begin
            if length(mgstr) > length(namestr + ': ') then
              mgstr := leftstr(mgstr, length(mgstr) - 1);
          end;
        gameinput.keydown := false;
      end;

    SDL_BlitSurface(Overlay, nil, Display, nil);
    addmessages;
    //convert to pchar for transmission
    mgpchar := pchar(@mgstr + 1);
    writeln(mgpchar);
    if length(mgstr) > 0 then
      putmessage(mgpchar, 10, 10);
    //Update
    SDL_Flip(Display);
    //wait 30 milliseconds
    SDL_Delay(30);
  until 1 = 2;
end.

Remarks

Could you write your own client and server programs using SDL?

Programming - a skill for life!

by James Hall: L6 Age ~17