path: root/lang/dynamo/1.8.7/src/dyn.plot+

PACKET graphics DEFINES graphmode, 
                        attribut, 
                        palette, 
                        move, 
                        plot, 
                        draw line, 
                        draw linetype, 
                        color, 
                        draw to: 
 
 
(* Autor: Giffeler GD *) 
(* Datum: 31.03.1988  *) 
(* Schönbeck SHard    *) 
 
INT VAR linie :: -1, farbe :: 1, dummy; 
 
 
PROC attribut (INT CONST nr): 
 
(* 0..15 Vordergrundfarben fuer Textdarstellung    
   0..7  Hintergrundfarben                         
   Attribut fuer blinkende Darstellung (+128)   *) 
 
  control (-3, nr, 0, dummy) 
 
END PROC attribut; 
 
 
PROC palette (INT CONST nr): 
 
(* Farbauswahl fuer Grafikmodi *) 
 
  control (-4, 0, nr, dummy) 
 
END PROC palette; 
 
 
PROC graphmode (INT CONST mode): 
 
(*   0 -> TEXT 40*25 monochrom    
     2 ->      80*25              
     1 ->      40*25 farbig       
     3 ->      80*25              
     7 ->      80*25 Herkules     
     4 -> GRAFIK 320*200 farbig       
     5 ->                monochrom    
     6 ->        640*200              
    64 -> Olivetti 640*400 monochrom         
    72 ->                  kleine Schrift 
   512 -> Herkules 720*348 monochrom      *) 
 
  control (-5, mode, 0, dummy) 
 
END PROC graphmode; 
 
 
PROC draw linetype (INT CONST pen, color): 
 
(* Linienschraffur und Zeichenfarbe *) 
 
  linie:= pen; 
  farbe:= color; 
  control (-8, linie, farbe, dummy) 
 
END PROC draw linetype; 
 
 
PROC draw linetype (INT CONST nr): 
 
(* Ausschliessliche Aenderung der Linienschraffur *) 
 
  linie:= nr; 
  control (-8, linie, farbe, dummy) 
 
END PROC draw linetype; 
 
 
PROC color (INT CONST nr): 
 
(* Ausschliessliche Aenderung der Zeichenfarbe *) 
 
  farbe:= nr; 
  control (-8, linie, farbe, dummy) 
 
END PROC color; 
 
 
PROC move (INT CONST x, y): 
 
(* Bewegt Zeichencursor zu Koordinaten (0,0 = Links oben) *) 
 
  control (-7, x, y, dummy) 
 
END PROC move; 
 
 
PROC move (REAL CONST x, y): 
 
  control (-7, int(x+0.5), int(y+0.5), dummy) 
 
END PROC move; 
 
 
PROC draw to (INT CONST x, y): 
 
(* Zeichnet Gerade von momentaner Zeichencursorposition nach x,y *) 
 
  control (-6, x, y, dummy) 
 
END PROC draw to; 
 
 
PROC draw to (REAL CONST x, y): 
 
  control (-6, int(x+0.5), int(y+0.5), dummy) 
 
END PROC draw to; 
 
 
PROC draw line (INT CONST x1, y1, x2, y2): 
 
(* Zieht eine Linie von x1,y1 nach x2,y2 *) 
 
  plot (x1, y1); 
  draw to (x2, y2) 
 
END PROC draw line; 
 
 
PROC draw line (REAL CONST x1, y1, x2, y2): 
 
  plot (x1, y1); 
  draw to (x2, y2) 
 
END PROC draw line; 
 
 
PROC plot (INT CONST x, y): 
 
(* Zeichnet einen Punkt *) 
 
  control (-7, x, y, dummy); 
  control (-6, x, y, dummy) 
 
END PROC plot; 
 
 
PROC plot (REAL CONST x, y): 
 
  control (-7, int(x+0.5), int(y+0.5), dummy); 
  control (-6, int(x+0.5), int(y+0.5), dummy) 
 
END PROC plot; 
 
 
PROC draw to (INT CONST x, y, f): 
 
