PROGRAM t_rechner;
  USES crt,dos;

  CONST          { Konstantenarray mit gleichzeitiger Zuweisung }
   tasten : ARRAY[1..36] OF STRING[3] = (' ce',' û ',' % ','sin','cos',
   ' 7 ',' 8 ',' 9 ',' / ',' n ',' nü','hex',' a ',' b ',' 4 ',' 5 ',' 6 ',
   ' * ',' xý','mod','dru',' c ',' d ',' 1 ',' 2 ',' 3 ',' - ','aus',
   ' m-',' m+',' e ',' f ',' 0 ',' . ',' = ',' + ');
  leer = '                                            ';
  VAR
      x,y,i,j,z:INTEGER;     { globale Variablen  }
      bildseg:WORD;      { Cga = $b800, Hercules = $b000 }
                         { Vga = $b800 }
      regs:REGISTERS;    { Type registers ist in Unit dos definiert }
                         { globale Proceduren }
      hex,dez:BOOLEAN;

  PROCEDURE r_string(zeil,spal,att:BYTE;satz:STRING);
  VAR                  { att -> farbe der Zeichen }
   i,l:INTEGER;
   offset:WORD;
  BEGIN
   l:=LENGTH(satz);    { L„nge des šbergebenen Strings in l speichern }
                       { LENGTH -> ermittle L„nge von satz }
   i:=1;
   offset := (zeil * 160) + (spal * 2); { Offsetanteil der Adresse }
   WHILE i <= l DO                      { MEM[bildseg:offset] bildet die }
     BEGIN                              { Adresse an der ein Zeichen }
       MEM[bildseg:offset]:=ORD(satz[i]); { geschrieben wird }
       INC(offset);                       { ORD liefert den Zahlenwert }
       MEM[bildseg:offset]:=att;          { des Zeichens z.B. 'A' = 65 }
       INC(offset);
       INC(i);
     END;
  END;

  PROCEDURE r_zeichen(zeil,spal:INTEGER;att:BYTE;zeich:CHAR);
  VAR                    {  lokale Variablen zeil,spal usw. }
  offset:WORD;
  BEGIN
  offset := (zeil * 160) + (spal * 2);
  MEM[bildseg:offset]:=ORD(zeich);
  MEM[bildseg:offset + 1]:=att;
  END;

  PROCEDURE rahmen(zeil,spal,breit,hoch,attr,art:BYTE);
  VAR                       { breit = breite des rahmens(anzahl Zeichen) }
  b,h:INTEGER;              { hoch  = h”he des rahmens }
                            { attr  = farbe des Zeichens }
                            { art = einfach 1, doppelt 2, usw. }
  r1, r2, r3, r4, r5, r6:CHAR;

  BEGIN
      CASE art OF
        1:BEGIN
          r1:=#218; r2:=#196; r3:=#191; { r1 = Ú  }
          r4:=#179; r5:=#192; r6:=#217; { einfach }
          END;
        2:BEGIN
          r1:=#201; r2:=#205; r3:=#187; { r1 = É  }
          r4:=#186; r5:=#200; r6:=#188; { doppelt }
          END;
        3:BEGIN
          r1:=#177; r2:=#177; r3:=#177;
          r4:=#177; r5:=#177; r6:=#177; { alle ± }
          END;
        4:BEGIN
          r1:=#176; r2:=#176; r3:=#176;
          r4:=#176; r5:=#176; r6:=#176; { alle ° }
          END;
        5:BEGIN
          r1:=#178; r2:=#178; r3:=#178;
          r4:=#178; r5:=#178; r6:=#178; { alle ² }
          END;
        6:BEGIN
          r1:=#219; r2:=#219; r3:=#219;
          r4:=#219; r5:=#219; r6:=#219; { Û }
          END;
      END;
      r_zeichen(zeil,spal,attr,r1);
       FOR b := 1 TO breit - 1 DO
           r_zeichen(zeil, spal + b, attr, r2);
            r_zeichen(zeil,spal + b,attr,r3);
         FOR h := 1 TO hoch - 1 DO
          BEGIN
            r_zeichen(zeil + h,spal,attr,r4);
             FOR b := 1 TO breit - 1 DO
                 r_zeichen(zeil + h,spal + b,attr,chr(32));
                  r_zeichen(zeil + h,spal + b,attr,r4);
          END;
       r_zeichen(zeil + h,spal,attr,r5);
        FOR b := 1 TO breit - 1 DO
            r_zeichen(zeil + h,spal + b,attr,r2);
        r_zeichen(zeil + h,spal + b,attr,r6);
  END;
