{
#
  simple sheepdog game, found on nbs pascal distribution
  modified for p5x
  this version assumes ansi console, posix environment
}

program sheepdog(input, output);

const
  screenx = 79;
  screeny = 24;

  penxl = 37;
  penxu = 41;
  penyl = 10;
  penyu = 13;
  gatex = 39;
  gatey = 10;
  scorey = 24;
  scorexl = 37;
  scorexu = 40;

  maxanimals = 6;

  doggy = '+';
  sheepy = '=';
  marginx = '-';
  marginy = '|';
  pennyx = '-';
  pennyy = '|';
  space = ' ';

  cup = chr(18);
  cdown = chr(20);
  cleft = chr(28);
  cright = chr(29);

  {how much faster does the dog move than the sheep?}
  dogmoves = 10;
  scorecount = dogmoves div 5;

type
  pixel = (nothing, border, status, pen, object, user);
  animal = record
             x, y : integer
           end;
  animals = array [1..maxanimals] of animal;

var
  screen : array [1..screenx, 1..screeny] of pixel;
  sheep : animals;
  dog : animal;
  sheepsize : integer;
  score : integer;
  i : integer;
  finished : boolean;


function rand : integer; external;


#include "console.inc.pas"

procedure locate(x, y :integer);

begin
   gotoXY(x, y);
end;


procedure clearscreen;
begin
   clrScr;
end; { clearscreen }




{**************************************************************************}


procedure place(x, y : integer; p : pixel; c : char);

begin
  screen[x, y] := p;
  locate(x, y);
  write(c)
end;


function collision(d : animal):boolean;

begin
  with d do
    collision := screen[x, y] <> nothing
end;


function jobdone:boolean;

var
  result : boolean;
  i : integer;

begin
  with dog do
    result := (x = gatex) and (y = gatey);
  if result then begin
    i := 0;
    repeat
      i := i + 1;
      with sheep[i] do
        result := (y > penyl) and (y < penyu) and (x > penxl) and (x < penxu)
    until (i = sheepsize) or not result
  end;
  jobdone := result
end;


function movedog:boolean;
var
  ch : char;
  xx, yy : integer;
  newdog : animal;
begin
  movedog := false;
  ch := readkey;
  if ch <> '[' then
     ch := chr(0)
  else begin
     ch := readkey;
     case ch of
       'A' : ch := cup;
       'B' : ch := cdown;
       'C' : ch := cright;
       'D' : ch := cleft;
       otherwise
          ch  := chr(0);
     end; {case}
  end;

  if ch <> chr(0) then begin
    xx := 0;
    yy := 0;
    if ch = cup then
      yy := -1
    else if ch = cdown then
      yy := 1
    else if ch = cleft then
      xx := -1
    else if ch = cright then
      xx := 1;
    if (xx + yy) <> 0 then begin
      newdog := dog;
      with newdog do begin
        x := x + xx;
        y := y + yy
      end;
      if not collision(newdog) then begin
        with dog do
          place(x, y, nothing, space);
        dog := newdog;
        with dog do begin
          place(x, y, user, doggy);
          movedog := jobdone
        end
      end
    end
  end
end;


function update:boolean;
begin
  score := score - 2;
  locate(scorexl, scorey);
  write(score : 4);
  update := score = 0
end; { update }


function movesheep:boolean;
var
  xdef, ydef, dx, dy, xabs, yabs : integer;
  i : integer;
  terminate : boolean;
  newsheep : animal;

function sgn(i : integer):integer;

begin
  if i > 0 then
    sgn := 1
  else if i < 0 then
    sgn := -1
  else
    sgn := 0
end;


begin
  terminate := false;
  xdef := trunc(rand/maxint * 3.1) - 1;
  ydef := trunc(rand/maxint * 3.1) - 1;

  i := 0;
  repeat
    i := i + 1;
    with sheep[i] do begin
      xabs := abs(dog.x - x);
      yabs := abs(dog.y - y);
      if ((xabs < 2) and (yabs < 2)) or ((xabs > 16) or (yabs > 8)) then begin
        dx := xdef;
        dy := ydef
      end
      else begin
        dx := sgn(x - dog.x);
        dy := sgn(y - dog.y)
      end;
      newsheep := sheep[i];
      with newsheep do begin
        x := x + dx;
        if x < 0 then x := 0;
        if x > screenx then x := screenx;
        y := y + dy;
        if y < 0 then y := 0;
        if y > screeny then y := screeny;
      end;
      if not collision(newsheep) then begin
        place(x, y, nothing, space);
        sheep[i] := newsheep;
        with newsheep do
          place(x, y, object, sheepy)
      end;
      xdef := dx;
      ydef := dy;
      terminate := movedog
    end
  until (i = sheepsize) or terminate;
  movesheep := terminate
