src/SPECIAL.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   Special_Responce_Writer;\r
  26 \r
  27          {This program WRITES and READS from the two text files:\r
  28     'special1' and 'special2'.  If a description exceeds 240 letters (Max),\r
  29        then the file 'special2' is used.  Otherwise 'special2' = ''.}\r
  30                {This program has the line edit feature!}\r
  31 const\r
  32   Max = 240;\r
  33 \r
  34 type\r
  35   DescriptionLength = string[Max];\r
  36   OneChar = string[1];\r
  37 \r
  38 var\r
  39   Special1, Special2 : file of descriptionlength;\r
  40   Position,Counter,Start,Stop : integer;\r
  41   Text1, Text2 : descriptionlength;\r
  42   Answer : char;\r
  43   Letter : onechar;\r
  44   List   : boolean;\r
  45 \r
  46 procedure Diskwrite(text1,text2: Descriptionlength; pointer: integer);\r
  47   begin\r
  48     seek(special1,pointer); seek(special2,pointer);\r
  49     WRITE(special1,text1); WRITE(special2,text2);\r
  50     writeln('Special responce ',pointer,\r
  51             ' is written!  Size = ',filesize(special1));\r
  52     close(special1); close(special2);\r
  53   end; {End of Diskwrite.}\r
  54 \r
  55 procedure Diskread(start,stop: integer);\r
  56 var\r
  57 counter : integer;\r
  58 text1, text2 : descriptionlength;\r
  59   begin\r
  60    assign(special1,'special1'); assign(special2,'special2');\r
  61    reset(special1); reset(special2);\r
  62    seek(special1,start); seek(special2,start);\r
  63     for counter:= start to stop do\r
  64       begin\r
  65         highvideo;\r
  66         READ(special1,text1); READ(special2,text2);\r
  67         if list then\r
  68           begin\r
  69             writeln(lst,'Special # ',counter);\r
  70             writeln(lst,text1,text2);\r
  71           end\r
  72         else\r
  73           begin\r
  74             writeln('Here is special responce # ',counter);\r
  75             lowvideo;\r
  76             writeln(text1,text2);\r
  77             highvideo;\r
  78           end;\r
  79       end;\r
  80     close(special1); close(special2);\r
  81     write('The file contains ',filesize(special1),' special responces.');\r
  82   end;  {End of Diskread.}\r
  83 \r
  84 procedure Beep;\r
  85 begin\r
  86  if(length(text1)in[70,150,230])or(length(text2)in[70,150,230])then write(^g);\r
  87 end;\r
  88 \r
  89 BEGIN\r
  90 repeat          {Main loop.}\r
  91   text1:='';\r
  92   text2:='';\r
  93 \r
  94 writeln;\r
  95 writeln('Do you want to R)ead or W)rite?');\r
  96 read(kbd,answer);\r
  97 if upcase(answer) <> 'R' then       {Write to 'Special' files.}\r
  98     begin\r
  99       writeln;writeln;\r
 100       assign(special1,'special1'); assign(special2,'special2');\r
 101       writeln('Now RESETing Special files.');\r
 102             RESET(special1); RESET(special2);\r
 103       writeln;\r
 104       writeln('Input a string not more than ',2*Max,' characters.',\r
 105               '  ''\''-Ends string.');\r
 106       lowvideo;\r
 107         repeat\r
 108           read(trm,letter);\r
 109           if letter = ^h then\r
 110             begin\r
 111               write(^h,' ',^h);\r
 112               delete(text1,length(text1),2);\r
 113             end;\r
 114           beep;\r
 115           if (letter <> '\') and (letter <> ^h) then text1:=text1+letter\r
 116         until (length(text1)=Max) or (letter='\');\r
 117         writeln;\r
 118         if letter = '\' then\r
 119           begin\r
 120             highvideo;\r
 121             writeln('Total of ',length(text1),' characters.');\r
 122             text2:='';\r
 123           end\r
 124         else\r
 125           begin\r
 126             writeln;\r
 127             highvideo;\r
 128             writeln('String #1 is full!  Now writing to string #2.',^g);\r
 129             lowvideo;\r
 130               repeat\r
 131                 read(trm,letter);\r
 132                 if letter = ^h then\r
 133                   begin\r
 134                     write(^h,' ',^h);\r
 135                     delete(text2,length(text2),2);\r
 136                   end;\r
 137                 beep;\r
 138                 if (letter <> '\') and (letter <> ^h) then text2:=text2+letter\r
 139               until (length(text2)=Max) or (letter='\');\r
 140             writeln; highvideo;\r
 141             writeln('Total description length = ',\r
 142                      length(text1)+length(text2),' characters.');\r
 143           end;\r
 144       writeln('Now WRITING string to disk.');\r
 145       writeln('  At what position?  (Next open is # ',filesize(special1),')');\r
 146       readln(position);\r
 147       Diskwrite(text1,text2,position);\r
 148     end\r
 149 else                      {Read from 'Rooms'.}\r
 150   begin\r
 151     writeln;writeln;\r
 152     writeln('To the S)creen or the P)rinter?');\r
 153     read(kbd,answer);\r
 154     if(upcase(answer)='P')then List:=True else List:=False;\r
 155     assign(special1,'special1');\r
 156     reset(special1);\r
 157     writeln('Filesize = ',filesize(special1),\r
 158             '  (From 0 to ',filesize(special1)-1,')');\r
 159     close(special1);\r
 160     writeln('Enter starting position:');\r
 161     readln(start);\r
 162     if(start > filesize(special1)-5)then stop:=(filesize(special1)-1) else\r
 163       begin\r
 164         writeln('Enter final position:');\r
 165         readln(stop);\r
 166       end;\r
 167     Diskread(start,stop);\r
 168   end;  {End of else clause.}\r
 169 writeln;writeln('Another special responce?  Y)es or N)o');\r
 170 read(kbd,answer);\r
 171 until upcase(answer) = 'N';     {End of Main loop.}\r
 172 writeln; writeln(^g,'You are now out of the program.')\r
 173 END.\r
 174 \r
 175 \r
 176 \1a\r