path: root/system/std.graphik/1.8.7/src/GRAPHIK.Picfile

PACKET picture DEFINES                        (*Autor: Heiko.Indenbirken *)
               PICTURE,                       (*Stand:    12.03.1985     *)
               :=, CAT, nilpicture,           (*Änderung: 20.08.85/10:38 *)
               draw, draw r,                  (*Änderung: 05.08.86/12:21 *)
               move, move r,
               mark, bar, circle,
               length, dim, pen, where,
               extrema, rotate, stretch, translate,
               picture:

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,
    max length    = 31974;

LET overflow  = "Picture overflow",
    pen range = "pen out of range [0-16]",
    dim 3     = "Picture is 3 dimensional",
    dim 2     = "Picture is 2 dimensional",
    dim init  = "Picture isn't initialized",
    wrong key = "wrong key code",
    nil       = "",
    zero      = ""0"";

TYPE PICTURE = STRUCT (INT dim, pen, TEXT points);


INT VAR read pos;
REAL VAR x, y, z;
TEXT VAR r1 :: 8*zero, r2 :: 16*zero, r3 :: 24*zero, i1 :: 2*zero;

OP := (PICTURE VAR l, PICTURE CONST r) :
  CONCR (l) := CONCR (r)
END OP :=;

OP CAT (PICTURE VAR l, PICTURE CONST r) :
  check dim (l, r.dim);
  IF length (l.points) > max length - length (r.points)
  THEN errorstop (overflow) FI;

  l.points CAT r.points
END OP CAT;

PICTURE PROC nilpicture :
  PICTURE : (0, 1, nil)
END PROC nilpicture;

PICTURE PROC nilpicture (INT CONST pen):
  PICTURE : (0, pen, nil)
END PROC nilpicture;

PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, height, bright):
  write (p.points, text, angle, height, bright, text key)
END PROC draw;

PROC draw (PICTURE VAR p, REAL CONST x, y, z) :
  check dim (p, 3);
  write (p.points, x, y, z, draw key)
END PROC draw;

PROC draw (PICTURE VAR p, REAL CONST x, y) :
  check dim (p, 2);
  write (p.points, x, y, draw key)
END PROC draw;

PROC draw r (PICTURE VAR p, REAL CONST x, y, z) :
  check dim (p, 3);
  write (p.points, x, y, z, draw r key)
END PROC draw r;

PROC draw r (PICTURE VAR p, REAL CONST x, y) :
  check dim (p, 2);
  write (p.points, x, y, draw r key)
END PROC draw r;

PROC move (PICTURE VAR p, REAL CONST x, y, z) :
  check dim (p, 3);
  write (p.points, x, y, z, move key)
END PROC move;

PROC move (PICTURE VAR p, REAL CONST x, y) :
  check dim (p, 2);
  write (p.points, x, y, move key)
END PROC move;

PROC move r (PICTURE VAR p, REAL CONST x, y, z) :
  check dim (p, 3);
  write (p.points, x, y, z, move r key)
END PROC move r;

PROC move r (PICTURE VAR p, REAL CONST x, y) :
  check dim (p, 2);
  write (p.points, x, y, move r key)
END PROC move r;

PROC bar (PICTURE VAR p, REAL CONST width, height, INT CONST pattern):
  check dim (p, 2);
  write (p.points, width, height, pattern, bar 2 key)
END PROC bar;

PROC bar (PICTURE VAR p, REAL CONST from, to, height, INT CONST pattern):
  check dim (p, 2);
  write (p.points, from, to, height, pattern, bar 3 key)
END PROC bar;

PROC circle (PICTURE VAR p, REAL CONST radius, from, to, INT CONST pattern):
  check dim (p, 2);
  write (p.points, radius, from, to, pattern, circle key)
END PROC circle;

PROC mark (PICTURE VAR p, REAL CONST size, INT CONST no):
  write (p.points, size, no, mark key)
END PROC mark;

PROC write (TEXT VAR points, REAL CONST x, y, z, INT CONST key) :
  IF length (points) < max length
  THEN points CAT code (key); 
       replace (r3, 1, x);
       replace (r3, 2, y);
       replace (r3, 3, z);
       points CAT r3
  ELSE errorstop (overflow) FI
END PROC write;

