Chess Horses (TP 7)

uses crt,graph;
const
  xs=1; ys=1;
  cw=4;
  csteps:array[1..4,1..2]of longint=(
    (0,-1),
    (0,1),
    (-1,0),
    (1,0)
  );
  hsteps:array[1..8,1..2]of longint=(
    (2,1),
    (1,2),
    (-2,1),
    (-1,2),
    (2,-1),
    (1,-2),
    (-2,-1),
    (-1,-2)
  );
  gridborder=15;
  cursor=4;
  horse=7;
  wronghorse=12;

procedure drawhorse(x,y:longint);
  procedure m(xx,yy:longint); begin moveto(x+xx*xs,y+yy*ys); end;
  procedure l(xx,yy:longint); begin lineto(x+xx*xs,y+yy*ys); end;
  begin
    m( 7, 7);
    l( 6, 9); l( 5,12); l( 5,14); l( 7,15); l(10,15); l(12,14);
    l(12,12); l(11,10); l(12, 8); l(12, 3); l(10, 1); l( 8, 1);
    l( 6, 2); l( 6, 3); l( 3, 5); l( 3, 6); l( 5, 7); l( 8, 7);
    m( 5,12);
    l( 7,13); l(10,13); l(12,12);
    m(11,10);
    l(11, 4); l( 9, 2); l( 6, 3);
  end;

const
  cmd='wsad q';
var
  gd,gm:integer;
  i,n,m,mx,my,c:longint;
  field:array[0..49,0..49]of boolean;
  f:boolean;

procedure drawgrid;
  var
    i,j,sx,sy:longint;
  begin
    setcolor(gridborder);
    sx:=xs*16;
    sy:=ys*16;
    for i:=0 to n-1 do
      for j:=0 to m-1 do
        begin
          line(i*sx,j*sy,(i+1)*sx,j*sy);
          line(i*sx,j*sy,i*sx,(j+1)*sy);
        end;
    for i:=0 to n-1 do
      line(i*sx,m*sy,(i+1)*sx,m*sy);
    for i:=0 to m-1 do
      line(n*sx,i*sy,n*sx,(i+1)*sy);
  end;
procedure drawcursor(n,m:longint;active:boolean);
  var
    sx,sy,ssx,ssy:longint;
  begin
    sx:=n*xs*16;
    sy:=m*ys*16;
    ssx:=sx+xs*16;
    ssy:=sy+ys*16;
    if active
    then setcolor(cursor)
    else setcolor(gridborder);
    line(sx,sy,sx+cw,sy);   line(sx,sy,sx,sy+cw);
    line(ssx,sy,ssx-cw,sy); line(ssx,sy,ssx,sy+cw);
    line(sx,ssy,sx,ssy-cw); line(sx,ssy,sx+cw,ssy);
    line(ssx,ssy,ssx-cw,ssy); line(ssx,ssy,ssx,ssy-cw);
  end;
function inbounds(x,l,r:longint):boolean;
  begin
    inbounds:=(x>=l)and(x<=r);
  end;
procedure redrawhorses(x,y:longint);
  var
    f:boolean;
    i,cx,cy:longint;
  function check(x,y:longint):boolean;
    var
      i,cx,cy:longint;
    begin
      for i:=1 to 8 do
        begin
          cx:=x+hsteps[i,1];
          cy:=y+hsteps[i,2];
          if inbounds(cx,0,n-1) and inbounds(cy,0,m-1) and field[cx,cy]
          then
            begin
              check:=true;
              exit;
            end;
        end;
      check:=false;
    end;

  begin
    f:=false;
    for i:=1 to 8 do
      begin
        cx:=x+hsteps[i,1];
        cy:=y+hsteps[i,2];
        if inbounds(cx,0,n-1) and inbounds(cy,0,m-1) and field[cx,cy]
        then
          begin
            if check(cx,cy)
            then setcolor(wronghorse)
            else setcolor(horse);
            drawhorse(cx*16*xs,cy*16*ys);
          end;
      end;
    if not field[x,y]
    then setcolor(0)
    else if check(x,y)
    then setcolor(wronghorse)
    else setcolor(horse);
    drawhorse(x*16*xs,y*16*ys);
  end;

begin
  clrscr;
  fillchar(field,sizeof(field),false);
  writeln('Enter width and height:');
  readln(n,m);
  if (n>50)or(m>50)or(n<1)or(m<1) then exit;
  randomize;
  gd:=detect;
  InitGraph(gd,gm,'');
  if GraphResult<>grOk then halt;

  mx:=0;my:=0;
  drawgrid;
  drawcursor(mx,my,true);
  while true do
    begin
      c:=pos(readkey,cmd);
      case c of
        5:
          begin
            field[mx,my]:=not field[mx,my];
            redrawhorses(mx,my);
          end;
        6:break;
        0:continue;
        else
          begin
            drawcursor(mx,my,false);
            if inbounds(mx+csteps[c,1],0,n-1)
            then mx:=mx+csteps[c,1];
            if inbounds(my+csteps[c,2],0,m-1)
            then my:=my+csteps[c,2];
            drawcursor(mx,my,true);
          end;
      end;
    end;

  CloseGraph;
end.