PROCEDURE loeschen;
BEGIN
           GOTOXY(13,3);
           WRITE(leer);
           GOTOXY(13,4);
           WRITE(leer);
           GOTOXY(13,5);
           WRITE(leer);
           GOTOXY(13,6);
           WRITE(leer);
END;

PROCEDURE hexdez;
type
     string4 = string[4];
     hexletter = SET OF CHAR;
const
     hexziffer :array[0..15] of char = '0123456789ABCDEF';
     hexb:hexletter = ['0'..'9','a'..'f','A'..'F'];
var
     dezimal,summe:word;
     dezi1,dezi2:string4;
     fehler:integer;
     ch:char;

function  hexa(d:word):string4;
var
 i:word;
 begin
   hexa[0]:=#4;
   for i:=0 to 3 do
   begin
   hexa[4-i]:=hexziffer[d and $f];
   d:=d shr 4;
   end;
end;

function dezi(temp:string4):word;
var
   dez:word;
   dstr:string4;
   i:byte;
begin
      dez:=0;
      dstr:='';
      for i:=1 to 4 do
          dstr[i]:=upcase(temp[i]);
       if ord(dstr[1]) < 65 then
          dez:=(ord(dstr[1])-48) * 4096
          else
          dez:=(ord(dstr[1])-55) * 4096;
        if ord(dstr[2]) < 65 then
           dez:=dez+((ord(dstr[2])-48)*256)
           else
           dez:=dez+((ord(dstr[2])-55)*256);
         if ord(dstr[3]) < 65 then
            dez:=dez+((ord(dstr[3])-48)*16)
            else
            dez:=dez+((ord(dstr[3])-55)*16);
          if ord(dstr[4]) < 65 then
             dez:=dez+((ord(dstr[4])-48)*1)
             else
             dez:=dez+((ord(dstr[4])-55)*1);
       dezi:=dez;
end;
                           { LIEFERT HEXZAHL ZURšCK }
   FUNCTION hex_zahl:string4;
       BEGIN
        REPEAT             { SCHLEIFENBEGINN DER EINGABE }
        loeschen;
         GOTOXY(13,5);
         WRITE('Hex -> Dezimal');
         GOTOXY(13,4);
          READLN(dezi1);
        UNTIL (dezi1[1] in hexb) and (dezi1[2] in hexb) and (dezi1[3] in hexb)
        and (dezi1[4] in hexb);
     hex_zahl:=dezi1;            { SCHLEIFENENDE WENN KEIN EINGABEFEHLER }
   END;
                            { LIEFERT DEZIMALZAHL ZURšCK }
    FUNCTION dezimal_zahl:word;
      BEGIN
      REPEAT
      loeschen;
       GOTOXY(13,5);
       WRITE('Dezimal -> Hex');
        GOTOXY(13,4);
     {$I-} READLN(dezimal); {$I+}
        fehler:=IOresult;
      UNTIL  (fehler = 0) and (dezimal < 65536);
      dezimal_zahl:=dezimal;
    END;

begin
    dezimal:=0;dezi1:='';
    IF hex THEN
     BEGIN
     dezimal:=dezimal_zahl;
     gotoxy(13,6);
     write(hexa(dezimal));
     END;
    IF dez THEN
     BEGIN
     dezi1:=hex_zahl;
     gotoxy(13,6);
     write(dezi(dezi1));
     END;
     ch:=readkey;
     IF ORD(ch) = 0 THEN
        ch:=READKEY;
     IF ORD(ch) = 62 THEN
        BEGIN
        hex:=FALSE;
        dez:=FALSE;
        loeschen;
        END
        ELSE
        hexdez;

