(*********************************************************************
 *     スタートレック ゲーム (HAPPy Version 0.3添付版)               *
 *                                                                   *
 *        HAPPyのサンプルプログラム                                  *
 *           作者  このソースコードに関しては浅野比富美              *
 *                 ゲームの原作者は不明                              *
 *           このソースコード自体は  Public Domain Software です     *
 *********************************************************************)

(*
　あなたは宇宙船エンタープライズ号の船長です。
　５００日内に宇宙内に散在する宿敵クリンゴン２０隻を、各種コマンドを駆
　使して全滅させて下さい。
　エネルギーがなくなるか、期日が過ぎるとゲームオーバーで船長失格です。
　宇宙は、８×８の区画が、９×９並んで成り立っています。
　宇宙内を移動するには、ワープコマンド、移動コマンドを使います。
　クリンゴンを破壊するには、魚雷コマンド、攻撃コマンドを使います。また
  自らクリンゴンにぶつかっていっても破壊できます。
  宇宙内の様子を見るには、区図コマンド、全図コマンドを使います。
　コマンドの状態を見るには、状態コマンドを使います。
  コマンドは何回か使うと壊れてしまいます。壊れたコマンドは、何日か後に
  直りますが、修理コマンドで修理することもできます。
  エンタープライズ号と同一区画にいるクリンゴンは、攻撃してきます。
  エンタープライズ号のエネルギーと魚雷は、基地にドッキングすると補給で
  きます。

　ゲームの難易度は、全て定数定義部で定義しています。調節してください。
*)

program StarTrek(input,output) ;

  const
    LargeSize     =    9       ;  { 大宇宙のサイズ                     }
    SmallSize     =    8       ;  { 小宇宙(1区画)サイズ                }
    InitLimitDate =  500{日}   ;  { 残り日数                           }
    MaxTorpedo    =    3{個}   ;  { 最大魚雷数                         }
    InitEenergy   = 5000       ;  { エンタープライズ号エネルギー初期値 }
    MaxKrinEnergy =  500       ;  { 最大クリンゴンエネルギー           }
    InitKringon   =   20{隻}   ;  { クリンゴン数                       }
    MaxStar       =  150{個}   ;  { 星の数                             }
    MaxBase       =    3{個}   ;  { 基地の数                           }
    MaxKrinAtack  =   80{%}    ;  { クリンゴンの最大攻撃パワー率       }
    MinKrinAtack  =   30{%}    ;  { クリンゴンの最低攻撃パワー率       }
    KrinCollide   =    5{倍}   ;  { クリンゴン衝突時エネルギー喪失倍率 }
    StarCollide   = 1000       ;  { 星と衝突時のエネルギー喪失量       }
    WarpEnergy    =  400       ;  { ワープに必要なエネルギー           }
    WarpDate      =   10{日}   ;  { ワープに必要な期間                 }
    WarpHelth     =    5{回}   ;  { ﾜｰﾌﾟコマンドの最大使用可能回数     }
    WarpRepair    =   30{日}   ;  { ﾜｰﾌﾟコマンドの最大修理期間         }
    MoveEnergy    =   25       ;  { 1座標移動するのに必要なエネルギー  }
    MoveHelth     =    5{回}   ;  { 移動コマンドの最大使用可能回数     }
    MoveRepair    =   15{日}   ;  { 移動コマンドの最大修理期間         }
    PhotonHelth   =    2{回}   ;  { 魚雷コマンドの最大使用可能回数     }
    PhotonRepair  =   50{日}   ;  { 魚雷コマンドの最大修理期間         }
    PhaserHelth   =   10{回}   ;  { 攻撃コマンドの最大使用可能回数     }
    PhaserRepair  =   15{日}   ;  { 攻撃コマンドの最大修理期間         }
    SMapHelth     =   10{回}   ;  { 区図コマンドの最大使用可能回数     }
    SMapRepair    =   15{日}   ;  { 区図コマンドの最大修理期間         }
    GMapHelth     =   10{回}   ;  { 全図コマンドの最大使用可能回数     }
    GMapRepair    =   15{日}   ;  { 全図コマンドの最大修理期間         }

  type
    largeRange     = 1..LargeSize   ;         { 大宇宙の範囲     }
    smallRange     = 1..SmallSize   ;         { 小宇宙の範囲     }
    position       = record                   { 座標             }
                       plx,ply : largeRange ; { 大宇宙のx,y座標  }
                       psx,psy : smallRange   { 小宇宙のx,y座標  }
                     end ;
    kringonRange   = 1..InitKringon ;         { クリンゴンの範囲 }
    Kinf           = array[kringonRange] of   { クリンゴン情報   }
                       record
                         kpos    : position ; { 座標             }
                         kenergy : integer    { > 0 残りエネルギー
                                                <=0 破壊状態     }
                       end ;
    CommandKind    =                    { 装備しているコマンド   }
                   ( warpEngine    ,    { ワープエンジン         }
                     moveEngine    ,    { 移動エンジン           }
                     photonTorpedo ,    { 光子発射コマンド       }
                     phaserCannon  ,    { フェザー砲発射コマンド }
                     shortMap      ,    { 短距離地図             }
                     globalMap     ,    { 宇宙全体地図           }
            { 以下のコマンドは故障しない}
                     reportCommand ,    { コマンド状態報告       }
                     repairCommand  ) ; { コマンド修理           }
    NGcommandRange = warpEngine..globalMap;{ 故障するコマンド範囲}
    CInf           = array[CommandKind] of { コマンド情報        }
                       record
                         name   : packed array[1..4] of
                                     char ; { コマンド名       }
                         helth  : integer ; { 最大使用可能回数 }
                         repair : integer ; { 最大修理日数     }
                         status : integer   { >0 ･･･ 使用可能回数
                                              <0 ･･･ 修理日数  }
                       end ;
    smallSpace     = array[smallRange,smallRange] of
                       set of ( Star         ,    { 星                  }
                                Base         ,    { 基地                }
                                Kringon      ,    { クリンゴン          }
                                Enterprise ) ;    { エンタープライズ号  }
    string6        = packed array[1..6] of char ; { 全角3文字の文字列型 }

  var
    space         : array[largeRange,largeRange] of smallSpace ; { 宇宙 }
    map           : array[largeRange,largeRange] of integer    ; { 地図 }
                                  { >=0 クリンゴン数*100+基地数*10+星数 }
                                  { < 0 未探索                          }
    KringonNum    : integer ;     { クリンゴン数                        }
    KringonInf    : Kinf    ;     { クリンゴン情報                      }
    CommandInf    : CInf    ;     { コマンド情報                        }
    command       : CommandKind ;        { 入力コマンド                 }
    usableCommand : set of CommandKind ; { 使用可能コマンド             }
    Epos          : position;     { エンタープライズ号の座標            }
    Eenergy       : integer ;     { エンタープライズ号のエネルギー      }
    TorpedoNum    : integer ;     { 残り光子魚雷数                      }
    LimitDate     : integer ;     { 残り日数                            }
    oldDate       : integer ;     { コマンド前の残り日数                }
    normal        : packed array[1..4] of char ;{ｱﾄﾘﾋﾞｭｰﾄ解除のESC      }
    red,green,
    yellow,cyan   : packed array[1..5] of char ;{ 画面表示色のESC       }
    RD            : integer ;     { 乱数発生に使う                      }

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

