home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tp_util / mandelbb.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-23  |  40.6 KB  |  1,501 lines
  1.  
  2. PROGRAM MANDELB;
  3. { BERECHNEN UND ABSPEICHERN MANDELBROTMENGE }
  4.  
  5. {$N+}
  6. {$E+}
  7. { *****  für Irm  ***** }
  8.  
  9.  
  10. USES  TPCRT,GRAPH,DOS,TPDOS,
  11.       SELECTD,GETPUT,DIRBOXG,
  12.       EGAVGA,TPENHKBD,
  13.       TPSTRING;
  14.  
  15. CONST
  16.       SELCOL  = 12; { TEXTFARBE AKTUELLER MENUEPUNKT }
  17.       NORMCOL = 9;  { TEXTFARBE NICHT AKTUELLER MENUEPUNKT }
  18.       UEBCOL  = 10; { TEXTFARBE UEBERSCHRIFTEN }
  19.       BLANK   = '               ';
  20.  
  21.       MAXMAXCOL = 60; { MAXIMALE GROESSE DES FARBEN- ARRAY }
  22.  
  23.       MMAX    = 9;
  24.       MMAX1   = 9;
  25.  
  26. CONST FBUFSIZ = 8192;
  27.  
  28. TYPE  XARR = ARRAY [1..2] OF BYTE;
  29.  
  30. VAR   I,J,K,XWID,YWID,XOFF,YOFF,
  31.       GDRIV,GMODE,MPOS,MPOS1,
  32.       OXWID,OYWID,OXOFF,OYOFF,
  33.       XMAX,YMAX                         : INTEGER;
  34.       L,L1                              : LONGINT;
  35.       STD,MIN,SEC,MSEC                  : WORD;
  36.       CH                                : CHAR;
  37.       HATBILD,PARSAV                    : BOOLEAN;
  38.       BB,MAXCOL,PP                      : BYTE;
  39.       COL                               : ARRAY[0..255] OF BYTE;
  40.       SIZ,ZSIZ                          : WORD;
  41.       GSIZ                              : LONGINT;
  42.       BILD                              : ARRAY[0..8] OF ^XARR;
  43.       ZOOM                              : POINTER;
  44.       N,NMAX                            : INTEGER;
  45.       A,B,DA,DB,AMIN,AMAX,BMIN,BMAX,
  46.       X,Y,G,CA,CB                       : SINGLE;
  47.       NM_S                              : INTEGER;
  48.       AA_S,AI_S,BA_S,BI_S,G_S           : SINGLE;
  49.       JULIA                             : BOOLEAN;
  50.       DP,RP                             : PALETTETYPE;
  51.  
  52.       PATH,FNAM,PARAM                   : STRING;
  53.       F                                 : FILE;
  54.       FP                                : ^XARR;
  55.       FPTR                              : WORD;
  56.       RC                                : SINGLE;
  57.       RCB                               : ARRAY[0..5] OF BYTE ABSOLUTE RC;
  58.  
  59.  
  60. PROCEDURE ZEIGEBILD(WMOD:BYTE);
  61. VAR   I  : BYTE;
  62. BEGIN
  63.   FOR I := 0 TO 8 DO
  64.     PUTIMAGE(XOFF,YOFF+(I*SUCC(YWID DIV 8)),BILD[I]^,WMOD);
  65. END; { ZEIGEBILD }
  66.  
  67.  
  68. FUNCTION SHIFT:BOOLEAN;
  69. BEGIN
  70.   SHIFT := (MEM[$40:$17] AND 3) <> 0;
  71. (*
  72. MEM[$40:$17] -> D0 = RIGHT SHIFT
  73.                 D1 = LEFT SHIFT
  74.                 D2 = CONTROL
  75.                 D3 = ALT
  76.                 D4 = SCROLL LOCK (GESPEICHERT)
  77.                 D5 = NUMLOCK     (GESPEICHERT)
  78.                 D6 = CAPSLOCK    (GESPEICHERT)
  79.                 D7 = INSERT      (GESPEICHERT)
  80. *)
  81. END;
  82.  
  83.  
  84. PROCEDURE DISPPAR(XP,YP:INTEGER);
  85. BEGIN
  86.   GOTOXY(XP,YP);   WRITE('File -> ',FNAM);
  87.   GOTOXY(XP,YP+1); WRITE('    Größe : ',XWID:4,' *',YWID:4);
  88.   GOTOXY(XP,YP+2); WRITE('     XMIN =',AMIN:8:5);
  89.   GOTOXY(XP,YP+3); WRITE('     XMAX =',AMAX:8:5);
  90.   GOTOXY(XP,YP+4); WRITE('     YMIN =',BMIN:8:5);
  91.   GOTOXY(XP,YP+5); WRITE('     YMAX =',BMAX:8:5);
  92.   GOTOXY(XP,YP+6); WRITE('    Tiefe =',NMAX:5,'   ');
  93.   GOTOXY(XP,YP+7); WRITE('Grenzwert =',G:8:2);
  94.   IF NOT JULIA THEN EXIT;
  95.   GOTOXY(XP,YP+8); WRITE(' C - Real =',CA:8:5);
  96.   GOTOXY(XP,YP+9); WRITE('C-Imaginär=',CB:8:5);
  97. END;
  98.  
  99.  
  100. PROCEDURE HELP;
  101. VAR   CH  : CHAR;
  102. BEGIN
  103.   CLEARDEVICE;
  104.   WRITELN('***** HELP NOCH NICHT INSTALLIERT *****');
  105.   CH := READKEY; IF CH = #0 THEN CH := READKEY;
  106.   CLEARDEVICE;
  107. END;
  108.  
  109.  
  110. PROCEDURE SETOUTP;
  111. VAR   CH            : CHAR;
  112.       R             : SINGLE;
  113.       CSIZ,XW1,YW1  : INTEGER;
  114.       FAKT          : BYTE;
  115.       OVF           : BOOLEAN;
  116.  
  117. PROCEDURE XRECT;
  118. BEGIN
  119.   SETCOLOR(2);
  120.   SETLINESTYLE(SOLIDLN,0,1);
  121.   SETWRITEMODE(XORPUT);
  122.   RECTANGLE(OXOFF,OYOFF,OXOFF+OXWID,OYOFF+OYWID);
  123.   SETWRITEMODE(COPYPUT);
  124. END;
  125.  
  126. PROCEDURE CHKOVR;
  127. BEGIN
  128.   CSIZ := IMAGESIZE(0,0,OXWID,(OYWID DIV 8));
  129.   L := CSIZ; L := L * 9;
  130.   IF L > (MEMAVAIL + GSIZ) THEN BEGIN
  131.     IF NOT OVF THEN BEGIN
  132.       GOTOXY(1,15);
  133.       WRITE('***** ZU WENIG SPEICHER *****');
  134.       WRITE(CHR(7));
  135.       OVF := TRUE;
  136.     END;
  137.   END ELSE BEGIN
  138.     IF OVF THEN BEGIN
  139.       GOTOXY(1,15);
  140.       WRITE(' ':30);
  141.       OVF := FALSE;
  142.     END;
  143.   END;
  144. END; { CHKOVR }
  145.  
  146. BEGIN { SETOUTP }
  147.   MPOS := 3;
  148.   OVF  := FALSE;
  149.   CLEARDEVICE;
  150.   WINDOW(28,10,80,25);
  151.   GOTOXY(1,1);
  152.   WRITELN('Fenstergröße : ',OXWID:4,' *',OYWID:4);
  153.   WRITELN('Offset       : ',OXOFF:4,' -',OYOFF:4);
  154.   WRITELN('       ',#27,',',#24,' kleiner');
  155.   WRITELN('       ',#26,',',#25,' größer');
  156.   WRITELN('   mit SHIFT schneller');
  157.   WRITELN;
  158.   WRITE('Verzerrung');
  159.   R := OXWID; R := R / OYWID;     WRITE(' 1:',R:4:2);
  160.   R := (AMAX-AMIN) / (BMAX-BMIN); WRITE(', 1:',R:4:2);
  161.   WRITELN;
  162.   WRITELN;
  163.   WRITELN('<Home> = Quadrat');
  164.   WRITELN;
  165.   WRITELN('<End> oder E = Ende');
  166.   CHKOVR;
  167.   REPEAT;
  168.     OXOFF := (SUCC(XMAX)-OXWID) DIV 2;
  169.     OYOFF := (SUCC(YMAX)-OYWID) DIV 2; IF OYOFF < 0 THEN OYOFF := 0;
  170.     XRECT;
  171.  
  172.     IF NOT KEYPRESSED THEN BEGIN
  173.       XRECT;
  174.       GOTOXY(16,1);
  175.       WRITELN(OXWID:4,' *',OYWID:4);
  176.       GOTOXY(16,2);
  177.       WRITELN(OXOFF:4,' -',OYOFF:4);
  178.       GOTOXY(14,7);
  179.       R := OXWID; R := R / OYWID;     WRITE(R:4:2);
  180.       GOTOXY(22,7);
  181.       R := (AMAX-AMIN) / (BMAX-BMIN); WRITE(R:4:2);
  182.       XRECT;
  183.     END;
  184.  
  185.     CH := UPCASE(READKEY); IF CH = #0 THEN CH := READKEY;
  186.     XW1 := OXWID; YW1 := OYWID;
  187.     XRECT;
  188.     IF SHIFT THEN FAKT := 5 ELSE FAKT := 1;
  189.     CASE CH OF
  190.       #72 : BEGIN { AUF }
  191.               IF OYWID > (50+FAKT) THEN DEC(OYWID,FAKT) ELSE OYWID := 50;
  192.             END;
  193.       #80 : BEGIN { AB }
  194.               IF OYWID < (YMAX-FAKT) THEN INC(OYWID,FAKT) ELSE OYWID := YMAX;
  195.             END;
  196.       #75 : BEGIN { LINKS }
  197.               IF OXWID > (50+FAKT) THEN DEC(OXWID,FAKT) ELSE OXWID := 50;
  198.             END;
  199.       #77 : BEGIN { RECHTS }
  200.               IF OXWID < (XMAX-FAKT) THEN INC(OXWID,FAKT) ELSE OXWID := XMAX;
  201.             END;
  202.       #79 : CH := 'E'; { END }
  203.       #71 : BEGIN { HOME }
  204.               IF OXWID < YMAX THEN OYWID := OXWID ELSE OXWID := OYWID;
  205.             END;
  206.     END; { CASE }
  207.     CHKOVR;
  208.   UNTIL CH = 'E';
  209.   CLEARDEVICE;
  210. END; { SETOUTP }
  211.  
  212.  
  213. PROCEDURE BILDFREIGEBEN;
  214. VAR   I  : BYTE;
  215. BEGIN
  216.   IF HATBILD THEN BEGIN
  217.     FOR I := 0 TO 8 DO FREEMEM(BILD[I],SIZ);
  218.     GSIZ := 0;
  219.   END;
  220. END; { BILDFREIGEBEN }
  221.  
  222.  
  223. FUNCTION GETFILENAME:STRING;
  224. VAR   FNAM  : STRING;
  225. BEGIN
  226.   GETFILENAME := '';
  227.   FNAM := '';
  228.   WINDOW(6,3,74,15);
  229.   GOTOXY(1,1);
  230.   WRITE('╔');
  231.   FOR I := 1 TO 66 DO WRITE('═');
  232.   WRITE('╗');
  233.   FOR I := 2 TO 11 DO BEGIN
  234.     GOTOXY(1,I); WRITE('║');
  235.     GOTOXY(68,I); WRITE('║');
  236.   END;
  237.   GOTOXY(1,12);
  238.   WRITE('╚');
  239.   FOR I := 1 TO 66 DO WRITE('═');
  240.   WRITE('╝');
  241.   WINDOW(7,4,72,13);
  242.   FNAM := SELECTFILE(PATH,'*.MBM');
  243.   WINDOW(1,1,80,25);
  244.   IF LENGTH(FNAM) = 0 THEN BEGIN
  245.     CLEARDEVICE;
  246.     EXIT;
  247.   END;
  248.   PATH := JUSTPATHNAME(FNAM);
  249.   GETFILENAME := FNAM;
  250. END; { GETFILENAME }
  251.  
  252.  
  253. FUNCTION LIESFILE(FNAM:STRING;MSG:BOOLEAN):BOOLEAN;
  254. VAR   I,J  : INTEGER;
  255.       CH   : CHAR;
  256.       B1   : BYTE ABSOLUTE CH;
  257.       OK   : BOOLEAN;
  258.       R    : REAL;
  259. BEGIN
  260.   LIESFILE := FALSE;
  261.   IF NOT EXISTFILE(FNAM) THEN BEGIN
  262.     IF MSG THEN WRITELN('  File ',FNAM,' nicht gefunden');
  263.     EXIT;
  264.   END;
  265.   FOPEN(F,FNAM);
  266. {$I-}
  267.   OK := TRUE;
  268.   FGETC(F,CH); IF CH <> 'M' THEN OK := FALSE;
  269.   FGETC(F,CH); IF CH <> 'B' THEN OK := FALSE;
  270.   FGETC(F,CH); IF CH <> 'M' THEN OK := FALSE;
  271.   FGETC(F,CH); IF (CH <> #$1A) AND ((CH < '1') OR (CH > '3')) THEN OK := FALSE;
  272.   IF NOT OK THEN BEGIN
  273.     FCLOSE(F);
  274.     IF MSG THEN WRITELN('*****  INKOMPATIBLES DATEIFORMAT  *****');
  275.     CH := READKEY; IF CH = #0 THEN CH := READKEY;
  276.     CLEARDEVICE;
  277.     PARSAV := FALSE;
  278.     EXIT;
  279.   END;
  280.   IF CH >= '2' THEN BEGIN
  281.     FOR I := 5 TO 8 DO FGETB(F,BB);
  282.     FGETW(F,STD); FGETW(F,MIN); FGETW(F,SEC); FGETW(F,MSEC);
  283.   END ELSE BEGIN
  284.     FOR I := 5 TO 16 DO FGETB(F,BB);
  285.     STD := 9999;
  286.   END;
  287.   FGETI(F,XWID); FGETI(F,YWID);
  288.   FGETI(F,NMAX); FGETW(F,SIZ);
  289.   OXWID := XWID; OYWID := YWID;
  290.   FGETR(F,R); AMIN := R; FGETR(F,R); AMAX := R;
  291.   FGETR(F,R); BMIN := R; FGETR(F,R); BMAX := R;
  292.   FGETR(F,R); G := R;
  293.   IF CH >= '1' THEN BEGIN
  294.     FGETB(F,MAXCOL);
  295.     FOR I := 1 TO MAXMAXCOL DO FGETB(F,COL[I]);
  296.   END;
  297.   IF CH >= '3' THEN BEGIN
  298.     FGETR(F,R); CA := R;
  299.     FGETR(F,R); CB := R;
  300.     FGETB(F,B1); IF B1 = 0 THEN JULIA := FALSE ELSE JULIA := TRUE;
  301.   END ELSE BEGIN
  302.     CA := 0;
  303.     CB := 0;
  304.     JULIA := FALSE;
  305.   END;
  306.   XOFF := (SUCC(XMAX)-XWID) DIV 2;
  307.   YOFF := (SUCC(YMAX)-YWID) DIV 2; IF YOFF < 0 THEN YOFF := 0;
  308.   OXWID := XWID; OXOFF := XOFF;
  309.   OYWID := YWID; OYOFF := YOFF;
  310.  
  311.   L := SIZ; L := L * 9;
  312.   IF L > (MEMAVAIL+GSIZ) THEN BEGIN
  313.     FCLOSE(F);
  314.     IF MSG THEN WRITELN('*****  ZU WENIG SPEICHERPLATZ  *****');
  315.     CH := READKEY; IF CH = #0 THEN CH := READKEY;
  316.     HATBILD := FALSE;
  317.     PARSAV := FALSE;
  318.     EXIT;
  319.   END;
  320.  
  321.   FOR I := 0 TO 8 DO BEGIN
  322.     GETMEM(BILD[I],SIZ);
  323.     GSIZ := GSIZ + SIZ;
  324.     FGET(F,BILD[I],SIZ);
  325.   END; { NEXT I }
  326. {$I+}
  327.   IF FILEERR = 0 THEN BEGIN
  328.     FCLOSE(F);
  329.     HATBILD := TRUE;
  330.   END ELSE BEGIN
  331.     IF MSG THEN WRITELN('Lesefehler File ',FNAM);
  332.     HATBILD := FALSE;
  333.   END;
  334.  
  335.   LIESFILE := TRUE;
  336. END; { LIESFILE }
  337.  
  338.  
  339. PROCEDURE DISPPZEIT;
  340. BEGIN
  341.   DISPPAR(1,1);
  342.   IF STD < 9999 THEN BEGIN
  343.     GOTOXY(42,1);
  344.     WRITE('Rechenzeit :',STD:3,' Std,',MIN:3,' min,',SEC:3,',',MSEC:3,' sec');
  345.   END;
  346. END; { DISPPZEIT }
  347.  
  348.  
  349. PROCEDURE LOAD;
  350. VAR   CH  : CHAR;
  351. BEGIN
  352.   MPOS := 1;
  353.   CLEARDEVICE;
  354.   BILDFREIGEBEN;
  355.  
  356.   GOTOXY(1,1);
  357.   WRITE('     Einlesen File');
  358.   FNAM := GETFILENAME;
  359.   IF FNAM = '' THEN EXIT;
  360.   GOTOXY(1,21);
  361.  
  362.   IF NOT LIESFILE(FNAM,TRUE) THEN EXIT;
  363.  
  364.   CLEARDEVICE;
  365.   ZEIGEBILD(0);
  366.   GOTOXY(1,1); WRITE(BLANK,BLANK);
  367.   DISPPZEIT;
  368.   WRITE(CHR(7));
  369.   CH := READKEY; IF CH = #0 THEN CH := READKEY;
  370.   CLEARDEVICE;
  371.   PARSAV := FALSE;
  372. END; { LOAD }
  373.  
  374.  
  375. PROCEDURE STORE;
  376. VAR   I,J  : INTEGER;
  377.       CH   : CHAR;
  378.       R    : REAL;
  379. BEGIN
  380.   IF NOT HATBILD THEN EXIT;
  381.   MPOS := 7;
  382.   CLEARDEVICE;
  383.   IF PARSAV THEN BEGIN
  384.     AMIN := AI_S; AMAX := AA_S; BMIN := BI_S; BMAX := BA_S;
  385.     G := G_S; NMAX := NM_S;
  386.     PARSAV := FALSE;
  387.   END;
  388.   ZEIGEBILD(0);
  389.  
  390.   GOTOXY(1,1);
  391.   FNAM := '';
  392.   WRITELN('Eingabe ''*'' = File- Selector- Box');
  393.   WRITE('Abspeichern File -> '); READLN(FNAM);
  394.   IF FNAM = '*' THEN FNAM := GETFILENAME;
  395.   IF LENGTH(FNAM) = 0 THEN BEGIN
  396.     CLEARDEVICE;
  397.     EXIT;
  398.   END;
  399.   IF POS('.',FNAM) = 0 THEN FNAM := FNAM + '.MBM';
  400.  
  401.   CLEARDEVICE;
  402.   ZEIGEBILD(0);
  403.   DISPPAR(1,1);
  404.  
  405.   FOPEN(F,FNAM);
  406. {$I-}
  407.   FPUTC(F,'M'); FPUTC(F,'B'); FPUTC(F,'M'); FPUTC(F,'3'); FPUTB(F,$1A);
  408.   FOR I := 6 TO 8 DO FPUTB(F,0);
  409.   FPUTW(F,STD); FPUTW(F,MIN); FPUTW(F,SEC); FPUTW(F,MSEC);
  410.   FPUTW(F,XWID); FPUTW(F,YWID);
  411.   FPUTW(F,NMAX); FPUTW(F,SIZ);
  412.   R := AMIN; FPUTR(F,R); R := AMAX; FPUTR(F,R);
  413.   R := BMIN; FPUTR(F,R); R := BMAX; FPUTR(F,R);
  414.   R := G; FPUTR(F,R);
  415.   FPUTB(F,MAXCOL);
  416.   FOR I := 1 TO MAXMAXCOL DO FPUTB(F,COL[I]);
  417.   R := CA; FPUTR(F,R);
  418.   R := CB; FPUTR(F,R);
  419.   IF JULIA THEN FPUTB(F,$FF) ELSE FPUTB(F,$00);
  420.  
  421.   FOR I := 0 TO 8 DO BEGIN
  422.     FPUT(F,BILD[I],SIZ);
  423.   END; { NEXT I }
  424. {$I+}
  425.   IF FILEERR = 0 THEN BEGIN
  426.     FCLOSE(F);
  427.   END ELSE BEGIN
  428.     WRITELN('Schreibfehler File ',FNAM);
  429.   END;
  430.  
  431.   WRITE(CHR(7));
  432.   CH := READKEY; IF CH = #0 THEN CH := READKEY;
  433.   CLEARDEVICE;
  434. END;
  435.  
  436.  
  437. PROCEDURE GETPARAM;
  438. VAR   R       : SINGLE;
  439.       S       : STRING[10];
  440.       I       : INTEGER;
  441.       CH      : CHAR;
  442.       MM      : BYTE;
  443.  
  444. PROCEDURE GETVAL;
  445. BEGIN
  446.   IF S = '' THEN EXIT;
  447.   IF S[1] = '.' THEN INSERT('0',S,1);
  448.   IF (S[1] = '-') AND (S[2]='.') THEN INSERT('0',S,2);
  449.   CASE MPOS1 OF
  450.     1 : VAL(S,AMIN,I);
  451.     2 : VAL(S,AMAX,I);
  452.     3 : VAL(S,BMIN,I);
  453.     4 : VAL(S,BMAX,I);
  454.     5 : VAL(S,NMAX,I);
  455.     6 : VAL(S,G,I);
  456.     7 : VAL(S,CA,I);
  457.     8 : VAL(S,CB,I);
  458.   END; { CASE }
  459.   IF G < 0.1 THEN G := 0.1;
  460.   IF NMAX < 1 THEN NMAX := 1;
  461.   S := '';
  462. END;
  463.  
  464. PROCEDURE DISPPMENUE(VON,BIS:BYTE);
  465. LABEL ENDE;
  466. BEGIN
  467.   IF VON = 0 THEN BEGIN
  468.     WINDOW(20,8,80,25);
  469.     TEXTCOLOR(UEBCOL);
  470.     GOTOXY(1,1);
  471.     WRITELN('Berechnungsparameter :');
  472.     WRITELN;
  473.     WRITELN('<End> oder E = Ende');
  474.   END;
  475.   WINDOW(20,12,80,25);
  476.   IF BIS < 1 THEN GOTO ENDE;
  477.   IF VON < 2 THEN BEGIN
  478.     GOTOXY(1,1);
  479.     IF MPOS1 = 1 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  480.     WRITE('      XMIN (',AMIN:8:5,') -> ');
  481.     IF MPOS1 = 1 THEN WRITE(S);
  482.     WRITELN(BLANK);
  483.   END;
  484.   IF BIS < 2 THEN GOTO ENDE;
  485.   IF VON < 3 THEN BEGIN
  486.     GOTOXY(1,2);
  487.     IF MPOS1 = 2 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  488.     WRITE('      XMAX (',AMAX:8:5,') -> ');
  489.     IF MPOS1 = 2 THEN WRITE(S);
  490.     WRITELN(BLANK);
  491.   END;
  492.   IF BIS < 3 THEN GOTO ENDE;
  493.   IF VON < 4 THEN BEGIN
  494.     GOTOXY(1,3);
  495.     IF MPOS1 = 3 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  496.     WRITE('      YMIN (',BMIN:8:5,') -> ');
  497.     IF MPOS1 = 3 THEN WRITE(S);
  498.     WRITELN(BLANK);
  499.   END;
  500.   IF BIS < 4 THEN GOTO ENDE;
  501.   IF VON < 5 THEN BEGIN
  502.     GOTOXY(1,4);
  503.     IF MPOS1 = 4 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  504.     WRITE('      YMAX (',BMAX:8:5,') -> ');
  505.     IF MPOS1 = 4 THEN WRITE(S);
  506.     WRITELN(BLANK);
  507.   END;
  508.   IF BIS < 5 THEN GOTO ENDE;
  509.   IF VON < 6 THEN BEGIN
  510.     GOTOXY(1,5);
  511.     IF MPOS1 = 5 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  512.     WRITE('     Tiefe (',NMAX:5  ,'   ) -> ');
  513.     IF MPOS1 = 5 THEN WRITE(S);
  514.     WRITELN(BLANK);
  515.   END;
  516.   IF BIS < 6 THEN GOTO ENDE;
  517.   IF VON < 7 THEN BEGIN
  518.     GOTOXY(1,6);
  519.     IF MPOS1 = 6 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  520.     WRITE(' Grenzwert (',G:8:2   ,') -> ');
  521.     IF MPOS1 = 6 THEN WRITE(S);
  522.     WRITELN(BLANK);
  523.   END;
  524.   IF BIS < 7 THEN GOTO ENDE;
  525.   IF VON < 8 THEN BEGIN
  526.     GOTOXY(1,8);
  527.     IF MPOS1 = 7 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  528.     WRITE(' C - Real  (',CA:8:5   ,') -> ');
  529.     IF MPOS1 = 7 THEN WRITE(S);
  530.     WRITELN(BLANK);
  531.   END;
  532.   IF BIS < 8 THEN GOTO ENDE;
  533.   IF VON < 9 THEN BEGIN
  534.     GOTOXY(1,9);
  535.     IF MPOS1 = 8 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  536.     WRITE('C-Imaginär (',CB:8:5   ,') -> ');
  537.     IF MPOS1 = 8 THEN WRITE(S);
  538.     WRITELN(BLANK);
  539.   END;
  540. ENDE:
  541.   TEXTCOLOR(UEBCOL);
  542. END;
  543.  
  544. BEGIN { PARAM }
  545.   MPOS := 4;
  546.   MPOS1 := 1;
  547.   MM := MMAX1; IF NOT JULIA THEN DEC(MM,2);
  548.   CLEARDEVICE;
  549.   IF NOT PARSAV THEN BEGIN
  550.     AI_S := AMIN; AA_S := AMAX; BI_S := BMIN; BA_S := BMAX;
  551.     G_S  := G; NM_S := NMAX;
  552.     PARSAV := TRUE;
  553.   END;
  554.   S := '';
  555.   DISPPMENUE(0,MM);
  556.   REPEAT
  557.     DISPPMENUE(MPOS1,MPOS1);
  558.     CH := READKEY; IF CH = #0 THEN CH := READKEY;
  559.     CASE CH OF
  560.        ^H : IF LENGTH(S) > 0 THEN DELETE(S,LENGTH(S),1);
  561.        ^M : BEGIN
  562.               GETVAL;
  563.               INC(MPOS1);
  564.               DISPPMENUE(PRED(MPOS1),PRED(MPOS1));
  565.               IF MPOS1 > MM THEN MPOS1 := 1;
  566.             END;
  567.   ',','.' : IF POS('.',S) = 0 THEN IF LENGTH(S) < 3 THEN S := S + '.';
  568.       '-' : IF LENGTH(S) = 0 THEN S := '-';
  569.  '0'..'9' : S := S + CH;
  570.       #72 : BEGIN { AUF }
  571.               DEC(MPOS1);
  572.               DISPPMENUE(SUCC(MPOS1),SUCC(MPOS1));
  573.               IF MPOS1 < 1 THEN MPOS1 := MM;
  574.             END;
  575.       #80 : BEGIN { AB }
  576.               INC(MPOS1);
  577.               DISPPMENUE(PRED(MPOS1),PRED(MPOS1));
  578.               IF MPOS1 > MM THEN MPOS1 := 1;
  579.             END;
  580.       #79 : CH := 'E'; { END }
  581.     END; { CASE }
  582.  
  583.     IF AMIN > AMAX THEN BEGIN
  584.       R := AMIN; AMIN := AMAX; AMAX := R;
  585.       DISPPMENUE(1,2);
  586.     END;
  587.     IF BMIN > BMAX THEN BEGIN
  588.       R := BMIN; BMIN := BMAX; BMAX := R;
  589.       DISPPMENUE(3,4);
  590.     END;
  591.   UNTIL CH = 'E';
  592.   CLEARDEVICE;
  593. END;
  594.  
  595.  
  596. PROCEDURE AUSSCHN;
  597. VAR   I,J,YP,XW1,YW1,XP1,YP1,ZF  : INTEGER;
  598.       CH,CH1                     : CHAR;
  599.       XSC,YSC,R,
  600.       AI_T,AA_T,BI_T,BA_T,G_T    : SINGLE;
  601.       NM_T                       : INTEGER;
  602.       ON                         : BOOLEAN;
  603.       FAKT                       : BYTE;
  604.  
  605. PROCEDURE INIDISP;
  606. BEGIN
  607.   SETCOLOR(15);
  608.   SETLINESTYLE(SOLIDLN,0,3);
  609.   SETWRITEMODE(XORPUT);
  610.  
  611.   GOTOXY(65,YP);   WRITE('XMIN = ',XP1*XSC+AMIN:8:5);
  612.   GOTOXY(65,YP+1); WRITE('XMAX = ',(XP1+XW1)*XSC+AMIN:8:5);
  613.   GOTOXY(65,YP+2); WRITE('YMIN = ',YP1*YSC+BMIN:8:5);
  614.   GOTOXY(65,YP+3); WRITE('YMAX = ',(YP1+YW1)*YSC+BMIN:8:5);
  615.  
  616.   GOTOXY(65,YP+4);
  617.   WRITE('Verzerrung     ');
  618.   GOTOXY(65,YP+5);
  619.   R := XWID; R := R / YWID; WRITE(' 1:',R:4:2);
  620.   R := XW1; R := R * XSC; R := R / YSC; R := R /YW1;
  621.   WRITE(', 1:',R:4:2);
  622.   GOTOXY(65,YP+6); WRITE('<End> = Ende   ');
  623. END; { INIDISP }
  624.  
  625. PROCEDURE BLINK;
  626. BEGIN
  627.   BEGIN
  628.     RECTANGLE(XOFF+XP1,YOFF+YP1,XOFF+XP1+XW1,YOFF+YP1+YW1);
  629.   END;
  630.  
  631.   IF ON THEN ON := FALSE ELSE ON := TRUE;
  632. END; { BLINK }
  633.  
  634. PROCEDURE SETWIN;
  635. BEGIN
  636.   BLINK;
  637.   GOTOXY(72,YP);   WRITE(XP1*XSC+AMIN:8:5);
  638.   GOTOXY(72,YP+1); WRITE((XP1+XW1)*XSC+AMIN:8:5);
  639.   GOTOXY(72,YP+2); WRITE(YP1*YSC+BMIN:8:5);
  640.   GOTOXY(72,YP+3); WRITE((YP1+YW1)*YSC+BMIN:8:5);
  641.   GOTOXY(68,YP+5);
  642.   R := XWID; R := R / YWID; WRITE(R:4:2);
  643.   GOTOXY(76,YP+5);
  644.   R := XW1; R := R * XSC; R := R / YSC; R := R /YW1;
  645.   WRITE(R:4:2);
  646. END; { SETWIN }
  647.  
  648. BEGIN { AUSSCHN }
  649.   IF NOT HATBILD THEN EXIT;
  650.   MPOS := 6;
  651.   CLEARDEVICE;
  652.   ON := FALSE;
  653.   AI_T := AMIN; AA_T := AMAX; BI_T := BMIN; BA_T := BMAX;
  654.   G_T := G; NM_T := NMAX;
  655.   IF PARSAV THEN BEGIN
  656.     AMIN := AI_S; AMAX := AA_S; BMIN := BI_S; BMAX := BA_S;
  657.     G := G_S; NMAX := NM_S;
  658.   END;
  659.   YP := 1;
  660.   XW1 := XWID DIV 2;
  661.   YW1 := YWID DIV 2;
  662.   XP1 := XWID DIV 4;
  663.   YP1 := YWID DIV 4;
  664.   XSC := (AMAX-AMIN); XSC := XSC / XWID;
  665.   YSC := (BMAX-BMIN); YSC := YSC / YWID;
  666.   ZEIGEBILD(0);
  667.   INIDISP;
  668.   SETWIN;
  669.   REPEAT
  670.     L := TIMEMS;
  671.     REPEAT
  672.       IF TIMEMS - L > 50 THEN BEGIN
  673.         L := TIMEMS;
  674.         BLINK;
  675.       END;
  676.     UNTIL KEYPRESSED;
  677.     CH := UPCASE(READKEY); IF CH = #0 THEN CH1 := READKEY ELSE CH1 := #0;
  678.     IF NOT ON THEN BLINK;
  679.     IF SHIFT THEN FAKT := 5 ELSE FAKT := 1;
  680.     CASE CH OF
  681.       'P' : BEGIN
  682.               SETWIN;
  683.               IF YP = 1 THEN YP := 19 ELSE YP := 1;
  684.               CLEARDEVICE;
  685.               ZEIGEBILD(0);
  686.               INIDISP;
  687.               SETWIN;
  688.             END;
  689.       'Z' : BEGIN { ZOOM }
  690.               IF (XW1 <= (XWID DIV 2)) AND (YW1 <= (YWID DIV 2)) THEN BEGIN
  691.                 SETWIN;
  692.                 I := XMAX DIV XW1; J := YMAX DIV YW1;
  693.                 IF I < J THEN ZF := I ELSE ZF := J;
  694.  
  695.                 ZSIZ := IMAGESIZE(0,0,1,YW1+1);
  696.                 GETMEM(ZOOM,ZSIZ);
  697.                 FOR I := 0 TO PRED(XW1) DO BEGIN
  698.                   GETIMAGE(XOFF+XP1+I,YOFF+YP1,XOFF+XP1+I+1,YOFF+YP1+YW1,ZOOM^);
  699.                   FOR J := 0 TO PRED(ZF) DO PUTIMAGE(ZF*I+J,0,ZOOM^,0);
  700.                 END; { NEXT I }
  701.                 FREEMEM(ZOOM,ZSIZ);
  702.  
  703.                 ZSIZ := IMAGESIZE(0,0,XW1*ZF,1);
  704.                 GETMEM(ZOOM,ZSIZ);
  705.                 FOR I := PRED(YW1) DOWNTO 0 DO BEGIN
  706.                   GETIMAGE(0,I,XW1*ZF,I+1,ZOOM^);
  707.                   FOR J := PRED(ZF) DOWNTO 0 DO PUTIMAGE(0,ZF*I+J,ZOOM^,0);
  708.                 END; { NEXT I}
  709.                 FREEMEM(ZOOM,ZSIZ);
  710.  
  711.                 CH := UPCASE(READKEY);
  712.                 IF CH = #0 THEN CH1 := READKEY ELSE CH1 := #0;
  713.                 CLEARDEVICE;
  714.                 ZEIGEBILD(0);
  715.                 INIDISP;
  716.                 SETWIN;
  717.               END;
  718.             END;
  719.      ELSE CASE CH1 OF
  720.          #59 : BEGIN { F1 }
  721.                  SETWIN;
  722.                  SETFILLSTYLE(1,0);
  723.                  BAR(0,0,400,160);
  724. GOTOXY(1,1);
  725. WRITELN('Ausschnitt verschieben : ',#24,',',#25,',',#26,',',#27);
  726. WRITELN('Ausschnitt verkleinern : CTRL- ',#27,',',#24);
  727. WRITELN('Ausschnitt  vergrößern : CTRL- ',#26,',',#25);
  728. WRITELN('                 schneller mit SHIFT');
  729. WRITELN;
  730. WRITELN('Verzerrung zeigt die Verhältnisse Breite zu Höhe');
  731. WRITELN('   des Ausgabefensters und');
  732. WRITELN('   des zu berechnenden Ausschnitts an');
  733. WRITELN;
  734. WRITELN('"Z" = zoom zeigt den Ausschnitt vergrößert');
  735.                  CH := UPCASE(READKEY);
  736.                  IF CH = #0 THEN CH1 := READKEY ELSE CH1 := #0;
  737.                  CLEARDEVICE;
  738.                  ZEIGEBILD(0);
  739.                  INIDISP;
  740.                  SETWIN;
  741.                END;
  742.          #75 : BEGIN { LINKS }
  743.                  SETWIN;
  744.                  IF (XOFF+XP1) > PRED(FAKT) THEN DEC(XP1,FAKT);
  745.                  SETWIN;
  746.                END;
  747.          #77 : BEGIN { RECHTS }
  748.                  SETWIN;
  749.                  IF (XOFF+XP1+XW1) < (XMAX-FAKT) THEN INC(XP1,FAKT);
  750.                  SETWIN;
  751.                END;
  752.          #72 : BEGIN { AUF }
  753.                  SETWIN;
  754.                  IF (YOFF+YP1) > PRED(FAKT) THEN DEC(YP1,FAKT);
  755.                  SETWIN;
  756.                END;
  757.          #80 : BEGIN { AB }
  758.                  SETWIN;
  759.                  IF (YOFF+YP1+YW1) < (YMAX-FAKT) THEN INC(YP1,FAKT);
  760.                  SETWIN;
  761.                END;
  762.         #115 : BEGIN { CTRL LINKS }
  763.                  SETWIN;
  764.                  IF XW1 > (3+FAKT) THEN DEC(XW1,FAKT) ELSE XW1 := 3;
  765.                  SETWIN;
  766.                END;
  767.         #116 : BEGIN { CTRL RECHTS }
  768.                  SETWIN;
  769.                  IF XW1 < (XMAX-XOFF-XP1-FAKT) THEN INC(XW1,FAKT) ELSE XW1 := XMAX - XOFF - XP1;
  770.                  SETWIN;
  771.                END;
  772.         #141 : BEGIN { CTRL AUF }
  773.                  SETWIN;
  774.                  IF YW1 > (3+FAKT) THEN DEC(YW1,FAKT) ELSE YW1 := 3;
  775.                  SETWIN;
  776.                END;
  777.         #145 : BEGIN { CTRL AB }
  778.                  SETWIN;
  779.                  IF YW1 < (YMAX-YOFF-YP1-FAKT) THEN INC(YW1,FAKT) ELSE YW1 := YMAX - YOFF - YP1;
  780.                  SETWIN;
  781.                END;
  782.          #79 : CH := 'E'; { END }
  783.       END; { CASE CH1 }
  784.     END; { CASE CH }
  785.   UNTIL CH = 'E';
  786.   GOTOXY(1,1);
  787.   WRITE('Ausschnitt übernehmen J/N ? ');
  788.   CH := UPCASE(READKEY); IF CH = #0 THEN CH1 := READKEY ELSE CH1 := #0;
  789.   IF CH = 'J' THEN BEGIN
  790.  
  791.     IF NOT PARSAV THEN BEGIN
  792.       AI_S := AMIN; AA_S := AMAX; BI_S := BMIN; BA_S := BMAX;
  793.       G_S  := G; NM_S := NMAX;
  794.       PARSAV := TRUE;
  795.     END;
  796.  
  797.     R := AMIN;
  798.     AMIN := XP1*XSC+R;
  799.     AMAX := (XP1+XW1)*XSC+R;
  800.     R := BMIN;
  801.     BMIN := YP1*YSC+R;
  802.     BMAX := (YP1+YW1)*YSC+R;
  803.  
  804.     MPOS := 5;
  805.   END ELSE BEGIN
  806.     AMIN := AI_T; AMAX := AA_T; BMIN := BI_T; BMAX := BA_T;
  807.     G := G_T; NMAX := NM_T;
  808.   END;
  809.   SETLINESTYLE(SOLIDLN,0,1);
  810.   SETWRITEMODE(COPYPUT);
  811.   CLEARDEVICE;
  812. END; { AUSSCHN }
  813.  
  814.  
  815. PROCEDURE FARBEN;
  816. VAR   I,J,W,A                 : INTEGER;
  817.       ACOL                    : BYTE;
  818.       CH,CH1                  : CHAR;
  819.       YYOFF,YYWID,YZWID,YCOFF : INTEGER;
  820.  
  821. PROCEDURE DISPPOS(FARBE:BYTE);
  822. BEGIN
  823.   TEXTCOLOR(FARBE);
  824.   GOTOXY(10+5*(PRED(ACOL) MOD 12),YCOFF+YCOFF*(PRED(ACOL) DIV 12));
  825.   WRITE(ACOL:5);
  826.   TEXTCOLOR(UEBCOL);
  827. END;
  828.  
  829. PROCEDURE DISPCOL(SELPOS:INTEGER);
  830. VAR   I,J     : INTEGER;
  831. BEGIN
  832.   I := PRED(SELPOS) DIV 12;
  833.   J := SUCC(PRED(SELPOS) MOD 12);
  834.   IF SELPOS = ACOL THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  835.   GOTOXY(10+5*PRED(J),YCOFF+YCOFF*I);
  836.   WRITE(SELPOS:5);
  837.   TEXTCOLOR(UEBCOL);
  838.   SETFILLSTYLE(1,COL[12*I+J]);
  839.   BAR(50+40*J,YYOFF+YYOFF*I,80+40*J,YYOFF+YYWID+YYOFF*I);
  840.   RECTANGLE(50+40*J,YYOFF+YYOFF*I,80+40*J,YYOFF+YYWID+YYOFF*I);
  841. END; { DISPCOL }
  842.  
  843. BEGIN { FARBEN }
  844.   MPOS := 2;
  845.   CLEARDEVICE;
  846.   ACOL := 1;
  847.   W := -1;
  848.  
  849.   IF YMAX = 479 THEN BEGIN
  850.     YYOFF := 80;
  851.     YYWID := 50;
  852.     YZWID := 16;
  853.     YCOFF := 5;
  854.   END ELSE BEGIN
  855.     YYOFF := 56;
  856.     YYWID := 36;
  857.     YZWID := 14;
  858.     YCOFF := 4;
  859.   END;
  860.  
  861.   TEXTCOLOR(UEBCOL);
  862.   GOTOXY(1,1);
  863.   WRITE(#24,' = 1 Farbe mehr, ',#25,' = 1 Farbe weniger            <End> oder "E" = Ende');
  864.   GOTOXY(1,2);
  865.   WRITE(#26,',',#27,' = Farb- Nr. auswählen');
  866.   GOTOXY(1,3);
  867.   WRITE('Zahl eingeben dann Enter = aktuelle Farbe einstellen');
  868.  
  869.   FOR I := 0 TO 15 DO BEGIN
  870.     GOTOXY(1,I+SUCC(YCOFF)); WRITE(I:2);
  871.     SETFILLSTYLE(1,I); BAR(      30,YYOFF+YZWID*I,42,YYOFF+12+YZWID*I);
  872.     SETCOLOR(15);      RECTANGLE(30,YYOFF+YZWID*I,42,YYOFF+12+YZWID*I);
  873.   END;
  874.  
  875.   FOR I := 1 TO MAXCOL DO DISPCOL(I);
  876.  
  877.   REPEAT
  878.     CH := UPCASE(READKEY); IF CH = #0 THEN CH1 := READKEY ELSE CH1 := #0;
  879.     CASE CH OF
  880.  '0'..'9' : BEGIN
  881.               A := ORD(CH) - $30;
  882.               IF W > -1 THEN IF W = 1 THEN W := 10 + A ELSE W := A
  883.                         ELSE W := A;
  884.               GOTOXY(13+5*(PRED(ACOL) MOD 12),YCOFF+YCOFF*(PRED(ACOL) DIV 12)+1);
  885.               TEXTCOLOR(14);
  886.               WRITE(W:2);
  887.               TEXTCOLOR(UEBCOL);
  888.             END;
  889.        ^H : BEGIN
  890.               GOTOXY(13+5*(PRED(ACOL) MOD 12),YCOFF+YCOFF*(PRED(ACOL) DIV 12)+1);
  891.               IF W > 0 THEN BEGIN
  892.                 W := W DIV 10;
  893.                 TEXTCOLOR(14);
  894.                 WRITE(W:2);
  895.                 TEXTCOLOR(UEBCOL);
  896.               END ELSE BEGIN
  897.                 W := -1;
  898.                 WRITE('  ');
  899.               END;
  900.             END;
  901.        ^M : BEGIN
  902.               IF W > -1 THEN BEGIN
  903.                 IF W > 15 THEN W := 15;
  904.                 COL[ACOL] := W;
  905.                 DISPCOL(ACOL);
  906.                 W := -1;
  907.               END;
  908.               IF ACOL < MAXCOL THEN BEGIN
  909.                 DISPCOL(ACOL);
  910.                 DISPPOS(NORMCOL);
  911.                 INC(ACOL);
  912.                 DISPPOS(SELCOL);
  913.               END;
  914.             END;
  915.      ELSE CASE CH1 OF
  916.          #75 : BEGIN { LINKS }
  917.                  DISPCOL(ACOL);
  918.                  W := -1;
  919.                  DISPPOS(NORMCOL);
  920.                  IF ACOL > 1 THEN DEC(ACOL);
  921.                  DISPPOS(SELCOL);
  922.                END;
  923.          #77 : BEGIN { RECHTS }
  924.                  DISPCOL(ACOL);
  925.                  W := -1;
  926.                  DISPPOS(NORMCOL);
  927.                  IF ACOL < MAXCOL THEN INC(ACOL);
  928.                  DISPPOS(SELCOL);
  929.                END;
  930.          #72 : BEGIN { AUF }
  931.                  DISPCOL(ACOL);
  932.                  W := -1;
  933.                  IF MAXCOL < MAXMAXCOL THEN BEGIN
  934.                    INC(MAXCOL);
  935.                    DISPCOL(MAXCOL);
  936.                  END;
  937.                END;
  938.          #80 : BEGIN { AB }
  939.                  DISPCOL(ACOL);
  940.                  W := -1;
  941.                  DISPPOS(NORMCOL);
  942.                  IF MAXCOL > 2 THEN BEGIN
  943.                    I := PRED(MAXCOL) DIV 12;
  944.                    J := SUCC(PRED(MAXCOL) MOD 12);
  945.                    SETFILLSTYLE(1,0);
  946.                    BAR(50+40*J,YYOFF-16+YYOFF*I,80+40*J,YYOFF+YYWID+YYOFF*I);
  947.                    DEC(MAXCOL);
  948.                  END;
  949.                  IF ACOL > MAXCOL THEN ACOL := MAXCOL;
  950.                  DISPPOS(SELCOL);
  951.                END;
  952.          #82 : BEGIN { INSERT }
  953.                  DISPCOL(ACOL);
  954.                  W := -1;
  955.                  IF ACOL < MAXMAXCOL THEN BEGIN
  956.                    IF MAXCOL < MAXMAXCOL THEN INC(MAXCOL);
  957.                    FOR I := PRED(MAXMAXCOL) DOWNTO ACOL DO BEGIN
  958.                      COL[SUCC(I)] := COL[I];
  959.                      IF I < MAXCOL THEN DISPCOL(SUCC(I));
  960.                    END;
  961.                  END;
  962.                END;
  963.          #83 : BEGIN { DELETE }
  964.                  DISPCOL(ACOL);
  965.                  W := -1;
  966.                  IF ACOL < MAXMAXCOL THEN BEGIN
  967.                    IF MAXCOL > 2 THEN BEGIN
  968.                      I := PRED(MAXCOL) DIV 12;
  969.                      J := SUCC(PRED(MAXCOL) MOD 12);
  970.                      SETFILLSTYLE(1,0);
  971.                      BAR(50+40*J,YYOFF-16+YYOFF*I,80+40*J,YYOFF+YYWID+YYOFF*I);
  972.                    DEC(MAXCOL);
  973.                    END;
  974.                    FOR I := ACOL TO MAXMAXCOL DO BEGIN
  975.                      COL[I] := COL[SUCC(I)];
  976.                      IF I <= MAXCOL THEN DISPCOL(I);
  977.                    END;
  978.                  END;
  979.                  IF ACOL > MAXCOL THEN ACOL := MAXCOL;
  980.                  DISPPOS(SELCOL);
  981.                END;
  982.          #79 : CH := 'E'; { END }
  983.       END; { CASE CH1 }
  984.     END; { CASE CH }
  985.   UNTIL CH = 'E';
  986.   TEXTCOLOR(UEBCOL);
  987.   CLEARDEVICE;
  988. END;
  989.  
  990.  
  991. PROCEDURE MACHHIN;
  992. VAR   I,J,XW1,YW1,XO1,YO1  : INTEGER;
  993.       CH                   : CHAR;
  994.       COL1                 : WORD;
  995.       XW2,YW2              : INTEGER;
  996.       XQ,YQ                : SINGLE;
  997.       RAND                 : BOOLEAN;
  998.  
  999. PROCEDURE RECHNEPUNKT(XO,YO:INTEGER);
  1000. BEGIN
  1001.   IF JULIA THEN BEGIN
  1002.     X := AMIN + ((I+XO) * DA);
  1003.     Y := BMIN + ((J+YO) * DB);
  1004.   END ELSE BEGIN
  1005.     B := BMIN + ((J+YO) * DB);
  1006.     X := 0; Y := 0;
  1007.   END;
  1008.   N := 0;
  1009.   REPEAT
  1010.     XQ := SQR(X);
  1011.     YQ := SQR(Y);
  1012.     Y := 2 * X * Y + B;
  1013.     X := XQ - YQ + A;
  1014.     INC(N);
  1015.   UNTIL (N = NMAX) OR ((XQ + YQ) > G);
  1016.   IF N < NMAX THEN PUTPIXEL(XOFF+I+XO,YOFF+J+YO,COL[N MOD MAXCOL])
  1017.               ELSE PUTPIXEL(XOFF+I,YOFF+J,0);
  1018. END;
  1019.  
  1020. BEGIN { MACHHIN }
  1021.   COL[0] := COL[MAXCOL];
  1022.   MPOS := 5;
  1023.   CLEARDEVICE;
  1024.   XW1  := XWID;  YW1  := YWID;
  1025.   XO1  := XOFF;  YO1  := YOFF;
  1026.   XWID := OXWID; YWID := OYWID;
  1027.   XOFF := OXOFF; YOFF := OYOFF;
  1028.   XW2 := (XWID AND $FFFE); YW2 := (YWID AND $FFFE);
  1029.   SETLINESTYLE(SOLIDLN,0,1);
  1030.   RECTANGLE(XOFF,YOFF,XOFF+XW2,YOFF+YW2);
  1031.   L := IMAGESIZE(0,0,OXWID,(OYWID DIV 8));
  1032.   L := L * 9;
  1033.   IF L > (MEMAVAIL+GSIZ) THEN BEGIN
  1034.     FCLOSE(F);
  1035.     GOTOXY(1,10);
  1036.     WRITELN('*****  ZU WENIG SPEICHERPLATZ  *****');
  1037.     CH := READKEY; IF CH = #0 THEN CH := READKEY;
  1038.     CLEARDEVICE;
  1039.     HATBILD := FALSE;
  1040.     PARSAV := FALSE;
  1041.     EXIT;
  1042.   END;
  1043.   DISPPAR(1,1);
  1044.   SETCOLOR(15);
  1045.  
  1046.   L := TIMEMS;
  1047.   IF JULIA THEN BEGIN
  1048.     A := CA;
  1049.     B := CB;
  1050.   END;
  1051.  
  1052.   DA := (AMAX - AMIN) / XWID;
  1053.   DB := (BMAX - BMIN) / YWID;
  1054.  
  1055.   FOR I := 0 TO XWID DO BEGIN
  1056.     RAND := ((I = 0) OR (I = XW2));
  1057.     IF NOT JULIA THEN A := AMIN + I * DA;
  1058.     IF (I AND 1) <> 0 THEN BEGIN
  1059.     END ELSE BEGIN
  1060.       FOR J := 0 TO YWID DO BEGIN
  1061.         IF (J AND 1) <> 0 THEN BEGIN
  1062.         END ELSE BEGIN
  1063.           RECHNEPUNKT(0,0);
  1064.           IF KEYPRESSED THEN BEGIN
  1065.             CH := READKEY; IF CH = #0 THEN CH := READKEY;
  1066.             IF CH = ^[ THEN BEGIN
  1067.               XWID := XW1;  YWID := YW1;
  1068.               XOFF := XO1;  YOFF := YO1;
  1069.               CLEARDEVICE;
  1070.               EXIT;
  1071.             END;
  1072.           END;
  1073.           IF J > 1 THEN BEGIN
  1074.             COL1 := GETPIXEL(XOFF+I,YOFF+J);
  1075.             IF COL1 = GETPIXEL(XOFF+I,YOFF+J-2)
  1076.               THEN PUTPIXEL(XOFF+I,YOFF+J-1,COL1)
  1077.               ELSE RECHNEPUNKT(0,-1);
  1078.           END;
  1079.         END; { IF (J AND 1) <> 0 }
  1080.       END; { NEXT J }
  1081.       IF I > 1 THEN BEGIN
  1082.         FOR J := 0 TO YWID DO BEGIN
  1083.           COL1 := GETPIXEL(XOFF+I,YOFF+J);
  1084.           IF COL1 = GETPIXEL(XOFF+I-2,YOFF+J)
  1085.             THEN PUTPIXEL(XOFF+I-1,YOFF+J,COL1)
  1086.             ELSE BEGIN
  1087.               IF NOT JULIA THEN A := AMIN + (PRED(I) * DA);
  1088.               RECHNEPUNKT(-1,0);
  1089.             END;
  1090.         END; { NEXT J }
  1091.       END;
  1092.     END; { IF (I AND 1) <> 0 }
  1093.   END; { NEXT I }
  1094.  
  1095.   BILDFREIGEBEN;
  1096.   SIZ := IMAGESIZE(0,0,XWID,(YWID DIV 8));
  1097.   FOR I := 0 TO 8 DO BEGIN
  1098.     GETMEM(BILD[I],SIZ);
  1099.     GSIZ := GSIZ + SIZ;
  1100.     GETIMAGE(XOFF,YOFF+(I*(YWID DIV 8)),
  1101.              XOFF+XWID,YOFF+((I+1)*(YWID DIV 8)),BILD[I]^);
  1102.   END; { NEXT I }
  1103.   HATBILD := TRUE;
  1104.  
  1105.   L1 := TIMEMS;
  1106.   IF L < L1 THEN L := L1 - L ELSE L := 86400000 - L + L1;
  1107.   STD := L DIV 3600000;
  1108.   L1 := STD; L1 := L1 * 3600000; L := L - L1;
  1109.   MIN := L DIV 60000;
  1110.   L1 := MIN; L1 := L1 * 60000;   L := L - L1;
  1111.   SEC := L DIV 1000;
  1112.   L1 := SEC; L1 := L1 * 1000;    L := L - L1;
  1113.   MSEC := L;
  1114.   GOTOXY(42,1);
  1115.   WRITE('Rechenzeit :',STD:3,' Std,',MIN:3,' min,',SEC:3,',',MSEC:3,' sec');
  1116.  
  1117.   WRITE(CHR(7));
  1118.   CH := READKEY; IF CH = #0 THEN CH := READKEY;
  1119.   CLEARDEVICE;
  1120.   PARSAV := FALSE;
  1121.   MPOS := 7;
  1122. END; { MACHHIN }
  1123.  
  1124.  
  1125. PROCEDURE GUCKMAL;
  1126. VAR   CH1  : CHAR;
  1127.       I    : BYTE;
  1128. BEGIN
  1129.   IF NOT HATBILD THEN EXIT;
  1130.   CLEARDEVICE;
  1131.   ZEIGEBILD(0);
  1132.   CH1 := READKEY; IF CH1 = #0 THEN CH1 := READKEY;
  1133. (*
  1134.   CLEARDEVICE;
  1135. *)
  1136. END; { GUCKMAL }
  1137.  
  1138.  
  1139. PROCEDURE MENUE;
  1140. CONST SELCHAR : ARRAY[1..MMAX] OF CHAR =
  1141.                 ('1','2','3','4','5','6','7','8','E');
  1142. VAR   CH,CH1  : CHAR;
  1143.  
  1144. PROCEDURE DISPMENUE(VON,BIS:BYTE);
  1145. LABEL ENDE;
  1146. BEGIN
  1147.   IF VON = 0 THEN BEGIN
  1148.     WINDOW(1,1,80,25);
  1149.     TEXTCOLOR(7);
  1150.     GOTOXY(55,25); WRITE(MAXAVAIL,' Bytes Speicher');
  1151.  
  1152.     WINDOW(15,2,80,25);
  1153.     TEXTCOLOR(UEBCOL);
  1154.     GOTOXY(1,1);
  1155.     IF JULIA THEN WRITE('  ******  Juliamengen- Berechnung  ******   ')
  1156.              ELSE WRITE('Mandelbrotmengen- Berechnung (Apfelmännchen)');
  1157.     WINDOW(20,4,80,25);
  1158.     TEXTCOLOR(NORMCOL);
  1159.     IF JULIA THEN WRITE('Mandelbrotmenge ........... M')
  1160.              ELSE WRITE('Juliamenge ................ J');
  1161.   END;
  1162.   WINDOW(20,6,80,25);
  1163.   IF BIS < 1 THEN GOTO ENDE;
  1164.   IF VON < 2 THEN BEGIN
  1165.     GOTOXY(1,1);
  1166.     IF MPOS = 1 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  1167.     WRITE('File laden ................ 1');
  1168.   END;
  1169.   IF BIS < 2 THEN GOTO ENDE;
  1170.   IF VON < 3 THEN BEGIN
  1171.     GOTOXY(1,3);
  1172.     IF MPOS = 2 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  1173.     WRITE('Farben einstellen ......... 2');
  1174.   END;
  1175.   IF BIS < 3 THEN GOTO ENDE;
  1176.   IF VON < 4 THEN BEGIN
  1177.     GOTOXY(1,5);
  1178.     IF MPOS = 3 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  1179.     WRITE('Fenstergröße einstellen ... 3');
  1180.   END;
  1181.   IF BIS < 4 THEN GOTO ENDE;
  1182.   IF VON < 5 THEN BEGIN
  1183.     GOTOXY(1,7);
  1184.     IF MPOS = 4 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  1185.     WRITE('Parameter einstellen ...... 4');
  1186.   END;
  1187.   IF BIS < 5 THEN GOTO ENDE;
  1188.   IF VON < 6 THEN BEGIN
  1189.     GOTOXY(1,9);
  1190.     IF MPOS = 5 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  1191.     WRITE('Berechnen ................. 5');
  1192.   END;
  1193.   IF BIS < 6 THEN GOTO ENDE;
  1194.   IF VON < 7 THEN BEGIN
  1195.     GOTOXY(1,11);
  1196.     IF MPOS = 6 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  1197.     IF HATBILD THEN WRITE('Ausschnitt festlegen ...... 6');
  1198.   END;
  1199.   IF BIS < 7 THEN GOTO ENDE;
  1200.   IF VON < 8 THEN BEGIN
  1201.     GOTOXY(1,13);
  1202.     IF MPOS = 7 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  1203.     IF HATBILD THEN WRITE('File abspeichern .......... 7');
  1204.   END;
  1205.   IF BIS < 8 THEN GOTO ENDE;
  1206.   IF VON < 9 THEN BEGIN
  1207.     GOTOXY(1,15);
  1208.     IF MPOS = 8 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  1209.     IF HATBILD THEN WRITE('Bild ansehen .............. 8');
  1210.   END;
  1211.   IF BIS < 9 THEN GOTO ENDE;
  1212.   IF VON < 10 THEN BEGIN
  1213.     GOTOXY(1,17);
  1214.     IF MPOS = 9 THEN TEXTCOLOR(SELCOL) ELSE TEXTCOLOR(NORMCOL);
  1215.     WRITE('Programm Ende ............. E');
  1216.   END;
  1217. ENDE:
  1218.   TEXTCOLOR(UEBCOL);
  1219.   WINDOW(1,1,80,25); GOTOXY(1,1);
  1220. END;
  1221.  
  1222. BEGIN { MENUE }
  1223.   SETVIEWPORT(0,0,XMAX,YMAX,CLIPON);
  1224.   CH := ' ';
  1225.   REPEAT
  1226.     IF CH <> #0 THEN DISPMENUE(0,99);
  1227.     CH := UPCASE(READKEY); IF CH = #0 THEN CH1 := READKEY ELSE CH1 := #0;
  1228.     IF CH = #0 THEN CASE CH1 OF
  1229.       #59 : BEGIN { F1 }
  1230.               HELP;
  1231.               CH := '@';
  1232.               DISPMENUE(0,99);
  1233.             END;
  1234.       #72 : BEGIN { AUF }
  1235.               DEC(MPOS);
  1236.               DISPMENUE(SUCC(MPOS),SUCC(MPOS));
  1237.               IF (NOT HATBILD) AND (MPOS = 7) THEN MPOS := 5;
  1238.               IF MPOS < 1 THEN MPOS := MMAX;
  1239.               DISPMENUE(MPOS,MPOS);
  1240.             END;
  1241.       #80 : BEGIN { AB }
  1242.               INC(MPOS);
  1243.               DISPMENUE(PRED(MPOS),PRED(MPOS));
  1244.               IF (NOT HATBILD) AND (MPOS = 6) THEN MPOS := 8;
  1245.               IF MPOS > MMAX THEN MPOS := 1;
  1246.               DISPMENUE(MPOS,MPOS);
  1247.             END;
  1248.       #79 : CH := 'E'; { END }
  1249.     END; { CASE }
  1250.     IF CH = ^M THEN CH := SELCHAR[MPOS];
  1251.     CASE CH OF
  1252.       '1' : LOAD;
  1253.       '2' : FARBEN;
  1254.       '3' : SETOUTP;
  1255.       '4' : GETPARAM;
  1256.       '5' : MACHHIN;
  1257.       '6' : AUSSCHN;
  1258.       '7' : STORE;
  1259.       '8' : GUCKMAL;
  1260.   'J','j' : JULIA := TRUE;
  1261.   'M','m' : JULIA := FALSE;
  1262.     END; { CASE }
  1263.   UNTIL CH = 'E';
  1264. END; { MENUE }
  1265.  
  1266.  
  1267. PROCEDURE ROTATEPAL(DIR:BOOLEAN);
  1268. VAR   PC  : CHAR;
  1269.       PS  : STRING[16] ABSOLUTE RP;
  1270. BEGIN
  1271.   IF DIR THEN BEGIN
  1272.     PC := PS[2];
  1273.     MOVE(PS[3],PS[2],14);
  1274.     PS[16] := PC;
  1275.   END ELSE BEGIN
  1276.     INSERT(PS[16],PS,2);
  1277.   END;
  1278.   SETALLPALETTE(RP);
  1279. END; { ROTATEPAL }
  1280.  
  1281.  
  1282. PROCEDURE BATCH;
  1283. VAR   BF            : TEXT;
  1284.       LIN           : STRING;
  1285.       WMOD          : BYTE;
  1286.       STOP,ANIMATE  : BOOLEAN;
  1287.       CH1           : CHAR;
  1288.       SCHLEIFE      : WORD;
  1289.  
  1290. PROCEDURE DELBLANK;
  1291. BEGIN
  1292.   WHILE (LENGTH(LIN) > 0) AND (LIN[1] = ' ') DO DELETE(LIN,1,1);
  1293. END; { DELBLANK }
  1294.  
  1295. PROCEDURE DELNONBLANK;
  1296. BEGIN
  1297.   WHILE (LENGTH(LIN) > 0) AND (LIN[1] <> ' ') DO DELETE(LIN,1,1);
  1298. END; { DELNONBLANK }
  1299.  
  1300. PROCEDURE BATCHCOMMAND;
  1301. VAR   I,J     : WORD;
  1302.       CH1     : CHAR;
  1303.       S       : STRING;
  1304. BEGIN { BATCHCOMMAND }
  1305.   DELBLANK;
  1306.   CASE LIN[1] OF
  1307.     'A' : ANIMATE := NOT ANIMATE;
  1308.     'C' : CLEARDEVICE;
  1309.     'D' : BEGIN
  1310.             DELNONBLANK;
  1311.             DELBLANK;
  1312.             VAL(LIN,I,J);
  1313.             IF J = 0 THEN REPEAT
  1314.               DELAY(100);
  1315.               IF ANIMATE THEN ROTATEPAL(FALSE);
  1316.               DEC(I);
  1317.             UNTIL KEYPRESSED OR (I = 0);
  1318.           END;
  1319.     'F' : BEGIN
  1320.             DELNONBLANK;
  1321.             DELBLANK;
  1322.             IF SCHLEIFE = 0 THEN BEGIN
  1323.               I := POS(' ',LIN);
  1324.               VAL(COPY(LIN,1,PRED(I)),SCHLEIFE,J);
  1325.               IF J = 0 THEN BEGIN
  1326.                 DELNONBLANK;
  1327.                 DELBLANK;
  1328.               END ELSE SCHLEIFE := 0;
  1329.             END ELSE BEGIN
  1330.               DELNONBLANK;
  1331.               DELBLANK;
  1332.               DEC(SCHLEIFE);
  1333.             END;
  1334.             IF SCHLEIFE > 0 THEN BEGIN
  1335.               IF TEXTSEEK(BF,0) THEN REPEAT
  1336.                 READLN(BF,S);
  1337.               UNTIL EOF(BF) OR (S = ':'+LIN);
  1338.             END;
  1339.           END;
  1340.     'G' : BEGIN
  1341.             DELNONBLANK;
  1342.             DELBLANK;
  1343.             IF TEXTSEEK(BF,0) THEN REPEAT
  1344.               READLN(BF,S);
  1345.             UNTIL EOF(BF) OR (S = ':'+LIN);
  1346.           END;
  1347.     'K' : BEGIN
  1348.             REPEAT
  1349.               DELAY(100);
  1350.               IF ANIMATE THEN ROTATEPAL(FALSE);
  1351.             UNTIL KEYPRESSED;
  1352.             CH1 := READKEY;
  1353.             IF CH1 = ^[ THEN STOP := TRUE;
  1354.             IF CH1 = #0 THEN CH1 := READKEY;
  1355.           END;
  1356.     'L' : BEGIN
  1357.             DELNONBLANK;
  1358.             DELBLANK;
  1359.             RP := DP;
  1360.             SETALLPALETTE(RP);
  1361.             ANIMATE := FALSE;
  1362.             BILDFREIGEBEN;
  1363.             IF LIESFILE(LIN,FALSE) THEN ZEIGEBILD(WMOD);
  1364.           END;
  1365.     'P' : DISPPZEIT;
  1366.     'R' : ZEIGEBILD(WMOD);
  1367.     'W' : BEGIN
  1368.             DELNONBLANK;
  1369.             DELBLANK;
  1370.             VAL(LIN,I,J);
  1371.             IF (J = 0) AND (I IN [0..3]) THEN WMOD := I;
  1372.           END;
  1373.   END; { CASE LIN[1] }
  1374. END; { BATCHCOMMAND }
  1375.  
  1376. BEGIN { BATCH }
  1377.   STOP := FALSE;
  1378.   ANIMATE := FALSE;
  1379.   WMOD := 0;
  1380.   SCHLEIFE := 0;
  1381.   ASSIGN(BF,PARAM);
  1382.   RESET(BF);
  1383.   WHILE NOT EOF(BF) AND NOT STOP DO BEGIN
  1384.     READLN(BF,LIN);
  1385.     LIN := STUPCASE(LIN);
  1386.     BATCHCOMMAND;
  1387.     IF KEYPRESSED THEN BEGIN
  1388.       CH1 := READKEY;
  1389.       IF CH1 = ^[ THEN STOP := TRUE;
  1390.       IF CH1 = #0 THEN CH1 := READKEY;
  1391.     END;
  1392.   END; { WHILE NOT EOF(BF) }
  1393.   CLOSE(BF);
  1394.   CLOSEGRAPH;
  1395.   HALT;
  1396. END; { BATCH }
  1397.  
  1398.  
  1399. BEGIN { MAIN }
  1400.   DIRECTVIDEO := FALSE;
  1401.   TEXTCOLOR(UEBCOL);
  1402.  
  1403.   DETECTGRAPH(GDRIV,GMODE);
  1404.   IF (GDRIV <> EGA) AND (GDRIV <> VGA) THEN BEGIN
  1405.     WRITELN;
  1406.     WRITELN;
  1407.     WRITELN('Dies Programm funktioniert nur mit EGA > 64k Bytes');
  1408.     WRITELN('oder VGA - mein Vorschlag : neuen Computer kaufen !');
  1409.     WRITELN;
  1410.     HALT;
  1411.   END;
  1412.  
  1413.   PATH    := ZIELDIR;
  1414.   FNAM    := 'GBILD.MBM';
  1415.   PARAM   := '';
  1416.   HATBILD := FALSE;
  1417.   PARSAV  := FALSE;
  1418.   MPOS    := 1;
  1419.   MAXCOL  := 15;
  1420.   FOR I   := 1 TO MAXMAXCOL DO COL[I] := I MOD 16;
  1421.   GSIZ    := 0;
  1422.  
  1423.   IF ZIELDIR[LENGTH(ZIELDIR)] = '\' THEN FNAM := ZIELDIR + FNAM
  1424.                                     ELSE FNAM := ZIELDIR + '\' + FNAM;
  1425.  
  1426.   if RegisterBGIdriver(@EGAVGADriver) < 0 then BEGIN
  1427.     WRITELN('FEHLER BEI REGISTERBGIDRIVER');
  1428.     HALT(1);
  1429.   END;
  1430.  
  1431.   DETECTGRAPH(GDRIV,GMODE);
  1432.   PP := 2;
  1433.   IF PARAMCOUNT > 0 THEN BEGIN
  1434.     IF STUPCASE(PARAMSTR(1)) = '/E' THEN BEGIN
  1435.       GDRIV := EGA;
  1436.       GMODE := EGAHI;
  1437.     END ELSE BEGIN
  1438.       IF STUPCASE(PARAMSTR(1)) = '/V' THEN BEGIN
  1439.         GDRIV := VGA;
  1440.         GMODE := VGAHI;
  1441.       END ELSE BEGIN
  1442.         PP := 1;
  1443.       END;
  1444.     END;
  1445.     PARAM := STUPCASE(PARAMSTR(PP));
  1446.     IF POS('.MBM',PARAM) > 0 THEN FNAM := PARAM;
  1447.   END;
  1448.  
  1449.   INITGRAPH(GDRIV,GMODE,'');
  1450.   XMAX := GETMAXX;
  1451.   YMAX := GETMAXY;
  1452.   SETLINESTYLE(SOLIDLN,0,1);
  1453.  
  1454.   DP.SIZE := 16;
  1455.   DP.COLORS[0]  := 0;
  1456.   DP.COLORS[1]  := 1;
  1457.   DP.COLORS[2]  := 2;
  1458.   DP.COLORS[3]  := 3;
  1459.   DP.COLORS[4]  := 4;
  1460.   DP.COLORS[5]  := 5;
  1461.   DP.COLORS[6]  := 6;
  1462.   DP.COLORS[7]  := 7;
  1463.   DP.COLORS[8]  := $38;
  1464.   DP.COLORS[9]  := 1 + 1 SHL 3;
  1465.   DP.COLORS[10] := 2 + 2 SHL 3;
  1466.   DP.COLORS[11] := 3 + 3 SHL 3;
  1467.   DP.COLORS[12] := 4 + 4 SHL 3;
  1468.   DP.COLORS[13] := 5 + 5 SHL 3;
  1469.   DP.COLORS[14] := 6 + 6 SHL 3;
  1470.   DP.COLORS[15] := 7 + 7 SHL 3;
  1471.   RP := DP;
  1472.  
  1473.   YWID  := YMAX - 100;
  1474.   XWID  := YWID;
  1475.   XOFF  := (SUCC(XMAX)-XWID) DIV 2;
  1476.   YOFF  := (SUCC(YMAX)-YWID) DIV 2; IF YOFF < 0 THEN YOFF := 0;
  1477.   OXWID := XWID; OYWID := YWID;
  1478.   OXOFF := XOFF; OYOFF := YOFF;
  1479.   STD   := 9999;
  1480.  
  1481.   AMIN := -2;
  1482.   AMAX := 1;
  1483.   BMIN := -1.15;
  1484.   BMAX := 1.15;
  1485.   NMAX := 100;
  1486.   G    := 100;
  1487.   CA   := 0;
  1488.   CB   := 0;
  1489.   JULIA := FALSE;
  1490.  
  1491.   SETVIEWPORT(0,0,XMAX,YMAX,CLIPON);
  1492.   CLEARDEVICE;
  1493. { GGF. MANDELBROT- BATCH AUSFÜHREN }
  1494.   IF (POS('.MBB',PARAM) > 0) AND (EXISTFILE(PARAM)) THEN BATCH;
  1495.   IF LIESFILE(FNAM,FALSE) THEN ZEIGEBILD(0);
  1496.   MENUE;
  1497.  
  1498.   CLOSEGRAPH;
  1499. END.
  1500.  
  1501.