home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TPROUTN.ZIP / GRAPHSRC.LBR / UTIL.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-05-15  |  2.9 KB  |  96 lines
  1. {  TURBO VIDEO UTILITY PROCEDURES
  2.  
  3.    William P. Smith,  Author.
  4.       Mitchellville, MD.
  5.       March 1985.
  6.  
  7.    Software for the Public Domain. }
  8.  
  9.  
  10. Type
  11.      Line = String[80];
  12.      GraphFileName = String[15];
  13.  
  14.  
  15. {----------------------------------------------------------------------------}
  16.  
  17. Procedure LoadGraf(Name: GraphFileName; Color: Integer);
  18.  
  19. {This procedure loads a disk file of High resolution graphics into the Buffer
  20.     and then Move's the Buffer contents into Video memory.
  21.  
  22.  The use of Move with two or more Buffers allows rapid swapping of graphics
  23.     in and out of Video!!!  This results in the appearance of motion and can
  24.     be used to construct animation or moving pictures such as the spheres in
  25.     my demonstration. }
  26.  
  27.  
  28.  
  29. Var
  30.      Scrnfil: File;
  31.      Buffer: Array[1..$4000] of Byte;
  32.      Video: Byte Absolute $B800:0000;
  33.  
  34. Begin
  35.   Assign(Scrnfil,Name); Reset(Scrnfil);
  36.   Blockread(Scrnfil,Buffer,128);
  37.   Close(Scrnfil);
  38.   Hires; Hirescolor(Color);
  39.   Move(Buffer,Video,$4000);
  40.   Repeat Until Keypressed;
  41.   Textmode(2);
  42. End;
  43.  
  44. {--------------------------------------------------------------------------}
  45.  
  46. {This procedure stores High Resolution Graphics from the screen to disk. }
  47.  
  48. Procedure GrafSave(Name: GraphFileName);
  49.  
  50.  
  51.  
  52. Var
  53.       Scrnfil: File;
  54.       Buffer: array[1..$4000] of Byte;
  55.       Video: Byte Absolute $B800:0000;
  56.  
  57. Begin
  58.   Assign(Scrnfil,Name); rewrite(Scrnfil);
  59.   Move(Video,Buffer,$4000);
  60.   Blockwrite(Scrnfil,Buffer,128);
  61.   Close(Scrnfil);
  62. End;
  63.  
  64. {----------------------------------------------------------------------------}
  65.  
  66. {This procedure writes text with the selected Video attribute.  This allows
  67.  full access to any combination of reverse, intensified, and blinking text
  68.  display. Note: VideoSeg=$B000 for IBM Monochrome Display, otherwise
  69.  VideoSeg=$B800.}
  70.  
  71. Procedure Vwrite(St: Line; Attribute: Byte);
  72. var X,Y,i: Integer;
  73. begin
  74.   X:=whereX; Y:=whereY;
  75.   write(st);
  76.   for i:=1 to length(St) do mem[VideoSeg:2*((Y-1)*80+i+X-2)+1]:=attribute;
  77. end;
  78.       {-------------------  ATTRIBUTE BYTE  ---------------------------}
  79.       {        BIT: Effect                                             }
  80.       {          7: Blink              0=normal      1=blinking        }
  81.       {      6,5,4: Background       000=black     111=white           }
  82.       {          3: Intensity          0=normal      1=intensified     }
  83.       {      2,1,0: Foreground       000=black     111=white           }
  84.       {----------------------------------------------------------------}
  85. {begin
  86.   Vwrite('normal',$7); writeln;
  87.   Vwrite('reverse',$70); writeln;
  88.   Vwrite('blinking',$87); writeln;
  89.   Vwrite('blinking intensified',$8F); writeln;
  90.   Vwrite('reverse intensified',$78); writeln;
  91.   Vwrite('intensified',$F); writeln;
  92.   Vwrite('reverse blinking',$F0); writeln;
  93.   Vwrite('reverse blinking intensified',$F8);
  94. end.}
  95.  
  96.