home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / ega / egademo.pas < prev    next >
Pascal/Delphi Source File  |  1994-03-04  |  4KB  |  171 lines
  1. program interrupt(input,output);
  2. {this program uses the high resolution mode, 640X350 by 16 color graphics
  3.  that are available with the enhanced graphics adapter and enhanced color
  4.  monitor.  This was written by Alan Curtis, 1985.                        }
  5.  
  6. var
  7.   j,k,page : integer;
  8.  
  9. {////////////////////////////}
  10.  
  11. procedure super_hires;
  12. {set resolution to 640X350 by 16 color mode}
  13. type
  14.   result = record
  15.     al,ah,bl,bh : byte;
  16.     cx,dx,bp,si,di,ds,es,flags : integer;
  17.   end;
  18. var
  19.   int_result : result;
  20.   col : byte;
  21. begin
  22.   with int_result do begin
  23.     al := $10;  {graphics mode}
  24.     ah := $0;
  25.   end;
  26.   intr($10,int_result);  {high res mode}
  27. end;
  28.  
  29. {////////////////////////////}
  30.  
  31. procedure set_page(page : integer);
  32. {sets active display page - must have 128K of graphics memory}
  33. type
  34.   result = record
  35.     al,ah,bl,bh : byte;
  36.     cx,dx,bp,si,di,ds,es,flags : integer;
  37.   end;
  38. var
  39.   int_result : result;
  40.   b_page : byte;
  41. begin
  42.   b_page := page;
  43.   int_result.ah := $5;
  44.   int_result.al := b_page;  {active page}
  45.   intr($10,int_result);
  46. end;
  47.  
  48. {////////////////////////////}
  49.  
  50. procedure plot_point(row,col,color,page : integer);
  51. {plots a point at row,col in the specified color (0-15), at the
  52.  specific page}
  53. type
  54.   result = record
  55.     al,ah,bl,bh : byte;
  56.     cx,dx,bp,si,di,ds,es,flags : integer;
  57.   end;
  58. var
  59.   int_result : result;
  60.   b_page,b_color : byte;
  61.  
  62. begin
  63.   b_page := page;
  64.   b_color := color;
  65.   int_result.ah := $C;
  66.   int_result.bh := b_page;  {active page}
  67.   int_result.al := b_color;
  68.   int_result.dx := row;
  69.   int_result.cx := col;
  70.   intr($10,int_result);
  71. end;
  72.  
  73. {////////////////////////////}
  74.  
  75. procedure plot_line(x1,y1,x2,y2 : real; color,page : integer);
  76. {draws a line from x1,y1 to x2,y2 in the specified color}
  77. type
  78.   result = record
  79.     al,ah,bl,bh : byte;
  80.     cx,dx,bp,si,di,ds,es,flags : integer;
  81.   end;
  82. var
  83.   counter : real;
  84.   int_result : result;
  85.   dx,dy,ddx,ddy,newx,newy : real;
  86.   b_page,b_color : byte;
  87.   xmult,ymult : integer;
  88.  
  89. begin
  90.   b_page := page;
  91.   b_color := color;
  92.   int_result.ah := $C;
  93.   int_result.bh := b_page;  {active page}
  94.   int_result.al := b_color;
  95.   int_result.dx := round(y1);
  96.   int_result.cx := round(x1);
  97.   intr($10,int_result);
  98.  
  99.   dx := x2 - x1;
  100.   if dx < 0.0 then xmult := -1 else xmult := 1; {increment can be negative}
  101.   dy := y2 - y1;
  102.   if dy < 0.0 then ymult := -1 else ymult := 1;
  103.  
  104.   {before getting ratios, check for zeros in dx and dy}
  105.   if dy = 0.0 then begin
  106.     {x will be incremented by 1 through every loop, y by 0}
  107.     ddx := 1.0 * xmult;
  108.     ymult := 0;
  109.     dy := abs(dx);    {fool loop counter below}
  110.   end
  111.   else if dx = 0.0 then begin
  112.     ddx := 2;
  113.     ddy := 1 * ymult;
  114.     xmult := 0;
  115.     dx := abs(dy);    {fool loop counter}
  116.   end
  117.   else begin
  118.     ddx := abs(dx/dy);  {get ratio}
  119.     ddy := abs(dy/dx);
  120.     ddx := ddx*xmult;
  121.     ddy := ddy*ymult;
  122.   end;
  123.  
  124.   {the following initializations are used in the proceeding loops}
  125.   newy := y1;
  126.   newx := x1;
  127.   counter := 0.0;
  128.   dy := abs(dy);
  129.   dx := abs(dx);
  130.  
  131.   if abs(ddx) <= 1.0 then
  132.   while counter < dy do begin
  133.     counter := counter + 1.0;
  134.     newx := newx + ddx;
  135.     newy := newy + ymult;
  136.     int_result.ah := $C;
  137.     int_result.bh := b_page;  {active page}
  138.     int_result.al := b_color;
  139.     int_result.dx := round(newy);
  140.     int_result.cx := round(newx);
  141.     intr($10,int_result);
  142.   end
  143.  
  144.   else while counter < dx do begin  {x will be incremented by 1}
  145.     counter := counter + 1.0;
  146.     newx := newx + xmult;
  147.     newy := newy + ddy;
  148.     int_result.ah := $C;
  149.     int_result.bh := b_page;  {active page}
  150.     int_result.al := b_color;
  151.     int_result.dx := round(newy);
  152.     int_result.cx := round(newx);
  153.     intr($10,int_result);
  154.   end;
  155. end;
  156.  
  157. {****************************}
  158. {begin main}
  159. begin
  160.   super_hires;
  161.   page := 0;
  162.   set_page(page);
  163.   plot_line(0.0,0.0,639.0,0.0,9,0);
  164.   plot_line(639.0,0.0,639.0,349.0,9,0);
  165.   plot_line(639.0,349.0,0.0,349.0,9,0);
  166.   plot_line(0.0,349.0,0.0,0.0,9,0);
  167.   for j := 1 to 15 do
  168.    for k := 1 to 10 do
  169.      plot_line(j*10.0+k,1.0,349.0+j*10.0+k,350.0,j,0);
  170. end.
  171.