program GEIST(input,output);
(*

Geisterjagd, BASIC-Quelle auf http://www.joyce.de/software/soft.htm

1.Versuch BASIC nach TURBO-PASCAL

*)

type
  str2         = string[  2];
  str3         = string[  3];
  str4         = string[  4];
  str6         = string[  6];
  str13        = string[ 13];
  str16        = string[ 16];
  str21        = string[ 21];
  str33        = string[ 33];
  str80        = string[ 80];
  str255       = string[255];
const
  nul          = #0;
  bell         = ^G;
  esc_dollar   = #$1b;
  text_dollar  : array[1..5] of str21 = ('   WEITERSPIELEN ?   ',  (* 1 *)
                                         '  EIN NEUES SPIEL ?  ',  (* 2 *)
                                         '        j / n        ',  (* 3 *)
                                         '  SCORE SPEICHERN ?  ',  (* 4 *)
                                         '                     '); (* 5 *)
  Geistername  = 'GEIST.SCR';
var
  x1_1400,
  x2_1400      : boolean;
  ein_dollar   : char;
  t1,                        (* WEG *)
  t2,                        (* WEG *)
  nn,
  zz1,
  zz2,
  zz3,
  zeit,
  score,
  exgz1,
  exgs1,
  exgz2,
  exgs2,
  exgz3,
  exgs3,
  goz1,
  gos1,
  goz2,
  gos2,
  gz1,
  gs1,
  gz2,
  gs2,
  gz3,
  gs3,
  uz,
  us,
  exhz,
  exhs,
  akz,
  aks,
  hz,
  hs,
  goldi,
  leben,
  objekt1,
  objekt2      : integer;
  tot          : integer;             (* boolean *)
  bi           : integer;             (* boolean *)
  cls_dollar,
  invan_dollar,
  invaus_dollar,
  szan_dollar,
  szaus_dollar,
  home_dollar,
  curan_dollar,
  curaus_dollar: str2;
  scran_dollar,
  scraus_dollar: str6;
  beep_dollar  : str13;
  co_dollar    : str16;
  t1_dollar,
  t2_dollar    : str33;
  namei_dollar : str80;
  t_dollar     : array[1..20] of str3;
  gold         : array[1..11] of integer;
  name_dollar  : array[1..11] of str80;
  FI1          : text;

{$IGEIST1.INC}
{$IGEIST2.INC}

