billr@saab.CNA.TEK.COM (Bill Randle) (05/04/90)
Submitted-by: Chris Rende <rphroy!trux!car@uunet.uu.net>
Posting-number: Volume 9, Issue 46
Archive-name: ctrek/Part01
[Now here's a strange one - StarTrek in COBOL. Now I know
none of you program in Cobol :-), but you may have friends
that do. It is one large source file split into two sections
for posting. The single file will automatically be built
when both parts are unshar'd. -br]
[From the submitter...]
[[I've been collecting various versions of Star Trek games for years.
Here's one that I came accross that is written in COBOL.
No copyright notice so it should be OK to share it.]]
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 1 (of 2)."
# Contents: README MANIFEST ctrek.p1
# Wrapped by billr@saab on Thu May 3 15:21:22 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'README' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(478 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
XI've been collecting various versions of Star Trek games for years.
X
XHere's one that I came accross that is written in COBOL.
XNo copyright notice so it should be OK to share it.
X
XChristopher A. Rende Central Cartage (Nixdorf/Pyramid/SysVR2/BSD4.3)
Xuunet!edsews!rphroy!trux!car Multics,DTSS,Unix,Shortwave,Scanners,StarTrek
X trux!car@uunet.uu.net Minix 1.2,PC/XT,Mac+,TRS-80 Model I,1802 ELF
X "I don't ever remember forgetting anything." - Chris Rende
END_OF_FILE
if test 478 -ne `wc -c <'README'`; then
echo shar: \"'README'\" unpacked with wrong size!
fi
# end of 'README'
fi
if test -f 'MANIFEST' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'MANIFEST'\"
else
echo shar: Extracting \"'MANIFEST'\" \(238 characters\)
sed "s/^X//" >'MANIFEST' <<'END_OF_FILE'
X File Name Archive # Description
X-----------------------------------------------------------
X MANIFEST 1 This shipping list
X README 1
X ctrek.p1 1
X ctrek.p2 2
END_OF_FILE
if test 238 -ne `wc -c <'MANIFEST'`; then
echo shar: \"'MANIFEST'\" unpacked with wrong size!
fi
# end of 'MANIFEST'
fi
if test -f 'ctrek.p1' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'ctrek.p1'\"
else
echo shar: Extracting \"'ctrek.p1'\" \(31341 characters\)
sed "s/^X//" >'ctrek.p1' <<'END_OF_FILE'
X identification division.
X program-id. star_trek.
X author. Kurt Wilhelm.
X installation. Oakland University.
X date-written. Completed September 1, 1979.
X *
X *******************************************************
X * star_trek simulates an outer space adventure game *
X * on a remote terminal. The user commands the U.S.S. *
X * Enterprise, and thru various offensive and defen- *
X * sive commands, travels throughout the galaxy on a *
X * mission to destroy all Klingons, which also maneu- *
X * ver and fire on the Enterprise. *
X *******************************************************
X *
X
X environment division.
X configuration section.
X source-computer. multics.
X object-computer. multics.
X
X data division.
X working-storage section.
X 01 eof-flag pic x value "n".
X 01 star-table.
X 05 row occurs 42 times.
X 10 kolumn pic x occurs 42 times.
X 01 rctr pic 99.
X 01 kctr pic 99.
X 01 commands-x.
X 05 command pic x(3).
X 88 navigate value "nav".
X 88 phasers value "pha".
X 88 torpedo value "tor".
X 88 shields value "def".
X 88 dock value "doc".
X 88 lib-com value "com".
X 88 nav-c value "NAV".
X 88 pha-c value "PHA".
X 88 tor-c value "TOR".
X 88 def-c value "DEF".
X 88 doc-c value "DOC".
X 88 com-c value "COM".
X 05 entry1 pic 9.
X 05 entry2 pic 9.
X 01 mini-table.
X 05 mrow occurs 14 times.
X 10 mcol pic x occurs 14 times.
X 01 rcntr pic 99.
X 01 kcntr pic 99.
X 01 x pic 999.
X 01 y pic 999.
X 01 ws-date pic 9(4) comp-5.
X 01 time-flag pic 9.
X 88 time-flag-set value 1.
X 01 max-no pic 999.
X 01 hq1 pic 9.
X 01 hq2 pic 9.
X 01 t-store pic 9(4) comp-5.
X 01 attack-flag pic 9.
X 88 klingons-attacking value 1.
X 01 too-late-flag pic 9.
X 88 too-late value 1.
X 01 bye-k pic 99.
X 01 var1 pic 99 value 1.
X 01 var2 pic 9(6) comp-5.
X 01 var3 pic 9(6) comp-5.
X 01 var4 pic 9(4) comp-5.
X 01 var4-an pic x(4).
X 01 var5 pic zzz999.
X 01 var6 pic zzzz99.
X 01 return-x pic x.
X 01 comp-com pic 9.
X 01 base-cnt pic 9 value 0.
X 01 nx pic 99 value 0.
X 01 a pic 999.
X 01 b pic 999.
X 01 warp1 pic 99.
X 01 warp2 pic 99.
X 01 warp3 pic 99.
X 01 warp4 pic 99.
X 01 generate-table.
X 05 char pic x occurs 25 times.
X 01 seed-table pic x(25) value
X "a4hfxnc89kd3jxf5dks3hb3m1".
X 01 genrte-result pic 9.
X 88 no-way value 1.
X 01 fuel-count pic s9(5) comp-5.
X 01 torps pic 9 value 5.
X 01 prt-lines.
X 05 con-red.
X 10 filler pic x(16) value
X "*Condition RED* ".
X 10 klgns pic 99.
X 10 filler pic x(21) value
X " Klingons in quadrant".
X 05 con-green.
X 10 filler pic x(17) value
X "*Condition GREEN*".
X 05 com-req.
X 10 filler pic x(22) value
X "What is your command? ".
X 01 master-tbl.
X 05 marow occurs 126 times.
X 10 macol pic x occurs 126 times.
X 01 mrctr pic 999.
X 01 mkctr pic 999.
X 01 vab1 pic 9.
X 01 vab2 pic 99.
X 01 roll-x pic 999v.
X 01 shield-cnt pic s9(4) comp-5.
X 01 shield-cnt-an pic x(4).
X 01 damage-cnt pic 9(6) comp-5.
X 01 scan-keep.
X 05 cv pic 99 occurs 18 times.
X 01 scan-ctr pic 99.
X 01 scan-table.
X 05 scan-row occurs 14 times.
X 10 scan-col pic x occurs 14 times.
X 01 rx-s pic 99v99.
X 01 qt pic 99.
X 01 rt pic 99.
X 01 qx pic 99.
X 01 rx pic 99.
X 01 tr1 pic 9.
X 01 tr2 pic 9.
X 01 ktctr pic 99.
X 01 rtctr pic 99.
X 01 name-var.
X 05 name-x pic x(12).
X 01 inst-reply pic x(3).
X 88 yes-reply value "yes".
X 01 indicate-y pic 9.
X 88 trap-vec value 1.
X 01 indicate-x pic 9.
X 88 bye-bye value 1.
X 01 indicate-z pic 9.
X 88 just-starting value 0.
X 01 quadrant.
X 05 filler pic x(9) value "Quadrant ".
X 05 q1 pic 9.
X 05 filler pic x value ",".
X 05 q2 pic 9.
X 05 filler pic x(15) value
X " STAR DATE: ".
X 05 s-date pic 9(4).
X 01 ds-date pic 9(4).
X 01 ds-table.
X 05 ds-min pic 99.
X 05 ds-sec pic 99.
X 01 klingons pic 99.
X 01 romulons pic 99.
X 01 lst-reply pic x(3).
X 88 yes-lst value "yes".
X 01 rev-str pic 9(6) comp-5.
X 01 seed-x pic v9(6) comp-5.
X 01 seed-ast pic 9(6)v9(6) comp-5.
X 01 ws-time.
X 05 ws-hour pic 99.
X 05 ws-min pic 99.
X 05 ws-sec pic 99.
X 05 ws-sixty pic 99.
X 01 time-rev.
X 05 ws-sixty pic 99.
X 05 ws-sec pic 99.
X 05 ws-min pic 99.
X 01 warp-speed.
X 05 warp-a pic 9.
X 05 warp-pt pic x.
X 05 warp-b pic 99.
X 01 course-x.
X 05 course-a pic 9.
X 05 course-pt pic x.
X 05 course-b pic 99.
X 01 vab5 pic 99.
X 01 vab6 pic 99.
X 01 vae1 pic z9.
X 01 k-or pic 99.
X 01 qs-1 pic 9.
X 01 qs-2 pic 9.
X 01 srctr pic s999.
X 01 skctr pic s999.
X 01 mod-ctr pic 99.
X 01 md-row.
X 05 md-sub pic x occurs 28 times.
X 01 dm-var4 pic 9(4) comp-5.
X
X 01 ct-k pic 99.
X 01 ct-r pic 99.
X 01 dist-x pic 99.
X 01 dist-r pic 99.
X 01 dist-b pic 99.
X 01 tal4 pic 9.
X 01 kh-tl pic 9(5) comp-5.
X 01 str-a pic 99.
X 01 str-r pic 99.
X 01 str-x pic 99.
X 01 cx pic 999 comp-5.
X 01 dx pic 999 comp-5.
X 01 cx-1 pic 9.
X 01 dx-1 pic 9.
X 01 e1 pic 99.
X 01 e2 pic 99.
X 01 r1 pic 99.
X 01 r2 pic 99.
X 01 k1 pic 99.
X 01 k2 pic 99.
X 01 b1 pic 99.
X 01 b2 pic 99.
X 01 star-ctr pic 999.
X 01 rep-ctr pic 99.
X 01 fuel-co pic zzz99.
X 01 shield-co pic zz99.
X 01 sbl pic 9.
X 01 qt1 pic 9.
X 01 qt2 pic 9.
X 01 qt3 pic 9.
X 01 qt4 pic 9.
X 01 r9 pic 9.
X 01 q9 pic 9.
X 01 w pic 999.
X 01 z pic 999.
X 01 skill-lev pic 9.
X 01 dist-k-str.
X 05 dkc pic 99 occurs 45 times.
X 01 dist-r-str.
X 05 drc pic 99 occurs 60 times.
X
X procedure division.
X
X 0000-control section.
X 0000-program-control.
X perform 0100-housekeeping thru 0100-exit.
X perform 1000-mainline thru 1000-exit.
X perform 9000-end-of-job thru 9000-exit.
X stop run.
X
X ************************************************
X * 0100-housekeeping initializes variables, and *
X * asks the user for a name and skill level. *
X * It then determines the quantity of bases, *
X * klingons, and romulons in the galaxy. *
X * Instructions are a user option. *
X ************************************************
X
X 0100-housekeeping-section section.
X 0100-housekeeping.
X move 0 to shield-cnt.
X move 0 to damage-cnt.
X move 40000 to fuel-count.
X move 0 to indicate-z.
X move 0 to genrte-result.
X move spaces to md-row.
X move seed-table to generate-table.
X move 0 to indicate-x.
X move 0 to indicate-y.
X move 0 to attack-flag.
X move 0 to too-late-flag.
X display " ".
X display " *STAR TREK* ".
X display " ".
X display "Congratulations - you have just been appointed ".
X display "Captain of the U.S.S. Enterprise. ".
X display " ".
X display "Please enter your name, Captain ".
X accept name-x.
X display "And your skill level (1-4)? ".
X accept skill-lev.
X if skill-lev not numeric or skill-lev < 1 or skill-lev > 4
X display "INVALID SKILL LEVEL "
X display "Enter your skill level (1-4) "
X accept skill-lev
X if skill-lev not numeric or skill-lev < 1 or skill-lev > 4
X move 1 to skill-lev
X display "Your skill level must be 1 ".
X move 0 to vab5.
X move 0 to vab6.
X inspect name-x tallying vab6 for all "a".
X inspect name-x tallying vab6 for all "e".
X add 1 to vab6.
X inspect name-x tallying vab5 for all " ".
X compute vab6 rounded = (vab5 / 1.75) + (vab6 / skill-lev).
X compute k-or rounded = (skill-lev * 4) + vab6 + 5.
X compute vab1 = 9 - skill-lev.
X compute vab2 rounded = (skill-lev / 3) * k-or.
X move k-or to klingons.
X move vab1 to vae1.
X accept ws-time from time.
X move ws-min of ws-time to ds-min.
X move ws-sec of ws-time to ds-sec.
X move ds-table to s-date.
X add 16 to ds-min.
X if ds-min > 59
X move 1 to time-flag
X else
X move 0 to time-flag.
X move ds-table to ds-date.
X display " ".
X display " *MESSAGE FROM STAR FLEET COMMAND* ".
X display " ".
X display "Attention - Captain " name-x.
X display "Your mission is to destroy the ".
X display k-or " Klingon ships that have invaded ".
X display "the galaxy to attack Star Fleet HQ ".
X display "on star date " ds-date " - giving you 16 star dates.".
X perform 1200-initialize-galaxy thru 1200-exit.
X display " ".
X display "Do you require instructions? ".
X accept inst-reply.
X if yes-reply
X perform 0500-prt-inst thru 0500-exit
X perform 0550-add-inst thru 0550-exit.
X 0100-exit. exit.
X
X 0500-prt-inst.
X display " ".
X display "You may use the following commands: ".
X display " nav (to navigate) ".
X display " pha (to fire phasers) ".
X display " tor (to fire torpedo) ".
X display " def (to raise or lower shields) ".
X display " doc (to dock at a star base) ".
X display " com (to request info from the library computer) ".
X display " ".
X display "COURSE PLOT: ".
X display " ".
X display " 1 ".
X display " 8 2 ".
X display "7 -x- 3 ".
X display " 6 4 ".
X display " 5 ".
X display " ".
X 0500-exit. exit.
X
X 0550-add-inst.
X display "There are " vae1 " star bases located somewhere in the galaxy, ".
X display "which is made up of 81 quadrants, 1,1 thru 9,9. ".
X display "You may dock at a star base to refuel and effect repairs ".
X display "when there is a base in your quadrant. You are authorized ".
X display "to destroy Romulon vessels if they interfere with your mission. ".
X display " ".
X display "Hit RETURN ".
X accept return-x.
X 0550-exit. exit.
X
X 1000-mainline.
X perform 4000-display-g thru 4000-exit.
X move 1 to indicate-z.
X perform 2000-process thru 2000-exit
X until klingons < 1 or bye-bye.
X perform 8500-finish-game thru 8500-exit.
X 1000-exit. exit.
X
X 1100-chk-galaxy.
X add 1 to var1.
X if var1 = 7
X inspect master-tbl replacing all " K" by "K "
X perform 1120-reset thru 1120-exit
X else
X if var1 = 12
X inspect master-tbl replacing all "R " by " R"
X perform 1120-reset thru 1120-exit
X else
X if var1 = 15
X inspect master-tbl replacing all "K " by " K"
X perform 1120-reset thru 1120-exit
X else
X if var1 > 20
X inspect master-tbl replacing all " R" by "R "
X perform 1120-reset thru 1120-exit
X move 1 to var1.
X 1100-exit. exit.
X
X 1120-reset.
X perform 5900-trans thru 5900-exit.
X move 0 to klgns.
X move 0 to romulons.
X move 0 to base-cnt.
X inspect mini-table tallying klgns for all "K".
X inspect mini-table tallying romulons for all "R".
X inspect mini-table tallying base-cnt for all "B".
X 1120-exit. exit.
X
X 1145-ck-flag.
X if time-flag-set and ds-min < 40
X
X add 60 to ds-min.
X 1145-exit. exit.
X
X 1150-ck-time.
X if klingons > 0
X accept ws-time from time
X move ws-min of ws-time to ds-min
X perform 1145-ck-flag thru 1145-exit
X move ws-sec of ws-time to ds-sec
X move ds-table to s-date
X else
X go to 1150-exit.
X compute t-store = ds-date - s-date.
X if t-store < 90 and not klingons-attacking
X move 14 to max-no
X compute w = ((hq2 - 1) * 14)
X compute z = ((hq1 - 1) * 14)
X inspect master-tbl replacing all "K" by " "
X move 0 to rx
X perform 1170-move-on-hq thru 1170-exit
X varying kctr from 1 by 1 until kctr > klingons
X move 1 to attack-flag
X perform 5900-trans thru 5900-exit
X if (q1 not = hq1 or q2 not = hq2)
X display "WARNING - STAR DATE: " s-date
X display "Science Officer Spock advises"
X display "you navigate to quadrant " hq1 "," hq2
X display "to defend Star Fleet Headquarters".
X if not too-late
X move ds-date to ws-date.
X if s-date > ws-date and q1 = hq1 and q2 = hq2 and not too-late
X move 1 to too-late-flag
X add 230 to ws-date
X else
X if s-date > ws-date
X move 1 to indicate-x
X perform 8200-ck-done thru 8200-exit.
X 1150-exit. exit.
X
X 1160-dbl-k.
X perform 1225-dbl-roll thru 1225-exit.
X add 1 to rx.
X compute a = w + a.
X compute b = z + b.
X 1160-exit. exit.
X
X 1170-move-on-hq.
X move 0 to a.
X perform 1160-dbl-k thru 1160-exit
X until macol (a , b) = " " and a > 0.
X move "K" to macol (a , b).
X 1170-exit. exit.
X
X **********************************************
X * 1200-initialize-galaxy moves stars, kling- *
X * ons, romulons, bases, and finally, the en- *
X * terprise to master-tbl in random position, *
X * and in the quantities determined in 0100- *
X * housekeeping. *
X **********************************************
X
X 1200-initialize-galaxy.
X move spaces to master-tbl.
X accept ws-time from time.
X move corresponding ws-time to time-rev.
X move time-rev to rev-str.
X compute seed-x = (rev-str / 1000000).
X move 126 to max-no.
X perform 1230-move-stars thru 1230-exit
X varying star-ctr from 1 by 1 until star-ctr > 275.
X perform 1240-move-romulons thru 1240-exit
X varying star-ctr from 1 by 1 until star-ctr > vab2.
X perform 1250-move-klingons thru 1250-exit
X varying star-ctr from 1 by 1 until star-ctr > k-or.
X perform 1260-move-base thru 1260-exit
X varying star-ctr from 1 by 1 until star-ctr > vab1.
X perform 1270-move-e thru 1270-exit.
X perform 1280-move-hq thru 1280-exit.
X 1200-exit. exit.
X
X 1220-roll.
X compute seed-ast = (262147.0 * seed-x).
X move seed-ast to seed-x.
X compute roll-x = (seed-x * max-no) + 1.
X 1220-exit. exit.
X
X 1225-dbl-roll.
X perform 1220-roll thru 1220-exit.
X move roll-x to a.
X perform 1220-roll thru 1220-exit.
X move roll-x to b.
X 1225-exit. exit.
X
X 1230-move-stars.
X perform 1225-dbl-roll thru 1225-exit.
X move "*" to macol (a , b).
X 1230-exit. exit.
X
X 1240-move-romulons.
X perform 1225-dbl-roll thru 1225-exit.
X move "R" to macol (a , b).
X 1240-exit. exit.
X
X 1250-move-klingons.
X perform 1225-dbl-roll thru 1225-exit
X until macol (a , b) = " ".
X move "K" to macol (a , b).
X 1250-exit. exit.
X
X 1260-move-base.
X perform 1225-dbl-roll thru 1225-exit
X until macol (a , b) = " ".
X move "B" to macol (a , b).
X 1260-exit. exit.
X
X 1270-move-e.
X perform 1225-dbl-roll thru 1225-exit
X until macol (a , b) = " ".
X move a to mrctr.
X move b to mkctr.
X move "E" to macol (mrctr , mkctr).
X 1270-exit. exit.
X
X 1280-move-hq.
X perform 1225-dbl-roll thru 1225-exit
X until macol (a , b) = " ".
X move "H" to macol (a , b).
X compute hq1 = (b - 1) / 14 + 1.
X compute hq2 = (a - 1) / 14 + 1.
X 1280-exit. exit.
X
X 1700-ck-var-warp.
X inspect course-b replacing all " " by zeros.
X inspect warp-a replacing all " " by zeros.
X inspect warp-b replacing all " " by zeros.
X if course-b not numeric
X move zero to course-b.
X if warp-a not numeric
X move zero to warp-a.
X if warp-b not numeric
X move zero to warp-b.
X 1700-exit. exit.
X
X ********************************************
X * 2000-process is an iterative loop that *
X * requests and executes a command until *
X * all klingons are destroyed, or the en- *
X * terprise is no longer able to continue. *
X ********************************************
X
X 2000-process.
X perform 8400-generate thru 8400-exit.
X if no-way or klgns > 1
X add 4 to nx.
X display com-req.
X accept commands-x.
X if navigate or nav-c
X if entry1 not numeric or entry1 < 1 or entry1 > 8 or entry2 not numeric
X display "What course (1 - 8.99)? "
X accept course-x
X display "What warp factor (0 - 9.99)? "
X accept warp-speed
X perform 1700-ck-var-warp thru 1700-exit
X perform 7100-nav thru 7100-exit
X perform 4000-display-g thru 4000-exit
X else
X move entry1 to course-a
X move entry2 to warp-a
X move 0 to course-b
X move 0 to warp-b
X perform 7100-nav thru 7100-exit
X perform 4000-display-g thru 4000-exit
X else
X if phasers or pha-c
X perform 7200-pha thru 7200-exit
X else
X if torpedo or tor-c
X perform 7300-tor thru 7300-exit
X else
X if shields or def-c
X perform 7500-def thru 7500-exit
X else
X if dock or doc-c
X perform 7600-doc thru 7600-exit
X else
X if lib-com or com-c
X perform 3000-com-fun thru 3000-exit
X else
X display "INVALID COMMAND - Do you want a list of commands? "
X accept lst-reply
X if yes-lst
X perform 0500-prt-inst thru 0500-exit.
X perform 1150-ck-time thru 1150-exit.
X perform 1100-chk-galaxy thru 1100-exit.
X 2000-exit. exit.
X
X ***************************************
X * 3000-com-fun simulates the opera- *
X * tion of an on-board library compu- *
X * ter, and responds to numeric com- *
X * mands , range 1 - 6. *
X ***************************************
X
X 3000-com-fun.
X display " ".
X if entry1 not numeric or entry1 < 1 or entry1 > 6
X display "*COMPUTER ACTIVE AND AWAITING COMMAND* "
X accept comp-com
X else
X move entry1 to comp-com.
X if comp-com not numeric or comp-com < 1 or comp-com > 6
X display "INVALID COMPUTER COMMAND "
X display "Do you want a list of computer commands? "
X
X accept lst-reply
X if yes-lst
X display "Functions available from the library computer: "
X display " 1 To request ship status "
X display " 2 To request short range scan of quadrant "
X display " 3 To request long range scan "
X display " 4 To request tally of Klingons "
X display " 5 To request intelligence report "
X display " 6 To terminate program execution "
X display " "
X display "*COMPUTER ACTIVE AND AWAITING COMMAND* "
X accept comp-com
X else
X display "COMPUTER COMMAND?"
X accept comp-com.
X go to
X 3010-com
X 3020-com
X 3030-com
X 3040-com
X 3050-com
X 3060-com
X depending on comp-com.
X display " INVALID COMPUTER COMMAND ".
X go to 3000-exit.
X
X 3010-com.
X perform 7400-sta thru 7400-exit.
X go to 3000-exit.
X
X 3020-com.
X perform 4000-display-g thru 4000-exit.
X go to 3000-exit.
X
X 3030-com.
X perform 7700-lrs thru 7700-exit.
X go to 3000-exit.
X
X 3040-com.
X compute bye-k = k-or - klingons.
X display " ".
X display bye-k " Klingons destroyed, " klingons " remain ".
X display "ATTACK DATE: " ds-date.
X display "STAR DATE: " s-date.
X display " ".
X perform 8100-dmg-com thru 8100-exit.
X go to 3000-exit.
X
X 3050-com.
X perform 7800-int thru 7800-exit.
X go to 3000-exit.
X
X 3060-com.
X move 1 to indicate-x.
X display " ".
X display "*ENTERPRISE STRANDED - CAPTAIN BOOKED* ".
X display " ".
X perform 8200-ck-done thru 8200-exit.
X go to 3000-exit.
X
X 3000-exit. exit.
X
X *******************************************
X * 4000-display-g determines what quadrant *
X * the enterprise is in, and displays the *
X * quadrant, notifying user of presence of *
X * klingons in quadrant. *
X *******************************************
X
X 4000-display-g.
X move 0 to klgns.
X move 0 to romulons.
X move 0 to base-cnt.
X move q1 to qs-1.
X move q2 to qs-2.
X compute q1 = (mkctr - 1) / 14 + 1.
X compute q2 = (mrctr - 1) / 14 + 1.
X if q1 not = qs-1 or q2 not = qs-2
X move 0 to kh-tl.
X compute x = (q1 - 1) * 14.
X compute y = (q2 - 1) * 14.
X perform 5900-trans thru 5900-exit.
X inspect mini-table tallying klgns for all "K".
X inspect mini-table tallying romulons for all "R".
X inspect mini-table tallying base-cnt for all "B".
X display " ".
X if just-starting
X display "You begin in quadrant " q1 "," q2 " with 40,000 "
X display "units of fuel and 5 photon torpedoes. "
X display " "
X display "Good luck, Captain " name-x
X display " "
X if klgns > 0
X display con-red
X else
X display con-green
X else
X if klgns > 0
X display con-red
X compute var2 = klgns * fuel-count / (shield-cnt + 27)
X perform 4200-test-var thru 4200-exit
X compute var3 = .75 * var2
X add var2 to damage-cnt
X subtract var3 from shield-cnt
X display "*ENTERPRISE ENCOUNTERING KLINGON FIRE* "
X perform 4500-disp-hit thru 4500-exit
X else
X display con-green.
X display quadrant.
X perform 6500-display-mt thru 6500-exit
X varying rcntr from 1 by 1 until rcntr > 14.
X display " ".
X perform 8300-ck-fuel-damage thru 8300-exit.
X perform 8200-ck-done thru 8200-exit.
X 4000-exit. exit.
X
X 4200-test-var.
X if var2 < 1776 and klgns > 0
X add 223 to var2
X compute var2 = (klgns * var2 / 3.5) + (var2 * damage-cnt / 760) + (nx * 17).
X 4200-exit. exit.
X
X 4500-disp-hit.
X move var2 to var5.
X display var5 " unit hit on Enterprise ".
X 4500-exit. exit.
X
X 4700-disp-hit.
X move var4 to var5.
X display var5 " unit hit on Klingon ".
X 4700-exit. exit.
X
X 5400-trans-back.
X perform 5500-transfer-back thru 5500-exit
X varying kcntr from 1 by 1 until kcntr > 14
X after rcntr from 1 by 1 until rcntr > 14.
X 5400-exit. exit.
X
X 5500-transfer-back.
X compute a = y + rcntr.
X compute b = x + kcntr.
X move mcol (rcntr , kcntr) to macol (a , b).
X 5500-exit. exit.
X
X 5900-trans.
X perform 6000-transfer thru 6000-exit
X varying kcntr from 1 by 1 until kcntr > 14
X after rcntr from 1 by 1 until rcntr > 14.
X 5900-exit. exit.
X
X 6000-transfer.
X compute a = y + rcntr.
X compute b = x + kcntr.
X move macol (a , b) to mcol (rcntr , kcntr).
X 6000-exit. exit.
X
X 6500-display-mt.
X display "= = = = = = = = = = = = = = = =".
X perform 6600-mini-dis thru 6600-exit
X varying rcntr from 1 by 1 until rcntr > 14.
X display "= = = = = = = = = = = = = = = =".
X 6500-exit. exit.
X
X 6600-mini-dis.
X perform 6700-mini-mod thru 6700-exit
X varying kcntr from 1 by 1 until kcntr > 14.
X display "=" md-row " =".
X 6600-exit. exit.
X
X 6700-mini-mod.
X compute mod-ctr = 2 * kcntr.
X move mcol (rcntr , kcntr) to md-sub (mod-ctr).
X 6700-exit. exit.
X
X 7000-nav-ck.
X if srctr < 1 or srctr > 126 or skctr < 1 or skctr > 126
X display "Warp drive shut down - "
X display "UNAUTHORIZED ATTEMPT TO LEAVE GALAXY "
X perform 8100-dmg-com thru 8100-exit
X go to 2000-exit
X else
X move " " to macol (mrctr , mkctr)
X move srctr to mrctr.
X move skctr to mkctr.
X if macol (mrctr , mkctr) = "K" or macol (mrctr , mkctr) = "R" or macol (mrctr , mkctr) = "B"
X perform 8000-bomb thru 8000-exit
X else
X move "E" to macol (mrctr , mkctr).
X 7000-exit. exit.
END_OF_FILE
if test 31341 -ne `wc -c <'ctrek.p1'`; then
echo shar: \"'ctrek.p1'\" unpacked with wrong size!
fi
# end of 'ctrek.p1'
fi
echo shar: End of archive 1 \(of 2\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 2 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked both archives.
echo Building source file
cat ctrek.p1 ctrek.p2 >ctrek.cob
rm -f ctrek.p1 ctrek.p2
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0