(************************)
(*     初期設定処理     *)
(************************)
  procedure Init ;
    var lx,ly : largeRange   ;  { 座標          }
        sx,sy : smallRange   ;  { 座標          }
        i     : integer      ;  { for文制御変数 }
        k     : kringonRange ;  { for文制御変数 }

  (***********************************)
  (*  画面表示色ｴｽｹｰﾌﾟｼｰｹﾝｽ作成処理  *)
  (***********************************)
    procedure InitESC ;
    begin
      normal := ' [0m'  ; normal[1] := chr(27) ; { ｱﾄﾘﾋﾞｭｰﾄ解除 }
      red    := ' [31m' ; red   [1] := chr(27) ; { 赤 }
      green  := ' [32m' ; green [1] := chr(27) ; { 緑 }
      yellow := ' [33m' ; yellow[1] := chr(27) ; { 黄 }
      cyan   := ' [36m' ; cyan  [1] := chr(27)   { 水 }
    end {InitESC} ;

  (**************************)
  (* 乱数列の初期値入力処理 *)
  (**************************)
  (*  入力された数を1〜32767までの奇数に変換する *)
    procedure InitRand ;
    begin
      write('乱数の初期値を入れて下さい => ');
      read(RD) ;
      RD := abs(RD) mod 32768 ;
      if not odd(RD) then RD := RD + 1
    end {InitRand} ;

  (************************)
  (*   コマンド初期設定   *)
  (************************)
    procedure InitCommandInformation ;
      var c : NGcommandRange ;  { for文制御変数 }
    begin
      with CommandInf[warpEngine] do
        begin name:='ﾜｰﾌﾟ' ; helth:=WarpHelth   ; repair:=WarpRepair   end ;
      with CommandInf[moveEngine] do
        begin name:='移動' ; helth:=MoveHelth   ; repair:=MoveRepair   end ;
      with CommandInf[photonTorpedo] do
        begin name:='魚雷' ; helth:=PhotonHelth ; repair:=PhotonRepair end ;
      with CommandInf[phaserCannon] do
        begin name:='攻撃' ; helth:=PhaserHelth ; repair:=PhaserRepair end ;
      with CommandInf[shortMap] do
        begin name:='区図' ; helth:=SMapHelth   ; repair:=SMapRepair   end ;
      with CommandInf[globalMap] do
        begin name:='全図' ; helth:=GMapHelth   ; repair:=GMapRepair   end ;
      with CommandInf[reportCommand] do
              name:='状態' ;{ 故障しないので helth, repair は 意味がない  }
      with CommandInf[repairCommand] do
              name:='修理' ;{ 故障しないので helth, repair は 意味がない  }

      for c:=warpEngine to globalMap do                { 使用可能回数設定 }
        with CommandInf[c] do status := Rand(helth)+1 ;
      usableCommand := [warpEngine..reportCommand]     { コマンド使用可能 }
    end {InitCommand} ;

  (************************)
  (*   乱数座標決定処理   *)
  (************************)
  procedure RandomPosition(var lx,ly:largeRange; var sx,sy:smallRange) ;
  begin
    lx := Rand(LargeSize) + 1 ;
    ly := Rand(LargeSize) + 1 ;
    sx := Rand(SmallSize) + 1 ;
    sy := Rand(SmallSize) + 1
  end {RandomPosition} ;

  begin {Init}
    InitESC  ;                          { 表示色のｴｽｹｰﾌﾟｼｰｹﾝｽ作成     }
    InitRand ;                          { 乱数列の初期値入力          }

    writeln('しばらくお待ち下さい') ;   { やや時間がかかるので言い訳  }

    (* 宇宙の初期設定 *)
    for lx:=1 to LargeSize do
      for ly:=1 to LargeSize do
      begin
        map[lx,ly] := -1 ;              { 全体を未探索とする }
        for sx:=1 to SmallSize do
          for sy:=1 to SmallSize do space[lx,ly][sx,sy] := []
      end ;

    (* 星を配置 *)
    for i:=1 to MaxStar do
    begin
      RandomPosition(lx,ly,sx,sy) ;
      space[lx,ly,sx,sy] := [Star]
    end ;

    (* 基地を配置 *)
    for i:=1 to MaxBase do
    begin
      repeat
        RandomPosition(lx,ly,sx,sy)
      until space[lx,ly][sx,sy] = [] ;     { 他と重ならないように }
      space[lx,ly][sx,sy] := [Base]
    end ;

    (* クリンゴン情報設定 *)
    for k:=1 to InitKringon do
      with KringonInf[k],kpos do
      begin
        repeat
          RandomPosition(plx,ply,psx,psy)
        until space[plx,ply][psx,psy] = [];{ 他と重ならないように }
        space[plx,ply][psx,psy] := [Kringon] ;
        kenergy := Rand(MaxKrinEnergy)+1   { エネルギー設定 }
      end ;

    (* エンタープライズ号の初期座標決定 *)
    with Epos do
    begin
      repeat
        RandomPosition(plx,ply,psx,psy)
      until space[plx,ply][psx,psy] = [] ; { 他と重ならないように }
      space[plx,ply][psx,psy] := [Enterprise]
    end ;

    InitCommandInformation      ;       { コマンド情報初期化       }
    Eenergy    := InitEenergy   ;       { ｴﾝﾀｰﾌﾟﾗｲｽﾞ号ｴﾈﾙｷﾞｰ初期化 }
    KringonNum := InitKringon   ;       { クリンゴン数初期化       }
    TorpedoNum := MaxTorpedo    ;       { 光子魚雷数初期化         }
    LimitDate  := InitLimitDate ;       { 残り時間初期設定         }
    oldDate    := LimitDate
  end {Init} ;

