home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CONTOUR.ZIP / VIDEO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-12-06  |  2.1 KB  |  86 lines
  1. {$N+,E+}
  2. {video routines for contour plots
  3.  copyright 1988, Optimal Systems Laboratory, Plainfield, NJ}
  4. unit Video;
  5.  
  6. interface
  7.  
  8. uses graph, c_defs;
  9.  
  10. {procedure init_graphics;
  11.   initializes crt to graphics mode
  12.  }
  13. procedure init_graphics;
  14.  
  15. {procedure close_graphics;
  16.   restores crt to text mode
  17.  }
  18. procedure close_graphics;
  19.  
  20. {procedure make_line(block_x, block_y : integer
  21.   ;local_x_start, local_y_start, local_x_finish, local_y_finish : float
  22.   ;c_number,x_size,y_size :integer) ;
  23.  
  24.  plots a single line in a single bilinear patch
  25.  
  26.  inputs:
  27.   block_x,block_y     x,y numbers of this patch
  28.  
  29.   local_x_start,      x,y coordinates of start point relative to this patch
  30.   local_y_start
  31.  
  32.   local_x_stop,     x,y coordinates of stop point relative to this patch
  33.   local_y_stop
  34.  
  35.   c_number          number of contour for plotting, used to set color
  36.                     of line
  37.  
  38.   x_size,y_size     size of original data array (for scaling)
  39.  
  40.  }
  41. procedure make_line(block_x, block_y : integer
  42.   ;local_x_start, local_y_start, local_x_finish, local_y_finish : float
  43.   ;c_number,x_size,y_size :integer) ;
  44.  
  45. implementation
  46.  
  47. procedure init_graphics;
  48.   var
  49.     graph_driver, graph_mode, error_code : integer;
  50.  
  51.   begin
  52.     graph_driver:=detect;
  53.     initgraph(graph_driver,graph_mode,'');
  54.     error_code:=graphresult;
  55.     if (error_code<>grOK) then
  56.       begin
  57.         writeln('Graphics error=',grapherrormsg(error_code));
  58.         halt(1);
  59.       end;
  60.   end;
  61.  
  62. procedure make_line(block_x, block_y : integer
  63.   ;local_x_start, local_y_start, local_x_finish, local_y_finish : float
  64.   ;c_number,x_size,y_size :integer) ;
  65.  
  66.   var
  67.     x_start, y_start, x_finish, y_finish, color : integer;
  68.  
  69.   begin
  70.     color:=(c_number mod getmaxcolor)+1;
  71.     setcolor(color);
  72.     x_start:=round(getmaxx*(block_x+local_x_start)/(x_size-1));
  73.     y_start:=round(getmaxy*(block_y+local_y_start)/(y_size-1));
  74.     x_finish:=round(getmaxx*(block_x+local_x_finish)/(x_size-1));
  75.     y_finish:=round(getmaxy*(block_y+local_y_finish)/(y_size-1));
  76.     line(x_start,y_start,x_finish,y_finish);
  77.   end;
  78.  
  79. procedure close_graphics ;
  80.  
  81.   begin
  82.     closegraph;
  83.   end;
  84.  
  85. end.
  86.