program XWord;
{$I graph.p}

(*
   The program displays a grid of 15x15 squares.  The cursor starts
   in the upper left.
     When the user hits an arrow key, the cursor moves to the next
   square in that direction.  When the user then starts typing, the
   letters appear in the grid going in the direction (horizontal or
   vertical) she last moved in.
     The '-' and '|' commands change the current direction to
   horizontal and vertical, respectively.
     When the user hits the '#' or ' ' keys, the current box is
   changed to black or white, respectively, and so is the diametrically
   opposite box, according to the symmetry settings.  The user can
   toggle between 0, 90, and 180-degree rotational symmetries with the
   '/' and '\' keys.
      The '#' command will not have any effect if any of its target
   grid boxes are already filled with text.  The ',' command can be
   used to clear any single grid box back to its initial "gray" state;
   the ',' command does not respect symmetries.
     The '.' command takes the current direction and looks forward
   and backward from the current box, looking for the boxes on either
   side of the current "word" (text-filled boxes).  Once it finds the
   two ends of the current word, it executes the '#' command on them.

     The '%' command updates the clue count by counting the number of
   boxes with black neighbors above and/or to their left.
     The '@' or 'Esc' command quits the program and writes the grid
   to a disk file called "xword.sav".
     The '~' command resets the entire grid to the initial state.
*)

var
  Grid: array[0..16] of array [0..16] of char;
  Command: char;
  CurX, CurY: integer;
  Horiz: boolean;
  SymRot: integer;
  HorizCount, VertCount: integer;
  invcmd: boolean;
  NotOkay: boolean;


procedure InitializeGrid;
var i,j: integer;
  begin
    for i:=1 to 15 do
      for j:=1 to 15 do
        Grid[i][j] := '.';
    for i:=0 to 16 do
      begin
        Grid[ i][ 0] := '#';
        Grid[ i][16] := '#';
        Grid[ 0][ i] := '#';
        Grid[16][ i] := '#';
      end;
    CurX := 1;
    CurY := 1;
    Horiz := true;
    SymRot := 1;
    HorizCount := 0; VertCount := 0;
    invcmd := false;
  end;

procedure BlackSquare(y,x:integer; s:integer);
var i: integer;
  begin
    for i:=0 to s-1 do
      Draw(y+i, x, y+i, x+s-1, 1);
  end;

procedure ShowGrid;
var i,j: integer;
  begin
    ClearScreen;
    for i:=1 to 15 do
      for j:=1 to 15 do
        begin
          case Grid[i][j] of
            '#': BlackSquare(8*i+8, 8*j+8, 7);
            '.': BlackSquare(8*i+9, 8*j+9, 5);
            else begin
              GotoXY(2+i,2+j);
              Write(Grid[i][j]);
            end;
          end;
        end;
    for i:=0 to 15 do begin
      Draw(8*i+15, 15, 8*i+15, 135, 1);
      Draw(15, 8*i+15, 135, 8*i+15, 1);
    end;
    Draw(8*CurX+7, 8*CurY+7, 8*CurX+15, 8*CurY+7, 3);
    Draw(8*CurX+15, 8*CurY+7, 8*CurX+15, 8*CurY+15, 3);
    Draw(8*CurX+15, 8*CurY+15, 8*CurX+7, 8*CurY+15, 3);
    Draw(8*CurX+7, 8*CurY+15, 8*CurX+7, 8*CurY+7, 3);
    GotoXY(31,23); Write('CC: '); Write(HorizCount:2);
    Write('/'); Write(VertCount:2);
    if (invcmd) then begin
      GotoXY(25, 24); Write('Invalid Command');
      invcmd := false;
    end;
    if (NotOkay) then begin
      GotoXY(23, 24); Write('Conflicting Marks');
      NotOkay := false;
    end;
  end;

procedure InvalidCommand;
  begin
    invcmd := true;
  end;

procedure SetGrid(x,y:integer; ch:char);
var okay: boolean;

  procedure SetClear(x,y:integer);
    begin
      if Grid[x][y] in ['#','.',' '] then Grid[x][y] := ' ';
    end;

  begin
    if ((x < 1) OR (x > 15) OR (y < 1) OR (y > 15)) then
    else begin
      if (ch = '#') then begin
        okay := true;
        if (SymRot>0) AND not (Grid[16-x][16-y] in ['#','.',' ']) then
          okay := false;
        if (SymRot>1) AND not (Grid[16-y][x] in ['#','.',' ']) then
          okay := false;
        if (SymRot>1) AND not (Grid[y][16-x] in ['#','.',' ']) then
          okay := false;
        if (okay) then begin
          Grid[x][y] := ch;
          if (SymRot>0) then Grid[16-x][16-y] := ch;
          if (SymRot>1) then Grid[16-y][x] := ch;
          if (SymRot>1) then Grid[y][16-x] := ch;
        end else NotOkay := true;
      end
      else if (ch = ' ') then begin
        okay := true;
