PROGRAM graph3d;
{ Business-Grafik in 3D }
USES graphics, intuition, exec;

{$ path "ram:include/", "pas:include/" }
{  incl "intuition.lib", "graphics.lib", "exec.lib" }
{$ incl "dos.lib", "req.lib", "intuition/preferences.h" }
{$ incl "workbench/startup.h", "libraries/dosextens.h", "graphics/gfxbase.h"  }
{$ opt q,s+,i+ } { Laufzeitprüfungen: nur Stack und Indizes }

CONST nmax=100;
      strspace = 4000;    { ca. 2*nmax*20 -> im Mittel Platz für 20 Zeichen }
      version='$VER: Graph3D 1.43  (28.04.96)';
      DEUTSCH = 'D';

TYPE r_vekt = RECORD x,y,z: real END;
     fl_vekt = RECORD x,y: real END;
     IntArr10 = ARRAY[1..10] OF Integer;
     WordArr40 = ARRAY[1..40] OF Word;
     chefstring = String[40];
     str80 = String[80];

{ Alle etwas größeren Variablen werden als STATIC deklariert, damit KICK-Pascal }
{ sie nicht auf den Stack packt (Argh!). }

VAR zr: ARRAY[1..nmax,1..nmax] OF real; STATIC;
    skz: real;
    StrHalde: ARRAY[1..strspace] OF char; STATIC;
    xtitel,ytitel: ARRAY[1..nmax] OF Str; STATIC;
    titel,einheit,filename: str80; STATIC;
    ext: string[5];
    b,o,r,e1,e2,pr0,pr1,pr0m,pr1m: r_vekt; STATIC;
    fl_quader: ARRAY[1..8] OF fl_vekt; STATIC;
    off,pfl0,pfl1: fl_vekt;
    rd,rb,phi,theta: Real;
    mag,gap: Real;
    schraeg,ende,notaus,quickdraw: Boolean;
    datei: Text;
    nx,ny,modus: Integer;
    grace,horiz,vert: Integer;

    { ab hier für Systemprogrammierung: }
VAR areabuffer: ARRAY[1..250] OF Word; STATIC;
    MyAreaInfo: AreaInfo;
    tmp: TmpRas;
    Strip,LastMenu: p_Menu;
    LastItem, LastSubItem: p_MenuItem;
    WinGad: ARRAY[1..6] OF Gadget; STATIC;
    PropInf1,PropInf2: PropInfo; STATIC;
    MoveDat1,MoveDat2: ARRAY[1..6] OF Integer;
    Bild: ARRAY[1..4] OF Image; STATIC;
    ChipSpc: ARRAY[1..5] OF ^WordArr40;
    wintitle,scrtitle: Str80; STATIC;
    palette: ARRAY[0..3] OF Long;
    myprocess: p_Process;
    NeuesWindow: NewWindow; STATIC;
    MyWindow,oldwindowptr: p_Window;
    Rast: p_RastPort;
    Con,Upt,armem: Ptr;
    MyMsg: p_IntuiMessage;
    topazAttr: TextAttr;
    NSTags: ARRAY[1..5] OF TagItem; STATIC;
    NeuerScreen: ExtNewScreen; STATIC;
    MyScreen: p_Screen;
    charx,chary,baseline: Word;  { beschreiben den Font des Screens }
    breite,hoehe: Integer;
    { für die Reuester: }
    MyRequest: Requester; STATIC;
    ReqGad: ARRAY[1..10] OF Gadget; STATIC;
    StrInf: ARRAY[1..10] OF StringInfo; STATIC;
    ITxt: ARRAY[1..10] OF IntuiText; STATIC;
    Bord: ARRAY [1..8] OF Border; STATIC;
    Coords: ARRAY[1..4] OF IntArr10; STATIC;
    ubuf: str80; { einer für alle ;-) }
    muell: ARRAY[0..31] OF Byte;
    { für die req.library: }
    MyFileReq: p_ReqFileRequester;
    pfad: ARRAY[0..DSIZE] OF Char; STATIC;
    name: ARRAY[0..FCHARS] OF Char; STATIC;
    pfadname: ARRAY[-DSIZE..FCHARS] OF Char; STATIC;

