|
DataMuseum.dkPresents historical artifacts from the history of: DKUUG/EUUG Conference tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DKUUG/EUUG Conference tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: T f
Length: 2250 (0x8ca)
Types: TextFile
Names: »find.f«
└─⟦b20c6495f⟧ Bits:30007238 EUUGD18: Wien-båndet, efterår 1987
└─⟦this⟧ »EUUGD18/General/Empire/find.f«
subroutine find(own, z6, z8, h2)
c
c Cross-reference subroutine, it finds data on whatever
c craft is at point z6.
c
IMPLICIT INTEGER(A-Z)
include 'common.h'
C
if (h2 .gt. 0) goto 1100
c
c Now we must destroy own
c first of all, update troopt
c
ishp = 0
if (own .eq. 'D') ishp = 1
if (own .eq. 'S') ishp = 2
if (own .eq. 'T') ishp = 3
if (own .eq. 'R') ishp = 4
if (own .eq. 'C') ishp = 5
if (own .eq. 'B') ishp = 6
if (ishp .eq. 0) goto 200
do 100 z = 1, 5
100 if (troopt(ishp, z) .eq. z6) troopt(ishp, z) = 0
c
c Now destroy the craft, set rlmap(n)=0
c
200 if (own .ne. 'C') goto 400
do 300 z = 1, 200
if (rlmap(500 + z) .ne. z6) goto 300
rlmap(500 + z) = 0
if (mode .eq. 1) call tpos(2, 60)
print 999, z
999 format('+Fighter #'I3' sunk'$)
300 continue
400 if (own .ne. 'T') goto 600
do 500 z = 1, 500
if (rlmap(z) .ne. z6) goto 500
rlmap(z) = 0
if (mode .eq. 1) call tpos(2, 60)
print 998, z
998 format('+Army #'I3' sunk'$)
500 continue
600 if (own .ne. 't') goto 800
do 700 z = 1501, 2000
700 if (rlmap(z) .eq. z6) rlmap(z) = 0
800 if (own .ne. 'c') goto 1000
do 900 z = 2001, 2200
900 if (rlmap(z) .eq. z6) rlmap(z) = 0
1000 rlmap(z8) = 0
if ((own .ge. 'a') .and. (own .le. 't')) call sonar(z6)
if ((own .ge. 'A') .and. (own .le. 'T')) call sensor(z6)
return
1100 if (h2 .eq. 30) goto 1200
if ((own .eq. 'A') .or. (own .eq. 'F') .or. (own .eq. 'a') .or.
$ (own .eq. 'f')) return
if ((own .ge. 'A') .and. (own .le. 'T')) j1ts(z8 - 700) = h2
if ((own .ge. 'a') .and. (own .le. 't')) j1ts(z8 - 1400) = h2
return
1200 h2 = 0
ia = 1
if (own .eq. 'T') ia = 1101
if (own .eq. 'O') ia = 1101
comment special hack for docking
if (own .eq. 'C') ia = 1301
if (own .eq. 'a') ia = 1501
if (own .eq. 'f') ia = 2001
if (own .eq. 't') ia = 2601
if (own .eq. 'c') ia = 2801
do 1300 z8 = ia, 3000
if (rlmap(z8) .eq. z6) goto 1400
1300 continue
pause ' Error in subroutine find, "CONTINUE" to continue'
997 format(' ERROR IN SUB. FIND')
return
1400 if ((own .eq. 'A') .or. (own .eq. 'F') .or. (own .eq. 'a') .or.
$ (own .eq. 'f')) h2 = 1
if (h2 .eq. 1) return
if ((own .ge. 'A') .and. (own .le. 'T')) h2 = j1ts(z8 - 700)
if ((own .ge. 'a') .and. (own .le. 't')) h2 = j1ts(z8 - 1400)
return
end