home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 09 / bcidemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-07-22  |  32.6 KB  |  792 lines
  1. Programm DTPDEMO;
  2.  
  3. (*****************************************************************************
  4. *   Quellprogramm:   DTPDEMO.PAS                                             *
  5. *   Beschreibung:    Händler- und Endbenutzerdemonstration des               *
  6. *                    Deutschen Pascals/i86 Version 1.0                       *
  7. *   Programmierer:   Dirk Benthien                                           *
  8. *   Datum:           Mai 1987                                                *
  9. *   Version                                                                  *
  10. *     Distribution:  1.0                                                     *
  11. *     Arbeitdatei:   1.037                                                   *
  12. *                                                                            *
  13. *   Compilierung:                                                            *
  14. *                a)  DTPINTF DTPDEMO (Festplattenversion)                    *
  15. *           oder b)  DTP1 DTPDEMO                                            *
  16. *                    DTP2 DTPDEMO                                            *
  17. *                    LINK DTPDEMO,,,DTPSTD+DTPINT                            *
  18. *                                                                            *
  19. *   Eingabe/Ausgabe: Datei mit Namen DTPDEMO.DAT                             *
  20. *                    Benutzerinteraktion (con i/o)                           *
  21. *                                                                            *
  22. *   Empfehlung:      Farbmonitor, aber nicht notwendig                       *
  23. *                                                                            *
  24. *                                                                            *
  25. *                                                                            *
  26. *   (C) Copyright 1987 by BCI - Benthien Consulting International            *
  27. *                         West Germany and USA                               *
  28. *                                                                            *
  29. *   Einschränkung des Copyrights:                                            *
  30. *   -----------------------------                                            *
  31. *   Dieses Programm darf als Quellprogramm wie auch als exekutierbare        *
  32. *   Version frei kopiert und verwendet werden. Es ist aber ausdrücklich      *
  33. *   verboten, Quell- oder Objektprogramm in gleichgültig welcher Weise zu    *
  34. *   zu verändern, und in den Umlauf zu bringen. Den registrierten Benutzern  *
  35. *   des Deutschen Pascals wird das Recht eingeräumt, die in diesem Programm  *
  36. *   enthaltenen Routinen in Ihren eigenen Programmen zu verwenden.           *
  37. *****************************************************************************)
  38.  
  39. Konstante
  40.   Meldg0  = '                                                                                ';
  41.   Meldg1  = '+++ bci software mitteilung +++ bci software mitteilung +++ bci software mittei';
  42.   Meldg2  = 'Programm Zins;                                                                 ';
  43.   Meldg3  = '  Variable                                                                     ';
  44.   Meldg4  = '    gegenwärtig  :   Gleit;                                                    ';
  45.   Meldg5  = '    zukünftig    :   Gleit;                                                    ';
  46.   Meldg6  = '    Jahre        :   Gleit;                                                    ';
  47.   Meldg7  = '    Zinsfuß      :   Gleit;                                                    ';
  48.   Meldg9  = '  Funktion Zinseszins (gegenwärtig, Zinsfuß, Jahre, : Gleit) : Gleit;          ';
  49.   Meldg10 = '    Anfang                                                                     ';
  50.   Meldg11 = '      Zinseszins := gegenwärtig*exp(ln(1+Zinsfuß)*Jahre);                      ';
  51.   Meldg12 = '    Ende;                                                                      ';
  52.   Meldg14 = '  Anfang                                                                       ';
  53.   Meldg15 = '    schreibezl(''Einfache Zinseszinsrechnung: Bitte Betrag, Zinsfuß '');       ';
  54.   Meldg16 = '    schreibezl(''und Jahre getrennt durch Leerzeichen eingeben: '');           ';
  55.   Meldg17 = '    lieszl(gegenwärtig, Zinsfuß, Jahre);                                       ';
  56.   Meldg18 = '    Zinsfuß := Zinsfuß/100;                                                    ';
  57.   Meldg19 = '    zukünftig := Zinseszins (gegenwärtig, Zinsfuß, Jahre);                     ';
  58.   Meldg20 = '    schreibezl(''Der Endbetrag ist gleich '', zukünftig)                       ';
  59.   Meldg21 = '  Ende.                                                                        ';
  60.   Meldg22 = 'Deutsches Pascal/i86';
  61.   Meldg23 = 'Zusammenfassung der Vorteile des neuen Programmentwicklungssystems';
  62.   Meldg24 = 'Erforderliche Systemausstattung';
  63.   Meldg25 = 'Lieferumfang und Preis';
  64.  
  65.   Adr0    = 'Exklusiv Distributor';
  66.   Adr1    = 'D M V';
  67.   Adr2    = 'Daten & Medien Verlagsges. mbH';
  68.   Adr3    = 'Fuldaer Str. 6, 3440 Eschwege';
  69.  
  70. (**************************************************************************
  71. * Typenvereinbarungen                                                     *
  72. * -------------------                                                     *
  73. *                                                                         *
  74. * === Kommandos ===                                                       *
  75. * Interessant ist hier die Definition der Kommandos als Kontrollkonstruct *
  76. * zur Steuerung der Ablauffolge der einzelnen Screens. Eine völlig andere *
  77. * Reihenfolge kann durch andere Anordnung der Elemente erzielt werden.    *
  78. * Wichtig: Alle Elemente müssen ultimativ zu Prozeduren oder Funktionen   *
  79. * führen (siehe Hauptprogramm). Hier ist auch eine Fehlerquelle für den   *
  80. * unvorsichtigen Programmierer, es kann so eine nicht existente Routine   *
  81. * angesprungen werden, was kein Compiler beim Compilieren erkennen kann,  *
  82. * und zur Laufzeit zum "halting state" führt.                             *
  83. *                                                                         *
  84. * === Register ===                                                        *
  85. * Abbildung der Register der 8088 CPU als Byte (low, high) bzw.           *
  86. * "Redefinition" des ganzen Registers als Integer                         *
  87. **************************************************************************)
  88.  
  89.  
  90. Typus
  91.   Byte              =   0..255;
  92.   Farben            = ( schwarz,     blau,       grün,     metallic,
  93.                         rot,         violet,     braun,    grau,
  94.                         hellschwarz, hellblau,   hellgrün, silber,
  95.                         hellrot,     hellviolet, gelb,     weiß );
  96.   Folge80           =   Folge(80);
  97.   Kommandos         = ( K_Hallo,       K_Mitteilung,    K_Prg1_deutsch,
  98.                         K_Prg1_Wörter, K_Prg1_englisch, K_Prg1_gemischt,
  99.                         K_Prg1_Umlaut, K_Bibliotheken,  K_Vorteile,
  100.                         K_System,      K_Lieferung                      );
  101.   Null_Länge        =   Folge(0);
  102.   Rahmenart         = ( einfach, doppelt);
  103.   Register          =
  104.     Satz
  105.       falls integer von                 { 4 Datenregister mit je 16 bits   }
  106.         0: (al,ah,                      { = Wort    => ax,bx,cx,dx) bzw.   }
  107.             bl,bh,                      { = 2 Bytes => al,ah,bl,bh,...     }
  108.             cl,ch,                      { wobei al => Register A, low byte }
  109.             dl,dh   : Byte);            { und   ah => Register A, high byte}
  110.         1: (ax,bx,
  111.             cx,dx   : Integer);
  112.     Ende;
  113.  
  114. Variable
  115.   Ausgabezeile          : Folge80;
  116.   Adresse               : Bereich[0..3] von Folge80;
  117.   Eingabe               : Zeichen;
  118.   Folgenlänge           : Integer;
  119.   i,j                   : Integer;
  120.   Kommando, Letztes_Kmd : Kommandos;
  121.   Meldung               : Bereich[0..100] von Folge80;
  122.   Mode                  : Integer;
  123.   Spalte, Zeile         : Integer;
  124.  
  125.  
  126. (**************************************************************************
  127. * vorvereinbarte Referenzen von Prozeduren/Funktionen                     *
  128. ***************************************************************************)
  129.  
  130. Prozedur farbig       ( Ausgabetext   : Folge80;
  131.                         Farbe         : Farben;
  132.                         Spalte, Zeile : Integer    ); Referenz;
  133. Prozedur farbig_warte ( Ausgabetext   : Folge80;
  134.                         Farbe         : Farben;
  135.                         Spalte, Zeile : Integer;
  136.                         sek           : Integer    ); Referenz;
  137. Prozedur Haken        ( Zeile         : Integer    ); Referenz;
  138. Prozedur Linie        ( Spaltelinks,
  139.                         Zeile,
  140.                         Spalterechts  : Integer;
  141.                         Art           : Rahmenart;
  142.                         Farbe         : Farben     ); Referenz;
  143. Prozedur Mitte        ( Ausgabetext   : Folge80;
  144.                         Farbe         : Farben;
  145.                         Zeile         : Integer    ); Referenz;
  146. Prozedur Pause;                                       Referenz;
  147. Prozedur Programm_ausgabe;                            Referenz;
  148. Prozedur Rahmen       ( Spaltelinks,
  149.                         Zeileoben,
  150.                         Spalterechts,
  151.                         Zeileunten    : Integer;
  152.                         Art           : Rahmenart;
  153.                         Farbe         : Farben     ); Referenz;
  154. Prozedur schreibe_attr( Zeichencode,
  155.                         Seite, Farbe  : Byte       ); Referenz;
  156. Prozedur tausche      ( Eins, Zwei    : Integer    ); Referenz;
  157. Prozedur warte        ( sek           : Integer    ); Referenz;
  158.  
  159. (**************************************************************************
  160. * externe Referenzen von Prozeduren/Funktionen                            *
  161. ***************************************************************************)
  162.  
  163. Funktion Länge        ( Variable i    : Null_Länge ): Integer; extern;
  164. Prozedur pos          ( Spalte, Zeile : Integer    ); extern;
  165. Prozedur rufeBIOS     ( Var X         : Register   ); extern;
  166. Prozedur rufeDOS      ( Var X         : Register   ); extern;
  167.  
  168.  
  169. Prozedur Bibliotheken;
  170.   Anfang
  171.     Vorschub;
  172.     farbig( Meldg22, gelb, 3,0 );
  173.     farbig( ' schließt eine komplette Sammlung von Prozedur- und', weiß, 23,0 );
  174.     farbig( ' Funktionenbibliotheken ein... natürlich ohne Aufpreis!', weiß, 12,1);
  175.     Rahmen(  0,  3, 56,  5, einfach, metallic );
  176.     Rahmen(  4,  6, 60,  9, einfach, blau     );
  177.     Rahmen(  8, 10, 65, 13, einfach, gelb     );
  178.     Rahmen( 13, 14, 71, 18, doppelt, rot      );
  179.     Rahmen( 17, 19, 78, 22, doppelt, grün     );
  180.     farbig( ' Standardbibliothek ', weiß, 3, 3);
  181.     farbig_warte( '... enthält die üblichen Allzweckroutinen', grau, 3,4,1 );
  182.     farbig( ' Integerbibliothek ', weiß, 7, 6);
  183.     farbig( '... für das superkompakte Programm.', grau, 7,7 );
  184.     farbig_warte( 'Ideal für Systemprogrammierung!', grau, 11, 8, 1 );
  185.     farbig( ' Gleitpunktbibliothek ', weiß, 11, 10);
  186.     farbig( '... umfangreiche Sammlung äußerst leistungstarker', grau, 11, 11);
  187.     farbig_warte( 'mathematischer Routinen (64 bits Präzision)', grau, 15, 12, 1);
  188.     farbig( ' 8087/80287-Bibliothek ', weiß, 16,14 );
  189.     farbig( '... nutzt vorhandenen 8087- bzw. 80287-Arithmetik-', grau, 16, 15 );
  190.     farbig( 'koprozessor für höchste Präzision und extrem', grau, 20, 16);
  191.     farbig_warte( 'schnelle Verarbeitungsgeschwindigkeit', grau, 20, 17, 1);
  192.     farbig( ' BCD-Bibliothek ', weiß, 20, 19 );
  193.     farbig( '... binär-codierte Dezimalzahlen für absolute Genauigkeit.', grau, 20, 20 );
  194.     farbig_warte( 'Hervorragend in der Finanzmathematik einzusetzen!', grau, 24, 21, 3);
  195.     Pause;
  196.     falls Eingabe gleich
  197.       'e'     : Eingabe := 'E';
  198.       'v', 'V': Kommando := Vorwert(K_Bibliotheken);
  199.     andernfalls
  200.       Kommando := Nachwert(K_Bibliotheken);
  201.     Ende;
  202.   Ende; { Bibliotheken }
  203.  
  204. Prozedur Danke;
  205.   Anfang
  206.     Vorschub;
  207.     mitte( 'Die Mannschaft von', grau, 0);
  208.     mitte( 'B C I', metallic, 1);
  209.     mitte( 'Benthien Consulting International', metallic, 2);
  210.     mitte( 'dankt Ihnen für Ihre Aufmerksamkeit, und hofft daß unsere kleine Show', grau, 3);
  211.     mitte( 'Spaß gemacht hat und alle Ihre Fragen bezüglich unseres Compilers', grau, 4 );
  212.     mitte(  Meldg22, gelb, 6);
  213.     mitte( 'beantworten konnte.', grau, 8);
  214.     mitte( 'Bitte wenden Sie sich im Falle von weiteren Fragen oder Bestellungen an:', grau, 9);
  215.     mitte(  Adresse[0], gelb, 11 );
  216.     mitte(  Adresse[1], gelb, 12 );
  217.     mitte(  Adresse[2], gelb, 13 );
  218.     mitte(  Adresse[3], gelb, 14 );
  219.     pos (1,23);
  220.   Ende; { Danke }
  221.  
  222. (**************************************************************************
  223. * Prozedur Dialograhmen gibt Text in korrekt bemessenem Rahmen aus,       *
  224. * allerdings ohne den schon auf dem Bildschirm vorhandenen Text zu retten.*
  225. * Wäre aber nicht so schwierig...                                         *
  226. * Haben wir hier nicht gemacht, weil der Text auch so paßt...             *
  227. ***************************************************************************)
  228.  
  229. Prozedur Dialograhmen (Ausgabetext : Folge80);       { gibt Text in Dialog-    }
  230.   Variable                                           { rahmen aus              }
  231.     Anzahl       : Integer;
  232.     Spaltelinks  : Integer;
  233.     Spalterechts : Integer;
  234.     Zeile        : Integer;
  235.  
  236.   Anfang
  237.     Anzahl := Länge( Ausgabetext );
  238.     Spaltelinks := 39 - (Anzahl div 2);
  239.     Spalterechts := 80 - Spaltelinks;
  240.     Zeile := 20;
  241.     für i := 20 hinauf 23 tue
  242.       Anfang
  243.         pos( 0,i );
  244.         schreibe( Meldg0 );                               {evt. vorhandenen}
  245.       Ende;                                               {Text löschen    }
  246.     farbig( '╓', rot, Spaltelinks, Zeile);                {Rahmen bauen    }
  247.     für i := Spaltelinks + 1 hinauf Spalterechts - 1 tue
  248.       farbig( '─', rot, i, Zeile);
  249.     farbig( '╖', rot, Spalterechts, Zeile);
  250.     farbig( '║', rot, Spalterechts, Zeile + 1);
  251.     farbig( '╜', rot, Spalterechts, Zeile + 2);
  252.     für i := Spalterechts - 1 hinab Spaltelinks + 1 tue
  253.       farbig( '─', rot, i, Zeile + 2);
  254.     farbig( '╙', rot, Spaltelinks, Zeile + 2);
  255.     farbig( '║', rot, Spaltelinks, Zeile + 1);
  256.     farbig( Ausgabetext, grau, Spaltelinks + 2, Zeile + 1 );
  257.   Ende; { Dialograhmen }
  258.  
  259.  
  260. Prozedur farbig;                               { diese Funktion schreibt Text }
  261.   Variable                                     { in gewünschter Farbe an be-  }
  262.     Anzahl : Integer;                          { timmter Position auf den     }
  263.     Reg    : Register;                         { auf den Bildschirm           }
  264.  
  265.   Anfang
  266.     Anzahl := Länge( Ausgabetext );
  267.     pos( Spalte, Zeile );
  268.     (* Setze Attribute *)
  269.       Reg.ah := 09h;                           { es handelt sich hier um }
  270.       Reg.al := 20h;                           { mächtige BIOS-Routinen  }
  271.       Reg.bh := 00h;
  272.       Reg.bl := ord(Farbe);
  273.       Reg.cx := Anzahl;
  274.       rufebios ( Reg );
  275.     schreibe( Ausgabetext );
  276.   Ende; { farbig }
  277.  
  278.  
  279. Prozedur farbig_warte;                                   { diese Funktion ruft }
  280.                                                          { "farbig" und wartet }
  281.   Anfang                                                 { bis spezifizierte   }
  282.     farbig( Ausgabetext, Farbe, Spalte, Zeile );         { Anzahl Sekunden     }
  283.     warte( sek );                                        { verstrichen ist...  }
  284.   Ende; { farbig_warte }                                  { ..bewirkt drastische}
  285.                                                          { Verlangsamung des   }
  286.                                                          { Programms           }
  287. Prozedur Hallo;
  288.   Typus
  289.     ZeilenInhalt              = Folge(57);
  290.   Variable
  291.     Farbe                     : Integer;
  292.     Hallo                     : Bereich[1..6] von Zeileninhalt;
  293.     Hallozeile                : Integer;
  294.     Seite                     : Byte;
  295.  
  296.   Anfang
  297.     Vorschub;
  298.     Kommando   := Nachwert(K_Hallo);
  299.     Seite      :=  0;
  300.     Spalte     := 10;
  301.     Zeile      := 10;
  302.     Hallozeile :=  1;
  303.     Hallo[1]   := '▓      ▓   ▓▓▓▓▓▓   ▓       ▓        ▓▓▓▓▓▓     ▓▓  ▓▓▓▓ ';
  304.     Hallo[2]   := '▓      ▓  ▓      ▓  ▓       ▓       ▓      ▓     ▓      ▓';
  305.     Hallo[3]   := '▓      ▓  ▓      ▓  ▓       ▓       ▓      ▓     ▓      ▓';
  306.     Hallo[4]   := '▓▓▓▓▓▓▓▓  ▓▓▓▓▓▓▓▓  ▓       ▓       ▓      ▓     ▓    ▓▓▓';
  307.     Hallo[5]   := '▓      ▓  ▓      ▓  ▓       ▓       ▓      ▓             ';
  308.     Hallo[6]   := '▓      ▓  ▓      ▓  ▓▓▓▓▓▓  ▓▓▓▓▓▓   ▓▓▓▓▓▓      ▓      ▓';
  309.  
  310.     für i := 1 hinauf 12 tue
  311.       Anfang
  312.         falls i gleich
  313.           1, 5,  9 : Farbe := 01h; {blau}
  314.           2, 6, 10 : Farbe := 0Eh; {gelb}
  315.           3, 7, 11 : Farbe := 04h; {cyan}
  316.           4, 8, 12 : Farbe := 03h; {rot }
  317.         Ende;
  318.  
  319.         für j := 1 hinauf 57 tue
  320.           Anfang
  321.             pos (Spalte, Zeile);
  322.             für Hallozeile := 1 hinauf 6 tue             { schreibe 1 Spalte }
  323.               Anfang                                     { aller Zeilen }
  324.                 schreibe_attr( ord(hallo[Hallozeile][j]), Seite, Farbe);
  325.                 Zeile := Zeile + 1;
  326.                 pos (Spalte, Zeile);
  327.               Ende;
  328.             Zeile := 10;
  329.             Spalte := Spalte + 1;
  330.           Ende;
  331.         Spalte := 10;
  332.       Ende;
  333.   Ende; {Hallo}
  334.  
  335.  
  336. Prozedur Haken;
  337.   Anfang
  338.     farbig( '√', rot, 3, Zeile );
  339.   Ende; { Haken }
  340.  
  341.  
  342. Prozedur Initialisieren;
  343.   Variable
  344.     Buchstabe  :  Zeichen;
  345.     Satznummer :  Integer;
  346.  
  347.   Anfang
  348.     Meldung[0] := Meldg0;
  349.     Meldung[1] := Meldg1;
  350.     Meldung[2] := Meldg2;
  351.     Meldung[3] := Meldg3;
  352.     Meldung[4] := Meldg4;
  353.     Meldung[5] := Meldg5;
  354.     Meldung[6] := Meldg6;
  355.     Meldung[7] := Meldg7;
  356.     Meldung[8] := Meldg0;
  357.     Meldung[9] := Meldg9;
  358.     Meldung[10] := Meldg10;
  359.     Meldung[11] := Meldg11;
  360.     Meldung[12] := Meldg12;
  361.     Meldung[13] := Meldg0;
  362.     Meldung[14] := Meldg14;
  363.     Meldung[15] := Meldg15;
  364.     Meldung[16] := Meldg16;
  365.     Meldung[17] := Meldg17;
  366.     Meldung[18] := Meldg18;
  367.     Meldung[19] := Meldg19;
  368.     Meldung[20] := Meldg20;
  369.     Meldung[21] := Meldg21;
  370.  
  371.     Adresse[0]  := Adr0;
  372.     Adresse[1]  := Adr1;
  373.     Adresse[2]  := Adr2;
  374.     Adresse[3]  := Adr3;
  375.  
  376.   Ende; { Initialisieren }
  377.  
  378.  
  379. Prozedur Lieferung;
  380.   Anfang
  381.     Vorschub;
  382.     Rahmen( 0, 0, 79, 3, einfach, metallic );
  383.     Linie( 0, 22, 79, doppelt, metallic );
  384.     mitte( Meldg25, grau, 1 );
  385.     mitte( Meldg22, gelb, 2 );
  386.     farbig_warte( 'Lieferumfang', gelb, 0, 5, 1 );
  387.     Haken( 7 );
  388.     farbig_warte( 'Mehrphasiger, zweisprachiger und hochoptimierender Pascalcompiler', grau, 6, 7, 1 );
  389.     Haken( 9 );
  390.     farbig_warte( 'Quellprogrammlistengenerator integriert in Compiler', grau, 6, 9, 1 );
  391.     Haken( 11 );
  392.     farbig_warte( 'Deutsches Handbuch mit ca. 200 Seiten, 119 Abbildungen/Syntaxgraphen', grau, 6, 11, 1 );
  393.     Haken( 13 );
  394.     farbig_warte( 'Über 100 ausführbare Programmbeispiele zum Testen und Studieren', grau, 6, 13, 1);
  395.     Haken( 15 );
  396.     farbig_warte( 'Leistungsfähiger Spezialprogrammeditor mit ca. 40 Funktionen', grau, 6, 15, 1);
  397.     farbig_warte( 'Unverbindliche Preisempfehlung', gelb, 0, 17, 1);
  398.     Haken( 19 );
  399.     farbig_warte( 'DM 249.50 inklusive MwSt, Verpackung, Porto frei Haus', grau, 6, 19, 1);
  400.     Haken( 21 );
  401.     farbig_warte( 'DM 218.86 ohne MwSt. Händler- und Schulpreise auf Anfrage', grau, 6, 21, 1);
  402.     Pause;
  403.     Eingabe := 'E';
  404.  
  405. (*    falls Eingabe gleich                           { falls weitere Kommandos }
  406. (*    'e'     : Eingabe := 'E';                      { folgen, muß dieser Code }
  407. (*    'v', 'V': Kommando := Vorwert(K_Lieferung)     { aktiviert werden        }
  408. (*  andernfalls
  409.       Kommando := Nachwert(K_Lieferung);
  410.     Ende;
  411. *)
  412.   Ende; { Lieferung}
  413.  
  414.  
  415. Prozedur Linie;
  416.   Variable
  417.     Linienelement : Zeichen;
  418.  
  419.   Anfang
  420.     wenn Art = einfach
  421.       dann Linienelement := '─'
  422.       sonst Linienelement := '═';
  423.     für Spalte := Spaltelinks hinauf Spalterechts tue
  424.       farbig( '─', Farbe, Spalte, Zeile );
  425.   Ende; { Linie }
  426.  
  427.  
  428. Prozedur Mitte;
  429.   Anfang
  430.     Spalte := (80 - Länge( Ausgabetext )) div 2;
  431.     farbig( Ausgabetext, Farbe, Spalte, Zeile);
  432.   Ende; { Mitte }
  433.  
  434. Prozedur Mitteilung;
  435.   Anfang
  436.     Vorschub;
  437.     für i := 1 hinauf 4 tue                                { Zeilen auf Screen }
  438.       Anfang
  439.         falls i gleich
  440.           1 : Zeile :=  0;
  441.           2 : Zeile :=  2;
  442.           3 : Zeile := 20;
  443.           4 : Zeile := 22;
  444.         Ende;
  445.         für Spalte := 0 hinauf 79 tue
  446.           Anfang
  447.             pos( Spalte, Zeile );
  448.             schreibe( '─' );
  449.           Ende;
  450.       Ende;                                           { Ende Zeilen auf Screen }
  451.  
  452.       farbig( Meldg1, weiß, 1, 1 );                  { bci software mitteilung }
  453.       farbig( Meldg1, weiß, 1,21 );
  454.       pos( 0,24 );
  455.       warte ( 2 );
  456.  
  457.       farbig_warte( 'Sehr geehrte Programmiererinnen und Programmierer!', weiß, 0,4,1 );
  458.       farbig_warte( 'Wir möchten Ihnen unseren "zwei in einem" Compiler vorstellen:', weiß, 0,6,1 );
  459.       farbig_warte( 'D E U T S C H E S   P A S C A L / i86', gelb, 22,8, 2 );
  460.       Haken( 10 );
  461.       farbig_warte( '100% Standardpascal (englisch)', weiß, 6,10,1 );
  462.       Haken( 11 );
  463.       farbig_warte( '100% deutsches Pascal', weiß, 6,11,1 );
  464.       Haken( 12 );
  465.       farbig_warte( 'jede beliebige deutsch/englische Mischung', weiß, 6,12,1 );
  466.       pos( 0,14 );
  467.       schreibezl('Das Konzept eines zweisprachigen Compilers ist eine absolute Weltneuheit');
  468.       schreibezl('aus dem Hause BCI. Wir kommen damit dem Wunsche vieler deutschsprachigen');
  469.       schreibezl('Programmierer und Programmiererinnen entgegen, äußerst lesbare und wart-');
  470.       schreibezl('bare Programme in Ihrer Muttersprache zu schreiben. Auf den nächsten Seiten');
  471.       schreibe('informieren wir Sie über das sehr leistungsstarke ');
  472.       farbig('Deutsche Pascal/i86.', gelb, 50,18 );
  473.  
  474.       Pause;
  475.       falls Eingabe gleich
  476.         'e'     : Eingabe := 'E';
  477.         'v', 'V': Kommando := Vorwert(K_Mitteilung);
  478.       andernfalls
  479.         Kommando := Nachwert(K_Mitteilung);
  480.       Ende;
  481.   Ende;
  482.  
  483. Prozedur Pause;
  484.   Anfang
  485.     farbig( 'Bitte'               , grau,  0,23 );
  486.     farbig( 'v'                   , gelb,  6,23 );
  487.     farbig( 'orherige oder'       , grau,  7,23 );
  488.     farbig( 'n'                   , gelb, 21,23 );
  489.     farbig( 'ächste Seite oder'   , grau, 22,23 );
  490.     farbig( 'E'                   , gelb, 40,23 );
  491.     farbig( 'nde + Eingabetaste <', grau, 41,23 );
  492.     farbig( Ascii(17)             , grau, 60,23 );
  493.     farbig( '─┘ betätigen! '      , grau, 61,23 );
  494.     lieszl(Eingabe);
  495.   Ende; { Pause }
  496.  
  497. Prozedur Prg1_deutsch;
  498.   Anfang
  499.     wenn letztes_Kmd <> K_Prg1_Wörter
  500.       dann Vorschub;
  501.     Programm_Ausgabe;
  502.     Dialograhmen( 'Hier sehen Sie ein in Deutschem Pascal geschriebenes Beispiel.');
  503.     Pause;
  504.     falls Eingabe gleich
  505.       'e'     : Eingabe := 'E';
  506.       'v', 'V': Kommando := Vorwert(K_Prg1_deutsch);
  507.     andernfalls
  508.       Kommando := Nachwert(K_Prg1_deutsch);
  509.     Ende;
  510.   Ende;
  511.  
  512. Prozedur Prg1_englisch;
  513.   Anfang
  514.     Dialograhmen( 'Außerdem kann Standardpascal zu 100% verarbeitet werden!' );
  515.     farbig_warte( 'program ',   gelb, 0, 0, 1 );
  516.     farbig_warte( 'variable',   gelb, 2, 1, 1 );
  517.     farbig_warte( 'function',   gelb, 2, 7, 1 );
  518.     farbig      ( 'begin ',     gelb, 4, 8    );
  519.     farbig_warte( 'begin ',     gelb, 2,12, 1 );
  520.     farbig      ( 'end ',       gelb, 4,10    );
  521.     farbig_warte( 'end ',       gelb, 2,19, 1 );
  522.     farbig      ( 'writeln   ', gelb, 4,13    );
  523.     farbig      ( 'writeln   ', gelb, 4,14    );
  524.     farbig_warte( 'writeln   ', gelb, 4,18, 1 );
  525.     farbig_warte( 'readln',     gelb, 4,15, 1 );
  526.     Pause;
  527.     letztes_Kmd := K_Prg1_englisch;
  528.     falls Eingabe gleich
  529.       'e'     : Eingabe := 'E';
  530.       'v', 'V': Kommando := Vorwert(K_Prg1_englisch);
  531.     andernfalls
  532.       Kommando := Nachwert(K_Prg1_englisch);
  533.     Ende;
  534.   Ende;
  535.  
  536. Prozedur Prg1_gemischt;
  537.   Anfang
  538.     Dialograhmen( 'Sogar absolut jede Sprachmischung wird mühelos verkraftet!' );
  539.     farbig_warte( 'Programm',   hellgrün, 0, 0, 1 );
  540.     farbig_warte( 'variable',   gelb,     2, 1, 1 );
  541.     farbig_warte( 'function',   gelb,     2, 7, 1 );
  542.     farbig      ( 'Anfang',     hellgrün, 4, 8    );
  543.     farbig_warte( 'begin ',     gelb,     2,12, 1 );
  544.     farbig      ( 'end ',       gelb,     4,10    );
  545.     farbig_warte( 'Ende',       hellgrün, 2,19, 1 );
  546.     farbig      ( 'schreibezl', hellgrün, 4,13    );
  547.     farbig      ( 'writeln   ', gelb,     4,14    );
  548.     farbig_warte( 'writeln   ', gelb,     4,18, 1 );
  549.     farbig_warte( 'lieszl',     hellgrün, 4,15, 1 );
  550.     Pause;
  551.     letztes_Kmd := K_Prg1_gemischt;
  552.     falls Eingabe gleich
  553.       'e'     : Eingabe := 'E';
  554.       'v', 'V': Kommando := Vorwert(K_Prg1_gemischt);
  555.     andernfalls
  556.       Kommando := Nachwert(K_Prg1_gemischt);
  557.     Ende;
  558.   Ende;
  559.  
  560. Prozedur Prg1_Umlaut;
  561.   Anfang
  562.     Programm_Ausgabe;
  563.     Dialograhmen( 'Natürlich können Sie alle Umlaute und "ß" überall verwenden!');
  564.     farbig_warte( 'ä',   metallic, 10, 2, 1 );
  565.     farbig_warte( 'ü',   metallic,  7, 3, 1 );
  566.     farbig_warte( 'ß',   metallic, 10, 5, 1 );
  567.     farbig_warte( 'ä',   metallic, 29, 7, 1 );
  568.     farbig_warte( 'ß',   metallic, 42, 7, 1 );
  569.     farbig_warte( 'ä',   metallic, 26, 9, 1 );
  570.     farbig_warte( 'ß',   metallic, 47, 9, 1 );
  571.     farbig_warte( 'ß',   metallic, 65,13, 1 );
  572.     farbig_warte( 'ä',   metallic, 17,15, 1 );
  573.     farbig_warte( 'ß',   metallic, 30,15, 1 );
  574.     farbig_warte( 'ß',   metallic, 10,16, 1 );
  575.     farbig_warte( 'ß',   metallic, 21,16, 1 );
  576.     farbig_warte( 'ü',   metallic,  7,17, 1 );
  577.     farbig_warte( 'ä',   metallic, 35,17, 1 );
  578.     farbig_warte( 'ß',   metallic, 48,17, 1 );
  579.     farbig_warte( 'ü',   metallic, 47,18, 1 );
  580.     Pause;
  581.     falls Eingabe gleich
  582.       'e'     : Eingabe := 'E';
  583.       'v', 'V': Kommando := Vorwert(K_Prg1_Umlaut);
  584.     andernfalls
  585.       Kommando := Nachwert(K_Prg1_Umlaut);
  586.     Ende;
  587.   Ende;
  588.  
  589. Prozedur Prg1_Wörter;
  590.   Anfang
  591.     Dialograhmen( 'Alle reservierten Wörter können auf deutsch programmiert werden!' );
  592.     farbig_warte( 'Programm',   hellgrün, 0, 0, 1 );
  593.     farbig_warte( 'Variable',   hellgrün, 2, 1, 1 );
  594.     farbig_warte( 'Funktion',   hellgrün, 2, 7, 1 );
  595.     farbig      ( 'Anfang',     hellgrün, 4, 8    );
  596.     farbig_warte( 'Anfang',     hellgrün, 2,12, 1 );
  597.     farbig      ( 'Ende',       hellgrün, 4,10    );
  598.     farbig_warte( 'Ende',       hellgrün, 2,19, 1 );
  599.     farbig      ( 'schreibezl', hellgrün, 4,13    );
  600.     farbig      ( 'schreibezl', hellgrün, 4,14    );
  601.     farbig_warte( 'schreibezl', hellgrün, 4,18, 1 );
  602.     farbig_warte( 'lieszl',     hellgrün, 4,15, 1 );
  603.     Pause;
  604.     letztes_Kmd := K_Prg1_Wörter;
  605.     falls Eingabe gleich
  606.       'e'     : Eingabe := 'E';
  607.       'v', 'V': Kommando := Vorwert(K_Prg1_Wörter);
  608.     andernfalls
  609.       Kommando := Nachwert(K_Prg1_Wörter);
  610.     Ende;
  611.   Ende;
  612.  
  613. Prozedur Programm_Ausgabe;
  614.   Anfang
  615.     für i := 2 hinauf 21 tue
  616.       Anfang
  617.         farbig( Meldung[i], grau, 0,i-2 );
  618.       Ende;
  619.   Ende;
  620.  
  621. Prozedur Rahmen;
  622.   Anfang
  623.     wenn Zeileoben > Zeileunten
  624.       dann tausche( Zeileoben, Zeileunten );
  625.     wenn Spaltelinks > Spalterechts
  626.       dann tausche( Spaltelinks, Spalterechts );
  627.     wenn Art = einfach
  628.       dann
  629.         Anfang
  630.           farbig( '┌', Farbe, Spaltelinks, Zeileoben );
  631.           für Spalte := Spaltelinks+1 hinauf Spalterechts tue
  632.             farbig( '─', Farbe, Spalte, Zeileoben );
  633.           farbig( '┐', Farbe, Spalterechts, Zeileoben );
  634.           für Zeile := Zeileoben+1 hinauf Zeileunten tue
  635.             farbig( '│', Farbe, Spalterechts, Zeile );
  636.           farbig( '┘', Farbe, Spalterechts, Zeileunten );
  637.           für Spalte := Spalterechts-1 hinab Spaltelinks tue
  638.             farbig( '─', Farbe, Spalte, Zeileunten );
  639.           farbig( '└', Farbe, Spaltelinks, Zeileunten );
  640.           für Zeile := Zeileunten-1 hinab Zeileoben+1 tue
  641.             farbig( '│', Farbe, Spaltelinks, Zeile );
  642.         Ende
  643.       sonst
  644.         Anfang
  645.           farbig( '╔', Farbe, Spaltelinks, Zeileoben );
  646.           für Spalte := Spaltelinks+1 hinauf Spalterechts tue
  647.             farbig( '═', Farbe, Spalte, Zeileoben );
  648.           farbig( '╗', Farbe, Spalterechts, Zeileoben );
  649.           für Zeile := Zeileoben+1 hinauf Zeileunten tue
  650.             farbig( '║', Farbe, Spalterechts, Zeile );
  651.           farbig( '╝', Farbe, Spalterechts, Zeileunten );
  652.           für Spalte := Spalterechts-1 hinab Spaltelinks tue
  653.             farbig( '═', Farbe, Spalte, Zeileunten );
  654.           farbig( '╚', Farbe, Spaltelinks, Zeileunten );
  655.           für Zeile := Zeileunten-1 hinab Zeileoben+1 tue
  656.             farbig( '║', Farbe, Spaltelinks, Zeile );
  657.         Ende
  658.   Ende;
  659.  
  660. Prozedur schreibe_attr;
  661.   Variable
  662.     Reg     :   Register;
  663.   Anfang
  664.     Reg.ah := 09h;
  665.     Reg.al := Zeichencode;
  666.     Reg.bh := Seite;
  667.     Reg.bl := Farbe;
  668.     Reg.cx := 01h;
  669.     rufeBIOS ( Reg );
  670.   Ende;
  671.  
  672. Prozedur System;
  673.   Anfang
  674.     Vorschub;
  675.     Rahmen( 0, 0, 79, 3, einfach, metallic );
  676.     Linie( 0, 22, 79, doppelt, metallic );
  677.     mitte( Meldg24, grau, 1 );
  678.     mitte( Meldg22, gelb, 2 );
  679.     farbig_warte( 'Mindestanforderungen an das Entwicklungssystem', gelb, 0, 5, 1 );
  680.     Haken( 7 );
  681.     farbig_warte( 'IBM PC, PC/XT, PC/AT oder kompatible', grau, 6, 7, 1 );
  682.     Haken( 9 );
  683.     farbig_warte( '256 KB Hauptspeicher', grau, 6, 9, 1 );
  684.     Haken( 11 );
  685.     farbig_warte( 'MS-DOS oder PC-DOS Version 2.0 oder höher', grau, 6, 11, 1 );
  686.     Haken( 13 );
  687.     farbig_warte( '2 Wechselplatten mit je 360 KB oder 1 Floppy mit 360 KB plus 1 Festplatte', grau, 6, 13, 1);
  688.     Haken( 15 );
  689.     farbig_warte( 'Farbiger oder monochromer Bildschirm (Grafik nicht erforderlich)', grau, 6, 15, 1);
  690.     farbig_warte( 'Nicht notwendige, aber einsetzbare Ausrüstung', gelb, 0, 17, 1);
  691.     Haken( 19 );
  692.     farbig_warte( '8087/80287-Arithmetikkoprozessor', grau, 6, 19, 1);
  693.     Haken( 21 );
  694.     farbig_warte( 'Bibliotheksverwaltungsprogramm LIB.EXE', grau, 6, 21, 1);
  695.  
  696.     Pause;
  697.     letztes_Kmd := K_Prg1_Wörter;
  698.     falls Eingabe gleich
  699.       'e'     : Eingabe := 'E';
  700.       'v', 'V': Kommando := Vorwert(K_System);
  701.     andernfalls
  702.       Kommando := Nachwert(K_System);
  703.     Ende;
  704.   Ende;
  705.  
  706. Prozedur Tausche;
  707.   Variable
  708.     Zwischenspeicher : Integer;
  709.  
  710.   Anfang
  711.     Zwischenspeicher := Eins;
  712.     Eins := Zwei;
  713.     Zwei := Zwischenspeicher;
  714.   Ende;
  715.  
  716. Prozedur Vorteile;
  717.   Anfang
  718.     Vorschub;
  719.     Rahmen( 0, 0, 79, 3, einfach, metallic );
  720.     Linie( 0, 22, 79, doppelt, metallic );
  721.     mitte( Meldg23, grau, 1 );
  722.     mitte( Meldg22, gelb, 2 );
  723.     farbig_warte( 'Optimale Ünterstützung in der Entwicklungsphase ', gelb, 0, 5, 1 );
  724.     Haken( 7 );
  725.     farbig_warte( 'Zweisprachige Quellprogramme', grau, 6, 7, 1 );
  726.     Haken( 9 );
  727.     farbig_warte( 'adressiert volle 640 KB Hauptspeicher', grau, 6, 9, 1 );
  728.     Haken( 11 );
  729.     farbig      ( 'alle Bibliotheken', grau, 6, 11 );
  730.     farbig      ( 'ohne', gelb, 24, 11 );
  731.     farbig_warte( 'Aufpreis', grau, 29, 11, 1 );
  732.     Haken( 13 );
  733.     farbig_warte( 'komplette, deutsche Umgebung: Handbuch, Fehler- und Systemmeldungen', grau, 6, 13, 1);
  734.     Haken( 15 );
  735.     farbig_warte( 'hervorragende Ünterstützung für den Anfänger (über 100 Programmbeispiele)', grau, 6, 15, 1);
  736.     farbig_warte( 'Optimale exekutierbare Programme', gelb, 0, 17, 1);
  737.     Haken( 19 );
  738.     farbig_warte( 'Erzeugung hochoptimierter Programme', grau, 6, 19, 1);
  739.     Haken( 21 );
  740.     farbig_warte( 'Superkompakte und daher extrem schnelle Programme', grau, 6, 21, 1);
  741.  
  742.     Pause;
  743.     falls Eingabe gleich
  744.       'e'     : Eingabe := 'E';
  745.       'v', 'V': Kommando := Vorwert(K_Vorteile);
  746.     andernfalls
  747.       Kommando := Nachwert(K_Vorteile);
  748.     Ende;
  749.   Ende;
  750.  
  751. Prozedur Warte;
  752.   Variable
  753.     Reg     : Register;
  754.     Sekunde : Integer;
  755.   Anfang
  756.     Reg.ah := 2Ch;
  757.     rufeDOS( Reg );
  758.     Sekunde := Reg.dh + sek;
  759.     Sekunde := Sekunde mod 60;
  760.     solange Sekunde <> Reg.dh tue
  761.       Anfang
  762.         Reg.ah := 2Ch;
  763.         rufeDOS( Reg );
  764.       Ende;
  765.   Ende;
  766.  
  767. Anfang { Hauptprogramm }
  768.   letztes_Kmd := K_Hallo;
  769.   Vorschub;
  770.   Initialisieren;
  771.   Kommando := K_Hallo;
  772.   Eingabe := 'x';
  773.   solange Eingabe <> 'E' tue
  774.     Anfang
  775.       falls Kommando gleich
  776.         K_Bibliotheken  : Bibliotheken;
  777.         K_Hallo         : Hallo;
  778.         K_Lieferung     : Lieferung
  779.         K_Mitteilung    : Mitteilung;
  780.         K_Prg1_deutsch  : Prg1_deutsch;
  781.         K_Prg1_englisch : Prg1_englisch;
  782.         K_Prg1_gemischt : Prg1_gemischt;
  783.         K_Prg1_Umlaut   : Prg1_Umlaut;
  784.         K_Prg1_Wörter   : Prg1_Wörter;
  785.         K_Vorteile      : Vorteile;
  786.         K_System        : System
  787.       andernfalls
  788.         Eingabe := 'E';
  789.       Ende;
  790.   Ende;
  791.   Danke;
  792. Ende. { Hauptprogramm }I