(* Zeichnet Gerade von momentaner Zeichencursorposition nach x,y *) 
 
  color (f); 
  control (-6, x, y, dummy) 
 
END PROC draw to; 
 
 
PROC draw to (REAL CONST x, y, INT CONST f): 
 
  color (f); 
  control (-6, int(x+0.5), int(y+0.5), dummy) 
 
END PROC draw to; 
 
 
PROC draw line (INT CONST x1, y1, x2, y2, f): 
 
(* Zieht eine Linie von x1,y1 nach x2,y2 *) 
 
  plot (x1, y1, f); 
  draw to (x2, y2) 
 
END PROC draw line; 
 
 
PROC draw line (REAL CONST x1, y1, x2, y2, INT CONST f): 
 
  plot (x1, y1, f); 
  draw to (x2, y2) 
 
END PROC draw line; 
 
 
PROC plot (INT CONST x, y, f): 
 
(* Zeichnet einen Punkt mit der Farbe f (0 = schwarz) *) 
 
  color (f); 
  control (-7, x, y, dummy); 
  control (-6, x, y, dummy) 
 
END PROC plot; 
 
 
PROC plot (REAL CONST x, y, INT CONST f): 
 
  color (f); 
  control (-7, int(x+0.5), int(y+0.5), dummy); 
  control (-6, int(x+0.5), int(y+0.5), dummy) 
 
END PROC plot 
 
 
END PACKET graphics; 
 
 
PACKET dynamo plotter plus DEFINES configurate plot, 
                                   initialize plot, 
                                   new plot line, 
                                   plot, 
                                   end of program, 
                                   stop request, 
                                   plot scale: 
 
(* DYNAMO Grafikausgabe           *) 
(* Autor : Giffeler GD            *) 
(* Datum : 29.04.1988, 03.06.1988 *) 
(* Änder.: Christian Szymanski    *) 
(*         21.07.88               *) 
 
 
LET max value         = 330, 
    value page length = 30, 
    max param numb    = 10, 
 
    PARAM = ROW value page length REAL, 
    BIG   = ROW 300 REAL, 
 
    max devices = 3, 
    SWITCH      = STRUCT (TEXT bezeichnung, INT on, off, 
                          zeichenbreite, zeichenhoehe, 
                          h offset, 
                          x, y, breite, hoehe), 
    SIZE        = ROW max devices SWITCH; 
 
 
TYPE PLOTPARAM = STRUCT (TEXT name, REAL lower bound, upper bound); 
 
 
ROW max param numb PLOTPARAM VAR plotparam; 
ROW max value REAL VAR value; 
 
BOOL VAR plt, ende; 
REAL VAR pltper, nextplot; 
INT VAR  value no, param no, plot line no, mode nr, plot param no, line no, 
         xp, yp; 
 
SIZE CONST table :: SIZE: 
           (SWITCH: ("CGA 640 * 200", 6, 2, 8, 8, 5, 4, 20, 615, 102), 
            SWITCH: ("HGC 720 * 348", 512, 0, 0, 0, 0, 0, 0, 0, 0), 
            SWITCH: ("OLI 640 * 400", 64, 2, 8, 16, 10, 4, 25, 615, 223)); 
 
configurate plot; (* Erster Aufruf nach der Insertierung *) 
 
 
PROC plot one page : 
INT VAR loop nr, n, m; 
PARAM VAR x, y; 
BIG VAR xr, yr; 
 
  kopfzeile ("Stuetzstellen:     ", TRUE); 
  xp:= 1; yp:= 19; 
  FOR loop nr FROM 1 UPTO plot param no REP 
    werte aus value in x und y uebertragen; 
    koordinatenkreuz (table[mode nr].x, table[mode nr].y, 
                      table[mode nr].breite, table[mode nr].hoehe); 
    x raster (table[mode nr].x, table[mode nr].y, 
              table[mode nr].breite, table[mode nr].hoehe, n); 
    zusatzinformationen ausgeben; 
    spline (n, m, 1, x, y, xr, yr); 
    draw picture (table[mode nr].x, table[mode nr].y, 
                  table[mode nr].breite, table[mode nr].hoehe, 
                  loop nr, m, 
                  plot param[loop nr].lower bound, 
                  plot param[loop nr].upper bound, 
                  xr, yr); 
    legende ausgeben 
  PER; 
  abbruch; 
  graphmode(table[mode nr].off). 
 
