PROGRAM PLANE C***************************************************************************** C C Adopted from AIRPLANE LANDING GAME C By Bill Greene, Digital Equipment Corp. C C Rewritten in FORTRAN-77, restructured, and anotated C by Robert Walraven, Multiware, Inc. C C Version 1.0, 18-Aug-85 C C***************************************************************************** include 'SYSERV.INC/nolist' include 'VTSERV.INC/nolist' byte reply ! Terminal reply character C...... Write initial identification. call VT SERVICE ( erase screen ) type *, ' ' type *, ' AIRCRAFT INSTRUMENT FLIGHT SIMULATION GAME' type *, ' ' type *, ' Original by Bill Greene' type *, ' Digital Equipment Corp.' type *, ' ' type *, ' Rewritten by Robert Walraven' type *, ' Multiware, Inc.' type *, ' ' type *, ' ' C...... If user wants instructions, print them out type *, 'Do you want instructions ?' accept '(A1)', reply if ( reply .eq. 'Y' .or. reply .eq. 'y' ) then call VT SERVICE ( erase screen ) call PAGE1 accept '(A1)', reply type *, ' ' call VT SERVICE ( erase screen ) call PAGE2 accept '(A1)', reply endif C...... Set terminal input to immediate 10 call SYS SERVICE ( tt in immediate ) C...... Erase screen and put up control panel call VT SERVICE ( erase screen ) call PANEL C...... Fly the plane until it hits the ground in one way or another call FLY C...... Another game? call VT SERVICE ( erase screen ) call SYS SERVICE ( tt in normal ) call OUTS ( ' Do you want to fly again ? ' ) accept '(A1)', reply if ( reply .eq. 'Y' .or. reply .eq. 'y' ) go to 10 end C***************************************************************************** subroutine FLY C...... This is the mainline code for flying the plane. After a landing C...... (one way or another) control is returned to the calling program. C------------------------- Parameter definitions ----------------------------- include 'SYSERV.INC/nolist' include 'VTSERV.INC/nolist' INTEGER right turn ! Parameters for banking PARAMETER ( left turn = +1 ) PARAMETER ( level flight = 0 ) PARAMETER ( right turn = -1 ) PARAMETER ( in grave = 0 ) ! Crash parameters PARAMETER ( in pieces = 1 ) PARAMETER ( in field = 2 ) PARAMETER ( in mountain = 3 ) ! POSITION AND LENGTH OF READINGS: PARAMETER ( ix climb = 17 ) ! climb velocity PARAMETER ( iy climb = 4 ) PARAMETER ( il climb = 5 ) PARAMETER ( ix fuel = 56 ) ! fuel PARAMETER ( iy fuel = 11 ) PARAMETER ( il fuel = 5 ) PARAMETER ( ix head = 33 ) ! heading PARAMETER ( iy head = 5 ) PARAMETER ( il head = 5 ) PARAMETER ( ix height = 6 ) ! height PARAMETER ( iy height = 4 ) PARAMETER ( il height = 5 ) PARAMETER ( ix meter = 35 ) ! tilt/attack meter PARAMETER ( iy meter = 12 ) PARAMETER ( ix stall = 53 ) ! STALL WARNING message PARAMETER ( iy stall = 15 ) INTEGER bell ! Misc. constants PARAMETER ( bell = 7 ) PARAMETER ( two pi over 180 = .034906585 ) C------------------------ Variable typing ------------------------------------ REAL ASCENT ANGLE ! Angle of path with horizontal INTEGER BANK ! Indicates tilt of plane LOGICAL BOUNCE ! Indicates a bounce on landing INTEGER CHANGE COUNT ! Count for time to change course REAL CLIMB VELOCITY ! Climb rate in feet per second REAL FUEL ! Fuel remaining REAL GLIDE HEIGHT ! Glidepath height where plane should be LOGICAL GROUNDED ! Indicates that we have touched down REAL HEADING ! Current course heading REAL HEIGHT ! Altitude in feet REAL METER VELOCITY ! Rounded velocity used for meter reading REAL OLD ASCENT ANGLE! Starting angle of ascent REAL OLD HEADING ! Previous course heading REAL OLD HEIGHT ! Height from a while ago REAL OLD THROTTLE ! Throttle setting from last time step REAL OLD VELOCITY ! Forward velocity from last time step BYTE REPLY ! Terminal reply character REAL RANGE ! Range from runway in feet REAL RANGE1 ! Range to next multiple of 500 ft. LOGICAL STALL ! .TRUE. = stall condition REAL THROTTLE ! Throttle setting (full power = 36) REAL VELOCITY ! Current forward velocity C--------------------------------- CODE -------------------------------------- C...... Initialize the flight variables ASCENT ANGLE = 8. ! Initial ascent angle BOUNCE = .FALSE. ! We have not bounced on landing CHANGE COUNT = 0 ! Not ready to change course yet CLIMB VELOCITY = 0. ! Start out level BANK = level flight ! Start out level FUEL = 1000. ! Initial fuel GROUNDED = .FALSE. ! We are in the air HEADING = 281. ! Initial course heading HEIGHT = 2500. ! Initial altitude METER VELOCITY = 0. ! Velocity meter doesn't read yet OLD ASCENT ANGLE = 7. ! Previous ascent angle OLD HEADING = 281. ! Previous course OLD HEIGHT = 2300. ! Height from a while ago OLD THROTTLE = 0. ! Force throttle display OLD VELOCITY = 0. ! Force velocity display RANGE = 32000. ! Range to runway in feet. RANGE1 = 30000. ! Range to next 500 ft. marker STALL = .FALSE. ! Not stalled yet THROTTLE = 25. ! Initial throttle setting VELOCITY = 125. ! Forward velocity C...... Initialize panel level meter and heading call LEVEL ( ixmeter , iymeter ) call VT SERVICE ( position, ixhead , iyhead ) CALL OUTF ( HEADING , ilhead ) C...... Compute vertical equations of motion for next one second time step 10 ACCELERATION = -32. + VELOCITY*SIN(ASCENT ANGLE * two pi over 180) HEIGHT = HEIGHT + CLIMB VELOCITY + 0.5 * ACCELERATION CLIMB VELOCITY = CLIMB VELOCITY + 0.5 * ACCELERATION C...... Correct for air friction, throttle, gravity, and brakes VELOCITY = VELOCITY-0.1*VELOCITY+0.5*THROTTLE-0.4*CLIMB VELOCITY IF ( GROUNDED ) VELOCITY = VELOCITY - 10. C...... Update stall status IF ( VELOCITY .GE. 80. ) STALL = .FALSE. IF ( VELOCITY .LE. 55. ) STALL = .TRUE. C...... If stall condition, apply correction IF ( STALL ) THEN ASCENT ANGLE = ASCENT ANGLE - 2. HEIGHT = HEIGHT - 50. ENDIF C...... Use up some fuel FUEL = FUEL - THROTTLE/4 C...... If stall condition and still in air, flash a warning and beep IF ( VELOCITY.LE.64. .AND. .NOT.GROUNDED ) THEN call VT SERVICE ( position, ix stall , iy stall ) CALL OUTS ( 'STALL WARNING' ) CALL OUTS ( bell ) call SYS SERVICE ( sleep , 0 , 0 , 0 , 30 ) call VT SERVICE ( position, ix stall , iy stall ) CALL OUTS ( ' ' ) call SYS SERVICE ( sleep , 0 , 0 , 0 , 30 ) ELSE call SYS SERVICE ( sleep , 0 , 0 , 1 , 0 ) ENDIF C...... Check or a reply 20 call SYS SERVICE ( tt get character , ICHAR ) REPLY = ICHAR C...... If something was typed, process it. IF ( REPLY .GE. 0) THEN IF ( REPLY .EQ. '8' ) THEN ASCENT ANGLE = ASCENT ANGLE + 1. ELSE IF ( REPLY .EQ. '2' ) THEN ASCENT ANGLE = ASCENT ANGLE - 1. ELSE IF ( REPLY .EQ. '1' ) THEN THROTTLE = THROTTLE - 1. IF ( THROTTLE .LT. 0. ) THROTTLE = 0. ELSE IF ( REPLY .EQ. '7' ) THEN THROTTLE = THROTTLE + 1. ELSE IF ( REPLY .EQ. '6' ) THEN CALL RIGHT ( ix meter , iy meter ) BANK = right turn ELSE IF ( REPLY .EQ. '5' ) THEN CALL LEVEL ( ix meter , iy meter ) BANK = level flight ELSE IF ( REPLY .EQ. '4' ) THEN CALL LEFT ( ix meter , iy meter ) BANK = left turn ENDIF GO TO 20 ENDIF C...... If nothing was typed, update information IF ( HEIGHT .GT. 0. .OR. BOUNCE ) THEN GROUNDED = .FALSE. IF ( BOUNCE ) THEN BOUNCE = .FALSE. ASCENT ANGLE = ASCENT ANGLE - 3. ENDIF ELSE IF ( .NOT. GROUNDED ) THEN C ----------------------------------------------------- IF ( CLIMB VELOCITY .LT. -15. ) THEN CALL BAD LANDING ( in grave ) RETURN ENDIF C ----------------------------------------------------- IF ( CLIMB VELOCITY .LT. -10. ) THEN CALL BAD LANDING ( in pieces ) RETURN ENDIF C ----------------------------------------------------- IF ( RANGE .GT. 1500. .OR. RANGE .LT. -2500. ) THEN CALL BAD LANDING ( in field ) RETURN ENDIF C ----------------------------------------------------- IF ( VELOCITY .GT. 100. ) THEN ASCENT ANGLE = ASCENT ANGLE + 3. BOUNCE = .TRUE. HEIGHT = 20. GO TO 10 ENDIF C ----------------------------------------------------- ENDIF IF ( VELOCITY .LT. 15. ) THEN call VT SERVICE ( erase screen ) call SYS SERVICE ( sleep , 0 , 0 , 3 , 0 ) RETURN ENDIF IF ( ASCENT ANGLE .GT. 8. ) ASCENT ANGLE = 8. ASCENT ANGLE = ASCENT ANGLE - 1. CLIMB VELOCITY = 0. GROUNDED = .TRUE. HEIGHT = 0. IF ( THROTTLE .NE. 0. ) THROTTLE = THROTTLE - 1. ENDIF C...... Update gauges CALL VT SERVICE ( bold ) CALL VT SERVICE ( reverse ) call VT SERVICE ( position, ix height , iy height ) CALL OUTF ( HEIGHT , il height ) call VT SERVICE ( position, ix climb , iy climb ) CALL OUTF ( CLIMB VELOCITY , il climb ) CALL VT SERVICE ( off attributes ) IF ( FUEL .LT. 0. ) FUEL = 0. IF ( FUEL .EQ. 0. ) THROTTLE = 0. call VT SERVICE ( position, ix fuel , iy fuel ) CALL OUTF ( FUEL , il fuel ) IF ( THROTTLE .GT. 36. ) THROTTLE = 36. IF ( THROTTLE .LT. 0. ) THROTTLE = 0. CALL POWER ( THROTTLE , OLD THROTTLE ) OLD THROTTLE = THROTTLE CALL SPEED ( VELOCITY , OLD VELOCITY ) OLD VELOCITY = VELOCITY CALL ATT ( ASCENT ANGLE , OLD ASCENT ANGLE ) OLD ASCENT ANGLE = ASCENT ANGLE CALL ALT ( HEIGHT , OLD HEIGHT ) IF ( ABS(HEIGHT-OLD HEIGHT) .GE. 100.0 ) OLD HEIGHT = HEIGHT CALL CLIMB ( CLIMB VELOCITY , METER VELOCITY ) IF ( ABS ( METER VELOCITY-CLIMB VELOCITY ) .GE. 1.6 ) 1 METER VELOCITY = CLIMB VELOCITY C...... Update heading IF ( BANK .NE. level flight ) THEN HEADING = HEADING + BANK IF ( HEADING .GT. 360. ) HEADING = 1. IF ( HEADING .LE. 0. ) HEADING = 360. call VT SERVICE ( position, ixhead , iyhead ) call OUTF ( HEADING , ilhead ) ENDIF IF ( HEADING .EQ. OLD HEADING ) RANGE = RANGE - (1.5*VELOCITY) C...... If we are on the ground, then we did it! IF ( GROUNDED ) THEN CALL COMM ( 'Nice landing ' ) GO TO 10 ENDIF C...... If we are close, report how much runway is left IF ( RANGE .LT. 1500. ) THEN IF ( RANGE .GE. RANGE1 ) GO TO 10 RANGE1 = RANGE1 - 500. IF ( RANGE .GE. -2500. ) THEN CALL COMM ( 0 ) CALL OUTF ( ABS(-3000.-RANGE1) , 5 ) CALL OUTS ( ' feet of runway left' ) GO TO 10 ENDIF C...... If we are below 100 ft, we got the mountain IF ( HEIGHT .GT. 100. ) THEN CALL COMM ( 'Missed approach-go around ' ) GO TO 10 ELSE CALL BAD LANDING ( in mountain ) RETURN ENDIF ENDIF C...... Do message update at each 500 ft marker. IF ( RANGE .GE. RANGE1 ) GO TO 10 RANGE1 = RANGE1 - 500. IF (RANGE1 .EQ. 29500.) CALL COMM ( 'You are in radar contact ' ) IF (RANGE1 .EQ. 29000.) CALL COMM ( 'Descend to 1500 feet ' ) IF (RANGE1 .EQ. 28000.) THEN CALL COURSE ( 120. , HEADING , OLD HEADING ) ENDIF IF (RANGE1 .EQ. 21000.) CALL COMM ( 'Slow aircraft to 90 mph ' ) IF (RANGE1 .EQ. 20000.) THEN CALL COURSE ( 30. , HEADING , OLD HEADING ) ENDIF IF (RANGE1 .EQ. 18000.) CALL COMM ( 'Begin 10 fps descent ' ) IF (RANGE1 .GT. 17500.) GO TO 10 C...... Compute (5 degree slope) glidepath height where we should be GLIDE HEIGHT = .0875 * RANGE C...... If not near glidepath, report error IF ( HEIGHT .LT. GLIDE HEIGHT - 50. ) THEN CALL COMM ( 'You are ' ) CALL OUTF ( GLIDE HEIGHT - HEIGHT , 4 ) CALL OUTS ( ' feet low ' ) GO TO 10 ENDIF IF ( HEIGHT .GT. GLIDE HEIGHT + 50. ) THEN CALL COMM ( 'You are ' ) CALL OUTF ( HEIGHT - GLIDE HEIGHT , 4 ) CALL OUTS ( ' feet high ' ) GO TO 10 ENDIF IF ( CHANGE COUNT .GT. 2) THEN CHANGE COUNT = 0 CALL COURSE ( 10. , HEADING , OLD HEADING ) ELSE CALL COMM ( 'You are on glidepath ' ) IF ( BANK .EQ. level flight ) CHANGE COUNT = CHANGE COUNT + 1 ENDIF GO TO 10 END C***************************************************************************** SUBROUTINE BAD LANDING ( icode ) C...... Output message for a bad landing. include 'VTSERV.INC/nolist' include 'SYSERV.INC/nolist' call VT SERVICE ( erase screen ) call VT SERVICE ( position, 30 , 12 ) call SYS SERVICE ( sleep , 0 , 0 , 1 , 0 ) IF ( icode .EQ. 0 ) THEN CALL OUTS ( 'You did not survive to tell about it' ) ELSE IF ( icode .EQ. 1 ) THEN CALL OUTS ( 'You are alive, but your plane is damaged.' ) ELSE IF ( icode .EQ. 2 ) THEN CALL OUTS ( 'How did we get in this cornfield?' ) ELSE IF ( icode .EQ. 3 ) THEN CALL OUTS ( 'You just planted yourself in the mountain.' ) ENDIF call SYS SERVICE ( sleep , 0 , 0 , 3 , 0 ) call VT SERVICE ( erase screen ) call SYS SERVICE ( sleep , 0 , 0 , 1 , 0 ) END C***************************************************************************** SUBROUTINE PANEL C Output the control panel to the screen include 'VTSERV.INC/nolist' C...... Put out header CALL VT SERVICE ( double ) CALL VT SERVICE ( position , 10 , 1 ) CALL OUTS ( 'FLIGHT SIMULATOR' ) CALL VT SERVICE ( position , 1 , 2 ) CALL VT SERVICE ( single ) C...... Output altitude meter call VT SERVICE ( bold ) call VT SERVICE ( reverse ) call VT SERVICE ( underline ) call VT SERVICE ( position, 1 , 3 ) call OUTS ( ' ALTITUDE ' ) call VT SERVICE ( off attributes ) call VT SERVICE ( bold ) call VT SERVICE ( reverse ) call VT SERVICE ( position, 1 , 4 ) call OUTS ( ' ' ) DO 100 I = 5,15 call VT SERVICE ( position, 1 , I ) call OUTS ( ' ' ) call VT SERVICE ( position, 12 , I ) call OUTS ( ' ' ) 100 CONTINUE call VT SERVICE ( position, 1 , 16 ) call OUTS ( ' ' ) call VT SERVICE ( off attributes ) DO 110 I = 5,15 call VT SERVICE ( position, 3 , I ) call OUTI ( 500 * (15-I) , 4 ) 110 CONTINUE C...... Output the climb meter call VT SERVICE ( bold ) call VT SERVICE ( reverse ) call VT SERVICE ( underline ) call VT SERVICE ( position, 15 , 3 ) call OUTS ( ' CLIMB ' ) call VT SERVICE ( off attributes ) call VT SERVICE ( bold ) call VT SERVICE ( reverse ) call VT SERVICE ( position, 15 , 4 ) call OUTS ( ' ' ) DO 200 I = 5,15 call VT SERVICE ( position, 15 , I ) call OUTS ( ' ' ) call VT SERVICE ( position, 23 , I ) call OUTS ( ' ' ) 200 CONTINUE call VT SERVICE ( position, 15 , 16 ) call OUTS ( ' ' ) call VT SERVICE ( off attributes ) DO 210 I = 5,15 call VT SERVICE ( position, 16 , I ) call OUTI ( 5 * (10-I) , 3 ) 210 CONTINUE C...... Output the heading display call VT SERVICE ( bold ) call VT SERVICE ( reverse ) call VT SERVICE ( position, 28 , 3 ) call OUTS ( ' HEADING ' ) DO 300 I = 4,6 call VT SERVICE ( position, 28 , I ) call OUTS ( ' ' ) call VT SERVICE ( position, 42 , I ) call OUTS ( ' ' ) 300 CONTINUE call VT SERVICE ( position, 28, 7 ) call OUTS ( ' ' ) call VT SERVICE ( off attributes ) C...... Output the communications panel call VT SERVICE ( bold ) call VT SERVICE ( reverse ) call VT SERVICE ( position, 46 , 3 ) call OUTS ( ' COMMUNICATIONS ' ) DO 400 I = 4,6 call VT SERVICE ( position, 46 , I ) call OUTS ( ' ' ) call VT SERVICE ( position, 75 , I ) call OUTS ( ' ' ) 400 CONTINUE call VT SERVICE ( position, 46 , 7 ) call OUTS ( ' ' ) call VT SERVICE ( off attributes ) C...... Output attack/tilt meter call VT SERVICE ( bold ) call VT SERVICE ( position, 30 , 8 ) call OUTS ( '___________' ) call VT SERVICE ( position, 29 , 9 ) call OUTS ( '/' ) call VT SERVICE ( position, 41 , 9 ) call OUTS ( '\' ) call VT SERVICE ( position, 28 , 10 ) call OUTS ( '/' ) call VT SERVICE ( position, 42 , 10 ) call OUTS ( '\' ) DO 500 I = 11,13 call VT SERVICE ( position, 27 , I ) call OUTS ( '|' ) call VT SERVICE ( position, 43 , I ) call OUTS ( '|' ) 500 CONTINUE call VT SERVICE ( position, 28 , 14 ) call OUTS ( '\' ) call VT SERVICE ( position, 42 , 14 ) call OUTS ( '/' ) call VT SERVICE ( position, 29 , 15 ) call OUTS ( '\' ) call VT SERVICE ( position, 41 , 15 ) call OUTS ( '/' ) call VT SERVICE ( position, 30 , 16 ) call OUTS ( '-----------' ) call VT SERVICE ( off attributes ) C...... Output fuel meter call VT SERVICE ( bold ) call VT SERVICE ( reverse ) call VT SERVICE ( position, 54 , 9 ) call OUTS ( ' FUEL ' ) DO 600 I = 10,12 call VT SERVICE ( position, 54 , I ) call OUTS ( ' ' ) call VT SERVICE ( position, 63 , I ) call OUTS ( ' ' ) 600 CONTINUE call VT SERVICE ( position, 54 , 13 ) call OUTS ( ' ' ) call VT SERVICE ( off attributes ) C...... Output airspeed meter call VT SERVICE ( bold ) call VT SERVICE ( reverse ) call VT SERVICE ( position, 1 , 18 ) call OUTS ( ' AIRSPEED' ) call VT SERVICE ( position, 42, 18 ) call OUTS ( ' ' ) call VT SERVICE ( position, 1 , 19 ) call OUTS ( ' ' ) call VT SERVICE ( position, 1 , 20 ) call OUTS ( ' ' ) call VT SERVICE ( position, 75 , 19 ) call OUTS ( ' ' ) call VT SERVICE ( position, 75 , 20 ) call OUTS ( ' ' ) call VT SERVICE ( off attributes ) call VT SERVICE ( position, 2 , 19 ) call OUTS ( ' 40 60 80 100 120' ) call VT SERVICE ( position, 37 , 19 ) call OUTS ( '140 160 180 200 220 ' ) call VT SERVICE ( bold ) call VT SERVICE ( underline ) call VT SERVICE ( position, 2 , 20 ) call OUTS ( ' ' ) call VT SERVICE ( position, 37 , 20 ) call OUTS ( ' ' ) call VT SERVICE ( off attributes ) C...... Output power meter call VT SERVICE ( bold ) call VT SERVICE ( reverse ) call VT SERVICE ( position, 1 , 22 ) call OUTS ( ' POWER' ) call VT SERVICE ( position, 41 , 22 ) call OUTS ( ' ' ) call VT SERVICE ( position, 1 , 23 ) call OUTS ( ' ' ) call VT SERVICE ( position, 1 , 24 ) call OUTS ( ' ' ) call VT SERVICE ( position, 75 , 23 ) call OUTS ( ' ' ) call VT SERVICE ( position, 75 , 24 ) call OUTS ( ' ' ) call VT SERVICE ( off attributes ) call VT SERVICE ( position, 2 , 23 ) call OUTS ( ' 0 10 20 30 40' ) call VT SERVICE ( position, 37 , 23 ) call OUTS ( '50 60 70 80 90 100 ' ) call VT SERVICE ( bold ) call VT SERVICE ( underline ) call VT SERVICE ( position, 2 , 24 ) call OUTS ( ' ' ) call VT SERVICE ( position, 37 , 24 ) call OUTS ( ' ' ) call VT SERVICE ( off attributes ) end C***************************************************************************** SUBROUTINE SPEED ( VELOCITY , OLD VELOCITY ) parameter ( iy speed = 20 ) C...... Update the speed meter. IP = ( VELOCITY - 40. ) * 0.335 + 3. IP0 = ( OLD VELOCITY - 40. ) * 0.335 + 3. CALL BAR ( IP , IP0 , iy speed ) END C***************************************************************************** SUBROUTINE POWER ( THROTTLE , OLD THROTTLE ) parameter ( iy power = 24 ) C...... Update the power meter. IP = THROTTLE * 1.87 + 3. IP0 = OLD THROTTLE * 1.87 + 3. CALL BAR ( IP , IP0 , iy power ) END C***************************************************************************** SUBROUTINE BAR ( P , P0 , Y ) C...... Update a horizontal meter bar at screen vertical location Y. include 'VTSERV.INC/nolist' INTEGER P0 , P , Y IF ( P .GT. 72 ) P = 72 IF ( P .LT. 2 ) P = 2 IF ( P0 .GT. 72 ) P0 = 72 IF ( P0 .LT. 2 ) P0 = 2 IF ( P .LT. P0 ) THEN call VT SERVICE ( position, P , Y ) CALL VT SERVICE ( underline ) CALL VT SERVICE ( bold ) DO 10 I = 1, P0-P CALL OUTS ( ' ' ) 10 CONTINUE CALL VT SERVICE ( off attributes ) ENDIF IF ( P .GT. P0 ) THEN call VT SERVICE ( position, P0 , Y ) CALL VT SERVICE ( underline ) CALL VT SERVICE ( bold ) DO 20 I = 1, P-P0 CALL OUTS ( '>' ) 20 CONTINUE CALL VT SERVICE ( off attributes ) ENDIF END C***************************************************************************** SUBROUTINE CLIMB ( VELOCITY , OLD VELOCITY ) C...... Update rate of climb meter IF ( ABS( VELOCITY - OLD VELOCITY ) .GE. 1.6 ) THEN CALL VERT CLEAR ( 19 , 10 , 4 , -15 , 15 , OLD VELOCITY/5. ) CALL VERT SET ( 19 , 10 , 4 , -15 , 15 , VELOCITY/5. ) ENDIF END C***************************************************************************** SUBROUTINE ALT ( HEIGHT , OLD HEIGHT ) C...... Update the altitude meter IF ( ABS( HEIGHT - OLD HEIGHT ) .GE. 100.0 ) THEN CALL VERT CLEAR ( 7 , 15 , 5 , 0 , 30 , OLD HEIGHT/500. ) CALL VERT SET ( 7 , 15 , 5 , 0 , 30 , HEIGHT/500. ) ENDIF END C***************************************************************************** SUBROUTINE ATT ( ASCENT ANGLE , OLD ASCENT ANGLE ) C...... Update the ascent angle meter (center of tilt meter). IF ( ASCENT ANGLE .NE. OLD ASCENT ANGLE ) THEN Z = ( OLD ASCENT ANGLE - 8. ) / 3. CALL VERT CLEAR ( 33 , 12 , 5 , -10 , 10 , Z ) Z = ( ASCENT ANGLE - 8. ) / 3. CALL VERT SET ( 33 , 12 , 5 , -10 , 10 , Z ) ENDIF END C***************************************************************************** SUBROUTINE VERT SET ( IX0 , IY0 , N , MIN , MAX , Z ) C...... Set a vertical bar needle. IX0 is the x location of the bar, C...... IY0 is the location of zero on the bar, N is the width of the C...... bar, MIN and MAX are the minimum and maximum values the meter C...... can read, and Z is the value to set the meter to. include 'VTSERV.INC/nolist' LINE = Z * 3. IF ( LINE .GT. MAX ) LINE = MAX IF ( LINE .LT. MIN ) LINE = MIN IY = ( IABS(LINE)+1 ) / 3 IF ( LINE .LT. 0 ) IY = -IY call VT SERVICE ( position, IX0, IY0-IY ) ITYPE = LINE - IY*3 DO 300 I=1,N IF ( ITYPE .EQ. +1 ) CALL OUTS ( '^' ) IF ( ITYPE .EQ. 0 ) CALL OUTS ( '-' ) IF ( ITYPE .EQ. -1 ) CALL OUTS ( '_' ) 300 CONTINUE END C***************************************************************************** SUBROUTINE VERT CLEAR ( IX0 , IY0 , N , MIN , MAX , Z ) C...... Clear a vertical bar meter needle. include 'VTSERV.INC/nolist' LINE = Z * 3. IF ( LINE .GT. MAX ) LINE = MAX IF ( LINE .LT. MIN ) LINE = MIN IY = ( IABS(LINE)+1 ) / 3 IF ( LINE .LT. 0 ) IY = -IY call VT SERVICE ( position, IX0, IY0-IY ) DO 100 I=1,N CALL OUTS ( ' ' ) 100 CONTINUE END C***************************************************************************** SUBROUTINE RIGHT ( IXMETER , IYMETER ) C...... Update tilt meter for right turn include 'VTSERV.INC/nolist' call VT SERVICE ( position, IXMETER-6 , IYMETER-2 ) CALL OUTS ( '_' ) call VT SERVICE ( position, IXMETER-5 , IYMETER-1 ) CALL OUTS ( '^-_' ) call VT SERVICE ( position, IXMETER-7 , IYMETER ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER-5 , IYMETER+1 ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER-6 , IYMETER+2 ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER+6 , IYMETER-2 ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER+3 , IYMETER-1 ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER+3 , IYMETER ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER+3 , IYMETER+1 ) CALL OUTS ( '^-_' ) call VT SERVICE ( position, IXMETER+6 , IYMETER+2 ) CALL OUTS ( '^' ) END C***************************************************************************** SUBROUTINE LEFT ( IXMETER , IYMETER ) C...... Update the tilt meter for a left turn. include 'VTSERV.INC/nolist' call VT SERVICE ( position, IXMETER-6 , IYMETER-2 ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER-5 , IYMETER-1 ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER-7 , IYMETER ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER-5 , IYMETER+1 ) CALL OUTS ( '_-^' ) call VT SERVICE ( position, IXMETER-6 , IYMETER+2 ) CALL OUTS ( '^' ) call VT SERVICE ( position, IXMETER+6 , IYMETER-2 ) CALL OUTS ( '_' ) call VT SERVICE ( position, IXMETER+3 , IYMETER-1 ) CALL OUTS ( '_-^' ) call VT SERVICE ( position, IXMETER+3 , IYMETER ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER+3 , IYMETER+1 ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER+6 , IYMETER+2 ) CALL OUTS ( ' ' ) END C***************************************************************************** SUBROUTINE LEVEL ( IXMETER , IYMETER ) C...... Update the tilt meter for a level flight. include 'VTSERV.INC/nolist' call VT SERVICE ( position, IXMETER-6 , IYMETER-2 ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER-5 , IYMETER-1 ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER-7 , IYMETER ) CALL OUTS ( '=====' ) call VT SERVICE ( position, IXMETER-5 , IYMETER+1 ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER-6 , IYMETER+2 ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER+6 , IYMETER-2 ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER+3 , IYMETER-1 ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER+3 , IYMETER ) CALL OUTS ( '=====' ) call VT SERVICE ( position, IXMETER+3 , IYMETER+1 ) CALL OUTS ( ' ' ) call VT SERVICE ( position, IXMETER+6 , IYMETER+2 ) CALL OUTS ( ' ' ) END C***************************************************************************** SUBROUTINE COURSE ( DELTAMAX , HEADING , OLD HEADING ) C...... Make a random course change. The magnitude of the change C...... will be proportional to DELTAMAX. INTEGER I1, I2 !Random number generator seeds DATA I1, I2 / 0, 0 / C...... Put out a change heading message if needed. OLD HEADING = DELTAMAX * RAN ( I1 , I2 ) OLD HEADING = INT ( OLD HEADING ) + HEADING - DELTAMAX / 2 IF ( HEADING .LT. OLD HEADING ) THEN CALL COMM ( 'Turn left heading ' ) CALL OUTF ( OLD HEADING , 4 ) CALL OUTS ( ' ' ) ENDIF IF ( HEADING .GT. OLD HEADING ) THEN CALL COMM ( 'Turn right heading ' ) CALL OUTF ( OLD HEADING, 4 ) CALL OUTS ( ' ' ) ENDIF END C***************************************************************************** SUBROUTINE PAGE1 TYPE *, 'This program provides a psuedo-graphic video' TYPE *, 'presentation of a pilots instrument panel,' TYPE *, 'with real-time updates at 1 second intervals.' TYPE *, ' ' TYPE *, 'The following keys are your controls:' TYPE *, ' ' TYPE *, ' +-----------------------------------+' TYPE *, ' | 7 | 8 | 9 |' TYPE *, ' | INCREASE | NOSE | |' TYPE *, ' | POWER | UP | |' TYPE *, ' |-----------+-----------+-----------|' TYPE *, ' | 4 | 5 | 6 |' TYPE *, ' | TURN | FLY | TURN |' TYPE *, ' | LEFT | STRAIGHT | RIGHT |' TYPE *, ' |-----------+-----------+-----------+' TYPE *, ' | 1 | 2 | 3 |' TYPE *, ' | DECREASE | NOSE | |' TYPE *, ' | POWER | DOWN | |' TYPE *, ' +-----------------------------------+' TYPE *, ' ' TYPE *, 'Keys may be depressed repeatedly for gross changes' TYPE *, ' ' TYPE *, ' HIT RETURN FOR NEXT PAGE' END C***************************************************************************** SUBROUTINE PAGE2 TYPE *, 'When the game starts, you will be flying level at 2500' TYPE *, 'feet. Instructions from the ground radar controller' TYPE *, 'will appear in the upper r.h. corner of the screen.' TYPE *, 'The controller will attempt to talk you down safely.' TYPE *, ' ' TYPE *, 'PLEASE NOTE THE FOLLOWING:' TYPE *, ' ' TYPE *, '1. The plane will stall below 75 mph.' TYPE *, '2. Touchdown above 100 mph results in a bounce.' TYPE *, '3. Descent rate must be below -10 fps at touchdown.' TYPE *, '4. A 100 foot hill is at the far end of the runway.' TYPE *, '5. The fuel supply is marginal.' TYPE *, '6. Not flying the correct heading wastes gas.' TYPE *, '7. A forced landing is possible if touchdown is gentle.' TYPE *, ' ' TYPE *, ' HIT RETURN TO BEGIN' END C***************************************************************************** SUBROUTINE COMM ( STRING ) C...... Output the text STRING in the communications box include 'VTSERV.INC/nolist' BYTE STRING(1) call VT SERVICE ( position, 48, 5 ) CALL OUTS ( STRING ) END C***************************************************************************** SUBROUTINE OUTS ( STRING ) C...... Output text STRING to screen at current location. BYTE STRING (80) DO 10 N=1,80 IF (STRING(N) .EQ. 0) GO TO 20 10 CONTINUE N = 81 20 N = N-1 IF (N.NE.0) WRITE ( 5, '(1H+,A1,$)' ) (STRING(I),I=1,N) END C***************************************************************************** SUBROUTINE OUTF ( VALUE, NWIDTH ) C...... Output VALUE to screen at current location in I format IVALUE = VALUE CALL OUTI ( IVALUE, NWIDTH ) END C***************************************************************************** SUBROUTINE OUTI ( IVALUE, NWIDTH ) C...... Output IVALUE to screen at current location in I format WRITE (5, '(1H+,I,$)' ) IVALUE END C***************************************************************************** subroutine SYS SERVICE ( REQUEST , I1 , I2 , I3 , I4 ) C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C SYS SERVICE ( REQUEST , I1 , I2 , I3 , I4 ) C C All system dependent services are isolated to this subroutine C so that this program can easily be modified for other operating C systems. The support shown here is for the RT-11 operating C system. C C Recognized service requests are defined in the include file C SYSERV.INC. Set REQUEST to the service desired. Optional C parameters I1, I2, I3, and I4 are used by some services. C C The currently recognized services are: C C tt in immediate: Set up the user terminal so that characters C typed are returned immediately to the C program (as opposed to waiting for a ). C The character typed should NOT be echoed C on the user terminal. C C tt in normal: Set the user terminal to normal input mode. C I.e., wait for a before returning C characters, and echo characters on the C terminal. C C tt get character: If a character was typed, return it in C parameter I1. If no character available, C return with I1 = -1. C C sleep Suspend the program for I1 hours, I2 minutes, C I3 seconds, and I4 ticks ( 1 tick = 1/60 sec.) C C----------------------------------------------------------------------------- parameter ( JSW = '44'O ) ! RT-11 Job Status Word Address parameter ( JTCBIT = '100'O ) ! JSW inhibit terminal wait bit parameter ( JTTSPC = '10000'O ) ! JSW special mode terminal bit parameter ( JTTLC = '40000'O ) ! JSW lowercase bit parameter ( JSWMASK = JTCBIT + JTTSPC + JTTLC ) include 'SYSERV.INC/NOLIST' ! Definitions of system services integer REQUEST if ( REQUEST .eq. tt in immediate ) then call IPOKE ( JSW, JSWMASK.or.IPEEK(JSW) ) else if ( REQUEST .eq. tt in normal ) then call IPOKE ( JSW , (.not.JSWMASK).and.IPEEK(JSW) ) else if ( REQUEST .eq. tt get character ) then I1 = ITTINR () else if ( REQUEST .eq. sleep ) then call ISLEEP ( I1 , I2 , I3 , I4 ) endif end C***************************************************************************** subroutine VT SERVICE ( REQUEST , I1 , I2 ) C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C VT SERVICE ( REQUEST , I1 , I2 ) C C All terminal dependent services are isolated to this subroutine C so that this program can easily be modified for other terminal C types. The support shown here is for a VT-100 ANSI terminal. C C Recognized service requests are defined in the include file C VTSERV.INC. Set REQUEST to the service desired. I1 and I2 are C optional parameters required by some requests. C C The currently recognized services are: C C off attributes: Turn off bold, underline, and reverse C attributes. C bold: Turn on bold attribute. C underline: Turn on underlined attribute. C reverse: Turn on reverse video attribute. C erase screen: Erase the user's screen and home cursor. C position ( I1 , I2 ): Position the cursor on column I1, row I2. C double: Set to double width, single height lines C single: Set to single width, single height lines C C----------------------------------------------------------------------------- integer REQUEST include 'VTSERV.INC/nolist' C...... Define VT100 attribute setting escape sequences byte str off(4) , str bold(4) , str underline(4), str reverse(4) byte str erase(7) data str off / "33 , '[' , '0' , 'm' / data str bold / "33 , '[' , '1' , 'm' / data str underline / "33 , '[' , '4' , 'm' / data str reverse / "33 , '[' , '7' , 'm' / data str erase / "33 , '[' , 'H' , "33 , '[' , '2' , 'J' / IF ( REQUEST .EQ. off attributes ) THEN TYPE '(1H+,4A1,$)' , str off ELSE IF ( REQUEST .EQ. bold ) THEN TYPE '(1H+,4A1,$)' , str bold ELSE IF ( REQUEST .EQ. underline ) THEN TYPE '(1H+,4A1,$)' , str underline ELSE IF ( REQUEST .EQ. reverse ) THEN TYPE '(1H+,4A1,$)' , str reverse ELSE IF ( REQUEST .EQ. erase screen ) THEN TYPE '(1H+,7A1,$)' , str erase ELSE IF ( REQUEST .EQ. double ) THEN TYPE '(1H+,3A1,$)' , "33 , '#' , '6' ELSE IF ( REQUEST .EQ. single ) THEN TYPE '(1H+,3A1,$)' , "33 , '#' , '5' ELSE IF ( REQUEST .EQ. position ) THEN NCOLUMN = I1 LINE = I2 IF ( LINE .GT. 9 ) THEN MR = 2 ELSE MR = 1 ENDIF IF ( NCOLUMN .GT. 99 ) THEN MC = 3 ELSE IF ( NCOLUMN .GT. 9 ) THEN MC = 2 ELSE MC = 1 ENDIF WRITE ( 5, 10 ) "33, LINE, NCOLUMN 10 FORMAT ( 1H+, A1, '[', I, ';', I, 'H', $ ) ENDIF END