(************************)
(*   情報出力処理       *)
(************************)
  procedure PrintInformation ;
  begin
    writeln ;
    write('あと',LimitDate:3,'日',
          ' ｴﾈﾙｷﾞｰ:',Eenergy:4,' 光子魚雷数:',TorpedoNum:1) ;
    with Epos do
      write(' 位置[',plx:1,',',ply:1,'][',psx:1,',',psy:1,']') ;
    writeln(' ｸﾘﾝｺﾞﾝ数:',KringonNum:2)
  end {PrintInformation} ;

(************************)
(*   コマンド入力処理   *)
(************************)
  function InputCommand : CommandKind ;
    var command : integer     ;  { 入力コマンド番号 }
        c       : CommandKind ;  { コマンド種別     }
        ok      : Boolean     ;  { コマンドOKの時 真}
  begin {InputCommand}
    PrintInformation ;
    repeat
      write('コマンド(');
      for c:=warpEngine to repairCommand do { 使用可能コマンドは 普通の色 }
      begin                                 { 使用不能コマンドは 赤色     }
        if c in usableCommand then write(normal) else write(red) ;
        write(ord(c):2,':',CommandInf[c].name)
      end ;
      write(normal,') => ') ;
      read(command) ;
      ok := (ord(warpEngine) <= command) and (command <= ord(repairCommand)) ;
      if ok then
      begin
        c := warpEngine ;                   { 数字からコマンド種別を得る }
        while ord(c) <> command do c := succ(c) ;
        ok := c in usableCommand
      end
    until ok ;
    InputCommand := c
  end {InputCommand} ;

