DataMuseum.dk

top - download

    Length: 8960 (0x2300)
    Types: TextFile
    Names: »GSX.PAS«

└─⟦a83ac2122⟧ Bits:30002655 COBOL Level II v.2.1 og RcTekst
    └─ ⟦this⟧ »GSX.PAS« 
└─⟦c96461903⟧ Bits:30002787 SW1602 COMPAS Pascal Version 3.07 Release 1.1
    └─ ⟦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;
«eof»