DataMuseum.dk

top - download

    Length: 7808 (0x1e80)
    Types: TextFile
    Names: »GSX.PAS«

└─⟦a1337913c⟧ Bits:30002679 PGM1 - indeholder forskellige undervisningsprogrammer
    └─ ⟦this⟧ »GSX.PAS« 

TextFile

(* FØLGENDE PROCEDURER ER FJERNET:
   ARC,PIE,CIRCLE,CELLARRAY,TEXTFONT,SETCOLOR,INQCOLOR,INQTABLET.
*)

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 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 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 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 HARDCOPY;
CONST BIT : ARRAY(.0..7.) OF BYTE = ($01,$02,$04,$08,$10,$20,$40,$80);
VAR SCREEN : ARRAY(.0..34,BYTE.) OF INTEGER AT $D000:$0000;
    DY : 0..7;
    Y  : 0..256;
    X  : 0..559;
    ASC: BYTE;
BEGIN
  WRITE(LST,@27,'>',@27,'T16',@27,'E');
  Y:=0;
  REPEAT
    WRITE(LST,@27,'F0103',@27,'S0560');
    FOR X:=0 TO 559 DO BEGIN
      ASC:=0;
      FOR DY:=0 TO 7 DO
        IF (SCREEN(.X DIV 16,Y+DY.) SHL (X MOD 16)) AND $8000=$8000 THEN
          ASC:=ASC+BIT(.DY.);
      WRITE(LST,CHR(ASC))
    END;
    WRITELN(LST);
    Y:=Y+8
  UNTIL Y=256;
  WRITE(LST,@27,'c1')
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»