forked from videogamepreservation/softporn
-
Notifications
You must be signed in to change notification settings - Fork 3
/
SOFTPORN.PAS
170 lines (126 loc) · 4.42 KB
/
SOFTPORN.PAS
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
program softporn_adventure;
const bottom_line = 25; { 24 for CP/M, 25 for IBM PC }
label quit_game;
{$C+}
{$R+}
{$U+}
const recsize = 450;
type rectype = array[1..recsize] of char;
var messg_rec : rectype;
messg_file : file of rectype;
ioerr : integer;
{$I SOFTP1.INC }
{$I SOFTP2.INC }
{$I SOFTP3.INC }
begin { main program }
lowvideo;
{$I-}
assign(messg_file,'SOFTPORN.MSG');
reset(messg_file);
{$I+}
ioerr := IOresult;
if ioerr<>0 then
begin
writeln('Cannot open SOFTPORN.MSG, file missing?');
halt;
end;
with game_position do
begin
repeat
init_new_game;
game_ended := false;
repeat { until game_ended }
if your_place in bar_area then
begin
object_place[_sign] := b_street;
object_place[_button] := b_bar;
end
else if your_place in casino_area then
begin
object_place[_sign] := c_street;
object_place[_button] := c_htdesk;
object_place[_elevator] := c_htdesk;
end
else if your_place in disco_area then
begin
object_place[_sign] := d_street;
object_place[_telephone] := d_telbth;
end
else if your_place in penthouse_area then
begin
object_place[_button] := p_pntfoy;
object_place[_elevator] := p_pntfoy;
object_place[_telephone] := p_pntpch;
end;
if your_place<>b_bar then
path[b_bar,east] := nowhere;
if your_place<>d_entrnc then
begin
path[d_entrnc,west] := nowhere;
door_W_open := false;
end;
if not is_here(_stool) then
stool_climbed := false;
if rubber_worn and (your_place in public_places) then
if random(8)=5 then
begin
write_message('A passerby kills me ' +
'for wearing my kinky rubber in public!');
purgatory;
if game_ended then
goto quit_game;
end;
read_and_parse_command( verbnam, objnam, full_verb, full_noun );
verb_only := objnam[1]=' ';
verb := first_verb;
while ( verbnam <> verb_name[verb] ) and ( verb < last_verb ) do
verb := succ(verb);
no_verb := verb = _no_verb;
noun := first_object;
while ( objnam <> obj_name[noun] ) and ( noun < last_object ) do
noun := succ(noun);
no_object := noun = _no_object;
direction := first_direction;
while ( objnam<>dir_name[direction] ) and
( direction<=last_direction ) do
direction := succ(direction);
no_direction := direction = _no_direction;
if noun=_sign then
begin
if your_place=d_entrnc then {sign on door to west}
noun := _door_west;
if your_place=p_kitchn then {sign on sink}
noun := _sink;
end;
if no_verb then
write_message('I don''t know how to ' + full_verb + ' something!')
else if verb_only and (not (verb in stand_alone_verbs)) then
write_message('Gimme a noun!!')
else if (not verb_only) and ( no_object and no_direction and
(not (verb in special_verbs)) ) then
begin
add_definite_article_to( full_noun );
write_message
('I don''t know how to ' + full_verb + full_noun + '!');
end
else
begin
case verb of
{$I SOFTP4.INC }
{$I SOFTP5.INC }
{$I SOFTP6.INC }
end;
end; { If }
until game_ended;
quit_game:
writeln;
writeln('You scored ''',score,''' out of a possible ''3''');
newlines(2);
write( 'Thanks for playing. Would you like to play again? ');
read_key( yesno, ['Y','N'] );
until yesno='N';
write_message( 'Good-Bye!!' ); writeln;
end; { with }
close(messg_file);
end.