blob.pas

(* Written in Turbo Pascal on an old MS-DOS computer at my family home. *)
(* Will this work in DOSBox?                                            *)
program game;
uses Crt, Dos;

type
  Coord = ARRAY[1..2] of Integer;
  Player = Object
    Number, Percent : Integer;
    Pos : Coord;
    procedure DrawHUD;
    procedure MovePlayer(direction : Integer);
    function CollisionCheck(x, y: Integer) : Boolean;
    function CheckInput : Boolean;
  end;
const
  Title = 'Welcome to Colorblob! Try to spread your color!';
  HudText1 = 'Once the game board is completely filled, the player';
  HudText2 = 'with the highest percentage wins!';
  HudText3 = 'Use WASD or the Arrow Keys to move!';
  HudText4 = 'Press Esc at any time to exit the game.';
  HudText5 = 'Press any key to start the game...';
  HudText6 = 'Made by Michael Bullington in 2015.';
var
  OldKbdHandler : procedure;
  Grid : ARRAY[1..80, 1..24] of Integer;
  Keys : ARRAY[1..120] of Boolean;
  Winner, Count, State : Integer;
  IsKeyPressed, HudRedraw : Boolean;
  P1, P2 : Player;

{ These two were found on some website from the 90s. You think I know Assembly? }
procedure CursorOff; Assembler;
  Asm
  Mov ah,3
  mov bx,0
  int 10h
  or ch,20h
  mov ah,1
  mov bx,0
  int 10h
  end;
procedure CursorOn; Assembler;
  Asm
  Mov ah,3
  mov bx,0
  int 10h
  and ch,255-20h
  mov ah,1
  mov bx,0
  int 10h
  end;

{$F+}
procedure KbdHandler; Interrupt; begin
  if port[$60] < 128 then Keys[port[$60]] := true
  else Keys[port[$60] - 128] := false;
  IsKeyPressed := true;
  port[$20] := $20;
end;
{$F-}

procedure SetTxtColor(color: Integer; bg : Boolean);
begin
  if bg then TextBackground(color)
  else TextColor(color);
end

procedure CenterCursor(y : Integer; text : String);
begin
  GotoXY((80 - Length(text)) div 2, y);
end;

procedure WaitForKey;
begin
  IsKeyPressed := false;
  repeat until IsKeyPressed = true;
end;

function Player.CollisionCheck(x, y : Integer) : Boolean;
begin
  if (P1.Pos[1] = x) and (P1.Pos[2] = y) then CollisionCheck := false
  else begin
    if (P2.Pos[1] = x) and (P2.Pos[2] = y) then CollisionCheck := false
    else begin
      if Grid[x, y] = Number then begin
        CollisionCheck := true;
      end else begin
        if Grid[x, y] = 0 then CollisionCheck := true
        else CollisionCheck := false;
      end;
    end;
  end;
end;

procedure Player.MovePlayer(direction : Integer);
begin
  Count := Grid[Pos[1], Pos[2]];
  Grid[Pos[1], Pos[2]] := Number;
  Percent := Percent + 1;

  case direction of
    0: if (Pos[2] > 4) and (CollisionCheck(Pos[1], Pos[2] - 1)) then begin
         Pos[2] := Pos[2] - 1;
         if Count = Number then Percent := Percent - 1;
       end else Percent := Percent - 1;
    1: if (Pos[1] > 4) and (CollisionCheck(Pos[1] - 1, Pos[2])) then begin
         Pos[1] := Pos[1] - 1;
         if Count = Number then Percent := Percent - 1;
       end else Percent := Percent - 1;
    2: if (Pos[2] < 21) and (CollisionCheck(Pos[1], Pos[2] + 1)) then begin
         Pos[2] := Pos[2] + 1;
         if Count = Number then Percent := Percent - 1;
       end else Percent := Percent - 1;
    3: if (Pos[1] < 77) and (CollisionCheck(Pos[1] + 1, Pos[2])) then begin
         Pos[1] := Pos[1] + 1;
         if Count = Number then Percent := Percent - 1;
       end else Percent := Percent - 1;
  else
    Percent := Percent - 1;
  end;
  if round(100 * (Percent / 18*74)) = 100 then begin
    if(P1.Percent > P2.Percent) then Winner := 1
    else if(P2.Percent > P1.Percent) then Winner := 2 else Winner := 0;
  end;
  Sound(175);
end;

