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