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 --- system/base/unknown/src/STDPLOT.ELA | 365 ++++++++++++++++++++++++++++++++++++ 1 file changed, 365 insertions(+) create mode 100644 system/base/unknown/src/STDPLOT.ELA (limited to 'system/base/unknown/src/STDPLOT.ELA') diff --git a/system/base/unknown/src/STDPLOT.ELA b/system/base/unknown/src/STDPLOT.ELA new file mode 100644 index 0000000..be55e33 --- /dev/null +++ b/system/base/unknown/src/STDPLOT.ELA @@ -0,0 +1,365 @@ +PACKET std plot DEFINES (* J. Liedtke 06.02.81 *) + (* H.Indenbirken, 19.08.82 *) + transform, + set values, + + clear , + begin plot , + end plot , + dir move, + dir draw , + pen, + pen info : + +LET pen down = "*"8"" , + y raster = 43, + display hor = 78.0, + display vert = 43.0; + +INT CONST up := 1 , + right := 1 , + down := -1 , + left := -1 ; + +REAL VAR h min limit :: 0.0, h max limit :: display hor, + v min limit :: 0.0, v max limit :: display vert, + h :: display hor/2.0, v :: display vert/2.0, + size hor :: 23.5, size vert :: 15.5; + +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 5 ROW 5 REAL VAR result; +INT VAR i, j; + +ROW 5 ROW 5 REAL OP * (ROW 5 ROW 5 REAL CONST l, r) : + ROW 5 ROW 5 REAL VAR erg; + FOR i FROM 1 UPTO 5 + REP FOR j FROM 1 UPTO 5 + REP erg [i] [j] := zeile i mal spalte j + PER + PER; + erg . + +zeile i mal spalte j : + INT VAR k; + REAL VAR summe :: 0.0; + FOR k FROM 1 UPTO 5 + REP summe INCR zeile i * spalte j PER; + summe . + +zeile i : l [i] [k] . + +spalte j : r [k] [j] . + +END OP *; + +PROC set values (ROW 3 ROW 2 REAL CONST size, + ROW 2 ROW 2 REAL CONST limits, + ROW 3 REAL CONST angles, + ROW 2 REAL CONST oblique, + ROW 3 REAL CONST perspective) : + norm p; + set views; + calc two dim extrema; + calc limits; + calc result values . + +norm p : + p := ROW 5 ROW 5 REAL : + (ROW 5 REAL : (1.0/dx, 0.0, 0.0, 0.0, 0.0), + ROW 5 REAL : ( 0.0, 1.0/dy, 0.0, 0.0, 0.0), + ROW 5 REAL : ( 0.0, 0.0, 1.0/dz, 0.0, 0.0), + ROW 5 REAL : ( 0.0, 0.0, 0.0, 1.0, 0.0), + ROW 5 REAL : (size [1][1]/dx, size [2][1]/dy, + size [3][1]/dz, 0.0, 1.0)) . + +dx : size [1][2] - size [1][1] . +dy : size [2][2] - size [2][1] . +dz : size [3][2] - size [3][1] . + +set views : + REAL VAR sin a := sind (angles [1]), cos a := cosd (angles [1]), + sin p := sind (angles [2]), cos p := cosd (angles [2]), + sin t := sind (angles [3]), cos t := cosd (angles [3]), + norm a :: oblique [1] * p [1][1], + norm b :: oblique [2] * p [2][2], + norm cx :: perspective [1] * p [1][1], + norm cy :: perspective [2] * p [2][2], + norm cz :: perspective [3] * p [3][3]; + + result := ROW 5 ROW 5 REAL : + (ROW 5 REAL : (cos p*cos t, -sin p, cos p*sin t, 0.0, 0.0), + ROW 5 REAL : (sin p*cos t, cos p, sin p*sin t, 0.0, 0.0), + ROW 5 REAL : ( -sin t, 0.0, cos t, 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)); + p := p*result; + + + result := 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 : ( norm a, norm b, 0.0, 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)); + p := p * result; + + result := ROW 5 ROW 5 REAL : + (ROW 5 REAL : (cos a,-sin a, 0.0, 0.0, 0.0), + ROW 5 REAL : (sin a, cos a, 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)); + p := p * result . + +calc two dim extrema : + REAL VAR max x :: - max real, min x :: max real, + max y :: - max real, min y :: max real, x, y; + + transform (size [1][1], size [2][1], size [3][1], x, y); + extrema; + transform (size [1][2], size [2][1], size [3][1], x, y); + extrema; + transform (size [1][2], size [2][2], size [3][1], x, y); + extrema; + transform (size [1][1], size [2][2], size [3][1], x, y); + extrema; + transform (size [1][1], size [2][1], size [3][2], x, y); + extrema; + transform (size [1][2], size [2][1], size [3][2], x, y); + extrema; + transform (size [1][2], size [2][2], size [3][2], x, y); + extrema; + transform (size [1][1], size [2][2], size [3][2], x, y); + extrema . + +extrema : + min x := min (min x, x); + max x := max (max x, x); + + min y := min (min y, y); + max y := max (max y, y) . + +calc limits : + IF all limits smaller than 2 + THEN prozente + ELSE zentimeter FI . + +all limits smaller than 2 : + limits [1][2] < 2.0 AND limits [2][2] < 2.0 . + +prozente : + h min limit := limits [1][1] * display hor * (size vert/size hor); + h max limit := limits [1][2] * display hor * (size vert/size hor); + + 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) . + +calc result values : + REAL VAR sh := (h max limit - h min limit) / (max x - min x), + sv := (v max limit - v min limit) / (max y - min y), + dh := h min limit - min x*sh, + dv := v min limit - min y*sv; + + result := ROW 5 ROW 5 REAL : + (ROW 5 REAL : ( sh, 0.0, 0.0, 0.0, 0.0), + ROW 5 REAL : (0.0, sv, 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 : ( dh, dv, 0.0, 0.0, 1.0)); + p := p * result . + +END PROC set values; + +PROC transform (REAL CONST x, y, z, REAL VAR h, v) : + REAL CONST w :: 1.0/(x*p [1][4] + y*p [2][4] + z*p [3][4] + p [4][4]); + + h := (x*p [1][1]+y*p [2][1]+z*p [3][1]+p [4][1])*w + p [5][1]; + v := (x*p [1][2]+y*p [2][2]+z*p [3][2]+p [4][2])*w + p [5][2]; +END PROC transform; + +(************************** Eigentliches plot *************************) +INT VAR x pos := 0 , + y pos := 0 , + new x pos , + new y pos ; + +ROW 24 TEXT VAR display; +clear ; + +PROC clear : + + INT VAR i; + display (1) := 79 * " " ; + FOR i FROM 2 UPTO 24 + REP display [i] := display [1] + PER; + out (""6""2""0""4"") + +END PROC clear ; + +PROC begin plot : + + cursor (x pos + 1, 24 - (y pos) DIV 2 ) + +ENDPROC begin plot ; + +PROC end plot : + +ENDPROC end plot ; + +PROC dir move (REAL CONST x, y, z) : + transform (x, y, z, h, v); + move (round (h), round (v)) + +END PROC dir move; + +PROC move (INT CONST x val, y val) : + + x pos := x val; + y pos := y val + +ENDPROC move ; + +PROC dir draw (REAL CONST x, y, z) : + transform (x, y, z, h, v); + draw (round (h), round (v)) + +END PROC dir draw; + +PROC draw (INT CONST x val, y val) : + + new x pos := x val; + new y pos := y val; + + plot vector (new x pos - x pos, new y pos - y pos) ; + +END PROC draw ; + +PROC dir draw (TEXT CONST text, REAL CONST angle, height) : + out (""6""); + out (code (23 - (y pos DIV 2))); + out (code (x pos)); + + out (text) + +END PROC dir draw; + +INT VAR act no :: 1, act thickness :: 1, act line type :: 1; + +PROC pen (INT CONST no, thickness, line type) : + act no := no; + act thickness := thickness; + act line type := line type + +ENDPROC pen ; + +PROC pen info (INT VAR no, thickness, line type) : + no := act no; + thickness := act thickness; + line type := act line type + +END PROC pen info; + +PROC plot vector (INT CONST dx , dy) : + + IF dx >= 0 + THEN IF dy > dx THEN vector (y pos, x pos, dy, dx, up, right) + ELIF dy > 0 THEN vector (x pos, y pos, dx, dy, right, up) + + ELIF dy > -dx THEN vector (x pos, y pos, dx, -dy, right, down) + ELSE vector (y pos, x pos, -dy, dx, down, right) + FI + ELSE IF dy > -dx THEN vector (y pos, x pos, dy, -dx, up, left) + ELIF dy > 0 THEN vector (x pos, y pos, -dx, dy, left, up) + + ELIF dy > dx THEN vector (x pos, y pos, -dx, -dy, left, down) + ELSE vector (y pos, x pos, -dy, -dx, down, left) + FI + FI . + +ENDPROC plot vector ; + +PROC vector (INT VAR x pos, y pos; INT CONST dx, dy, right, up) : + + prepare first step ; + INT VAR i ; + FOR i FROM 1 UPTO dx REP + do one step + PER . + +prepare first step : + point; + INT VAR old error := 0 , + up right error := dy - dx , + right error := dy . + +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 ; + point ; + old error INCR upright error . + +do right step : + x pos INCR right ; + point ; + old error INCR right error . + +ENDPROC vector ; + + +PROC point : + INT CONST line :: y pos DIV 2; + BOOL CONST above :: (y pos MOD 2) = 1; + TEXT CONST point :: display [line+1] SUB (x pos+1), + new point :: calculated point; + + replace (display [line+1], x pos+1, new point); + out (""6"") ; + out (code (23-line)) ; + out (code (x pos)) ; + out (new point) . + +calculated point : + IF above + THEN IF point = "," OR point = "|" + THEN "|" + ELSE "'" FI + ELSE IF point = "'" OR point = "|" + THEN "|" + ELSE "," FI + FI + +END PROC point; + +REAL CONST real max int := real (max int); +INT PROC round (REAL CONST x) : + IF x > real max int + THEN max int + ELIF x < 0.0 + THEN 0 + ELSE int (x + 0.5) FI + +END PROC round; + +ENDPACKET std plot ; -- cgit v1.2.3