Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/23/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