path: root/app/mpg/1987/src/VIDEOPLO.ELA

#   Stand : 26.Juni 1985  #
PACKET videostar plot DEFINES drawing area, 
                         begin plot, 
                         end plot, 
                         clear, 
 
                         background,
                         foreground,
                         thickness,
                         linetype,

                         move, 
                         draw, 
                         marker, 
 
                         range,
                         clipping:
 
LET begin vector = ""16"";
LET max x        =   679,
    max y        =   479;               (* Direkt-Adressierung *)
LET POS = STRUCT (INT x, y); 
POS VAR pos :: POS : (0, 0);
 
INT VAR akt pen :: 1, akt pen line type :: 1; 
BOOL VAR check :: TRUE;
INT VAR thick :: 0, i, x min :: 0, x max :: 679, y min :: 0, y max :: 479;
TEXT VAR old pos :: "";
 
PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 
   x cm    := 27.0 ;   y cm    := 20.00; 
   x pixel := 679;     y pixel  :=  479
END PROC drawing area;

PROC range (INT CONST h min, h max, v min, v max):
  x min := h min;  x max := h max;
  y min := v min;  y max := v max
END PROC range;

PROC clipping (BOOL CONST flag):
  check := flag
END PROC clipping;

BOOL PROC clipping:
  check
END PROC clipping;

PROC begin plot : 
ENDPROC begin plot ;
 
PROC end plot : 
  out (""27"0@")
ENDPROC end plot ;

PROC clear :
write (""29""27""140""27"/0d"24"")
END PROC clear;
 
PROC background (INT CONST desired, INT VAR realized):
  realized := 0                      (*Nur schwarzer Hintergrund möglich *)
END PROC background;

PROC foreground (INT CONST desired, INT VAR realized):
  akt pen := desired;
  realized := sign (desired)  .  (*Nur weißer Sift möglich, aber         *)
                                 (*löschend, ändernd oder überschreibend *)
END PROC foreground;

PROC thickness (INT CONST desired, INT VAR realized):
  thick     := desired DIV 10;
  realized  := thick*2+1                   (*Breite des Stiftes in Pixel *)
END PROC thickness;

PROC linetype (INT CONST desired, INT VAR realized):
 IF desired <> akt pen linetype 
 THEN write (""29"") ; # Graphicmode on # 
      akt pen line type := desired; 
      write (type cmd);
      write (""27"x"24"") 
  FI;
  IF desired >= 0 AND desired <= 5 
  THEN realized := desired 
  ELSE realized := 0 FI  .

type cmd:
   SELECT desired OF 
    CASE 1 : ""27"/a"                  # durchgängige Linie # 
    CASE 2 : ""27"/1;1a"               # gepunktet # 
    CASE 3 : ""27"/3;3a"               # kurz gestrichelt # 
    CASE 4 : ""27"/6;6a"               # lang gestrichelt # 
    CASE 5 : ""27"/6;3;1;3a"            # Strichpunkt # 
  OTHERWISE ""27"/a" END SELECT
END PROC linetype;
 
 
PROC move (INT CONST x, y) :
  x MOVE y;
  pos := POS:(x, y)  . 
END PROC move;
 
PROC draw (INT CONST x, y):
  IF std thickness
  THEN draw (pos.x, pos.y, x, y)
  ELIF is point
  THEN point (x, y, thick);
       x MOVE y;
  ELIF is horizontal line 
  THEN horizontal line (pos.x, pos.y, x, y, thick);
       x MOVE y;
  ELSE vertical line (pos.x, pos.y, x, y, thick);
       x MOVE y
  FI; 
  pos := POS:(x, y)  . 

std thickness:
  thick = 0  .

is point:
  pos.x = x AND pos.y = y  .

is horizontal line:
  abs (pos.x-x) >= abs (pos.y-y)  .

END PROC draw;

PROC point (INT CONST x, y, thick):
  INT VAR i;
  FOR i FROM -thick UPTO thick
  REP line (x-thick, y+i, x+thick, y+i) PER

END PROC point;

PROC horizontal line (INT CONST from x, from y, to x, to y, thick):
  IF from x > to x
  THEN horizontal line (to x, to y, from x, from y, thick)
  ELSE draw line FI  .

draw line:
  INT VAR i;
  calculate increase;
  calculate limit points;
  FOR i FROM -thick UPTO thick
  REP calculate delta x;
      line (x start+delta x, y start+i, x end+delta x, y end+i)
  PER  .

calculate increase:
  REAL VAR increase :: -dy / dx  .

calculate limit points:
  INT CONST x start :: from x - thick,
            x end   :: to x   + thick,
            y start :: from y + int (increase * real (thick)), 
            y end   :: to y   - int (increase * real (thick))  .

calculate delta x:
  INT CONST delta x :: int (increase*real (i))  .

dx: real (to x-from x)  .
dy: real (to y-from y)  .

END PROC horizontal line;

PROC vertical line (INT CONST from x, from y, to x, to y, thick):
  IF from y > to y
  THEN vertical line (to x, to y, from x, from y, thick)
  ELSE draw line FI  .

draw line:
  INT VAR i;
  calculate increase;
  calculate limit points;
  FOR i FROM -thick UPTO thick
  REP calculate delta y;
      line (x start+i, y start+delta y, x end+i, y end+delta y)
  PER  .

calculate increase:
  REAL VAR increase :: -dx / dy  .

