Listing of file='CMND.FOR;03' on disk='vmedia/fortrek-sector.ccvf'
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
SUBROUTINE CMPTR
REAL COORDS(2)
INTEGER GALAXY(8,8)
INTEGER AG,PITCH
BYTE QUDRNT(8,8),DEV(9)
BYTE I,J,P,Q,U,V,X,Y
BYTE BLK,RED,GRN,YEL
LOGICAL OUTSID
COMMON /MAP/GALAXY,U,V,GUDRNT,X,Y
COMMON /STAT/DEV
COMMON /COLORS/BLK,RED,GRN,YEL
IF(DEV(8).GE.0) GOTO 100
CALL SCLCLR
WRITE(3,50)RED
50 FORMAT('+','COMPUTER DOWN')
RETURN
100 CALL SCLCLR
WRITE(3,150)YEL,GRN
150 FORMAT('+',A1,'TARGET SECTOR: ')
CALL INPUT(COORDS,2)
P = INT(COORD(1))
Q = INT(COORD(2))
IF(P.EQ.X.AND.Q.EQ.Y) GOTO 100
IF(OUTSID(P,Q)) GOTO 100
CALL OUT(8,247)
PX = X-P
QY = Q-Y
DO 200 I=1,10
PITCH = 10+RND(1.0)*30
200 CALL SOUND(PITCH,50,1,0,0)
IF(QY.NE.0.0) GOTO 300
IF(PX.GT.0.0) ANGLE = 90.0
IF(PX.LT.0.0) ANGLE = 270.0
GOTO 400
300 ANGLE = 180.0*ATAN(PX/QY)/3.1415927
IF((PX.GE.0.0).AND.(QY.GT.0.0)) GOTO 400
IF(QY.LT.0.0) ANGLE = ANGLE+180.0
IF(ANGLE.LT.0.0) ANGLE = ANGLE+360.0
400 AG = INT(ANGLE+0.25)
WRITE(3,450)YEL,WHT,AG,YEL
450 FORMAT('+',A1,'COURSE',A1,I4,A1,' DEGREES')
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
SUBROUTINE MOVE(ENERGY)
INTEGER EGYREQ,GALAXY(8,8)
BYTE QUDRNT(8,8)
BYTE SPD,CRS
BYTE DEV(9),P,Q,U,V,X,Y
BYTE NK,NB,NS
BYTE OBJECT
BYTE BLK,RED,GRN,YEL,BLU,MGN,CYN,WHT
LOGICAL OUT
COMMON /MAP/GALAXY,U,V,QUDRNT,X,Y
COMMON /STAT/DEV
COMMON /COLOR/BLK,RED,GRN,YEL,BLU,MGN,CYN,WHT
10 CALL SCLCLR
WRITE(3,20)YEL,GRN
20 FORMAT('+',A1,'COURSE: ',A1)
CALL INPUT(COURSE,1)
IF(COURSE.LT.0.0) RETURN
IF(COURSE.GT.360.0) GOTO 10
COURSE = COURSE/45.0+1.0
IF(COURSE.GE.9.0) COURSE = 1.0
CRS = INT(COURSE)
30 CALL SCLCLR
WRITE(3,40)YEL,GRN
40 FORMAT('+',A1,'WARP FACTOR: ',A1)
CALL INPUT(WARP,1)
IF((WARP.LT.0.0).OR.(WARP.GT.8.0)) GOTO 10
IF(.NOT.(D(1).LT.0.AND.WARP.GT.0.125) GOTO 60
CALL SCLCLR
CALL SCLCLR
WRITE(3,10)RED,WHT,GRN
50 FORMAT('+',A1,'MAXIMUM SPEED = WARP ',A1,'0.125',A1)
GOTO 30
60 CALL OUT(8,247)
SPD = INT(8.0*WARP+0.5)
IF(SPD.EQ.0) SPD = 1
EGYREQ = INT(5.0+3*R+0.05*R*R)
IF(EGYREQ.LE.ENERGY) GOTO 80
CALL SCLCLR
WRITE(3,80)RED,CYN,EGYREQ,RED,GRN
70 FORMAT('+',A1,'MOVE REQUIRES',I5,' ENERGY UNITS',A1)
RETURN
80 CALL GETMAP(NK,NB,NS)
IF(NK.GT.0) CALL KLGFIR
CALL DEVST
IF(WARP.GE.1.0) CALL SOUND(100,2,95,255,0)
CALL SRPLOT(0,X,Y)
CALL VECTOR(SPD,CRS,P,Q,OUT,OBJECT)
IF(OUT) GOTO 500
CALL SOUND(900,10,10,254,2)
CALL SCLCLR
CALL SCLCLR
WRITE(3,110)
RETURN
END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
SUBROUTINE VECTOR(SPD,CRS,P,Q,OUT,OBJECT)
BYTE SPD,CRS,P,Q,OBJECT
LOGICAL OUT
RETURN
END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
REAL FUNCTION XF(S)
REAL X(9)
INTEGER SINT
DATA X/1.0,1.0,0.0,-1.0,-1.0,-1.0,0.0,1.0,1.0/
SINT = INT(S)
XF = X(SINT)+(S-SINT)*(X(SINT+1)-X(SINT))
RETURN
END
REAL FUNCTION YF(S)
REAL Y(9)
INTEGER SINT
DATA Y/0.0,-1.0,-1.0,-1.0,0.0,1.0,1.0,1.0,0.0/
SINT = INT(S)
YF = Y(SINT)+(S-SINT)*(Y(SINT+1)-Y(SINT))
RETURN
END