werte aus value in x und y uebertragen: 
INT CONST erh :: plot param no + 1; 
INT VAR z :: 1, w :: loop nr + 1; 
 
  FOR n FROM 1 UPTO value no DIV erh REP 
    x[n]:= value[z]; y[n]:= value[w]; 
    z INCR erh; 
    w INCR erh 
  PER; 
  n DECR 1; 
  m:= n * 10. 
 
zusatzinformationen ausgeben: 
TEXT CONST xn :: text(x[n]); 
 
  cursor (1, 17); put (x[1]); 
  cursor (81 - LENGTH xn, 17); 
  out (xn); 
  cursor (74, 1). 
 
legende ausgeben: 
INT VAR xph, yph; 
 
  cursor (xp, yp); 
  put (plot param[loop nr].name + "="); 
  put (plot param[loop nr].lower bound); 
  put ("-"); 
  put (plot param[loop nr].upper bound); 
  get cursor (xph, yph); 
  draw line (xph * table[mode nr].zeichenbreite -  8, 
             yph * table[mode nr].zeichenhoehe - table[mode nr].h offset, 
             xph * table[mode nr].zeichenbreite + 24, 
             yph * table[mode nr].zeichenhoehe - table[mode nr].h offset); 
  IF xp > 1 THEN line ELSE cursor (40, yph) FI; 
  get cursor (xp, yp). 
 
abbruch: 
TEXT VAR eingabe; 
 
  REP 
    cursor (30, 1); 
    put (39*" "+"(+, p, e)?"); 
    inchar (eingabe); 
    SELECT code (eingabe) OF 
      CASE 43     : eingabe:= "" 
      CASE 69, 101: ende:= TRUE; eingabe:= "" 
      CASE 80, 112: phasendiagramm 
    OTHERWISE out(""7"") 
    END SELECT 
  UNTIL eingabe = "" PER 
 
END PROC plot one page; 
 
 
PROC initialize plot (TEXT CONST h) : 
INT VAR c :: 1, typ; 
TEXT VAR sym, num; 
 
  ende:= FALSE; 
  pltper:= get pltper; 
  plot line no:= value page length; 
  nextplot:= 0.0; 
  value no:= 0; 
  line no:= 0; 
  plot param no:= 0; 
  kopfzeile zerlegen. 
 
kopfzeile zerlegen: 
  scan (h); 
  REP 
    next symbol (plot param[c].name); 
    next symbol (sym, typ); 
    IF sym = "(" THEN 
      next symbol (num); 
      next symbol (sym, typ); 
      IF sym = ")" THEN 
        plot param[c].name CAT ("(" + num + ")") 
      FI 
    FI; 
    WHILE typ < 7 CAND NOT (sym = "(" COR sym = ",") REP 
      next symbol (sym, typ) 
    PER; 
    IF typ < 7 CAND sym = "(" THEN 
      REP next symbol (sym) 
      UNTIL sym = "," PER; 
      REP next symbol (sym, typ) 
      UNTIL typ > 6 COR sym = "," COR sym = "/" PER 
    FI; 
    c INCR 1 
  UNTIL typ > 6 PER 
 
END PROC initialize plot; 
 
 
PROC plot scale (TEXT CONST id, INT CONST scale pointer, 
                 REAL CONST lower bound, upper bound, 
                 BOOL CONST l fixed scale, u fixed scale) : 
 
 plot param no INCR 1; 
 plot param[plot param no].lower bound:= lower bound; 
 plot param[plot param no].upper bound:= upper bound 
 
