home *** CD-ROM | disk | FTP | other *** search
/ ftp.ee.lbl.gov / 2014.05.ftp.ee.lbl.gov.tar / ftp.ee.lbl.gov / mtrek.shar.Z / mtrek.shar / bplayer.ftn < prev    next >
Text File  |  1990-04-02  |  8KB  |  414 lines
  1.     PROGRAM PLAYER
  2.  
  3.     INCLUDE 'LEDFOR.COM/-LI'
  4.     INCLUDE 'PLAYER.COM/-LI'
  5.     INCLUDE 'COMMND.COM/-LI'
  6.     INCLUDE 'BUFFER.COM/-LI'
  7.  
  8.     REAL OVER(4)
  9.     INTEGER*2 ILOCAT
  10.     DATA OVER /6RREADY ,6RMESAGE,6RREDRAW,6RTWENTY/
  11.     DATA ILOCAT/0/
  12.  
  13.     CALL MNLOAD(OVER(1))    ! Load ready
  14.     CALL READY
  15.     CALL MNLOAD(OVER(2))    ! Load mesage
  16. C
  17. C    *** This is the top of the loop ***
  18. C
  19. 10021    CONTINUE
  20.  
  21. C    Generate new display
  22.     DO 10046 IX=1,21
  23.     DO 10049 IY=1,17
  24.     NEWBUF(IX,IY)=' '
  25. 10049    CONTINUE
  26. 10046    CONTINUE
  27.  
  28.     I=INT(XCORD(WHO))
  29.     J=INT(YCORD(WHO))
  30.     IXB=0
  31.     IXRIG=I+10
  32.     IF(IXRIG.GT.100)IXRIG=100
  33.     IXLEF=I-10
  34.     IF(IXLEF.GE.1)GOTO 10015
  35.     IXLEF=1
  36.     IXB=20-IXRIG
  37. 10015    CONTINUE
  38.     IYSCA=0
  39.     IYBOT=J-8
  40.     IF(IYBOT.LT.1)IYBOT=1
  41.     IYTOP=J+8
  42.     IF(IYTOP.LE.100)GOTO 10016
  43.     IYTOP=100
  44.     IYSCA=IYBOT-84
  45. 10016    CONTINUE
  46.  
  47.     DO 10052 IX=IXLEF,IXRIG
  48.     IXB=IXB+1
  49.     IYB=IYSCA
  50.     DO 10054 IY=IYTOP,IYBOT,-1
  51.     IYB=IYB+1
  52.     NEWBUF(IXB,IYB)=UNIV(IX,IY)
  53.     IF(NEWBUF(IXB,IYB).LT.'1')GOTO 10054
  54.     IF(NEWBUF(IXB,IYB).GT.'8')GOTO 10054
  55.     J=NEWBUF(IXB,IYB)-"60
  56.     IF(.NOT.CLOAK(J))GOTO 10054
  57.     NEWBUF(IXB,IYB)='.'
  58.     IF(J.NE.WHO)GOTO 10054
  59.     NEWBUF(IXB,IYB)='~'
  60. 10054    CONTINUE
  61. 10052    CONTINUE
  62. C
  63. C    Generate report
  64. C
  65.     VALUE=XTOCLK(COURSE(WHO))
  66.     ENCODE(28,10063,NEWREP)VALUE,WARP(WHO),ENERGY(WHO),SHIELD(WHO)
  67. 10063    FORMAT(2X,F5.2,2X,F5.2,F7.1,F7.1)
  68. C
  69. C    Generate scores
  70. C
  71.     ENCODE(56,10064,NEWSCR)SCORE
  72. 10064    FORMAT(8I7)
  73. C
  74. C    Generate new coordinates
  75. C
  76.     ENCODE(15,10070,NEWCOR)XCORD(WHO),YCORD(WHO)
  77. 10070    FORMAT('X:',F5.1,' Y:',F5.1)
  78. C
  79. C    Redraw display for a 'reset'
  80. C
  81.     IF(.NOT.RESET)GOTO 10122
  82.     CALL MNLOAD(OVER(3))    ! Load redraw
  83.     CALL REDRAW
  84.     CALL MNLOAD(OVER(4))    ! Load twenty
  85.     GOTO 10120
  86. C
  87. C    ** Start of updating code **
  88. C
  89. C    Compare and update display
  90. C
  91. 10122    CONTINUE
  92.     DO 10102 IY=1,17
  93.     DO 10104 IX=1,21
  94.     IF(NEWBUF(IX,IY).EQ.OLDBUF(IX,IY))GOTO 10104
  95.     CALL WRITE(IY,2*(IX-1)+24,NEWBUF(IX,IY),1)
  96.     OLDBUF(IX,IY)=NEWBUF(IX,IY)
  97. 10104    CONTINUE
  98. 10102    CONTINUE
  99. C
  100. C    Compare and update coordinates
  101. C
  102.     DO 10095 I=3,15
  103.     IF(OLDCOR(I).EQ.NEWCOR(I))GOTO 10095
  104.     CALL WRITE(2,3+I,NEWCOR(I),1)
  105.     OLDCOR(I)=NEWCOR(I)
  106. 10095    CONTINUE
  107. C
  108. C    Compare and update reports
  109. C
  110.     DO 10111 IY=1,4
  111.     DO 10114 IX=1,7
  112.     IF(OLDREP(IX,IY).EQ.NEWREP(IX,IY))GOTO 10114
  113.     OLDREP(IX,IY)=NEWREP(IX,IY)
  114.     CALL WRITE(IY+3,IX+11,NEWREP(IX,IY),1)
  115. 10114    CONTINUE
  116. 10111    CONTINUE
  117.  
  118.     IF(HYPER(WHO).EQ.HYPX)GOTO 10115
  119.     HYPX=HYPER(WHO)
  120.     CALL WRITE(8,14,0)
  121.     CALL NUMBER(HYPX)
  122. 10115    IF(TORPS(WHO).EQ.TORX)GOTO 10116
  123.     CALL WRITE(9,14,0)
  124.     TORX=TORPS(WHO)
  125.     CALL NUMBER(TORX)
  126. 10116    CONTINUE
  127. C
  128. C
  129. C    Compare and update time
  130. C
  131.     DO 10121 I=1,15
  132.     IF(TIM(I).EQ.OLDTIM(I))GOTO 10121
  133.     CALL WRITE(14,I,TIM(I),1)
  134.     OLDTIM(I)=TIM(I)
  135. 10121    CONTINUE
  136.  
  137.     IF(OLDTIM(16).EQ.TIM(16))GOTO 10119
  138.     CALL WRITE(14,17,TIM(16),1)
  139.     OLDTIM(16)=TIM(16)
  140. C
  141. C    Compare and update scores and manned ships
  142. C
  143. 10119    DO 10120 IY=1,8
  144.     DO 10123 IX=1,7
  145.     IF(OLDSCR(IX,IY).EQ.NEWSCR(IX,IY))GOTO 10112
  146.     CALL WRITE(IY+5,IX+71,NEWSCR(IX,IY),1)
  147.     OLDSCR(IX,IY)=NEWSCR(IX,IY)
  148.  
  149. C    Now check manned ships
  150. 10112    IF(.NOT.(OLDACT(IY).XOR.ALIVE(IY)))GOTO 10123
  151.     TMP=' '
  152.     IF(ALIVE(IY))TMP='*'
  153.     CALL WRITE(IY+5,69,TMP,1)
  154.     OLDACT(IY)=ALIVE(IY)
  155. 10123    CONTINUE
  156. 10120    CONTINUE
  157. C
  158. C    ** Top of command loop **
  159. C
  160. C
  161. C    Flush the buffer and delay a second before continuing
  162. C
  163.     CALL FLUSH
  164.     CALL MARK(24,60,1)
  165.     CALL WFLOR(24,25)
  166.     CALL BANDIT            ! *** Robot time...
  167.     IF(CMD(1).EQ.0)GOTO 10132
  168. C
  169. C    Got a command
  170. C
  171.     IF(CMD(1).EQ."32)GOTO 10022    ! Exit
  172.     IF(CMD(1).EQ.'R')GOTO 10146    ! Reset
  173.     IF(CMD(1).EQ."15)GOTO 10138    ! Null command
  174.     LOOP=2
  175.     CALL WRITE(19,35,0)
  176.     IF(CMD(1).EQ.'X')GOTO 10278    ! Explode
  177.     IF(CMD(1).EQ.'W')GOTO 10137    ! Warp
  178.     IF(CMD(1).EQ.'C')GOTO 10139    ! Course
  179.     IF(CMD(1).EQ.'P')GOTO 10200    ! Phaser
  180.     IF(CMD(1).EQ.'T')GOTO 10185    ! Torpedo
  181.     IF(CMD(1).EQ.'Z')GOTO 10286    ! Launch
  182.     IF(CMD(1).EQ.'S')GOTO 10160    ! Shields
  183.     IF(CMD(1).EQ.'L')GOTO 10225    ! Locate
  184.     IF(CMD(1).EQ.'F')GOTO 10258    ! Cloak
  185.     IF(CMD(1).EQ.'A')GOTO 10270    ! Un-cloak
  186.     IF(CMD(1).EQ.'H')GOTO 10148    ! Hyperspace
  187. C
  188. C    Not a valid command
  189. C
  190.     CALL FILL(7,1)
  191.     CALL FILL('Illegal command.    ')
  192.     GOTO 10138
  193. C
  194. C    Reset command
  195. C
  196. 10146    RESET=.TRUE.
  197.     CALL CLREF(25)
  198.     CMD(1)=0
  199.     GOTO 10021
  200. C
  201. C    Warp command
  202. C
  203. 10137    CALL CONREL(VALUE,OK,0.0,20.0,RANGE)
  204.     IF(.NOT.RANGE)GOTO 10141
  205.     IF(VALUE.NE.0.0)GOTO 10140
  206.     WARP(WHO)=0.0
  207.     CALL FILL('Engines stop.       ')
  208.     GOTO 10138
  209.  
  210. 10140    CLOAK(WHO)=.FALSE.
  211.     WARP(WHO)=VALUE
  212.     CALL FILL('Helm acknowledges.  ')
  213.     GOTO 10138
  214. C
  215. C    Course command
  216. C
  217. 10139    CALL CONREL(VALUE,OK,0.0,12.0,RANGE)
  218.     IF(.NOT.RANGE)GOTO 10141
  219.     IF(.NOT.OK)GOTO 10138
  220.     COURSE(WHO)=XTODEG(VALUE)
  221. 10158    CALL FILL('Helm responds.      ')
  222.     GOTO 10138
  223. C
  224. C    Hyperspace command
  225. C
  226. 10148    CALL CONINT(I,OK,1,6,RANGE)
  227.     IF(.NOT.RANGE)GOTO 10141
  228.     IF(.NOT.OK)GOTO 10138
  229.     HYPER(WHO)=I
  230.     CALL FILL('Navigation responds.')
  231.     GOTO 10138
  232. C
  233. C    Shield command
  234. C
  235. 10160    CALL CONREL(VALUE,OK,-1.E36,1.E36,RANGE)
  236.     IF(.NOT.RANGE)GOTO 10141
  237.     IF((.NOT.OK).OR.(VALUE.EQ.0.0))GOTO 10165
  238.     IF((SHIELD(WHO).GE.0.0).AND.(SHIELD(WHO)+VALUE.LE.0.0))GOTO 10178
  239.     IF(ENERGY(WHO)-VALUE.LT.0.0)GOTO 10180
  240.     ENERGY(WHO)=ENERGY(WHO)-VALUE
  241.     SHIELD(WHO)=SHIELD(WHO)+VALUE
  242.     CALL FILL('Defense responds.   ')
  243.     GOTO 10138
  244.  
  245. 10165    IF(SHIELD(WHO).LT.1000.0)GOTO 10167
  246.     VALUE=100.0
  247.     GOTO 10168
  248. 10167    VALUE=AINT(SHIELD(WHO))/10.0
  249. 10168    ENCODE(20,10166,IBUF)VALUE
  250. 10166    FORMAT('Shields at ',F<2+IWR(VALUE)>.1,' %',<5-IWR(VALUE)>X)
  251.     CALL FILL(IBUF,20)
  252.     GOTO 10138
  253.  
  254. 10178    ENERGY(WHO)=ENERGY(WHO)+SHIELD(WHO)
  255.     SHIELD(WHO)=0.0
  256.     CALL FILL('All energy to ship. ')
  257.     GOTO 10138
  258.  
  259. 10180    CALL FILL(7,1)
  260.     CALL FILL('That is impossible! ')
  261.     GOTO 10138
  262. C
  263. C    Torpedo command
  264. C
  265. 10185    IF(LAUNCH(WHO).GE.0.0)GOTO 10202
  266.     IF(TORPS(WHO).LE.0)GOTO 10205
  267.     CALL CONREL(VALUE,OK,0.0,12.0,RANGE)
  268.     IF(.NOT.RANGE)GOTO 10141
  269.     IF(OK)GOTO 10213
  270.     LAUNCH(WHO)=COURSE(WHO)
  271.     GOTO 10212
  272. 10213    LAUNCH(WHO)=XTODEG(VALUE)
  273. 10212    TORPS(WHO)=TORPS(WHO)-1
  274.     CALL FILL('Torpedo fired.      ')
  275.     GOTO 10138
  276.  
  277. 10205    CALL FILL(7,1)
  278.     CALL FILL('Out of torpedoes.   ')
  279.     GOTO 10138
  280.  
  281. 10202    CALL FILL(7,1)
  282.     CALL FILL('Torpedo not ready!  ')
  283.     GOTO 10138
  284. C
  285. C    Phaser command
  286. C
  287. 10200    IF(PHA(WHO).GE.0.0)GOTO 10227
  288.     CALL CONREL(VALUE,OK,0.0,12.0,RANGE)
  289.     IF(.NOT.RANGE)GOTO 10141
  290.     IF(OK)GOTO 10234
  291.     PHA(WHO)=COURSE(WHO)
  292.     GOTO 10235
  293. 10234    PHA(WHO)=XTODEG(VALUE)
  294. 10235    ENERGY(WHO)=ENERGY(WHO)-50.0
  295.     CALL FILL('Phaser banks fired. ')
  296.     GOTO 10138
  297.  
  298. 10227    CALL FILL(7,1)
  299.     CALL FILL('* Phasers not ready!')
  300.     GOTO 10138
  301. C
  302. C    Long range scan command
  303. C
  304. 10225    CALL CONINT(I,OK,0,8,RANGE)
  305.     IF(.NOT.RANGE)GOTO 10141
  306.     IF(.NOT.OK)I=ILOCAT
  307.     ILOCAT=I
  308.     IF(I.NE.0)GOTO 10151
  309.     IX=INT(ZX/10.0)
  310.     IY=INT(ZY/10.0)
  311.     GOTO 10152
  312.  
  313. 10151    IF(.NOT.ALIVE(I))GOTO 10257
  314.     IX=INT(XCORD(I)/10.0)
  315.     IY=INT(YCORD(I)/10.0)
  316. 10152    X=FLOAT(IX*10)
  317.     Y=FLOAT(IY*10)
  318.     VALUE=XTOCLK(ATAN2(Y-YCORD(WHO),X-XCORD(WHO))*180.0/3.1415926)
  319. 10254    ENCODE(20,10256,IBUF)VALUE
  320. 10256    FORMAT('Course is ',F<3+IWR(VALUE)>.2,<7-IWR(VALUE)>X)
  321.     CALL FILL(IBUF,20)
  322.     GOTO 10138
  323.  
  324. 10257    CALL FILL('No signal.          ')
  325.     GOTO 10138
  326. C
  327. C    Cloaking command
  328. C
  329. 10258    IF(CLOAK(WHO))GOTO 10272
  330.     CLOAK(WHO)=.TRUE.
  331.     WARP(WHO)=0.0
  332.     CALL FILL('Cloak activated.    ')
  333.     GOTO 10138
  334.  
  335. 10272    CALL FILL(7,1)
  336.     CALL FILL('* Already cloaked!  ')
  337.     GOTO 10138
  338. C
  339. C    Un-cloak command
  340. C
  341. 10270    IF(.NOT.CLOAK(WHO))GOTO 10280
  342.     CLOAK(WHO)=.FALSE.
  343.     CALL FILL('Cloak deactivated.  ')
  344.     GOTO 10138
  345.  
  346. 10280    CALL FILL(7,1)
  347.     CALL FILL('* Not cloaked yet!  ')
  348.     GOTO 10138
  349. C
  350. C    Detonate anti-matter device
  351. C
  352. 10278    IF(IPOD(WHO).NE.2)GOTO 10288
  353.     IPOD(WHO)=3
  354.     CALL FILL('Detonation signaled!')
  355.     GOTO 10138
  356.  
  357. 10288    CALL FILL(7,1)
  358.     CALL FILL('* Pod not active!   ')
  359.     GOTO 10138
  360. C
  361. C    Launch anti-matter device
  362. C
  363. 10286    IF(IPOD(WHO).NE.0)GOTO 10295
  364.     CALL CONREL(VALUE,OK,0.0,12.0,RANGE)
  365.     IF(.NOT.RANGE)GOTO 10141
  366.     IF(OK)GOTO 10287
  367.     CALL FILL('Anti-matter ready.  ')
  368.     GOTO 10138
  369.  
  370. 10287    DPOD(WHO)=XTODEG(VALUE)
  371.     IPOD(WHO)=1
  372.     CALL FILL('Pod requested.      ')
  373.     GOTO 10138
  374.  
  375. 10295    CALL FILL(7,1)
  376.     CALL FILL('* No pod availiable.')
  377.     GOTO 10138
  378.  
  379. 10141    CALL FILL(7,1)
  380.     CALL FILL('* Invalid input.    ')
  381. 10138    CONTINUE
  382.     CMD(1)=0
  383.     CALL CLREF(25)
  384. C
  385. C    Clean up command message
  386. C
  387. 10132    IF(LOOP.LT.0)GOTO 10133
  388.     LOOP=LOOP-1
  389.     IF(LOOP.EQ.0)CALL WRITE(19,35,'                    ')
  390. C
  391. C    Write out messages from zip
  392. C
  393. 10133    CALL MESAGE
  394. C
  395. C    Clean up old messages
  396. C
  397.     CALL BLANKS
  398.     GOTO 10021
  399. C
  400. C    Exit nicely
  401. C
  402. 10022    CALL WRITE(23,1,0)
  403.     CALL FLUSH
  404.     THRU=THRU-1
  405.     IF(THRU.LT.0)THRU=0
  406.     ALIVE(WHO)=.FALSE.
  407.     CLOAK(WHO)=.TRUE.
  408.     WARP(WHO)=0.0
  409.     IF(IPOD(WHO).NE.2)GOTO 10023
  410.     IF(UNIV(INT(XPOD(WHO)),INT(YPOD(WHO))).EQ.'@')
  411.      $    UNIV(INT(XPOD(WHO)),INT(YPOD(WHO)))='.'
  412. 10023    CALL EXIT
  413.     END
  414.