home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FORUM25C.ZIP / IOTXTFIL.SUB < prev    next >
Encoding:
Text File  |  1988-12-27  |  1.7 KB  |  99 lines
  1. {$ifdef testingdevices}
  2.  
  3. Procedure devicedone (VAR t:textrec; m:mstr);
  4. VAR r:registers;
  5.     cnt:integer;
  6. begin
  7.   write (usr,'Device ');
  8.   cnt:=0;
  9.   while t.name[cnt]<>#0 do begin
  10.     write (usr,t.name[cnt]);
  11.     cnt:=cnt+1
  12.   end;
  13.   writeln (usr,' ',m,'... press any key');
  14.   r.ax:=0;
  15.   intr ($16,r);
  16.   if r.al=3 then halt
  17. end;
  18.  
  19. {$endif}
  20.  
  21. {$F+}
  22.  
  23. Function opendevice;
  24. begin
  25.   {$ifdef testingdevices}  devicedone (t,'opened');  {$endif}
  26.   t.handle:=1;
  27.   t.mode:=fminout;
  28.   t.bufend:=0;
  29.   t.bufpos:=0;
  30.   opendevice:=0
  31. end;
  32.  
  33. Function closedevice;
  34. begin
  35.   {$ifdef testingdevices}  devicedone (t,'closed');  {$endif}
  36.   t.handle:=0;
  37.   t.mode:=fmclosed;
  38.   t.bufend:=0;
  39.   t.bufpos:=0;
  40.   closedevice:=0
  41. end;
  42.  
  43. Function cleardevice;
  44. begin
  45.   {$ifdef testingdevices}  devicedone (t,'cleared');  {$endif}
  46.   t.bufend:=0;
  47.   t.bufpos:=0;
  48.   cleardevice:=0
  49. end;
  50.  
  51. Function ignorecommand;
  52. begin
  53.   {$ifdef testingdevices}  devicedone (t,'ignored');  {$endif}
  54.   ignorecommand:=0
  55. end;
  56.  
  57. Function directoutchars;
  58. VAR cnt:integer;
  59. begin
  60.   for cnt:=t.bufend to t.bufpos-1 do
  61.     directoutchar (t.bufptr^[cnt]);
  62.   t.bufend:=0;
  63.   t.bufpos:=0;
  64.   directoutchars:=0
  65. end;
  66.  
  67. Function writechars;
  68. VAR cnt:integer;
  69. begin
  70.   for cnt:=t.bufend to t.bufpos-1 do
  71.     writechar (t.bufptr^[cnt]);
  72.   t.bufend:=0;
  73.   t.bufpos:=0;
  74.   writechars:=0
  75. end;
  76.  
  77. Function directinchars;
  78. begin
  79.   with t do begin
  80.     bufptr^[0]:=waitforchar;
  81.     t.bufpos:=0;
  82.     t.bufend:=1
  83.   end;
  84.   directinchars:=0
  85. end;
  86.  
  87. Function readcharfunc;
  88. begin
  89.   with t do begin
  90.     bufptr^[0]:=getinputchar;
  91.     t.bufpos:=0;
  92.     t.bufend:=1
  93.   end;
  94.   readcharfunc:=0
  95. end;
  96.  
  97. {$F-}
  98.  
  99.