home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / visionix / vstrtxtu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-12-28  |  8.8 KB  |  481 lines
  1. {
  2.  ════════════════════════════════════════════════════════════════════════════
  3.  
  4.  Visionix StringList Text File Device Driver Unit (VStrTxtU)
  5.    Version 0.6
  6.  Copyright 1991,92,93 Visionix
  7.  ALL RIGHTS RESERVED
  8.  
  9.  ────────────────────────────────────────────────────────────────────────────
  10.  
  11.  Revision history in reverse chronological order:
  12.  
  13.  Initials  Date      Comment
  14.  ────────  ────────  ────────────────────────────────────────────────────────
  15.  
  16.  jrt       11/02/93  Changed to use stringlists in VSTRING;
  17.                      renamed VStrTxtU
  18.  
  19.  jrt       10/27/93  Renamed from VATM to VATMU for beta 0.30
  20.  
  21.  lpg       03/15/93  Added Source Documentation
  22.  
  23.  mep       02/11/93  Cleaned up code for beta release
  24.  
  25.  jrt       02/08/93  Sync with beta 0.12 release
  26.  
  27.  jrt       12/07/92  Sync with beta 0.11 release
  28.  
  29.  jrt       11/21/92  Sync with beta 0.08
  30.  
  31.  jrt       09/01/92  First logged revision.
  32.  
  33.  ════════════════════════════════════════════════════════════════════════════
  34. }
  35.  
  36. (*-
  37.  
  38. [TEXT]
  39.  
  40. <Overview>
  41.  
  42. This unit implements a text file device driver that will write to a
  43. VSTRINGu string list.  This provides a flexable mechanism to use the
  44. Write and WriteLn commands to format strings.
  45.  
  46. <Interface>
  47.  
  48. -*)
  49.  
  50. Unit VStrTxtu;
  51.  
  52. Interface
  53.  
  54. Uses
  55.  
  56.   VTypesu,
  57.   VStringu,
  58.   DOS;
  59.  
  60. {────────────────────────────────────────────────────────────────────────────}
  61.  
  62. Procedure VStrTextAssign(     Var F              : Text;
  63.                                   SL             : PStrList     );
  64.  
  65. Function  VStrTextGetLines(   Var F              : Text         ) : INTEGER;
  66.  
  67.  
  68. {────────────────────────────────────────────────────────────────────────────}
  69.  
  70. Implementation
  71.  
  72. Type
  73.  
  74.   TST_Info = RECORD
  75.  
  76.     SL        : PStrList;
  77.     CurLine   : WORD;
  78.     Buffer    : Array[0..255] of CHAR;
  79.  
  80.   END;
  81.  
  82.   PST_Info = ^TST_Info;
  83.  
  84.   {----}
  85.  
  86. Var
  87.  
  88.   HandlesGiven : BYTE;
  89.  
  90.   ST_InfoList : Array[1..32] of PST_Info;
  91.  
  92. {────────────────────────────────────────────────────────────────────────────}
  93.  
  94. (*-
  95.  
  96. [FUNCTION]
  97.  
  98. Function VST_NullRoutine(     Var F              : TEXTREC      ):INTEGER;
  99.  
  100. [PARAMETERS]
  101.  
  102. F           VAR TextFile Record Handle
  103.  
  104. [RETURNS]
  105.  
  106. [DESCRIPTION]
  107.  
  108. [SEE-ALSO]
  109.  
  110. [EXAMPLE]
  111.  
  112. -*)
  113.  
  114. Function VST_NullRoutine(     Var F              : TEXTREC      ):INTEGER;
  115. Far;
  116.  
  117. BEGIN
  118.  
  119.   VST_NullRoutine := 0;
  120.  
  121. END;  { VST_NullRoutine }
  122.  
  123. {────────────────────────────────────────────────────────────────────────────}
  124.  
  125. (*-
  126.  
  127. [FUNCTION]
  128.  
  129. Function VST_InOutRoutine( var F : TEXTREC ) : INTEGER; Far;
  130.  
  131. [PARAMETERS]
  132.  
  133. F           VAR TextFile Handle Record
  134.  
  135. [RETURNS]
  136.  
  137. [DESCRIPTION]
  138.  
  139. [SEE-ALSO]
  140.  
  141. [EXAMPLE]
  142.  
  143. -*)
  144.  
  145. Function VST_InOutRoutine( var F : TEXTREC ) : INTEGER; Far;
  146.  
  147. Var
  148.   Loopy   : INTEGER;
  149.   Ch      : CHAR;
  150.   ST_Info : PST_Info;
  151.   S       : STRING;
  152.  
  153. BEGIN
  154.  
  155.   If F.Handle <> 0 Then
  156.   BEGIN
  157.  
  158.     S := '';
  159.  
  160.     With F Do
  161.     BEGIN
  162.  
  163.       ST_Info := ST_InfoList[ Handle ];
  164.  
  165.       Loopy := 0;
  166.  
  167.       While Loopy < BufPos Do
  168.       BEGIN
  169.  
  170.         Case BufPtr^[Loopy] Of
  171.  
  172.           #10 :
  173.           BEGIN
  174.  
  175.             {------------------------------------------}
  176.             { put the string into the string list, and }
  177.             { move onto the next line                  }
  178.             {------------------------------------------}
  179.  
  180.             IF S<>'' Then
  181.               VStrListPutStr( ST_Info^.SL,
  182.                               ST_Info^.CurLine,
  183.                               VStrListGetStr( ST_Info^.SL,
  184.                                               ST_Info^.CurLine )+ S );
  185.  
  186.             S := '';
  187.  
  188.             Inc( ST_Info^.CurLine );
  189.  
  190.           END;
  191.  
  192.           #13 :
  193.           BEGIN
  194.           END;
  195.  
  196.         Else
  197.  
  198.           S := S + BufPtr^[Loopy];
  199. (*
  200.           ST_INfo^.Menu^[ ST_Info^.CurLine ]:=
  201.                  ST_INfo^.Menu^[ ST_Info^.CurLine ]+ BufPtr^[Loopy];
  202. *)
  203.  
  204.         END;  { Case BufPtr^[Loopy] }
  205.  
  206.         Inc( Loopy );
  207.  
  208.       END;  { While Loopy }
  209.  
  210.       {---------------------------------------------}
  211.       { add the remainder to the string in the list }
  212.       {---------------------------------------------}
  213.  
  214.       If S<>'' Then
  215.         VStrListPutStr( ST_Info^.SL,
  216.                         ST_Info^.CurLine,
  217.                         VStrListGetStr( ST_Info^.SL,
  218.                                         ST_Info^.CurLine )+ S );
  219.  
  220.  
  221.       BufPos := 0;
  222.  
  223.       VST_InOutRoutine :=0;
  224.  
  225.     END;   { With F }
  226.  
  227.   END
  228.   Else  { If F.Handle / Else }
  229.  
  230.     VST_InOutRoutine := 1;
  231.  
  232. END;   { Of InOutRoutine }
  233.  
  234. {────────────────────────────────────────────────────────────────────────────}
  235.  
  236. (*-
  237.  
  238. [FUNCTION]
  239.  
  240. Function VST_CloseRoutine(    Var F              : TEXTREC      ):INTEGER;
  241.  
  242. [PARAMETERS]
  243.  
  244. F           VAR TextFile Record Handle
  245.  
  246. [RETURNS]
  247.  
  248. [DESCRIPTION]
  249.  
  250. [SEE-ALSO]
  251.  
  252. [EXAMPLE]
  253.  
  254. -*)
  255.  
  256. Function VST_CloseRoutine(    Var F              : TEXTREC      ):INTEGER;
  257. Far;
  258.  
  259. Var
  260.   Z : INTEGER;
  261.  
  262. BEGIN
  263.  
  264.   If F.Handle <> 0 Then
  265.   BEGIN
  266.  
  267.     {------------------------}
  268.     { Flush by calling InOut }
  269.     {------------------------}
  270.  
  271.     Z := VST_InOutRoutine( F );
  272.  
  273.     {------------------------}
  274.     { Dispose of the ST_Info }
  275.     {------------------------}
  276.  
  277.     Dispose( ST_InfoList[ F.Handle ] );
  278.  
  279.     ST_InfoList[ F.Handle ] := NIL;
  280.  
  281.     {-------------------------}
  282.     { Zero out the handle and }
  283.     { return.                 }
  284.     {-------------------------}
  285.  
  286.     F.Handle         := 0;
  287.  
  288.     VST_CloseRoutine := 0;
  289.  
  290.   END;  { If F.Handle }
  291.  
  292. END;  { VST_CloseRoutine }
  293.  
  294. {────────────────────────────────────────────────────────────────────────────}
  295.  
  296. (*-
  297.  
  298. [FUNCTION]
  299.  
  300. Procedure VStrTextAssign(     Var F              : Text;
  301.                                   StrList        : POINTER      );
  302.  
  303. [PARAMETERS]
  304.  
  305. F           VAR Text File Handle to Assign to Menu
  306. StrList     Pointer to a string list
  307.  
  308. [RETURNS]
  309.  
  310. (None)
  311.  
  312. [DESCRIPTION]
  313.  
  314. Assigns the Text File Device Driver (TFDD) Handle "F" to a string list.
  315. Subseqent Write operations to F will fill in the assigned string list.
  316.  
  317.   F                   Turbo Pascal TFDD Handle.
  318.   Menu                Pointer to string list
  319.  
  320. [SEE-ALSO]
  321.  
  322. [EXAMPLE]
  323.  
  324. -*)
  325.  
  326. Procedure VStrTextAssign(     Var F              : Text;
  327.                                   SL             : PStrList     );
  328.  
  329. Type
  330.  
  331.   PTextRec = ^TextRec;
  332.  
  333. Var
  334.  
  335.   ST_Info : PST_Info;
  336.   F2      : PTextRec;
  337.   Z       : INTEGER;
  338.  
  339. BEGIN
  340.  
  341.   F2 := @F;
  342.  
  343.   With F2^ Do
  344.   BEGIN
  345.  
  346.     {----------------------------}
  347.     { Make a new ST_Info record, }
  348.     { F.Handle will point to it. }
  349.     {----------------------------}
  350.  
  351.     New( ST_Info );
  352.  
  353.     ST_Info^.SL      := SL;
  354.     ST_Info^.CurLine := 1;
  355.  
  356.     {-----------------}
  357.     { Setup rest of F }
  358.     {-----------------}
  359.  
  360.     Mode      := fmOutput;
  361.  
  362.     BufSize   := SizeOf( ST_Info^.Buffer );
  363.     BufPtr    := @ST_Info^.Buffer;
  364.  
  365.     OpenFunc  := @VST_NullRoutine;
  366.     FlushFunc := @VST_InOutRoutine;
  367.     CloseFunc := @VST_CloseRoutine;
  368.     InOutFunc := @VST_InOutRoutine;
  369.  
  370.     BufPos    := 0;
  371.  
  372.     { Search for handle slot }
  373.  
  374.     Z := 0;
  375.  
  376.     Repeat
  377.       Inc( Z );
  378.     Until (ST_InfoList[Z]=NIL) or (Z=32);
  379.  
  380.     If ST_InfoList[Z]=NIL Then
  381.     BEGIN
  382.  
  383.       Handle                := Z;
  384.       ST_InfoList[ Handle ] := ST_Info;
  385.  
  386.     END  { If ST_InfoList[z] }
  387.  
  388.     ELSE
  389.       Handle := 0;
  390.  
  391.   END;  { With F2^ }
  392.  
  393. END;  { VAssignToMenu }
  394.  
  395. {────────────────────────────────────────────────────────────────────────────}
  396.  
  397. (*-
  398.  
  399. [FUNCTION]
  400.  
  401. Function  VST_GetCurLine(     Var F              : Text         ) : INTEGER;
  402.  
  403. [PARAMETERS]
  404.  
  405. F           VAR Text File Handle (previously assigned to a menu)
  406.  
  407. [RETURNS]
  408.  
  409. Current Line number in Assigned Menu
  410.  
  411. [DESCRIPTION]
  412.  
  413. The Current Number of Lines in the Menu Assigned to the Text File.
  414.  
  415. VST_GetCurLine returns the current number of lines in the menu
  416. assigned to "F".
  417.  
  418.  F                   Turbo Pascal TFDD Handle that has
  419.                      previously been assigned to a menu.
  420.  
  421. [SEE-ALSO]
  422.  
  423. [EXAMPLE]
  424.  
  425. -*)
  426.  
  427. Function  VStrTextGetLines(   Var F              : Text         ) : INTEGER;
  428.  
  429. BEGIN
  430.  
  431.   VStrTextGetLines := ST_InfoList[ TextRec( F ).Handle ]^.CurLine;
  432.  
  433. END;  { VST_GetCurLine }
  434.  
  435. {────────────────────────────────────────────────────────────────────────────}
  436.  
  437. (*-
  438.  
  439. [FUNCTION]
  440.  
  441. Procedure InitST_InfoList;
  442.  
  443. [PARAMETERS]
  444.  
  445. (None)
  446.  
  447. [RETURNS]
  448.  
  449. (None)
  450.  
  451. [DESCRIPTION]
  452.  
  453. [SEE-ALSO]
  454.  
  455. [EXAMPLE]
  456.  
  457. -*)
  458.  
  459. Procedure InitST_InfoList;
  460.  
  461. Var
  462.  
  463.   Z : INTEGER;
  464.  
  465. BEGIN
  466.  
  467.   For Z:=1 to 32 Do
  468.     ST_InfoList[Z] := NIL;
  469.  
  470. END;  { InitST_InfoList }
  471.  
  472. {────────────────────────────────────────────────────────────────────────────}
  473. {────────────────────────────────────────────────────────────────────────────}
  474. {────────────────────────────────────────────────────────────────────────────}
  475.  
  476. BEGIN
  477.  
  478.   InitST_InfoList;
  479.  
  480. END.
  481.