Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/libsim/figsim.src
There is 1 other file named figsim.src in the archive. Click here to see a list.
OPTIONS(/E);
EXTERNAL CHARACTER PROCEDURE getch;
CLASS graphics; COMMENT: Version 2, january 1975, $ke Blomberg;
BEGIN
CHARACTER amode,gmode,enq,esc,cursor_char,hx,lx,hy,ly,bs,ht;
BOOLEAN after_cursor; INTEGER savei,savej;
PROCEDURE reset_tty;
BEGIN Outchar(amode); Breakoutimage;
END***RESET_TTY***;
PROCEDURE transform(i,j); INTEGER i,j;
BEGIN INTEGER a,b;
a:=i//32; b:=i-32*a; hx:=Char(32+a); lx:=Char(64+b);
a:=j//32; b:=j-32*a; hy:=Char(32+a); ly:=Char(96+b);
END***TRANSFORM***;
PROCEDURE move(i,j); INTEGER i,j;
BEGIN transform(i,j); Outchar(gmode);
Outchar(hy); Outchar(ly); Outchar(hx); Outchar(lx);
Breakoutimage;
savei:=i; savej:=j; after_cursor:=false;
END***MOVE***;
PROCEDURE Draw(i,j); INTEGER i,j;
BEGIN
If after_cursor then move(savei,savej);
transform(i,j);
Outchar(hy); Outchar(ly); Outchar(hx); Outchar(lx);
Breakoutimage;
savei:=i; savej:=j; after_cursor:=false;
END***DRAW***;
PROCEDURE cursor (c,x,y);
NAME c,x,y; CHARACTER c; INTEGER x,y;
BEGIN Outchar(esc); Outchar(cursor_char); Breakoutimage;
c:=getch;
hx:=getch; lx:=getch;
hy:=getch; ly:=getch;
x:=32*(Rank(hx)-33)+Rank(lx);
y:=32*(Rank(hy)-33)+Rank(ly);
reset_tty; after_cursor:=true;
END***CURSOR***;
PROCEDURE getpos(x,y);
NAME x,y; INTEGER x,y;
BEGIN CHARACTER c;
Outchar(esc); Outchar(enq); Breakoutimage;
c:=getch; COMMENT:c is the terminal status byte and not used;
hx:=getch; lx:=getch;
hy:=getch; ly:=getch;
x:=32*(Rank(hx)-33)+Rank(lx);
y:=32*(Rank(hy)-33)+Rank(ly);
reset_tty;
END***getpos***;
COMMENT: Ascii character definitions;
amode:=Char(31); gmode:=Char(29); esc:=Char(27);
cursor_char:=Char(26); enq:=Char(5);
END***GRAPHICS***
OPTIONS(/E:CODE,RUBOUT);
PROCEDURE RUBOUT;;
COMMENT: Version 2, january 1975, $ke Blomberg;
OPTIONS(/E:CODE,GETCH);
CHARACTER PROCEDURE GETCH;;
COMMENT: Version 2, january 1975, $ke Blomberg (Jacob Palme);
OPTIONS(/E);
EXTERNAL CLASS figure;
COMMENT: Version 2, january 1975, $ke Blomberg;
REF(figure) PROCEDURE cosys(ox,x0,nx,dx,oy,y0,ny,dy);
REAL ox,oy,x0,y0,dx,dy; INTEGER nx,ny;
Comment: ox,oy origin (all measures in raster points)
x0,y0 starting coordinates of the axises
nx,ny number of tic marks on each axis
dx,dy distance between adjacent tic marks
The axises will be of length nx*dx, ny*dy;
BEGIN REF(figure) f; INTEGER i,n; REAL temp;
f:- NEW figure;
f.moveto(ox+x0,oy); f.drawto(ox+x0+nx*dx,oy);
f.moveto(ox,oy+y0); f.drawto(ox,oy+y0+ny*dy);
FOR i:=ny-1 STEP -1 UNTIL 0 DO
BEGIN temp:=oy+y0+i*dy;
f.moveto(ox-4,temp); f.drawto(ox+4,temp);
END;
n:=nx-1;
FOR i:=0 STEP 1 UNTIL n DO
BEGIN temp:=ox+x0+i*dx;
f.moveto(temp,oy+4); f.drawto(temp,oy-4);
END;
cosys:-f;
END***COSYS***
Options(/e:code,ctime);
Real procedure cptime;;
OPTIONS(/E);
CLASS figure; COMMENT: Version 4, nov 1976, $ke Blomberg;
BEGIN
TEXT t; INTEGER cc;
CHARACTER highx,lowx,highy,lowy,saved_mode,gmode,amode;
REAL origin_x,origin_y,scale_x,scale_y,xmin,xmax,ymin,ymax;
BOOLEAN sizecheck;
PROCEDURE check_length(l); INTEGER l;
BEGIN
WHILE l > t.Length DO
BEGIN TEXT new_t; new_t:-Blanks(2*t.Length);
new_t:=t; t:-new_t; t.Setpos(cc+1);
END;
END***CHECK_LENGTH***;
PROCEDURE trans_to_plotchar(x,y); REAL x,y;
BEGIN INTEGER a,b,c;
IF sizecheck THEN check_size(x,y);
a:=Entier(origin_x+scale_x*x);
b:=a//32; c:=a-32*b;
highx:=Char(32+b); lowx:=Char(64+c);
a:=Entier(origin_y+scale_y*y);
b:=a//32; c:=a-32*b;
highy:=Char(32+b); lowy:=Char(96+c);
END***TRANS_TO_PLOTCHAR***;
PROCEDURE check_size(x,y); real x,y;
BEGIN BOOLEAN fatal;
if x > xmax then xmax:=x;
if x < xmin then xmin:=x;
if y > ymax then ymax:=y;
if y < ymin then ymin:=y;
fatal:= (origin_x+scale_x*xmin < -1055) or
(origin_x+scale_x*xmax > 3071) or
(origin_y+scale_y*ymin < -1055) or
(origin_y+scale_y*ymax > 3071);
IF fatal THEN
BEGIN
OUTTEXT("FATAL FIGURE ERROR"); outimage;
OUTTEXT("CAN'T HANDLE COORDINATES OUTSIDE [-1055,3071]");
OUTIMAGE;
END;
END***check_size***;
BOOLEAN PROCEDURE On_screen;
BEGIN
on_screen:=(origin_x+scale_x*xmin >= 0) and
(origin_x+scale_x*xmax <= 1023) and
(origin_y+scale_y*ymin >= 0) and
(origin_y+scale_y*ymax <= 759);
END***On_screen***;
PROCEDURE checkon; sizecheck:=TRUE;
PROCEDURE checkoff; sizecheck:=FALSE;
PROCEDURE moveto(x,y); REAL x,y;
BEGIN trans_to_plotchar(x,y); check_length(cc+5); cc:=cc+5;
t.Putchar(gmode);
t.Putchar(highy); t.Putchar(lowy);
t.Putchar(highx); t.Putchar(lowx);
END***MOVETO***;
PROCEDURE drawto(x,y); REAL x,y;
BEGIN trans_to_plotchar(x,y); check_length(cc+4); cc:=cc+4;
t.Putchar(highy); t.Putchar(lowy);
t.Putchar(highx); t.Putchar(lowx);
END***DRAWTO***;
PROCEDURE write(string); VALUE string; TEXT string;
BEGIN check_length(cc+1+string.Length); cc:=cc+1+string.Length;
t.Putchar(amode); string.Setpos(1);
WHILE string.More DO t.Putchar(string.Getchar);
END***WRITE***;
PROCEDURE plot;
BEGIN Sysout.Image:-Blanks(cc+1);
Outtext(t.Sub(1,cc)); Outchar(amode); Breakoutimage;
Sysout.Image:-Blanks(132);
END***PLOT***;
PROCEDURE savefig(ofile); VALUE ofile; TEXT ofile;
BEGIN REF(Outfile) of; of:-NEW Outfile(ofile);
of.Open(Blanks(5)); of.Outint(cc,5); of.Outimage;
of.Image:-Blanks(cc); of.Outtext(t.Sub(1,cc));
of.Outimage; of.Close;
END***SAVEFIG***;
PROCEDURE getfig(ifile); VALUE ifile; TEXT ifile;
BEGIN INTEGER size;
REF(Infile) ifi; ifi:-NEW Infile(ifile);
ifi.Open(Blanks(5)); ifi.Inimage; size:=ifi.Inint;
ifi.Image:-Blanks(size); ifi.Inimage; t:-ifi.Image;
t.Setpos(size+1); cc:=size; ifi.Close;
END***GETFIG***;
PROCEDURE origin(ox,oy); REAL ox,oy;
BEGIN origin_x:=ox; origin_y:=oy;
END***ORIGIN***;
PROCEDURE scale(sx,sy); REAL sx,sy;
BEGIN scale_x:=sx; scale_y:=sy;
END***SCALE***;
PROCEDURE addfig(fig); REF (figure) fig;
BEGIN
check_length(cc+fig.cc);
t.Sub(cc+1,fig.cc):=fig.t.Sub(1,fig.cc);
cc:=cc+fig.cc; t.Setpos(cc+1);
END***ADDFIG***;
PROCEDURE sizefrom(fig); REF (figure) fig;
BEGIN
scale_x:=fig.scale_x; scale_y:=fig.scale_y;
origin_x:=fig.origin_x; origin_y:=fig.origin_y;
END***sizefrom***;
procedure recompute;
begin text oldt; character c,hx,lx,hy,ly;
integer oldcc,textstart,textlength; real x,y;
oldt:-copy(t); oldcc:=cc; cc:=0; oldt.setpos(1); t.setpos(1);
xmax:=-1&+30; xmin:=1&+30; ymax:=xmax; ymin:=xmin;
while cc < oldcc do
begin c:=oldt.getchar;
if c=amode then begin textstart:=oldt.pos;
while c\=gmode and oldt.pos <= oldcc do
c:=oldt.getchar; textlength:=oldt.pos-1-textstart;
write(oldt.sub(textstart,textlength));
if c=gmode then oldt.setpos(oldt.pos-1);
end
else if c=gmode then
begin hy:=oldt.getchar; ly:=oldt.getchar;
hx:=oldt.getchar; lx:=oldt.getchar;
x:=32*rank(hx)+rank(lx)-1088;
y:=32*rank(hy)+rank(ly)-1120; moveto(x,y);
end
else begin hy:=c;
ly:=oldt.getchar; hx:=oldt.getchar; lx:=oldt.getchar;
x:=32*rank(hx)+rank(lx)-1088; y:=32*rank(hy)+rank(ly)-1120;
drawto(x,y);
end;
end;
end***recompute***;
Comment: initial settings: ;
t:-Blanks(25); cc:=0; t.Setpos(1);
origin_x:=0; origin_y:=0; scale_x:=1; scale_y:=1;
amode:=Char(31); gmode:=Char(29);
sizecheck:=FALSE;
xmax:=-1&+30; xmin:=1&+30; ymax:=xmax; ymin:=xmin;
END***FIGURE***
OPTIONS(/e);
EXTERNAL CLASS figure;
COMMENT: This procedure will construct a coordinate system
suitable for a figure within the limits xmin,xmax
and ymin,ymax along x- and y-axis respectively.
Version 2, march 1975
Author: Ake Blomberg, FOA, Sweden. ;
REF(figure) PROCEDURE cosysfor(xmin,xmax,ymin,ymax);
REAL xmin,xmax,ymin,ymax;
BEGIN
REAL xleft,yleft,xlift,yshift,sx,sy,xstep,ystep,ox,oy,temp;
INTEGER i,zerox,zeroy,xtics,ytics;
TEXT labe;
REF(figure) c;
PROCEDURE axis (min,max,metric,left,tics,scale,ztep,zeropos);
NAME left,tics,scale,ztep,zeropos;
REAL min,max,metric,left,scale,ztep;
INTEGER tics,zeropos;
BEGIN
REAL width,right,bigleft,bigright,bigztep,p10,b10,a;
INTEGER nleft,nright,nbig,i,p;
width:=max-min;
p:=Entier(Ln(width)/Ln(10));
p10:=10**p; a:=width/p10; b10:=10*p10;
ztep:= IF a<=2 THEN 0.2*p10 ELSE IF a<=6 THEN 0.5*p10 ELSE p10;
nleft:=Entier(min/ztep); nright:=Entier(max/ztep)+1;
IF Abs(nleft-nright) >= 4 THEN
BEGIN
IF a>2 AND a<=6 AND Mod(nleft,2) NE 0 THEN nleft:=nleft-1;
IF a>2 AND a<=6 AND Mod(nright,2) NE 0 THEN nright:=nright+1;
END;
left:=nleft*ztep; right:=nright*ztep;
bigztep:=IF a<=5 THEN p10 ELSE b10; nbig:=Entier(left/bigztep);
bigleft:=nbig*bigztep;
IF left-bigleft <= ztep THEN left:=bigleft;
bigright:=bigleft+bigztep;
IF bigright>right AND bigright<=right+ztep THEN
right:=bigright;
width:=right-left;
nleft:=Entier(left/ztep); nright:=Entier(right/ztep);
scale:=metric/width; ztep:=scale*ztep;
zeropos:=IF min*max > 0 THEN -1 ELSE -nleft;
tics:=Abs(nleft-nright)+1;
END***axis***;
labe:-blanks(10);
axis(xmin,xmax,750,xleft,xtics,sx,xstep,zerox);
axis(ymin,ymax,500,yleft,ytics,sy,ystep,zeroy);
xlift:=IF zeroy>=0 THEN 200+zeroy*ystep ELSE 200;
yshift:=IF zerox>=0 THEN 150+zerox*xstep ELSE 150;
ox:=150-sx*xleft; oy:=200-sy*yleft;
c:-NEW figure;
c.moveto(yshift,700); c.drawto(yshift,200);
c.moveto(150,xlift); c.drawto(900,xlift);
temp:=200-ystep;
FOR i:=1 STEP 1 UNTIL ytics DO
BEGIN temp:=temp+ystep;
c.moveto(yshift+4,temp); c.drawto(yshift-4,temp);
END;
temp:=150-xstep;
FOR i:=1 STEP 1 UNTIL xtics DO
BEGIN temp:=temp+xstep;
c.moveto(temp,xlift+4); c.drawto(temp,xlift-4);
END;
c.moveto(180,110);
c.write("x-axis: y="); labe.Setpos(1);
IF zeroy >=0 THEN labe.Putchar('0') ELSE labe.Putreal(yleft,4);
c.write(labe);
c.moveto(500,110);
labe.Setpos(1); labe.Putreal(xstep/sx,4);
c.write("x-step ="); c.write(labe);
c.moveto(180,150); labe:=" ";
c.write("y-axis: x="); labe.Setpos(1);
IF zerox >=0 THEN labe.putchar('0') ELSE labe.Putreal(xleft,4);
c.write(labe);
c.moveto(500,150);
labe.Setpos(1); labe.Putreal(ystep/sy,4);
c.write("y-step ="); c.write(labe);
c.scale_y:=sy; c.origin_y:=oy;
c.scale_x:=sx; c.origin_x:=ox;
cosysfor:-c;
END********************************************************
TITLE RUBOUT ;PROCEDURE TO RUBOUT TEKTRONIX SCREEN
ENTRY RUBOUT ;************************************
;Version 2, january 1975, $ke Blomberg
ESC=33
RUB=14
C1=1
RUBOUT: MOVEI C1,ESC ;rubout screen
IONEOU C1
MOVEI C1,RUB
IONEOU C1
MOVEI C1,C1 ;sleep 1 second
CALLI C1,31
MOVE 2,-1(15) ;return to simula program
HLRZ 15,2
JRST (2)
END
TITLE GETCH ;PROCEDURE TO INPUT A SINGLE CHARACTER
;*************************************
;Version 2, january 1975
;$ke Blomberg (Jacob Palme)
SEARCH MACSIM
ENTRY GETCH
SPECIFY< PROC INCW
CHARACTER INCW>
GETCH: INCHRW INCW
RETURN
END
Title cptime ;Procedure to measure cpu time of job in ms
Entry ctime ;******************************************
;$ke Blomberg, FOA 252, Grindsj`n
Search macsim
Specify < proc cptime
real cptime
>
ac1=1
ctime: movei ac1,0 ;zero ac1
calli ac1,27 ;get job's accumulated cpu time in ms
movem ac1,t#
fltr ac1,t ;convert to floating representation
movem ac1,cptime ;return value
return ;return to Simula program
end