DataMuseum.dk

top - metrics - download

    Length: 4352 (0x1100)
    Types: TextFile
    Names: »PUFGSX.PAS«

└─⟦456974178⟧ Bits:30002875 Pascal-bibliotek til tegning af streg-grafik på Piccoline
    └─⟦this⟧ »PUFGSX.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;
  mousestat,termv:integer;
  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 closews;
BEGIN
  gsxc(2,0,0);
END;

PROCEDURE clearws;
BEGIN
  gsxc(3,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 polyfill(npts: integer; VAR ptsin);
BEGIN
  gsxp(9,npts,ptsin);
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 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 textcolor(index: integer);
BEGIN
  gsxi(22,index);
END;

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

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

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

PROCEDURE smlocator(device: integer; VAR status,xout,yout:integer);
BEGIN
 inputmode(1,2);
 intinÆ1Å:=device;
 gsxc(28,1,1); status:=contrlÆ5Å;
 xout:=ptsoutÆ1Å.x;yout:=ptsoutÆ1Å.y;
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 gcursor(x,y: integer);
BEGIN
  ptsinÆ1Å.x:=x; ptsinÆ1Å.y:=y; escp(18,1,0);
END;

PROCEDURE remgcur;
BEGIN escn(19); END;

PROCEDURE ENTERGRAF;
BEGIN ESCN(2); END;

PROCEDURE EXITGRAF;
BEGIN ESCN(3); END;
«eof»