From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 11 Feb 2019 11:49:19 +0100 Subject: Add source files from Michael --- app/mpg/1987/src/FUPLOT.ELA | 319 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 319 insertions(+) create mode 100644 app/mpg/1987/src/FUPLOT.ELA (limited to 'app/mpg/1987/src/FUPLOT.ELA') diff --git a/app/mpg/1987/src/FUPLOT.ELA b/app/mpg/1987/src/FUPLOT.ELA new file mode 100644 index 0000000..1d0d247 --- /dev/null +++ b/app/mpg/1987/src/FUPLOT.ELA @@ -0,0 +1,319 @@ +PACKET fuplot DEFINES axis, (*Autor : H.Indenbirken *) + plot, (*Stand : 23.02.85 *) + cube: + +PICTURE VAR pic; +TEXT VAR value text; + +PICTURE PROC cube (REAL CONST x min, x max, INT CONST no x, + REAL CONST y min, y max, INT CONST no y, + REAL CONST z min, z max, INT CONST no z): + cube (x min, x max, (x max-x min)/real (no x), + y min, y max, (y max-y min)/real (no y), + z min, z max, (z min-z max)/real (no z)) +END PROC cube; + +PICTURE PROC cube (REAL CONST x min, x max, dx, y min, y max, dy, z min, z max, dz): + pic := cube (x min, x max, y min, y max, z min, z max); + move (pic, x max, y min, z min); draw (pic, text (x max)); + move (pic, x min, y max, z min); draw (pic, text (y max)); + move (pic, x min, y min, z max); draw (pic, text (z max)); + + draw tabs (pic, x min, y min, z min, x max, y min, z min, dx, 0.0, 0.0); + draw tabs (pic, x min, y min, z min, x min, y max, z min, 0.0, dy, 0.0); + draw tabs (pic, x min, y min, z min, x min, y min, z max, 0.0, 0.0, dx); + pic +END PROC cube; + +PICTURE PROC cube (REAL CONST x min, x max, y min, y max, z min, z max): + pic := nilpicture; + move (pic, x min, y min, z min); + draw (pic, x max, y min, z min); + draw (pic, x max, y max, z min); + draw (pic, x min, y max, z min); + draw (pic, x min, y min, z min); + + move (pic, x min, y min, z max); + draw (pic, x max, y min, z max); + draw (pic, x max, y max, z max); + draw (pic, x min, y max, z max); + draw (pic, x min, y min, z max); + + move (pic, x min, y min, z min); + draw (pic, x min, y min, z max); + + move (pic, x max, y min, z min); + draw (pic, x max, y min, z max); + + move (pic, x max, y max, z min); + draw (pic, x max, y max, z max); + + move (pic, x min, y max, z min); + draw (pic, x min, y max, z max); + pic + +END PROC cube; + +PICTURE PROC axis (REAL CONST x min, x max, INT CONST no x, + REAL CONST y min, y max, INT CONST no y) : + axis (x min, x max, (x max-x min) / real (no x - 1), + y min, y max, (y max-y min) / real (no y - 1)) +END PROC axis; + +PICTURE PROC axis (REAL CONST x min, x max, dx, y min, y max, dy) : + REAL CONST x diff :: x max - x min, + y diff :: y max - y min; + pic := nilpicture; + calc axis pos; + IF dx > 0.0 + THEN x axis FI; + IF dy > 0.0 + THEN y axis FI; + pic . + +calc axis pos : + REAL VAR x0, y0; + IF x min < 0.0 AND x max < 0.0 + THEN y0 := y max + ELIF x min > 0.0 AND x max > 0.0 + THEN y0 := y max + ELSE y0 := 0.0 FI; + + IF y min < 0.0 AND y max < 0.0 + THEN x0 := x max + ELIF y min > 0.0 AND y max > 0.0 + THEN x0 := x max + ELSE x0 := 0.0 FI . + +x axis : + move (pic, x max, y0); + move cm r (pic, 0.1, -0.3); + draw (pic, "X"); + + draw tabs (pic, x0,y0, x max,y0, dx,0.0); + value text := text (x max); + draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text); + + draw tabs (pic, x0,y0, x min,y0,-dx,0.0); + value text := text (x min); + draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text) . + +y axis : + move (pic, x0, y max); + move cm r (pic, -0.18, 0.1); + draw (pic, "Y"); + + draw tabs (pic, x0,y0, x0,y max, 0.0, dy); + value text := text (y max); + draw (pic, length (value text) * ""8"" + value text); + + draw tabs (pic, x0,y0, x0,y min, 0.0,-dy); + value text := text (y min); + draw (pic, length (value text) * ""8"" + value text) . + +END PROC axis; + +PROC draw tabs (PICTURE VAR pic, REAL CONST x0,y0, x1,y1, dx,dy) : + move (pic, x0, y0); + draw (pic, x1, y1); + + REAL VAR x :: x0, y :: y0; + INT VAR i :: 0; + WHILE abs (x) <= abs (x1) AND abs (y) <= abs (y1) + REP move (pic, x, y); + IF dx <> 0.0 + THEN draw cm r (pic, 0.0, size) + ELIF dy <> 0.0 + THEN draw cm r (pic, size, 0.0) FI; + i INCR 1; + x INCR dx; y INCR dy + PER . + +size: + IF i MOD 10 = 0 + THEN -0.75 + ELIF i MOD 5 = 0 + THEN -0.5 + ELSE -0.3 FI . + +END PROC draw tabs; + +PICTURE PROC axis (REAL CONST x min, x max, INT CONST no x, + REAL CONST y min, y max, INT CONST no y, + REAL CONST z min, z max, INT CONST no z) : + axis (x min, x max, (x max-x min) / real (no x - 1), + y min, y max, (y max-y min) / real (no y - 1), + z min, z max, (z max-z min) / real (no z - 1)) +END PROC axis; + +PICTURE PROC axis (REAL CONST x min, x max, dx, + y min, y max, dy, + z min, z max, dz) : + REAL CONST x diff :: x max - x min, + y diff :: y max - y min, + z diff :: z max - z min; + pic := nilpicture; + calc axis pos; + IF dx > 0.0 + THEN x axis FI; + IF dy > 0.0 + THEN y axis FI; + IF dz > 0.0 + THEN z axis FI; + pic . + +calc axis pos : + REAL VAR x0, y0, z0; + IF x min < 0.0 AND x max < 0.0 + THEN y0 := y max + ELIF x min > 0.0 AND x max > 0.0 + THEN y0 := y max + ELSE y0 := 0.0 FI; + + IF y min < 0.0 AND y max < 0.0 + THEN x0 := x max + ELIF y min > 0.0 AND y max > 0.0 + THEN x0 := x max + ELSE x0 := 0.0 FI; + + IF z min < 0.0 AND z max < 0.0 + THEN z0 := z max + ELIF z min > 0.0 AND z max > 0.0 + THEN z0 := z max + ELSE z0 := 0.0 FI . + +x axis : + move (pic, x max, y0, z0); + move cm r (pic, 0.1, -0.3); + draw (pic, "X"); + + draw tabs (pic, x0,y0,z0, x max,y0,z0, dx,0.0,0.0); + value text := text (x max); + draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text); + + draw tabs (pic, x0,y0,z0, x min,y0,z0,-dx,0.0,0.0); + value text := text (x min); + draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text) . + +y axis : + move (pic, x0, y max, z0); + move cm r (pic, -0.18, -0.1); + draw (pic, "Y"); + + draw tabs (pic, x0,y0,z0, x0,y max,z0, 0.0, dy,0.0); + value text := text (y max); + draw (pic, length (value text) * ""8"" + value text); + + draw tabs (pic, x0,y0,z0, x0,y min,z0, 0.0,-dy,0.0); + value text := text (y min); + draw (pic, length (value text) * ""8"" + value text) . + +z axis : + move (pic, x0, y0, z max); + move cm r (pic, 0.1, -0.3); + draw (pic, "Z"); + + draw tabs (pic, x0,y0,z0, x0,y0,z max, 0.0,0.0, dz); + value text := text (z max); + draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text); + + draw tabs (pic, x0,y0,z0, x0,y0,z min, 0.0,0.0,-dz); + value text := text (z min); + draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text) . + +END PROC axis; + +PROC draw tabs (PICTURE VAR pic, REAL CONST x0,y0,z0, x1,y1,z1, dx,dy,dz) : + move (pic, x0, y0, z0); + draw (pic, x1, y1, z1); + + REAL VAR x :: x0, y :: y0, z :: z0; + INT VAR i :: 0; + WHILE abs (x) <= abs (x1) AND abs (y) <= abs (y1) AND abs (z) <= abs (z1) + REP move (pic, x, y, z); + IF dx <> 0.0 + THEN draw cm r (pic, 0.0, size); + ELIF dy <> 0.0 + THEN draw cm r (pic, size, 0.0); + ELIF dz <> 0.0 + THEN draw cm r (pic, 0.0, size) FI; + i INCR 1; + x INCR dx; y INCR dy; z INCR dz + PER . + +size: + IF i MOD 10 = 0 + THEN -0.75 + ELIF i MOD 5 = 0 + THEN -0.5 + ELSE -0.3 FI . + +END PROC draw tabs; + +PROC plot (PICFILE VAR p, REAL PROC (REAL CONST, REAL CONST) f, + REAL CONST x min, x max, INT CONST pixel x, + REAL CONST z min, z max, INT CONST pixel z) : + plot (p, PROC f, 1, x min, x max, (x max-x min) / real (pixel x), + z min, z max, (z max-z min) / real (pixel z)) +END PROC plot; + +PROC plot (PICFILE VAR p, REAL PROC (REAL CONST, REAL CONST) f, INT CONST pen, + REAL CONST x min, x max, INT CONST pixel x, + REAL CONST z min, z max, INT CONST pixel z) : + plot (p, PROC f, pen, x min, x max, (x max-x min) / real (pixel x), + z min, z max, (z max-z min) / real (pixel z)) +END PROC plot; + +PROC plot (PICFILE VAR p, REAL PROC (REAL CONST, REAL CONST) f, + REAL CONST x min, x max, dx, + REAL CONST z min, z max, dz) : + plot (p, PROC f, 1, x min, x max, dx, z min, z max, dz) +END PROC plot; + +PROC plot (PICFILE VAR p, REAL PROC (REAL CONST, REAL CONST) f, INT CONST n, + REAL CONST x min, x max, dx, + REAL CONST z min, z max, dz) : + REAL VAR z := z min; + line; + WHILE z <= z max + REP out (""13""5"Ebene: " + text (z)); + pic := plot (PROC f, x min, x max, dx, z); + pen (pic, n); + put picture (p, pic); + z INCR dz + PER . + +END PROC plot; + +PICTURE PROC plot (REAL PROC (REAL CONST, REAL CONST) f, + REAL CONST x min, x max, dx, z): + pic := nilpicture; + REAL VAR x := x min; + move (pic, x, f (x, z), z); + WHILE x < x max + REP x INCR dx; + draw (pic, x, f (x, z), z); + PER; + draw (pic, x, f (x, z), z); + pic . + +END PROC plot; + +PICTURE PROC plot (REAL PROC (REAL CONST) f, + REAL CONST x min, x max, INT CONST pixel) : + plot (PROC f, x min, x max, (x max-x min) / real (pixel)) +END PROC plot; + +PICTURE PROC plot (REAL PROC (REAL CONST) f, REAL CONST x min, x max, dx) : + PICTURE VAR pic :: nilpicture; + REAL VAR x := x min; + move (pic, x, f (x)); + WHILE x < x max + REP x INCR dx; + draw (pic, x, f (x)); + PER; + draw (pic, x, f (x)); + pic +END PROC plot; + +END PACKET fuplot -- cgit v1.2.3