{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#  Ausgabeformatierung  #*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }

FUNCTION max(a,b: Real): Real;
BEGIN
  IF a>b THEN  max := a  ELSE  max := b;
END;

FUNCTION min(a,b: Real): Real;
BEGIN
  IF a<b THEN  min := a  ELSE  min := b;
END;

FUNCTION glatt(x: Real): Real;
{ aus funktion.mod übernommen, 29.09.93 }
VAR ziffer,potenz: Real;
BEGIN
  IF x=0 THEN
    glatt := x
  ELSE BEGIN
    potenz := Pwr10(Round(Ln(Abs(x))/Ln(10)-0.5)) * x/Abs(x);
    { ln x/ln 10  ist log10(x), x/abs x  ist sgn(x) }
    ziffer := x/potenz;
    IF ziffer>7.5 THEN
      glatt := 10*potenz
    ELSE IF ziffer>3.5 THEN
      glatt := 5*potenz
    ELSE IF ziffer>1.5 THEN
      glatt := 2*potenz
    ELSE
      glatt := 1*potenz
  END
END;

PROCEDURE itoa(l: long; anz: integer; vz, fill: char; VAR xstr: chefstring);
{ Longinteger mit anz Stellen in String wandeln, von links wird mit <fill>
  aufgefüllt (z. B. '0', ' ', '*'). Falls Zahl zu lang, Leerstring als
  Fehlermeldung. }
{ <vz>: hier kann '+', '-' oder ' ' stehen. Vor negative <l> wird aber
  auf jeden Fall ein '-' gesetzt, vor positive nie. Zweck von vz='-':
  '-0' ermöglichen. }
{ aus Matrizen.p übernommen, 29.09.93 }
VAR i: Integer;
BEGIN
  IF l<0 THEN vz := '-';
  IF (l>0) AND (vz='-') THEN vz := '+';
  l := Abs(l);
  xstr := '';
  REPEAT
    xstr := Chr(l MOD 10 + Ord('0')) + xstr;
    l := l DIV 10;
  UNTIL l=0;
  IF (vz='+') OR (vz='-') THEN   { gültiges Vorzeichen }
    xstr := vz + xstr;
  anz := anz - Length(xstr);
  IF anz<0 THEN
    xstr := ''
  ELSE
    FOR i := 1 TO anz DO
      xstr := fill + xstr;
END;

PROCEDURE f77fix(r: Real; b,s: Integer; VAR ausg: chefstring);
{ Zahl r wie mit dem Fortran-Formatbeschreiber  Fb.s  umwandeln }
{ aus Matrizen.p übernommen, 29.09.93 }
VAR i,j,pos: Integer;
    teil: chefstring;
    vz: Char;
BEGIN
  { letzte auszugebende Stelle jetzt schon runden, nur die Nachkommastellen }
  { zu runden, kann Fehler ergeben! }
  IF abs(r*pwr10(s))<MaxLongInt THEN
    r := Round(r*pwr10(s)) * pwr10(-s);
  IF r<0 THEN vz := '-'  ELSE  vz := ' ';
  IF s>0 THEN BEGIN
    { Nachkommastellen }
    itoa(Trunc(Frac(Abs(r))*Pwr10(s)), s, ' ', '0', ausg);
    ausg := '.' + ausg;
  END ELSE
    ausg := '';
  itoa(Trunc(r), b - Length(ausg), vz, ' ', teil);
  IF teil = '' THEN BEGIN   { Fehler, Zahl paßt nicht }
    ausg := '';
    FOR i := 1 TO b DO
      ausg := ausg + '*';
  END ELSE
    ausg := teil + ausg;
END;

PROCEDURE ftoa(r: real; s: integer; VAR xstr: chefstring);
{ Zahl r mit maximal s signifikanten Stellen in String umwandeln, abschließende }
{ Nullen hinter dem Komma werden abgeschnitten. }
{ Schweren Bug beseitigt, z. B. r=1.0 ergab "0.1"! (10/95) }
VAR i,j,pos: integer;
    teil: chefstring;
    x: real;
BEGIN
  IF r=0 THEN
    xstr := '0'
  ELSE BEGIN
    x := Abs(r);
    pos := Round(Ln(x)/Ln(10)-0.5);    { die Zehnerpotenz, in der die
              erste Ziffer <>0 steht, für Darstellung x=?.???*pwr10(pos) }
    { Mantisse s-stellig erzeugen: }
    xstr := IntStr(Round(x/pwr10(pos-s+1)));
    { manchmal (bei 1.00E??) wird pos falsch berechnet, korrigieren! }
    j := Length(xstr); IF j>s THEN Inc(pos);
    { überflüssige Nullen wegwerfen: }
    s := j; WHILE xstr[s] = '0' DO BEGIN
      xstr[s] := chr(0); Dec(s)
    END;
    IF (pos>s+5) OR (pos<-3) THEN BEGIN
      { Exponentialdarstellung ratsam }
      IF s>1 THEN BEGIN     { Komma an Stelle 2 einpatchen }
        i := Length(xstr)+1; WHILE i>=2 DO BEGIN
          xstr[i+1] := xstr[i]; Dec(i);
        END;
        xstr[2] := '.';
      END;
      IF pos<0 THEN  xstr := xstr + 'E-' ELSE  xstr := xstr + 'E+';
      xstr := xstr + IntStr(Abs(pos) DIV 10);
      xstr := xstr + IntStr(Abs(pos) MOD 10);
    END ELSE BEGIN
      { gewöhnliche Dezimalschreibweise }
      IF s<=pos+1 THEN
        { keine Nachkommastellen, evtl. Nullen anhängen }
        FOR i := 1 TO pos+1-s DO  xstr := xstr + '0'
      ELSE IF pos<0 THEN BEGIN
        { führende Nullen: '0.'+... }
        teil := '0.';  FOR i := 1 TO abs(pos)-1 DO teil := teil + '0';
        xstr := teil + xstr;
      END ELSE BEGIN
        { Komma an Stelle pos+2 einpatchen }
        i := Length(xstr)+1; WHILE i>=pos+2 DO BEGIN
          xstr[i+1] := xstr[i]; Dec(i);
        END;
        xstr[pos+2] := '.';
      END;
    END;
    IF r<0 THEN  xstr := '-' + xstr;
  END;
END;

{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#* 3D-Vektorbehandlung *#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }

PROCEDURE projektion(pr: r_vekt; VAR pf: fl_vekt);
VAR v: r_vekt;
    vr: Real;
BEGIN
  { Vektor v=pr-b in Richtung von r (Blickrichtung) "normieren" }
  vr := (pr.x-b.x)*r.x+(pr.y-b.y)*r.y+(pr.z-b.z)*r.z;
  v.x := (pr.x-b.x)/vr;
  v.y := (pr.y-b.y)/vr;
  v.z := (pr.z-b.z)/vr;
  { auf die Schirmvektoren e1, e2 projizieren }
  pf.x := v.x*e1.x + v.y*e1.y + v.z*e1.z;
  pf.y := v.x*e2.x + v.y*e2.y + v.z*e2.z;
  { zurechtrücken }
  pf.x := off.x + pf.x*mag*horiz;
  pf.y := off.y + pf.y*mag*vert;
END;

PROCEDURE vektoren;
{ initialisiert die Projektionsvektoren für einen Beobachter in den (auf rd }
{ bezogenen) Kugelkoordinaten rb, phi, theta }
VAR rr: Real;
BEGIN
  { Raumdiagonale rd: }
  rd := Sqrt(Sqr(pr1.x-pr0.x)+Sqr(pr1.y-pr0.y)+Sqr(pr1.z-pr0.z));
  { Aufpunkt o für Blickrichtung: }
  o.x := (pr0.x+pr1.x)/2;
  o.y := (pr0.y+pr1.y)/2;
  o.z := (pr0.z+pr1.z)/2;
  { Beobachterpunkt b: }
  b.x := o.x + rd*rb*Cos(phi)*Sin(theta);
  b.y := o.y + rd*rb*Sin(phi)*Sin(theta);
  b.z := o.z + rd*rb*Cos(theta);
  { daraus Richtungsvektor r berechnen und normieren }
  rr := Sqrt(Sqr(o.x-b.x)+Sqr(o.y-b.y)+Sqr(o.z-b.z));
  r.x := (o.x-b.x)/rr;
  r.y := (o.y-b.y)/rr;
  r.z := (o.z-b.z)/rr;
  { Basisvektoren e1, e2 der "Rückwand der Lochkamera" bestimmen, dies sind
  zum Glück einfach die Einheitsvektoren e-Phi, e-Theta.
  Die verkehrte y-Achse des Bildschirms ist hierin berücksichtigt! }
  e1.x := -Sin(phi);
  e1.y :=  Cos(phi);
  e1.z := 0;
  e2.x := Cos(theta)*Cos(phi);
  e2.y := Cos(theta)*Sin(phi);
  e2.z := -Sin(theta);
END;

{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*  diverse Systemoperationen  *#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }

FUNCTION abbruch: Boolean;
{ wird von zeitaufwendigen Zeichenroutinen abgefragt }
VAR gad: p_Gadget;
    m,i,s: Integer;
BEGIN
  abbruch := False;
  MyMsg := Get_Msg(Upt);
  IF MyMsg<>Nil THEN BEGIN
    IF MyMsg^.Class=GADGETUP THEN BEGIN
      gad := MyMsg^.IAddress;
      IF gad^.GadgetID=2 THEN  abbruch := True;   { Not-Aus Gadget }
    END;
    IF MyMsg^.Class=MENUPICK THEN BEGIN
      m := MyMsg^.Code AND $1F;
      i := (MyMsg^.Code SHR 5) AND $3F;
      s := (MyMsg^.Code SHR 11) AND $1F;
      IF (m=2) AND (i=8) THEN  abbruch := True;  { Menüpunkt "Halt" }
    END;
    Reply_Msg(MyMsg);
  END;
END;

PROCEDURE desaster(meldung: str80);
{ erzeugt einen Alert }
VAR egal: Boolean;
    buf: String[100];
    xpos: Integer;
BEGIN
  xpos := 320 - 4*Length(meldung);
  buf := '   '+meldung;
  buf[1] := Chr(Hi(xpos)); buf[2] := Chr(Lo(xpos));
  buf[3] := Chr(18);
  buf [Length(meldung)+5] := Chr(0);
  egal := DisplayAlert(RECOVERY_ALERT,buf,32);
END;

PROCEDURE writepalette;
VAR i: integer;
BEGIN
  FOR i := 0 TO 3 DO
    SetRGB4(^MyScreen^.ViewPort,i,(palette[i] div 256) AND 15,
    (palette[i] div 16) AND 15, palette[i] AND 15);
END;

PROCEDURE getpalette;
VAR i: integer;
BEGIN
  FOR i := 0 TO 3 DO
    palette[i] := GetRGB4(MyScreen^.ViewPort.ColorMap,i);
END;

PROCEDURE defcolors;
BEGIN
  { 2.0-"Pewter"-Palette }
  palette[0] := $CCB; palette[1] := $003;
  palette[2] := $FFF; palette[3] := $9AB;
  writepalette;
END;

PROCEDURE clonecolors;
{ Farben der Workbench übernehmen }
VAR prefs: Preferences;
    i: integer;
BEGIN
  IF GetPrefs(^prefs, SizeOf(Preferences))<>Nil THEN BEGIN
    palette[0] := prefs.color0; palette[1] := prefs.color1;
    palette[2] := prefs.color2; palette[3] := prefs.color3;
    writepalette;
  END;
END;

PROCEDURE settitles(normal: Boolean);
BEGIN
  {$ if def DEUTSCH }
  scrtitle := filename+'  '+IntStr(nx)+' Spalten, '+IntStr(ny)+' Zeilen';
  {$ else }
  scrtitle := filename+'  '+IntStr(nx)+' Columns, '+IntStr(ny)+' Lines';
  {$ endif }
  IF normal THEN BEGIN
    wintitle := titel;
  END ELSE
    wintitle := Copy(version,7,Length(version)-6);
  SetWindowTitles(MyWindow,wintitle,scrtitle);
END;

{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#  Zeichnen  *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }

PROCEDURE quader;
{ projiziert die Eckpunkte des 'Quaders im R³' und ermittelt das der
Projektion umbeschriebene Rechteck }
VAR i: Integer;
    pr: r_vekt;
BEGIN
  FOR i := 1 TO 8 DO BEGIN
    pr.x := pr0.x + (pr1.x-pr0.x)*((i-1) MOD 2);
    pr.y := pr0.y + (pr1.y-pr0.y)*(((i-1) DIV 2) MOD 2);
    pr.z := pr0.z + (pr1.z-pr0.z)*(((i-1) DIV 4) MOD 2);
    projektion(pr,fl_quader[i]);
    IF (i=1) OR (fl_quader[i].x>pfl1.x) THEN  pfl1.x := fl_quader[i].x;
    IF (i=1) OR (fl_quader[i].y>pfl1.y) THEN  pfl1.y := fl_quader[i].y;
    IF (i=1) OR (fl_quader[i].x<pfl0.x) THEN  pfl0.x := fl_quader[i].x;
    IF (i=1) OR (fl_quader[i].y<pfl0.y) THEN  pfl0.y := fl_quader[i].y;
  END;
END;

PROCEDURE skizze;
{ Rückwände des dargestellten Quaders andeuten }
  PROCEDURE auf(i: Integer); BEGIN
    Move(Rast,Round(fl_quader[i].x),Round(fl_quader[i].y));
  END;
  PROCEDURE nach(i: Integer); BEGIN
    Draw(Rast,Round(fl_quader[i].x),Round(fl_quader[i].y));
  END;
BEGIN
  quader;       { Eckpunkte projizieren }
  SetRast(Rast,0);      { löschen }
  SetAPen(Rast,1);      { schwarz }
  auf(1); nach(2); nach(6); nach(5); nach(7); nach(3); nach(1); nach(5);
  auf(2); nach(4); nach(3);
END;

PROCEDURE schrift(ausg: chefstring; abst: integer; p0,p1: fl_vekt; ernst: boolean);
{ Ordnet den String ausg auf dem Strahl aus p0 durch p1 an, dabei abst
Leerzeichen.
Greift auf globale Variablen pfl0, pfl1 zu, um tatsächlichen Platzbedarf
der beschrifteten Zeichnung zu ermitteln }
VAR delta,step: fl_vekt;
    i,j,l: Integer;
    unsinn: Long;
    charx,chary,baseline: Word;    { Font des Windows, nicht des Screens }
BEGIN
  charx := Rast^.TxWidth;
  chary := Rast^.TxHeight;
  baseline := Rast^.TxBaseline;
  delta.x := p1.x - p0.x;
  delta.y := p1.y - p0.y;
  IF abs(delta.x/charx)>abs(delta.y/chary) THEN BEGIN
    step.x := charx*delta.x/abs(delta.x);
    step.y := charx*delta.y/abs(delta.x);
  END ELSE BEGIN
    step.x := chary*delta.x/abs(delta.y);
    step.y := chary*delta.y/abs(delta.y);
  END;
  p1.x := p0.x + abst*step.x;
  p1.y := p0.y + abst*step.y;
  IF NOT schraeg THEN BEGIN
    { normale horizontale Schrift, nützlich für Zahlen }
    step.x := charx*delta.x/abs(delta.x);
    step.y := 0;
  END;
  l := length(ausg);
  SetDrMd(Rast,JAM1);
  IF ernst THEN FOR i := 1 TO l DO BEGIN
    IF step.x>=0 THEN
      j := i
    ELSE
      j := l-i+1;
    Move(Rast,Round(p1.x+(i-1)*step.x)-charx div 2,
              Round(p1.y+(i-1)*step.y)+baseline-chary div 2);
    unsinn := _Text(Rast,ausg[j],1);
  END;
  { benötigten Platz aus der Position des ersten und letzten Zeichens
  ermitteln: }
  pfl1.x := max(pfl1.x, p1.x + charx/2);
  pfl1.y := max(pfl1.y, p1.y + chary/2);
  pfl0.x := min(pfl0.x, p1.x - charx/2);
  pfl0.y := min(pfl0.y, p1.y - chary/2);
  pfl1.x := max(pfl1.x, p1.x + (l-1)*step.x + charx/2);
  pfl1.y := max(pfl1.y, p1.y + (l-1)*step.y + chary/2);
  pfl0.x := min(pfl0.x, p1.x + (l-1)*step.x - charx/2);
  pfl0.y := min(pfl0.y, p1.y + (l-1)*step.y - chary/2);
END;

PROCEDURE skalen(ernst: boolean);
VAR textoff,step,p0,p1: fl_vekt;
    pr: r_vekt;
    i, gst,nkst: integer;
    bez: chefstring;
BEGIN
  IF ernst THEN skizze;         { Rückwände und Boden zeichnen }
  { x-/y-Skalierung und Beschriftung in Abhängigkeit vom Modus }
  textoff.x := 0;  { Verschiebung der Beschriftung vom Skalenstrich weg }
  textoff.y := 0;
  CASE modus OF
    1: BEGIN      { (nx-1)·(ny-1) Felder }
      step.x := (pr1.x - pr0.x)/(nx-1);
      step.y := (pr1.y - pr0.y)/(ny-1);
    END;
    2: BEGIN      { (nx-1)·ny Felder }
      step.x := (pr1.x - pr0.x)/(nx-1);
      step.y := (pr1.y - pr0.y)/ny;
      textoff.y := step.y*(1 + gap)/2;
    END;
    3: BEGIN      { nx·(ny-1) Felder }
      step.x := (pr1.x - pr0.x)/nx;
      textoff.x := step.x*(1 + gap)/2;
      step.y := (pr1.y - pr0.y)/(ny-1);
    END;
    4: BEGIN      { nx·ny Felder }
      step.x := (pr1.x - pr0.x)/nx;
      textoff.x := step.x*(1 + gap)/2;
      step.y := (pr1.y - pr0.y)/ny;
      textoff.y := step.y*(1 + gap)/2;
    END;
  END;
  IF abbruch THEN BEGIN
    notaus := True; Exit END;
  { z-Linien zuerst zeichnen, da sie nur Ziffern tragen, die ruhig
  beschädigt werden dürfen: }
  { Zunächst herausfinden, wieviele Nachkommastellen und Gesamtstellen für die
  Ausgabe der z-Werte benötigt werden. }
  nkst := 0;
  WHILE skz*Pwr10(nkst)<1 DO  Inc(nkst);
  gst := 1; IF pr0.z<0 THEN gst := 2;
  WHILE pr1.z/Pwr10(gst)>1 DO  Inc(gst);
  WHILE -pr0.z/Pwr10(gst)>0.1 DO  Inc(gst);
  IF nkst>0 THEN
    gst := gst + nkst + 1;
  FOR i := Round(pr0.z/skz + 0.5) TO Round(pr1.z/skz - 0.5) DO BEGIN
    pr.z := i*skz;
    f77fix(pr.z,gst,nkst,bez);
    pr.x := pr0.x; pr.y := pr1.y;
    projektion(pr,p0);
    Move(Rast,Round(p0.x),Round(p0.y));
    pr.y := pr0.y;
    projektion(pr,p0);
    IF ernst THEN Draw(Rast,Round(p0.x),Round(p0.y));
    pr.x := pr1.x;
    projektion(pr,p0);
    IF ernst THEN Draw(Rast,Round(p0.x),Round(p0.y));
    pr.x := pr.x + rd/10;
    projektion(pr,p1);
    schrift(bez,1,p0,p1,ernst);
  END;
  { und noch den Titel der z-Achse }
  pr.z := pr1.z+skz;
  projektion(pr,p1);
  pr.x := pr.x - rd/10;
  projektion(pr,p0);
  schrift(einheit,-length(einheit) div 2,p0,p1,ernst);
  IF abbruch THEN BEGIN
    notaus := True; Exit END;
  { x-Linien }
  FOR i := 1 TO nx DO IF (xtitel[i]<>'') OR (modus IN [3,4]) THEN BEGIN
    pr.x := pr0.x + step.x*(i - 1);
    pr.y := pr0.y; pr.z := pr1.z;
    projektion(pr,p0);
    Move(Rast,Round(p0.x),Round(p0.y));
    pr.z := pr0.z;
    projektion(pr,p0);
    IF ernst THEN Draw(Rast,Round(p0.x),Round(p0.y));
    pr.y := pr1.y;
    projektion(pr,p0);
    IF ernst THEN Draw(Rast,Round(p0.x),Round(p0.y));
    pr.x := pr.x + textoff.x;
    projektion(pr,p0);
    pr.y := pr.y + rd/10;
    projektion(pr,p1);
    bez := xtitel[i];
    schrift(bez,1,p0,p1,ernst);
  END;
  IF abbruch THEN BEGIN
    notaus := True; Exit END;
  { y-Linien, das gleiche }
  FOR i := 1 TO ny DO IF (ytitel[i]<>'') OR (modus IN [2,4]) THEN BEGIN
    pr.y := pr0.y + step.y*(i - 1);
    pr.x := pr0.x; pr.z := pr1.z;
    projektion(pr,p0);
    Move(Rast,Round(p0.x),Round(p0.y));
    pr.z := pr0.z;
    projektion(pr,p0);
    IF ernst THEN Draw(Rast,Round(p0.x),Round(p0.y));
    pr.x := pr1.x;
    projektion(pr,p0);
    IF ernst THEN Draw(Rast,Round(p0.x),Round(p0.y));
    pr.y := pr.y + textoff.y;
    projektion(pr,p0);
    pr.x := pr.x + rd/10;
    projektion(pr,p1);
    bez := ytitel[i];
    schrift(bez,1,p0,p1,ernst);
  END;
END;

PROCEDURE zentriere;
{ wählt Offset und Vergrößerung für optimalen Bildausschnitt }
VAR i: integer;
    frei: fl_vekt;
BEGIN
  off.x := 0;
  off.y := 0;
  mag := 1;
  quader;       { die acht Eckpunkte projizieren und Rahmen ermitteln }
  frei.x := MyWindow^.GZZWidth-2*grace;
  frei.y := MyWindow^.GZZHeight-2*grace;
  mag := min(frei.x/(pfl1.x-pfl0.x), frei.y/(pfl1.y-pfl0.y));
  off.x := grace - mag*pfl0.x + (frei.x-mag*(pfl1.x-pfl0.x))/2;
  off.y := grace - mag*pfl0.y + (frei.y-mag*(pfl1.y-pfl0.y))/2;
END;

PROCEDURE zentr_m_text;
{ Durch Beschriftung nichtlinearer Zusammenhang zwischen Vergrößerung und
Platzbedarf der Zeichnung, darum Iteration nach Regula Falsi für den
Überstand fehler in Abhängigkeit von mag }
VAR fehler1,fehler2,mag0,mag1,mag2: real;
    frei: fl_vekt;
BEGIN
  frei.x := MyWindow^.GZZWidth-2*grace;
  frei.y := MyWindow^.GZZHeight-2*grace;
  zentriere;
  mag1 := mag;          { 1. Näherung für mag }
  mag0 := mag;
  quader;
  skalen(False);        { Wirkung ausprobieren }
  IF notaus THEN
    Exit;
  fehler1 := max((pfl1.x-pfl0.x)/frei.x, (pfl1.y-pfl0.y)/frei.y) - 1;
  mag2 := mag1/(fehler1 + 1);
  { 2. Näherung, tut so als wäre Größe trotz Text proportional zu mag }
  mag := mag2;
  quader;
  skalen(False);
  IF notaus THEN
    Exit;
  fehler2 := max((pfl1.x-pfl0.x)/frei.x, (pfl1.y-pfl0.y)/frei.y) - 1;
  mag := (fehler2*mag1 - fehler1*mag2)/(fehler2 - fehler1); { Regula Falsi }
  { winzige (oder sogar kopfstehende) Bilder vermeiden: }
  IF mag<mag0/3 THEN mag := mag0/3;
  off.x := 0;
  off.y := 0;
  quader;
  skalen(False);
  off.x := grace - pfl0.x + (frei.x - (pfl1.x-pfl0.x))/2;
  off.y := grace - pfl0.y + (frei.y - (pfl1.y-pfl0.y))/2;
END;

PROCEDURE netz;
{ Oberfläche als (nx-1)·(ny-1) Vierecke zeichnen. Diagonale Vorgehensweise, }
{ um Fehler bei Hidden-Line zu vermeiden. Die beiden letzten Zeilen werden }
{ zwischengespeichert, damit nicht jeder Punkt viermal projiziert werden }
{ muß. }
VAR dx,dy: real;
    i,ii,j,k,akt,vor1,vor2: integer;
    p: ARRAY[1..4] OF fl_vekt;
    zeile: ARRAY[1..3,1..nmax] OF fl_vekt;
    pr: r_vekt;
    status: LongInt;
BEGIN
  dx := (pr1.x - pr0.x)/(nx-1);
  dy := (pr1.y - pr0.y)/(ny-1);
  akt := 1;
  vor2 := 2;
  vor1 := 3;
  FOR ii := 1 TO nx+ny DO BEGIN
    FOR j := 1 TO ii DO BEGIN
      i := 1+ii-j;
      IF (i<=nx) AND (j<=ny) THEN BEGIN
        pr.x := pr0.x + (i-1)*dx;
        pr.y := pr0.y + (j-1)*dy;
        pr.z := zr[i,j];
        projektion(pr,zeile[akt,j]);
        IF (i>1) AND (j>1) THEN BEGIN
          p[1] := zeile[akt,j];
          p[2] := zeile[vor1,j];
          p[3] := zeile[vor2,j-1];
          p[4] := zeile[vor1,j-1];
          SetDrMd(Rast,JAM1);
          status := AreaMove(Rast,Round(p[4].x),Round(p[4].y));
          FOR k := 1 TO 4 DO
            status := AreaDraw(Rast,Round(p[k].x),Round(p[k].y));
          SetAPen(Rast,3);      { rot }
          status := AreaEnd(Rast);
          SetAPen(Rast,1);      { schwarz }
          Move(Rast,Round(p[4].x),Round(p[4].y));
          FOR k := 1 TO 4 DO
            Draw(Rast,Round(p[k].x),Round(p[k].y));
        END;
      END;
      IF abbruch THEN
        Exit;
    END;
    vor2 := vor1;
    vor1 := akt;
    akt := akt mod 3 + 1;
  END;
END;

PROCEDURE saeulen;
{ Stellt zr(nx,ny) als Bänder in x-Richtung (modus=2), Bänder in y-Richtung
(modus=3) bzw. als Säulendiagramm (modus=4) dar. Diagonale Vorgehensweise
hilft diesmal leider nicht, darum Hiddenline-Fehler bei Betrachtung aus
x- oder y-Achsenrichtung. }
VAR nxvar,nyvar,i,j,k: integer;
    dx,dy,a,b,c: real;
    pr: r_vekt;
    p: ARRAY[1..8] OF fl_vekt;
    status: LongInt;

  PROCEDURE viereck(i1,i2,i3,i4: integer; flfarb,lfarb: long);
  VAR i: ARRAY[1..4] OF integer;
      k: integer;
  BEGIN
    i[1] := i1; i[2] := i2; i[3] := i3; i[4] := i4;
    SetDrMd(Rast,JAM1);
    SetAPen(Rast,flfarb);
    status := AreaMove(Rast,Round(p[i4].x),Round(p[i4].y));
    FOR k := 1 TO 4 DO
      status := AreaDraw(Rast,Round(p[i[k]].x),Round(p[i[k]].y));
    status := AreaEnd(Rast);
    SetAPen(Rast,lfarb);
    Move(Rast,Round(p[i4].x),Round(p[i4].y));
    FOR k := 1 TO 4 DO
      Draw(Rast,Round(p[i[k]].x),Round(p[i[k]].y));
  END;

BEGIN
  { Oberfläche als ny bzw. nx Bänder zu (nx-1) bzw. (ny-1) Flächen zeichnen
  bzw. als nx·ny rechteckige Säulen }
  IF modus=2 THEN nxvar := nx-1  ELSE nxvar := nx;
  IF modus=3 THEN nyvar := ny-1  ELSE nyvar := ny;
  dx := (pr1.x - pr0.x)/nxvar;
  dy := (pr1.y - pr0.y)/nyvar;
  FOR i := 1 TO nxvar DO
    FOR j := 1 TO nyvar DO BEGIN
      { 8 Eckpunkte der Säule bzw. schiefen Säule projizieren }
      FOR k := 1 TO 8 DO BEGIN
        { Ecke auswählen als Tripel von (0 oder 1) }
        a := (k-1) mod 2;
        b := ((k-1) div 2) mod 2;
        c := ((k-1) div 4) mod 2;
        IF modus<>2 THEN
          a := max(a,gap);
        IF modus<>3 THEN
          b := max(b,gap);
        pr.x := pr0.x + (i-1+a)*dx;
        pr.y := pr0.y + (j-1+b)*dy;
        CASE modus OF
          2: pr.z := pr0.z + c*(zr[i+Round(a),j]-pr0.z);
          3: pr.z := pr0.z + c*(zr[i,j+Round(b)]-pr0.z);
          4: pr.z := pr0.z + c*(zr[i,j]-pr0.z);
        END;
        projektion(pr,p[k]);
      END;
      { Deckfläche und zwei vordere Seitenflächen zeichnen }
      viereck(5,6,8,7, 3,1);    { rot, schwarz }
      viereck(2,4,8,6, 2,1);    { weiß, schwarz }
      viereck(3,4,8,7, 2,1);
      IF abbruch THEN
        Exit;
    END;
END;

PROCEDURE darstellen;
VAR i: integer;
BEGIN
  SetRast(Rast,0);    { Bildschirm löschen }
  notaus := False;      { für Abbruchüberprüfung in den Unterrroutinen }
  zentr_m_text;
  IF notaus THEN BEGIN
    skizze; Exit END;
  skalen(True);
  IF modus=1 THEN
    netz          { Netzdiagramm }
  ELSE
    saeulen;      { behandelt Säulen- und Bänderdiagramme zusammen }
END;

PROCEDURE refresh;
{ Bilschirm neu aufbauen, für quickdraw=True: Skizze, sonst Zeichnung }
BEGIN
  settitles(True);
  IF quickdraw THEN BEGIN
    zentriere;
    skizze;
  END ELSE
    darstellen;
END;

{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*  Datenverwaltung  *#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }

PROCEDURE swapxy;
{ Tabelle im Speicher transponieren }
VAR i, j, m: integer;
    hilf: chefstring;
BEGIN
  IF nx>ny THEN m := nx ELSE m := ny;
  FOR i := 1 TO m DO BEGIN
    Exchange(xtitel[i],ytitel[i]);
    FOR j := 1 TO i-1 DO
      Exchange(zr[i,j], zr[j,i]);
  END;
  Exchange(nx, ny);
  Exchange(pr0.x, pr0.y);
  Exchange(pr1.x, pr1.y);
  IF modus=2 THEN
    modus := 3
  ELSE IF modus=3 THEN
    modus := 2;
  vektoren;
END;

PROCEDURE mirrorx;
{ Reihenfolge der Spalten umkehren }
VAR i, j: integer;
    hilf: chefstring;
BEGIN
  FOR i := 1 TO nx div 2 DO BEGIN
    exchange(xtitel[i], xtitel[nx+1-i]);
    FOR j := 1 TO ny DO
      exchange(zr[i,j], zr[nx+1-i,j]);
  END;
END;

PROCEDURE mirrory;
{ Reihenfolge der Zeilen umkehren }
VAR i, j: integer;
    hilf: chefstring;
BEGIN
  FOR j := 1 TO ny div 2 DO BEGIN
    exchange(ytitel[j], ytitel[ny+1-j]);
    FOR i := 1 TO nx DO
      exchange(zr[i,j], zr[i,ny-j+1]);
  END;
END;

PROCEDURE makeborder(n, x0,y0, x1,y1: Integer; raised: Boolean);
{ legt in Coords[n] und Bord[2*n-1], Bord[2*n] einen 3D-Rahmen an }
VAR c1,c2: Word;
BEGIN
  c1 := 1; c2 := 1;
  IF raised THEN c2 := 2 ELSE c1 := 2;
  Coords[n] := IntArr10(x0,y1, x1,y1, x1,y0, x0,y0, x0,y1);
  Bord[2*n-1] := Border(0,0,c1,0,JAM1,3,^Coords[n][1],^Bord[2*n]);
  Bord[2*n]   := Border(0,0,c2,0,JAM1,3,^Coords[n][5],Nil);
END;

FUNCTION move_row(line: Boolean): Boolean;
{ Requester öffnen, Zeile bzw. Spalte verschieben lassen }
{ Rückgabewert: Datenbestand wirklich geändert? }
TYPE strarr=ARRAY[1..4] OF Str;
VAR texte: strarr;
    l: ARRAY[1..4] OF Integer;
    gad: p_Gadget;
    ende,genehmigt,soso: Boolean;
    warte,eventclass: Long;
    i,j,di,n,x1,x2,lmax,off: Integer;
    b,h: Word;
    buf: ARRAY[1..4] OF chefstring;
BEGIN
  move_row := False;
  IF line THEN BEGIN
    n := ny; buf[3] := ytitel[1]; buf[4] := ytitel[n];
  END ELSE BEGIN
    n := nx; buf[3] := xtitel[1]; buf[4] := xtitel[n];
  END;
  buf[1] := '1'; buf[2] := IntStr(n);
  ubuf := '';
  {$ if def DEUTSCH }
  texte := strarr('Spalte verschieben:','an Position:','OK','Abbruch');
  IF line THEN texte[1] := 'Zeile verschieben:';
  {$ else }
  texte := strarr('Move column:','To position:','OK','Cancel');
  IF line THEN texte[1] := 'Move line:';
  {$ endif }
  FOR i := 1 TO 4 DO l[i] := Length(texte[i]);
  lmax := l[1]; IF l[2]>l[1] THEN lmax := l[2];
  x1 := 15 + (lmax+1)*charx; x2 := x1 + 5*8;
  b := x1 + 20*8 + 15;
  h := 44 + 3*chary;
  off := (chary-8) DIV 2;
  FOR i := 1 TO 2 DO
    ITxt[i] := IntuiText(1,2,JAM1,15,12+(i-1)*(chary+8),Nil,texte[i],^ITxt[i+1]);
  ITxt[2].NextText := Nil;
  FOR i := 1 TO 2 DO
    ReqGad[i] := Gadget(^ReqGad[i+1],x1,12+(i-1)*(chary+8)+off,4*8,8,
        GADGHCOMP,RELVERIFY OR _LONGINT,STRGADGET OR REQGADGET,
        ^Bord[1],Nil,Nil,0,^StrInf[i],i,Nil);
  FOR i := 3 TO 4 DO
    ReqGad[i] := Gadget(^ReqGad[i+1],x2,12+(i-3)*(chary+8)+off,15*8,8,GADGHCOMP,
        RELVERIFY,STRGADGET OR REQGADGET,Nil, Nil,Nil,0,^StrInf[i],i,Nil);
  FOR i := 1 TO 4 DO
    StrInf[i] := StringInfo(^buf[i],^ubuf,0,39,0,0,0,0,0,0,Nil,0,Nil);
  FOR i := 5 TO 6 DO
    ReqGad[i] := Gadget(^ReqGad[i+1],10,32+2*chary,9*charx+2,chary+2,
        GADGHCOMP, RELVERIFY OR ENDGADGET, BOOLGADGET OR REQGADGET,
        ^Bord[3],Nil,^ITxt[i-2],0,Nil,i,Nil);
  FOR i := 3 TO 4 DO
    ITxt[i] := IntuiText(1,2,JAM1,1+(9-l[i])*charx DIV 2,1,Nil,texte[i],Nil);
  ReqGad[6].LeftEdge := b-(11+9*charx);
  ReqGad[6].NextGadget := Nil;
  makeborder(1, -1,-1, 4*8, 8, False);
  makeborder(2,  0, 0, 9*charx+1,chary+1, True);
  makeborder(3,  0, 0, b-1,h-1, True);
  MyRequest := Requester(Nil,40,30,b,h,0,0,^ReqGad[1],^Bord[5],
                         ^ITxt[1],0,3,Nil,muell,Nil,Nil,Nil,muell);
  IF Request(^MyRequest,MyWindow) THEN BEGIN
    { Ereignisse abfragen }
    ende := False;
    REPEAT
      warte := Wait(-1);
      REPEAT              { Schleife, da mehrere Ereignisse möglich }
        MyMsg := Get_Msg(Upt);
        IF MyMsg <> Nil THEN BEGIN
          eventclass := MyMsg^.Class;
          gad := MyMsg^.IAddress;
          Reply_Msg(MyMsg);             { so schnell wie möglich antworten! }
          IF eventclass=REQSET THEN
            soso := ActivateGadget(^ReqGad[1],MyWindow,^MyRequest);
          IF eventclass=GADGETUP THEN
            CASE gad^.GadgetID OF
              1,2: BEGIN
                i := gad^.GadgetID
                j := StrInf[i].LongInt;
                IF j<1 THEN j := 1; IF j>n THEN j := n;
                buf[i] := IntStr(j);
                IF line THEN buf[i+2] := ytitel[j]
                  ELSE buf[i+2] := xtitel[j];
                IF i=1 THEN x1 := j ELSE x2 := j;
                soso := ActivateGadget(^ReqGad[3-i],MyWindow,^MyRequest);
                RefreshGadgets(^ReqGad[1],MyWindow,^MyRequest);
              END;
              5: genehmigt := True;
              6: genehmigt := False;
              OTHERWISE;
            END;
          IF eventclass=REQCLEAR THEN ende := True;
        END;
      UNTIL MyMsg = Nil;
    UNTIL ende;
    IF genehmigt THEN BEGIN
      IF x1<x2 THEN di := 1 ELSE di := -1;
      i := x1; WHILE i<>x2 DO BEGIN
        IF line THEN BEGIN
          Exchange(ytitel[i],ytitel[i+di]);
          FOR j := 1 TO nx DO Exchange(zr[j,i],zr[j,i+di]);
        END ELSE BEGIN
          Exchange(xtitel[i],xtitel[i+di]);
          FOR j := 1 TO ny DO Exchange(zr[i,j],zr[i+di,j]);
        END;
        i := i + di;
      END;
      move_row := True;
    END;
  END;
END;

{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#*  Abmessungen  *#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }

PROCEDURE merken;
BEGIN
  pr0m := pr0; pr1m := pr1;
END;

PROCEDURE erinnern;
BEGIN
  pr0 := pr0m; pr1 := pr1m;
  vektoren;
END;

PROCEDURE tauschen;
VAR hilf: r_vekt;
BEGIN
  hilf := pr0m; pr0m := pr0; pr0 := hilf;
  hilf := pr1m; pr1m := pr1; pr1 := hilf;
  vektoren;
END;

PROCEDURE best_guess;
{ Abmessungen und Skalenteilung "optimal" einstellen }
VAR zmin,zmax,dz: Real;
    i,j: Integer;
BEGIN
  zmin := zr[1,1]; zmax := zr[1,1];
  FOR j := 1 TO ny DO
    FOR i := 1 TO nx DO BEGIN
      IF zr[i,j]<zmin THEN zmin := zr[i,j];
      IF zr[i,j]>zmax THEN zmax := zr[i,j];
    END;
  { Skalenteilung auf der z-Achse }
  dz := zmax-zmin;
  IF dz=0 THEN dz := 1;
  IF (zmin>0) AND (zmin<dz/2) THEN
    pr0.z := 0
  ELSE
    pr0.z := zmin-0.05*dz;
  skz := glatt(dz/10);
  pr1.z := zmax+0.05*dz;
  pr0.x := 0;
  pr1.x := 1.1*dz*sqrt(nx/ny);
  pr0.y := 0;
  pr1.y := 1.1*dz*sqrt(ny/nx);
  vektoren;
END;

FUNCTION bereichstest: Boolean;
{ überprüfen, ob neugewählte Abmessungen mit der Datei verträglich sind }
{ und erzeugt ggf. einen Requester }
TYPE strarr=ARRAY[1..4] OF Str;
VAR texte: strarr;
    egal: Boolean;
    meldung,buf: chefstring;
    zmin,zmax,dz: Real;
    lmax,i,j: Integer;
BEGIN
  bereichstest := True;
  zmin := zr[1,1]; zmax := zr[1,1];
  FOR j := 1 TO ny DO
    FOR i := 1 TO nx DO BEGIN
      IF zr[i,j]<zmin THEN zmin := zr[i,j];
      IF zr[i,j]>zmax THEN zmax := zr[i,j];
    END;
  dz := zmax - zmin;
  IF max(zmax-pr1.z,pr0.z-zmin)>dz/10 THEN BEGIN
    bereichstest := False;
    ftoa(zmin,4,meldung);
    ftoa(zmax,4,buf);
    settitles(False);
    {$ if def DEUTSCH }
    meldung := 'für Wertebereich '+meldung+' .. '+buf;
    texte := strarr('Gewählter z-Ausschnitt zu klein',meldung,
             'Ändern Sie das besser.',' Mach Ich ');
    {$ else }
    meldung := 'for data range '+meldung+' .. '+buf;
    texte := strarr('Chosen z-range not sufficient',meldung,
             'You''d better fix that.',' Aye, Sir! ');
    {$ endif }
    lmax := 0; FOR i := 1 TO 3 DO
      IF lmax<Length(texte[i]) THEN lmax := Length(texte[i]);
    FOR i := 1 TO 3 DO
      ITxt[i] := IntuiText(2,1,JAM1,(2+lmax-Length(texte[i]))*charx DIV 2,
               i*(chary+2),Nil,texte[i],^ITxt[i+1]);
    ITxt[3].NextText := Nil;
    ITxt[4] := Intuitext(2,1,JAM1,6,3,Nil,texte[4],Nil);
    egal := AutoRequest(MyWindow,^ITxt[1],Nil,^ITxt[4],0,0,
            (6+lmax)*charx,5*(chary+2)+30);
    settitles(True);
  END;
END;

FUNCTION gr_aendern: Boolean;
{ Requester öffnen, z-Bereich, Skalenteilung, x/z und y/z einlesen }
{ Rückgabewert: Abmessungen wirklich geändert? }
TYPE strarr=ARRAY[1..7] OF Str;
VAR texte: strarr;
    l: ARRAY[1..7] OF Integer;
    xz,yz: Real;
    gad: p_Gadget;
    ende,genehmigt,soso: Boolean;
    warte,eventclass: Long;
    i,x1,x2,lmax,off: Integer;
    b,h: Word;
    buf: ARRAY[1..5] OF chefstring;
BEGIN
  gr_aendern := False;
  xz := (pr1.x-pr0.x)/(pr1.z-pr0.z);
  yz := (pr1.y-pr0.y)/(pr1.z-pr0.z);
  ftoa(pr0.z,4,buf[1]);
  ftoa(pr1.z,4,buf[2]);
  ftoa(skz,4,buf[3]);
  ftoa(xz,4,buf[4]);
  ftoa(yz,4,buf[5]);
  ubuf := '';
  {$ if def DEUTSCH }
  texte := strarr('Wertebereich:','Skalenteilung:','relative Achsenlängen:',
           'x/z:','y/z:','OK','Abbruch');
  {$ else }
  texte := strarr('z-Range:','z-Step:','Relative length of axes:',
           'x/z:','y/z:','OK','Cancel');
  {$ endif }
  FOR i := 1 TO 7 DO l[i] := Length(texte[i]);
  lmax := l[1]; IF l[2]>l[1] THEN lmax := l[2];
  x1 := 15 + (lmax+1)*charx;
  lmax := l[4]; IF l[5]>l[4] THEN lmax := l[5];
  x2 := 15 + (lmax+1)*charx;
  b := 30 + l[3]*charx; IF b<x1+95 THEN b := x1+95;
  h := 84 + 7*chary;
  off := (chary-8) DIV 2;
  FOR i := 1 TO 5 DO BEGIN
    ITxt[i] := IntuiText(1,2,JAM1,15,20+i*(chary+8),Nil,texte[i],^ITxt[i+1]);
    ReqGad[i] := Gadget(^ReqGad[i+1],x1,12+(i-1)*(chary+8)+off,80,8,GADGHCOMP,
        RELVERIFY,STRGADGET OR REQGADGET,^Bord[1],Nil,Nil,0,^StrInf[i],i,Nil);
    StrInf[i] := StringInfo(^buf[i],^ubuf,0,20,0,0,0,0,0,0,Nil,0,Nil);
  END;
  ITxt[1].TopEdge := 12;
  ITxt[2].TopEdge := 28 + 2*chary;
  FOR i := 4 TO 5 DO BEGIN
    ReqGad[i].LeftEdge := x2; ReqGad[i].TopEdge := 20+i*(chary+8)+off; END;
  ITxt[5].NextText := Nil;
  FOR i := 6 TO 7 DO BEGIN
    ReqGad[i] := Gadget(^ReqGad[i+1],10,72+6*chary,9*charx+2,chary+2,
        GADGHCOMP, RELVERIFY OR ENDGADGET, BOOLGADGET OR REQGADGET,
        ^Bord[3],Nil,^ITxt[i],0,Nil,i,Nil);
    ITxt[i] := IntuiText(1,2,JAM1,1+(9-l[i])*charx DIV 2,1,Nil,texte[i],Nil);
  END;
  ReqGad[7].LeftEdge := b-(11+9*charx);
  ReqGad[7].NextGadget := Nil;
  makeborder(1, -1,-1, 80, 8, False);
  makeborder(2,  0, 0, 9*charx+1,chary+1, True);
  makeborder(3,  0, 0, b-1,h-1, True);
  MyRequest := Requester(Nil,40,30,b,h,0,0,^ReqGad[1],^Bord[5],
                         ^ITxt[1],0,3,Nil,muell,Nil,Nil,Nil,muell);
  IF Request(^MyRequest,MyWindow) THEN BEGIN
    { Ereignisse abfragen }
    ende := False;
    REPEAT
      warte := Wait(-1);
      REPEAT              { Schleife, da mehrere Ereignisse möglich }
        MyMsg := Get_Msg(Upt);
        IF MyMsg <> Nil THEN BEGIN
          eventclass := MyMsg^.Class;
          gad := MyMsg^.IAddress;
          Reply_Msg(MyMsg);             { so schnell wie möglich antworten! }
          IF eventclass=REQSET THEN
            soso := ActivateGadget(^ReqGad[1],MyWindow,^MyRequest);
          IF eventclass=GADGETUP THEN
            CASE gad^.GadgetID OF
              1..4: soso := ActivateGadget(gad^.NextGadget,MyWindow,^MyRequest);
              6: genehmigt := True;
              7: genehmigt := False;
              OTHERWISE;
            END;
          IF eventclass=REQCLEAR THEN ende := True;
        END;
      UNTIL MyMsg = Nil;
    UNTIL ende;
    IF genehmigt THEN BEGIN
      val(buf[1],pr0.z,i);
      val(buf[2],pr1.z,i);
      IF pr1.z=pr0.z THEN pr1.z := pr0.z + 1;
      IF pr1.z<pr0.z THEN BEGIN
        xz := pr0.z; pr0.z := pr1.z; pr1.z := xz;
      END;
      val(buf[3],skz,i);
      IF skz<=0 THEN skz := glatt(pr1.z-pr0.z);
      val(buf[4],xz,i);
      IF xz=0 THEN xz := 1;
      pr0.x := 0;
      pr1.x := abs(xz)*(pr1.z-pr0.z);
      val(buf[5],yz,i);
      IF yz=0 THEN yz := 1;
      pr0.y := 0;
      pr1.y := abs(yz)*(pr1.z-pr0.z);
      vektoren;
      gr_aendern := True;
    END;
  END;
END;

{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#  diverse Requester  #*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }

PROCEDURE infotext;
TYPE strarr=ARRAY[1..5] OF Str;
VAR texte: strarr;
    egal: Boolean;
    i,lmax: Integer;
BEGIN
  settitles(False);
  {$ if def DEUTSCH }
  texte := strarr('Autor: Wilhelm Nöker','Hertastr. 8 / D-44388 Dortmund',
           'Compiler: KICK-Pascal 2.12','von MAXON Computer',' Verstanden ');
  {$ else }
  texte := strarr('Author: Wilhelm Nöker','Hertastr. 8 / D-44388 Dortmund',
           'Compiler: KICK-Pascal 2.12','by MAXON Computer',' Roger ');
  {$ endif }
  lmax := 0; FOR i := 1 TO 4 DO
    IF lmax<Length(texte[i]) THEN lmax := Length(texte[i]);
  FOR i := 1 TO 4 DO
    ITxt[i] := IntuiText(2,1,JAM1,(2+lmax-Length(texte[i]))*charx DIV 2,
               i*(chary+2),Nil,texte[i],^ITxt[i+1]);
  ITxt[4].NextText := Nil;
  FOR i := 3 TO 4 DO
    ITxt[i].TopEdge := ITxt[i].TopEdge + chary DIV 2;
  ITxt[5] := Intuitext(2,1,JAM1,6,3,Nil,texte[5],Nil);
  egal := AutoRequest(MyWindow,^ITxt[1],Nil,^ITxt[5],0,0,
          (6+lmax)*charx,6*(chary+2)+30);
  settitles(True);
END;

PROCEDURE trunc_warning;
{ Informiert den Benutzer, daß nur ein Teil seiner Daten gelesen wurde }
TYPE strarr=ARRAY[1..3] OF Str;
VAR texte: strarr;
    egal: Boolean;
    meldung: chefstring;
    lmax,i,j: Integer;
BEGIN
  settitles(False);
  {$ if def DEUTSCH }
  meldung := 'nur '+IntStr(nx)+' × '+IntStr(ny)+' Daten gelesen!';
  texte := strarr('Zu große Datei,',meldung,' Hmm ');
  {$ else }
  meldung := 'read only '+IntStr(nx)+' × '+IntStr(ny)+' data!';
  texte := strarr('File too large,',meldung,' Oops ');
  {$ endif }
  lmax := 0; FOR i := 1 TO 2 DO
    IF lmax<Length(texte[i]) THEN lmax := Length(texte[i]);
  FOR i := 1 TO 2 DO
    ITxt[i] := IntuiText(2,1,JAM1,(2+lmax-Length(texte[i]))*charx DIV 2,
             i*(chary+2),Nil,texte[i],^ITxt[i+1]);
  ITxt[2].NextText := Nil;
  ITxt[3] := Intuitext(2,1,JAM1,6,3,Nil,texte[3],Nil);
  egal := AutoRequest(MyWindow,^ITxt[1],Nil,^ITxt[3],0,0,
          (6+lmax)*charx,5*(chary+2)+30);
  settitles(True);
END;

PROCEDURE simple_request(msgtext,buttontext: Str);
VAR egal: Boolean;
    b: Integer;
BEGIN
  settitles(False);
  ITxt[1] := IntuiText(2,1,JAM1,10,10,Nil,msgtext,Nil);
  ITxt[2] := IntuiText(2,1,JAM1,6,3,Nil,buttontext,Nil);
  egal := AutoRequest(MyWindow,^ITxt[1],Nil,^ITxt[2],0,0,
          (6+Length(msgtext))*charx,3*(chary+2)+30);
  settitles(True);
END;

PROCEDURE confirm_snap;
VAR vergiss: boolean;
BEGIN
  {$ if def DEUTSCH }
  simple_request('Abmessungen gemerkt',' Danke ');
  {$ else }
  simple_request('Snapshot confirmed',' Thanks ');
  {$ endif }
END;

PROCEDURE dosfehler(nr: integer);
VAR meldung: chefstring;
BEGIN
  {$ if def DEUTSCH }
  meldung := 'DOS-Fehler Nr. '+IntStr(nr);
  simple_request(meldung,' Verstanden ');
  {$ else }
  meldung := 'DOS-error no. '+IntStr(nr);
  simple_request(meldung,' I see ');
  {$ endif }
END;

FUNCTION intreq(vorgabe: Long; hinweis: str80): Long;
{ Requester öffnen und eine Integerzahl einlesen }
VAR ende,soso: boolean;
    warte,eventclass: Long;
    b,h: Word;
    buf: chefstring;
BEGIN
  intreq := vorgabe;
  buf := IntStr(vorgabe);
  ubuf := '';
  b := charx*length(hinweis)+30;  IF b<80+30  THEN b := 80+30;
  h := chary + 8 + 20;
  ITxt[1] := IntuiText(1,3,JAM1,15,6,Nil,hinweis,Nil);
  StrInf[1] := StringInfo(^buf,^ubuf,0,20,0,0,0,0,0,0,Nil,0,Nil);
  ReqGad[1] := Gadget(Nil,(b-80) div 2,chary+12,80,8,GADGHCOMP,
      RELVERIFY OR ENDGADGET OR _LONGINT OR STRINGRIGHT, STRGADGET OR REQGADGET,
      ^Bord[1], Nil,Nil,0,^StrInf[1],2,Nil);
  makeborder(1, -1,-1, 80, 8, False);
  makeborder(2,  0, 0, b-1,h-1, True);
  MyRequest := Requester(Nil,40,30,b,h,0,0,^ReqGad[1],^Bord[3],
                         ^ITxt[1],0,3,Nil,muell,Nil,Nil,Nil,muell);
  IF Request(^MyRequest,MyWindow) THEN BEGIN
    { Ereignisse abfragen }
    ende := False;
    REPEAT
      warte := Wait(-1);
      REPEAT              { Schleife, da mehrere Ereignisse möglich }
        MyMsg := Get_Msg(Upt);
        IF MyMsg <> Nil THEN BEGIN
          eventclass := MyMsg^.Class;
          Reply_Msg(MyMsg);             { so schnell wie möglich antworten! }
          IF eventclass=REQSET THEN
            soso := ActivateGadget(^ReqGad[1],MyWindow,^MyRequest);
          IF eventclass=REQCLEAR THEN ende := True;
        END;
      UNTIL MyMsg = Nil;
    UNTIL ende;
    intreq := StrInf[1].LongInt;
  END;
END;

PROCEDURE korridor_eing;
VAR eing: long;
BEGIN
  {$ if def DEUTSCH }
  eing := intreq(Round(100*gap),'Korridorbreite in %:');
  {$ else }
  eing := intreq(Round(100*gap),'Width of corridors, %:');
  {$ endif }
  IF abs(eing)<100 THEN
    gap := abs(eing)/100;
END;

{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*  Dateioperationen  #*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }

FUNCTION fileselect(was_los: str80; speichern: Boolean;
                                   VAR selected: str80): Boolean;
{ Benutzt (wenn vorhanden) den Filerequester der req.library }
VAR i,p,l: Integer;
    Msg: p_IntuiMessage;
    ende: Boolean;
    class: Long;
    b,h: Word;
    buf,ubuf: str80;
BEGIN
  fileselect := False;
  l := Length(selected);
  { selected in pfad und name spalten }
  p := 0; FOR i := 1 TO l DO
    IF selected[i] IN ['/',':'] THEN p := i;
  IF p=0 THEN pfad := '' ELSE pfad := Copy(selected,1,p);
  IF p=l THEN name := '' ELSE name := Copy(selected,p+1,l-p);
  IF ReqBase<>Nil THEN BEGIN  { *** "req.library" benutzen }
    WITH MyFileReq^ DO BEGIN
      VersionNumber := REQVERSION;
      Title := was_los;
      PathName := pfadname;   { Str-Zeiger auf meinen Puffer setzen }
      Dir := pfad;
      _File := name;
      WindowLeftEdge := 128;
      WindowTopEdge := 25;
      Flags := FRQABSOLUTEXYM;
      IF speichern THEN
        Flags := Flags OR FRQSAVINGM
      ELSE
        Flags := Flags OR FRQLOADINGM;
      Hide := '';
      Show := '#?'+ext;
      dirnamescolor := 2;
      devicenamescolor := 2;
    END;
    IF _FileRequester(MyFileReq) THEN BEGIN
      fileselect := True;
      selected := pfadname;
    END;
  END
END;

FUNCTION laden(name: str80): boolean;
{ Datei lesen, gibt bei Fehlern False zurück }
VAR i,j,result,k,hz: integer;
    zeile: Str80;
    dummy: Real;
    truncated: Boolean;
  FUNCTION auf_halde(zeile: str80): Str;
  VAR i: integer;
  BEGIN
    auf_halde := Ptr(^StrHalde[hz]);
    i := 0;
    REPEAT
      Inc(i);
      StrHalde[hz] := zeile[i];
      IF (hz<strspace) THEN Inc(hz);
    UNTIL (i=80) OR (zeile[i]=chr(0));
  END;
BEGIN
  SetPointer(MyWindow, ChipSpc[5], 16, 16, -6, 0);
  Reset(datei,name);
  result := IOResult;
  IF result=0 THEN BEGIN
    laden := True;
    hz := 1;    { Zeiger der String-Halde zurücksetzen }
    ReadLn(datei,titel);
    ReadLn(datei,einheit);
    ReadLn(datei,ny);
    FOR j := 1 TO ny DO BEGIN
      ReadLn(datei,zeile);
      IF j<=nmax THEN ytitel[j] := auf_halde(zeile);
    END;
    ReadLn(datei,nx);
    truncated := False;
    FOR i := 1 TO nx DO BEGIN
      ReadLn(datei,zeile);
      IF i<=nmax THEN xtitel[i] := auf_halde(zeile);
      FOR j := 1 TO ny DO IF (i>nmax) OR (j>nmax) THEN BEGIN
        ReadLn(datei,dummy); truncated := True;
      END ELSE
        ReadLn(datei,zr[i,j]);
      ReadLn(datei,zeile);
    END;
    IF nx>nmax THEN nx := nmax;
    IF ny>nmax THEN ny := nmax;
    best_guess; { Abmessungen und Skalenteilung einstellen }
    IF NOT eof(datei) THEN ReadLn(datei,zeile);
    IF zeile='INFO' THEN BEGIN
      { Parameter lesen }
      ReadLn(datei,pr0.z,skz,pr1.z);
      ReadLn(datei,pr1.x);
      ReadLn(datei,pr1.y);
      ReadLn(datei,modus);
      ReadLn(datei,gap);
      ReadLn(datei,i); schraeg := i<>0;
    END;
    Close(datei);
    vektoren;
    IF truncated THEN trunc_warning;
  END ELSE BEGIN
    dosfehler(result);
    laden := False;
  END;
  ClearPointer(MyWindow);
END;

FUNCTION speichern(name: str80): boolean;
{ Speichern, True, falls erfolgreich. }
VAR i,j,result: integer;
    dz: real;
BEGIN
  SetPointer(MyWindow, ChipSpc[5], 16, 16, -6, 0);
  Rewrite(datei,name);
  result := IOResult;
  IF result=0 THEN BEGIN
    speichern := True;
    WriteLn(datei,titel);
    WriteLn(datei,einheit);
    WriteLn(datei);
    WriteLn(datei,ny);
    FOR j := 1 TO ny DO WriteLn(datei,ytitel[j]);
    WriteLn(datei);
    WriteLn(datei,nx);
    FOR i := 1 TO nx DO BEGIN
      WriteLn(datei,xtitel[i]);
      FOR j := 1 TO ny DO WriteLn(datei,zr[i,j]);
      WriteLn(datei);
    END;
    { Einstellungen mit abspeichern }
    WriteLn(datei,'INFO');
    WriteLn(datei,pr0.z,' ',skz,' ',pr1.z,'  (z0 dz z1)');
    WriteLn(datei,pr1.x-pr0.x,'  (xlen)');
    WriteLn(datei,pr1.y-pr0.y,'  (ylen)');
    WriteLn(datei,modus:2,'  (mode)');
    WriteLn(datei,gap,'  (corridors)');
    WriteLn(datei,Ord(schraeg):2,'  (fancy texts)');
    Close(datei);
  END ELSE BEGIN
    dosfehler(result);
    speichern := False;
  END;
  ClearPointer(MyWindow);
END;

PROCEDURE force_extension(VAR name: str80);
{ An einen Dateinamen die Extension ext='.3D' anhängen, sofern sie noch nicht }
{ existiert. }
VAR konform: boolean;
    i: integer;
BEGIN
  konform := True;
  FOR i := 1 TO length(ext) DO
    IF upcase(ext[i]) <> upcase(name[length(name)-length(ext)+i]) THEN
      konform := False;
  IF NOT konform THEN
    name := name + ext;
END;

{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*# Initialisierungen #*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }

PROCEDURE varinit;
BEGIN
  ext := '.3D';
  schraeg := True;
  quickdraw := False;
  modus := 1;
  horiz := 2;   { x/y-Auflösung }
  vert := 2;
  gap := 0.2;   { Zwischenraum zwischen Säulen oder Bändern, 0..1 }
  grace := 2;
  rb := 2.0;    { Beobachterposition in bezogenen Kugelkoordinaten }
  phi := Pi/4;
  theta := Pi/4;
END;

PROCEDURE demodaten;
{ Demodatensatz erzeugen (reiner Unfug). }
VAR i,j: integer;
BEGIN
  filename := 'RAM:Demo.3D';
  titel := 'Star Trek (The Next Generation) cast characters';
  nx := 8;
  ny := 6;
  xtitel[1] := 'Jean-Luc';  xtitel[5] := 'Imzadi';
  xtitel[2] := 'Der Biker'; xtitel[6] := 'Weasley';
  xtitel[3] := 'Data';      xtitel[7] := 'Dr. Crusher';
  xtitel[4] := 'Geordie';   xtitel[8] := 'Microbrain';
  ytitel[1] := '1st Season';  ytitel[2] := '2nd Season';
  ytitel[3] := '3rd Season';  ytitel[4] := '4th Season';
  ytitel[5] := '5th Season';  ytitel[6] := '6th Season';
  pr0.x := 0; pr1.x := 240;
  pr0.y := 0; pr1.y := 180;
  pr0.z := 0; pr1.z := 200; skz := 50;
  einheit := 'Funny Moments';
  FOR i := 1 TO nx DO
    FOR j := 1 TO ny DO
      zr[i,j] := Round(150*Exp(-Sqr(j-2)/4)*Exp(-Sqr(i-4)/8))+Random(50);
  modus := 3;
  vektoren;
END;

{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*# System-Initialisierungen *#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }

PROCEDURE bilder;
{ Image-Strukturen initialisieren. Wichtig: Der ChipMem-Speicher ChipSpc[] }
{ muß bereits reserviert sein !!! }
{ WB 2.0-Farben: 00: grau, 01: schwarz, 10: weiß, 11: blau }
BEGIN
  ChipSpc[1]^ := WordArr40(
    %0000000000000001,%1111111100000000,
    %0000000000000111,%1111100100000000,
    %0000000000011111,%1110000100000000,
    %0000000001111111,%1000000100000000,
    %0000000111111110,%0000000100000000,
    %0000000111111000,%0000000100000000,
    %0000000001100000,%0000000100000000,
    %0000110000000000,%0000000100000000,
    %0000000000000000,%0000000100000000,
    %1111111111111111,%1111111100000000,
    %1000000000000000,%0100000000000000,
    %1000000000000001,%0000000000000000,
    %1000000000000100,%0000000000000000,
    %1000000000010000,%0000000000000000,
    %1000000001000000,%0000000000000000,
    %1000001100000000,%0000000000000000,
    %1000011111000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %0000000000000000,%0000000000000000 )
  Bild[1] := Image(0,1,24,10,2,ChipSpc[1],%11,%00,Nil);
  ChipSpc[2]^ := WordArr40(
    %0000000000000000,%0000000100000000,
    %0000011000000000,%0011100100000000,
    %0000111111000001,%1111000100000000,
    %0000000111101111,%1000000100000000,
    %0000000000111100,%0000000100000000,
    %0000000011100001,%1000000100000000,
    %0000001100000000,%0110000100000000,
    %0000010000000000,%0000100100000000,
    %0000000000000000,%0000000100000000,
    %1111111111111111,%1111111100000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %0000000000000000,%0000000000000000 )
  Bild[2] := Image(0,1,24,10,2,ChipSpc[2],%11,%00,Nil);
  ChipSpc[3]^ := WordArr40(
    %0000000000000000,%0000000100000000,
    %0000001111000011,%1100000100000000,
    %0000001111011011,%1100000100000000,
    %0000011111111111,%1110000100000000,
    %0000011111111111,%1110000100000000,
    %0000001111011011,%1100000100000000,
    %0000011111000011,%1110000100000000,
    %0000011111100111,%1110000100000000,
    %0000000000000000,%0000000100000000,
    %1111111111111111,%1111111100000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %1000000101001001,%0100000000000000,
    %1000000000001000,%0000000000000000,
    %1000000000001000,%0000000000000000,
    %1000000000001000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %0000000000000000,%0000000000000000 )
  Bild[3] := Image(0,1,24,10,2,ChipSpc[3],%11,%00,Nil);
  ChipSpc[4]^ := WordArr40(
    %0000000000000000,%0000000100000000,
    %0000000111111100,%0000000100000000,
    %0000011100000111,%0000000100000000,
    %0000110001000001,%1000000100000000,
    %0000110011000001,%1000000100000000,
    %0000110000000001,%1000000100000000,
    %0000011100000111,%0000000100000000,
    %0000000111111100,%0000000100000000,
    %0000000000000000,%0000000100000000,
    %1111111111111111,%1111111100000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %1000000001000000,%0000000000000000,
    %1000000011000000,%0000000000000000,
    %1000000000000000,%0000000000000000,
    %1000000000000000,%1000000000000000,
    %1000000000000001,%1110000000000000,
    %1000000000000000,%0111100000000000,
    %1000000000000000,%0000000000000000 )
  Bild[4] := Image(0,1,24,10,2,ChipSpc[4],%11,%00,Nil);
  ChipSpc[5]^ := WordArr40(
      $0000,$0000,
      $0400,$07C0,$0000,$07C0,$0100,$0380,$0000,$07E0,
      $07C0,$1FF8,$1FF0,$3FEC,$3FF8,$7FDE,$3FF8,$7FBE,
      $7FFC,$FF7F,$7EFC,$FFFF,$7FFC,$FFFF,$3FF8,$7FFE,
      $3FF8,$7FFE,$1FF0,$3FFC,$07C0,$1FF8,$0000,$07E0,
      $0000,$0000, 0,0,0,0   { Busy-Pointer, ist eigentlich WordArr36 ... }
    );
END;

PROCEDURE gadgetsetup(bleft,btop,bright,bbot: byte);
{ Gadgets aufbauen, Image-Strukturen müssen bereits initialisiert sein! }
{ Ihr Aussehen wird soweit möglich den angegebenen Randstärken des Fensters }
{ angepaßt. }
VAR i: Integer;
BEGIN
  { Gadgets in der Titelleiste }
  FOR i := 1 TO 4 DO BEGIN
    WinGad[i] := Gadget(^WinGad[i+1],-172+24*i,0, 24,11,
        GADGHCOMP OR GRELRIGHT OR GADGIMAGE,
        RELVERIFY OR GADGIMMEDIATE OR TOPBORDER, BOOLGADGET OR GZZGADGET,
        ^Bild[i], Nil,Nil,0,Nil, i, Nil);
    IF (btop=10) OR (btop=12) THEN BEGIN
      { Die beiden Fälle, in denen ein 11 Pixel hohes Gadget extrem mies }
      { aussehen würde (schließen den Fall Kick 1.3 mit ein ;-) }
      WinGad[i].Height := btop; Bild[i].Height := 9;
    END ELSE
      Bild[i].Height := 10;
  END;
  { Proportionalgadgets im rechten und unteren Rand }
  WinGad[5] := Gadget(^WinGad[6],-bright+2,btop,bright-2,-(btop+bbot)+1,
               GADGHCOMP OR GRELHEIGHT OR GRELRIGHT,
               GADGIMMEDIATE OR RIGHTBORDER,PROPGADGET OR GZZGADGET,
               ^MoveDat1,Nil,Nil,0,^PropInf1,5,Nil);
  PropInf1 := PropInfo(FREEVERT OR AUTOKNOB,$8000,$8000,0,$8000 DIV 5,
                       0,0,0,0,0,0);
  WinGad[6] := Gadget(Nil,bleft,-bbot+2,-(bleft+bright)+1,bbot-2,
               GADGHCOMP OR GRELWIDTH OR GRELBOTTOM,
               GADGIMMEDIATE OR BOTTOMBORDER,PROPGADGET OR GZZGADGET,
               ^MoveDat2,Nil,Nil,0,^PropInf2,6,Nil);
  PropInf2 := PropInfo(FREEHORIZ OR AUTOKNOB,$8000,$8000,$8000 DIV 5,0,
                       0,0,0,0,0,0);
END;

{ *** ein paar Routinen für die Menüs: }

PROCEDURE AddMenu (dx: Integer; name: Str);
VAR m: p_Menu;
    it: IntuiText;
    x: Integer;
BEGIN
  x := dx;
  IF LastMenu<>Nil THEN x := x + LastMenu^.LeftEdge + LastMenu^.Width;
  it := IntuiText(0, 1, JAM1, 0, 0, MyWindow^.WScreen^.Font, name, Nil);
  New (m);
  m^ := Menu(Nil, x, 0, IntuiTextLength(^it) + 8,
               MyWindow^.WScreen^.Font^.ta_YSize, MENUENABLED,
               name, Nil, 0, 0, 0, 0);
  IF LastMenu=Nil THEN Strip := m
    ELSE LastMenu^.NextMenu := m;
  LastMenu := m; LastItem := Nil;
END;

PROCEDURE AddItem (dy: Integer;  Flag: Word;  name: Str;  Com: Char);
VAR i: p_MenuItem;
    t: p_IntuiText;
    w,y: Integer;
BEGIN
  IF LastMenu=Nil THEN Error('MenItem without Menu!');
  y := dy;
  IF LastItem<>Nil THEN y := y + LastItem^.TopEdge + LastItem^.Height;
  New(i); New(t);
  IF com>' ' THEN Flag := Flag OR COMMSEQ;
  t^ := IntuiText(0,1, JAM1, 2,1, MyWindow^.WScreen^.Font, name, Nil);
  w := IntuiTextLength(t);
  i^ := MenuItem(Nil, 0,y, w + 4,MyWindow^.WScreen^.Font^.ta_YSize + 2,
                 Flag OR ITEMTEXT OR ITEMENABLED OR HIGHCOMP,
                 0, t, Nil, Com, Nil, 0);
  IF LastItem=Nil THEN LastMenu^.FirstItem := i
    ELSE LastItem^.NextItem := i;
  LastItem := i; LastSubItem := Nil;
END;

PROCEDURE AddSubItem (dy: Integer; Flag: Word; name: Str;  Com: Char);
VAR s: p_MenuItem;
    t: p_IntuiText;
    w,y: Integer;
BEGIN
  IF LastItem=Nil THEN Error('SubItem without MenItem');
  y := dy;
  IF LastSubItem<>Nil THEN y := y + LastSubItem^.TopEdge + LastSubItem^.Height;
  New(s); New(t);
  If com>' ' THEN Flag := Flag OR COMMSEQ;
  t^ := IntuiText(0,1, JAM1, 2,1, MyWindow^.WScreen^.Font, name, Nil);
  w := IntuiTextLength(t);
  s^ := MenuItem(Nil, LastItem^.Width-12, y, w+4,MyWindow^.WScreen^.Font^.ta_YSize + 2,
                   Flag OR ITEMTEXT OR ITEMENABLED OR HIGHCOMP,
                   0, t, Nil, Com, Nil, 0);
  IF LastSubItem=Nil THEN LastItem^.SubItem := s
    ELSE LastSubItem^.NextItem := s;
  LastSubItem := s;
END;

PROCEDURE MutEx(exc: LongInt);
VAR i: p_MenuItem;
BEGIN
  i := LastItem;
  IF i=Nil THEN Error('no Item for MutEx');
  IF LastSubItem<>Nil THEN i := LastSubItem;
  i^.MutualExclude := exc;
  i^.Flags := i^.Flags AND NOT MENUTOGGLE;
END;

PROCEDURE ItEnable(really: Boolean);
VAR i: p_MenuItem;
BEGIN
  i := LastItem;
  IF i=Nil THEN Error('no Item for ItEnable');
  IF LastSubItem<>Nil THEN i := LastSubItem;
  IF NOT really THEN
    i^.Flags := i^.Flags AND NOT ITEMENABLED;
END;

PROCEDURE CalcMenuWidth(f: p_MenuItem);
{ alle Einträge einer Menüspalte auf gleiche Breite bringen }
VAR i: p_MenuItem;
    t: p_IntuiText;
    max, w: Integer;
BEGIN
  i := f;
  max := 8;
  WHILE i<>Nil DO BEGIN
    t := i^.ItemFill;
    w := 2 + IntuiTextLength(t) + t^.LeftEdge;
    IF i^.Flags AND COMMSEQ<>0 THEN w := w + 48;
    IF w>max THEN max := w;
    i := i^.NextItem;
  END;
  i := f;
  WHILE i<>Nil DO BEGIN
    i^.Width := max
    i := i^.NextItem
  END;
END;

PROCEDURE MenuWidths;
{ CalcMenuWidth auf alle Menüs und Untermenüs anwenden }
VAR m: p_Menu;
    i: p_MenuItem;
BEGIN
  m := Strip;
  WHILE m<>Nil DO BEGIN
    i := m^.FirstItem;
    IF i<>Nil THEN CalcMenuWidth(i);
    WHILE i<>Nil DO BEGIN
      IF i^.SubItem<>Nil THEN
        CalcMenuWidth(i^.SubItem);
      i := i^.NextItem;
    END;
    m := m^.NextMenu;
  END;
END;

PROCEDURE create_menu;
CONST chk = CHECKIT OR MENUTOGGLE;
      chkon = chk OR CHECKED;
VAR egal: Boolean;
BEGIN
  LastMenu := Nil;
  {$ if def DEUTSCH }
  AddMenu(10, 'Projekt');
    AddItem(0, 0, 'Öffnen',          'O'); ItEnable(ReqBase<>Nil);
    AddItem(0, 0, 'Sichern',         'S');
    AddItem(0, 0, 'Sichern als ...', 'A'); ItEnable(ReqBase<>Nil);
    AddItem(5, 0, 'Ende',            'Q');
    AddItem(0, 0, 'Sichern & Ende',  'X');
    AddItem(5, 0, 'Info',            '?');
  AddMenu(20, 'Daten');
    AddItem(0, 0, 'Achsen tauschen',    ' ');
    AddItem(5, 0, 'Zeilen spiegeln',    ' ');
    AddItem(0, 0, 'Spalten spiegeln',   ' ');
    AddItem(5, 0, 'Zeile verschieben',  'L');
    AddItem(0, 0, 'Spalte verschieben', 'C');
  AddMenu(20, 'Darstellung');
    AddItem(0, chkon, '  Netz',         ' '); MutEx(%1110);
    AddItem(0, chk,   '  Zeilenbänder', ' '); MutEx(%1101);
    AddItem(0, chk,   '  Spaltenbänder',' '); MutEx(%1011);
    AddItem(0, chk,   '  Säulen',       ' '); MutEx(%0111);
    AddItem(5, 0,     'Abmessungen  »', ' ');
      AddSubItem(0, 0,  'ändern',       'M');
      AddSubItem(0, 0,  'optimal',      ' ');
      AddSubItem(0, 0,  'merken',       ' ');
      AddSubItem(0, 0,  'zurückholen',  ' ');
    AddItem(0, 0,     'Korridore',      'K');
    AddItem(0, chk,   '  3D-Schrift',   ' ');
    AddItem(5, 0,     'Zeichnen',       'D');
    AddItem(0, 0,     'Abbruch',        'H');
    AddItem(0, 0,     'Refreshs als  »', ' ');
      AddSubItem(0, chkon, '  Skizze',  '0'); MutEx(%10);
      AddSubItem(0, chk,   '  Vollbild','+'); MutEx(%01);
  AddMenu(20, 'Extras');
    AddItem(0, chkon, '  Interlace',   'I');
    AddItem(0, 0,     'Farben  »',     ' ');
      AddSubItem(0, 0,  'Palette',     'P'); ItEnable(ReqBase<>Nil);
      AddSubItem(0, 0,  'Workbench',   ' ');
      AddSubItem(0, 0,  'Default',     ' ');
    AddItem(0, 0,     'Font ...',      'F'); ItEnable(ReqBase<>Nil);
  {$ else }
  AddMenu(10, 'Project');
    AddItem(0, 0, 'Open',        'O'); ItEnable(ReqBase<>Nil);
    AddItem(0, 0, 'Save',        'S');
    AddItem(0, 0, 'Save as ...', 'A'); ItEnable(ReqBase<>Nil);
    AddItem(5, 0, 'Quit',        'Q');
    AddItem(0, 0, 'Save & Quit', 'X');
    AddItem(5, 0, 'About',       '?');
  AddMenu(20, 'Data');
    AddItem(0, 0, 'Swap Axes',      ' ');
    AddItem(5, 0, 'Mirror Lines',   ' ');
    AddItem(0, 0, 'Mirror Columns', ' ');
    AddItem(5, 0, 'Move Line',      'L');
    AddItem(0, 0, 'Move Column',    'C');
  AddMenu(20, 'Display');
    AddItem(0, chkon, '  Surface',     ' '); MutEx(%1110);
    AddItem(0, chk,   '  Lines',       ' '); MutEx(%1101);
    AddItem(0, chk,   '  Columns',     ' '); MutEx(%1011);
    AddItem(0, chk,   '  Fields',      ' '); MutEx(%0111);
    AddItem(5, 0,     'Dimensions  »', ' ');
      AddSubItem(0, 0,  'Enter',       'M');
      AddSubItem(0, 0,  'Find Best',   ' ');
      AddSubItem(0, 0,  'Snapshot',    ' ');
      AddSubItem(0, 0,  'Recall',      ' ');
    AddItem(0, 0,     'Corridors',     'K');
    AddItem(0, chk,   '  Fancy Texts', ' ');
    AddItem(5, 0,     'Draw',          'D');
    AddItem(0, 0,     'Halt',          'H');
    AddItem(0, 0,     'Auto Redraw as  »', ' ');
      AddSubItem(0, chkon, '  Sketch', '0'); MutEx(%10);
      AddSubItem(0, chk,   '  Diagram','+'); MutEx(%01);
  AddMenu(20, 'Outfit');
    AddItem(0, chkon, '  Interlace', 'I');
    AddItem(0, 0,     'Colors  »',   ' ');
      AddSubItem(0, 0,  'Palette',   'P'); ItEnable(ReqBase<>Nil);
      AddSubItem(0, 0,  'Workbench', ' ');
      AddSubItem(0, 0,  'Default',   ' ');
    AddItem(0, 0,     'Font ...',    'F'); ItEnable(ReqBase<>Nil);
  {$ endif }
  MenuWidths;
  egal := SetMenuStrip(MyWindow,Strip);
END;

PROCEDURE clear_menu;
{ Die Arbeit von create_menu rückgängig machen }
VAR m, m2: p_Menu;
    i, i2: p_MenuItem;
    t:     p_IntuiText;
BEGIN
  IF Strip<>Nil THEN ClearMenuStrip(MyWindow);
  m := Strip;
  WHILE m<>Nil DO BEGIN
    i := m^.FirstItem;
    WHILE i<>Nil DO BEGIN
      i2 := i;
      t := i^.ItemFill;
      i := i^.NextItem;
      Dispose(t);
      Dispose(i2)
    END;
    m2 := m;
    m := m^.NextMenu;
    Dispose(m2)
  END;
  LastMenu := Nil; Strip := Nil;
END;

PROCEDURE sysclean;
{ Das Werk von sysinit rückgängig machen, wird bei Programmende aufgerufen. }
VAR i: Integer;
BEGIN
  FOR i := 1 TO 5 DO BEGIN
    IF ChipSpc[i]<>Nil THEN Free_Mem(Long(ChipSpc[i]),SizeOf(WordArr40));
    ChipSpc[i] := Nil;
  END;
  IF IntuitionBase<>Nil THEN CloseLibrary(IntuitionBase);
  IF GfxBase<>Nil THEN CloseLibrary(GfxBase);
  IF ReqBase<>Nil THEN BEGIN
    PurgeFiles(MyFileReq);
    CloseLibrary(ReqBase);
  END;
  IF MyFileReq<>Nil THEN Free_Mem(Long(MyFileReq),SizeOf(ReqFileRequester));
  MyFileReq := Nil;
  IntuitionBase := Nil; GfxBase := Nil; ReqBase := Nil;
END;

PROCEDURE screenclean;
{ Das Werk von screeninit rückgängig machen, wird bei jeder Screenmode- }
{ Umschaltung aufgerufen. }
VAR egal: word;
BEGIN
  IF oldwindowptr<>Nil THEN myprocess^.pr_WindowPtr := oldwindowptr;
  IF MyWindow<>Nil THEN BEGIN
    egal := RemoveGList(MyWindow,^WinGad[1],6);
    clear_menu; Strip := Nil;
    CloseWindow(MyWindow);
    MyWindow := Nil;
  END;
  IF MyScreen<>Nil THEN IF CloseScreen(MyScreen) THEN; MyScreen := Nil;
  IF armem<>Nil THEN FreeRaster(armem,breite,hoehe); armem := Nil;
END;

PROCEDURE sysinit;
{ Libraries öffnen, Programmstart-Argumente auswerten, Gadgetbilder aufbauen }
VAR i,j,len: integer;
    s: str80;
    hail: p_WBStartup;
    arg: p_WBArg;
    olddir: BPTR;
BEGIN
  { zuerst Zeiger für den zugehörigen ExitServer initialisieren: }
  FOR i := 1 TO 5 DO ChipSpc[i] := Nil; MyFileReq := Nil;
  IntuitionBase := Nil; GfxBase := Nil; ReqBase := Nil;
  { Filerequester-Struktur anlegen, muß mit Nullen vorbesetzt sein! }
  MyFileReq := Ptr(Alloc_Mem(SizeOf(ReqFileRequester),MEMF_CLEAR));
  { Intuition-Version >= 1.2, da ich z. B. ActivateGadget() benutze: }
  IntuitionBase := OpenLibrary('intuition.library',33);
  GfxBase := OpenLibrary('graphics.library',0);
  ReqBase := OpenLibrary('req.library',0);
  IF IntuitionBase=Nil THEN  Error('You need intuition.library V33+!');
  IF GfxBase=Nil THEN  Error('Can''t open graphics.library ... hm?');
  IF ReqBase=Nil THEN  {desaster('Can''t open req.library !!!')};
  { Bei fehlender req.library werden nur ein paar Menues gesperrt ... }
  FOR i := 1 TO 5 DO
    ChipSpc[i] := Ptr(Alloc_Mem(SizeOf(WordArr40),MEMF_CHIP));
  bilder;
  filename := '';
  IF fromWB THEN BEGIN                    { WB-Start }
    hail := StartupMessage;
    arg := hail^.sm_ArgList;
    olddir := CurrentDir(arg^.wa_Lock);   { ins richtige Verzeichnis wechseln }
    IF hail^.sm_NumArgs>1 THEN BEGIN      { mit Argumentdateien gestartet? }
      { auf nächsten WBArg-Zeiger zugreifen: }
      arg := Ptr(Long(arg)+SizeOf(WBArg));
      olddir := CurrentDir(arg^.wa_Lock);
      filename := arg^.wa_Name;
    END;
  END ELSE BEGIN                          { CLI-Start }
    len := ParameterLen; IF len >79 THEN len := 79;
    s := Copy(ParameterStr,1,len);
    { eigentlichen Dateinamen herausfinden (von Trennzeichen eingeschlossen: }
    i := 1; WHILE (s[i]<=' ') AND (i<=len) DO Inc(i);
    j := i; WHILE (s[i]>' ') AND (j<=len) DO Inc(j);
    IF s[i]='"' THEN BEGIN { in "" eingeschlossener Name }
      Inc(i); j := i; WHILE (s[j]<>'"') AND (j<=len) DO Inc(j);
    END;
    IF j>i THEN BEGIN
      filename := Copy(s,i,j-i); force_extension(filename);
    END;
  END;
END;

FUNCTION RASSIZE (w,h : Long) : Long;  { tolle 3.1-Includes :-P }
BEGIN
 RASSIZE:=(h*((w+15) DIV 8) AND $FFFE);
END;

PROCEDURE screeninit;
{ Screen, Window, Menue und Gadgets installieren }
VAR flags, pen, egal: Word;
    theGfxBase: p_GfxBase;
BEGIN
  { zuerst Zeiger für den zugehörigen ExitServer initialisieren: }
  MyScreen := Nil; armem := Nil; MyWindow := Nil; Con := Nil; Strip := Nil;
  oldwindowptr := Nil;
  { DrawInfo-Pens für den Screen angeben, damit die Fenster darauf unter }
  { 2.0 gut aussehen. Programm ist trotzdem unter 1.3 lauffähig! (Trick: Die }
  { ExtNewScreen-Struktur, die von 1.3 für eine gewönliche NewScreen-Struktur }
  { gehalten wird, da das Flag NS_EXTENDED für 1.3 keine Bedeutung hat.) }
  pen := $FFFF; { Zeichen für "der Rest nach Default" }
  NSTags[1] := TagItem(SA_Pens,Long(^pen));
  NSTags[2] := TagItem(TAG_DONE,0);
  theGfxBase := GfxBase;
  breite := theGfxBase^.NormalDisplayColumns * horiz DIV 2;
  flags := GENLOCK_VIDEO
  IF horiz=2 THEN flags := flags OR HIRES;
  IF vert=2 THEN  flags := flags OR LACE;
  topazAttr := TextAttr('topaz.font',8,FS_NORMAL,FPF_ROMFONT);
  NeuerScreen := ExtNewScreen(0,0,breite,STDSCREENHEIGHT,2,0,1,flags,
       NS_EXTENDED OR CUSTOMSCREEN,Nil,'Graph3D-Screen',Nil,Nil,^NSTags[1]);
  MyScreen := OpenScreen(^NeuerScreen);
  IF MyScreen = Nil THEN Error('Cannot open screen!');
  charx := MyScreen^.RastPort.TxWidth;  { Screenfont, für Text in Requestern }
  chary := MyScreen^.RastPort.TxHeight;
  baseline := MyScreen^.RastPort.TxBaseline;
  hoehe := MyScreen^.Height;
  NeuesWindow := NewWindow(0,MyScreen^.BarHeight+1,breite,
      hoehe-MyScreen^.Barheight-1,2,1, GADGETUP OR GADGETDOWN OR _CLOSEWINDOW
      OR MENUPICK OR NEWSIZE OR REQCLEAR OR REQSET,
      ACTIVATE OR WINDOWSIZING OR WINDOWCLOSE OR WINDOWDEPTH OR WINDOWDRAG
      OR SIZEBRIGHT OR SIZEBBOTTOM OR GIMMEZEROZERO,
      Nil, Nil, 'Graph3D',MyScreen,Nil,220,100,breite,hoehe,CUSTOMSCREEN);
  MyWindow := OpenWindow(^NeuesWindow);
  IF MyWindow = Nil THEN Error('Cannot open window!');
  create_menu;
  Rast := MyWindow^.RPort;
  Upt := MyWindow^.Userport;
  gadgetsetup(MyWindow^.BorderLeft,MyWindow^.BorderTop,MyWindow^.BorderRight,
    MyWindow^.BorderBottom);
  egal := AddGList(MyWindow,^WinGad[1],1,6,Nil);
  RefreshGadgets(^WinGad[1],MyWindow,Nil);
  armem := AllocRaster(breite,hoehe);  { Speicher fuer Areas }
  IF armem=Nil THEN Error('Cannot allocate temporary raster!');
  InitArea(^MyAreaInfo,^areabuffer[1],100);
  Rast^.TmpRas := InitTmpRas(^tmp,armem,RASSIZE(breite,hoehe));
  Rast^.AreaInfo := ^MyAreaInfo;
  { meine Task finden und System Requests auf meinen Screen umleiten }
  myprocess := ptr(FindTask(Nil));
  oldwindowptr := myprocess^.pr_WindowPtr;
  myprocess^.pr_WindowPtr := MyWindow;
END;

{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#* Ereignisverarbeitung #*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }

FUNCTION wrongviewmode: boolean;
{ Stellt fest, ob der momentan offene Screen die gewünschte vertikale }
{ Auflösung hat. }
VAR is_laced: boolean;
BEGIN
  is_laced := (MyScreen^.ViewPort.Modes AND LACE)<>0;
  wrongviewmode := ((vert=1) AND is_laced) OR ((vert=2) AND NOT is_laced);
END;

PROCEDURE check(m,i,s: Integer; really: Boolean);
VAR it: p_MenuItem;
    code: Long;
BEGIN
  code := m + (i SHL 5) + (s SHL 11);
  it := ItemAddress(Strip,code);
  IF really THEN
    it^.Flags := it^.Flags OR CHECKED
  ELSE
    it^.Flags := it^.Flags AND NOT CHECKED;
END;

FUNCTION has_check(m,i,s: Integer): Boolean;
VAR it: p_MenuItem;
    code: Long;
BEGIN
  code := m + (i SHL 5) + (s SHL 11);
  it := ItemAddress(Strip,code);
  has_check := (it^.Flags AND CHECKED)<>0;
END;

PROCEDURE write_checks;
{ Variablen ins Menue übertragen }
VAR i: integer;
BEGIN
  check(2,6,-1, schraeg);
  FOR i := 1 TO 4 DO
    check(2,i-1,-1, (i = modus));
  check(3,0,-1, (vert=2));
  check(2,9,0, quickdraw);
  check(2,9,1, NOT quickdraw);
END;

PROCEDURE check_checks;
{ Menuehäkchen in Programmvariablen übernehmen }
VAR i: integer;
    egal: boolean;
BEGIN
  schraeg := has_check(2,6,-1);
  modus := 1;
  FOR i := 1 TO 4 DO
    IF has_check(2,i-1,-1) THEN modus := i;
  IF has_check(3,0,-1) THEN vert := 2 ELSE vert := 1;
  quickdraw := has_check(2,9,0);
END;

PROCEDURE menuhandling(item: word);
{ Menu-Handhabung }
VAR men,menitem,subitem: integer;
    item_address: ^MenuItem;
    hallo: long;
    update: Boolean;
    tryname: str80;
BEGIN
  update := False;
  WHILE item<>MENUNULL DO BEGIN
    { item nach Menue, Menuepunkt und Untermenue aufschlüsseln }
    men := item AND $1F;
    menitem := (item SHR 5) AND $3F;
    subitem := (item SHR 11) AND $1F;
    { und schon mal zum nächsten vorrücken: }
    item_address := ItemAddress(Strip,item);
    item := item_address^.NextSelect;
    IF men=0 THEN       { 1. Menue: Projekt }
      CASE menitem OF
        0: BEGIN
            tryname := filename;
            IF fileselect('Tabellendaten einlesen',False,tryname) THEN
              IF laden(tryname) THEN BEGIN
                filename := tryname; write_checks; update := True;
              END;
          END;
        1: IF NOT speichern(filename) THEN;
        2: BEGIN
            tryname := filename;
            IF fileselect('Daten und Parameter sichern',True,tryname) THEN BEGIN
              force_extension(tryname);
              IF speichern(tryname) THEN filename := tryname;
            END;
          END;
        3: ende := True;
        4: IF speichern(filename) THEN ende := True;
        5: infotext;
      OTHERWISE;
      END;
    IF men=1 THEN BEGIN      { 2. Menue: Daten }
      update := True;
      CASE menitem OF
        0: BEGIN swapxy; write_checks; END;
        1: mirrorx;
        2: mirrory;
        3: update := move_row(True);
        4: update := move_row(False);
        OTHERWISE;
      END;
    END;
    IF men=2 THEN       { 3. Menue: Darstellung }
      CASE menitem OF
        0..3: update := True;
        4: CASE subitem OF
             0: IF gr_aendern THEN update := bereichstest;
             1: BEGIN best_guess; update := True; END;
             2: BEGIN merken; confirm_snap; END;
             3: BEGIN erinnern; update := bereichstest; END;
           OTHERWISE;
           END;
         5: BEGIN korridor_eing; update := True; END;
         6: update := True;
         7: BEGIN darstellen; update := False; END;
      OTHERWISE;
      END;
    IF men=3 THEN       { 4. Menue: Extras }
      CASE menitem OF
        1: CASE subitem OF
             0: IF ReqBase<>Nil THEN hallo := ColorRequester(0);
             1: clonecolors;
             2: defcolors;
             OTHERWISE;
           END;
        OTHERWISE;
      END;
  END;
  IF update THEN refresh;
END;

PROCEDURE gadgetprimaer(g:p_Gadget);
{ Ereignisse bei GADGETDOWN }
VAR MyInfo: ^PropInfo;
    alt: real;
BEGIN
  IF g<>Nil THEN
    CASE g^.GadgetID OF
      3: IF rb<20 THEN BEGIN    { wegzoomen }
          rb := rb * 1.3; vektoren; skizze;
        END;
      4: IF rb>0.5 THEN BEGIN   { ranzoomen }
          rb := rb / 1.3; vektoren; skizze;
        END;
      5: BEGIN   { vertikale Beobachterposition aus Prop übernehmen }
        MyInfo := g^.SpecialInfo;
        REPEAT
          alt := theta; theta := (MyInfo^.VertPot*Pi/2)/MAXPOT;
          IF theta<>alt THEN BEGIN vektoren; zentriere; skizze; END;
        UNTIL (g^.flags AND SELECTED) = 0;
        refresh;
      END;
      6: BEGIN   { dasselbe für horizontale Beobachterposition }
        MyInfo := g^.SpecialInfo;
        REPEAT
          alt := phi; phi := (MyInfo^.HorizPot*Pi/2)/MAXPOT;
          IF phi<>alt THEN BEGIN vektoren; zentriere; skizze; END;
        UNTIL (g^.flags AND SELECTED) = 0;
        refresh;
      END;
      OTHERWISE;
    END;
END;

PROCEDURE gadgetfolge(g:p_Gadget);
{ Ereignisse bei GADGETUP }
BEGIN
  IF g<>Nil THEN
    CASE g^.GadgetID OF
      1: darstellen;
      2: skizze;
      3,4: refresh;   { wegzoomen/ranzoomen abschließen }
      OTHERWISE;
    END;
END;

{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#  Hauptprogramm  #*#*#*#*#*#*#*#*#*#*#*#*#*#* }
{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }

VAR l,eventclass: Long;
    address: Ptr;
    code: Word;

BEGIN
  varinit;
  AddExitServer(sysclean); sysinit;
  AddExitServer(screenclean); screeninit;
  defcolors;
  IF filename='' THEN
    demodaten
  ELSE IF NOT laden(filename) THEN
    demodaten;
  write_checks;
  refresh;
  merken;
  ende := False;
  REPEAT
    l := Wait(-1);
    REPEAT              { Schleife, da mehrere Ereignisse möglich }
      check_checks;     { Häkchen auslesen, bevor eine Aktion stattfindet }
      MyMsg := Get_Msg(Upt);
      IF MyMsg<>Nil THEN BEGIN
        eventclass := MyMsg^.Class;
        code := MyMsg^.Code;
        address := MyMsg^.IAddress;
        Reply_Msg(MyMsg);             { so schnell wie möglich antworten! }
        CASE eventclass OF
          _CLOSEWINDOW:
            ende := True;
          NEWSIZE:
            refresh;
          GADGETDOWN:
            gadgetprimaer(address);
          GADGETUP:
            gadgetfolge(address);
          MENUPICK:
            menuhandling(code);
        OTHERWISE;
        END;
      END;
    UNTIL MyMsg = Nil;
    IF wrongviewmode THEN BEGIN
      screenclean; screeninit;   { neuen Screen mit/ohne Interlace öffnen }
      writepalette; write_checks; refresh;
    END;
  UNTIL ende;
  screenclean; sysclean;
END.