PROGRAM t_rechner;
  USES crt,dos,printer;

  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 ',' - ',' mc',
   ' 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;
      gesamt:REAL;


  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ý         ';
      F7  = ' F7  = n!         ';
      F8  = ' F8  = xü         ';
      F9  = ' F9  = %          ';
      F11 = ' F11 = druck      '; { F�r Tastatur ohne F11-F20 Tasten }
      F12 = ' F12 = druckende  '; { gilt Shift+F-Taste }
      F13 = ' F13 = Sinus      ';
      F14 = ' F14 = Cosinus    ';
      F15 = ' F15 = Rest b.Div.';
      F16 = ' F16 = m+         ';
      F17 = ' F17 = m-         ';
      F18 = ' F18 = mc Inhalt  ';
      F19 = ' F19 = mc L”schen ';
     VAR                     { VARIABLE BEZEICHNER FESTLEGEN }
      eingabe,druckop:CHAR;         { FšR TASTATURABFRAGE }
      op1,op2,ergeb,sinus,cosinus,sergeb,altergeb:REAL;    { OPERANDEN }
      fehler,rest,z:INTEGER;        { FšR FEHLERCODE }
      ch,operation:CHAR;     { AUFNAHME DER OPERATIONSZEICHEN +,-,USW.}
      erste,ende:BOOLEAN;    { FšR BEDINGUNGSABFRAGE }
      dezimal,summe:word;
      ergdruck,proz:BOOLEAN;

     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;
                        { ERGEBNISSE DRUCKEN }
PROCEDURE drucken(erste,zweite:real;operat:CHAR);
BEGIN
 IF ergdruck THEN
  CASE operat OF
 '*','-','+','/':
   BEGIN
     WRITELN(lst,erste:1:2,'  ',operat,'  ',zweite:1:2,' = ',ergeb:1:2);
   END;
 'n':
   BEGIN
     WRITELN(lst,operat,'! (',erste:1:0,') = ',ergeb:1:0);
   END;
 '%':
  BEGIN
  WRITELN(lst,erste:1:2,' ',operation,' ',
          zweite:1:2,operat,' = ',ergeb:1:2);
  END;
 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;

