1 {//-------------------------------------------------------------------------}
\r
3 {Copyright (C) 2014 Jason Self <j@jxself.org> }
\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
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
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
22 {This file incorporates work covered by the following copyright and }
\r
23 {permission notice: }
\r
25 {Copyright (C) 1990, 2009 - Apogee Software, Ltd. }
\r
27 {This file is part of Beyond The Titanic. Beyond The Titanic is free }
\r
28 {software; you can redistribute it and/or modify it under the terms of the }
\r
29 {GNU General Public License as published by the Free Software Foundation; }
\r
30 {either version 3 of the License, or (at your option) any later version. }
\r
32 {This program is distributed in the hope that it will be useful, but WITHOUT}
\r
33 {ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or }
\r
34 {FITNESS FOR A PARTICULAR PURPOSE. }
\r
36 {See the GNU General Public License for more details. }
\r
38 {You should have received a copy of the GNU General Public License }
\r
39 {along with this program; if not, write to: }
\r
40 { Free Software Foundation, Inc. }
\r
41 { 51 Franklin Street, Fifth Floor }
\r
42 { Boston, MA 02110-1301 }
\r
45 {Original Source: 1990 Scott Miller }
\r
46 {Prepared for public release: 03/19/09 - Joe Siegler, Apogee Software, Ltd. }
\r
48 {//-------------------------------------------------------------------------}
\r
49 {*****************************************************************************}
\r
51 {* by Scott Miller *}
\r
52 {* This include file to Adgame contains the word parser commands. *}
\r
53 {* Copyright 1984 Pending *}
\r
54 {*****************************************************************************}
\r
57 procedure RR(RoomNum : integer);
\r
60 seek(rooms1,RoomNum);
\r
62 seek(rooms2,RoomNum);
\r
65 {window(1,1,25,80);}
\r
66 writeln(text1,text2);
\r
70 procedure RS(RoomNum : integer);
\r
74 seek(Special1,RoomNum);
\r
75 seek(Special2,RoomNum);
\r
76 READ(Special1,text1);
\r
77 READ(Special2,text2);
\r
78 writeln(text1,text2);
\r
79 end; {of SpecialRead}
\r
81 procedure RL(RoomNum : integer);
\r
85 seek(Line1,RoomNum);
\r
91 procedure Format(var input : Str80);
\r
92 procedure D(A:str14; B: Byte);
\r
93 begin while pos(A,input)<>0 do delete(input,pos(A,input),B) end;
\r
94 begin input:=input+' '; insert(' ',input,1);
\r
95 d(' of ',3); d(' go ',3); d('''',1); d('"',1); d(',',1);
\r
96 d(' a ',2); d('?',1); d('!',1); d(';',1); d('#',1);
\r
97 d(' the ',4); d('fly ',4); d('drive ',6); d('run ',4);
\r
98 d('walk ',5); d('travel ',7); d('please ',7); d('room ',5);
\r
99 d('crawl se',6); d('crawl nw',6); d('steer ',6); d('crawl n ',6);
\r
100 d('crawl s ',6); d('crawl e',6); d('crawl w',6); d('that ',5);
\r
101 d('first ',6); d('second ',7); d('number ',7);
\r
102 d('this ',5); d('game ',5); d('i want to ',10); d(' my ',3); d('big ',4);
\r
103 d('those ',6); d('them ',5); d('broken ',7); d('large ',6);
\r
104 d('huge ',5); d('small ',6); d('tiny ',5);d('little ',7); d('within ',4);
\r
105 d('yes ',3); d('no ',2); d('wade ',4); d('swim ',4);
\r
106 while pos('examine ',input)>0 do delete(input,pos('examine ',input)+2,5);
\r
107 while pos('into ',input)>0 do delete(input,pos('into ',input)+2,2);
\r
108 while pos('. ',input)>0 do delete(input,pos('. ',input)+1,1);
\r
109 while pos('inside ',input)>0 do delete(input,pos('inside ',input)+2,4);
\r
110 d(' .',1); d(' ',1); d('..',1);
\r
111 if(input[1]='.')then delete(input,1,1);
\r
112 while(length(input)>0)and(input[1]=' ')do delete(input,1,1);
\r
113 while(length(input)>0)and(input[length(input)]=' ')do
\r
114 delete(input,length(input),1);
\r
115 if(input='')or(input[1]='.')then writeln('Whoops!')
\r
119 procedure Chop(var input : Str80);
\r
123 if length(input) >0 then
\r
129 while(input[j]<>' ')and(input[j]<>'.')do begin
\r
130 Word:=Word+input[j];
\r
133 if length(Word) >7 then
\r
135 l:=pos(Word,input);
\r
136 j:=j+(7-length(Word));
\r
137 delete(input,l,length(Word));
\r
138 delete(Word,8,120);
\r
139 insert(Word,input,l)
\r
142 until (j-1)=length(input);
\r
143 delete(input,length(input),1)
\r
148 procedure LowerCase(var input : Str80);
\r
151 if length(input) > 0 then
\r
152 for j:=1 to length(input) do
\r
153 if(input[j] in ['A'..'Z'])then
\r
154 input[j]:=chr(ord(input[j])+32)
\r
155 end; {of LowerCase}
\r
158 procedure FindVerb (var input:Str80;var Word:Str14;var Verb:integer);
\r
159 var j, k, r : integer;
\r
164 while input[j]<>' ' do begin
\r
165 Word:=Word+input[j];
\r
168 if length(Word+' ')<length(input)then begin
\r
169 Word:=Word+' '; j:=j+1;
\r
170 while input[j]<>' ' do begin
\r
171 Word:=Word+input[j];
\r
177 for r:= 0 to VMax do
\r
182 if v[r,k]=Word then
\r
184 until (v[r,k]=Q)or(k=5)
\r
187 if(pos(' ',Word)<>0)and(Verb=Null)then
\r
189 delete(Word,pos(' ',Word),8);
\r
190 for r:=0 to VMax do
\r
195 if v[r,k]=Word then
\r
197 until (v[r,k]=Q)or(k=5)
\r
200 delete(input,length(input),1);
\r
201 if Verb<>Null then delete(input,1,length(Word));
\r
202 if input[1]=' 'then delete(input,1,1)
\r
206 procedure FindNoun(var input:Str80;var Word:Str14;var Noun:integer);
\r
207 var j, k, t : integer;
\r
212 while input[j]<>' ' do begin
\r
213 Word:=Word+input[j];
\r
216 if length(Word+' ')<length(input)then begin
\r
217 Word:=Word+' ';j:=j+1;
\r
218 while input[j]<>' ' do begin
\r
219 Word:=Word+input[j];
\r
225 for t:=0 to NMax do
\r
230 if n[t,k]=Word then
\r
232 until (n[t,k]=Q)or(k=5)
\r
235 if(pos(' ',Word)<>0)and(Noun=Null)then
\r
237 delete(Word,pos(' ',Word),8);
\r
238 for t:=0 to NMax do
\r
243 if n[t,k]=Word then
\r
245 until (n[t,k]=Q)or(k=5)
\r
248 delete(input,length(input),1);
\r
249 if Noun<>Null then delete(input,1,length(Word));
\r
250 if input[1]=' 'then delete(input,1,1)
\r
254 procedure FindSep(var input : Str80; var h : Str14);
\r
260 while input[j]<>' ' do begin
\r
264 if pos(' '+h+' ',' crawl on at to in off with within into '+
\r
265 ' above against through beside behind around across '+
\r
266 ' inside from by under using near over onto down ') >0 then
\r
268 delete(input,length(input),1);
\r
269 delete(input,1,length(h));
\r
270 if input[1]=' ' then delete(input,1,1);
\r
271 if(h='on')or(h='around')or(h='above')or(h='over')or(h='onto')
\r
273 if(h='inside')or(h='within')or(h='through')or(h='into')or(h='down')
\r
275 if(h='using')then h:='with';
\r
276 if(h='beside')or(h='by')then h:='near';
\r
277 if(h='against')then h:='at';
\r
278 if(h='across')then h:='over'
\r
283 delete(input,length(input),1)
\r
288 procedure Check(var SepWord : Str14);
\r
291 Verb:=Null; Noun:=Null; Noun2:=Null; DialNum:=Null; Flag:='?';
\r
293 if length(input)>0then
\r
295 FindVerb(input,Word,Verb);
\r
297 if(length(input)>0)and not(Verb in [31,53,63])then
\r
299 FindNoun(input,Word,Noun);
\r
300 If(Noun<>Null)then LastNoun:=n[noun,1];
\r
302 if(Verb in[0,8,9,21,36,6,7,15,17,32,26])and(length(input)=0)then
\r
305 if(Verb in[36,15])then Verb:=9
\r
308 if(Verb in[0,8,21,36,37,29,9,39,6,15,7,17,32,26,40])then
\r
309 if length(input)>0 then
\r
311 if(Verb=9)then Verb:=29 else ;
\r
312 FindSep(input,SepWord);
\r
313 if SepWord<>'s' then
\r
314 if length(input)>0 then
\r
317 val(input,DialNum,j);
\r
322 FindNoun(input,Word,Noun2);
\r
323 if Noun2<>Null then
\r
324 if length(input)>0 then
\r
330 FindVerb(input,Word,Verb);
\r
331 if Verb=Null then Flag:='n'
\r
336 if(Verb=39)and((SepWord='to')or(SepWord='off'))then
\r
337 Flag:='g' else Flag:='e'
\r
344 if length(input)>0 then
\r
345 begin FindVerb(input,Word,j);if j<>Null then Flag:='b' else
\r
346 begin FindSep(input,SepWord);if SepWord<>'s' then Flag:='b' else
\r
347 begin FindNoun(input,Word,j);if j<>Null then Flag:='h' end end;
\r
348 if Flag='?' then Flag:='v'
\r
354 FindVerb(input,Word,Verb);
\r
355 if Verb=Null then Flag:='n'
\r
360 if Verb in OneWordCommands then Flag:='g'
\r
364 FindNoun(input,Word,Noun2);
\r
365 If Noun2=Null then Flag:='v'
\r
370 'v','n':if pos(' '+Word+' ',' crawl on at to in off with within into '+
\r
371 ' above against through beside behind around down '+
\r
372 ' inside by under using near over onto top below '+
\r
373 ' from away want across ')>0 then begin
\r
374 write('The word ''',Word);RL(393)end
\r
375 else writeln('I don''t understand the word ''',Word,'.''');
\r
377 if pos(' ',Word)>0 then delete(Word,pos(' ',Word),9);
\r
378 writeln('You can''t use the word ''',Word,''' here.')
\r
385 'h' :begin write(Word);RL(392)end
\r
388 if flag<>'g' then begin Attack:=False;Line:='';Skip:=False end
\r
391 {***************************** END OF ADPARSER ******************************}
\r