(*        if (Grid[x][y] = '#') then okay := false;
        if (SymRot>0) AND (Grid[16-x][16-y] = '#') then okay := false;
        if (SymRot>1) AND (Grid[16-y][x] = '#') then okay := false;
        if (SymRot>1) AND (Grid[y][16-x] = '#') then okay := false;*)
        if (okay) then begin
          Grid[x][y] := ch;
          if (SymRot>0) then SetClear(16-x, 16-y);
          if (SymRot>1) then SetClear(16-y, x);
          if (SymRot>1) then SetClear(y, 16-x);
        end else NotOkay := true;
      end
      else if (ch = '.') then begin
        Grid[x][y] := '.';
      end
      else begin
        Grid[x][y] := ch;
        if (SymRot > 0) then begin (* 180-degree symmetry *)
          SetClear(16-x, 16-y);
          if (SymRot > 1) then begin (* 90-degree symmetry *)
            SetClear(y, 16-x);
            SetClear(16-y, x);
          end;
        end;
      end;
    end;
  end;

procedure BracketCurrentWord;
var cx, cy: integer;
  begin
    cx := CurX; cy := CurY;
    while (cx<16) AND (cy<16) AND not (Grid[cx][cy] in ['#','.',' ']) do
      if Horiz then cx := cx + 1 else cy := cy + 1;
    SetGrid(cx,cy,'#');
    cx := CurX; cy := CurY;
    while (cx>0) AND (cy>0) AND not (Grid[cx][cy] in ['#','.',' ']) do
      if Horiz then cx := cx - 1 else cy := cy - 1;
    SetGrid(cx,cy,'#');
  end;

procedure advance;
  begin
    if Horiz AND (CurX < 15) then CurX := CurX + 1;
    if (not Horiz) AND (CurY < 15) then CurY := CurY + 1;
  end;

procedure CalculateClueCount;
var i,j:integer;
  begin
    HorizCount := 0; VertCount := 0;
    for i:=1 to 15 do
      for j:=1 to 15 do
        begin
          if Grid[i-1][j] = '#' then HorizCount := HorizCount+1;
          if Grid[i][j-1] = '#' then VertCount := VertCount+1;
        end;
  end;

procedure LoadWork; forward;

procedure ActOnCommand;
var EscC: integer;
  begin
    EscC := 0;
    while not KeyPressed do;
    Read(KBD, Command);
    if KeyPressed then
      begin
        Read(KBD, Command);
        EscC := 1000;
      end;
    case Ord(Command)+EscC of
      65..90, 97..122: Command:=UpCase(Command);
      1075: Command:='<';
      1077: Command:='>';
      1072: Command:='^';
      1080: Command:='_';
      27, 64: Command:='@';
    end;

    (*
       Now we actually deal with the command we have been given.
       Letters go in grid slots; arrows move the active grid slot
       up or down; the space, hash, and dot characters change the
       category of the active grid slot; and the comma "fixes" the
       current word in the grid by sandwiching it with black squares.
    *)
    case Command of
      '<': begin if CurX>1 then CurX:=CurX-1; Horiz := true; end;
      '>': begin if CurX<15 then CurX:=CurX+1; Horiz := true; end;
      '^': begin if CurY>1 then CurY:=CurY-1; Horiz := false; end;
      '_': begin if CurY<15 then CurY:=CurY+1; Horiz := false; end;
      '#': begin SetGrid(CurX, CurY, '#'); end;
      ' ': begin SetGrid(CurX, CurY, ' '); advance; end;
      '.': begin SetGrid(CurX, CurY, '.'); advance; end;
      ',': BracketCurrentWord;
      '-': Horiz := true;
      '|': Horiz := false;
      '\', '/': SymRot := (SymRot+1) mod 3;
      'A'..'Z', 'a'..'z': begin SetGrid(CurX, CurY, Command); advance; end;
      '%': CalculateClueCount;
      '~': InitializeGrid;
      '!': LoadWork;
      '@': ;
      else InvalidCommand;
    end;
  end;

procedure SaveWork;
var i,j: integer;
    fp: TEXT;
  begin
    Assign(fp, 'xword.sav');
    Rewrite(fp);
    for j:=1 to 15 do begin
      for i:=1 to 15 do begin
        case Grid[i][j] of
          ' ': Write(fp, '.');
          '.': Write(fp, '+');
          else Write(fp, Grid[i][j]);
        end;
      end;
      Writeln(fp);
    end;
    Close(fp);
  end;

procedure LoadWork;
var i,j: integer;
    fp: TEXT;
  begin
    Assign(fp, 'xword.sav');
    Reset(fp);
    for j:=1 to 15 do begin
      for i:=1 to 15 do begin
        Read(fp, Grid[i][j]);
        case Grid[i][j] of
          '.': Grid[i][j] := ' ';
          '+': Grid[i][j] := '.';
        end;
      end;
      Readln(fp);
    end;
    Close(fp);
  end;

begin {main}
  InitializeGrid;
  GraphColorMode;
  REPEAT
    ShowGrid;
    ActOnCommand;
  UNTIL (Command = '@');
  TextMode;
  SaveWork;
end.