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/STDPLOT.ELA | 234 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 234 insertions(+) create mode 100644 app/mpg/1987/src/STDPLOT.ELA (limited to 'app/mpg/1987/src/STDPLOT.ELA') diff --git a/app/mpg/1987/src/STDPLOT.ELA b/app/mpg/1987/src/STDPLOT.ELA new file mode 100644 index 0000000..542b032 --- /dev/null +++ b/app/mpg/1987/src/STDPLOT.ELA @@ -0,0 +1,234 @@ +PACKET std plot DEFINES drawing area, + begin plot, + end plot, + clear, + pen, + move, + draw, + get cursor: + +LET delete = 0, {Farbcodes} + std = 1, + black = 5, + white = 6, + + durchgehend = 1, {Linientypen} + gepunktet = 2, + kurz gestrichelt = 3, + lang gestrichelt = 4, + strichpunkt = 5, + + empty = 0, {Punktsymbole} + high = 1, + low = 2, + both = 3; + +LET POS = STRUCT (INT x, y); + +ROW 79 ROW 24 INT VAR screen; +BOOL VAR colour :: TRUE, action :: TRUE; +POS VAR pos :: POS : (0, 0); + +clear; + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + x cm := 25.0; y cm := 17.0; {***** Horizontale und vertikale *****} + {***** GrӇe in Zentimetern. *****} + x pixel := 79; y pixel := 48 {***** Koordinaten des rechten *****} + {***** oberen Punktes. *****} +END PROC drawing area; + +PROC begin plot : +ENDPROC begin plot ; + +PROC end plot : +ENDPROC end plot ; + +PROC clear : + INT VAR i, j; + colour := TRUE; + action := TRUE; + pos := POS : (0, 0); + + FOR i FROM 1 UPTO 24 + REP screen [1] [i] := 0 PER; + FOR i FROM 2 UPTO 79 + REP screen [i] := screen [1] PER; + page; + out (""6""23""0"") . +END PROC clear; + +PROC pen (INT CONST background, foreground, thickness, linetype): + colour := foreground > 0; + action := linetype <> 0 . + +END PROC pen; + +PROC move (INT CONST x, y) : + out (""6""+ code (23-y DIV 2) + code (x)); + pos := POS : (x, y) +END PROC move; + +PROC draw (INT CONST x, y) : + IF action + THEN vector (x-pos.x, y-pos.y) FI; + pos := POS : (x, y) . + +END PROC draw; + +PROC vector (INT CONST dx , dy) : + IF dx >= 0 + THEN IF dy > dx THEN vector (pos.y, pos.x, dy, dx, 1, 1) + ELIF dy > 0 THEN vector (pos.x, pos.y, dx, dy, 1, 1) + + ELIF dy > -dx THEN vector (pos.x, pos.y, dx, -dy, 1,-1) + ELSE vector (pos.y, pos.x, -dy, dx,-1, 1) FI + + ELSE IF dy > -dx THEN vector (pos.y, pos.x, dy, -dx, 1,-1) + ELIF dy > 0 THEN vector (pos.x, pos.y, -dx, dy,-1, 1) + + ELIF dy > dx THEN vector (pos.x, pos.y, -dx, -dy,-1,-1) + ELSE vector (pos.y, pos.x, -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 ; + point; + FOR i FROM 1 UPTO dx + REP do one step PER . + +prepare first step : + INT VAR up right error := dy - dx, + right error := dy, + old error := 0 . + +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 . + +point : + IF (pos.y AND 1) = 0 + THEN lower point + ELSE upper point FI . + +lower point : + out (""6""+ code (23-pos.y DIV 2) + code (pos.x)); + IF colour + THEN set lower point + ELSE reset lower point FI . + +set lower point: + SELECT screen [pos.x+1] [pos.y DIV 2+1] OF + CASE empty : out (","8""); + screen [pos.x+1] [pos.y DIV 2+1] := low + CASE high : out ("|"8""); + screen [pos.x+1] [pos.y DIV 2+1] := both + ENDSELECT . + +reset lower point: + SELECT screen [pos.x+1] [pos.y DIV 2+1] OF + CASE low : out (" "8""); + screen [pos.x+1] [pos.y DIV 2+1] := empty + CASE both : out ("'"8""); + screen [pos.x+1] [pos.y DIV 2+1] := high + ENDSELECT . + +upper point : + out (""6""+ code (23-pos.y DIV 2) + code (pos.x)); + IF colour + THEN set upper point + ELSE reset upper point FI . + +set upper point: + SELECT screen [pos.x+1] [pos.y DIV 2+1] OF + CASE empty : out ("'"8""); + screen [pos.x+1] [pos.y DIV 2+1] := high + CASE low : out ("|"8""); + screen [pos.x+1] [pos.y DIV 2+1] := both + ENDSELECT . + +reset upper point: + SELECT screen [pos.x+1] [pos.y DIV 2+1] OF + CASE high : out (" "8""); + screen [pos.x+1] [pos.y DIV 2+1] := empty + CASE both : out (","8""); + screen [pos.x+1] [pos.y DIV 2+1] := low + ENDSELECT . + +END PROC vector; + +PROC draw (TEXT CONST record, REAL CONST angle, height, width): + out (subtext (record, 1, 79-pos.x)); + out (""6""+ code (23-pos.y DIV 2) + code (pos.x)); +END PROC draw; + +PROC draw (TEXT CONST record) : + draw (record, 0.0, 0.0, 0.0) +END PROC draw; + +PROC get cursor (TEXT VAR t, INT VAR x, y) : + x := pos.x; + y := pos.y; + REP out (""6""+ code (23-y DIV 2) + code (x)); + inchar (t); + SELECT code (t) OF + CASE 2 : x INCR 1 + CASE 3 : y INCR 1 + CASE 8 : x DECR 1 + CASE 10: y DECR 1 + CASE 1 : out (""0""1"" + text (x, 3) + "," + text (y, 3) + " "13""16"") + OTHERWISE leave get cursor ENDSELECT; + check + PER . + +leave get cursor: + out (""6""+ code (23-pos.y DIV 2) + code (pos.x)); + LEAVE get cursor . + +check : + IF x < 0 + THEN x := 0; + out (""7"") + ELIF x > 47 + THEN x := 47; + out (""7"") + FI; + IF y < 0 + THEN y := 0; + out (""7"") + ELIF y > 78 + THEN y := 78; + out (""7"") + FI . + +END PROC get cursor; + +PROC test (INT CONST x, y, TEXT CONST t): + out (""27";(" + text (x) + "," + text (y) + ") " + t + ""29""); + IF incharety (10000) = ""27"" + THEN stop FI +END PROC test; + + +END PACKET std plot; + + -- cgit v1.2.3