END PROC plot scale; 
 
 
PROC new plot line (REAL CONST time) : 
 
  plt:= time >= nextplot; 
  IF plt THEN 
    add (time); 
    line no INCR 1; 
    param no:= 0 
  FI; 
  WHILE time >= nextplot REP 
   nextplot INCR pltper 
  PER 
 
END PROC new plot line; 
 
 
PROC plot (REAL CONST r): 
 
  IF plt THEN 
    param no INCR 1; 
    add (r); 
    IF NOT ende CAND param no = plot param no AND 
                     line no = value page length THEN 
      plot one page; 
      value no:= 0; 
      line no:= 0 
    FI 
  FI 
 
END PROC plot; 
 
 
PROC add (REAL CONST r): 
 
  IF NOT ende THEN 
    value no INCR 1; 
    value[value no]:= r 
  FI 
 
END PROC add; 
 
 
PROC spline (INT CONST n, m, s, PARAM CONST x, y, BIG VAR xr, yr): 
 
{ Kubische Splineinterpolation 3. Grades; 2 fach Differenzierbar       } 
{ Quelle: Rita Schmidt, Hahn-Meitner-Institut für Kernforschung Berlin } 
{         "Spline-Prozeduren" (HMI-B 220)                              } 
{ Umsetzung & Modifikation: Giffeler GD, 13.04.1988, 22.04.1988        } 
 
{ n     = Anzahl der Stützstellen                                      } 
{ m     = Anzahl der zu berechnenden Funktionswerte                    } 
{ s     = Index des x-Startpunktes                                     } 
{ x     = x-Werte der Stützstellen (linear steigend)                   } 
{ y     = y-Werte der Stützstellen                                     } 
{ xr    = x-Werte der Punkte, an denen die Funktion berechnet werden   } 
{         soll                                                         } 
{ yr    = y-Werte der Punkte, an denen die Funktion berechnet werden   } 
{         soll                                                         } 
 
 
INT  CONST nn :: n - 1; 
REAL CONST steps :: (real(nn) * (x[2] - x[1])) / real(m - 1); 
 
PARAM VAR q, au; 
REAL  VAR hi, hk, hk1, dij, dim1j; 
INT   VAR k, kk, j, m1, m2, m3; 
 
  q[1]:= 0.0; 
  yr[1]:= x[s]; 
  FOR j FROM 2 UPTO m REP yr[j]:= yr[j - 1] + steps PER; 
  xr:= yr; 
  block 0; 
  FOR k FROM 2 UPTO nn REP block 1 PER; 
  FOR kk FROM 2 UPTO nn REP block 2 PER; 
  FOR j FROM 1 UPTO m REP block 3 PER. 
 
block 0: 
  au[1]:= (y[3] - y[2] - y[2] + y[1]) / ((x[2] - x[1]) * (x[3] - x[2])); 
  au[n]:= (y[n] - y[nn] - y[nn] + y[n - 2]) / 
          ((x[n] - x[nn]) * (x[nn] - x[n - 2])). 
 
block 1: 
INT CONST km1 :: k - 1, kp1 :: k + 1; 
 
  hk:= x[k] - x[km1]; 
  hk1:= x[kp1] - x[k]; 
  q[k]:=  - hk1 / (hk * (q[km1] + 2.0) + 2.0 * hk1); 
  au[k]:= (hk * au[km1] - 6.0 * ((y[kp1] - y[k]) / hk1 - (y[k] - 
          y[km1]) / hk)) * q[k] / hk1. 
 
block 2: 
  k:= nn - kk + 2; 
  au[k]:= q[k] * au[k + 1] + au[k]. 
 
block 3: 
  zeige benutzer das du noch lebst; 
  IF yr[j] < x[1] THEN 
    m1:= 1; 
    m2:= 2 
  ELIF yr[j] > x[n] THEN 
    m1:= n - 1; 
    m2:= n 
  ELSE 
    m1:= 1; 
    m2:= n; 
    wiederholung 
  FI; 
  dij:= x[m2] - yr[j]; 
  hi:= x[m2] - x[m1]; 
  dim1j:= x[m1] - yr[j]; 
  yr[j]:= 1.0 / 6.0 / hi * (au[m1] * dij ** 3 - au[m2] * dim1j ** 3 + 
          (6.0 * y[m1] - hi ** 2 * au[m1]) * dij - (6.0 * y[m2] - hi ** 2 
          * au[m2]) * dim1j). 
 
