Program SLIDER;

{ Spielprogramm SLIDER Version 2.2       (c) ML-Soft }
{ -------------------------------------------------- }
{ Endadresse COM-File: A000H                         }
{ V2.0: 21.07.1991 erweitertes Menue                 }
{ V2.1: 21.07.1996 Zugriff auf RTC-Uhr               }
{ V2.2: 31.10.1998 MicroDOS+ZSDOS, Anzeige Zeitlimit }

{ V2.2J:24.09.2004 Adaption fuer JOYCE (CP/M 3.x)    }

type
  LStrg        = string[255];
  BStrg        = string[  3];
const
  NULL         = #0;
  BREAK        = #3;
  ESC          = #27;
  GAME         = 'G';
  CRLF         = ^M^J;
  { ========================== }
  { Cursor       JOYCE      KC }
  { ========================== }
  RECHTS       = ^F;        {#4}
  LINKS        = ^A;        {#8}
  HOCH         = ^_;        {#5}
  RUNTER       = ^^;       {#24}
  { ========================== }
  { Cursor       JOYCE      KC }
  { ========================== }
  CursOn       = #27'e';   {#82}
  CursOff      = #27'f';   {#83}
  ClearScreen  = #0;        {^L}
  Screen40x80  = #0;    {#27'P'}

  Version      = 'Version 2.2J (c) ML-Soft 31.10.1998';

  FREI         = ' ';
  KISTE        = 'O';
  KISTE1       = 'o';
  STELLPLATZ   = '*';
  MAUER        = '#';
  MANNSTEIN    = 'M';
  MARKSTEIN    = 'X';

  MSB          = $80;        {Hoechstes Bit}

  MaxLevel     = 28;
  Leer         = '                                          ';
var
  Auswahl      : char;
  Move,
  Markierung,
  Level,
  Maenner,
  Push,
  AnzahlKisten,
  ZeitLimit,
  MannY,MannX,
  LaufZeit,
  Minuten,
  Sekunden,
  Stunden      : integer;
  BildNr       : BStrg;
  Zeile1,
  Zeile2       : string[79];
  Bild         : array[1..14,1..40] of integer;
  Feld         : array[1..14] of string[40];

{$C-,U-}
{$I INKEY.MOD}

procedure KBDread;
Begin
  repeat
    Inkey;
  until (Auswahl<>NULL);
End;

{$I TIMER.MOD}

procedure TextAusgabe(x,y,del:integer;msg:LStrg);
begin
  gotoXY(x,y);
  write(msg);
  if (del<>0) then delay(del);
end;

procedure Feldlesen(Kisten,x,y,Limit:integer;Nummer:BStrg);
var
  i,j,
  Laenge       : integer;
  FeldChar     : char;
Begin
  AnzahlKisten:=Kisten;
  MannY:=y;
  MannX:=x;
  ZeitLimit:=Limit;
  BildNr:=Nummer;
  gotoXY(4,4);
  write('Level: ',Level:2,'     Bild: ',BildNr,' Mann: ',Maenner:2);
  gotoXY(4,26);
  write('Moves :           Zeit :');
  gotoXY(4,28);
  write('Pushes:          Grenze:  ',ZeitLimit DIV 60:2,':');
  if ((ZeitLimit mod 60)>9) then write(ZeitLimit mod 60:2)
                            else write('0',ZeitLimit mod 60);
  gotoXY(0,8);
  Markierung:=ord(FREI);
  Move:=0;
  Push:=0;
  for i:=1 to 14 do
    if Feld[i]<>'' then
    begin
      write('          ');
      Laenge:=length(Feld[i]);
      for j:=1 to Laenge do
      begin
        FeldChar:=Feld[i][j];
        if (FeldChar=KISTE1) then
        begin
          AnzahlKisten:=pred(AnzahlKisten);
          Bild[i,j]:=ord(KISTE)+MSB;               { KISTE MARKIEREN }
          write(KISTE);
        end else
        begin
          Bild[i,j]:=ord(FeldChar);
          write(FeldChar);
        end;
      end;
    write(CRLF);
    end else write(CRLF);
  LaufZeit:=-1;
  timer;
End;

procedure Mann(Stein,MoveX,MoveY:integer);
var
  Anzeige      : integer;
Begin
  Bild[MannY+MoveY,MannX+MoveX]:=ord(MANNSTEIN);
  if (Markierung<>ord(STELLPLATZ)) then Markierung:=ord(FREI);
  Bild[MannY,MannX]:=Markierung;
  Markierung:=Stein;
  gotoXY(MannX+10,MannY+7);             { AUF BILDSCHIRM }
  write(chr(Bild[MannY,MannX]));
  gotoXY(MannX+MoveX+10,MannY+MoveY+7);
  write(MARKSTEIN);
  Anzeige:=Bild[MannY+2*MoveY,MannX+2*MoveX];
  if (Anzeige>MSB) then Anzeige:=Anzeige-MSB;
  gotoXY(MannX+2*MoveX+10,MannY+2*MoveY+7);
  write(chr(Anzeige));
  MannY:=MannY+MoveY;
  MannX:=MannX+MoveX;
End;

procedure Bewegung(MoveX,MoveY:integer);
var
  AktuellerStein,
  NachbarStein,
  SteinKopie   : integer;
Begin
  AktuellerStein:=Bild[MannY+MoveY,MannX+MoveX];
  NachbarStein:=Bild[MannY+2*MoveY,MannX+2*MoveX];
  if (AktuellerStein<>ord(MAUER)) then
  begin
    if ((AktuellerStein=ord(FREI)) or (AktuellerStein=ord(STELLPLATZ))) then
    begin
      Move:=succ(Move);
      Mann(AktuellerStein,MoveX,MoveY);
    end else
      if ((NachbarStein=ord(FREI)) or (NachbarStein=ord(STELLPLATZ))) then
      begin
        SteinKopie:=AktuellerStein;
        Push:=succ(Push);
        if ((AktuellerStein=ord(KISTE)) or
            (AktuellerStein=ord(KISTE1))) then Bild[MannY+MoveY,MannX+MoveX]:=ord(FREI)
        else
        begin
          AnzahlKisten:=succ(AnzahlKisten);
          SteinKopie:=AktuellerStein-MSB;
          AktuellerStein:=ord(STELLPLATZ);
          Bild[MannY+MoveY,MannX+MoveX]:=ord(STELLPLATZ);
        end;
        if (NachbarStein=ord(STELLPLATZ)) then
        begin                                             { TONNE VERSCHIEBEN }
          Bild[MannY+2*MoveY,MannX+2*MoveX]:=SteinKopie+MSB;
          AnzahlKisten:=pred(AnzahlKisten);
        end;
        if (NachbarStein=ord(FREI)) then Bild[MannY+2*MoveY,MannX+2*MoveX]:=SteinKopie;
        Mann(AktuellerStein,MoveX,MoveY);
      end;
  end;
End;

procedure Tastatur;
var
  MoveX,MoveY  : integer;
Begin
  repeat
    gotoXY(12,26);
    writeln(Move:3);
    gotoXY(12,28);
    writeln(Push:3);
    MoveX:=0;
    MoveY:=0;
    repeat
      Inkey;
      timer;
      gotoXY(30,26);
      write(Minuten:2,':');
      if (Sekunden>9) then write(Sekunden:2)
                      else write('0',Sekunden:1);
    until (Auswahl<>NULL) or (LaufZeit>=ZeitLimit);
    case Auswahl of
      BREAK  : Auswahl:=ESC;
      RECHTS : MoveX:=+1;
      HOCH   : MoveY:=-1;
      LINKS  : MoveX:=-1;
      RUNTER : MoveY:=+1;
    end;
    Bewegung(MoveX,MoveY);
  until ((Auswahl=GAME) or (Auswahl=ESC) or (AnzahlKisten=0) or (LaufZeit>=ZeitLimit));
  if (LaufZeit>=ZeitLimit) then write(^G,^G);
  if ((AnzahlKisten=0) or (LaufZeit>=ZeitLimit)) then delay(3000);
  if (Auswahl=ESC) then
  begin
    Maenner:=0;
    Level:=MaxLevel+2;
  end;
  if ((Auswahl=GAME) or (LaufZeit>=ZeitLimit)) then
  begin
    Maenner:=pred(Maenner);
    ClrScr {write(ClearScreen)};
    if (Auswahl=GAME) then TextAusgabe(3,15,4000,'D U   H A S T   A B G E B R O C H E N   !!!')
                      else TextAusgabe(3,15,4000,' D I E   Z E I T   I S T     U M  !');
    case Maenner of
      0 : begin
            TextAusgabe(5,18,5000,'D A S   S P I E L   I S T   V O R B E I');
            Level:=MaxLevel+2;
          end;
      1 :   TextAusgabe(6,18,5000,'D E I N   L E T Z T E R   M A N N   !');
    end;
  end;
  if (AnzahlKisten=0) then Level:=succ(Level);
  ClrScr {write(ClearScreen)};
End;

{ GAME DEFINITION }

{$I SLIDER-0.PIC}
{$I SLIDER-1.PIC}
{$I SLIDER-2.PIC}

procedure Spielen;
Begin
  {write(ESC,'P');}                   {Schirm 40/80}
  write(CursOff);
  ClrScr;
  repeat
    case Level of
       1 : Eins;
       2 : Zwei;
       3 : Drei;
       4 : Vier;
       5 : Fuenf;
       6 : Sechs;
       7 : Sieben;
       8 : Acht;
       9 : Neun;
      10 : Zehn;
      11 : Elf;
      12 : Zwoelf;
      13 : Dreizehn;
      14 : Vierzehn;
      15 : Fuenfzehn;
      16 : Sechzehn;
      17 : Siebzehn;
      18 : Achtzehn;
      19 : Neunzehn;
      20 : Zwanzig;
      21 : Einundzwanzig;
      22 : Zweiundzwanzig;
      23 : Dreiundzwanzig;
      24 : Vierundzwanzig;
      25 : Fuenfundzwanzig;
      26 : Sechsundzwanzig;
      27 : Siebenundzwanzig;
      28 : Achtundzwanzig;
    end;
  until (Level>MaxLevel);
  {write(ESC,'P');}                   {Schirm 40/80}
End;

Procedure RahmenAufbau;
var
  i            : integer;
Begin
  Zeile1:='X';
  for i:=1 to 79 do Zeile1:=Zeile1+'X';
  Zeile2:='XX';
  for i:=1 to 75 do Zeile2:=Zeile2+' ';
  Zeile2:=Zeile2+'XX';
End;

Procedure Kopfausgeben;
var
  i            : integer;
Begin
  ClrScr;
  writeln(Zeile1);
  writeln(Zeile1);
  for i:=1 to 19 do writeln(Zeile2);
  writeln(Zeile1);
  writeln(Zeile1);
  gotoXY(1,4);
  writeln('XX      SSSS        L          IIIII       DDDD        EEEEE       RRRR');
  writeln('XX     S            L            I         D   D       E           R   R');
  writeln('XX     S            L            I         D   D       E           R   R');
  writeln('XX      SSSS        L            I         D   D       EEEE        RRRR');
  writeln('XX          S       L            I         D   D       E           R R');
  writeln('XX          S       L            I         D   D       E           R  R');
  writeln('XX      SSSS        LLLLL      IIIII       DDDD        EEEEE       R   R');
  gotoXY(41,12);
  writeln(Version);
End;

Procedure Hinweis;
var
  LevDisp      : string[2];
Begin
  str(MaxLevel,LevDisp);
  TextAusgabe(22,14,0,'( I )    -    I N S T R U K T I O N E N  ');
  TextAusgabe(22,16,0,'( L )    -    L E V E L   ( 1 ... '+LevDisp+' )');
  TextAusgabe(22,18,0,'( G )    -    N E U E S   S P I E L');
  TextAusgabe(22,20,0,'( E )    -    E N D E  D E S   S P I E L S');
End;

Procedure Instruktionen;
var
  LevDisp      : string[2];
Begin
  str(MaxLevel,LevDisp);
  TextAusgabe(22,20,0,Leer);
  TextAusgabe(22,18,0,Leer);
  TextAusgabe(22,16,0,Leer);
  LowVideo;
  TextAusgabe(22,17,4000,^G+'  SLIDER ist ein Spiel f}r jedermann    ');
  TextAusgabe(22,17,4000,^G+' Der seine Intelligenz beweisen will.   ');
  TextAusgabe(22,17,4000,^G+'       Du musst auf den markierten      ');
  TextAusgabe(22,17,4000,^G+'        Feldern F{sser schieben         ');
  TextAusgabe(22,17,4000,^G+'       in '+LevDisp+' verschiedenen Ebenen       ');
  TextAusgabe(22,17,4000,^G+'   und die Zeit arbeitet gegen dich !   ');
  TextAusgabe(22,17,4000,^G+'Gebrauche die Cursor-Tasten zum Spielen.');
  TextAusgabe(22,17,4000,^G+'        Bet{tige >G< zum Aufgeben.      ');
  TextAusgabe(22,17,4000,^G+'     Bet{tige BRK oder ESC zum Abbruch. ');
  NormVideo;
  TextAusgabe(22,17,0,Leer);
  LowVideo;
  TextAusgabe(22,14,2000,^G+^G+^G+'       V I E L    G L ] C K    !        ');
  NormVideo;
  TextAusgabe(42,19,0,'Weiter mit beliebiger Taste!');
  KBDread;
  TextAusgabe(34,19,0,Leer);
End;

Procedure LevelSetzen;
var
  Fehler       : integer;
  ZeichLev     : string[2];
begin
  gotoXY(22,14);
  write(Leer);
  gotoXY(22,18);
  write(Leer);
  repeat
    TextAusgabe(59,20,0,'        ');
    TextAusgabe(22,20,0,'B I T T E   L E V E L   E I N G E B E N : ');
    write(CursOn);
    readln(ZeichLev);
    write(CursOff);
    val(ZeichLev,Level,Fehler);
  until ((Fehler=0) and (Level>0) and (Level<=MaxLevel));
  Maenner:=1;
  Spielen;
End;

Procedure ZumSpielen;
begin
  Level:=1;
  Maenner:=7;
  Spielen;
End;

BEGIN              { HAUPTPROGRAMM }
  write(CursOff);
  RahmenAufbau;
  Kopfausgeben;
  repeat
    Hinweis;
    KBDread;
    case Auswahl of
      'I' : Instruktionen;
      'L' : LevelSetzen;
      'G' : ZumSpielen;
    end;
    if (Auswahl in ['G','L']) then Kopfausgeben;
  until (Auswahl='E');
  write(CursOn);
  ClrScr;
END.