迷宮脱出プログラム：ＰＡＳＣＡＬ編

program BreakOutMaze;

プログラムで使用する様々な定数

• 定数とはプログラムの中で使う様々な変化しない値を、分かりやすい文字や単語で表現するためのものです。
  

const
  {方向を分かりやすく表示するための定数}
  NORTH=0;
  EAST=90;
  SOUTH=180;
  WEST=270;

  {その方向に行くときPositionにどんな値を足せばいいかを分かりやすく
  表示するための定数}
  D_NORTH=-15;
  D_EAST=1;
  D_SOUTH=15;
  D_WEST=-1;

  {迷路の升目が道である場合どんな値が入っているかを分かりやすく表示
  するための定数}
  PATH=0;

  {スタート地点と出口を分かりやすく表示するための定数}
  EXIT_POSITION=13;
  START_POSITION=196;

プログラム全体で使用する変数

var 
  Maze:array[1..15*15] of byte;  {迷路を配列を使って表しています}
  Position:Word;                 {現在位置を示す変数}
  Direction:Word;                {現在の向きを示す変数}

周囲の道の数を数える関数

function RootCount(Position:Word):byte;
var Count:byte;
begin
  Count:=0;
  if Maze[Position+D_NORTH]=PATH then Count:=Count+1;
  if Maze[Position+D_EAST] =PATH then Count:=Count+1;
  if Maze[Position+D_SOUTH]=PATH then Count:=Count+1;
  if Maze[Position+D_WEST] =PATH then Count:=Count+1;
  Result:=Count;
end;

Directionの方向に隣接した位置を求める関数

function NextCell(Position:Word;Direction:Word):Word;
begin
  case Direction of
    NORTH :Result:=Position+D_NORTH;
    EAST  :Result:=Position+D_EAST;
    SOUTH :Result:=Position+D_SOUTH;
    else   Result:=Position-D_WEST;
  end;
end;

後ろ側の方向を求める関数

function DirectBack(Direction:Word):Word;
begin
  Result:=Direction+180;
  if Result>360 then Result:=Result-360;
end;

左側の方向を求める関数

function DirectLeft(Direction:Word):Word;
begin
  Result:=Direction+270;
  if Result>360 then Result:=Result-360;
end;

道なりの方向を得る関数

function AlongWay(Position:Word;Direction:byte):Word;
var Bk:Word;
begin
  Bk:=DirectBack(Direction);
  if (Maze[NextCell(Position,NORTH)]=PATH) and (Bk<>NORTH) then
    Result:=NORTH
  else if (Maze[NextCell(Position,NORTH)]=PATH) and (Bk<>EAST) then
    Result:=EAST
  else if (Maze[NextCell(Position,SOUTH)]=PATH) and (Bk<>SOUTH) then
    Result:=SOUTH
  else
    Result:=WEST;
end;

※<>というのは等しくないことを表します。

プログラムの本体

begin
  {最初の位置と向きを設定する}
  Position:=START_POSITION;
  Direction:=EAST;

  {現在位置が出口でない場合、以下を繰り返す}
  while (Position<>EXIT_POSITION) do begin
    {道の数を数えて}
    case RootCount(Position) of
      {数えた結果が１カ所だった場合（＝行き止まり）}
      1:begin
        Direction:=DirectBack(Direction);
        Position:=NextCell(Position,Direction);
      end;
      {数えた結果が２カ所だった場合（＝普通の道）}
      2:begin
        Direction:=AlongWay(Position,Direction);
        Position:=NextCell(Position,Direction);
      end;
      {数えた結果がそれ以外だった場合（＝分かれ道）}
      else begin
        if Maze[NextCell(Position,DirectLeft(Direction))]=PATH then
          Direction:=DirectLeft(Direction);
          Position:=NextCell(Position,Direction);
      end;
    end;
  end;
end.

何か長さはあまり変わらないけど・・・