calculate limit points:
  INT CONST x start :: from x + int (increase * real (thick)), 
            x end   :: to x   - int (increase * real (thick)),
            y start :: from y - thick,
            y end   :: to y   + thick  .

calculate delta y:
  INT CONST delta y :: int (increase*real (i))  .

dx: real (to x-from x)  .
dy: real (to y-from y)  .

END PROC vertical line;
 
PROC marker (INT CONST x, y, no, size):
  IF no = 0
  THEN draw cursor FI; 
  pos.x MOVE pos.y  .

draw cursor:
  write(""29""27"/f"27""26"")  .

END PROC marker; 
 
PROC line (INT CONST from x, from y, to x, to y):
  from x MOVE from y;
  draw (from x, from y, to x, to y)
END PROC line;

PROC draw (INT CONST from x, from y, to x, to y):
  IF check
  THEN draw with clipping
  ELSE to x DRAW to y FI  .

draw with clipping:
  INT VAR x, y;
  calculate parts of line;
  IF both points inside
  THEN to x DRAW to y
  ELIF both points outside
  THEN 
  ELIF first point outside
  THEN intersection (to x, to y, to part, from x, from y, from part, x, y);
       x    MOVE y;
       to x DRAW to y
  ELIF second point outside
  THEN intersection (from x, from y, from part, to x, to y, to part, x, y);
       x DRAW y
  ELSE check intersection FI  .

calculate parts of line:
  INT CONST from part :: part (from x, from y),
            to part   :: part (to x, to y)  .

both points inside:
  from part = 0 AND to part = 0  .

both points outside:
  (from part AND to part) <> 0  .

first point outside:
  from part <> 0 AND to part = 0  .

second point outside:
  to part <> 0 AND from part = 0  .

check intersection:
  intersection (to x, to y, to part, from x, from y, from part, x, y);
  x MOVE y;
  draw (x, y, to x, to y)  .

END PROC draw;

INT PROC part (INT CONST x, y):
  INT VAR index :: 0;
  IF x > x max
  THEN set bit (index, 0)
  ELIF x < x min
  THEN set bit (index, 1) FI;

  IF y > y max
  THEN set bit (index, 2)
  ELIF y < y min
  THEN set bit (index, 3) FI;

  index

END PROC part;

PROC intersection (INT CONST from x, from y, from part, to x, to y, to part,
                   INT VAR x, y):
  SELECT to part OF
  CASE  1: right side
  CASE  2: left side 
  CASE  4: up side 
  CASE  5: upright side 
  CASE  6: upleft side 
  CASE  8: down side 
  CASE  9: downright side 
  CASE 10: downleft side
  OTHERWISE errorstop ("wrong partno.:" + text (to part)) ENDSELECT  .

right side:
  y := from y + int (real (x max-from x)*(dy/dx));
  x := x max  .

left side:
  y := from y + int (real (x min-from x)*(dy/dx));
  x := x min  .

up side:
  x := from x + int (real (y max-from y)*(dx/dy));
  y := y max  .

down side:
  x := from x + int (real (y min-from y)*(dx/dy));
  y := y min  .

upright side:
  right side;
  IF y > y max
  THEN up side FI  .

downright side:
  right side;
  IF y < y min
  THEN down side FI  . 

upleft side:
  left side;
  IF y > y max
  THEN up side FI  .

downleft side:
  left side;
  IF y < y min
  THEN down side FI  .

dx: real (to x-from x)  .
dy: real (to y-from y)  .

END PROC intersection;

PROC draw (TEXT CONST text, REAL CONST angle, height, thick) :
INT CONST hoehe :: int(height);
  IF akt pen linetype <> 0
  THEN write (""29""); 
       write (old pos);
       write (""31"");
       write (size);
       write (text);
       write(""24"")
  FI  .

size:
  SELECT hoehe OF 
   CASE 1 : ""27"4" 
   CASE 2 : ""27"5"
   CASE 3 : ""27"0"
   CASE 4 : ""27"1"
   CASE 5 : ""27"2"
   CASE 6 : ""27"3"
  OTHERWISE ""27"0" END SELECT  .  # Größe 3 für undefinierte Werte #

END PROC draw;
 
PROC draw (TEXT CONST record) :
  draw (record, 0.0, 0.0, 0.0)
END PROC draw;
 
OP MOVE (INT CONST x, y) :
 write (""29"");
 old pos := koordinaten (x,y);
 write (old pos);
 write (""24"");
END OP MOVE;
 
OP DRAW (INT CONST x, y) :
  IF akt pen line type = 0
  THEN x MOVE y
  ELSE write (""29""); (* plot ein *)
       write (colour cmd);
       write (old pos);
       old pos := koordinaten (x,y);
       write (old pos);
       write (""24""); (* plot aus *)
  FI  .

colour cmd:
  IF   akt pen = 0 THEN ""27"/1d"    # löschend #
  ELIF akt pen < 0 THEN ""27"/2d"    # XOR #
                   ELSE ""27"/0"     # normal # 
  FI  .

END OP DRAW;

TEXT PROC koordinaten (INT CONST x,y):
  code(32+((y DIV 32) AND 31)) + code(96+(y MOD 32)) +
  code(32+((x DIV 32) AND 31)) + code(64+(x MOD 32))
END PROC koordinaten;
 
END PACKET videostar plot