src/LINERITE.PAS

   1 {//-------------------------------------------------------------------------}\r
   2 {/*                                                                         }\r
   3 {Copyright (C) 1990, 2009 - Apogee Software, Ltd.                           }\r
   4 {                                                                           }\r
   5 {This file is part of Supernova.  Supernova is free software; you can       }\r
   6 {redistribute it and/or modify it under the terms of the GNU General Public }\r
   7 {License as published by the Free Software Foundation; either version 3     }\r
   8 {of the License, or (at your option) any later version.                     }\r
   9 {                                                                           }\r
  10 {This program is distributed in the hope that it will be useful,            }\r
  11 {but WITHOUT ANY WARRANTY; without even the implied warranty of             }\r
  12 {MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }\r
  13 {                                                                           }\r
  14 {See the GNU General Public License for more details.                       }\r
  15 {                                                                           }\r
  16 {You should have received a copy of the GNU General Public License          }\r
  17 {along with this program; if not, write to the Free Software                }\r
  18 {Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.}\r
  19 {                                                                           }\r
  20 {Original Source: 1990 Scott Miller                                         }\r
  21 {Prepared for public release: 03/19/09 - Joe Siegler, Apogee Software, Ltd. }\r
  22 {*/                                                                         }\r
  23 {//-------------------------------------------------------------------------}\r
  24 program\r
  25   line_Responce_Writer;\r
  26 \r
  27            {This program WRITES and READS from the text file:\r
  28                       'Line', 80 letters (Max),\r
  29                {This program has the line edit feature!}\r
  30 const\r
  31   Max = 80;\r
  32 \r
  33 type\r
  34   DescriptionLength = string[Max];\r
  35   OneChar = string[1];\r
  36 \r
  37 var\r
  38   Line   : file of descriptionlength;\r
  39   Position,Counter,Start,Stop : integer;\r
  40   Text   : descriptionlength;\r
  41   Answer : char;\r
  42   Letter : onechar;\r
  43   List   : boolean;\r
  44 \r
  45 procedure Diskwrite(text: Descriptionlength; pointer: integer);\r
  46   begin\r
  47     seek(Line,pointer);\r
  48     WRITE(Line,text);\r
  49     writeln('line responce ',pointer,\r
  50             ' is written!  Size = ',filesize(Line));\r
  51     close(Line);\r
  52   end; {End of Diskwrite.}\r
  53 \r
  54 procedure Diskread(start,stop: integer);\r
  55 var\r
  56 counter : integer;\r
  57 text    : descriptionlength;\r
  58   begin\r
  59    assign(Line,'Line');\r
  60    reset(Line);\r
  61    seek(Line,start);\r
  62     for counter:= start to stop do\r
  63       begin\r
  64         highvideo;\r
  65         READ(Line,text);\r
  66         if List then\r
  67           writeln(lst,counter,text)\r
  68         else\r
  69           begin\r
  70             writeln('Here is line responce # ',counter);\r
  71             lowvideo;\r
  72             writeln(text);\r
  73             highvideo;\r
  74           end;\r
  75       end;\r
  76     close(Line);\r
  77     write('The file contains ',filesize(Line),' line responces.');\r
  78   end;  {End of Diskread.}\r
  79 \r
  80 procedure Beep;\r
  81 begin\r
  82  if (length(text)=70) then write(^g);\r
  83 end;\r
  84 \r
  85 BEGIN\r
  86 repeat          {Main loop.}\r
  87   text:='';\r
  88 \r
  89 writeln;\r
  90 writeln('Do you want to R)ead or W)rite?');\r
  91 read(kbd,answer);\r
  92 if upcase(answer) <> 'R' then       {Write to 'line' files.}\r
  93     begin\r
  94       writeln;\r
  95       assign(Line,'Line');\r
  96       writeln('Now RESETing line files.');\r
  97             RESET(Line);\r
  98       writeln;\r
  99       writeln('Input a string not more than ',Max,' characters.',\r
 100               '  ''\''-Ends string.');\r
 101       lowvideo;\r
 102         repeat\r
 103           read(trm,letter);\r
 104           if letter = ^h then\r
 105             begin\r
 106               write(^h,' ',^h);\r
 107               delete(text,length(text),2);\r
 108             end;\r
 109           beep;\r
 110           if (letter <> '\') and (letter <> ^h) then text:=text+letter\r
 111         until (length(text)=Max) or (letter='\');\r
 112         writeln;\r
 113         if letter = '\' then\r
 114           begin\r
 115             highvideo;\r
 116             writeln('Total of ',length(text),' characters.');\r
 117           end\r
 118         else\r
 119           begin\r
 120            highvideo\r
 121           end;\r
 122       writeln('Now WRITING string to disk.');\r
 123       writeln('  At what position?  (Next open is # ',filesize(Line),')');\r
 124       readln(position);\r
 125       Diskwrite(text,position);\r
 126     end\r
 127 else                      {Read from 'Rooms'.}\r
 128   begin\r
 129     writeln;\r
 130     writeln('To the S)creen or P)rinter?');\r
 131     read(kbd,answer);\r
 132     if(upcase(answer)='P')then List:=True else List:=False;\r
 133     assign(Line,'Line');\r
 134     reset(Line);\r
 135     writeln('Filesize = ',filesize(Line),\r
 136             '  (From 0 to ',filesize(Line)-1,')');\r
 137     close(Line);\r
 138     writeln('Enter starting position:');\r
 139     readln(start);\r
 140     if(start > filesize(line)-7)then stop:=(filesize(line)-1) else\r
 141       begin\r
 142         writeln('Enter final position:');\r
 143         readln(stop);\r
 144       end;\r
 145     Diskread(start,stop);\r
 146   end;  {End of else clause.}\r
 147 writeln;writeln('Another line responce?  Y)es or N)o');\r
 148 read(kbd,answer);\r
 149 until upcase(answer) = 'N';     {End of Main loop.}\r
 150 writeln; writeln(^g,'You are now out of the program.')\r
 151 END.\r
 152 \r
 153 \r
 154 \1a\r