wiederholung: 
  REP 
    m3:= (m2 + m1) DIV 2; 
    IF yr[j] >= x[m3] THEN m1:= m3 ELSE m2:= m3 FI 
  UNTIL m2 - m1 = 1 PER. 
 
zeige benutzer das du noch lebst: 
  cout (j) 
 
END PROC spline; 
 
 
PROC phasendiagramm: 
REAL VAR l :: maxreal, u :: smallreal; 
BIG VAR x, y; 
INT VAR i, no1, no2; 
 
  IF plot param no > 1 THEN 
    partnerwahl; 
    werte aus value uebertragen; 
    kopfzeile ("Phasendiagramm", TRUE); 
    koordinatenkreuz (table[mode nr].x, table[mode nr].y, 
                      table[mode nr].breite, table[mode nr].hoehe+50); 
    draw picture (table[mode nr].x, table[mode nr].y, 
                  table[mode nr].breite, table[mode nr].hoehe+50, 
                  1, i-1, l, u, x, y); 
    legende 
  FI. 
 
partnerwahl: 
  kopfzeile ("Phasendiagramm", FALSE); 
  line (2); 
  FOR i FROM 1 UPTO plot param no REP 
    putline (text(i, 3) + " = " + plot param[i].name) 
  PER; 
  REP 
    cursor (1, plot param no +5); 
    put ("X-ACHSE:"); get (no1); 
    cursor (1, plot param no +5); 
    put ("Y-ACHSE:"); get (no2) 
  UNTIL no1 > 0 CAND no1 <= plot param no CAND 
        no2 > 0 CAND no2 <= plot param no CAND 
        no1 <> no2 PER. 
 
werte aus value uebertragen: 
INT CONST erh :: plot param no + 1; 
INT VAR n1 :: no1 + 1, n2 :: no2 + 1; 
 
  FOR i FROM 1 UPTO value no DIV erh REP 
    x[i]:= value[n1]; 
    y[i]:= value[n2]; 
    n1 INCR erh; 
    n2 INCR erh 
  PER. 
 
legende: 
  cursor (1, 23); 
  putline ("X-Achse: " + plot param[no1].name); 
  out     ("Y-Achse: " + plot param[no2].name) 
 
END PROC phasendiagramm; 
 
 
PROC draw picture (INT CONST x, y, xb, yb, schraffur, m, 
                   REAL VAR lower bound, upper bound, 
                   BIG CONST xr, yr): 
 
{ Ausgabe einer Funktionskurve                                         } 
{ Autor: Giffeler GD, 22.04.1988, 27.04.1988                           } 
 
{ x           = X-Position (oben links = 0)                            } 
{ y           = Y-Position (oben links = 0)                            } 
{ xb          = Ausgabebreite                                          } 
{ yb          = Ausgabehöhe                                            } 
{ schraffur   = Linienschraffur (1 - 10)                               } 
{ m           = Anzahl der Funktionswerte                              } 
{ lower bound = Unterer Grenzwert (maxreal wenn Grenze beliebig)       } 
{ upper bound = Oberer Grenzwert (smallreal wenn Grenze beliebig)      } 
{ xr          = Durch SPLINE erzeugte X-Werte                          } 
{ yr          = Durch SPLINE erzeugte Y-Werte                          } 
 
 
ROW 10 INT CONST linienarten :: ROW 10 INT: (-1, -256, 3855, -240, 
                                             21845, -1, -1, -1, -1, -1); 
 
REAL VAR lbx :: maxreal, ubx :: smallreal; 
INT VAR i; 
 
  minimum und maximum fuer x und y berechnen; 
  abmessungsparameter umwandeln; 
  spannweite errechnen; 
  linienschraffur bestimmen; 
  eine funktion ausgeben. 
 
