diff options
Diffstat (limited to 'app/mpg/1987/src/BASISPLT.ELA')
| -rw-r--r-- | app/mpg/1987/src/BASISPLT.ELA | 781 |
1 files changed, 781 insertions, 0 deletions
diff --git a/app/mpg/1987/src/BASISPLT.ELA b/app/mpg/1987/src/BASISPLT.ELA new file mode 100644 index 0000000..366f4a6 --- /dev/null +++ b/app/mpg/1987/src/BASISPLT.ELA @@ -0,0 +1,781 @@ +PACKET basis plot DEFINES (* Autor: H. Indenbirken *)
+ (* Stand: 30.12.84 *)
+(********************** Hardwareunabh„ngiger Teil *************************
+* *
+* *
+* Im Harwareunabh„ngigen Paket 'transformation' werden folgende *
+* Prozeduren definiert: *
+* Procedure : Bedeutung *
+* -------------------------------------------------------------------*
+* transform : Sie Prozedur projeziert einen dreidimensionalen *
+* Vektor (x,y,z) auf einen zweidimensionalen (h,v)*
+* set values : Mit dieser Prozedur werden die Projektionspara- *
+* meter gesetzt. *
+* size: Weltkoordinatenbereich *
+* ((xmin,xmax),(ymin,ymax),(zmin,zmax)) *
+* limits: Zeichenfl„che *
+* ((h min, h max), (v min, v max)) *
+* Bei Werten < 2.0 werden die Werte als *
+* Prozente interpretiert, ansonsten als *
+* cm-Gr”ssen. *
+* get values : šbergibt die aktuellen Werte *
+* new values : Vermerkt neue Werte *
+* *
+* *
+* drawing area : šbergibt die aktuelle Zeichengr”áe in Pixel. *
+* *
+* angles : a) alpha: Winkel der Y-Achse in Grad *
+* b) (x, y, z): karth. Projektionswinkel *
+* oblique : Schiefwinklige Projektion mit dem *
+* Normalenvektor (a, b). *
+* perspective : Perspektive mit dem Betrachtungsstandort *
+* (x, y, z). *
+* window : siehe set values, size *
+* viewport : siehe set values, limit *
+* view : siehe set values, angle *
+* oblique : Schiefwinklige Projektion *
+* orthographic : Orthografische Projektion *
+* perspective : Perspektivische Projektion *
+* *
+* *
+* box : Rahmen um die aktuelle Zeichenfl„che *
+* reset : L”scht alte verdeckte Linien *
+* hidden lines : Unterdrckt verdeckte Linien *
+* *
+* move : Positioniert auf (x, y, [z]) in Weltkoordinaten *
+* draw : Zeichnet eine Linie bis zum Punkt (x, y, [z]). *
+* move r : Positioniert (x, y, [z]) weiter *
+* draw r : Zeichnet (x, y, [z]) weiter *
+* move cm : Positioniert auf (x cm, y cm). *
+* draw cm : Zeichnet eine Linie bis (x cm, y cm) *
+* move cm r : Positioniert (x cm, y cm) weiter *
+* draw cm r : Zeichnet (x cm, y cm) weiter *
+* *
+* bar : Balken mit (hight, width, pattern) *
+* circle : Kreis(segment) mit (radius, from, to, pattern) *
+* *
+* where : Gibt die aktuelle Stiftposition (x, y, [z]) *
+* *
+* get cursor : Graphische Eingabe *
+* *
+* *
+****************************************************************************)
+
+ transform,
+ set values,
+ get values,
+ new values,
+ drawing area,
+
+ window,
+ viewport,
+ view,
+ oblique,
+ orthographic,
+ perspective,
+
+ box,
+ reset,
+ hidden lines,
+
+ move,
+ draw,
+ move r,
+ draw r,
+ move cm,
+ draw cm,
+ move cm r,
+ draw cm r,
+ bar,
+ circle,
+
+ where:
+
+BOOL VAR new limits :: TRUE, values new :: TRUE,
+ perspective projektion :: FALSE;
+INT VAR pixel hor, pixel vert;
+REAL VAR display hor, display vert, (* Anzahl der Pixel *)
+ size hor, size vert; (* Groesse des Bildschirms *)
+drawing area (size hor, size vert, pixel hor, pixel vert);
+display hor := real (pixel hor); display vert := real (pixel vert);
+
+REAL VAR h min limit :: 0.0, h max limit :: display hor,
+ v min limit :: 0.0, v max limit :: display vert,
+ h min :: 0.0, h max :: size hor,
+ v min :: 0.0, v max :: size vert,
+ hor relation :: display hor/size hor,
+ vert relation :: display vert/size vert,
+ relation :: size hor/size vert;
+
+ROW 5 ROW 5 REAL VAR p :: ROW 5 ROW 5 REAL :
+ (ROW 5 REAL : (1.0, 0.0, 0.0, 0.0, 0.0),
+ ROW 5 REAL : (0.0, 1.0, 0.0, 0.0, 0.0),
+ ROW 5 REAL : (0.0, 0.0, 1.0, 0.0, 0.0),
+ ROW 5 REAL : (0.0, 0.0, 0.0, 1.0, 0.0),
+ ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0));
+
+ROW 3 ROW 2 REAL VAR size d :: ROW 3 ROW 2 REAL :
+ (ROW 2 REAL : (0.0, 1.0),
+ ROW 2 REAL : (0.0, 1.0),
+ ROW 2 REAL : (0.0, 1.0)),
+ last size :: size d;
+ROW 2 ROW 2 REAL VAR limits d :: ROW 2 ROW 2 REAL :
+ (ROW 2 REAL : (0.0, relation),
+ ROW 2 REAL : (0.0, 1.0));
+ROW 4 REAL VAR angles d :: ROW 4 REAL : (0.0, 0.0, 0.0, 0.0);
+ROW 2 REAL VAR oblique d :: ROW 2 REAL : (0.0, 0.0);
+ROW 3 REAL VAR perspective d :: ROW 3 REAL : (0.0, 0.0, 0.0);
+REAL VAR size hor d := size hor, size vert d := size vert;
+INT VAR pixel hor d := pixel hor, pixel vert d := pixel vert;
+
+INT VAR i, j, k;
+
+BOOL OP = (ROW 3 ROW 2 REAL CONST l, r):
+ FOR i FROM 1 UPTO 3
+ REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2]
+ THEN LEAVE = WITH FALSE FI
+ PER;
+ TRUE
+END OP =;
+
+BOOL OP = (ROW 2 ROW 2 REAL CONST l, r):
+ FOR i FROM 1 UPTO 2
+ REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2]
+ THEN LEAVE = WITH FALSE FI
+ PER;
+ TRUE
+END OP =;
+
+BOOL OP = (ROW 2 REAL CONST l, r):
+ l [1] = r [1] AND l [2] = r [2]
+END OP =;
+
+BOOL OP = (ROW 3 REAL CONST l, r):
+ l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3]
+END OP =;
+
+BOOL OP = (ROW 4 REAL CONST l, r):
+ l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3] AND l [4] = r [4]
+END OP =;
+
+PROC oblique (REAL CONST a, b) :
+ set values (size d, limits d, angles d, ROW 2 REAL : (a, b), ROW 3 REAL : (0.0, 0.0, 0.0))
+END PROC oblique;
+
+PROC orthographic :
+ set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (0.0, 0.0, 0.0))
+END PROC orthographic;
+
+PROC perspective (REAL CONST cx, cy, cz) :
+ set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (cx, cy, cz))
+END PROC perspective;
+
+PROC window (BOOL CONST dev) :
+ new limits := dev
+END PROC window;
+
+PROC window (REAL CONST x min, x max, y min, y max) :
+ window (x min, x max, y min, y max, 0.0, 1.0)
+END PROC window;
+
+PROC window (REAL CONST x min, x max, y min, y max, z min, z max) :
+ set values (ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max),
+ ROW 2 REAL : (y min, y max),
+ ROW 2 REAL : (z min, z max)),
+ limits d, angles d, oblique d, perspective d)
+END PROC window;
+
+PROC viewport (REAL CONST h min, h max, v min, v max) :
+ set values (size d, ROW 2 ROW 2 REAL : (ROW 2 REAL : (h min, h max),
+ ROW 2 REAL : (v min, v max)),
+ angles d, oblique d, perspective d)
+END PROC view port;
+
+PROC view (REAL CONST alpha) :
+ set values (size d, limits d, ROW 4 REAL : (alpha, angles d(2), angles d (3), angles d (4)),
+ oblique d, perspective d)
+END PROC view;
+
+PROC view (REAL CONST phi, theta) :
+ set values (size d, limits d, ROW 4 REAL : (angles d(1), sind (theta) * cosd (phi),
+ sind (theta) * sind (phi), cosd (theta)),
+ oblique d, perspective d)
+END PROC view;
+
+PROC view (REAL CONST x, y, z) :
+ set values (size d, limits d, ROW 4 REAL : (angles d (1), x, y, z), oblique d, perspective d)
+END PROC view;
+
+set values (size d, limits d, angles d, oblique d, perspective d);
+
+PROC drawing area (REAL VAR min h, max h, min v, max v):
+ min h := h min limit; max h := h max limit;
+ min v := v min limit; max v := v max limit
+END PROC drawing area;
+
+BOOL PROC new values:
+ IF values new
+ THEN values new := FALSE;
+ TRUE
+ ELSE FALSE FI
+END PROC new values;
+
+PROC get values (ROW 3 ROW 2 REAL VAR size,
+ ROW 2 ROW 2 REAL VAR limits,
+ ROW 4 REAL VAR angles,
+ ROW 2 REAL VAR oblique,
+ ROW 3 REAL VAR perspective) :
+ size := size d;
+ limits := limits d;
+ angles := angles d;
+ oblique := oblique d;
+ perspective := perspective d;
+
+END PROC get values;
+
+PROC set values (ROW 3 ROW 2 REAL CONST size,
+ ROW 2 ROW 2 REAL CONST limits,
+ ROW 4 REAL CONST angles,
+ ROW 2 REAL CONST oblique,
+ ROW 3 REAL CONST perspective) :
+ drawing area (size hor, size vert, pixel hor, pixel vert);
+ display hor := real (pixel hor); display vert := real (pixel vert);
+ IF NOT same values
+ THEN values new := TRUE;
+ copy values;
+ set views;
+ check perspective projektion;
+ calc limits;
+ change projektion
+ FI .
+
+same values:
+ size hor d = size hor AND size vert d = size vert AND
+ pixel hor d = pixel hor AND pixel vert d = pixel vert AND
+ size d = size AND limits d = limits AND angles d = angles AND
+ oblique d = oblique AND perspective d = perspective .
+
+copy values :
+ size hor d := size hor;
+ size vert d := size vert;
+ pixel hor d := pixel hor;
+ pixel vert d := pixel vert;
+ size d := size;
+ limits d := limits;
+ angles d := angles;
+ oblique d := oblique;
+ perspective d := perspective .
+
+set views :
+ REAL VAR diagonale := sqrt (angles [2] * angles [2] +
+ angles [3] * angles [3] +
+ angles [4] * angles [4]),
+ projektion := sqrt (angles [2] * angles [2] +
+ angles [4] * angles [4]),
+ sin p, cos p, sin t, cos t, sin a, cos a;
+
+ IF diagonale = 0.0
+ THEN sin p := 0.0; cos p := 1.0;
+ sin t := 0.0; cos t := 1.0
+ ELIF projektion = 0.0
+ THEN sin p := angles [3] / diagonale;
+ cos p := projektion / diagonale;
+ sin t := 0.0; cos t := 1.0
+ ELSE sin p := angles [3] / diagonale;
+ cos p := projektion / diagonale;
+ sin t := angles [2] / projektion;
+ cos t := angles [4] / projektion
+ FI;
+
+ REAL VAR sin p sin t := sin p * sin t,
+ sin p cos t := sin p * cos t,
+ cos p sin t := cos p * sin t,
+ cos p cos t := cos p * cos t,
+
+ dx := size [1][2] - size [1][1],
+ dy := size [2][2] - size [2][1],
+ dz := size [3][2] - size [3][1],
+ norm az := oblique [1] ,
+ norm bz := oblique [2] ,
+ norm cx := perspective [1] / dx,
+ norm cy := perspective [2] / dy,
+ norm cz := perspective [3] / dz,
+ xx := - size [1][1] / dx * cos p sin t -
+ size [2][1] / dy * sin p +
+ size [3][1] / dz * cos p cos t;
+
+p := ROW 5 ROW 5 REAL :
+ (ROW 5 REAL : ( cos t / dx - cos p sin t / dx * norm az ,
+ - sin p sin t / dx - cos p sin t / dx * norm bz,
+ 0.0,
+ - cos p sin t / dx * norm cz,
+ 0.0 ),
+ ROW 5 REAL : ( - sin p / dy * norm az,
+ cos p / dy - sin p / dy * norm bz,
+ 0.0,
+ - sin p / dy * norm cz,
+ 0.0 ),
+ ROW 5 REAL : ( sin t / dz + cos p cos t / dz * norm az,
+ + sin p cos t / dz + cos p cos t / dz * norm bz,
+ 0.0,
+ cos p cos t / dz * norm cz,
+ 0.0 ),
+ ROW 5 REAL : (- norm cx, - norm cy, 0.0, 1.0, 0.0 ),
+ ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0));
+
+ IF angles (1) = 0.0
+ THEN set alpha as y vertical
+ ELSE sin a := sind (angles (1));
+ cos a := cosd (angles (1))
+ FI;
+
+ FOR j FROM 1 UPTO 5
+ REP REAL CONST p j 1 := p (j)(1);
+ p (j)(1) := p j 1 * cos a - p (j)(2) * sin a;
+ p (j)(2) := p j 1 * sin a + p (j)(2) * cos a
+ PER .
+
+set alpha as y vertical :
+ REAL VAR r := sqrt (p(2)(1)**2 + p(2)(2)**2);
+ IF r = 0.0
+ THEN sin a := 0.0;
+ cos a := 1.0
+ ELSE sin a :=-p(2)(1)/r;
+ cos a := p(2)(2)/r
+ FI .
+
+check perspective projektion:
+ perspective projektion := perspective [3] <> 0.0 .
+
+calc limits :
+ IF new limits
+ THEN calc two dim extrema;
+ IF all limits smaller than 2
+ THEN prozente
+ ELSE zentimeter FI
+ FI .
+
+calc two dim extrema :
+ h min := max real; h max :=-max real;
+ v min := max real; v max :=-max real;
+
+ extrema (size [1][1], size [2][1], size [3][1], h min, h max, v min, v max);
+ extrema (size [1][2], size [2][1], size [3][1], h min, h max, v min, v max);
+ extrema (size [1][2], size [2][2], size [3][1], h min, h max, v min, v max);
+ extrema (size [1][1], size [2][2], size [3][1], h min, h max, v min, v max);
+ extrema (size [1][1], size [2][1], size [3][2], h min, h max, v min, v max);
+ extrema (size [1][2], size [2][1], size [3][2], h min, h max, v min, v max);
+ extrema (size [1][2], size [2][2], size [3][2], h min, h max, v min, v max);
+ extrema (size [1][1], size [2][2], size [3][2], h min, h max, v min, v max) .
+
+all limits smaller than 2 :
+ limits (1)(2) < 2.0 AND limits (2)(2) < 2.0 .
+
+prozente :
+ h min limit := display hor * limits (1)(1)/relation;
+ h max limit := display hor * limits (1)(2)/relation;
+
+ v min limit := limits (2)(1) * display vert;
+ v max limit := limits (2)(2) * display vert .
+
+zentimeter :
+ h min limit := display hor * (limits (1)(1)/size hor);
+ h max limit := display hor * (limits (1)(2)/size hor);
+
+ v min limit := display vert * (limits (2)(1)/size vert);
+ v max limit := display vert * (limits (2)(2)/size vert) .
+
+change projektion :
+ REAL VAR sh := (h max limit - h min limit) / (h max - h min),
+ sv := (v max limit - v min limit) / (v max - v min),
+ dh := h min limit - h min*sh,
+ dv := v min limit - v min*sv;
+
+ FOR j FROM 1 UPTO 5
+ REP
+ p (j)(1) := p (j)(1) * sh;
+ p (j)(2) := p (j)(2) * sv
+ PER;
+ p (5)(1) := dh;
+ p (5)(2) := dv.
+END PROC set values;
+
+PROC transform (REAL CONST x, y, z, INT VAR h, v) :
+ disable stop;
+ IF perspective projektion
+ THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0);
+ h := int ((x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (4)(1))*w + p (5)(1));
+ v := int ((x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (4)(2))*w + p (5)(2))
+ ELSE h := int (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (5)(1));
+ v := int (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (5)(2));
+ FI;
+ IF is error
+ THEN h := -1;
+ v := -1;
+ clear error
+ FI
+END PROC transform;
+
+PROC extrema (REAL CONST x, y, z, REAL VAR h min, h max, v min, v max):
+ REAL VAR h, v;
+ IF perspective projektion
+ THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0);
+ h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) +p (4)(1))*w;
+ v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) +p (4)(2))*w
+ ELSE h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1));
+ v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2))
+ FI;
+
+ IF h < h min
+ THEN h min := h
+ ELIF h > h max
+ THEN h max := h FI;
+
+ IF v < v min
+ THEN v min := v
+ ELIF v > v max
+ THEN v max := v FI
+
+END PROC extrema;
+
+(**************************** Plot Prozeduren ****************************)
+LET empty = 0, {Punktmuster}
+ half = 1,
+ full = 2,
+ horizontal = 3,
+ vertical = 4,
+ cross = 5,
+ diagonal right = 6,
+ diagonal left = 7,
+ diagonal both = 8;
+
+LET POS = STRUCT (REAL x, y, z);
+POS VAR pos :: POS : (0.0, 0.0, 0.0);
+INT VAR h :: 0, v :: 0, new h :: 0, new v :: 0;
+BOOL VAR hidden :: FALSE;
+DATASPACE VAR ds :: nilspace;
+BOUND STRUCT (ROW 32764 INT akt, last) VAR maxima :: ds;
+
+
+PROC box :
+ move (int (h min limit+0.5), int (v min limit+0.5));
+ draw (int (h max limit+0.5), int (v min limit+0.5));
+ draw (int (h max limit+0.5), int (v max limit+0.5));
+ draw (int (h min limit+0.5), int (v max limit+0.5));
+ draw (int (h min limit+0.5), int (v min limit+0.5))
+END PROC box;
+
+PROC reset:
+ forget (ds);
+ ds := nilspace;
+ maxima := ds
+END PROC reset;
+
+PROC move (REAL CONST x, y) :
+ IF hidden
+ THEN maxima.last := maxima.akt FI;
+
+ transform (x, y, 0.0, h, v);
+ move (h, v);
+ pos := POS : (x, y, 0.0)
+END PROC move;
+
+PROC move (REAL CONST x, y, z) :
+ IF hidden
+ THEN maxima.last := maxima.akt FI;
+
+ transform (x, y, z, h, v);
+ move (h, v);
+ pos := POS : (x, y, z)
+END PROC move;
+
+PROC draw (REAL CONST x, y) :
+ IF hidden
+ THEN transform (x, y, 0.0, new h, new v);
+ vector (new h-h, new v-v)
+ ELSE transform (x, y, 0.0, h, v);
+ draw (h, v)
+ FI;
+ pos := POS : (x, y, 0.0)
+END PROC draw;
+
+PROC draw (REAL CONST x, y, z) :
+ IF hidden
+ THEN transform (x, y, z, new h, new v);
+ vector (new h-h, new v-v)
+ ELSE transform (x, y, z, h, v);
+ draw (h, v)
+ FI;
+ pos := POS : (x, y, z)
+END PROC draw;
+
+PROC move r (REAL CONST x, y) :
+ IF hidden
+ THEN maxima.last := maxima.akt FI;
+
+ transform (pos.x+x, pos.y+y, pos.z, h, v);
+ move (h, v);
+ pos := POS : (pos.x+x, pos.y+y, pos.z)
+END PROC move r;
+
+PROC move r (REAL CONST x, y, z) :
+ IF hidden
+ THEN maxima.last := maxima.akt FI;
+
+ transform (pos.x+x, pos.y+y, pos.z+z, h, v);
+ move (h, v);
+ pos := POS : (pos.x+x, pos.y+y, pos.z+z)
+END PROC move r;
+
+PROC draw r (REAL CONST x, y) :
+ IF hidden
+ THEN transform (pos.x+x, pos.y+y, pos.z, h, v);
+ vector (new h-h, new v-v)
+ ELSE transform (pos.x+x, pos.y+y, pos.z, h, v);
+ draw (h, v)
+ FI;
+ pos := POS : (pos.x+x, pos.y+y, pos.z)
+END PROC draw r;
+
+PROC draw r (REAL CONST x, y, z) :
+ IF hidden
+ THEN transform (pos.x+x, pos.y+y, pos.z+z, h, v);
+ vector (new h-h, new v-v)
+ ELSE transform (pos.x+x, pos.y+y, pos.z+z, h, v);
+ draw (h, v)
+ FI;
+ pos := POS : (pos.x+x, pos.y+y, pos.z+z)
+END PROC draw r;
+
+PROC move cm (REAL CONST x cm, y cm) :
+ IF hidden
+ THEN maxima.last := maxima.akt FI;
+
+ h := int (x cm*hor relation+0.5);
+ v := int (y cm*vert relation+0.5);
+ move (h, v)
+END PROC move cm;
+
+PROC draw cm (REAL CONST x cm, y cm) :
+ IF hidden
+ THEN vector (int (x cm*hor relation+0.5)-h, int (y cm*vert relation+0.5)-v)
+ ELSE h := int (x cm*hor relation+0.5);
+ v := int (y cm*vert relation+0.5);
+ draw (h, v)
+ FI
+END PROC draw cm;
+
+PROC move cm r (REAL CONST x cm, y cm) :
+ IF hidden
+ THEN maxima.last := maxima.akt FI;
+
+ h INCR int (x cm*hor relation+0.5);
+ v INCR int (y cm*vert relation+0.5);
+ move (h, v)
+END PROC move cm r;
+
+PROC draw cm r (REAL CONST x cm, y cm) :
+ IF hidden
+ THEN vector (int (x cm*hor relation+0.5), int (y cm*vert relation+0.5))
+ ELSE h INCR int (x cm*hor relation+0.5);
+ v INCR int (y cm*vert relation+0.5);
+ draw (h, v)
+ FI
+END PROC draw cm r;
+
+PROC hidden lines (BOOL CONST dev):
+ hidden := NOT dev;
+END PROC hidden lines;
+
+PROC vector (INT CONST dx, dy):
+ IF dx >= 0
+ THEN IF dy > dx THEN vector (v, h, dy, dx, 1, 1)
+ ELIF dy > 0 THEN vector (h, v, dx, dy, 1, 1)
+
+ ELIF dy > -dx THEN vector (h, v, dx, -dy, 1,-1)
+ ELSE vector (v, h, -dy, dx,-1, 1) FI
+
+ ELSE IF dy > -dx THEN vector (v, h, dy, -dx, 1,-1)
+ ELIF dy > 0 THEN vector (h, v, -dx, dy,-1, 1)
+
+ ELIF dy > dx THEN vector (h, v, -dx, -dy,-1,-1)
+ ELSE vector (v, h, -dy, -dx,-1,-1) FI
+ FI .
+
+ENDPROC vector ;
+
+PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) :
+ INT VAR i;
+ prepare first step ;
+ draw point;
+ FOR i FROM 1 UPTO dx
+ REP do one step PER;
+
+ IF was visible
+ THEN draw (h, v) FI .
+
+
+prepare first step :
+ INT VAR up right error := dy - dx,
+ right error := dy,
+ old error := 0,
+ last h :: h, last v :: v;
+ BOOL VAR was visible :: visible .
+
+
+do one step:
+ IF right is better
+ THEN do right step
+ ELSE do up right step
+ FI .
+
+right is better :
+ abs (old error + right error) < abs (old error + up right error) .
+
+do upright step :
+ x pos INCR right ;
+ y pos INCR up ;
+ draw point ;
+ old error INCR upright error .
+
+do right step :
+ x pos INCR right ;
+ draw point ;
+ old error INCR right error .
+
+draw point :
+ IF was visible
+ THEN IF NOT visible
+ THEN draw (last h, last v);
+ was visible := FALSE
+ FI;
+ last h := h;
+ last v := v
+ ELSE IF visible
+ THEN move (h, v);
+ was visible := TRUE;
+ last h := h;
+ last v := v
+ FI
+ FI .
+
+visible:
+ IF h < 1 OR h > pixel hor
+ THEN FALSE
+ ELSE IF maxima.akt [h] < v
+ THEN maxima.akt [h] := v FI;
+ v > maxima.last [h]
+ FI
+END PROC vector;
+
+PROC where (REAL VAR x, y) :
+ x := pos.x; y := pos.y
+END PROC where;
+
+PROC where (REAL VAR x, y, z) :
+ x := pos.x; y := pos.y; z := pos.z
+END PROC where;
+
+PROC bar (REAL CONST hight, width, INT CONST pattern):
+ INT VAR zero x, zero y, end x, end y;
+ transform (0.0, 0.0, 0.0, zero x, zero y);
+ transform (width, hight, 0.0, end x, end y);
+ bar (h-(end x-zero x) DIV 2, v, end x-zero x, end y-zero y, pattern)
+END PROC bar;
+
+PROC bar (INT CONST from x, from y, width, hight, pattern):
+ INT CONST to x :: from x+width, to y :: from y+hight;
+ INT VAR x, y;
+ draw frame;
+ SELECT pattern OF
+ CASE empty: (* nothing to do *)
+ CASE half: half bar
+ CASE full: full bar
+ CASE horizontal: horizontal bar
+ CASE vertical: vertical bar
+ CASE cross: horizontal bar;
+ vertical bar
+ CASE diagonal right: diagonal right bar
+ CASE diagonal left: diagonal left bar
+ CASE diagonal both: diagonal both bar
+ OTHERWISE errorstop ("Unknown pattern") ENDSELECT .
+
+draw frame:
+ move (from x, from y);
+ draw (from x, to y);
+ draw (to x, to y);
+ draw (to x, from y) .
+
+full bar:
+ FOR y FROM from y UPTO to y
+ REP move (from x, y);
+ draw (to x, y)
+ PER .
+
+half bar:
+ FOR y FROM from y UPTO to y
+ REP x := from x + 1 + (y AND 1);
+ WHILE x < to x
+ REP move (x, y);
+ draw (x, y);
+ x INCR 2
+ PER
+ PER .
+
+horizontal bar:
+ y := from y;
+ WHILE y < to y
+ REP move (from x, y);
+ draw (to x, y);
+ y INCR 5
+ PER .
+
+vertical bar:
+ x := from x + 5;
+ WHILE x < to x
+ REP move (x, from y);
+ draw (x, to y);
+ x INCR 5
+ PER .
+
+diagonal right bar:
+ y := from y-width+5;
+ WHILE y < to y
+ REP move (max (from x, to x-y-width+from y), max (from y, y));
+ draw (min (to x, from x+to y-y), min (to y, y+width));
+ y INCR 5
+ PER .
+
+diagonal left bar:
+ y := from y-width+5;
+ WHILE y < to y
+ REP move (min (to x, to x-from y+y), max (from y, y));
+ draw (max (from x, from x+y+width-to y), min (to y, y+width));
+ y INCR 5
+ PER .
+
+diagonal both bar:
+ y := from y-width+5;
+ WHILE y < to y
+ REP move (max (from x, to x-y-width+from y), max (from y, y));
+ draw (min (to x, from x+to y-y), min (to y, y+width));
+ move (min (to x, to x-from y+y), max (from y, y));
+ draw (max (from x, from x+y+width-to y), min (to y, y+width));
+ y INCR 5
+ PER .
+
+END PROC bar;
+
+PROC circle (REAL CONST r, from, to, INT CONST pattern):
+ REAL VAR t :: from;
+ WHILE t < to
+ REP transform (pos.x + r*cosd (t), pos.y + r*sind (t), 0.0, h, v);
+ draw (h, v);
+ t INCR 1.0
+ PER;
+ transform (pos.x, pos.y, 0.0, h, v);
+ draw (h, v) .
+
+END PROC circle;
+
+ENDPACKET basis plot;
|