(*************************)
(*     進路計算処理      *)
(*************************)
(* 角度と距離から、到達地点を求める。到達地点が宇宙内の時 関数は真 *)
  function CalcStep
     (angle{角度}:integer; distance{距離}:integer ; pos{現在地}:position ;
      var lx,ly,sx,sy{到達地点の座標･･･出力}:integer) : Boolean ;
    const unit      = 1.745329e-2 ; {3.141593(円周率)/180.0=1度のラジアン値}
    var   Xpos,Ypos : integer     ; { 計算ワーク }
  begin
    with pos do
    begin
      Xpos := -round(distance * cos(unit*angle)) + plx*SmallSize + psx -1 ;
      Ypos :=  round(distance * sin(unit*angle)) + ply*SmallSize + psy -1
    end ;
    lx := Xpos div SmallSize     ;
    ly := Ypos div SmallSize     ;
    sx := Xpos mod SmallSize + 1 ;
    sy := Ypos mod SmallSize + 1 ;
    CalcStep := (lx in [1..LargeSize]) and (ly in [1..LargeSize]) and
                (sx in [1..SmallSize]) and (sy in [1..SmallSize])
  end {CalcStep} ;

(*************************)
(*     角度入力処理      *)
(*************************)
  function InputAngle(PutString : string6) : integer ;
    var angle : integer ; { 入力角度 }
  begin
    writeln('    0')    ;
    writeln('-90 ･ 90') ;
    writeln('   180')   ;
    repeat
      write(PutString,'角度 (-179〜180) => ') ;
      read(angle)
    until (-179<=angle) and (angle<=180) ;
    InputAngle := angle
  end {InputAngle} ;

(*************************)
(*  基地ドッキング処理   *)
(*************************)
  procedure Dock ;
  begin
    writeln(cyan,'宇宙基地にドッキング！',normal) ;
    Eenergy    := InitEenergy ;  { エネルギー補給 }
    TorpedoNum := MaxTorpedo     { 光子魚雷  補給 }
  end {Dock};

(********************)
(*    宇宙外処理    *)
(********************)
(*
   距離と方向が正しくない時の処理。ここでゲームオーバーにさせることもできるが
   間違えたくらいで終わるのはかわいそうなので、メッセージのみにしている。
*)
  procedure OutOfSpace ;
  begin
    writeln('その指定値では宇宙外に行ってしまう！')
  end {OutOfSpace};

(****************************)
(*  クリンゴン番号取得処理  *)
(****************************)
  function FindKringon(lx,ly,sx,sy : integer) : kringonRange ;
    var k     : kringonRange ; { クリンゴンの番号 }
        found : Boolean      ; { 見つかった時 真  }
  begin
    k := 1 ;
    repeat
      with KringonInf[k],kpos do
        found := (lx=plx) and (ly=ply) and (sx=psx) and (sy=psy) ;
      if not found then k := succ(k)
    until found ;
    FindKringon := k
  end {FindKringon} ;

(***********************)
(*  クリンゴン衝突処理 *)
(***********************)
  procedure CollideKringon(lx,ly,sx,sy : integer) ;
    var loss : integer ;  { 喪失エネルギー }
  begin
    with KringonInf[FindKringon(lx,ly,sx,sy)] do
    begin
      loss := kenergy * KrinCollide ;
      writeln(red,'ｸﾘﾝｺﾞﾝに衝突！ 破壊！ エネルギー',loss:4,'を失う',normal) ;
      Eenergy             := Eenergy - loss ;
      kenergy             := 0              ;
      KringonNum          := KringonNUm - 1 ;
      space[lx,ly][sx,sy] := space[lx,ly][sx,sy] - [Kringon] ;
      if map[lx,ly]<>-1 then map[lx,ly] := map[lx,ly] - 100
    end
  end {CollideKringon} ;

(********************)
(*    星衝突処理    *)
(********************)
  procedure CollideStar ;
  begin
    writeln(red,'星と衝突！　エネルギー',StarCollide:4,'を失う',normal) ;
    Eenergy := Eenergy - StarCollide
  end {CollideStar} ;