end;

  PROCEDURE aktion;    { ANFANG VON AKTION }
     TYPE
      letter = SET OF CHAR;  { MENGE FšR BUCHSTABEN BILDEN }

     CONST                   { KONSTANTEN FESTLEGEN }
      inhalt : letter = ['+','-','=','*',':','c','C',#59,#68];
      inhalt1: letter = ['0'..'9','.'];

                                  { INHALT DER MENGE FESTLEGEN }
      text = 'Falsche Eingabe: ';

      F1  = ' F1  = L™SCHEN(ce)';
      F10 = ' F10 = ENDE       ';
      CC  = ' C   = NEU        ';
      F2  = ' F2  = HEXDEZ     ';
      F3  = ' F3  = DEZHEX     ';
      F4  = ' F4  = ENDE F2,F3 ';
      F5  = ' F5  = û          ';
      F6  = ' F6  = xý         ';

     VAR                     { VARIABLE BEZEICHNER FESTLEGEN }
      eingabe:CHAR;         { FšR TASTATURABFRAGE }
      op1,op2,ergeb:REAL;    { OPERANDEN }
      fehler:INTEGER;        { FšR FEHLERCODE }
      ch,operation:CHAR;     { AUFNAHME DER OPERATIONSZEICHEN +,-,USW.}
      erste,ende:BOOLEAN;    { FšR BEDINGUNGSABFRAGE }
      dezimal,summe:word;

     PROCEDURE cursor(x,y:byte);  { CURSOR UNSICHTBAR ODER SICHTBAR }
     BEGIN
     WITH regs DO
      BEGIN
       ah:=1;           { FUNKTIONSNUMMER NACH AH-REGISTER }
       ch:=x;           { STARTZ. CURSOR, X:=30,Y:=30 CUR. UNSICHTBAR }
       cl:=y;           { ENDZ. CURSOR  X:=6,Y:=7 CUR. SICHTBAR }
      INTR($10,regs);   { BIOSINTERRUPT AUFRUF }
      END;
     END;
                        { ERGEBNIS AUSGEBEN }
     PROCEDURE ergebnis(spalte,zeile:INTEGER);
     BEGIN
      GOTOXY(spalte,zeile);
      IF FRAC(ergeb) > 0.00 THEN  { TP-FUNKTION FRAC LIEFERT DEN WERT }
       WRITE(ergeb:20:4)          { DER STELLEN NACH DEM KOMMA }
       ELSE                       { SOLLTE WERT > .00 DANN GEBE 4 NACHKOMMA-}
      WRITE(ergeb:20:0);          { STELLEN AUS, SONST NUR VORKOMMASTELLEN }
      END;
                         { RECHENOPERATIONEN AUSFšHREN }
      PROCEDURE rechnen(var summe:REAL);
      BEGIN
       CASE operation OF  { JE NACH INHALT VON OPERATION FšHRE AUS }
         '+' : BEGIN              { BLOCKBEGINN }
               summe := op1 + op2;
               ergebnis(36,6);
               END;               { BLOCKENDE }
         '-' : BEGIN
               summe := op1 - op2;
               ergebnis(36,6);
               END;
         '*' : BEGIN
               summe := op1 * op2;
               ergebnis(36,6);
               END;
         ':' : BEGIN
               IF op2 = 0.0 THEN op2 := 1;
               summe := op1 / op2;
               ergebnis(36,6);
               END;
           END;
        op1:=summe;
        END;
                           { LIEFERT ERSTEN OPERANDEN ZURšCK }
     FUNCTION erste_zahl:REAL;
     VAR
       eins:REAL;
       BEGIN
        REPEAT             { SCHLEIFENBEGINN DER EINGABE }
         GOTOXY(13,3);
          WRITE(leer);     { EVENTUELLE ALTE EINGABEN L™SCHEN }
         GOTOXY(13,3);
      {$I-}  READLN(eins); {$I+} { AUTOMATISCHE EIN/AUSGABEPRšFUNG MIT $S-}
          fehler:=IORESULT;      { AUSSCHALTEN, CODE IN FEHLER SPEICHERN,}
                                 { SONST WšRDE BEI FEHLER PRG. UNTERBROCHEN}
        UNTIL fehler = 0;   { SCHLEIFENENDE WENN KEIN EINGABEFEHLER }
       erste_zahl:=eins;    { WERT IN FUNKTIONSNAMEN SPEICHERN }
        GOTOXY(36,3);
      IF FRAC(eins) > 0.00 THEN
         WRITE(eins:20:4)
        ELSE
         WRITE(eins:20:0);
     END;
                            { LIEFERT ZWEITEN OPERANDEN ZURšCK }
     FUNCTION zweite_zahl:REAL;
      VAR
        zwei:REAL;             { ARBEITSWEISE WIE OBEN }
      BEGIN
      REPEAT
       GOTOXY(13,4);
        WRITE(leer);
        GOTOXY(13,5);
       WRITE(operation);
        GOTOXY(13,4);
    {$I-}  READLN(zwei); {$I+}
           fehler:=IORESULT;
      UNTIL fehler = 0;
     zweite_zahl:=zwei;
      GOTOXY(36,4);
      IF FRAC(zwei) > 0.00 THEN
         WRITE(zwei:20:4)
        ELSE
         WRITE(zwei:20:0);
     END;
PROCEDURE neu;
BEGIN
           erste:=true;          { VARIABLE AUF wahr SETZEN, TYP BOOLEAN }
           op1:=0.0;             { MIT 0.00 L™SCHEN }
           op2:=0.0;
           ergeb:=0.0;
           operation:=' ';
           loeschen;
           ergebnis(36,6);
           op1:=erste_zahl;      { FUNCTION erste_zahl AUFRUFEN }
END;
                               { TASTATUREINGABE AUSWERTEN }
     PROCEDURE tastatur;
      BEGIN
       REPEAT                  { SCHLEIFENBEGINN }
        cursor(30,30);         { CURSOR UNSICHTBAR }
        ERGEBNIS(36,6);
         eingabe:=READKEY;     { ZEICHENEINLESEN OHNE ANZEIGE }
     CASE ORD(eingabe) OF
        0:BEGIN
         eingabe := READKEY;    { ERWEITERTEN TASTATUR CODE EINLESEN }
        CASE ORD(eingabe) OF
        59:BEGIN                 { F1 ZWEITE EINGABE WIEDERHOLEN }
            gotoxy(13,4);
            write(leer);
            op2:=zweite_zahl;     { FUNCTION zweite_zahl AUFRUFEN DURCH }
                                  { ZUWEISUNG }
            rechnen(ergeb);       { PROZEDUR RECHNEN MIT PARAMETER AUFRUFEN }
            END;
        61:BEGIN                  { Schalter hex f�r HEXA.-Berechnung }
           hex:=TRUE;
           REPEAT
           hexdez;
           UNTIL hex = FALSE;
           neu;
           END;
        60:BEGIN
           dez:=TRUE;
           REPEAT
           hexdez;
           UNTIL dez = FALSE;
           neu;
           END;
        63:BEGIN
           neu;
           ergeb:=sqrt(op1);
           ergebnis(36,6);
           END;
        64:BEGIN
           neu;
           ergeb:=sqr(op1);
           ergebnis(36,6);
           END;
        68:BEGIN                 { TASTE F10 }
            ende:=true;           { ENDE AUF wahr SETZEN, BEDINGUNG FšR }
            END;                  { SCHLEIFENENDE }
           END;
          END;                    { ENDE ZWEITE CASEABFRAGE }
   67,99:BEGIN                 {c,C NEUE EINGABEN, ALTE WERTE L™SCHEN }
         neu;                  { PROCEDURE neu AUFRUFEN }
         END;
        43:BEGIN                 { + }
            IF erste THEN         { WENN ERSTE EINGABE(erste = wahr(=1)) }
             BEGIN                { DANN FOLGENDEN BLOCK }
             erste:=FALSE;        { erste AUF NICHT WAHR(=0) SETZEN }
             operation:='+';      { AUSZUFšHRENDE OPERATION FšR PROCEDUR RECH.}
             op2:=zweite_zahl;    { FUNCTION zweite_zahl AUFRUFEN }
             rechnen(ergeb);      { PROCEDUR RECHNEN AUFRUFEN }
             END ELSE             { SONST DIESEN BLOCK }
             BEGIN
             operation:='+';
             op2:=zweite_zahl;     { FUNCTION zweite_zahl }
             rechnen(ergeb);       { PROCEDUR RECHNEN }
             op1:=ergeb;           { FšR WEITERE BERECHN. ERSTEN OPERAN. MIT }
             END;                  { WERT VON ergeb LADEN }
            END;
         45:BEGIN                  { - }
             IF erste THEN         { WIE OBEN }
             BEGIN
             erste:=FALSE;
             operation:='-';
             op2:=zweite_zahl;
             rechnen(ergeb);
             END ELSE
             BEGIN
             operation:='-';
             op2:=zweite_zahl;
             rechnen(ergeb);
             op1:=ergeb;
             END;
            END;
          42:BEGIN                 { * }
              IF erste THEN        { WIE OBEN }
              BEGIN
              erste:=FALSE;
              operation:='*';
              op2:=zweite_zahl;
              rechnen(ergeb);
              END ELSE
              BEGIN
              operation:='*';
              op2:=zweite_zahl;
              rechnen(ergeb);
              op1:=ergeb;
              END;
             END;
          58:BEGIN                  { : }
              IF erste THEN         { WIE OBEN }
               BEGIN
               erste:=FALSE;
               operation:=':';
               op2:=zweite_zahl;
               rechnen(ergeb);
               END ELSE
                BEGIN
               operation:=':';
               op2:=zweite_zahl;
               rechnen(ergeb);
               op1:=ergeb;
               END;
              END;
          61:BEGIN                  { = }
              op1:=ergeb;
              ergebnis(36,6);
              END;
              END;
       UNTIL ende;      { SCHLEIFEN UND PROGRAMMENDE WENN ENDE = WAHR }
     END;               { ENDE VON PROCEDURE tastatur }

     BEGIN              { BEGINN DES PROCEDURHAUPTPROGRAMMES }
      ergeb:=0;erste:=true;ende:=false;   { VARIABLEN AUF ANFANGSWERTE }
      hex:=false;dez:=false;  { KEINE HEXABERECHNUNG }
      cursor(30,30);
      ergebnis(36,6);   { ANFANGSERGEBNIS AUSGEBEN = 0 }
      r_string(1,62,$70,F1);   { FUNKTION F1 AUSGEBEN }
      r_string(2,62,$70,CC);   { FUNKTION CE AUSGEBEN }
      r_string(3,62,$70,F10);  { FUNKTION F10 AUSGEBEN }
      r_string(4,62,$70,F2);   { FUNKTION F2 AUSGEBEN }
      r_string(5,62,$70,F3);   { FUNKTION F3 AUSGEBEN }
      r_string(6,62,$70,F4);   { FUNKTION F4 AUSGEBEN }
      r_string(7,62,$70,F5);   { FUNKTION F5 AUSGEBEN }
      r_string(8,62,$70,F6);   { FUNKTION F6 AUSGEBEN }
      op1:=erste_zahl;
      operation:=' ';   { KEINE OPERATION }
      tastatur;         { PROCEDUR tastatur AUFRUFEN }
      cursor(6,7);      { WENN PRG.-ENDE DANN CURSOR SICHTBAR }
     END;               { ENDE VON PROCEDURE aktion }

  BEGIN                  { HAUPTPROGRAMM }
  CLRSCR;
  regs.ah := 15;
  INTR($10, regs);       { Dieser Aufruf betrifft Dos-Funktionen }
  IF regs.al = 7 then    { dazu kommen wir sp„ter (Grafikteil }
      bildseg := $b000
     ELSE
      bildseg := $b800;
  x:=7;y:=3;z:=1;
  rahmen(0,0,60,21,yellow,1);
  rahmen(1,2,56,6,yellow,2);
  FOR I:= 1 to 4 DO
  BEGIN
      FOR j := 1 to 9 DO
          BEGIN
          rahmen(x,y,5,3,yellow,2);
          INC(y,6);
          IF j = 5 THEN y:= y +1;    { das ist gleich dem befehl INC(y) }
          END;
  INC(x,3);       { erh”he x um 3, -> x := x + 3 }
  y:=3;
  END;
  TEXTCOLOR(white);          { oh wie umst„ndlich }
  GOTOXY(4,3);               { mit r_string gehts schneller }
  WRITE('->');
  GOTOXY(4,4);   { -> GOTOXY = setze Cursor auf spalte 4, zeile 4 }
  WRITE('->');
  GOTOXY(4,5);
  WRITE('Aktion:');
  GOTOXY(4,6);
  WRITE('Ergebnis:');
  r_string(19,26,red,'D.E.R 3000');  { oder nicht ? }
  x:=8;y:=4;
  FOR I:= 1 to 4 DO       { f�hre 4 mal die folgenden Aktionen aus }
  BEGIN                    { a�áere Schleife }
      FOR j := 1 to 9 DO   { f�hre 9 mal die folgenden Aktionen aus }
          BEGIN            { innere Schleife }
          r_string(x,y,white,tasten[z]);  { tasten[z] -> einzelne Array- }
          INC(y,6);                       { elemente ausgeben            }
          INC(z);                         { Z„hler f�r tasten[z] erh”hen }
          IF j = 5 THEN y:= y +1;    { y:=y+1 ist gleich dem befehl INC(y) }
          END;
  INC(x,3);       { erh”he x um 3, -> x := x + 3 }
  y:=4;
  END;
  aktion;
  clrscr;
  END.