|
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: 6912 (0x1b00)
Types: TextFile
Names: »tplotxy1«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦dd2c1b53f⟧ »tplot«
└─⟦this⟧
scope temp plotxy penup pendown plotend setplotstep
clear temp plotxy penup pendown plotend setplotstep
plotxy=set 10
penup=set 1
pendown=set 1
plotend=set 1
setplotstep=set 1
scope user plotxy penup pendown plotend setplotstep
message plotxy in tplotxy
plotxy=algol message.no list.no
80-08-07
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(form) (ignored)
8 : end buffer
9 : alpha(char) (ignored)
10: steplength(step)
;
integer dum;
own boolean pendwn,last;
own integer p,h,pb,sHX,sHY,sLY,x,y;
integer array A,M(1:20),
w(1:5),buf(1:1);
own integer bufff;
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
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:>,i,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;
MAIN:
redefarray(buf,firstaddr(bufff),512);
last:=true;
if par>0 and par<11
then begin
if par=4 then par:=2;
case par of
begin
begin
comment 1: clear/move up;
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 1;
begin
comment 2: vector;
if plotrelmode
then begin
x:=plotxstep; y:=plotystep;
end
else begin
x:=plotposx; y:=plotposy;
end;
VECT:
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;
if -,pendwn then goto PNUP;
end 2;
end 2;
begin
comment 3;
end;
begin
comment 4;
end;
begin
comment 5: penup;
if pendwn
then begin
PNUP: w(1):=29;
put(1);
pendwn:=false;
end;
penstatus:=0;
end 5;
begin
comment 6: pendown;
if -,pendwn
then begin
if plotrelmode
then vector(0,0)
else vector(plotposx,plotposy);
pendwn:=true;
end;
penstatus:=1;
end 6;
begin
comment 7;
end;
begin
comment 8: plotbufout;
transmit;
end 8;
begin
comment 9;
end;
begin
comment 10;
w(1):=plotstepno;
put(1);
end 10;
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
▶EOF◀