minimum und maximum fuer x und y berechnen: 
  FOR i FROM 1 UPTO m REP 
    lower bound:= min (lower bound, yr[i]); 
    upper bound:= max (upper bound, yr[i]); 
    lbx:= min (lbx, xr[i]); 
    ubx:= max (ubx, xr[i]) 
  PER. 
 
abmessungsparameter umwandeln: 
REAL CONST xpos :: real (x), ypos :: real (y), 
           breite :: real (xb), hoehe :: real (yb). 
 
spannweite errechnen: 
REAL CONST sy :: (upper bound - lower bound) / hoehe, 
           sx :: (ubx - lbx) / breite. 
 
linienschraffur bestimmen: 
  draw linetype (linienarten [abs(schraffur) MOD 10]). 
 
eine funktion ausgeben: 
  move (xpos + (xr[1] - lbx) / sx, 
        ypos + hoehe - (yr[1] - lower bound) / sy); 
  FOR i FROM 2 UPTO m REP 
    drawto (xpos + (xr[i] - lbx) / sx, 
            ypos + hoehe - (yr[i] - lower bound) / sy) 
  PER 
 
END PROC draw picture; 
 
 
PROC koordinatenkreuz (INT CONST nx, ny, breite, hoehe): 
 
  anpassung; 
  rahmen; 
  pfeil oben; 
  pfeil rechts. 
 
anpassung: 
INT CONST x :: nx - 1, 
          y :: ny - 10, 
          b :: breite + 21, 
          h :: hoehe + 11. 
 
rahmen: 
  draw linetype (-1); 
  draw line (x, y, x, y + h); 
  draw to (x + b, y + h). 
 
pfeil oben: 
  draw line (x - 3, y + 4, x, y); 
  draw to (x + 3, y + 4). 
 
pfeil rechts: 
  draw line (x + b - 5, y + h - 2, x + b, y + h); 
  draw to (x + b - 5, y + h + 2) 
 
END PROC koordinatenkreuz; 
 
 
PROC x raster (INT CONST nx, ny, breite, hoehe, anzahl): 
REAL CONST y :: real (ny + hoehe + 2), 
           w :: real (breite) / real (anzahl); 
REAL VAR s :: real (nx); 
INT VAR i; 
 
  FOR i FROM 1 UPTO anzahl REP 
    s INCR w; 
    plot (s, y) 
  PER 
 
END PROC x raster; 
 
 
PROC configurate plot: 
(*
BOOL CONST cmd :: command dialogue; 
INT VAR i; 
 
  command dialogue (TRUE); 
  REP 
    bildschirmausgabe zur auswahl 
  UNTIL (mode nr <= max devices AND mode nr > 0) CAND 
        yes ("Eingabe richtig") PER; 
  command dialogue (cmd). 
 
bildschirmausgabe zur auswahl: 
  page; 
  putline ("CONFIGURATIONSTABELLE DYNAMO GRAFIK"); 
  line (2); 
  FOR i FROM 1 UPTO max devices REP 
    putline (text(i)+" -- "+table[i].bezeichnung) 
  PER; 
  line (2); 
  put ("Modus:"); 
  get (mode nr) 
 
*)
mode nr := 1.     (* CGA *)
END PROC configurate plot; 
 
 
PROC kopfzeile (TEXT CONST message, BOOL CONST grafik): 
 
  IF grafik THEN graphmode (table[mode nr].on) 
  ELSE graphmode (table[mode nr].off) FI; 
  out (""1"");                                     (* C.S. 21.07.88 *) 
  out ("DYNAMO 3.3+"); 
  cursor (79 - LENGTH message, 1); 
  out (message) 
 
END PROC kopfzeile; 
 
 
PROC end of program : 
 
  IF NOT ende CAND (value no DIV (plot param no + 1)) > 2 THEN 
    plot one page 
  FI 
 
END PROC end of program; 
 
 
BOOL PROC stop request: ende END PROC stop request 
 
 
END PACKET dynamo plotter plus