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