DataMuseum.dk

Presents historical artifacts from the history of:

CP/M

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CP/M

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - download

⟦e25f7d9b3⟧ TextFile

    Length: 8832 (0x2280)
    Types: TextFile
    Names: »GSX.PAS«

Derivation

└─⟦74e5ee6fb⟧ Bits:30002683 PolyPascal-86 v. 3.11 - Piccoline
└─⟦74e5ee6fb⟧ Bits:30003934 SW1402 PolyPascal v3.11 (dk) til Piccoline
    └─ ⟦this⟧ »GSX.PAS«

TextFile

CONST
  maxintin  = 80;	æ Maximum number of input integers å
  maxptsin  = 4;	æ Maximum number of input points å
  maxintout = 80;	æ Maximum number of output integers å
  maxptsout = 2;	æ Maximum number of output points å

TYPE
  coor      = RECORD
		x,y: integer;
	      END;
  stringin  = STRINGÆmaxintinÅ;
  stringout = STRINGÆmaxintoutÅ;

VAR
  contrl    : ARRAYÆ1..9Å OF integer;
  intin     : ARRAYÆ1..maxintinÅ OF integer;
  ptsin     : ARRAYÆ1..maxptsinÅ OF coor;
  intout    : ARRAYÆ1..maxintoutÅ OF integer;
  ptsout    : ARRAYÆ1..maxptsoutÅ OF coor;
  wsintout  : ARRAYÆ1..45Å OF integer;
  wsptsout  : ARRAYÆ1..6Å OF coor;
  actual    : integer;

æ$R-,K-å

PROCEDURE gsx(VAR ctrl,inti,ptsi,into,ptso);
TYPE
  gsxpb = RECORD
	    ctrlp,intip,ptsip,intop,ptsop: ^integer;
	  END;
  rpack = RECORD
	    ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
	  END;
VAR
  pb: gsxpb;
  rp: rpack;
BEGIN
  pb.ctrlp:=addr(ctrl);
  pb.intip:=addr(inti); pb.ptsip:=addr(ptsi);
  pb.intop:=addr(into); pb.ptsop:=addr(ptso);
  rp.cx:=$473; rp.dx:=ofs(pb); rp.ds:=seg(pb);
  swint(224,rp);
END;

PROCEDURE gsxc(func,npts,nint: integer);
BEGIN
  contrlÆ1Å:=func; contrlÆ2Å:=npts; contrlÆ4Å:=nint;
  gsx(contrl,intin,ptsin,intout,ptsout);
END;

PROCEDURE gsxp(func,npts: integer; VAR ptsin);
BEGIN
  contrlÆ1Å:=func; contrlÆ2Å:=npts; contrlÆ4Å:=0;
  gsx(contrl,intin,ptsin,intout,ptsout);
END;

PROCEDURE gsxi(func,value: integer);
BEGIN
  intinÆ1Å:=value; gsxc(func,0,1); actual:=intoutÆ1Å;
END;

PROCEDURE gsxx(func,value: integer);
BEGIN
  ptsinÆ1Å.x:=value; ptsinÆ1Å.y:=0;
  gsxc(func,1,0); actual:=ptsoutÆ1Å.x;
END;

PROCEDURE gsxy(func,value: integer);
BEGIN
  ptsinÆ1Å.x:=0; ptsinÆ1Å.y:=value;
  gsxc(func,1,0); actual:=ptsoutÆ1Å.y;
END;

PROCEDURE openws(id: integer);
CONST
  wsinti: ARRAYÆ2..10Å OF integer = (1,1,1,1,1,1,1,1,1);
BEGIN
  intinÆ1Å:=id; move(wsinti,intinÆ2Å,18);
  contrlÆ1Å:=1; contrlÆ2Å:=0; contrlÆ4Å:=10;
  gsx(contrl,intin,ptsin,wsintout,wsptsout);
END;

PROCEDURE initws(VAR wsintin);
BEGIN
  contrlÆ1Å:=1; contrlÆ2Å:=0; contrlÆ4Å:=10;
  gsx(contrl,wsintin,ptsin,wsintout,wsptsout);
END;

PROCEDURE closews;
BEGIN
  gsxc(2,0,0);
END;

PROCEDURE clearws;
BEGIN
  gsxc(3,0,0);
END;

PROCEDURE updatews;
BEGIN
  gsxc(4,0,0);
END;

PROCEDURE polyline(npts: integer; VAR ptsin);
BEGIN
  gsxp(6,npts,ptsin);
END;

PROCEDURE linetype(typ: integer);
BEGIN
  gsxi(15,typ);
END;

PROCEDURE linewidth(width: integer);
BEGIN
  gsxx(16,width);
END;

PROCEDURE polymark(npts: integer; VAR ptsin);
BEGIN
  gsxp(7,npts,ptsin);
END;

PROCEDURE marktype(typ: integer);
BEGIN
  gsxi(18,typ);
END;

PROCEDURE markscale(scale: integer);
BEGIN
  gsxy(19,scale);
END;