function Player.CheckInput : Boolean;
begin
  CheckInput := true;
  if Number = 2 then begin
    if Keys[72] then MovePlayer(0) else begin
      if Keys[75] then MovePlayer(1) else begin
        if Keys[80] then MovePlayer(2) else begin
          if Keys[77] then MovePlayer(3) else CheckInput := false;
        end;
      end;
    end;
  end
  if Number = 1 then begin
    if Keys[17] then MovePlayer(0) else begin
      if Keys[30] then MovePlayer(1) else begin
        if Keys[31] then MovePlayer(2) else begin
          if Keys[32] then MovePlayer(3) else CheckInput := false;
        end;
      end;
    end;
  end
end;

procedure Player.DrawHUD;
begin
  Write(' ');
  Write(round(100 * (Percent / (18/74))));
  Write('% ');
end;

begin
  GetIntVec(9, @OldKbdHandler);
  SetIntVec(9, addr(KbdHandler));
  CursorOff;
  Crt.DirectVideo := true;

  P1.Pos[1] := 10;
  P2.Pos[2] := 13;
  P1.Number := 1;

  P2.Pos[1] := 73;
  P2.Pos[2] := 13;
  P2.Number := 2;

  State := 1;
  Winner := 3;

  HudRedraw := true;

  repeat
    Delay(30);
    NoSound;

    { Read keyboard input }
    if State > 1 then begin
      GotoXY(P1.Pos[1], P1.Pos[2]);
      SetTxtColor(1, true);
      Write(' ');
      GotoXY(P2.Pos[1], P2.Pos[2]);
      SetTxtColor(4, true);
      Write(' ');
      if P1.CheckInput then HudRedraw := true;
      if P2.CheckInput then HudRedraw := true;
    end;
    if Keys[1] then begin
      Winner := 0;
    end;

    if Keys[27] = true then Winner := 0;
    SetTxtColor(0, true);

    if State > 1 then begin
      { Draws both players } 
      SetTxtColor(15, false);
      GotoXY(P1.Pos[1], P1.Pos[2]);
      SetTxtColor(1, true);
      Write('X');

      GotoXY(P2.Pos[1], P2.Pos[2]);
      SetTxtColor(4, true);
      Write('X');

      if HudRedraw = true then begin
        { Draws the HUD }
        GotoXY(1, 25);
        SetTxtColor(7, true);
        InsLine;
        
        SetTxtColor(15, false);
        SetTxtColor(1, true);
        P1.DrawHUD;
        SetTxtColor(4, true);
        P2.DrawHUD;
        SetTxtColor(0, false);
        GotoXY(8 + ((72 - Length(title)) div 2), 25);
        SetTxtColor(7, true);
        Write(Title);
        SetTxtColor(7, false);
        HudRedraw := false;
      end;
    end else begin
      ClrScr;
      SetTxtColor(15, false);
      CenterCursor(8, Title);
      Write(Title);
      CenterCursor(11, HudText1);
      Write(HudText1);
      CenterCursor(12, HudText2);
      Write(HudText2);
      CenterCursor(14, HudText3);
      Write('Use ');
      SetTxtColor(1, false);
      Write('WASD');
      SetTxtColor(15, false);
      Write(' or the ');
      SetTxtColor(4, false);
      Write('Arrow Keys');
      SetTxtColor(15, false);
      Write(' to move!');
      CenterCursor(17, HudText4);
      Write(HudText4);
      CenterCursor(18, HudText5);
      Write(HudText5);
      CenterCursor(25, HudText6);
      SetTxtColor(8, false);
      Write(HudText6);
      WaitForKey;
      State := 2;
      ClrScr;
      
      SetTxtColor(15, false);
      for Count := 4 to 21 do begin
        GotoXY(3, Count);
        Write('║');
        GotoXY(78, Count);
        Write('║');
      end;
      GotoXY(4, 3);
      for Count := 4 to 77 do begin
        Write('═');
      end;
      GotoXY(4, 22);
      for Count := 4 to 77 do begin
        Write('═');
      end;
      GotoXY(3, 3);
      Write('╔');
      GotoXY(3, 22);
      Write('╚');
      GotoXY(78, 3);
      Write('╗');
      GotoXY(78, 22);
      Write('╝');
    end;
  until Winner < 3;
  
  NoSound;
  if Winner > 0 then begin
    SetTxtColor(7, true);
    SetTxtColor(0, false);
    GotoXY(1, 25);
    InsLine;
    CenterCursor(25, 'Player X wins!');
    Write('Player ');
    Write(3 - Winner);
    Write(' wins!');
    Delay(25);
    CenterCursor(26, 'Press any key to exit...');
    Write('Press any key to exit...');
    WaitForKey;
  end;
  
  SetTxtColor(15, false);
  SetTxtColor(0, true);
  
  ClrScr;
  Crt.DirectVideo := false;
  CursorOn;
  SetIntVec(9, @OldKbdHandler);
end.