PROC write (TEXT VAR points, REAL CONST x, y, INT CONST key) :
  IF length (points) < max length
  THEN points CAT code (key); 
       replace (r2, 1, x);
       replace (r2, 2, y);
       points CAT r2
  ELSE errorstop (overflow) FI
END PROC write;

PROC write (TEXT VAR points, REAL CONST x, y, INT CONST n, key) :
  IF length (points) < max length
  THEN points CAT code (key); 
       replace (r2, 1, x);
       replace (r2, 2, y);
       points CAT r2;
       replace (i1, 1, n);
       points CAT i1
  ELSE errorstop (overflow) FI
END PROC write;

PROC write (TEXT VAR points, REAL CONST x, y, z, INT CONST n, key) :
  IF length (points) < max length
  THEN points CAT code (key); 
       replace (r3, 1, x);
       replace (r3, 2, y);
       replace (r3, 3, z);
       points CAT r3;
       replace (i1, 1, n);
       points CAT i1 
  ELSE errorstop (overflow) FI
END PROC write;

PROC write (TEXT VAR points, TEXT CONST t, REAL CONST angle, height, bright,
            INT CONST key) :
  IF max length - length (points) >= length (t)
  THEN points CAT code (key);
       replace (i1, 1, length (t));
       points CAT i1;
       points CAT t;
       replace (r3, 1, angle);
       replace (r3, 2, height);
       replace (r3, 3, bright);
       points CAT r3
  FI;
END PROC write;

PROC write (TEXT VAR points, REAL CONST size, INT CONST no, key) :
  IF length (points) < max length
  THEN points CAT code (key); 
       replace (r1, 1, size);
       points CAT r1;
       replace (i1, 1, no);
       points CAT i1;
  ELSE errorstop (overflow) FI
END PROC write;

PROC check dim (PICTURE VAR p, INT CONST dim):
  IF p.dim = dim
  THEN
  ELIF p.dim = 0
  THEN p.dim := dim
  ELSE errorstop (dimension) FI  .

dimension:
  IF p.dim = 2
  THEN dim 2
  ELIF p.dim = 3
  THEN dim 3
  ELSE dim init FI  .

END PROC check dim;

INT PROC length (PICTURE CONST p):
  length (p.points)
END PROC length;

INT PROC dim (PICTURE CONST pic) :
  pic.dim
END PROC dim;

PICTURE PROC pen (PICTURE CONST p, INT CONST pen) :
  IF pen < 0 OR pen > 16
  THEN errorstop (pen range) FI;

  PICTURE:(p.dim, pen, p.points)
END PROC pen;

INT PROC pen (PICTURE CONST p) :
  p.pen
END PROC pen;

PROC where (PICTURE CONST p, REAL VAR x, y) :
  IF p.dim = 0
  THEN x := 0.0;  y := 0.0
  ELIF p.dim = 3
  THEN errorstop (dim 3)
  ELSE x := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1;
       y := subtext (p.points, length (p.points)-7,  length (p.points)) RSUB 1
  FI
END PROC where;

PROC where (PICTURE CONST p, REAL VAR x, y, z) :
  IF p.dim = 0
  THEN x := 0.0;  y := 0.0;  z := 0.0
  ELIF p.dim = 2
  THEN errorstop (dim 2)
  ELSE x := subtext (p.points, length (p.points)-23, length (p.points)-16) RSUB 1;
       y := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1;
       z := subtext (p.points, length (p.points)-7,  length (p.points)) RSUB 1;
  FI
END PROC where;


PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max, z min, z max) :
  x min := max real;  x max :=-max real;
  y min := max real;  y max :=-max real;
  z min := max real;  z max :=-max real;
  read pos := 0; 
  INT CONST pic length := length (p.points);
  WHILE read pos < pic length
  REP check position PER  .

check position :
  read pos INCR 1;
  SELECT code (p.points SUB read pos) OF
  CASE draw key : calc extrema
  CASE move key : calc extrema
  CASE move r key : calc rel extrema
  CASE draw r key : calc rel extrema
  CASE text key : read pos INCR next int + 24
  CASE bar 2 key : read pos INCR 18
  CASE bar 3 key, circle key : read pos INCR 26
  CASE mark key: read pos INCR 4 
  OTHERWISE errorstop (wrong key) END SELECT  . 

