program MGDEMO2 (input,output);

(* Dies ist ein kleines Demonstrationsprogramm *)
(* fuer die Anwendung von TURBO.GRAF. Diese    *)
(* Version zeigt die Verwendung des Treibers   *)
(* auf der HIGH LEVEL Ebene                    *)
(*                                             *)
(*      DEMOVERSION 3.0 ( C ) ComSoft          *)
(*      f}r TURBOGRAF V 2.0 / 16.09.84         *)

(*$IMGRAF.LIB*)   (* Durch Verwendung von MGRAF wird MONOCHROME selektiert *)

procedure BEGRUESSUNG;
begin
ClrScr;
Writeln ; Writeln ; Writeln;
Writeln ('Demonstration - Program for');
Writeln ('      Turbograf V 2.0');
Writeln ('         MONOCHROME');
Writeln ('     (C) ComSoft  1984');
DELAY (500);
end;

procedure DISTR;
begin
GMODE (0);
SELCHAR (1,1);
SETTEXT (20,0,
    ' Turbograf V 2.0 / ComSoft D-8901 Stadtbergen 2, Fuggerstr. 4 ',0,0,6);
SELCHAR (1,0);
end;

procedure VIELECK;
var
X   :array [0 .. 18] of integer;
Y   :array [0 .. 18] of integer;

A,B :integer;

begin
    for A:=0 to 18 do
       begin
          X[A] := ROUND (((COS ((6.28/360) * A*20)) * 180) + 320);
          Y[A] := ROUND (((SIN ((6.28/360) * A*20)) * 180) + 200);
       end;

    GINIT;
    DISTR;
    GMODE (0);
       for B:=0 to 17 do
          for A:=B+1 to 18 do
             begin
                SETLINE (X[B],Y[B],X[A],Y[A],2);
             end;
DELAY (800);
end;


procedure CIRCLES;

var A:integer;
begin
A:=180;
GINIT;
DISTR;
repeat
    SETCIRCL (450-A,290-TRUNC(A/2),A,1);
    SETCIRCL (190+A,290-TRUNC(A/2),A,1);
    A:=A-3;
until A=3;
end;

procedure MUCHLINES;
VAR A:INTEGER;
BEGIN
GINIT;
GMODE (1);
FOR A:=0 TO 639 DO
    BEGIN
       SETLINE (320,200,A,399,1);
       SETLINE (320,200,A,0,1);
    END;
DISTR;
GMODE (1);
FOR A:=0 TO 399 DO
    BEGIN
       SETLINE (320,200,0,A,1);
       SETLINE (320,200,639,A,1);
    END;
DELAY (400);
END;
PROCEDURE RECT;
var N   :integer;

begin
GINIT;
SETTEXT (50,350,'Fast Rectangle Drawing',0,2,7);
DISTR;
for N:=1 to 15 do
       begin
         SETRECT (100+N*6,50+N*6,20+N*20,8+N*10,0,0,4);
       end;
DELAY (1500);
GCLEAR;
for N:=0 to 7 do
    begin
       SETRECT (320,200,60,60,N,0,3);
    end;
DELAY (600);
end;


procedure BOX;

var N    :integer;
M        :array [ 0 .. 3 ] of array [ 1 .. 2 ] OF INTEGER;
begin
M [ 0,1 ] := 50; M [ 0,2 ] := 50;
M [ 1,1 ] :=350; M [ 1,2 ] := 50;
M [ 2,1 ] := 50; M [ 2,2 ] := 180;
M [ 3,1 ] :=350; M [ 3,2 ] := 180;
GINIT;
SETTEXT (50,350,'Fast Box Drawing',0,2,7);
SETTEXT (70,300,'With 16 Patterns',0,2,7);
DISTR;
DELAY (600);
GMODE (0);
for N:=0 to 15 do
       begin
          GPATT (N);
          SETBOX (M [ N AND 3,1 ], M [ N AND 3,2 ],50,20,0,4,1);
          DELAY (100);
       end;
DELAY (500);
end;

procedure TEXT;

var N:CHAR;
    A:integer;

begin
GINIT;
GMODE (0);
SELCHAR (1,1);
SETTEXT (50,350,'Fully implemented',0,2,5);
SETTEXT (75,310,'Graphic Charakters',0,2,3);
DISTR;
SELCHAR (1,1);
for N:=' ' to 'z' do
      begin
      SELCHAR (1,1);
      SETTEXT (50,100,N,0,12,4);
      SELCHAR (1,0);
      SETTEXT (370,100,N,0,12,4);
      DELAY (80);
      end;
SETTEXT (370,100,' ',0,12,4);
SELCHAR (1,1);
SETTEXT (50,100,' ',0,12,4);
for A:=0 to 7 do
    begin
    SETTEXT (320,170,'In 8 Directions',A,0,1);
    DELAY (400);
    end;
SELCHAR (0,0);
end;


procedure ARC;
var A,B,C  :integer;

begin
GINIT;
GMODE (1);
DISTR;
B:=0;
C:=0;
for A:=20 to 40 do
    begin
    SETARC (320,200,A*4,B,B+100,7);
    B:=B+36;
    if B>260 then B:=0;
    end;
DELAY (500);
end;

procedure INOUT;

begin
GINIT;
SETTEXT (10,50,'Read Data from Disk ',0,1,3);
DISTR;
READSCREEN ('FELD.PIX');
DELAY (400);
end;

begin
BEGRUESSUNG;
repeat
   if not Keypressed then VIELECK;
   if not Keypressed then CIRCLES;
   if not Keypressed then MUCHLINES;
   if not Keypressed then RECT;
   if not Keypressed then BOX;
   if not Keypressed then ARC;
   if not Keypressed then TEXT;
   if not Keypressed then INOUT;
until Keypressed;
GEXIT;
end.
