SUBROUTINE SEND (MTYPE, IX, IY) C*BEGIN COMMON COMMON SNAP,SNAPSHT(247), + DATE,REMKL,REMCOM,REMBASE,REMRES,REMTIME,STARKL,BASEKL, + KILLK,KILLC,GALAXY(8,8),CX(10),CY(10),BASEQX(5),BASEQY(5), + NEWSTUF(8,8),PLNETS(10,5),ISX,ISY,NSCREM,NROMKL,NROMREM, + NSCKILL,NPLANKL,ISATB,BATX,BATY,THINGX,THINGY, + QUAD(10,10),KX(20),KY(20),KPOWER(20),KDIST(20),KSTUF(20), + FUTURE(10),MESSAGE(5,10), + INKLING,INBASE,INRESOR,INCOM,INTIME,INSTAR,INENRG,INSHLD, + INTORPS,INLSR,INDATE,ENERGY,SHLD,SHLDUP,CONDIT,TORPS,SHIP, + QUADX,QUADY,SECTX,SECTY,WARPFAC,WFACSQ,LSUPRES,DAMAGE(20), + LENGTH,SKILL,PASSWD,DIST,DIREC,TIME,BASEX,BASEY,DOCKFAC, + KLHERE,COMHERE,CASUAL,NHELP,NKINKS,STARCH(8,8), + DEVICE(2,14),IDIDIT,GAMEWON,ALIVE,JUSTIN,RESTING,ALLDONE, + DAMFAC,SHLDCHG,NDEVICE,PLNETX,PLNETY,INORBIT,LANDED,IPLANET, + IMINE,ICRYSTL,INPLAN,NENHERE,ISHERE,NEUTZ,IRHERE,ICRAFT, + IENTESC,ISCRAFT,ISCATE,CRYPROB,ICITE,IPHWHO, + CRACKS(12) INTEGER SHLDUP,CONDIT,QUADX,QUADY,SECTX,SECTY,TORPS, + REMKL,REMBASE,SKILL,REMCOM,GALAXY,STARCH,CX,CY, + SHIP,ALLDONE,BASEQX,BASEQY,BASEX,BASEY,GAMEWON, + ALIVE,STARKL,BASEKL,CASUAL,COMHERE,RESTING,SNAP,SHLDCHG, + THINGX,THINGY,BATX,BATY,PLNETX,PLNETY,PLNETS REAL KDIST,KPOWER,LSUPRES,INTIME,INRESOR,INDATE,INSHLD, + INENRG,INLSR BYTE QUAD REAL*8 DEVICE,PASSWD C*END COMMON LOGICAL*1 IHS,IHR,IHC,IHK,IHE,IHF,IHBLANK,IHDOT,IHP,IHB 1 ,IHSTAR,IHT,IHQUEST,IHNUM COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB +,IHT,IHNUM INTEGER SENT EQUIVALENCE (CRACKS(8),SENT),(KSTUF(6),MESS) EQUIVALENCE (KSTUF(7),IKNOWC),(KSTUF(8),IKNOWS) INTEGER BACK,ISD(2) EQUIVALENCE (SD,ISD(1)) C----------CLEAR 'MESSAGE SENT' FLAG SENT=0 C----------NO MESSAGES IF NO BASES LEFT IF(REMBASE .LE. 0) RETURN IF(CONDIT.EQ.IHDOCKD .OR. DAMAGE(9).EQ.0.0) GO TO 30 C----------CANNOT SEND NOW IF(MTYPE .EQ. 0) RETURN C----------TRY SAVING IT FOR LATER IF(MESS .EQ. 0) GO TO 25 GO TO (20,2,2,20,4,2,4),MTYPE C----------S. C. SEEN, DESTROYS PLANET, OR ATTACKS BASE C----------REMOVE PREVIOUS 'SEEN' MESSAGE 2 MDROP=2 GO TO 10 C----------BASE DESTROYED, REMOVE 'UNDER ATTACK' MESSAGE 4 MDROP=MTYPE-1 10 I=0 11 I=I+1 12 IF(I .GT. MESS) GO TO 20 IF(MESSAGE(3,I) .NE. MDROP) GO TO 11 MESS=MESS-1 DO 15 J=I,MESS DO 15 K=1,5 15 MESSAGE(K,J)=MESSAGE(K,J+1) IF(MDROP .NE. 1) GO TO 12 C----------OBSOLETE MESSAGES DROPPED - IS THERE ROOM FOR THIS ONE? 20 IF(MESS .LT. 10) GO TO 25 C----------NO; START DROPPING SUPERNOVA MESSAGES MDROP=1 GO TO 10 C----------SAVE THIS MESSAGE FOR LATER TRANSMISSION 25 MESS=MESS+1 SD=DATE MESSAGE(1,MESS)=ISD(1) MESSAGE(2,MESS)=ISD(2) MESSAGE(3,MESS)=MTYPE MESSAGE(4,MESS)=IX MESSAGE(5,MESS)=IY IF(MTYPE .EQ. 4) IKNOWC=0 IF(MTYPE .EQ. 6) IKNOWS=0 C----------NEW MESSAGE SAVED - NOTHING MORE TO DO RETURN C----------TRANSMIT ANY SAVED MESSAGES 30 IF(MESS .EQ. 0) GO TO 84 CALL SKIP(1) CALL PROUT(39HLT. UHURA: "CAPTAIN, STARFLEET COMMAND,39) CALL PROUT(43H HAS TRANSMITTED THE FOLLOWING MESSAGES,43) CALL PROUT(41H ACCUMULATED WHILE OUR SUBSPACE RADIO,41) CALL PROUT(17H WAS DAMAGED.,17) BACK=1 I=0 35 I=I+1 IF(I .GT. MESS) GO TO 82 CALL SKIP(1) CALL CRAM(9HSTARDATE ) ISD(1)=MESSAGE(1,I) ISD(2)=MESSAGE(2,I) CALL CRAMF(SD,0,1) CALL CRAM(1H.) CALL CRAMCH(1H ,5) MESTYP=MESSAGE(3,I) JX=MESSAGE(4,I) JY=MESSAGE(5,I) 39 GO TO (40,40,40,60,40,60,40),MESTYP 40 CALL CRAM(10HSTARFLEET ) GO TO (45,46,46,60,45,60,45),MESTYP 45 CALL CRAM(8HCOMMAND ) GO TO 47 46 CALL CRAM(13HINTELLIGENCE ) 47 CALL CRAMDMP(8HREPORTS ) CALL CRAMCH(1H ,5) GO TO (50,60,50,60,60,60,60),MESTYP 50 CALL CRAM(2HA ) IF(MESTYP .EQ. 3) GO TO 55 CALL CRAM(13HSUPERNOVA IN ) CALL CRAMLOC(1,JX,JY) CALL CRAM(17H; CAUTION ADVISED) STARCH(JX,JY) = 1 GO TO 80 55 CALL CRMENA(IHP,1,JX,JY) GO TO 66 60 CALL CRAM(4HTHE ) IF(MESTYP .NE. 2) GO TO 65 CALL CRAMEN(IHS) CALL CRAM(7H IS IN ) CALL CRAMLOC(1,JX,JY) GO TO 80 65 CALL CRMENA(IHB,1,JX,JY) GO TO (40,46,40,75,66,75,66),MESTYP 66 CALL CRAMDMP(22H HAS BEEN DESTROYED BY) CALL CRAMCH(1H ,5) IF(MESTYP .NE. 5) GO TO 70 CALL CRAM(10HA KLINGON ) CALL CRAMEN(IHC) IKNOWC=0 GO TO 80 70 CALL CRAM(12HTHE KLINGON ) CALL CRAMEN(IHS) IF(MESTYP .EQ. 7) IKNOWS=0 GO TO 80 75 CALL CREND CALL CRAMCH(1H ,5) CALL CRAM(20HREPORTS IT IS UNDER ) IF(MESTYP .NE. 4) GO TO 77 CALL CRAMEN(IHC) IKNOWC=1 77 IF(MESTYP .NE. 6) GO TO 78 CALL CRAMEN(IHS) IKNOWS=1 78 CALL CRAMDMP(24H ATTACK. IT CAN SURVIVE) CALL CRAMCH(1H ,5) CALL CRAM(15HUNTIL STARDATE ) CALL CRAMF(FUTURE(MESTYP+1),0,1) 80 CALL CRAM(1H.) IF(BACK .EQ. 0) GO TO 90 C----------CONTINUE WITH MESSAGE BACKLOG CALL CREND GO TO 35 C----------END OF SAVED MESSAGES 82 MESS=0 CALL SKIP(1) CALL PROUT(42HNO FURTHER ACCUMULATED MESSAGES, CAPTAIN.",42) C----------PRINT THE CURRENT MESSAGE IF ANY 84 IF(MTYPE .EQ. 0) RETURN BACK=0 MESTYP=MTYPE JX=IX JY=IY CALL SKIP(1) CALL CRAM(22HLT. UHURA: "CAPTAIN, ) GO TO 39 90 CALL CRAMDMP(1H") C----------CURRENT MESSAGE SENT, SET FLAG TO SAY SO SENT=1 RETURN END