John Levine <johnl@taugh.com> writes:

According to Michael S <already5chosen@yahoo.com>:

I once ported a COBOL-specific algorithm to Pascal, which meant
that I had to reimplement code for all the 80-col punch card
formatted IO as well as sorting according to quite special rules.

The original was 25 pages, my replacement ~5, at least half of
which was the COBOL specific function replacements, so the
mainline code became an order of magnitude smaller.

My assumption was that majority of size reduction happened due to >>identifying repeated patterns and implementing them as subroutines.
Which could be done in any reasonable language. I know nothing about
COBOL, but hope that it supports subroutines.

COBOL is by design, really really verbose, e.g. what we would write as

tg = kb + ro

is

ADD KICK-BACK TO RAKE-OFF GIVING TOTAL-GRAFT.

It has only weak subroutines. You can say

PERFORM PARA1 THRU PARA2 VARYING THING-INDEX FROM THING-BASE TO THING-LIMIT.

it will set THING-BASE, jump to PARA1 and loop and return at the end
of PARA2 more or less like a FOR loop, but handling the parameters
beyond that is up to you. At least in IBM COBOL there is a way to
break up a program into subroutines you can call with parameters
but there is so much mandatory glop for each routine (the whole
ENVIRONMENT DIVISION, DATA DIVISION thing) that you're not going
to end up with a short program.

COBOL85 added real subroutines, and I suspect later versions have
made them more useful.

Also, as someone else keeps pointing out, any sort of string
processing beyond putting stuff in fixed fields is very painful.

Hm. I don't believe that I would agree with that.

You should look at some COBOL programs. It's a whole different world.

?LI SYSTEM/OPERATOR
?COMPILE STREK COBOL LIB MEM + 300.
?DATA CARD
$SET CODE
IDENTIFICATION DIVISION.
PROGRAM-ID. STREK.
AUTHOR. KURT WILHELM.
INSTALLATION. OAKLAND UNIVERSITY.
DATE-WRITTEN. COMPLETED SEPTEMBER 1, 1979.
*
*******************************************************
* 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. *
*******************************************************
*

ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. V-380.
OBJECT-COMPUTER. V-300.

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) COMP.
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) COMP.
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) COMP.
01 VAR3 PIC 9(6) COMP.
01 VAR4 PIC 9(4) COMP.
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) COMP.
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) COMP.
01 SHIELD-CNT-AN PIC X(4).
01 DAMAGE-CNT PIC 9(6) COMP.
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 VALUE "YES".
01 REV-STR PIC 9(6) COMP.
01 SEED-X PIC V9(6) COMP.
01 SEED-AST PIC 9(6)V9(6) COMP.
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) COMP.

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) COMP.
01 STR-A PIC 99.
01 STR-R PIC 99.
01 STR-X PIC 99.
01 CX PIC 999 COMP.
01 DX PIC 999 COMP.
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-LAT
- E
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 ENTR
- Y2 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-E
- XIT.
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.
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.

[continued in next message]

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)