(***********************************)
(*  エンタープライズ号座標移動処理 *)
(***********************************)
  procedure MoveEnterprise(oldlx,oldly:largeRange;oldsx,oldsy:smallRange) ;
  begin
    with Epos do
    begin
      space[plx,ply][psx,psy] := space[plx,ply][psx,psy] - [Enterprise] ;
      plx := oldlx ;
      ply := oldly ;
      psx := oldsx ;
      psy := oldsy ;
      space[plx,ply][psx,psy] := space[plx,ply][psx,psy] + [Enterprise]
    end
  end {MoveEnterprise} ;

(*************************)
(*     ワープ処理        *)
(*************************)
  procedure Warp ;
    label 9 ;
    var distance    : integer ;  { ワープ距離       }
        angle       : integer ;  { 角度             }
        lx,ly,sx,sy : integer ;  { 座標             }
        MaxWarp     : integer ;  { 最大ワープ距離   }
        ok          : Boolean ;  { ワープ可能フラグ }
  begin
    if Eenergy < WarpEnergy then
    begin
      writeln('エネルギー不足で動けない') ;
      goto 9 {return}
    end ;

    MaxWarp := round(LargeSize*sqrt(2.0))-1 ; { 最大ワープ距離=対角線 }
    repeat
      repeat
        write('ワープ距離 (1〜',MaxWarp:1,') => ') ;
        read(distance)
      until (1<=distance) and (distance<=MaxWarp) ;
      angle := InputAngle('ワープ') ; { 1distanceでSmallSize分移動できる }
      ok := CalcStep(angle,distance*SmallSize,Epos,lx,ly,sx,sy) ;
      if not ok then OutOfSpace
    until ok ;

    LimitDate := LimitDate - WarpDate   ;
    Eenergy   := Eenergy   - WarpEnergy ;
    MoveEnterprise(lx,ly,sx,sy)         ;     { エンタープライズ移動 }

    (* ワープ終了地点にある物体に応じた処理をする *)
    if      Base    in space[lx,ly][sx,sy] then Dock
    else if Kringon in space[lx,ly][sx,sy] then CollideKringon(lx,ly,sx,sy)
    else if Star    in space[lx,ly][sx,sy] then CollideStar ;
9:
  end {Warp} ;

(*************************)
(*       移動処理        *)
(*************************)
  procedure Move ;
    label 5,9 ;
    var distance    : integer ;   { 移動距離       }
        angle       : integer ;   { 移動角度       }
        lx,ly,sx,sy : integer ;   { 座標           }
        step        : integer ;   { 移動の歩み     }
        MaxMove     : integer ;   { 最大移動距離   }
        ok          : Boolean ;   { 移動可能フラグ }
        dummyFlag   : Boolean ;   { ダミーフラグ   }
  begin
    MaxMove := round(LargeSize*SmallSize*sqrt(2.0))-1 ;{ 最大移動距離=対角線 }
    if Eenergy < MaxMove*MoveEnergy then
    begin
      MaxMove := Eenergy div MoveEnergy ;   { エネルギー分しか移動できない}
      if MaxMove = 0 then
      begin
        writeln('エネルギー不足で動けない') ;
        goto 9 {return}
      end
    end ;

    repeat
      repeat
        write('移動距離 (1〜',MaxMove:1,') => ') ;
        read(distance)
      until (1<=distance) and (distance<=MaxMove) ;
      angle := InputAngle('  移動') ;
      ok := CalcStep(angle,distance,Epos,lx,ly,sx,sy)  ;
      if not ok then OutOfSpace
    until ok ;

    for step := 1 to distance do   { 1座標ずつ進む }
    begin
      dummyFlag := CalcStep(angle,step,Epos,lx,ly,sx,sy)  ;
      if Star in space[lx,ly][sx,sy] then { 星と衝突 }
      begin
        CollideStar ;
        distance := step ;         { 星までの移動エネルギーを消費 }
        goto 5 {exit for loop}
      end
      else if (Base in space[lx,ly][sx,sy]) and (step <> distance) then
      begin                        { 経路途中で基地に衝突 }
        writeln(red,'基地と衝突！　基地破壊！',normal) ;
        if map[lx,ly]<>-1 then map[lx,ly] := map[lx,ly] - 10 ;
        space[lx,ly][sx,sy] := [] ;
        distance := step ;         { 基地までの移動エネルギーを消費 }
        goto 5 {exit for loop}
      end
      else if Kringon in space[lx,ly][sx,sy] then
      begin
        CollideKringon(lx,ly,sx,sy) ;
        distance := step ;
        goto 5 {exit for loop}
      end
    end ;
