const
  NULL             = #0;
  ABBRUCH          = ^C;
  CR               = #$0d;

  LINKS            = #8;      { Cursorbewegungen intern }
  RECHTS           = #4;
  HOCH             = #5;
  RUNTER           = #24;
  GAME             = 'G';

  J_LINKS          = ^A;      { Cursorbewegungen JOYCE }
  J_RECHTS         = ^F;
  J_HOCH           = ^_ ;
  J_RUNTER         = ^^;

  BILDENDE        = '0';
  LEERFELD        = '@';
  MAUERFELD       = 'A';
  KISTENFELD      = 'B';
  KISTENLAGER     = 'C';
  SPIELERFELD     = 'D';
  HINDERNISFELD   = 'E';

  DEFDRV           = '@';      { Aktuelles Laufwerk fuer Spielfelder .PIC Dateien}

  PRGNAME          = 'SOKOBAN';

  PIC              = 2048;     { Laenge einer PIC Definitionsdatei }
  RecLen           = 128;      { Laenge eines CP/M Rekords}
type
  string40         = string[ 40];
  LSTR             = string[255];
  Stand            = (Neu,Aktuell);
  Pixel            = (An,Aus);
var
  AltX             : integer;
  AltY             : integer;
  NeuX             : integer;
  NeuY             : integer;
  AktuellesZeichen : char;
  VorigesZeichen   : char;
  DateiName        : string[14];
  PICDatei         : file;
  DateiGroesse     : byte;
  DateiNr          : byte;
  PICFeld          : array[0..PIC]      of char;     { PIC Feld }
  SpielFeld        : array[1..20,1..18] of char;
  FeldIndex        : integer;
  BildNr           : integer;
  FeldZeile        : byte;
  FeldSpalte       : byte;
  SpielSteine      : byte;
  Spalte           : byte;
  Zeile            : byte;
  DateiOk          : boolean;
  PICindex         : integer;
  SchubNr          : integer;                        { Push Zaehler }
  ZugNr            : integer;                        { Move Zaehler }
  Eingabe1         : byte;
  Eingabe2         : byte;
  Loeschen         : byte;

procedure BEENDEN(Meldung:LSTR);
{
  Gibt Text aus und beendet SOKOBAN
}
Begin
  CLRGRAF;
  writeln(PRGNAME,Meldung);
  ShowCursor;
  halt;
End;

procedure ZeichenLesen;
{
  Zeichen mittels BIOS-Aufruf lesen
  Cursorkontrollen vom JOYCE anpassen
}
Begin
  delay(90);
  if (bios(1)<>ord(NULL)) then AktuellesZeichen:=upcase(char(bios(2)))
                          else AktuellesZeichen:=NULL;
  if (AktuellesZeichen=ABBRUCH) then BEENDEN(' abgebrochen!');
{
  Mappen der JOYCE Cursor Kontrollzeichen
}
  case AktuellesZeichen of
    J_RECHTS : AktuellesZeichen:=RECHTS;
    J_LINKS  : AktuellesZeichen:=LINKS;
    J_RUNTER : AktuellesZeichen:=RUNTER;
    J_HOCH   : AktuellesZeichen:=HOCH;
  end;
End;

procedure AktuellesZeichenLesen;
{
  Aktuelles Zeichen mittels BIOS-Aufruf lesen
}
Begin
  repeat
    ZeichenLesen;
  until (AktuellesZeichen<>NULL);
End;

procedure Video(Modus:Pixel);
{
  Der JOYCE ist eine schwarz/weiss-Maschine
  Alle Farbangaben im Original sind deshalb entfernt,
  um den Code kuerzer zu machen

  Nur die Aufrufe, die einen Bildpunkt loeschen und anschliessend
  wieder setzen, sind - in geaenderter Form - vorhanden
}
Begin
  case Modus of
    An  : Loeschen:=0;
    Aus : Loeschen:=1;
  end;
End;

{ Das JOYCE Koordinatensystem ist im Vergleich zum KC85/4 an der Y-Achse gespiegelt }
{ --------------------------------------------------------------------------------- }

