-
Notifications
You must be signed in to change notification settings - Fork 6
/
A8.BAS.txt
1486 lines (1439 loc) · 60 KB
/
A8.BAS.txt
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
' Copyright (c) 1995 Jeffrey R. Olson
'
' Permission is hereby granted, free of charge, to any person obtaining a copy
' of this software and associated documentation files (the "Software"), to deal
' in the Software without restriction, including without limitation the rights
' to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
' copies of the Software, and to permit persons to whom the Software is
' furnished to do so, subject to the following conditions:
'
' The above copyright notice and this permission notice shall be included in all
' copies or substantial portions of the Software.
'
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
' AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
' LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
' OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
' SOFTWARE.
DECLARE SUB Box CDECL (BYVAL lc%, BYVAL rc%, BYVAL tc%, BYVAL bc%, BYVAL nl%, BYVAL fclr%, BYVAL pag%)
DECLARE SUB DisplayCritter (typ%)
DECLARE SUB TapeRecorder (i%)
DECLARE SUB DetailedMap (loadmappossible%)
DECLARE SUB TargetLong (lsym%, range!, nlx%, nly%, fc%, bc%)
DECLARE SUB SortGoody ()
DECLARE FUNCTION CreatNam$ (typ%, num%)
DECLARE FUNCTION BerEff$ (i%)
DECLARE FUNCTION ssdnm$ (i%)
DECLARE FUNCTION lsdnm$ (i%)
DECLARE FUNCTION wepnm$ (i%)
DECLARE FUNCTION shnm$ (i%)
DECLARE FUNCTION armnm$ (i%)
DECLARE FUNCTION pmutnm$ (i%)
DECLARE FUNCTION mmutnm$ (i%)
DECLARE SUB DisplayGoodies (pak%)
DECLARE SUB SelectGoody (num%, colr%, pak%)
DECLARE SUB MakeCreature (x%, y%, border%, fake%)
DECLARE SUB mphk (ch%, atktyp%)
DECLARE SUB Teleport (b%)
DECLARE SUB Dismantle (i%)
DECLARE SUB BuildGoody (i%)
DECLARE SUB Look (scope%)
DECLARE SUB Explode (dx%, dy%, damage%, damtype%, need%, r!, slf%, clr%, div%)
DECLARE SUB Target (num%, range!, dx%, dy%, avoidcolr%)
DECLARE SUB MaybeMessPause (fc%, bc%)
DECLARE SUB RemoveLocalGoody (mlocx%, mlocy%, dropped%)
DECLARE SUB Awaken (i%)
DECLARE SUB RemoveWall (sym%, x%, y%, removed%)
DECLARE SUB DrawSpecial (special%)
DECLARE FUNCTION RoomIt% CDECL (BYVAL xr%, BYVAL xl%, BYVAL yb%, BYVAL yt%)
DECLARE SUB SplitCre (ch%)
DECLARE SUB CreatSort CDECL (BYVAL nnear%, tentgrab%, SEG nn%)
DECLARE SUB Printjnk (a%, b%, c%)
DECLARE SUB ErasePut ()
DECLARE SUB Ljnkbig (a%, b%, c%, d%, e%, f%, a$, n%, i%)
DECLARE SUB ljnk (a%, b%, c%, i%)
DECLARE SUB Cave (numrms%, rms%())
DECLARE SUB Lair CDECL (xr%, xl%, yb%, yt%, xs%, ys%)
DECLARE SUB CrDef (ch%, atktyp%, roll%, missspec%, r%)
DECLARE SUB TeleCreat (x%, y%)
DECLARE SUB AddToDrop (num%)
DECLARE SUB ccls CDECL (BYVAL pag%)
DECLARE SUB cRandomize CDECL (BYVAL seed!)
DECLARE SUB ffEffect (damage%, ffkill%)
DECLARE SUB SetDark (dark%, old%, chang%)
DECLARE SUB Level (newlev%, a$)
DECLARE SUB DumpBuffer ()
DECLARE SUB DamSuit (i%, dam%)
DECLARE SUB ChangeDark ()
DECLARE SUB KillCreat (i%)
DECLARE SUB RemoveGoody (i%, pak%)
DECLARE SUB RemoveCreat (i%)
DECLARE SUB MakeStuff (i%)
DECLARE SUB FindDot CDECL (x%, y%, BYVAL i%)
DECLARE SUB DrawRoom (xdoor%, ydoor%, dir%, doorsym%, sm%)
DECLARE SUB AddRoom (x%, y%, didit%, sm%)
DECLARE SUB DotCorn ()
DECLARE SUB DotIt (x%, y%)
DECLARE SUB DisplayCharacter ()
DECLARE SUB Dead (spec%)
DECLARE SUB PauseForKey ()
DECLARE SUB SetCombatStats ()
DECLARE SUB MessPause (fc%, bc%)
DECLARE SUB ClearMess ()
DECLARE SUB PutSym (sym%, col%, row%, fcolr%, bcolr%, pag%)
DECLARE SUB GetSym (sym%, col%, row%, fcolr%, bcolr%, pag%)
DECLARE SUB PrintMessage (fcolr%, bcolr%)
DECLARE SUB Wrong ()
DECLARE FUNCTION RollDice% CDECL (BYVAL dsize%, BYVAL nroll%, BYVAL nuse%)
DECLARE FUNCTION jnk$ (num%, strt%, leng%)
DECLARE FUNCTION cRd% CDECL (BYVAL x%, BYVAL y%)
DECLARE FUNCTION cRoll% CDECL (BYVAL max%)
DECLARE FUNCTION SameRoom% (x%, y%)
DECLARE FUNCTION Der$ (kil%, n%, i%)
DEFINT A-Z
REM $INCLUDE: 'alpha.dc2'
REM $INCLUDE: 'alpha.dec'
DIM SHARED bbbb(1 TO 423) AS STRING * 68
a8comd:
DATA 211,1,17, 211,18,17, 211,35,23
DATA 243,35,25, 212,1,20, 212,21,24
DATA 212,45,16, 213,1,10, 213,11,13
DATA 213,24,7, 213,31,15, 213,46,7
DATA 214,1,17, 214,18,15, 207,1,1
DATA 214,33,8, 214,41,7, 215,1,20
DATA 215,21,13, 96,1,13, 96,14,15
DATA 215,34,14, 211,58,9, 215,48,18
DATA 213,53,16, 279,1,20, 264,43,19
DATA 214,53,12, 216,1,12, 216,13,18
DATA 272,20,22, 262,1,19, 210,59,9
END
SUB ActiveMod
SCREEN , , 3, vpage: ccls 3
IF notoxin THEN
COLOR 12: LOCATE 1, 5
Printjnk 140 + (notoxin > 0), 1, 42 + (notoxin > 0)
END IF
COLOR 11, 0: LOCATE 2 - (notoxin <> 0), 5: Printjnk 244, 47, 19
row = 3: col = 5: GOSUB incrow
COLOR 12
IF hits < 5 THEN a = 246: b = 55: c = 8: GOSUB incrow
COLOR 4
IF hunger < -1500 THEN a = 325: b = 44: c = 19: GOSUB incrow
IF inwater THEN a = 59: b = 58: c = 8: GOSUB incrow
IF inpit THEN a = 245: b = 1: c = 14: GOSUB incrow
IF inweb THEN a = 160: b = 44: c = 14: GOSUB incrow
IF inglue THEN a = 164: b = 41: c = 13: GOSUB incrow
IF inbog THEN a = 383: b = 49: c = 17: GOSUB incrow
IF insand THEN a = 384: b = 29: c = 18: GOSUB incrow
IF grabbed > 0 THEN a = 248: b = 42: c = 17: GOSUB incrow
COLOR 3
IF zippy > 0 THEN a = 245: b = 15: c = 6: GOSUB incrow
IF zippy < 0 THEN a = 245: b = 21: c = 11: GOSUB incrow
IF invisible THEN a = 248: b = 12: c = 9: GOSUB incrow
IF berconfuse THEN a = 317: b = 36: c = 8: GOSUB incrow
IF berblind THEN a = 247: b = 41: c = 5: GOSUB incrow
IF berhic THEN
lngth = LEN(ber$): IF RIGHT$(ber$, 1) = "e" THEN lngth = lngth - 1
PRINT LEFT$(ber$, lngth) + "ing"; : a = 0: GOSUB incrow
END IF
IF berhpmut THEN a = 418: b = 19: c = 23: GOSUB incrow
IF berhmmut THEN a = 418: b = 42: c = 21: GOSUB incrow
IF berdet THEN a = 247: b = 32: c = 9: GOSUB incrow
COLOR 9
IF berstr > 0 THEN a = 245: b = 56: c = 6: GOSUB incrow
IF berstr < 0 THEN a = 245: b = 62: c = 4: GOSUB incrow
IF berdex > 0 THEN a = 246: b = 1: c = 5: GOSUB incrow
IF berdex < 0 THEN a = 246: b = 6: c = 6: GOSUB incrow
IF bercon > 0 THEN a = 246: b = 12: c = 6: GOSUB incrow
IF bercon < 0 THEN a = 246: b = 18: c = 6: GOSUB incrow
IF berrr > 0 THEN a = 246: b = 24: c = 27: GOSUB incrow
IF berrr < 0 THEN Printjnk 246, 51, 4: Printjnk 246, 28, 23: a = 0: GOSUB incrow
IF bermr > 0 THEN a = 247: b = 1: c = 13: GOSUB incrow
IF bermr < 0 THEN Printjnk 247, 14, 4: Printjnk 247, 7, 7: a = 0: GOSUB incrow
IF berintl > 0 THEN a = 247: b = 18: c = 5: GOSUB incrow
IF berintl < 0 THEN a = 247: b = 23: c = 4: GOSUB incrow
COLOR 5
IF berff OR ffgen THEN a = 404: b = 12: c = 25: GOSUB incrow
IF repulse THEN a = 122: b = 21: c = 31: GOSUB incrow
IF bergreen THEN a = 205: b = 28: c = 5: GOSUB incrow
IF berfresh THEN a = 288: b = 59: c = 9: GOSUB incrow
IF berscience THEN a = 247: b = 46: c = 10: GOSUB incrow
IF berscare THEN a = 247: b = 56: c = 11: GOSUB incrow
IF berrambo THEN a = 248: b = 1: c = 11: GOSUB incrow
IF berklutz THEN a = 304: b = 10: c = 6: GOSUB incrow
IF berregen THEN a = 305: b = 49: c = 12: GOSUB incrow
IF beryum THEN a = 306: b = 1: c = 5: GOSUB incrow
COLOR 2
IF sick THEN a = 248: b = 21: c = 14: GOSUB incrow
IF strtox THEN
d = strtox: e = 307: f = 14: g = 12: a = 249: b = 1: c = 18: GOSUB incrow
END IF
IF dextox THEN
d = dextox: e = 369: f = 17: g = 13: a = 312: b = 19: c = 16: GOSUB incrow
END IF
IF contox THEN
d = contox: e = 369: f = 1: g = 16: a = 312: b = 35: c = 21: GOSUB incrow
END IF
IF hittox THEN
d = hittox: e = 307: f = 26: g = 10: a = 312: b = 35: c = 21: GOSUB incrow
END IF
COLOR 6
IF serum! > gt! THEN a = 407: b = 1: c = 26: GOSUB incrow
IF wpturns THEN a = 245: b = 32: c = 13: GOSUB incrow
IF sunscreen THEN a = 245: b = 45: c = 11: GOSUB incrow
IF mindweb THEN a = 110: b = 21: c = 22: GOSUB incrow
IF udder THEN a = 248: b = 35: c = 7: GOSUB incrow
IF tapeworm THEN a = 308: b = 56: c = 10: GOSUB incrow
IF coffee THEN a = 291: b = 59: c = 10: GOSUB incrow
IF brandy > 1500 THEN
a = 247: b = 27: c = 5: GOSUB incrow
ELSEIF brandy > 600 THEN
a = 317: b = 44: c = 5: GOSUB incrow
ELSEIF brandy > 0 THEN
a = 317: b = 23: c = 13: GOSUB incrow
END IF
IF metshat THEN a = 94: b = 54: c = 13: GOSUB incrow
COLOR 8
SELECT CASE spore
CASE 0
CASE 1 TO 3: a = 137: b = 1: c = 12: GOSUB incrow 'odd
CASE 4 TO 6: a = 137: b = 13: c = 15: GOSUB incrow 'sweat
CASE 7 TO 9: a = 137: b = 28: c = 20: GOSUB incrow 'lightheaded
CASE ELSE: a = 137: b = 48: c = 20: GOSUB incrow 'heart racing
END SELECT
IF row = 4 AND col = 5 THEN COLOR 11: Printjnk 2, 15, 6: row = 5
row = row + 2: IF col > 5 THEN row = 20
COLOR 9: LOCATE row, 4: SetCombatStats
PRINT USING jnk$(411, 1, 43); str2hit + other2hitc; strdam + otherdam;
LOCATE row + 1, 4
PRINT USING jnk$(411, 1, 28); dex2hit + other2hitr; otherdam;
Printjnk 411, 44, 13
IF lvl <= 12 THEN needed& = 5& * 2 ^ lvl ELSE needed& = (5& * 2 ^ 12) * (lvl - 11)
LOCATE row + 3, 5
PRINT USING jnk$(138, 17, 36); LTRIM$(STR$(needed&)); : PRINT lvl + 1;
COLOR 3
LOCATE 1, 50
IF fastfight THEN aa$ = "on" ELSE aa$ = "off"
PRINT jnk$(279, 21, 19); aa$;
LOCATE 2, 50: b = 4: c = 22
SELECT CASE difficulty
CASE moderateplay: b = 29: c = 18
CASE easyplay: b = 50: c = 9
END SELECT
Printjnk 280, b, c
LOCATE 25, 5: COLOR 10, 0: Printjnk 3, 1, 18
SCREEN , , 3
EXIT SUB
incrow:
IF a > 0 THEN Printjnk a, b, c
IF d > 0 THEN PRINT USING jnk$(e, f, g); LTRIM$(RTRIM$(STR$(d))); : d = 0
row = row + 1: IF row > 18 THEN row = 4: col = col + 37: IF col > 60 THEN col = 5
LOCATE row, col
RETURN
END SUB
SUB BuildGoody (iii) 'return iii to Use as remoov - true if successful build
SCREEN , , 3: ccls 3
IF ngoody = 20 THEN ljnk 57, 25, 29, 1: MessPause 5, 0: GOTO exbg
brainymult! = (1 - (berhmmut > 0)) * (1 - (berscience > 0))
brainymult! = .8 * brainymult! / (1 - 2 * (berklutz > 0)) / (1 - 2 * (berrambo > 0))
IF brainymult! > 1 THEN brainymult! = 1
IF goody(ngoody, 1) = 10 THEN 'determine usable parts amounts----
partsweight = goody(ngoody, 2) * brainymult!
partsenergy = goody(ngoody, 3) * brainymult!
ELSE
iii = false: ClearMess: ljnk 357, 1, 31, 1: MessPause 5, 0: GOTO exbg
END IF
COLOR 9, 0: LOCATE 2, 5: Printjnk 356, 21, 48
i = 1: max = 0
DO
renumbl: num = cRoll(nssd + ntechwep + nstrash + nlsd + nltrash)
SELECT CASE num
CASE 2, 6, 14, 15, 19, nssd + ntechwep + 5, nssd + ntechwep + 13: GOTO renumbl
CASE nssd + ntechwep + nstrash + 8: GOTO renumbl
END SELECT
scratch(i) = num: typ = 1
IF num > nssd + ntechwep + nstrash THEN
num = num - nssd - ntechwep - nstrash: typ = 2
END IF
energy = 0
IF typ = 1 THEN
known = ssdknown(num): st1 = ssdnm$(num)
weight = ssd(num, 1): maxenergy = ssd(num, 2)
ELSE
known = lsdknown(num): st1 = lsdnm$(num)
weight = lsd(num, 1): maxenergy = lsd(num, 2)
END IF
IF maxenergy > 0 THEN
energy = 10 / maxenergy: IF energy < 1 THEN energy = 1
END IF
bad = false
IF known AND (weight <= partsweight) AND (energy <= partsenergy) THEN
FOR j = 1 TO i - 1
IF scratch(j) = scratch(i) THEN bad = true
NEXT
ELSE
bad = true
END IF
IF NOT bad THEN
max = i: i = i + 1
COLOR 17 - 3 * typ: LOCATE max + 3, 5: PRINT max; ": "; st1;
ELSEIF cRoll(20 * brainymult! ^ 2) <= 1 THEN
i = 11
END IF
LOOP WHILE i <= 8
COLOR 9
IF max = 0 THEN
LOCATE 2, 5: Printjnk 359, 1, 41: PRINT SPACE$(10)
LOCATE 3, 5: Printjnk 3, 1, 18: PauseForKey: SCREEN , , vpage: EXIT SUB
END IF
rebg: LOCATE max + 5, 5: Printjnk 357, 32, 27
INPUT "", st1: choice = VAL(st1)
SELECT CASE choice
CASE 0: fatadd! = 1: iii = false: SCREEN , , vpage: EXIT SUB
CASE 1 TO max: iii = true
IF berconfuse THEN choice = cRoll(max)
num = scratch(choice): ngoody = ngoody + 1
FOR j = 1 TO 12: goody(ngoody, j) = 0: NEXT
goody(ngoody, 10) = true 'known
IF num > nssd + ntechwep + nstrash THEN GOSUB bldl ELSE GOSUB blds
energygiven = 0
IF (maxenergy > 0) AND (partsenergy > 0) THEN
COLOR 13: LOCATE max + 7, 5: Printjnk 358, 1, 41
COLOR 5: LOCATE max + 8, 5: Printjnk 416, 33, 33
LOCATE max + 9, 5: Printjnk 417, 1, 21
minuse = 10 / maxenergy: IF minuse < 1 THEN minuse = 1
PRINT STR$(minuse); jnk$(416, 35, 5); : IF minuse > 1 THEN PRINT "s";
INPUT " ", st1: energygiven = VAL(st1)
IF energygiven > 10 THEN energygiven = 10
IF energygiven > partsenergy THEN energygiven = partsenergy
IF energygiven < minuse THEN energygiven = 0
goody(ngoody, 3) = energygiven * maxenergy / 10
ELSEIF maxenergy > 0 THEN
goody(ngoody, 3) = 0
ELSE
goody(ngoody, 3) = -1
END IF
goody(ngoody - 1, 2) = goody(ngoody - 1, 2) - goody(ngoody, 2) / brainymult!
goody(ngoody - 1, 3) = goody(ngoody - 1, 3) - energygiven / brainymult!
fatadd! = 10
CASE ELSE: LOCATE max + 6, 5: Printjnk 46, 1, 44: GOTO rebg
END SELECT
IF rdisp = 2 THEN DisplayGoodies false
SCREEN , , vpage
EXIT SUB
bldl:
num = num - nssd - ntechwep - nstrash: goody(ngoody, 1) = 8
FOR j = 1 TO 3: goody(ngoody, j + 1) = lsd(num, j): NEXT j
goody(ngoody, 11) = num: maxenergy = lsd(num, 2): gdy(ngoody) = lsdnm$(num)
RETURN
blds:
goody(ngoody, 1) = 7
FOR i = 1 TO 8: goody(ngoody, i + 1) = ssd(num, i): NEXT i
goody(ngoody, 11) = num: maxenergy = ssd(num, 2): gdy(ngoody) = ssdnm$(num)
RETURN
exbg:
didstuff = false: SCREEN , , vpage
END SUB
SUB Compute (main%)
OPEN "alphaman.6" FOR BINARY AS #2 'for treatise, tech specifics
timesthrough = 0
cmpt:
timesthrough = timesthrough + 1
SELECT CASE main%
CASE 2 'Monolith
nselect = 9: nselext = 8: maxcomp = 14
CASE 1 'Workstation
nselect = 6 - 2 * (berscience <> 0) + (intl < 7) + (intl < 11)
nselext = 3 - 2 * (berscience <> 0) + (intl < 9)
maxcomp = 11
CASE ELSE '0 - Data Computer
nselect = 4 - 3 * (berscience <> 0) + (intl < 7) + (intl < 11)
nselext = 2 - (berscience <> 0) + (intl < 9)
maxcomp = 9
END SELECT
FOR j = 1 TO maxcomp: scratch(j) = j: NEXT
FOR j = 1 TO nselect
resel: scratch(j) = cRoll(maxcomp): nope = false
FOR k = 1 TO j - 1
IF scratch(j) = scratch(k) THEN nope = true: EXIT FOR
IF scratch(j) < scratch(k) THEN SWAP scratch(j), scratch(k)
NEXT k: IF nope THEN GOTO resel
NEXT j
SCREEN , , 3, vpage: ccls 3: row = 4: COLOR 11, 0: LOCATE 2, 5
IF main% = 2 THEN Printjnk 324, 41, 27 ELSE Printjnk 178, 50, 14
COLOR 9
FOR j = 1 TO nselect
GOSUB nmsel: LOCATE row, 5: PRINT STR$(j); bl; st1; : row = row + 1
NEXT
row = row + 1: COLOR 3: LOCATE row, 5: Printjnk 349, 52, 16
SCREEN , , 3
rsel: PauseForKey
aa = VAL(st1): IF aa < 1 OR aa > nselect THEN Wrong: GOTO rsel
IF berconfuse THEN aa = cRoll(nselect)
ccls 3
SELECT CASE scratch(aa)
CASE 1 'Food ====================================================
COLOR 5: LOCATE 5, 10: PRINT CHR$(22): COLOR 13
LOCATE 5, 15: Printjnk 179, 1, 48
COLOR 6: LOCATE 7, 10: PRINT CHR$(254): COLOR 14
LOCATE 7, 15: Printjnk 180, 1, 42
COLOR 12: LOCATE 9, 10: Printjnk 354, 1, 62: mx = mx + 10
CASE 2 'Weapons =============================================
num = nwep + nrwep: row = 3: COLOR 9
nselext = nselext + 2: IF nselext > 9 THEN nselext = 9
FOR j = 1 TO nselext
selwep: scratch(j + 20) = cRoll(num): nope = false
FOR k = 1 TO j - 1
IF scratch(j + 20) = scratch(k + 20) THEN nope = true: EXIT FOR
IF scratch(j + 20) < scratch(k + 20) THEN SWAP scratch(j + 20), scratch(k + 20)
NEXT k: IF nope THEN GOTO selwep
NEXT j
FOR j = 1 TO nselext
LOCATE row, 15: PRINT STR$(j); bl; wepnm$(scratch(j + 20));
row = row + 1
NEXT j
row = row + 1: COLOR 3: LOCATE row, 5: Printjnk 178, 37, 13
row = row + 2
rswep: PauseForKey
aa = VAL(st1): IF aa < 1 OR aa > nselext THEN Wrong: GOTO rswep
IF berconfuse THEN aa = cRoll(nselext)
typ = scratch(aa + 20)
ccls 3: COLOR 11
LOCATE 10, 15: PRINT wepnm$(typ); " : ";
numdice = wep(typ, 3): dicsiz = wep(typ, 4)
PRINT LTRIM$(STR$(numdice)); "-"; LTRIM$(STR$(numdice * dicsiz)); bl;
Printjnk 179, 49, 7: PRINT SPACE$(3);
IF wep(typ, 5) >= 0 THEN
st1 = CHR$(43) + LTRIM$(STR$(wep(typ, 5)))
ELSE
st1 = LTRIM$(STR$(wep(typ, 5)))
END IF
PRINT st1; bl; : Printjnk 179, 56, 7: PRINT ; SPACE$(3);
Printjnk 179, 63, 5: PRINT STR$(wep(typ, 6));
CASE 3 'Armor ======================================================
IF nselext > 9 THEN nselext = 9
FOR j = 1 TO nselext
selarm: scratch(j + 20) = cRoll(narm - 1): nope = false
FOR k = 1 TO j - 1
IF scratch(j + 20) = scratch(k + 20) THEN nope = true: EXIT FOR
IF scratch(j + 20) < scratch(k + 20) THEN SWAP scratch(j + 20), scratch(k + 20)
NEXT k: IF nope THEN GOTO selarm
NEXT j: row = 3: COLOR 7
FOR j = 1 TO nselext
LOCATE row, 15: PRINT STR$(j); bl; armnm$(scratch(j + 20)): row = row + 1
NEXT j: row = row + 1
COLOR 15: LOCATE row, 5: Printjnk 178, 37, 13: row = row + 2
rsarm: PauseForKey
aa = VAL(st1): IF aa < 1 OR aa > nselext THEN Wrong: GOTO rsarm
IF berconfuse THEN aa = cRoll(nselext)
typ = scratch(aa + 20)
ccls 3: LOCATE 10, 15: PRINT armnm$(typ); " : ";
Printjnk 180, 43, 7: PRINT STR$(typ - 2); CHR$(44); SPACE$(3);
PRINT STR$(arm(typ, 2)); : Printjnk 180, 50, 17
CASE 4 'Shields ===================================================
IF nselext > nsh - 1 THEN nselext = nsh - 1
IF nselext > 9 THEN nselext = 9
FOR j = 1 TO nselext
selsh: scratch(j + 20) = cRoll(nsh - 1): nope = false
FOR k = 1 TO j - 1
IF scratch(j + 20) = scratch(k + 20) THEN nope = true: EXIT FOR
IF scratch(j + 20) < scratch(k + 20) THEN SWAP scratch(j + 20), scratch(k + 20)
NEXT k: IF nope THEN GOTO selsh
NEXT j: row = 3: COLOR 3
FOR j = 1 TO nselext
LOCATE row, 15: PRINT STR$(j); bl; shnm$(scratch(j + 20)): row = row + 1
NEXT j: row = row + 1
COLOR 15: LOCATE row, 5: Printjnk 178, 37, 13: row = row + 2
rssh: PauseForKey
aa = VAL(st1): IF aa < 1 OR aa > nselext THEN Wrong: GOTO rssh
IF berconfuse THEN aa = cRoll(nselext)
typ = scratch(aa + 20): lll = (nsh - typ + 1) \ 2: mm = (nsh - typ + 1) MOD 2
ccls 3: LOCATE 10, 15: PRINT shnm$(typ); " : -";
IF lll THEN PRINT LTRIM$(STR$(lll));
IF mm > 0 THEN PRINT CHR$(171);
Printjnk 61, 11, 7: PRINT SPACE$(3); STR$(sh(typ, 2));
Printjnk 180, 50, 17
CASE 5 'Berries =================================================
IF nselext > 8 THEN nselext = 8
row = 9 - nselext
FOR j = 1 TO nselext
k = cRoll(nberry): scratch(j + 20) = k
nope = false
FOR l = 1 TO j - 1
IF scratch(j + 20) = scratch(l + 20) THEN nope = true
NEXT
IF NOT nope THEN
knownb(k) = true: LOCATE row, 5
COLOR 12: PRINT berry$(k);
COLOR 4: Printjnk 22, 5, 9: PRINT BerEff$(k)
LOCATE row + 1, 5: num = k + 230: GOSUB gettech: PRINT st1;
row = row + 3
END IF
NEXT j
CASE 6 'SSD ======================================================
row = 4: COLOR 14: LOCATE 2, 1: Printjnk 193, 36, 33
FOR j = 1 TO nselext
k = cRoll(nssd + ntechwep + nstrash): scratch(j + 20) = k
nope = false
FOR l = 1 TO j - 1
IF scratch(j + 20) = scratch(l + 20) THEN nope = true: EXIT FOR
NEXT l
ssdknown(k) = true: LOCATE row, 1
FOR l = 1 TO ngoody
IF ABS(goody(l, 1)) = 7 AND goody(l, 11) = k THEN goody(l, 10) = true
NEXT l
FOR l = 1 TO npack
IF ABS(backpack(l, 1)) = 7 AND backpack(l, 11) = k THEN backpack(l, 10) = true
NEXT l
FOR l = 1 TO nsafe
IF ABS(safe(l, 1)) = 7 AND safe(l, 11) = k THEN safe(l, 10) = true
NEXT l
IF NOT nope THEN
COLOR 14: PRINT ssdnm$(k);
IF k > nssd AND k <= nssd + ntechwep THEN
PRINT " : ";
numdice = ssd(k, 4): dicsiz = ssd(k, 5)
PRINT LTRIM$(STR$(numdice)); "-"; LTRIM$(STR$(numdice * dicsiz)); bl;
Printjnk 179, 49, 7
PRINT SPACE$(3); CHR$(43); LTRIM$(STR$(ssd(k, 6))); bl;
Printjnk 179, 56, 7
PRINT SPACE$(3);
IF k <= nssd + ngrenade THEN
Printjnk 273, 57, 12
ELSE
Printjnk 179, 63, 5
END IF
PRINT STR$(ssd(k, 7));
END IF
SELECT CASE k
CASE 1 TO nssd: num = k
CASE nssd + 1 TO nssd + ngrenade: num = nssd + 1
CASE nssd + ngrenade + 1 TO nssd + ntechwep: num = nssd + 2
CASE ELSE: num = k - ntechwep + 2
END SELECT
num = k
GOSUB gettech: COLOR 6: LOCATE row + 1, 1: PRINT st1; : row = row + 2
END IF
NEXT j
CASE 7 'LSD =======================================================
row = 7: COLOR 11: LOCATE 5, 1: Printjnk 193, 36, 33
numb = nselext / 2: IF numb < 1 THEN numb = 1
FOR j = 1 TO numb
k = cRoll(nlsd + nltrash): scratch(j + 20) = k
nope = false
FOR l = 1 TO j - 1
IF scratch(j + 20) = scratch(l + 20) THEN nope = true: EXIT FOR
NEXT
lsdknown(k) = true: LOCATE row, 1
FOR l = 1 TO ngoody
IF ABS(goody(l, 1)) = 8 AND goody(l, 11) = k THEN goody(l, 10) = true
NEXT l
FOR l = 1 TO npack
IF ABS(backpack(l, 1)) = 8 AND backpack(l, 11) = k THEN backpack(l, 10) = true
NEXT l
FOR l = 1 TO nsafe
IF ABS(safe(l, 1)) = 8 AND safe(l, 11) = k THEN safe(l, 10) = true
NEXT l
IF NOT nope THEN
COLOR 11: PRINT lsdnm$(k)
num = k + nssd + nstrash + 2
num = k + nssd + ntechwep + nstrash: GOSUB gettech
COLOR 3: LOCATE row + 1, 1: PRINT st1; : row = row + 2
END IF
NEXT j
CASE 8 'Critters ===============================================
selcrtop:
IF nselext > 9 THEN nselext = 9
FOR j = 1 TO nselext
selcr: scratch(j + 20) = cRoll(ncreat + creextra): nope = false
FOR k = 1 TO j - 1
IF scratch(j + 20) = scratch(k + 20) THEN nope = true: EXIT FOR
NEXT k: IF nope THEN GOTO selcr
NEXT j: row = 3: COLOR 1 + 1: ccls 3
FOR j = 1 TO nselext
LOCATE row, 15: PRINT STR$(j) + bl + CreatNam$(scratch(j + 20), 1)
row = row + 1
NEXT j: row = row + 1
COLOR 15: LOCATE row, 5: Printjnk 178, 37, 13: row = row + 2
rscr: PauseForKey
aa = VAL(st1): IF aa < 1 OR aa > nselext THEN Wrong: GOTO rscr
IF berconfuse THEN aa = cRoll(nselext)
typ = scratch(aa + 20): DisplayCritter typ
IF cRoll(100) < main% * intl AND cRoll(10) <> 1 THEN PauseForKey: GOTO selcrtop
CASE 9 'Lore =====================================================
COLOR 10: row = 0
comlore:
LOCATE 10 + row, 10: zz = cRoll(84)
IF main% = 2 THEN zz = row * 18 + 18
SELECT CASE zz
CASE 1 TO 19: a = 61: b = 18: c = 27
CASE 20 TO 38: a = 89: b = 1: c = 37
CASE 39 TO 57: a = 198: b = 1: c = 48
CASE 58 TO 76: a = 197: b = 33: c = 31
CASE ELSE: a = 199: b = 1: c = 42
END SELECT
Printjnk a, b, c: row = row + 1
IF main% = 2 AND row < 5 GOTO comlore
CASE 10 'Treatise on Berry Colors ================================
COLOR 12: FOR num = 150 TO 163
GOSUB gettech: LOCATE num - 144, 5: PRINT st1; : NEXT
CASE 11 'Treatise on Arms and Armor ==============================
COLOR 9: FOR num = 211 TO 221
GOSUB gettech: LOCATE num - 205, 3: PRINT st1; : NEXT
CASE 12 'Weapon Comparison =======================================
LOCATE 5, 10: Printjnk 163, 1, 30: row = 0
DO: row = row + 1: LOCATE 6 + row, 10: PRINT wepnm$(row); TAB(35);
IF row < 11 THEN PRINT wepnm$(row + 14)
LOOP UNTIL row = 14
CASE 13 'Armor & Shield Comparison ===============================
LOCATE 5, 10: Printjnk 164, 1, 40: row = 0
DO: row = row + 1: LOCATE 6 + row, 10: PRINT armnm$(row); TAB(35);
IF row <= nsh THEN PRINT shnm$(row)
LOOP UNTIL row = 12
CASE 14 'TapeRecorder messages
oldvpage = vpage: vpage = 3: tapenum = 0
CLOSE #2: FOR i = 1 TO 7: TapeRecorder 0: NEXT i: vpage = oldvpage
OPEN "alphaman.6" FOR BINARY AS #2 'had to close: OPEN in TapeRecrdr
END SELECT
COLOR 10: LOCATE 25, 1: Printjnk 35, 1, 32: PauseForKey
mx = 25 + intl: IF mx > 50 THEN mx = 50
IF (timesthrough < main% + 1) OR (cRoll(100) < mx) THEN GOTO cmpt
ccls 3: SCREEN , , vpage: CLOSE #2
EXIT SUB
nmsel:
a = 177: st1 = ""
SELECT CASE scratch(j)
CASE 1: b = 15: c = 4
CASE 2: a = 207: b = 26: c = 7
CASE 3: b = 47: c = 5
CASE 4: a = 3: b = 56: c = 7
CASE 5: b = 58: c = 7
CASE 6: a = 178: b = 1: c = 18
CASE 7: a = 178: b = 19: c = 5: st1 = jnk$(178, 6, 13)
CASE 8: a = 178: b = 24: c = 9
CASE 9: a = 178: b = 33: c = 4
CASE 10: a = 112: b = 13: c = 26
CASE 11: a = 276: b = 1: c = 28
CASE 12: a = 355: b = 1: c = 17
CASE 13: a = 355: b = 18: c = 27
CASE 14: a = 355: b = 45: c = 8
END SELECT
st1 = jnk$(a, b, c) + st1
RETURN
gettech:
st1 = SPACE$(74): GET #2, num * 74 - 73, st1
FOR i = 1 TO 74
MID$(st1, i, 1) = CHR$(ASC(MID$(st1, i, 1)) XOR (ABS(17 * num + 31 * i) MOD 256))
NEXT i
st1 = RTRIM$(st1)
RETURN
END SUB
SUB CrDamAlter (num, dam, damtype)
defnum = ncre(num, 10): suscnum = ncre(num, 12)
typ = ncre(num, 1)
SELECT CASE damtype
CASE 1: IF defnum AND 1 THEN dam = (dam + 2) \ 3
IF suscnum AND 1 THEN dam = dam * 2
IF typ = mph THEN dam = 1: mphk num, 1
IF typ = roach THEN roachdef = roachdef OR 1
CASE 2: IF defnum AND 8 THEN dam = 0
IF suscnum AND 8 THEN dam = dam * 2
IF typ = mph THEN dam = 1: mphk num, 2
IF typ = roach THEN roachdef = roachdef OR 8
CASE 3, 4, 5: IF defnum AND 1024 THEN dam = 0
IF suscnum AND 1024 THEN dam = dam * 2
IF cRoll(3) = 1 AND dam > 0 THEN ncre(num, 11) = ncre(num, 11) OR 8
IF typ = mph THEN dam = 1: mphk num, 3
IF typ = roach THEN roachdef = roachdef OR 1024
CASE 6: IF defnum AND 2 THEN dam = 0
IF suscnum AND 2 THEN dam = dam * 2
IF typ = mph THEN dam = 1: mphk num, 6
IF typ = roach THEN roachdef = roachdef OR 2
CASE 7
IF defnum AND 64 THEN
dam = 0
ELSEIF defnum AND 128 THEN
dam = -dam: Ljnkbig -1, 62, 6, 0, 0, 0, Der$(false, num, 2), 0, 2
END IF
IF suscnum AND 64 THEN dam = dam * 2
IF typ = mph THEN dam = 1: mphk num, 7
IF typ = roach THEN roachdef = roachdef OR 64
CASE 8: IF defnum AND 512 THEN dam = 0
IF suscnum AND 512 THEN dam = dam * 2
IF typ = mph THEN dam = 1: mphk num, 8
IF typ = roach THEN roachdef = roachdef OR 512
CASE 9: IF defnum AND 4 THEN dam = 0
IF suscnum AND 4 THEN dam = dam * 2
IF typ = mph THEN dam = 1: mphk num, 9
IF typ = roach THEN roachdef = roachdef OR 4
CASE 10
IF defnum AND 16 THEN
dam = 0
ELSEIF defnum AND 128 THEN
dam = -dam: Ljnkbig -1, 62, 6, 0, 0, 0, Der$(false, num, 2), 0, 2
END IF
IF suscnum AND 16 THEN dam = dam * 2
IF typ = mph THEN dam = 1: mphk num, 10
IF typ = roach THEN roachdef = roachdef OR 16
CASE 11: IF defnum AND 32 THEN dam = 0
IF suscnum AND 32 THEN dam = dam * 2
IF typ = mph THEN dam = 1: mphk num, 11
IF typ = roach THEN roachdef = roachdef OR 32
CASE 12: IF defnum AND 1 THEN dam = (dam + 2) \ 3
IF suscnum AND 1 THEN dam = dam * 2
IF typ = mph THEN dam = 1: mphk num, 1
ncre(num, 6) = 0 'move rate = 0
CASE 15: IF suscnum AND 128 THEN dam = dam * 2
' IF typ = mph THEN dam = 1: mphk num, 15
CASE 18: IF (suscnum AND 2048) = 0 THEN ncre(num, 11) = ncre(num, 11) OR 32 ELSE dam = 0
CASE 22: IF (suscnum AND 4096) = 0 THEN ncre(num, 11) = ncre(num, 11) OR 2 ELSE dam = 0
CASE 26: IF typ = mph THEN dam = 1: mphk num, 1
IF typ = gill THEN dam = RollDice(12, 8, 6)
CASE 27: IF typ = mph THEN dam = 1: mphk num, 3
ncre(num, 11) = ncre(num, 11) AND (NOT 1) 'asleep
CASE 28: IF typ = mph THEN dam = 1: mphk num, 9
IF (suscnum AND 2048) = 0 THEN ncre(num, 11) = ncre(num, 11) OR 16
CASE 29: IF typ = mph THEN dam = 1: mphk num, 9
IF typ = slug OR typ = snail OR typ = leec OR typ = slime THEN
dam = RollDice(8, 8, 8)
END IF
CASE 31
IF typ = rdro OR typ = ddro OR typ = sdro OR typ = wdro OR typ = robot THEN
dam = 2 * ncre(num, 2)
ELSE
damtype = 1: dam = 1: IF typ = mph THEN mphk num, 1
END IF
CASE ELSE: IF typ = mph THEN dam = 1: mphk num, 6
END SELECT
END SUB
SUB define
ccls 3: SCREEN , , 3: LOCATE 7, 5: COLOR 5, 0
INPUT "Enter name for wimpy monster: ", w$
IF LTRIM$(RTRIM$(w$)) <> "" THEN wimpname$ = w$ ELSE wimpname$ = "Wolverine"
LOCATE 9, 5: COLOR 4, 0
INPUT "Enter letter to represent this monster: ", wsym$
IF UCASE$(wsym$) >= "A" AND UCASE$(wsym$) <= "Z" THEN
wimpsym = ASC(wsym$)
ELSE
wimpsym = 77
END IF
LOCATE 15, 5: FOR i = 0 TO 15: COLOR i, 0: PRINT i; : NEXT i
LOCATE 11, 5: COLOR 4, 0
INPUT "Enter color to represent this monster: ", w
IF w >= 0 AND w <= 16 THEN wimpcolr = w ELSE wimpcolr = 1
IF wimpcolr = wallcolr THEN wimpcolr = wallcolr - 8
SCREEN , , vpage
CLOSE #2: OPEN "alphaman.def" FOR OUTPUT AS #2
PRINT #2, "WIMPNAME " + wimpname$
PRINT #2, "WIMPSYM " + CHR$(wimpsym)
PRINT #2, "WIMPCOLOR"; wimpcolr: CLOSE #2
END SUB
SUB Dismantle (i)
IF ngoody = 0 THEN EXIT SUB
ljnk 350, 1, 15, 1
k = 0: SelectGoody k, 14, false
IF k < 1 THEN didstuff = false: ClearMess: EXIT SUB
IF berconfuse THEN k = cRoll(ngoody)
SELECT CASE goody(k, 1)
CASE -7, -8
a = 234: b = 41: c = 28: fc = 11: didstuff = false
CASE 7, 8: i = true 'returned to use as remoov
fract! = (1! - (berscience > 0)) * (1 - (berhmmut > 0))
fract! = fract! / (1! - 2 * (berrambo > 0)) * (1 - 2 * (berklutz > 0))
SELECT CASE goody(k, 1)
CASE 7: fractnum = ssdtyp(goody(k, 11))
CASE 8: fractnum = lsdtyp(goody(k, 11))
END SELECT
massfract! = (fractnum MOD 10) / 10! * fract! * (6! + cRoll(8)) / 12!
IF massfract! > .95 THEN massfract! = .95
energyfract! = (fractnum \ 10) / 10! * fract! * (8! + cRoll(5)) / 12!
IF energyfract! > .95 THEN energyfract! = .95
goody(k, 2) = goody(k, 2) * massfract!
IF goody(k, 2) < 1 THEN goody(k, 2) = 1
IF goody(k, 3) > 0 THEN
IF goody(k, 1) = 7 THEN
goody(k, 3) = goody(k, 3) * 10! / ssd(goody(k, 11), 2)
ELSE
goody(k, 3) = goody(k, 3) * 10! / lsd(goody(k, 11), 2)
END IF
goody(k, 3) = goody(k, 3) * (9! + cRoll(11)) / 20! * energyfract!
ELSE
goody(k, 3) = 0
END IF
goody(k, 1) = 10
FOR j = 4 TO 12: goody(k, j) = 0: NEXT j
gdy(k) = jnk$(319, 50, 17)
fatadd! = 4
IF goody(k, 2) <> 1 THEN lng = 13 ELSE lng = 12 ' "s" on end
Ljnkbig 412, 50, 12, 414, 49, lng, STR$(goody(k, 2)), 1, 1
IF goody(k, 3) <> 1 THEN lng = 13 ELSE lng = 12
Ljnkbig 354, 25, 3, 358, 9, lng, STR$(goody(k, 3)), 1, 2
MessPause 13, 0
CASE ELSE
a = 360: b = 1: c = 30: fc = 11: didstuff = false
END SELECT
IF c > 0 THEN ljnk a, b, c, 2: MessPause fc, 0
IF rdisp = 2 THEN DisplayGoodies false ELSE SortGoody
END SUB
SUB ffEffect (damage, ffkill)
ffkill = false: IF damage < 1 THEN EXIT SUB
IF forcefield THEN
damreduce = cRoll(damage) - 1
IF berhmmut > 0 THEN
damreduce2 = cRoll(damage)
IF damreduce < damreduce2 THEN damreduce = damreduce2
END IF
IF damreduce > (10 - 10 * (berhmmut > 0)) THEN damreduce = (10 - 10 * (berhmmut > 0))
damage = damage - damreduce
END IF
IF berff THEN
damreduce = cRoll(damage) - 1
IF damreduce > 10 THEN damreduce = 10
damage = damage - damreduce
END IF
IF ffgen AND (damage > 2) THEN
newdam = cRoll(damage / 2): ffgen = ffgen - cRoll(damage - newdam)
damage = newdam: iff = 0
FOR iu = 1 TO ngoody
IF goody(iu, 1) = -7 AND goody(iu, 11) = 13 THEN
iff = iu: goody(iu, 3) = ffgen: EXIT FOR
END IF
NEXT iu
IF ffgen <= 0 THEN
ffgen = 0
IF iff > 0 THEN
RemoveGoody iff, false: ffkill = true
IF rdisp = 2 THEN DisplayGoodies false
END IF
END IF
END IF
END SUB
SUB GetTextArray
OPEN st1 + "1" FOR BINARY AS #2
FOR num = -2 TO 420 'change 420 in jnk$ as well!!!!
GET #2, (num + 2) * 68 + 1, bbbb(num + 3)
IF (num MOD 20) = 0 THEN PRINT ".";
NEXT num
CLOSE #2
END SUB
FUNCTION jnk$ (num, strt, leng)
IF num < -2 THEN num = -2 ELSE IF num > 420 THEN num = 420
n = num + 3
IF leng > 69 - strt THEN leng = 69 - strt
junk$ = MID$(bbbb(n), strt, leng)
FOR i = 1 TO leng
MID$(junk$, i, 1) = CHR$(ASC(MID$(junk$, i, 1)) XOR (ABS(17 * num + 31 * (i + strt - 1)) MOD 256))
NEXT i
jnk$ = junk$
END FUNCTION
SUB Look (scope)
looking = true: vpagesav = vpage: vpage = 0
IF dark THEN ljnk 241, 48, 20, 1: didstuff = false: GOTO lo2
IF incastle THEN EXIT SUB
TargetLong lsym, 200!, nlx, nly, fc, bc: ClearMess
IF NOT didstuff THEN GOTO lo2
FOR l = 1 TO nnear
ncre(l, 4) = ncre(l, 4) - 50 * (nlx - mainx)
ncre(l, 5) = ncre(l, 5) - 20 * (nly - mainy)
NEXT l
lookrad = false
FOR i = 1 TO 10
IF nlx = radzone(i, 1) AND nly = radzone(i, 2) THEN
lookrad = true
oldterrain = terrain: oldterrf = terrf: oldterrb = terrb
oldrz = radzone(i, 3): oldi = i: oldradint = radint
IF i = grinchzone THEN terrain = 71: terrf = 5: map = true
terrb = 4: radzone(i, 3) = -ABS(radzone(i, 3))
radint = ABS(radzone(i, 3)): EXIT FOR
END IF
NEXT i
z = cRd(nlx - mainx, nly - mainy)
IF berdet THEN z = (z + 1) \ 2
IF scope AND (pmut = 4) AND (berpmut = 0) THEN z = (z + 1) \ 2
IF pmut = 4 AND berpmut = 0 AND berhpmut > 0 THEN z = (z + 1) \ 2
SELECT CASE z
CASE 0: ClearMess: ljnk 47, 1, 27, 1: didstuff = false: GOTO lo2
CASE 1
SWAP mainx, nlx: SWAP mainy, nly: looksym = terrain: SWAP terrain, lsym
startsav = starting: starting = 0
vpage = 1: DetailedMap false: starting = startsav
SWAP mainx, nlx: SWAP mainy, nly: SWAP terrain, lsym
CASE 2 TO 11
SWAP mainx, nlx: SWAP mainy, nly: looksym = terrain: SWAP terrain, lsym
startsav = starting: starting = 0
vpage = 1: DetailedMap false: starting = startsav
SWAP mainx, nlx: SWAP mainy, nly: SWAP terrain, lsym
SCREEN , , 3, 0: ccls 3
imax = INT(51 / z) + 1: irm = imax * z - 51: imin = 25 - imax / 2
jmax = INT(21 / z) + 1: jrm = jmax * z - 21: jmin = 11 - jmax / 2
FOR i = 2 TO imax: ic = cRoll(2 * z - 2 - irm) + irm - 1
FOR j = 2 TO jmax: jc = cRoll(2 * z - 2 - jrm) + jrm - 1
GetSym sym, z * i - ic, z * j - jc, fcc, bcc, 1
PutSym sym, i + imin, j + jmin, fcc, bcc, 3
NEXT j, i
Box imin + 1, imax + 1 + imin, jmin + 1, jmax + 1 + jmin, 1, 4, 3
SCREEN , , 3, 3
CASE ELSE
ljnk 47, 28, 34, 1: didstuff = false
END SELECT
IF didstuff THEN ClearMess
MessPause 5, 0
FOR l = 1 TO nnear
ncre(l, 4) = ncre(l, 4) + 50 * (nlx - mainx)
ncre(l, 5) = ncre(l, 5) + 20 * (nly - mainy)
NEXT l
IF lookrad THEN
terrain = oldterrain: terrf = oldterrf: terrb = oldterrb
radzone(oldi, 3) = oldrz: radint = oldradint
END IF
looking = false: DetailedMap false: PutSym lsym, nlx, nly, fc, bc, 0
lo2: looking = false: vpage = vpagesav: SCREEN , , vpage: PrintMessage 7, 0
END SUB
SUB MakeCommandScreen
ClearMess
ljnk 28, 57, 11, 1: PrintMessage 3, 0
SCREEN , , 3, vpage: ccls 3: COLOR 3, 0
RESTORE a8comd
FOR i = 1 TO 11: FOR j = 1 TO 60 STEP 27
IF j = 28 THEN j = 29
READ a, b, c: st1 = jnk$(a, b, c)
IF i > 3 THEN
PutSym ASC(LEFT$(st1, 1)), j, i, 11, 0, 3
LOCATE i, j + 1: PRINT RIGHT$(st1, LEN(st1) - 1);
ELSE
LOCATE i, j: PRINT st1;
END IF
IF j = 29 THEN j = 28
NEXT j, i
OPEN "alphaman.5" FOR INPUT AS #2
FOR i = 1 TO 33: LINE INPUT #2, st1: NEXT 'unused commands+blank
LINE INPUT #2, st1: PRINT st1: LINE INPUT #2, st1
COLOR 9
FOR i = 1 TO 6
LOCATE i + 13, 1: LINE INPUT #2, st1: PRINT st1; 'stat descr.
NEXT
FOR i = 1 TO 2 * pmut - 1: LINE INPUT #2, st1: NEXT 'unused pmuts+blank
COLOR 5: LOCATE 20, 1: LINE INPUT #2, st1: PRINT st1; 'pmuts
LOCATE 21, 1: LINE INPUT #2, st1: PRINT st1; 'pmuts
FOR i = 1 TO 2 * (nphysmut - pmut) + 2 * mmut - 1
LINE INPUT #2, st1 'unused pmuts+blank+mmuts
NEXT
LOCATE 22, 1: LINE INPUT #2, st1: PRINT st1; 'mmuts
LOCATE 23, 1: LINE INPUT #2, st1: PRINT st1; 'mmuts
CLOSE #2
COLOR 10: LOCATE 25, 1: Printjnk 320, 1, 68
SCREEN , , vpage
END SUB
SUB Search (s%)
IF berblind THEN
ljnk 352, 56, 13, 1: didstuff = false
ELSEIF mask THEN
ljnk 88, 45, 22, 2: didstuff = false
ELSE
fatadd! = fatig!
IF (pmut = 4 AND berpmut = 0) THEN
num = (25 - 25 * (berhpmut > 0)): rrr = (2 - (berhpmut > 0))
IF uvhelmet THEN num = num * 3: rrr = rrr + 1
ELSE
num = 4: rrr = 1
IF uvhelmet THEN num = 10
END IF
IF berdet > 0 THEN num = num * 3 + 5: rrr = rrr + 1
IF s% = false THEN num = num / 5: rrr = rrr - 1: IF rrr < 1 THEN rrr = 1
IF sunglasses THEN num = num / 3: rrr = 1
IF num < 1 THEN num = 1
FOR i = 1 TO num
sea: dx = cRoll(2 * rrr + 1) - 1 - rrr: dy = cRoll(2 * rrr + 1) - 1 - rrr
IF (dx = 0 AND dy = 0) OR (NOT SameRoom(dx, dy)) THEN GOTO sea
xx = dx + localx: yy = dy + localy
GetSym sym, xx, yy, fc, bc, 2
SELECT CASE sym
CASE trap, pit, gas, 215, 216: PutSym sym, xx, yy, fc, bc, 1
CASE secretdoor: PutSym cen, xx, yy, wallcolr, 0, -1
CASE 65 TO 90, 97 TO 122
IF fc = 0 THEN PutSym sym, xx, yy, 8, bc, -1: seecrit = true
CASE ELSE: IF fc = 0 THEN PutSym sym, xx, yy, 8, bc, -1
END SELECT
NEXT i
END IF