-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathctrek.cob
1581 lines (1480 loc) · 60.9 KB
/
ctrek.cob
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
*>******************************************************
*> star_trek simulates an outer space adventure game *
*> on a remote terminal. The user commands the U.S.S. *
*> Enterprise, and thru various offensive and defen- *
*> sive commands, travels throughout the galaxy on a *
*> mission to destroy all Klingons, which also maneu- *
*> ver and fire on the Enterprise. *
*>******************************************************
*> Tectonics:
*> cobc -free -x ctrek.cob -cb_conf=perform-osvs:yes
*>******************************************************
identification division.
program-id. star_trek.
*>author. Kurt Wilhelm.
*>installation. Oakland University.
*>date-written. Completed September 1, 1979.
*> Harald Arnesen <[email protected]>, 2010-03-24:
*>
*> Ported to OpenCobol 1.1 by changing the comments
*> to free format, as some lines are too long for fixed format.
*>
*> I haven't played it, just checked that it compiles and runs!
*>
*> Original source:
*> <http://www.dunnington.u-net.com/public/startrek/ctrek.cob>
*>
*> Brian Tiffin <[email protected]>, 2010-03-24:
*> btiffin updates, it actually works now, when compiled with
*> perform-osvs:yes This allows thru with overlapping exits
environment division.
configuration section.
source-computer. multics.
object-computer. multics.
data division.
working-storage section.
01 eof-flag pic x value "n".
01 star-table.
05 row occurs 42 times.
10 kolumn pic x occurs 42 times.
01 rctr pic 99.
01 kctr pic 99.
01 commands-x.
05 command pic x(3).
88 navigate value "nav".
88 phasers value "pha".
88 torpedo value "tor".
88 shields value "def".
88 dock value "doc".
88 lib-com value "com".
88 nav-c value "NAV".
88 pha-c value "PHA".
88 tor-c value "TOR".
88 def-c value "DEF".
88 doc-c value "DOC".
88 com-c value "COM".
05 entry1 pic 9.
05 entry2 pic 9.
01 mini-table.
05 mrow occurs 14 times.
10 mcol pic x occurs 14 times.
01 rcntr pic 99.
01 kcntr pic 99.
01 x pic 999.
01 y pic 999.
01 ws-date pic 9(4).
01 time-flag pic 9.
88 time-flag-set value 1.
01 max-no pic 999.
01 hq1 pic 9.
01 hq2 pic 9.
01 t-store pic 9(4).
01 attack-flag pic 9.
88 klingons-attacking value 1.
01 too-late-flag pic 9.
88 too-late value 1.
01 bye-k pic 99.
01 var1 pic 99 value 1.
01 var2 pic 9(6).
01 var3 pic 9(6).
01 var4 pic 9(4).
01 var4-an pic x(4).
01 var5 pic zzz999.
01 var6 pic zzzz99.
01 return-x pic x.
01 comp-com pic 9.
01 base-cnt pic 9 value 0.
01 nx pic 99 value 0.
01 a pic 999.
01 b pic 999.
01 warp1 pic 99.
01 warp2 pic 99.
01 warp3 pic 99.
01 warp4 pic 99.
01 generate-table.
05 char pic x occurs 25 times.
01 seed-table pic x(25) value
"a4hfxnc89kd3jxf5dks3hb3m1".
01 genrte-result pic 9.
88 no-way value 1.
01 fuel-count pic s9(5).
01 torps pic 9 value 5.
01 prt-lines.
05 con-red.
10 filler pic x(16) value
"*Condition RED* ".
10 klgns pic 99.
10 filler pic x(21) value
" Klingons in quadrant".
05 con-green.
10 filler pic x(17) value
"*Condition GREEN*".
05 com-req.
10 filler pic x(22) value
"What is your command? ".
01 master-tbl.
05 marow occurs 126 times.
10 macol pic x occurs 126 times.
01 mrctr pic 999.
01 mkctr pic 999.
01 vab1 pic 9.
01 vab2 pic 99.
01 roll-x pic 999v.
01 shield-cnt pic s9(4).
01 shield-cnt-an pic x(4).
01 damage-cnt pic 9(6).
01 scan-keep.
05 cv pic 99 occurs 18 times.
01 scan-ctr pic 99.
01 scan-table.
05 scan-row occurs 14 times.
10 scan-col pic x occurs 14 times.
01 rx-s pic 99v99.
01 qt pic 99.
01 rt pic 99.
01 qx pic 99.
01 rx pic 99.
01 tr1 pic 9.
01 tr2 pic 9.
01 ktctr pic 99.
01 rtctr pic 99.
01 name-var.
05 name-x pic x(12).
01 inst-reply pic x(3).
88 yes-reply value "yes".
01 indicate-y pic 9.
88 trap-vec value 1.
01 indicate-x pic 9.
88 bye-bye value 1.
01 indicate-z pic 9.
88 just-starting value 0.
01 quadrant.
05 filler pic x(9) value "Quadrant ".
05 q1 pic 9.
05 filler pic x value ",".
05 q2 pic 9.
05 filler pic x(15) value
" STAR DATE: ".
05 s-date pic 9(4).
01 ds-date pic 9(4).
01 ds-table.
05 ds-min pic 99.
05 ds-sec pic 99.
01 klingons pic 99.
01 romulons pic 99.
01 lst-reply pic x(3).
88 yes-lst values "yes" "y".
01 rev-str pic 9(6).
01 seed-x pic v9(6).
01 seed-ast pic 9(6)v9(6).
01 ws-time.
05 ws-hour pic 99.
05 ws-min pic 99.
05 ws-sec pic 99.
05 ws-sixty pic 99.
01 time-rev.
05 ws-sixty pic 99.
05 ws-sec pic 99.
05 ws-min pic 99.
01 warp-speed.
05 warp-a pic 9.
05 warp-pt pic x.
05 warp-b pic 99.
01 course-x.
05 course-a pic 9.
05 course-pt pic x.
05 course-b pic 99.
01 vab5 pic 99.
01 vab6 pic 99.
01 vae1 pic z9.
01 k-or pic 99.
01 qs-1 pic 9.
01 qs-2 pic 9.
01 srctr pic s999.
01 skctr pic s999.
01 mod-ctr pic 99.
01 md-row.
05 md-sub pic x occurs 28 times.
01 dm-var4 pic 9(4).
01 ct-k pic 99.
01 ct-r pic 99.
01 dist-x pic 99.
01 dist-r pic 99.
01 dist-b pic 99.
01 tal4 pic 9.
01 kh-tl pic 9(5).
01 str-a pic 99.
01 str-r pic 99.
01 str-x pic 99.
01 cx pic 999.
01 dx pic 999.
01 cx-1 pic 9.
01 dx-1 pic 9.
01 e1 pic 99.
01 e2 pic 99.
01 r1 pic 99.
01 r2 pic 99.
01 k1 pic 99.
01 k2 pic 99.
01 b1 pic 99.
01 b2 pic 99.
01 star-ctr pic 999.
01 rep-ctr pic 99.
01 fuel-co pic zzz99.
01 shield-co pic zz99.
01 sbl pic 9.
01 qt1 pic 9.
01 qt2 pic 9.
01 qt3 pic 9.
01 qt4 pic 9.
01 r9 pic 9.
01 q9 pic 9.
01 w pic 999.
01 z pic 999.
01 skill-lev pic 9.
01 dist-k-str.
05 dkc pic 99 occurs 45 times.
01 dist-r-str.
05 drc pic 99 occurs 60 times.
procedure division.
0000-control section.
0000-program-control.
perform 0100-housekeeping thru 0100-exit.
perform 1000-mainline thru 1000-exit.
perform 9000-end-of-job thru 9000-exit.
stop run.
*>***********************************************
*> 0100-housekeeping initializes variables, and *
*> asks the user for a name and skill level. *
*> It then determines the quantity of bases, *
*> klingons, and romulons in the galaxy. *
*> Instructions are a user option. *
*>***********************************************
0100-housekeeping-section section.
0100-housekeeping.
move 0 to shield-cnt.
move 0 to damage-cnt.
move 40000 to fuel-count.
move 0 to indicate-z.
move 0 to genrte-result.
move spaces to md-row.
move seed-table to generate-table.
move 0 to indicate-x.
move 0 to indicate-y.
move 0 to attack-flag.
move 0 to too-late-flag.
display " ".
display " *STAR TREK* ".
display " ".
display "Congratulations - you have just been appointed ".
display "Captain of the U.S.S. Enterprise. ".
display " ".
display "Please enter your name, Captain ".
accept name-x.
display "And your skill level (1-4)? ".
accept skill-lev.
if skill-lev not numeric or skill-lev < 1 or skill-lev > 4
display "INVALID SKILL LEVEL "
display "Enter your skill level (1-4) "
accept skill-lev
if skill-lev not numeric or skill-lev < 1 or skill-lev > 4
move 1 to skill-lev
display "Your skill level must be 1 ".
move 0 to vab5.
move 0 to vab6.
inspect name-x tallying vab6 for all "a".
inspect name-x tallying vab6 for all "e".
add 1 to vab6.
inspect name-x tallying vab5 for all " ".
compute vab6 rounded = (vab5 / 1.75) + (vab6 / skill-lev).
compute k-or rounded = (skill-lev * 4) + vab6 + 5.
compute vab1 = 9 - skill-lev.
compute vab2 rounded = (skill-lev / 3) * k-or.
move k-or to klingons.
move vab1 to vae1.
accept ws-time from time.
move ws-min of ws-time to ds-min.
move ws-sec of ws-time to ds-sec.
move ds-table to s-date.
add 16 to ds-min.
if ds-min > 59
move 1 to time-flag
else
move 0 to time-flag.
move ds-table to ds-date.
display " ".
display " *MESSAGE FROM STAR FLEET COMMAND* ".
display " ".
display "Attention - Captain " name-x.
display "Your mission is to destroy the ".
display k-or " Klingon ships that have invaded ".
display "the galaxy to attack Star Fleet HQ ".
display "on star date " ds-date " - giving you 16 star dates.".
perform 1200-initialize-galaxy thru 1200-exit.
display " ".
display "Do you require instructions? ".
accept inst-reply.
if yes-reply
perform 0500-prt-inst thru 0500-exit
perform 0550-add-inst thru 0550-exit.
0100-exit. exit.
0500-prt-inst.
display " ".
display "You may use the following commands: ".
display " nav (to navigate) ".
display " pha (to fire phasers) ".
display " tor (to fire torpedo) ".
display " def (to raise or lower shields) ".
display " doc (to dock at a star base) ".
display " com (to request info from the library computer) ".
display " ".
display "COURSE PLOT: ".
display " ".
display " 1 ".
display " 8 2 ".
display "7 -x- 3 ".
display " 6 4 ".
display " 5 ".
display " ".
0500-exit. exit.
0550-add-inst.
display "There are " vae1 " star bases located somewhere in the galaxy, ".
display "which is made up of 81 quadrants, 1,1 thru 9,9. ".
display "You may dock at a star base to refuel and effect repairs ".
display "when there is a base in your quadrant. You are authorized ".
display "to destroy Romulon vessels if they interfere with your mission. ".
display " ".
display "Hit RETURN ".
accept return-x.
0550-exit. exit.
1000-mainline.
perform 4000-display-g thru 4000-exit.
move 1 to indicate-z.
perform 2000-process thru 2000-exit
until klingons < 1 or bye-bye.
perform 8500-finish-game thru 8500-exit.
1000-exit. exit.
1100-chk-galaxy.
add 1 to var1.
if var1 = 7
inspect master-tbl replacing all " K" by "K "
perform 1120-reset thru 1120-exit
else
if var1 = 12
inspect master-tbl replacing all "R " by " R"
perform 1120-reset thru 1120-exit
else
if var1 = 15
inspect master-tbl replacing all "K " by " K"
perform 1120-reset thru 1120-exit
else
if var1 > 20
inspect master-tbl replacing all " R" by "R "
perform 1120-reset thru 1120-exit
move 1 to var1.
1100-exit. exit.
1120-reset.
perform 5900-trans thru 5900-exit.
move 0 to klgns.
move 0 to romulons.
move 0 to base-cnt.
inspect mini-table tallying klgns for all "K".
inspect mini-table tallying romulons for all "R".
inspect mini-table tallying base-cnt for all "B".
1120-exit. exit.
1145-ck-flag.
if time-flag-set and ds-min < 40
add 60 to ds-min.
1145-exit. exit.
1150-ck-time.
if klingons > 0
accept ws-time from time
move ws-min of ws-time to ds-min
perform 1145-ck-flag thru 1145-exit
move ws-sec of ws-time to ds-sec
move ds-table to s-date
else
go to 1150-exit.
compute t-store = ds-date - s-date.
if t-store < 90 and not klingons-attacking
move 14 to max-no
compute w = ((hq2 - 1) * 14)
compute z = ((hq1 - 1) * 14)
inspect master-tbl replacing all "K" by " "
move 0 to rx
perform 1170-move-on-hq thru 1170-exit
varying kctr from 1 by 1 until kctr > klingons
move 1 to attack-flag
perform 5900-trans thru 5900-exit
if (q1 not = hq1 or q2 not = hq2)
display "WARNING - STAR DATE: " s-date
display "Science Officer Spock advises"
display "you navigate to quadrant " hq1 "," hq2
display "to defend Star Fleet Headquarters".
if not too-late
move ds-date to ws-date.
if s-date > ws-date and q1 = hq1 and q2 = hq2 and not too-late
move 1 to too-late-flag
add 230 to ws-date
else
if s-date > ws-date
move 1 to indicate-x
perform 8200-ck-done thru 8200-exit.
1150-exit. exit.
1160-dbl-k.
perform 1225-dbl-roll thru 1225-exit.
add 1 to rx.
compute a = w + a.
compute b = z + b.
1160-exit. exit.
1170-move-on-hq.
move 0 to a.
perform 1160-dbl-k thru 1160-exit
until macol (a , b) = " " and a > 0.
move "K" to macol (a , b).
1170-exit. exit.
*>*********************************************
*> 1200-initialize-galaxy moves stars, kling- *
*> ons, romulons, bases, and finally, the en- *
*> terprise to master-tbl in random position, *
*> and in the quantities determined in 0100- *
*> housekeeping. *
*>*********************************************
1200-initialize-galaxy.
move spaces to master-tbl.
accept ws-time from time.
move corresponding ws-time to time-rev.
move time-rev to rev-str.
compute seed-x = (rev-str / 1000000).
move 126 to max-no.
perform 1230-move-stars thru 1230-exit
varying star-ctr from 1 by 1 until star-ctr > 275.
perform 1240-move-romulons thru 1240-exit
varying star-ctr from 1 by 1 until star-ctr > vab2.
perform 1250-move-klingons thru 1250-exit
varying star-ctr from 1 by 1 until star-ctr > k-or.
perform 1260-move-base thru 1260-exit
varying star-ctr from 1 by 1 until star-ctr > vab1.
perform 1270-move-e thru 1270-exit.
perform 1280-move-hq thru 1280-exit.
1200-exit. exit.
1220-roll.
compute seed-ast = (262147.0 * seed-x).
move seed-ast to seed-x.
compute roll-x = (seed-x * max-no) + 1.
1220-exit. exit.
1225-dbl-roll.
perform 1220-roll thru 1220-exit.
move roll-x to a.
perform 1220-roll thru 1220-exit.
move roll-x to b.
1225-exit. exit.
1230-move-stars.
perform 1225-dbl-roll thru 1225-exit.
move "*" to macol (a , b).
1230-exit. exit.
1240-move-romulons.
perform 1225-dbl-roll thru 1225-exit.
move "R" to macol (a , b).
1240-exit. exit.
1250-move-klingons.
perform 1225-dbl-roll thru 1225-exit
until macol (a , b) = " ".
move "K" to macol (a , b).
1250-exit. exit.
1260-move-base.
perform 1225-dbl-roll thru 1225-exit
until macol (a , b) = " ".
move "B" to macol (a , b).
1260-exit. exit.
1270-move-e.
perform 1225-dbl-roll thru 1225-exit
until macol (a , b) = " ".
move a to mrctr.
move b to mkctr.
move "E" to macol (mrctr , mkctr).
1270-exit. exit.
1280-move-hq.
perform 1225-dbl-roll thru 1225-exit
until macol (a , b) = " ".
move "H" to macol (a , b).
compute hq1 = (b - 1) / 14 + 1.
compute hq2 = (a - 1) / 14 + 1.
1280-exit. exit.
1700-ck-var-warp.
inspect course-b replacing all " " by zeros.
inspect warp-a replacing all " " by zeros.
inspect warp-b replacing all " " by zeros.
if course-b not numeric
move zero to course-b.
if warp-a not numeric
move zero to warp-a.
if warp-b not numeric
move zero to warp-b.
1700-exit. exit.
*>*******************************************
*> 2000-process is an iterative loop that *
*> requests and executes a command until *
*> all klingons are destroyed, or the en- *
*> terprise is no longer able to continue. *
*>*******************************************
2000-process.
perform 8400-generate thru 8400-exit.
if no-way or klgns > 1
add 4 to nx.
display com-req.
accept commands-x.
if navigate or nav-c
if entry1 not numeric or entry1 < 1 or entry1 > 8 or entry2 not numeric
display "What course (1 - 8.99)? "
accept course-x
display "What warp factor (0 - 9.99)? "
accept warp-speed
perform 1700-ck-var-warp thru 1700-exit
perform 7100-nav thru 7100-exit
perform 4000-display-g thru 4000-exit
else
move entry1 to course-a
move entry2 to warp-a
move 0 to course-b
move 0 to warp-b
perform 7100-nav thru 7100-exit
perform 4000-display-g thru 4000-exit
else
if phasers or pha-c
perform 7200-pha thru 7200-exit
else
if torpedo or tor-c
perform 7300-tor thru 7300-exit
else
if shields or def-c
perform 7500-def thru 7500-exit
else
if dock or doc-c
perform 7600-doc thru 7600-exit
else
if lib-com or com-c
perform 3000-com-fun thru 3000-exit
else
display "INVALID COMMAND - Do you want a list of commands? "
accept lst-reply
if yes-lst
perform 0500-prt-inst thru 0500-exit.
perform 1150-ck-time thru 1150-exit.
perform 1100-chk-galaxy thru 1100-exit.
2000-exit. exit.
*>**************************************
*> 3000-com-fun simulates the opera- *
*> tion of an on-board library compu- *
*> ter, and responds to numeric com- *
*> mands , range 1 - 6. *
*>**************************************
3000-com-fun.
display " ".
if entry1 not numeric or entry1 < 1 or entry1 > 6
display "*COMPUTER ACTIVE AND AWAITING COMMAND* "
accept comp-com
else
move entry1 to comp-com.
if comp-com not numeric or comp-com < 1 or comp-com > 6
display "INVALID COMPUTER COMMAND "
display "Do you want a list of computer commands? "
accept lst-reply
if yes-lst
display "Functions available from the library computer: "
display " 1 To request ship status "
display " 2 To request short range scan of quadrant "
display " 3 To request long range scan "
display " 4 To request tally of Klingons "
display " 5 To request intelligence report "
display " 6 To terminate program execution "
display " "
display "*COMPUTER ACTIVE AND AWAITING COMMAND* "
accept comp-com
else
display "COMPUTER COMMAND?"
accept comp-com.
go to
3010-com
3020-com
3030-com
3040-com
3050-com
3060-com
depending on comp-com.
display " INVALID COMPUTER COMMAND ".
go to 3000-exit.
3010-com.
perform 7400-sta thru 7400-exit.
go to 3000-exit.
3020-com.
perform 4000-display-g thru 4000-exit.
go to 3000-exit.
3030-com.
perform 7700-lrs thru 7700-exit.
go to 3000-exit.
3040-com.
compute bye-k = k-or - klingons.
display " ".
display bye-k " Klingons destroyed, " klingons " remain ".
display "ATTACK DATE: " ds-date.
display "STAR DATE: " s-date.
display " ".
perform 8100-dmg-com thru 8100-exit.
go to 3000-exit.
3050-com.
perform 7800-int thru 7800-exit.
go to 3000-exit.
3060-com.
display "Do you want to rethink that decision? "
accept lst-reply
if yes-lst
go to 3000-exit.
move 1 to indicate-x.
display " ".
display "*ENTERPRISE STRANDED - CAPTAIN BOOKED* ".
display " ".
perform 8200-ck-done thru 8200-exit.
go to 3000-exit.
3000-exit. exit.
*>******************************************
*> 4000-display-g determines what quadrant *
*> the enterprise is in, and displays the *
*> quadrant, notifying user of presence of *
*> klingons in quadrant. *
*>******************************************
4000-display-g.
move 0 to klgns.
move 0 to romulons.
move 0 to base-cnt.
move q1 to qs-1.
move q2 to qs-2.
compute q1 = (mkctr - 1) / 14 + 1.
compute q2 = (mrctr - 1) / 14 + 1.
if q1 not = qs-1 or q2 not = qs-2
move 0 to kh-tl.
compute x = (q1 - 1) * 14.
compute y = (q2 - 1) * 14.
perform 5900-trans thru 5900-exit.
inspect mini-table tallying klgns for all "K".
inspect mini-table tallying romulons for all "R".
inspect mini-table tallying base-cnt for all "B".
display " ".
if just-starting
display "You begin in quadrant " q1 "," q2 " with 40,000 "
display "units of fuel and 5 photon torpedoes. "
display " "
display "Good luck, Captain " name-x
display " "
if klgns > 0
display con-red
else
display con-green
else
if klgns > 0
display con-red
compute var2 = klgns * fuel-count / (shield-cnt + 27)
perform 4200-test-var thru 4200-exit
compute var3 = .75 * var2
add var2 to damage-cnt
subtract var3 from shield-cnt
display "*ENTERPRISE ENCOUNTERING KLINGON FIRE* "
perform 4500-disp-hit thru 4500-exit
else
display con-green.
display quadrant.
perform 6500-display-mt thru 6500-exit
varying rcntr from 1 by 1 until rcntr > 14.
display " ".
perform 8300-ck-fuel-damage thru 8300-exit.
perform 8200-ck-done thru 8200-exit.
4000-exit. exit.
4200-test-var.
if var2 < 1776 and klgns > 0
add 223 to var2
compute var2 = (klgns * var2 / 3.5) + (var2 * damage-cnt / 760) + (nx * 17).
4200-exit. exit.
4500-disp-hit.
move var2 to var5.
display var5 " unit hit on Enterprise ".
4500-exit. exit.
4700-disp-hit.
move var4 to var5.
display var5 " unit hit on Klingon ".
4700-exit. exit.
5400-trans-back.
perform 5500-transfer-back thru 5500-exit
varying kcntr from 1 by 1 until kcntr > 14
after rcntr from 1 by 1 until rcntr > 14.
5400-exit. exit.
5500-transfer-back.
compute a = y + rcntr.
compute b = x + kcntr.
move mcol (rcntr , kcntr) to macol (a , b).
5500-exit. exit.
5900-trans.
perform 6000-transfer thru 6000-exit
varying kcntr from 1 by 1 until kcntr > 14
after rcntr from 1 by 1 until rcntr > 14.
5900-exit. exit.
6000-transfer.
compute a = y + rcntr.
compute b = x + kcntr.
move macol (a , b) to mcol (rcntr , kcntr).
6000-exit. exit.
6500-display-mt.
display "= = = = = = = = = = = = = = = =".
perform 6600-mini-dis thru 6600-exit
varying rcntr from 1 by 1 until rcntr > 14.
display "= = = = = = = = = = = = = = = =".
6500-exit. exit.
6600-mini-dis.
perform 6700-mini-mod thru 6700-exit
varying kcntr from 1 by 1 until kcntr > 14.
display "=" md-row " =".
6600-exit. exit.
6700-mini-mod.
compute mod-ctr = 2 * kcntr.
move mcol (rcntr , kcntr) to md-sub (mod-ctr).
6700-exit. exit.
7000-nav-ck.
if srctr < 1 or srctr > 126 or skctr < 1 or skctr > 126
display "Warp drive shut down - "
display "UNAUTHORIZED ATTEMPT TO LEAVE GALAXY "
perform 8100-dmg-com thru 8100-exit
go to 2000-exit
else
move " " to macol (mrctr , mkctr)
move srctr to mrctr.
move skctr to mkctr.
if macol (mrctr , mkctr) = "K" or macol (mrctr , mkctr) = "R" or macol (mrctr , mkctr) = "B"
perform 8000-bomb thru 8000-exit
else
move "E" to macol (mrctr , mkctr).
7000-exit. exit.
*>*******************************************
*> 7100-nav thru 7800-int execute various *
*> commands from the user, and present the *
*> results and consequences of each command *
*> *
*> Called from 2000-process or 3000-com-fun *
*>*******************************************
7100-nav.
perform 8340-ck-fl thru 8340-exit.
compute fuel-count = fuel-count - (200 * warp-a).
if warp-a > 0
move warp-a to rx-s
else
compute rx-s rounded = warp-b / 100.
move mrctr to srctr.
move mkctr to skctr.
compute warp1 rounded = (warp-a * 5) + (warp-b * .05).
compute warp2 rounded = (warp-a * 8) + (warp-b * .08).
compute warp3 rounded = (course-b * .05) * rx-s.
compute warp4 rounded = (course-b * .03) * rx-s.
go to
7110-nav
7120-nav
7130-nav
7140-nav
7150-nav
7160-nav
7170-nav
7180-nav
depending on course-a.
display "INVALID COURSE".
go to 7100-exit.
7110-nav.
compute srctr = srctr - warp2 + warp4.
compute skctr = skctr + warp3.
perform 7000-nav-ck thru 7000-exit.
go to 7100-exit.
7120-nav.
compute srctr = srctr - warp1 + warp3.
compute skctr = skctr + warp1 + warp4.
perform 7000-nav-ck thru 7000-exit.
go to 7100-exit.
7130-nav.
compute srctr = srctr + warp3.
compute skctr = skctr + warp2 - warp4.
perform 7000-nav-ck thru 7000-exit.
go to 7100-exit.
7140-nav.
compute srctr = srctr + warp1 + warp4.
compute skctr = skctr + warp1 - warp3.
perform 7000-nav-ck thru 7000-exit.
go to 7100-exit.
7150-nav.
compute srctr = srctr + warp2 - warp4.
compute skctr = skctr - warp3.
perform 7000-nav-ck thru 7000-exit.
go to 7100-exit.
7160-nav.
compute srctr = srctr + warp1 - warp3.
compute skctr = skctr - warp1 - warp4.
perform 7000-nav-ck thru 7000-exit.
go to 7100-exit.
7170-nav.
compute srctr = srctr - warp3.
compute skctr = skctr - warp2 + warp4.
perform 7000-nav-ck thru 7000-exit.
go to 7100-exit.
7180-nav.
compute srctr = srctr - warp1 - warp4.
compute skctr = skctr - warp1 + warp3.
perform 7000-nav-ck thru 7000-exit.
go to 7100-exit.
7100-exit. exit.
7200-pha.
if klgns < 1 and romulons < 1
display "Science Officer Spock reports no enemy "
display "vessels in this quadrant, " name-x
go to 7200-exit.
perform 8340-ck-fl thru 8340-exit.
if fuel-count < 9999
move fuel-count to fuel-co
display "Maximum of " fuel-co " units available to phasers ".
display "How many units to phaser banks? ".
accept var4-an.
perform 7210-rep-bl thru 7210-exit.
perform 7220-compute-dist thru 7220-exit.
compute var2 = 450000 / (shield-cnt + 100).
perform 8150-test-agn thru 8150-exit.
if klgns > 1 and trap-vec
display "*ENTERPRISE DESTROYED* "
display "Direct hits from " klgns " klingons "
move 1 to indicate-x.
perform 8200-ck-done thru 8200-exit.
compute dm-var4 = var4 - (damage-cnt / 15).
compute var3 = var2 / 2.
if romulons > 0
display "*ROMULON VESSELS PRESENT IN QUADRANT* "
display "Do you want to fire on Romulons? "
accept lst-reply
if yes-lst
perform 7250-romulon-ck thru 7250-exit
go to 7200-exit.
if klgns > 0
compute var2 = var2 / (dist-x / 10)
subtract var4 from fuel-count
move dm-var4 to var4
add kh-tl to var4
if var4 < 400
perform 4700-disp-hit thru 4700-exit
display "*KLINGON DISABLED* "
perform 4500-disp-hit thru 4500-exit
compute var4 = .75 * var4
add var4 to kh-tl
add var2 to damage-cnt
subtract var3 from shield-cnt
else
perform 7201-replace thru 7201-exit
varying rep-ctr from 1 by 1 until rep-ctr > rx
inspect mini-table replacing first "K" by " "
inspect mini-table replacing all "x" by "K"
compute var4 = var4 / (dist-x ** .224)
perform 4700-disp-hit thru 4700-exit
display "*KLINGON DESTROYED* "
move 0 to kh-tl
subtract 1 from klgns
subtract 1 from klingons
perform 5400-trans-back thru 5400-exit
if klgns > 0
perform 4500-disp-hit thru 4500-exit
add var2 to damage-cnt
compute var2 = .75 * var2
subtract var2 from shield-cnt
else
move var3 to var2
perform 4500-disp-hit thru 4500-exit
add var3 to damage-cnt
subtract var3 from shield-cnt
else
display "There are 0 Klingons in this quadrant, " name-x.
perform 8120-dam-com thru 8120-exit.
perform 8300-ck-fuel-damage thru 8300-exit.
perform 8200-ck-done thru 8200-exit.
7200-exit. exit.
7201-replace.
inspect mini-table replacing first "K" by "x".
7201-exit. exit.
7202-replace.
inspect mini-table replacing first "R" by "x".
7202-exit. exit.
7210-rep-bl.
move 0 to tal4.
inspect var4-an tallying tal4 for all " ".
if tal4 > 0
inspect var4-an replacing all " " by zeros
if var4-an numeric
move var4-an to var4
compute var4 = var4 / (10 ** tal4)
else
move 300 to var4
else
if var4-an numeric
move var4-an to var4
else
move 300 to var4.
if var4 < 300
move 300 to var4.
7210-exit. exit.
7220-compute-dist.
move 30 to dist-b.
move 30 to dist-x.
move 30 to dist-r.
move 0 to ct-k.
move 0 to ct-r.
perform 7225-find-e thru 7225-exit
varying rcntr from 1 by 1 until rcntr > 14
after kcntr from 1 by 1 until kcntr > 14.
perform 7230-compute thru 7230-exit
varying rcntr from 1 by 1 until rcntr > 14
after kcntr from 1 by 1 until kcntr > 14.
perform 7247-est-nbr thru 7247-exit.
7220-exit. exit.
7225-find-e.
if mcol (rcntr , kcntr) = "E"