procedure Linie(x1,y1,x2,y2:integer);
{
  Beliebige Linie zeichnen von X-Anfang=x1
                               Y-Anfang=y1
                               X-Ende  =x2
                               Y-Ende  =y2
}
Begin
  line(x1,255-y1,x2,255-y2,Loeschen);
End;

procedure Kreis(x,y,r:integer);
{
  Kreis zeichen von x=x
                    y=y
                mit r=r
}
Begin
  circle(x,255-y,r,Loeschen);
End;

{ --------------------------------------------------------------------------------- }

procedure Rechteck(x1,x2,y1,y2:integer);
{
  Rechteck zeichen
      mit den Eckpunkten x1,y1 und x2,y2
}
Begin
  Linie(x1,y2,x2,y2);
  Linie(x2,y1,x2,y2);
  Linie(x1,y1,x2,y1);
  Linie(x1,y1,x1,y2);
End;

procedure Kiste(x,y:integer);
{
  Zeichen einer Kiste - Rechteck mit Diagonalen
}
Begin
  Rechteck(x+1, x+11,y+1, y+11);
  Linie   (x+1, y+1, x+11,y+11);
  Linie   (x+11,y+1, x+1, y+11);
End;

procedure Mauer(x,y:integer);
{
  Zeichnen einer Mauer - Rechteck mit vertikalen Linien
}
Begin
  Rechteck(x,   x+12,y,   y+12);
  Linie   (x,   y+4, x+12,y+4);
  Linie   (x,   y+8, x+12,y+8);
  Linie   (x+4, y,   x+4, y+4);
  Linie   (x+8, y,   x+8, y+4);
  Linie   (x+6, y+4, x+6, y+8);
  Linie   (x+4, y+8, x+4, y+12);
  Linie   (x+8, y+8, x+8, y+12);
End;

procedure SpielerLinks(x,y:integer);
{
  Zeichnen Spieler links
}
Begin
  Linie(x+10,y+6,x+3,y+10);
  Linie(x+10,y+6,x+3,y+2);
  Kreis(x+6, y+6,3);
End;

procedure SpielerRechts(x,y:integer);
{
  Zeichnen Spieler rechts
}
Begin
  Linie(x+2,y+6,x+10,y+10);
  Linie(x+2,y+6,x+10,y+2);
  Kreis(x+6,y+6,3);
End;

procedure SpielerHoch(x,y:integer);
{
  Zeichnen Spieler hoch
}
Begin
  Linie(x+6,y+2,x+3, y+10);
  Linie(x+6,y+2,x+10,y+10);
  Kreis(x+6,y+6,3);
End;

procedure SpielerRunter(x,y:integer);
{
  Zeichnen Spieler runter
}
Begin
  Linie(x+6,y+10,x+3, y+2);
  Linie(x+6,y+10,x+10,y+2);
  Kreis(x+6,y+6,3);
End;

procedure BewegeSpieler(xvon,yvon,xnach,ynach:integer);
{
  In Abhaengigkeit von der vorigen Eingabe Spieler bewegen

  Spieler mit Kopf und Armen
}
Begin
  Video(Aus);
  case VorigesZeichen of
    LINKS  : SpielerLinks (xvon,yvon);
    RECHTS : SpielerRechts(xvon,yvon);
    HOCH   : SpielerHoch  (xvon,yvon);
    RUNTER : SpielerRunter(xvon,yvon);
  end;
  Video(An);
  case AktuellesZeichen of
    LINKS  : SpielerLinks (xnach,ynach);
    RECHTS : SpielerRechts(xnach,ynach);
    HOCH   : SpielerHoch  (xnach,ynach);
    RUNTER : SpielerRunter(xnach,ynach);
  end;
  VorigesZeichen:=AktuellesZeichen;
End;

