home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TPRO.ZIP / TPRO6.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-01-26  |  4.8 KB  |  149 lines
  1. {
  2.  
  3.                    T P R O    N U M B E R    6
  4.  
  5.    The following is a set of procedures that we have been used in
  6. various commercial programs. Feel free to use them for commercial
  7. and noncomercial uses. We claim no responsibility to the outcome of
  8. the use of these procedures. You are using them at your own risk.
  9. Enough of the legalities. If you find these routines useful, we
  10. would greatly appreciate any small donation.
  11.  
  12.  
  13.  
  14.  
  15.                                 Soft-Touch Computers
  16.                                 James Billmeyer
  17.                                 7716 Balboa Blvd, Unit D
  18.                                 Van Nuys, Ca  91406
  19.  }
  20.  
  21. program get_put_test;
  22.  
  23.  
  24. (*****************************************************************)
  25. (*  This program demonstrates the getascii/putascii procedures.  *)
  26. (*  These procedures are used in the same manner as the get/put  *)
  27. (*  procedures described  on page  173,174  of the Turbo Pascal  *)
  28. (*  3.0 manual. These procedures are designed  to only  work in  *)
  29. (*  the text mode of the graphics card or the monochrome card.   *)
  30. (*  The variable buffer size is determined by the equation:      *)
  31. (*       buffer size = ((abs(x1 - x2) * abs(y1 - y2)) + 2        *)
  32. (*  The first two bytes store the height  and width information  *)
  33. (*  on the object or screen image "gotten".                      *)
  34. (*  If speed is more important than  screen flash,  then change  *)
  35. (*  the following lines:                                         *)
  36. (*           repeat until  (port[$3DA] and $8) > 0;              *)
  37. (*                              to         ^^                    *)
  38. (*           repeat until  (port[$3DA] and $9) > 0;              *)
  39. (*                                         ^^                    *)
  40. (*****************************************************************)
  41.  
  42. type
  43.    buf_type = array[1..296] of integer;
  44.  
  45. var
  46.    buffer1,
  47.    buffer2  : buf_type;
  48.    calcscr  : file of buf_type;
  49.    i        : integer;
  50.  
  51.  
  52. procedure putascii(buffer: buf_type; x1,y1: integer);
  53.  
  54. (**************************************************)
  55. (*  This procedure is an ascii equivilant to the  *)
  56. (*  putpic procedure.                             *)
  57. (**************************************************)
  58.  
  59. const
  60.    segment = $B000;
  61.    offset  = $8000;    (* this constant would be $0000 for monochrome *)
  62.  
  63. var
  64.    counter,
  65.    row,j,
  66.    bytes    : integer;
  67.    screen   : array[1..4096] of integer absolute segment:offset;
  68.  
  69. begin
  70.    counter := 3;
  71.    bytes := (buffer[1] + 1) * 2;
  72.    for  row := y1  to  (y1 + buffer[2])  do
  73.       begin
  74.          j := ((row - 1) * 80) + x1;
  75.          repeat until  (port[$3DA] and $8) > 0;
  76.          port[$3D8] := 33;
  77.          move(buffer[counter],screen[j],bytes);
  78.          port[$3D8] := 41;
  79.          counter := counter + buffer[1] + 1;
  80.       end;
  81. end;
  82.  
  83.  
  84.  
  85. procedure getascii(var buffer: buf_type; x1,y1,x2,y2: integer);
  86.  
  87. (**************************************************)
  88. (*  This procedure is an ascii equivilant to the  *)
  89. (*  getpic procedure.                             *)
  90. (**************************************************)
  91.  
  92. const
  93.    segment = $B000;
  94.    offset  = $8000;    (* this constant would be $0000 for monochrome *)
  95.  
  96. var
  97.    counter,
  98.    row,col,
  99.    j,i,bytes  : integer;
  100.    screen   : array[1..4096] of integer absolute segment:offset;
  101.  
  102. begin
  103.    counter := 3;
  104.    buffer[1] := abs(x1 - x2);
  105.    buffer[2] := abs(y1 - y2);
  106.    col := x1;
  107.    bytes := (buffer[1] + 1) shl 2;
  108.    for  row := y1  to  y2  do
  109.       begin
  110.          j := ((row - 1) * 80) + x1;
  111.          repeat until  (port[$3DA] and $8) > 0;
  112.          port[$3D8] := 33;
  113.          move(screen[j],buffer[counter],bytes);
  114.          port[$3D8] := 41;
  115.          counter := counter + buffer[1] + 1;
  116.       end;
  117. end;
  118.  
  119.  
  120.  
  121. begin
  122.    clrscr;
  123.  
  124. (* I am reading in a predefined screen symbol here to display later *)
  125.  
  126.    assign(calcscr,'calc.scr');
  127.    reset(calcscr);
  128.    read(calcscr,buffer1);
  129.    close(calcscr);
  130.  
  131.    writeln('This is a test of the ascii get and put operations.');
  132.    writeln('This is a test of the ascii get and put operations.');
  133.    writeln('This is a test of the ascii get and put operations.');
  134.    writeln('This is a test of the ascii get and put operations.');
  135.    writeln('This is a test of the ascii get and put operations.');
  136.    writeln('This is a test of the ascii get and put operations.');
  137.    writeln('This is a test of the ascii get and put operations.');
  138.    writeln('This is a test of the ascii get and put operations.');
  139.    for  i := 1  to  12  do
  140.       begin
  141.          if  i <> 1  then
  142.             putascii(buffer2,(i - 1),(i - 1));
  143.          getascii(buffer2,i,i,(i + 20),(i + 13));
  144.          putascii(buffer1,i,i);
  145.       end;
  146. end.
  147.  
  148. er2,(i - 1),(i - 1));
  149.          getascii(buffer