program vid(input,output);
(* Das Programm konvertiert die Video-Adresse einer SOL 20 Maschine *)
(* in XY-Koordinaten.                                               *)

(* Die Video-Adresse liegt im Bereich 0xCC00..0xCFFF (52224..53247) *)

(* Diese Programmversion erlaubt die Eingabe als Hexadezimalzahl    *)
(* mit genau 4 Ziffern oder Dezimalzahl mit genau 5 Ziffern         *)
const
  VIDbase      = $CC00; (* Start des Videobereiches *)
  MaxRow       = 16;
  MaxCol       = 64;
  MaxColB      =  6;    (* 2^6 ergibt 64 *)
  hexl         =  4;    (* Anzahl von hexadezimalen Zeichen *)
  decl         =  5;    (* Anzahl von dezimalen Zeichen *)
type
  eingabe      = string[32];
  Zahlentyp    = (hexadezimal,dezimal);
var
  Ende         : boolean;
  RELAD,
  R,C,RD,
  ADR,
  VID,
  VIDTOP       : integer;
  Darstellung  : Zahlentyp;

function cmpwrd(x,y:integer):integer;
(* Vorzeichenloser Vergleich zweier 16 Bit Werte        *)
(* Ergibt                                               *)
(*   1, wenn beide Werte gleich sind                    *)
(*   0, wenn der erste Wert kleiner als der zweite ist  *)
(*   2, wenn der erste Wert groesser als der zweite ist *)
Begin
  if x=y then cmpwrd:=1
         else if ((x<y) xor ((x<0) xor (y<0))) then cmpwrd:=0
                                               else cmpwrd:=2;
End;

function wLT(x,y:integer):boolean;
(* Vorzeichenloser Vergleich zweier 16 Bit Werte               *)
(* Ergibt TRUE, wenn der erste Wert kleiner als der zweite ist *)
Begin
  wLT:=(cmpwrd(x,y)=0);
End;

function wGTE(x,y:integer):boolean;
(* Vorzeichenloser Vergleich zweier 16 Bit Werte                         *)
(* Ergibt TRUE, wenn der erste Wert groesser oder gleich dem zweiten ist *)
Begin
  wGTE:=((cmpwrd(x,y)=2) OR (x=y));
End;

function HEXs(val16:integer):eingabe;
(* Wandelt 16 Bit Wert um in Hex-Zeichenkette *)
var
  i,Digit      : integer;
  Hex          : eingabe;
Begin
  Hex:='0000';
  for i:=4 downto 1 do
  begin
    Digit:=(val16 and $0F) + ord('0');
    if Digit>ord('9') then Digit:=Digit + ord('A') - ord('0') - 10;
    Hex[i]:=Chr(Digit);
    val16:=val16 shr 4;
  end;
  HEXs:=Hex;
End;

function DEZs(val16:integer):eingabe;
(* Wandelt 16 Bit Wert um in Dezimal-Zeichenkette *)
var
  wrd          : real;
  Dez          : eingabe;
Begin
  if (val16<0) then wrd:=65536.0+val16
               else wrd:=val16;
  str(wrd:decl:0,Dez);
  DEZs:=Dez;
End;

procedure Range;
(* Gibt Start- und Endadresse aus *)
Begin
  case Darstellung of
    hexadezimal : begin
                    write(HEXs(VID),' bis ',HEXs(pred(VIDTOP)));
                    write(' (',DEZs(VID),' bis ',DEZs(pred(VIDTOP)),')');
                  end;
      dezimal   : begin
                    write(DEZs(VID),' bis ',DEZs(pred(VIDTOP)));
                    write(' (',HEXs(VID),' bis ',HEXs(pred(VIDTOP)),')');
                  end;
  end;
End;

procedure InitVID;
(* Initialisierung *)
Begin
  Darstellung:=hexadezimal;
  writeln;
  writeln('Berechnung der Zeile und Spalte aus SOL 20 Videoadresse');
  writeln;
  VID:=VIDbase;
  VIDTOP:=VID+MaxCol*MaxRow;
  write('[Eingabe der Adresse hexadezimal von ');
  Range;
  writeln(']');
  writeln('[Leere Zeile beendet das Programm]');
  writeln;
  Ende:=false;
End;

function VideoAdresse:integer;
(* Holt aktuelle Adresse *)
type
  Modus        = (Ok,Bereich,Zeichen,Anzahl);
var
  Fehler       : Modus;
  i,
  ci,
  ZahlWert     : integer;
  ADRs         : eingabe;

  function HexZeichen(c:char):integer;
  (* Wandelt Hex-Zeichen um in Ziffer *)
  begin
    case c of
      '0'..'9' : ci:=ord(c)-ord('0');
      'A'..'F' : ci:=ord(c)-ord('A')+10;
      'a'..'f' : ci:=ord(c)-ord('a')+10;
      else Fehler:=Zeichen;
    end;
    HexZeichen:=ci;
  end;

  function DezZeichen(c:char):integer;
  (* Wandelt Dezimal-Zeichen um in Ziffer *)
  begin
    if c in ['0'..'9'] then ci:=ord(c)-ord('0')
                       else Fehler:=Zeichen;
    DezZeichen:=ci;
  end;

  procedure ZahlEingabe(var x:integer);
  (* Holt aktuelle Adresse und ueberprueft, ob die Adresse richtig ist *)
  var
    ZahlLen    : integer;

    procedure TesteBereich;
    (* Testet gueltigen Adressbereich *)
    begin
      if Fehler=Ok then if wLT(x,VID)     then Fehler:=Bereich;
      if Fehler=Ok then if wGTE(x,VIDTOP) then Fehler:=Bereich;
    end;

  begin (* ZahlEingabe *)
    Fehler:=Ok;
    write('Videoadresse: ');
    readln(ADRs);
    ZahlLen:=length(ADRs);
    x:=0;
    case ZahlLen of
         0  : Ende:=true;
       hexl : begin
                Darstellung:=hexadezimal;
                for i:=1 to hexl do x:=16*x+HexZeichen(ADRs[i]);
              end;
       decl : begin
                Darstellung:=dezimal;
                for i:=1 to decl do x:=10*x+DezZeichen(ADRs[i]);
              end;
      else Fehler:=Anzahl;
    end;
    if ((ZahlLen in [hexl..decl]) and (Fehler=Ok)) then TesteBereich;
  end;

  function Laenge:eingabe;
  (* Testet Laenge der Eingabe *)
  begin
  if length(ADRs)<hexl then Laenge:='kurz'
                       else Laenge:='lang';
  end;

Begin (* VideoAdresse *)
  repeat
    ZahlEingabe(ZahlWert);
    case Fehler of
      Bereich : begin
                  write('Adresse ausserhalb ');
                  Range;
                  writeln;
                end;
      Zeichen : writeln('Fehlerhaftes Zeichen in Eingabe >>',ADRs,'<<');
      Anzahl  : writeln('Eingabe >>',ADRs,'<< zu ',Laenge);
    end;
  until Fehler=Ok;
  VideoAdresse:=ZahlWert;
End;

BEGIN (* M A I N *)
  InitVID;
  while not Ende do
  begin
    ADR:=VideoAdresse;
    if not Ende then
    begin
      RELAD:=ADR-VID;
      R:=RELAD DIV MaxCol;
      C:=RELAD-MaxCol*R;
      write('Videoadresse ');
      case Darstellung of
        hexadezimal : write(HEXs(ADR),' (',DEZs(ADR));
          dezimal   : write(DEZs(ADR),' (',HEXs(ADR));
      end;
      writeln(') -> Zeile ',R:2,', Spalte ',C:2);
    end;
  end;
END.