calc extrema :
  x := next real;  y := next real;  z := next real;
  x min := min (x min, x);  x max := max (x max, x);
  y min := min (y min, y);  y max := max (y max, y);
  z min := min (z min, z);  z max := max (z max, z)  .

calc rel extrema :
  x INCR next real;  y INCR next real;  z INCR next real;
  x min := min (x min, x);  x max := max (x max, x);
  y min := min (y min, y);  y max := max (y max, y);
  z min := min (z min, z);  z max := max (z max, z)  .

next real :
  read pos INCR 8;
  subtext (p.points, read pos-7, read pos) RSUB 1  .

next int :
  read pos INCR 2;
  subtext (p.points, read pos-1, read pos) ISUB 1  .

END PROC extrema;

PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max):
  x min := max real;  x max :=-max real;
  y min := max real;  y max :=-max real;
  read pos := 0; 
  INT CONST pic length := length (p.points);
  WHILE read pos < pic length
  REP check position PER  .

check position :
  read pos INCR 1;
  SELECT code (p.points SUB read pos) OF
  CASE draw key : calc extrema
  CASE move key : calc extrema
  CASE move r key : calc rel extrema
  CASE draw r key : calc rel extrema
  CASE text key : read pos INCR next int + 24
  CASE bar 2 key : read pos INCR 18
  CASE bar 3 key, circle key : read pos INCR 26
  CASE mark key: read pos INCR 4 
  OTHERWISE errorstop (wrong key) END SELECT  . 

calc extrema :
  x := next real;  y := next real;
  x min := min (x min, x);  x max := max (x max, x);
  y min := min (y min, y);  y max := max (y max, y)  .

calc rel extrema :
  x INCR next real;  y INCR next real;
  x min := min (x min, x);  x max := max (x max, x);
  y min := min (y min, y);  y max := max (y max, y)  .

next real :
  read pos INCR 8;
  subtext (p.points, read pos-7, read pos) RSUB 1  .

next int :
  read pos INCR 2;
  subtext (p.points, read pos-1, read pos) ISUB 1  .

END PROC extrema;

PROC rotate (PICTURE VAR p, REAL CONST angle) :
  REAL CONST s :: sind( angle ), c := cosd( angle );
  transform (p, ROW 4 ROW 3 REAL : 
               (ROW 3 REAL : ( 1.0,  0.0,  0.0 ),
                ROW 3 REAL : ( 0.0,   c ,   s  ),
                ROW 3 REAL : ( 0.0,  -s ,   c  ),
                ROW 3 REAL : ( 0.0,  0.0,  0.0 )))
END PROC rotate;

PROC rotate (PICTURE VAR p, REAL CONST phi, theta, lambda ) :
  REAL CONST s   :: sind ( theta ), c   :: cosd ( theta ),
             s p :: sind (  phi  ), s l :: sind ( lambda ),
             ga  :: cosd (  phi  ), c l :: cosd ( lambda ),
             be  :: s p * s l,      al  :: s p * c l, c1 :: 1.0 - c;
  transform (p, ROW 4 ROW 3 REAL : 
               (ROW 3 REAL : ( al*al*c1 + c , be*al*c1+ga*s, ga*al*c1-be*s ),
                ROW 3 REAL : ( al*be*c1-ga*s, be*be*c1 + c , ga*be*c1+al*s ),
                ROW 3 REAL : ( al*ga*c1+be*s, be*ga*c1-al*s, ga*ga*c1 + c  ),
                ROW 3 REAL : (      0.0     ,      0.0     ,      0.0    )))
END PROC rotate; 
 
PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) : 
  stretch (pic, sx, sy, 1.0) 
END PROC stretch;

PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) :
  transform (p, ROW 4 ROW 3 REAL : 
               (ROW 3 REAL : ( sx, 0.0, 0.0),
                ROW 3 REAL : (0.0,  sy, 0.0),
                ROW 3 REAL : (0.0, 0.0,  sz),
                ROW 3 REAL : (0.0, 0.0, 0.0)))
END PROC stretch;

PROC translate (PICTURE VAR p, REAL CONST dx, dy) : 
  translate (p, dx, dy, 0.0) 
END PROC translate;

PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) :
  transform (p, ROW 4 ROW 3 REAL : 
               (ROW 3 REAL : (1.0, 0.0, 0.0),
                ROW 3 REAL : (0.0, 1.0, 0.0),
                ROW 3 REAL : (0.0, 0.0, 1.0),
                ROW 3 REAL : ( dx,  dy,  dz)))
END PROC translate;

PROC transform (PICTURE VAR p, ROW 4 ROW 3 REAL CONST a) :
  INT CONST pic length := length (p.points);
  INT VAR begin pos;
  read pos := 0; 
  x := 0.0; y := 0.0; z := 0.0;
  IF p.dim = 2
  THEN transform 2 dim pic
  ELSE transform 3 dim pic FI  .
 
transform 2 dim pic:
  WHILE read pos < pic length
  REP transform 2 dim position PER  .

transform 2 dim position:
  read pos INCR 1;
  SELECT code (p.points SUB read pos) OF
  CASE draw key : transform 2 dim point 
  CASE move key : transform 2 dim point 
  CASE move r key : transform 2 dim point 
  CASE draw r key : transform 2 dim point 
  CASE text key : read pos INCR next int + 24
  CASE bar 2 key : read pos INCR 18
  CASE bar 3 key, circle key : read pos INCR 26
  CASE mark key: read pos INCR 4 
  OTHERWISE errorstop (wrong key) END SELECT  . 

transform 2 dim point:
  begin pos := read pos+1;
  x := next real;  y := next real;
  transform (a, x, y, z); 
  replace (r2, 1, x);
  replace (r2, 2, y);
  replace (p.points, begin pos, r2)  .

transform 3 dim pic:
  WHILE read pos < pic length
  REP transform 3 dim position PER  .

transform 3 dim position :
  read pos INCR 1;
  SELECT code (p.points SUB read pos) OF
  CASE draw key : transform 3 dim point 
  CASE move key : transform 3 dim point 
  CASE move r key : transform 3 dim point 
  CASE draw r key : transform 3 dim point 
  CASE text key : read pos INCR next int + 24
  CASE bar 2 key : read pos INCR 18
  CASE bar 3 key, circle key : read pos INCR 26
  CASE mark key: read pos INCR 4
  OTHERWISE errorstop (wrong key) END SELECT  . 

transform 3 dim point:
  begin pos := read pos+1;
  x := next real;  y := next real; z := next real;
  transform (a, x, y, z); 
  replace (r3, 1, x);
  replace (r3, 2, y);
  replace (r3, 3, z);
  replace (p.points, begin pos, r3)  .

next real :
  read pos INCR 8;
  subtext (p.points, read pos-7, read pos) RSUB 1  .

next int :
  read pos INCR 2;
  subtext (p.points, read pos-1, read pos) ISUB 1  .

END PROC transform;

PROC transform (ROW 4 ROW 3 REAL CONST a, REAL VAR x, y, z) :
  REAL CONST ox :: x, oy :: y, oz :: z;
  x := ox*a(1)(1) + oy*a(2)(1) + oz*a(3)(1) + a(4)(1);
  y := ox*a(1)(2) + oy*a(2)(2) + oz*a(3)(2) + a(4)(2);
  z := ox*a(1)(3) + oy*a(2)(3) + oz*a(3)(3) + a(4)(3)
END PROC transform;

PROC picture (PICTURE CONST pic, TEXT VAR points, INT VAR dim, pen):
  dim    := pic.dim;
  pen    := pic.pen;
  points := pic.points;
END PROC picture;

END PACKET picture;

PACKET picfile DEFINES                        (*Autor: Heiko Indenbirken *)
                                              (*Stand:    23.02.1985     *)
               PICFILE, :=, picture file,     (*Änderung: 13.10.89/23:11 *)
               select pen, selected pen, background, 
               set values, get values,
               view, viewport, window,
               oblique, orthographic, perspective,
               extrema,

               to pic, up, down,
               eof, picture no, pictures,
               delete picture, insert picture,
               read picture, write picture,
               get picture, put picture:


LET no picfile = "dataspace is no PICFILE",
    pen range  = "pen out of range",
    pos under  = "Position underflow",
    pos over   = "Position overflow",
    pic over   = "PICFILE overflow";

LET max pics = 1024,
    pic dataspace = 1103;


