1 {//-------------------------------------------------------------------------}
\r
3 {Copyright (C) 1990, 2009 - Apogee Software, Ltd. }
\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
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
14 {See the GNU General Public License for more details. }
\r
16 {You should have received a copy of the GNU General Public License }
\r
17 {along with this program; if not, see https://gnu.org/licenses or write to: }
\r
18 { Free Software Foundation, Inc. }
\r
19 { 51 Franklin Street, Fifth Floor }
\r
20 { Boston, MA 02110-1301 }
\r
23 {Original Source: 1990 Scott Miller }
\r
24 {Prepared for public release: 03/19/09 - Joe Siegler, Apogee Software, Ltd. }
\r
26 {//-------------------------------------------------------------------------}
\r
32 MaxLength = string[Max];
\r
33 OneChar = string[1];
\r
36 R1, R2 : file of MaxLength;
\r
38 Start,Stop,x : integer;
\r
39 Text1, Text2 : MaxLength;
\r
44 procedure Diskwrite(text1,text2: MaxLength; pointer: integer);
\r
46 seek(R1,pointer); seek(R2,pointer);
\r
47 WRITE(R1,text1); WRITE(R2,text2);
\r
48 writeln('ROOM decription ',pointer,
\r
49 ' is written! Size = ',filesize(R1));
\r
50 close(R1); close(R2);
\r
51 end; {End of Diskwrite.}
\r
53 procedure Diskread(start,stop: integer);
\r
56 text1, text2 : MaxLength;
\r
58 assign(R1,'R1');assign(R2,'R2');
\r
59 reset(R1); reset(R2);
\r
60 seek(R1,start); seek(R2,start);
\r
61 for counter:= start to stop do
\r
64 READ(R1,text1); READ(R2,text2);
\r
67 writeln(lst,'Discription # ',counter);
\r
68 writeln(lst,text1,text2);
\r
72 writeln('Here is ROOM description # ',counter);
\r
74 writeln(text1,text2);
\r
78 close(R1); close(R2);
\r
79 write('The file contains ',filesize(R1),' ROOM descriptions.');
\r
80 end; {End of Diskread.}
\r
84 if(length(text1)in[68,146,224])or(length(text2)in[68,146,224])then
\r
85 begin sound(99);delay(50);nosound;end;
\r
96 writeln('Do you want to R)ead, W)rite or Q)uit?');
\r
98 if upcase(answer) = 'Q' then begin writeln('FINISHED');halt;end;
\r
99 if upcase(answer) <> 'R' then {Write to 'ROOMS'.}
\r
102 assign(R1,'R1'); assign(R2,'R2');
\r
103 textcolor(9);writeln('Now RESETing ROOM files.');highvideo;
\r
104 RESET(R1); RESET(R2);
\r
106 writeln('Input a string not more than ',2*Max,' characters.',
\r
107 ' ''\''-Ends string.');
\r
108 x:=wherey;if(x>17)then x:=18;for stop:=1 to 7 do writeln;gotoxy(1,x);
\r
112 if letter = ^h then
\r
115 begin window(2,1,80,25);gotoxy(79,wherey-1)end;
\r
117 delete(text1,length(text1),2);
\r
121 if (letter <> '\') and (letter <> ^h) then text1:=text1+letter
\r
122 until (length(text1)=Max) or (letter='\');
\r
123 if letter = '\' then
\r
127 writeln('Total of ',length(text1),' characters.');
\r
135 if letter = ^h then
\r
138 begin window(2,1,80,25);gotoxy(79,wherey-1)end;
\r
140 delete(text2,length(text2),2);
\r
144 if (letter <> '\') and (letter <> ^h) then text2:=text2+letter
\r
145 until (length(text2)=Max) or (letter='\');
\r
146 writeln; highvideo;
\r
147 writeln('Total description length = ',
\r
148 length(text1)+length(text2),' characters.');
\r
150 writeln('Now WRITING string to disk.');
\r
151 writeln(' At what position? (Next open is # ',filesize(R1),')');
\r
152 textcolor(12);position:=position+1;readln(position);highvideo;
\r
153 Diskwrite(text1,text2,position);
\r
155 else {Read from 'ROOMS'.}
\r
158 writeln('To the S)creen or the P)rinter');
\r
160 if(upcase(answer)='P')then List:=True else List:=False;
\r
163 writeln('Filesize = ',filesize(R1),
\r
164 ' (From 0 to ',filesize(R1)-1,')');
\r
166 writeln('Enter starting position:');
\r
167 textcolor(12);readln(start);highvideo;
\r
168 if(start > filesize(R1)-5)then stop:=(filesize(R1)-1) else
\r
170 writeln('Enter final position:');
\r
171 textcolor(12);readln(stop);highvideo;
\r
173 Diskread(start,stop);
\r
174 end; {End of else clause.}
\r
175 until false; {End of Main loop.}
\r