PROCEDURE bar(x1,y1,x2,y2: integer);
BEGIN
  contrlÆ6Å:=1;
  ptsinÆ1Å.x:=x1; ptsinÆ1Å.y:=y1;
  ptsinÆ2Å.x:=x2; ptsinÆ2Å.y:=y2;
  gsxc(11,2,0);
END;

PROCEDURE arc(startang,endang,xctr,yctr,xstart,ystart,
  xend,yend,radius: integer);
BEGIN
  contrlÆ6Å:=2;
  intinÆ1Å:=startang; intinÆ2Å:=endang;
  ptsinÆ1Å.x:=xctr; ptsinÆ1Å.y:=yctr;
  ptsinÆ2Å.x:=xstart; ptsinÆ2Å.y:=ystart;
  ptsinÆ3Å.x:=xend; ptsinÆ3Å.y:=yend;
  ptsinÆ4Å.x:=radius; ptsinÆ4Å.y:=0;
  gsxc(11,4,2);
END;

PROCEDURE pie(startang,endang,xctr,yctr,xstart,ystart,
  xend,yend,radius: integer);
BEGIN
  contrlÆ6Å:=3;
  intinÆ1Å:=startang; intinÆ2Å:=endang;
  ptsinÆ1Å.x:=xctr; ptsinÆ1Å.y:=yctr;
  ptsinÆ2Å.x:=xstart; ptsinÆ2Å.y:=ystart;
  ptsinÆ3Å.x:=xend; ptsinÆ3Å.y:=yend;
  ptsinÆ4Å.x:=radius; ptsinÆ4Å.y:=0;
  gsxc(11,4,2);
END;

PROCEDURE circle(xctr,yctr,radius: integer);
BEGIN
  contrlÆ6Å:=4;
  ptsinÆ1Å.x:=xctr; ptsinÆ1Å.y:=yctr;
  ptsinÆ2Å.x:=xctr+radius; ptsinÆ2Å.y:=yctr;
  ptsinÆ3Å.x:=radius; ptsinÆ3Å.y:=0;
  gsxc(11,3,0);
END;

PROCEDURE polyfill(npts: integer; VAR ptsin);
BEGIN
  gsxp(9,npts,ptsin);
END;

PROCEDURE cellarray(rowlen,width,height,mode: integer;
  x1,y1,x2,y2: integer; VAR colorindex);
BEGIN
  contrlÆ1Å:=10; contrlÆ2Å:=2; contrlÆ4Å:=1;
  contrlÆ6Å:=rowlen; contrlÆ7Å:=width;
  contrlÆ8Å:=height; contrlÆ9Å:=mode;
  ptsinÆ1Å.x:=x1; ptsinÆ1Å.y:=y1;
  ptsinÆ2Å.x:=x2; ptsinÆ2Å.y:=y2;
  gsx(contrl,colorindex,ptsin,intout,ptsout);
END;

PROCEDURE filltype(typ: integer);
BEGIN
  gsxi(23,typ);
END;

PROCEDURE fillstyle(index: integer);
BEGIN
  gsxi(24,index);
END;

PROCEDURE gtext(x,y: integer; s: stringin);
VAR
  i: integer;
BEGIN
  FOR i:=1 TO len(s) DO intinÆiÅ:=ord(sÆiÅ);
  ptsinÆ1Å.x:=x; ptsinÆ1Å.y:=y; gsxc(8,1,len(s));
END;

PROCEDURE charheight(height: integer;
  VAR charw,charh,cellw,cellh: integer);
BEGIN
  gsxy(12,height);
  charw:=ptsoutÆ1Å.x; charh:=ptsoutÆ1Å.y;
  cellw:=ptsoutÆ2Å.x; cellh:=ptsoutÆ1Å.y;
END;

PROCEDURE charupvec(angle: integer);
CONST
  f1800 = 0.001745329252; (* PI/1800 *)
BEGIN
  intinÆ1Å:=angle;
  intinÆ2Å:=round(100.0*cos(angle*f1800));
  intinÆ3Å:=round(100.0*sin(angle*f1800));
  gsxc(13,0,3); actual:=intoutÆ1Å;
END;

PROCEDURE textfont(font: integer);
BEGIN
  gsxi(21,font);
END;

PROCEDURE setcolor(index,red,green,blue: integer);
BEGIN
  intinÆ1Å:=index; intinÆ2Å:=red;
  intinÆ3Å:=green; intinÆ4Å:=blue;
  gsxc(14,0,4);
END;

PROCEDURE linecolor(index: integer);
BEGIN
  gsxi(17,index);
END;

PROCEDURE markcolor(index: integer);
BEGIN
  gsxi(20,index);
END;

PROCEDURE textcolor(index: integer);
BEGIN
  gsxi(22,index);
END;

PROCEDURE fillcolor(index: integer);
BEGIN
  gsxi(25,index);
END;

PROCEDURE writemode(mode: integer);
BEGIN
  gsxi(32,mode);
END;

PROCEDURE inputmode(device,mode: integer);
BEGIN
  intinÆ1Å:=device; intinÆ2Å:=mode; gsxc(33,0,2);