TYPE PICFILE = BOUND STRUCT (INT size, pos, background,
                             ROW 16 ROW 3 INT pens,
                             ROW 3 ROW 2 REAL sizes,
                             ROW 2 ROW 2 REAL limits,
                             ROW 4 REAL angles,
                             ROW 2 REAL obliques,
                             ROW 3 REAL perspectives
                             ROW max pics PICTURE pic);

INT VAR i;

OP := (PICFILE VAR l, PICFILE CONST r):
  EXTERNAL 260
END OP :=;

OP := (PICFILE VAR p, DATASPACE CONST d) :
  IF type (d) = pic dataspace
    THEN CONCR (p) := d
  ELIF type (d) < 0
    THEN type (d, pic dataspace) ;
         CONCR (p) := d ;
         init picfile dataspace ;
  ELSE errorstop (no picfile) FI .
 
init picfile dataspace :
  r.size := 0;
  r.pos  := 1;
  r.background := 0;
  r.sizes := ROW 3 ROW 2 REAL : (ROW 2 REAL : (0.0, 1.0),
                                 ROW 2 REAL : (0.0, 1.0),
                                 ROW 2 REAL : (0.0, 1.0));
  r.limits := ROW 2 ROW 2 REAL : (ROW 2 REAL : (0.0, 0.0),
                                  ROW 2 REAL : (0.0, 0.0));
  r.angles := ROW 4 REAL : (0.0, 0.0, 0.0, 0.0);
  r.obliques := ROW 2 REAL : (0.0, 0.0);
  r.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0);
  FOR i FROM 1 UPTO 16
  REP r.pens [i] := ROW 3 INT : (1, 0, 1) PER  .

r : CONCR (CONCR (p)).
END OP :=;
 
DATASPACE PROC picture file (TEXT CONST name) :
  IF exists (name)
  THEN old (name)
  ELSE new (name) FI 
END PROC picture file;

PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line type):
  IF pen < 1 OR pen > 16
  THEN errorstop (pen range) FI;
  p.pens   [pen] := ROW 3 INT : (colour, thickness, line type)
END PROC select pen;

PROC selected pen (PICFILE CONST p, INT CONST pen,
                                    INT VAR colour, thickness, line type):
  IF pen < 1 OR pen > 16
  THEN errorstop (pen range) FI;
  colour    := p.pens [pen][1];
  thickness := p.pens [pen][2];
  line type := p.pens [pen][3];
END PROC selected pen;

INT PROC background (PICFILE CONST p):
  p.background
END PROC background;

PROC background (PICFILE VAR p, INT CONST colour):
  p.background := colour
END PROC background;

PROC get values (PICFILE CONST p,
                 ROW 3 ROW 2 REAL VAR size, 
                 ROW 2 ROW 2 REAL VAR limits,
                 ROW 4 REAL VAR angles,
                 ROW 2 REAL VAR oblique,
                 ROW 3 REAL VAR perspective) : 
  size        := p.sizes;
  limits      := p.limits;
  angles      := p.angles;
  oblique     := p.obliques;
  perspective := p.perspectives;

END PROC get values;
 
PROC set values (PICFILE VAR p,
                 ROW 3 ROW 2 REAL CONST size, 
                 ROW 2 ROW 2 REAL CONST limits,
                 ROW 4 REAL CONST angles,
                 ROW 2 REAL CONST oblique,
                 ROW 3 REAL CONST perspective) : 
  p.sizes        := size;
  p.limits       := limits;
  p.angles       := angles;
  p.obliques     := oblique;
  p.perspectives := perspective;

END PROC set values;
 
PROC view (PICFILE VAR p, REAL CONST alpha):
  p.angles [1] := alpha
END PROC view;

PROC view (PICFILE VAR p, REAL CONST phi, theta):
  p.angles [2] := sind (theta) * cosd (phi);
  p.angles [3] := sind (theta) * sind (phi);
  p.angles [4] := cosd (theta);
END PROC view;

PROC view (PICFILE VAR p, REAL CONST x, y, z):
  p.angles [2] := x;
  p.angles [3] := y;
  p.angles [4] := z
END PROC view;

PROC viewport (PICFILE VAR p,REAL CONST hor min,hor max,vert min,vert max) :
  p.limits := ROW 2 ROW 2 REAL : (ROW 2 REAL : (hor min, hor max),
                                  ROW 2 REAL : (vert min, vert max))