procedure l_1630;
(* Eingabe des Spielernamens *)
var
  ins          : boolean;
  n            : integer;

  procedure l_1780;
  var
    exname_dollar: str80;
  begin
    exname_dollar:=namei_dollar;
    namei_dollar:=namei_dollar+ein_dollar;
    if length(namei_dollar)>20 then namei_dollar[0]:=chr(20);
    If namei_dollar=exname_dollar then ins:=false;
  end;

  procedure l_1750;
  begin
    ins:=true;

    if ((ein_dollar=#127)         and
        (length(namei_dollar)>0))
        then delete(namei_dollar,length(namei_dollar),1)
        else begin
               if (ein_dollar in [' ','-','.'])
                  then l_1780
(* 1770 *)
                  else if (upcase(ein_dollar) in ['A'..']']) then l_1780
                                                             else ins:=false;
             end;


(* 1800 *)
    if ins then write(FNc_dollar(18,35),UPPER_dollar(namei_dollar),
                      SPACE_dollar(20-length(namei_dollar)),
                      FNc_dollar(18,35+length(namei_dollar)));
  end;

Begin { l_1630 }
  writeln(FNclab_dollar(hz,hs),
          FNclab_dollar(gz1,gs1),
          FNclab_dollar(gz2,gs2),
          FNclab_dollar(gz3,gs3));
  writeln(FNcla_dollar(goz1,gos1),
          FNcla_dollar(goz2,gos2),
          FNclab_dollar(akz,aks),
          FNclab_dollar(uz,us));
  writeln(FNc_dollar(15,37),'IHR NAME BITTE ?');
  writeln(FNc_dollar(17,33),#150,STRING_dollar(22,#154),#156);
  writeln(FNc_dollar(18,33),#149,STRING_dollar(22, ' '),#149);
  writeln(FNc_dollar(19,33),#147,STRING_dollar(22,#154),#153);
  write  (FNc_dollar(18,35),curan_dollar);
  while INKEY_dollar<>nul do;
  repeat
    ein_dollar:=INKEY_dollar;
    case ein_dollar of
      #123 : ein_dollar:='[';
      #124 : ein_dollar:='\';
      #125 : ein_dollar:=']';
       #13 : ;
       else  l_1750;
    end;
  until ein_dollar=#13;
(* 1820 *)
  write(curaus_dollar,FNc_dollar(15,37),SPACE_dollar(16));
  for n:=17 to 19 do write(FNc_dollar(n,33),SPACE_dollar(24));
  if length(namei_dollar)<>0 then
     while namei_dollar[1]=' ' do delete(namei_dollar,1,1);
  namei_dollar:=UPPER_dollar(namei_dollar);
  if namei_dollar='' then namei_dollar:='RUMPELSTILZCHEN';
  n:=0;
  repeat
    n:=succ(n);
  until ((n=10) or (goldi>=gold[n]));  (* ---->>> Gleicher Name!!!!???? *)
  for nn:=10 downto 1 do
  begin
    name_dollar[succ(nn)]:=name_dollar[nn];
    gold[succ(nn)]:=gold[nn];
  end;
  name_dollar[n]:=namei_dollar;
  gold[n]:=goldi;
End;

procedure l_1400;

    procedure l_1550;
    begin
      writeln(cls_dollar,curan_dollar,szan_dollar,home_dollar);
      halt;                                                   (* UEBER BOOLEAN !! ?? *)
    end;

    procedure l_1520;
    (* Spielstand speichern *)
    var
      n        : integer;
    begin
      assign(FI1,geistername);
      rewrite(FI1);
      for n:=1 to 10 do writes(name_dollar[n],gold[n]);
      close(FI1);
      l_1550;
    end;

  procedure l_1450;
  var
    s          : integer;
  begin
    for s:=14 to 20 do writeln(FNc_dollar(s,32),SPACE_dollar(25));
    if goldi>=gold[10] then
    begin
      l_1630;
      l_1920;
    end;
    t1:=4;
    t2:=3;
    writeln(FNreq_dollar(14,32,21,t1,t2));
    while INKEY_dollar<>nul do;
    repeat
      ein_dollar:=INKEY_dollar;
      ein_dollar:=upcase(ein_dollar);
    until ein_dollar in ['J','N'];
    if ein_dollar='J' then l_1520
                      else l_1550;
  end;

  procedure l_1560;
  var
    s          : integer;
  begin
    for s:=14 to 20 do writeln(FNc_dollar(s,32),SPACE_dollar(25));
    if t1=2 then
    begin
      writeln(FNclab_dollar(hz,hs),
              FNclab_dollar(gz1,gs1),
              FNclab_dollar(gz2,gs2),
              FNclab_dollar(gz3,gs3));
      writeln(FNcla_dollar(goz1,gos1),
              FNcla_dollar(goz2,gos2),
              FNclab_dollar(akz,aks),
              FNclab_dollar(uz,us));
      if goldi>=gold[10] then l_1630;
      x2_1400:=false;                         (* x1_1400:=false; ??? *)
    end;
  end;

Begin { l_1400 }
  writeln(FNreq_dollar(14,32,21,t1,t2));
  while INKEY_dollar<>nul do ;
  repeat
    ein_dollar:=INKEY_dollar;
    ein_dollar:=upcase(ein_dollar);
  until ein_dollar in ['J','N'];
  if ein_dollar='J' then l_1560
                    else l_1450;
End;

procedure l_920;
Begin
  if ((hz=exhz) and (hs=exhs)) then writeln(FNha_dollar(hz,hs))
                               else writeln(FNhacl_dollar(exhz,exhs,hz,hs));
  if ((gz1=exgz1) and (gs1=exgs1)) then writeln(FNga_dollar(gz1,gs1))
                                   else writeln(FNgacl_dollar(exgz1,exgs1,gz1,gs1));
  if ((gz2=exgz2) and (gs2=exgs2)) then writeln(FNga_dollar(gz2,gs2))
                                   else writeln(FNgacl_dollar(exgz2,exgs2,gz2,gs2));
  if ((gz3=exgz3) and (gs3=exgs3)) then writeln(FNgb_dollar(gz3,gs3))
                                   else writeln(FNgbcl_dollar(exgz3,exgs3,gz3,gs3));
  if objekt1=1 then writeln(FNgoa_dollar(goz1,gos1))
               else writeln(FNaka_dollar(akz,aks));
  if objekt2=1 then writeln(FNgob_dollar(goz2,gos2))
               else writeln(FNua_dollar(uz,us));
End;

procedure l_990;
Begin
  if ((hz=exhz) and (hs=exhs)) then writeln(FNhb_dollar(hz,hs))
                               else writeln(FNhbcl_dollar(exhz,exhs,hz,hs));
  if ((gz1=exgz1) and (gs1=exgs1)) then writeln(FNgb_dollar(gz1,gs1))
                                   else writeln(FNgbcl_dollar(exgz1,exgs1,gz1,gs1));
  if ((gz2=exgz2) and (gs2=exgs2)) then writeln(FNgb_dollar(gz2,gs2))
                                   else writeln(FNgbcl_dollar(exgz2,exgs2,gz2,gs2));
  if ((gz3=exgz3) and (gs3=exgs3)) then writeln(FNga_dollar(gz3,gs3))
                                   else writeln(FNgacl_dollar(exgz3,exgs3,gz3,gs3));
  if objekt1=1 then writeln(FNgob_dollar(goz1,gos1))
               else writeln(FNakb_dollar(akz,aks));
  if objekt2=1 then writeln(FNgoa_dollar(goz2,gos2))
               else writeln(FNub_dollar(uz,us));
End;

procedure l_1220;
var
  n,
  nn           : integer;

  procedure l_1350;
  begin
    writeln(FNc_dollar(18,21),'SIE HABEN BIS JETZT SOVIELE M]NZEN EINGSAMMELT !');
    writeln(FNc_dollar(21,38),'BONUS: 3 LEBEN');
    leben:=leben+3;
    l_1060;
  end;

Begin { l_1220 }
  writeln(FNclab_dollar(hz,hs),
          FNclab_dollar(gz1,gs1),
          FNclab_dollar(gz2,gs2),
          FNclab_dollar(gz3,gs3));
  writeln(FNcla_dollar(goz1,gos1),
          FNcla_dollar(goz2,gos2),
          FNclab_dollar(akz,aks),
          FNclab_dollar(uz,us));
  for n:=1 to goldi do
  begin
    for nn:=1 to 10 do
    begin
      port[248]:=11;   (* Ton einschalten *)
      port[248]:=12;   (* Ton ausschalten *)
    end;
    writeln(FNgoa_dollar(FNrza,FNrs));
  end;
  case goldi of
     50 : begin
            writeln(FNc_dollar(14,13),'N I C H T  S C H L E C H T  F ] R  E I N E N  A N F [ N G E R  !');
            l_1350;
          end;
    100 : begin
            writeln(FNc_dollar(14,14),'H O C H A C H T U N G,  E I N E  R E I F E  L E I S T U N G  !');
            l_1350;
          end;
    150 : begin
            writeln(FNc_dollar(14,19),'T O L L,  W I E  M A C H E N  S I E  D A S  N U R  ?');
            l_1350;
          end;
    200 : begin
            writeln(FNc_dollar(14,17),'F A N T A S T I S C H,  N I C H T  Z U  G L A U B E N  !');
            l_1350;
          end;
    250 : begin
            writeln(FNc_dollar(14,21),'S U P E R,  K A U M  Z U  ] B E R B I E T E N  !');
            l_1350;
          end;
    else  begin
            writeln(FNc_dollar(13,31),'] B E R W [ L T I G E N D  !');
            writeln(FNc_dollar(16,31),'HIERMIT WIRD IHNEN DER TITEL');
            writeln(FNc_dollar(19,8),'* G * E * I * S * T * E * R * J * A * G * D * M * E * I * S * T * E * R *');
            writeln(FNc_dollar(22,40),'VERLIEHEN!');
          end;
  end;
(* 1370 *)
  while INKEY_dollar<>nul do ;
  while INKEY_dollar= nul do ;
  for n:=8 to 27 do writeln(FNc_dollar(n,5),SPACE_dollar(80));
  if goldi=300 then
               begin
                 t1:=2;
                 t2:=3;
                 l_1400;          (* Neues Spiel? *)
               end
               else x2_1400:=false;
End;

procedure l_600;
var
  n            : integer;
Begin
  if ((hs=gos1) and (hz<goz1+1) and (hz>goz1-2)) then
  begin
    for n:=1 to 10 do
    begin
      port[248]:=11;   (* Ton einschalten *)
      port[248]:=12;   (* Ton ausschalten *)
    end;
    writeln(FNcla_dollar(goz1,gos1));
    objekt1:=0;
    goldi:=goldi+1;
    l_1170;
    if goldi in [50,100,150,200,250,300] then l_1220;
  end;
End;

procedure l_650;
var
  nn,
  n            : integer;
Begin
  if ((hs=aks) and (hz<akz+2) and (hz>akz-2)) then 
  begin
    for n:=1 to 5 do
    begin
      port[248]:=11;   (* Ton einschalten *)
      for nn:=1 to 5 do;
      port[248]:=12;   (* Ton ausschalten *)
      for nn:=1 to 10 do;
    end;
    writeln(FNclab_dollar(akz,aks));
    objekt1:=0;
    leben:=leben+1;
    l_1060;
  end;
End;

procedure l_710;
var
  n            : integer;
Begin
  if ((hs=gos2) and (hz<goz2+1) and (hz>goz2-2)) then 
  begin
    for n:=1 to 10 do
    begin
      port[248]:=11;   (* Ton einschalten *)
      port[248]:=12;   (* Ton ausschalten *)
    end;
    writeln(FNclab_dollar(goz2,gos2));
    objekt2:=0;
    goldi:=goldi+1;
    l_1170;
    if goldi in [50,100,150,200,250,300] then l_1220;
  end;
End;

procedure l_760;
var
  nn,
  n            : integer;
Begin
  if ((hs=us) and (hz<uz+2) and (hz>uz-2)) then 
  begin
    for n:=1 to 20 do
    begin
      port[248]:=11;   (* Ton einschalten *)
      port[248]:=12;   (* Ton ausschalten *)
      for nn:=1 to 5 do;
    end;
    writeln(FNclab_dollar(uz,us));
    objekt2:=0;
    zeit:=FNr(30,50);
  end;
End;

procedure l_790;
Begin
  if ((gs1=hs) and (gz1<hz+2) and (gz1>hz-2)) then
  begin
    writeln(beep_dollar,FNclab_dollar(gz1,gs1));
    leben:=leben-1;
    repeat
      gz1:=FNrzab;
      gs1:=FNrs;
    until ((gs1<=hs-10) or (gs1>=hs+10));
    l_1060;
  end;
End;

procedure l_830;
Begin
  if ((gs2=hs) and (gz2<hz+2) and (gz2>hz-2)) then
  begin
    writeln(beep_dollar,FNclab_dollar(gz2,gs2));
    leben:=leben-1;
    repeat
      gz2:=FNrzab;
      gs2:=FNrs;
    until ((gs2<=hs-10) or (gs2>=hs+10));
    l_1060;
  end;
End;

procedure l_870;
Begin
  if ((gs3=hs) and (gz3<hz+2) and (gz3>hz-2)) then
  begin
    writeln(beep_dollar,FNclab_dollar(gz3,gs3));
    leben:=leben-1;
    repeat
      gz3:=FNrzab;
      gs3:=FNrs;
    until ((gs3<=hs-10) or (gs3>=hs+10));
    l_1060;
  end;
End;

procedure l_290;

  procedure l_390;
  begin
    nn:=nn+1;
    case nn of
      1 : zz1:=FNr(2,3);
      3 : zz2:=FNr(2,3);
    end;
    if nn>4 then
    begin
      zz3:=FNr(2,3);
      nn:=0;
    end;
(* 430 *)
    if FNr(1,zz1)<=1 then
    begin
      if gz1<>hz then
         if gz1<hz then gz1:=gz1+1
                   else gz1:=gz1-1;
      if gs1<>hs then
         if gs1<hs then gs1:=gs1+2
                   else gs1:=gs1-2;
    end;
(* 460 *)
    if FNr(1,zz2)<=1 then
    begin
      if gz2<>hz then
         if gz2<hz then gz2:=gz2+1
                   else gz2:=gz2-1;
      if gs2<>hs then
         if gs2<hs then gs2:=gs2+2
                   else gs2:=gs2-2;
    end;
(* 490 *)
    if FNr(1,zz3)<=1 then
    begin
      if gz3<>hz then
         if gz3<hz then gz3:=gz3+1
                   else gz3:=gz3-1;
      if gs3<>hs then
         if gs3<hs then gs3:=gs3+2
                   else gs3:=gs3-2;
    end;
  end;

  procedure l_320;
  begin
    exhz:=hz;
    exhs:=hs;
    exgz1:=gz1;
    exgs1:=gs1;
    exgz2:=gz2;
    exgs2:=gs2;
    exgz3:=gz3;
    exgs3:=gs3;
    case ein_dollar of
      #01 : begin                         (* <^A -  1> Cursor links *)
              hs:=hs-2;
              if hs<5 then hs:=hs+2;
            end;
      #06 : begin                         (* <^F -  6> Cursor rechts *)
              hs:=hs+2;
              if hs>83 then hs:=hs-2;
            end;
      #30 : begin                         (* <^^ - 30> Cursor nach unten *)
              hz:=hz+1;
              if hz>26 then hz:=hz-1;
            end;
      #31 : begin                         (* <^_ - 31>  Cursor nach oben *)
              hz:=hz-1;
              if hz<8 then hz:=hz+1;
            end;
    end;
    if zeit>0 then zeit:=zeit-1
              else l_390;
(* 520 *)
    if objekt1<=0 then
    begin
      if leben>2 then objekt1:=1
                 else objekt1:=FNr(1,2);
      if objekt1=1 then
                   begin
                     goz1:=FNrza;
                     gos1:=FNrs;
                   end else
                   begin
                     akz:=FNrzab;
                     aks:=FNrs;
                   end;
    end;
(* 550 *)
    if objekt2<=0 then
    begin
      if leben>2 then objekt2:=1
                 else objekt2:=FNr(1,2);
      if objekt2=1 then
                   begin
                     goz2:=FNrza;
                     gos2:=FNrs;
                   end else
                   begin
                     uz:=FNrzab;
                     us:=FNrs;
                   end;
    end;
(* 580 *)
    if bi=1 then begin
                   l_920;
                   bi:=0;
                  end
            else begin
                   l_990;
                   bi:=1;
                 end;
(* 590 *)
    case objekt1 of
      1 : l_600;
      2 : l_650;
    end;
(* 700 *)
    case objekt2 of
      1 : l_710;
      2 : l_760;
    end;
(* 790 *)
    l_790;
    l_830;
    l_870;
  end;

  procedure l_310;
  begin
    if tot=1 then
    begin
      t1:=2;
      t2:=3;
      l_1400;                               (* Neues Spiel? *)
      x2_1400:=false;
    end;
    if (x1_1400 and x2_1400) then l_320;
  end;

Begin { l_290 }
  ein_dollar:=INKEY_delay;
  if ein_dollar=^C then
  begin
    t1:=1;
    t2:=3;
    l_1400;                                 (* Weiterspielen? *)
  end;
  if (x1_1400 and x2_1400) then l_310;
End;

procedure l_2260;
(* Zeichensatz und Kontrollzeichen fuer den JOYCE aufsetzen *)
Begin
  cls_dollar:=esc_dollar+'E';
  invan_dollar:=esc_dollar+'p';
  invaus_dollar:=esc_dollar+'q';
  szan_dollar:=esc_dollar+'1';
  szaus_dollar:=esc_dollar+'0';
  home_dollar:=esc_dollar+'H';
  curan_dollar:=esc_dollar+'e';
  curaus_dollar:=esc_dollar+'f';
  scran_dollar:=esc_dollar+'c'+#0+esc_dollar+'b'+#63;
  scraus_dollar:=esc_dollar+'c'+#63+esc_dollar+'b'+#0;
  beep_dollar:=scran_dollar+bell+scraus_dollar;
  l_2430;
End;

BEGIN (* MAIN *)
  nn:=0;
  zz1:=0;
  zz2:=0;
  zz3:=0;
  bi:=0;
  l_50;
  l_90;
  l_2260;
  l_3390;
  x1_1400:=true;
  while x1_1400 do
  begin
  port[248]:=8;   (* Bildschirm ausschalten *)
  l_140;
    l_220;
    x2_1400:=true;
    while (x1_1400 and x2_1400) do l_290;
  end;
END.