{*********************************************************************
 *  *** 15 パズル ***                                                *
 *                                                                   *
 *        HAPPyのサンプルプログラム                                  *
 *          (作者  浅野比富美 Public Domain Software)                *
 *********************************************************************}

program FifteenPuzzle(input,output) ;
  const N       = 4   ;                         { 盤の1辺  5にしたら25パズル }
        MaxSwap = 500 ;                         { 最初の最大入替回数  }
  type  range = 1..N ;                          { 盤の範囲 }
        Direction = (up,left,right,down);       { 方向  上 左 右 下 }
  var   PossibleDirection : array[range,range]
                              of set of Direction ; { 移動可能な方向集合 }
        table     : array[range,range] of integer ; { 数字表 }
        RD        : integer ;                   { 乱数列の初期値 }
        spx,spy   : range   ;                   { 移動させる空白の座標 }
        SwapLevel : integer ;                   { 初期の数字入替え回数 }

{*********************************}
{* k未満の乱数を乗算合同法で発生 *}
{*********************************}
  function rand(k:integer) : integer ;
  begin
    RD := RD*259 mod 32768 ;
    rand := trunc((RD/32768.0)*k)
  end {rand} ;

{*********************************}
{* 入替え処理 : 入替えOKの時 真  *}
{*********************************}
  function Swap(MoveDirect : direction  ) : Boolean ;
    var newspx,newspy : range ;
        work          : integer ;
  begin
    if MoveDirect in PossibleDirection[spx,spy] then   { 入替え可能 }
    begin
      case MoveDirect of
        up    : begin newspx := spx-1 ; newspy := spy    end ;
        left  : begin newspx := spx   ; newspy := spy-1  end ;
        right : begin newspx := spx   ; newspy := spy+1  end ;
        down  : begin newspx := spx+1 ; newspy := spy    end
      end ;
      work                 := table[newspx,newspy] ;
      table[newspx,newspy] := table[spx,spy] ;
      table[spx,spy]       := work ;
      spx := newspx ; spy := newspy ;
      Swap := true
    end
    else Swap := false                  { 入替え不可能 }
  end {Swap} ;

{*********************************}
{*      数字の印字処理           *}
{*********************************}
  procedure Print ;
    var x,y : range ;
  begin
    for x:=1 to N do
    begin
      for y:=1 to N do
        if (x=spx) and (y=spy) then write(' '       :4)   { 移動する空白 }
                               else write(table[x,y]:4) ; { 普通の数字   }
      writeln
    end
  end {Print} ;

{*********************************}
{*          初期設定             *}
{*********************************}
  procedure Init ;
    var x,y      : range   ;
        ok       : Boolean ;
        SwapTime : integer ;            { 数字入替えのカウンター }
  begin
    repeat
      write('乱数の初期値を入れて下さい(0以外) ? ') ;
      readln(RD)
    until RD <> 0 ;

    repeat
      write('数字の入替え回数を入れて下さい(1〜',MaxSwap:3,') ? ') ;
      readln(SwapLevel)
    until (1<=SwapLevel) and (SwapLevel<=MaxSwap) ;

    for x:=1 to N do                    { 空白の移動可能方向表を作成する }
      for y:=1 to N do
      begin
        PossibleDirection[x,y] := [left,right,up,down] ;
        if x=1 then PossibleDirection[x,y]:=PossibleDirection[x,y]-[up   ] ;
        if x=N then PossibleDirection[x,y]:=PossibleDirection[x,y]-[down ] ;
        if y=1 then PossibleDirection[x,y]:=PossibleDirection[x,y]-[left ] ;
        if y=N then PossibleDirection[x,y]:=PossibleDirection[x,y]-[right]
      end ;

    for x:=1 to N do                    { 数字を入れる }
      for y:=1 to N do
        table[x,y] := (x-1)*N+y ;
    spx := N ; spy := N ;               { 空白の座標   }
    writeln('以下のようになるように空白を移動させて下さい') ;
    Print ;
    writeln('**** では スタート *****') ;

    {***** 入れ替えて最初の問題を作る ****}
    SwapTime := 0 ;
    repeat
      case rand(4)+1 of
        1 : ok := Swap(up)    ;
        2 : ok := Swap(left)  ;
        3 : ok := Swap(right) ;
        4 : ok := Swap(down)
      end ;
      if ok then SwapTime := SwapTime+1 { 入れ替えが出来たときだけｶｳﾝﾄｱｯﾌﾟ }
    until SwapTime = SwapLevel
  end {Init} ;

{**********************************}
{*     空白移動方向入力&入替え    *}
{**********************************}
  procedure InputDirection ;
    var ch : char ;
        ok : Boolean ;
  begin
    repeat
      write('空白の移動方向  [8(上)  4(左)  6(右)  2(下)] ? ') ;
      readln(ch)  ;
      ok := false ;
      if      ch='8' then ok := Swap(up)
      else if ch='4' then ok := Swap(left)
      else if ch='6' then ok := Swap(right)
      else if ch='2' then ok := Swap(down)
    until ok
  end {InputDirection} ;

{**********************************}
{*      完成判定処理              *}
{**********************************}
  function Complete : Boolean ;
    var x,y : range ;
  begin
    complete := true ;
    for x:=1 to N do                    { 番号順に並んでいるか調べる }
      for y:=1 to N do
        if table[x,y] <> (x-1)*N+y then complete := false
  end {complete} ;

{**********************************}
{*      メイン処理                *}
{**********************************}
begin
  Init             ;                    { 初期設定 }
  Print            ;                    { 最初の状態印字 }
  repeat
    InputDirection ;                    { 空白の移動方向入力 & 移動 }
    Print                               { 移動後の状態印字 }
  until Complete                        { 完成したら終わり }
end.