procedure KistenPlatz(x,y:integer);
{
  Platz fuer Kiste zeichen - Raute
}
Begin
  Linie(x+6, y+2, x+10,y+6);
  Linie(x+10,y+6, x+6, y+10);
  Linie(x+6, y+10,x+2, y+6);
  Linie(x+2, y+6, x+6, y+2);
End;

procedure TextAusgeben(x,y:integer; Meldung:string40);
{
  Cursor setzen und Text ausgeben

  Beim JOYCE mit Offset - links Grafik, rechts Text

  Grafikbereich ist (x/y)    0..319/0..255
     Entspricht Spalte/Zeile     40/32
}
Begin
  gotoxy(x+40,y);
  write(Meldung);
End;

procedure GrossesFenster;
{
  Grosse Fenster zeichen
}
Begin
  Rechteck(0,319,0,255);
End;

procedure Zeichen1(x,y:integer);
{
  Ausgabe "1"
}
Begin
  Linie(x+20,y-7,x+20,y-27);
  Linie(x+20,y-7,x+10,y-17);
End;

procedure Zeichen2(x,y:integer);
{
  Ausgabe "2"
}
Begin
  Linie(x+10,y-7, x+22,y-7);
  Linie(x+22,y-7, x+22,y-17);
  Linie(x+10,y-17,x+22,y-17);
  Linie(x+10,y-17,x+10,y-27);
  Linie(x+10,y-27,x+22,y-27);
End;

procedure Zeichen3(x,y:integer);
{
  Ausgabe "3"
}
Begin
  Linie(x+10,y-7, x+22,y-7);
  Linie(x+22,y-7, x+22,y-27);
  Linie(x+10,y-27,x+22,y-27);
  Linie(x+10,y-17,x+22,y-17);
End;

procedure Zeichen4(x,y:integer);
{
  Ausgabe "4"
}
Begin
  Linie(x+20,y-7, x+20,y-27);
  Linie(x+20,y-7, x+9, y-21);
  Linie(x+9, y-21,x+27,y-21);
End;

procedure Zeichen5(x,y:integer);
{
  Ausgabe "5"
}
Begin
  Linie(x+10,y-7, x+22,y-7);
  Linie(x+10,y-7, x+10,y-17);
  Linie(x+10,y-17,x+22,y-17);
  Linie(x+22,y-17,x+22,y-27);
  Linie(x+22,y-27,x+10,y-27);
End;

procedure Zeichen6(x,y:integer);
{
  Ausgabe "6"
}
Begin
  Linie(x+10,y-7, x+22,y-7);
  Linie(x+10,y-7, x+10,y-27);
  Linie(x+10,y-27,x+22,y-27);
  Linie(x+22,y-27,x+22,y-17);
  Linie(x+22,y-17,x+10,y-17);
End;

procedure Zeichen7(x,y:integer);
{
  Ausgabe "7"
}
Begin
  Linie(x+9, y-7, x+25,y-7);
  Linie(x+25,y-7, x+12,y-27);
  Linie(x+14,y-17,x+20,y-17);
End;

procedure Zeichen8(x,y:integer);
{
  Ausgabe "8"
}
Begin
  Linie(x+10,y-7, x+22,y-7);
  Linie(x+22,y-7, x+22,y-27);
  Linie(x+10,y-7, x+10,y-27);
  Linie(x+10,y-17,x+22,y-17);
  Linie(x+10,y-27,x+22,y-27);
End;

procedure Zeichen9(x,y:integer);
{
  Ausgabe "9"
}
Begin
  Linie(x+10,y-7, x+22,y-7);
  Linie(x+22,y-7, x+22,y-27);
  Linie(x+10,y-7, x+10,y-17);
  Linie(x+10,y-17,x+22,y-17);
  Linie(x+10,y-27,x+22,y-27);
End;

procedure Zeichen0(x,y:integer);
{
  Ausgabe "0"
}
Begin
  Linie(x+10,y-7, x+22,y-7);
  Linie(x+10,y-7, x+10,y-27);
  Linie(x+22,y-7, x+22,y-27);
  Linie(x+10,y-27,x+22,y-27);
End;

