home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 2 / amigaformatcd02.iso / pd / graphics / graph3d / graph3d.p < prev    next >
Encoding:
Text File  |  1996-05-20  |  72.0 KB  |  2,245 lines
  1. PROGRAM graph3d;
  2. { Business-Grafik in 3D }
  3. USES graphics, intuition, exec;
  4.  
  5. {$ path "ram:include/", "pas:include/" }
  6. {  incl "intuition.lib", "graphics.lib", "exec.lib" }
  7. {$ incl "dos.lib", "req.lib", "intuition/preferences.h" }
  8. {$ incl "workbench/startup.h", "libraries/dosextens.h", "graphics/gfxbase.h"  }
  9. {$ opt q,s+,i+ } { Laufzeitprüfungen: nur Stack und Indizes }
  10.  
  11. CONST nmax=100;
  12.       strspace = 4000;    { ca. 2*nmax*20 -> im Mittel Platz für 20 Zeichen }
  13.       version='$VER: Graph3D 1.43  (28.04.96)';
  14.       DEUTSCH = 'D';
  15.  
  16. TYPE r_vekt = RECORD x,y,z: real END;
  17.      fl_vekt = RECORD x,y: real END;
  18.      IntArr10 = ARRAY[1..10] OF Integer;
  19.      WordArr40 = ARRAY[1..40] OF Word;
  20.      chefstring = String[40];
  21.      str80 = String[80];
  22.  
  23. { Alle etwas größeren Variablen werden als STATIC deklariert, damit KICK-Pascal }
  24. { sie nicht auf den Stack packt (Argh!). }
  25.  
  26. VAR zr: ARRAY[1..nmax,1..nmax] OF real; STATIC;
  27.     skz: real;
  28.     StrHalde: ARRAY[1..strspace] OF char; STATIC;
  29.     xtitel,ytitel: ARRAY[1..nmax] OF Str; STATIC;
  30.     titel,einheit,filename: str80; STATIC;
  31.     ext: string[5];
  32.     b,o,r,e1,e2,pr0,pr1,pr0m,pr1m: r_vekt; STATIC;
  33.     fl_quader: ARRAY[1..8] OF fl_vekt; STATIC;
  34.     off,pfl0,pfl1: fl_vekt;
  35.     rd,rb,phi,theta: Real;
  36.     mag,gap: Real;
  37.     schraeg,ende,notaus,quickdraw: Boolean;
  38.     datei: Text;
  39.     nx,ny,modus: Integer;
  40.     grace,horiz,vert: Integer;
  41.  
  42.     { ab hier für Systemprogrammierung: }
  43. VAR areabuffer: ARRAY[1..250] OF Word; STATIC;
  44.     MyAreaInfo: AreaInfo;
  45.     tmp: TmpRas;
  46.     Strip,LastMenu: p_Menu;
  47.     LastItem, LastSubItem: p_MenuItem;
  48.     WinGad: ARRAY[1..6] OF Gadget; STATIC;
  49.     PropInf1,PropInf2: PropInfo; STATIC;
  50.     MoveDat1,MoveDat2: ARRAY[1..6] OF Integer;
  51.     Bild: ARRAY[1..4] OF Image; STATIC;
  52.     ChipSpc: ARRAY[1..5] OF ^WordArr40;
  53.     wintitle,scrtitle: Str80; STATIC;
  54.     palette: ARRAY[0..3] OF Long;
  55.     myprocess: p_Process;
  56.     NeuesWindow: NewWindow; STATIC;
  57.     MyWindow,oldwindowptr: p_Window;
  58.     Rast: p_RastPort;
  59.     Con,Upt,armem: Ptr;
  60.     MyMsg: p_IntuiMessage;
  61.     topazAttr: TextAttr;
  62.     NSTags: ARRAY[1..5] OF TagItem; STATIC;
  63.     NeuerScreen: ExtNewScreen; STATIC;
  64.     MyScreen: p_Screen;
  65.     charx,chary,baseline: Word;  { beschreiben den Font des Screens }
  66.     breite,hoehe: Integer;
  67.     { für die Reuester: }
  68.     MyRequest: Requester; STATIC;
  69.     ReqGad: ARRAY[1..10] OF Gadget; STATIC;
  70.     StrInf: ARRAY[1..10] OF StringInfo; STATIC;
  71.     ITxt: ARRAY[1..10] OF IntuiText; STATIC;
  72.     Bord: ARRAY [1..8] OF Border; STATIC;
  73.     Coords: ARRAY[1..4] OF IntArr10; STATIC;
  74.     ubuf: str80; { einer für alle ;-) }
  75.     muell: ARRAY[0..31] OF Byte;
  76.     { für die req.library: }
  77.     MyFileReq: p_ReqFileRequester;
  78.     pfad: ARRAY[0..DSIZE] OF Char; STATIC;
  79.     name: ARRAY[0..FCHARS] OF Char; STATIC;
  80.     pfadname: ARRAY[-DSIZE..FCHARS] OF Char; STATIC;
  81.  
  82. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  83. { *#*#*#*#*#*#*#*#*#*#*#*#  Ausgabeformatierung  #*#*#*#*#*#*#*#*#*#*#*#* }
  84. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  85.  
  86. FUNCTION max(a,b: Real): Real;
  87. BEGIN
  88.   IF a>b THEN  max := a  ELSE  max := b;
  89. END;
  90.  
  91. FUNCTION min(a,b: Real): Real;
  92. BEGIN
  93.   IF a<b THEN  min := a  ELSE  min := b;
  94. END;
  95.  
  96. FUNCTION glatt(x: Real): Real;
  97. { aus funktion.mod übernommen, 29.09.93 }
  98. VAR ziffer,potenz: Real;
  99. BEGIN
  100.   IF x=0 THEN
  101.     glatt := x
  102.   ELSE BEGIN
  103.     potenz := Pwr10(Round(Ln(Abs(x))/Ln(10)-0.5)) * x/Abs(x);
  104.     { ln x/ln 10  ist log10(x), x/abs x  ist sgn(x) }
  105.     ziffer := x/potenz;
  106.     IF ziffer>7.5 THEN
  107.       glatt := 10*potenz
  108.     ELSE IF ziffer>3.5 THEN
  109.       glatt := 5*potenz
  110.     ELSE IF ziffer>1.5 THEN
  111.       glatt := 2*potenz
  112.     ELSE
  113.       glatt := 1*potenz
  114.   END
  115. END;
  116.  
  117. PROCEDURE itoa(l: long; anz: integer; vz, fill: char; VAR xstr: chefstring);
  118. { Longinteger mit anz Stellen in String wandeln, von links wird mit <fill>
  119.   aufgefüllt (z. B. '0', ' ', '*'). Falls Zahl zu lang, Leerstring als
  120.   Fehlermeldung. }
  121. { <vz>: hier kann '+', '-' oder ' ' stehen. Vor negative <l> wird aber
  122.   auf jeden Fall ein '-' gesetzt, vor positive nie. Zweck von vz='-':
  123.   '-0' ermöglichen. }
  124. { aus Matrizen.p übernommen, 29.09.93 }
  125. VAR i: Integer;
  126. BEGIN
  127.   IF l<0 THEN vz := '-';
  128.   IF (l>0) AND (vz='-') THEN vz := '+';
  129.   l := Abs(l);
  130.   xstr := '';
  131.   REPEAT
  132.     xstr := Chr(l MOD 10 + Ord('0')) + xstr;
  133.     l := l DIV 10;
  134.   UNTIL l=0;
  135.   IF (vz='+') OR (vz='-') THEN   { gültiges Vorzeichen }
  136.     xstr := vz + xstr;
  137.   anz := anz - Length(xstr);
  138.   IF anz<0 THEN
  139.     xstr := ''
  140.   ELSE
  141.     FOR i := 1 TO anz DO
  142.       xstr := fill + xstr;
  143. END;
  144.  
  145. PROCEDURE f77fix(r: Real; b,s: Integer; VAR ausg: chefstring);
  146. { Zahl r wie mit dem Fortran-Formatbeschreiber  Fb.s  umwandeln }
  147. { aus Matrizen.p übernommen, 29.09.93 }
  148. VAR i,j,pos: Integer;
  149.     teil: chefstring;
  150.     vz: Char;
  151. BEGIN
  152.   { letzte auszugebende Stelle jetzt schon runden, nur die Nachkommastellen }
  153.   { zu runden, kann Fehler ergeben! }
  154.   IF abs(r*pwr10(s))<MaxLongInt THEN
  155.     r := Round(r*pwr10(s)) * pwr10(-s);
  156.   IF r<0 THEN vz := '-'  ELSE  vz := ' ';
  157.   IF s>0 THEN BEGIN
  158.     { Nachkommastellen }
  159.     itoa(Trunc(Frac(Abs(r))*Pwr10(s)), s, ' ', '0', ausg);
  160.     ausg := '.' + ausg;
  161.   END ELSE
  162.     ausg := '';
  163.   itoa(Trunc(r), b - Length(ausg), vz, ' ', teil);
  164.   IF teil = '' THEN BEGIN   { Fehler, Zahl paßt nicht }
  165.     ausg := '';
  166.     FOR i := 1 TO b DO
  167.       ausg := ausg + '*';
  168.   END ELSE
  169.     ausg := teil + ausg;
  170. END;
  171.  
  172. PROCEDURE ftoa(r: real; s: integer; VAR xstr: chefstring);
  173. { Zahl r mit maximal s signifikanten Stellen in String umwandeln, abschließende }
  174. { Nullen hinter dem Komma werden abgeschnitten. }
  175. { Schweren Bug beseitigt, z. B. r=1.0 ergab "0.1"! (10/95) }
  176. VAR i,j,pos: integer;
  177.     teil: chefstring;
  178.     x: real;
  179. BEGIN
  180.   IF r=0 THEN
  181.     xstr := '0'
  182.   ELSE BEGIN
  183.     x := Abs(r);
  184.     pos := Round(Ln(x)/Ln(10)-0.5);    { die Zehnerpotenz, in der die
  185.               erste Ziffer <>0 steht, für Darstellung x=?.???*pwr10(pos) }
  186.     { Mantisse s-stellig erzeugen: }
  187.     xstr := IntStr(Round(x/pwr10(pos-s+1)));
  188.     { manchmal (bei 1.00E??) wird pos falsch berechnet, korrigieren! }
  189.     j := Length(xstr); IF j>s THEN Inc(pos);
  190.     { überflüssige Nullen wegwerfen: }
  191.     s := j; WHILE xstr[s] = '0' DO BEGIN
  192.       xstr[s] := chr(0); Dec(s)
  193.     END;
  194.     IF (pos>s+5) OR (pos<-3) THEN BEGIN
  195.       { Exponentialdarstellung ratsam }
  196.       IF s>1 THEN BEGIN     { Komma an Stelle 2 einpatchen }
  197.         i := Length(xstr)+1; WHILE i>=2 DO BEGIN
  198.           xstr[i+1] := xstr[i]; Dec(i);
  199.         END;
  200.         xstr[2] := '.';
  201.       END;
  202.       IF pos<0 THEN  xstr := xstr + 'E-' ELSE  xstr := xstr + 'E+';
  203.       xstr := xstr + IntStr(Abs(pos) DIV 10);
  204.       xstr := xstr + IntStr(Abs(pos) MOD 10);
  205.     END ELSE BEGIN
  206.       { gewöhnliche Dezimalschreibweise }
  207.       IF s<=pos+1 THEN
  208.         { keine Nachkommastellen, evtl. Nullen anhängen }
  209.         FOR i := 1 TO pos+1-s DO  xstr := xstr + '0'
  210.       ELSE IF pos<0 THEN BEGIN
  211.         { führende Nullen: '0.'+... }
  212.         teil := '0.';  FOR i := 1 TO abs(pos)-1 DO teil := teil + '0';
  213.         xstr := teil + xstr;
  214.       END ELSE BEGIN
  215.         { Komma an Stelle pos+2 einpatchen }
  216.         i := Length(xstr)+1; WHILE i>=pos+2 DO BEGIN
  217.           xstr[i+1] := xstr[i]; Dec(i);
  218.         END;
  219.         xstr[pos+2] := '.';
  220.       END;
  221.     END;
  222.     IF r<0 THEN  xstr := '-' + xstr;
  223.   END;
  224. END;
  225.  
  226. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  227. { *#*#*#*#*#*#*#*#*#*#*#* 3D-Vektorbehandlung *#*#*#*#*#*#*#*#*#*#*#*#*#* }
  228. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  229.  
  230. PROCEDURE projektion(pr: r_vekt; VAR pf: fl_vekt);
  231. VAR v: r_vekt;
  232.     vr: Real;
  233. BEGIN
  234.   { Vektor v=pr-b in Richtung von r (Blickrichtung) "normieren" }
  235.   vr := (pr.x-b.x)*r.x+(pr.y-b.y)*r.y+(pr.z-b.z)*r.z;
  236.   v.x := (pr.x-b.x)/vr;
  237.   v.y := (pr.y-b.y)/vr;
  238.   v.z := (pr.z-b.z)/vr;
  239.   { auf die Schirmvektoren e1, e2 projizieren }
  240.   pf.x := v.x*e1.x + v.y*e1.y + v.z*e1.z;
  241.   pf.y := v.x*e2.x + v.y*e2.y + v.z*e2.z;
  242.   { zurechtrücken }
  243.   pf.x := off.x + pf.x*mag*horiz;
  244.   pf.y := off.y + pf.y*mag*vert;
  245. END;
  246.  
  247. PROCEDURE vektoren;
  248. { initialisiert die Projektionsvektoren für einen Beobachter in den (auf rd }
  249. { bezogenen) Kugelkoordinaten rb, phi, theta }
  250. VAR rr: Real;
  251. BEGIN
  252.   { Raumdiagonale rd: }
  253.   rd := Sqrt(Sqr(pr1.x-pr0.x)+Sqr(pr1.y-pr0.y)+Sqr(pr1.z-pr0.z));
  254.   { Aufpunkt o für Blickrichtung: }
  255.   o.x := (pr0.x+pr1.x)/2;
  256.   o.y := (pr0.y+pr1.y)/2;
  257.   o.z := (pr0.z+pr1.z)/2;
  258.   { Beobachterpunkt b: }
  259.   b.x := o.x + rd*rb*Cos(phi)*Sin(theta);
  260.   b.y := o.y + rd*rb*Sin(phi)*Sin(theta);
  261.   b.z := o.z + rd*rb*Cos(theta);
  262.   { daraus Richtungsvektor r berechnen und normieren }
  263.   rr := Sqrt(Sqr(o.x-b.x)+Sqr(o.y-b.y)+Sqr(o.z-b.z));
  264.   r.x := (o.x-b.x)/rr;
  265.   r.y := (o.y-b.y)/rr;
  266.   r.z := (o.z-b.z)/rr;
  267.   { Basisvektoren e1, e2 der "Rückwand der Lochkamera" bestimmen, dies sind
  268.   zum Glück einfach die Einheitsvektoren e-Phi, e-Theta.
  269.   Die verkehrte y-Achse des Bildschirms ist hierin berücksichtigt! }
  270.   e1.x := -Sin(phi);
  271.   e1.y :=  Cos(phi);
  272.   e1.z := 0;
  273.   e2.x := Cos(theta)*Cos(phi);
  274.   e2.y := Cos(theta)*Sin(phi);
  275.   e2.z := -Sin(theta);
  276. END;
  277.  
  278. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  279. { *#*#*#*#*#*#*#*#*#*#*  diverse Systemoperationen  *#*#*#*#*#*#*#*#*#*#* }
  280. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  281.  
  282. FUNCTION abbruch: Boolean;
  283. { wird von zeitaufwendigen Zeichenroutinen abgefragt }
  284. VAR gad: p_Gadget;
  285.     m,i,s: Integer;
  286. BEGIN
  287.   abbruch := False;
  288.   MyMsg := Get_Msg(Upt);
  289.   IF MyMsg<>Nil THEN BEGIN
  290.     IF MyMsg^.Class=GADGETUP THEN BEGIN
  291.       gad := MyMsg^.IAddress;
  292.       IF gad^.GadgetID=2 THEN  abbruch := True;   { Not-Aus Gadget }
  293.     END;
  294.     IF MyMsg^.Class=MENUPICK THEN BEGIN
  295.       m := MyMsg^.Code AND $1F;
  296.       i := (MyMsg^.Code SHR 5) AND $3F;
  297.       s := (MyMsg^.Code SHR 11) AND $1F;
  298.       IF (m=2) AND (i=8) THEN  abbruch := True;  { Menüpunkt "Halt" }
  299.     END;
  300.     Reply_Msg(MyMsg);
  301.   END;
  302. END;
  303.  
  304. PROCEDURE desaster(meldung: str80);
  305. { erzeugt einen Alert }
  306. VAR egal: Boolean;
  307.     buf: String[100];
  308.     xpos: Integer;
  309. BEGIN
  310.   xpos := 320 - 4*Length(meldung);
  311.   buf := '   '+meldung;
  312.   buf[1] := Chr(Hi(xpos)); buf[2] := Chr(Lo(xpos));
  313.   buf[3] := Chr(18);
  314.   buf [Length(meldung)+5] := Chr(0);
  315.   egal := DisplayAlert(RECOVERY_ALERT,buf,32);
  316. END;
  317.  
  318. PROCEDURE writepalette;
  319. VAR i: integer;
  320. BEGIN
  321.   FOR i := 0 TO 3 DO
  322.     SetRGB4(^MyScreen^.ViewPort,i,(palette[i] div 256) AND 15,
  323.     (palette[i] div 16) AND 15, palette[i] AND 15);
  324. END;
  325.  
  326. PROCEDURE getpalette;
  327. VAR i: integer;
  328. BEGIN
  329.   FOR i := 0 TO 3 DO
  330.     palette[i] := GetRGB4(MyScreen^.ViewPort.ColorMap,i);
  331. END;
  332.  
  333. PROCEDURE defcolors;
  334. BEGIN
  335.   { 2.0-"Pewter"-Palette }
  336.   palette[0] := $CCB; palette[1] := $003;
  337.   palette[2] := $FFF; palette[3] := $9AB;
  338.   writepalette;
  339. END;
  340.  
  341. PROCEDURE clonecolors;
  342. { Farben der Workbench übernehmen }
  343. VAR prefs: Preferences;
  344.     i: integer;
  345. BEGIN
  346.   IF GetPrefs(^prefs, SizeOf(Preferences))<>Nil THEN BEGIN
  347.     palette[0] := prefs.color0; palette[1] := prefs.color1;
  348.     palette[2] := prefs.color2; palette[3] := prefs.color3;
  349.     writepalette;
  350.   END;
  351. END;
  352.  
  353. PROCEDURE settitles(normal: Boolean);
  354. BEGIN
  355.   {$ if def DEUTSCH }
  356.   scrtitle := filename+'  '+IntStr(nx)+' Spalten, '+IntStr(ny)+' Zeilen';
  357.   {$ else }
  358.   scrtitle := filename+'  '+IntStr(nx)+' Columns, '+IntStr(ny)+' Lines';
  359.   {$ endif }
  360.   IF normal THEN BEGIN
  361.     wintitle := titel;
  362.   END ELSE
  363.     wintitle := Copy(version,7,Length(version)-6);
  364.   SetWindowTitles(MyWindow,wintitle,scrtitle);
  365. END;
  366.  
  367. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  368. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#  Zeichnen  *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  369. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  370.  
  371. PROCEDURE quader;
  372. { projiziert die Eckpunkte des 'Quaders im R³' und ermittelt das der
  373. Projektion umbeschriebene Rechteck }
  374. VAR i: Integer;
  375.     pr: r_vekt;
  376. BEGIN
  377.   FOR i := 1 TO 8 DO BEGIN
  378.     pr.x := pr0.x + (pr1.x-pr0.x)*((i-1) MOD 2);
  379.     pr.y := pr0.y + (pr1.y-pr0.y)*(((i-1) DIV 2) MOD 2);
  380.     pr.z := pr0.z + (pr1.z-pr0.z)*(((i-1) DIV 4) MOD 2);
  381.     projektion(pr,fl_quader[i]);
  382.     IF (i=1) OR (fl_quader[i].x>pfl1.x) THEN  pfl1.x := fl_quader[i].x;
  383.     IF (i=1) OR (fl_quader[i].y>pfl1.y) THEN  pfl1.y := fl_quader[i].y;
  384.     IF (i=1) OR (fl_quader[i].x<pfl0.x) THEN  pfl0.x := fl_quader[i].x;
  385.     IF (i=1) OR (fl_quader[i].y<pfl0.y) THEN  pfl0.y := fl_quader[i].y;
  386.   END;
  387. END;
  388.  
  389. PROCEDURE skizze;
  390. { Rückwände des dargestellten Quaders andeuten }
  391.   PROCEDURE auf(i: Integer); BEGIN
  392.     Move(Rast,Round(fl_quader[i].x),Round(fl_quader[i].y));
  393.   END;
  394.   PROCEDURE nach(i: Integer); BEGIN
  395.     Draw(Rast,Round(fl_quader[i].x),Round(fl_quader[i].y));
  396.   END;
  397. BEGIN
  398.   quader;       { Eckpunkte projizieren }
  399.   SetRast(Rast,0);      { löschen }
  400.   SetAPen(Rast,1);      { schwarz }
  401.   auf(1); nach(2); nach(6); nach(5); nach(7); nach(3); nach(1); nach(5);
  402.   auf(2); nach(4); nach(3);
  403. END;
  404.  
  405. PROCEDURE schrift(ausg: chefstring; abst: integer; p0,p1: fl_vekt; ernst: boolean);
  406. { Ordnet den String ausg auf dem Strahl aus p0 durch p1 an, dabei abst
  407. Leerzeichen.
  408. Greift auf globale Variablen pfl0, pfl1 zu, um tatsächlichen Platzbedarf
  409. der beschrifteten Zeichnung zu ermitteln }
  410. VAR delta,step: fl_vekt;
  411.     i,j,l: Integer;
  412.     unsinn: Long;
  413.     charx,chary,baseline: Word;    { Font des Windows, nicht des Screens }
  414. BEGIN
  415.   charx := Rast^.TxWidth;
  416.   chary := Rast^.TxHeight;
  417.   baseline := Rast^.TxBaseline;
  418.   delta.x := p1.x - p0.x;
  419.   delta.y := p1.y - p0.y;
  420.   IF abs(delta.x/charx)>abs(delta.y/chary) THEN BEGIN
  421.     step.x := charx*delta.x/abs(delta.x);
  422.     step.y := charx*delta.y/abs(delta.x);
  423.   END ELSE BEGIN
  424.     step.x := chary*delta.x/abs(delta.y);
  425.     step.y := chary*delta.y/abs(delta.y);
  426.   END;
  427.   p1.x := p0.x + abst*step.x;
  428.   p1.y := p0.y + abst*step.y;
  429.   IF NOT schraeg THEN BEGIN
  430.     { normale horizontale Schrift, nützlich für Zahlen }
  431.     step.x := charx*delta.x/abs(delta.x);
  432.     step.y := 0;
  433.   END;
  434.   l := length(ausg);
  435.   SetDrMd(Rast,JAM1);
  436.   IF ernst THEN FOR i := 1 TO l DO BEGIN
  437.     IF step.x>=0 THEN
  438.       j := i
  439.     ELSE
  440.       j := l-i+1;
  441.     Move(Rast,Round(p1.x+(i-1)*step.x)-charx div 2,
  442.               Round(p1.y+(i-1)*step.y)+baseline-chary div 2);
  443.     unsinn := _Text(Rast,ausg[j],1);
  444.   END;
  445.   { benötigten Platz aus der Position des ersten und letzten Zeichens
  446.   ermitteln: }
  447.   pfl1.x := max(pfl1.x, p1.x + charx/2);
  448.   pfl1.y := max(pfl1.y, p1.y + chary/2);
  449.   pfl0.x := min(pfl0.x, p1.x - charx/2);
  450.   pfl0.y := min(pfl0.y, p1.y - chary/2);
  451.   pfl1.x := max(pfl1.x, p1.x + (l-1)*step.x + charx/2);
  452.   pfl1.y := max(pfl1.y, p1.y + (l-1)*step.y + chary/2);
  453.   pfl0.x := min(pfl0.x, p1.x + (l-1)*step.x - charx/2);
  454.   pfl0.y := min(pfl0.y, p1.y + (l-1)*step.y - chary/2);
  455. END;
  456.  
  457. PROCEDURE skalen(ernst: boolean);
  458. VAR textoff,step,p0,p1: fl_vekt;
  459.     pr: r_vekt;
  460.     i, gst,nkst: integer;
  461.     bez: chefstring;
  462. BEGIN
  463.   IF ernst THEN skizze;         { Rückwände und Boden zeichnen }
  464.   { x-/y-Skalierung und Beschriftung in Abhängigkeit vom Modus }
  465.   textoff.x := 0;  { Verschiebung der Beschriftung vom Skalenstrich weg }
  466.   textoff.y := 0;
  467.   CASE modus OF
  468.     1: BEGIN      { (nx-1)·(ny-1) Felder }
  469.       step.x := (pr1.x - pr0.x)/(nx-1);
  470.       step.y := (pr1.y - pr0.y)/(ny-1);
  471.     END;
  472.     2: BEGIN      { (nx-1)·ny Felder }
  473.       step.x := (pr1.x - pr0.x)/(nx-1);
  474.       step.y := (pr1.y - pr0.y)/ny;
  475.       textoff.y := step.y*(1 + gap)/2;
  476.     END;
  477.     3: BEGIN      { nx·(ny-1) Felder }
  478.       step.x := (pr1.x - pr0.x)/nx;
  479.       textoff.x := step.x*(1 + gap)/2;
  480.       step.y := (pr1.y - pr0.y)/(ny-1);
  481.     END;
  482.     4: BEGIN      { nx·ny Felder }
  483.       step.x := (pr1.x - pr0.x)/nx;
  484.       textoff.x := step.x*(1 + gap)/2;
  485.       step.y := (pr1.y - pr0.y)/ny;
  486.       textoff.y := step.y*(1 + gap)/2;
  487.     END;
  488.   END;
  489.   IF abbruch THEN BEGIN
  490.     notaus := True; Exit END;
  491.   { z-Linien zuerst zeichnen, da sie nur Ziffern tragen, die ruhig
  492.   beschädigt werden dürfen: }
  493.   { Zunächst herausfinden, wieviele Nachkommastellen und Gesamtstellen für die
  494.   Ausgabe der z-Werte benötigt werden. }
  495.   nkst := 0;
  496.   WHILE skz*Pwr10(nkst)<1 DO  Inc(nkst);
  497.   gst := 1; IF pr0.z<0 THEN gst := 2;
  498.   WHILE pr1.z/Pwr10(gst)>1 DO  Inc(gst);
  499.   WHILE -pr0.z/Pwr10(gst)>0.1 DO  Inc(gst);
  500.   IF nkst>0 THEN
  501.     gst := gst + nkst + 1;
  502.   FOR i := Round(pr0.z/skz + 0.5) TO Round(pr1.z/skz - 0.5) DO BEGIN
  503.     pr.z := i*skz;
  504.     f77fix(pr.z,gst,nkst,bez);
  505.     pr.x := pr0.x; pr.y := pr1.y;
  506.     projektion(pr,p0);
  507.     Move(Rast,Round(p0.x),Round(p0.y));
  508.     pr.y := pr0.y;
  509.     projektion(pr,p0);
  510.     IF ernst THEN Draw(Rast,Round(p0.x),Round(p0.y));
  511.     pr.x := pr1.x;
  512.     projektion(pr,p0);
  513.     IF ernst THEN Draw(Rast,Round(p0.x),Round(p0.y));
  514.     pr.x := pr.x + rd/10;
  515.     projektion(pr,p1);
  516.     schrift(bez,1,p0,p1,ernst);
  517.   END;
  518.   { und noch den Titel der z-Achse }
  519.   pr.z := pr1.z+skz;
  520.   projektion(pr,p1);
  521.   pr.x := pr.x - rd/10;
  522.   projektion(pr,p0);
  523.   schrift(einheit,-length(einheit) div 2,p0,p1,ernst);
  524.   IF abbruch THEN BEGIN
  525.     notaus := True; Exit END;
  526.   { x-Linien }
  527.   FOR i := 1 TO nx DO IF (xtitel[i]<>'') OR (modus IN [3,4]) THEN BEGIN
  528.     pr.x := pr0.x + step.x*(i - 1);
  529.     pr.y := pr0.y; pr.z := pr1.z;
  530.     projektion(pr,p0);
  531.     Move(Rast,Round(p0.x),Round(p0.y));
  532.     pr.z := pr0.z;
  533.     projektion(pr,p0);
  534.     IF ernst THEN Draw(Rast,Round(p0.x),Round(p0.y));
  535.     pr.y := pr1.y;
  536.     projektion(pr,p0);
  537.     IF ernst THEN Draw(Rast,Round(p0.x),Round(p0.y));
  538.     pr.x := pr.x + textoff.x;
  539.     projektion(pr,p0);
  540.     pr.y := pr.y + rd/10;
  541.     projektion(pr,p1);
  542.     bez := xtitel[i];
  543.     schrift(bez,1,p0,p1,ernst);
  544.   END;
  545.   IF abbruch THEN BEGIN
  546.     notaus := True; Exit END;
  547.   { y-Linien, das gleiche }
  548.   FOR i := 1 TO ny DO IF (ytitel[i]<>'') OR (modus IN [2,4]) THEN BEGIN
  549.     pr.y := pr0.y + step.y*(i - 1);
  550.     pr.x := pr0.x; pr.z := pr1.z;
  551.     projektion(pr,p0);
  552.     Move(Rast,Round(p0.x),Round(p0.y));
  553.     pr.z := pr0.z;
  554.     projektion(pr,p0);
  555.     IF ernst THEN Draw(Rast,Round(p0.x),Round(p0.y));
  556.     pr.x := pr1.x;
  557.     projektion(pr,p0);
  558.     IF ernst THEN Draw(Rast,Round(p0.x),Round(p0.y));
  559.     pr.y := pr.y + textoff.y;
  560.     projektion(pr,p0);
  561.     pr.x := pr.x + rd/10;
  562.     projektion(pr,p1);
  563.     bez := ytitel[i];
  564.     schrift(bez,1,p0,p1,ernst);
  565.   END;
  566. END;
  567.  
  568. PROCEDURE zentriere;
  569. { wählt Offset und Vergrößerung für optimalen Bildausschnitt }
  570. VAR i: integer;
  571.     frei: fl_vekt;
  572. BEGIN
  573.   off.x := 0;
  574.   off.y := 0;
  575.   mag := 1;
  576.   quader;       { die acht Eckpunkte projizieren und Rahmen ermitteln }
  577.   frei.x := MyWindow^.GZZWidth-2*grace;
  578.   frei.y := MyWindow^.GZZHeight-2*grace;
  579.   mag := min(frei.x/(pfl1.x-pfl0.x), frei.y/(pfl1.y-pfl0.y));
  580.   off.x := grace - mag*pfl0.x + (frei.x-mag*(pfl1.x-pfl0.x))/2;
  581.   off.y := grace - mag*pfl0.y + (frei.y-mag*(pfl1.y-pfl0.y))/2;
  582. END;
  583.  
  584. PROCEDURE zentr_m_text;
  585. { Durch Beschriftung nichtlinearer Zusammenhang zwischen Vergrößerung und
  586. Platzbedarf der Zeichnung, darum Iteration nach Regula Falsi für den
  587. Überstand fehler in Abhängigkeit von mag }
  588. VAR fehler1,fehler2,mag0,mag1,mag2: real;
  589.     frei: fl_vekt;
  590. BEGIN
  591.   frei.x := MyWindow^.GZZWidth-2*grace;
  592.   frei.y := MyWindow^.GZZHeight-2*grace;
  593.   zentriere;
  594.   mag1 := mag;          { 1. Näherung für mag }
  595.   mag0 := mag;
  596.   quader;
  597.   skalen(False);        { Wirkung ausprobieren }
  598.   IF notaus THEN
  599.     Exit;
  600.   fehler1 := max((pfl1.x-pfl0.x)/frei.x, (pfl1.y-pfl0.y)/frei.y) - 1;
  601.   mag2 := mag1/(fehler1 + 1);
  602.   { 2. Näherung, tut so als wäre Größe trotz Text proportional zu mag }
  603.   mag := mag2;
  604.   quader;
  605.   skalen(False);
  606.   IF notaus THEN
  607.     Exit;
  608.   fehler2 := max((pfl1.x-pfl0.x)/frei.x, (pfl1.y-pfl0.y)/frei.y) - 1;
  609.   mag := (fehler2*mag1 - fehler1*mag2)/(fehler2 - fehler1); { Regula Falsi }
  610.   { winzige (oder sogar kopfstehende) Bilder vermeiden: }
  611.   IF mag<mag0/3 THEN mag := mag0/3;
  612.   off.x := 0;
  613.   off.y := 0;
  614.   quader;
  615.   skalen(False);
  616.   off.x := grace - pfl0.x + (frei.x - (pfl1.x-pfl0.x))/2;
  617.   off.y := grace - pfl0.y + (frei.y - (pfl1.y-pfl0.y))/2;
  618. END;
  619.  
  620. PROCEDURE netz;
  621. { Oberfläche als (nx-1)·(ny-1) Vierecke zeichnen. Diagonale Vorgehensweise, }
  622. { um Fehler bei Hidden-Line zu vermeiden. Die beiden letzten Zeilen werden }
  623. { zwischengespeichert, damit nicht jeder Punkt viermal projiziert werden }
  624. { muß. }
  625. VAR dx,dy: real;
  626.     i,ii,j,k,akt,vor1,vor2: integer;
  627.     p: ARRAY[1..4] OF fl_vekt;
  628.     zeile: ARRAY[1..3,1..nmax] OF fl_vekt;
  629.     pr: r_vekt;
  630.     status: LongInt;
  631. BEGIN
  632.   dx := (pr1.x - pr0.x)/(nx-1);
  633.   dy := (pr1.y - pr0.y)/(ny-1);
  634.   akt := 1;
  635.   vor2 := 2;
  636.   vor1 := 3;
  637.   FOR ii := 1 TO nx+ny DO BEGIN
  638.     FOR j := 1 TO ii DO BEGIN
  639.       i := 1+ii-j;
  640.       IF (i<=nx) AND (j<=ny) THEN BEGIN
  641.         pr.x := pr0.x + (i-1)*dx;
  642.         pr.y := pr0.y + (j-1)*dy;
  643.         pr.z := zr[i,j];
  644.         projektion(pr,zeile[akt,j]);
  645.         IF (i>1) AND (j>1) THEN BEGIN
  646.           p[1] := zeile[akt,j];
  647.           p[2] := zeile[vor1,j];
  648.           p[3] := zeile[vor2,j-1];
  649.           p[4] := zeile[vor1,j-1];
  650.           SetDrMd(Rast,JAM1);
  651.           status := AreaMove(Rast,Round(p[4].x),Round(p[4].y));
  652.           FOR k := 1 TO 4 DO
  653.             status := AreaDraw(Rast,Round(p[k].x),Round(p[k].y));
  654.           SetAPen(Rast,3);      { rot }
  655.           status := AreaEnd(Rast);
  656.           SetAPen(Rast,1);      { schwarz }
  657.           Move(Rast,Round(p[4].x),Round(p[4].y));
  658.           FOR k := 1 TO 4 DO
  659.             Draw(Rast,Round(p[k].x),Round(p[k].y));
  660.         END;
  661.       END;
  662.       IF abbruch THEN
  663.         Exit;
  664.     END;
  665.     vor2 := vor1;
  666.     vor1 := akt;
  667.     akt := akt mod 3 + 1;
  668.   END;
  669. END;
  670.  
  671. PROCEDURE saeulen;
  672. { Stellt zr(nx,ny) als Bänder in x-Richtung (modus=2), Bänder in y-Richtung
  673. (modus=3) bzw. als Säulendiagramm (modus=4) dar. Diagonale Vorgehensweise
  674. hilft diesmal leider nicht, darum Hiddenline-Fehler bei Betrachtung aus
  675. x- oder y-Achsenrichtung. }
  676. VAR nxvar,nyvar,i,j,k: integer;
  677.     dx,dy,a,b,c: real;
  678.     pr: r_vekt;
  679.     p: ARRAY[1..8] OF fl_vekt;
  680.     status: LongInt;
  681.  
  682.   PROCEDURE viereck(i1,i2,i3,i4: integer; flfarb,lfarb: long);
  683.   VAR i: ARRAY[1..4] OF integer;
  684.       k: integer;
  685.   BEGIN
  686.     i[1] := i1; i[2] := i2; i[3] := i3; i[4] := i4;
  687.     SetDrMd(Rast,JAM1);
  688.     SetAPen(Rast,flfarb);
  689.     status := AreaMove(Rast,Round(p[i4].x),Round(p[i4].y));
  690.     FOR k := 1 TO 4 DO
  691.       status := AreaDraw(Rast,Round(p[i[k]].x),Round(p[i[k]].y));
  692.     status := AreaEnd(Rast);
  693.     SetAPen(Rast,lfarb);
  694.     Move(Rast,Round(p[i4].x),Round(p[i4].y));
  695.     FOR k := 1 TO 4 DO
  696.       Draw(Rast,Round(p[i[k]].x),Round(p[i[k]].y));
  697.   END;
  698.  
  699. BEGIN
  700.   { Oberfläche als ny bzw. nx Bänder zu (nx-1) bzw. (ny-1) Flächen zeichnen
  701.   bzw. als nx·ny rechteckige Säulen }
  702.   IF modus=2 THEN nxvar := nx-1  ELSE nxvar := nx;
  703.   IF modus=3 THEN nyvar := ny-1  ELSE nyvar := ny;
  704.   dx := (pr1.x - pr0.x)/nxvar;
  705.   dy := (pr1.y - pr0.y)/nyvar;
  706.   FOR i := 1 TO nxvar DO
  707.     FOR j := 1 TO nyvar DO BEGIN
  708.       { 8 Eckpunkte der Säule bzw. schiefen Säule projizieren }
  709.       FOR k := 1 TO 8 DO BEGIN
  710.         { Ecke auswählen als Tripel von (0 oder 1) }
  711.         a := (k-1) mod 2;
  712.         b := ((k-1) div 2) mod 2;
  713.         c := ((k-1) div 4) mod 2;
  714.         IF modus<>2 THEN
  715.           a := max(a,gap);
  716.         IF modus<>3 THEN
  717.           b := max(b,gap);
  718.         pr.x := pr0.x + (i-1+a)*dx;
  719.         pr.y := pr0.y + (j-1+b)*dy;
  720.         CASE modus OF
  721.           2: pr.z := pr0.z + c*(zr[i+Round(a),j]-pr0.z);
  722.           3: pr.z := pr0.z + c*(zr[i,j+Round(b)]-pr0.z);
  723.           4: pr.z := pr0.z + c*(zr[i,j]-pr0.z);
  724.         END;
  725.         projektion(pr,p[k]);
  726.       END;
  727.       { Deckfläche und zwei vordere Seitenflächen zeichnen }
  728.       viereck(5,6,8,7, 3,1);    { rot, schwarz }
  729.       viereck(2,4,8,6, 2,1);    { weiß, schwarz }
  730.       viereck(3,4,8,7, 2,1);
  731.       IF abbruch THEN
  732.         Exit;
  733.     END;
  734. END;
  735.  
  736. PROCEDURE darstellen;
  737. VAR i: integer;
  738. BEGIN
  739.   SetRast(Rast,0);    { Bildschirm löschen }
  740.   notaus := False;      { für Abbruchüberprüfung in den Unterrroutinen }
  741.   zentr_m_text;
  742.   IF notaus THEN BEGIN
  743.     skizze; Exit END;
  744.   skalen(True);
  745.   IF modus=1 THEN
  746.     netz          { Netzdiagramm }
  747.   ELSE
  748.     saeulen;      { behandelt Säulen- und Bänderdiagramme zusammen }
  749. END;
  750.  
  751. PROCEDURE refresh;
  752. { Bilschirm neu aufbauen, für quickdraw=True: Skizze, sonst Zeichnung }
  753. BEGIN
  754.   settitles(True);
  755.   IF quickdraw THEN BEGIN
  756.     zentriere;
  757.     skizze;
  758.   END ELSE
  759.     darstellen;
  760. END;
  761.  
  762. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  763. { *#*#*#*#*#*#*#*#*#*#*#*#*  Datenverwaltung  *#*#*#*#*#*#*#*#*#*#*#*#*#* }
  764. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  765.  
  766. PROCEDURE swapxy;
  767. { Tabelle im Speicher transponieren }
  768. VAR i, j, m: integer;
  769.     hilf: chefstring;
  770. BEGIN
  771.   IF nx>ny THEN m := nx ELSE m := ny;
  772.   FOR i := 1 TO m DO BEGIN
  773.     Exchange(xtitel[i],ytitel[i]);
  774.     FOR j := 1 TO i-1 DO
  775.       Exchange(zr[i,j], zr[j,i]);
  776.   END;
  777.   Exchange(nx, ny);
  778.   Exchange(pr0.x, pr0.y);
  779.   Exchange(pr1.x, pr1.y);
  780.   IF modus=2 THEN
  781.     modus := 3
  782.   ELSE IF modus=3 THEN
  783.     modus := 2;
  784.   vektoren;
  785. END;
  786.  
  787. PROCEDURE mirrorx;
  788. { Reihenfolge der Spalten umkehren }
  789. VAR i, j: integer;
  790.     hilf: chefstring;
  791. BEGIN
  792.   FOR i := 1 TO nx div 2 DO BEGIN
  793.     exchange(xtitel[i], xtitel[nx+1-i]);
  794.     FOR j := 1 TO ny DO
  795.       exchange(zr[i,j], zr[nx+1-i,j]);
  796.   END;
  797. END;
  798.  
  799. PROCEDURE mirrory;
  800. { Reihenfolge der Zeilen umkehren }
  801. VAR i, j: integer;
  802.     hilf: chefstring;
  803. BEGIN
  804.   FOR j := 1 TO ny div 2 DO BEGIN
  805.     exchange(ytitel[j], ytitel[ny+1-j]);
  806.     FOR i := 1 TO nx DO
  807.       exchange(zr[i,j], zr[i,ny-j+1]);
  808.   END;
  809. END;
  810.  
  811. PROCEDURE makeborder(n, x0,y0, x1,y1: Integer; raised: Boolean);
  812. { legt in Coords[n] und Bord[2*n-1], Bord[2*n] einen 3D-Rahmen an }
  813. VAR c1,c2: Word;
  814. BEGIN
  815.   c1 := 1; c2 := 1;
  816.   IF raised THEN c2 := 2 ELSE c1 := 2;
  817.   Coords[n] := IntArr10(x0,y1, x1,y1, x1,y0, x0,y0, x0,y1);
  818.   Bord[2*n-1] := Border(0,0,c1,0,JAM1,3,^Coords[n][1],^Bord[2*n]);
  819.   Bord[2*n]   := Border(0,0,c2,0,JAM1,3,^Coords[n][5],Nil);
  820. END;
  821.  
  822. FUNCTION move_row(line: Boolean): Boolean;
  823. { Requester öffnen, Zeile bzw. Spalte verschieben lassen }
  824. { Rückgabewert: Datenbestand wirklich geändert? }
  825. TYPE strarr=ARRAY[1..4] OF Str;
  826. VAR texte: strarr;
  827.     l: ARRAY[1..4] OF Integer;
  828.     gad: p_Gadget;
  829.     ende,genehmigt,soso: Boolean;
  830.     warte,eventclass: Long;
  831.     i,j,di,n,x1,x2,lmax,off: Integer;
  832.     b,h: Word;
  833.     buf: ARRAY[1..4] OF chefstring;
  834. BEGIN
  835.   move_row := False;
  836.   IF line THEN BEGIN
  837.     n := ny; buf[3] := ytitel[1]; buf[4] := ytitel[n];
  838.   END ELSE BEGIN
  839.     n := nx; buf[3] := xtitel[1]; buf[4] := xtitel[n];
  840.   END;
  841.   buf[1] := '1'; buf[2] := IntStr(n);
  842.   ubuf := '';
  843.   {$ if def DEUTSCH }
  844.   texte := strarr('Spalte verschieben:','an Position:','OK','Abbruch');
  845.   IF line THEN texte[1] := 'Zeile verschieben:';
  846.   {$ else }
  847.   texte := strarr('Move column:','To position:','OK','Cancel');
  848.   IF line THEN texte[1] := 'Move line:';
  849.   {$ endif }
  850.   FOR i := 1 TO 4 DO l[i] := Length(texte[i]);
  851.   lmax := l[1]; IF l[2]>l[1] THEN lmax := l[2];
  852.   x1 := 15 + (lmax+1)*charx; x2 := x1 + 5*8;
  853.   b := x1 + 20*8 + 15;
  854.   h := 44 + 3*chary;
  855.   off := (chary-8) DIV 2;
  856.   FOR i := 1 TO 2 DO
  857.     ITxt[i] := IntuiText(1,2,JAM1,15,12+(i-1)*(chary+8),Nil,texte[i],^ITxt[i+1]);
  858.   ITxt[2].NextText := Nil;
  859.   FOR i := 1 TO 2 DO
  860.     ReqGad[i] := Gadget(^ReqGad[i+1],x1,12+(i-1)*(chary+8)+off,4*8,8,
  861.         GADGHCOMP,RELVERIFY OR _LONGINT,STRGADGET OR REQGADGET,
  862.         ^Bord[1],Nil,Nil,0,^StrInf[i],i,Nil);
  863.   FOR i := 3 TO 4 DO
  864.     ReqGad[i] := Gadget(^ReqGad[i+1],x2,12+(i-3)*(chary+8)+off,15*8,8,GADGHCOMP,
  865.         RELVERIFY,STRGADGET OR REQGADGET,Nil, Nil,Nil,0,^StrInf[i],i,Nil);
  866.   FOR i := 1 TO 4 DO
  867.     StrInf[i] := StringInfo(^buf[i],^ubuf,0,39,0,0,0,0,0,0,Nil,0,Nil);
  868.   FOR i := 5 TO 6 DO
  869.     ReqGad[i] := Gadget(^ReqGad[i+1],10,32+2*chary,9*charx+2,chary+2,
  870.         GADGHCOMP, RELVERIFY OR ENDGADGET, BOOLGADGET OR REQGADGET,
  871.         ^Bord[3],Nil,^ITxt[i-2],0,Nil,i,Nil);
  872.   FOR i := 3 TO 4 DO
  873.     ITxt[i] := IntuiText(1,2,JAM1,1+(9-l[i])*charx DIV 2,1,Nil,texte[i],Nil);
  874.   ReqGad[6].LeftEdge := b-(11+9*charx);
  875.   ReqGad[6].NextGadget := Nil;
  876.   makeborder(1, -1,-1, 4*8, 8, False);
  877.   makeborder(2,  0, 0, 9*charx+1,chary+1, True);
  878.   makeborder(3,  0, 0, b-1,h-1, True);
  879.   MyRequest := Requester(Nil,40,30,b,h,0,0,^ReqGad[1],^Bord[5],
  880.                          ^ITxt[1],0,3,Nil,muell,Nil,Nil,Nil,muell);
  881.   IF Request(^MyRequest,MyWindow) THEN BEGIN
  882.     { Ereignisse abfragen }
  883.     ende := False;
  884.     REPEAT
  885.       warte := Wait(-1);
  886.       REPEAT              { Schleife, da mehrere Ereignisse möglich }
  887.         MyMsg := Get_Msg(Upt);
  888.         IF MyMsg <> Nil THEN BEGIN
  889.           eventclass := MyMsg^.Class;
  890.           gad := MyMsg^.IAddress;
  891.           Reply_Msg(MyMsg);             { so schnell wie möglich antworten! }
  892.           IF eventclass=REQSET THEN
  893.             soso := ActivateGadget(^ReqGad[1],MyWindow,^MyRequest);
  894.           IF eventclass=GADGETUP THEN
  895.             CASE gad^.GadgetID OF
  896.               1,2: BEGIN
  897.                 i := gad^.GadgetID
  898.                 j := StrInf[i].LongInt;
  899.                 IF j<1 THEN j := 1; IF j>n THEN j := n;
  900.                 buf[i] := IntStr(j);
  901.                 IF line THEN buf[i+2] := ytitel[j]
  902.                   ELSE buf[i+2] := xtitel[j];
  903.                 IF i=1 THEN x1 := j ELSE x2 := j;
  904.                 soso := ActivateGadget(^ReqGad[3-i],MyWindow,^MyRequest);
  905.                 RefreshGadgets(^ReqGad[1],MyWindow,^MyRequest);
  906.               END;
  907.               5: genehmigt := True;
  908.               6: genehmigt := False;
  909.               OTHERWISE;
  910.             END;
  911.           IF eventclass=REQCLEAR THEN ende := True;
  912.         END;
  913.       UNTIL MyMsg = Nil;
  914.     UNTIL ende;
  915.     IF genehmigt THEN BEGIN
  916.       IF x1<x2 THEN di := 1 ELSE di := -1;
  917.       i := x1; WHILE i<>x2 DO BEGIN
  918.         IF line THEN BEGIN
  919.           Exchange(ytitel[i],ytitel[i+di]);
  920.           FOR j := 1 TO nx DO Exchange(zr[j,i],zr[j,i+di]);
  921.         END ELSE BEGIN
  922.           Exchange(xtitel[i],xtitel[i+di]);
  923.           FOR j := 1 TO ny DO Exchange(zr[i,j],zr[i+di,j]);
  924.         END;
  925.         i := i + di;
  926.       END;
  927.       move_row := True;
  928.     END;
  929.   END;
  930. END;
  931.  
  932. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  933. { *#*#*#*#*#*#*#*#*#*#*#*#*#*  Abmessungen  *#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  934. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  935.  
  936. PROCEDURE merken;
  937. BEGIN
  938.   pr0m := pr0; pr1m := pr1;
  939. END;
  940.  
  941. PROCEDURE erinnern;
  942. BEGIN
  943.   pr0 := pr0m; pr1 := pr1m;
  944.   vektoren;
  945. END;
  946.  
  947. PROCEDURE tauschen;
  948. VAR hilf: r_vekt;
  949. BEGIN
  950.   hilf := pr0m; pr0m := pr0; pr0 := hilf;
  951.   hilf := pr1m; pr1m := pr1; pr1 := hilf;
  952.   vektoren;
  953. END;
  954.  
  955. PROCEDURE best_guess;
  956. { Abmessungen und Skalenteilung "optimal" einstellen }
  957. VAR zmin,zmax,dz: Real;
  958.     i,j: Integer;
  959. BEGIN
  960.   zmin := zr[1,1]; zmax := zr[1,1];
  961.   FOR j := 1 TO ny DO
  962.     FOR i := 1 TO nx DO BEGIN
  963.       IF zr[i,j]<zmin THEN zmin := zr[i,j];
  964.       IF zr[i,j]>zmax THEN zmax := zr[i,j];
  965.     END;
  966.   { Skalenteilung auf der z-Achse }
  967.   dz := zmax-zmin;
  968.   IF dz=0 THEN dz := 1;
  969.   IF (zmin>0) AND (zmin<dz/2) THEN
  970.     pr0.z := 0
  971.   ELSE
  972.     pr0.z := zmin-0.05*dz;
  973.   skz := glatt(dz/10);
  974.   pr1.z := zmax+0.05*dz;
  975.   pr0.x := 0;
  976.   pr1.x := 1.1*dz*sqrt(nx/ny);
  977.   pr0.y := 0;
  978.   pr1.y := 1.1*dz*sqrt(ny/nx);
  979.   vektoren;
  980. END;
  981.  
  982. FUNCTION bereichstest: Boolean;
  983. { überprüfen, ob neugewählte Abmessungen mit der Datei verträglich sind }
  984. { und erzeugt ggf. einen Requester }
  985. TYPE strarr=ARRAY[1..4] OF Str;
  986. VAR texte: strarr;
  987.     egal: Boolean;
  988.     meldung,buf: chefstring;
  989.     zmin,zmax,dz: Real;
  990.     lmax,i,j: Integer;
  991. BEGIN
  992.   bereichstest := True;
  993.   zmin := zr[1,1]; zmax := zr[1,1];
  994.   FOR j := 1 TO ny DO
  995.     FOR i := 1 TO nx DO BEGIN
  996.       IF zr[i,j]<zmin THEN zmin := zr[i,j];
  997.       IF zr[i,j]>zmax THEN zmax := zr[i,j];
  998.     END;
  999.   dz := zmax - zmin;
  1000.   IF max(zmax-pr1.z,pr0.z-zmin)>dz/10 THEN BEGIN
  1001.     bereichstest := False;
  1002.     ftoa(zmin,4,meldung);
  1003.     ftoa(zmax,4,buf);
  1004.     settitles(False);
  1005.     {$ if def DEUTSCH }
  1006.     meldung := 'für Wertebereich '+meldung+' .. '+buf;
  1007.     texte := strarr('Gewählter z-Ausschnitt zu klein',meldung,
  1008.              'Ändern Sie das besser.',' Mach Ich ');
  1009.     {$ else }
  1010.     meldung := 'for data range '+meldung+' .. '+buf;
  1011.     texte := strarr('Chosen z-range not sufficient',meldung,
  1012.              'You''d better fix that.',' Aye, Sir! ');
  1013.     {$ endif }
  1014.     lmax := 0; FOR i := 1 TO 3 DO
  1015.       IF lmax<Length(texte[i]) THEN lmax := Length(texte[i]);
  1016.     FOR i := 1 TO 3 DO
  1017.       ITxt[i] := IntuiText(2,1,JAM1,(2+lmax-Length(texte[i]))*charx DIV 2,
  1018.                i*(chary+2),Nil,texte[i],^ITxt[i+1]);
  1019.     ITxt[3].NextText := Nil;
  1020.     ITxt[4] := Intuitext(2,1,JAM1,6,3,Nil,texte[4],Nil);
  1021.     egal := AutoRequest(MyWindow,^ITxt[1],Nil,^ITxt[4],0,0,
  1022.             (6+lmax)*charx,5*(chary+2)+30);
  1023.     settitles(True);
  1024.   END;
  1025. END;
  1026.  
  1027. FUNCTION gr_aendern: Boolean;
  1028. { Requester öffnen, z-Bereich, Skalenteilung, x/z und y/z einlesen }
  1029. { Rückgabewert: Abmessungen wirklich geändert? }
  1030. TYPE strarr=ARRAY[1..7] OF Str;
  1031. VAR texte: strarr;
  1032.     l: ARRAY[1..7] OF Integer;
  1033.     xz,yz: Real;
  1034.     gad: p_Gadget;
  1035.     ende,genehmigt,soso: Boolean;
  1036.     warte,eventclass: Long;
  1037.     i,x1,x2,lmax,off: Integer;
  1038.     b,h: Word;
  1039.     buf: ARRAY[1..5] OF chefstring;
  1040. BEGIN
  1041.   gr_aendern := False;
  1042.   xz := (pr1.x-pr0.x)/(pr1.z-pr0.z);
  1043.   yz := (pr1.y-pr0.y)/(pr1.z-pr0.z);
  1044.   ftoa(pr0.z,4,buf[1]);
  1045.   ftoa(pr1.z,4,buf[2]);
  1046.   ftoa(skz,4,buf[3]);
  1047.   ftoa(xz,4,buf[4]);
  1048.   ftoa(yz,4,buf[5]);
  1049.   ubuf := '';
  1050.   {$ if def DEUTSCH }
  1051.   texte := strarr('Wertebereich:','Skalenteilung:','relative Achsenlängen:',
  1052.            'x/z:','y/z:','OK','Abbruch');
  1053.   {$ else }
  1054.   texte := strarr('z-Range:','z-Step:','Relative length of axes:',
  1055.            'x/z:','y/z:','OK','Cancel');
  1056.   {$ endif }
  1057.   FOR i := 1 TO 7 DO l[i] := Length(texte[i]);
  1058.   lmax := l[1]; IF l[2]>l[1] THEN lmax := l[2];
  1059.   x1 := 15 + (lmax+1)*charx;
  1060.   lmax := l[4]; IF l[5]>l[4] THEN lmax := l[5];
  1061.   x2 := 15 + (lmax+1)*charx;
  1062.   b := 30 + l[3]*charx; IF b<x1+95 THEN b := x1+95;
  1063.   h := 84 + 7*chary;
  1064.   off := (chary-8) DIV 2;
  1065.   FOR i := 1 TO 5 DO BEGIN
  1066.     ITxt[i] := IntuiText(1,2,JAM1,15,20+i*(chary+8),Nil,texte[i],^ITxt[i+1]);
  1067.     ReqGad[i] := Gadget(^ReqGad[i+1],x1,12+(i-1)*(chary+8)+off,80,8,GADGHCOMP,
  1068.         RELVERIFY,STRGADGET OR REQGADGET,^Bord[1],Nil,Nil,0,^StrInf[i],i,Nil);
  1069.     StrInf[i] := StringInfo(^buf[i],^ubuf,0,20,0,0,0,0,0,0,Nil,0,Nil);
  1070.   END;
  1071.   ITxt[1].TopEdge := 12;
  1072.   ITxt[2].TopEdge := 28 + 2*chary;
  1073.   FOR i := 4 TO 5 DO BEGIN
  1074.     ReqGad[i].LeftEdge := x2; ReqGad[i].TopEdge := 20+i*(chary+8)+off; END;
  1075.   ITxt[5].NextText := Nil;
  1076.   FOR i := 6 TO 7 DO BEGIN
  1077.     ReqGad[i] := Gadget(^ReqGad[i+1],10,72+6*chary,9*charx+2,chary+2,
  1078.         GADGHCOMP, RELVERIFY OR ENDGADGET, BOOLGADGET OR REQGADGET,
  1079.         ^Bord[3],Nil,^ITxt[i],0,Nil,i,Nil);
  1080.     ITxt[i] := IntuiText(1,2,JAM1,1+(9-l[i])*charx DIV 2,1,Nil,texte[i],Nil);
  1081.   END;
  1082.   ReqGad[7].LeftEdge := b-(11+9*charx);
  1083.   ReqGad[7].NextGadget := Nil;
  1084.   makeborder(1, -1,-1, 80, 8, False);
  1085.   makeborder(2,  0, 0, 9*charx+1,chary+1, True);
  1086.   makeborder(3,  0, 0, b-1,h-1, True);
  1087.   MyRequest := Requester(Nil,40,30,b,h,0,0,^ReqGad[1],^Bord[5],
  1088.                          ^ITxt[1],0,3,Nil,muell,Nil,Nil,Nil,muell);
  1089.   IF Request(^MyRequest,MyWindow) THEN BEGIN
  1090.     { Ereignisse abfragen }
  1091.     ende := False;
  1092.     REPEAT
  1093.       warte := Wait(-1);
  1094.       REPEAT              { Schleife, da mehrere Ereignisse möglich }
  1095.         MyMsg := Get_Msg(Upt);
  1096.         IF MyMsg <> Nil THEN BEGIN
  1097.           eventclass := MyMsg^.Class;
  1098.           gad := MyMsg^.IAddress;
  1099.           Reply_Msg(MyMsg);             { so schnell wie möglich antworten! }
  1100.           IF eventclass=REQSET THEN
  1101.             soso := ActivateGadget(^ReqGad[1],MyWindow,^MyRequest);
  1102.           IF eventclass=GADGETUP THEN
  1103.             CASE gad^.GadgetID OF
  1104.               1..4: soso := ActivateGadget(gad^.NextGadget,MyWindow,^MyRequest);
  1105.               6: genehmigt := True;
  1106.               7: genehmigt := False;
  1107.               OTHERWISE;
  1108.             END;
  1109.           IF eventclass=REQCLEAR THEN ende := True;
  1110.         END;
  1111.       UNTIL MyMsg = Nil;
  1112.     UNTIL ende;
  1113.     IF genehmigt THEN BEGIN
  1114.       val(buf[1],pr0.z,i);
  1115.       val(buf[2],pr1.z,i);
  1116.       IF pr1.z=pr0.z THEN pr1.z := pr0.z + 1;
  1117.       IF pr1.z<pr0.z THEN BEGIN
  1118.         xz := pr0.z; pr0.z := pr1.z; pr1.z := xz;
  1119.       END;
  1120.       val(buf[3],skz,i);
  1121.       IF skz<=0 THEN skz := glatt(pr1.z-pr0.z);
  1122.       val(buf[4],xz,i);
  1123.       IF xz=0 THEN xz := 1;
  1124.       pr0.x := 0;
  1125.       pr1.x := abs(xz)*(pr1.z-pr0.z);
  1126.       val(buf[5],yz,i);
  1127.       IF yz=0 THEN yz := 1;
  1128.       pr0.y := 0;
  1129.       pr1.y := abs(yz)*(pr1.z-pr0.z);
  1130.       vektoren;
  1131.       gr_aendern := True;
  1132.     END;
  1133.   END;
  1134. END;
  1135.  
  1136. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  1137. { *#*#*#*#*#*#*#*#*#*#*#*#  diverse Requester  #*#*#*#*#*#*#*#*#*#*#*#*#* }
  1138. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  1139.  
  1140. PROCEDURE infotext;
  1141. TYPE strarr=ARRAY[1..5] OF Str;
  1142. VAR texte: strarr;
  1143.     egal: Boolean;
  1144.     i,lmax: Integer;
  1145. BEGIN
  1146.   settitles(False);
  1147.   {$ if def DEUTSCH }
  1148.   texte := strarr('Autor: Wilhelm Nöker','Hertastr. 8 / D-44388 Dortmund',
  1149.            'Compiler: KICK-Pascal 2.12','von MAXON Computer',' Verstanden ');
  1150.   {$ else }
  1151.   texte := strarr('Author: Wilhelm Nöker','Hertastr. 8 / D-44388 Dortmund',
  1152.            'Compiler: KICK-Pascal 2.12','by MAXON Computer',' Roger ');
  1153.   {$ endif }
  1154.   lmax := 0; FOR i := 1 TO 4 DO
  1155.     IF lmax<Length(texte[i]) THEN lmax := Length(texte[i]);
  1156.   FOR i := 1 TO 4 DO
  1157.     ITxt[i] := IntuiText(2,1,JAM1,(2+lmax-Length(texte[i]))*charx DIV 2,
  1158.                i*(chary+2),Nil,texte[i],^ITxt[i+1]);
  1159.   ITxt[4].NextText := Nil;
  1160.   FOR i := 3 TO 4 DO
  1161.     ITxt[i].TopEdge := ITxt[i].TopEdge + chary DIV 2;
  1162.   ITxt[5] := Intuitext(2,1,JAM1,6,3,Nil,texte[5],Nil);
  1163.   egal := AutoRequest(MyWindow,^ITxt[1],Nil,^ITxt[5],0,0,
  1164.           (6+lmax)*charx,6*(chary+2)+30);
  1165.   settitles(True);
  1166. END;
  1167.  
  1168. PROCEDURE trunc_warning;
  1169. { Informiert den Benutzer, daß nur ein Teil seiner Daten gelesen wurde }
  1170. TYPE strarr=ARRAY[1..3] OF Str;
  1171. VAR texte: strarr;
  1172.     egal: Boolean;
  1173.     meldung: chefstring;
  1174.     lmax,i,j: Integer;
  1175. BEGIN
  1176.   settitles(False);
  1177.   {$ if def DEUTSCH }
  1178.   meldung := 'nur '+IntStr(nx)+' × '+IntStr(ny)+' Daten gelesen!';
  1179.   texte := strarr('Zu große Datei,',meldung,' Hmm ');
  1180.   {$ else }
  1181.   meldung := 'read only '+IntStr(nx)+' × '+IntStr(ny)+' data!';
  1182.   texte := strarr('File too large,',meldung,' Oops ');
  1183.   {$ endif }
  1184.   lmax := 0; FOR i := 1 TO 2 DO
  1185.     IF lmax<Length(texte[i]) THEN lmax := Length(texte[i]);
  1186.   FOR i := 1 TO 2 DO
  1187.     ITxt[i] := IntuiText(2,1,JAM1,(2+lmax-Length(texte[i]))*charx DIV 2,
  1188.              i*(chary+2),Nil,texte[i],^ITxt[i+1]);
  1189.   ITxt[2].NextText := Nil;
  1190.   ITxt[3] := Intuitext(2,1,JAM1,6,3,Nil,texte[3],Nil);
  1191.   egal := AutoRequest(MyWindow,^ITxt[1],Nil,^ITxt[3],0,0,
  1192.           (6+lmax)*charx,5*(chary+2)+30);
  1193.   settitles(True);
  1194. END;
  1195.  
  1196. PROCEDURE simple_request(msgtext,buttontext: Str);
  1197. VAR egal: Boolean;
  1198.     b: Integer;
  1199. BEGIN
  1200.   settitles(False);
  1201.   ITxt[1] := IntuiText(2,1,JAM1,10,10,Nil,msgtext,Nil);
  1202.   ITxt[2] := IntuiText(2,1,JAM1,6,3,Nil,buttontext,Nil);
  1203.   egal := AutoRequest(MyWindow,^ITxt[1],Nil,^ITxt[2],0,0,
  1204.           (6+Length(msgtext))*charx,3*(chary+2)+30);
  1205.   settitles(True);
  1206. END;
  1207.  
  1208. PROCEDURE confirm_snap;
  1209. VAR vergiss: boolean;
  1210. BEGIN
  1211.   {$ if def DEUTSCH }
  1212.   simple_request('Abmessungen gemerkt',' Danke ');
  1213.   {$ else }
  1214.   simple_request('Snapshot confirmed',' Thanks ');
  1215.   {$ endif }
  1216. END;
  1217.  
  1218. PROCEDURE dosfehler(nr: integer);
  1219. VAR meldung: chefstring;
  1220. BEGIN
  1221.   {$ if def DEUTSCH }
  1222.   meldung := 'DOS-Fehler Nr. '+IntStr(nr);
  1223.   simple_request(meldung,' Verstanden ');
  1224.   {$ else }
  1225.   meldung := 'DOS-error no. '+IntStr(nr);
  1226.   simple_request(meldung,' I see ');
  1227.   {$ endif }
  1228. END;
  1229.  
  1230. FUNCTION intreq(vorgabe: Long; hinweis: str80): Long;
  1231. { Requester öffnen und eine Integerzahl einlesen }
  1232. VAR ende,soso: boolean;
  1233.     warte,eventclass: Long;
  1234.     b,h: Word;
  1235.     buf: chefstring;
  1236. BEGIN
  1237.   intreq := vorgabe;
  1238.   buf := IntStr(vorgabe);
  1239.   ubuf := '';
  1240.   b := charx*length(hinweis)+30;  IF b<80+30  THEN b := 80+30;
  1241.   h := chary + 8 + 20;
  1242.   ITxt[1] := IntuiText(1,3,JAM1,15,6,Nil,hinweis,Nil);
  1243.   StrInf[1] := StringInfo(^buf,^ubuf,0,20,0,0,0,0,0,0,Nil,0,Nil);
  1244.   ReqGad[1] := Gadget(Nil,(b-80) div 2,chary+12,80,8,GADGHCOMP,
  1245.       RELVERIFY OR ENDGADGET OR _LONGINT OR STRINGRIGHT, STRGADGET OR REQGADGET,
  1246.       ^Bord[1], Nil,Nil,0,^StrInf[1],2,Nil);
  1247.   makeborder(1, -1,-1, 80, 8, False);
  1248.   makeborder(2,  0, 0, b-1,h-1, True);
  1249.   MyRequest := Requester(Nil,40,30,b,h,0,0,^ReqGad[1],^Bord[3],
  1250.                          ^ITxt[1],0,3,Nil,muell,Nil,Nil,Nil,muell);
  1251.   IF Request(^MyRequest,MyWindow) THEN BEGIN
  1252.     { Ereignisse abfragen }
  1253.     ende := False;
  1254.     REPEAT
  1255.       warte := Wait(-1);
  1256.       REPEAT              { Schleife, da mehrere Ereignisse möglich }
  1257.         MyMsg := Get_Msg(Upt);
  1258.         IF MyMsg <> Nil THEN BEGIN
  1259.           eventclass := MyMsg^.Class;
  1260.           Reply_Msg(MyMsg);             { so schnell wie möglich antworten! }
  1261.           IF eventclass=REQSET THEN
  1262.             soso := ActivateGadget(^ReqGad[1],MyWindow,^MyRequest);
  1263.           IF eventclass=REQCLEAR THEN ende := True;
  1264.         END;
  1265.       UNTIL MyMsg = Nil;
  1266.     UNTIL ende;
  1267.     intreq := StrInf[1].LongInt;
  1268.   END;
  1269. END;
  1270.  
  1271. PROCEDURE korridor_eing;
  1272. VAR eing: long;
  1273. BEGIN
  1274.   {$ if def DEUTSCH }
  1275.   eing := intreq(Round(100*gap),'Korridorbreite in %:');
  1276.   {$ else }
  1277.   eing := intreq(Round(100*gap),'Width of corridors, %:');
  1278.   {$ endif }
  1279.   IF abs(eing)<100 THEN
  1280.     gap := abs(eing)/100;
  1281. END;
  1282.  
  1283. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  1284. { *#*#*#*#*#*#*#*#*#*#*#*#*  Dateioperationen  #*#*#*#*#*#*#*#*#*#*#*#*#* }
  1285. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  1286.  
  1287. FUNCTION fileselect(was_los: str80; speichern: Boolean;
  1288.                                    VAR selected: str80): Boolean;
  1289. { Benutzt (wenn vorhanden) den Filerequester der req.library }
  1290. VAR i,p,l: Integer;
  1291.     Msg: p_IntuiMessage;
  1292.     ende: Boolean;
  1293.     class: Long;
  1294.     b,h: Word;
  1295.     buf,ubuf: str80;
  1296. BEGIN
  1297.   fileselect := False;
  1298.   l := Length(selected);
  1299.   { selected in pfad und name spalten }
  1300.   p := 0; FOR i := 1 TO l DO
  1301.     IF selected[i] IN ['/',':'] THEN p := i;
  1302.   IF p=0 THEN pfad := '' ELSE pfad := Copy(selected,1,p);
  1303.   IF p=l THEN name := '' ELSE name := Copy(selected,p+1,l-p);
  1304.   IF ReqBase<>Nil THEN BEGIN  { *** "req.library" benutzen }
  1305.     WITH MyFileReq^ DO BEGIN
  1306.       VersionNumber := REQVERSION;
  1307.       Title := was_los;
  1308.       PathName := pfadname;   { Str-Zeiger auf meinen Puffer setzen }
  1309.       Dir := pfad;
  1310.       _File := name;
  1311.       WindowLeftEdge := 128;
  1312.       WindowTopEdge := 25;
  1313.       Flags := FRQABSOLUTEXYM;
  1314.       IF speichern THEN
  1315.         Flags := Flags OR FRQSAVINGM
  1316.       ELSE
  1317.         Flags := Flags OR FRQLOADINGM;
  1318.       Hide := '';
  1319.       Show := '#?'+ext;
  1320.       dirnamescolor := 2;
  1321.       devicenamescolor := 2;
  1322.     END;
  1323.     IF _FileRequester(MyFileReq) THEN BEGIN
  1324.       fileselect := True;
  1325.       selected := pfadname;
  1326.     END;
  1327.   END
  1328. END;
  1329.  
  1330. FUNCTION laden(name: str80): boolean;
  1331. { Datei lesen, gibt bei Fehlern False zurück }
  1332. VAR i,j,result,k,hz: integer;
  1333.     zeile: Str80;
  1334.     dummy: Real;
  1335.     truncated: Boolean;
  1336.   FUNCTION auf_halde(zeile: str80): Str;
  1337.   VAR i: integer;
  1338.   BEGIN
  1339.     auf_halde := Ptr(^StrHalde[hz]);
  1340.     i := 0;
  1341.     REPEAT
  1342.       Inc(i);
  1343.       StrHalde[hz] := zeile[i];
  1344.       IF (hz<strspace) THEN Inc(hz);
  1345.     UNTIL (i=80) OR (zeile[i]=chr(0));
  1346.   END;
  1347. BEGIN
  1348.   SetPointer(MyWindow, ChipSpc[5], 16, 16, -6, 0);
  1349.   Reset(datei,name);
  1350.   result := IOResult;
  1351.   IF result=0 THEN BEGIN
  1352.     laden := True;
  1353.     hz := 1;    { Zeiger der String-Halde zurücksetzen }
  1354.     ReadLn(datei,titel);
  1355.     ReadLn(datei,einheit);
  1356.     ReadLn(datei,ny);
  1357.     FOR j := 1 TO ny DO BEGIN
  1358.       ReadLn(datei,zeile);
  1359.       IF j<=nmax THEN ytitel[j] := auf_halde(zeile);
  1360.     END;
  1361.     ReadLn(datei,nx);
  1362.     truncated := False;
  1363.     FOR i := 1 TO nx DO BEGIN
  1364.       ReadLn(datei,zeile);
  1365.       IF i<=nmax THEN xtitel[i] := auf_halde(zeile);
  1366.       FOR j := 1 TO ny DO IF (i>nmax) OR (j>nmax) THEN BEGIN
  1367.         ReadLn(datei,dummy); truncated := True;
  1368.       END ELSE
  1369.         ReadLn(datei,zr[i,j]);
  1370.       ReadLn(datei,zeile);
  1371.     END;
  1372.     IF nx>nmax THEN nx := nmax;
  1373.     IF ny>nmax THEN ny := nmax;
  1374.     best_guess; { Abmessungen und Skalenteilung einstellen }
  1375.     IF NOT eof(datei) THEN ReadLn(datei,zeile);
  1376.     IF zeile='INFO' THEN BEGIN
  1377.       { Parameter lesen }
  1378.       ReadLn(datei,pr0.z,skz,pr1.z);
  1379.       ReadLn(datei,pr1.x);
  1380.       ReadLn(datei,pr1.y);
  1381.       ReadLn(datei,modus);
  1382.       ReadLn(datei,gap);
  1383.       ReadLn(datei,i); schraeg := i<>0;
  1384.     END;
  1385.     Close(datei);
  1386.     vektoren;
  1387.     IF truncated THEN trunc_warning;
  1388.   END ELSE BEGIN
  1389.     dosfehler(result);
  1390.     laden := False;
  1391.   END;
  1392.   ClearPointer(MyWindow);
  1393. END;
  1394.  
  1395. FUNCTION speichern(name: str80): boolean;
  1396. { Speichern, True, falls erfolgreich. }
  1397. VAR i,j,result: integer;
  1398.     dz: real;
  1399. BEGIN
  1400.   SetPointer(MyWindow, ChipSpc[5], 16, 16, -6, 0);
  1401.   Rewrite(datei,name);
  1402.   result := IOResult;
  1403.   IF result=0 THEN BEGIN
  1404.     speichern := True;
  1405.     WriteLn(datei,titel);
  1406.     WriteLn(datei,einheit);
  1407.     WriteLn(datei);
  1408.     WriteLn(datei,ny);
  1409.     FOR j := 1 TO ny DO WriteLn(datei,ytitel[j]);
  1410.     WriteLn(datei);
  1411.     WriteLn(datei,nx);
  1412.     FOR i := 1 TO nx DO BEGIN
  1413.       WriteLn(datei,xtitel[i]);
  1414.       FOR j := 1 TO ny DO WriteLn(datei,zr[i,j]);
  1415.       WriteLn(datei);
  1416.     END;
  1417.     { Einstellungen mit abspeichern }
  1418.     WriteLn(datei,'INFO');
  1419.     WriteLn(datei,pr0.z,' ',skz,' ',pr1.z,'  (z0 dz z1)');
  1420.     WriteLn(datei,pr1.x-pr0.x,'  (xlen)');
  1421.     WriteLn(datei,pr1.y-pr0.y,'  (ylen)');
  1422.     WriteLn(datei,modus:2,'  (mode)');
  1423.     WriteLn(datei,gap,'  (corridors)');
  1424.     WriteLn(datei,Ord(schraeg):2,'  (fancy texts)');
  1425.     Close(datei);
  1426.   END ELSE BEGIN
  1427.     dosfehler(result);
  1428.     speichern := False;
  1429.   END;
  1430.   ClearPointer(MyWindow);
  1431. END;
  1432.  
  1433. PROCEDURE force_extension(VAR name: str80);
  1434. { An einen Dateinamen die Extension ext='.3D' anhängen, sofern sie noch nicht }
  1435. { existiert. }
  1436. VAR konform: boolean;
  1437.     i: integer;
  1438. BEGIN
  1439.   konform := True;
  1440.   FOR i := 1 TO length(ext) DO
  1441.     IF upcase(ext[i]) <> upcase(name[length(name)-length(ext)+i]) THEN
  1442.       konform := False;
  1443.   IF NOT konform THEN
  1444.     name := name + ext;
  1445. END;
  1446.  
  1447. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  1448. { *#*#*#*#*#*#*#*#*#*#*#*#*# Initialisierungen #*#*#*#*#*#*#*#*#*#*#*#*#* }
  1449. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  1450.  
  1451. PROCEDURE varinit;
  1452. BEGIN
  1453.   ext := '.3D';
  1454.   schraeg := True;
  1455.   quickdraw := False;
  1456.   modus := 1;
  1457.   horiz := 2;   { x/y-Auflösung }
  1458.   vert := 2;
  1459.   gap := 0.2;   { Zwischenraum zwischen Säulen oder Bändern, 0..1 }
  1460.   grace := 2;
  1461.   rb := 2.0;    { Beobachterposition in bezogenen Kugelkoordinaten }
  1462.   phi := Pi/4;
  1463.   theta := Pi/4;
  1464. END;
  1465.  
  1466. PROCEDURE demodaten;
  1467. { Demodatensatz erzeugen (reiner Unfug). }
  1468. VAR i,j: integer;
  1469. BEGIN
  1470.   filename := 'RAM:Demo.3D';
  1471.   titel := 'Star Trek (The Next Generation) cast characters';
  1472.   nx := 8;
  1473.   ny := 6;
  1474.   xtitel[1] := 'Jean-Luc';  xtitel[5] := 'Imzadi';
  1475.   xtitel[2] := 'Der Biker'; xtitel[6] := 'Weasley';
  1476.   xtitel[3] := 'Data';      xtitel[7] := 'Dr. Crusher';
  1477.   xtitel[4] := 'Geordie';   xtitel[8] := 'Microbrain';
  1478.   ytitel[1] := '1st Season';  ytitel[2] := '2nd Season';
  1479.   ytitel[3] := '3rd Season';  ytitel[4] := '4th Season';
  1480.   ytitel[5] := '5th Season';  ytitel[6] := '6th Season';
  1481.   pr0.x := 0; pr1.x := 240;
  1482.   pr0.y := 0; pr1.y := 180;
  1483.   pr0.z := 0; pr1.z := 200; skz := 50;
  1484.   einheit := 'Funny Moments';
  1485.   FOR i := 1 TO nx DO
  1486.     FOR j := 1 TO ny DO
  1487.       zr[i,j] := Round(150*Exp(-Sqr(j-2)/4)*Exp(-Sqr(i-4)/8))+Random(50);
  1488.   modus := 3;
  1489.   vektoren;
  1490. END;
  1491.  
  1492. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  1493. { *#*#*#*#*#*#*#*#*#*#*# System-Initialisierungen *#*#*#*#*#*#*#*#*#*#*#* }
  1494. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  1495.  
  1496. PROCEDURE bilder;
  1497. { Image-Strukturen initialisieren. Wichtig: Der ChipMem-Speicher ChipSpc[] }
  1498. { muß bereits reserviert sein !!! }
  1499. { WB 2.0-Farben: 00: grau, 01: schwarz, 10: weiß, 11: blau }
  1500. BEGIN
  1501.   ChipSpc[1]^ := WordArr40(
  1502.     %0000000000000001,%1111111100000000,
  1503.     %0000000000000111,%1111100100000000,
  1504.     %0000000000011111,%1110000100000000,
  1505.     %0000000001111111,%1000000100000000,
  1506.     %0000000111111110,%0000000100000000,
  1507.     %0000000111111000,%0000000100000000,
  1508.     %0000000001100000,%0000000100000000,
  1509.     %0000110000000000,%0000000100000000,
  1510.     %0000000000000000,%0000000100000000,
  1511.     %1111111111111111,%1111111100000000,
  1512.     %1000000000000000,%0100000000000000,
  1513.     %1000000000000001,%0000000000000000,
  1514.     %1000000000000100,%0000000000000000,
  1515.     %1000000000010000,%0000000000000000,
  1516.     %1000000001000000,%0000000000000000,
  1517.     %1000001100000000,%0000000000000000,
  1518.     %1000011111000000,%0000000000000000,
  1519.     %1000000000000000,%0000000000000000,
  1520.     %1000000000000000,%0000000000000000,
  1521.     %0000000000000000,%0000000000000000 )
  1522.   Bild[1] := Image(0,1,24,10,2,ChipSpc[1],%11,%00,Nil);
  1523.   ChipSpc[2]^ := WordArr40(
  1524.     %0000000000000000,%0000000100000000,
  1525.     %0000011000000000,%0011100100000000,
  1526.     %0000111111000001,%1111000100000000,
  1527.     %0000000111101111,%1000000100000000,
  1528.     %0000000000111100,%0000000100000000,
  1529.     %0000000011100001,%1000000100000000,
  1530.     %0000001100000000,%0110000100000000,
  1531.     %0000010000000000,%0000100100000000,
  1532.     %0000000000000000,%0000000100000000,
  1533.     %1111111111111111,%1111111100000000,
  1534.     %1000000000000000,%0000000000000000,
  1535.     %1000000000000000,%0000000000000000,
  1536.     %1000000000000000,%0000000000000000,
  1537.     %1000000000000000,%0000000000000000,
  1538.     %1000000000000000,%0000000000000000,
  1539.     %1000000000000000,%0000000000000000,
  1540.     %1000000000000000,%0000000000000000,
  1541.     %1000000000000000,%0000000000000000,
  1542.     %1000000000000000,%0000000000000000,
  1543.     %0000000000000000,%0000000000000000 )
  1544.   Bild[2] := Image(0,1,24,10,2,ChipSpc[2],%11,%00,Nil);
  1545.   ChipSpc[3]^ := WordArr40(
  1546.     %0000000000000000,%0000000100000000,
  1547.     %0000001111000011,%1100000100000000,
  1548.     %0000001111011011,%1100000100000000,
  1549.     %0000011111111111,%1110000100000000,
  1550.     %0000011111111111,%1110000100000000,
  1551.     %0000001111011011,%1100000100000000,
  1552.     %0000011111000011,%1110000100000000,
  1553.     %0000011111100111,%1110000100000000,
  1554.     %0000000000000000,%0000000100000000,
  1555.     %1111111111111111,%1111111100000000,
  1556.     %1000000000000000,%0000000000000000,
  1557.     %1000000000000000,%0000000000000000,
  1558.     %1000000101001001,%0100000000000000,
  1559.     %1000000000001000,%0000000000000000,
  1560.     %1000000000001000,%0000000000000000,
  1561.     %1000000000001000,%0000000000000000,
  1562.     %1000000000000000,%0000000000000000,
  1563.     %1000000000000000,%0000000000000000,
  1564.     %1000000000000000,%0000000000000000,
  1565.     %0000000000000000,%0000000000000000 )
  1566.   Bild[3] := Image(0,1,24,10,2,ChipSpc[3],%11,%00,Nil);
  1567.   ChipSpc[4]^ := WordArr40(
  1568.     %0000000000000000,%0000000100000000,
  1569.     %0000000111111100,%0000000100000000,
  1570.     %0000011100000111,%0000000100000000,
  1571.     %0000110001000001,%1000000100000000,
  1572.     %0000110011000001,%1000000100000000,
  1573.     %0000110000000001,%1000000100000000,
  1574.     %0000011100000111,%0000000100000000,
  1575.     %0000000111111100,%0000000100000000,
  1576.     %0000000000000000,%0000000100000000,
  1577.     %1111111111111111,%1111111100000000,
  1578.     %1000000000000000,%0000000000000000,
  1579.     %1000000000000000,%0000000000000000,
  1580.     %1000000000000000,%0000000000000000,
  1581.     %1000000001000000,%0000000000000000,
  1582.     %1000000011000000,%0000000000000000,
  1583.     %1000000000000000,%0000000000000000,
  1584.     %1000000000000000,%1000000000000000,
  1585.     %1000000000000001,%1110000000000000,
  1586.     %1000000000000000,%0111100000000000,
  1587.     %1000000000000000,%0000000000000000 )
  1588.   Bild[4] := Image(0,1,24,10,2,ChipSpc[4],%11,%00,Nil);
  1589.   ChipSpc[5]^ := WordArr40(
  1590.       $0000,$0000,
  1591.       $0400,$07C0,$0000,$07C0,$0100,$0380,$0000,$07E0,
  1592.       $07C0,$1FF8,$1FF0,$3FEC,$3FF8,$7FDE,$3FF8,$7FBE,
  1593.       $7FFC,$FF7F,$7EFC,$FFFF,$7FFC,$FFFF,$3FF8,$7FFE,
  1594.       $3FF8,$7FFE,$1FF0,$3FFC,$07C0,$1FF8,$0000,$07E0,
  1595.       $0000,$0000, 0,0,0,0   { Busy-Pointer, ist eigentlich WordArr36 ... }
  1596.     );
  1597. END;
  1598.  
  1599. PROCEDURE gadgetsetup(bleft,btop,bright,bbot: byte);
  1600. { Gadgets aufbauen, Image-Strukturen müssen bereits initialisiert sein! }
  1601. { Ihr Aussehen wird soweit möglich den angegebenen Randstärken des Fensters }
  1602. { angepaßt. }
  1603. VAR i: Integer;
  1604. BEGIN
  1605.   { Gadgets in der Titelleiste }
  1606.   FOR i := 1 TO 4 DO BEGIN
  1607.     WinGad[i] := Gadget(^WinGad[i+1],-172+24*i,0, 24,11,
  1608.         GADGHCOMP OR GRELRIGHT OR GADGIMAGE,
  1609.         RELVERIFY OR GADGIMMEDIATE OR TOPBORDER, BOOLGADGET OR GZZGADGET,
  1610.         ^Bild[i], Nil,Nil,0,Nil, i, Nil);
  1611.     IF (btop=10) OR (btop=12) THEN BEGIN
  1612.       { Die beiden Fälle, in denen ein 11 Pixel hohes Gadget extrem mies }
  1613.       { aussehen würde (schließen den Fall Kick 1.3 mit ein ;-) }
  1614.       WinGad[i].Height := btop; Bild[i].Height := 9;
  1615.     END ELSE
  1616.       Bild[i].Height := 10;
  1617.   END;
  1618.   { Proportionalgadgets im rechten und unteren Rand }
  1619.   WinGad[5] := Gadget(^WinGad[6],-bright+2,btop,bright-2,-(btop+bbot)+1,
  1620.                GADGHCOMP OR GRELHEIGHT OR GRELRIGHT,
  1621.                GADGIMMEDIATE OR RIGHTBORDER,PROPGADGET OR GZZGADGET,
  1622.                ^MoveDat1,Nil,Nil,0,^PropInf1,5,Nil);
  1623.   PropInf1 := PropInfo(FREEVERT OR AUTOKNOB,$8000,$8000,0,$8000 DIV 5,
  1624.                        0,0,0,0,0,0);
  1625.   WinGad[6] := Gadget(Nil,bleft,-bbot+2,-(bleft+bright)+1,bbot-2,
  1626.                GADGHCOMP OR GRELWIDTH OR GRELBOTTOM,
  1627.                GADGIMMEDIATE OR BOTTOMBORDER,PROPGADGET OR GZZGADGET,
  1628.                ^MoveDat2,Nil,Nil,0,^PropInf2,6,Nil);
  1629.   PropInf2 := PropInfo(FREEHORIZ OR AUTOKNOB,$8000,$8000,$8000 DIV 5,0,
  1630.                        0,0,0,0,0,0);
  1631. END;
  1632.  
  1633. { *** ein paar Routinen für die Menüs: }
  1634.  
  1635. PROCEDURE AddMenu (dx: Integer; name: Str);
  1636. VAR m: p_Menu;
  1637.     it: IntuiText;
  1638.     x: Integer;
  1639. BEGIN
  1640.   x := dx;
  1641.   IF LastMenu<>Nil THEN x := x + LastMenu^.LeftEdge + LastMenu^.Width;
  1642.   it := IntuiText(0, 1, JAM1, 0, 0, MyWindow^.WScreen^.Font, name, Nil);
  1643.   New (m);
  1644.   m^ := Menu(Nil, x, 0, IntuiTextLength(^it) + 8,
  1645.                MyWindow^.WScreen^.Font^.ta_YSize, MENUENABLED,
  1646.                name, Nil, 0, 0, 0, 0);
  1647.   IF LastMenu=Nil THEN Strip := m
  1648.     ELSE LastMenu^.NextMenu := m;
  1649.   LastMenu := m; LastItem := Nil;
  1650. END;
  1651.  
  1652. PROCEDURE AddItem (dy: Integer;  Flag: Word;  name: Str;  Com: Char);
  1653. VAR i: p_MenuItem;
  1654.     t: p_IntuiText;
  1655.     w,y: Integer;
  1656. BEGIN
  1657.   IF LastMenu=Nil THEN Error('MenItem without Menu!');
  1658.   y := dy;
  1659.   IF LastItem<>Nil THEN y := y + LastItem^.TopEdge + LastItem^.Height;
  1660.   New(i); New(t);
  1661.   IF com>' ' THEN Flag := Flag OR COMMSEQ;
  1662.   t^ := IntuiText(0,1, JAM1, 2,1, MyWindow^.WScreen^.Font, name, Nil);
  1663.   w := IntuiTextLength(t);
  1664.   i^ := MenuItem(Nil, 0,y, w + 4,MyWindow^.WScreen^.Font^.ta_YSize + 2,
  1665.                  Flag OR ITEMTEXT OR ITEMENABLED OR HIGHCOMP,
  1666.                  0, t, Nil, Com, Nil, 0);
  1667.   IF LastItem=Nil THEN LastMenu^.FirstItem := i
  1668.     ELSE LastItem^.NextItem := i;
  1669.   LastItem := i; LastSubItem := Nil;
  1670. END;
  1671.  
  1672. PROCEDURE AddSubItem (dy: Integer; Flag: Word; name: Str;  Com: Char);
  1673. VAR s: p_MenuItem;
  1674.     t: p_IntuiText;
  1675.     w,y: Integer;
  1676. BEGIN
  1677.   IF LastItem=Nil THEN Error('SubItem without MenItem');
  1678.   y := dy;
  1679.   IF LastSubItem<>Nil THEN y := y + LastSubItem^.TopEdge + LastSubItem^.Height;
  1680.   New(s); New(t);
  1681.   If com>' ' THEN Flag := Flag OR COMMSEQ;
  1682.   t^ := IntuiText(0,1, JAM1, 2,1, MyWindow^.WScreen^.Font, name, Nil);
  1683.   w := IntuiTextLength(t);
  1684.   s^ := MenuItem(Nil, LastItem^.Width-12, y, w+4,MyWindow^.WScreen^.Font^.ta_YSize + 2,
  1685.                    Flag OR ITEMTEXT OR ITEMENABLED OR HIGHCOMP,
  1686.                    0, t, Nil, Com, Nil, 0);
  1687.   IF LastSubItem=Nil THEN LastItem^.SubItem := s
  1688.     ELSE LastSubItem^.NextItem := s;
  1689.   LastSubItem := s;
  1690. END;
  1691.  
  1692. PROCEDURE MutEx(exc: LongInt);
  1693. VAR i: p_MenuItem;
  1694. BEGIN
  1695.   i := LastItem;
  1696.   IF i=Nil THEN Error('no Item for MutEx');
  1697.   IF LastSubItem<>Nil THEN i := LastSubItem;
  1698.   i^.MutualExclude := exc;
  1699.   i^.Flags := i^.Flags AND NOT MENUTOGGLE;
  1700. END;
  1701.  
  1702. PROCEDURE ItEnable(really: Boolean);
  1703. VAR i: p_MenuItem;
  1704. BEGIN
  1705.   i := LastItem;
  1706.   IF i=Nil THEN Error('no Item for ItEnable');
  1707.   IF LastSubItem<>Nil THEN i := LastSubItem;
  1708.   IF NOT really THEN
  1709.     i^.Flags := i^.Flags AND NOT ITEMENABLED;
  1710. END;
  1711.  
  1712. PROCEDURE CalcMenuWidth(f: p_MenuItem);
  1713. { alle Einträge einer Menüspalte auf gleiche Breite bringen }
  1714. VAR i: p_MenuItem;
  1715.     t: p_IntuiText;
  1716.     max, w: Integer;
  1717. BEGIN
  1718.   i := f;
  1719.   max := 8;
  1720.   WHILE i<>Nil DO BEGIN
  1721.     t := i^.ItemFill;
  1722.     w := 2 + IntuiTextLength(t) + t^.LeftEdge;
  1723.     IF i^.Flags AND COMMSEQ<>0 THEN w := w + 48;
  1724.     IF w>max THEN max := w;
  1725.     i := i^.NextItem;
  1726.   END;
  1727.   i := f;
  1728.   WHILE i<>Nil DO BEGIN
  1729.     i^.Width := max
  1730.     i := i^.NextItem
  1731.   END;
  1732. END;
  1733.  
  1734. PROCEDURE MenuWidths;
  1735. { CalcMenuWidth auf alle Menüs und Untermenüs anwenden }
  1736. VAR m: p_Menu;
  1737.     i: p_MenuItem;
  1738. BEGIN
  1739.   m := Strip;
  1740.   WHILE m<>Nil DO BEGIN
  1741.     i := m^.FirstItem;
  1742.     IF i<>Nil THEN CalcMenuWidth(i);
  1743.     WHILE i<>Nil DO BEGIN
  1744.       IF i^.SubItem<>Nil THEN
  1745.         CalcMenuWidth(i^.SubItem);
  1746.       i := i^.NextItem;
  1747.     END;
  1748.     m := m^.NextMenu;
  1749.   END;
  1750. END;
  1751.  
  1752. PROCEDURE create_menu;
  1753. CONST chk = CHECKIT OR MENUTOGGLE;
  1754.       chkon = chk OR CHECKED;
  1755. VAR egal: Boolean;
  1756. BEGIN
  1757.   LastMenu := Nil;
  1758.   {$ if def DEUTSCH }
  1759.   AddMenu(10, 'Projekt');
  1760.     AddItem(0, 0, 'Öffnen',          'O'); ItEnable(ReqBase<>Nil);
  1761.     AddItem(0, 0, 'Sichern',         'S');
  1762.     AddItem(0, 0, 'Sichern als ...', 'A'); ItEnable(ReqBase<>Nil);
  1763.     AddItem(5, 0, 'Ende',            'Q');
  1764.     AddItem(0, 0, 'Sichern & Ende',  'X');
  1765.     AddItem(5, 0, 'Info',            '?');
  1766.   AddMenu(20, 'Daten');
  1767.     AddItem(0, 0, 'Achsen tauschen',    ' ');
  1768.     AddItem(5, 0, 'Zeilen spiegeln',    ' ');
  1769.     AddItem(0, 0, 'Spalten spiegeln',   ' ');
  1770.     AddItem(5, 0, 'Zeile verschieben',  'L');
  1771.     AddItem(0, 0, 'Spalte verschieben', 'C');
  1772.   AddMenu(20, 'Darstellung');
  1773.     AddItem(0, chkon, '  Netz',         ' '); MutEx(%1110);
  1774.     AddItem(0, chk,   '  Zeilenbänder', ' '); MutEx(%1101);
  1775.     AddItem(0, chk,   '  Spaltenbänder',' '); MutEx(%1011);
  1776.     AddItem(0, chk,   '  Säulen',       ' '); MutEx(%0111);
  1777.     AddItem(5, 0,     'Abmessungen  »', ' ');
  1778.       AddSubItem(0, 0,  'ändern',       'M');
  1779.       AddSubItem(0, 0,  'optimal',      ' ');
  1780.       AddSubItem(0, 0,  'merken',       ' ');
  1781.       AddSubItem(0, 0,  'zurückholen',  ' ');
  1782.     AddItem(0, 0,     'Korridore',      'K');
  1783.     AddItem(0, chk,   '  3D-Schrift',   ' ');
  1784.     AddItem(5, 0,     'Zeichnen',       'D');
  1785.     AddItem(0, 0,     'Abbruch',        'H');
  1786.     AddItem(0, 0,     'Refreshs als  »', ' ');
  1787.       AddSubItem(0, chkon, '  Skizze',  '0'); MutEx(%10);
  1788.       AddSubItem(0, chk,   '  Vollbild','+'); MutEx(%01);
  1789.   AddMenu(20, 'Extras');
  1790.     AddItem(0, chkon, '  Interlace',   'I');
  1791.     AddItem(0, 0,     'Farben  »',     ' ');
  1792.       AddSubItem(0, 0,  'Palette',     'P'); ItEnable(ReqBase<>Nil);
  1793.       AddSubItem(0, 0,  'Workbench',   ' ');
  1794.       AddSubItem(0, 0,  'Default',     ' ');
  1795.     AddItem(0, 0,     'Font ...',      'F'); ItEnable(ReqBase<>Nil);
  1796.   {$ else }
  1797.   AddMenu(10, 'Project');
  1798.     AddItem(0, 0, 'Open',        'O'); ItEnable(ReqBase<>Nil);
  1799.     AddItem(0, 0, 'Save',        'S');
  1800.     AddItem(0, 0, 'Save as ...', 'A'); ItEnable(ReqBase<>Nil);
  1801.     AddItem(5, 0, 'Quit',        'Q');
  1802.     AddItem(0, 0, 'Save & Quit', 'X');
  1803.     AddItem(5, 0, 'About',       '?');
  1804.   AddMenu(20, 'Data');
  1805.     AddItem(0, 0, 'Swap Axes',      ' ');
  1806.     AddItem(5, 0, 'Mirror Lines',   ' ');
  1807.     AddItem(0, 0, 'Mirror Columns', ' ');
  1808.     AddItem(5, 0, 'Move Line',      'L');
  1809.     AddItem(0, 0, 'Move Column',    'C');
  1810.   AddMenu(20, 'Display');
  1811.     AddItem(0, chkon, '  Surface',     ' '); MutEx(%1110);
  1812.     AddItem(0, chk,   '  Lines',       ' '); MutEx(%1101);
  1813.     AddItem(0, chk,   '  Columns',     ' '); MutEx(%1011);
  1814.     AddItem(0, chk,   '  Fields',      ' '); MutEx(%0111);
  1815.     AddItem(5, 0,     'Dimensions  »', ' ');
  1816.       AddSubItem(0, 0,  'Enter',       'M');
  1817.       AddSubItem(0, 0,  'Find Best',   ' ');
  1818.       AddSubItem(0, 0,  'Snapshot',    ' ');
  1819.       AddSubItem(0, 0,  'Recall',      ' ');
  1820.     AddItem(0, 0,     'Corridors',     'K');
  1821.     AddItem(0, chk,   '  Fancy Texts', ' ');
  1822.     AddItem(5, 0,     'Draw',          'D');
  1823.     AddItem(0, 0,     'Halt',          'H');
  1824.     AddItem(0, 0,     'Auto Redraw as  »', ' ');
  1825.       AddSubItem(0, chkon, '  Sketch', '0'); MutEx(%10);
  1826.       AddSubItem(0, chk,   '  Diagram','+'); MutEx(%01);
  1827.   AddMenu(20, 'Outfit');
  1828.     AddItem(0, chkon, '  Interlace', 'I');
  1829.     AddItem(0, 0,     'Colors  »',   ' ');
  1830.       AddSubItem(0, 0,  'Palette',   'P'); ItEnable(ReqBase<>Nil);
  1831.       AddSubItem(0, 0,  'Workbench', ' ');
  1832.       AddSubItem(0, 0,  'Default',   ' ');
  1833.     AddItem(0, 0,     'Font ...',    'F'); ItEnable(ReqBase<>Nil);
  1834.   {$ endif }
  1835.   MenuWidths;
  1836.   egal := SetMenuStrip(MyWindow,Strip);
  1837. END;
  1838.  
  1839. PROCEDURE clear_menu;
  1840. { Die Arbeit von create_menu rückgängig machen }
  1841. VAR m, m2: p_Menu;
  1842.     i, i2: p_MenuItem;
  1843.     t:     p_IntuiText;
  1844. BEGIN
  1845.   IF Strip<>Nil THEN ClearMenuStrip(MyWindow);
  1846.   m := Strip;
  1847.   WHILE m<>Nil DO BEGIN
  1848.     i := m^.FirstItem;
  1849.     WHILE i<>Nil DO BEGIN
  1850.       i2 := i;
  1851.       t := i^.ItemFill;
  1852.       i := i^.NextItem;
  1853.       Dispose(t);
  1854.       Dispose(i2)
  1855.     END;
  1856.     m2 := m;
  1857.     m := m^.NextMenu;
  1858.     Dispose(m2)
  1859.   END;
  1860.   LastMenu := Nil; Strip := Nil;
  1861. END;
  1862.  
  1863. PROCEDURE sysclean;
  1864. { Das Werk von sysinit rückgängig machen, wird bei Programmende aufgerufen. }
  1865. VAR i: Integer;
  1866. BEGIN
  1867.   FOR i := 1 TO 5 DO BEGIN
  1868.     IF ChipSpc[i]<>Nil THEN Free_Mem(Long(ChipSpc[i]),SizeOf(WordArr40));
  1869.     ChipSpc[i] := Nil;
  1870.   END;
  1871.   IF IntuitionBase<>Nil THEN CloseLibrary(IntuitionBase);
  1872.   IF GfxBase<>Nil THEN CloseLibrary(GfxBase);
  1873.   IF ReqBase<>Nil THEN BEGIN
  1874.     PurgeFiles(MyFileReq);
  1875.     CloseLibrary(ReqBase);
  1876.   END;
  1877.   IF MyFileReq<>Nil THEN Free_Mem(Long(MyFileReq),SizeOf(ReqFileRequester));
  1878.   MyFileReq := Nil;
  1879.   IntuitionBase := Nil; GfxBase := Nil; ReqBase := Nil;
  1880. END;
  1881.  
  1882. PROCEDURE screenclean;
  1883. { Das Werk von screeninit rückgängig machen, wird bei jeder Screenmode- }
  1884. { Umschaltung aufgerufen. }
  1885. VAR egal: word;
  1886. BEGIN
  1887.   IF oldwindowptr<>Nil THEN myprocess^.pr_WindowPtr := oldwindowptr;
  1888.   IF MyWindow<>Nil THEN BEGIN
  1889.     egal := RemoveGList(MyWindow,^WinGad[1],6);
  1890.     clear_menu; Strip := Nil;
  1891.     CloseWindow(MyWindow);
  1892.     MyWindow := Nil;
  1893.   END;
  1894.   IF MyScreen<>Nil THEN IF CloseScreen(MyScreen) THEN; MyScreen := Nil;
  1895.   IF armem<>Nil THEN FreeRaster(armem,breite,hoehe); armem := Nil;
  1896. END;
  1897.  
  1898. PROCEDURE sysinit;
  1899. { Libraries öffnen, Programmstart-Argumente auswerten, Gadgetbilder aufbauen }
  1900. VAR i,j,len: integer;
  1901.     s: str80;
  1902.     hail: p_WBStartup;
  1903.     arg: p_WBArg;
  1904.     olddir: BPTR;
  1905. BEGIN
  1906.   { zuerst Zeiger für den zugehörigen ExitServer initialisieren: }
  1907.   FOR i := 1 TO 5 DO ChipSpc[i] := Nil; MyFileReq := Nil;
  1908.   IntuitionBase := Nil; GfxBase := Nil; ReqBase := Nil;
  1909.   { Filerequester-Struktur anlegen, muß mit Nullen vorbesetzt sein! }
  1910.   MyFileReq := Ptr(Alloc_Mem(SizeOf(ReqFileRequester),MEMF_CLEAR));
  1911.   { Intuition-Version >= 1.2, da ich z. B. ActivateGadget() benutze: }
  1912.   IntuitionBase := OpenLibrary('intuition.library',33);
  1913.   GfxBase := OpenLibrary('graphics.library',0);
  1914.   ReqBase := OpenLibrary('req.library',0);
  1915.   IF IntuitionBase=Nil THEN  Error('You need intuition.library V33+!');
  1916.   IF GfxBase=Nil THEN  Error('Can''t open graphics.library ... hm?');
  1917.   IF ReqBase=Nil THEN  {desaster('Can''t open req.library !!!')};
  1918.   { Bei fehlender req.library werden nur ein paar Menues gesperrt ... }
  1919.   FOR i := 1 TO 5 DO
  1920.     ChipSpc[i] := Ptr(Alloc_Mem(SizeOf(WordArr40),MEMF_CHIP));
  1921.   bilder;
  1922.   filename := '';
  1923.   IF fromWB THEN BEGIN                    { WB-Start }
  1924.     hail := StartupMessage;
  1925.     arg := hail^.sm_ArgList;
  1926.     olddir := CurrentDir(arg^.wa_Lock);   { ins richtige Verzeichnis wechseln }
  1927.     IF hail^.sm_NumArgs>1 THEN BEGIN      { mit Argumentdateien gestartet? }
  1928.       { auf nächsten WBArg-Zeiger zugreifen: }
  1929.       arg := Ptr(Long(arg)+SizeOf(WBArg));
  1930.       olddir := CurrentDir(arg^.wa_Lock);
  1931.       filename := arg^.wa_Name;
  1932.     END;
  1933.   END ELSE BEGIN                          { CLI-Start }
  1934.     len := ParameterLen; IF len >79 THEN len := 79;
  1935.     s := Copy(ParameterStr,1,len);
  1936.     { eigentlichen Dateinamen herausfinden (von Trennzeichen eingeschlossen: }
  1937.     i := 1; WHILE (s[i]<=' ') AND (i<=len) DO Inc(i);
  1938.     j := i; WHILE (s[i]>' ') AND (j<=len) DO Inc(j);
  1939.     IF s[i]='"' THEN BEGIN { in "" eingeschlossener Name }
  1940.       Inc(i); j := i; WHILE (s[j]<>'"') AND (j<=len) DO Inc(j);
  1941.     END;
  1942.     IF j>i THEN BEGIN
  1943.       filename := Copy(s,i,j-i); force_extension(filename);
  1944.     END;
  1945.   END;
  1946. END;
  1947.  
  1948. FUNCTION RASSIZE (w,h : Long) : Long;  { tolle 3.1-Includes :-P }
  1949. BEGIN
  1950.  RASSIZE:=(h*((w+15) DIV 8) AND $FFFE);
  1951. END;
  1952.  
  1953. PROCEDURE screeninit;
  1954. { Screen, Window, Menue und Gadgets installieren }
  1955. VAR flags, pen, egal: Word;
  1956.     theGfxBase: p_GfxBase;
  1957. BEGIN
  1958.   { zuerst Zeiger für den zugehörigen ExitServer initialisieren: }
  1959.   MyScreen := Nil; armem := Nil; MyWindow := Nil; Con := Nil; Strip := Nil;
  1960.   oldwindowptr := Nil;
  1961.   { DrawInfo-Pens für den Screen angeben, damit die Fenster darauf unter }
  1962.   { 2.0 gut aussehen. Programm ist trotzdem unter 1.3 lauffähig! (Trick: Die }
  1963.   { ExtNewScreen-Struktur, die von 1.3 für eine gewönliche NewScreen-Struktur }
  1964.   { gehalten wird, da das Flag NS_EXTENDED für 1.3 keine Bedeutung hat.) }
  1965.   pen := $FFFF; { Zeichen für "der Rest nach Default" }
  1966.   NSTags[1] := TagItem(SA_Pens,Long(^pen));
  1967.   NSTags[2] := TagItem(TAG_DONE,0);
  1968.   theGfxBase := GfxBase;
  1969.   breite := theGfxBase^.NormalDisplayColumns * horiz DIV 2;
  1970.   flags := GENLOCK_VIDEO
  1971.   IF horiz=2 THEN flags := flags OR HIRES;
  1972.   IF vert=2 THEN  flags := flags OR LACE;
  1973.   topazAttr := TextAttr('topaz.font',8,FS_NORMAL,FPF_ROMFONT);
  1974.   NeuerScreen := ExtNewScreen(0,0,breite,STDSCREENHEIGHT,2,0,1,flags,
  1975.        NS_EXTENDED OR CUSTOMSCREEN,Nil,'Graph3D-Screen',Nil,Nil,^NSTags[1]);
  1976.   MyScreen := OpenScreen(^NeuerScreen);
  1977.   IF MyScreen = Nil THEN Error('Cannot open screen!');
  1978.   charx := MyScreen^.RastPort.TxWidth;  { Screenfont, für Text in Requestern }
  1979.   chary := MyScreen^.RastPort.TxHeight;
  1980.   baseline := MyScreen^.RastPort.TxBaseline;
  1981.   hoehe := MyScreen^.Height;
  1982.   NeuesWindow := NewWindow(0,MyScreen^.BarHeight+1,breite,
  1983.       hoehe-MyScreen^.Barheight-1,2,1, GADGETUP OR GADGETDOWN OR _CLOSEWINDOW
  1984.       OR MENUPICK OR NEWSIZE OR REQCLEAR OR REQSET,
  1985.       ACTIVATE OR WINDOWSIZING OR WINDOWCLOSE OR WINDOWDEPTH OR WINDOWDRAG
  1986.       OR SIZEBRIGHT OR SIZEBBOTTOM OR GIMMEZEROZERO,
  1987.       Nil, Nil, 'Graph3D',MyScreen,Nil,220,100,breite,hoehe,CUSTOMSCREEN);
  1988.   MyWindow := OpenWindow(^NeuesWindow);
  1989.   IF MyWindow = Nil THEN Error('Cannot open window!');
  1990.   create_menu;
  1991.   Rast := MyWindow^.RPort;
  1992.   Upt := MyWindow^.Userport;
  1993.   gadgetsetup(MyWindow^.BorderLeft,MyWindow^.BorderTop,MyWindow^.BorderRight,
  1994.     MyWindow^.BorderBottom);
  1995.   egal := AddGList(MyWindow,^WinGad[1],1,6,Nil);
  1996.   RefreshGadgets(^WinGad[1],MyWindow,Nil);
  1997.   armem := AllocRaster(breite,hoehe);  { Speicher fuer Areas }
  1998.   IF armem=Nil THEN Error('Cannot allocate temporary raster!');
  1999.   InitArea(^MyAreaInfo,^areabuffer[1],100);
  2000.   Rast^.TmpRas := InitTmpRas(^tmp,armem,RASSIZE(breite,hoehe));
  2001.   Rast^.AreaInfo := ^MyAreaInfo;
  2002.   { meine Task finden und System Requests auf meinen Screen umleiten }
  2003.   myprocess := ptr(FindTask(Nil));
  2004.   oldwindowptr := myprocess^.pr_WindowPtr;
  2005.   myprocess^.pr_WindowPtr := MyWindow;
  2006. END;
  2007.  
  2008. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  2009. { *#*#*#*#*#*#*#*#*#*#*#* Ereignisverarbeitung #*#*#*#*#*#*#*#*#*#*#*#*#* }
  2010. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  2011.  
  2012. FUNCTION wrongviewmode: boolean;
  2013. { Stellt fest, ob der momentan offene Screen die gewünschte vertikale }
  2014. { Auflösung hat. }
  2015. VAR is_laced: boolean;
  2016. BEGIN
  2017.   is_laced := (MyScreen^.ViewPort.Modes AND LACE)<>0;
  2018.   wrongviewmode := ((vert=1) AND is_laced) OR ((vert=2) AND NOT is_laced);
  2019. END;
  2020.  
  2021. PROCEDURE check(m,i,s: Integer; really: Boolean);
  2022. VAR it: p_MenuItem;
  2023.     code: Long;
  2024. BEGIN
  2025.   code := m + (i SHL 5) + (s SHL 11);
  2026.   it := ItemAddress(Strip,code);
  2027.   IF really THEN
  2028.     it^.Flags := it^.Flags OR CHECKED
  2029.   ELSE
  2030.     it^.Flags := it^.Flags AND NOT CHECKED;
  2031. END;
  2032.  
  2033. FUNCTION has_check(m,i,s: Integer): Boolean;
  2034. VAR it: p_MenuItem;
  2035.     code: Long;
  2036. BEGIN
  2037.   code := m + (i SHL 5) + (s SHL 11);
  2038.   it := ItemAddress(Strip,code);
  2039.   has_check := (it^.Flags AND CHECKED)<>0;
  2040. END;
  2041.  
  2042. PROCEDURE write_checks;
  2043. { Variablen ins Menue übertragen }
  2044. VAR i: integer;
  2045. BEGIN
  2046.   check(2,6,-1, schraeg);
  2047.   FOR i := 1 TO 4 DO
  2048.     check(2,i-1,-1, (i = modus));
  2049.   check(3,0,-1, (vert=2));
  2050.   check(2,9,0, quickdraw);
  2051.   check(2,9,1, NOT quickdraw);
  2052. END;
  2053.  
  2054. PROCEDURE check_checks;
  2055. { Menuehäkchen in Programmvariablen übernehmen }
  2056. VAR i: integer;
  2057.     egal: boolean;
  2058. BEGIN
  2059.   schraeg := has_check(2,6,-1);
  2060.   modus := 1;
  2061.   FOR i := 1 TO 4 DO
  2062.     IF has_check(2,i-1,-1) THEN modus := i;
  2063.   IF has_check(3,0,-1) THEN vert := 2 ELSE vert := 1;
  2064.   quickdraw := has_check(2,9,0);
  2065. END;
  2066.  
  2067. PROCEDURE menuhandling(item: word);
  2068. { Menu-Handhabung }
  2069. VAR men,menitem,subitem: integer;
  2070.     item_address: ^MenuItem;
  2071.     hallo: long;
  2072.     update: Boolean;
  2073.     tryname: str80;
  2074. BEGIN
  2075.   update := False;
  2076.   WHILE item<>MENUNULL DO BEGIN
  2077.     { item nach Menue, Menuepunkt und Untermenue aufschlüsseln }
  2078.     men := item AND $1F;
  2079.     menitem := (item SHR 5) AND $3F;
  2080.     subitem := (item SHR 11) AND $1F;
  2081.     { und schon mal zum nächsten vorrücken: }
  2082.     item_address := ItemAddress(Strip,item);
  2083.     item := item_address^.NextSelect;
  2084.     IF men=0 THEN       { 1. Menue: Projekt }
  2085.       CASE menitem OF
  2086.         0: BEGIN
  2087.             tryname := filename;
  2088.             IF fileselect('Tabellendaten einlesen',False,tryname) THEN
  2089.               IF laden(tryname) THEN BEGIN
  2090.                 filename := tryname; write_checks; update := True;
  2091.               END;
  2092.           END;
  2093.         1: IF NOT speichern(filename) THEN;
  2094.         2: BEGIN
  2095.             tryname := filename;
  2096.             IF fileselect('Daten und Parameter sichern',True,tryname) THEN BEGIN
  2097.               force_extension(tryname);
  2098.               IF speichern(tryname) THEN filename := tryname;
  2099.             END;
  2100.           END;
  2101.         3: ende := True;
  2102.         4: IF speichern(filename) THEN ende := True;
  2103.         5: infotext;
  2104.       OTHERWISE;
  2105.       END;
  2106.     IF men=1 THEN BEGIN      { 2. Menue: Daten }
  2107.       update := True;
  2108.       CASE menitem OF
  2109.         0: BEGIN swapxy; write_checks; END;
  2110.         1: mirrorx;
  2111.         2: mirrory;
  2112.         3: update := move_row(True);
  2113.         4: update := move_row(False);
  2114.         OTHERWISE;
  2115.       END;
  2116.     END;
  2117.     IF men=2 THEN       { 3. Menue: Darstellung }
  2118.       CASE menitem OF
  2119.         0..3: update := True;
  2120.         4: CASE subitem OF
  2121.              0: IF gr_aendern THEN update := bereichstest;
  2122.              1: BEGIN best_guess; update := True; END;
  2123.              2: BEGIN merken; confirm_snap; END;
  2124.              3: BEGIN erinnern; update := bereichstest; END;
  2125.            OTHERWISE;
  2126.            END;
  2127.          5: BEGIN korridor_eing; update := True; END;
  2128.          6: update := True;
  2129.          7: BEGIN darstellen; update := False; END;
  2130.       OTHERWISE;
  2131.       END;
  2132.     IF men=3 THEN       { 4. Menue: Extras }
  2133.       CASE menitem OF
  2134.         1: CASE subitem OF
  2135.              0: IF ReqBase<>Nil THEN hallo := ColorRequester(0);
  2136.              1: clonecolors;
  2137.              2: defcolors;
  2138.              OTHERWISE;
  2139.            END;
  2140.         OTHERWISE;
  2141.       END;
  2142.   END;
  2143.   IF update THEN refresh;
  2144. END;
  2145.  
  2146. PROCEDURE gadgetprimaer(g:p_Gadget);
  2147. { Ereignisse bei GADGETDOWN }
  2148. VAR MyInfo: ^PropInfo;
  2149.     alt: real;
  2150. BEGIN
  2151.   IF g<>Nil THEN
  2152.     CASE g^.GadgetID OF
  2153.       3: IF rb<20 THEN BEGIN    { wegzoomen }
  2154.           rb := rb * 1.3; vektoren; skizze;
  2155.         END;
  2156.       4: IF rb>0.5 THEN BEGIN   { ranzoomen }
  2157.           rb := rb / 1.3; vektoren; skizze;
  2158.         END;
  2159.       5: BEGIN   { vertikale Beobachterposition aus Prop übernehmen }
  2160.         MyInfo := g^.SpecialInfo;
  2161.         REPEAT
  2162.           alt := theta; theta := (MyInfo^.VertPot*Pi/2)/MAXPOT;
  2163.           IF theta<>alt THEN BEGIN vektoren; zentriere; skizze; END;
  2164.         UNTIL (g^.flags AND SELECTED) = 0;
  2165.         refresh;
  2166.       END;
  2167.       6: BEGIN   { dasselbe für horizontale Beobachterposition }
  2168.         MyInfo := g^.SpecialInfo;
  2169.         REPEAT
  2170.           alt := phi; phi := (MyInfo^.HorizPot*Pi/2)/MAXPOT;
  2171.           IF phi<>alt THEN BEGIN vektoren; zentriere; skizze; END;
  2172.         UNTIL (g^.flags AND SELECTED) = 0;
  2173.         refresh;
  2174.       END;
  2175.       OTHERWISE;
  2176.     END;
  2177. END;
  2178.  
  2179. PROCEDURE gadgetfolge(g:p_Gadget);
  2180. { Ereignisse bei GADGETUP }
  2181. BEGIN
  2182.   IF g<>Nil THEN
  2183.     CASE g^.GadgetID OF
  2184.       1: darstellen;
  2185.       2: skizze;
  2186.       3,4: refresh;   { wegzoomen/ranzoomen abschließen }
  2187.       OTHERWISE;
  2188.     END;
  2189. END;
  2190.  
  2191. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  2192. { *#*#*#*#*#*#*#*#*#*#*#*#*#  Hauptprogramm  #*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  2193. { *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
  2194.  
  2195. VAR l,eventclass: Long;
  2196.     address: Ptr;
  2197.     code: Word;
  2198.  
  2199. BEGIN
  2200.   varinit;
  2201.   AddExitServer(sysclean); sysinit;
  2202.   AddExitServer(screenclean); screeninit;
  2203.   defcolors;
  2204.   IF filename='' THEN
  2205.     demodaten
  2206.   ELSE IF NOT laden(filename) THEN
  2207.     demodaten;
  2208.   write_checks;
  2209.   refresh;
  2210.   merken;
  2211.   ende := False;
  2212.   REPEAT
  2213.     l := Wait(-1);
  2214.     REPEAT              { Schleife, da mehrere Ereignisse möglich }
  2215.       check_checks;     { Häkchen auslesen, bevor eine Aktion stattfindet }
  2216.       MyMsg := Get_Msg(Upt);
  2217.       IF MyMsg<>Nil THEN BEGIN
  2218.         eventclass := MyMsg^.Class;
  2219.         code := MyMsg^.Code;
  2220.         address := MyMsg^.IAddress;
  2221.         Reply_Msg(MyMsg);             { so schnell wie möglich antworten! }
  2222.         CASE eventclass OF
  2223.           _CLOSEWINDOW:
  2224.             ende := True;
  2225.           NEWSIZE:
  2226.             refresh;
  2227.           GADGETDOWN:
  2228.             gadgetprimaer(address);
  2229.           GADGETUP:
  2230.             gadgetfolge(address);
  2231.           MENUPICK:
  2232.             menuhandling(code);
  2233.         OTHERWISE;
  2234.         END;
  2235.       END;
  2236.     UNTIL MyMsg = Nil;
  2237.     IF wrongviewmode THEN BEGIN
  2238.       screenclean; screeninit;   { neuen Screen mit/ohne Interlace öffnen }
  2239.       writepalette; write_checks; refresh;
  2240.     END;
  2241.   UNTIL ende;
  2242.   screenclean; sysclean;
  2243. END.
  2244.  
  2245.