Compucolor.org – Virtual Media

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