LINERITE.PAS

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