;WORK:<RASPUZZI.VTTREK>VTTREK.MAC.172, 14-Jul-88 11:45:24, Edit by RASPUZZI
; Cleanup beginning comments.
;WORK:<RASPUZZI.VTTREK>VTTREK.MAC.171, 14-Jul-88 11:39:41, Edit by RASPUZZI
; Phaser shots should always be yellow. Make sure. (edit 204)
;WORK:<RASPUZZI.VTTREK>VTTREK.MAC.168, 28-Jun-88 15:07:36, Edit by RASPUZZI
; Make sure LAT terminals can't supress stars. (edit 203)
;WORK:<RASPUZZI.VTTREK>VTTREK.MAC.165, 24-Jun-88 09:58:29, Edit by RASPUZZI
; Fix a bug when redisplaying the console. (edit 202)
;WORK:<RASPUZZI.VTTREK>VTTREK.MAC.163, 22-Jun-88 10:42:08, Edit by RASPUZZI
; Make sure screen stays Magenta for Klingon torpedoes (edit 201).
;WORK:<RASPUZZI.VTTREK>VTTREK.MAC.158, 9-Jun-88 14:47:29, Edit by RASPUZZI
; Finish code cleanup. Neatness counts!
;WORK:<RASPUZZI.VTTREK>VTTREK.MAC.133, 9-Jun-88 12:30:31, Edit by RASPUZZI
; Remove TOPS-10 stuff so this is now TOPS-20 only.
;WORK:<RASPUZZI.VTTREK>VTTREK.MAC.12, 7-Jun-88 14:50:36, Edit by RASPUZZI
; Add VT241 support and begin cleanup of messy code.
;<HESS>VTTREK.MAC.41 15-Jan-81 09:42:56, Edit by HESS
; VT100 TREK Version 4.0
;
; TREK is a VT100 game for up to eight players. It's written in
; MACRO-20 for VT100s that are equipped with the Advanced Video
; Option, VT125s, VT241s or GIGIs
;
; Each player runs the game from a separate TTY and job. The
; jobs communicate via a shareable high segment.
;
; VTTREK.DOC contains a complete game description. The program
; uses a file of help texts named VTTREK.HLP. This file should be
; on the same device and in the same directory as the VTTREK.EXE.
; The file isn't required in order to run the game.
;
; Version 2.0 contains all of the modifications since the release
; of Version 1.0 plus many new routines. VTTREK.DOC describes
; Version 4.0 and the differences between the old and new versions.
;
; Version 4.0 has GIGI, VT125 and VT241 support. VT241s must be in
; VT125 mode for the ReGIS graphics. Color is also a feature in
; this version.
;
; VTTREK timing is based on 1200 baud lines. Lower baud rates give a
; slow-motion effect and an advantage to interceptors and bases. Higher
; baud rates seem to make it easy to defeat computer ships.
;
; Questions, comments, suggestions, etc, are welcome.
;
; For further information, contact:
;
; Michael Raspuzzi
; TOPS-20 Monitor Engineering
; MRO1-2/L14 Pole P14
; (617) 467-2346 DTN 297-2346
;
; Revisions since release of version 1.0:
;
; 7-Jun-88 Add VT241 support and start general cleanup and
; start edit history.
;
; 7-Jan-81 Conversion to TOPS20
;
; 16-Sep-80 added optional ADJBP macro for KL to KI conversion.
;
; 16-Sep-80 added ROTRAN routine to randomize starting orientation.
;
; 05-Oct-80 move one-line messages to the bottom of the display.
;
; 12-Oct-80 modify RF command to allow setting energy/torpedoes.
;
; 28-Oct-80 photon fire visually detectable up to 2048 distance.
;
; 28-Oct-80 'harden' starbases by allowing them to refuel.
;
; 04-Nov-80 ship-to-ship messages displayed at bottom of screen.
;
; 04-Nov-80 'more' message shifted to keypad.
;
; 04-Nov-80 added planet rebellions.
TITLE TREK
.REQUEST SYS:FORLIB
.REQUIRE SYS:MACREL
SEARCH MONSYM,MACSYM
SALL
.JBUUO==40
;Version definitions
TK.VER=4 ;Version number
TK.MIN=0 ;Minor version
TK.WHO=0 ;Who last edited
TK.EDT=^D204 ;Edit #
Subttl Table of Contents
; Table of Contents for VTTREK
;
; Section Page
;
;
; 1. Data Constants . . . . . . . . . . . . . . . . . . . . 7
; 2. Data Storage
; 2.1 General Usage . . . . . . . . . . . . . . . . 10
; 2.2 Ship Masks . . . . . . . . . . . . . . . . . . 16
; 2.3 Ally Ship Masks . . . . . . . . . . . . . . . 17
; 2.4 Event Queue Area . . . . . . . . . . . . . . . 18
; 2.5 Shareable Segment . . . . . . . . . . . . . . 19
; 2.6 Universal Object Table . . . . . . . . . . . . 21
; 3. Warp Distances . . . . . . . . . . . . . . . . . . . . 23
; 4. Universal Table Initial Values . . . . . . . . . . . . 24
; 5. Ship Object Tables . . . . . . . . . . . . . . . . . . 25
; 6. Quadrant Table . . . . . . . . . . . . . . . . . . . . 27
; 7. Command Storage . . . . . . . . . . . . . . . . . . . 28
; 8. Scanner Tables . . . . . . . . . . . . . . . . . . . . 30
; 9. Viewer Tables . . . . . . . . . . . . . . . . . . . . 31
; 10. Object Names . . . . . . . . . . . . . . . . . . . . . 34
; 11. PSI Tables . . . . . . . . . . . . . . . . . . . . . . 37
; 12. Weapon Flash Sequences . . . . . . . . . . . . . . . . 38
; 13. Macro Definitions . . . . . . . . . . . . . . . . . . 40
; 14. UUO Definitions . . . . . . . . . . . . . . . . . . . 43
; 15. Macro & UUO Handling Routines . . . . . . . . . . . . 44
; 16. UUO Dispatch . . . . . . . . . . . . . . . . . . . . . 45
; 17. UUO Supporting Routines . . . . . . . . . . . . . . . 46
; 18. Entry Vector . . . . . . . . . . . . . . . . . . . . . 54
; 19. Main Program Loop . . . . . . . . . . . . . . . . . . 55
; 20. Command Dispatch Table . . . . . . . . . . . . . . . . 57
; 21. Short Range Sensor Scan . . . . . . . . . . . . . . . 58
; 22. Long Range Sensor Scan
; 22.1 Check Target . . . . . . . . . . . . . . . . . 60
; 22.2 Display Target Information . . . . . . . . . . 61
; 23. Command Support
; 23.1 Special Command . . . . . . . . . . . . . . . 62
; 23.2 Get From Library . . . . . . . . . . . . . . . 64
; 23.3 Lock Target . . . . . . . . . . . . . . . . . 65
; 23.4 Raise/Lower Shields . . . . . . . . . . . . . 67
; 23.5 Move Target . . . . . . . . . . . . . . . . . 68
; 23.6 Transfer Energy . . . . . . . . . . . . . . . 71
; 23.7 Status of Game . . . . . . . . . . . . . . . . 72
; 23.8 Request Assistance . . . . . . . . . . . . . . 74
; 23.9 Red Alert & Yellow Alert . . . . . . . . . . . 75
; 23.10 Secure from Alert . . . . . . . . . . . . . . 76
; 23.11 Alert Ally Ships . . . . . . . . . . . . . . . 77
; 23.12 Rapid Fire . . . . . . . . . . . . . . . . . . 78
; 23.13 Rapid Fire (Shoot Phasers) . . . . . . . . . . 79
; 23.14 Fire Phasers . . . . . . . . . . . . . . . . . 80
; 23.15 Rapid Fire (Launch Photon Torpedo) . . . . . . 81
; 23.16 Fire Photon Torpedo . . . . . . . . . . . . . 82
Subttl Table of Contents (page 2)
; Table of Contents for VTTREK
;
; Section Page
;
;
; 24. Weapons Flash
; 24.1 Phasers . . . . . . . . . . . . . . . . . . . 83
; 24.2 Photon Torpedoes . . . . . . . . . . . . . . . 84
; 24.3 Display the Flash . . . . . . . . . . . . . . 85
; 25. Command Support
; 25.1 Ship Movement . . . . . . . . . . . . . . . . 86
; 25.2 Rotate Ship . . . . . . . . . . . . . . . . . 89
; 25.3 Rotate Target With Ship Rotation . . . . . . . 90
; 25.4 Warp Distance . . . . . . . . . . . . . . . . 91
; 25.5 Display Object in List . . . . . . . . . . . . 93
; 25.6 Display Any Object . . . . . . . . . . . . . . 94
; 25.7 Capture Planet . . . . . . . . . . . . . . . . 95
; 25.8 Refueling . . . . . . . . . . . . . . . . . . 96
; 25.9 Routine To Actually Refuel . . . . . . . . . . 97
; 25.10 Find Nearest Base (or Planet) . . . . . . . . 98
; 25.11 Send Message . . . . . . . . . . . . . . . . . 100
; 25.12 Display Users in Game . . . . . . . . . . . . 101
; 25.13 Help . . . . . . . . . . . . . . . . . . . . . 104
; 25.14 Quit or Exit . . . . . . . . . . . . . . . . . 105
; 25.15 Suppress Stars (1200 baud only) . . . . . . . 106
; 25.16 Do Self Test . . . . . . . . . . . . . . . . . 107
; 25.17 Refresh the Screen . . . . . . . . . . . . . . 108
; 26. Library Supporting Routines . . . . . . . . . . . . . 109
; 27. Notification of Movement . . . . . . . . . . . . . . . 112
; 28. Help File
; 28.1 Open Help File . . . . . . . . . . . . . . . . 113
; 28.2 Read Information in From Help File . . . . . . 114
; 28.3 Close Help File . . . . . . . . . . . . . . . 115
; 29. Standard Scan . . . . . . . . . . . . . . . . . . . . 116
; 30. Check For an Entry in Our Library Computer . . . . . . 117
; 31. Get Object in Target . . . . . . . . . . . . . . . . . 119
; 32. Find Target . . . . . . . . . . . . . . . . . . . . . 120
; 33. Test Target Validity . . . . . . . . . . . . . . . . . 121
; 34. Scan Target Area . . . . . . . . . . . . . . . . . . . 122
; 35. Scan For Objects in Range . . . . . . . . . . . . . . 123
; 36. Get Object From List . . . . . . . . . . . . . . . . . 124
; 37. Last Clear . . . . . . . . . . . . . . . . . . . . . . 125
; 38. Catalog . . . . . . . . . . . . . . . . . . . . . . . 126
; 39. Display List Items . . . . . . . . . . . . . . . . . . 127
; 40. Last X,Y,Z . . . . . . . . . . . . . . . . . . . . . . 128
; 41. Display Warp Factor on Console . . . . . . . . . . . . 129
; 42. Sufficient Energy Test . . . . . . . . . . . . . . . . 130
; 43. Energy Display on Console . . . . . . . . . . . . . . 131
; 44. Shield Display on Console . . . . . . . . . . . . . . 132
; 45. Number Display on Console . . . . . . . . . . . . . . 133
; 46. Fix Floating Point Number for Display . . . . . . . . 134
; 47. Output Number . . . . . . . . . . . . . . . . . . . . 135
Subttl Table of Contents (page 3)
; Table of Contents for VTTREK
;
; Section Page
;
;
; 48. Display Floating Point Number . . . . . . . . . . . . 136
; 49. Viewer Display
; 49.1 Get Item . . . . . . . . . . . . . . . . . . . 137
; 49.2 Show A Character . . . . . . . . . . . . . . . 138
; 49.3 RC Test . . . . . . . . . . . . . . . . . . . 139
; 49.4 Clear Target . . . . . . . . . . . . . . . . . 140
; 50. Starbase Range Checking . . . . . . . . . . . . . . . 141
; 51. Planet Defense . . . . . . . . . . . . . . . . . . . . 143
; 52. Planetary Interceptor Routines . . . . . . . . . . . . 147
; 53. Set Up Planet Rebel Time . . . . . . . . . . . . . . . 151
; 54. Test For Ship in Range . . . . . . . . . . . . . . . . 153
; 55. Terminal Flash & Hold Routine . . . . . . . . . . . . 154
; 56. More Flash Routines (For GIGI Graphics) . . . . . . . 159
; 57. Transfer Energy Wait Routine . . . . . . . . . . . . . 161
; 58. Phaser Hit . . . . . . . . . . . . . . . . . . . . . . 162
; 59. Photon Hit . . . . . . . . . . . . . . . . . . . . . . 164
; 60. Display Explosion . . . . . . . . . . . . . . . . . . 165
; 61. Ship Destoryed! . . . . . . . . . . . . . . . . . . . 166
; 62. Energy Transfer Notification . . . . . . . . . . . . . 167
; 63. Display Sent Message . . . . . . . . . . . . . . . . . 168
; 64. Unmanned Ship Phaser/Photon Control . . . . . . . . . 170
; 65. Energy Adjustment . . . . . . . . . . . . . . . . . . 171
; 66. Object Destoryed . . . . . . . . . . . . . . . . . . . 174
; 67. Get Message . . . . . . . . . . . . . . . . . . . . . 176
; 68. Activate a TIME.Q . . . . . . . . . . . . . . . . . . 179
; 69. Event Queue Routines
; 69.1 Event Execution . . . . . . . . . . . . . . . 182
; 69.2 Phaser/Photon Fire . . . . . . . . . . . . . . 183
; 69.3 Event Handling (Dispatch) . . . . . . . . . . 187
; 69.4 Move Object . . . . . . . . . . . . . . . . . 188
; 69.5 Delete Object From Existance . . . . . . . . . 189
; 69.6 Display Hit On Object . . . . . . . . . . . . 190
; 69.7 Hit Request . . . . . . . . . . . . . . . . . 193
; 69.8 Hit Test . . . . . . . . . . . . . . . . . . . 196
; 69.9 Our Ship Has Been Hit . . . . . . . . . . . . 197
; 69.10 Describe Weapon Hit . . . . . . . . . . . . . 198
; 69.11 Display Weapon Hits On Viewer Objects . . . . 199
; 69.12 Notification Of Attacks . . . . . . . . . . . 200
; 69.13 Notification Of Ship Destruction . . . . . . . 201
; 69.14 Notification Of Enemy Detection . . . . . . . 202
; 69.15 Notification Of Planet Rebellion . . . . . . . 203
; 69.16 Display Alert . . . . . . . . . . . . . . . . 204
; 70. Unmanned Ship Control Missions . . . . . . . . . . . . 205
; 71. Ship Mask Setup . . . . . . . . . . . . . . . . . . . 206
; 72. Build Ranges For All Non-star Objects . . . . . . . . 207
; 73. Short Range Scan Catalog . . . . . . . . . . . . . . . 209
Subttl Table of Contents (page 4)
; Table of Contents for VTTREK
;
; Section Page
;
;
; 74. Unmanned Ship Missions
; 74.1 Travel to Planet/Base . . . . . . . . . . . . 212
; 74.2 Retreat to Base & Refuel . . . . . . . . . . . 213
; 74.3 ESH Mission . . . . . . . . . . . . . . . . . 215
; 74.4 EBA Mission . . . . . . . . . . . . . . . . . 217
; 74.5 Capture Planet . . . . . . . . . . . . . . . . 218
; 74.6 Respond to Other Ship's Red Alert . . . . . . 220
; 74.7 Allocate Energy to Shields . . . . . . . . . . 222
; 75. Find Nearest Base . . . . . . . . . . . . . . . . . . 224
; 76. Reenter Game . . . . . . . . . . . . . . . . . . . . . 226
; 77. Phaser Energy Based on Automatic Ships . . . . . . . . 227
; 78. Automatic Ship Movement . . . . . . . . . . . . . . . 230
; 79. Unmanned Ship Request For Mission . . . . . . . . . . 234
; 80. Game Setup . . . . . . . . . . . . . . . . . . . . . . 235
; 81. Check For Game Time Expiration . . . . . . . . . . . . 237
; 82. Display Current Time . . . . . . . . . . . . . . . . . 239
; 83. Startup Interlock Routine . . . . . . . . . . . . . . 240
; 84. Display Ships in Play . . . . . . . . . . . . . . . . 241
; 85. Dsiplay Available Ships . . . . . . . . . . . . . . . 243
; 86. Find User Job Information . . . . . . . . . . . . . . 244
; 87. Random Rotation . . . . . . . . . . . . . . . . . . . 245
; 88. Select Ship At Startup . . . . . . . . . . . . . . . . 246
; 89. Initialize Event Queue . . . . . . . . . . . . . . . . 247
; 90. Load Universal Object Table . . . . . . . . . . . . . 248
; 91. Random Number Generator Seeder . . . . . . . . . . . . 254
; 92. Get Random Number . . . . . . . . . . . . . . . . . . 255
; 93. Initialize The PSI System . . . . . . . . . . . . . . 256
; 94. Control C Trapping Routine . . . . . . . . . . . . . . 257
; 95. Reentry Wait . . . . . . . . . . . . . . . . . . . . . 258
; 96. Cleanup When We Leave (or Are Destroyed) . . . . . . . 259
; 97. Ship Rotation
; 97.1 Z & Y . . . . . . . . . . . . . . . . . . . . 263
; 97.2 X Only . . . . . . . . . . . . . . . . . . . . 264
; 97.3 Y Only . . . . . . . . . . . . . . . . . . . . 265
; 97.4 Z Only . . . . . . . . . . . . . . . . . . . . 266
; 98. Do SINE & COSINE Trig Functions . . . . . . . . . . . 268
; 99. UOT For Screen Display . . . . . . . . . . . . . . . . 269
; 100. Calculate ARCTANGENT of Angle . . . . . . . . . . . . 273
; 101. Get Command Sequence From Terminal . . . . . . . . . . 274
; 102. Scans
; 102.1 Jacket Routine . . . . . . . . . . . . . . . . 286
; 102.2 Test to See if Object is in Scanning Range . . 287
; 102.3 Clear Scan Table . . . . . . . . . . . . . . . 288
; 102.4 Update Scan Table . . . . . . . . . . . . . . 289
; 102.5 Delete Object . . . . . . . . . . . . . . . . 290
; 102.6 Load Viewer From Scan Table . . . . . . . . . 291
Subttl Table of Contents (page 5)
; Table of Contents for VTTREK
;
; Section Page
;
;
; 103. Viewer
; 103.1 Update Two Viewer Rows . . . . . . . . . . . . 292
; 103.2 Update Single Viewer Row . . . . . . . . . . . 293
; 103.3 Delete Object From Viewer . . . . . . . . . . 295
; 103.4 Viewer Initialization . . . . . . . . . . . . 296
; 103.5 Update Target . . . . . . . . . . . . . . . . 298
; 103.6 Clear Viewer . . . . . . . . . . . . . . . . . 299
; 103.7 Output Object On Viewer . . . . . . . . . . . 303
; 103.8 GIGI Color For Objects in Viewer . . . . . . . 304
; 103.9 Target Redo . . . . . . . . . . . . . . . . . 305
; 103.10 Target Update . . . . . . . . . . . . . . . . 306
; 103.11 Make Target Blink . . . . . . . . . . . . . . 307
; 103.12 Put Cursor on Status Line . . . . . . . . . . 310
; 103.13 Position Cursor . . . . . . . . . . . . . . . 312
; 104. Get Character From Terminal . . . . . . . . . . . . . 314
; 105. Timed Input From Terminal . . . . . . . . . . . . . . 316
; 106. Handle Tyepin Interrupts . . . . . . . . . . . . . . . 317
; 107. Load GIGI Macrographs . . . . . . . . . . . . . . . . 318
; 108. Display The Main Console Screen . . . . . . . . . . . 319
; 109. Clear Screen . . . . . . . . . . . . . . . . . . . . . 323
; 110. Do VT100 Self Test . . . . . . . . . . . . . . . . . . 324
; 111. VT100 Initialization . . . . . . . . . . . . . . . . . 325
; 112. Check Terminal Type . . . . . . . . . . . . . . . . . 326
; 113. Set Terminal Control Words . . . . . . . . . . . . . . 329
; 114. Reset Terminal Modes When Exit . . . . . . . . . . . . 330
; 115. Make .SHARE File & .EXE File . . . . . . . . . . . . . 331
; 116. Code to Make Shareable Segment . . . . . . . . . . . . 333
; 117. Error Reporting . . . . . . . . . . . . . . . . . . . 334
; 118. Game Boot Area . . . . . . . . . . . . . . . . . . . . 335
SUBTTL Data Constants
;ACs...
RS==0
T1==1 ;Temporary registers
T2==2
T3==3
T4==4
UOT==5 ;Accumulator for universal table index
ROW==6 ;Accumulator for row values
COL==7 ;Accumulator for col values
LST==10 ;Accumulator for target list routines
P1==11 ;Registers used by the queue routines.
P2==12 ;Must be considered permanent by any routine
P3==13 ;That isn't a queue routine.
P4==14
SUOT==15 ;UOT of this ship - set at startup, never changed
AP==16 ;General purpose register
C==16 ; (AP is sometimes called C)
P==17 ;Stack pointer
SP==17 ; (P is sometimes called SP)
PDLSZ==300 ;Stack size
SH.CT=10 ;Number of ships
SB.CT=10 ;Number of starbases
PL.CT=100 ;Number of planets and interceptors
ST.CT=100 ;Number of stars
SH.MN=0 ;Low index of ships in universal table
SB.MN=10 ;Low index of starbases
PL.MN=20 ;Low index of planets and interceptors
ST.MN=120 ;Low index of stars
SH.MX=7 ;High index of ships in universal table
SB.MX=17 ;High index of starbases
PL.MX=117 ;High index of planets
ST.MX=217 ;High index of stars
Q.SIZE=600*6 ;Size of the event queue
HQ.MIN=0
HQ.MAX=77*6
LQ.MIN=100*6
LQ.MAX=577*6
SUBTTL Data Storage -- General Usage
PDL: BLOCK PDLSZ ;Stack
TTTYP: 0 ;Terminal type flag (-1 = GIGI)
GRTYP: 0 ;Graphics type (-1 = ReGIS)
VT241F: 0 ;VT241 flag (-1 = VT241)
VKFLAG: 0 ;VK flag (-1 = GIGI) Used for FONTs
.DIRECTIVE FLBLST ;Really don't need a big listing.
;VK FONTs
VKFNT1: ASCIZ
PpL(A1)
L" "00;
l"("0000800103030180;
l")"0000804060604080;
l"*"002A55BEFFBE552A;
l"+"0000082A5D2A08;
l"-"000000223E22;
l"."000000001818;
l"0"001C22414141221C;
l"8"007FE37F9C9C7FE37F;
l"="000000FF0000FF;
l"@"003EFFC10808C1FF3E;
l"H"000041EBFFEB41;
l"O"00003EE3C9E33E;
L"V"0041412222141408;
L"`"00081C3E7F3E1C08;
L"f"000E11110E;
L"p"0000FF;
L"q"00000000FF;
L"r"000000000000FF;
L"t"0C1E3676C7C776361E0C;
L"u"183C3637F1F137363C18;
L"w"1F7FFFFFFFFFFFFF7F1F;
L"x"1F7FFF3F07073FFF7F1F;
L"y"1F7F1F070101071F7F1F;
L"z"F8FEFFFFFFFFFFFFFEF8;
L"~"0000000008;
\
;VT100 FONTs
VTFNT1: ASCIZ
PpL(A1)
L" "00,00,00,00,00,00,00,00,00,00;
l"("00,00,80,01,03,03,01,80,00,00;
l")"00,00,80,40,60,60,40,80,00,00;
l"*"00,2A,55,BE,FF,BE,55,2A,00,00;
l"+"00,00,08,2A,5D,2A,08,00,00,00;
l"-"00,00,00,22,3E,22,00,00,00,00;
l"."00,00,00,00,18,18,00,00,00,00;
l"0"00,1C,22,41,41,41,22,1C,00,00;
l"8"00,7F,E3,7F,9C,9C,7F,E3,7F,00;
l"="00,00,00,FF,00,00,FF,00,00,00;
l"@"00,3E,FF,C1,08,08,C1,FF,3E,00;
l"H"00,00,41,EB,FF,EB,41,00,00,00;
l"O"00,00,3E,E3,C9,E3,3E,00,00,00;
L"V"00,41,41,22,22,14,14,08,00,00;
L"`"00,08,1C,3E,7F,3E,1C,08,00,00;
L"f"00,0E,11,11,0E,00,00,00,00,00;
L"p"00,00,FF,00,00,00,00,00,00,00;
L"q"00,00,00,00,FF,00,00,00,00,00;
L"r"00,00,00,00,00,00,FF,00,00,00;
L"t"0C,1E,36,76,C7,C7,76,36,1E,0C;
L"u"18,3C,36,37,F1,F1,37,36,3C,18;
L"w"1F,7F,FF,FF,FF,FF,FF,FF,7F,1F;
L"x"1F,7F,FF,3F,07,07,3F,FF,7F,1F;
L"y"1F,7F,1F,07,01,01,07,1F,7F,1F;
L"z"F8,FE,FF,FF,FF,FF,FF,FF,FE,F8;
L"~"00,00,00,00,08,00,00,00,00,00;
\
.DIRECTIVE NO FLBLST ;Return to normal listing.
VTFLAG: 1
V52FLG: 0 ;-1 if VT100 in VT52 mode
DBUGF: 0 ;Debug flag
BOOTF: BLOCK 1 ;Once only flag for BOOTS
HLPJFN: BLOCK 1 ;Help file JFN
SAVMOD: BLOCK 1 ;TTY JFN mode saved here
D.TCNT: BLOCK 1 ;Counter to prevent time from being displayed too often
GJBLK: GJ%OLD ;File must exist
.NULIO,,.NULIO ;No primary input/output
-1,,TK.DEV ;Device is here
-1,,TK.DIR ;Directory goes here
-1,,TK.NAM ;File name goes here
0 ;File extension - to be supplied
0 ;Protection
0 ;Account
0 ;JFN (not used)
TK.NAM: BLOCK 10 ;Name of program
TK.DIR: BLOCK 10 ;Directory of program
TK.DEV: BLOCK 10 ;Device of program
D.LINE: BLOCK 1
D.LAST: BLOCK 1
F.DATA: BLOCK 1 ;Data for FORTRAN calls
F.LOC: 200,,F.DATA ;Location of FORTRAN data
F.MAX: BLOCK 1
F.HIT: BLOCK 1
F.UOT: BLOCK 1
MAX.EN: DEC 5000000 ;Max energy a ship can have
K256: 128.0
K181: 90.50966802
I.CHAR: BLOCK 1
I.SIGN: BLOCK 1
I.NBR: BLOCK 1
I.PATH: BLOCK 1
I.POS: BLOCK 1
I.SPOS: BLOCK 1
I.MAX: BLOCK 1
SIN.A: BLOCK 1 ;Store SINE of angle
COS.A: BLOCK 1 ;Store COSINE of angle
TAN.A: BLOCK 1 ;Tangent goes here
SIN.B: BLOCK 1
COS.B: BLOCK 1
TAN.B: BLOCK 1
VAR.X: 0
VAR.Y: ^D256
P.ENER: BLOCK 1
P.TIME: BLOCK 1
P.SAVE: BLOCK 1
P.RANG: BLOCK 1
B1: BLOCK 1 ;Bearing
E1: BLOCK 1 ;Elevation
R1: BLOCK 1 ;Range
X1: BLOCK 1
Y1: BLOCK 1
Z1: BLOCK 1
X2: BLOCK 1
Y2: BLOCK 1
Z2: BLOCK 1
COMP.X: BLOCK 1
COMP.Y: BLOCK 1
COMP.Z: BLOCK 1
A.ABSX: BLOCK 1
A.ABSY: BLOCK 1
A.ABSZ: BLOCK 1
RAN.MN: 1
RAN.MX: 100
RAN.NR: BLOCK 1
RAN.SD: BLOCK 1
R.FIRE: BLOCK 1 ;= 0 rapid fire off
;< 0 rapid fire on
RF.PHA: ^D200 ;Rapid fire phaser energy (default 200)
RF.PHO: ^D1 ;Rapid fire photon count (default 1)
A.FIRE: BLOCK 1 ;Phaser/photon work area for bases,
;interceptors, and unmanned ships:
;
;LH - weapons code, bit 9: 0 = pha, 1 = pho.
;RH - energy to be applied.
SUBTTL Data Storage -- Ship Masks
;Ship masks
;
; Ship masks are used in the event queue to indicate which ship an
; event applies to, and in the universal table to indicate which
; libraries an object is in. The mask is always the leftmost 8 bits
; in a halfword. The bits are in reverse order. Bit 18 pertains to
; ship 8, bit 25 to ship 1.
MASK.F: 252000 ;All Federation ships
MASK.K: 524000 ;All Klingon ships
MASK.A: 776000 ;All ships, Federation and Klingon
MASK.C: 0 ;This ship only (set during setup)
MASK.O: 776000 ;Any ship but this one (set during setup)
MASK.U: 524000 ;'US' - friendly ships (set during setup)
MASK.T: 524000 ;'THEM' - enemy ships (set during setup)
MSKA.U: BLOCK 1 ;'US' for unmanned ships.
MSKA.T: BLOCK 1 ;'THEM' for unmanned ships.
SUBTTL Data Storage -- Ally Ship Masks
;Ally masks
;
; Used to determine which side an object is on. Masks bits
; 29 thru 31 in the U.TAB word.
ALLY.F: 1B31 ;Federation mask.
ALLY.K: 1B30 ;Klingon mask.
ALLY.N: 1B29 ;Neutral mask.
ALLY.A: 7B31 ;Neutral, Federation, or Klingon.
ALLY.U: 1B30 ;'US' - our side (set by setup routine).
ALLY.T: 1B30 ;'THEM' - their side (set by setup routines).
ALYA.U: BLOCK 1 ;'US' for unmanned ships.
ALYA.T: BLOCK 1 ;'THEM' for unmanned ships.
CHAN.C: BLOCK 1
CHAN.F: BLOCK 1
CHAN.K: BLOCK 1
CHAN.A: BLOCK 1
U.SIDE::BLOCK 1 ;Side a player is on (used during startup)
SUBTTL Data Storage -- Event Queue Area
EADD.T: BLOCK 1 ;Event queue add area
EADD.A: BLOCK 1
EADD.B: BLOCK 1
EADD.X: BLOCK 1
EADD.Y: BLOCK 1
EADD.Z: BLOCK 1
EWRK.T: BLOCK 1 ;Event queue work area
EWRK.A: BLOCK 1
EWRK.B: BLOCK 1
EWRK.X: BLOCK 1
EWRK.Y: BLOCK 1
EWRK.Z: BLOCK 1
M.TIME: BLOCK 1 ;TODCLK as obtained by TIME%
WORK.Q: BLOCK 600
SUBTTL Data Storage -- Shareable Segment
LOCSHR:: PHASE 400K
SHRBEG::
SEGVER: BYTE (3)TK.WHO (9)TK.VER (6)TK.MIN (18)TK.EDT ;Matched against EV+2 at startup
INITF: BLOCK 1 ;Interlock for boot init
;High-segment information shared by all ships
GAM.NR: BLOCK 1 ;Tournament game number or 0 if random
GAM.TM: ^D20 ;Minutes remaining in the game
GAM.HR: BLOCK 1 ;Current hour
GAM.MN: BLOCK 1 ;Current minute
I.LOCK: BLOCK 1 ;Initial (startup) lock. Keeps 2 or more
;players from starting up simultaneously.
I.TIME: BLOCK 1 ;Time I.LOCK was set. Allows I.LOCK to be reset
;if system crash occurred while a player was
;starting up.
Q.TIME:: 1 ;= 0, no non-ship (base, planet, interceptor)
; is waiting to be activated.
;> 0, lowest time that a non-ship is due to
; be activated.
A.SHIPS:: 10 ; number of ships under automatic control
MASK.Q::BLOCK 1 ;8-bit mask (0-7) indicating active ships.
TIME.Q:: BLOCK 120 ;Time that an unmanned ship or a non-ship is to
;be activated. Zero means the entry is empty.
REBEL: BLOCK 120 ;Time after which a planet may consider rebellion.
;Event queue
q:: BLOCK Q.SIZE
EVNT.T==Q ;Time after which event is to occur.
;= 0, entry is empty.
;< 0, entry is being temporarily held by a ship.
EVNT.A==Q+1 ;Event code word:
;0-7 ships to whom event applies (8-bit mask, ships
; 7 to 0). when a ship processes the event,
; it sets its bit to 0. when the mask is all 0,
; all ships have processed the event and the
; entry is returned to the available pool.
;8-9 weapons code:
; 0 = phasers
; 1 = photon torpedo
; message code:
; 0 = ship detected
; 1 = ship attacked
;10-17 uot of ship that sourced the event. this is
; the 'secondary' uot.
;18 message bit indicating an 'under attack' msg
; should be displayed.
;19-29 not used.
;30-35 event code.
EVNT.B==Q+2 ;UOT word:
;0-17 energy (for weapons and energy transfer).
;18-27 not used.
;28-35 uot of ship to whom the event is to occur.
; (may also be the sourcing uot, depending on
; the event.) this is the 'primary' uot.
EVNT.X==Q+3 ;absolute coordinates of object to whom event is to
EVNT.Y==Q+4 ;occur. used to test whether object has moved since
EVNT.Z==Q+5 ;event was initiated (mainly for weapons).
BLOCK 1
SUBTTL Data Storage -- Universal Object Table
;Universal Object Tables
;
; Data describing all of the objects in the galaxy. U.TAB is a
; general information word filled in when the galaxy is loaded.
; Initially, U.TAB contains only uid's (ID identifying what the
; object is). The term 'UOT' usually means the index into these
; tables.
U.TAB:: REPEAT 4,<EXP 5,6> ;Federation, Klingon ships
REPEAT 4,<EXP 3,4> ;Federation, Klingon bases
REPEAT 20,<EXP 2,7,7,7> ;Planets and their interceptors
REPEAT 100,<EXP 1> ;Stars
BLOCK 1
U.ABSX: BLOCK 220 ;Absolute X,Y,Z coordinates of
U.ABSY: BLOCK 220 ;the object (floating point)
U.ABSZ: BLOCK 220
U.ENER: BLOCK 220 ;Ship and shield energy. All objects have an
U.SHLD: BLOCK 220 ;energy allocation. (binary milliunits)
U.MSG: BLOCK 130 ;message area, one line per ship
U.ALRT: BLOCK 10 ;Alert status (ships only).
U.JOB: BLOCK 10 ;Job number of player
U.NAMX: BLOCK 10 ;User number of player
U.TIME: BLOCK 10 ;Time (ms) player was last active. when game
;is run, any player with no activity for
;past 5 minutes is reset. This is intended
;as a means to reset the game after a system
;crash. The time is updated every second
;or so whether the player enters a command
;or not, so it's not a time limit within
;which a player has to make a move.
U.BEGX: BLOCK 10 ;Ship positions assigned at startup. Players
U.BEGY: BLOCK 10 ;coming back into the game begin at their
U.BEGZ: BLOCK 10 ;original starting position.
U.LSTX: BLOCK 10 ;Last known position of a ship.
U.LSTY: BLOCK 10
U.LSTZ: BLOCK 10
U.TTY: BLOCK 10 ;TTY of player. TTY number determines
;whether a player was previously in the
;game, hence is in the shared section.
U.WAIT: BLOCK 10 ;Time (ms) at which a player may reenter the
;game. Player must wait 2 minutes before
;reentry is allowed.
U.TORP: BLOCK 10 ;Number of torpedoes a ship has.
N.MUOT: BLOCK 10 ;Object toward which an unmanned ship is
;moving.
N.MSSN: BLOCK 10 ;Unmanned ship's current mission.
SUBTTL Warp Distances
;WF.DIS and WF.ENE - distances and energy used when moving at
;standard warp factors.
WF.DIS: DEC 1 ;Warp 0
DEC 2 ;Warp 1
DEC 4 ;Warp 2
DEC 8 ;Warp 3
DEC 16 ;Warp 4
DEC 32 ;Warp 5
DEC 64 ;Warp 6
DEC 128 ;Warp 7
DEC 256 ;Warp 8
DEC 512 ;Warp 9
WF.ENE: DEC 1 ;Warp 0
DEC 4 ;Warp 1
DEC 16 ;Warp 2
DEC 64 ;Warp 3
DEC 256 ;Warp 4
DEC 1024 ;Warp 5
DEC 4096 ;Warp 6
DEC 16384 ;Warp 7
DEC 65536 ;Warp 8
DEC 262144 ;Warp 9
SUBTTL Universal Table Initial Values
;Universal table initial values, loaded at startup
;
; U.TAB bit assignments and values:
;18 0 0 (positive), object is active.
; 1 (negative), object is inactive or destroyed.
;19 1 0 - ship is not occupied (not under human control).
; 1 - ship is under human control.
; 2-7 not used.
;26 8 enemy detected.
; 0 - notify others.
; 1 - others have been notified.
;27 9 enemy under attack.
; 0 - notify others.
; 1 - others have been notified.
; 10-17 planets:
; 10 not used.
;29 11 defenses up (1) or down (0).
;30-32 12-14 launched interceptor bits.
;33-35 15-17 interceptor in base bits.
; interceptors:
;28-31 10-13 count-down field, fire if zero.
;32-35 14-17 index to a.fact and b.fact, offset values for motion.
; 18-25 library mask, 1 bit per ship. if mask bit is set, object
; is in that ships library.
; 26-28 not used.
; 29-31 alliance:
; 29 neutral.
; 30 klingon.
; 31 federation.
; 32-35 object id (uid).
; 0 - not used.
; 1 - star.
; 2 - planet.
; 3 - federation base.
; 4 - klingon base.
; 5 - federation ship.
; 6 - klingon ship.
; 7 - interceptor.
UI.T0: BYTE (1)0(17)0(8)0(3)0(3)0(4)0 ;Romulan
UI.T1: BYTE (1)0(17)0(8)0(3)0(3)4(4)1 ;Star
UI.T2: BYTE (1)0(17)107(8)0(3)0(3)4(4)2 ;Planet
UI.T3: BYTE (1)0(17)0(8)125(3)0(3)1(4)3 ;Federation base
UI.T4: BYTE (1)0(17)0(8)252(3)0(3)2(4)4 ;Klingon base
UI.T5: BYTE (1)0(17)0(8)125(3)0(3)1(4)5 ;Federation ship
UI.T6: BYTE (1)0(17)0(8)252(3)0(3)2(4)6 ;Klingon ship
UI.T7: BYTE (1)1(17)0(8)0(3)0(3)4(4)7 ;Interceptor
UI.E0: DEC 3000000 ;Ship energy starting values
UI.E1: DEC 200000000
UI.E2: DEC 20000000
UI.E3: DEC 5000000
UI.E4: DEC 5000000
UI.E5: DEC 3000000
UI.E6: DEC 3000000
UI.E7: DEC 0
UI.S0: DEC 2000000 ;Shield energy starting values
UI.S1: DEC 200000000 ;Starbase
UI.S2: DEC 20000000
UI.S3: DEC 5000000 ;Ship
UI.S4: DEC 5000000
UI.S5: DEC 2000000
UI.S6: DEC 2000000
UI.S7: DEC 499000 ;Interceptor
SHREND::DEPHASE ;End of shareable data base
SUBTTL Ship Object Tables
;Ship object tables
;
; object information from the perspective of the ship
O.RELX: BLOCK 220 ;Object X,Y,Z coordinates relative to
O.RELY: BLOCK 220 ;the ship (floating point)
O.RELZ: BLOCK 220
O.ELEV: BLOCK 220 ;Object elevation, bearing, and range
O.BEAR: BLOCK 220 ;(B,E are tangents; R is floating point)
O.RANG: BLOCK 220
S.UOT: BLOCK 1 ;UOT of the ship (same as SUOT accumulator)
S.MASK: BLOCK 1 ;A work mask
S.MUID: BLOCK 1 ;A work universal ID
S.WARP: DEC 7 ;Current warp factor
S.11: 1.0 ;3x3 matrix for vector calculations
S.12: 0.0
S.13: 0.0
S.21: 0.0
S.22: 1.0
S.23: 0.0
S.31: 0.0
S.32: 0.0
S.33: 1.0
A.11: 1.0 ;3x3 work matrix
A.12: 0.0
A.13: 0.0
A.21: 0.0
A.22: 1.0
A.23: 0.0
A.31: 0.0
A.32: 0.0
A.33: 1.0
;WF.TAB - this ship's warp factor distances (changeable by player).
WF.TAB: DEC 1,2,4,8,16,32,64,128,256,512
;Table of ranges used by unmanned ships.
N.RANG: BLOCK 120
;a list of nearest objects of a class and their ranges, used by
;unmanned ships.
N.NUOT: BLOCK 10
NUPL.N=N.NUOT ;Nearest neutral planet.
NUPL.U=N.NUOT+1 ;Nearest friendly planet.
NUPL.T=N.NUOT+2 ;Nearest enemy planet.
NUSB.U=N.NUOT+3 ;Nearest friendly base.
NUSB.T=N.NUOT+4 ;Nearest enemy base.
NUSH.U=N.NUOT+5 ;Nearest friendly ship.
NUSH.T=N.NUOT+6 ;Nearest enemy ship.
NUIN.A=N.NUOT+7 ;Nearest interceptor, any side.
N.NRAN: BLOCK 10
NRPL.N=N.NRAN ;Nearest neutral planet.
NRPL.U=N.NRAN+1 ;Nearest friendly planet.
NRPL.T=N.NRAN+2 ;Nearest enemy planet.
NRSB.U=N.NRAN+3 ;Nearest friendly base.
NRSB.T=N.NRAN+4 ;Nearest enemy base.
NRSH.U=N.NRAN+5 ;Nearest friendly ship.
NRSH.T=N.NRAN+6 ;Nearest enemy ship.
NRIN.A=N.NRAN+7 ;Nearest interceptor, any side.
N.ENER: BLOCK 1 ;Total shield plus ship energy of unmanned ship
N.PCNT: BLOCK 1 ;Count of captured planets, used by unmanned ships.
N.SCNT: BLOCK 1 ;Count of near enemy ships, used by unmanned ships.
SUBTTL Quadrant Table
; Quadrant table used at startup. XYZ.I is the index. XYZ.T entries
; have a bit for X,Y,Z. If set, bit means coordinate is to be
; negated. Determines where objects will go at startup, ensures that
; objects will be evenly distributed in 8 quadrants of galaxy.
XYZ.I: 7
XYZ.T: DEC 0,1,3,2,5,4,6,7
;Target list
L.IDX: BLOCK 1
LUOT.A: EXP -1,-1,-1,-1,-1
LUOT.B: EXP -1,-1,-1,-1,-1
M.MSG: BLOCK ^D11
M.PTR: POINT 7,m.msg
M.WPTR: BLOCK 1
M.ROW: BLOCK 1
T.ROW: ^D7 ;Target ROW and COL, not necessarily within
T.COL: ^D41 ;range of the viewer or the screen.
T.VIEW: 1
T.ELEM: BLOCK 1
T.UOT: -1 ;If not < 0, indicates target is locked on
;object T.UOT
T.BEAR: BLOCK 1 ;To confuse things, target B,E is kept in
T.ELEV: BLOCK 1 ;degrees, not as tangents (floating point)
T.RMAX: BLOCK 1 ;Some MIN and MAX values used when determining
T.RMIN: BLOCK 1 ;whether an object is pointed to by the target.
T.CMAX: BLOCK 1
T.CMIN: BLOCK 1
A.FACT: 128.0 ;Each of a planet's 3 interceptors rotates
118.2565802 ;around the planet at a fixed distance of
90.50966802 ;128 units. Rotation is in one of the planet's
48.98347936 ;3 primary planes. A.FACT and B.FACT are
0.0 ;used to compute the interceptor's next
-48.98347936 ;position, in absolute coordinates, relative
-90.50966802 ;to the absolute coordinates of the planet.
-118.2565802
-128.0 ;It keeps the program from having to do a lot
-118.2565802 ;of accumulator-destroying trig.
-90.50966802
-48.98347936 ;A.FACT = 128 * COS ang
0.0 ;B.FACT = 128 * SIN ang
48.98347936
90.50966802 ;Where ang varies from 0 to 360 in
118.2565802 ;22.5 degree increments
B.FACT: 0.0
48.98347936
90.50966802
118.2565802
128.0
118.2565802
90.50966802
48.98347936
0.0
-48.98347936
-90.50966802
-118.2565802
-128.0
-118.2565802
-90.50966802
-48.98347936
SUBTTL Command Storage
C.INTE: BLOCK 1 ;Integer returned by VTGET
C.CHAR: BLOCK 1 ;Character returned by VTGET
C.CMD: BLOCK 1 ;Command number returned by VTCMD
C.DIR: BLOCK 1 ;Direction returned by VTCMD
C.NBR1: BLOCK 1 ;1st number returned by VTCMD
C.NBR2: BLOCK 1 ;2nd number returned by VTCMD
C.CNT: BLOCK 1 ;Count of numbers entered
C.IMM: BLOCK 1 ;Immediate execute flag
C.TAB: XWD 0," " ;Command abbreviations
XWD 0,"SP" ;1 special
XWD 0,"LO" ;2 lock target
XWD 0,"RE" ;3 refuel and reload
XWD 0,"SH" ;4 shields
XWD 0,"TA" ;5 target
XWD 0,"PH" ;6 phaser
XWD 0,"TO" ;7 photon torpedo
XWD 8,"MO" ;8 move
XWD 0,"RO" ;9 rotate
XWD 0,"WR" ;10 warp
XWD 0,"LI" ;11 display target list
XWD 0,"CA" ;12 capture planet
XWD 0,"TR" ;13 transfer energy
XWD 0,"BA" ;14 display all bases
XWD 0,"BN" ;15 display nearest base
XWD 0,"AL" ;16 list all objects
XWD 0,"FE" ;17 list federation objects
XWD 0,"KL" ;18 list klingon objects
XWD 0,"PL" ;19 list planetary objects
XWD 0,"SE" ;20 send a message
XWD 0,"NE" ;21 get the news (a HELP feature)
XWD 0,"US" ;22 list users
XWD 0,"HE" ;23 help
XWD 0,"H " ;24 help synonym
XWD 0,"X " ;25 exit program
XWD 0,"Q " ;26 quit (exit synonym)
XWD 0,"R " ;27 refresh screen
XWD 0,"RT" ;28 refresh with VT100 self-test
XWD 0,"RF" ;29 rapid fire mode on/off
XWD 0,"ST" ;30 display active status
XWD 0,"AS" ;31 request assistance
XWD 0,"RA" ;32 red alert
XWD 0,"YA" ;33 yellow alert
XWD 0,"SA" ;34 secure from alert
XWD 0,"FB" ;35 list fed bases
XWD 0,"FP" ;36 list fed planets
XWD 0,"FS" ;37 list fed ships
XWD 0,"KB" ;38 list kli bases
XWD 0,"KP" ;39 list kli planets
XWD 0,"KS" ;40 list kli ships
XWD 0,"NP" ;41 list neutral planets
XWD 0,"PN" ;42 list neutral planets (synonym)
XWD 0,"S " ;43 display/suppress stars
C.SIZE=.-C.TAB ;Size of command abbr table
DPPTR: BLOCK 1 ;Permanent pointer
DWPTR: BLOCK 1 ;Working pointer
DPTRA: BLOCK 1
DPTRB: BLOCK 1
DCOL: BLOCK 1
UTXT.A: BLOCK 4*13
UTXT.B: BLOCK 4*13
;Arrow key table
D.TAB: ASCIZ " "
ASCIZ " UP"
ASCIZ " DN"
ASCIZ " RI"
ASCIZ " LF"
ASCIZ " FED"
ASCIZ " KLI"
ASCIZ " ALL"
ASCIZ " ALL"
ASCIZ " FW"
ASCIZ " BK"
ASCIZ " RI"
ASCIZ " LF"
W.ROW: BLOCK 1
W.COL: BLOCK 1
W.ID: BLOCK 1
W.UOT: BLOCK 1
W.BEAR: BLOCK 1
W.ELEV: BLOCK 1
W.RANG: BLOCK 1
SUBTTL Scanner Tables
;Scanner tables
;
; SCAN.1 and SCAN.2 contain data on objects that are visible in the
; viewer.
;
; SCAN.1:
; bit 0-8 object nbr (index to universal tables)
; bit 9-17 object id (1 thru 7)
; bit 18-26 viewer column
; bit 27-35 viewer row
; SCAN.2:
; range (converted to integer)
;
; the scan tables are in ascending sequence by row, descending
; sequence by range within row.
SCAN.1: BLOCK ^D145
SCAN.2: BLOCK ^D145
S.MAX: BLOCK 1
S.STAR: BLOCK 1
V.POS: BLOCK 1
V.COL: BLOCK 1
V.ROW: BLOCK 1
V.FLAG: BLOCK 1
V.RSET: BLOCK 1
V.MOD: BLOCK 1
V.GRA: ASCIZ "
(0" ;Escape sequence to enter graphics mode
V.ASC: ASCIZ "
(B" ;Escape sequence to get back to ASCII mode
SUBTTL Viewer Tables
;Viewer tables
;
; viewer area 'bit maps'.
;
; V.WRK: work area for one viewer row
; V.TAB: complete viewer area (all rows)
;
; Viewer tables are in '6-bit'; the low 5 bits correspond to an
; entry in the viewer element table; the high bit indicates the
; location is the target if 1, not the target if 0
V.WRK: BLOCK ^D14
V.TAB: BLOCK ^D173
V.WRKP: POINT 6,v.wrk
V.TABP: POINT 6,v.tab
V.WPTR: POINT 6,v.wrk
V.TPTR: POINT 6,v.tab
;viewer object table
;
; list of displayable objects at 8 ranges
;
; 1st 6 bytes are element nrs (from v.elem); 00 implies end of elements.
; 7th byte is offset from center of object; 7 implies no display.
V.OBJ: BYTE (5)17,22,12,22,17,00(6)2 ;Range 0 - rom ship
BYTE (5)34,00,00,00,00,00(6)0 ; star
BYTE (5)13,15,14,00,00,00(6)1 ; planet
BYTE (5)20,12,20,12,20,00(6)2 ; fed base
BYTE (5)11,12,11,12,11,00(6)2 ; kli base
BYTE (5)16,21,27,21,16,00(6)2 ; fed ship
BYTE (5)36,30,10,30,36,00(6)2 ; kli ship
BYTE (5)24,17,25,00,00,00(6)1 ; interceptor
BYTE (5)23,12,23,00,00,00(6)1 ;Range 1 - rom ship
BYTE (5)34,00,00,00,00,00(6)0 ; star
BYTE (5)13,15,14,00,00,00(6)1 ; planet
BYTE (5)20,12,20,12,20,00(6)2 ; fed base
BYTE (5)11,12,11,12,11,00(6)2 ; kli base
BYTE (5)22,26,22,00,00,00(6)1 ; fed ship
BYTE (5)23,36,23,00,00,00(6)1 ; kli ship
BYTE (5)32,00,00,00,00,00(6)0 ; interceptor
BYTE (5)04,00,00,00,00,00(6)0 ;Range 2 - rom ship
BYTE (5)05,00,00,00,00,00(6)0 ; star
BYTE (5)33,00,00,00,00,00(6)0 ; planet
BYTE (5)17,17,17,00,00,00(6)1 ; fed base
BYTE (5)12,12,12,00,00,00(6)1 ; kli base
BYTE (5)04,00,00,00,00,00(6)0 ; fed ship
BYTE (5)37,00,00,00,00,00(6)0 ; kli ship
BYTE (5)31,00,00,00,00,00(6)0 ; interceptor
BYTE (5)01,00,00,00,00,00(6)0 ;Range 3 - rom ship
BYTE (5)06,00,00,00,00,00(6)0 ; star
BYTE (5)36,00,00,00,00,00(6)0 ; planet
BYTE (5)07,00,00,00,00,00(6)0 ; fed base
BYTE (5)07,00,00,00,00,00(6)0 ; kli base
BYTE (5)01,00,00,00,00,00(6)0 ; fed ship
BYTE (5)01,00,00,00,00,00(6)0 ; kli ship
BYTE (5)02,00,00,00,00,00(6)0 ; interceptor
BYTE (5)02,00,00,00,00,00(6)0 ;Range 4 - rom ship
BYTE (5)35,00,00,00,00,00(6)0 ; star
BYTE (5)03,00,00,00,00,00(6)0 ; planet
BYTE (5)01,00,00,00,00,00(6)0 ; fed base
BYTE (5)01,00,00,00,00,00(6)0 ; kli base
BYTE (5)02,00,00,00,00,00(6)0 ; fed ship
BYTE (5)02,00,00,00,00,00(6)0 ; kli ship
BYTE (5)00,00,00,00,00,00(6)7 ; interceptor
BYTE (5)00,00,00,00,00,00(6)7 ;Range 5 - rom ship
BYTE (5)03,00,00,00,00,00(6)0 ; star
BYTE (5)01,00,00,00,00,00(6)0 ; planet
BYTE (5)02,00,00,00,00,00(6)0 ; fed base
BYTE (5)02,00,00,00,00,00(6)0 ; kli base
BYTE (5)00,00,00,00,00,00(6)7 ; fed ship
BYTE (5)00,00,00,00,00,00(6)7 ; kli ship
BYTE (5)00,00,00,00,00,00(6)7 ; interceptor
BYTE (5)00,00,00,00,00,00(6)7 ;Range 6 - rom ship
BYTE (5)01,00,00,00,00,00(6)0 ; star
BYTE (5)02,00,00,00,00,00(6)0 ; planet
BYTE (5)00,00,00,00,00,00(6)7 ; fed base
BYTE (5)00,00,00,00,00,00(6)7 ; kli base
BYTE (5)00,00,00,00,00,00(6)7 ; fed ship
BYTE (5)00,00,00,00,00,00(6)7 ; kli ship
BYTE (5)00,00,00,00,00,00(6)7 ; interceptor
BYTE (5)00,00,00,00,00,00(6)7 ;Range 7 - rom ship
BYTE (5)02,00,00,00,00,00(6)0 ; star
BYTE (5)00,00,00,00,00,00(6)7 ; planet
BYTE (5)00,00,00,00,00,00(6)7 ; fed base
BYTE (5)00,00,00,00,00,00(6)7 ; kli base
BYTE (5)00,00,00,00,00,00(6)7 ; fed ship
BYTE (5)00,00,00,00,00,00(6)7 ; kli ship
BYTE (5)00,00,00,00,00,00(6)7 ; interceptor
V.ELEM: XWD 0,"0 " ;Viewer element table
XWD 1,"1~" ;
XWD 1,"0~" ;a list of all characters that can be displayed
XWD 1,"0." ;in the viewer area
XWD 22,"0-" ;
XWD 1,"1*" ;left half: 1st digit is color, 2nd is mode
XWD 1,"0*" ; 0 - can be displayed in any mode
XWD 52,"0-" ; 1 - requires graphics mode
XWD 60,"00" ; 2 - requires ASCII mode
XWD 51,"08" ;
XWD 51,"0=" ;right half - 1st character:
XWD 41,"0(" ; 0 - normal intensity
XWD 41,"0)" ; 1 - bold (increased) intensity
XWD 41,"0@" ;
XWD 21,"0f" ;right half - 2nd character:
XWD 52,"0o" ; character to be displayed
XWD 52,"0O"
XWD 21,"0p"
XWD 21,"0q"
XWD 61,"0r"
XWD 51,"0t"
XWD 51,"0u"
XWD 22,"0v"
XWD 20,"0V"
XWD 61,"0q"
XWD 51,"0-"
XWD 51,"0H"
XWD 41,"0O"
XWD 31,"1*"
XWD 1,"0+"
XWD 62,"0o"
XWD 62,"0-"
;Color sequences for GIGIs
V.COLR: BLOCK 1
V.RED: [ASCIZ "
[31m"]
V.GRN: [ASCIZ "
[32m"]
V.YEL: [ASCIZ "
[33m"]
V.BLU: [ASCIZ "
[34m"]
V.MAG: [ASCIZ "
[35m"]
V.CYN: [ASCIZ "
[36m"]
V.WHT: [ASCIZ "
[37m"]
;For VT241s
SETPHA: ;Phaser setup is the same as...
SET241: [ASCIZ /
PpS(M0(AD)1(AC)2(AW)3(AY))
\/] ;...initial setup
SETTOR: [ASCIZ /
PpS(M0(AD)1(AC)2(AW)3(AR))
\/] ;When torps are fired
HIT241: [ASCIZ /
PpS(M0(AW)1(AR)2(AD)3(AM))
\/] ;Reverse when we are hit
;Substitute table for VT241 into GIGI table
T241.R: [ASCIZ /
PpW(I(R))
\/]
T241.G: [ASCIZ /
PpW(I(G))
\/]
T241.Y: [ASCIZ /
PpW(I(Y))
\/]
T241.B: [ASCIZ /
PpW(I(B))
\/]
T241.M: [ASCIZ /
PpW(I(M))
\/]
T241.C: [ASCIZ /
PpW(I(C))
\/]
T241.W: [ASCIZ /
PpW(I(W))
\/]
SUBTTL Object Names
;List of specific object names
O.NAME: EXP NM00,NM01,NM02,NM03,NM04,NM05,NM06,NM07
EXP NM10,NM11,NM12,NM13,NM14,NM15,NM16,NM17
EXP NM20,0,0,0,NM21,0,0,0,NM22,0,0,0,NM23,0,0,0
EXP NM24,0,0,0,NM25,0,0,0,NM26,0,0,0,NM27,0,0,0
EXP NM30,0,0,0,NM31,0,0,0,NM32,0,0,0,NM33,0,0,0
EXP NM34,0,0,0,NM35,0,0,0,NM36,0,0,0,NM37
NM00: ASCIZ "ENTERPRISE"
NM01: ASCIZ "COBRA"
NM02: ASCIZ "INTREPID"
NM03: ASCIZ "HAWK"
NM04: ASCIZ "LEXINGTON"
NM05: ASCIZ "PYTHON"
NM06: ASCIZ "VALIANT"
NM07: ASCIZ "RAVEN"
NM10: ASCIZ "17"
NM11: ASCIZ "21"
NM12: ASCIZ "18"
NM13: ASCIZ "22"
NM14: ASCIZ "19"
NM15: ASCIZ "23"
NM16: ASCIZ "20"
NM17: ASCIZ "24"
NM20: ASCIZ "ALPHA 1"
NM21: ASCIZ "BETA 2"
NM22: ASCIZ "GAMMA 3"
NM23: ASCIZ "DELTA 4"
NM24: ASCIZ "EPSILON 5"
NM25: ASCIZ "ZETA 6"
NM26: ASCIZ "RIGEL 7"
NM27: ASCIZ "THETA 8"
NM30: ASCIZ "IOTA 9"
NM31: ASCIZ "KAPPA 10"
NM32: ASCIZ "LAMBDA 11"
NM33: ASCIZ "OMICRON 12"
NM34: ASCIZ "SIGMA 13"
NM35: ASCIZ "TAU 14"
NM36: ASCIZ "UPSILON 15"
NM37: ASCIZ "OMEGA 16"
O.NBR: EXP 20,24,30,34,40,44,50,54
EXP 60,64,70,74,100,104,110,114
EXP 10,12,14,16,11,13,15,17
O.INIT: ASCIZ "E"
ASCIZ "C"
ASCIZ "I"
ASCIZ "H"
ASCIZ "L"
ASCIZ "P"
ASCIZ "V"
ASCIZ "R"
;List of generic (universal) object names
U.NAME: ASCIZ " "
ASCIZ "Star "
ASCIZ "Neu Planet "
ASCIZ "Fed Starbase "
ASCIZ "Kli Starbase "
ASCIZ "Fed Starship "
ASCIZ "Kli Cruiser "
ASCIZ "Interceptor "
P.NAME: ASCII "Neu P"
ASCII "Fed P"
ASCII "Kli P"
SU.LN1: ASCIZ " Federation
[26CKlingon Empire"
SU.LN2: ASCIZ " ----------
[26C--------------"
SPC.55: ASCIZ " "
SPC.31: ASCIZ " "
N.WRK: BLOCK 3
WTIME: BLOCK 1
T.TIME: BLOCK 1
T.MORE: BLOCK 1
T.MOR1: BLOCK 1
T.MOR2: BLOCK 1
T.MOR3: BLOCK 1
T.MOR4: BLOCK 1
ROW.1: BLOCK 1
ROW.2: BLOCK 1
SUBTTL PSI Tables
;PSI interrupt blocks
LEVTAB: LEV1PC ;Level 1 entry
LEV2PC ;Level 2 entry
LEV3PC ;Level 3 entry
LEV1PC: BLOCK 1 ;Level 1 PC goes here
LEV2PC: BLOCK 1 ;Level 2 PC goes here
LEV3PC: BLOCK 1 ;Level 3 PC goes here
CHNTAB: 0 ;(0)
1,,ICTRAP ;(1) Ctrl-C
2,,ITYPIN ;(2) typein
REPEAT ^D33,<0> ;Unused channels
SUBTTL Weapon Flash Sequences
FLSH.C: BLOCK 1
FLSH.P: BLOCK 1
FLSH.T: BLOCK 60
FLSH01: BYTE (2)0(16)1(18)1
BLOCK 1
FLSH03: BYTE (2)0(16)2(18)3
BLOCK 1
FLSH05: BYTE (2)1(16)1(18)1
BYTE (2)2(16)2(18)1
BYTE (2)2(16)0(18)1
BYTE (2)1(16)1(18)2
BLOCK 1
FLSH11: BYTE (2)1(16)2(18)2
BYTE (2)2(16)3(18)2
BYTE (2)2(16)1(18)3
BYTE (2)1(16)1(18)2
BYTE (2)1(16)2(18)1
BLOCK 1
FLSH16: BYTE (2)1(16)3(18)3
BYTE (2)2(16)4(18)3
BYTE (2)2(16)2(18)5
BYTE (2)1(16)2(18)3
BYTE (2)1(16)3(18)2
BLOCK 1
FLSH24: BYTE (2)1(16)2(18)2
BYTE (2)1(16)4(18)3
BYTE (2)2(16)4(18)3
BYTE (2)2(16)4(18)5
BYTE (2)2(16)4(18)6
BYTE (2)2(16)5(18)7
BYTE (2)1(16)2(18)3
BYTE (2)1(16)4(18)5
BYTE (2)1(16)5(18)4
BYTE (2)1(16)5(18)4
BLOCK 1
FLSHGI: BYTE (2)0(16)3(18)5
BLOCK 1
IO.PTR: BLOCK 1
IO.CNT: BLOCK 1
IO.BLK: BLOCK 13
BLOCK 1
;TTY characteristics
SBAUDR==^D1200 ;Baud rate below which we allow
; the "S " command to work.
TOTSP: BLOCK 1
MPPTR: BLOCK 1
MWPTR: BLOCK 1
MPTRA: BLOCK 1
MPTRB: BLOCK 1
MCOL: BLOCK 1
MTXT.A: BLOCK 13
MTXT.B: BLOCK 13
SUBTTL Macro Definitions
; TYPE types an ASCII string without a CRLF.
; TYPEC types an ASCII string followed by a CRLF.
; CRLF types a CRLF.
; .TTSTR builds an ASCII string without a CRLF.
; .TTSTC builds an ASCII string followed by a CRLF.
DEFINE TYPE (STRING)<
OUTSTR [ASCIZ $'STRING'$]
>
DEFINE TYPEC (STRING)<
OUTSTR [ASCIZ $'STRING'
$]>
DEFINE CRLF <
OUTSTR [ASCIZ $
$]>
DEFINE .TTSTR (STRING)<
[ASCIZ $'STRING'$]
>
DEFINE .TTSTC (STRING)<
[ASCIZ $'STRING'
$]>
; DSPTYP types an ASCII string in the display area.
; MSPTYP types an ASCII string on the message line.
DEFINE DSPTYP (STRING)<
DSPSTR [ASCIZ $'STRING'$]
>
DEFINE MSPTYP (STRING)<
MSPSTR [ASCIZ $'STRING'$]
>
; MORDSP causes the MOR key to flash.
; MORCLR returns the MOR key to its normal state.
DEFINE MORDSP <
CALL MORFLS
>
DEFINE MORCLR <
CALL MORSTP
>
;GETIME gets the time (ms) and compares it to the last time retrieved.
; If not greater, assume new day and subtract 24 hours.
DEFINE GETIME (ac)<
IFN AC-T1,<EXCH AC,T1> ;If not T1, then preserve
SAVE T2
TIME%
MOVEM T1,U.TIME(SUOT)
REST T2
IFN AC-T1,<EXCH T1,AC>
>
; SAVE saves up to 10 registers.
; REST restores registers saved by SAVE.
DEFINE SAVE (D0,D1,D2,D3,D4,D5,D6,D7,D8,D9)<
IFN D0,<PUSH P,D0>
IFN D1,<PUSH P,D1>
IFN D2,<PUSH P,D2>
IFN D3,<PUSH P,D3>
IFN D4,<PUSH P,D4>
IFN D5,<PUSH P,D5>
IFN D6,<PUSH P,D6>
IFN D7,<PUSH P,D7>
IFN D8,<PUSH P,D8>
IFN D9,<PUSH P,D9>
>
DEFINE REST (D0,D1,D2,D3,D4,D5,D6,D7,D8,D9)<
IFN D9,<POP P,D9>
IFN D8,<POP P,D8>
IFN D7,<POP P,D7>
IFN D6,<POP P,D6>
IFN D5,<POP P,D5>
IFN D4,<POP P,D4>
IFN D3,<POP P,D3>
IFN D2,<POP P,D2>
IFN D1,<POP P,D1>
IFN D0,<POP P,D0>
>
SUBTTL UUO Definitions
; Displays in the 4-line display area and on the message line are
; performed using local UUOs. The DSP UUOs display in the display
; area. The MSP UUOs display on the message line.
LOC 41 ;Must be at this location
CALL UUOSER ;UUO service routine
RELOC
OPDEF DSPINI [1B8]
OPDEF DSPCHR [2B8]
OPDEF DSPSTR [3B8]
OPDEF DSPPOS [4B8]
OPDEF DSPOUT [5B8]
OPDEF DSPCLR [6B8]
OPDEF DSPIMM [7B8]
OPDEF MSPINI [10B8]
OPDEF MSPCHR [11B8]
OPDEF MSPSTR [12B8]
OPDEF MSPPOS [13B8]
OPDEF MSPOUT [14B8]
OPDEF MSPCLR [15B8]
OPDEF MSPIMM [16B8]
OPDEF INCHRW [35B8]
OPDEF OUTCHR [36B8]
OPDEF OUTSTR [37B8]
SUBTTL Macro & UUO Handling Routines
;MORFLS - Cause MOR key to flash
MORFLS: OUTSTR [ASCIZ /
[m/]
SKIPE .TTTYP ;Skip if VT100
OUTSTR @V.YEL ;Yellow
OUTSTR [ASCIZ /
[5;7m
[22;72HMOR
8/] ;Show the key
OUTSTR [ASCIZ /
[m/] ;Normal cursor again
RET
;MORSTP - Undoes the flashing MOR key
MORSTP: OUTSTR [ASCIZ /
[m/]
SKIPE .TTTYP ;If GIGI
OUTSTR @V.GRN ;Then make it normal color (green)
OUTSTR [ASCIZ /
[22;72HMOR
8/] ;Show the key
OUTSTR [ASCIZ /
[m/] ;Cursor not graphics no more
RET
;UUO service
UUOSER: SAVE AP ;Save stack pointer
LDB AP,[POINT 9,.JBUUO,8] ;Get us an op code
JUMPE AP,UUOERR ;If 0, then we have a problem
CALL @UUOTAB-1(AP) ;Dispatch to correct UUO
REST AP ;Restore stack
RET ;And done
UUOERR: EXCH AP,T1
HRROI T1,[ASCIZ /
?Illegal LUUO
/]
PSOUT%
EXCH T1,AP
HALTF%
JRST .-1 ;No continue
SUBTTL UUO Dispatch
UUOTAB: %DSINI
%DSCHR
%DSSTR
%DSPOS
%DSOUT
%DSCLR
%DSIMM
%MSINI
%MSCHR
%MSSTR
%MSPOS
%MSOUT
%MSCLR
%MSIMM
REPEAT <37-<.-UUOTAB>>,<UUOERR>
RELOC UUOTAB+34
.SICHW
.SOCHR
.SOSTR
SUBTTL UUO Supporting Routines
%DSINI: PUSH P,T1 ;Save T1
HRRZ AP,.JBUUO ;Get effective address
MOVE T1,[ASCII / /] ;Get a string
SKIPE AP ;Was there an effective address?
IFSKP. ;If not,
MOVEM T1,UTXT.B ;Save the string we had
MOVE T1,[XWD UTXT.B,UTXT.B+1] ;Clear this out
BLT T1,UTXT.B+53 ;Do it
JRST %DSI.1 ;And done
ENDIF.
SOSE AP
IMULI AP,13
MOVEM T1,UTXT.B(AP)
HRRI T1,UTXT.B+1(AP)
HRLI T1,UTXT.B(AP)
BLT T1,UTXT.B+12(AP)
%DSI.1: MOVE T1,[POINT 7,UTXT.B]
ADD T1,AP
MOVEM T1,.DPPTR
MOVEM T1,.DWPTR
POP P,T1
RET
%DSCHR: HRRZ AP,.JBUUO
MOVE AP,(AP)
IDPB AP,.DWPTR
RET
%DSIMM: HRRZ AP,.JBUUO
MOVE AP,(AP)
OUTCHR AP
IDPB AP,.DWPTR
PUSH P,T1
MOVE T1,.DWPTR
SUBI T1,54
DPB AP,T1
POP P,T1
RET
%DSSTR: PUSH P,T1
HRRZ AP,.JBUUO
MOVE T1,[POINT 7,0]
ADD T1,AP
%DSS.1: ILDB AP,T1
JUMPE AP,%DSS.2
IDPB AP,.DWPTR
JRST %DSS.1
%DSS.2: POP P,T1
RET
%DSPOS: HRRZ AP,.JBUUO
SOJ AP,
ADJBP AP,.DPPTR
MOVEM AP,.DWPTR
RET
%DSOUT: PUSH P,T1 ;Save some destuctos
PUSH P,T2
PUSH P,T3
PUSH P,T4
PUSH P,ROW
PUSH P,COL
HRRZ AP,.JBUUO ;Get effective address
SKIPE .TTTYP ;If GIGI,
OUTSTR @V.CYN ;then do a color
SKIPE AP ;Effective address?
IFSKP. ;If not
MOVEI AP,1
CALL %DSO.1
MOVEI AP,2
SKIPE .TTTYP
OUTSTR @V.CYN
CALL %DSO.1
MOVEI AP,3
SKIPE .TTTYP
OUTSTR @V.CYN
CALL %DSO.1
MOVEI AP,4
SKIPE .TTTYP
OUTSTR @V.CYN
CALL %DSO.1
JRST DSOUT1
ENDIF.
CALL %DSO.1
DSOUT1: OUTSTR [ASCIZ/
[m/]
POP P,COL ;Restore ACs
POP P,ROW
POP P,T4
POP P,T3
POP P,T2
POP P,T1
RET
%DSO.1: MOVE ROW,AP
ADDI ROW,^D17
SOSE AP
IMULI AP,13
MOVE T1,[POINT 7,UTXT.A]
ADD T1,AP
MOVEM T1,.DPTRA
MOVE T1,[POINT 7,UTXT.B]
ADD T1,AP
MOVEM T1,.DPTRB
MOVEI COL,6
SETZM .DCOL
%DSO.2: ILDB T1,.DPTRA
ILDB T2,.DPTRB
CAME T1,T2
CALL %DSO.3
CAIGE COL,^D59
AOJA COL,%DSO.2
SKIPE .DCOL
OUTSTR [ASCIZ/
8/]
RET
%DSO.3: SKIPG .DCOL
JRST %DSO.4
CAMG COL,.DCOL
JRST %DSO.4
MOVE T3,COL
SUB T3,.DCOL
SOJE T3,%DSO.5
OUTSTR [ASCIZ/
[/]
CAIE T3,1
CALL %DSO.6
OUTSTR [ASCIZ/C/]
JRST %DSO.5
%DSO.4: OUTSTR [ASCIZ/
[/]
MOVE T3,ROW
CALL %DSO.6
OUTSTR [ASCIZ/;/]
MOVE T3,COL
CALL %DSO.6
OUTSTR [ASCIZ/H/]
%DSO.5: OUTCHR T2
DPB T2,.DPTRA
MOVEM COL,.DCOL
RET
%DSO.6: IDIVI T3,^D10
TRO T3,"0"
TRO T4,"0"
CAIE T3,"0"
OUTCHR T3
OUTCHR T4
RET
%DSCLR: MOVE AP,[ASCII / /]
MOVEM AP,UTXT.A
MOVE AP,[XWD UTXT.A,UTXT.A+1]
BLT AP,UTXT.A+127
RET
%MSINI: PUSH P,T1
MOVE T1,[ASCII / /]
MOVEM T1,MTXT.B
MOVE T1,[XWD MTXT.B,MTXT.B+1]
BLT T1,MTXT.B+12
%MSI.1: MOVE T1,[POINT 7,MTXT.B]
MOVEM T1,.MPPTR
MOVEM T1,.MWPTR
POP P,T1
RET
%MSCHR: HRRZ AP,.JBUUO
MOVE AP,(AP)
IDPB AP,.MWPTR
RET
%MSIMM: HRRZ AP,.JBUUO
MOVE AP,(AP)
OUTCHR AP
IDPB AP,.MWPTR
PUSH P,T1
MOVE T1,.MWPTR
SUBI T1,54
DPB AP,T1
POP P,T1
RET
%MSSTR: PUSH P,T1
HRRZ AP,.JBUUO
MOVE T1,[POINT 7,0]
ADD T1,AP
%MSS.1: ILDB AP,T1
JUMPE AP,%MSS.2
IDPB AP,.MWPTR
JRST %MSS.1
%MSS.2: POP P,T1
RET
%MSPOS: HRRZ AP,.JBUUO
SOJ AP,
ADJBP AP,.MPPTR
MOVEM AP,.MWPTR
RET
%MSOUT: PUSH P,T1
PUSH P,T2
PUSH P,T3
PUSH P,T4
PUSH P,ROW
PUSH P,COL
CALL %MSO.1
POP P,COL
POP P,ROW
POP P,T4
POP P,T3
POP P,T2
POP P,T1
RET
%MSO.1: MOVE T1,[POINT 7,MTXT.A]
MOVEM T1,.MPTRA
MOVE T1,[POINT 7,MTXT.B]
MOVEM T1,.MPTRB
MOVEI COL,6
SETZM .MCOL
%MSO.2: ILDB T1,.MPTRA
ILDB T2,.MPTRB
CAME T1,T2
CALL %MSO.3
CAIGE COL,^D59
AOJA COL,%MSO.2
SKIPE .MCOL
OUTSTR [ASCIZ/
[m/] ;Reset cursor attributes
OUTSTR [ASCIZ/
8/]
RET
%MSO.3: SKIPG .MCOL
JRST %MSO.4
CAMG COL,.MCOL
JRST %MSO.4
MOVE T3,COL
SUB T3,.MCOL
SOJE T3,%MSO.5
OUTSTR [ASCIZ/
[/]
CAIE T3,1
CALL %MSO.6
OUTSTR [ASCIZ/C/]
JRST %MSO.5
%MSO.4: OUTSTR [ASCIZ/
[;7m/]
SKIPN .TTTYP ;Are we a GIGI?
IFSKP.
TRNE SUOT,1B35
OUTSTR @V.CYN
TRNN SUOT,1B35
OUTSTR @V.GRN
OUTSTR [ASCIZ/
[24;/]
ENDIF.
SKIPN .TTTYP
OUTSTR [ASCIZ/
[23;/]
MOVE T3,COL
CALL %MSO.6
OUTSTR [ASCIZ/H/]
%MSO.5: OUTCHR T2
DPB T2,.MPTRA
MOVEM COL,.MCOL
RET
%MSO.6: IDIVI T3,^D10
TRO T3,"0"
TRO T4,"0"
CAIE T3,"0"
OUTCHR T3
OUTCHR T4
RET
%MSCLR: MOVE AP,[ASCII / /]
MOVEM AP,MTXT.A
MOVE AP,[XWD MTXT.A,MTXT.A+1]
BLT AP,MTXT.A+25
RET
SICHW: SAVE T1
PBIN%
HRRZ AP,.JBUUO
CAIN AP,T1
MOVEI AP,0(P)
CAIN AP,AP
MOVEI AP,-2(P)
MOVEM T1,(AP)
REST T1
RET
SOSTR: SAVE T1
HRRZ T1,.JBUUO
CAIN T1,T1
MOVEI T1,0(P)
CAIN T1,AP
MOVEI T1,-2(P)
TLO T1,-1
PSOUT%
REST T1
RET
SOCHR: POP P,(P) ;Prune PDL
MOVE AP,0(P) ;Restore AP
MOVEM T1,0(P) ;Save T1
MOVE T1,@.JBUUO
PBOUT%
REST T1
RET ;Exit from LUUO
SUBTTL Entry Vector
EV:: JRST BOOTS
JRST BOOTS
BYTE (3)TK.WHO (9)TK.VER (6)TK.MIN (18)TK.EDT
TREK:: RESET% ;Like a good program should
MOVE SP,[IOWD PDLSZ,PDL] ;Set up the stack
MOVE T1,SEGVER ;Get .SHARE version
CAME T1,EV+2 ;Same version as us?
JRST VERERR ;Nope - sorry can't play
CALL INIPSI ;Init the PSI system
CALL VTINI ;Init the terminal
SKIPE DBUGF ;If debugging
JRST TREK2 ;Then skip these tests
CALL VTEST ;Test terminal
CALL FINTTY
TREK2: CALL SETUP ;Init the galaxy
MOVEI C,CCTRAP ;Setup ^C handling
HRRM C,CHNTAB+1 ;Put this in channel table
CALL VTEST
JRST TREK1
TYPE <
[H
[J> ;Blank the screen
CALL GILOAD ;Load GIGI macrographs
CALL DSPCON ;Display the trek console
CALL ENEDSP ;Setup energy display
CALL SHLDSP ;And shield
TREK1: CALL WRPDSP ;Now for current warp factor
CALL ROTRAN
CALL OBLOAD ;Load objects in viewer
DSPCLR ;Clear viewer
MSPCLR
SETZM T.TIME
SETZM T.MORE
;..
SUBTTL Main Program Loop
;..
TRMAIN::CALL VTCMD ;See if command there
SKIPGE T1,C.IMM ;Immediate?
IFNSK. ;If so,
SKIPE T.MORE ;See if more
CALL @T.MORE ;If so, do the more command
JRST TRMAIN ;And loop back
ENDIF.
SKIPN T.MORE ;Still more?
IFSKP. ;If not,
SETZM T.MORE ;Flag no more
MORCLR ;And stop flashing
ENDIF.
MOVE AP,C.DIR ;Get command
CAIE AP,5 ;Some type of help?
IFSKP. ;If so,
CALL HELP ;Be as helpful as we can
JRST TRMAIN ;And see if anything else typed
ENDIF.
JUMPE T1,TR.CMD
TR.IMM: SKIPN T.MORE ;See if we must clear "MOR" key
IFSKP. ;If so,
SETZM T.MORE ;Unflag
MORCLR ;And do it
ENDIF.
CALL @[SRSCAN
SRSCAN
SRSCAN
SRSCAN
LRSCAN
RFPHAS
RFPHOT]-1(T1) ;Dispatch to immediate command
JRST TRMAIN ;And loop back
TR.CMD: SKIPN T.MORE ;More been flashing?
IFSKP.
SETZM T.MORE ;If so, that's enough
MORCLR ;Reset display
ENDIF.
MOVE T1,C.CMD ;Get command
JUMPE T1,TRMAIN ;If none, then go back
CALL @CMDDSP-1(T1) ;Dispatch to command
JRST TRMAIN ;Done, now loop back
SUBTTL Command Dispatch Table
CMDDSP: SPEC
TLOCK
REFUEL
SHIELD
TARGET
PHASER
PHOTON
MOTION
ROTATE
WARP
DSPLST
CAPTUR
TRNSFR
BASES
NEARB
ALIBR
FLIBR
KLIBR
PLIBR
SEND
HELP
USERS
HELP
HELP
QUIT
QUIT
RFRESH
SLFTST
RAPFIR
SCORE
ASSIST
RALERT
YALERT
SALERT
FLIBB
FLIBP
FLIBS
KLIBB
KLIBP
KLIBS
PLIBN
PLIBN
SSTARS
CMDLEN==<.-CMDDSP+1>
SUBTTL Short Range Sensor Scan
;SRSCAN
;
; Short range sensor scan. Search depends on the value of the
; immediate flag:
;
; 1 = Federation, 2 = Klingon, 3 = Planet, 4 = anything
SRSCAN::CALL LSTCLR
SKIPN T.MORE
IFSKP.
MOVE UOT,T.MOR1
MOVE AP,T.MOR2
MOVEM AP,C.IMM
MOVE AP,T.MOR3
MOVEM AP,S.MASK
SETZM T.MORE
MORCLR
JRST SR.MOR
ENDIF.
SETO UOT,
HRRZ T2,C.IMM
CAILE T2,2
JRST SR.NXT
LSH T2,4
MOVEM T2,S.MASK
SR.NXT: CALL SSCAN
JRST SR.END
CAIL LST,4
IFNSK.
MOVEM UOT,T.MOR1
MOVE AP,C.IMM
MOVEM AP,T.MOR2
MOVE AP,S.MASK
MOVEM AP,T.MOR3
MOVEI AP,SRSCAN
MOVEM AP,T.MORE
JRST SR.END
ENDIF.
SR.MOR: AOJ LST,
MOVEM UOT,LUOT.B(LST)
CALL CATALG
JRST SR.NXT
SR.END: SKIPLE LST
IFSKP.
MSPINI
MSPTYP <nothing detected by short-range sensors>
MSPOUT
RET
ENDIF.
MOVE AP,[XWD LUOT.B,LUOT.A]
BLT AP,LUOT.A+4
CALL LSTOUT
SKIPE T.MORE
MORDSP
RET
SSCAN: CALL STDSCN
RET
FIX AP,O.RANG(UOT)
CAILE AP,^D1024
JRST SSCAN
HRRZ AP,C.IMM
CAIN AP,3
JRST SS.HIT
CAIN AP,4
IFSKP.
HRRZ AP,U.TAB(UOT)
XOR AP,S.MASK
TRNE AP,3B31
JRST SSCAN
JRST SS.HIT
ENDIF.
CAIE T1,2
CAIN T1,7
SKIPA
JRST SSCAN
SS.HIT: RETSKP
SUBTTL Long Range Sensor Scan -- Check Target
LRSCAN::CALL TARSCN ;Scan the target
IFNSK. ;If no target
MSPINI
MSPTYP <nothing detected by long-range sensors>
MSPOUT
RET
ENDIF.
CALL LSTCLR
AOJ LST,
MOVEM UOT,LUOT.B(LST)
CALL CATALG
MOVE AP,[XWD LUOT.B,LUOT.A]
BLT AP,LUOT.A+4
DSPINI
CALL LSTDSP
CALL LRSHLD
DSPOUT
RET
SUBTTL Long Range Sensor Scan -- Display Target Information
LRSHLD::MOVE AP,U.TAB(UOT)
ANDI AP,17
CAIE AP,7
CAIG UOT,17
SKIPA
RET
DSPINI 2
DSPTYP < shields > ;Prefix shields
SKIPG T3,U.SHLD(UOT) ;Are they up or down?
IFSKP. ;I guess they are up
DSPTYP <UP > ;Say so
IDIVI T3,^D1000 ;Scale down for display
CALL NBROUT ;Show us shield value
RET ;And done
ENDIF.
MOVM T3,T3
DSPTYP <DN > ;Say shields are down
IDIVI T3,^D1000 ;Get a printable value
CALL NBROUT ;Show shield value
DSPTYP <, energy > ;Also display energy remaining
MOVE T3,U.ENER(UOT) ;First we get the energy
IDIVI T3,^D1000 ;Adjust it by scale
CALL NBROUT ;Now display it
RET ;And done
SUBTTL Command Support -- Special Command
SPEC:: SKIPE DBUGF ;If not debugging
IFSKP. ;then show this
DSPINI
DSPTYP <SPACE! The Final Frontier!>
DSPOUT
RET
ENDIF.
CALL LSTCLR
SKIPN T.MORE
IFSKP.
MOVE UOT,T.MOR1
MOVE AP,T.MOR2
MOVEM AP,C.NBR1
SETZM T.MORE
MORCLR
JRST SP.MOR
ENDIF.
SETO UOT,
SP.NXT: CALL GETLIB
JRST SP.END
CAIGE LST,4
IFSKP.
MOVEM UOT,T.MOR1
MOVE AP,C.NBR1
MOVEM AP,T.MOR2
MOVEI AP,SPEC
MOVEM AP,T.MORE
JRST SP.END
ENDIF.
SP.MOR: AOJ LST,
MOVEM UOT,LUOT.B(LST)
CALL CATALG
JRST SP.NXT
SP.END: SKIPLE LST
IFSKP.
MSPINI
MSPTYP <not found>
MSPOUT
RET
ENDIF.
MOVE AP,[XWD LUOT.B,LUOT.A]
BLT AP,LUOT.A+4
CALL LSTOUT
SKIPE T.MORE
MORDSP
RET
SUBTTL Command Support -- Get From Library
GETLIB: AOJ UOT,
CAILE UOT,217
RET
CAMN UOT,SUOT
JRST GETLIB
SKIPGE T1,U.TAB(UOT)
JRST GETLIB
SKIPN C.NBR1
IFSKP.
ANDI T1,17
CAME T1,C.NBR1
JRST GETLIB
ENDIF.
RETSKP
SUBTTL Command Support -- Lock Target
TLOCK:: CALL GETOBJ ;Something there?
RET ;No, return
FIX T1,O.RANG(UOT) ;Get distance to target
CAIG T1,^D1024 ;Farther than this?
IFSKP. ;If so,
MSPINI
MSPTYP <target object not within 1024 units>
MSPOUT
RET ;And can't do it
ENDIF.
MOVEM UOT,T.UOT
CALL CONUOT
MOVE T1,B1
MOVEM T1,T.BEAR
MOVE T1,E1
MOVEM T1,T.ELEV
CALL CONTRC
CALL TARDSP
TYPE <
8>
OUTSTR V.ASC
MOVEI T1,7
MOVEM T1,V.COLR
MSPINI
MSPTYP <target locked>
MSPOUT
RET
SYNCH:: MOVE T1,T.BEAR
MOVEM T1,B1
MOVE T1,T.ELEV
MOVEM T1,E1
SETZM T.BEAR
SETZM T.ELEV
MOVEI ROW,7
MOVEI COL,^D41
CALL TARDSP
TYPE <
8>
OUTSTR V.ASC
MOVEI T1,7
MOVEM T1,V.COLR
CALL ROT.ZY
CALL OBLOAD
RET
SUBTTL Command Support -- Raise/Lower Shields
SHIELD::MOVE T2,C.DIR
CAILE T2,2
JRST SHL.ER
MOVE T1,C.CNT
JUMPE T1,SHL.ST
MOVE T1,C.NBR1
CAIGE T1,0
JRST SHL.ER
IMULI T1,^D1000
MOVEM T1,F.DATA
MOVM T2,U.SHLD(SUOT)
SUB T1,T2
CALL ENETST
RET
MOVE T1,F.DATA
SKIPA
SHL.ST: MOVM T1,U.SHLD(SUOT)
MOVE T2,C.DIR
CAIG T2,0
SKIPL U.SHLD(SUOT)
CAIN T2,2
MOVN T1,T1
MOVEM T1,U.SHLD(SUOT)
CALL SHLDSP
RET
SHL.ER: TYPE <>
RET
SUBTTL Command Support -- Move Target
TARGET::SETOM T.UOT
MOVE T1,C.CNT
MOVE T2,C.DIR
JRST @[TA.C0
TA.C1
TA.C2](T1)
RET
TA.C0: MOVEI T1,^D5000
MOVEM T1,P.ENER
CALL ENETST
RET
CALL TARFND
JFCL
RET
TA.00: MSPINI
MSPTYP <target reset>
MSPOUT
SETZM T.BEAR
SETZM T.ELEV
JRST TA.DD
TA.C1: FLTR T3,C.NBR1
JRST @[TA.D0
TA.D1
TA.D2
TA.D3
TA.D4](T2)
RET
TA.D0: JUMPE T3,TA.00
CALL GETLST
RET
MOVE T3,B1
MOVEM T3,T.BEAR
MOVE T3,E1
MOVEM T3,T.ELEV
JRST TA.DD
TA.D1: MOVE T4,T.ELEV
FADR T4,T3
JRST TA.D21
TA.D2: MOVE T4,T.ELEV
FSBR T4,T3
TA.D21: MOVEM T4,T.ELEV
JRST TA.DD
TA.D3: MOVE T4,T.BEAR
FADR T4,T3
JRST TA.D41
TA.D4: MOVE T4,T.BEAR
FSBR T4,T3
TA.D41: MOVEM T4,T.BEAR
TA.DD: CALL CONTRC
CALL TARDSP
RET
TA.C2: FLTR T3,C.NBR1
MOVEM T3,T.BEAR
FLTR T3,C.NBR2
MOVEM T3,T.ELEV
JRST TA.DD
SUBTTL Command Support -- Transfer Energy
TRNSFR::MOVEI T1,^D200
SKIPE C.CNT
MOVE T1,C.NBR1
CAILE T1,0
CAILE T1,^D1000
IFNSK.
TYPE <>
RET
ENDIF.
MOVEM T1,P.ENER
IMUL T1,T1
MOVEM T1,P.TIME
MOVE T1,P.ENER
IMULI T1,^D1000
SKIPG U.SHLD(SUOT) ;Are the shields up?
IFSKP. ;If so,
MSPINI ;Can't transfer
MSPSTR @O.NAME(SUOT)
MSPTYP < shields are up>
MSPOUT
RET
ENDIF.
CALL ENETST
RET
MOVE T1,P.TIME
IDIVI T1,^D100
CAIGE T1,^D2000
MOVEI T1,^D2000
MOVEM T1,P.TIME
SETZ T2,
CALL PFLASH
CALL TARSCN
JRST TRS.WT
FIXR T1,O.RANG(UOT)
CAILE T1,^D1024
JRST TRS.WT
MOVEM T1,EADD.T
MOVE T1,P.ENER
CALL ENEADD
CAILE UOT,7
JRST TRS.WT
MOVEI T1,2000
LSH T1,@UOT
IOR T1,SUOT
HRLI T1,10
MOVSM T1,EADD.A
MOVEM UOT,EADD.B
CALL LQADD
TRS.WT: MOVE T1,P.TIME
JRST TRWAIT
SUBTTL Command Support -- Status of Game
SCORE:: SETZM N.NUOT
MOVE C,[XWD N.NUOT,N.NUOT+1]
BLT C,N.NUOT+7
MOVEI T1,120
SCO.1: SOJL T1,SCO.3
SKIPGE C,U.TAB(T1)
JRST SCO.1
ANDI C,17
CAIL C,7
JRST SCO.1
CAIE C,2
JRST SCO.2
MOVE T2,U.TAB(T1)
TRNE T2,@ALLY.N
JRST SCO.1
TRNE T2,@ALLY.F
SOJ C,
SCO.2: AOS N.NUOT(C)
JRST SCO.1
SCO.3: SAVE P1,P2,P3
DSPINI 1
DSPTYP <Active status:>
DSPINI 2
DSPTYP < Federation:>
MOVE P1,N.NUOT+5
MOVE P2,N.NUOT+3
MOVE P3,N.NUOT+1
CALL SCO.4
DSPINI 3
DSPTYP < Klingon Empire:>
MOVE P1,N.NUOT+6
MOVE P2,N.NUOT+4
MOVE P3,N.NUOT+2
CALL SCO.4
DSPINI 4
DSPOUT
REST P1,P2,P3
RET
SCO.4: DSPPOS ^D20
MOVE T1,P1
CALL NBRFIX
DSPTYP < ship>
CAIE P1,1
DSPTYP <s>
DSPPOS ^D31
MOVE T1,P2
CALL NBRFIX
DSPTYP < base>
CAIE P2,1
DSPTYP <s>
DSPPOS ^D42
MOVE T1,P3
CALL NBRFIX
DSPTYP < planet>
CAIE P3,1
DSPTYP <s>
RET
SUBTTL Command Support -- Request Assistance
ASSIST::SETZ T1,
CALL ALERTS ;Alert ally ships
MSPINI
MSPTYP <assistance requested> ;And say it is done
MSPOUT
RET
SUBTTL Command Support -- Red Alert & Yellow Alert
RALERT::MOVEI T1,1
CALL ALERTS ;Let ally ships know
MSPINI
MSPTYP <RED ALERT>
MSPOUT
RET
YALERT::MOVEI T1,2
CALL ALERTS
MSPINI
MSPTYP <YELLOW ALERT>
MSPOUT
RET
SUBTTL Command Support -- Secure from Alert
SALERT::MOVEI T1,3
CALL ALERTS
MSPINI
MSPTYP <secure from alert>
MSPOUT
RET
SUBTTL Command Support -- Alert Ally Ships
ALERTS::MOVE UOT,SUOT
MOVE C,MASK.U
MOVEM C,S.MASK
JRST ALERT
ALERT:: MOVEI T2,2000
LSH T2,@UOT
MOVEI T3,SH.MX
ALR.1: CAMN T3,UOT
JRST ALR.2
ANDCAM T2,U.ALRT(T3)
CAIG T1,1
IORM T2,U.ALRT(T3)
ALR.2: SOJGE T3,ALR.1
HRLZ C,T1
HRR C,UOT
MOVEM C,EADD.B
MOVE C,S.MASK
TRZ C,@T2
HRLI C,12
MOVSM C,EADD.A
SETZM EADD.T
JRST LQINS
SUBTTL Command Support -- Rapid Fire
RAPFIR::MSPINI
SKIPN C.NBR1
SKIPE C.NBR2
SKIPA
IFNSK.
SETZM R.FIRE
MSPTYP <weapons in normal mode>
MSPOUT
SKIPE .TTTYP ;Skip if VT100
OUTSTR @V.GRN ;Green for GIGI
TYPE <
[18;68HPHA
[CTOR
8> ;Display in normal mode
TYPE <
[m> ;Restore cursor attributes
RET
ENDIF.
SKIPN T1,C.NBR1 ;Get RF phaser energy
MOVEI T1,^D200 ;If 0, then make it 200 by default
CAILE T1,0 ;If not between 0
CAILE T1,^D1000 ;and 1000, then
JRST RF.ERR ;say this is a problem
SKIPN T2,C.NBR2 ;Get photon count
MOVEI T2,1 ;If 0, then burst default to 1
CAILE T2,0 ;If not between 1 and 3,
CAILE T2,3
JRST RF.ERR ;Then say we have a problem
MOVEM T1,RF.PHA
MOVEM T2,RF.PHO
SETOM R.FIRE
MSPTYP <weapons in rapid fire mode>
MSPOUT
SKIPE .TTTYP ;Skip if VT100
TYPE @V.RED ;Red for GIGIs
TYPE <
[18;68H
[7mPHA
[CTOR
8>
TYPE <
[m> ;Restore cursor attributes
RET
RF.ERR: TYPE <>
RET
SUBTTL Command Support -- Rapid Fire (Shoot Phasers)
RFPHAS::PUSH P,C.CNT
PUSH P,C.NBR1
MOVE C,RF.PHA
MOVEM C,C.NBR1
MOVEI C,1
MOVEM C,C.CNT
CALL PHASER
POP P,C.NBR1
POP P,C.CNT
RET
SUBTTL Command Support -- Fire Phasers
PHASER::MOVEI T1,^D200
SKIPE C.CNT
MOVE T1,C.NBR1
CAILE T1,0
CAILE T1,^D1000
IFNSK.
TYPE <>
RET
ENDIF.
MOVEM T1,P.ENER
IMUL T1,T1
MOVEM T1,P.TIME
CALL ENETST
RET
OUTSTR @SETPHA ;Make phaser shot be yellow
MOVE T1,P.TIME
IDIVI T1,^D75
CAIGE T1,^D3000
MOVEI T1,^D3000
MOVEM T1,P.TIME
SETZ T2, ;Weapons code (phaser = 0)
CALL PFLASH
CALL TARSCN
JRST PHA.WT
FIXR T1,O.RANG(UOT)
CAILE T1,^D1024
JRST PHA.WT
SETZ T2, ;Weapons code (phaser = 0)
CALL PQADD
PHA.WT: MOVE T1,P.TIME
JRST TRWAIT
SUBTTL Command Support -- Rapid Fire (Launch Photon Torpedo)
RFPHOT::PUSH P,C.CNT
PUSH P,C.NBR1
MOVE C,RF.PHO
MOVEM C,C.NBR1
MOVEI C,1
MOVEM C,C.CNT
CALL PHOTON
POP P,C.NBR1
POP P,C.CNT
RET
SUBTTL Command Support -- Fire Photon Torpedo
PHOTON::SKIPE VT241F ;VT241?
OUTSTR @SETTOR ;Yes, make torpedoes red
MOVEI T1,1
SKIPE C.CNT
MOVE T1,C.NBR1
CAIL T1,1 ;Must fire between 1
CAILE T1,3 ;and 3
IFNSK. ;Bad number, don't do it
TYPE <>
RET
ENDIF.
CAMLE T1,U.TORP(SUOT) ;Have enough torpedoes stored?
IFNSK. ;If not,
MSPINI
MSPTYP <insufficient torpedos for burst>
MSPOUT
RET
ENDIF.
MOVEM T1,P.SAVE
IMULI T1,^D40000
CALL ENETST
RET
MOVEI T1,^D200
MOVEM T1,P.ENER
PHO.SR: SOS U.TORP(SUOT)
MOVEI T1,^D2000
MOVEM T1,P.TIME
HRRZI T2,1B27 ;Weapons code (photon = 1)
CALL PFLASH
CALL TARSCN
JRST PHO.WT
FIXR T1,O.RANG(UOT)
ADDI T1,^D2000
HRRZI T2,1B27 ;weapons code (photon = 1)
CALL PQADD
PHO.WT: MOVE T1,P.TIME
CALL TRWAIT
SOSLE P.SAVE
JRST PHO.SR
RET
SUBTTL Weapons Flash -- Phasers
PFLASH::IOR T2,MASK.O
HRLI T2,4 ;Weapons fire event code
MOVSM T2,EADD.A
MOVEM SUOT,EADD.B
SETZM EADD.T
PUSH SP,T2
CALL LQADD
POP SP,T2
TRNE T2,1B27
JRST PHO.FL
; JRST PHA.FL
PHA.FL: MOVE ROW,T.ROW
MOVE COL,T.COL
CALL RCTEST
RET
CALL VTPOS
CALL GIPOS ;Get GIGI position
SKIPN .TTTYP
TYPE <
[1m> ;High intensity
MOVE T3,.GRTYP ;Graphics type
MOVE T1,P.TIME
SKIPE .GRTYP
SUBI T1,^D800
MOVEM T1,P.TIME
SKIPE .GRTYP
TYPE <
Pp> ;Enter REGIS
MOVEI T1,^D8
PHAFL1: CALL PH.FL ;Do flash depending on graphics type
SOJG T1,PHAFL1
SKIPN .TTTYP
TYPE <
[m> ;Reset cursor
SKIPE .GRTYP ;If we have REGIS
TYPE <
\> ;Exit REGIS
CALL GETVWR
SETZM V.MOD
CALL DSPVWR
TYPE <
8>
OUTSTR V.ASC
MOVEI T1,7
MOVEM T1,V.COLR
RET
PH.FL: JRST .+1(T3) ;Depending on term type
JRST PH100
JRST PHGIGI
PH100: TYPE <
(1
[D> ;Alternate character,backspace,ASCII
OUTSTR V.ASC
RET
PHGIGI: TYPE <@p> ;Do macrograph p
RET
SUBTTL Weapons Flash -- Photon Torpedoes
PHO.FL: MOVE ROW,T.ROW
MOVE COL,T.COL
CALL RCTEST
RET
CALL GIPOS
SKIPN .GRTYP
IFSKP.
TYPE <
Pp@t
\>
MOVE T1,P.TIME
SUBI T1,^D800
MOVEM T1,P.TIME
SKIPE VT241F ;VT241?
OUTSTR @SET241 ;Back to normal
RET
ENDIF.
MOVEI C,^D1
MOVEM C,FLSH.C
CALL FLALT
RET
SUBTTL Weapons Flash -- Display the Flash
FLALT: CALL FLSHLD
TYPE <
(1
[;1m>
CALL FLSHBR
TYPE <
8>
OUTSTR V.ASC
CALL FLSHCH
TYPE <
8>
OUTSTR V.ASC
MOVEI T1,7
MOVEM T1,V.COLR
RET
SUBTTL Command Support -- Ship Movement
MOTION::MOVE T2,C.DIR
CAIE T2,3
CAIN T2,4
JRST ROLSHP
MOVE T3,S.WARP
MOVE T2,C.CNT
CAIN T2,2
JRST MOT.A
CAIE T2,1
JRST MOT.T
SKIPE C.DIR
JRST MOT.B
MOT.LS: CALL GETLST
RET
CALL ROT.ZY
JRST MOT.C
MOT.B: SKIPL T3,C.NBR1
CAILE T3,^D9
IFSKP. <
JRST MOT.C>
TYPE <>
RET
MOT.A: FLTR T1,C.NBR1
MOVEM T1,B1
FLTR T1,C.NBR2
MOVEM T1,E1
CALL ROT.ZY
JRST MOT.C
MOT.T: SKIPN C.DIR
CALL ROTTAR
MOT.C: MOVE T1,WF.TAB(T3)
MOVEM T1,F.DATA
MOVE T2,C.DIR
CAIN T2,2
MOVNM T1,F.DATA
IMUL T1,T1
CALL ENETST
JRST OBLOAD
CALL MOVSHP
HRLZ T1,MASK.O
HRRI T1,1 ;Movement event code
MOVEM T1,EADD.A
MOVEM SUOT,EADD.B
SETZM EADD.T
CALL HQADD
CALL OBLOAD
JRST IFNEAR
MOVSHP: FLTR T1,F.DATA
FMPR T1,S.11
FADRM T1,U.ABSX(SUOT)
FLTR T1,F.DATA
FMPR T1,S.12
FADRM T1,U.ABSY(SUOT)
FLTR T1,F.DATA
FMPR T1,S.13
FADRM T1,U.ABSZ(SUOT)
RET
ROLSHP: SKIPG C.CNT
RET
MOVE T1,C.NBR1
CAIN T2,3
MOVN T1,C.NBR1
FLTR T1,T1
CALL SINCOS
CALL ROT.X
CALL OBLOAD
RET
IFNEAR::SETO UOT,
IFNR.1: CALL STDSCN
RET
CAILE T1,4 ;Test only bases and planets
JRST IFNR.1
MOVE AP,U.TAB(UOT)
TRNN AP,3B31 ;Test if neutral
JRST IFNR.1 ;Don't perturb neutral entities
SETZ T1,
FIX AP,O.RANG(UOT)
CAIG AP,^D1024
CALL TQINS
JRST IFNR.1
SUBTTL Command Support -- Rotate Ship
ROTATE::SKIPG T1,C.CNT
JRST ROT.D
CAIN T1,2
JRST ROT.2
SKIPG T2,C.DIR
JRST ROT.LS
MOVE T1,C.NBR1
CAIE T2,2
CAIN T2,4
MOVN T1,T1
FLTR T1,T1
CALL SINCOS
MOVEI C,ROT.Z
CAIG T2,2
MOVEI C,ROT.Y
CALL @C
JRST OBLOAD
ROT.LS: CALL GETLST
RET
CALL ROT.ZY
JRST OBLOAD
ROT.D: SKIPG T2,C.DIR
JRST ROT.T
CALL TARFND
RET
ROT.T: CALL ROTTAR
JRST OBLOAD
ROT.2: FLTR T1,C.NBR1
MOVEM T1,B1
FLTR T1,C.NBR2
MOVEM T1,E1
CALL ROT.ZY
JRST OBLOAD
SUBTTL Command Support -- Rotate Target With Ship Rotation
ROTTAR::MOVE T1,T.BEAR
MOVEM T1,B1
MOVE T1,T.ELEV
MOVEM T1,E1
CALL ROT.ZY
SETZM T.BEAR
SETZM T.ELEV
MOVEI ROW,7
MOVEM ROW,T.ROW
MOVEI COL,^D41
MOVEM COL,T.COL
RET
SUBTTL Command Support -- Warp Distance
WARP:: SKIPN T1,C.CNT
JRST WRP.DS
MOVE T2,C.NBR1
CAIGE T2,0
JRST WRP.ER
CAILE T2,^D9
JRST WRP.ER
CAIE T1,2
JRST WRP.EX
MOVE T3,C.NBR2
CAIGE T3,0
JRST WRP.ER
CAILE T3,^D1000
JRST WRP.ER
MOVEM T3,WF.TAB(T2)
WRP.EX: MOVEM T2,S.WARP
CALL WRPDSP
RET
WRP.DS: DSPINI 1
DSPTYP <Warp distances:>
DSPINI 2
DSPTYP < w0:>
MOVE T1,WF.TAB
CALL NBRFIX
DSPTYP < w1:>
MOVE T1,WF.TAB+1
CALL NBRFIX
DSPTYP < w2:>
MOVE T1,WF.TAB+2
CALL NBRFIX
DSPTYP < w3:>
MOVE T1,WF.TAB+3
CALL NBRFIX
DSPTYP < w4:>
MOVE T1,WF.TAB+4
CALL NBRFIX
DSPINI 3
DSPTYP < w5:>
MOVE T1,WF.TAB+5
CALL NBRFIX
DSPTYP < w6:>
MOVE T1,WF.TAB+6
CALL NBRFIX
DSPTYP < w7:>
MOVE T1,WF.TAB+7
CALL NBRFIX
DSPTYP < w8:>
MOVE T1,WF.TAB+8
CALL NBRFIX
DSPTYP < w9:>
MOVE T1,WF.TAB+9
CALL NBRFIX
DSPINI 4
DSPOUT
RET
WRP.ER: TYPE <>
RET
SUBTTL Command Support -- Display Object in List
DSPLST::SKIPE T1,C.NBR1
JRST DSPANY
MOVEI LST,4
DSPLS1: SKIPL LUOT.A(LST)
JRST LSTOUT
SOJG LST,DSPLS1
MSPINI
MSPTYP <object list is empty>
MSPOUT
RET
SUBTTL Command Support -- Display Any Object
DSPANY::CAIL T1,1 ;Valid object number?
CAILE T1,30
IFNSK. ;If not, punt now
TYPE<>
RET
ENDIF.
MOVE UOT,O.NBR-1(T1)
SKIPL C,U.TAB(UOT)
TRNN C,@MASK.C
IFNSK.
MSPINI
MSPTYP <nothing found by library computer>
MSPOUT
RET
ENDIF.
CALL LSTCLR
AOJ LST,
MOVEM UOT,LUOT.B(LST)
MOVE C,[XWD LUOT.B,LUOT.A]
BLT C,LUOT.A+4
JRST LSTOUT
SUBTTL Command Support -- Capture Planet
CAPTUR::CALL GETOBJ ;Get object in target area
RET ;Nothing there
HRRZ T2,U.TAB(UOT)
ANDI T2,7
CAIE T2,2
JRST CA.NP
MOVE T2,O.RANG(UOT)
CAMLE T2,[512.0]
JRST CA.RE
MOVE T2,U.TAB(UOT)
TLNE T2,100
JRST CA.UP
MOVE T2,U.TAB(UOT)
TRZ T2,7B31
IOR T2,ALLY.U
MOVEM T2,U.TAB(UOT)
CALL CATALG
MSPINI
MSPTYP <planet captured>
MSPOUT
CALL REBTIM
MOVEM T1,REBEL(UOT)
RET
CA.NP: CALL CA.ID
MSPTYP < is not a planet>
MSPOUT
RET
CA.RE: CALL CA.ID
MSPTYP < is not within 512 units>
MSPOUT
RET
CA.ID: MSPINI
JUMPE T1,[MSPTYP <target object>
RET]
MSPTYP <object >
TRO T1,"0"
MSPCHR T1
RET
CA.UP: SETZ T1,
CALL TQINS
MSPINI
MSPTYP <planetary defenses are up>
MSPOUT
RET
SUBTTL Command Support -- Refueling
REFUEL::MOVEI UOT,7
CALL NSCANP
JRST REF.ER
CAMLE T3,[512.0]
JRST REF.ER
MOVE T1,SUOT
MOVE T2,UOT
CALL REENER
CALL ENEDSP
MOVEI T1,^D1500
JRST TRWAIT
REF.ER: MSPINI
MSPTYP <not within 512 units of a base>
MSPOUT
RET
SUBTTL Command Support -- Routine To Actually Refuel
;REENER
;
; Refuels ship T1 from base (or planet) T2.
REENER::SAVE T2
MOVE T2,U.TAB(T2)
ANDI T2,17
MOVE C,U.TORP(T1)
ADDI C,3
CAIE T2,2
ADDI C,2
CAILE C,^D10
MOVEI C,^D10
MOVEM C,U.TORP(T1)
MOVE C,[^D250000]
CAIE T2,2
ADD C,C
ADDB C,U.ENER(T1)
MOVM T2,U.SHLD(T1)
ADD C,T2
CAMG C,MAX.EN
IFSKP.
MOVE C,MAX.EN
SUB C,T2
MOVEM C,U.ENER(T1)
ENDIF.
REST T2
RET
SUBTTL Command Support -- Find Nearest Base (or Planet)
NEARB:: CALL LSTCLR
MOVEI UOT,7
CALL NSCANB
JRST NRB.2
AOJ LST,
MOVEM UOT,LUOT.B(LST)
NRB.2: MOVEI UOT,17
CALL NSCANP
JRST NRB.3
AOJ LST,
MOVEM UOT,LUOT.B(LST)
NRB.3: SKIPLE LST
IFSKP.
MSPINI
MSPTYP <nothing found by library computer>
MSPOUT
RET
ENDIF.
MOVE AP,[XWD LUOT.B,LUOT.A]
BLT AP,LUOT.A+4
CALL LSTOUT
RET
NSCANB: MOVEI T2,17 ;Don't include planets
SKIPA
NSCANP: MOVEI T2,117
SETZB T3,T4
NSC.1: AOJ UOT,
CAMLE UOT,T2
JRST NSC.2
SKIPGE T1,U.TAB(UOT)
JRST NSC.1
ANDI T1,17
MOVE C,ALLY.U
CAIE T1,7
TDNN C,U.TAB(UOT)
JRST NSC.1
JUMPE T3,NSC.11
CAMG T3,O.RANG(UOT)
JRST NSC.1
NSC.11: MOVE T3,O.RANG(UOT)
MOVE T4,UOT
JRST NSC.1
NSC.2: SKIPE UOT,T4
RETSKP
RET
SUBTTL Command Support -- Send Message
SEND:: MOVE T1,C.NBR1
CAIG T1,2
JRST SEND.1
MOVE UOT,T1
SUBI UOT,3
SKIPGE U.TAB(UOT)
JRST SEN.NA
SEND.1: MOVEI ROW,^D21
MOVEM ROW,M.ROW
CALL GETMSG
RET
CALL MOVMSG
MOVE T2,C.NBR1
CAIGE T2,3
IFSKP.
MOVEI T1,200
LSH T1,@T2
JRST SEND.2
ENDIF.
MOVE T1,@[MASK.A
MASK.F
MASK.K](T2)
TRZ T1,@MASK.C
SEND.2: HRLI T1,3 ;Message event code
MOVSM T1,EADD.A
MOVEM SUOT,EADD.B
SETZM EADD.T
JRST LQADD
SEN.NA: MSPINI
MSPSTR @O.NAME(UOT)
MSPTYP < not available>
MSPOUT
RET
SUBTTL Command Support -- Display Users in Game
USERS:: CALL LSTCLR
SKIPN T.MORE
IFSKP.
MOVE UOT,T.MOR1
SETZM T.MORE
MORCLR
JRST USR.MR
ENDIF.
MOVEI UOT,10
USR.NX: SOJL UOT,USR.EN
SKIPL C,U.TAB(UOT)
TLNN C,1B19
JRST USR.NX
CAIGE LST,4
IFSKP.
MOVEM UOT,T.MOR1
MOVEI AP,USERS
MOVEM AP,T.MORE
JRST USR.EN
ENDIF.
USR.MR: AOJ LST,
MOVEM UOT,LUOT.B(LST)
JRST USR.NX
USR.EN: SKIPLE LST
IFSKP.
MSPINI
MSPTYP <no ships in play>
MSPOUT
RET
ENDIF.
DSPINI
USR.OT: SKIPL UOT,LUOT.B(LST)
CALL USROUT
SOJG LST,USR.OT
DSPOUT
SKIPE T.MORE
MORDSP
RET
;Output each game player 1 at a time
USROUT::DSPINI (LST)
DSPSTR @O.NAME(UOT)
DSPPOS ^D16
DSPTYP <TTY>
MOVE T2,U.TTY(UOT)
CALL OCTOUT
DSPTYP < >
HRROI T1,IO.BLK
MOVE T2,U.NAMX(UOT)
DIRST%
JFCL
DSPSTR IO.BLK
RET
OCTOUT::IDIVI T2,10
PUSH P,T3
SKIPE T2
CALL OCTOUT
POP P,T3
ADDI T3,"0"
DSPCHR T3
RET
SUBTTL Command Support -- Help
HELP:: DSPINI
SKIPN T.MORE
IFSKP.
SETZB T3,T.MORE
MORCLR
JRST HLP.M
ENDIF.
CALL CLOSIN
CALL OPENIN
JRST HLP.NF
MOVE T3,C.CMD
HRRZ T3,C.TAB(T3)
HLP.1: CALL READIN
JRST HLP.NF
MOVE T1,[POINT 7,IO.BLK]
ILDB T2,T1
HLP.2: CAIE T2,"."
JRST HLP.1
ILDB AP,T1
LSH AP,7
ILDB T2,T1
CAIL T2,"A"
CAILE T2,"Z"
IFNSK.
IORI AP,.CHSPC
JRST HLP.21
ENDIF.
IOR AP,T2
ILDB T2,T1
HLP.21: CAME AP,T3
JRST HLP.2
SETZ T3,
HLP.3: CALL READIN
JRST HLP.4
MOVE T1,[POINT 7,IO.BLK]
ILDB T2,T1
CAIN T2,"."
JRST HLP.4
CAIGE T3,4
IFSKP.
MOVEI AP,HELP
MOVEM AP,T.MORE
DSPOUT
MORDSP
RET
ENDIF.
HLP.M: AOJ T3,
DSPINI (T3)
DSPSTR IO.BLK
JRST HLP.3
HLP.4: DSPOUT
CALL CLOSIN
RET
HLP.NF: MSPINI
MSPTYP <no help available>
MSPOUT
RET
SUBTTL Command Support -- Quit or Exit
QUIT:: TYPE <
[H
[J>
CALL STWAIT
MOVE C,U.TAB(SUOT)
TLZ C,1B19
MOVEM C,U.TAB(SUOT)
AOS A.SHIPS ;Add 1 to auto ship count
CALL WRAPUP
JRST FINI ;Done
SUBTTL Command Support -- Suppress Stars (1200 baud only)
SSTARS::SKIPG C,TOTSP ;Check speed
JRST SSTAR1 ;If LAT terminal, assume fast
SKIPN DBUGF
CAIGE C,SBAUDR
SKIPA
IFNSK.
SSTAR1: MSPINI
MSPTYP <Baud rate not less than 1200>
MSPOUT
RET
ENDIF.
SETCMM S.STAR ;Compliment flag
CALL SCANLD
CALL TARUPD
JRST VIEWLD ;Update screen
SUBTTL Command Support -- Do Self Test
SLFTST::TYPE <
[2;1y>
MOVEI T1,^D2000
CALL TRWAIT
JRST RFRESH
SUBTTL Command Support -- Refresh the Screen
RFRESH::CALL GILOAD ;Load GIGI macrographs
CALL DSPCON ;Display the trek console
MOVEI UOT,7 ;Going to look
CALL NSCANP ;For planets or starbases
JRST RFR.SH ;Nothing near
CAMLE T3,[512.0] ;Nothing near
JRST RFR.SH
MOVE T1,SUOT
MOVE T2,UOT
MOVE T3,TOTSP
MOVEI T4,1
CAIG T3,^D4800
MOVEI T4,2
CAIG T3,^D2400
MOVEI T4,4
CAIG T3,^D1200
MOVEI T3,10
CAIG T3,^D300
MOVEI T4,20
RFRES1: CALL REENER ;Energize me
SOJG T4,RFRES1 ;Multiple times depending on baud rate
RFR.SH: CALL ENEDSP
CALL SHLDSP
CALL WRPDSP
SKIPN R.FIRE
IFSKP.
SKIPE .TTTYP
TYPE @V.RED
TYPE <
[18;68H
[7mPHA
[CTOR
8>
ENDIF.
SETZM D.TCNT
CALL D.TIME
CALL VWRCLR
CALL OBLOAD
DSPCLR
MSPCLR
RET
SUBTTL Library Supporting Routines
PLIBN:: MOVE C,ALLY.N
MOVEM C,S.MASK
SKIPA
PLIBR:: SETZM S.MASK
SETZM S.MUID
MOVEI UOT,17
JRST LIBSCN
ALIBR:: SETO UOT,
SETZM S.MASK
SETZM S.MUID
JRST LIBSCN
FLIBB:: MOVEI C,3
JRST FLIB
FLIBP:: MOVEI C,2
JRST FLIB
FLIBS:: MOVEI C,5
SKIPA
FLIBR:: SETZ C,
FLIB:: MOVEM C,S.MUID
MOVE C,ALLY.F
MOVEM C,S.MASK
SETO UOT,
JRST LIBSCN
KLIBB:: MOVEI C,4
JRST KLIB
KLIBP:: MOVEI C,2
JRST KLIB
KLIBS:: MOVEI C,6
SKIPA
KLIBR:: SETZ C,
KLIB:: MOVEM C,S.MUID
MOVE C,ALLY.K
MOVEM C,S.MASK
SETO UOT,
JRST LIBSCN
BASES:: MOVE C,ALLY.U
MOVEM C,S.MASK
SETZM S.MUID
MOVEI UOT,7
JRST LIBSCN
SUBTTL Notification of Movement
MOVMSG::PUSH SP,T1
PUSH SP,T2
MOVE T1,SUOT
IMULI T1,^D11
ADDI T1,U.MSG
MOVE T2,T1
HRLI T1,M.MSG
BLT T1,^D10(T2)
POP SP,T2
POP SP,T1
RET
SUBTTL Help File -- Open Help File
OPENIN::SAVE T1,T2 ;Save these for now
HRROI T1,[ASCIZ /HLP/] ;This is the file extension
MOVEM T1,GJBLK+.GJEXT ;Put it in GTJFN argument block
SETZ T2, ;No default strings for anything
MOVEI T1,GJBLK ;GTJFN argument block is here
GTJFN% ;Get a JFN for the help file
ERJMP OPENIX ;Must not be here
MOVEM T1,HLPJFN ;Save help file JFN here
MOVX T2,<FLD(7,OF%BSZ)+OF%RD> ;Open file for read
OPENF%
IFJER. ;If we can't open it
MOVE T1,HLPJFN ;Get the JFN back
RLJFN% ;And release it
JFCL
JRST OPENIX ;Now report error
ENDIF.
OPENIX: REST T1,T2 ;Restore the used ACs
RETSKP ;And return success
SUBTTL Help File -- Read Information in From Help File
READIN::SETZM IO.BLK ;Clear object list display
MOVE AP,[XWD IO.BLK,IO.BLK+1]
BLT AP,IO.BLK+12
MOVE AP,[POINT 7,IO.BLK]
MOVEM AP,IO.PTR
SETZM IO.CNT
RD.1: MOVE T1,HLPJFN ;Get help file JFN
BIN% ;Read a byte
ERJMP CLOSIN ;Probably EOF
CAIN T2,.CHCRT ;Carriage return?
JRST RD.1 ;Yes, now eat LF
CAIN T2,.CHLFD ;End of line?
RETSKP ;Yes, we have read in something
IDPB T2,IO.PTR ;Stick character in this area
AOS IO.CNT ;And keep track of the number of characters
JRST RD.1 ;Get next character from file
SUBTTL Help File -- Close Help File
CLOSIN::SAVE T1 ;Save this AC
MOVE T1,HLPJFN ;Get JFN for help file
CLOSF% ;Get rid of it
JFCL ;Don't care about errors
SETZM HLPJFN ;Say we have no help file for now
REST T1 ;And restore this AC
RET
SUBTTL Standard Scan
;STDSCN
;
; Scans for active objects, skips stars and our ship. Returns
; UOT in UOT and UID in T1. UOT must be initialized to 1 less
; than the 1st U.TAB entry to be scanned. In most cases, this
; value is -1. If object is found, skip return is taken.
STDSCN::AOJ UOT,
CAILE UOT,117
RET
CAMN UOT,SUOT
JRST STDSCN
SKIPGE T1,U.TAB(UOT)
JRST STDSCN
HRRZ T1,T1
ANDI T1,17
RETSKP
SUBTTL Check For an Entry in Our Library Computer
LIBSCN::CALL LSTCLR
SKIPN T.MORE
IFSKP.
MOVE UOT,T.MOR1
MOVE AP,T.MOR2
MOVEM AP,S.MASK
SETZM T.MORE
MORCLR
JRST LB.MOR
ENDIF.
LB.NXT: CALL LBSCN
JRST LB.END
SKIPN S.MASK
JRST LB.SC1
TRNN T1,@S.MASK
JRST LB.NXT
LB.SC1: SKIPN S.MUID
JRST LB.SC2
ANDI T1,17
CAME T1,S.MUID
JRST LB.NXT
LB.SC2: CAIGE LST,4
IFSKP.
MOVEM UOT,T.MOR1
MOVE AP,S.MASK
MOVEM AP,T.MOR2
MOVEI AP,LIBSCN
MOVEM AP,T.MORE
JRST LB.END
ENDIF.
LB.MOR: AOJ LST,
MOVEM UOT,LUOT.B(LST)
JRST LB.NXT
LB.END: SKIPLE LST
IFSKP.
MSPINI
MSPTYP <nothing found by library computer>
MSPOUT
RET
ENDIF.
MOVE AP,[XWD LUOT.B,LUOT.A]
BLT AP,LUOT.A+4
CALL LSTOUT
SKIPE T.MORE
MORDSP
RET
LBSCN: DO.
AOS UOT
CAILE UOT,117
RET
CAMN UOT,SUOT
JRST TOP.
SKIPGE T1,U.TAB(UOT)
JRST TOP.
TRNN T1,@MASK.C
JRST TOP.
OD.
RETSKP
SUBTTL Get Object in Target
GETOBJ::SKIPE C.DIR
JRST GO.ER
SKIPE T1,C.CNT
JRST GO.LST
CALL TARSCN ;Get object in target area
IFNSK. ;If no object there,
MSPINI
MSPTYP <no object found at target coordinates>
MSPOUT
RET
ENDIF.
SETZ T1,
RETSKP
GO.LST: CAIE T1,1
JRST GO.ER
CALL GETLST
RET
RETSKP
GO.ER: TYPE <>
RET
SUBTTL Find Target
TARFND::SAVE P1,P2,P3,P4
MOVEI P1,^D13
MOVEI P2,1
MOVEI P3,7
MOVEI P4,^D75
CAMLE P1,T.ROW
CAML P2,T.ROW
JRST TF.NUL
CAMLE P4,T.COL
CAML P3,T.COL
JRST TF.NUL
CAIN T2,1
MOVE P1,T.ROW
CAIN T2,2
MOVE P2,T.ROW
CAIN T2,3
MOVE P3,T.COL
CAIN T2,4
MOVE P4,T.COL
MOVEM P1,T.RMAX
MOVEM P2,T.RMIN
MOVEM P3,T.CMIN
MOVEM P4,T.CMAX
CALL TARTST
JRST TF.NUL
CALL CONTRC
CALL TARDSP
TYPE <
8>
OUTSTR V.ASC
MOVEI T1,7
MOVEM T1,V.COLR
REST P1,P2,P3,P4
RETSKP
TF.NUL: MSPINI
MSPTYP <target not obtained>
MSPOUT
REST P1,P2,P3,P4
RET
SUBTTL Test Target Validity
TARTST::SETZ T3,
SETOB UOT,F.HIT
TT.NXT: AOJ UOT,
HLRZ T1,SCAN.1(UOT)
ANDI T1,7 ;Get object ID
CAIN T1,1 ;Is it a star?
JRST TT.NXT ;Yes, ignore it
HRRZ T1,SCAN.1(UOT)
JUMPE T1,TT.END
TRZ T1,-1000
CAMLE T1,T.RMIN
CAML T1,T.RMAX
JRST TT.NXT
HRRZ T2,SCAN.1(UOT)
LSH T2,-^D9
CAMLE T2,T.CMIN
CAML T2,T.CMAX
JRST TT.NXT
CAME T1,T.ROW
JRST TTNXT1
CAMN T2,T.COL
JRST TT.NXT
TTNXT1: MOVE T4,T1
SOJ T4,
IMULI T4,^D78
ADD T4,T2
ADJBP T4,V.TABP
LDB T4,T4
TRZ T4,40
CAIN T4,0
JRST TT.NXT
PUSH SP,UOT
HLRZ UOT,SCAN.1(UOT)
LSH UOT,-^D9
CALL CONUOT
MOVE T1,B1
FSBR T1,T.BEAR
FMPR T1,T1
MOVE T2,E1
FSBR T2,T.ELEV
FMPR T2,T2
FADR T1,T2
MOVEM T1,F.DATA
MOVEI AP,F.LOC
CALL SQRT.##
POP SP,UOT
JUMPE T3,TT.N1
CAMG T3,RS
JRST TT.NXT
TT.N1: MOVE T3,RS
MOVE T1,B1
MOVEM T1,W.BEAR
MOVE T1,E1
MOVEM T1,W.ELEV
SETZM F.HIT
JRST TT.NXT
TT.END: SKIPGE F.HIT
RET
MOVE T1,W.BEAR
MOVEM T1,T.BEAR
MOVE T1,W.ELEV
MOVEM T1,T.ELEV
RETSKP
SUBTTL Scan Target Area
TARSCN::SAVE P1,P2,P3,P4
MOVE P1,T.BEAR
FSBR P1,[0.9]
MOVE P2,T.BEAR
FADR P2,[0.9]
MOVE P3,T.ELEV
FSBR P3,[2.1]
MOVE P4,T.ELEV
FADR P4,[2.1]
SETZB T3,T4
SETOB UOT,F.HIT
TS.NXT: CALL RNGSCN
JRST TS.END
CALL CONUOT
CAMG P1,B1
CAMGE P2,B1
JRST TS.NXT
CAMG P3,E1
CAMGE P4,E1
JRST TS.NXT
JUMPE T3,TS.N1
CAMG T3,O.RANG(UOT)
JRST TS.NXT
TS.N1: MOVE T3,O.RANG(UOT)
MOVE T4,UOT
SETZM F.HIT
JRST TS.NXT
TS.END: REST P1,P2,P3,P4
MOVEM T4,UOT
SKIPL F.HIT
RETSKP
RET
SUBTTL Scan For Objects in Range
RNGSCN::AOJ UOT,
CAILE UOT,217
RET
CAMN UOT,SUOT
JRST RNGSCN
SKIPGE U.TAB(UOT)
JRST RNGSCN
FIXR AP,O.RANG(UOT)
CAILE AP,^D2048
JRST RNGSCN
RETSKP
SUBTTL Get Object From List
GETLST::MOVE T1,C.CNT
CAILE T1,1
JRST GL.ER
SKIPL T1,C.NBR1
CAILE T1,4
JRST GL.ER
SKIPG T1
MOVEI T1,1
SKIPL UOT,LUOT.A(T1)
IFSKP.
MSPINI
MSPTYP <list entry >
TRO T1,"0"
MSPCHR T1
MSPTYP < is empty>
MSPOUT
RET
ENDIF.
SAVE T1
CALL LSTXYZ
CALL RBECMP
CALL CONANG
REST T1
RETSKP
GL.ER: TYPE <>
RET
SUBTTL Last Clear
LSTCLR::SETOM LUOT.B
MOVE AP,[XWD LUOT.B,LUOT.B+1]
BLT AP,LUOT.B+4
SETZ LST,
RET
SUBTTL Catalog
CATALG::CAILE UOT,7
IFSKP.
MOVE C,ALLY.T
TDNN C,U.TAB(UOT)
RET
MOVE C,U.ABSX(UOT)
MOVEM C,U.LSTX(UOT)
MOVE C,U.ABSY(UOT)
MOVEM C,U.LSTY(UOT)
MOVE C,U.ABSZ(UOT)
MOVEM C,U.LSTZ(UOT)
JRST CAT.1
ENDIF.
MOVE C,U.TAB(UOT)
ANDI C,17
CAIE C,7
CAIN C,1
RET
CAT.1: MOVE C,MASK.U
IORM C,U.TAB(UOT)
RET
SUBTTL Display List Items
LSTOUT::DSPINI
MOVEI LST,1
DO.
SKIPL LUOT.A(LST)
CALL LSTDSP
CAIGE LST,4
AOJA LST,TOP.
OD.
DSPOUT
RET
;Routine to display the list items
LSTDSP::DSPINI (LST)
MOVE T1,LST
TRO T1,"0"
DSPCHR T1
DSPTYP < >
MOVE UOT,LUOT.A(LST)
SKIPGE T2,U.TAB(UOT)
RET
HRRZ T2,T2
ANDI T2,7
CAIE T2,2 ;Test for planet
IFSKP.
HRRZ T3,U.TAB(UOT)
ANDI T3,3B31
LSH T3,-4
MOVE T3,P.NAME(T3)
MOVEM T3,U.NAME+6
ENDIF.
MOVEI T3,3
IMUL T3,T2
DSPSTR U.NAME(T3)
CAIE T2,1 ;Test for star
CAIN T2,7 ;Test for interceptor
SKIPA
DSPSTR @O.NAME(UOT)
LDSP.1: DSPPOS ^D35
CALL LSTXYZ
CALL RBECMP
CALL CONANG
FIXR T1,B1
CALL NBRFIX
DSPTYP <b >
FIXR T1,E1
CALL NBRFIX
DSPTYP <e >
FIXR T1,R1
CAIG T1,^D9999
IFSKP.
IDIVI T1,^D1000
CALL NBRFIX
DSPTYP <E3r>
RET
ENDIF.
DSPTYP < >
CALL NBRFIX
DSPTYP <r>
RET
SUBTTL Last X,Y,Z
LSTXYZ::MOVE C,ALLY.T
CAIG UOT,7
TDNN C,U.TAB(UOT)
JRST LXYZ.1
PUSH P,U.LSTX(UOT)
PUSH P,U.LSTY(UOT)
PUSH P,U.LSTZ(UOT)
JRST LXYZ.2
LXYZ.1: PUSH P,U.ABSX(UOT)
PUSH P,U.ABSY(UOT)
PUSH P,U.ABSZ(UOT)
LXYZ.2: POP P,Z1
POP P,Y1
POP P,X1
RET
SUBTTL Display Warp Factor on Console
WRPDSP::SKIPE .TTTYP ;Skip if VT100
OUTSTR @V.GRN ;Green
TYPE <
[16;39H> ;Position cursor
MOVE T1,S.WARP ;Get current warp setting
TRO T1,"0" ;ASCIIfy it
OUTCHR T1 ;Show it to the user
TYPE <
[m> ;Reset cursor attributes
RET
SUBTTL Sufficient Energy Test
ENETST::CAMLE T1,U.ENER(SUOT)
JRST ENE.ER
EXCH T1,U.ENER(SUOT)
SUBB T1,U.ENER(SUOT)
CALL ENEDSP
RETSKP
ENE.ER: SUB T1,U.ENER(SUOT)
MSPINI
MSPTYP <insufficient energy, >
CALL FLTDSP
MSPTYP < units required>
MSPOUT
RET
SUBTTL Energy Display on Console
ENEDSP::SKIPE .TTTYP ;Skip if VT100
OUTSTR @V.GRN ;Green
MOVE SUOT,S.UOT
TYPE <
[16;13H> ;Position cursor
MOVE T1,U.ENER(SUOT) ;Get energy
IDIVI T1,^D1000 ;Scale it down
CALL NBRDSP ;Display it
TYPE <
8>
TYPE <
[m> ;Reset cursor attributes
RET
SUBTTL Shield Display on Console
SHLDSP::SKIPE .TTTYP ;Skip if VT100
OUTSTR @V.GRN ;Green
MOVE SUOT,S.UOT
TYPE <
[16;24H> ;Position cursor
SKIPLE U.SHLD(SUOT) ;Shields up?
IFSKP. ;No
TYPE <DN > ;Say they are down
SKIPA ;And go on
ENDIF.
TYPE <UP > ;Shields are up
SHLD.1: MOVM T1,U.SHLD(SUOT) ;Get shield power
IDIVI T1,^D1000 ;Scale it down
CALL NBRDSP ;Now display it
TYPE <
8>
TYPE <
[m> ;Reset cursor
RET
SUBTTL Number Display on Console
NBRDSP::MOVEI T4,.CHSPC
IFL. T1
MOVEI T4,"-"
MOVM T1,T1
ENDIF.
MOVEI T3,3
JRST NBRDS2
NBRDS1: IFLE. T1
PUSH SP,T4
MOVEI T4,.CHSPC
JRST NBRDS3
ENDIF.
NBRDS2: IDIVI T1,^D10
TRO T2,"0"
PUSH SP,T2
NBRDS3: SOJGE T3,NBRDS1
MOVEI T3,3
NBRDS4: POP SP,T2
OUTCHR T2
SOJGE T3,NBRDS4
RET
SUBTTL Fix Floating Point Number for Display
NBRFIX::MOVEI T4,.CHSPC
IFL. T1
MOVEI T4,"-"
MOVM T1,T1
ENDIF.
MOVEI T3,3
JRST NBRFX2
NBRFX1: IFLE. T1
PUSH SP,T4
MOVEI T4,.CHSPC
JRST NBRFX3
ENDIF.
NBRFX2: IDIVI t1,^D10
TRO T2,"0"
PUSH SP,T2
NBRFX3: SOJGE T3,NBRFX1
MOVEI T3,3
NBRFX4: POP SP,T2
DSPCHR T2
SOJGE T3,NBRFX4
RET
SUBTTL Output Number
NBROUT::IFL. T3
DSPTYP <->
MOVM T3,T3
ENDIF.
NR.OUT: IDIVI T3,^D10
PUSH SP,T4
SKIPE T3
CALL NR.OUT
POP SP,T4
ADDI T4,"0"
DSPCHR T4
RET
MSPNBR::IFL. T3
MSPTYP <->
MOVM T3,T3
ENDIF.
MS.OUT: IDIVI t3,^D10
PUSH SP,T4
SKIPE T3
CALL MS.OUT
POP SP,T4
ADDI T4,"0"
MSPCHR T4
RET
SUBTTL Display Floating Point Number
FLTDSP::IDIVI T1,^D1000
PUSH SP,T2
SETZ T3,
FLTDS1: IDIVI T1,^D10
PUSH SP,T2
AOJ T3,
JUMPG T1,FLTDS1
FLTDS2: POP SP,T2
TRO T2,"0"
MSPCHR T2
SOJG T3,FLTDS2
MSPTYP <.>
POP SP,T1
FLTDS3: IDIVI T1,^D10
PUSH SP,T2
AOJ T3,
CAIGE T3,3
JRST FLTDS3
FLTDS4: POP SP,T2
TRO T2,"0"
MSPCHR T2
SOJG T3,FLTDS4
RET
SUBTTL Viewer Display -- Get Item
GETVWR::MOVE T1,ROW
SOJ T1,
IMULI T1,^D78
ADD T1,COL
ADJBP T1,V.TABP
LDB T1,T1
RET
SUBTTL Viewer Display -- Show A Character
;DSPVWR displays one character in viewer
; T1 has blink bit in bit 40, V.ELEM # in right
DSPVWR::MOVE T2,T1
JRST OBJOUT
SUBTTL Viewer Display -- RC Test
RCTEST::CAIGE ROW,2
RET
CAILE ROW,^D12
RET
CAIGE COL,^D8
RET
CAIG COL,^D74
RETSKP
RET
SUBTTL Viewer Display -- Clear Target
TARCLR::MOVE ROW,T.ROW
MOVE COL,T.COL
MOVEI AP,7
MOVEM AP,T.ROW
MOVEI AP,^D41
MOVEM AP,T.COL
CALL TARDSP
RET
SUBTTL Starbase Range Checking
STBASE::MOVEI T1,^D2048
CALL SHPTST
JRST SB.NSH ;No ship in range
SB.TST: MOVE C,U.TAB(UOT)
CAIG T2,^D1024
IFSKP.
CALL SB.ST
JFCL
MOVEI T1,^D6000
JRST TQINS
ENDIF.
TLNE C,1B27
JRST SB.ATT
CAIG T2,^D512
IFSKP.
TLNN C,1B26
CALL DETINS
JRST SB.HIB
ENDIF.
SAVE T1,UOT
CALL ATTINS
REST T1,UOT
SB.ATT: CALL AUTPHA
SB.HIB: MOVEI T1,^D3000
JRST TQINS
SB.NSH: MOVE C,U.TAB(UOT) ;No ship in range
TLZ C,3B27
MOVEM C,U.TAB(UOT)
CALL SB.ST
RET
MOVEI T1,^D6000
JRST TQINS
SB.ST: MOVE C,U.ENER(UOT)
CAML C,MAX.EN
JRST SB.ET
ADDI C,^D150K
CAMLE C,MAX.EN
MOVE C,MAX.EN
MOVEM C,U.ENER(UOT)
RETSKP
SB.ET: MOVE C,U.SHLD(UOT)
CAML C,MAX.EN
RET
ADDI C,^D150K
CAMLE C,MAX.EN
MOVE C,MAX.EN
MOVEM C,U.SHLD(UOT)
RETSKP
SUBTTL Planet Defense
;PLANET
;
; Planet routine. Responsible for launching and retrieving interceptors.
;
; Planet UOT's are a multiple of 4, ie the last 3 bits are 0. The
; planet's three interceptors immediately follow the planet and have
; UOT's equal to the planet uot plus 1, 2, or 3.
;
; If a planet UOT is known, the interceptor UOT's are also known.
; If an interceptor UOT is known, the planet's UOT can be found by
; changing the last 3 bits of the interceptor uot to 0. A number
; of routines depend on this relationship.
PLANET::MOVSI T1,1B29
IORM T1,U.TAB(UOT)
MOVEI T1,^D2048
CALL SHPTST
JRST PL.NSH ;No ship in range
MOVE C,U.TAB(UOT)
CAIG T2,^D1024
IFSKP.
TLNN C,1B26
CALL DETINS
JRST PL.REB
ENDIF.
SAVE UOT
TLNN C,1B27
CALL ATTINS
REST UOT
MOVE T1,U.TAB(UOT)
TLNE T1,7
JRST PL.LCH
TLNE T1,70
IFNSK.
MOVEI T1,^D3000
JRST TQADD
ENDIF.
TLZ T1,100
TLO T1,7
MOVEM T1,U.TAB(UOT)
MOVEI T1,^D150 ;Maximum 15 seconds
MOVEM T1,RAN.MX
SETZM RAN.MN ;Minimum 0 seconds
CALL RANDOM ;Get random number
IMULI T1,^D100 ;Make milliseconds into seconds
JRST TQADD
PL.NSH: MOVE T1,U.TAB(UOT)
TLNE T1,70
JRST PL.GET
TLON T1,1
JRST PL.NSX
TLON T1,2
JRST PL.NSX
TLON T1,4
JRST PL.NSX
TLZ T1,3B27
MOVEM T1,U.TAB(UOT)
JRST PL.REB
PL.NSX: MOVEM T1,U.TAB(UOT)
MOVEI T1,^D10000
JRST TQADD
PL.GET: MOVE T2,UOT
MOVSI T3,1
TLZE T1,10
JRST PL.GT1
AOJ T2,
MOVSI T3,2
TLZE T1,20
JRST PL.GT1
AOJ T2,
MOVSI T3,4
TLZ T1,40
PL.GT1: AOJ T2,
IOR T1,T3
MOVEM T1,U.TAB(UOT)
MOVE T3,U.TAB(T2)
TLO T3,1B18
MOVEM T3,U.TAB(T2)
SETZM TIME.Q(T2)
MOVEI T1,^D5000
CALL TQADD
HRLZ T1,MASK.A
HRRI T1,2 ;Delete object event code
MOVEM T1,EADD.A
MOVEM T2,EADD.B
SETZM EADD.T
JRST LQINS
PL.LCH: MOVE T2,UOT
MOVSI T3,10
TLZE T1,1
JRST PL.LC1
AOJ T2,
MOVSI T3,20
TLZE T1,2
JRST PL.LC1
AOJ T2,
MOVSI T3,40
TLZ T1,4
PL.LC1: AOJ T2,
IOR T1,T3
MOVEM T1,U.TAB(UOT)
MOVE T3,U.TAB(T2)
ANDI T1,7B31
TRZ T3,7B31
IOR T3,T1
TLZ T3,1B18
MOVE T1,UI.E7
MOVEM T1,U.ENER(T2)
MOVE T1,UI.S7
MOVEM T1,U.SHLD(T2)
MOVEM T3,U.TAB(T2)
MOVE UOT,T2
MOVEI T1,^D500
CALL TQADD
TRZ UOT,3
MOVEI T1,^D3000
CALL TQADD
RET
PL.REB: CALL PL.SHP
JRST PL.RB2
GETIME T1
CAMGE T1,REBEL(UOT)
RET
MOVEI C,100
MOVEM C,RAN.MX
SETZM RAN.MN
CALL RANDOM
TRNE T1,1
JRST REBINS
CALL REBTIM
MOVEM T1,REBEL(UOT)
PL.RB2: MOVEI T1,^D3000
JRST TQINS
PL.SHP: MOVE T1,U.TAB(UOT)
ANDI T1,3B31
SKIPN T1
RET
LSH T1,-5
AOS (P)
PL.SH1: MOVE T2,U.ABSX(UOT)
FSBR T2,U.ABSX(T1)
FMPR T2,T2
MOVE C,U.ABSY(UOT)
FSBR C,U.ABSY(T1)
FMPR C,C
FADR T2,C
MOVE C,U.ABSZ(UOT)
FSBR C,U.ABSZ(T1)
FMPR C,C
FADR T2,C
CAMG T2,[4000000] ;1024*1024
RET
ADDI T1,2
CAIG T1,SH.MX
JRST PL.SH1
SOS (P)
RET
SUBTTL Planetary Interceptor Routines
INTERC::CALL INT.MV
CALL INT.TA
RET
INT.MV: MOVE T1,UOT ;Interceptor UOT
MOVE T2,T1
TRZ T1,3 ;Form planet UOT
ANDI T2,3 ;Form coordinate key
MOVE T3,@[U.ABSZ(T1)
U.ABSX(T1)
U.ABSX(T1)]-1(T2)
MOVE T4,@[U.ABSY(T1)
U.ABSZ(T1)
U.ABSY(T1)]-1(T2)
HLRZ T1,U.TAB(UOT)
ANDI T1,17
FADR T3,A.FACT(T1)
FADR T4,B.FACT(T1)
MOVEM T3,@[U.ABSZ(UOT)
U.ABSX(UOT)
U.ABSX(UOT)]-1(T2)
MOVEM T4,@[U.ABSY(UOT)
U.ABSZ(UOT)
U.ABSY(UOT)]-1(T2)
AOJ T1,
CAILE T1,17
SETZ T1,
MOVS C,U.TAB(UOT)
TRZ C,17
IOR C,T1
MOVSM C,U.TAB(UOT)
MOVEI T1,^D2000
CALL TQADD
HRLZ C,MASK.A
HRRI C,1 ;Movement event code
MOVEM C,EADD.A
MOVEM UOT,EADD.B
SETZM EADD.T
JRST LQINS
INT.TA: HLRZ T1,U.TAB(UOT)
ANDI T1,360
LSH T1,-4
CAIL T1,6
SETO T1,
AOJ T1,
LSH T1,4
MOVS T2,U.TAB(UOT)
TRZ T2,360
IOR T2,T1
MOVSM T2,U.TAB(UOT)
TRNE T1,360
RET
MOVEI T1,^D1024
CALL SHPTST
RET ;No ship in range
CALL AUTPHA
RET
DETINS::MOVE C,U.TAB(UOT)
TLO C,1B26
MOVEM C,U.TAB(UOT)
TRNN C,3B31
RET
TRNN C,1B31
IFSKP.
HRRZ C,MASK.F
SKIPA
ENDIF.
HRRZ C,MASK.K
IOR C,UOT
HRLI C,11
MOVSM C,EADD.A
HRRZM T1,EADD.B
SETZM EADD.T
JRST LQINS
ATTINS::MOVE C,U.TAB(UOT)
TLO C,3B27
MOVEM C,U.TAB(UOT)
TRNN C,3B31
RET
TRNN C,1B31
IFSKP.
HRRZ C,MASK.F
SKIPA
ENDIF.
HRRZ C,MASK.K
TRO C,1B27
IOR C,UOT
HRLI C,11
MOVSM C,EADD.A
HRRZM T1,EADD.B
SETZM EADD.T
JRST LQINS
SUBTTL Set Up Planet Rebel Time
REBTIM::GETIME T1
ADDI T1,^D10000
MOVE T2,U.TAB(UOT)
ANDI T2,3B31
MOVEI T3,PL.MX
RTIM1: SKIPGE C,U.TAB(T3)
JRST RTIM2
ANDI C,3B31
CAME C,T2
JRST RTIM2
MOVE C,U.TAB(T3)
ANDI C,17
CAIE C,2
IFSKP.
ADDI T1,^D10000
JRST RTIM2
ENDIF.
CAIE C,3
CAIN C,4
ADDI T1,^D30000
RTIM2: SOJ T3,
CAIL T3,SB.MN
JRST RTIM1
RET
REBINS::MOVE C,U.TAB(UOT)
TRNN C,1B31
IFSKP.
HRRZ C,MASK.F
SKIPA
ENDIF.
HRRZ C,MASK.K
HRLI C,13
MOVSM C,EADD.A
HRRZM UOT,EADD.B
SETZM EADD.T
MOVE C,U.TAB(UOT)
TRZ C,3B31
TRO C,1B29
MOVEM C,U.TAB(UOT)
JRST LQINS
SUBTTL Test For Ship in Range
;SHPTST
;
; Test for nearest ship within a given range of an object. T1 = test
; range. UOT = object UOT. Non-skip return and T1 < 0 if no ship
; is in range. Skip return and T1 = ship UOT if a ship is in range.
; Range is in T2. If object is neutral all ships are tested,
; otherwise only enemy ships are tested.
SHPTST::IMUL T1,T1 ;Square the distance
FLTR T4,T1 ;T4 is the distance to beat
HRRZ C,U.TAB(UOT) ;Get the UOT's U.TAB word
ANDI C,3B31 ;Mask everything but the alliance field
SKIPE C ;Zero means neutral
TRC C,3B31 ;The complement is the enemy
MOVEM C,S.MASK ;Save either neutral (0) or enemy mask
MOVEI T1,117 ;Test ships and interceptors
SETOM F.UOT ;Temp storage if any ship passes the tests
SPT.LP: CAME T1,UOT
SKIPGE T2,U.TAB(T1) ;Active ship?
JRST SPT.NX ;No - skip it
TRNN T2,3B31 ;Neutral?
JRST SPT.NX ;Yes - skip it
MOVE C,T2 ;Going to look for a ship or an interceptor
ANDI C,17
CAIL C,3 ;Ship UIDs are 5 and 6
CAILE C,7 ;Interceptor UID is 7
JRST SPT.NX ;Neither a ship nor an interceptor
SKIPE S.MASK ;If the mask isn't zero,
IFNSK.
XOR T2,S.MASK ;Xor it with U.TAB word;
TRNE T2,3B31 ;If zero, the ship is an enemy,
JRST SPT.NX ;If not zero, it's a friend
ENDIF. ;It's an enemy
SPT.RN: MOVE T3,U.ABSX(UOT) ;Compute range ** 2 = (X1 - X2) ** 2
FSBR T3,U.ABSX(T1)
FMPR T3,T3 ;If any intermediate square is greater than
CAMLE T3,T4 ;the squared least distance
JRST SPT.NX ;the ship is not nearest or is out of range.
MOVE C,U.ABSY(UOT)
FSBR C,U.ABSY(T1)
FMPR C,C
CAMLE C,T4 ;Test the y distance
JRST SPT.NX
FADR T3,C
MOVE C,U.ABSZ(UOT)
FSBR C,U.ABSZ(T1)
FMPR C,C
CAMLE C,T4 ;Test the Z distance
JRST SPT.NX
FADR T3,C
CAMLE T3,T4 ;Test the total distance
JRST SPT.NX ;Ship is not closest or is out of range
MOVEM T3,T4 ;Store the new least distance
MOVEM T1,F.UOT ;Save the ship's uot
SPT.NX: SOJGE T1,SPT.LP
SKIPGE T1,F.UOT ;F.UOT < 0 means no target found.
RET
MOVEM T4,F.DATA
MOVEI C,F.LOC
SAVE T1
CALL SQRT.##
FIXR T2,RS
REST T1
RETSKP
SUBTTL Terminal Flash & Hold Routine
FLSHLD::MOVEI C,FLSH24
MOVE T3,FLSH.C
CAIGE T3,^D5
MOVEI C,FLSH16
CAIGE T3,^D4
MOVEI C,FLSH11
CAIGE T3,^D3
MOVEI C,FLSH05
CAIGE T3,^D2
MOVEI C,FLSH03
CAIGE T3,^D1
MOVEI C,FLSH01
MOVEM C,FLSH.P
SKIPE .GRTYP
CALL GIEXPL
SAVE P1,P2
MOVE P1,FLSH.P
SETZ T4,
CALL FLINS
FLL.1: SKIPN P2,(P1)
JRST FLL.2
HLRZ P2,P2
TRZE P2,1B18
AOJA ROW,FLL11
TRZE P2,1B19
SOJ ROW,
FLL11: SUB COL,P2
HRRZ P2,(P1)
FLL12: CALL FLINS
SOJG P2,FLL12
AOJA P1,FLL.1
FLL.2: SETZM FLSH.T(T4)
REST P1,P2
RET
FLINS: CALL RCTEST
JRST FLI.1
CALL GETVWR
MOVE T3,COL
LSH T3,^D9
IOR T3,ROW
HRL T3,T1
MOVEM T3,FLSH.T(T4)
AOJ T4,
FLI.1: AOJ COL,
RET
GIEXPL::CALL RCTEST
RET
CALL GIPOS
MOVE T3,FLSH.C
CAILE T3,7
MOVEI T3,7
CAIGE T3,1
MOVEI T3,1
GIEX.1: JRST @GIDSP-1(T3)
RET
GIDSP: GISH01
GISH03
GISH05
GISH11
GISH16
GISH24
GISH24
GISH24
GISH24: CAIGE ROW,4
JRST GISM
CAILE ROW,^D10
JRST GISM
CAIGE COL,^D13
JRST GISM
CAILE COL,^D69
JRST GISM
TYPE <
Pp@j@j
\>
RET
GISM: SUBI T3,1
MOVEM T3,FLSH.C
JRST GIEX.1
GISH16: CAIGE ROW,3
JRST GISM
CAILE ROW,^D11
JRST GISM
CAIGE COL,^D15
JRST GISM
CAILE COL,^D71
JRST GISM
TYPE <
Pp@i@i
\>
RET
GISH11: CAIGE ROW,3
JRST GISM
CAILE ROW,^D11
JRST GISM
CAIGE COL,^D14
JRST GISM
CAILE COL,^D72
JRST GISM
TYPE <
Pp@h@h
\>
RET
GISH05: CAIGE ROW,3
JRST GISM
CAILE ROW,^D11
JRST GISM
CAIGE COL,^D13
JRST GISM
CAILE COL,^D73
JRST GISM
TYPE <
Pp@g@g
\>
RET
GISH03: CAIGE COL,^D13
JRST GISM
CAILE COL,^D73
JRST GISM
TYPE <
Pp@f@f
\>
RET
GISH01: TYPE <
Pp@e@e
\>
RET
SUBTTL More Flash Routines (For GIGI Graphics)
FLSHBR::SKIPE .GRTYP
RET
SAVE P1
SETZB P1,V.ROW
FLB.1: SKIPN ROW,FLSH.T(P1)
JRST FLB.2
MOVE COL,ROW
LSH COL,-^D9
ANDI ROW,777
ANDI COL,777
CALL VNEXTP
TYPE < >
AOJA P1,FLB.1
FLB.2: REST P1
RET
FLSHCH::SAVE P1
SETZB P1,V.ROW
SETZM V.MOD
FLC.1: SKIPN ROW,FLSH.T(P1)
JRST FLC.2
HLRZ T1,ROW
MOVE COL,ROW
LSH COL,-^D9
ANDI ROW,777
ANDI COL,777
CALL VNEXTP
CALL DSPVWR
AOJA P1,FLC.1
FLC.2: REST P1
RET
SUBTTL Transfer Energy Wait Routine
TRWAIT::MOVE T2,TOTSP ;Get termnal speed
CAIG T2,^D300
RET
TYPE <
[0;2q>
GETIME AP
ADD AP,T1
MOVEM AP,T.TIME
TR.WT: MOVEI T1,^D250
DISMS%
CALL QTEST
GETIME AP
CAMGE AP,T.TIME
JRST TR.WT
TYPE <
[q>
RET
SUBTTL Phaser Hit
PHAHIT::SKIPG O.RELX(UOT)
RET
FIX T1,O.RANG(UOT)
CAILE T1,^D1028
RET
SAVE T1
CALL CONUOT
CALL CONURC
REST T1
HLRZ T3,EVNT.B(P1) ;Get energy
MOVEI C,^D3 ;Standard size flash05
CAILE t3,^D500 ;Stronger than 500 units
MOVEI C,^D4 ;Yes, make flash bigger
CAILE T1,^D512 ;Is it farther than 512
SUBI C,^D1 ;Yes, make flash smaller
MOVEM C,FLSH.C
CALL FLASCI
RET
FLASCI: CALL FLSHLD
OUTSTR V.ASC
TYPE <
[1;7m>
CALL FLSHBR
TYPE <
[m>
CALL FLSHCH
TYPE <
8>
OUTSTR V.ASC
MOVEI T1,7
MOVEM T1,V.COLR
RET
SUBTTL Photon Hit
PHOHIT::SKIPG O.RELX(UOT)
RET
FIX T1,O.RANG(UOT)
CAILE T1,^D1792
RET
SAVE T1
CALL CONUOT
CALL CONURC
REST T1
MOVEI C,^D5 ;Largest flash size,flsh16
CAILE T1,^D128 ;Is it farther than 128?
MOVEI C,^D4 ;Yes, flsh11
CAILE T1,^D512 ;Is it farther than 512?
MOVEI C,^D3
CAILE T1,^D768 ;Is it farther than 768?
MOVEI C,^D2 ;Yes,flsh03
CAILE T1,^D1028 ;Is it farther than 1028?
MOVEI C,^D1 ;Yes,flsh01
MOVEM C,FLSH.C
CALL FLASCI
RET
SUBTTL Display Explosion
EXPLOD::SKIPG O.RELX(UOT)
RET
FIXR T1,O.RANG(UOT)
CAILE T1,^D3072
RET
SAVE T1,UOT
CALL SCNDEL
SKIPN ROW,ROW.1
IFSKP.
CAMN ROW,T.ROW
CALL TARUPD
MOVE ROW,ROW.1
SETOM V.FLAG
CALL VWRCHG
ENDIF.
REST UOT
CALL CONUOT
CALL CONURC
REST T1
IDIVI T1,^D512
HRRZ C,U.TAB(UOT)
ANDI C,17
CAIN C,7 ;Is it an interceptor?
ADDI T1,4 ;Yes, smaller explosion
CAIN C,3 ;Is it a Federation base?
SUBI T1,2 ;Yes, make it a bigger explosion
CAIN C,4 ;Is it a Klingon base?
SUBI T1,2 ;Yes, make it a bigger explosion
CAIL T1,7
RET
MOVEI C,^D7
SUB C,T1
MOVEM C,FLSH.C
CALL FLALT
RET
SUBTTL Ship Destoryed!
ZAPPED::MOVSI C,1B18
IORM C,U.TAB(SUOT)
MOVE UOT,SUOT
ANDI UOT,1
SETZ C,
ZAP.1: SKIPL U.TAB(UOT)
AOJ C,
ADDI UOT,2
CAIG UOT,SH.MX
JRST ZAP.1
SKIPN .GRTYP
IFSKP.
SKIPN VT241F
TYPE <
Ppp[767,23]@z@z@z@z
\>
ENDIF.
TYPE <
[12;41H
[2K
[B
[2K>
TYPE <
[2A
[2K
[3B
[2K>
TYPE <
[4A
[2K
[5B
[2K>
TYPE <
[6A
[2K
[7B
[2K>
TYPE <
[8A
[2K
[9B
[2K>
TYPE <
[10A
[2K
[11B
[2K>
TYPE <
[12A
[2K
[13B
[2K>
TYPE <
[14A
[2K
[15B
[2K>
TYPE <
[16A
[2K
[17B
[2K>
TYPE <
[18A
[2K
[19B
[2K>
TYPE <
[20A
[2K
[21B
[2K>
TYPE <
[22A
[2K
[23B
[2K>
TYPE <
[;5m>
OUTSTR V.ASC
MOVEI T1,[ASCIZ /
[12;9H
#3/]
SKIPN C
MOVEI T1,[ASCIZ /
[8;9H
#3/]
OUTSTR (T1)
OUTSTR @O.NAME(SUOT)
TYPE < Destroyed!>
MOVEI T2,[ASCIZ /
[13;9H
#4/]
SKIPN C
MOVEI T2,[ASCIZ /
[9;9H
#4/]
OUTSTR (T2)
OUTSTR @O.NAME(SUOT)
TYPE < Destroyed!>
SKIPE C
IFSKP.
MOVEI T1,[ASCIZ /FEDERATION/]
MOVEI T2,[ASCIZ /KLINGON EMPIRE/]
TRNE UOT,1
EXCH T1,T2
TYPE <
[12;9H
#3>
OUTSTR (T1)
TYPE < Defeated!>
TYPE <
[13;9H
#4>
OUTSTR (T1)
TYPE < Defeated!>
TYPE <
[16;9H
#3>
OUTSTR (T2)
TYPE < Victorious!>
TYPE <
[17;9H
#4>
OUTSTR (T2)
TYPE < Victorious!>
ENDIF.
TYPE <
[3B
[m>
MOVEI T1,.CTTRM ;This terminal
DOBE% ;Wait till all characters displayed
CALL STWAIT
AOS A.SHIPS ;Add 1 to auto ship count
CALL WRAPUP
MOVSI C,2000
LSH C,@SUOT
ANDCAM C,MASK.Q
JRST FINI
SUBTTL Energy Transfer Notification
ENETRN::CALL ENEDSP
CALL SHLDSP
MSPINI
MSPTYP <transfer complete>
MSPOUT
RET
SUBTTL Display Sent Message
DSPMSG::IMULI UOT,^D11
TYPE <>
MSPINI
MSPSTR U.MSG(UOT)
MSPOUT
RET
DSPNAM::MOVE AP,U.TAB(UOT)
ANDI AP,7
JRST @NAMDSP-1(AP)
NAMDSP: DNM.ST
DNM.RS
DNM.BS
DNM.BS
DNM.RS
DNM.RS
DNM.IN
DNM.ST: DSPTYP <Star>
RET
DNM.IN: DSPTYP <Interceptor>
RET
DNM.BS: DSPTYP <Starbase >
DNM.RS: DSPSTR @O.NAME(UOT)
RET
MSPNAM::MOVE AP,U.TAB(UOT)
ANDI AP,7
JRST @MSPDSP-1(AP)
MSPDSP: MNM.ST
MNM.RS
MNM.BS
MNM.BS
MNM.RS
MNM.RS
MNM.IN
MNM.ST: MSPTYP <Star>
RET
MNM.IN: MSPTYP <Interceptor>
RET
MNM.BS: MSPTYP <Starbase >
MNM.RS: MSPSTR @O.NAME(UOT)
RET
SUBTTL Unmanned Ship Phaser/Photon Control
;AUTPHA, AUTPHO
;
; Weapons fire from a base, interceptor, or unmanned ship. UOT is
; uot of firing entity. T1 is uot of receiving entity. uses A.FIRE
; work area. AUTPHA fires 200 units phaser, AUTPHO fires 1 torpedo.
AUTPHA::MOVEI C,^D200
MOVEM C,A.FIRE
JRST AUTHIT
AUTPHO::MOVSI C,1B27
HRRI C,^D200
MOVEM C,A.FIRE
; JRST AUTHIT
AUTHIT::HLRZ C,A.FIRE
IOR C,MASK.A
HRLI C,4
MOVSM C,EADD.A
MOVEM UOT,EADD.B
SETZM EADD.T
SAVE T1
CALL LQINS
REST T1
MOVEI C,2000
MOVE T2,U.TAB(T1)
CAIG T1,7
TLNN T2,1B19
IFNSK.
LSH C,@SUOT
SKIPA
ENDIF.
LSH C,@T1
IOR C,UOT
HRLI C,5 ;Hit request event code
MOVSM C,EADD.A
HLLZ C,A.FIRE
IORM C,EADD.A
HRLZ C,A.FIRE
HRR C,T1
MOVEM C,EADD.B
MOVEI C,^D750
MOVEM C,EADD.T
MOVE C,U.ABSX(T1)
MOVEM C,EADD.X
MOVE C,U.ABSY(T1)
MOVEM C,EADD.Y
MOVE C,U.ABSZ(T1)
MOVEM C,EADD.Z
JRST LQINS
SUBTTL Energy Adjustment
ENEADD::IMULI T1,^D1000
SKIPG C,U.SHLD(UOT)
JRST EDA.2
SUB C,T1
IFGE. C
CAIG C,^D100000
MOVN C,C ;Shields down
MOVEM C,U.SHLD(UOT)
RET
ENDIF.
EDA.1: MOVN T1,C
SETZB C,U.SHLD(UOT)
EDA.2: ADD T1,U.ENER(UOT)
SUB T1,C ;C is < 0 - this is an add
CAMLE T1,MAX.EN
MOVE T1,MAX.EN
ADD T1,C ;C is < 0 - this is a subtract
MOVEM T1,U.ENER(UOT)
RET
ENEDEL::IMULI T1,^D1000
SKIPGE AP,U.SHLD(UOT)
JRST EDL.1
SUB AP,T1
JUMPL AP,EDL.2
CAIG AP,^D100000
MOVN AP,AP
MOVEM AP,U.SHLD(UOT)
RET
EDL.1: MOVM AP,U.SHLD(UOT)
ADD T1,T1
SUB AP,T1
JUMPL AP,EDL.3
MOVNM AP,U.SHLD(UOT)
RET
EDL.2: ADD AP,AP
EDL.3: MOVM T1,AP
SETZM U.SHLD(UOT)
EXCH T1,U.ENER(UOT)
SUBM T1,U.ENER(UOT)
RET
PHRSET::CALL DSTROY
SETOM T.UOT
SETZM T.BEAR
SETZM T.ELEV
CALL CONTRC
CALL TARDSP
RET
SUBTTL Object Destoryed
DSTROY::MOVE T1,U.TAB(UOT)
TLO T1,1B18
MOVEM T1,U.TAB(UOT)
ANDI T1,7
CAIE T1,7
IFSKP.
MOVE T2,UOT
ANDI T2,3
MOVSI T1,4
LSH T1,@T2
MOVE T2,UOT
TRZ T2,3
ANDCAM T1,U.TAB(T2)
ENDIF.
CAILE UOT,7 ;Skip if ship
IFSKP.
TLNN T1,1B19 ;Auto ship
SOS A.SHIPS
ENDIF.
CAIL UOT,7
CAILE UOT,120
RET
SETZM TIME.Q(UOT)
RET
SCANSR::SETZ T2,
DO.
SKIPN SCAN.1(T2)
RET
HLRZ T3,SCAN.1(T2)
LSH T3,-^D9
CAME T3,UOT
AOJA T2,TOP.
OD.
HRRZ ROW,SCAN.1(T2)
MOVE COL,ROW
TRZ ROW,-1000
LSH COL,-^D9
RETSKP
SUBTTL Get Message
GETMSG::MOVE T1,M.PTR
MOVEM T1,M.WPTR
MOVE T2,[ASCII/ /]
MOVSI T1,-^D10
GETMS1: MOVEM T2,M.MSG(T1)
AOBJN T1,GETMS1
MOVE T2,[ASCIZ/ /]
MOVEM T2,M.MSG(T1)
MOVE UOT,S.UOT
MOVE T2,[POINT 7,O.INIT(UOT)]
ILDB T2,T2
IDPB T2,M.WPTR
MOVEI T2,":"
IDPB T2,M.WPTR
MOVEI T2,.CHSPC
IDPB T2,M.WPTR
CALL GM.OUT
GM.NXT: TYPE <
7>
PUSH SP,AP
CALL VTGET
POP SP,AP
SKIPE T1,C.INTE
JRST GM.SPE
CAIL AP,^D53
JRST GM.ERR
AOJ AP,
MOVE T2,C.CHAR
IDPB T2,M.WPTR
OUTCHR T2
JRST GM.NXT
GM.SPE: CAIN T1,^D13
JRST GM.EXE
CAIN T1,^D21
JRST GM.CTU
CAIN T1,^D127
JRST GM.DEL
CAIN T1,^D8
JRST GM.DEL
CAIE T1,.CHESC
JRST GM.ERR
MOVE T2,C.CHAR
CAIN T2,","
JRST GM.ERA
GM.ERR: TYPE <>
JRST GM.NXT
GM.DEL: CAIG AP,3
JRST GM.ERR
MOVEI T2,.CHSPC
DPB T2,M.WPTR
TYPE <
[D
[D>
SOJ AP,
MOVE T1,AP
ADJBP T1,M.PTR
MOVEM T1,M.WPTR
JRST GM.NXT
GM.CTU: PUSH SP,AP
MOVEI AP,3
MOVE T1,AP
ADJBP T1,M.PTR
MOVEM T1,M.WPTR
CALL GM.SPC
POP SP,AP
ADJBP AP,M.PTR
SETZ T2,
IDPB T2,AP
CALL GM.OUT
MOVE T1,AP
ADJBP T1,M.PTR
MOVEM T1,M.WPTR
JRST GM.NXT
GM.ERA: MOVE ROW,M.ROW
MOVEI COL,5
CALL VTPOS
OUTSTR SPC.55
JRST GMEXE1
GM.EXE: CAIN AP,3
JRST GM.NXT
CALL GM.SPC
AOS (SP)
GMEXE1: TYPE <
[7;41H
7>
MOVE AP,[XWD M.MSG,UTXT.A+41]
BLT AP,UTXT.A+53
MOVE AP,[XWD M.MSG,UTXT.B+41]
BLT AP,UTXT.B+53
RET
GM.OUT: MOVE ROW,M.ROW
MOVEI COL,6
CALL VTPOS
OUTSTR M.MSG
MOVEI COL,^D9
CALL VTPOS
MOVEI AP,3
RET
GM.SPC: MOVEI T2,.CHSPC
DO.
CAIL AP,^D53
EXIT.
AOJ AP,
IDPB T2,M.WPTR
JRST TOP.
OD.
SETZ T2,
IDPB T2,M.WPTR
RET
SUBTTL Activate a TIME.Q
;TQINS
;
; Activate a TIME.Q entry if not already activated
TQINS:: SKIPG TIME.Q(UOT)
JRST TQADD
RET
TQADD:: GETIME C
ADD T1,C
MOVEM T1,TIME.Q(UOT)
SKIPE C,Q.TIME
CAML C,T1
MOVEM T1,Q.TIME
RET
QTEST:: PUSH P,UOT ;Save UOT
GETIME C
MOVEM C,M.TIME
CALL EQTEST
SKIPN Q.TIME
IFSKP.
MOVE AP,[XWD EADD.A,EWRK.A]
BLT AP,EWRK.Z
CALL TQTEST
MOVE AP,[XWD EWRK.A,EADD.A]
BLT AP,EADD.Z
ENDIF.
POP P,UOT
RET
TQTEST::MOVE T1,M.TIME
CAMG T1,Q.TIME
RET
SETZM Q.TIME
MOVEI UOT,PL.MX+1
TQT.1: SOJL UOT,R
SKIPG T1,TIME.Q(UOT)
JRST TQT.1
CAML T1,M.TIME
IFSKP.
SETZM TIME.Q(UOT)
PUSH P,UOT
CALL TQEXEC
POP P,UOT
JRST TQT.1
ENDIF.
SKIPE AP,Q.TIME
CAML AP,T1
MOVEM T1,Q.TIME
JRST TQT.1
SUBTTL Event Queue Routines -- Event Execution
TQEXEC::MOVE C,U.TAB(UOT)
ANDI C,17
JRST @[PLANET
STBASE
STBASE
STSHIP
STSHIP
INTERC]-2(C)
RET
SUBTTL Event Queue Routines -- Phaser/Photon Fire
PQADD:: MOVEM T1,EADD.T
CAILE UOT,SH.MX
JRST PQA.1
MOVE T1,U.TAB(UOT)
TLNN T1,1B19
JRST PQA.1
MOVEI T1,2000
LSH T1,@UOT
SKIPA
PQA.1: MOVE T1,MASK.C
IOR T1,SUOT
IOR T1,T2 ;Weapons code
HRLI T1,5 ;Hit request event code
MOVSM T1,EADD.A
HRL T1,P.ENER
HRR T1,UOT
MOVEM T1,EADD.B
MOVE T1,U.ABSX(UOT)
MOVEM T1,EADD.X
MOVE T1,U.ABSY(UOT)
MOVEM T1,EADD.Y
MOVE T1,U.ABSZ(UOT)
MOVEM T1,EADD.Z
JRST LQADD
HQADD:: CALL QTEST
JRST HQINS
LQADD:: CALL QTEST
JRST LQINS
HQINS:: MOVEI P1,HQ.MIN
MOVEI P2,HQ.MAX
SAVE UOT
CALL EQINS
REST UOT
RET
LQINS:: MOVEI P1,LQ.MIN
MOVEI P2,LQ.MAX
SAVE UOT
CALL EQINS
REST UOT
RET
EQINS:: MOVE C,MASK.Q
ANDB C,EADD.A
TLNN C,@MASK.A
RET
EQI.1: MOVE P3,P1
SETO C,
EQI.2: EXCH C,EVNT.T(P3)
SKIPE C
IFSKP.
MOVEI C,EVNT.A(P3)
HRLI C,EADD.A
BLT C,EVNT.Z(P3)
AOS C,M.TIME
ADD C,EADD.T
MOVEM C,EVNT.T(P3)
RET
ENDIF.
SKIPGE EVNT.T(P3)
EXCH C,EVNT.T(P3)
ADDI P3,6
CAMG P3,P2
JRST EQI.2
SAVE P1,P2
GETIME C
MOVEM C,M.TIME
CALL EQTEST
REST P1,P2
JRST EQI.1
EQTEST::MOVEI P1,HQ.MIN
MOVEI P2,HQ.MAX
CALL EQSCAN
MOVEI P1,LQ.MIN
MOVEI P2,LQ.MAX
CALL EQSCAN
RET
EQSCAN::SETZ P3,
EQS.1: SKIPLE C,EVNT.T(P1)
CAMLE C,M.TIME
JRST EQS.2
MOVE C,EVNT.A(P1)
TLNN C,@MASK.C
JRST EQS.2
MOVEM P1,WORK.Q(P3)
AOJ P3,
EQS.2: ADDI P1,6
CAMG P1,P2
JRST EQS.1
EQS.3: MOVE T1,P3
MOVE T2,M.TIME
AOJ T2,
SETO T3,
EQS.4: SOJL T1,EQS.5
SKIPGE C,WORK.Q(T1)
JRST EQS.4
CAMG T2,EVNT.T(C)
JRST EQS.4
MOVE T3,T1
MOVE T2,EVNT.T(C)
JRST EQS.4
EQS.5: SKIPGE T3
RET
MOVE P1,WORK.Q(T3)
SETOM WORK.Q(T3)
CALL EQEXEC
MOVS C,MASK.C
ANDCAB C,EVNT.A(P1)
TLNN C,@MASK.A
SETZM EVNT.T(P1)
JRST EQS.3
SUBTTL Event Queue Routines -- Event Handling (Dispatch)
EQEXEC::HRRZ UOT,EVNT.B(P1) ;Get the UOT of the 'object' ship.
HRRZ T1,EVNT.A(P1) ;Get the event code.
ANDI T1,77 ;Mask the event code fields.
CAIE T1,0 ;Return if zero.
JRST @XECDSP-1(t1) ;Notify planet has rebelled.
RET ;None of the above.
XECDSP: MOVOBJ ;Movement.
DELOBJ ;Delete an object.
DSPMSG ;Display ship-ship message
HITDSP ;Display a hit.
HITREQ ;Process a hit.
HITACK ;Acknowledge a hit.
HITDST ;Hit caused an object's destruction.
ENETRN ;Transfer energy.
DETMSG ;Notify detected or attacking.
DALERT ;Notify needs assistance.
REBMSG
SUBTTL Event Queue Routines -- Move Object
MOVOBJ::SKIPGE U.TAB(UOT)
RET
CALL RBELOD
CAMN UOT,T.UOT
CALL TARUPD
CALL SCNDEL
CALL SCNTST
JRST VWRTST
SUBTTL Event Queue Routines -- Delete Object From Existance
DELOBJ::CALL SCNDEL
SETZM ROW.2
JRST VWRTST
SUBTTL Event Queue Routines -- Display Hit On Object
HITDSP::FIX AP,O.RANG(UOT)
CAILE AP,^D2048
RET
CALL SCANSR
RET
MOVE T2,AP
MOVE AP,EVNT.A(P1)
TLNE AP,1B27
JRST PHODSP
; JRST PHADSP
PHADSP: CAIG T2,^D1024
CALL RCTEST
RET
CALL VTPOS
CALL GIPOS
SKIPN .GRTYP
TYPE <
[1;7m>
MOVEI T1,^D8
MOVE T3,.GRTYP ;Graphics type
PHA.1: CALL PHA.DS
SOJG T1,PHA.1
SKIPN .GRTYP
TYPE <
[m>
SKIPN .GRTYP
IFSKP.
SKIPN .TTTYP
JRST PHA.2
ENDIF.
CALL GETVWR
SETZM V.MOD
CALL DSPVWR
PHA.2: OUTSTR V.ASC
TYPE <
8>
MOVEI T1,7
MOVEM T1,V.COLR
RET
PHA.DS: JRST .+1(t3) ;Depending on term type
JRST PHA100
JRST PHAGIG
PHA100: OUTSTR V.ASC
TYPE <
[D>
RET
PHAGIG: TYPE <
Pp@w
\> ;Enter REGIS, do macrograph w, return
MOVEI T1,1 ;Only do it once
RET
PHODSP: MOVEI C,^D2
CAILE T2,^D512
MOVEI C,^D1
MOVEM C,FLSH.C
CALL FLASCI
RET
SUBTTL Event Queue Routines -- Hit Request
;HITREQ
;
; Initiated by the PHASER, PHOTON, or AUTHIT routines. Determines
; whether an object has been hit. Two cases are handled:
;
; 1: Something hits us (UOT = SUOT).
; 2: We hit a non-ship (UOT not = SUOT).
;
; In both cases, only one ship processes a hit request (and therefore
; has exclusive control of the evnt data). Depending upon the outcome
; of this routine, the hit request is changed to a hit acknowledge
; (HITACK) or a hit destroy (HITDST), and the evnt.a ship mask is
; changed so that other ships can process it.
HITREQ::MOVEI AP,6 ;Hit acknowledge event code
HRRM AP,EVNT.A(P1)
CAME UOT,SUOT
JRST HR.OTH
HR.US: HLRZ AP,EVNT.A(P1)
ANDI AP,377
SKIPGE U.TAB(AP)
RET
CALL HITTST
RET
HLRZ T1,EVNT.B(P1)
CALL ENEDEL
CALL HITUS
MOVM AP,U.SHLD(UOT)
ADD AP,U.ENER(UOT)
SKIPGE AP
IFSKP.
CALL HITMSG
JRST HITCHG
ENDIF.
AOS EVNT.A(P1)
CALL HITCHG
JRST ZAPPED
HR.OTH: SKIPGE U.TAB(UOT)
RET
HLRZ T1,EVNT.B(P1)
CALL ENEDEL
MOVM AP,U.SHLD(UOT)
ADD AP,U.ENER(UOT)
SKIPGE AP
IFSKP.
CALL ATTACK
CALL HITACK
JRST HITCHG
ENDIF.
CALL DSTROY
HLRZ AP,EVNT.A(P1)
ANDI AP,377
CAME AP,SUOT
IFSKP.
SETOM T.UOT
SETZM T.BEAR
SETZM T.ELEV
CALL CONTRC
CALL TARDSP
ENDIF.
CALL HITDST
AOS EVNT.A(P1)
JRST HITCHG
HITCHG::MOVE C,EVNT.A(P1)
TLO C,@MASK.A
AND C,MASK.Q
TLZ C,@MASK.C
TLNE C,@MASK.A
MOVEM C,EVNT.A(P1)
RET
ATTACK::HRRZ C,U.TAB(UOT)
ANDI C,17
CAIE C,7
CAIN C,2
JRST ATT.PL
CAIE C,3
CAIN C,4
IFNSK.
CALL ATT.MS
JRST ATT.EX
ENDIF.
RET
ATT.PL: SAVE UOT
TRZ UOT,3
CALL ATT.MS
HLRZ C,EVNT.A(P1)
ANDI C,377
MOVE C,U.TAB(C)
TRNN C,3B31
IFNSK.
REST UOT
JRST ATT.EX
ENDIF.
ANDI C,3B31
TRC C,3B31
MOVEM C,S.MASK
ATT.P1: MOVE C,U.TAB(UOT)
TRZ C,3B31
IOR C,S.MASK
MOVEM C,U.TAB(UOT)
AOJ UOT,
TRNE UOT,3
JRST ATT.P1
REST UOT
ATT.EX: MOVEI T1,^D2000
CALL TQINS
RET
ATT.MS: MOVEI C,1B18
MOVE T1,U.TAB(UOT)
TLON T1,3B28
IORM C,EVNT.A(P1)
MOVEM T1,U.TAB(UOT)
RET
SUBTTL Event Queue Routines -- Hit Test
HITTST::MOVE T1,U.ABSX(UOT)
FSBR T1,EVNT.X(P1)
FMPR T1,T1
CAMLE T1,[4096.0]
RET
MOVE C,U.ABSY(UOT)
FSBR C,EVNT.Y(P1)
FMPR C,C
FADRM C,T1
CAMLE T1,[4096.0]
RET
MOVE C,U.ABSZ(UOT)
FSBR C,EVNT.Z(P1)
FMPR C,C
FADRM AP,T1
CAMG T1,[4096.0]
RETSKP
RET
SUBTTL Event Queue Routines -- Our Ship Has Been Hit
HITUS:: MOVE T1,.TTTYP
JRST .+1(T1)
JRST HIT.VT
JRST HIT.GG
HIT.VT: SKIPE VT241F ;VT241?
IFSKP. ;Nope, do screen flash
TYPE <
[?5h
[?5l>
TYPE <
[?5h
[?5l>
TYPE <
[?5h
[?5l>
TYPE <
[?5h
[?5l>
TYPE <
[?5h
[?5l>
ELSE. ;If VT241,
OUTSTR @HIT241 ;Then just change colors twice
OUTSTR @SET241
OUTSTR @HIT241
OUTSTR @SET241
ENDIF.
CALL ENEDSP
CALL SHLDSP
RET
HIT.GG: TYPE <
Pp>
MOVE SUOT,S.UOT
SKIPG U.SHLD(SUOT)
TYPE <@r@r@r@r@s>
SKIPE U.SHLD(SUOT)
TYPE <@y@y@y@y@s>
TYPE <
\>
CALL ENEDSP
CALL SHLDSP
RET
SUBTTL Event Queue Routines -- Describe Weapon Hit
HITMSG::MSPINI
HLRZ T3,EVNT.B(P1)
CALL MSPNBR
MSPTYP < unit hit by >
HLRZ T1,EVNT.A(P1)
TRNE T1,1B27
IFSKP.
MSPTYP <phasers>
SKIPA
ENDIF.
MSPTYP <photon torpedo>
MSPOUT
RET
SUBTTL Event Queue Routines -- Display Weapon Hits On Viewer Objects
HITACK::HLRZ C,EVNT.A(P1)
TRNN C,1B27
IFSKP.
CALL PHOHIT
SKIPA
ENDIF.
CALL PHAHIT
CALL ATTMSG
RET
;Ship hit by an attack in distance
HITDST::CALL EXPLOD
CALL DSTMSG
RET
SUBTTL Event Queue Routines -- Notification Of Attacks
ATTMSG::MOVE C,EVNT.A(P1)
TRNN C,1B18
RET
MOVE C,ALLY.U
TDNN C,U.TAB(UOT)
RET
MSPINI
SAVE UOT
HLRZ UOT,EVNT.A(P1)
ANDI UOT,377
CALL MSPNAM
MSPTYP < attacking >
REST UOT
CALL MSPNAM
MSPOUT
RET
SUBTTL Event Queue Routines -- Notification Of Ship Destruction
DSTMSG::HRRZ C,U.TAB(UOT)
ANDI C,17
CAIN C,7
RET
MSPINI
CALL MSPNAM
MSPTYP < destroyed>
MSPOUT
RET
SUBTTL Event Queue Routines -- Notification Of Enemy Detection
DETMSG::MSPINI
MOVE C,EVNT.A(P1)
TLNE C,1B27
JRST DET.A
DET.D: CALL MSPNAM
MSPTYP < detected by >
SAVE UOT
HLRZ UOT,EVNT.A(P1)
ANDI UOT,377
CALL MSPNAM
REST UOT
MSPOUT
RET
DET.A: SAVE UOT
HLRZ UOT,EVNT.A(P1)
ANDI UOT,377
CALL MSPNAM
REST UOT
MSPTYP < attacking >
CALL MSPNAM
MSPOUT
RET
SUBTTL Event Queue Routines -- Notification Of Planet Rebellion
REBMSG::MSPINI
MSPTYP <rebellion on >
MSPSTR @O.NAME(UOT)
MSPOUT
RET
SUBTTL Event Queue Routines -- Display Alert
DALERT::MSPINI
MSPSTR @O.NAME(UOT)
HLRZ C,EVNT.B(P1)
XCT [MSPTYP < needs assistance>
MSPTYP < on RED ALERT>
MSPTYP < on YELLOW ALERT>
MSPTYP < secure from alert>](C)
MSPOUT
RET
SUBTTL Unmanned Ship Control Missions
;STSHIP
;
; These routines control the activities of unmanned ships. Ship
; behavior is governed by a set of 'missions'.
STSHIP::CALL ASETUP
CALL NRLOAD
HRRZ T4,N.MSSN(UOT)
JRST @STSDSP(t4)
STSDSP: STSH.0
STSH.1
STSH.2
STSH.2
STSH.2
STSH.2
STSH.0: CALL AI.REF
RET
JRST STSH.3
STSH.1: CALL AC.REF
RET
JRST STSH.3
STSH.2: CALL AI.REF
RET
CALL @[AC.ESH
AC.EBA
AC.CAP
AC.HLP]-2(T4)
RET
STSH.3: CALL AI.ESH
RET
CALL AI.HLP
RET
CALL AI.EBA
RET
CALL AI.CAP
RET
JRST AU.SEA
SUBTTL Ship Mask Setup
;ASETUP
;
; Sets up us-them masks for this ship.
ASETUP::MOVEI C,1
DMOVE T1,MASK.F
TDNE C,UOT
EXCH T1,T2
DMOVEM T1,MSKA.U
DMOVE T1,ALLY.F
TDNE C,UOT
EXCH T1,T2
DMOVEM T1,ALYA.U
MOVM C,U.SHLD(UOT)
ADD C,U.ENER(UOT)
MOVEM C,N.ENER
MOVEI T1,^D50
JRST SALLOC
SUBTTL Build Ranges For All Non-star Objects
;NRLOAD
;
; Builds a table of ranges from this ship for all non-star objects.
; saves the UOT and range of the nearest object of a class (planet,
; Fed base, Kli base, etc) and of the nearest neu, Fed, and Kli
; planet. Also catalogs objects within 1024 units (short range
; scan function).
NRLOAD::SAVE P1,P2,P3
SETOM N.RANG
MOVE C,[XWD N.RANG,N.RANG+1]
BLT C,N.RANG+117
SETOM N.NUOT
MOVE C,[XWD N.NUOT,N.NUOT+1]
BLT C,N.NUOT+7
SETO C,
TLZ C,1B18
MOVEM C,N.NRAN
MOVE C,[XWD N.NRAN,N.NRAN+1]
BLT C,N.NRAN+7
SETZM N.PCNT
SETZM N.SCNT
MOVE T1,U.ABSX(UOT)
MOVE T2,U.ABSY(UOT)
MOVE T3,U.ABSZ(UOT)
MOVEI T4,117
NRL.1: SKIPL P2,U.TAB(T4)
CAMN T4,UOT
JRST NRL.3
MOVE P1,T1
FSBR P1,U.ABSX(T4)
FMPR P1,P1
MOVEM P1,F.DATA
MOVE P1,T2
FSBR P1,U.ABSY(T4)
FMPR P1,P1
FADRM P1,F.DATA
MOVE P1,T3
FSBR P1,U.ABSZ(T4)
FMPR P1,P1
FADRM P1,F.DATA
MOVEI C,F.LOC
SAVE T1
CALL SQRT.##
REST T1
FIXR RS,RS
MOVEM RS,N.RANG(T4)
ANDI P2,17
;..
;..
CAIG RS,^D1024
CALL NCATAL
CAIE P2,2
JRST NRL.2
MOVE P2,U.TAB(T4)
TRNE P2,@ALYA.U
AOS N.PCNT
TRNN P2,@MSKA.U
JRST NRL.3
ANDI P2,3B31
LSH P2,-4
NRL.2: CAML RS,N.NRAN(P2)
JRST NRL.3
MOVEM RS,N.NRAN(P2)
MOVEM T4,N.NUOT(P2)
NRL.3: SOJGE T4,NRL.1
MOVE C,UOT
TRNE C,1
CALL NRSWAP
REST P1,P2,P3
RET
SUBTTL Short Range Scan Catalog
;NCATAL
;
; The short range scan catalog routine.
NCATAL::CAILE T4,7
IFSKP.
MOVE C,ALYA.T
TDNN C,U.TAB(T4)
RET
AOS N.SCNT
MOVE C,U.ABSX(T4)
MOVEM C,U.LSTX(T4)
MOVE C,U.ABSY(T4)
MOVEM C,U.LSTY(T4)
MOVE C,U.ABSZ(T4)
MOVEM C,U.LSTZ(T4)
JRST NCAT.1
ENDIF.
CAIE P2,7
CAIN P2,1
RET
SKIPG TIME.Q(T4)
CALL NQINS
NCAT.1: MOVE C,MSKA.U
IORM C,U.TAB(T4)
RET
NQINS:: MOVE C,ALLY.N
TDNE C,U.TAB(T4)
RET
GETIME C
MOVEM C,TIME.Q(T4)
SKIPE Q.TIME
CAMGE C,Q.TIME
MOVEM C,Q.TIME
RET
;NRSWAP
;
; Swaps UOTs and ranges of near bases and ships.
NRSWAP::DMOVE T1,NRPL.U
EXCH T1,T2
DMOVEM T1,NRPL.U
DMOVE T1,NRSB.U
EXCH T1,T2
DMOVEM T1,NRSB.U
DMOVE T1,NRSH.U
EXCH T1,T2
DMOVEM T1,NRSH.U
DMOVE T1,NUPL.U
EXCH T1,T2
DMOVEM T1,NUPL.U
DMOVE T1,NUSB.U
EXCH T1,T2
DMOVEM T1,NUSB.U
DMOVE T1,NUSH.U
EXCH T1,T2
DMOVEM T1,NUSH.U
RET
SUBTTL Unmanned Ship Missions -- Travel to Planet/Base
;AU.SEA, MISSION 0
;
; The basic mission, performed when no other mission applies.
; A tour at warp 7 of all bases and friendly planets. Refuels
; at each stop.
AU.SEA::SETZM N.MSSN(UOT)
SKIPG T1,N.MUOT(UOT)
JRST AU.SE1
SKIPL C,U.TAB(T1)
TRNN C,@ALYA.U
JRST AU.SE1
JRST AU.SE2
AU.SE1: CALL AUBASE
JRST AU.SE3
MOVEM T1,N.MUOT(UOT)
AU.SE2: MOVE C,N.RANG(T1)
CAILE C,^D512
JRST A.MOV7
MOVE C,N.ENER
CAMGE C,MAX.EN
JRST A.REEN
CALL AUNXTB
JRST AU.SE3
MOVEM T1,N.MUOT(UOT)
JRST A.MOV7
AU.SE3: MOVEI T1,^D1000
JRST TQINS
SUBTTL Unmanned Ship Missions -- Retreat to Base & Refuel
;AX.REF, MISSION 1
;
; Retreat to a base and refuel
AI.REF::MOVE C,N.ENER
CAMGE C,[^D2500K]
CALL AUBASE
RETSKP
MOVEM T1,N.MUOT(UOT)
MOVEI C,1 ;REF mission code.
MOVEM C,N.MSSN(UOT)
JRST AU.REF
AC.REF::MOVE C,N.ENER
CAML C,MAX.EN
JRST ASKIPR
MOVE T1,N.MUOT(UOT)
SKIPL C,U.TAB(T1)
TRNN C,@ALYA.U
IFNSK.
CALL AUBASE
JRST ASKIPR
MOVEM T1,N.MUOT(UOT)
ENDIF.
; JRST AU.REF
AU.REF::HLRZ C,N.MSSN(UOT)
JUMPG C,AU.RE2
AU.RE1: MOVE C,N.RANG(T1)
CAIGE C,^D512
JRST AU.RE9
JRST AU.RE8
AU.RE2: MOVEI C,^D1024
CAMGE C,NRPL.T
CAML C,NRPL.N
JRST AU.RE5
CAML C,NRSB.T
JRST AU.RE5
SKIPG T2,N.SCNT
JRST AU.RE9
CAILE T1,SB.MX
JRST AU.RE6
CAILE T2,1
JRST AU.RE4
MOVE C,N.ENER
CAMGE C,[^D2000K]
JRST AU.RE9
MOVEI C,0
HRLM C,N.MSSN(UOT)
MOVE T1,NUSH.T
CALL A.PENE
JRST A.PHAS
AU.RE4: CALL AUNXSB
JRST AU.RE7
AU.RE5: CAIG T1,SB.MX
JRST AU.RE8
AU.RE6: SKIPL T1,NUSB.U
JRST AU.RE7
MOVE T1,N.MUOT(UOT)
CALL AUNXTB
SKIPA T1,N.MUOT(UOT)
AU.RE7: MOVEM T1,N.MUOT(UOT)
AU.RE8: MOVEI C,0
HRLM C,N.MSSN(UOT)
CAILE T1,SB.MX
SKIPE N.SCNT
JRST A.MOV8
JRST A.MOV7
AU.RE9: MOVEI C,1
HRLM C,N.MSSN(UOT)
JRST A.REEN
SUBTTL Unmanned Ship Missions -- ESH Mission
;AX.ESH, MISSION 2
AI.ESH::MOVE C,NRSH.T
CAILE C,^D1024
RETSKP
MOVE T1,NUSH.T
MOVEM T1,N.MUOT(UOT)
MOVEI C,2 ;ESH mission code.
MOVEM C,N.MSSN(UOT)
JRST AU.ES2
AC.ESH::MOVE T1,N.MUOT(UOT)
MOVE C,NRSH.T
CAIG C,^D1024
JRST AC.ES1
MOVE C,N.RANG(T1)
CAILE C,^D1536
JRST ASKIPR
HLRZ C,N.MSSN(UOT)
JUMPE C,AU.ES3
SKIPG U.TORP(UOT)
JRST AU.ES3
JRST AU.ES1
AC.ES1: CAIN T1,NUSH.T
JRST AC.ES2
MOVE T1,NUSH.T
MOVEM T1,N.MUOT(UOT)
JRST AU.ES2
AC.ES2: HLRZ C,N.MSSN(UOT)
JUMPN C,AU.ES2
MOVE C,N.RANG(T1)
CAIG C,^D256
JRST AU.ES2
JRST AU.ES3
AU.ES1::MOVEI C,0
HRLM C,N.MSSN(UOT)
JRST A.PHOT
AU.ES2::MOVEI C,0
HRLM C,N.MSSN(UOT)
CALL A.PENE
JRST A.PHAS
AU.ES3::MOVEI C,1
HRLM C,N.MSSN(UOT)
JRST A.MOV7
SUBTTL Unmanned Ship Missions -- EBA Mission
;AX.EBA, MISSION 3
AI.EBA::MOVE C,N.PCNT
CAILE C,8
SKIPG T1,NUSB.T
RETSKP
MOVEM T1,N.MUOT(UOT)
MOVEI C,3 ;EBA mission code.
MOVEM C,N.MSSN(UOT)
JRST AU.EBA
AC.EBA::MOVE T1,N.MUOT(UOT)
MOVE C,N.PCNT
CAILE C,8
SKIPGE U.TAB(T1)
JRST ASKIPR
MOVEI C,^D1024
CAMLE C,NRSH.T
JRST ASKIPR
CAMG C,NRPL.T
CAMLE C,NRPL.N
JRST ASKIPR
JRST AU.EBA
AU.EBA::MOVE C,N.RANG(T1)
CAIL C,^D2048
JRST A.MOV7
SKIPLE U.TORP(UOT)
JRST A.PHOT
CAIL C,^D1024
JRST A.MOV7
MOVEI T2,^D500
JRST A.PHAS
SUBTTL Unmanned Ship Missions -- Capture Planet
;AX.CAP, MISSION 4
;
; Capture a planet.
AI.CAP::MOVE T1,NUPL.T
MOVE T2,NRPL.T
CAMG T2,NRPL.N
JRST AI.CA1
MOVE T1,NUPL.N
MOVE T2,NRPL.N
AI.CA1: SKIPGE T1
RETSKP
MOVEI C,4 ;CAP mission code.
MOVEM C,N.MSSN(UOT)
MOVEM T1,N.MUOT(UOT)
JRST AU.CAP
AC.CAP::MOVE C,NRSH.T
CAIG C,^D1024
JRST ASKIPR
HRRZ T1,N.MUOT(UOT)
MOVE T2,N.RANG(T1)
; JRST AU.CAP
AU.CAP::MOVE C,U.TAB(T1)
TRNE C,@ALYA.U
JRST ASKIPR
CAIL T2,^D512
JRST A.MOV7
TLNN C,100
JRST AU.CA3
AU.CA1: AOJ T1,
TRNN T1,3
JRST AU.CA2
SKIPGE U.TAB(T1)
JRST AU.CA1
MOVEI T2,^D500
JRST A.PHAS
AU.CA2: SUBI T1,4
SAVE UOT
MOVE UOT,T1
SETZ T1,
CALL TQINS
REST UOT
MOVEI T1,^D750
JRST TQINS
AU.CA3: SETZM N.MSSN(UOT)
SETOM N.MUOT(UOT)
MOVE C,U.TAB(T1)
TRZ C,7B31
IOR C,ALYA.U
MOVEM C,U.TAB(T1)
MOVEM T1,^D1000
JRST TQINS
SUBTTL Unmanned Ship Missions -- Respond to Other Ship's Red Alert
;AX.HLP, MISSION 5
AI.HLP::MOVE T3,U.ALRT(UOT)
AND T3,MSKA.U
SKIPN T3
RETSKP
MOVEI T1,7
MOVEI T2,1B18
AI.HL1: CAME T1,UOT
TDNN T3,T2
JRST AI.HL2
SKIPL U.TAB(T1)
JRST AI.HL3
AI.HL2: LSH T2,-1
SOJGE T1,AI.HL1
RETSKP
AI.HL3: MOVEM T1,N.MUOT(UOT)
HRLM T2,N.MUOT(UOT)
MOVEI C,5 ;HLP mission code
MOVEM C,N.MSSN(UOT)
JRST AU.HLP
AC.HLP::HRRZ T1,N.MUOT(UOT)
CAME T1,UOT
SKIPGE U.TAB(T1)
JRST AC.HL1
HLRZ T2,N.MUOT(UOT)
TDNE T2,U.ALRT(UOT)
JRST AU.HLP
AC.HL1: ANDCAM T2,U.ALRT(UOT)
JRST ASKIPR
AU.HLP::MOVE C,N.RANG(T1)
CAILE C,^D256
JRST A.MOV7
SKIPLE C,U.SHLD(T1)
JRST AU.HL9
MOVM C,C
ADD C,U.ENER(T1)
CAMLE C,[^D200K]
JRST AU.HL9
MOVE C,MASK.A
HRLI C,4
MOVSM C,EADD.A
MOVEM UOT,EADD.B
SETZM EADD.T
SAVE T1,T2
CALL LQINS
REST T1,T2
MOVE C,U.ENER(T1)
ADD C,[^D400K]
MOVEM C,U.ENER(T1)
MOVE C,U.ENER(UOT)
SUB C,[^D400K]
MOVEM C,U.ENER(UOT)
MOVE C,T2
IOR C,UOT
HRLI C,10
MOVSM C,EADD.A
MOVEM T1,EADD.B
MOVE C,N.RANG(T1)
MOVEM C,EADD.T
SAVE T2
CALL LQINS
REST T2
ANDCAM T2,U.ALRT(UOT)
SETZM N.MSSN(UOT)
SETOM N.MUOT(UOT)
MOVEI T1,^D4000
JRST TQINS
AU.HL9: ANDCAM T2,U.ALRT(UOT)
JRST ASKIPR
SUBTTL Unmanned Ship Missions -- Allocate Energy to Shields
;SALLOC
;
; Allocates a percent of UOT's total energy to the shields. T1
; contains the integer percent, eg 50 for 50 percent.
SALLOC::SAVE T2,T3
MOVE C,N.ENER
MOVE T2,C
IMUL T2,T1
IDIVI T2,^D100
SUB C,T2
MOVEM C,U.ENER(UOT)
CAIG T2,^D100000
MOVN T2,T2
MOVEM T2,U.SHLD(UOT)
REST T2,T3
RET
AUNXSB::SAVE T2,T3,T4
MOVE T2,UOT
ANDI T2,1
ADDI T2,SB.MN
SETZ T3,
SETO T4,
TLZ T4,1B18
ANS.1: CAME T2,T1
SKIPGE U.TAB(T2)
JRST ANS.2
CAMG T4,N.RANG(T2)
JRST ANS.2
MOVE T3,T2
MOVE T4,N.RANG(T2)
ANS.2: ADDI T2,2
CAIG T2,SB.MX
JRST ANS.1
SKIPE T3
MOVE T1,T3
REST T2,T3,T4
RET
SUBTTL Find Nearest Base
;AUBASE
;
; Returns UOT of nearest base in T1, range in T2. If no base exists,
; T1 < 0 and non-skip, otherwise a skip return.
AUBASE::MOVE T1,NUPL.U
MOVE T2,NRPL.U
CAMG T2,NRSB.U
JRST AUBAS1
MOVE T1,NUSB.U
MOVE T2,NRSB.U
AUBAS1: SKIPL T1
RETSKP
RET
AUNXTB::MOVEI T2,SB.MN
MOVE T3,T1
CALL AUNXB
IFNSK.
SOS T2,T1
MOVEI T3,PL.MX
CALL AUNXB
RET
ENDIF.
MOVE T1,T3
RETSKP
AUNXB: SOJ T3,
CAMGE T3,T2
RET
SKIPL C,U.TAB(T3)
TRNN C,@ALYA.U
JRST AUNXB
ANDI C,17
CAIL C,2
CAILE C,4
JRST AUNXB
RETSKP
SUBTTL Reenter Game
A.REEN::MOVE T2,T1
MOVE T1,UOT
CALL REENER
MOVEI T1,^D1500
JRST TQINS
SUBTTL Phaser Energy Based on Automatic Ships
;A.PENE
; Determine phaser energy dependant of number
; of active automatic ships
A.PENE::MOVEI T2,^D600 ;1 to 3 ships
SAVE T1
MOVE T1,A.SHIPS
CAILE T1,3
MOVEI T2,^D450 ;4 to 5 ships
CAILE T1,5
MOVEI T2,^D300 ;6 to 7 ships
REST T1
RET
A.PHOT::SOS U.TORP(UOT)
MOVSI C,1B27
HRRI C,^D200
MOVEM C,A.FIRE
SKIPA
A.PHAS::MOVEM T2,A.FIRE
HRRZ C,A.FIRE
IMUL C,C
EXCH C,U.ENER(UOT)
SUBM C,U.ENER(UOT)
CALL AUTHIT
MOVEI T1,^D5000
MOVE T2,A.SHIPS
CAIG T2,2
MOVEI T1,^D3000 ;Less time for 2 or 1 ship left
JRST TQINS
A.MOV7::MOVEI T2,7
JRST A.MOVE
A.MOV8::MOVEI T2,8
; JRST A.MOVE
A.MOVE::CALL AUTXYZ
MOVE T1,N.RANG(T1)
CALL AUTMOT
JFCL
MOVEI T3,^D2500
JRST TQINS
SUBTTL Automatic Ship Movement
;AUTMOT
;
; Moves UOT toward or away from coor A.ABSn at warp factor T2.
; T2 > 0 moves toward, T2 < 0 moves away. Adjusts T2 down if
; insufficient energy for move, after 50/50 reallocation. Skip
; return if move okay. Non-skip return if ship needs energy.
; T1 must contain range from UOT to coordinates.
AUTMOT::SAVE T1,T2
MOVM T3,T2
MOVE C,U.ENER(UOT)
AM.1: CAML C,WF.ENE(T3)
JRST AM.2
SOJGE T3,AM.1
REST T1,T2
RET
AM.2: REST T1,T2
MOVE C,WF.ENE(T3)
EXCH C,U.ENER(UOT)
SUBM C,U.ENER(UOT)
MOVE C,WF.DIS(T3)
SKIPGE T2
MOVN C,C
MOVE T2,C
CALL AUTMOV
RETSKP
;AUTXYZ
;
; Moves absolute coordinates of object T1 to A.ABSn.
AUTXYZ::MOVE C,U.ABSX(T1)
MOVEM C,A.ABSX
MOVE C,U.ABSY(T1)
MOVEM C,A.ABSY
MOVE C,U.ABSZ(T1)
MOVEM C,A.ABSZ
RET
REPEAT 0,<
;AUTDIS (not referenced 1/8/81)
;
; Computes T1 = range between UOT and coordinates A.ABSn.
AUTDIS::MOVE C,U.ABSX(UOT)
FSBR C,A.ABSX
FMPR C,C
MOVEM C,F.DATA
MOVE C,U.ABSY(UOT)
FSBR C,A.ABSY
FMPR C,C
FADRM C,F.DATA
MOVE C,U.ABSZ(UOT)
FSBR C,A.ABSZ
FMPR C,C
FADRM C,F.DATA
MOVEI C,F.LOC
CALL SQRT.##
FIXR T1,RS
RET
> ;End of REPEAT 0
;AUTMOV
;
; Move object UOT toward (or away from) coordinates A.ABSX, A.ABSY,
; A.ABSZ at warp T2. T2 > 0 moves toward, T2 < 0 moves away. T1
; must contain range from UOT to coordinates.
AUTMOV::SKIPG T1
RET
SAVE P1,P2,P3
FLTR T3,T2
FLTR C,T1
FDVR T3,C
MOVE T4,[1.0]
FSBR T4,T3
FMPRM T3,A.ABSX
MOVE P1,U.ABSX(UOT)
FMPR P1,T4
FADR P1,A.ABSX
FMPRM T3,A.ABSY
MOVE P2,U.ABSY(UOT)
FMPR P2,T4
FADR P2,A.ABSY
FMPRM T3,A.ABSZ
MOVE P3,U.ABSZ(UOT)
FMPR P3,T4
FADR P3,A.ABSZ
MOVEM P1,U.ABSX(UOT)
MOVEM P2,U.ABSY(UOT)
MOVEM P3,U.ABSZ(UOT)
REST P1,P2,P3
HRLZ C,MASK.A
HRRI C,1
MOVEM C,EADD.A
MOVEM UOT,EADD.B
SETZM EADD.T
JRST LQINS
SUBTTL Unmanned Ship Request For Mission
ASKIPR::SETZM N.MSSN(UOT)
SETOM N.MUOT(UOT)
JRST RSKP
SUBTTL Game Setup
SETUP:: SETOM U.SIDE
CALL INTLOK
CALL GAMCHK
SETZ T1,
MOVEI SUOT,SH.MX
SET.A: MOVE C,U.TAB(SUOT)
TLNE C,3B19
AOJ T1,
SOJGE SUOT,SET.A
CAIGE T1,SH.CT
IFSKP.
TYPEC <
[H
[JNo ships available, try again later>
SETZM I.LOCK
JRST FINI ;And stop now
ENDIF.
TYPE <
[H
[J>
SKIPN GAM.NR
IFSKP.
TYPE <Tournament Game >
OUTCHR GAM.NR
CRLF
SKIPA
ENDIF.
TYPEC <Random Game>
CALL SU.PLA
CALL SU.AVA
CRLF
CRLF
TYPE <Enter the initial of the ship you wish to command: _
[D
7>
JRST SET.G
SET.E: TYPE <
[D_
[D>
TYPE <>
MOVEI T1,.PRIIN
CFIBF%
SET.G: INCHRW T1
CAIG T1,.CHSPC
JRST SET.E+1
OUTCHR T1
TRZ T1,1B30
MOVEM T1,C.CHAR
MOVEI SUOT,7
DO.
MOVE T2,[POINT 7,O.INIT(SUOT)]
ILDB T2,T2
CAMN T2,C.CHAR
EXIT.
SOJGE SUOT,TOP.
JRST SET.E
OD.
CAIN T2,"C"
JRST SET.K
CAIN T2,"R"
JRST SET.K
CAIN T2,"H"
JRST SET.K
CAIE T2,"P"
JRST SET.N1
SET.K: MOVEI T2,[ASCIZ /
PpS(M0(AD)1(AM)2(AW)3(AY))
\/]
MOVEM T2,SET241 ;Different color for you Klingons
MOVEI T2,[ASCIZ /
PpS(M0(AD)1(AM)2(AW)3(AR))
\/] ;When torps are fired
MOVEM T2,SETTOR ;Put it in for Klingons
OUTSTR @SET241 ;Set it up now
SET.N1: MOVE T2,U.TAB(SUOT)
TLNE T2,3B19
JRST SET.E
SKIPGE U.SIDE
IFSKP.
HRRZ C,SUOT
ANDI C,1
CAME C,U.SIDE
JRST SET.E
ENDIF.
TLO T2,1B19
MOVEM T2,U.TAB(SUOT)
GETIME C
SETZM TIME.Q(SUOT)
MOVEM SUOT,S.UOT
CALL USRLOD
MOVEI T2,2000
LSH T2,@SUOT
MOVEM T2,MASK.C
ANDCAM T2,MASK.O
TSO T2,MASK.Q
MOVSM T2,MASK.Q
MOVE T2,MASK.F
MOVE C,SUOT
ANDI C,1
MOVEM T2,MASK.U(C)
MOVE T2,ALLY.F
MOVEM T2,ALLY.U(C)
SOS A.SHIPS ;Decrement auto ship count
SET.X: SETZM I.LOCK ;Release the interlock (set in the
RET ;INTLOK routine) and return.
SUBTTL Check For Game Time Expiration
GAMCHK::TIME%
MOVE T2,T1
MOVEI UOT,SH.MX+1
GCHK.1: SOJL UOT,[SETZM U.TTY
MOVE C,[XWD U.TTY,U.TTY+1]
BLT C,U.TTY+SH.MX
JRST SELECT]
SKIPL C,U.TAB(UOT)
TLNN C,1B19
JRST GCHK.1
MOVE C,U.TIME(UOT)
SUB C,T2
SKIPG C
MOVN C,C
CAMLE C,[^D300000]
JRST GCHK.1
SAVE T2
GJINF%
MOVE C,T4
REST T2
MOVEI UOT,SH.MX+1
GCHK.2: SOJL UOT,R
CAME C,U.TTY(UOT)
JRST GCHK.2
MOVE C,UOT
ANDI C,1
MOVEM C,U.SIDE
GCHK.3: SKIPL U.TAB(C)
JRST GCHK.4
ADDI C,2
CAIG C,SH.MX
JRST GCHK.3
MOVEI T1,[ASCIZ /Federation/]
TRNE C,1
MOVEI T1,[ASCIZ /Klingon Empire/]
TYPE <
[H
[JThe >
OUTSTR (T1)
TYPE < has been defeated!>
SETZM I.LOCK
JRST FINI
GCHK.4: MOVE T1,U.WAIT(UOT) ;Get the wait time.
SUB T1,T2 ;Subtract the current time.
IDIVI T1,^D1000 ;Convert to seconds.
JUMPLE T1,[SETZM U.TTY(UOT) ;if not > 0, reset the tty nr
RET] ;and return.
TYPE <
[H
[JRe-entry in > ;Must wait - TYPE the wait message.
IDIVI T1,^D60 ;Display the time in mins and secs.
PUSH P,T2 ;Routine displays minutes if minutes
SKIPN T1 ; are > 0, otherwise only displays
IFSKP. ; seconds.
PUSH P,T1
CALL TIMOUT
TYPE < minute>
MOVEI C,[ASCIZ /s, /]
POP P,T1
CAIN T1,1
MOVEI C,[ASCIZ /, /]
OUTSTR (C)
ENDIF.
MOVE T1,0(P)
CALL TIMOUT
TYPE < second>
POP P,T1
CAIE T1,1
TYPE <s>
CRLF
SETZM I.LOCK
HALTF%
INCHRW C
CAIN C,"Z"
RET
JRST FINI
SUBTTL Display Current Time
TIMOUT: IDIVI T1,^D10 ;Displays a number without leading
SAVE T2 ;zeroes.
SKIPE T1
CALL TIMOUT
REST T2
ADDI T2,"0"
OUTCHR T2
RET
SUBTTL Startup Interlock Routine
;INTLOK
;
; Prevents two players from starting up at the same time. If I.LOCK < 0
; hibers for a second and tries again. When other player is finished
; I.LOCK will be = 0. This routine then sets I.LOCK < 0 to exclude
; other players and returns.
INTLOK::TIME%
SETO C,
EXCH C,I.LOCK
JUMPE C,ILOK.2 ;Interlock set - exit
MOVE C,t1 ;Compares current time with I.TIME,
SUB C,I.TIME ;Which is the time the other player
SKIPGE C ;grabbed I.LOCK. if the difference
MOVN C,C ;If > 5 mins, assume something is
CAMLE C,[^D300000] ;wrong (crash during startup) and
JRST ILOK.2 ;give player control immediately.
TYPE <
[H
[JStart-up interlock, please stand by >
ILOK.1: EXCH C,T1
MOVEI T1,^D1000 ;Wait 1
DISMS%
EXCH T1,C
SETO C,
EXCH C,I.LOCK
JUMPN C,ILOK.1
ILOK.2: MOVEM T1,I.TIME ;Save for future use by other startups.
RET ;Player now controls interlock.
SUBTTL Display Ships in Play
;SU.PLA
;
; Displays ships currently in play.
SU.PLA::MOVEI T1,SH.MX+1
SU.PL0: SOJL T1,R
SKIPL C,U.TAB(T1)
TLNN C,1B19
JRST SU.PL0
CRLF
TYPEC <Ships in play:>
CALL SU.HED
MOVEI C,.CHCRT
MOVNI T1,2
MOVNI T2,1
SU.PL1: CRLF
SETZ T3,
SU.PL2: CAIL T1,6
JRST SU.PL3
ADDI T1,2
SKIPL T4,U.TAB(T1)
TLNN T4,1B19
JRST SU.PL2
OUTCHR C
TYPE < >
OUTSTR @O.NAME(T1)
OUTCHR C
TYPE <
[15C>
MOVE UOT,T1
CALL SU.USR
SETO T3,
SU.PL3: CAIL T2,7
JRST SU.PL4
ADDI T2,2
SKIPL T4,U.TAB(T2)
TLNN T4,1B19
JRST SU.PL3
OUTCHR C
TYPE <
[38C>
OUTSTR @O.NAME(T2)
OUTCHR C
TYPE <
[51C>
MOVE UOT,T2
CALL SU.USR
JRST SU.PL1
SU.PL4: JUMPN T3,SU.PL1
RET
SU.USR: TYPE <(>
SAVE T1,T2
MOVEI T1,.PRIOU
MOVE T2,U.NAMX(UOT)
DIRST%
JFCL
REST T1,T2
TYPE <)>
RET
SUBTTL Dsiplay Available Ships
;SU.AVA
;
; Displays ships currently available.
SU.AVA::CRLF
TYPEC <Available ships:>
CALL SU.HED
MOVEI C,.CHCRT
MOVNI T1,2
MOVNI T2,1
SU.AV1: CRLF
SETZ T3,
SU.AV2: SKIPG U.SIDE
CAIL T1,6
JRST SU.AV3
ADDI T1,2
MOVE T4,U.TAB(T1)
TLNE T4,3B19
JRST SU.AV2
OUTCHR C
TYPE < >
OUTSTR @O.NAME(T1)
SETO T3,
SU.AV3: SKIPE U.SIDE
CAIL T2,7
JRST SU.AV4
ADDI T2,2
MOVE T4,U.TAB(T2)
TLNE T4,3B19
JRST SU.AV3
OUTCHR C
TYPE <
[38C>
OUTSTR @O.NAME(T2)
JRST SU.AV1
SU.AV4: JUMPN T3,SU.AV1
RET
SU.HED: CRLF
OUTSTR SU.LN1
CRLF
OUTSTR SU.LN2
RET
SUBTTL Find User Job Information
USRLOD: GJINF%
MOVEM T3,U.JOB(SUOT)
MOVEM T1,U.NAMX(SUOT)
MOVEM T4,U.TTY(SUOT)
RET
SUBTTL Random Rotation
ROTRAN::MOVEI C,^D360
MOVEM C,RAN.MX
SETZM RAN.MN
CALL RANDOM
FLTR T1,T1
MOVEM T1,B1
CALL RANDOM
FLTR T1,T1
MOVEM T1,E1
CALL ROT.ZY
RET
SUBTTL Select Ship At Startup
;SELECT
;
; First player in the game selects startup options. This routine
; initializes the game.
SELECT::TYPE <
[H
[JEnter a tournament number from 1 to 9 >
TYPEC <to load a tournament game;>
TYPE <Enter any other character to load a random game: _
[D
7>
INCHRW P2
OUTCHR P2
CRLF ;Display CRLF to acknowledge.
CAIL P2,"1"
CAILE P2,"9"
JRST SEL.RN
SEL.TR: MOVEM P2,GAM.NR ;Tournament game:
ANDI P2,17 ;cycle the randomizer 3 * tournament
IMULI P2,3 ;number times.
SELTR1: CALL RANDOM
SOJG P2,SELTR1
JRST SEL.LD
SEL.RN: SETZM GAM.NR ;Random game:
CALL RANSET ;Seed the randomizer with time (ms)
SEL.LD: CALL LOADQ ;Init the queue.
MOVEI C,^D8
MOVEM C,A.SHIPS
JRST LOADU ;Init the universal object table.
SUBTTL Initialize Event Queue
;LOADQ
;
; Initializes the event queue.
LOADQ:: MOVE C,[XWD 1777,777777]
MOVEM C,MASK.Q
SETZM Q
MOVE C,[XWD Q,Q+1]
BLT C,Q+Q.SIZE-1
SETZM TIME.Q
MOVE C,[XWD TIME.Q,TIME.Q+1]
BLT C,TIME.Q+117
RET
SUBTTL Load Universal Object Table
;***** LOADU
;
; Loads the universal object table. All objects are loaded,
; including inactive ships. Objects are spaced a minimum of
; 512 units from each other.
LOADU:: SETZ UOT,
LU.NXT: CALL LU.UOT
CAIN T1,7
JRST LOADU1
CALL LU.LIM ;Get range limits
LUNXT1: CALL LU.XYZ ;Get universal X, Y, and Z
CALL LU.TST ;Test 512 distances
JRST LUNXT1 ;Not 512 from all other objects
CALL LU.MOV ;Move universal X, Y, and Z to UOT
LOADU1: CAIGE UOT,217 ;All objects loaded?
AOJA UOT,LU.NXT ;No, repeat for next object
RET ;Table loaded
LU.UOT: MOVE T1,U.TAB(UOT)
ANDI T1,7
MOVE C,UI.T0(T1)
MOVEM C,U.TAB(UOT)
MOVE C,UI.E0(T1)
MOVEM C,U.ENER(UOT)
MOVE C,UI.S0(T1)
MOVEM C,U.SHLD(UOT)
CAILE UOT,7
RET
MOVEI C,^D10
MOVEM C,U.TORP(UOT)
MOVEI C,^D10000
MOVEM C,TIME.Q(UOT)
MOVE C,UOT
TRO C,10
MOVEM C,N.MUOT(UOT)
SETZM N.MSSN(UOT)
SETZM U.ABSX(UOT)
SETZM U.ABSY(UOT)
SETZM U.ABSZ(UOT)
SETZM U.ALRT(UOT)
SETZM U.TIME(UOT)
SETZM U.JOB(UOT)
SETZM U.TTY(UOT)
SETZM U.NAMX(UOT)
RET
LU.LIM: MOVEI T2,1
CAIE T1,1 ;Star?
IFSKP.
MOVEI T1,^D4000
JRST LU.LM1
ENDIF.
CAIE T1,2 ;Planet?
IFSKP.
MOVEI T1,^D2000
JRST LU.LM1
ENDIF.
MOVEI T2,^D1250 ;Set narrow limits
MOVEI T1,^D2250 ;Assures a reasonable separation
LU.LM1: MOVEM T2,RAN.MN ;Save as random number generator
MOVEM T1,RAN.MX ;MIN and MAX range
AOS T2,XYZ.I
CAIL T2,10
SETZB T2,XYZ.I
RET ;Return to calling routine
LU.XYZ: CALL RANDOM ;Get random x (ran.nr is also in t1)
MOVEM T1,X1 ;Save as x
CALL RANDOM ;Get random y
MOVEM T1,Y1 ;Save as y
CALL RANDOM ;Get random z
MOVEM T1,Z1 ;Save as z
CALL LU.STR
JRST LU.XYZ
MOVE T2,XYZ.I
MOVE T2,XYZ.T(T2)
MOVE T1,X1
TRNN T2,4 ;Test if x is to be negative
MOVN T1,T1 ;(3 tests will select 1 of 8 sectors)
FLTR T1,T1 ;Convert to floating point
MOVEM T1,X1 ;Save as x
MOVE T1,Y1
TRNN T2,2 ;Test if y is to be negative
MOVN T1,T1 ;(the 2nd test)
FLTR T1,T1 ;Convert to floating point
MOVEM T1,Y1 ;Save as y
MOVE T1,Z1
TRNN T2,1 ;Test if z is to be negative
MOVN T1,T1 ;(the 3rd test)
FLTR T1,T1 ;Convert to floating point
MOVEM T1,Z1 ;Save as z
RET ;Return to calling routine
LU.STR: AOS (P)
MOVE T1,U.TAB(UOT)
ANDI T1,7
CAIE T1,1
RET
MOVEI T1,^D2000
CAMG T1,X1
RET
CAMG T1,Y1
RET
CAMLE T1,Z1
SOS (P)
RET
LU.TST: IFLE. UOT ;Don't test if 1st element
AOS (P) ;Form skip return
RET ;Return to calling routine
ENDIF.
MOVN T3,UOT
HRLZ T3,T3
DO.
MOVE T1,U.TAB(T3)
ANDI T1,7
CAIN T1,7
JRST LU.TS2
MOVE T1,X1 ;Distance formula:
FSBR T1,U.ABSX(T3) ; d ** 2 =
FMPR T1,T1 ; (x - ux) ** 2) +
MOVEM T1,T2 ; (y - uy) ** 2) +
MOVE T1,Y1 ; (z - uz) ** 2)
FSBR T1,U.ABSY(T3)
FMPR T1,T1
FADRM T1,T2
MOVE T1,Z1
FSBR T1,U.ABSZ(T3)
FMPR T1,T1
FADRM T1,T2
CAMG T2,[262144.0] ;Must be greater that 512 ** 2
RET ;Failed test
LU.TS2: AOBJN T3,TOP. ;Try the next entry
OD.
RETSKP ;Passed test for all entries
LU.MOV: MOVE T2,U.TAB(UOT)
ANDI T2,7
MOVE T1,X1 ;Get x
MOVEM T1,U.ABSX(UOT) ;Store x
CAIN T2,2
MOVEM T1,1+U.ABSX(UOT)
MOVE T1,Y1 ;Get y
MOVEM T1,U.ABSY(UOT) ;Store y
CAIN T2,2
MOVEM T1,2+U.ABSY(UOT)
MOVE T1,Z1 ;Get z
MOVEM T1,U.ABSZ(UOT) ;Store z
CAIN T2,2
MOVEM T1,3+U.ABSZ(UOT)
RET ;Return to calling routine
SUBTTL Random Number Generator Seeder
;RANSET
;
; Seeds the FORTRAN random number generator with the current
; time of day.
RANSET::TIME%
MOVEM T1,RAN.SD
PUSH SP,RS
PUSH SP,AP
MOVEI AP,[0,,RAN.SD]
CALL SETRAN##
POP SP,AP
POP SP,RS
RET
SUBTTL Get Random Number
;RANDOM
;
; Gets a random number RAN.NR between RAN.MN and RAN.MAX from the
; FORTRAN random number generator.
RANDOM::MOVE T1,RAN.MX ;The formula is
SUB T1,RAN.MN ;NBR = min + ran * (max - min + 1)
AOJ T1, ;where 0 < ran < 1
FLTR T1,T1
SAVE T1 ;RAN uses T1
SETZ RS,
CALL RAN## ;Number is returned in AC0
REST T1
FMPR T1,RS
FIX T1,T1
ADD T1,RAN.MN
MOVEM T1,RAN.NR
RET
SUBTTL Initialize The PSI System
;INIPSI
;
; Initializes CTRL-C trapping.
INIPSI::CIS% ;Clear interrupt system
MOVEI T1,ICTRAP ;Control-C routine name
HRRM T1,CHNTAB+1 ;Put it in the channel table
MOVEI T1,.FHSLF ;This fork
MOVE T2,[LEVTAB,,CHNTAB] ;Here's the level table and channel table
SIR% ;Set address for those tables
EIR% ;Enable interrupts
MOVX T2,<1B1+1B2> ;Channels 1 and 2
AIC% ;Activate these channels
MOVE T1,[.TICCC,,1] ;Put CTRL-C on channel 1
ATI% ;Do it
ERJMP .+1 ;In case user has disabled this
MOVE T1,[.TICTI,,2] ;Put typein on channel 2
ATI% ;Do it
ERJMP .+1
RET
SUBTTL Control C Trapping Routine
;Here if ^C during game startup
ICTRAP::TYPE <
[H
[J> ;Clear the screen
SETZM I.LOCK ;Clear game interlock
CALL TTYRST ;Reset original terminal characteristics
MOVEI AP,ICEND ;Debreak to here
MOVEM AP,LEV1PC ;Make sure it is seen
DEBRK% ;Done
ERJMP .+1 ;Just in case
ICEND: JRST FINI ;Game is over
;Here if ^C during game
CCTRAP::TYPE <
[H
[J>
CALL STWAIT
MOVE C,U.TAB(SUOT)
TLZ C,1B19
MOVEM C,U.TAB(SUOT)
AOS A.SHIPS ;Add 1 to auto ship count
CALL WRAPUP
MOVEI AP,CCEND
MOVEM AP,LEV1PC
DEBRK%
ERJMP .+1
CCEND: JRST FINI
SUBTTL Reentry Wait
;STWAIT
;
; Sets the time (ms) after which a player may reenter the game.
STWAIT::EXCH C,T1
TIME%
ADD T1,[DEC 120000] ;Add 2 minutes
EXCH T1,C
MOVEM C,U.WAIT(SUOT) ;Save as time to wait.
RET
SUBTTL Cleanup When We Leave (or Are Destroyed)
;WRAPUP
;
; Performs cleanup after a ship is destroyed, quits, or
; Control-C's.
WRAPUP::SKIPE .TTTYP ;Skip if not GIGI
TYPE <
PrVC3
\> ;Turn cursor back on
MOVSI C,2000
LSH C,@SUOT
ANDCAM C,MASK.Q
MOVS C,MASK.C
MOVS T1,MASK.A
MOVEI P1,Q.SIZE-6
WRUP.1: SKIPG EVNT.T(P1)
JRST WRUP.2
ANDCAM C,EVNT.A(P1)
TDNN T1,EVNT.A(P1)
SETZM EVNT.T(P1)
WRUP.2: SUBI P1,6
JUMPGE P1,WRUP.1
WRUP.3: MOVEI C,^D5000
MOVEM C,TIME.Q(SUOT)
MOVEI T1,.PRIIN
CFIBF%
OUTSTR V.ASC
TYPE <
[m>
CALL TTYRST
RET
OBLOAD::CALL OTABLD
CALL SCANLD
CALL TARUPD
CALL VIEWLD
RET
OTABLD::MOVEI UOT,217
DO.
SKIPL U.TAB(UOT)
IFSKP.
MOVE AP,[9999.0]
MOVEM AP,O.RANG(UOT)
JRST OTABL1
ENDIF.
CAME UOT,SUOT
CALL RBELOD
OTABL1: SOJGE UOT,TOP.
OD.
RET
RBELOD::MOVE T1,U.ABSX(UOT)
MOVEM T1,X1
MOVE T1,U.ABSY(UOT)
MOVEM T1,Y1
MOVE T1,U.ABSZ(UOT)
MOVEM T1,Z1
CALL RBECMP
MOVE T1,X1
MOVEM T1,O.RELX(UOT)
MOVE T1,Y1
MOVEM T1,O.RELY(UOT)
MOVE T1,Z1
MOVEM T1,O.RELZ(UOT)
MOVE T1,R1
MOVEM T1,O.RANG(UOT)
MOVE T1,B1
MOVEM T1,O.BEAR(UOT)
MOVE T1,E1
MOVEM T1,O.ELEV(UOT)
RET
RBECMP::MOVE T1,X1
FSBR T1,U.ABSX(SUOT)
MOVEM T1,X2
MOVE T1,Y1
FSBR T1,U.ABSY(SUOT)
MOVEM T1,Y2
MOVE T1,Z1
FSBR T1,U.ABSZ(SUOT)
MOVEM T1,Z2
MOVE T1,X2
FMPR T1,S.11
MOVEM T1,X1
MOVE T1,Y2
FMPR T1,S.12
FADRM T1,X1
MOVE T1,Z2
FMPR T1,S.13
FADRM T1,X1
MOVE T1,X2
FMPR T1,S.21
MOVEM T1,Y1
MOVE T1,Y2
FMPR T1,S.22
FADRM T1,Y1
MOVE T1,Z2
FMPR T1,S.23
FADRM T1,Y1
MOVE T1,X2
FMPR T1,S.31
MOVEM T1,Z1
MOVE T1,Y2
FMPR T1,S.32
FADRM T1,Z1
MOVE T1,Z2
FMPR T1,S.33
FADRM T1,Z1
MOVE T1,X1
FMPR T1,T1
MOVEM T1,X2
MOVEM T1,F.DATA
MOVE T1,Y1
FMPR T1,T1
MOVEM T1,Y2
FADRM T1,F.DATA
MOVE T1,Z1
FMPR T1,T1
MOVEM T1,Z2
FADRM T1,F.DATA
MOVEI C,F.LOC
CALL SQRT.##
MOVEM RS,R1
MOVE T1,Y1
FDVR T1,X1
MOVEM T1,B1
MOVE T1,X2
FADR T1,Y2
MOVEM T1,F.DATA
MOVEI C,F.LOC
CALL SQRT.##
MOVE T1,Z1
FDVR T1,RS
MOVEM T1,E1
RET
SUBTTL Ship Rotation -- Z & Y
ROT.ZY::MOVE T1,B1
CALL SINCOS
CALL ROT.Z
MOVE T1,E1
CALL SINCOS
CALL ROT.Y
RET
SUBTTL Ship Rotation -- X Only
ROT.X:: CALL SAVMAT
MOVE T1,A.21 ;s.21 = (a.31 * sin.a) + (a.21 * cos.a)
FMPR T1,COS.A
MOVEM T1,S.21
MOVE T1,A.31
FMPR T1,SIN.A
FADRM T1,S.21
MOVE T1,A.21 ;s.31 = (a.31 * cos.a) - (a.21 * sin.a)
FMPR T1,SIN.A
MOVEM T1,S.31
MOVE T1,A.31
FMPR T1,COS.A
FSBRM T1,S.31
MOVE T1,A.22 ;s.22 = (a.32 * sin.a) + (a.22 * cos.a)
FMPR T1,COS.A
MOVEM T1,S.22
MOVE T1,A.32
FMPR T1,SIN.A
FADRM T1,S.22
MOVE T1,A.22 ;s.32 = (a.32 * cos.a) - (a.22 * sin.a)
FMPR T1,SIN.A
MOVEM T1,S.32
MOVE T1,A.32
FMPR T1,COS.A
FSBRM T1,S.32
MOVE T1,A.23 ;s.23 = (a.33 * sin.a) + (a.23 * cos.a)
FMPR T1,COS.A
MOVEM T1,S.23
MOVE T1,A.33
FMPR T1,SIN.A
FADRM T1,S.23
MOVE T1,A.23 ;s.33 = (a.33 * cos.a) - (a.23 * sin.a)
FMPR T1,SIN.A
MOVEM T1,S.33
MOVE T1,A.33
FMPR T1,COS.A
FSBRM T1,S.33
RET
SUBTTL Ship Rotation -- Y Only
ROT.Y:: CALL SAVMAT
MOVE T1,A.11 ;s.11 = (a.31 * sin.a) + (a.11 * cos.a)
FMPR T1,COS.A
MOVEM T1,S.11
MOVE T1,A.31
FMPR T1,SIN.A
FADRM T1,S.11
MOVE T1,A.11 ;s.31 = (a.31 * cos.a) - (a.11 * sin.a)
FMPR T1,SIN.A
MOVEM T1,S.31
MOVE T1,A.31
FMPR T1,COS.A
FSBRM T1,S.31
MOVE T1,A.12 ;s.12 = (a.32 * sin.a) + (a.12 * cos.a)
FMPR T1,COS.A
MOVEM T1,S.12
MOVE T1,A.32
FMPR T1,SIN.A
FADRM T1,S.12
MOVE T1,A.12 ;s.32 = (a.32 * cos.a) - (a.12 * sin.a)
FMPR T1,SIN.A
MOVEM T1,S.32
MOVE T1,A.32
FMPR T1,COS.A
FSBRM T1,S.32
MOVE T1,A.13 ;s.13 = (a.33 * sin.a) + (a.13 * cos.a)
FMPR T1,COS.A
MOVEM T1,S.13
MOVE T1,A.33
FMPR T1,SIN.A
FADRM T1,S.13
MOVE T1,A.13 ;s.33 = (a.33 * cos.a) - (a.13 * sin.a)
FMPR T1,SIN.A
MOVEM T1,S.33
MOVE T1,A.33
FMPR T1,COS.A
FSBRM T1,S.33
RET
SUBTTL Ship Rotation -- Z Only
ROT.Z:: CALL SAVMAT
MOVE T1,A.11 ;s.11 = (a.21 * sin.a) + (a.11 * cos.a)
FMPR T1,COS.A
MOVEM T1,S.11
MOVE T1,A.21
FMPR T1,SIN.A
FADRM T1,S.11
MOVE T1,A.11 ;s.21 = (a.21 * cos.a) - (a.11 * sin.a)
FMPR T1,SIN.A
MOVEM T1,S.21
MOVE T1,A.21
FMPR T1,COS.A
FSBRM T1,S.21
MOVE T1,A.12 ;s.12 = (a.22 * sin.a) + (a.12 * cos.a)
FMPR T1,COS.A
MOVEM T1,S.12
MOVE T1,A.22
FMPR T1,SIN.A
FADRM T1,S.12
MOVE T1,A.12 ;s.22 = (a.22 * cos.a) - (a.12 * sin.a)
FMPR T1,SIN.A
MOVEM T1,S.22
MOVE T1,A.22
FMPR T1,COS.A
FSBRM T1,S.22
MOVE T1,A.13 ;s.13 = (a.23 * sin.a) + (a.13 * cos.a)
FMPR T1,COS.A
MOVEM T1,S.13
MOVE T1,A.23
FMPR T1,SIN.A
FADRM T1,S.13
MOVE T1,A.13 ;s.23 = (a.23 * cos.a) - (a.13 * sin.a)
FMPR T1,SIN.A
MOVEM T1,S.23
MOVE T1,A.23
FMPR T1,COS.A
FSBRM T1,S.23
RET
SAVMAT: MOVE T1,[S.11,,A.11]
BLT T1,A.11+^D8
RET
SUBTTL Do SINE & COSINE Trig Functions
SINCOS::SAVE T1,T2
MOVEI AP,F.LOC
MOVEM T1,F.DATA
CALL SIND.##
MOVEM RS,SIN.A
CALL COSD.##
MOVEM RS,COS.A
REST T1,T2
RET
SUBTTL UOT For Screen Display
CONUOT::MOVE T1,O.BEAR(UOT)
MOVEM T1,B1
MOVE T1,O.ELEV(UOT)
MOVEM T1,E1
MOVE T1,O.RANG(UOT)
MOVEM T1,R1
MOVE T1,O.RELX(UOT)
MOVEM T1,X1
MOVE T1,O.RELY(UOT)
MOVEM T1,Y1
MOVE T1,O.RELZ(UOT)
MOVEM T1,Z1
CALL CONANG
RET
CONANG::MOVE AP,E1
CALL ATANA
MOVEM RS,E1
MOVE AP,B1
CALL ATANA
SKIPL X1
JRST CONAN1
MOVE AP,[-180.0]
SKIPG RS
MOVM AP,AP
FADR RS,AP
CONAN1: MOVEM RS,B1
RET
CONTRC::MOVE ROW,T.ELEV
FMPR ROW,[-0.25]
FADR ROW,[7.0]
FIXR ROW,ROW
MOVE COL,T.BEAR
FMPR COL,[0.625]
FADR COL,[41.0]
FIXR COL,COL
RET
CONURC::MOVE ROW,E1
FMPR ROW,[-0.25]
FADR ROW,[7.0]
FIXR ROW,ROW
MOVE COL,B1
FMPR COL,[0.625]
FADR COL,[41.0]
FIXR COL,COL
RET
SUBTTL Calculate ARCTANGENT of Angle
ATANA:: CALL FATAN
FMPR RS,[57.29577951]
RET
FATAN:: SAVE T1,T2,T3
MOVEM C,F.DATA
MOVEI C,F.LOC
CALL ATAN.##
REST T1,T2,T3
RET
SUBTTL Get Command Sequence From Terminal
;VTCMD
;
; Gets a command sequence from the terminal, returns the following:
;
; c.cmd - nbr of the command (0 = no cmd)
; c.dir - direction
; 0 = no direction
; 1 = up (FED or FWD)
; 2 = down (KLI or BAK)
; 3 = right (ALL)
; 4 = left (PLA)
; 5 = help
; c.nbr1 - 1st number
; c.nbr2 - 2nd number
; c.cnt - number of numbers entered
; c.imm - immediate execute flag
; 0 = no immediate command
; 1 = SR SCAN (FED)
; 2 = SR SCAN (KLI)
; 3 = SR SCAN (ALL)
; 4 = SR SCAN (PLA)
; 5 = LR SCAN
; 6 = RAPID FIRE PAHSER
; 7 = RAPID FIRE PHOTON
; -1 = more
VTCMD:: TYPE <
8>
OUTSTR V.ASC
SETZM C.IMM ;Reset the immediate flag
SKIPLE AP,C.DIR
CAIE AP,5
SKIPA
IFNSK.
SETZM C.DIR
TYPE <
[16;45H
[7m
8>
OUTSTR V.ASC
ENDIF.
VC.1ST: CALL VCGET ;Get 1st char of 1st field
JRST VC.EXE ;Execute entry comes back here
JRST VC.HLP ;Help requests come back here
JRST VC.CAN ;CMD cancel comes back here
JRST VC.CAN ;Backspace (delete) comes back here
CALL VC.IMM ;Test immediate entry (arrow)
JRST VC.EXE ;Immediate execute
SETZM C.CMD ;Reset the returned variables
SETZM C.DIR ;Can't reset these up front because
SETZM C.NBR1 ;An execute can mean repeat a previous
SETZM C.NBR2 ;Command
SETZM C.CNT
CAIE T1,.CHESC ;Escape sequence?
JRST VC.1C ;No - try letters
CALL VC.IFN ;Keypad function (escape followed by number)?
JRST VC.1A ;No - perhaps the keypad dash
ANDI T2,17 ;Convert ASCII to binary
AOJ T2, ;Increment to form command nbr
JRST VC.1B ;Jump to keypad routine
VC.1A: CAIE T2,"-" ;Was it the keypad dash?
JRST VC.1ER ;No - error
MOVEI T2,^D11 ;Yes - substitute 11
VC.1B: MOVEM T2,C.CMD ;Store the command nbr
CALL VC.KBD ;Display the abbr from the cmd table
JRST VC.2ND ;Go get the 2nd field
VC.1C: CAIE T1,0 ;Is the VCGET integer equal to zero?
JRST VC.1ER ;No - error
CALL VC.IFA ;Is the VCGET character a letter?
JRST VC.1ER ;No - error
TYPE <
[16;43H
[7m> ;Position the cursor
OUTCHR T2 ;Display the letter
TYPE <
8> ;Display space and restore cursor
LSH T2,7 ;Shift the letter left one ASCII position
MOVEM T2,I.CHAR ;Save the entry
CALL VCGET ;Get the next character
JRST VC.1D ;Must validate the cmd (exe return)
JRST VC.1D ;Must validate the cmd (hlp return)
JRST VC.CAN ;Cancel the command
JRST VC.CAN ;backspace is equivalent to cancel
CAIE T1,0 ;Is the VCGET integer a zero?
JRST VC.1D ;No - validate 1-char command
CALL VC.IFA ;Yes - is the VCGET char a letter?
JRST VC.1D ;Not a letter - validate 1-char
TYPE <
[16;44H
[7m> ;It was a letter - position cursor
OUTCHR T2 ;Display the letter (conditionally)
TYPE <
8> ;Restore the cursor
IORM T2,I.CHAR ;Combine it with the first letter
CALL VC.TAB ;Find both letters in the table
JRST VC.1ER ;Invalid command, cancel it
JRST VC.2ND ;Valid - go get 2nd field
VC.1D: MOVEI T3,.CHSPC ;Move space
IORM T3,I.CHAR ;Add it as the second cmd character
CALL VC.TAB ;Valid command?
JRST VC.1ER ;No - cancel the command
CAIN T1,^D13 ;Was execute the last entry?
JRST VC.EXE ;Yes (no params entered)
CAIN T2,"?" ;Was help the last entry?
JRST VC.HLP ;Yes
JRST VC.2A ;Assume the 1st letter of 2nd field
VC.1ER: TYPE <> ;Signal an error
TYPE <
[16;43H
[7m
8>
JRST VC.1ST ;Go back to 1st field
VC.2BK: TYPE <
[16;47H
[7m
8> ;(backspace function)
SETZM C.DIR ;Reset dir
SETZM C.NBR1 ;Reset nbr1
SETZM C.CNT ;Reset the count
VC.2ND: CALL VCGET ;Get 1st char of 2nd field
JRST VC.EXE ;No 2nd field - execute (no params)
JRST VC.HLP ;Request for help on given cmd
JRST VC.CAN ;Cancel command
JRST VC.CAN ;Backspace is equivalent to cancel here
VC.2A: MOVE T3,C.CMD
CAIN T3,^D20
JRST VC.2S
MOVEI T3,^D47 ;Entry point when input char is pending
CALL VC.COL ;Setup columns for 2nd field
SETZ T4, ;Zero the offset for arrow entries
CALL VC.ARR ;Test if arrow was entered
JRST VC.3RD ;Yes - go on to 3rd field
CALL VC.NUM ;Number or sign?
JRST VC.2B ;Yes - get rest of 2nd field
TYPE <> ;No - signal error
JRST VC.2ND ;Get the 1st char of 2nd field
VC.2S: CALL VC.SEN
JRST VC.EXE
TYPE <>
JRST VC.2ND
VC.2B: CALL VCGET ;Get the next char of 2nd field
JRST VC.2C ;Execute - must compute nbr1 first
JRST VC.2ER ;Help not allowed here
JRST VC.CAN ;Cancel the command
JRST VC.2BK ;Backspace to beginning of 2nd field
CALL VC.NUM ;Test for number or sign
JRST VC.2B ;Was a number or sign - get next char
VC.2C: MOVE T3,I.NBR ;Get the work number
SKIPE I.SIGN ;Is the sign negative?
MOVNS T3,I.NBR ;Yes - form the negative
MOVEM T3,C.NBR1 ;Store in 1st number
AOS C.CNT ;Increment the count
CAIN T1,^D13 ;Was the last command an execute?
JRST VC.EXE ;Yes - skip field 3
MOVEI T4,7 ;Setup 3rd field offset if arrow
SETZM I.PATH ;Reset direction flag - assume 2 nbrs
CALL VC.ARR ;No - was it an arrow?
JRST VC.4TH ;An arrow - get the terminator
CALL VC.BRK ;Was the entry a break character?
JRST VC.3RD ;Yes - start the 3rd field
VC.2ER: TYPE <> ;None of the above - therefore an error
JRST VC.2B ;Get another character
VC.3BK: TYPE <
[16;54H
[7m
8> ;(Backspace function)
SKIPE I.PATH ;Has a number been entered?
SETZM C.NBR1 ;No - reset nbr1
SETZM C.NBR2 ;Yes - reset nbr2 in any case
VC.3RD: CALL VCGET ;Get 1st char of 3rd field
JRST VC.EXE ;No 3rd field - execute
JRST VC.3X ;Help not allowed here
JRST VC.CAN ;Cancel the command
JRST VC.2BK ;Backspace to 2nd field
MOVEI T3,^D54 ;Setup columns for 3rd field
CALL VC.COL ;Starting at col 54
CALL VC.NUM ;Was the entry a number or a sign?
JRST VC.3B ;Yes - get the rest of 3rd field
SKIPE I.PATH ;Has an arrow been entered already?
JRST VC.3X ;Yes - skip the arrow test
SETZ T4, ;Zero the offset for arrow entries
CALL VC.ARR ;Was an arrow entered?
JRST VC.4TH ;An arrow - get the terminator
VC.3X: TYPE <> ;None of the above - signal an error
JRST VC.3RD ;Restart at 3rd field
VC.3B: CALL VCGET ;Get the next char of the 3rd field
JRST VC.3C ;Execute - must compute nbr first
JRST VC.3ER ;Help not allowed here
JRST VC.CAN ;Cancel the command
JRST VC.3BK ;Backspace to beginning of 3rd field
CALL VC.NUM ;Number or sign entered?
JRST VC.3B ;Yes - get more
VC.3C: MOVE T3,I.NBR ;Get the work nbr
SKIPE I.SIGN ;Is the sign negative?
MOVNS T3,I.NBR ;Yes - form a negative number
SKIPE I.PATH ;Is this the 2nd number?
JRST VC3C1 ;No - store in nbr1
MOVEM T3,C.NBR2 ;Yes - store it
SKIPA ;Skip the next
VC3C1: MOVEM T3,C.NBR1 ;Store in nbr1
AOS C.CNT ;Increment the count
CAIN T1,^D13 ;Was the last character entered an execute?
JRST VC.EXE ;Yes - skip the terminator
VC.3ER: TYPE <> ;None of the above - an error
JRST VC.3B ;Get the next character
VC.4ER: TYPE <> ;Signal an error
VC.4TH: CALL VCGET ;Get a terminator
JRST VC.EXE ;The desired response
JRST VC.4ER ;Help not allowed at this point
JRST VC.CAN ;Cancel the command
SKIPA ;Backspace to field 3
JRST VC.4ER ;Must be a terminator
SETZM C.DIR ;Reset the direction
SETZM I.PATH ;Reset the direction-entered flag
TYPE <
[16;54H
[7m
8>
JRST VC.3RD ;Go back to 3rd field
VC.HLP: TYPE <
[16;45h
[7m?
8> ;Display a "?"
MOVEI T1,5 ;Move 5 to direction, indicating
MOVEM T1,C.DIR ;Request for help
VC.EXE: TYPE <
8>
RET ;The end of the routine
VC.CAN: SETZM C.CMD ;Reset the command nbr
SETZM C.DIR ;Reset the direction
SETZM C.NBR1 ;Reset the 1st nbr
SETZM C.NBR2 ;Reset the 2nd nbr
SETZM C.CNT ;Reset the count
TYPE <
[16;43H
[7m
8>
JRST VC.1ST ;Go back to the beginning
VC.IMM: AOS (SP) ;Form skip - assume not immediate
CAIE T1,.CHESC ;Escape sequence?
RET ;No - can't be immediate (arrow)
CAIE T2,"0" ;Keypad zero? (LR SCAN)
IFSKP. ;Yes,
MOVEI T2,5
JRST VC.IMX
ENDIF.
CAIE T2,"." ;Keypad period? (MORE)
IFSKP.
SETO T2, ;Yes
JRST VC.IMX
ENDIF.
CAIL T2,"A" ;Is the character
CAILE T2,"D" ;One of the letters A, B, C, or D?
SKIPA ;No
IFNSK.
ANDI T2,7 ;Yes - mask out all but last three bits
JRST VC.IMX
ENDIF.
SKIPN R.FIRE ;Rapid fire enabled?
RET ;No - return
CAIE T2,"5" ;RF phasers?
CAIN T2,"6" ;RF photon torpedo?
SKIPA ;Yes
RET ;No
ANDI T2,7 ;Mask the bits
AOJ T2, ;Increment to form immediate cmd
VC.IMX: MOVEM T2,C.IMM ;Store as the immediate flag
SOS (SP) ;Cancel the skip
RET ;Return to calling routine
VC.KBD: TYPE <
[16;43H
[7m> ;Position the cursor at 1st field
MOVE T3,C.CMD ;Get the command nbr
HRRZ T3,C.TAB(T3) ;Move the command abbr
LSH T3,^D22 ;Form an ASCIZ literal
OUTSTR T3 ;Display it
TYPE <
[7m
8> ;Clear and restore cursor
RET ;Return to calling routine
VC.COL: MOVEM T3,I.SPOS ;Store sign position
AOJ T3, ;Add 1
MOVEM T3,I.POS ;Store as first nbr position
ADDI T3,3 ;Compute the last allowable position
MOVEM T3,I.MAX ;And store it
SETZM I.NBR ;Reset the work nbr
SETZM I.SIGN ;Reset the sign flag
RET ;Return to calling routine
VC.ARR: AOS (SP) ;Form skip - assume not an arrow
CAIE T1,.CHESC ;Escape sequence?
RET ;No - can't be an arrow
MOVE T3,I.SPOS ;Get the cursor position
ADD T3,T4 ;Add the offset, if any
CAIL T2,"A" ;Is the character
CAILE T2,"D" ;One of the letters A, B, C, or D?
RET ;No - return to calling routine
SOS (SP) ;Yes - cancel the skip - it's an arrow
CALL VPOS ;Position the cursor
ANDI T2,7 ;Convert char to a directional nbr
MOVEM T2,C.DIR ;Store the direction
MOVE T3,C.CMD ;Get the command nr
HLRZ T3,C.TAB(T3) ;Get the d.tab offset
ADD T3,T2 ;Add the direction
TYPE <
[7m>
OUTSTR D.TAB(T3) ;Display the direction literal
TYPE <
8> ;Display final spaces and restore cursor
SETOM I.PATH ;Set flag indicating arrow was entered
RET ;Return to calling routine
VC.SEN: AOS (SP)
CAIE T1,.CHESC
JRST VC.SN1
MOVSI T3,-4
VCSEN1: CAME T2,[EXP "A","B","C","D"](T3)
AOBJN T3,VCSEN1
SKIPL T3
RET
MOVE T3,[EXP 1, 2, 0, 0](T3)
JRST VC.SN2
VC.SN1: TRZ T2,1B30
MOVSI T3,-^D11
VCSN11: CAME T2,[EXP "A","F","K","E","C","I","H","L","P","V","R"](T3)
AOBJN T3,VCSN11
SKIPL T3
RET
VC.SN2: TYPE <
[16;48H
[7m>
HRRZ T3,T3
MOVEM T3,C.NBR1
AOS C.CNT
CAILE T3,2
JRST VC.SN3
IMULI T3,3
OUTSTR [ASCIZ/ALL /
ASCIZ/FEDERATION/
ASCIZ/KLINGON /](T3)
JRST VC.SN4
VC.SN3: MOVE UOT,T3
SUBI UOT,3
OUTSTR @O.NAME(UOT)
VC.SN4: SOS (SP)
RET
VC.TAB: MOVE T3,I.CHAR ;Move the two command characters
MOVSI T4,-C.SIZE ;Get the command table size
VCTAB1: HLL T3,C.TAB(T4)
CAME T3,C.TAB(T4) ;In the table?
AOBJN T4,VCTAB1 ;Bump the pointer, try again
IFL. T4 ;If not negative, it's not in the table
HRRZM T4,C.CMD ;Not zero - save the command nbr
RETSKP ;And skip return
ENDIF.
RET ;Return to calling routine
VC.NUM: AOS (SP) ;Form skip return - assume not a number
CALL VC.IFN ;Test numeric
JRST VC.SIG ;Not a number, try a sign
SOS (SP) ;Cancel the skip ret
MOVE T3,I.POS ;Get the column nbr
CAMG T3,I.MAX ;Greater than max allowed?
JRST VCNUM1 ;No - continue
TYPE <> ;Yes - signal the error
RET ;Return to calling routine
VCNUM1: CALL VPOS ;Position the cursor
TYPE <
[7m>
OUTCHR T2 ;Display the number
TYPE <
8> ;Restore the cursor
AOS I.POS ;Increase the column nbr
ANDI T2,17 ;Convert ASCII to binary nbr
MOVEI T3,^D10 ;Set the multiplier
IMULM T3,I.NBR ;Multiply the work number
ADDM T2,I.NBR ;Add the input number
RET ;Return to calling routine
VC.SIG: CAIN T2,"-" ;Minus sign?
JRST VCSIG1 ;Yes - continue
CAIE T2,"+" ;Plus sign?
RET ;Neither sign, ret
SETOM I.SIGN ;Set sign word to -1
VCSIG1: SETCMM I.SIGN ;Complement the sign
MOVE T3,I.SPOS ;Get column for sign
CALL VPOS ;Position the cursor
MOVEI T3,"-" ;Assume negative
SKIPL I.SIGN ;Skip if valid assumption
MOVEI T3,.CHSPC ;Wasn't negative after all, use space
TYPE <
[7m>
OUTCHR T3 ;Display the sign
TYPE <
8> ;Restore the cursor
SOS (SP) ;Cancel the skip ret
RET ;Return to calling routine
VC.BRK: CAIN T2,"." ;Is the character a period?
RET ;Yes - return
CAIN T1,.CHTAB ;Is the character a tab?
RET ;Yes - return
CAIE T1,0 ;Is the entry from the main keyboard?
RETSKP ;No - can't be a break, then RETSKP
CAIE T2,.CHSPC ;Is the character a space?
AOS (SP) ;Not a break - form skip ret
RET ;Return to calling program
VC.IFA: TRZ T2,1B30 ;Convert to uppercase
CAIL T2,"A" ;Is this a letter?
CAILE T2,"Z"
RET ;Not a letter
AOS (SP) ;It's a letter - form skip ret
RET ;It's out of range - no skip ret
VC.IFN: CAIL T2,"0" ;Is this a number?
CAILE T2,"9"
RET ;Not a number
AOS (SP) ;It's a number - form a skip ret
RET ;It's out of range - no skip ret
VCGET: CALL VTGET ;Get input integer and character
MOVE T1,C.INTE ;Load the integer
MOVE T2,C.CHAR ;Load the character
CAIN T1,.CHCRT ;Execute key? (carriage ret)
RET ;Yes - normal ret
AOS (SP) ;Form skip return 1
CAIN T2,"?" ;Help function?
RET ;Yes - skip return 1
AOS (SP) ;Form skip return 2
CAIN T2,.CHDEL ;Delete?
RET ;Yes - skip return 2
AOS (SP) ;Form skip return 3
CAIN T1,.CHBSP ;Backspace?
RET ;Yes - skip return 3
CAIN T2,"," ;Erase function? (same as backspace)
RET ;Yes - skip return 3
RETSKP ;Form skip return 4
SUBTTL Scans -- Jacket Routine
SCANLD::CALL SCNCLR
MOVEI UOT,217
SKIPE S.STAR ;Display stars?
MOVEI UOT,117 ;No - skip them then
SCNLD1: SKIPGE U.TAB(UOT)
JRST SCNLD2
CAME UOT,S.UOT
CALL SCNTST
SCNLD2: SOJGE UOT,SCNLD1
RET
SUBTTL Scans -- Test to See if Object is in Scanning Range
;SCNTST
;
; Tests whether an object is in scan range. If so, SCNUPD is
; called (updating scan tables) and ROW.2 is set = to the row
; containing the object.
SCNTST::SETZM ROW.2
SKIPG O.RELX(UOT) ;Object in front of us?
RET ;No - can't be in viewer
MOVM T1,O.ELEV(UOT) ;Object has a reasonable elevation?
CAMLE T1,[0.404026226]
RET ;No
MOVM T1,O.BEAR(UOT) ;Object has a reasonable bearing?
CAMLE T1,[1.625476800]
RET ;No
FIX T1,O.RANG(UOT)
CAIG UOT,117 ;If the object isn't a star,
CAIG T1,^D2048 ;Is it out of range?
SKIPA ;No - it's in range
RET ;Yes - it's out of range
MOVE AP,O.ELEV(UOT) ;Compute the exact row
CALL FATAN
FMPR RS,[14.32394488]
MOVE ROW,[7.0]
FSBR ROW,RS
FIXR ROW,ROW
SKIPLE ROW
CAILE ROW,^D13
RET ;Row not in viewer
MOVE AP,O.BEAR(UOT) ;Compute the exact column
CALL FATAN
FMPR RS,[35.80986218]
FADR RS,[41.0]
FIXR COL,RS
CAIL COL,6
CAILE COL,^D76
RET ;Column not in view
MOVEM ROW,ROW.2
CALL SCNUPD
RET
SUBTTL Scans -- Clear Scan Table
;SCNCLR
;
; Zeroes out the scanner table and moves zero to S.MAX, the
; number of elements in the table.
SCNCLR::MOVE T1,[SCAN.1,,SCAN.1+1]
SETZM SCAN.1
BLT T1,SCAN.1+^D289
SETZM S.MAX
RET
SUBTTL Scans -- Update Scan Table
;SCNUPD
;
; Updates the scanner table. Table is in ascending sequence
; by row and descending sequence by range within row. This
; allows VIEWLD to process a row at a time. Descending ranges
; allow VIEWLD to overlay the character elements in the viewer
; table; assures that closer objects will overlay farther objects.
;
; Uses the following:
; W.ROW - row on which object will be displayed
; W.COL - col on which the center of the object will display
; W.RANG - range as a floating point nbr
; W.ID - object id
; W.UOT - object nr (universal object idx)
SCNUPD::SETZ T1, ;T1 is the scan table index
FIX T2,O.RANG(UOT) ;Get the range
AOS S.MAX ;Increment the element count
SC.TST: HRRZ T3,SCAN.1(T1) ;Main loop - get a scanner element
TRZ T3,-1000 ;Mask everything but the row
CAML T3,ROW ;Scan row less than new object row?
JRST SCTST1 ;No - test same row
JUMPE T3,SC.UPD ;End of table? - if so, add to end
AOJA T1,SC.TST ;Try the next element
SCTST1: CAME T3,ROW ;Is there another object on this row?
JRST SC.SHF ;No - push the table and insert
CAMG T2,SCAN.2(T1) ;Range greater than new range?
AOJA T1,SC.TST ;No - try the next element
SC.SHF: MOVE T4,S.MAX ;Get the (new) table size
SCSHF1: MOVE T3,SCAN.1-1(T4) ;Shift the elements down one
MOVEM T3,SCAN.1(T4)
MOVE T3,SCAN.2-1(T4) ;Shift the ranges also
MOVEM T3,SCAN.2(T4)
SOJ T4, ;Decrement the table idx
CAMLE T4,T1 ;Are we at the insertion point?
JRST SCSHF1 ;No - shift the next element
SC.UPD: HRRZ T3,UOT ;Update - get the UOT idx (obj nr)
HRRZ T4,COL ;Get the column
LSHC T3,^D9 ;Shift T3 and T4 a quarter word left
MOVE AP,U.TAB(UOT) ;Get the U.TAB word
ANDI AP,17 ;Mask everything but the uid
IOR T3,AP ;Insert the object id
IOR T4,ROW ;Insert the row
HRL T4,T3 ;Combine T3 with T4
MOVEM T4,SCAN.1(T1) ;Store in SCAN.1
MOVEM T2,SCAN.2(T1) ;Store the range in SCAN.2
RET ;Return to calling routine
SUBTTL Scans -- Delete Object
;SCNDEL
;
; Searches for an object UOT in the scan tables and, if found,
; deletes it. If an object was found, its row is stored in
; ROW.1. If not found, ROW.1 will = 0.
SCNDEL::SETZB T1,ROW.1
DO.
SKIPN SCAN.1(T1) ;Search for the UOT
RET ;Not found
HLRZ T2,SCAN.1(T1)
LSH T2,-^D9
CAME T2,UOT
AOJA T1,TOP.
OD.
HRRZ T2,SCAN.1(T1)
TRZ T2,-1000
MOVEM T2,ROW.1
SOS S.MAX
SCD.2: MOVE T2,SCAN.2+1(T1) ;Close up the hole in the scan
MOVEM T2,SCAN.2(T1) ;table
MOVE T2,SCAN.1+1(T1)
MOVEM T2,SCAN.1(T1)
SKIPE T2
AOJA T1,SCD.2
RET
SUBTTL Scans -- Load Viewer From Scan Table
;VIEWLD
;
; Loads the viewer table from the scan table
VIEWLD::PUSH SP,P1
PUSH SP,P2
SETZM V.MOD
SETZM V.ROW
SETZB P1,ROW
HRRZ P2,SCAN.1(P1)
TRZ P2,-1000
VWL.1: AOJ ROW,
CALL VWRUPD
CAIGE ROW,^D13
JRST VWL.1
POP SP,P2
POP SP,P1
RET
SUBTTL Viewer -- Update Two Viewer Rows
;VWRTST
;
; Updates two viewer rows. Intended specifically for the case
; when an object moves. ROW.1 is the 'old' ROW, most probably
; set up by SCNDEL. ROW.2 is the 'new' ROW, set up by SCNTST.
; A row isn't processed if it equals zero. Also, if the new
; row = the old ROW, it's not necessary to process the new row.
VWRTST::SETZM V.RSET ;Will be set to -1 if a char is displayed.
SKIPN ROW,ROW.1
JRST VWT.1
CAMN ROW,T.ROW
CALL TARUPD
MOVE ROW,ROW.1
CALL VWRCHG
VWT.1: SKIPE ROW,ROW.2
CAMN ROW,ROW.1
JRST VWT.2
CAMN ROW,T.ROW
CALL TARUPD
MOVE ROW,ROW.2
CALL VWRCHG
VWT.2: SKIPE V.RSET ;Any characters displayed?
TYPE <
8> ;Yes, reset the cursor position.
OUTSTR V.ASC
MOVEI T1,7
MOVEM T1,V.COLR
RET
SUBTTL Viewer -- Update Single Viewer Row
;VWRCHG
;
; Changes a single viewer row after finding it in the scan
; table. Different from VIEWLD, which loads all rows
VWRCHG::PUSH SP,P1
PUSH SP,P2
SETZM V.MOD
SETZB P1,V.ROW
DO.
SKIPN P2,SCAN.1(P1)
EXIT.
HRRZ P2,P2
TRZ P2,-1000
CAMGE P2,ROW
AOJA P1,TOP.
OD.
CALL VWRUPD
POP SP,P2
POP SP,P1
RET
VWRUPD::CAME ROW,T.ROW
JRST VWU.1
CALL VWRINI
CAMN ROW,P2
CALL VWRROW
CALL VWRTAR
JRST VWU.2
VWU.1: CAME ROW,P2
JRST VWU.3
CALL VWRINI
CALL VWRROW
VWU.2: SKIPL V.FLAG
JRST VWU.25
CALL VWRINS
SKIPA
VWU.25: CALL VWRDSP
JRST VWU.4
VWU.3: SKIPGE V.FLAG
JRST VWU.35
CALL VWRNUL
SKIPA
VWU.35: CALL VWRDEL
VWU.4: SETZM V.FLAG
RET
SUBTTL Viewer -- Delete Object From Viewer
VWRDEL::CALL VR.TST
RET
CALL VR.INI
SETZ T3,
VWRDL1: AOJ COL,
IDPB T3,V.TPTR
CAIGE COL,^D74
JRST VWRDL1
RET
SUBTTL Viewer -- Viewer Initialization
VWRINI::MOVE T1,[V.WRK,,V.WRK+1]
SETZM V.WRK
BLT T1,V.WRK+^D13
RET
VWRROW::MOVE T1,SCAN.2(P1)
LSH T1,-5
CAIL T1,100
MOVEI T1,77
TRZ T1,7
HLRZ T2,SCAN.1(P1)
TRZ T2,-10
ADD T1,T2
HRRZ T2,V.OBJ(T1)
TRZ T2,-10
CAIL T2,7
JRST VR.NXT
HRRZ T3,SCAN.1(P1)
LSH T3,-^D9
SUB T3,T2
SOJ T3,
ADJBP T3,V.WRKP
MOVEM T3,V.WPTR
MOVE T2,V.OBJ(T1)
DO.
LSHC T1,5
ANDI T1,37
TRNN T1,37
EXIT.
IDPB T1,V.WPTR
JRST TOP.
OD.
VR.NXT: AOJ P1,
HRRZ P2,SCAN.1(P1)
TRZ P2,-1000
CAMN P2,ROW
JRST VWRROW
RET
SUBTTL Viewer -- Update Target
VWRTAR::MOVE COL,T.COL
SKIPE .GRTYP
JRST VWRTR1
CAIN ROW,7
CAIE COL,^D41
SKIPA
RET
VWRTR1: CAIL COL,2
CAILE COL,^D74
RET
ADJBP COL,V.WRKP
LDB T1,COL
TRO T1,40
DPB T1,COL
RET
SUBTTL Viewer -- Clear Viewer
VWRCLR::MOVE T1,[V.TAB,,V.TAB+1]
SETZM V.TAB
BLT T1,V.TAB+^D172
RET
VWRINS::CALL VR.TST
RET
CALL VR.INI
ADJBP T3,V.WRKP
MOVEM T3,V.WPTR
DO.
AOJ COL,
ILDB T2,V.WPTR
TRZ T2,40
IDPB T2,V.TPTR
CAIGE COL,^D74
JRST TOP.
OD.
RET
VWRDSP::CALL VR.TST
RET
CALL VR.INI
ADJBP T3,V.WRKP
MOVEM T3,V.WPTR
DO.
AOS T1,COL
ILDB T2,V.WPTR
ILDB T3,V.TPTR
CAME T2,T3
CALL VR.OUT
CAIGE T1,^D74
JRST TOP.
OD.
RET
VR.OUT: SETOM V.RSET ;A char will be displayed, must reset later.
CALL VNEXTP
DPB T2,V.TPTR
JRST OBJOUT
VWRNUL::CALL VR.TST
RET
CALL VR.INI
VR.NU1: AOJ COL,
ILDB T3,V.TPTR
JUMPE T3,VR.NU2
SETZ T3,
DPB T3,V.TPTR
CALL VNEXTP
TYPE < >
SETOM V.RSET ;Will reset the cursor later.
VR.NU2: CAIGE COL,^D74
JRST VR.NU1
RET
VR.TST: MOVE T2,ROW
CAIG T2,1
RET
CAIG T2,^D12
RETSKP
RET
VR.INI: MOVE T3,ROW
SOJ T3,
IMULI T3,^D78
ADDI T3,^D7
ADJBP T3,V.TABP
MOVEM T3,V.TPTR
MOVEI T3,7
MOVEM T3,COL
RET
SUBTTL Viewer -- Output Object On Viewer
OBJOUT: SETZ T4,
TRZE T2,40
MOVEI T4,40
HLRZ T3,V.ELEM(T2) ;Get character set
TRZ T3,70 ;Remove color bits
IFN. T3
CAME T3,V.MOD
OUTSTR V.MOD(T3)
MOVEM T3,V.MOD
ENDIF.
SKIPE .TTTYP
CALL OBJCLR ;Get color if GIGI
HRRZ T3,V.ELEM(T2)
CAIE T4,0
CALL BLINK
TRNE T3,200
JRST OBJBRI
OBJDRK: SKIPE VT241F
TYPE <
PpT(A1)
\>
OUTCHR T3
SKIPE VT241F
TYPE <
PpT(A0)
\>
CAIE T4,0
JRST BLREST
SKIPE .TTTYP
JRST TAREDO
RET
OBJBRI: SKIPN .TTTYP
TYPE <
[1m>
OUTCHR T3
CAIE T4,0
JRST BLREST
SKIPE .TTTYP
JRST TAREDO
TYPE <
[m>
RET
SUBTTL Viewer -- GIGI Color For Objects in Viewer
;Called if GIGI, sets cursor color
OBJCLR: SKIPE VT241F ;VT241?
RET ;Yes, don't do this
HLRZ T3,V.ELEM(T2) ;Get color and mode
LSH T3,-3 ;Get color only
CAIN T3,0 ;If no color
MOVEI T3,7 ;Use white
CAIN T2,0 ;If space
MOVE T3,V.COLR ;Use previous color (no change)
CAME T3,V.COLR ;Is it same as before
OUTSTR @V.COLR(T3) ;No, set new color
MOVEM T3,V.COLR ;Save color
RET
SUBTTL Viewer -- Target Redo
;Redoes target if previous character and GIGI
TAREDO: MOVE T3,ROW
CAME T3,T.ROW
RET
MOVE T3,COL
SUB T3,T.COL
SOSE T3
RET
SOS T3,COL
CALL CORNER
AOS T3,COL
RET
BLINK: SKIPN .TTTYP
TYPE <
[;5;7m>
RET
BLREST: SKIPE .TTTYP
IFSKP.
TYPE <
[m>
RET
ENDIF.
CALL CORNER ;GIGI target
RET
CORNER: CALL GIPOS
TYPE <
Pp@u
\>
RET
SUBTTL Viewer -- Target Update
TARUPD::MOVE UOT,t.UOT
IFL. UOT
MOVE ROW,T.ROW
MOVE COL,T.COL
RET
ENDIF.
FIX T1,O.RANG(UOT)
CAILE T1,^D1536
JRST TU.BRK
CALL CONUOT
MOVE T1,B1
MOVEM T1,T.BEAR
MOVE T1,E1
MOVEM T1,T.ELEV
CALL CONTRC
MOVEM ROW,T.ROW
MOVEM COL,T.COL
SETZM T.VIEW
CALL RCTEST
RET
SETOM T.VIEW
RET
TU.BRK: MSPINI
MSPTYP <target no longer locked>
MSPOUT
SETOM T.UOT
SETZM T.BEAR
SETZM T.ELEV
MOVEI ROW,7
MOVEI COL,^D41
MOVEM ROW,T.ROW
MOVEM COL,T.COL
SETOM T.VIEW
RET
SUBTTL Viewer -- Make Target Blink
;TARDSP
;
; Displays reverse-video blinking target at W.ROW and W.COL.
TARDSP::SETZ T1, ;T1 will flag a difference in position
CAMN ROW,T.ROW ;New row same as old?
CAME COL,T.COL ;New col same as old?
SETO T1, ;No - T1 < 0 implies difference
MOVE T2,T.VIEW ;Get viewer flag (0 = not in view)
JUMPE T2,TD.TST ;If wasn't in view, skip
JUMPE T1,TD.TST ;If in view but same location, skip
PUSH SP,ROW ;Save new row and col
PUSH SP,COL
MOVE ROW,T.ROW ;Get old row and col
MOVE COL,T.COL
CALL TD.GET ;Get the character number from viewer table
TRZ T2,40
DPB T2,T3
TYPE <
[m> ;Turn off blink and reverse
CALL TD.DSP ;Display the char as a normal character
POP SP,COL ;Retrieve new row and col
POP SP,ROW
TD.TST: SETZM T.VIEW ;Assume new target isn't in viewer
CAIL ROW,^D2 ;Test row
CAILE ROW,^D12 ;Row must be between 2 and 12
JRST TD.SAV
CAIL COL,^D8 ;Test col
CAILE COL,^D74 ;Column must be tween 8 and 74
JRST TD.SAV
SETOM T.VIEW ;Target in view, flip view flag
CALL TD.GET ;Get the char nbr at this row and pos
CAIN ROW,7
CAIN COL,^D41
IFSKP.
TRO T2,40
DPB T2,T3
TRZ T2,40
ENDIF.
JUMPN T1,TDTST1 ;Different position for target?
CAMN T2,T.ELEM ;No - different element number?
JRST TD.SAV ;No - don't bother to display it again
;..
;..
TDTST1: MOVE T1,.tttyp ;Get terminal type
JRST .+1(T1)
JRST TAR100
JRST TARGG
TAR100: TYPE <
[;5;7m> ;Turn on blink and reverse
CALL TD.DSP ;Display the new cursor
SKIPA
TARGG: CALL CORNER ;GIGI target
; JRST TD.SAV
TD.SAV: MOVEM ROW,T.ROW ;Save the new target row and col
MOVEM COL,T.COL
MOVEM T2,T.ELEM ;Save the char nbr that was displayed
RET ;Return to calling routine
TD.GET: MOVE T3,ROW ;Get target character from viewer table
SOJ T3,
IMULI T3,^D78 ;Offset = (78 * (row - 1)) + col
ADD T3,COL
ADJBP T3,V.TABP ;Get and adjust viewer pointer
LDB T2,T3 ;Load the character number
RET ;Return to calling routine
TD.DSP: SKIPE .TTTYP ;if gigi display regardless of position
JRST TDDSP1
CAIN ROW,^D7 ;If target is at center of viewer
CAIE COL,^D41 ;(row = 7 and col = 41)
SKIPA ;don't display
RET
TDDSP1: CALL VTPOS ;Position the cursor
HLRZ T3,V.ELEM(T2) ;Get the mode of the element
TRZ T3,70 ;Ignore color
SKIPE T2 ;Mode important?
OUTSTR V.MOD(T3) ;Yes - change the mode
SKIPE .TTTYP
CALL OBJCLR ;Get color if GIGI
HRRZ T3,V.ELEM(T2) ;Get the character
TRNE T3,200 ;Bold character?
TYPE <
[1m> ;Yes - turn on increased intensity
OUTCHR T3 ;Display the character
TRNE T3,200 ;Bold character?
TYPE <
[m> ;Yes - turn off intensity
RET ;Return
SUBTTL Viewer -- Put Cursor on Status Line
;VPOS
;
; Positions the cursor on the 'status' line (row 16).
; Assumes column nr in T3; T3 and T4 are destroyed.
VPOS:: TYPE <
[16;> ;Start the positioning sequence
IDIVI T3,^D10 ;Divide by 10
TRO T3,"0" ;Convert tens to ASCII
TRO T4,"0" ;Convert units to ASCII
CAIE T3,"0" ;Skip tens if zero
OUTCHR T3 ;Display the tens digit
OUTCHR T4 ;Display the units digit
TYPE <H> ;End the sequence
RET ;Return to calling routine
VNEXTP::CAME ROW,V.ROW
SETZM V.COL
SKIPG V.COL
JRST VNXT.1
CAMG COL,V.COL
JRST VNXT.1
MOVE T3,COL
SUB T3,V.COL
SOJE T3,VNXT.2
TYPE <
[>
IDIVI T3,^D10
TRO T3,"0"
TRO T4,"0"
CAIE T3,"0"
OUTCHR T3
OUTCHR T4
TYPE <C>
SKIPA
VNXT.1: CALL VTPOS
VNXT.2: MOVEM ROW,V.ROW
MOVEM COL,V.COL
RET
SUBTTL Viewer -- Position Cursor
;VTPOS
;
; Positions cursor at ROW and COL. Works for 2-digit ROW
; and COL. Destroys T3 and T4.
; Also positions graphics cursor for GIGI terminals
VTPOS:: TYPE <
[> ;Display start of sequence
MOVE T3,ROW ;Move the row
IDIVI T3,^D10 ;Divide by 10 (remainder is in T4)
TRO T3,"0" ;Convert tens to ASCII
TRO T4,"0" ;Convert units to ASCII
CAIE T3,"0" ;Skip tens if zero
OUTCHR T3 ;Display tens
OUTCHR T4 ;Display units
TYPE <;> ;Display sequence delimiter
MOVE T3,COL ;Move the col
IDIVI T3,^D10 ;Divide by 10 (remainder is in T4)
TRO T3,"0" ;Convert tens to ASCII
TRO T4,"0" ;Convert units to ASCII
CAIE T3,"0" ;Skip tens if zero
OUTCHR T3 ;Display tens
OUTCHR T4 ;Display units
TYPE <H> ;Display final control sequence character
RET
GIPOS:: SKIPN .GRTYP ;If not graphics,
RET ;return
TYPE <
PpP[> ;Enter REGIS, position command
MOVE T3,COL ;Get column (x-axis)
SKIPN VT241F ;If VT241
IFSKP.
IMULI T3,^D10 ;10 pixels per column
ADDI T3,^D25 ;Account for later mal-adjustment
JRST GIPOS1
ENDIF.
SKIPE .TTTYP ;If GIGI
IMULI T3,^D9 ;9 pixels per column
SKIPN .TTTYP ;If VT125
IMULI T3,^D10 ;10 pixels per column
GIPOS1: SUBI T3,^D4 ;Center of column
SKIPN .TTTYP ;If VT125
SUBI T3,^D25 ;adjust position to left
IDIVI T3,^D100 ;Get hundreds
TRO T3,"0" ;Convert hundreds to ASCII
CAIE T3,"0" ;Skip hundreds if zero
OUTCHR T3
MOVE T3,T4 ;Get remainder
IDIVI T3,^D10 ;Get tens
TRO T3,"0" ;Convert to ASCII
OUTCHR T3 ;Display tens
TRO T4,"0" ;Convert ones to ASCII
OUTCHR T4 ;Display ones
TYPE <,> ;X-Y axis delimiter
MOVE T3,ROW ;Get row
IMULI T3,^D20 ;20 pixels per row
SUBI T3,^D10 ;Center of row
IDIVI T3,^D100 ;Get hundreds (remainder in T4)
TRO T3,"0" ;Convert hundreds to ASCII
CAIE T3,"0" ;Skip hndreds if zero
OUTCHR T3 ;Display hundreds
MOVE T3,T4 ;Get remainder
IDIVI T3,^D10 ;Get tens
TRO T3,"0" ;Convert to ASCII
OUTCHR T3
TYPE <0]
\> ;Ones should always be zero
;close position, exit REGIS
RET ;Return
SUBTTL Get Character From Terminal
;VTGET
;
;
; Gets a character from the terminal, returns C.INTE and
; C.CHAR as follows:
;
; Normal entries: 0 in C.INTE, character entered in C.CHAR.
; Control char: ADE nbr in C.INTE, space in C.CHAR
; (delete returns 127 in C.INTE, space in C.CHAR).
; Keypad keys: 27 (escape) in C.INTE, the following in C.CHAR:
; UP A
; DOWN B
; RIGHT C
; LEFT D
; PF1-4 A,B,D,C (note sequence)
; 0-9 0-9
; COMMA comma
; DASH dash
; PERIOD period
; ENTER M in C.CHAR, 13 in C.INTE (cr)
VTGET:: CALL VTIMED ;Get a character (timed interrupt)
TYPE <
8>
ANDI T4,177 ;Mask the last 8 bits
SETZM C.INTE ;Zero the integer
MOVEI T1,.CHSPC ;Move space to the char
CAIGE T4,.CHSPC ;Is it a ctrl char? (less than space)
JRST VT.CTL ;Yes
CAIE T4,.CHDEL ;No - is it a delete?
JRST CT.CHR ;No - it's just a normal character
MOVEM T4,C.INTE ;Yes, a delete - move it to integer
JRST VT.SAV ;Go to return
VT.CTL: MOVEM T4,C.INTE ;Move to integer
CAIE T4,.CHESC ;is it an escape?
JRST VT.SAV ;Go to return
VT.ESC: INCHRW T4 ;Get the next esc sequence character
ANDI T4,177 ;Mask the last 8 bits
CAIN T4,"[" ;Is it a keypad sequence?
JRST VT.KPD ;Yes - process it
CAIE T4,"O" ;An arrow?
JRST CT.CHR ;No - don't know what it is
;Yes - process the sequence
VT.KPD: INCHRW T4 ;Get the next character
ANDI T4,177 ;Mask the last 8 bits
CAIGE T4,"l" ;Is it lowercase L or greater?
JRST VT.UPR ;No - probably an uppercase letter
CAILE T4,"y" ;Is it lowercase Y or less?
JRST CT.CHR ;No - don't know what it is
ANDI T4,77 ;Make it a number or - , . character
JRST CT.CHR ;Go to return
VT.UPR: CAIE T4,"M" ;Was it the ENTER key?
JRST VT.PF ;No - test the pf keys
MOVEI T3,.CHCRT ;Generate a carriage ret
MOVEM T3,C.INTE ;Move CR to integer
JRST CT.CHR ;Go to return
VT.PF: CAIN T4,"P" ;Is it pf1?
MOVEI T4,"A" ;Yes - convert to up arrow
CAIN T4,"Q" ;Is it pf2?
MOVEI T4,"B" ;Yes - convert to down arrow
CAIN T4,"R" ;Is it pf3?
MOVEI T4,"D" ;Yes - convert to left arrow
CAIN T4,"S" ;Is it pf4? (if not, it's probably an arrow)
MOVEI T4,"C" ;Yes - convert to right arrow
CT.CHR: MOVEM T4,T1 ;Move T4 to T1
VT.SAV: MOVEM T1,C.CHAR ;Save the character
RET ;Return to calling routine
SUBTTL Timed Input From Terminal
VTIMED::CALL D.TIME
MOVEI T1,.PRIIN ;This device (terminal)
SIBE% ;Any input?
JRST VTINP ;Yes, handle it
MOVEI T1,^D500 ;No, sleep for a touch
DISMS% ;Drumm fingers
VTDSMS: MOVEI T1,.PRIIN ;This device again
SIBE% ;Input now?
JRST VTINP ;Yes, see what we got
CALL QTEST ;No - do Q-processing
JRST VTIMED ;And loop back up
VTINP: INCHRW T4 ;Get terminal character input
RET ;And return
SUBTTL Handle Tyepin Interrupts
;ITYPIN - Get typein interrupts
ITYPIN: SAVE T1
HRRZ T1,LEV2PC ;Check interrupt PC
CAIE T1,VTDSMS ;From this routine?
JRST ITYPIX ;Not waiting - exit
MOVSI T1,10000 ;User mode flag
IORM T1,LEV2PC ;DEBRK back to wakeup
ITYPIX: REST T1
DEBRK%
D.TIME: SOSLE D.TCNT
RET
MOVEI T1,^D120 ;Call approx every 500ms
MOVEM T1,D.TCNT
SKIPN .TTTYP ;GIGI?
IFSKP. ;Do special things if so
TRNE SUOT,1B35
OUTSTR @V.CYN
TRNN SUOT,1B35
OUTSTR @V.GRN
ENDIF.
TYPE <
[1;7m
[24;74H>
MOVEI T1,.PRIOU ;This output device (terminal)
SETO T2, ;Current time
MOVX T3,<OT%NDA+OT%NSC> ;Hour and minute
ODTIM% ;Display it
ERJMP .+1 ;Should not happen
SKIPE .TTTYP
TYPE <
[m>
TYPE <
8>
RET
SUBTTL Load GIGI Macrographs
;GILOAD
;
; Loads macrographs if on Graphics terminal
;
GILOAD::SKIPN .GRTYP ;If not graphics,
RET ;Return
SKIPE VT241F ;Set VT241 to not hurt the eyes
TYPE <
PpS(M0(AD)1(AM)2(AR)3(AY))
\>
SKIPE .TTTYP
TYPE <
PrVC0MB0AW0
\> ;Don't display cursor
;Disable margin bell
;No generation of <CR>
TYPE <
Pp> ;Enter regis
TYPE <S(EN0A)W(RA0S0M1N0P1(M2))T(A0D0S1)>
;Initialize ReGIS (mostly)
TYPE <P[100,440]T(I-10)(W(i2R,n1))'Please Stand By...'>
TYPE <t(i0)>
TYPE <@.> ;Clear macrograph storage
; exp01 macrograph e
TYPE <@:eW(cI6)v(b)[-5,-9][+3,+19][+6,-17][-2,+17]>
TYPE <[-6,-4][+8,-6][-8,-7][+7][-7,+17](e)@;>
; exp03 macrograph f
TYPE <@:fp(b)@ev[-11,-05][+21,+3][-21,+10][+22,-3]>
TYPE <[-22,-4][+21,-6](e)@;>
; exp05 macrograph g
TYPE <@:gp(b)@fv[-2,-16][+5,-2][-5,+34]>
TYPE <[+5,+3][-13,-20][+21,-4][,+12](e)@;>
; exp11 macrograph h
TYPE <@:hp(b)@gv[-19,+6][+30,+12][-22,-43][+29,+29]>
TYPE <[-28,+20][+21,-48][-31,+25][+39,-7][-39,-1]>
TYPE <[+29,+34](e)@;>
; exp16 macrograph i
TYPE <@:i@hp(b)v[-29,+8][+49,-29][-6,+47][-33,-4][+47,-17]>
TYPE <[-47,-31][+14,+55][+22,-54][-45,+25]>
TYPE <[+47,+16][-37,+10][+36,-51][+0,+34]>
TYPE <[-37,-34][+8,+52][+40,-33](e)@;>
; exp24 macrograph j
TYPE <@:jp(b)w(p5(m9))@iv[-26,-44][+04,+91][+48,-90][,+87]>
TYPE <[-70,-44][+44,-46][+44,+46][-44,+45][-18,-89]>
TYPE <[+55,+67][-72,+4][+72,-48][-82,+26][+92,-13][-34,+47]>
TYPE <[-9,-81][-38,+30][+61,-27](e)@iw(p1(m2))@;>
;some of torpedo macrograph o
TYPE <@:op[-11,-2]v[+11]s(T1)@;>
;Phaser shots (must be in pairs) macrograph p
TYPE <@:pp(b)[261,239]v(w(ci)e)p(b)[471,239]v(w(ci)e)@q@;>
; phaser flash when we shoot macrograph q
TYPE <@:qw(s[,+2]i6r)p(b)[-3,-4]@vp(e)w(s0)@;>
; flash red macrograph r
TYPE <@:rs(i2T1i0T1)@;>
; shake screen up and down macrograph s
TYPE <@:ss(w(m12))26622662@;>
; photon torpedoes macrograph t
TYPE <@:tW(I2c)p[+5,242]@o@o@o@o@o@o>
TYPE <p[-10,-2]>
TYPE <s(T3)v[+9]p0v[,+12][-10][,-10]>
TYPE <p[,+8]v[+9]p[-8,-11]s(t7)v[+7]p0v[,+9]>
TYPE <[-8][,-8]p[,+6]v[+7]p[-6,-10]>
TYPE <s(T10)v[+5]p0v[,+8][-6][,-6]>
TYPE <p6666v[+5]p[-4,-7]s(T14)v000p0v[,+5]>
TYPE <[-4]2222p66v000p[-2,-6]s(T17)v0p0v666644220s(T20)v2@;>
; target display macrograph u
TYPE <@:uw(ri2a1)p(b)[-5,-10]v[+9]>
TYPE <p[+1,+18]v[-9]p(e)w(a0)@;>
; phaser flash macrograph v
TYPE <@:vv[+6]p[-6]v(w(e))[+6]p[-6]@;>
; phaser when someone else shoots macrograph w
TYPE <@:ww(i6r)p(b)[-3,+4]@vs(T2)@vs(T2)@vs(T2)@vp(e)@;>
; pacman macrograph x
TYPE <@:xt"wz "p[-78]t"xz "p[-78]t"yz "p[-78]t"xz "p[-78]@;>
; flash yellow macrograph y
TYPE <@:ys(i6T1i0T1)@;>
; move pacman for 1 row macrograph z
TYPE <@:zp(b)t[+24,](s[24,50]m[3,5]a1)w(ri6)>
TYPE <@x@x@x@x@x@x@x@x@x@x@x@x@x@x@x@x@x@x>
TYPE <@x@x@x@x@x@x@x@x@x@x@x@x@x@x@x@x@x@xp(e)[,+50]@;>
TYPE <s(e)>
TYPE <
\> ;Exit REGIS
OUTSTR @SET241 ;Back to normal for VT241
RET
SUBTTL Display The Main Console Screen
;DSPCON
;
; Displays the TREK console. Positions cursor in middle of view
; screen and stores it.
DSPCON::CALL CLRSCR ;Clear the screen
MOVE T1,.TTTYP
JRST .+1(T1)
JRST DSP100 ;.TTTYP = 0 VT100 or VT125 (or VT241)
; JRST DSPGG ;.TTTYP > 0 GIGI
; .TTTYP = 1 = GIGI
DSPGG: TYPE <
=
[?8h
[?5;7l
[H
[J>
OUTSTR V.ASC
TYPE <
[;37m
[7;41H
7>
MOVEI T1,7
MOVEM T1,V.COLR
TYPE <
Pp>
TYPE <s(i0)>
TRNE SUOT,1b35
TYPE <w(i5)W(S1[,479])P[0,0]V[+730]>
TRNN SUOT,1b35
TYPE <w(i4)W(S1[,479])P[0,0]V[+730]>
TRNE SUOT,1b35
TYPE <w(i1)>
TRNN SUOT,1b35
TYPE <w(i6)>
TYPE <w(s[,20])p[12,258]v[+13]p[55]>
TYPE <v[+618]p[+24]v[+12]>
TYPE <w(s[,280])p[12,458]v[+526]>
TYPE <W(ES[,241])P[23,20]V[+12]P[+24]V[+614]P[+24]V[+12]>
TYPE <W(S[,280])P[24,439]V[+516]P[+12,+20]V[+160]W(RS0)>
TYPE <w(i4)>
TYPE <P[,+40]P(B)V[+509]P(E)>
TYPE <@:AP(B)V[,-40]P(E)@;>
TYPE <P[+126]@A[+126]@A[+81]@A[+45]@A[+63]@A>
TYPE <@:ap(b)v[+144]p(e)[,+40]@;>
TYPE <p[561,288]@a@a@a@a@a>
TYPE <@:bp(b)v[,+160]p(e)[+36]@;>
TYPE <p[561,288]@b@b@b@b@b>
TYPE <p[597,408]v(w(c))[,+39]>
TYPE <p[669,408]v(w(c))[+35]>
TYPE <@:at(w(c))'48 40 32 24 16 8 0 8 16 24 32 40 48'@;>
TRNE SUOT,1b35
TYPE <w(i5)>
TRNN SUOT,1b35
TYPE <w(i4)>
TYPE <p[81,0]@a>
TYPE <p[81,260]@a>
TYPE <p[27,40]>
TYPE <t(w(c))'16'>
TYPE <@:bp[-9,+40]t(w(c))'8'>
TYPE <p[-9,+40]t(w(c))'0'>
TYPE <p[-9,+40]t(w(c))'8'@;>
TYPE <@bp[-18,+40]t(w(c))'16'>
TYPE <p[686,40]>
TYPE <t(w(c))'16'>
TYPE <p[-9]@b>
TYPE <p[-9,+40]t(w(c))'16'>
TYPE <@:cp[,+39]v(w(c))[][+1][,+1][-1]@;>
TRNE SUOT,1b35
TYPE <w(i1)>
TRNN SUOT,1b35
TYPE <w(i6)>
TYPE <p[54,10]@c@c@c@c@c>
TYPE <p[676,10]@c@c@c@c@c>
TYPE <@:dp[+44]v(w(C))[][,+1][+1][,-1]@;>
TYPE <p[51,251]@D@D@D@D@D@D@D@D@D@D@D@D@D>
TYPE <w(i4)>
TYPE <p[30,300]t'ENERGY'>
TYPE <p[+72]t'SHL'>
TYPE <p[+99]t'WARP'>
TYPE <p[567,300]t'MOV'>
TYPE <p[+9]t'ROT'>
TYPE <p[+9]t'WRP'>
TYPE <p[+9]t'LIS'>
TYPE <p[567,340]t'TAR'>
TYPE <p[+9]t'PHA'>
TYPE <p[+9]t'TOR'>
TYPE <p[+9]t'ERA'>
TYPE <p[567,380]t'LOK'>
TYPE <p[+9]t'REF'>
TYPE <p[+9]t'SHL'>
TYPE <p[+9]t'EXE'>
TYPE <p[567,420]t'LR SCAN'>
TYPE <p[+9]t'MOR'>
TYPE <
\>
RET
; .TTTYP = 0 = VT100 or VT125
DSP100: CALL DSPBRI ;Display the bright areas
CALL DSPDRK ;Display the dark areas
CALL DSPDSP ;Display the lower left area
CALL DSPPAD ;Display the keypad area
OUTSTR V.ASC
TYPE <
[m
[7;41H
7>
;Position the cursor at screen center
RET ;Return
DSPBRI: TYPE <
[H
[;1;7m>
OUTSTR V.GRA
CALL DSPBR1
CALL DSPBR2
TYPEC <
[C
[C16
[67C 16
[C >
CALL DSPBR2
TYPEC <
[C
[C 8
[67C 8
[C >
CALL DSPBR2
TYPEC <
[C
[C 0
[67C 0
[C >
CALL DSPBR2
TYPEC <
[C
[C 8
[67C 8
[C >
CALL DSPBR2
TYPEC <
[C
[C16
[67C 16
[C >
CALL DSPBR2
CALL DSPBR3
TYPEC < >
CALL DSPBR1
MOVEI C,10
DSPB.1: TYPEC <
[C
[57C
[17C >
SOJG C,DSPB.1
TYPE <
[C>
TYPE < >
TYPEC <
[17C >
CALL DSPBR3
TYPE < >
RET
DSPBR1: TYPE <
[C >
TYPE <48 40 32 24 16 8 0 8 16 24 32 40 48>
TYPEC < >
RET
DSPBR2: TYPEC <
[C
[C
[67C
[C >
RET
DSPBR3: TYPE <
[C >
TYPE < >
RET
DSPDRK: TYPE <
[2;1H
[;7m>
MOVEI C,5
DSPD.1: TYPEC <
[2C
[3C
[67C
[3C >
TYPEC <
[2C
[3C~
[67C~
[3C >
SOJG C,DSPD.1
TYPEC <
[2C
[3C
[67C
[3C >
TYPE <
[2C/
[2C>
TYPE </ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ \>
TYPE <
[2C \>
TYPE <
[15;1H>
MOVEI C,10
DSPD.2: TYPEC <
[2C
[57C >
SOJG C,DSPD.2
TYPE <
[2C/ \>
RET
DSPDSP: OUTSTR V.GRA
TYPE <
[15;4H>
TYPEC <
[mlqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqwqqqqwqqqqqqwqqqqqqk>
TYPE <
[3Cx ENERGY x SHL x WARP >
TYPEC <x
[7m
[mx>
TYPEC <
[3Ctqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqvqqqqvqqqqqqvqqqqqqu>
TYPEC <
[3Cx
[55Cx>
TYPEC <
[3Cx
[55Cx>
TYPEC <
[3Cx
[55Cx>
TYPEC <
[3Cx
[55Cx>
TYPE <
[3Cmqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqj>
RET
DSPPAD: TYPE <
[m>
OUTSTR V.GRA
TYPE <
[15;63Hlqqqwqqqwqqqwqqqk>
TYPE <
[16;63HxMOVxROTxWRPxLISx>
TYPE <
[17;63Htqqqnqqqnqqqnqqqu>
TYPE <
[18;63HxTARxPHAxTORxERAx>
TYPE <
[19;63Htqqqnqqqnqqqnqqqu>
TYPE <
[20;63HxLOKxREFxSHLxEXEx>
TYPE <
[21;63Htqqqvqqqnqqqu x>
TYPE <
[22;63HxLR SCANxMORx ` x>
TYPE <
[23;63Hmqqqqqqqvqqqvqqqj>
RET
SUBTTL Clear Screen
CLRSCR: TYPE <
[1;24r
=
[?8h
[?5;6;7l
[H
[J>
;set VT100 characteristics:
; 1;24r set scrolling region to full screen
; = turn on keypad
; 8h autorepeat on
; 5l white on black screen
; 6l absolute origin
; 7l no wraparound
; H home the cursor
; J clear the screen
; B alphanumeric character set
OUTSTR V.ASC
RET
SUBTTL Do VT100 Self Test
VTEST:: SKIPN VTFLAG
AOSA (SP)
TYPEC < >
RET
SUBTTL VT100 Initialization
;VTINI
;
; Call: enter routine VTINI using integer.
;
; Initializes and tests the terminal.
VTINI:: CALL TTYSET
CALL VTTEST
SKIPE VTFLAG
JRST VTERR
RET
SUBTTL Check Terminal Type
;VTTEST
;
; Call: enter routine VTTEST using integer.
;
; Determines whether the terminal is a VT100 with advanced
; video option. Returns 0 if this is the case, returns -1
; otherwise.
VTTEST::SETOM VTFLAG ;Assume not a VT100
SETZM V52FLG ;And not in VT52 mode
TYPE <
Z> ;Ask terminal to identify itself
MOVEI T3,^D100 ;Wait 100 * 100ms = 10 sec
VWAIT: MOVEI T1,^D100
DISMS%
MOVEI T1,.PRIIN
SIBE% ;Any input?
JRST VIDENT ;Yes - get it
SOJLE T3,R ;Return if timeout
JRST VWAIT ;Else, continue
VIDENT: INCHRW T3 ;Return char in T3
CAIE T3,.CHESC ;Is the character an escape?
RET ;No - error (id sequence begins w escape)
INCHRW T3 ;Get the next id character
CAIN T3,"[" ;Is it a [?
JRST VT100 ;Yes - assume a VT100
CAIE T3,"/" ;No - is it a /?
RET ;No - terminal is not a VT100
VT152: INCHRW T3 ;Get the 3rd character
CAIE T3,"Z" ;Is it a Z?
RET ;No - not a VT100 in VT52 mode
SETOM V52FLG ;Yes - remember that
OUTSTR [ASCIZ/
<
Z/] ;And change the mode to ANSI
INCHRW T3 ;And ask again for identification.
INCHRW T3 ;Skip the 1st 2 characters
VT100: INCHRW T3 ;Skip the ?
INCHRW T3 ;Get the terminal id nbr
CAIE T3,"5" ;Is it a GIGI
IFSKP.
AOS .TTTYP
AOS .GRTYP
JRST GIGI
ENDIF.
CAIN T3,"6" ;Is it a VT200 series or VT102
JRST VT220
CAIE T3,"1" ;Make sure it is a VT100
RET
SKIPA
;..
;..
GIGI: SETOM VKFLAG
INCHRW T3 ;Get next char
CAIN T3,"2" ;Is it a VT125
JRST VT125
INCHRW T1 ;Get options
INCHRW T3 ;Skip the final c
SETFNT: MOVEI T2,VKFNT1
SKIPN .TTTYP ;Skip if GIGI
MOVEI T2,VTFNT1
SETFN1: SKIPE VKFLAG ;Skip if not graphics
OUTSTR (T2)
SKIPN VKFLAG ;GIGI or
TRNE T1,1B34 ;Advanced video?
SKIPA
IFNSK.
OUTSTR [ASCIZ /
This VT100 does not have an advanced video option.
The game will be played anyhow even though the screen will be incomplete.
/]
MOVEI T1,^D5000
DISMS%
ENDIF.
SETZM VTFLAG ;Clear flag (TTY is a VT100)
RET ;Return
VT125: INCHRW T3 ;Skip input until c
CAIN T3,"7" ;Are we a VT241?
JRST VT241
CAIN T3,"C" ;At the end?
JRST VT125A
CAIE T3,"c"
JRST VT125
VT125A: AOS .GRTYP
SETOM VKFLAG
JRST SETFNT
VT220: INCHRW T3 ;Get next char
CAIN T3,"2" ;Is it a vT220
JRST VT221
CAIE T3,";" ;Is it a vT102
RET
INCHRW T1 ;Get options
VT221: INCHRW T3 ;Skip input until c
CAIN T3,"C" ;Is this a C?
JRST VTERR
CAIE T3,"c"
JRST VT221
JRST VTERR
VT241: MOVEI T2,.CTTRM ;Clear terminal input
CFIBF%
MOVE T1,[T241.R,,V.RED] ;Remap the color tables
BLT T1,V.WHT ;Do the rewrite
AOS .GRTYP ;And even say we have ReGIS graphics
SETOM VKFLAG ;Like a GIGI
SETOM VT241F ;But really a VT241
OUTSTR @SET241
MOVEI T2,VKFNT1 ;Set GIGI fonts
JRST SETFN1 ;And get going
VTERR: TYPEC < >
TYPEC < >
TYPEC <Sorry, this program only runs on VT100s, VT125s, and>
TYPEC <GIGIs, which gives full color and graphics! If you are>
TYPEC <using a VT241, set it in VT125 mode and you will be able>
TYPEC <to take advantage of graphic features too.>
FINI: HALTF%
JRST TREK
SUBTTL Set Terminal Control Words
TTYSET::MOVEI T1,.PRIOU ;This terminal
RFMOD% ;Get JFN mode word
MOVE T2,SAVMOD ;Save for later
TXZ T2,<TT%ECO+TT%DAM> ;Now set these for sure
SFMOD% ;Do it
MOVX T2,.MORSP ;Get terminal speed
MTOPR% ;Well?
ERJMP .+1 ;This sometimes no work
CAMN T3,[-1] ;Check for detached
MOVEI T3,0 ;If detached, then no terminal speed
HRRZM T3,TOTSP ;Stash speed here
RET
SUBTTL Reset Terminal Modes When Exit
TTYRST::SKIPE V52FLG ;Need to reset VT100 to VT52 mode?
OUTSTR [ASCIZ /
[?2l/] ;Yes, do it
SETZM V52FLG ;Say a VT52 again
MOVEI T1,.PRIOU ;This terminal
MOVE T2,SAVMOD ;Get old JFN mode words
SFMOD% ;Restore them
RET ;And done
FINTTY::CALL TTYRST
RET ;Return
SUBTTL Make .SHARE File & .EXE File
;Code to generate shareable segment and .EXE file
MAKIT: RESET% ;Start like all good programs
MOVX T1,<GJ%FOU+GJ%SHT> ;Short form
HRROI T2,[ASCIZ /DSK:VT241.SHARE/] ;This is the .SHARE file
GTJFN% ;Get a JFN for it
ERJMP MAKERR
MOVX T2,OF%WR ;Open for write
OPENF% ;Do it
ERJMP MAKERR
JSP SP,MAKSHR ;Move shareable pages, etc..
HRLI T1,.FBSIZ ;File page count
SETO T2,
MOVE T3,T4 ;Page count
LSH T3,^D9 ;Words
CHFDB% ;Change file's FDB
ERJMP .+1
HRLI T1,.FBBYV ;This word
MOVX T2,FB%BSZ ;This field
MOVX T3,<FLD (^D36,FB%BSZ)> ;Change byte size
CHFDB%
ERJMP .+1
SETZM BOOTF ;Boot flag
MOVEI T1,.FHSLF ;This fork
MOVE T2,[3,,EV] ;Get entry vector
SEVEC% ;Set entry vector
ERJMP .+1
;..
;..
SKIPN UOT,121 ;Make .EXE file if non-zero
JRST MAKIX
MOVEI UOT,(UOT) ;Higest location set by LINK
LSH UOT,-^D9
SETZM 120
SETZM 121
SETZM 44 ;Clear this TOPS10 stuff
MOVX T1,<GJ%FOU+GJ%SHT> ;Short form
HRROI T2,[ASCIZ /DSK:VT241.EXE/] ;Name of the .EXE file
GTJFN% ;Get a JFN for it
ERJMP MAKERR
HRLI T1,.FHSLF ;This process
MOVNI T2,1(UOT)
HRLZS T2
TXO T2,<SS%RD+SS%CPY+SS%EXE> ;Page protection (read, c-o-w, exe)
SETZ T3,
SSAVE% ;Make .EXE file be on disk
ERJMP MAKERR
MAKIX: HRROI T1,[ASCIZ /
Game successfully made. You must run the .EXE file it if you
would like to play.
/]
ERDUN: PSOUT
HALTF%
JRST .-1 ;Make user run new .EXE file
SUBTTL Code to Make Shareable Segment
;Common code to create shareable segment. JFN in T1, preserved.
MAKSHR: MOVE T3,[LOCSHR,,SHRBEG] ;Start here
BLT T3,SHREND ;Make pages private
SETOM INITF ;Say freshly initiated
HRLZ T2,T1 ;JFN to LHS
MOVE T1,[.FHSLF,,<SHRBEG>_-^D9]
MOVEI T3,<SHREND_-^D9>-<SHRBEG_-^D9>+1
MOVE T4,T3 ;Save page count
TXO T3,<PM%CNT+PM%RD+PM%WR+PM%EX>
PMAP%
ERJMP MAKERR
HLRZ T1,T2 ;Get JFN back
TXO T1,CO%NRJ ;Retain it
CLOSF%
ERJMP MAKERR
MOVEI T1,(T1)
JRSTF @SP
SUBTTL Error Reporting
MAKERR: HRROI T1,[ASCIZ /
Error while trying to make .EXE file or .share file - /]
LASERR: ESOUT%
MOVEI T1,.CTTRM ;This terminal
HRLOI T2,.FHSLF ;This fork
SETZ T3, ;Don't limit byte count
ERSTR% ;Show us last TOPS-20 error
JFCL
JFCL
HRROI T1,[ASCIZ /
/] ;Neatness counts
JRST ERDUN
VERERR: HRROI T1,[ASCIZ /
?Common segment and program versions don't match.
/]
JRST ERDUN
BTERR: HRROI T1,[ASCIZ /
?Access error for Common segment - /]
JRST LASERR
SUBTTL Game Boot Area
BOOTS:: SKIPE BOOTF ;Check boot flag
JRST TREK ;Game already booted!
MOVE T1,[.FHSLF,,<TREK>_-^D9]
RMAP%
ERJMP MAKERR
HLRZ T2,T1
SETZ T4,
HRROI T1,TK.DEV ;Get device name
MOVX T3,<FLD(.JSAOF,JS%DEV)>
JFNS%
HRROI T1,TK.DIR ;Now for directory name
MOVX T3,<FLD(.JSAOF,JS%DIR)>
JFNS%
HRROI T1,TK.NAM ;And last is the name
MOVX T3,<FLD(.JSAOF,JS%NAM)>
JFNS%
HRROI T1,[ASCIZ /SHARE/] ;Extension is already known
MOVEM T1,GJBLK+.GJEXT ;Put it in block
MOVX T1,GJ%OLD ;Must be there
MOVEM T1,GJBLK
MOVEI T1,GJBLK ;Here's the block
SETZ T2, ;No default string
GTJFN%
ERJMP BTERR
MOVE UOT,T1 ;Save JFN
MOVX T2,<OF%WR+OF%RD>
OPENF% ;Try to open frozen
ERJMP BOOT1 ;Can't game in progress!
JSP SP,BTMAP ;Map in segment
MOVE AP,INITF ;Get copy of flag
MOVE T2,[.FHSLF,,<SHRBEG_-^D9>]
SETO T1, ;Unmap pages
MOVE T3,[PM%CNT+<<SHREND_-^D9>-<SHRBEG_-^D9>+1>]
PMAP%
ERJMP BTERR
JUMPN AP,[MOVE T1,UOT
TXO T1,CO%NRJ ;Yes - just open thawed
CLOSF%
JFCL
JRST BOOT1]
MOVE T1,UOT ;Restore JFN
JSP SP,MAKSHR ;Write new disk copy
BOOT1: MOVX T2,<OF%RD+OF%WR+OF%THW+OF%DUD>
MOVE T1,UOT
OPENF%
ERJMP BTERR
JSP SP,BTMAP ;Get shareable segment
SETZM INITF ;Clear this
SETOM BOOTF ;Say successfully booted
JRST TREK ;Startup game...
;Map in shareable segment - T1 has JFN of segment
BTMAP: HRLZS T1 ;JFN only
MOVE T2,[.FHSLF,,<SHRBEG>_-^D9] ;File page count
MOVEI T3,<SHREND_-^D9>-<SHRBEG_-^D9>+1
TXO T3,<PM%CNT+PM%RD+PM%WR+PM%EX> ;Access control bits
PMAP% ;Map it in
ERJMP BTERR
JRSTF @SP
END <1,,MAKIT>