procedure ZeichenA(x,y:integer);
{
  Ausgabe "A"
}
Begin
  Linie(x,  y,   x+8, y+20);
  Linie(x+8,y+20,x+15,y);
  Linie(x+4,y+10,x+11,y+10);
End;

procedure ZeichenE(x,y:integer);
{
  Ausgabe "E"
}
Begin
  Linie(x,y+20,x+15,y+20);
  Linie(x,y+20,x,   y);
  Linie(x,y,   x+15,y);
  Linie(x,y+10,x+15,y+10);
End;

procedure ZeichenG(x,y:integer);
{
  Ausgabe "G"
}
Begin
  Linie(x,   y+20,x+15,y+20);
  Linie(x,   y+20,x,   y);
  Linie(x,   y,   x+15,y);
  Linie(x+15,y,   x+15,y+10);
  Linie(x+15,y+10,x+9 ,y+10);
End;

procedure ZeichenM(x,y:integer);
{
  Ausgabe "M"
}
Begin
  Linie(x,   y+20,x,   y);
  Linie(x+15,y+20,x+15,y);
  Linie(x,   y+20,x+7, y+10);
  Linie(x+7, y+10,x+15,y+20);
End;

procedure ZeichneZeichen(ZeichenNr,x,y:byte);
{
  Ziffern 0..9 grafisch darstellen
}
Begin
  case ZeichenNr of
    1 : Zeichen1(x,y);
    2 : Zeichen2(x,y);
    3 : Zeichen3(x,y);
    4 : Zeichen4(x,y);
    5 : Zeichen5(x,y);
    6 : Zeichen6(x,y);
    7 : Zeichen7(x,y);
    8 : Zeichen8(x,y);
    9 : Zeichen9(x,y);
    0 : Zeichen0(x,y);
  end;
End;

procedure Regeln;
{
  Ausgabe der Spielregeln
}
Begin
  TextAusgeben(9,6,'BEDIENUNGSANLEITUNG');
  Linie(392,255-51,528,255-51);
  Linie(392,255-53,528,255-53);
  TextAusgeben(4, 8,'W{hlen  Sie mit  Hilfe der  Tastatur');
  TextAusgeben(4, 9,'eine Spielebene aus  und starten Sie');
  TextAusgeben(4,10,'mit der  GAME-Taste. Zur}ck zur Aus-');
  TextAusgeben(4,11,'wahl gelangen Sie ebenfalls mit "G".');
  TextAusgeben(4,12,'Sokoban beenden Sie mit Level 0.');
  TextAusgeben(4,14,'Ziel ist  es, in der  k}rzesten Zeit');
  TextAusgeben(4,15,'und  mit  den  wenigsten  Z}gen alle');
  TextAusgeben(4,16,'Kisten  einzeln an die vorbestimmten');
  TextAusgeben(4,17,'Pl{tze zu schieben.');
  TextAusgeben(4,19,'         Aber Vorsicht');
  TextAusgeben(4,20,'Zwei Kisten sind f}r Sie zu schwer!');
  LowVideo;
  TextAusgeben(12,22,'Abbruch mit ^C');
  NormVideo;
End;

procedure SpielWaehlen;
{
  Spiel auswaehlen
}
var
  WahlX        : byte;
  WahlY        : byte;
