home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / acc_obj0 / u_ega_0a.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  6.5 KB  |  186 lines
  1. UNIT U_EGA_0a;                       {Last mod by JFH on 05/15/95}
  2.  
  3. { EXAMPLE OF MAKING ASSESS OBJECTS (CLASSES) }
  4.  
  5. { Pgm. 07/14/95 by John F Herbster, CIS:72714,3445, Houston, TX.
  6.       for Rick Rogers (CIS:74323,3573). }
  7.  
  8. {=====} INTERFACE {====================================================}
  9.  
  10. {   For example, AutoCADD text format DXF files use two-line records.
  11.   The first line of each pair must contain an integer between 0 and
  12.   1071, called the "group code", and the second line will contain a
  13.   value in text format, but representing a text string, floating
  14.   point number (double), integer, and a couple of other formats that
  15.   I will ignore here.  The files can be a megabyte in size.
  16.     We could build our program around a loop reading the lines and
  17.   interpreting the lines; which is OK for a test or a one time use.
  18.   But, for maintenance and because there are a lot of things that we
  19.   can do to speed up the reading of the file we should split up the
  20.   reading of the file into a neat unit or two.
  21.     What the application program could really use is an object like
  22.   the following. }
  23. Type  tBasicDFXReaderCls = class
  24.     Function NextGroupCode: integer;            virtual; abstract;
  25.     { rtns next group code or -2 for EOF or -1 for not a valid code.}
  26.     Function ValStr: string;                    virtual; abstract;
  27.     { rtns value as a string.}
  28.     Function ValDbl: double;                    virtual; abstract;
  29.     { rtns value as a double or a quiet NAN (quiet Not-A-Number).}
  30.     Function ValInt: integer;                   virtual; abstract;
  31.     { rtns value as an integer or a value of -$8000.}
  32.     end;
  33.  
  34. {   Now lets define a quick and dirty real thing just for use in
  35.   testing the rest of the application. }
  36. Type  tSimpleDFXReaderCls = class (tBasicDFXReaderCls)
  37.     Chan: text;
  38.     LnNbr: longint;
  39.     fLine: string;
  40.     fCode: integer;
  41.     EC: integer;
  42.     Constructor Create (const aPath: string);
  43.     Function NextGroupCode: integer;            override;
  44.     Function ValStr: string;                    override;
  45.     Function ValDbl: double;                    override;
  46.     Function ValInt: integer;                   override;
  47.     Destructor Destroy;                         override;
  48.     end;
  49.  
  50. { Suppose the application works, but we find that the text IO is
  51.   making it very slow.  So let's define a reader object that can use
  52.   block IO. }
  53. Const MaxSizeOfBuf = 4096;
  54. Type tCharArray = array [0..MaxSizeOfBuf-1] of char;
  55. Type  tBlkIoDFXReaderCls = class (tBasicDFXReaderCls)
  56.     Chan: file;
  57.     SizeOfBuf,ii,NbrInBuf: word;
  58.     EC,fCode: integer;
  59.     pBuf: ^tCharArray;
  60.     LnNbr: longint;
  61.     fLine: string;
  62.     Constructor Create (const aPath: string);
  63.     Function NextGroupCode: integer;            override;
  64.     Function ValStr: string;                    override;
  65.     Function ValDbl: double;                    override;
  66.     Function ValInt: integer;                   override;
  67.     Destructor Destroy;                         override;
  68.     end;
  69.  
  70. { Now I should have used a general text file reader object in the
  71.   latter tBlkIoDxfReaderCls.  Then the character scanning code could
  72.   be kept separate in another unit and improved separately AND used
  73.   in other projects without change. }
  74.  
  75. {----- Some NAN (Not a Number) Stuff ------}
  76. Function NAN: single;
  77.  
  78. {=====} IMPLEMENTATION {===============================================}
  79.  
  80. {----- Implement a First (simple) Reader -----}
  81. Constructor tSimpleDFXReaderCls.Create (const aPath: string);
  82.   Begin
  83.   Inherited Create;
  84.   AssignFile(Chan,aPath);
  85.   Reset(Chan);
  86.   End;
  87. Destructor tSimpleDFXReaderCls.Destroy;
  88.   Begin
  89.   Close(Chan);
  90.   Inherited Destroy;
  91.   End;
  92. Function tSimpleDFXReaderCls.NextGroupCode: integer;
  93.   Begin
  94.   If EOF(Chan)
  95.     then Result:=-2
  96.     else begin
  97.       ReadLn(Chan,fLine); Inc(LnNbr);
  98.       Val(fLine,Result,ec);
  99.       if ec<>0
  100.         then Result:=-1
  101.         else if EOF(Chan)
  102.           then Result:=-2
  103.           else begin ReadLn(Chan,fLine); Inc(LnNbr) end;
  104.       end;
  105.   End;
  106. Function tSimpleDFXReaderCls.ValStr: string;
  107.   Begin Result:=fLine End;
  108. Function tSimpleDFXReaderCls.ValDbl: double;
  109.   Begin
  110.   Val(fLine,Result,ec);
  111.   If ec<>0 then Result:=Nan;
  112.   End;
  113. Function tSimpleDFXReaderCls.ValInt: integer;
  114.   Begin
  115.   Val(fLine,Result,ec);
  116.   If ec<>0 then Result:=-$8000;
  117.   End;
  118.  
  119. {----- Implement the reader using block IO -----}
  120. Constructor tBlkIoDFXReaderCls.Create (const aPath: string);
  121.   Begin
  122.   Inherited Create;
  123.   AssignFile(Chan,aPath);
  124.   Reset(Chan,1);
  125.   SizeOfBuf:=MaxSizeOfBuf;
  126.   GetMem(pBuf,SizeOfBuf);
  127.   End;
  128. Destructor tBlkIoDFXReaderCls.Destroy;
  129.   Begin
  130.   Close(Chan);
  131.   FreeMem(pBuf,SizeOfBuf);
  132.   Inherited Destroy;
  133.   End;
  134. Function tBlkIoDFXReaderCls.NextGroupCode: integer;
  135.   function GotMore: boolean;
  136.     begin
  137.     BlockRead(Chan,pBuf^,SizeOfBuf,NbrInBuf); ec:=IoResult; ii:=0;
  138.     If (ec=0) and (NbrInBuf=0) then ec:=-1; GotMore:=(ec=0);
  139.     end{GotMore};
  140.   function GotLine: boolean;
  141.     const CR=^M; LF=^J; var c: char;
  142.     begin
  143.     byte(fLine[0]):=0;
  144.      While (ii<NbrInBuf) or GotMore do begin
  145.        c:=pBuf^[ii]; inc(ii);
  146.        If (c<>CR) and (length(fLine)<255)
  147.          then begin inc(fLine[0]); fLine[length(fLine)]:=c end
  148.          else if c=CR
  149.            then if (ii<NbrInBuf) or GotMore
  150.              then begin if pBuf^[ii]=LF then inc(ii) end;
  151.        end{while};
  152.      GotLine:=(ec=0) and (c=CR);
  153.      end{GotLine};
  154.   Begin{NextGroupCode}
  155.   If GotLine
  156.     then Val(fLine,fCode,ec);
  157.   If ec<>0
  158.     then fCode:=-2
  159.     else if not GotLine then fCode:=-2;
  160.   Result:=fCode;
  161.   End{NextGroupCode};
  162. Function tBlkIoDFXReaderCls.ValStr: string;
  163.   Begin Result:=fLine End;
  164. Function tBlkIoDFXReaderCls.ValDbl: double;
  165.   Begin
  166.   Val(fLine,Result,ec); If ec<>0 then Result:=NAN;
  167.   End;
  168. Function tBlkIoDFXReaderCls.ValInt: integer;
  169.   Begin
  170.   Val(fLine,Result,ec); If ec<>0 then Result:=-$8000;
  171.   End;
  172.  
  173. {----- Some NAN Stuff -------------------------------------------------}
  174.  
  175. Function Nan: single;
  176.  Const QuietNanTemplate: longint = $7FC00000 or $FFFF;
  177.  Begin Result:=single(QuietNanTemplate) End;
  178.  
  179. { Besides the "quiet" NANs, "signaling" NANs are possible, too, which
  180.   will cause interrupts if they take part in calculations.  Infinities
  181.   (plus and minus) are likewise defined.  The NANs and INFs can be
  182.   tested for and the Borland RTL write text routines convert them to
  183.   the text "NAN" and "INF". }
  184.  
  185. {=====} END. {=========================================================}
  186.