IMPLEMENTATION MODULE GSXMAIN;

FROM SYSTEM IMPORT ADR, BDOS;

PROCEDURE ResetAddr;			        (* Set up parablock addresses *)
BEGIN
  WITH PB DO
    CTRLADD := ADR ( CB     );
    CINADD  := ADR ( CARDIN );
    PINADD  := ADR ( PTSIN  );
    COUTADD := ADR ( CARDOUT);
    POUTADD := ADR ( PTSOUT );
  END;
END ResetAddr;

PROCEDURE ResetPara;				   (* Set no input parameters *)
BEGIN
  WITH CB DO
    PINLEN := 0;
    CINLEN := 0;
  END;
END ResetPara;

PROCEDURE simple ( Opcode : CARDINAL ); (* some GSX calls need only an opcode *)
BEGIN
  CB.OPCODE := Opcode;
  BDOS ( 115, ADR ( PB ) );
  ResetPara;
END simple;

PROCEDURE simplESC ( Opcode : CARDINAL );        (* ESC calls with ESC opcode *)
BEGIN
  CB.ESCID := Opcode;
  simple ( 5 );
END simplESC;

PROCEDURE oneCARD ( Opcode, Para : CARDINAL );  (* calls with one CARDIN para *)
BEGIN
  CARDIN[1] := Para;
  CB.CINLEN := 1;
  simple ( Opcode );
END oneCARD;

PROCEDURE SetText ( Text : ARRAY OF CHAR );  (* used to transfer text -> CARDIN *)
VAR i, m : CARDINAL;
    c    : CHAR;
BEGIN
  i := 0;
  m := HIGH ( Text );
  IF m > CinLen THEN m := CinLen; END;
  LOOP
    c := Text[i];
    IF ORD ( c ) = 0 THEN EXIT END;
    INC ( i );
    CARDIN[i] := CARDINAL ( c );
    IF i > m THEN EXIT END;
  END;
  CB.CINLEN := i;
END SetText;

PROCEDURE numPTS ( Opcode, Number : CARDINAL; VAR Points : ARRAY OF VECTOR );
BEGIN
  CB.PINLEN := Number;
  PB.PINADD := ADR ( Points );
  simple ( Opcode );
  ResetAddr;
END numPTS;

(***********************************************************************************)

PROCEDURE OpenStation ( Identifier : CARDINAL );
BEGIN
  WITH PB DO
    CINADD  := ADR ( OpenParas );
    COUTADD := ADR ( OpenCards );
    POUTADD := ADR ( OpenPtrs  );
  END;
  OpenParas[1] := Identifier;
  CB.CINLEN := 10;
  simple ( 1 );
  ResetAddr;
END OpenStation;

PROCEDURE CloseStation;
BEGIN
  simple ( 2 );
END CloseStation;

PROCEDURE ClearStation;
BEGIN
  simple ( 3 );
END ClearStation;

PROCEDURE UpdateStation;
BEGIN
  simple ( 4 );
END UpdateStation;

PROCEDURE GraphMode;
BEGIN
  simplESC ( 2 );
END GraphMode;

PROCEDURE TextMode;
BEGIN
  simplESC ( 3 );
END TextMode;

PROCEDURE HardCopy;
BEGIN
  simplESC ( 17 );
END HardCopy;

PROCEDURE SetCursor ( X,Y : CARDINAL );
BEGIN
  PTSIN[1].X := X;
  PTSIN[1].Y := Y;
  CB.PINLEN  := 1;
  simplESC ( 18 );
END SetCursor;

PROCEDURE RemoveCursor;
BEGIN
  simplESC ( 19 );
END RemoveCursor;

PROCEDURE DefineColor ( Index, Red, Green, Blue : CARDINAL );
BEGIN
  CARDIN[1] := Index;
  CARDIN[2] := Red;
  CARDIN[3] := Green;
  CARDIN[4] := Blue;
  CB.CINLEN := 4;
  simple ( 14 );
END DefineColor;

PROCEDURE ExamineColor ( Index : CARDINAL; Realized : BOOLEAN );
BEGIN
  CARDIN[1] := Index;
  CARDIN[2] := ORD ( Realized );
  CB.CINLEN := 2;
  PB.COUTADD:= ADR ( ColorExamined );
  simple ( 26 );
  ResetAddr;
END ExamineColor;

PROCEDURE DrawMode ( Mode : CARDINAL );
BEGIN
  oneCARD ( 32, Mode );
END DrawMode;

BEGIN (* Initialisation *)
  ResetAddr;
  ResetPara;
  OpenParas[1] := CRT;			    (* default workstation identifier *)
  OpenParas[2] := 1;			    (* default polyline type = solid  *)
  OpenParas[3] := 7;			    (* default polyline color = white *)
  OpenParas[4] := 3;			    (* default marker type = asterix  *)
  OpenParas[5] := 7;			    (* default marker color = white   *)
  OpenParas[6] := 1;			    (* default text font = first one  *)
  OpenParas[7] := 7;			    (* default text color = white     *)
  OpenParas[8] := 0;			    (* default fill style = hollow    *)
  OpenParas[9] := 1;			    (* default fill index = first one *)
  OpenParas[10]:= 7;			    (* default fill color = white     *)
END GSXMAIN.