diff options
Diffstat (limited to 'graphic/GRAPHIK.Plot')
| -rw-r--r-- | graphic/GRAPHIK.Plot | 285 |
1 files changed, 285 insertions, 0 deletions
diff --git a/graphic/GRAPHIK.Plot b/graphic/GRAPHIK.Plot new file mode 100644 index 0000000..5087abb --- /dev/null +++ b/graphic/GRAPHIK.Plot @@ -0,0 +1,285 @@ +PACKET basis plot DEFINES (* Autor: Heiko Indenbirken*) + (* Stand: 12.04.85 *) + (*Änderung: 06.08.86/10:03 *) +(* ****************** Hardwareunabhängiger Teil ********************* *) +(* *) +(* *) +(* Im Harwareunabhängigen Paket 'basis plot' werden folgende *) +(* Prozeduren definiert: *) +(* Procedure : Bedeutung *) +(* ---------------------------------------------------------------- *) +(* 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 *) +(* *) +(* draw : Zeichnet einen Text *) +(* *) +(* mark : Marker mit (no, size) *) +(* bar : Balken mit (width, height, pattern) *) +(* bar : Balken mit (from, to, width, pattern) *) +(* circle : Kreis(segment) mit (radius, from, to, pattern)*) +(* *) +(* where : Gibt die aktuelle Stiftposition (x, y, [z]) *) +(* *) +(*************************************************************************) + + move, draw, + move r, draw r, + mark, bar, circle, + where: + +LET POS = STRUCT (REAL x, y, z); + +POS VAR pos :: POS : (0.0, 0.0, 0.0); +INT VAR h :: 0, v :: 0; + +PROC move (REAL CONST x, y) : + 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) : + transform (x, y, z, h, v); + move (h, v); + pos := POS : (x, y, z) +END PROC move; + +PROC draw (REAL CONST x, y) : + transform (x, y, 0.0, h, v); + draw (h, v); + pos := POS : (x, y, 0.0) +END PROC draw; + +PROC draw (REAL CONST x, y, z) : + transform (x, y, z, h, v); + draw (h, v); + pos := POS : (x, y, z) +END PROC draw; + +PROC move r (REAL CONST x, y) : + 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) : + 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) : + transform (pos.x+x, pos.y+y, pos.z, h, v); + draw (h, v); + pos := POS : (pos.x+x, pos.y+y, pos.z) +END PROC draw r; + +PROC draw r (REAL CONST x, y, z) : + transform (pos.x+x, pos.y+y, pos.z+z, h, v); + draw (h, v); + pos := POS : (pos.x+x, pos.y+y, pos.z+z) +END PROC draw r; + +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 draw (TEXT CONST msg, REAL CONST angle, height percent, width percent): + draw (msg, angle, height (height percent), width (width percent)) . +END PROC draw; + +PROC mark (REAL CONST size, INT CONST no): + marker (h, v, no, diagonal (size)) +END PROC mark; + +PROC bar (REAL CONST width, height, INT CONST pattern): + INT VAR diff, up, zero x, zero y; + transform (0.0, 0.0, 0.0, zero x, zero y); + transform (width*0.5, height, 0.0, diff, up); + bar (h-(diff-zero x), v, h+(diff-zero x), v+(up-zero y), pattern); + move (h, v) + +END PROC bar; + +PROC bar (REAL CONST from, to, height, INT CONST pattern): + INT VAR from h, to h, up; + transform (from, height, 0.0, from h, up); + transform (to, height, 0.0, to h, up); + bar (from h, v, to h, up, pattern); + move (h, v) + +END PROC bar; + +PROC circle (REAL CONST rad, from, to, INT CONST pattern): + circle (h, v, diagonal (rad), from, to, pattern) . + +END PROC circle; + +ENDPACKET basis plot; + +PACKET plot DEFINES plot: (*Autor: Heiko Indenbirken *) + (*Stand: 13.10.89/22:31 *) + +LET draw key = 1, + move key = 2, + text key = 3, + move r key = 4, + draw r key = 5, + bar 2 key = 6, + bar 3 key = 7, + circle key = 8, + mark key = 9; + +LET dim error = "PICTURE not initialized", + key error = "wrong key code: "; + +TEXT VAR points; +INT VAR pic length, pic pen, pic dim, read pos; +PICTURE VAR pic; + +PROC plot (PICTURE CONST pic): + init plot; + IF pic dim = 2 + THEN plot two dim pic + ELIF pic dim = 3 + THEN plot three dim pic + ELIF NOT (pic dim = 0 AND pic length = 0) + THEN errorstop (dim error) FI; + points := "" . + +init plot: + picture (pic, points, pic dim, pic pen); + pic length := length (points); + read pos := 0 . + +plot two dim pic: + WHILE read pos < pic length + REP plot two dim position PER . + +plot two dim position : + read pos INCR 1; + SELECT key OF + CASE draw key: draw (next real, next real) + CASE move key: move (next real, next real) + CASE move r key: move r (next real, next real) + CASE draw r key: draw r (next real, next real) + CASE text key: draw (next text, next real, next real, next real) + CASE bar 2 key: bar (next real, next real, next int) + CASE bar 3 key: bar (next real, next real, next real, next int) + CASE circle key: circle (next real, next real, next real, next int) + CASE mark key: mark (next real, next int) + OTHERWISE errorstop (key error + text (key)) END SELECT . + +plot three dim pic: + WHILE read pos < pic length + REP plot three dim position PER . + +plot three dim position : + read pos INCR 1; + SELECT key OF + CASE draw key: draw (next real, next real, next real) + CASE move key: move (next real, next real, next real) + CASE move r key: move r (next real, next real, next real) + CASE draw r key: draw r (next real, next real, next real) + CASE text key: draw (next text, next real, next real, next real) + CASE bar 2 key: bar (next real, next real, next int) + CASE bar 3 key: bar (next real, next real, next real, next int) + CASE circle key: circle (next real, next real, next real, next int) + CASE mark key: mark (next real, next int) + OTHERWISE errorstop (key error + text (key)) END SELECT . + +key: + code (points SUB read pos) . + +END PROC plot; + +REAL PROC next real: + read pos INCR 8; + subtext (points, read pos-7, read pos) RSUB 1 . +END PROC next real; + +INT PROC next int: + read pos INCR 2; + subtext (points, read pos-1, read pos) ISUB 1 . +END PROC next int; + +TEXT PROC next text: + INT CONST text length :: next int; + read pos INCR text length; + subtext (points, read pos-text length+1, read pos) . +END PROC next text; + +PROC plot (TEXT CONST name) : + PICFILE VAR p :: old (name); + plot (p); +END PROC plot; + +PROC plot (PICFILE VAR p) : + set projektion; + disable stop; + begin plot; + clear screen; + plot pictures (p); + errorcheck; + end plot . + +set projektion: + ROW 3 ROW 2 REAL VAR size; + ROW 2 ROW 2 REAL VAR limit; + ROW 4 REAL VAR angles; + ROW 2 REAL VAR oblique; + ROW 3 REAL VAR perspective; + + get values (p, size, limit, angles, oblique, perspective); + set values (size, limit, angles, oblique, perspective) . + +clear screen: + INT VAR x0, y0, x1, y1, h max, v max; + REAL VAR x cm, y cm; + + IF background (p) > -1 + THEN clear + ELSE drawing area (x cm, y cm, h max, v max); + new values (x cm, y cm, h max, v max, x0, x1 , y0, y1); + set range (max (0, x0), max (0, y0), min (h max, x1), min (v max, y1)) + FI . + +errorcheck: + IF is error + THEN line; + put line ("Erorr at PICTURE No " + text (picture no (p))); + FI . + +END PROC plot; + +PROC plot pictures (PICFILE VAR p): + INT VAR back :: abs (background (p)), no; + enable stop; + FOR no FROM 1 UPTO pictures (p) + REP to pic (p, no); + read picture (p, pic); + + IF this picture is ok + THEN set pen of pic; + plot (pic) + FI + PER . + +this picture is ok: + pen (pic) <> 0 AND length (pic) > 0 . + +set pen of pic: + INT VAR colour, thick, type; + selected pen (p, pen (pic), colour, thick, type); + set pen (back, colour, thick, type) . + +END PROC plot pictures; + +END PACKET plot + |