END PROC viewport;

PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) :
  window (p, x min, x max, y min, y max, 0.0, 1.0)
END PROC window;

PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max, z min, z max) :
  p.sizes := ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max),
                                 ROW 2 REAL : (y min, y max),
                                 ROW 2 REAL : (z min, z max))
END PROC window;

PROC oblique (PICFILE VAR p, REAL CONST a, b) :
  p.obliques := ROW 2 REAL : (a, b);
  p.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0)
END PROC oblique;

PROC orthographic (PICFILE VAR p) :
  p.obliques := ROW 2 REAL : (0.0, 0.0);
  p.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0)
END PROC orthographic;
 
PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) :
  p.obliques := ROW 2 REAL : (0.0, 0.0);
  p.perspectives := ROW 3 REAL : (cx, cy, cz)
END PROC perspective;
 
PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) :
  REAL VAR dummy;
  extrema (p, x min, x max, y min, y max, dummy, dummy)
END PROC extrema;

PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z min,z max) :
  REAL VAR new x min, new x max, new y min, new y max, new z min, new z max;
  x min := max real;  x max := - max real;
  y min := max real;  y max := - max real;
  z min := max real;  z max := - max real;
  FOR i FROM 1 UPTO p.size
  REP IF dim (p.pic [i]) = 2
      THEN extrema (p.pic [i], new x min, new x max, new y min, new y max) 
      ELSE extrema (p.pic [i], new x min, new x max, new y min, new y max,
                               new z min, new z max)
      FI;
      x min := min (x min, new x min); x max := max (x max, new x max); 
      y min := min (y min, new y min); y max := max (y max, new y max); 
      z min := min (z min, new z min); z max := max (z max, new z max); 
  PER
END PROC extrema;

PROC to pic (PICFILE VAR p, INT CONST n):
  IF n < 1
  THEN errorstop (pos under)
  ELIF n <= p.size+1 AND n <= max pics
  THEN p.pos := n
  ELSE errorstop (pos over) FI
END PROC to pic;

PROC up (PICFILE VAR p):
  to pic (p, p.pos-1)
END PROC up;

PROC up (PICFILE VAR p, INT CONST n):
  to pic (p, p.pos-n)
END PROC up;

PROC down (PICFILE VAR p):
  to pic (p, p.pos+1)
END PROC down;

PROC down (PICFILE VAR p, INT CONST n):
  to pic (p, p.pos+n)
END PROC down;

BOOL PROC eof (PICFILE CONST p):
  p.pos >= p.size
END PROC eof;

INT PROC picture no (PICFILE CONST p):
  p.pos
END PROC picture no;

INT PROC pictures (PICFILE CONST p):
  p.size
END PROC pictures;

PROC delete picture (PICFILE VAR p) :
  INT VAR i;
  FOR i FROM p.pos+1 UPTO p.size
  REP p.pic [i-1] := p.pic [i] PER;

  p.pic [p.size] := nilpicture;
  IF p.size > 1
  THEN p.size DECR 1 FI
END PROC delete picture;

PROC insert picture (PICFILE VAR p) :
  INT VAR i;
  IF p.size >= max pics
  THEN errorstop (pic over)
  ELSE p.size INCR 1;
       FOR i FROM p.size DOWNTO p.pos+1
       REP p.pic [i] := p.pic [i-1] PER;

       p.pic [p.pos] := nilpicture;
  FI
END PROC insert picture;

PROC read picture (PICFILE VAR p, PICTURE VAR pic) :
  pic := p.pic (p.pos)  .
END PROC read picture;
 
PROC write picture (PICFILE VAR p, PICTURE CONST pic) :
  p.pic (p.pos) := pic  .
END PROC write picture;

PROC get picture (PICFILE VAR p, PICTURE VAR pic) :
  IF p.pos > p.size
  THEN errorstop (pos over)
  ELSE pic := p.pic [p.pos];
       p.pos INCR 1;
  FI 
END PROC get picture;

PROC put picture (PICFILE VAR p, PICTURE CONST pic) :
  IF p.pos > max pics
  THEN errorstop (pic over)
  ELSE p.pic [p.pos] := pic;

       IF p.pos > p.size
       THEN p.size INCR 1 FI;
       p.pos INCR 1
  FI 
END PROC put picture;

END PACKET picfile