Topspeed_JPI/gpm/GR_DEMO.MOD

MODULE GR_Demo;

(* GR_xxxx demonstration:
   Test code for Ellipses - Normalized Coordinates
   Use all aspect ratios, with hardware (EGA/VGA) colours in DefaultAspect
   and RBG colours in others. *)

FROM GR_Hardware   IMPORT VideoConfig, GetVideoConfig, SetVideoMode,
                          CGA_Adapter, EGA_Adapter, VGA_Adapter, HGC_Adapter,
                          CGA_Mode_4, EGA_Mode_16, VGA_Mode_18,
                          HGC_Graphics_Mode;
FROM GR_Attributes IMPORT AspectSetting, DefaultAspect, GetWriteMode,
                          MaxYAspect, SetBgColour, SetColour,
			  SetRGBBgColour, SetRGBColour,
			  SetNDCClipRect, SetNDCAspect, SetWriteMode,
			  WriteMode, xorMode,
                          White, Red, LightBlue, Yellow, Black;
FROM GR_Primitives IMPORT ClearDisplay, EllipseNDC, LineNDC;

FROM InOut    IMPORT WriteString, WriteLn, WriteCard;
FROM Terminal IMPORT GetKeyStroke;

VAR
    vinfo   : VideoConfig;
    oldMode,
    fg, bg  : CARDINAL;
    ok      : BOOLEAN;
    ch      : CHAR;
    x1, y1,
    x2, y2  : REAL;
    a       : AspectSetting;

BEGIN
    GetVideoConfig(vinfo);
    oldMode := vinfo.mode;
    IF vinfo.adapter = CGA_Adapter THEN
           ok := SetVideoMode(CGA_Mode_4);
           WriteString("set CGA"); WriteLn;
    ELSIF vinfo.adapter = EGA_Adapter THEN
           ok := SetVideoMode(EGA_Mode_16);
           WriteString("set EGA"); WriteLn;
    ELSIF vinfo.adapter = VGA_Adapter THEN
           ok := SetVideoMode(VGA_Mode_18);
           WriteString("set VGA"); WriteLn;
    ELSIF vinfo.adapter = HGC_Adapter THEN
           ok := SetVideoMode(HGC_Graphics_Mode);
           WriteString("set HGC"); WriteLn;
    ELSE
           WriteString("Graph error : unsupported video adapter.");
           WriteLn;
           HALT;
    END;
    
    GetVideoConfig(vinfo);

    FOR a := DefaultAspect TO MaxYAspect DO
	IF a = DefaultAspect THEN
	  SetBgColour(Red);
	ELSE
	  SetRGBBgColour(0.5, 0.0, 0.0); (* red - >0.75,0.0,0.0 is pink? *)
	END;
        SetNDCAspect(a);
        SetNDCClipRect(0.0, 0.0, 1.0, 1.0);
        ClearDisplay;

        EllipseNDC(-0.1, -0.1, 1.1, 1.1);
        EllipseNDC( 0.0,  0.0, 1.0, 1.0);
        EllipseNDC( 0.2,  0.2, 0.8, 0.8);

        x1 := 0.3; y1 := 0.3;
        x2 := 0.7; y2 := 0.7;
        SetNDCClipRect(x1, y1, x2, y2);
	IF a = DefaultAspect THEN
	  SetColour(Yellow);
	ELSE
          SetRGBColour(1.0, 1.0, 0.0); (* yellow *)
	END;
        LineNDC(x1, y1, x2, y1);
        LineNDC(x2, y1, x2, y2);
        LineNDC(x2, y2, x1, y2);
        LineNDC(x1, y2, x1, y1);

	IF a = DefaultAspect THEN
	  SetColour(LightBlue);
	ELSE
          SetRGBColour(0.0, 0.0, 1.0); (* (light) blue *)
	END;
        EllipseNDC(0.25, 0.25, 0.75, 0.75);
        EllipseNDC(0.3,  0.3,  0.7,  0.7);

	IF a = DefaultAspect THEN
	  SetColour(White);
	ELSE
          SetRGBColour(1.0, 1.0, 1.0); (* white *)
	END;
        EllipseNDC(0.4,  0.1,  0.6,  0.9);

        GetKeyStroke(ch);            (* wait for user to input   *)
	IF a = DefaultAspect THEN
	  SetBgColour(Black);
	ELSE
          SetRGBBgColour(0.0, 0.0, 0.0); (* black *)
	END;
        SetNDCClipRect(0.0, 0.0, 1.0, 1.0);
        ClearDisplay;
    END;  (* FOR *)

    ok := SetVideoMode(oldMode); (* return to text mode 3    *)

END GR_Demo.