5 :
    MoveEnterprise(lx,ly,sx,sy) ;       { エンタープライズ 移動 }

    LimitDate := LimitDate - distance ;
    Eenergy   := Eenergy   - distance * MoveEnergy ;

    if Base in space[lx,ly][sx,sy] then Dock ; { 最終地が基地の場合ﾄﾞｯｷﾝｸﾞ }
9:
  end {Move} ;

(*************************)
(*     光子魚雷処理      *)
(*************************)
  procedure Photon ;
    label 5,9 ;
    var angle       : integer ;    { 発射角度              }
        step        : integer ;    { 光子魚雷の歩み        }
        lx,ly,sx,sy : integer ;    { 座標                  }
        noflag      : Boolean ;    { 光子魚雷が外れた時 真 }
  begin
    if TorpedoNum = 0 then
    begin
      writeln('光子魚雷は使い果たした') ;
      goto 9 {return}
    end ;

    angle := InputAngle('  発射') ;
    noflag := true ;
    for step:=1 to SmallSize do    { 光子魚雷の届く距離は、区画の一辺分 }
      if CalcStep(angle,step,Epos,lx,ly,sx,sy) then
      begin
        if Kringon in space[lx,ly][sx,sy] then
          with KringonInf[FindKringon(lx,ly,sx,sy)],kpos do
          begin
            writeln(yellow,'ｸﾘﾝｺﾞﾝ[',plx:2,',',ply:2,
              '][', psx:2,',',psy:2,']を破壊した！',normal) ;
            if map[lx,ly]<>-1 then map[lx,ly] := map[lx,ly] - 100 ;
            kenergy             := 0                ;
            KringonNum          := KringonNum - 1   ;
            space[lx,ly][sx,sy] := []               ;
            noflag              := false            ;
            goto 5 {exit for loop}
          end
        else if Base in space[lx,ly][sx,sy] then
        begin
          writeln(red,'光子魚雷は基地に命中！　基地破壊！',normal) ;
          if map[lx,ly]<>-1 then map[lx,ly] := map[lx,ly] - 10 ;
          space[lx,ly][sx,sy] := []              ;
          noflag              := false           ;
          goto 5 {exit for loop}
        end
        else if Star in space[lx,ly][sx,sy] then
        begin
          writeln('光子魚雷は星に命中！　星破壊！') ;
          if map[lx,ly]<>-1 then map[lx,ly] := map[lx,ly] - 1 ;
          space[lx,ly][sx,sy] := []             ;
          noflag              := false          ;
          goto 5 {exit for loop}
        end
      end
      else goto 5 ;  { 宇宙外に行ってしまった時はもう繰り返す必要なし }

5:
    if noflag then writeln('光子魚雷ははずれました。') ;

    LimitDate  := LimitDate  - 1 ;      { 光子魚雷は 1日費やす  }
    TorpedoNum := TorpedoNum - 1 ;
9:
  end {Photon} ;

(*************************)
(*  フェザー砲攻撃処理   *)
(*************************)
  procedure Phasers ;
    var power       : integer      ;    { 使用エネルギー }
        lx,ly,sx,sy : integer      ;    { 座標           }
        damage      : integer      ;    { 与えるダメージ }
        k           : kringonRange ;    { for文の制御変数}
  begin
    repeat
      write('攻撃エネルギー (1〜',Eenergy:1,') => ') ;
      read(power)
    until (1<=power) and (power<=Eenergy) ;

    for k:=1 to InitKringon do
      with KringonInf[k],kpos do
        if kenergy > 0 then        { 死んだクリンゴンは対象外  }
          if (Epos.plx=plx) and (Epos.ply=ply) then { 同一区画 }
          begin
            damage := round        { 攻撃力は距離に反比例する  }
              (power / sqrt(sqr(psx-Epos.psx)+sqr(psy-Epos.psy))) ;
            if damage <> 0 then    { ダメージを与えない時はメッセージ不要 }
            begin
              kenergy := kenergy - damage ;
              write('ｸﾘﾝｺﾞﾝ[',plx:2,',',ply:2,'][',
                psx:2,',',psy:2,']に',damage:4,'のダメージを与えた') ;
              if kenergy <= 0 then
              begin
                writeln(yellow,'  破壊した！',normal) ;
                if map[plx,ply]<>-1 then map[plx,ply]:=map[plx,ply]-100 ;
                space[plx,ply][psx,psy] := []         ;
                KringonNum              := KringonNum - 1
              end
              else writeln         { まだクリンゴンは死なない }
            end
          end ;

    LimitDate := LimitDate - 1 ;   { 1日費やす                      }
    Eenergy   := Eenergy   - power { 使った分だけエネルギーを減らす }
  end {Phasers};

