home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / qpdemo / grdemo.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-10  |  23KB  |  887 lines
  1. PROGRAM grdemo;
  2. { GRDEMO.PAS demonstriert die QuickPascal Graphikbibliothek.
  3.   Es benutzt zwei zusätzliche Units: Menu und Turtle (für
  4.   Schildkrötengraphik).
  5.   Hinweis: Stellen Sie sicher, daß in Optionen/Umgebung die
  6.   Umgebungsvariable für Units (.QPU) richtig gesetzt ist (z.B.:
  7.   c:\qp\Beispiel), damit der Compiler die Dateien TURTLE.PAS
  8.   und MENU.PAS auch findet und mitkompiliert.
  9. }
  10.  
  11. USES
  12.     MSGraph, Crt, menu, turtle;
  13.  
  14. CONST
  15.     haupt_menu : element_array_t =
  16.     ( ( WTast : 1; element :  'Beenden' ),
  17.       ( WTast : 1; element :  'Kreise' ),
  18.       ( WTast : 1; element :  'Rotierende Kugel' ),
  19.       ( WTast : 1; element :  'Tunnel' ),
  20.       ( WTast : 1; element :  'Spirale' ),
  21.       ( WTast : 1; element :  'Invertierte Spirale' ),
  22.       ( WTast : 1; element :  'Wanze' ),
  23.       ( WTast : 1; element :  'Fenster anpassen' ),
  24.       ( WTast : 1; element :  'Modus ändern' ),
  25.       ( WTast : 1; element :  '' ) ,
  26.       ( WTast : 1; element :  '' )
  27.     );
  28.  
  29.     modus_mldg = 'Graphikmodus kann nicht gesetzt werden.';
  30.  
  31.     { Konstanten für die Auswahl aus dem Hauptmenü }
  32.     do_beenden = 0;
  33.     do_kreise = 1;
  34.     do_kugel = 2;
  35.     do_tunnel = 3;
  36.     do_spirale = 4;
  37.     do_invert_spirale = 5;
  38.     do_wanze = 6;
  39.     do_anpassen = 7;
  40.     do_modus_aendern = 8;
  41.  
  42. TYPE
  43.     modus_array_t = ARRAY[0..14] OF Integer;
  44.  
  45. VAR
  46.     aktuelles_hauptm : Integer;     { Aktuelle Wahl aus dem Hauptmenü }
  47.     aktueller_modus : Integer;      { Aktuelle Wahl aus den Modi }
  48.     modus_array  : modus_array_t;   { Indiziert von aktueller_modus }
  49.     modus_menu   : element_array_t; { Menü der Graphikmodi }
  50.     bool_wert, farbe : Boolean;
  51.     vc : _VideoConfig;
  52.     zeilen_mitt, spalten_mitt : Byte;  { Bildschirmmitte }
  53.     modus : Integer;                { Modus }
  54.     rueck_code : Integer;
  55.     ch : Char;
  56.     ITast : Word;
  57.  
  58. { ============================ zufalls_gen =============================
  59.   Zufalls_gen gibt eine Zufallszahl vom Typ Integer zurück. Der Bereich
  60.   ist durch ihre Parameter beschränkt.
  61. }
  62.  
  63. FUNCTION zufalls_gen( min, max: Integer ) : Integer;
  64.  
  65.     BEGIN
  66.     zufalls_gen := Random( max - min ) + min;
  67.     END;   { Funktion zufalls_gen }
  68.  
  69. { ============================= anpassen  ===============================
  70.   Ändert Seitenverhältnis, Fenstergröße und Ort des Fensters entsprechend
  71.   den Eingaben des Benutzers.
  72.  }
  73.  
  74. PROCEDURE anpassen;
  75.  
  76. VAR
  77.     links, rechts, spitze, anfang : Integer;
  78.     i         : Integer;
  79.     fmt, tmp  : CSTRING;
  80.     taste     : Word;
  81.     vc        : _VideoConfig;
  82.  
  83. CONST
  84.     radius_xy : Real = 400.0;
  85.     fn_inkr = 4;
  86.     u_oben = $0148;   { Pfeil nach oben }
  87.     u_unten = $0150;  { Pfeil nach unten }
  88.     u_links = $014B;  { Pfeil nach links }
  89.     u_rechts = $014d; { Pfeil nach rechts }
  90.     s_oben = $0248;   { UMSCH + Pfeil nach oben }
  91.     s_unten = $0250;  { UMSCH + Pfeil nach unten }
  92.     s_links = $024B;  { UMSCH + Pfeil nach links }
  93.     s_rechts = $024d; { UMSCH + Pfeil nach rechts }
  94.     n_plus = $014E;   { Plustaste auf numerischen Tastenblock }
  95.     n_minus = $014A;  { Minustaste auf numerischen Tastenblock }
  96.     eingabe  = 13;    { Eingabetaste }
  97.     n_eingabe = $1E0; { Eingabetaste auf numerischen Tastenblock }
  98.  
  99. BEGIN
  100.     _GetVideoConfig( vc );
  101.     WHILE True DO
  102.     BEGIN
  103.     _SetTextPosition( 1, 2 );
  104.     _OutText(' PLUS und MINUS des numerischen Blocks passen'+
  105.          ' das Verhältnis an' );
  106.     _SetTextPosition( 2, 2 );
  107.     _OutText(' Pfeiltasten            Fenstergröße' );
  108.     _SetTextPosition( 3, 2 );
  109.     _OutText(' UMSCH + Pfeiltasten    Fenster verschieben' );
  110.     _SetTextPosition( 4, 2 );
  111.     _OutText(' Eingabe                Ende' );
  112.  
  113.     Str( TVerhYX:5:2, tmp );
  114.     fmt := ' Verhältnis = ' + tmp + '   xMax = ';
  115.     Str( tmaxx:5:2, tmp );
  116.     fmt := fmt + tmp + '   yMax = ';
  117.     Str( tmaxy:5:2, tmp );
  118.     fmt := fmt + tmp;
  119.     _SetTextPosition( 6, 2 );
  120.     _OutText( fmt );
  121.  
  122.     { Zeichne Rand und Kreis. }
  123.     Rechteck( 2 * tmaxx,  2 * tmaxy );
  124.     stiftkont( False );
  125.     gehzu( 75.0, 0.0 );
  126.     stiftkont( True );
  127.     kreis( radius_xy );
  128.     FOR i := 1 TO 4 DO
  129.         BEGIN
  130.         stiftkont( True );
  131.         Bewegen( radius_xy );
  132.         drehen( 180 );
  133.         stiftkont( False );
  134.         Bewegen( radius_xy );
  135.         drehen( 90 );
  136.         END;
  137.  
  138.     { Eingabe lesen und Werte entsprechend anpassen. }
  139.     holfenster( links, spitze, rechts, anfang );
  140.     taste := hol_taste( LEER_WART );
  141.     CASE taste OF
  142.         n_minus:
  143.         TVerhYX := (tmaxx - (fn_inkr * TEinh)) / tmaxy;
  144.         n_plus:
  145.         TVerhYX := (tmaxx + (fn_inkr * TEinh)) / tmaxy;
  146.         u_rechts:
  147.         BEGIN
  148.         IF (links < (vc.NumXPixels DIV 3) ) THEN
  149.             links := links + fn_inkr;
  150.         IF( rechts > (vc.NumXPixels - (vc.NumXPixels DIV 3)) )
  151.             THEN
  152.             rechts := rechts - fn_inkr;
  153.         END;
  154.         u_links:
  155.         BEGIN
  156.         IF( links <> 0 ) THEN
  157.             links := links - fn_inkr;
  158.         IF( rechts < vc.NumXPixels ) THEN
  159.             rechts := rechts + fn_inkr;
  160.         END;
  161.         u_unten:
  162.         BEGIN
  163.         IF (spitze < (vc.NumYPixels DIV 3) ) THEN
  164.             spitze := spitze + fn_inkr;
  165.         IF (anfang > (vc.NumYPixels - (vc.NumYPixels DIV 3)) )
  166.             THEN
  167.             anfang := anfang - fn_inkr;
  168.         END;
  169.         u_oben:
  170.         BEGIN
  171.         IF( spitze <> 0 ) THEN
  172.             spitze := spitze - fn_inkr;
  173.         IF( anfang < vc.NumYPixels ) THEN
  174.             anfang := anfang + fn_inkr;
  175.         END;
  176.         s_links:
  177.         IF( links <> 0 ) THEN
  178.             BEGIN
  179.             links := links - fn_inkr;
  180.             rechts := rechts - fn_inkr;
  181.             END;
  182.         s_rechts:
  183.         IF( rechts < vc.NumXPixels ) THEN
  184.             BEGIN
  185.             links := links + fn_inkr;
  186.             rechts := rechts +  fn_inkr;
  187.             END;
  188.         s_oben:
  189.         IF( spitze <> 0 ) THEN
  190.             BEGIN
  191.             spitze := spitze - fn_inkr;
  192.             anfang := anfang - fn_inkr;
  193.             END;
  194.         s_unten:
  195.         IF( anfang < vc.NumYPixels ) THEN
  196.             BEGIN
  197.             spitze := spitze + fn_inkr;
  198.             anfang := anfang + fn_inkr;
  199.             END;
  200.  
  201.         eingabe, n_eingabe:
  202.         Exit;
  203.  
  204.         ELSE
  205.         zurueck;
  206.         END; { CASE }
  207.     _ClearScreen( _GClearScreen );
  208.     SetzFenster( links, spitze, rechts, anfang );
  209.     zurueck;
  210.     END; { WHILE }
  211. END; { anpassen }
  212.  
  213. { =========================== Kreise ==============================
  214.   Zeichnet Kreise in verschiedenen Größen, Farbe und runden Mustern.
  215.  
  216.   Parameter: Keine
  217. }
  218. PROCEDURE Kreise;
  219. VAR
  220.     x, y, radius_xy  : Double;
  221.     fuell_flag, stift_flag : Boolean;
  222.  
  223. BEGIN
  224.     { Initialiiere unnd speichere Stift- und Fuellflags. }
  225.     IF (tfarbindizes <= 4) THEN
  226.     fuellein( False )
  227.     ELSE
  228.     fuellein( True );
  229.     fuell_flag := FuellStatus;
  230.     stift_flag := StiftStatus;
  231.     stiftkont( False );
  232.  
  233.     WHILE True DO
  234.     BEGIN
  235.  
  236.     { Zeichne Kreise. }
  237.     radius_xy := 10.0;
  238.     WHILE (radius_xy <= 130.0) DO
  239.         BEGIN
  240.         x := (tmaxx - 30) * ArcTan( Sin( radius_xy / Pi ) );
  241.         y := (tmaxy - 30) * ArcTan( Cos( radius_xy / Pi ) );
  242.         gehzu( x, y );
  243.         stiftfarbe( naechstfarbindex( vorgabe ) );
  244.         kreis( radius_xy );
  245.         IF (hol_taste( nicht_warten ) <> 0) THEN
  246.         BEGIN
  247.         stiftkont( stift_flag );
  248.         fuellein( fuell_flag );
  249.         Exit;
  250.         END;
  251.         radius_xy := radius_xy + 1.0;
  252.         END; { WHILE }
  253.  
  254.     { Bei Palettenmodi (ausser 256 Farben), starte erneut. }
  255.     IF (tfarbwerte = 64) OR (tfarbwerte = 16) THEN
  256.         BEGIN
  257.         _ClearScreen( _GClearScreen );
  258.         fuellein( False );
  259.         gehzu( 0.0, 0.0 );
  260.         stiftfarbe( White );
  261.         Rechteck( 2 * tmaxx, 2 * tmaxy );
  262.         fuellein( fuell_flag );
  263.         naechstfarbwert( vorgabe );
  264.         END;
  265.     END; { WHILE }
  266. END;  { Kreise }
  267.  
  268.  
  269. { =========================== RotKugel ==============================
  270.   Zeichnet und füllt Teile einer rotierenden Kugel. Rotiert Farben
  271.   in EGA + modi mit mehr als 4 Farbindizes.
  272.  
  273.   Params: Keine
  274. }
  275. PROCEDURE RotKugel;
  276. VAR
  277.     aktx, xgroess, ygroess, xinkr : Double;
  278.     cvi, ci, c, rand_farbe, rueck : Integer;
  279.     fuell_flag : Boolean;
  280.  
  281. BEGIN
  282.     cvi := 0; ci := 0; c := 0;
  283.     xgroess := tmaxy * 0.9 * 2;
  284.     ygroess := xgroess;
  285.     fuell_flag := FuellStatus;
  286.     fuellein( False );
  287.     rueck := naechstfarbindex( 0 );
  288.     xinkr := xgroess / 14;
  289.     rand_farbe := holstiftfarbe;
  290.     randfarbe( rand_farbe );
  291.  
  292.     { Zeichne Stücke. }
  293.     aktx := xinkr;
  294.     WHILE (aktx <= xgroess) DO
  295.     BEGIN
  296.     ellipse( aktx, ygroess );
  297.     aktx := aktx + (xinkr * 2);
  298.     END;
  299.     fuellein( True );
  300.     stiftkont( False );
  301.     drehen( 90 );
  302.     xgroess := xgroess / 2;
  303.     gehzu( xgroess - xinkr, 0.0 );
  304.  
  305.     naechstfarbwert( limit );
  306.  
  307.     { Fülle Stücke. }
  308.     WHILE TAktX >= (-xgroess + xinkr) DO
  309.     BEGIN
  310.     stiftfarbe( naechstfarbindex( vorgabe ) );
  311.     zeichnen;
  312.     Bewegen( -xinkr );
  313.     END;
  314.  
  315.     WHILE ( hol_taste( nicht_warten ) = 0) DO
  316.     naechstfarbwert( limit );
  317.  
  318.     stiftkont( True );
  319.     fuellein( fuell_flag );
  320. END; { RotKugel }
  321.  
  322. { =========================== Polygone ==============================
  323.   Zeichnet Polygone (fängt mit einem Dreieck an), deren Größe wächst,
  324.   indem die Anzahl der Seiten zunimmt, ohne daß deren Länge zunimmt
  325.   Vergewissern Sie sich, daß der Lichtstift Kontakt hat.
  326.  
  327.   Parameter: Keine
  328.  
  329.   Rückgabe : 1 bei Benutzerunterbrechung,
  330.          0 bei Erreichen des Bildschirmrandes
  331.  
  332. }
  333. FUNCTION Polygone : Boolean;
  334. VAR
  335.     seiten, atrib : Integer;
  336.     dxy : Double;
  337.  
  338. BEGIN
  339.     seiten := 3;
  340.     atrib := 1;
  341.     dxy := TEinh;
  342.     WHILE True DO
  343.     BEGIN
  344.     stiftfarbe( naechstfarbindex( vorgabe ) );
  345.     Inc( seiten );
  346.     dxy := dxy + 1.5;
  347.     poly( seiten, dxy );
  348.     IF NOT turtlestat THEN
  349.         BEGIN
  350.         Polygone := False;
  351.         Exit;
  352.         END;
  353.     IF ( hol_taste( nicht_warten ) <> 0) THEN
  354.         BEGIN
  355.         Polygone := True;
  356.         Exit;
  357.         END;
  358.     END;
  359. END;  { Polygone }
  360.  
  361.  
  362. { =========================== Spirale ==============================
  363.   Zeichnet eine Spirale, indem es die Länge der Seiten einer rotie-
  364.   renden Figur inkrementiert.
  365.  
  366.   Parameter: wink   - legt die Weite fest
  367.          xyInkr - legt die Seitenlänge fest
  368.  
  369.   Rückgabe : 1 bei Benutzerunterbrechung,
  370.          0 bei Erreichen des Bildschirmrandes
  371.  
  372. }
  373. FUNCTION Spirale( wink : Integer; xyInkr : Double ) : Boolean;
  374. VAR
  375.     xy : Double;
  376.  
  377. BEGIN
  378.     xy := TEinh;
  379.  
  380.     WHILE True DO
  381.     BEGIN
  382.     stiftfarbe( naechstfarbindex( vorgabe ) );
  383.     xy := xy + xyInkr;
  384.     Bewegen( xy );
  385.     IF NOT turtlestat THEN
  386.         BEGIN
  387.         Spirale := False;
  388.         Exit;
  389.         END;
  390.     drehen( wink );
  391.     IF (hol_taste( nicht_warten ) <> 0) THEN
  392.         BEGIN
  393.         Spirale := True;
  394.         Exit;
  395.         END;
  396.     END;
  397. END; { Spirale }
  398.  
  399. { =========================== InSpirale ==============================
  400.   Zeichnet ein invertierte Spirale, indem jeder Winkel der rotierenden
  401.   Figur vergrößert wird, während die Länger der Seiten konstant ge-
  402.   halten wird.
  403.  
  404.   Parameter: xy - legen Größe fest
  405.          wink - initialisiert den Winkel
  406.          wink_inkr - legt Weite und Form fest
  407.  
  408.   Rückgabe : 1 bei Benutzerunterbrechung,
  409.          0 bei Erreichen des Bildschirmrandes
  410. }
  411. FUNCTION InSpirale( xy : Double; wink, wink_inkr : Integer ) : Boolean;
  412. BEGIN
  413.     WHILE True DO
  414.     BEGIN
  415.     stiftfarbe( naechstfarbindex( vorgabe ) );
  416.     Bewegen( xy );
  417.     IF NOT turtlestat THEN
  418.         BEGIN
  419.         InSpirale := False;
  420.         Exit;
  421.         END;
  422.     wink := wink + wink_inkr;
  423.     drehen( wink );
  424.     IF (hol_taste( nicht_warten ) <> 0) THEN
  425.         BEGIN
  426.         InSpirale := True;
  427.         Exit;
  428.         END;
  429.     END;
  430. END; { InSpirale }
  431.  
  432. { =========================== Wanze ==================================
  433.   Zeichnet ein geflügelte Wanze und bewegt sie nach einem zufzälligen
  434.   Muster.
  435.  
  436.   Parameter : keine
  437. }
  438.  
  439. PROCEDURE Wanze;
  440. TYPE
  441.     puffer_t   = ARRAY[1..65520] OF Byte;
  442.  
  443. CONST
  444.     flgspitze : _FillMask = ( $81, $3c, $c3, $66, $66, $0f, $f0, $18 );
  445.     flgansatz : _FillMask = ( $66, $0f, $f0, $18, $81, $3c, $c3, $66 );
  446.     leer      : _FillMask = ( $ff, $ff, $ff, $ff, $ff, $ff, $ff, $ff );
  447.  
  448. VAR
  449.     puffer : ^Byte;
  450.     bldgr  : LongInt;
  451.     stat   : Integer;
  452.  
  453. BEGIN
  454.     { Draw Wanze. }
  455.     stiftkont( False );
  456.     fuellein( True );
  457.     Bewegen( 40.0 );               { Zeichne und fülle Vorderflügel. }
  458.     drehen( 90 );
  459.     Bewegen( 80.0 );
  460.     stiftfarbe( 1 );
  461.     _SetFillMask( flgspitze );
  462.     ellipse( 172.0, 70.0 );
  463.     drehen( 180 );
  464.     Bewegen( 160.0 );
  465.     ellipse( 172.0, 70.0 );
  466.     drehen(-90 );
  467.     gehzu( 0.0, 0.0 );
  468.     Bewegen( 25.0 );               { Zeichne und fülle Hinterflügel. }
  469.     drehen( 90 );
  470.     Bewegen( 70.0 );
  471.     stiftfarbe( 2 );
  472.     _SetFillMask( flgansatz );
  473.     ellipse( 150.0, 70.0 );
  474.     drehen( 180 );
  475.     Bewegen( 140.0 );
  476.     ellipse( 150.0, 70.0 );
  477.     drehen( -90 );
  478.     gehzu( 0.0, 0.0 );
  479.     _SetFillMask( leer);      { Zeichne Körper. }
  480.     stiftfarbe( 3 );
  481.     randfarbe( 3 );
  482.     ellipse( 52.0, 220.0 );
  483.     stiftfarbe( 1 );              { Drehe Augen. }
  484.     randfarbe( 1 );
  485.     fuellein( False );
  486.     Bewegen( 90.0 );
  487.     drehen( 90 );
  488.     Bewegen( 22.0 );
  489.     kreis( 20.0 );
  490.     stiftfarbe( 0 );
  491.     zeichnen;
  492.     stiftfarbe( 1 );
  493.     drehen( 180 );
  494.     Bewegen( 44.0 );
  495.     kreis( 20.0 );
  496.     stiftfarbe( 0 );
  497.     zeichnen;
  498.  
  499.     { Gehe zur Position oben rechts des Bildes. }
  500.     gehzu( 0.0, 0.0 );
  501.     drehenin( 0 );
  502.     Bewegen( 120.0 );
  503.     drehen( -90 );
  504.     Bewegen( 175.0 );
  505.     drehen( 90 );
  506.  
  507.     { Bestimme Größe und reserviere Speicher dafür. }
  508.     bldgr := bildgross( 350.0, 240.0 );
  509.     GetMem( puffer, Word( bldgr ) );
  510.     HolBild( 350.0, 240.0, puffer^ );
  511.     stat := _GrStatus;
  512.  
  513.     { Bewege zufällig, passe dabei die Ränder an. }
  514.     WHILE (hol_taste( nicht_warten ) = 0) DO
  515.     BEGIN
  516.     IF TAktX <= (-tmaxx + 15.0) THEN
  517.         drehenin( 90 )
  518.     ELSE IF TAktY <= (-tmaxy + 15.0) THEN
  519.         drehenin( 180 )
  520.     ELSE IF TAktX >= (tmaxx - 365.0) THEN
  521.         drehenin( 270 )
  522.     ELSE IF TAktY >= (tmaxy - 255.0) THEN
  523.         drehenin( 0 )
  524.     ELSE
  525.         drehen( zufalls_gen( -20, 20 ) );
  526.     Bewegen( 3.0 );
  527.     ZeigBild( puffer^, _GPSet );
  528.     END;
  529.     FreeMem( puffer, Word( bldgr ) );
  530. END;  { Wanze }
  531.  
  532. { ========================= Lade_Modi =================================
  533.   Lädt ein Array mit Menüelementen die alle Graphikmodi repräsentieren,
  534.   die für diesen Graphikkarte gültig sind. Lädt auch ein Array, das
  535.   die Konstanten für jeden Graphikmodus enthält. Die Indizes der
  536.   Arrays sind äquivalent.
  537.  
  538.   Parameter:
  539.   adapter - Video adapter
  540.   mm      - Array containing menu elements (output)
  541.   ma      - Array containing graphics mode constants (output)
  542.   m       - Preferred initial mode for this adapter (output)
  543.  
  544.   Rückgabe:
  545.   True, falls das Programm die vorhandene Graphikkarte unterstützt;
  546.     sonst
  547.   False
  548. }
  549. FUNCTION Lade_Modi(      adapter : Integer;
  550.              VAR mm   : element_array_t;
  551.              VAR ma   : modus_array_t;
  552.              VAR m    : Integer ) : Boolean;
  553.  
  554. BEGIN
  555.  
  556.     Lade_Modi := True;
  557.     CASE adapter OF
  558.     _OCGA:   { Olivettimodus ein. }
  559.     BEGIN
  560.     ma[0] := _ORescolor;
  561.     mm[0].WTast := 1;
  562.     mm[0].element := 'OREScolor';
  563.     ma[1] := _MRes4Color;
  564.     mm[1].WTast := 5;
  565.     mm[1].element := 'MRES4COLOR';
  566.     ma[2] := _MResNoColor;
  567.     mm[2].element := 'MRESNOCOLOR';
  568.     mm[2].WTast := 5;
  569.     ma[3] := _HResBW;
  570.     mm[3].element := 'HRESBW';
  571.     mm[3].WTast := 5;
  572.     mm[4].element := '';
  573.     m := _MRes4Color;
  574.     END;
  575.     _CGA:    { EGA-Modi aus. }
  576.     BEGIN
  577.     ma[0] := _MRes4Color;
  578.     mm[0].WTast := 5;
  579.     mm[0].element := 'MRES4COLOR';
  580.     ma[1] := _MResNoColor;
  581.     mm[1].element := 'MRESNOCOLOR';
  582.     mm[1].WTast := 5;
  583.     ma[2] := _HResBW;
  584.     mm[2].element := 'HRESBW';
  585.     mm[2].WTast := 5;
  586.     mm[3].element := '';
  587.     m := _MRes4Color;
  588.     END;
  589.     _HGC:
  590.     BEGIN
  591.     ma[0] := _MRes4Color;
  592.     mm[0].WTast := 5;
  593.     mm[0].element := 'MRES4COLOR';
  594.     ma[1] := _MResNoColor;
  595.     mm[1].element := 'MRESNOCOLOR';
  596.     mm[1].WTast := 5;
  597.     ma[2] := _HResBW;
  598.     mm[2].element := 'HRESBW';
  599.     mm[2].WTast := 5;
  600.     ma[3] := _MRes16Color;
  601.     mm[3].element := 'MRES16COLOR';
  602.     mm[3].WTast := 1;
  603.     ma[4] := _HRes16Color;
  604.     mm[4].element := 'HRES16COLOR';
  605.     mm[4].WTast := 1;
  606.     ma[5] := _EResColor;
  607.     mm[5].element := 'ERESCOLOR';
  608.     mm[5].WTast := 1;
  609.     mm[6].element := '';
  610.     m := _HercMono;
  611.     END;
  612.     _OEGA:   { Olivettimodi ein; VGA-Modi aus. }
  613.     BEGIN
  614.     ma[0] := _OResColor;
  615.     mm[0].WTast := 1;
  616.     mm[0].element := 'ORESCOLOR';
  617.     ma[1] := _MRes4Color;
  618.     mm[1].WTast := 5;
  619.     mm[1].element := 'MRES4COLOR';
  620.     ma[2] := _MResNoColor;
  621.     mm[2].element := 'MRESNOCOLOR';
  622.     mm[2].WTast := 5;
  623.     ma[3] := _HResBW;
  624.     mm[3].element := 'HRESBW';
  625.     mm[3].WTast := 5;
  626.     ma[4] := _MRes16Color;
  627.     mm[4].element := 'MRES16COLOR';
  628.     mm[4].WTast := 1;
  629.     ma[5] := _HRes16Color;
  630.     mm[5].element := 'HRES16COLOR';
  631.     mm[5].WTast := 1;
  632.     ma[6] := _EResColor;
  633.     mm[6].element := 'ERESCOLOR';
  634.     mm[6].WTast := 1;
  635.     mm[7].element := '';
  636.     IF vc.Memory > 64 THEN m := _EResColor
  637.     ELSE m := _HRes16Color;
  638.     END;
  639.     _EGA:     { VGA-Modi aus. }
  640.     BEGIN
  641.     ma[0] := _MRes4Color;
  642.     mm[0].WTast := 5;
  643.     mm[0].element := 'MRES4COLOR';
  644.     ma[1] := _MResNoColor;
  645.     mm[1].element := 'MRESNOCOLOR';
  646.     mm[1].WTast := 5;
  647.     ma[2] := _HResBW;
  648.     mm[2].element := 'HRESBW';
  649.     mm[2].WTast := 5;
  650.     ma[3] := _MRes16Color;
  651.     mm[3].element := 'MRES16COLOR';
  652.     mm[3].WTast := 1;
  653.     ma[4] := _HRes16Color;
  654.     mm[4].element := 'HRES16COLOR';
  655.     mm[4].WTast := 1;
  656.     ma[5] := _EResColor;
  657.     mm[5].element := 'ERESCOLOR';
  658.     mm[5].WTast := 1;
  659.     mm[6].element := '';
  660.     IF (vc.Memory > 64) THEN m := _EResColor
  661.     ELSE m := _HRes16Color;
  662.     END;
  663.     _OVGA:    { Olivettimodi ein. }
  664.     BEGIN
  665.     ma[0] := _OResColor;
  666.     mm[0].WTast := 1;
  667.     mm[0].element := 'ORESCOLOR';
  668.     ma[1] := _MRes4Color;
  669.     mm[1].WTast := 5;
  670.     mm[1].element := 'MRES4COLOR';
  671.     ma[2] := _MResNoColor;
  672.     mm[2].element := 'MRESNOCOLOR';
  673.     mm[2].WTast := 5;
  674.     ma[3] := _HResBW;
  675.     mm[3].element := 'HRESBW';
  676.     mm[3].WTast := 5;
  677.     ma[4] := _MRes16Color;
  678.     mm[4].element := 'MRES16COLOR';
  679.     mm[4].WTast := 1;
  680.     ma[5] := _HRes16Color;
  681.     mm[5].element := 'HRES16COLOR';
  682.     mm[5].WTast := 1;
  683.     ma[6] := _EResColor;
  684.     mm[6].element := 'ERESCOLOR';
  685.     mm[6].WTast := 1;
  686.     ma[7] := _VRes2Color;
  687.     mm[7].element := 'VRES2COLOR';
  688.     mm[7].WTast := 5;
  689.     ma[8] := _VRes16Color;
  690.     mm[8].element := 'VRES16COLOR';
  691.     mm[8].WTast := 1;
  692.     ma[9] := _MRes256Color;
  693.     mm[9].element := 'MRES256COLOR';
  694.     mm[9].WTast := 2;
  695.     mm[10].element := '';
  696.     m := _VRes16Color;
  697.     END;
  698.     _VGA:
  699.     BEGIN
  700.     ma[0] := _MRes4Color;
  701.     mm[0].WTast := 5;
  702.     mm[0].element := 'MRES4COLOR';
  703.     ma[1] := _MResNoColor;
  704.     mm[1].element := 'MRESNOCOLOR';
  705.     mm[1].WTast := 5;
  706.     ma[2] := _HResBW;
  707.     mm[2].element := 'HRESBW';
  708.     mm[2].WTast := 5;
  709.     ma[3] := _MRes16Color;
  710.     mm[3].element := 'MRES16COLOR';
  711.     mm[3].WTast := 1;
  712.     ma[4] := _HRes16Color;
  713.     mm[4].element := 'HRES16COLOR';
  714.     mm[4].WTast := 1;
  715.     ma[5] := _EResColor;
  716.     mm[5].element := 'ERESCOLOR';
  717.     mm[5].WTast := 1;
  718.     ma[6] := _VRes2Color;
  719.     mm[6].element := 'VRES2COLOR';
  720.     mm[6].WTast := 5;
  721.     ma[7] := _VRes16Color;
  722.     mm[7].element := 'VRES16COLOR';
  723.     mm[7].WTast := 1;
  724.     ma[8] := _MRes256Color;
  725.     mm[8].element := 'MRES256COLOR';
  726.     mm[8].WTast := 2;
  727.     mm[9].element := '';
  728.     m := _VRes16Color;
  729.     END;
  730.  
  731.     _MCGA:
  732.     BEGIN
  733.     ma[0] := _MRes4Color;
  734.     mm[0].WTast := 5;
  735.     mm[0].element := 'MRES4COLOR';
  736.     ma[1] := _MResNoColor;
  737.     mm[1].element := 'MRESNOCOLOR';
  738.     mm[1].WTast := 5;
  739.     ma[2] := _HResBW;
  740.     mm[2].element := 'HRESBW';
  741.     mm[2].WTast := 5;
  742.     ma[3] := _VRes2Color;
  743.     mm[3].element := 'VRES2COLOR';
  744.     mm[3].WTast := 5;
  745.     ma[4] := _MRes256Color;
  746.     mm[4].element := 'MRES256COLOR';
  747.     mm[4].WTast := 2;
  748.     mm[5].element := '';
  749.     m := _MRes256Color;
  750.     END;
  751.     ELSE
  752.     Lade_Modi := False;
  753.     END; { case }
  754.  
  755. END; { Lade_Modi }
  756.  
  757. { ====================== Hauptprogramm ============================= }
  758.  
  759. BEGIN
  760.  
  761.     { Cursor ausschalten.  Herausfinden der Videokonfiguration, so
  762.       daß der gültige Graphikmodus für das Gerät bestimmt werde kann.
  763.     }
  764.     bool_wert := _DisplayCursor( False );
  765.     _GetVideoConfig( vc );
  766.  
  767.     zeilen_mitt := vc.NumTextRows DIV 2;
  768.     spalten_mitt := vc.NumTextCols DIV 2;
  769.  
  770.     { Wähle besten Graphikmodus und starte das Menü mit dem besten
  771.       Modus für dieses Gerät.
  772.     }
  773.     IF NOT(Lade_Modi( vc.Adapter, modus_menu, modus_array, modus )) THEN
  774.     BEGIN
  775.     Writeln( 'Kein Graphikmodus verfügbar.' );
  776.     Halt( 1 );
  777.     END;
  778.  
  779.     CASE vc.mode OF
  780.     _TextBW80, _TextBW40 :
  781.         farbe := False;
  782.     _TextMono, _HercMono, _EResNoColor :
  783.         BEGIN
  784.         farbe := False;
  785.         IF modus <> _HercMono THEN modus := _EResNoColor;
  786.         haupt_menu[8].element := '';  { Schalte Moduswechsel aus. }
  787.         END;
  788.     ELSE
  789.         farbe := True;
  790.     END; { CASE }
  791.  
  792.     { Initialisiert Zufallszahlengenerator. }
  793.     Randomize;
  794.  
  795.     { Initialisiere Hauptmenü und Modusauswahl. }
  796.     aktuelles_hauptm := 0;
  797.     aktueller_modus := 0;
  798.     WHILE (modus <> modus_array[aktueller_modus]) DO
  799.     Inc( aktueller_modus );
  800.  
  801.     WHILE (True) DO
  802.     BEGIN
  803.     { Setze Textmodus und lösche Bildschirm wahlweise in blau }
  804.     rueck_code := _SetVideoMode( _DefaultMode );
  805.     IF (farbe) THEN  _SetBkColor( LongInt( Blue ) );
  806.     _ClearScreen( _GClearScreen );
  807.  
  808.     { Wähle vom Menü. }
  809.     zeig_menu( zeilen_mitt, spalten_mitt, haupt_menu,
  810.     aktuelles_hauptm );
  811.  
  812.     { Setze Graphikmodus, initialisiere die Turtlegraphik und
  813.       zeichne den Rand }
  814.     IF (aktuelles_hauptm <> do_modus_aendern) THEN
  815.         BEGIN
  816.         rueck_code := _SetVideoMode( modus );
  817.         IF (_GrStatus <> _GrOk) THEN
  818.         BEGIN
  819.         GotoXY( spalten_mitt - Length( modus_mldg ) DIV 2, 1 );
  820.         TextColor( Black );
  821.         TextBackground( LightGray );
  822.         Writeln( modus_mldg );
  823.         ITast := hol_taste( warten );
  824.         END;
  825.         bool_wert := _DisplayCursor( False );
  826.         _GetVideoConfig( vc );
  827.         bool_wert := initturtle;
  828.         Rechteck( 2 * tmaxx, 2 * tmaxy );
  829.         END;
  830.  
  831.     { Springe zur Menüauswahl. }
  832.     CASE aktuelles_hauptm OF
  833.         do_beenden :
  834.         BEGIN
  835.         bool_wert := _DisplayCursor( True );
  836.         rueck_code := _SetVideoMode( _DefaultMode );
  837.         Halt( 0 );
  838.         END;
  839.         do_kreise :
  840.         Kreise;
  841.         do_kugel :
  842.         RotKugel;
  843.         do_tunnel :
  844.         BEGIN
  845.         stiftkont( False );
  846.         gehzu( -tmaxx * 0.2, tmaxy * 0.15 );
  847.         stiftkont( True );
  848.         bool_wert := Polygone;
  849.         WHILE (hol_taste( nicht_warten ) = 0) DO
  850.             naechstfarbwert( vorgabe );  { Rotiere Palette. }
  851.         END;
  852.         do_spirale :
  853.         BEGIN
  854.         IF NOT Spirale( zufalls_gen( 30, 80 ),
  855.                 zufalls_gen( 1, 5 ) )
  856.         THEN WHILE (hol_taste( nicht_warten ) = 0) DO
  857.              naechstfarbwert( vorgabe );
  858.         END;
  859.         do_invert_spirale:
  860.         BEGIN
  861.         rueck_code := naechstfarbindex( 0 );
  862.         IF (NOT InSpirale( zufalls_gen( 8, 20 ),
  863.               zufalls_gen( 4, 22 ),
  864.               zufalls_gen( 3, 31 ) )) THEN
  865.             WHILE (hol_taste( nicht_warten ) = 0) DO
  866.             naechstfarbwert( vorgabe );
  867.         END;
  868.         do_wanze :
  869.         Wanze;
  870.         do_anpassen :
  871.         anpassen;
  872.         do_modus_aendern :
  873.         BEGIN
  874.         IF (farbe) THEN _SetBkColor( Blue );
  875.         _ClearScreen( _GClearScreen );
  876.         zeig_menu( zeilen_mitt, spalten_mitt, modus_menu,
  877.                aktueller_modus );
  878.         modus := modus_array[aktueller_modus];
  879.         END;  { Case Wechsel2 }
  880.     END; { case }
  881.     END; { WHILE true }
  882. END.
  883.  
  884.  
  885.  
  886.  
  887.