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/TELEVPLT.ELA | 176 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 176 insertions(+) create mode 100644 app/mpg/1987/src/TELEVPLT.ELA (limited to 'app/mpg/1987/src/TELEVPLT.ELA') diff --git a/app/mpg/1987/src/TELEVPLT.ELA b/app/mpg/1987/src/TELEVPLT.ELA new file mode 100644 index 0000000..155eb02 --- /dev/null +++ b/app/mpg/1987/src/TELEVPLT.ELA @@ -0,0 +1,176 @@ +PACKET televideo plot DEFINES drawing area, { Autor: H. Indenbirken } + begin plot, { Stand: 31.01.85 } + end plot, + clear, + pen, + move, + draw, + get cursor, + cursor: + + +LET delete = 0, {Farbcodes} + std = 1, + black = 5, + white = 6, + + nothing = 0, {Linientypen} + durchgehend = 1, + gepunktet = 2, + kurz gestrichelt = 3, + lang gestrichelt = 4, + strichpunkt = 5, + mittel gestrichelt = 6, + punkt punkt strich = 7; + +INT VAR act thick :: 0; +LET POS = STRUCT (INT x, y); + +POS VAR pos :: POS : (0, 0); + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + x cm := 23.0; y cm := 13.7; + x pixel := 639; y pixel := 239 +END PROC drawing area; + +PROC begin plot : + page; + out (""27".0") +ENDPROC begin plot ; + +PROC end plot : + out (""27".1") +ENDPROC end plot ; + +PROC clear : + act thick := 0; + pos := POS : (0, 0); + out (""27"mCGD") +END PROC clear; + +PROC pen (INT CONST background, foreground, thickness, linetype): + out (""27"m"); + set background; + set foreground; + set thickness; + set linetype; + out ("D") . + +set background: + IF background = white + THEN out (""27"n1") + ELSE out (""27"n0") FI . + +set foreground: + IF foreground = delete + THEN out ("U0W1") + ELIF foreground < 0 + THEN out ("U1W4") + ELSE out ("U1W1") FI . + +set thickness: + act thick := thickness . + +set linetype: + SELECT linetype OF + CASE durchgehend : out ("T1") + CASE gepunktet : out ("T3") + CASE kurz gestrichelt : out ("T6") + CASE lang gestrichelt : out ("T5") + CASE strichpunkt : out ("T4") + CASE mittel gestrichelt : out ("T2") + CASE punkt punkt strich : out ("T7") + END SELECT . + +END PROC pen; + +PROC move (INT CONST x, y) : + out (""27"mM" + text (x, y) + ";D"); + pos := POS : (x, y) +END PROC move; + +PROC draw (INT CONST x, y) : + IF act thick <> 0 + THEN IF horizontal line + THEN thick y + ELSE thick x FI; + x MOVE y + ELSE out (""27"mL" + text (x, y) + ";D") FI; + pos := POS : (x, y) . + +horizontal line: + abs (pos.x-x) > abs (pos.y-y) . + +thick y: + INT VAR dy, old x :: pos.x-x ausgleich, new x :: x+x ausgleich; + FOR dy FROM 1 UPTO act thick + REP old x MOVE pos.y+dy; + new x DRAW y+dy; + old x MOVE pos.y-dy; + new x DRAW y-dy; + PER . + +x ausgleich: + IF pos.x <= x + THEN act thick + ELSE -act thick FI . + +thick x: + INT VAR dx, old y :: pos.y-y ausgleich, new y :: y+y ausgleich; + FOR dx FROM 1 UPTO act thick + REP pos.x+dx MOVE old y; + x+dx DRAW new y; + pos.x-dx MOVE old y; + x-dx DRAW new y; + PER . + +y ausgleich: + IF pos.y <= y + THEN act thick + ELSE -act thick FI . + +END PROC draw; + +PROC draw (TEXT CONST record, REAL CONST angle, height, width): + out (""27"m""" + record + """D") +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) : +END PROC get cursor; + +OP MOVE (INT CONST x, y): + out (""27"mM" + text (x, y) + ";D") +END OP MOVE; + +OP DRAW (INT CONST x, y): + out (""27"mL" + text (x, y) + ";D") +END OP DRAW; + +PROC cursor (INT CONST no,x,y): + out (""27"m|" + text (no) + "~0H" + text (x, y) + ";D") +END PROC cursor; + +TEXT PROC text (INT CONST x,y): + x text + "," + y text . + +x text: + IF x < 0 + THEN "0" + ELIF x > 639 + THEN "639" + ELSE text (x) FI . + +y text: + IF y < 0 + THEN "0" + ELIF y > 639 + THEN "639" + ELSE text (y) FI . + +END PROC text; + +END PACKET televideo plot -- cgit v1.2.3