end;


procedure finishup;
begin
  locate(penxl - 6, penyl - 3);
  write('G a m e    O v e r');
  locate(penxl - 10, penyl - 1);
  write('Press <Space> to Continue');
  repeat
  until readkey = space
end; { finishup }


function play : boolean;
begin
  clearscreen;
  if score > -1 then begin
    writeln;
    writeln('Your Score  :  ', score);
    writeln;
    writeln
  end;
  writeln('               S h e e p d o g    T r i a l s');
  writeln;
  writeln('	You must attempt to manoeuvre the sheep into the pen in the');
  writeln('centre of the screen.  You control the sheepdog while up to six');
  writeln('sheep wander about the screen.');
  writeln;
  writeln('	The sheep will wander according to the following rules :');
  writeln('1. If the dog is the correct distance from the sheep, the sheep');
  writeln('    will move away from the sheepdog.');
  writeln('2. If the dog is too far away, the sheep will move randomly.');
  writeln('3. If the dog is too near, the sheep will panic and scatter.');
  writeln('4. Sheep directed into the pen will escape if left unguarded');
  writeln('    for too long.');
  writeln('5. All other things being equal, the sheep will tend to follow');
  writeln('    each other.');
  writeln;
  writeln('	When you have rounded up the sheep, place the dog in the');
  writeln('gate of the pen to end the game.');
  writeln;
  writeln;
  write('Would you like to play ? [Y/N]  ');
   play := readKey in ['Y','y'];
  writeln;
end; { play }


procedure initialise;

var
  i, j : integer;
  rubbish : boolean;

begin
  finished := false;
  repeat
    write('Number of sheep desired [1..', maxanimals, '] : ');
    readln(sheepsize)
  until (sheepsize >= 1) and (sheepsize <= maxanimals);
  for i := 2 to (screenx - 1) do begin
    for j := 2 to (screeny - 1) do begin
      screen[i, j] := nothing
    end
  end;
  clearscreen;
  for i := 1 to screenx do begin
    place(i, 1, border, marginx);
    place(i, screeny, border, marginx)
  end;
  for j := 2 to (screeny - 1) do begin
    place(1, j, border, marginy);
    place(screenx, j, border, marginy)
  end;
  for i := penxl to penxu do begin
    place(i, penyl, pen, pennyx);
    place(i, penyu, pen, pennyx)
  end;
  for j := (penyl + 1) to (penyu - 1) do begin
    place(penxl, j, pen, pennyy);
    place(penxu, j, pen, pennyy)
  end;
  place(gatex, gatey, nothing, space);
  for i := scorexl to scorexu do
    place(i, scorey, status, space);
  score := 3000 + sheepsize * 1000 + 2;
  rubbish := update;
  for i := 1 to sheepsize do begin
    with sheep[i] do begin
      case i of
        1 : begin x := 9;  y := 17; end;
        2 : begin x := 8;  y := 18; end;
        3 : begin x := 9;  y := 18; end;
        4 : begin x := 10; y := 18; end;
        5 : begin x := 9;  y := 19; end;
        6 : begin x := 10; y := 19; end;
      end; {case}
      place(x, y, object, sheepy)
    end;
  end;
  repeat
    with dog do begin
      x := trunc(rand/maxint * screenx) + 1;
      y := trunc(rand/maxint * screeny) + 1
    end
  until not collision(dog);
  with dog do
    place(x, y, user, doggy)
end;


begin
  score := -1;
  while play do begin
    initialise;
    repeat
      i := 0;

      repeat
        i := i + 1;
        finished := movedog;
        if not finished and (i mod scorecount = 0) then
          finished := update;
      until finished or (i = dogmoves);

      if not finished then
         finished := movesheep;
    until finished;

    finishup
  end; {while}
end.


{%%%%%%%%%%%%%%%%%%%%%%%%%%%%% end of sheep.pas %%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
