home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / zweidim.pas < prev   
Pascal/Delphi Source File  |  1987-03-13  |  11KB  |  243 lines
  1. {---------------------------------------------------------------------------}
  2. {       Programm zur zweidimensionalen Darstellung von Matrizen             }
  3. {---------------------------------------------------------------------------}
  4.  
  5. PROGRAM ZweiDim (Input, Output);
  6.  
  7. CONST xmax = 72;                                { maximal (xmax+1)*(ymax+1) }
  8.       ymax = 72;                                { Punkte der Bildmatrix.    }
  9.  
  10. TYPE xi   = 1..xmax;                                 { (xi+1)*(yi+1) Punkte }
  11.      yi   = 1..ymax;                                 { der Bildmatrix.      }
  12.      bild = ARRAY[0..xmax,0..ymax] OF REAL;          { die Bildmatrix.      }
  13.      art  = (gs,hl,zv);                              { Darstellungsarten.   }
  14.  
  15. VAR bx: xi;
  16.     by: yi;
  17.     f: bild;                                                   { Bildmatrix }
  18.     h1, h2 : REAL;                       { untere und obere Intervallgrenze }
  19.     ptrinit: STRING;                   { Druckerinitialisierung fuer Grafik }
  20.     px, py : INTEGER;                     { Druckerpunkte pro Zeile, Spalte }
  21.     c      : CHAR;                                        { Index fuer Menu }
  22.  
  23. {---------------------------------------------------------------------------}
  24. {           Darstellung einer dreidimensionalen Flaeche durch:
  25.   Druckerausgabe des Bildes f[0..bx,0..by] im Intervall z = h1 ... h2
  26.   a: mit Graustufen, Hoehenlinien oder Zufallsverfahren
  27.   px, py geben die Bildabmessungen in Druckerpunkten an
  28.          (px <= dmax, py sollte durch 8 teilbar sein)
  29.   Init wird zu Beginn jeder Druckerzeile gesendet                           }
  30.  
  31. PROCEDURE ZweiD (VAR f: bild;          { Bildmatrix                         }
  32.                      bx: xi; by: yi;   { linke und untere Grenze des Bildes }
  33.                      h1, h2: REAL;     { Intervallgrenzen f. Bilderzeugung  }
  34.                      a: art;           { Art der Darstellung                }
  35.                      px, py: INTEGER;  { Bildabmessung in Druckerpunkte     }
  36.                      Init: STRING);    { Initialisierung des Druckers       }
  37.  
  38. CONST dmax = 960;                     { maximale Punktzahl pro Druckerzeile }
  39.       rmax = $FFFFFF;   { Groesstmoegliche Zahl des Zufallszahlengenerators }
  40.       nh   = 10;                  { nh + 1 Hoehenlinien im Intervall h1..h2 }
  41.  
  42. VAR db: ARRAY[1..dmax] OF BYTE;                         { eine Druckerzeile }
  43.     ha: ARRAY[1..dmax] OF INTEGER;      { Vorgaengerzeile fuer Hoehenlinien }
  44.     m1, m2, m3: BYTE;                                         { Punktmuster }
  45.     pb, dz,                                 { Pixel pro Byte, Druckerzeilen }
  46.     nx, ny,                                       { Pixel in x-, y-Richtung }
  47.     i, j, k,                                                { Laufvariablen }
  48.     ih, iha,               { Hoehe, Hoehe des Vorgaengers fuer Hoehenlinien }
  49.     x0, x1, xa,                                  { x-Indizes der Bildmatrix }
  50.     y0, y1,                                      { y-Indizes der Bildmatrix }
  51.     i1, i2           : INTEGER;        { Indizes im Feld db fuer Graustufen }
  52.     fx, fy, fz,                                         { Massstabsfaktoren }
  53.     xd, yd, zd,                              { Koordinaten der Druckerpixel }
  54.     x, y, ye,                                     { xd-x0, yd-y0, 1-(yd-y0) }
  55.     k0, k1           : REAL;               { Groessen zur Berechnung von zd }
  56.  
  57.   {-------------------------------------------------------------------------}
  58.   {               Zufallszahlengenerator fuer Atari ST:                     }
  59.  
  60.   FUNCTION Random: LONG_INTEGER;
  61.   XBios(17);
  62.  
  63.   {-------------------------------------------------------------------------}
  64.  
  65. BEGIN { ZweiD }
  66.                          { Berechnung der Normierungsfaktoren fx, fy und fz
  67.                            sowie der Drucker-Pixelzahlen nx und ny:         }
  68.   CASE a OF
  69.     gs: BEGIN pb := 4;  fz := 4/(h2-h1);  END;
  70.     zv: BEGIN pb := 8;  fz := rmax/(h2-h1);  END;
  71.     hl: BEGIN pb := 8;  fz := nh/(h2-h1);  END;
  72.   END;
  73.   nx := px*pb DIV 8;  ny := py*pb DIV 8;
  74.   fx := bx/nx;        fy := by/ny;
  75.   dz := py DIV 8;
  76.                { Initialisierung des Vorgaengerfeldes ha fuer Hoehenlinien: }
  77.   xd := 0.5*fx;
  78.   IF a = hl THEN
  79.     FOR i := 1 TO nx DO
  80.     BEGIN
  81.       x0 := Trunc(xd);  x := xd-x0;  x1 := Succ(x0);  xd := xd+fx;
  82.       ha[i] := Trunc(fz*((1-x)*f[x0,by]+x*f[x1,by]-h1)+1);
  83.     END;
  84.   ReWrite(Output, 'PRN:');                   { Ausgabe auf Drucker umleiten }
  85.   xa := MaxInt;
  86.   FOR j := 0 TO Pred(dz) DO        { Hauptschleife ueber alle Druckerzeilen }
  87.   BEGIN
  88.     FOR i := 1 TO px DO db[i] := 0;                 { Druckerzeile loeschen }
  89.              { Punktmuster fuer oberstes Bildpixel der Druckerzeile setzen: }
  90.     m1 := 64;  m2 := 128;  m3 := 192;
  91.     FOR k := 1 TO pb DO   { Schleife ueber alle Pixel in einer Druckerzeile }
  92.     BEGIN
  93.       yd := by-(pb*j+k-0.5)*fy;  xd := 0.5*fx;
  94.       y0 := Trunc(yd);           y1 := Succ(y0);
  95.       y  := yd-y0;               ye := 1-y;
  96.               { Initialisierung des Vorgaengerwertes iha fuer Hoehenlinien: }
  97.       IF a = hl THEN
  98.         iha := Trunc(fz*(ye*f[0,y0]+y*f[0,y1]-h1)+1);
  99.  
  100.       { Schleife ueber alle horizontal nebeneinanderliegenden Druckerpixel: }
  101.       FOR i := 1 TO nx DO
  102.       BEGIN
  103.         x0 := Trunc(xd);  x := xd-x0;
  104.               { Neues bildpixel? Wenn ja, dann Neuberechnung von k0 und k1,
  105.                 sonst zd mit alten Werten von k0 und k1 berechnen           }
  106.         IF x0 <> xa THEN
  107.         BEGIN
  108.           xa := x0;                      x1 := Succ(x0);
  109.           k0 := ye*f[x0,y0]+y*f[x0,y1];  k1 := ye*f[x1,y0]+y*f[x1,y1]-k0;
  110.           k0 := k0-h1;
  111.         END;
  112.         zd := x*k1+k0;  xd:=xd+fx;
  113.                                  { der weitere Ablauf unterscheidet sich je
  114.                                    nach Darstellungsart gs, hl oder zv:     }
  115.         CASE a OF
  116.                             { Graustufen: je nach Pixelwert zd bis zu 4
  117.                                           Punkte in Druckerfeld db ausgeben }
  118.           gs: IF zd > 0 THEN
  119.               BEGIN
  120.                 i2 := i+i;  i1 := Pred(i2);
  121.                 CASE Trunc(fz*zd) OF
  122.                   0: db[i2] := db[i2]+m1;
  123.                   1: BEGIN
  124.                        db[i1] := db[i1]+m2;  db[i2] := db[i2]+m1;
  125.                      END;
  126.                   2: BEGIN
  127.                        db[i1] := db[i1]+m1;  db[i2] := db[i2]+m3;
  128.                      END;
  129.                   3: BEGIN
  130.                        db[i1] := db[i1]+m3;  db[i2] := db[i2]+m3;
  131.                      END;
  132.                 END; { CASE Trunc }
  133.               END;
  134.                                 { Zufallsverfahren: Pixelwert zd mit
  135.                                                     Zufallswert vergleichen }
  136.           zv: IF zd > 0 THEN
  137.                 IF fz*zd > Random THEN
  138.                   db[i] := db[i]+m2;
  139.                                 { Hoehenlinien: Pixelwert zd mit oberem und
  140.                                                 linkem Nachbarn vergleichen }
  141.           hl: BEGIN
  142.                 ih := Trunc(fz*zd+1.0);
  143.                 IF ih <> iha THEN           { Vergleich mit linkem Nachbarn }
  144.                   IF (ih IN [1..nh]) OR (iha IN [1..nh]) THEN
  145.                     db[i] := db[i] | m2;       { |-Operator: bitweises Oder }
  146.                 IF ih <> ha[i] THEN         { Vergleich mit oberem Nachbarn }
  147.                   IF (ih IN [1..nh]) OR (ha[i] IN [1..nh]) THEN
  148.                     db[i] := db[i] | m2;
  149.                                  { Nachbarn fuer naechsten Punkt speichern: }
  150.                 iha := ih;  ha[i] := ih;
  151.               END;
  152.         END; { CASE a }
  153.       END; { FOR i }
  154.                       { Punktmuster fuer naechsttiefere Pixelzeile aendern: }
  155.       IF a = gs THEN
  156.         BEGIN
  157.           m1 := m1 DIV 4;  m2 := m2 DIV 4;  m3 := m3 DIV 4;
  158.         END
  159.       ELSE
  160.         m2 := m2 DIV 2;
  161.     END; { FOR k }
  162.                                { Drucker initialisieren und Zeile ausgeben: }
  163.     Write(Init);
  164.     FOR i:=1 TO px DO Write(Chr(db[i]));
  165.   END; { FOR j }
  166.   Page;                                                    { Seitenvorschub }
  167.   ReWrite(Output, 'CON:');              { Ausgabe wieder auf den Bildschirm }
  168. END; { ZweiD }
  169.  
  170. {---------------------------------------------------------------------------}
  171. {            Erzeugung einer beispielhaften Bildmatrix:                     }
  172.  
  173. PROCEDURE daten (VAR bx: xi; VAR by: yi; VAR f: bild);
  174.  
  175. VAR i, j, k       : INTEGER;
  176.     x, y, r, s, dx: REAL;
  177.     xx, mx, my, h : ARRAY[1..4] OF REAL;
  178.  
  179. BEGIN
  180.   WriteLn; WriteLn(' Berechnung der Bilddaten, bitte warten!');
  181.   bx := 50;  by := 50;  dx := 0.16;
  182.   mx[1] := 0.25*dx*bx;  my[1] := 0.25*dx*by;  h[1] := 11.5;
  183.   mx[2] := 0.50*dx*bx;  my[2] := 0.50*dx*by;  h[2] := -5.7;
  184.   mx[3] := 0.50*dx*bx;  my[3] := 0.75*dx*by;  h[3] := 11.3;
  185.   mx[4] := 0.75*dx*bx;  my[4] := 0.50*dx*by;  h[4] := 11.3;
  186.   FOR i := 0 TO bx DO
  187.   BEGIN
  188.     x := dx*i;
  189.     FOR k := 1 TO 4 DO xx[k] := Sqr(x-mx[k]);
  190.     FOR j := 0 TO by DO
  191.     BEGIN
  192.       y := dx*j;  s := 0;
  193.       FOR k := 1 TO 4 DO
  194.       BEGIN
  195.         r := xx[k]+Sqr(y-my[k]);
  196.         s := s+h[k]/(1+r);
  197.       END;
  198.       f[i,j] := s;
  199.     END;
  200.   END;
  201. END;
  202.  
  203. {---------------------------------------------------------------------------}
  204.  
  205. BEGIN { ZweiDim }
  206.   daten(bx, by, f);
  207.                                 { die Beispiele werden mit horizontal 640
  208.                                   und vertikal 576 Druckerpunkten gerechnet }
  209.   px := 640;  py := 576;
  210.                    { Druckerinitialisierung: Zeilenvorschub um 24/216 Zoll,
  211.                                              Druckkopf an linken Rand,
  212.                                              640 Punkte pro Zeile           }
  213.   ptrinit := Concat(#27, 'J', #24,
  214.                     #13,
  215.                     #27, '*', #4, Chr(px MOD 256), Chr(px DIV 256));
  216.                  { Schleife fuer das Menu, Bildschirm loeschen, Cursor ein: }
  217.   REPEAT
  218.     WriteLn(#27, 'e', #27, 'e');
  219.     WriteLn(' Druckerausgabe:');
  220.     WriteLn;
  221.     WriteLn(' G = Graustufen');
  222.     WriteLn(' H = Hoehenlinien');
  223.     WriteLn(' Z = Zufallsverfahren');
  224.     WriteLn;
  225.     WriteLn(' E = Ende');
  226.     WriteLn;  Write(' ');
  227.     Read(c);
  228.     IF c IN ['G','H','Z','g','h','z'] THEN
  229.     BEGIN
  230.       WriteLn;  WriteLn;
  231.       Write(' untere und obere Grenze h1 < h2 : ');
  232.       Read(h1, h2);
  233.       IF h1 < h2 THEN
  234.                 { Aufruf der Grafik-Prozedur mit entsprechenden Parametern: }
  235.         CASE c OF
  236.           'G', 'g': ZweiD(f, bx, by, h1, h2, gs, px, py, ptrinit);
  237.           'H', 'h': ZweiD(f, bx, by, h1, h2, hl, px, py, ptrinit);
  238.           'Z', 'z': ZweiD(f, bx, by, h1, h2, zv, px, py, ptrinit);
  239.         END;
  240.     END;
  241.   UNTIL c IN ['E','e'];
  242. END.
  243.