(********************)
(*     区図処理     *)
(********************)
(* 短距離レーダーを使ってエンタープライズ号のいる区画の様子を表示する *)
  procedure DispShort ;
    var sx,sy  : smallRange ;  { for文制御変数 }
        sspace : smallSpace ;  { 1区画         }
  begin
    sspace := space[Epos.plx,Epos.ply] ;{ エンタープライズがいる区画 }
    write(' ':3) ;
    for sy := 1 to SmallSize do write(sy:2,' ') ; { 座標目盛り }
    writeln ;
    for sx := 1 to SmallSize do
    begin
      write(normal,sx:2,' ') ;                    { 座標目盛り }
      for sy := 1 to SmallSize do
        if      sspace[sx,sy]=[]                then write(normal,' ･ ')
        else if sspace[sx,sy]=[Star]            then write(yellow,' * ')
        else if sspace[sx,sy]=[Base]            then write(cyan  ,' B ')
        else if sspace[sx,sy]=[Kringon]         then write(red   ,' K ')
        else if sspace[sx,sy]=[Enterprise]      then write(green ,' E ')
        else if sspace[sx,sy]=[Base,Enterprise] then write(cyan,' B',green,'E')
        else if sspace[sx,sy]=[Star,Enterprise] then
                                                   write(yellow,' *',green,'E')
       {else ･･･ 他の組合せはない } ;
      writeln
    end
  end {DispShort} ;

(****************************)
(*   宇宙全体地図出力処理   *)
(****************************)
  procedure DispMap ;
    var lx,ly : integer    ;       { for文制御変数 }
        sx,sy : smallRange ;       { for文制御変数 }
        sspace: smallSpace ;       { 1区画         }
        n     : integer    ;       { 区画情報      }
  begin
    (* まず長距離レーダーで回りを探索 *)
    for lx := Epos.plx-1 to Epos.plx+1 do
      for ly := Epos.ply-1 to Epos.ply+1 do
        if (lx in [1..LargeSize]) and (ly in [1..LargeSize]) then
        begin
          sspace := space[lx,ly] ;  { 区画をコピーした方が速い }
          n      := 0            ;
          for sx := 1 to SmallSize do
            for sy := 1 to SmallSize do
            begin { 各区画にそれぞれが10個以上にならないという前提
                    の処理なので、あまり星の数を多くしてはいけない }
              if  Kringon in sspace[sx,sy] then n := n + 100 ;
              if  Base    in sspace[sx,sy] then n := n +  10 ;
              if  Star    in sspace[sx,sy] then n := n +   1
            end ;
          map[lx,ly] := n
        end ;

    (* 全体図を出力 *)
    write(' ':4) ;
    for ly := 1 to LargeSize do write(ly:2,' ':2) ; { 座標目盛り  }
    writeln ;
    for lx :=1 to LargeSize do
    begin
      write(normal,lx:2,' ':2) ;   { 座標目盛り }
      for ly := 1 to LargeSize do
      begin
        n := map[lx,ly] ;
        if n >= 0 then             { 探索済の区画 }
        begin
          if (Epos.plx=lx) and (Epos.ply=ly) then write(green)  { ｴﾝﾀｰﾌﾟﾗｲｽﾞ}
          else if n <  10                    then write(normal) { 星のみ    }
          else if n < 100                    then write(cyan)   { 基地あり  }
          else                                    write(red) ;  { ｸﾘﾝｺﾞﾝ存在}
          write((n div 100):1,(n mod 100 div 10):1,(n mod 100 mod 10):1,' ')
                                   { 3桁の数字は  ｸﾘﾝｺﾞﾝ 基地 星 の数を表す }
        end
        else write(normal,'･･･ ')  { 未探索の区画 }
      end ;
      writeln
    end
  end {DispMap};

(************************)
(* コマンド状態報告処理 *)
(************************)
  procedure Report ;
    var c : NGcommandRange ;  { for文制御変数 }
  begin
    for c:=warpEngine to globalMap do
      with CommandInf[c] do
      begin
        write(name,'コマンド : ') ;
        if status > 0 then writeln('使用可能回数',     status:2)
                      else writeln('修理完了まであと',-status:2,'日')
      end
  end {Report} ;

(**************************)
(*    コマンド修理処理    *)
(**************************)
  procedure Repair ;
    var date : integer ;  { 修理にかける日数 }
  begin
    repeat
      write('修理に何日かけますか(1〜',LimitDate:1,')  => ') ;
      read(date)
    until  (1<=date) and (date<=LimitDate) ;
    LimitDate := LimitDate - date
  end {Repair} ;

