Topspeed_JPI/TS/EXAMPLES/GWINM2P.MOD

IMPLEMENTATION MODULE GWinM2P;

IMPORT GWinM2P,Graph,Storage,MATHLIB;
CONST
  PI=3.141592654;
  OneK=1024;
VAR
  vc:Graph.VideoConfig;
  CurrentMode:INTEGER;
  CurBackCol:INTEGER;

CLASS IMPLEMENTATION GWindow;

  PROCEDURE XReal(x:GCoord):GCoord;
    BEGIN
      RETURN GCoord((LONGINT(x)*LONGINT(XScale))>>10)
    END XReal;

  PROCEDURE YReal(x:GCoord):GCoord;
    BEGIN
      RETURN GCoord((LONGINT(x)*LONGINT(YScale))>>10)
    END YReal;

  PROCEDURE XPhys(x:GCoord):GCoord;
    BEGIN
      RETURN XReal(x)+XL
    END XPhys;

  PROCEDURE YPhys(x:GCoord):GCoord;
    BEGIN
      RETURN YReal(x)+YT
    END YPhys;

  PROCEDURE Colour(x:INTEGER):INTEGER;
    BEGIN
      IF x<0 THEN
        RETURN CurrentColor;
      ELSE
        RETURN x MOD NumColors
      END
    END Colour;

  PROCEDURE Open(x1,y1,x2,y2:GCoord;ColsReq:INTEGER);
    VAR
      BestMode:INTEGER;
    BEGIN
      ok:=FALSE;
      PreviousMode:=CurrentMode;
      IF (CurrentMode=Graph._DEFAULTMODE) THEN
        BestMode:=Graph._DEFAULTMODE;
        Graph.GetVideoConfig(vc);
        CASE vc.adapter OF
          Graph._VGA:
            IF ColsReq>16 THEN
              BestMode:=Graph._MRES256COLOR;
            ELSE
              BestMode:=Graph._VRES16COLOR
            END;
        | Graph._EGA:
            BestMode:=Graph._ERESCOLOR;
            IF ColsReq>16 THEN
              _GraphErr:=ErrFewerColors
            END;
        | Graph._CGA:
            IF ColsReq>2 THEN
              BestMode:=Graph._MRES4COLOR;
            ELSE
              BestMode:=Graph._HRESBW;
            END;
            IF ColsReq<4 THEN
              _GraphErr:=ErrFewerColors
            END;
        | Graph._HGC:
            BestMode:=Graph._HERCMONO;
            IF ColsReq>2 THEN
              _GraphErr:=ErrFewerColors;
            END;
        ELSE
          _GraphErr:=ErrUnknownAdapter
        END;
        IF BestMode#Graph._DEFAULTMODE THEN
          IF Graph.SetVideoMode(BestMode) THEN END;
          Graph.GetVideoConfig(vc);
          CurrentMode:=BestMode;
        END;
      END;
      NumColors:=vc.numcolors;
      ReSize(x1,y1,x2,y2);
      CurrentColor:=NumColors-1;
      CurrentBackColor:=0;
      ok:=TRUE;
    END Open;

  PROCEDURE ReSize(x1,y1,x2,y2:GCoord);
    BEGIN
      XScale:=vc.numxpixels;
      YScale:=vc.numypixels;
      XL:=XReal(x1);
      XR:=XReal(x2);
      YT:=YReal(y1);
      YB:=YReal(y2);
      XScale:=GCoord((LONGINT(vc.numxpixels)*LONGINT(x2-x1)) DIV OneK);
      YScale:=GCoord((LONGINT(vc.numypixels)*LONGINT(y2-y1)) DIV OneK);
    END ReSize;

  PROCEDURE Close();
    BEGIN
      ok:=FALSE;
      IF (PreviousMode#CurrentMode) AND
        Graph.SetVideoMode(PreviousMode) THEN END
    END Close;

  PROCEDURE AffixColor(Col,BkCol:INTEGER);
    VAR
      BC:INTEGER;
    BEGIN
      IF Col=-1 THEN
        IF Graph.SetTextColor(CurrentColor)=0 THEN END;
      ELSE
        IF Graph.SetTextColor(Col)=0 THEN END;
      END;
      IF BkCol=-1 THEN
        BC:=CurrentBackColor
      ELSE
        BC:=BkCol
      END;
      IF BC#CurBackCol THEN
        IF Graph.SetBkColor(LONGCARD(BC))=0 THEN END;
        CurBackCol:=BC
      END;
    END AffixColor;

  PROCEDURE Plot(x,y:GCoord;Col:INTEGER);
    BEGIN
      Graph.SetClipRgn(XL,YT,XR,YB);
      Graph.Plot(XPhys(x),YPhys(y),Colour(Col))
    END Plot;

  PROCEDURE Point(x,y:GCoord):INTEGER;
    BEGIN
      Graph.SetClipRgn(XL,YT,XR,YB);
      RETURN Graph.Point(XPhys(x),YPhys(y));
    END Point;

  PROCEDURE Fill(x,y:GCoord;bound:INTEGER;Flood:BOOLEAN);
    BEGIN
      Graph.SetClipRgn(XL,YT,XR,YB);
      IF Flood THEN
        Graph.FloodFill(XPhys(x),YPhys(y),Colour(-1),Colour(bound))
      ELSE
        Graph.StackFill(XPhys(x),YPhys(y),Colour(-1),Colour(bound))
      END
    END Fill;

  PROCEDURE SetColor(Col,BkCol:INTEGER);
    BEGIN
      IF Col>0 THEN
        CurrentColor:=Col MOD NumColors
      END;
      IF BkCol>0 THEN
        CurrentBackColor:=BkCol MOD NumColors
      END;
      AffixColor(-1,-1);
    END SetColor;

  PROCEDURE Clear(BkCol:INTEGER);
    BEGIN
      Graph.Rectangle(XL,YT,XR,YB,CurrentBackColor,TRUE);
    END Clear;

  PROCEDURE Rectangle(left,top,width,height:GCoord;fill:INTEGER);
    BEGIN
      Graph.SetClipRgn(XL,YT,XR,YB);
      Graph.Rectangle(XPhys(left),YPhys(top),XPhys(left+width),YPhys(top+height),
                      CurrentColor,fill#0);
    END Rectangle;

  PROCEDURE Polygon(nsides:INTEGER;px,py:ADDRESS;fill:INTEGER);
    TYPE
      GCP=ARRAY[0..20] OF CARDINAL;
      GCPP=POINTER TO GCP;
    VAR
      n:INTEGER;
      nx,ny:GCPP;
    BEGIN
      Graph.SetClipRgn(XL,YT,XR,YB);
      Storage.ALLOCATE(nx,SIZE(GCoord)*nsides);
      Storage.ALLOCATE(ny,SIZE(GCoord)*nsides);
      FOR n:=0 TO nsides DO
        nx^[n]:=XPhys(GCPP(px)^[n]);
        ny^[n]:=YPhys(GCPP(py)^[n]);
      END;
      Graph.Polygon(nsides,nx^,ny^,CurrentColor);
      Storage.DEALLOCATE(nx,SIZE(GCoord)*nsides);
      Storage.DEALLOCATE(ny,SIZE(GCoord)*nsides);
    END Polygon;

  PROCEDURE Ellipse(x,y,major,minor:GCoord;fill:INTEGER);
    BEGIN
      Graph.SetClipRgn(XL,YT,XR,YB);
      Graph.Ellipse(XPhys(x),YPhys(y),XReal(major),YReal(minor),CurrentColor,fill#0);
    END Ellipse;

  PROCEDURE Line(x1,y1,x2,y2:GCoord;Col:INTEGER);
    BEGIN
      Graph.SetClipRgn(XL,YT,XR,YB);
      Graph.Line(XPhys(x1),YPhys(y1),XPhys(x2),YPhys(y2),Colour(Col));
    END Line;

  PROCEDURE VectorFromAngle(Ang:INTEGER;VAR X,Y:GCoord);
    VAR
      RA:LONGREAL;
    BEGIN
      RA:=VAL(LONGREAL,Ang)*PI/180.0;
      X:=GCoord(1024.0*MATHLIB.Cos(RA));
      Y:=GCoord(1024.0*MATHLIB.Sin(RA));
    END VectorFromAngle;

(* Draw a proportion of an ellipse from starting position and subtended angle
StartAngle to EndAngle. The angle measurements are in degrees and measured
from the first quadrant *)
  PROCEDURE ArcServer(X,Y,Major,Minor:GCoord;StartA,EndA:INTEGER;Pie,FillQ:BOOLEAN);
    VAR
      StartX,StartY,EndX,EndY:GCoord;
    BEGIN
      VectorFromAngle(StartA,EndX,EndY);
      VectorFromAngle(EndA,StartX,StartY);
      Graph.SetClipRgn(XL,YT,XR,YB);
      IF Pie THEN
        Graph.Pie(XPhys(X),YPhys(Y),XReal(Major),YReal(Minor),
         StartX,StartY,EndX,EndY,CurrentColor,FillQ);
      ELSE
        Graph.Arc(XPhys(X),YPhys(Y),XReal(Major),YReal(Minor),
         StartX,StartY,EndX,EndY,CurrentColor);
      END
    END ArcServer;

  PROCEDURE EllipticArc(x,y,major,minor:GCoord;StartAngle,EndAngle:INTEGER);
    BEGIN
      ArcServer(x,y,major,minor,StartAngle,EndAngle,FALSE,FALSE)
    END EllipticArc;

  PROCEDURE EllipticPie(x,y,major,minor:GCoord;Start,EndAngle,FillQ:INTEGER);
    BEGIN
      ArcServer(x,y,major,minor,Start,EndAngle,TRUE,FillQ#0)
    END EllipticPie;

  PROCEDURE Cuboid(X,Y,width,height,depth:GCoord;top,fill:INTEGER);
    BEGIN
      Graph.SetClipRgn(XL,YT,XR,YB);
      Graph.Cube(top#0,XPhys(X),YPhys(Y),XPhys(X+width),YPhys(Y+height),
       XReal(depth),CurrentColor,fill#0);
    END Cuboid;

  PROCEDURE CursorPosition(x,y:GCoord);
    VAR
      rx,ry:INTEGER;
      Junk:Graph.TextCoords;
    BEGIN
      rx:=INTEGER((LONGINT(XPhys(x))*LONGINT(vc.numtextcols) DIV LONGINT(vc.numxpixels)));
      ry:=INTEGER((LONGINT(YPhys(y))*LONGINT(vc.numtextrows) DIV LONGINT(vc.numypixels)));
      Graph.SetTextWindow(1,1,vc.numtextrows,vc.numtextcols);
      Junk:=Graph.SetTextPosition(ry+1,rx+1);
      AffixColor(-1,-1)
    END CursorPosition;

  PROCEDURE CharWidth():INTEGER;
    BEGIN
      RETURN 1+INTEGER(OneK*LONGINT(vc.numxpixels) DIV
             (LONGINT(XR-XL)*LONGINT(vc.numtextcols)))
    END CharWidth;

  PROCEDURE CharHeight():INTEGER;
    BEGIN
      RETURN 1+INTEGER(OneK*LONGINT(vc.numypixels) DIV
             (LONGINT(YB-YT)*LONGINT(vc.numtextrows)))
    END CharHeight;
BEGIN
END GWindow;

BEGIN
  CurrentMode:=Graph._DEFAULTMODE;
  CurBackCol:=-1;
END GWinM2P.