🚀 go-pugleaf

Here's the Pascal (Turbo Pascal 6.0 for DOS) for the puzzle I posted earlier
under the title "Cute little puzzle."  Sorry it's not very portable.  I write
terrible, illegible code, and I didn't use a good language like C.  The reason
for this is that I just wanted to rattle something off really fast, and
debugging a C program can take me hours.  If it works at all.  For those with a
version of Pascal, the code should need only minor changes.  (textattr,
textcolor, and gotoxy routines.)  To those who wanted versions which would swap
fewer elements at a time, change the constant "swapregion."  To make a smaller
puzzle, choose smaller values for width and height.  (Both odd if swapregion is
odd, or even if swapregion is even.)

OH!  Space bar swaps, and the arrow keys move.  I'm not sure whether or not I
said that before.

For newcomers: this is a simple, elegant, and extremely difficult puzzle I
generalized from something I saw in a store.

uses crt;
const
  width = 23;
  height = 11;
  total = 2*width + 2*height - 4;
  swapregion = 11;
  tmargin = (28-2*height) div 2;
  lmargin = (83-3*width) div 2;
  rmargin = (84-3*width) div 2;
  offset = (width - swapregion) div 2;
type
  pieces = array[1..total] of 1..total;
var
  board : pieces;
  ch : char;
  f, g : text;
  i : 1..total;
procedure initialize(var p : pieces);
  var
    i : 1..total;
    j : 1..3;
  begin
    textattr := 0;
    clrscr;
    textbackground(1);
    for j := 1 to 3 do
      begin
        gotoxy(lmargin-1,tmargin+2-j);
        for i := 1 to width do
          write('   ');
        write(' ');
      end;
    for i := 1 to 2*height-5 do
      begin
        gotoxy(79-rmargin,tmargin+i+1);
        write('    ');
      end;
    for i := 1 to 2*height-5 do
      begin
        gotoxy(lmargin-1,tmargin+i+1);
        write('    ');
      end;
    for j := 1 to 3 do
      begin
        gotoxy(lmargin-1,tmargin+2*height-j);
        for i := 1 to width do
          write('   ');
        write(' ');
      end;
    textbackground(3);
    for j := 1 to 3 do
      begin
        gotoxy(40 - (3*swapregion) div 2, tmargin+2-j);
        for i := 1 to swapregion do
          write('   ');
        write(' ');
      end;
    textbackground(1);
    textcolor(11);
    for i := 1 to total do
      p[i] := i;
  end;
procedure display(var p : pieces);
  var
    i : integer;
  begin
    for i := 0 to width-1 do
      begin
        gotoxy(lmargin+3*i, tmargin);
        write(p[(i-offset+total) mod total + 1]:2);
      end;
    for i := 1 to height-2 do
      begin
        gotoxy(80-rmargin, tmargin + 2*i);
        write(p[(i+offset+swapregion) mod total]:2);
      end;
    for i := 1 to height-2 do
      begin
        gotoxy(lmargin, tmargin + 2*i);
        write(p[(total-offset-i+1) mod total]:2);
      end;
    for i := 0 to width-1 do
      begin
        gotoxy(lmargin+3*i, tmargin+2*(height-1));
        write(p[(total-offset-height-i) mod total + 2]:2);
      end;
    gotoxy(1,1);
  end;
procedure shiftleft(var p : pieces);
  var
    i, temp : 1..total;
  begin
    temp := p[1];
    for i := 1 to total-1 do
      p[i] := p[i+1];
    p[total] := temp;
  end;
procedure shiftright(var p : pieces);
  var
    i, temp : 1..total;
  begin
    temp := p[total];
    for i := total downto 2 do
      p[i] := p[i-1];
    p[1] := temp;
  end;
procedure rotate(var p : pieces);
  var
    i, temp : 1..total;
  begin
    for i := 1 to swapregion div 2 do
      begin
        temp := p[i];
        p[i] := p[swapregion+1-i];
        p[swapregion+1-i] := temp;
      end;
  end;
procedure scramble(var p : pieces);
  var
    i : integer;
    j : 1..total;
  begin
    randomize;
    for i := 1 to 100 do
      begin
        for j := 1 to 1+random(total) do
          shiftleft(p);
        rotate(p);
      end;
  end;
begin
  initialize(board);
  {$I-}
  assign(f, 'puzzle.dat');
  reset(f);
  if ioresult = 0 then
    for i := 1 to total do
      readln(f, board[i])
  else
    scramble(board);
  {$I+}
  repeat
    display(board);
    ch := readkey;
    case ord(ch) of
      32: rotate(board);
      75: shiftleft(board);
      77: shiftright(board);
    end;
  until ord(ch) = 27;
  textattr := 7;
  clrscr;
  rewrite(f);
  for i := 1 to total do
    writeln(f, board[i]);
  close(f);
end.