-
Notifications
You must be signed in to change notification settings - Fork 16
/
Copy pathother-misc.zap
1073 lines (953 loc) · 22.3 KB
/
other-misc.zap
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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
.FUNCT SET-SIZE-TO-ONE,OBJ,NUM
GETP OBJ,P?SIZE >NUM
DIV NUM,SIZE-VALS
MUL STACK,SIZE-VALS
ADD 1,STACK
PUTP OBJ,P?SIZE,STACK
RTRUE
.FUNCT GET-SIZE,OBJ,NUM
GETP OBJ,P?SIZE >NUM
MOD NUM,SIZE-VALS >NUM
LESS? NUM,6 \?CCL3
RETURN NUM
?CCL3: SUB NUM,6
GETB SIZE-TABLE,STACK
RSTACK
.FUNCT SET-MASS-TO-ONE,OBJ,NUM,?TMP1
GETP OBJ,P?SIZE >NUM
MOD NUM,SIZE-VALS
ADD SIZE-VALS,STACK >?TMP1
DIV NUM,143
MUL STACK,143
ADD ?TMP1,STACK
PUTP OBJ,P?SIZE,STACK
RTRUE
.FUNCT GET-MASS,OBJ,NUM
GETP OBJ,P?SIZE >NUM
DIV NUM,SIZE-VALS
MOD STACK,MASS-VALS >NUM
LESS? NUM,6 \?CCL3
RETURN NUM
?CCL3: SUB NUM,6
GETB MASS-TABLE,STACK
RSTACK
.FUNCT GET-CAPACITY,OBJ,NUM
GETP OBJ,P?SIZE >NUM
DIV NUM,143 >NUM
GRTR? NUM,100 \?CCL3
RETURN 999
?CCL3: RETURN NUM
.FUNCT SET-CAPACITY-TO-ONE,OBJ,NUM
GETP OBJ,P?SIZE >NUM
MOD NUM,143
ADD 143,STACK
PUTP OBJ,P?SIZE,STACK
RTRUE
.FUNCT RT-SEE-ANYTHING-IN?,THING,OBJ
FIRST? THING >OBJ /?PRG2
?PRG2: ZERO? OBJ /FALSE
FSET? OBJ,FL-NODESC /?CCL8
EQUAL? OBJ,GL-WINNER \TRUE
?CCL8: NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
.FUNCT RT-CANT-TOUCH-MSG,OBJ,CLSD,IN-OUT
ICALL1 RT-CYOU-MSG
PRINTI "cannot "
PRINTB GL-P-PRSA-WORD
PRINTC 32
ICALL2 RT-THEO-PRINT,OBJ
ZERO? CLSD /?CND1
PRINTI " because "
FSET? OBJ,FL-PLURAL \?CCL5
FSET? OBJ,FL-COLLECTIVE /?CCL5
PRINTI "they are"
JUMP ?CND3
?CCL5: PRINTI "it is"
?CND3: PRINTC 32
ZERO? IN-OUT /?CCL10
PRINTI "inside"
JUMP ?CND8
?CCL10: PRINTI "outside"
?CND8: PRINTC 32
ICALL2 RT-THEO-PRINT,CLSD
PRINTI ", which is closed"
?CND1: PRINTR "."
.FUNCT RT-TOTAL-SIZE-IN-OBJ,OBJ1,OBJ,TOTSIZ
FIRST? OBJ1 >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
CALL2 GET-SIZE,OBJ
ADD TOTSIZ,STACK >TOTSIZ
NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
?REP3: RETURN TOTSIZ
.FUNCT RT-TOTAL-MASS-OF-OBJ,OBJ1,OBJ,TOTMAS
FIRST? OBJ1 >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
CALL2 RT-TOTAL-MASS-OF-OBJ,OBJ
ADD TOTMAS,STACK >TOTMAS
NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
?REP3: CALL2 GET-MASS,OBJ1
ADD TOTMAS,STACK >TOTMAS
RETURN TOTMAS
.FUNCT RT-TOTAL-COUNT-IN-OBJ,OBJ1,OBJ,TOTCNT
FIRST? OBJ1 >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
FSET? OBJ,FL-WORN \?CCL8
IN? OBJ,CH-PLAYER /?CND4
?CCL8: FSET? OBJ,FL-BODYPART /?CND4
INC 'TOTCNT
?CND4: NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
?REP3: RETURN TOTCNT
.FUNCT RT-OBJ-TOO-LARGE?,OBJ1,OBJ2,?TMP1,?TMP2
CALL2 GET-SIZE,OBJ1 >?TMP2
CALL2 RT-TOTAL-SIZE-IN-OBJ,OBJ2
ADD ?TMP2,STACK >?TMP1
CALL2 GET-CAPACITY,OBJ2
GRTR? ?TMP1,STACK /TRUE
RFALSE
.FUNCT RT-OBJ-TOO-HEAVY?,OBJ1,OBJ2,?TMP1,?TMP2
CALL2 RT-TOTAL-MASS-OF-OBJ,OBJ1 >?TMP2
CALL2 RT-TOTAL-MASS-OF-OBJ,OBJ2
ADD ?TMP2,STACK >?TMP1
GETP OBJ2,P?STRENGTH
GRTR? ?TMP1,STACK /TRUE
RFALSE
.FUNCT RT-OBJ-TOO-MANY?,OBJ1,OBJ2,?TMP1
CALL2 RT-TOTAL-COUNT-IN-OBJ,OBJ2
ADD 1,STACK >?TMP1
GETP OBJ2,P?DEXTERITY
GRTR? ?TMP1,STACK /TRUE
RFALSE
.FUNCT RT-REMOVE-ALL,OBJ1,OBJ,NXT,CNT
FIRST? OBJ1 >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
NEXT? OBJ >NXT /?BOGUS6
?BOGUS6: REMOVE OBJ
INC 'CNT
SET 'OBJ,NXT
JUMP ?PRG2
?REP3: RETURN CNT
.FUNCT RT-MOVE-ALL-BUT-WORN,OBJ1,OBJ2,OBJ,NXT,CNT
FIRST? OBJ1 >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
NEXT? OBJ >NXT /?BOGUS6
?BOGUS6: FSET? OBJ,FL-WORN /?CND7
EQUAL? OBJ,TH-POCKET /?CND7
MOVE OBJ,OBJ2
INC 'CNT
?CND7: SET 'OBJ,NXT
JUMP ?PRG2
?REP3: RETURN CNT
.FUNCT RT-MOVE-NODESC-OBJS,OBJ1,OBJ2,OBJ,NXT,CNT
FIRST? OBJ1 >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
NEXT? OBJ >NXT /?BOGUS6
?BOGUS6: FSET? OBJ,FL-NODESC \?CND7
MOVE OBJ,OBJ2
INC 'CNT
?CND7: SET 'OBJ,NXT
JUMP ?PRG2
?REP3: RETURN CNT
.FUNCT RT-FIND-IN?,OBJ1,FLG,OBJ
FIRST? OBJ1 >OBJ /?PRG2
?PRG2: ZERO? OBJ /FALSE
FSET? OBJ,FLG \?CND4
RETURN OBJ
?CND4: NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
.FUNCT RT-GET-ANY-KEY,X
PRINTI "[Press any key.]"
CRLF
INPUT 1 >X
RTRUE
.FUNCT RT-GET-YES-NO?,WORD
?PRG1: CRLF
PRINTI "Please type YES or NO > "
PUTB GL-YES-LEXV,0,4
PUTB GL-YES-IBUF,1,0
READ GL-YES-IBUF,GL-YES-LEXV
GET GL-YES-LEXV,K-P-LEXSTART >WORD
GETB GL-YES-LEXV,K-P-LEXWORDS
ZERO? STACK /?PRG1
ZERO? WORD /?PRG1
EQUAL? WORD,W?Y,W?YES /TRUE
EQUAL? WORD,W?N,W?NO \?PRG1
RFALSE
.FUNCT RT-INIT-SCREEN,FAST?
ZERO? FAST? /?CCL3
SPLIT GL-SPLIT-ROW
CLEAR 1
JUMP ?CND1
?CCL3: CLEAR -1
SPLIT GL-SPLIT-ROW
?CND1: SCREEN K-S-WIN
HLIGHT K-H-INV
CURSET GL-SPLIT-ROW,1
ICALL2 RT-PRINT-SPACES,GL-ALLSCREEN
SET 'GL-PLACE-STS,-1
SET 'GL-MOVES-STS,-1
SET 'GL-SCORE-STS,-1
CURSET GL-SPLIT-ROW,GL-STAT-S-POS
ZERO? GL-SHORT-STAT? \?CND4
PRINTI "Score:"
?CND4: HLIGHT K-H-NRM
SCREEN K-S-NOR
RTRUE
.FUNCT RT-GAMETITLE-MSG
PRINTR "Sherlock: The Riddle of the Crown Jewels"
.FUNCT RT-COPYRIGHT-MSG
PRINTR "Copyright 1987 Infocom, Inc."
.FUNCT RT-TRADEMARK-MSG
PRINTR "Sherlock: The Riddle of the Crown Jewels is a trademark of Infocom, Inc."
.FUNCT RT-ID-MSG,IDX
SET 'IDX,18
PRINTI "Release "
GET 0,1
BAND STACK,2047
PRINTN STACK
PRINTI " Interpreter "
GETB 0,30
PRINTN STACK
PRINTI " Version "
GETB 0,31
PRINTC STACK
PRINTI " Serial Number "
?PRG1: GETB 0,IDX
PRINTC STACK
IGRTR? 'IDX,23 \?PRG1
CRLF
RTRUE
.FUNCT RT-VERSION-MSG
HLIGHT K-H-BLD
ICALL1 RT-GAMETITLE-MSG
ICALL1 RT-COPYRIGHT-MSG
ICALL1 RT-TRADEMARK-MSG
ICALL1 RT-ID-MSG
HLIGHT K-H-NRM
RTRUE
.FUNCT RT-DESC-PL-CONT-1,SURFACE,CNT,OBJ,NXT,FIRST,PERSON-COUNT,PERSON-PLURAL
FIRST? SURFACE >OBJ /?BOGUS1
?BOGUS1: SET 'FIRST,TRUE-VALUE
?PRG2: ZERO? OBJ /?REP3
FSET? OBJ,FL-NODESC /?CTR7
EQUAL? OBJ,GL-PUPPY \?CCL8
?CTR7: NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
?CCL8: FSET? OBJ,FL-PERSON \?CCL13
INC 'PERSON-COUNT
NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
?CCL13: ZERO? FIRST /?CND4
GRTR? CNT,0 \?CCL18
PRINTC 32
JUMP ?CND16
?CCL18: CRLF
?CND16: PRINTI "You see "
SET 'FIRST,FALSE-VALUE
?CND4: ICALL2 RT-A-PRINT,OBJ
INC 'CNT
NEXT? OBJ >OBJ /?PRG20
?PRG20: ZERO? OBJ /?REP21
EQUAL? OBJ,GL-PUPPY /?CND22
FSET? OBJ,FL-NODESC /?CND22
FSET? OBJ,FL-PERSON \?REP21
FSET? OBJ,FL-NODESC /?REP21
INC 'PERSON-COUNT
?CND22: NEXT? OBJ >OBJ /?PRG20
JUMP ?PRG20
?REP21: ZERO? OBJ /?CCL36
NEXT? OBJ >NXT /?PRG38
?PRG38: ZERO? NXT /?REP39
FSET? NXT,FL-NODESC /?CND40
EQUAL? NXT,GL-PUPPY /?CND40
FSET? NXT,FL-PERSON \?REP39
?CND40: NEXT? NXT >NXT /?PRG38
JUMP ?PRG38
?REP39: ZERO? NXT \?CCL50
PRINTI " and "
JUMP ?PRG2
?CCL50: PRINTI ", "
JUMP ?PRG2
?CCL36: IN? SURFACE,ROOMS /?CND51
PRINTI " on "
ICALL2 RT-THEO-PRINT,SURFACE
?CND51: PRINTC 46
JUMP ?PRG2
?REP3: GRTR? PERSON-COUNT,0 \?CND53
GRTR? CNT,0 \?CCL57
PRINTC 32
JUMP ?CND55
?CCL57: CRLF
?CND55: ADD CNT,PERSON-COUNT >CNT
GRTR? PERSON-COUNT,1 \?CND58
SET 'PERSON-PLURAL,TRUE-VALUE
?CND58: FIRST? SURFACE >OBJ /?BOGUS60
?BOGUS60: SET 'FIRST,TRUE-VALUE
?PRG61: FSET? OBJ,FL-NODESC /?CND63
EQUAL? OBJ,GL-PUPPY /?CND63
FSET? OBJ,FL-PERSON \?CND63
ZERO? FIRST /?CCL71
ICALL RT-THEO-PRINT,OBJ,TRUE-VALUE,K-DESC-A
JUMP ?CND69
?CCL71: ICALL2 RT-A-PRINT,OBJ
?CND69: SET 'FIRST,FALSE-VALUE
FSET? OBJ,FL-PLURAL \?CND72
SET 'PERSON-PLURAL,TRUE-VALUE
?CND72: DEC 'PERSON-COUNT
ZERO? PERSON-COUNT \?CCL76
ZERO? PERSON-PLURAL /?CCL79
PRINTI " are"
JUMP ?CND77
?CCL79: PRINTI " is"
?CND77: PRINTI " here."
?CND53: FIRST? SURFACE >OBJ /?PRG84
?PRG84: ZERO? OBJ /?REP85
FSET? OBJ,FL-SURFACE \?CND86
CALL RT-DESC-PL-CONT-1,OBJ,CNT >CNT
?CND86: NEXT? OBJ >OBJ /?PRG84
JUMP ?PRG84
?CCL76: EQUAL? PERSON-COUNT,1 \?CCL81
PRINTI " and "
JUMP ?CND63
?CCL81: PRINTI ", "
?CND63: NEXT? OBJ >OBJ /?PRG61
JUMP ?PRG61
?REP85: RETURN CNT
.FUNCT RT-DESCRIBE-PLACE-CONTENTS,PLACE,LOOK,OBJ,PREV,CNT,LIGHT
ZERO? PLACE \?CND1
SET 'PLACE,GL-PLACE-CUR
?CND1: CALL RT-DESC-PL-CONT-1,PLACE,0
ZERO? STACK /TRUE
CRLF
RTRUE
.FUNCT RT-RANK-STR,PTS
LESS? PTS,1 \?CCL3
RETURN STR?231
?CCL3: LESS? PTS,21 \?CCL5
RETURN STR?232
?CCL5: LESS? PTS,41 \?CCL7
RETURN STR?233
?CCL7: LESS? PTS,61 \?CCL9
RETURN STR?234
?CCL9: LESS? PTS,81 \?CCL11
RETURN STR?235
?CCL11: LESS? PTS,91 \?CCL13
RETURN STR?236
?CCL13: LESS? PTS,100 /?CTR14
RETURN STR?238
?CTR14: RETURN STR?237
.FUNCT RT-NEW-SCORE-MSG,PTS
ZERO? PTS /FALSE
HLIGHT K-H-BLD
ZERO? GL-SCORE-MSG /?CND3
CRLF
PRINTI "[Your score just went up by "
PRINTN PTS
PRINTI " point"
GRTR? PTS,1 \?CND5
PRINTC 115
?CND5: PRINTI ". The total is now "
PRINTN GL-SCORE-CUR
PRINTI " out of "
PRINTN GL-SCORE-MAX
PRINTI ".]"
CRLF
?CND3: HLIGHT K-H-NRM
RTRUE
.FUNCT RT-PARSE-EVENT?,NOUN,ADJ,OBJ,N,TB,NTB,ATB,FLGS,?TMP1
SET 'OBJ,TH-EVENT
SET 'N,10
SET 'TB,TH-EVENT-NAMES+2
?PRG1: GET TB,0 >NTB
ADD NTB,2 >?TMP1
GET NTB,0
INTBL? NOUN,?TMP1,STACK \?CND3
ZERO? ADJ /?CTR6
GET TB,1 >ATB
ZERO? ATB /FALSE
ADD ATB,2 >?TMP1
GET ATB,0
INTBL? ADJ,?TMP1,STACK \FALSE
?CTR6: GET NTB,1
PUTP OBJ,P?OBJ-NOUN,STACK
GET TB,3 >FLGS
BTST FLGS,2 \?CCL14
FSET OBJ,FL-ALIVE
JUMP ?CND12
?CCL14: FCLEAR OBJ,FL-ALIVE
?CND12: BTST FLGS,4 \?CCL17
FSET OBJ,FL-PERSON
JUMP ?CND15
?CCL17: FCLEAR OBJ,FL-PERSON
?CND15: BTST FLGS,8 \?CCL20
FSET OBJ,FL-VOWEL
RETURN OBJ
?CCL20: FCLEAR OBJ,FL-VOWEL
RETURN OBJ
?CND3: DLESS? 'N,1 /FALSE
ADD TB,8 >TB
JUMP ?PRG1
.FUNCT RT-IDENTIFY-EVENT?,WD,OBJ,NAM,N,TB,NTB,?TMP1
GETP TH-EVENT,P?OBJ-NOUN >NAM
ZERO? OBJ /?CND1
EQUAL? OBJ,TH-EVENT \FALSE
?CND1: SET 'N,10
SET 'TB,TH-EVENT-NAMES+2
?PRG5: GET TB,0 >NTB
GET NTB,1
EQUAL? WD,STACK \?CND7
ADD NTB,2 >?TMP1
GET NTB,0
INTBL? NAM,?TMP1,STACK /TRUE
RFALSE
?CND7: DLESS? 'N,1 /FALSE
ADD TB,8 >TB
JUMP ?PRG5
.FUNCT RT-DESC-EVENT,CLASS,WD,FLAGS,N,TB,?TMP1,?TMP2,?TMP3
GETP TH-EVENT,P?OBJ-NOUN >WD
SET 'N,10
SET 'TB,TH-EVENT-NAMES+2
?PRG1: GET TB,0
GET STACK,1
EQUAL? WD,STACK \?CND3
GET TB,3 >FLAGS
GET TB,2
ZERO? STACK /?CCL7
GET TB,2 >?TMP3
BTST FLAGS,1 \?PRF10
SET '?TMP2,1
JUMP ?PEN8
?PRF10: SET '?TMP2,0
?PEN8: FSET? TH-EVENT,FL-PLURAL /?PRD11
PUSH 0
JUMP ?PRD12
?PRD11: PUSH 1
?PRD12: SET '?TMP1,STACK
FSET? TH-EVENT,FL-VOWEL /?PRD13
PUSH 0
JUMP ?PRD14
?PRD13: PUSH 1
?PRD14: ICALL PRINT-SDESC,?TMP3,CLASS,?TMP2,?TMP1,STACK
RTRUE
?CCL7: BTST FLAGS,1 \?PRF17
SET '?TMP2,1
JUMP ?PEN15
?PRF17: SET '?TMP2,0
?PEN15: FSET? TH-EVENT,FL-PLURAL /?PRD18
PUSH 0
JUMP ?PRD19
?PRD18: PUSH 1
?PRD19: SET '?TMP1,STACK
FSET? TH-EVENT,FL-VOWEL /?PRD20
PUSH 0
JUMP ?PRD21
?PRD20: PUSH 1
?PRD21: ICALL PRINT-SDESC,WD,CLASS,?TMP2,?TMP1,STACK,TRUE-VALUE
RTRUE
?CND3: DLESS? 'N,1 /FALSE
ADD TB,8 >TB
JUMP ?PRG1
.FUNCT RT-AC-TH-EVENT,CONTEXT,CLASS
EQUAL? CONTEXT,K-M-SDESC \?CCL3
CALL2 RT-DESC-EVENT,CLASS
RSTACK
?CCL3: CALL1 RT-TALK-VERB?
ZERO? STACK \FALSE
ICALL1 RT-IMPOSSIBLE-MSG
RTRUE
.FUNCT RT-TO-DO-THING-USE-MSG,STR1,STR2
PRINTI "[To "
PRINT STR1
PRINTI " something, use the command: "
PRINT STR2
PRINTR " THING.]"
.FUNCT RT-NOT-IN-SENTENCE-MSG,STR
PRINTI "[There are not "
PRINT STR
PRINTR " in that sentence.]"
.FUNCT RT-IMPOSSIBLE-MSG,WHO
CALL1 RT-WHO-SAYS? >WHO
EQUAL? WHO,CH-HOLMES,CH-WIGGINS \?CCL3
EQUAL? WHO,CH-HOLMES \?CCL6
CALL2 RT-PICK-NEXT,GL-HOLMES-DESC-TXT
PRINT STACK
PRINTI " looks at you "
CALL2 RT-PICK-NEXT,GL-HOLMES-DESPAIR-TXT
PRINT STACK
PRINTI " and says, """
CALL2 RT-PICK-NEXT,GL-HOLMES-IMPOSSIBLE-TXT
PRINT STACK
JUMP ?CND4
?CCL6: EQUAL? WHO,CH-WIGGINS \?CND4
CALL2 RT-PICK-NEXT,GL-WIGGINS-DESC-TXT
PRINT STACK
PRINTI " says, """
CALL2 RT-PICK-NEXT,GL-WIGGINS-IMPOSSIBLE-TXT
PRINT STACK
?CND4: PRINTR "."""
?CCL3: CALL2 RT-PICK-NEXT,GL-IMPOSSIBLE-TXT
PRINT STACK
PRINTR "."
.FUNCT RT-NOT-LIKELY-MSG,THING,STR
PRINTI "It"
CALL2 RT-PICK-NEXT,GL-NOT-LIKELY-TXT
PRINT STACK
PRINTI " that "
ICALL2 RT-THEO-PRINT,THING
PRINTC 32
PRINT STR
PRINTR "."
.FUNCT RT-LOOKS-PUZZLED-MSG,WHO
ICALL2 RT-CTHEO-PRINT,WHO
PRINTC 32
CALL2 RT-PICK-NEXT,GL-LOOKS-TXT
PRINT STACK
PRINTC 32
CALL2 RT-PICK-NEXT,GL-PUZZLED-TXT
PRINT STACK
PRINTR "."
.FUNCT RT-WINNER-NOT-HOLDING-MSG
ICALL2 RT-CTHEO-PRINT,GL-WINNER
ICALL2 RT-ISNT-ARENT-MSG,GL-WINNER
PRINTI "holding "
RTRUE
.FUNCT RT-YOUD-HAVE-TO-MSG,STR,THING
PRINTI "You would have to "
PRINT STR
PRINTC 32
ICALL2 RT-THEO-PRINT,THING
PRINTI " to do that."
CRLF
ICALL2 RT-THIS-IS-IT,THING
RTRUE
.FUNCT RT-WOULD-HAVE-TO-MSG,STR,THING
PRINTI "would have to "
PRINT STR
PRINTC 32
ZERO? THING /?CND1
ICALL2 RT-THEO-PRINT,THING
?CND1: ICALL2 RT-THIS-IS-IT,THING
RTRUE
.FUNCT RT-NOBODY-TO-ASK-MSG
PRINTI "[There is nobody here to ask.]"
CRLF
ICALL1 RT-P-CLEAR
RTRUE
.FUNCT RT-TALK-TO-SELF-MSG
PRINTI "[You must address characters directly.]"
CRLF
ICALL1 RT-P-CLEAR
RTRUE
.FUNCT RT-WAY-TO-TALK-MSG
PRINTI "[Refer to your instruction manual for the correct way to address characters.]"
CRLF
ICALL1 RT-P-CLEAR
RETURN 2
.FUNCT RT-I-SUN-UP-DOWN-MSG,TOD
FSET? GL-PLACE-CUR,FL-INDOORS /FALSE
CALL RT-CLOCK-CMP,6,30,0
ZERO? STACK \?CCL5
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,0,30,0
ICALL RT-ALARM-SET-REL,RT-I-SUN-UP-DOWN-MSG,STACK
SET 'GL-LAST-OUT-TOD,1
CRLF
PRINTI "Visibility increases in the gathering light of the new day."
EQUAL? GL-PLACE-CUR,RM-THAMES-ONE,RM-THAMES-TWO,RM-THAMES-THREE /?CND6
EQUAL? GL-PLACE-CUR,RM-THAMES-FOUR,RM-THAMES-FIVE /?CND6
PRINTR " Tourists are beginning to crowd into the streets."
?CND6: CRLF
RTRUE
?CCL5: CALL RT-CLOCK-CMP,7,0,0
ZERO? STACK \?CCL11
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,12,30,0
ICALL RT-ALARM-SET-REL,RT-I-SUN-UP-DOWN-MSG,STACK
SET 'GL-LAST-OUT-TOD,2
CRLF
PRINTI "The sun comes up, as much as it ever comes up in England."
CRLF
RFALSE
?CCL11: CALL RT-CLOCK-CMP,19,30,0
ZERO? STACK \?CCL13
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,0,30,0
ICALL RT-ALARM-SET-REL,RT-I-SUN-UP-DOWN-MSG,STACK
SET 'GL-LAST-OUT-TOD,3
CRLF
PRINTR "Daylight begins to fade. Soon it will be dark."
?CCL13: CALL RT-CLOCK-CMP,20,0,0
ZERO? STACK \FALSE
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,10,30,0
ICALL RT-ALARM-SET-REL,RT-I-SUN-UP-DOWN-MSG,STACK
SET 'GL-LAST-OUT-TOD,0
CRLF
PRINTI "Darkness falls and the mists come in."
CRLF
RFALSE
.FUNCT RT-NO-OTHER?,FEMALE?,OBJ
FIRST? GL-PLACE-CUR >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
EQUAL? OBJ,GL-WINNER /?CND7
FSET? OBJ,FL-PERSON \?CND7
ZERO? FEMALE? /?CCL13
FSET? OBJ,FL-FEMALE /?REP3
?CCL13: ZERO? FEMALE? \?CND7
FSET? OBJ,FL-FEMALE \?REP3
?CND7: NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
?REP3: ZERO? OBJ /FALSE
ICALL2 RT-LOOKS-PUZZLED-MSG,GL-WINNER
PRINTR "To whom are you referring?"
.FUNCT RT-GLOBAL-IN?,OBJ1,OBJ2,TBL
GETPT OBJ2,P?GLOBAL >TBL
ZERO? TBL /FALSE
GRTR? OBJ1,255 /FALSE
PTSIZE TBL
INTBL? OBJ1,TBL,STACK,1 /TRUE
RFALSE
.FUNCT RT-META-LOC,OBJ
?PRG1: ZERO? OBJ /FALSE
IN? OBJ,GLOBAL-OBJECTS \?CCL7
RETURN GLOBAL-OBJECTS
?CCL7: IN? OBJ,ROOMS \?CCL9
RETURN OBJ
?CCL9: LOC OBJ >OBJ
JUMP ?PRG1
.FUNCT GO
START::
?FCN: SET 'GL-CLOCK-FMT,0
SET 'GL-SCORE-MSG,TRUE-VALUE
SET 'GL-SCORE-MAX,100
SET 'GL-PLACE-CUR,RM-221B-BAKER-ST
ICALL RT-DO-CLOCK-SET,GL-TIME-UPDT-INC,0,1,0
ICALL RT-DO-CLOCK-SET,GL-TIME-UPDT-DEF,0,1,0
ICALL RT-DO-CLOCK-SET,GL-TIME,5,0,0,18
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,6,0,0,18
ICALL RT-ALARM-SET-ABS,RT-I-BIGBEN,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,6,30,0,18
ICALL RT-ALARM-SET-ABS,RT-I-SUN-UP-DOWN-MSG,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,6,30,0,18
ICALL RT-ALARM-SET-ABS,RT-I-PM-QUITS,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,7,0,0,18
ICALL RT-ALARM-SET-ABS,RT-I-OPEN-WESTMINSTER-DOOR,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,6,55,0,18
ICALL RT-ALARM-SET-ABS,RT-I-WESTMINSTER-LIGHTS-ON,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,17,50,0,18
ICALL RT-ALARM-SET-ABS,RT-I-FLASH-WESTMINSTER-LIGHTS,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,18,5,0,18
ICALL RT-ALARM-SET-ABS,RT-I-WESTMINSTER-LIGHTS-OFF,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,6,55,0,19
ICALL RT-ALARM-SET-ABS,RT-I-WESTMINSTER-LIGHTS-ON,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,17,50,0,19
ICALL RT-ALARM-SET-ABS,RT-I-FLASH-WESTMINSTER-LIGHTS,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,18,1,0,19
ICALL RT-ALARM-SET-ABS,RT-I-LOCKED-IN-END-GAME,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,8,0,0,18
ICALL RT-ALARM-SET-ABS,RT-I-OPEN-MUSEUM-DOOR,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,9,0,0,20
ICALL RT-ALARM-SET-ABS,RT-I-OUT-OF-TIME,STACK
SET 'GL-SCORE-CUR,0
SET 'GL-MOVES-CUR,0
SET 'GL-SCORE-STS,-1
SET 'GL-MOVES-STS,-1
SET 'GL-PLACE-STS,-1
SET 'GL-PLACE-PRV,-1
CALL1 RT-IS-LIT? >GL-NOW-LIT?
SET 'GL-WINNER,CH-PLAYER
GETB 0,33 >GL-ALLSCREEN
DIV GL-ALLSCREEN,2 >GL-MIDSCREEN
LESS? GL-ALLSCREEN,60 \?CND1
SET 'GL-SHORT-STAT?,TRUE-VALUE
SET 'GL-STAT-S-POS,4
SET 'GL-STAT-T-POS,17
SET 'GL-SCORE-HEADER-LEN,0
SUB GL-ALLSCREEN,19 >GL-STAT-MAX-ROOM
?CND1: SUB GL-ALLSCREEN,GL-STAT-S-POS >GL-STAT-S-POS
SUB GL-ALLSCREEN,GL-STAT-T-POS >GL-STAT-T-POS
SET 'GL-SPLIT-ROW,1
MOVE CH-PLAYER,GL-PLACE-CUR
CLEAR -1
CRLF
ICALL1 RT-GAMETITLE-MSG
ICALL1 RT-COPYRIGHT-MSG
ICALL1 RT-TRADEMARK-MSG
ICALL1 RT-ID-MSG
CRLF
ICALL1 RT-GET-ANY-KEY
ICALL1 RT-INIT-SCREEN
ICALL1 RT-UPDATE-STATUS-LINE
ICALL1 RT-DESC-ALL
ICALL1 RT-P-CLEAR
ICALL1 RT-MAIN-LOOP
JUMP ?FCN
.FUNCT RT-NUMBER?,PTR,TMP,CNT,BPTR,TPTR,CHR,SUM,TIM,AM-PM?,?TMP1
SET 'TPTR,K-HRS
MUL PTR,2
ADD GL-P-P-LEX,STACK >TMP
GET TMP,K-P-LEXELEN >CNT
EQUAL? CNT,W?AM \?CCL3
SET 'AM-PM?,1
JUMP ?CND1
?CCL3: EQUAL? CNT,W?PM \?CND1
SET 'AM-PM?,2
?CND1: ZERO? AM-PM? /?CCL7
SET 'BELIEVE-WAIT-TIME?,TRUE-VALUE
JUMP ?CND5
?CCL7: SET 'BELIEVE-WAIT-TIME?,FALSE-VALUE
?CND5: GETB TMP,2 >CNT
GETB TMP,3 >BPTR
?PRG8: DLESS? 'CNT,0 /?REP9
GETB GL-P-PIBUF,BPTR >CHR
EQUAL? CHR,58 \?CCL15
PUTB GL-P-TIME,TPTR,SUM
EQUAL? TPTR,K-HRS \?CCL18
GRTR? SUM,23 /FALSE
EQUAL? AM-PM?,2 \?CND21
LESS? SUM,12 \?CND21
ADD SUM,12 >SUM
PUTB GL-P-TIME,K-HRS,SUM
?CND21: SET 'TPTR,K-MIN
JUMP ?CND16
?CCL18: EQUAL? TPTR,K-MIN /FALSE
ZERO? TPTR /FALSE
?CND16: SET 'TIM,TRUE-VALUE
SET 'SUM,0
JUMP ?CND13
?CCL15: GRTR? SUM,9999 /FALSE
GRTR? CHR,57 /FALSE
LESS? CHR,48 /FALSE
MUL SUM,10 >?TMP1
SUB CHR,48
ADD ?TMP1,STACK >SUM
?CND13: INC 'BPTR
JUMP ?PRG8
?REP9: ZERO? TIM /?CCL36
PUTB GL-P-TIME,TPTR,SUM
EQUAL? TPTR,K-HRS /FALSE
EQUAL? TPTR,K-MIN \?CCL41
LESS? SUM,0 /FALSE
GRTR? SUM,59 \?CND34
RFALSE
?CCL41: ZERO? TPTR \?CND34
RFALSE
?CCL36: EQUAL? AM-PM?,2 \?CND47
LESS? SUM,12 \?CND47
ADD SUM,12 >SUM
?CND47: PUTB GL-P-TIME,K-HRS,SUM
PUTB GL-P-TIME,K-MIN,0
PUTB GL-P-TIME,K-SEC,0
?CND34: ICALL RT-CHANGE-LEXV,PTR,W?INTNUM
GRTR? SUM,9999 /FALSE
ZERO? TIM /?CND51
SET 'SUM,0
?CND51: SET 'GL-P-TIME-FLAG,TIM
SET 'GL-P-NUMBER,SUM
RETURN W?INTNUM
.FUNCT V-WAIT-FOR,H,M,S,N
EQUAL? GL-PRSO,TH-TIME \?CCL3
SET 'N,GL-P-NUMBER
EQUAL? N,-1 \?CND4
SET 'N,1
?CND4: GETP GL-PRSO,P?OBJ-NOUN
EQUAL? STACK,W?MINUTE,W?MINUTES \?CCL8
SET 'H,0
SET 'M,N
JUMP ?CND6
?CCL8: SET 'H,N
SET 'M,0
?CND6: SET 'S,0
PRINTI "Time passes..."
CRLF
CALL RT-CLOCK-JMP,H,M,S
RSTACK
?CCL3: ZERO? GL-P-TIME-FLAG \?CCL10
EQUAL? GL-PRSO,TH-INTNUM /?CCL10
ICALL1 RT-CYOU-MSG
PRINT K-CANT-WAIT-MSG
CRLF
RETURN 2
?CCL10: GETB GL-P-TIME,K-HRS >H
GETB GL-P-TIME,K-MIN >M
GETB GL-P-TIME,K-SEC >S
EQUAL? GL-PRSO,TH-INTNUM \?CND13
ZERO? GL-P-TIME-FLAG \?CND13
PRINTC 91
PRINTN H
PRINTI ":00]"
CRLF
CRLF
?CND13: GRTR? H,23 \?CCL19
ICALL1 RT-CYOU-MSG
PRINT K-CANT-WAIT-MSG
CRLF
RETURN 2
?CCL19: ZERO? BELIEVE-WAIT-TIME? \?CTR20
GRTR? H,12 \?CCL21
?CTR20: GETB GL-TIME,K-HRS
SUB H,STACK >H
GETB GL-TIME,K-MIN
SUB M,STACK >M
GETB GL-TIME,K-SEC
SUB S,STACK >S
JUMP ?CND17
?CCL21: GETB GL-TIME,K-HRS
SUB STACK,1
MOD STACK,12
ADD STACK,1
SUB H,STACK >H
GETB GL-TIME,K-MIN
SUB M,STACK >M
GETB GL-TIME,K-SEC
SUB S,STACK >S
?CND17: SUB S,59
DIV STACK,60 >N
ADD M,N >M
MUL N,60
SUB S,STACK >S
SUB M,59
DIV STACK,60 >N
ADD H,N >H
MUL N,60
SUB M,STACK >M
?PRG24: LESS? H,0 \?REP25
ZERO? BELIEVE-WAIT-TIME? /?CCL30
ADD H,24 >H
JUMP ?PRG24
?CCL30: ADD H,12 >H
JUMP ?PRG24
?REP25: ZERO? H \?CCL33
ZERO? M \?CCL33
ZERO? S \?CCL33
PRINTI "It is"
GETB GL-TIME,K-HRS
SUB STACK,1
MOD STACK,12
ADD STACK,1
GRTR? STACK,9 \?CND37
PRINTC 32
?CND37: ICALL2 RT-CLK-NTI-MSG,6
PRINTI " now."
CRLF
ICALL2 RT-TIME-OF-DAY-MSG,TRUE-VALUE
RETURN 2
?CCL33: PRINTI "Time passes..."
CRLF
ICALL RT-CLOCK-JMP,H,M,S
ICALL2 RT-TIME-OF-DAY-MSG,TRUE-VALUE
RTRUE
.FUNCT RT-WAIT-TOD-MSG,TOD
CRLF
PRINTI "While you were waiting, "
ZERO? TOD \?CCL3
PRINTR "the sun set and the mists rolled in."
?CCL3: EQUAL? TOD,1 \?CCL5
PRINTR "the sky started to lighten. Soon it will be sunrise."
?CCL5: EQUAL? TOD,2 \?CCL7
PRINTR "the sun rose... as much as it ever does here."
?CCL7: PRINTR "the sun set. Soon it will be dark."
.FUNCT RT-WINDOW,TABLE,MARGIN,Y,I,WIDTH,LINES,STR,PLINES
SET 'Y,8
SET 'I,2
GET TABLE,0 >LINES
GET TABLE,1 >WIDTH
SET 'PLINES,LINES
GRTR? WIDTH,GL-ALLSCREEN \?CND1
PRINTR "[*** Window too wide ***]"
?CND1: ZERO? MARGIN \?CND3
DIV WIDTH,2
SUB GL-MIDSCREEN,STACK >MARGIN
?CND3: ADD LINES,6
SPLIT STACK
SCREEN K-S-WIN
HLIGHT K-H-INV
CURSET Y,MARGIN
ICALL2 RT-PRINT-SPACES,WIDTH
?PRG5: INC 'Y
CURSET Y,MARGIN
DEC 'LINES
ZERO? LINES \?CND7
ICALL2 RT-PRINT-SPACES,WIDTH
HLIGHT K-H-NRM
SCREEN K-S-NOR
SPLIT 1
DIROUT K-D-SCR-OFF
SET 'I,2
CRLF
PRINTC 91
?PRG12: DEC 'PLINES
ZERO? PLINES /?REP13
GET TABLE,I >STR
ZERO? STR /?CND16
EQUAL? I,2 /?CND18
PRINTC 32
?CND18: PRINT STR
EQUAL? PLINES,1 \?CND16
PRINTC 93
?CND16: CRLF
INC 'I
JUMP ?PRG12
?CND7: GET TABLE,I >STR
ZERO? STR \?CCL11
ICALL2 RT-PRINT-SPACES,WIDTH