END;

PROCEDURE rqlocator(device,xin,yin: integer;
  VAR status,term,xout,yout: integer);
BEGIN
  inputmode(1,1); intinÆ1Å:=device;
  ptsinÆ1Å.x:=xin; ptsinÆ1Å.y:=yin;
  gsxc(28,1,1);
  status:=contrlÆ5Å; term:=intoutÆ1Å;
  xout:=ptsoutÆ1Å.x; yout:=ptsoutÆ1Å.y;
END;

PROCEDURE smlocator(device: integer;
  VAR status,xout,yout: integer);
BEGIN
  inputmode(1,2); intinÆ1Å:=device;
  gsxc(28,0,1); status:=contrlÆ5Å;
  xout:=ptsoutÆ1Å.x; yout:=ptsoutÆ1Å.y;
END;

PROCEDURE rqvaluator(device,vin: integer;
  VAR status,vout: integer);
BEGIN
  inputmode(2,1); intinÆ1Å:=device; intinÆ2Å:=vin;
  gsxc(29,0,2); status:=contrlÆ5Å; vout:=intoutÆ1Å;
END;

PROCEDURE smvaluator(device: integer;
  VAR status,vout: integer);
BEGIN
  inputmode(2,2); intinÆ1Å:=device;
  gsxc(29,0,1); status:=contrlÆ5Å; vout:=intoutÆ1Å;
END;

PROCEDURE rqchoice(device,cin: integer;
  VAR status,cout: integer);
BEGIN
  inputmode(3,1); intinÆ1Å:=device; intinÆ2Å:=cin;
  gsxc(30,0,2); status:=contrlÆ5Å; cout:=intoutÆ1Å;
END;

PROCEDURE smchoice(device: integer;
  VAR status,cout: integer);
BEGIN
  inputmode(3,2); intinÆ1Å:=device;
  gsxc(30,0,1); status:=contrlÆ5Å; cout:=intoutÆ1Å;
END;

PROCEDURE rqstring(device,maxlen,mode: integer;
  VAR s: stringout);
VAR
  i: integer;
BEGIN
  inputmode(4,1); intinÆ1Å:=device;
  intinÆ2Å:=maxlen; intinÆ3Å:=mode;
  gsxc(31,0,3); sÆ0Å:=chr(intoutÆ5Å);
  FOR i:=1 TO contrlÆ5Å DO sÆiÅ:=chr(intoutÆiÅ);
END;

PROCEDURE inqcolor(rindex,flag: integer;
  VAR sindex,red,green,blue: integer);
BEGIN
  intinÆ1Å:=rindex; intinÆ2Å:=flag;
  gsxc(26,0,2);
  sindex:=intoutÆ1Å; red:=intoutÆ2Å;
  green:=intoutÆ3Å; blue:=intoutÆ4Å;
END;

PROCEDURE escp(func,npts,nint: integer);
BEGIN
  contrlÆ6Å:=func; gsxc(5,npts,nint);
END;

PROCEDURE escn(func: integer);
BEGIN
  contrlÆ6Å:=func; gsxc(5,0,0);
END;

PROCEDURE inqcells(VAR row,col: integer);
BEGIN
  escn(1); row:=intoutÆ1Å; col:=intoutÆ2Å;
END;

PROCEDURE entergraf;
BEGIN escn(2); END;

PROCEDURE exitgraf;
BEGIN escn(3); END;

PROCEDURE cursorup;
BEGIN escn(4); END;

PROCEDURE cursordown;
BEGIN escn(5); END;

PROCEDURE cursorright;
BEGIN escn(6); END;

PROCEDURE cursorleft;
BEGIN escn(7); END;

PROCEDURE cursorhome;
BEGIN escn(8); END;

PROCEDURE eraeos;
BEGIN escn(9); END;

PROCEDURE eraeol;
BEGIN escn(10); END;

PROCEDURE cursor(row,col: integer);
BEGIN
  intinÆ1Å:=row; intinÆ2Å:=col; escp(11,0,2);
END;

PROCEDURE ctext(s: stringin);
VAR
  i: integer;
BEGIN
  FOR i:=1 TO len(s) DO intinÆiÅ:=ord(sÆiÅ);
  escp(12,0,len(s));
END;

PROCEDURE reverseon;
BEGIN escn(13); END;

PROCEDURE reverseoff;
BEGIN escn(14); END;

PROCEDURE inqcursor(VAR row,col: integer);
BEGIN
  escn(15); row:=intoutÆ1Å; col:=intoutÆ2Å;
END;

PROCEDURE inqtablet(VAR status: integer);
BEGIN
  escn(16); status:=intoutÆ1Å;
END;

PROCEDURE hardcopy;
BEGIN escn(17); END;

PROCEDURE gcursor(x,y: integer);
BEGIN
  ptsinÆ1Å.x:=x; ptsinÆ1Å.y:=y; escp(18,1,0);
END;

PROCEDURE remgcur;
BEGIN escn(19); END;