Begin
  clrscr;
  Video(An);
  GrossesFenster;
  Rechteck( 20,119,207,240);
  Rechteck( 20,119,  9, 42);
  Rechteck(200,299, 42, 75);
  Rechteck(200,299,108,207);
  Linie(200,174,299,174);
  Linie(200,141,299,141);
  Linie(233,207,233, 75);
  Linie(266,207,266, 75);
  Zeichen1(200,207);
  Zeichen2(233,207);
  Zeichen3(266,207);
  Zeichen4(200,174);
  Zeichen5(233,174);
  Zeichen6(266,174);
  Zeichen7(200,141);
  Zeichen8(233,141);
  Zeichen9(266,141);
  Zeichen0(233,108);
  ZeichenG(211, 49);
  ZeichenA(231, 49);
  ZeichenM(251, 49);
  ZeichenE(271, 49);
  Regeln;
  Mauer(200,230);
  Kiste(225,230);
  KistenPlatz(225,230);
  KistenPlatz(245,230);
  Kiste(265,230);
  SpielerLinks(285,230);
  Video(Aus);
  ZeichneZeichen(Eingabe2,60,42);
  Video(An);
  if ((BildNr DIV 10)<>0) then ZeichneZeichen((BildNr DIV 10),60,240);
  ZeichneZeichen((BildNr MOD 10),80,240);
  Eingabe1:=0;
  Eingabe2:=0;
  WahlY:=80;
  repeat
    AktuellesZeichenLesen;
    if (AktuellesZeichen in ['0'..'9']) then
    begin
      write(^G);
      WahlX:=ord(AktuellesZeichen)-ord('0');
      if (WahlY=80) then
      begin
        Eingabe1:=WahlX;
        ZeichneZeichen(Eingabe1,80,42);
        WahlY:=WahlY-20;
      end else
      begin
        Video(Aus);
        ZeichneZeichen(Eingabe1,WahlY+20,42);
        ZeichneZeichen(Eingabe2,WahlY,42);
        Video(An);
        ZeichneZeichen(WahlX,WahlY+20,42);
        Eingabe2:=Eingabe1;
        Eingabe1:=WahlX;
        if (Eingabe2>0) then ZeichneZeichen(Eingabe2,WahlY,42);
      end;
    end;
  until (AktuellesZeichen=GAME);
  BildNr:=Eingabe2*10+Eingabe1;
  DateiNr:=Eingabe2*2;
  if ((Eingabe1=0) and (Eingabe2>0)) then
  begin
    DateiNr:=pred(DateiNr);
    Eingabe1:=5;
  end;
  if (Eingabe1>5) then
  begin
    DateiNr:=succ(DateiNr);
    Eingabe1:=Eingabe1-5;
  end;
End;

procedure StandAusgeben(Modus:Stand);
{
  Gibt Spielstand aus

  Zusammengefasst wegen Cursor-Koordinaten
}
Begin
  LowVideo;
  if (Modus=Neu) then
  begin
    gotoxy(3,31);
    write('Bild : ',BildNr:2,'. Pushes :    . Moves :    ');
{
                                         ^^^          ^^^
                                         23           36
}
  end;
  gotoxy(23,31);                        {<-+ }
  write(SchubNr:3);
  gotoxy(36,31);                                     {<-+ }
  write(ZugNr:3);
  NormVideo;
End;

procedure PICdekodieren;
{
  .PIC Datei dekodieren

  Jede PIC Datei besteht aus 5 Bildern
  Diese Routine sucht das Bild in der Datei
  und erstellt daraus ein Spielfeld

  Bild  1.. 5: Datei SOKO-1.PIC
  Bild  6..10: Datei SOKO-2.PIC
  Bild 11..15: Datei SOKO-3.PIC
          usw.

  Maximale Eingabe ist 60 -> SOKO-11.PIC
  Letztes Spielfeld
}
var
  PICZeiger    : integer;

  procedure SetzeFeld(Art:char);
  begin
    AltX:=AltX+12;
    SpielFeld[FeldSpalte,FeldZeile]:=Art;
    FeldSpalte:=succ(FeldSpalte);
  end;

