home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TEGA02.ZIP / TPDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-02-28  |  11.2 KB  |  426 lines
  1. program Demo;
  2.  
  3. {                                                                              }
  4. {   Program:     Demo, Version 01/20/86                                        }
  5. {                                                                              }
  6. {   Description: Demonstrate some of the EGA graphic routines.                 }
  7. {                                                                              }
  8. {   Author:      Kent Cedola                                                   }
  9. {                2015 Meadow Lake Court, Norfolk VA, 23518. 1-(804)-857-0613   }
  10. {                                                                              }
  11. {   Language:    Turbo Pascal, V3.01A                                          }
  12. {                                                                              }
  13. {   Comments:    This program only includes the graphic routines needed to     }
  14. {                save space and time for BBS's.  If you would like a complete  }
  15. {                set of EGA graphic routines (FREE), please let me know.       }
  16. {                                                                              }
  17.  
  18. {$K- }
  19.  
  20. {$I GPPARMS.P }
  21. {$I GPINIT.P  }
  22. {$I GPTERM.P  }
  23. {$I GPCOLOR.P }
  24. {$I GPSTYLE.P }
  25. {$I GPSHADE.P }
  26. {$I GPPAL.P   }
  27. {$I GPPLOT.P  }
  28. {$I GPBOX.P   }
  29. {$I GPBALL.P  }
  30. {$I GPMOVE.P  }
  31. {$I GPLINE.P  }
  32. {$I GPRECT.P  }
  33. {$I GPCIR.P   }
  34. {$I GPFLOOD.P }
  35. {$I GPFILL.P  }
  36. {$I GPWINDOW.P }
  37. {$I GPVIEWPO.P }
  38. {$I GPSCALE.P  }
  39. {$I GPCLIP2.P  }
  40. {$I World.P   }
  41.  
  42. var
  43.   x,y:    integer;
  44.   stat:   integer;
  45.   Ch:     char;
  46.  
  47.   buff:   array [0..15] of Byte;
  48.   Shade:  array [0..15] of Byte;
  49.  
  50. procedure InitGraphics;
  51. begin
  52.   GPPARMS;                             { Sets up all global variables  }
  53.  
  54.   if GDTYPE = 4 then                    { Give monochrome user bad news }
  55.     begin
  56.       writeln('Sorry, must have a Color Display not monochrome!');
  57.       halt(1);
  58.     end
  59.   else if GDTYPE <> 5 then              { Tell non-EGA users no can run }
  60.     begin
  61.       writeln('Enhanced Color Adapter and Display not found!');
  62.       halt(2);
  63.     end;
  64.  
  65.   if GDMEMORY = 64 then                 { We need lots of EGA memory    }
  66.     begin
  67.       writeln('This program will work much better with 128k+ EGA memory!');
  68.       writeln('    Hit any key to continue!');
  69.       Read(Kbd,Ch);
  70.    end;
  71.  
  72.   GPINIT;                              { We are now in graphic mode!   }
  73.  
  74.   buff[0] := 4;
  75.   buff[1] := Green;
  76.   buff[2] := Green;
  77.   buff[3] := Blue;
  78.   buff[4] := Blue;
  79.  
  80.   GPSTYLE(buff);
  81.  
  82. end;
  83.  
  84. procedure TermGraphics;
  85. begin
  86.  
  87.   GPTERM;                              { Terminate graphic mode        }
  88.  
  89. end;
  90.  
  91. {
  92.   Example on how to fill(flood) an area on the screen.
  93.  
  94.   Written to test logic for 3-D hidden line removal.  (works).
  95. }
  96.  
  97. procedure TestFill;
  98. begin
  99.  
  100.   GPCOLOR(White);                      { Draw a white line across the screen }
  101.   GPMOVE(0,0);
  102.   GPLINE(GDMAXCOL,GDMAXROW);
  103.  
  104.   GPCOLOR(Red);                        { Draw a Red rectangle }
  105.   GPMOVE(50,50);
  106.   GPRECT(300,100);
  107.  
  108.   Read(KBD,Ch);
  109.  
  110.   GPCOLOR(Green);                      { Fill in the area as GREEN }
  111.   GPMOVE(60,60);      { VERY IMPORTANT: must set starting location }
  112.   GPFLOOD(Red);                        { Red = border for flood }
  113.  
  114.   Read(KBD,Ch);
  115.  
  116.   GPCOLOR(Blue);                       { Fill as Blue }
  117.   GPFLOOD(Red);
  118.  
  119.   Read(KBD,Ch);
  120.  
  121.   GPCOLOR(Red);                        { Fill as Red }
  122.   GPFLOOD(Red);
  123.  
  124.   Read(KBD,Ch);
  125.  
  126. end;
  127.  
  128. procedure TitlePage;
  129. begin { TitlePage }
  130.  
  131.   GPCOLOR(Black);
  132.   GPMOVE(0,0);
  133.   GPBOX(GDMAXCOL,GDMAXROW);
  134.  
  135.   TextColor(Cyan);
  136.   GotoXY( 3,2); Write('KC-TPDEMO Beta');
  137.   GotoXY(24,2); Write('Demonstration of Turbo Pascal & EGA');
  138.   GotoXY(68,2); Write('KC-Graphics');
  139.  
  140.   GPCOLOR(Green);
  141.   GPMOVE(0,0);
  142.   GPRECT(GDMAXCOL,GDMAXROW);
  143.   GPMOVE(4,3);
  144.   GPRECT(GDMAXCOL-4,38);
  145.   GPMOVE(4,41);
  146.   GPRECT(124,346);
  147.   GPMOVE(128,41);
  148.   GPRECT(635,346);
  149.  
  150. end; { TitlePage }
  151.  
  152. procedure MapPage;
  153. const
  154.   World: array [0..1250] of Integer =
  155.     (
  156.     168,2,16,3,16,3,15,4,14,6,14,6,12,8,12,9,10,10,10,12,9,15,9,17,10,
  157.     19,11,25,11,27,12,27,13,30,13,30,12,28,12,28,10,26,10,26,9,28,8,30,8,
  158.     30,9,32,10,32,9,33,9,33,12,31,12,32,13,35,13,35,11,37,9,39,9,36,12,
  159.     39,12,39,10,40,9,43,9,46,12,46,14,43,17,40,15,40,14,42,14,43,13,42,12,
  160.     40,12,40,13,38,14,38,16,34,16,30,19,30,20,33,22,34,22,34,25,37,21,
  161.     36,19,39,17,40,17,41,18,41,19,43,18,44,22,46,23,46,24,45,24,45,25,
  162.     45,26,46,26,46,28,43,27,43,26,45,25,42,25,39,25,40,27,40,30,37,30,
  163.     32,35,32,37,28,39,29,43,28,44,27,43,26,40,24,40,24,41,21,41,18,44,
  164.     18,46,17,47,19,49,21,48,21,46,24,46,22,51,25,51,25,55,28,55,28,56,
  165.     29,56,32,53,35,55,36,54,42,58,44,58,45,60,45,62,47,62,48,64,51,64,
  166.     54,66,54,68,52,71,52,76,48,80,48,83,45,87,45,88,42,91,42,94,43,95,
  167.     43,99,45,100,42,100,43,99,41,100,38,96,35,88,35,83,34,76,30,74,30,73,
  168.     26,66,26,62,28,57,27,56,24,56,22,53,21,53,21,52,19,52,19,51,16,51,
  169.     12,49,13,47,10,40,11,46,10,46,8,42,8,38,7,37,7,32,11,27,12,27,12,26,
  170.     11,24,12,19,9,17,7,18,6,18,6,19,4,19,2,20,2,16,
  171.     5,
  172.     31,8,34,7,35,8,32,9,31,8,
  173.     4,
  174.     34,9,36,9,34,11,34,9,
  175.     5,
  176.     36,7,38,7,38,8,36,8,36,7,
  177.     40,
  178.     42,7,46,4,44,4,43,6,41,6,41,5,44,4,48,2,50,2,51,3,50,4,54,3,58,3,61,1,
  179.     64,1,65,3,67,3,67,4,65,8,64,8,62,10,63,10,63,11,59,12,58,14,57,14,
  180.     53,19,51,18,49,14,51,12,51,11,52,11,52,8,48,8,47,7,50,4,48,4,45,8,
  181.     44,7,42,7,
  182.     6,
  183.     62,13,66,13,67,14,64,16,62,14,62,13,
  184.     7,
  185.     25,46,26,45,28,45,31,47,29,48,29,47,25,46,
  186.     5,
  187.     32,47,34,48,32,49,31,48,32,47,
  188.     5,
  189.     78,5,80,5,81,6,79,7,78,5,
  190.     4,
  191.     81,4,82,4,82,5,81,4,
  192.     4,
  193.     81,6,82,6,82,7,81,6,
  194.     8,
  195.     94,10,94,8,97,6,98,6,98,7,95,9,95,10,94,10,
  196.     9,
  197.     96,70,98,69,98,68,99,67,100,70,98,76,96,77,95,75,96,70,
  198.     5,
  199.     140,20,143,23,143,25,142,25,140,20,
  200.     5,
  201.     143,26,145,26,146,27,144,29,143,26,
  202.     9,
  203.     145,29,147,30,147,33,143,36,142,35,144,34,142,34,145,32,145,29,
  204.     5,
  205.     139,40,140,40,140,43,139,42,139,40,
  206.     7,
  207.     140,46,141,45,142,48,143,50,142,50,139,48,140,46,
  208.     4,
  209.     140,51,140,52,139,53,140,51,
  210.     4,
  211.     142,50,143,52,142,52,142,50,
  212.     10,
  213.     144,52,145,53,144,56,143,55,143,54,142,54,142,53,142,52,143,52,144,52,
  214.     9,
  215.     138,54,140,54,140,60,138,62,135,62,134,60,134,57,136,57,138,54,
  216.     8,
  217.     141,58,144,58,144,59,142,59,143,64,141,64,140,62,141,58,
  218.     5,
  219.     145,58,146,58,146,59,145,59,145,58,
  220.     15,
  221.     147,59,149,59,150,60,152,60,156,62,158,64,160,64,158,66,160,68,157,68,
  222.     155,66,152,67,151,64,148,62,147,59,
  223.     4,
  224.     143,66,140,66,140,67,141,67,
  225.     2,
  226.     143,67,144,66,
  227.     13,
  228.     160,86,162,86,163,90,160,93,159,92,154,96,152,96,152,95,158,91,
  229.     159,92,159,90,161,89,160,86,
  230.     26,
  231.     133,85,134,83,134,76,136,74,138,74,143,70,145,70,148,68,150,68,
  232.     150,70,152,72,153,68,154,68,156,76,158,78,152,88,146,89,148,90,
  233.     148,91,146,92,146,89,144,84,139,84,139,85,134,85,133,84,
  234.     10,
  235.     126,55,127,55,133,61,132,65,136,66,137,65,136,64,131,64,126,57,126,55,
  236.     9,
  237.     68,20,70,19,71,20,71,22,72,23,72,24,68,25,69,22,68,20,
  238.     5,
  239.     68,22,68,24,66,24,67,22,68,22,
  240.     178,
  241.     65,36,60,44,60,52,66,57,74,57,74,60,77,64,77,68,76,70,76,73,81,83,
  242.     86,83,91,76,91,73,94,70,94,66,93,64,93,62,100,54,100,51,96,52,
  243.     92,47,90,40,94,46,96,50,100,49,102,48,105,44,103,42,108,42,110,45,
  244.     112,45,113,52,115,55,116,55,117,52,117,55,118,55,118,53,117,52,
  245.     118,48,122,44,127,51,127,53,130,58,132,58,132,57,128,52,128,50,
  246.     132,54,134,52,134,50,132,46,132,44,136,44,138,42,139,36,136,34,
  247.     136,32,134,32,134,30,137,30,139,34,140,34,141,33,139,30,139,28,
  248.     141,28,141,28,136,18,136,16,141,16,141,14,143,14,143,18,147,21,
  249.     148,20,145,15,148,12,147,10,150,10,149,8,146,8,144,7,138,7,138,8,
  250.     134,8,134,7,126,7,126,8,122,8,122,7,115,7,114,5,110,5,110,4,108,4,
  251.     106,2,104,4,105,4,105,3,106,3,106,5,108,5,108,7,106,7,102,9,104,12,
  252.     102,12,100,8,99,8,99,10,100,12,94,12,92,13,91,11,90,11,90,14,88,15,
  253.     88,14,89,13,84,10,82,10,74,17,74,20,76,19,79,21,80,20,80,17,82,14,
  254.     84,16,82,18,83,20,80,22,76,22,76,20,75,20,75,22,70,26,69,26,70,28,
  255.     70,29,66,29,65,33,67,34,71,33,71,31,76,29,79,33,79,34,80,34,80,31,
  256.     76,28,79,28,83,34,83,32,86,31,86,28,88,28,89,29,90,27,92,27,91,28,
  257.     93,30,88,30,85,33,86,34,90,34,90,38,86,38,83,36,80,38,76,36,76,34,
  258.     71,34,70,35,67,35,65,36,
  259.     5,
  260.     96,28,98,27,100,34,98,34,96,28,
  261.     -34
  262.     );
  263. var
  264.   x,y,i,j: Integer;
  265.  
  266. begin
  267.   SetViewport(129,42,634,345);
  268.   SetWindow(-10,-11,180,129);
  269.  
  270.   GPCOLOR(Black);
  271.   GPMOVE(129,42);
  272.   GPBOX(634,345);
  273.  
  274.   GPCOLOR(Green);
  275.   i := 0;
  276.   while World[i] > 0 do
  277.     begin
  278.     j := World[i] - 1;
  279.     MovAbs(World[i+1],World[i+2]);
  280.     i := i + 3;
  281.     while j > 0 do
  282.       begin
  283.       LnAbs(World[i],World[i+1]);
  284.       j := j - 1;
  285.       i := i + 2;
  286.       end;
  287.     end;
  288.  
  289.   readln;
  290.  
  291.   Shade[0] := 2;
  292.   Shade[1] := 2;
  293.   Shade[2] := Blue;
  294.   Shade[3] := Green;
  295.   Shade[4] := Green;
  296.   SHade[5] := Blue;
  297.  
  298.   GPSHADE(Shade);
  299.   GPMOVE(131,44);
  300.   GPFLOOD(Green);
  301.  
  302.   GPCOLOR(Blue);
  303.   GPMOVE(390,259);
  304.   GPRECT(510,341);
  305.  
  306.   SetViewport(390,259,510,341);
  307.   SetWindow(-10,-11,180,129);
  308.  
  309.   GPCOLOR(Red);
  310.   i := 0;
  311.   while World[i] > 0 do
  312.     begin
  313.     j := World[i] - 1;
  314.     MovAbs(World[i+1],World[i+2]);
  315.     i := i + 3;
  316.     while j > 0 do
  317.       begin
  318.       LnAbs(World[i],World[i+1]);
  319.       j := j - 1;
  320.       i := i + 2;
  321.       end;
  322.     end;
  323.  
  324.   SetViewport(0,0,GDMaxCol,GDMaxRow);
  325.   SetWindow(0,0,GDMaxCol,GDMaxRow);
  326. end;
  327.  
  328. procedure BoxPage;
  329.   var x1,y1,x2,y2: Integer;
  330.  
  331. begin { BoxPage }
  332.  
  333.   GPCOLOR(LightGray);
  334.   GPMOVE(129,42);
  335.   GPBOX(634,345);
  336.  
  337.   TextColor(LightGray);
  338.   GotoXY(41,24); write(' Hit any key to end ');
  339.  
  340.   while not KeyPressed do
  341.     begin
  342.     x1 := random(GDMaxCol - 130) + 130;
  343.     y1 := random(GDMaxRow - 43) + 43;
  344.     x2 := random(GDMaxCol - 144) + 130;
  345.     y2 := random(GDMaxRow - 43) + 43;
  346.  
  347.     if x1 < 130 then x1 := 130;
  348.     if y1 < 43  then y1 := 43;
  349.     if x2 > 633 then x2 := 633;
  350.     if y2 > 314 then y2 := 314;
  351.  
  352.     if (x1 < x2) and (y1 < y2) then
  353.       begin
  354.       if x2 - x1 > 300 then x2 := x1 + (x2 - x1) div 4;
  355.       if y2 - y1 > 150 then y2 := y1 + (y2 - y1) div 4;
  356.       GPCOLOR(Black);
  357.       GPMOVE(x1-1,y1-1);
  358.       GPRECT(x2+1,y2+1);
  359.       GPCOLOR(random(16));
  360.       GPMOVE(x1,y1);
  361.       GPBOX(x2,y2);
  362.       end;
  363.     end;
  364.  
  365. end;  { BoxPage }
  366.  
  367. procedure CirclePage;
  368.   var x,y,r,c: Integer;
  369.  
  370. begin { CirclePage }
  371.  
  372.   GPVIEWPORT(129,42,634,345);
  373.  
  374.   GPCOLOR(LightGray);
  375.   GPMOVE(129,42);
  376.   GPBOX(634,345);
  377.  
  378.   TextColor(LightGray);
  379.   GotoXY(41,24); write(' Hit any key to end ');
  380.  
  381.   while not KeyPressed do
  382.     begin
  383.     x := random(GDMaxCol - 129) + 129;
  384.     y := random(GDMaxRow - 42) + 42;
  385.     r := random(50);
  386.  
  387.     if x < 130 then x := 130;
  388.     if x > 633 then x := 633;
  389.     if y < 43  then y := 43;
  390.     if y > 344 then y := 344;
  391.  
  392.     GPCOLOR(Random(16));
  393.     GPMOVE(x,y);
  394.     GPBALL(r);
  395.  
  396.     end;
  397.  
  398. end;  { CirclePage }
  399.  
  400. begin { Main program }
  401.  
  402.   InitGraphics;
  403.  
  404.   TestFill;
  405.  
  406.   TitlePage;
  407.   Read(KBD,Ch);
  408.  
  409.   MapPage;
  410.   Read(KBD,Ch);
  411.  
  412.   GPPAL(1,50);
  413.   Read(KBD,Ch);
  414.  
  415.   GPPAL(1,1);
  416.  
  417.   Read(KBD,Ch);
  418.  
  419.   BoxPage;
  420.  
  421.   CirclePage;
  422.  
  423.   TermGraphics;
  424.  
  425. end.
  426.