(*****************************)
(*    コマンドチェック処理   *)
(*****************************)
  procedure CheckCommand(command : CommandKind) ;
    var c    : NGcommandRange ;  { for文制御変数      }
        date : integer        ;  { 前回からの経過日数 }
  begin
    date    := oldDate - LimitDate ;
    oldDate := LimitDate           ;
    if command in [warpEngine..globalMap] then   { 故障するコマンド }
      with CommandInf[command] do status := status - 1 ;

    (* 各コマンドの状態変化メッセージを出力する *)
    for c:=warpEngine to globalMap do
      with CommandInf[c] do
        if status = 0 then      { 故障した時は 0になる    }
        begin
          usableCommand := usableCommand - [c] ; { コマンド使用不能 }
          write(red,name,'コマンド故障！　修理に') ;
          status := -(Rand(repair)+1) ;
          writeln(-status:2,'日必要',normal)
        end
        else if status < 0 then { 故障中は　負の値 }
        begin
          status := status + date ;
          if status >= 0 then   { 修理完了 }
          begin
            write(green,name,'コマンド修理完了 ') ;
            status := Rand(helth) + 1 ;
            writeln(status:2,'回使用可能',normal) ;
            usableCommand := usableCommand + [c] { コマンド使用可能 }
          end
        end ;

    (* 修理コマンドの受付可否を設定する *)
    if [warpEngine..globalMap] <= usableCommand then
      usableCommand := usableCommand - [repairCommand]  { 修理コマンド不可 }
    else
      usableCommand := usableCommand + [repairCommand]  { 修理コマンド可能 }
  end {CheckCommand} ;

(***************************)
(*    クリンゴン攻撃処理   *)
(***************************)
  procedure AtackKringon ;
    var k        : kringonRange ;  { for文制御変数 }
        usePower : integer      ;  { クリンゴンの攻撃パワー       }
        damage   : integer      ;  { エンタープライズに与える被害 }
  begin
    write(red) ;                   { ここでは赤のメッセージしか出さない }
    for k:=1 to InitKringon do
      with KringonInf[k],kpos do
        if kenergy > 0 then             { <=0 のクリンゴンは破壊されたもの  }
          if (Epos.plx=plx) and (Epos.ply=ply) then { 同一区画 }
          begin
            usePower := kenergy *
              (Rand(MaxKrinAtack-MinKrinAtack){%} + MinKrinAtack{%}) div 100 ;
            damage := round  { 攻撃力は距離に反比例する }
              (usePower / sqrt(sqr(Epos.psx-psx)+sqr(Epos.psy-psy))) ;
            if damage <> 0 then
            begin
              writeln('ｸﾘﾝｺﾞﾝ[',plx:2,',',ply:2,'][',
                psx:2,',',psy:2,']から',damage:4,'の攻撃を受けた');
              Eenergy := Eenergy - damage        {ｸﾘﾝｺﾞﾝ攻撃はｴﾝﾀｰﾌﾟﾗｲｽﾞに
                          ﾀﾞﾒｰｼﾞを与えるが自分のｴﾈﾙｷﾞｰを消費しないのが憎い }
            end
          end ;
    write(normal)  { 赤から元にアトリビュートを戻しておく }
  end {KringonAtack} ;

(*******************************)
(*  ゲームオーバーチェック処理 *)
(*******************************)
  function GameOver : Boolean ;         { ゲームオーバーの時 真 }
  begin
    if (KringonNum = 0) and (LimitDate >= 0) and (Eenergy >= 0) then
    begin
      PrintInformation ;
      writeln('クリンゴンを全滅できました。あなたは立派な船長です！') ;
      GameOver := true
    end
    else if LimitDate <= 0 then
    begin
      PrintInformation ;
      writeln('期日が来ました。船長失格です。') ;
      GameOver := true
    end
    else if Eenergy <= 0 then
    begin
      PrintInformation ;
      writeln('エネルギー切れ。船長失格です。') ;
      GameOver := true
    end
    else GameOver := false              { ゲームはまだ続く }
  end {GameOver} ;

(**********************)
(*     メイン処理     *)
(**********************)
begin {main}
  Init                          ;     { 初期設定          }
  repeat
    command := InputCommand     ;
    case command of
      warpEngine    : Warp      ;     { ワープ            }
      moveEngine    : Move      ;     { 移動              }
      photonTorpedo : Photon    ;     { 光子魚雷          }
      phaserCannon  : Phasers   ;     { フェザー砲攻撃    }
      shortMap      : DispShort ;     { 短距離レーダー区図}
      globalMap     : DispMap   ;     { 長距離レーダー全図}
      reportCommand : Report    ;     { コマンド状態報告  }
      repairCommand : Repair          { コマンド修理      }
    end                         ;
    CheckCommand(command)       ;     { コマンドチェック  }
    AtackKringon                      { クリンゴン攻撃    }
  until GameOver
end {main} .