Begin {PICdekodieren}
  PICindex:=0;
  PICZeiger:=1;
  FeldIndex:=0;
  while (PICZeiger<>Eingabe1) do
  begin
    if (PICFeld[FeldIndex]=BILDENDE) then PICZeiger:=succ(PICZeiger);
    if (PICZeiger=Eingabe1) then PICindex:=FeldIndex+2;
    FeldIndex:=succ(FeldIndex);
    if (FeldIndex>PIC) then BEENDEN(': Spielfelddaten falsch kodiert');
  end;
  CLRGRAF;
  AltX:=0;
  AltY:=240;
  FeldZeile:=1;
  FeldSpalte:=1;
  SpielSteine:=0;
  GrossesFenster;
  Linie(0,25,319,25);
  while (PICFeld[PICindex]<>BILDENDE) do
  begin
    case PICFeld[PICindex] of
        CR :
             begin
               AltX:=0;
               AltY:=AltY-12;
               FeldZeile:=succ(FeldZeile);
               FeldSpalte:=1;
             end;
       LEERFELD :
             SetzeFeld(LEERFELD);
       MAUERFELD :
             begin
               Mauer(AltX,AltY);
               SetzeFeld(MAUERFELD);
             end;
       KISTENFELD :
             begin
               Kiste(AltX,AltY);
               SetzeFeld(KISTENFELD);
              end;
       KISTENLAGER :
             begin
               KistenPlatz(AltX,AltY);
               SetzeFeld(KISTENLAGER);
               SpielSteine:=succ(SpielSteine);
             end;
       SPIELERFELD :
             begin
               SpielerLinks(AltX,AltY);
               NeuX:=AltX;
               NeuY:=AltY;
               Spalte:=FeldSpalte;
               Zeile:=FeldZeile;
               SetzeFeld(LEERFELD);
             end;
       HINDERNISFELD :
             begin
               KistenPlatz(AltX,AltY);
               Kiste(AltX,AltY);
               SetzeFeld(HINDERNISFELD);
             end;
    end;
    PICindex:=succ(PICindex);
  end;
  VorigesZeichen:=LINKS;
  SchubNr:=0;
  ZugNr:=0;
  AltX:=NeuX;
  AltY:=NeuY;
  StandAusgeben(Neu);
End;

procedure PIClesen(var Erfolg:boolean);
{
  .PIC Datei laden
}
Begin
  str(DateiNr,DateiName);
  DateiName:='SOKO-'+DateiName+'.PIC';
  if (DEFDRV<>'@') then DateiName:=DEFDRV+':'+DateiName;
  assign(PICDatei,DateiName);
  {$I-}reset(PICDatei);{$I+}
  Erfolg:=(IOResult=0);
  if Erfolg then
  begin
    FeldIndex:=0;
    DateiGroesse:=filesize(PICDatei);
    if (DateiGroesse*RecLen>PIC) then BEENDEN(': Definitionsdatei '+DateiName+' zu lang!');
    blockread(PICDatei,PICFeld[FeldIndex],DateiGroesse);
    close(PICDatei);
    DateiNr:=succ(DateiNr);
    PICindex:=0;
  end;
End;

procedure NeuesSpielEinlesen;
{
  Neue Spielebene waehlen, .PIC Datei einlesen und dekodieren
}
Begin
  repeat
    SpielWaehlen;
    PIClesen(DateiOk);
  until DateiOk;
  if ((BildNr<>0) and DateiOk) then PICdekodieren;
End;

procedure SchiebeKiste(Wohin:char);
{
  Kiste in angegebene Richtung schieben
}
var
  dx,dy        : integer;
Begin
  case Wohin of
    LINKS  : begin
               dx:=-1;
               dy:= 0;
             end;
    RECHTS : begin
               dx:=+1;
               dy:= 0;
             end;
    HOCH   : begin
               dx:= 0;
               dy:=+1;
             end;
    RUNTER : begin
               dx:= 0;
               dy:=-1;
             end;
  end;
{ Alte Kiste loeschen }
  Video(Aus);
  Kiste(AltX+12*dx,AltY+12*dy);
{ Neue Kiste setzen   }
  Video(An);
  Kiste(AltX+24*dx,AltY+24*dy);
{ Zeiger setzen       }
  SchubNr:=succ(SchubNr);
  ZugNr:=succ(ZugNr);
  Spalte:=Spalte+dx;
  Zeile :=Zeile-dy;
  SpielFeld[Spalte,Zeile]:=LEERFELD;
  NeuX:=AltX+12*dx;
  NeuY:=AltY+12*dy;
End;