Category : Pascal Source Code
Archive   : TFDD.ZIP
Filename : STRWRITE.PAS

 
Output of file : STRWRITE.PAS contained in archive : TFDD.ZIP

(******************************************************************************

UNIT STRWRITE


-------------------------------------------------------------------------------
Philippe Ranger (514) 274 4653
First version 26-6-90 Present version 13-7-90
-------------------------------------------------------------------------------
SPECIFICATION
Defines a class of TFDD, strWriteC, and declares, initializes and opens one
instance, sw (text file is sw.t).
Writes to strWriteC.t are stored up to 255 chars, and retrieved thru func-
tion strWriteC.res

NOTE The initial underline indicates a class-private field.
******************************************************************************)

UNIT strWrite;

INTERFACE

USES tfdd;

TYPE
strWriteC = object (tfddC)
_s: string;
function res: string;
(*Returns total write since last call of res or init*)
constructor init
end;

VAR sw: strWriteC;

IMPLEMENTATION

USES crt, dos;

CONST errorValue = 255;

{$F+}

PROCEDURE initialize; BEGIN sw.init END;


FUNCTION strWriteC.res: string; (*Returns _s and nulls _s*)
BEGIN
res := _s;
_s := ''
END;



FUNCTION write2str (var t: textRec): integer;
(*=============================================================================
PRE t open for output only;
-------------------------------------------------------------------------------
POST Device write added to _s, if within limit of 255 for length(s); any
excedent returns 255 (test through IOresult).
=============================================================================*)

VAR
selfp: ^strWriteC;
p: byte;

BEGIN
with t do begin
write2str := 0;
move (userData, selfp, sizeof(selfp));
with selfp^ do begin
if length(_s) + bufPos > 255 then begin
write2str := 255;
bufPos := 255 - length(_s);
if length(_s) = 255 then EXIT
end;
p := length(_s) + 1;
inc (_s[0], bufPos);
move (bufPtr^[0], _s[p], bufPos)
end;
bufPos := 0
end
END; (*write2str*)


CONSTRUCTOR strWriteC.init;
BEGIN
tfddC.init;
textRec(t).inoutFunc := @write2str; (*on principle*)
textRec(t).flushFunc := @write2str;
(*Flush seems to be the only function actually called for writes*)
_s := '';
rewrite (t)
END;


BEGIN INITIALIZE END.