FUNCTION potenzieren(basis,exponent:real):REAL;
BEGIN
   IF basis > 0 THEN potenzieren := EXP(LN(basis)*exponent)
   ELSE
    IF basis = 0 THEN           { Wenn Basis = 0 und Exponent > 0 dann ist }
    IF exponent > 0 THEN potenzieren := 0      { der Potenzwert = 0        }
    ELSE                                       { ist der Exponent = 0 dann }
     IF exponent = 0 THEN potenzieren := 1     { ist der Potenzwert = 1    }
     ELSE write(#7)
   ELSE                         {  Falls Basis < 0 }
     IF exponent = TRUNC(exponent) THEN
        IF ODD(TRUNC(exponent)) THEN
        potenzieren:= - EXP(LN(ABS(basis)) * exponent)
        ELSE
        potenzieren:= EXP(LN(ABS(basis)) * exponent)
     ELSE                       { Falls Basis < 0 und Exponent ein Bruch   }
  IF (ABS(ROUND(1/exponent) - 1/exponent) < 1E-8 ) AND
  (ODD(ROUND(1/exponent))) THEN potenzieren:=-EXP(LN(ABS(basis))*exponent)
  ELSE write(#7);
END;

FUNCTION faku(fzahl:real):real;  { Bis N!(33) }
BEGIN
 IF fzahl > 33 THEN
  BEGIN
   WRITE(#7);
   faku:=0;
   END;
  IF fzahl > 1 THEN faku := fzahl * faku(fzahl-1)
   ELSE
     faku:=1;
END;

FUNCTION prozentwert(gwert,pwert:REAL;operand:CHAR):REAL;
VAR
    hwert:REAL;
BEGIN
     hwert:=0.0;
      CASE operand OF
       '*':BEGIN
           prozentwert:=(gwert * pwert) / 100;
           ergebnis(36,6);
           END;
       '-':BEGIN
           hwert:=(gwert * pwert) / 100;
           prozentwert:= gwert - hwert;
           ergebnis(36,6);
           END;
       '+':BEGIN
           hwert:=(gwert * pwert) / 100;
           prozentwert:= gwert + hwert;
           ergebnis(36,6);
           END;
      END;
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);
               druckop:='+';
               END;               { BLOCKENDE }
         '-' : BEGIN
               summe := op1 - op2;
               ergebnis(36,6);
               druckop:='-';
               END;
         '*' : BEGIN
               summe := op1 * op2;
               ergebnis(36,6);
               druckop:='*';
               END;
         ':' : BEGIN
               IF op2 = 0.0 THEN op2 := 1;
               summe := op1 / op2;
               ergebnis(36,6);
               druckop:='/';
               END;
           END;
          IF ergdruck THEN
           drucken(op1,op2,druckop);
        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;
        65:BEGIN
           neu;
           ergeb:=faku(op1);
           druckop:='n';
           ergebnis(36,6);
           IF ergdruck THEN
            drucken(op1,op2,druckop);
           operation:=' ';
           END;
        66:BEGIN
           op2:=zweite_zahl;
           operation:='ü';
           druckop:='n';
           ergeb:=potenzieren(op1,op2);
           ergebnis(36,6);
           IF ergdruck THEN
            drucken(op1,op2,druckop);
           operation:=' ';
           END;
        67:BEGIN
           neu;
           druckop:='%';
           proz:=true;
           END;
        68:BEGIN                 { TASTE F10 }
            ende:=true;           { ENDE AUF wahr SETZEN, BEDINGUNG FšR }
            END;                  { SCHLEIFENENDE }
        84:BEGIN
            ergdruck:=TRUE;
           END;
        85:BEGIN
           ergdruck:=FALSE;
           END;
        86:BEGIN
           sinus:=sin(op1);      { Sinusberechnung }
           ergeb:=sinus;
           ergebnis(36,6);
           END;
        87:BEGIN
           cosinus:=cos(op1);    { Cosinusberechnung }
           ergeb:=cosinus;
           ergebnis(36,6);
           END;
        88:BEGIN
           op2:=zweite_zahl;     { Restwertberechnung der Division von Ganzz.}
           rest:= round(op1) mod round(op2);
           ergeb:=rest;
           ergebnis(36,6);
           END;
        89:BEGIN
           sergeb:=sergeb + ergeb; { Speicherinhalt + ergebnis einer Berechn.}
           END;
        90:BEGIN
           sergeb:=sergeb - ergeb; { Speicherinhalt - ergebnis einer Berechn.}
           END;
        91:BEGIN
           inc(z);
           altergeb:= ergeb;       { Speicherinhalt ausgeben, ergebnis der }
           ergeb:=sergeb;          { letzten Berechnung zwischenspeichern }
           ergebnis(36,6);
           if z = 2 then           { Wurde F18 zum zweitenmal gedr�ckt }
            begin                  { letztes Ergebnis wieder anzeigen }
            ergeb:=altergeb;
            ergebnis(36,6);
            z:=0;
            end;
           END;
        92:BEGIN                   { Speicherinhalt l”schen }
           z:=1;
           altergeb:=0.0;
           sergeb:=0.0;
           END;
           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 }
             IF proz THEN
              BEGIN
                ergeb:=prozentwert(op1,op2,'+');
               IF ergdruck THEN
                drucken(op1,op2,druckop);
              END
             ELSE
             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 }
            proz:=FALSE;
            END;
         45:BEGIN                  { - }
             IF erste THEN         { WIE OBEN }
             BEGIN
             erste:=FALSE;
             operation:='-';
             op2:=zweite_zahl;
             IF proz THEN
              BEGIN
                ergeb:=prozentwert(op1,op2,'-');
               IF ergdruck THEN
                drucken(op1,op2,druckop);
              END
             ELSE
             rechnen(ergeb);
             END ELSE
             BEGIN
             operation:='-';
             op2:=zweite_zahl;
             rechnen(ergeb);
             op1:=ergeb;
             END;
            proz:=FALSE;
            END;
          42:BEGIN                 { * }
              IF erste THEN        { WIE OBEN }
              BEGIN
              erste:=FALSE;
              operation:='*';
              op2:=zweite_zahl;
             IF proz THEN
              BEGIN
                ergeb:=prozentwert(op1,op2,'*');
               IF ergdruck THEN
                drucken(op1,op2,druckop);
              END
             ELSE
              rechnen(ergeb);
              END ELSE
              BEGIN
              operation:='*';
              op2:=zweite_zahl;
              rechnen(ergeb);
               op1:=ergeb;
              END;
            proz:=FALSE;
             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;sergeb:=0;altergeb:=0;z:=0;
      proz:=false;ergdruck:=false;   { VARIABLEN AUF ANFANGSWERTE }
      hex:=false;dez:=false;  { KEINE HEXABERECHNUNG }
      cursor(30,30);
      ergebnis(36,6);   { ANFANGSERGEBNIS AUSGEBEN = 0 }
      r_string(1,62,$70,CC);    { FUNKTION CE AUSGEBEN }
      r_string(2,62,$70,F1);    { FUNKTION F1 AUSGEBEN }
      r_string(3,62,$70,F2);    { FUNKTION F2 AUSGEBEN }
      r_string(4,62,$70,F3);    { FUNKTION F3 AUSGEBEN }
      r_string(5,62,$70,F4);    { FUNKTION F4 AUSGEBEN }
      r_string(6,62,$70,F5);    { FUNKTION F5 AUSGEBEN }
      r_string(7,62,$70,F6);    { FUNKTION F6 AUSGEBEN }
      r_string(8,62,$70,F7);    { FUNKTION F7 AUSGEBEN }
      r_string(9,62,$70,F8);    { FUNKTION F8 AUSGEBEN }
      r_string(10,62,$70,F9);   { FUNKTION F9 AUSGEBEN }
      r_string(11,62,$70,F10);  { FUNKTION F10 AUSGEBEN }
      r_string(12,62,$70,F11);  { FUNKTION F11 AUSGEBEN }
      r_string(13,62,$70,F12);  { FUNKTION F12 AUSGEBEN }
      r_string(14,62,$70,F13);  { FUNKTION F13 AUSGEBEN }
      r_string(15,62,$70,F14);  { FUNKTION F14 AUSGEBEN }
      r_string(16,62,$70,F15);  { FUNKTION F15 AUSGEBEN }
      r_string(17,62,$70,F16);  { FUNKTION F16 AUSGEBEN }
      r_string(18,62,$70,F17);  { FUNKTION F17 AUSGEBEN }
      r_string(19,62,$70,F18);  { FUNKTION F18 AUSGEBEN }
      r_string(20,62,$70,F19);  { FUNKTION F19 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.