|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 11520 (0x2d00)
Types: TextFile
Names: »tplotxy«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦14f79e1b8⟧ »tplot1«
└─⟦this⟧
;plotxy 1982-02-17
scope temp plotxy penup pendown plotend setplotstep selectpen selectchar
clear temp plotxy penup pendown plotend setplotstep selectpen selectchar
plotxy=set 10
penup=set 1
pendown=set 1
plotend=set 1
setplotstep=set 1
selectpen=set 1
selectchar=set 1
scope user plotxy penup pendown plotend setplotstep selectpen selectchar
message plotxy in tplotxy
plotxy=algol message.no list.no
1982-02-17
external
procedure plotxy(par);
value par;
integer par;
begin
comment par = 0 : sense (ignored)
1 : clear screen
2 : vector(x,y), 16 bit
3 : setmask(down1,up,down2) (ignored)
4 : vector(x,y), 8 bit
5 : penup
6 : pendown
7 : penformat (xform,yform,draw) <*calcomp81 only*>
8 : end buffer
9 : alpha(char) (calcomp81 only)
10: steplength(step)
11: settextparam(h,w,theta)
12: select pen(pen number)
13: select charset(charset)
14: advance paper
;
integer dum,i,j,xx,yy;
own boolean pendwn,last,charmode;
own integer p,h,pb,sHX,sHY,sLY,x,y;
integer array A,M(1:20),
w(1:20),buf(1:1);
own integer bufff;
procedure setval(w,i,val);
value val; integer i,val;
integer array w;
begin
boolean f;
f:=false;
if val>=10000 then
begin
w(i):=val//10000+48; i:=i+1;
val:=val mod 10000;
f:=true;
end;
if val>=1000 or f then
begin
w(i):=val//1000+48; i:=i+1;
val:=val mod 1000;
f:=true;
end;
if val>=100 or f then
begin
w(i):=val//100+48; i:=i+1;
val:=val mod 100;
f:=true;
end;
if val>=10 or f then
begin
w(i):=val//10+48; i:=i+1;
val:=val mod 10;
f:=true;
end;
w(i):=val+48; i:=i+1;
end setval;
procedure udskriv(i); integer i;
begin write(out,i shift (-16) extract 8,
i shift (-8) extract 8,i extract 8); outendcur(32);
end;
procedure put(n);
integer n;
begin integer i;
for i:= 1 step 1 until n do
if w(i)<>0
then begin
if pb=0 then begin
if p>255 then transmit;
p:=p+1;
pb:=16;
buf(p):=0;
end
else pb:= pb-8;
buf(p):=buf(p) + w(i) shift pb;
end;
end put;
procedure transmit;
begin integer i;
if plotrelmode
then begin p:=p+1; buf(p):=25; end;
if plottstst then
for i:=1 step 1 until p do udskriv(buf(i));
h:= 2*p;
if false and plotbs
then begin
M(1):= 5 shift 12;
M(2):= firstaddr(buf);
M(3):= M(2)+512;
BSLOOP:
i:= waitanswer(sendmessage(plotbsadd,M),A);
if i<>1 then alarm(<:<10>***bs error:>,i);
if A(1)<>0 then alarm(<:<10>bs status error:>);
if A(2)<>512 then goto BSLOOP;
plotbssegm:=plotbssegm+1;
end plotbs;
if plotpl and h>0
then begin
M(1):= 5 shift 12 + 2; comment or +4;
M(2):= firstaddr(buf);
M(3):= M(2) + h - 2;
PLLOOP:
i:=waitanswer(sendmessage(plotpda,M),A);
if i<>1
then alarm(<:<10>***plotter error:>,
case i of(<::>,<: reservation:>,
<: unintelligible (contact computer department):>,
<: disconnected :>,<::>,<::>),M(2),M(3));
if A(2) <> h
then begin
pb:= A(3) mod 3;
p:= if pb=0 or p=0 then A(2) else A(2)-2;
if plottstst
then begin write(out,<:<10>break :>,p);
udskriv(buf(p));
end;
h:= h-p;
M(2):= M(2)+p;
p:= p//2 + 1;
if pb=1 then buf(p):=buf(p) extract 16 else
if pb=2 then buf(p):=buf(p) extract 8;
if plottstst
then udskriv(buf(p));
goto PLLOOP;
end;
end plotpl;
p:=pb:=0;
end transmit;
procedure vector(x0,y0);
integer x0,y0;
begin
integer x1,y1,z;
x:=x0; y:=y0;
REP:
last:=true;
if plotrelmode and abs(x)>511
then begin
x1:=sign(x)*511;
last:=false;
end
else x1:=x;
if plotrelmode and abs(y)>511
then begin
y1:=sign(y)*511;
last:=false;
end
else y1:=y;
z:= (y1 shift (-5)) extract 5 + 1 shift 5;
if z = sHY and -,plotrelmode then w(1):=0
else w(1):=sHY:= z;
z:= (x1 shift (-5)) extract 5 + 1 shift 5;
if z = sHX and -,plotrelmode then w(3):=0
else w(3):=sHX:= z;
z:= y1 extract 5 + 3 shift 5;
if z = sLY and w(3)=0 and w(1)<>0 and -,plotrelmode then w(2):=0
else w(2):=sLY:= z;
w(4):= x1 extract 5 + 2 shift 5;
if last
then begin
if -,plotrelmode then put(4)
else
begin
w(5):=22; put(5);
end;
end
else
if plotrelmode
then begin
x:=x-x1;
y:=y-y1;
put(4);
goto REP;
end;
end vector;
MAIN:
redefarray(buf,firstaddr(bufff),512);
last:=true;
if par>0 and par<15
then begin
if charmode and par<>9 then
begin
w(1):='cr'; i:=1;
if pendwn then
begin
w(2):='I'; i:=2;
end;
put(i);
charmode:=false; pendwn:=false;
end;
if par=4 then par:=2;
case par of
begin
begin
comment 1: clear/move up;
case convtype of
begin
begin <*tektronix type*>
w(1):=27; w(2):=12;
put(2);
if -,plotrelmode
then begin transmit; wait(1);
end;
w(1):=29; put(1);
if plotrelmode then transmit;
end tektronix;
begin <*calcomp 81*>
w(1):='soh'; w(2):='P';
w(3):='#' ; w(4):='4';
put(4); transmit;
end calcomp81;
end case;
end 1;
begin
comment 2: vector;
case convtype of
begin
begin <*tektronix*>
if plotrelmode
then begin
vector(plotxstep,plotystep);
end
else vector(plotposx,plotposy);
if -,pendwn then goto PNUP;
end tektronix;
begin <*calcomp81*>
if plotrelmode then
begin
xx:=plotxstep;
yy:=plotystep;
end else
begin
xx:=plotposx;
yy:=plotposy;
end;
w(1):= 'sp';
i:=2;
if xx<0 then
begin
w(i):='-'; i:=i+1;
xx:=abs xx;
end;
setval(w,i,xx);
w(i):='/'; i:=i+1;
if yy<0 then
begin
w(i):='-'; i:=i+1;
yy:=abs yy;
end;
setval(w,i,yy);
w(i):=if plotrelmode then 'J' else 'K';
put(i);
end calcomp81;
end case;
end 2;
begin
comment 3: setmask;
w(1):='L'; i:=2;
w(2):='0'+plotxstep; i:=i+1;
w(i):=','; i:=i+1;
setval(w,i,plotystep);
put(i-1); transmit;
end;
begin
comment 4;
end;
begin
comment 5: penup;
if pendwn
then begin
PNUP: w(1):=case convtype of (29,'H');
put(1);
pendwn:=false;
end;
penstatus:=0;
end 5;
begin
comment 6: pendown;
if -,pendwn
then begin
case convtype of
begin
begin <*tektronix*>
if plotrelmode
then vector(0,0)
else vector(plotposx,plotposy);
end tektronix;
begin <*calcomp81*>
w(1):='I'; put(1);
end;
end case;
pendwn:=true;
end;
penstatus:=1;
end 6;
begin
comment 7: penformat;
i:=1;
w(i):='W'; i:=i+1; w(i):='0'; i:=i+1;
w(i):=','; i:=i+1; setval(w,i,plotxstep);
w(i):=','; i:=i+1; w(i):='0'; i:=i+1;
w(i):=','; i:=i+1; setval(w,i,plotystep);
if plotdraw then begin w(i):='V'; i:=i+1; end;
put(i); transmit;
end;
begin
comment 8: plotbufout;
transmit;
end 8;
begin
comment 9: alpha;
i:=1;
if -,charmode then
begin
w(1):='B'; i:=2;
charmode:=true;
end setcharmode;
w(i):=plotxstep;
put(i);
end;
begin
comment 10;
w(1):=plotstepno;
put(1);
end 10;
begin
comment 11: settextparam(h,w,theta);
i:=1;
w(i):='Z'; i:=i+1;
setval(w,i,plotxstep);
w(i):=','; i:=i+1;
setval(w,i,plotangle);
w(i):=','; i:=i+1;
setval(w,i,plotystep);
put(i-1); transmit;
end 11;
begin
comment 12: selectpen;
w(1):='F'; w(2):='0'+plotxstep; put(2); transmit;
end 12;
begin
comment 13: select charset;
w(1):='#'; w(2):=plotxstep;
put(2); transmit;
end 13;
begin
comment 14: paper advance;
i:=1;
w(i):='U'; i:=i+1;
setval(w,i,plotxstep);
w(i):='etx';
put(i); transmit;
end 14;
end case;
end if par;
end plotxy;
end
plotxy=changeentry plotxy plotxy plotxy plotxy plotxy plotxy plotxy.550
message penup in tplotxy
penup=algol message.no list.no
external
procedure penup;
begin
plotxy(5);
end penup;
end
message pendown in tplotxy
pendown=algol message.no list.no
external
procedure pendown;
begin
plotxy(6);
end pendown;
end
message plotend in tplotxy
plotend=algol message.no list.no
external
procedure plotend;
begin
plotxy(8);
end plotnd;
end
message setplotstep in tplotxy
setplotstep=algol message.no list.no
external
boolean procedure setplotstep(stepno);
value stepno;
integer stepno;
begin
if stepno<1 or stepno>4 then setplotstep:=false
else begin
setplotstep:=true;
plotstepno:=stepno;
plotxy(10);
end;
end setplotstep;
end
message selectpen in tplotxy
selectpen=algol
external
procedure selectpen(pen);
value pen; integer pen;
if convtype=2 and pen>=0 and pen <=8 then
begin
plotxstep:=pen;
plotxy(12);
end;
end
message selectchar in tplotxy
selectchar=algol
external
procedure selectchar(charset);
value charset; integer charset;
if convtype=2 and charset>=0 and charset<=5 then
begin
plotxstep:=charset;
plotxy(13);
end;
end
▶EOF◀