src/SPECIAL.PAS

   1 {//-------------------------------------------------------------------------}\r
   2 {/*                                                                         }\r
   3 {Copyright (C) 2014 Jason Self <j@jxself.org>                               }\r
   4 {                                                                           }\r
   5 {This file is free software: you may copy, redistribute and/or modify it    }\r
   6 {under the terms of the GNU Affero General Public License as published by   }\r
   7 {the Free Software Foundation, either version 3 of the License, or (at your }\r
   8 {option) any later version.                                                 }\r
   9 {                                                                           }\r
  10 {This file is distributed in the hope that it will be useful, but WITHOUT   }\r
  11 {ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or      }\r
  12 {FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License}\r
  13 {for more details.                                                          }\r
  14 {                                                                           }\r
  15 {You should have received a copy of the GNU Affero General Public License   }\r
  16 {along with this program; if not, see https://gnu.org/licenses or write to: }\r
  17 {  Free Software Foundation, Inc.                                           }\r
  18 {  51 Franklin Street, Fifth Floor                                          }\r
  19 {  Boston, MA 02110-1301                                                    }\r
  20 {  USA                                                                      }\r
  21 {                                                                           }\r
  22 {This file incorporates work covered by the following copyright and         }\r
  23 {permission notice:                                                         }\r
  24 {                                                                           }\r
  25 {Copyright (C) 1990, 2009 - Apogee Software, Ltd.                           }\r
  26 {                                                                           }\r
  27 {This file is part of Supernova.  Supernova is free software; you can       }\r
  28 {redistribute it and/or modify it under the terms of the GNU General Public }\r
  29 {License as published by the Free Software Foundation; either version 3     }\r
  30 {of the License, or (at your option) any later version.                     }\r
  31 {                                                                           }\r
  32 {This program is distributed in the hope that it will be useful,            }\r
  33 {but WITHOUT ANY WARRANTY; without even the implied warranty of             }\r
  34 {MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }\r
  35 {                                                                           }\r
  36 {See the GNU General Public License for more details.                       }\r
  37 {                                                                           }\r
  38 {You should have received a copy of the GNU General Public License          }\r
  39 {along with this program; if not, write to the Free Software                }\r
  40 {Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.}\r
  41 {                                                                           }\r
  42 {Original Source: 1990 Scott Miller                                         }\r
  43 {Prepared for public release: 03/19/09 - Joe Siegler, Apogee Software, Ltd. }\r
  44 {*/                                                                         }\r
  45 {//-------------------------------------------------------------------------}\r
  46 program\r
  47   Special_Responce_Writer;\r
  48 \r
  49          {This program WRITES and READS from the two text files:\r
  50     'special1' and 'special2'.  If a description exceeds 240 letters (Max),\r
  51        then the file 'special2' is used.  Otherwise 'special2' = ''.}\r
  52                {This program has the line edit feature!}\r
  53 \r
  54 uses Crt, Printer;\r
  55 \r
  56 const\r
  57   Max = 240;\r
  58 \r
  59 type\r
  60   DescriptionLength = string[Max];\r
  61   OneChar = string[1];\r
  62 \r
  63 var\r
  64   Special1, Special2 : file of descriptionlength;\r
  65   Position,Counter,Start,Stop : integer;\r
  66   Text1, Text2 : descriptionlength;\r
  67   Answer : char;\r
  68   Letter : onechar;\r
  69   List   : boolean;\r
  70 \r
  71 procedure Diskwrite(text1,text2: Descriptionlength; pointer: integer);\r
  72   begin\r
  73     seek(special1,pointer); seek(special2,pointer);\r
  74     WRITE(special1,text1); WRITE(special2,text2);\r
  75     writeln('Special responce ',pointer,\r
  76             ' is written!  Size = ',filesize(special1));\r
  77     close(special1); close(special2);\r
  78   end; {End of Diskwrite.}\r
  79 \r
  80 procedure Diskread(start,stop: integer);\r
  81 var\r
  82 counter : integer;\r
  83 text1, text2 : descriptionlength;\r
  84   begin\r
  85    assign(special1,'special1'); assign(special2,'special2');\r
  86    reset(special1); reset(special2);\r
  87    seek(special1,start); seek(special2,start);\r
  88     for counter:= start to stop do\r
  89       begin\r
  90         highvideo;\r
  91         READ(special1,text1); READ(special2,text2);\r
  92         if list then\r
  93           begin\r
  94             writeln(lst,'Special # ',counter);\r
  95             writeln(lst,text1,text2);\r
  96           end\r
  97         else\r
  98           begin\r
  99             writeln('Here is special responce # ',counter);\r
 100             lowvideo;\r
 101             writeln(text1,text2);\r
 102             highvideo;\r
 103           end;\r
 104       end;\r
 105 \r
 106     write('The file contains ',filesize(special1),' special responces.');\r
 107     close(special1); close(special2);\r
 108   end;  {End of Diskread.}\r
 109 \r
 110 procedure Beep;\r
 111 begin\r
 112  if(length(text1)in[70,150,230])or(length(text2)in[70,150,230])then write(^g);\r
 113 end;\r
 114 \r
 115 BEGIN\r
 116 repeat          {Main loop.}\r
 117   text1:='';\r
 118   text2:='';\r
 119 \r
 120 writeln;\r
 121 writeln('Do you want to R)ead or W)rite?');\r
 122 readln(answer);\r
 123 if upcase(answer) <> 'R' then       {Write to 'Special' files.}\r
 124     begin\r
 125       writeln;writeln;\r
 126       assign(special1,'special1'); assign(special2,'special2');\r
 127       writeln('Now RESETing Special files.');\r
 128             RESET(special1); RESET(special2);\r
 129       writeln;\r
 130       writeln('Input a string not more than ',2*Max,' characters.',\r
 131               '  ''\''-Ends string.');\r
 132       lowvideo;\r
 133         repeat\r
 134           letter := ReadKey;\r
 135           write(letter);\r
 136           if letter = ^h then\r
 137             begin\r
 138               write(' ',^h);\r
 139               delete(text1,length(text1),1);\r
 140             end;\r
 141           beep;\r
 142           if (letter <> '\') and (letter <> ^h) then text1:=text1+letter\r
 143         until (length(text1)=Max) or (letter='\');\r
 144         writeln;\r
 145         if letter = '\' then\r
 146           begin\r
 147             highvideo;\r
 148             writeln('Total of ',length(text1),' characters.');\r
 149             text2:='';\r
 150           end\r
 151         else\r
 152           begin\r
 153             writeln;\r
 154             highvideo;\r
 155             writeln('String #1 is full!  Now writing to string #2.',^g);\r
 156             lowvideo;\r
 157               repeat\r
 158                 letter := ReadKey;\r
 159                 write(letter);\r
 160                 if letter = ^h then\r
 161                   begin\r
 162                     write(' ',^h);\r
 163                     delete(text2,length(text2),1);\r
 164                   end;\r
 165                 beep;\r
 166                 if (letter <> '\') and (letter <> ^h) then text2:=text2+letter\r
 167               until (length(text2)=Max) or (letter='\');\r
 168             writeln; highvideo;\r
 169             writeln('Total description length = ',\r
 170                      length(text1)+length(text2),' characters.');\r
 171           end;\r
 172       writeln('Now WRITING string to disk.');\r
 173       writeln('  At what position?  (Next open is # ',filesize(special1),')');\r
 174       readln(position);\r
 175       Diskwrite(text1,text2,position);\r
 176     end\r
 177 else                      {Read from 'Rooms'.}\r
 178   begin\r
 179     writeln;writeln;\r
 180     writeln('To the S)creen or the P)rinter?');\r
 181     readln(answer);\r
 182     if(upcase(answer)='P')then List:=True else List:=False;\r
 183     assign(special1,'special1');\r
 184     reset(special1);\r
 185     writeln('Filesize = ',filesize(special1),\r
 186             '  (From 0 to ',filesize(special1)-1,')');\r
 187 \r
 188     writeln('Enter starting position:');\r
 189     readln(start);\r
 190     if(start > filesize(special1)-5)then stop:=(filesize(special1)-1) else\r
 191       begin\r
 192         writeln('Enter final position:');\r
 193         readln(stop);\r
 194       end;\r
 195     Diskread(start,stop);\r
 196 \r
 197   end;  {End of else clause.}\r
 198 writeln;writeln('Another special responce?  Y)es or N)o');\r
 199 readln(answer);\r
 200 until upcase(answer) = 'N';     {End of Main loop.}\r
 201 writeln; writeln(^g,'You are now out of the program.')\r
 202 END.\r