Compucolor.org – Virtual Media

Listing of file='PLTLIB.FOR;01' on disk='vmedia/chip_61-sector.ccvf'

C	======================================================
C
	SUBROUTINE TIMER(SECS)
C
C	THIS SUBROUTINE PROVIDES A DELAY OF "SECS" SECONDS
C
C	WRITTEN BY: JOSEPH J. CHARLES, 130 SHERWOOD DRIVE,
C		    HILTON, NY 14468  TEL:(716) 392-8152
C
C
C	VERSION: JULY 18,1982,  6:17 PM
C
	INTEGER DELTA,SECS
C
	LOGICAL HR,MIN,SEC
C
	HR=PEEK(X'81BB')
	MIN=PEEK(X'81BA')
	SEC=PEEK(X'81B9')
C
C	STARTING TIME
	STIME=3600.*HR+60.*MIN+SEC
C
1	HR=PEEK(X'81BB')
	MIN=PEEK(X'81BA')
	SEC=PEEK(X'81B9')
C
C	PRESENT TIME
	PRESTM=3600.*HR+60.*MIN+SEC
C
	DELTA=PRESTM-STIME
	IF(DELTA .LT. SECS) GOTO 1
C
	RETURN
	END
C
C	=======================================================
C
	SUBROUTINE LINE (X,Y,N,FCOLOR,BCOLOR,IBL,IFL)
C
C	THIS SUBROUTINE WILL PLOT CURVES WITH OPTIONS
C	  FOR COLOR,BLINKING, AND "EXCLUSIVE OR"-ING.
C
C	WRITTEN BY: JOSEPH J. CHARLES, 130 SHERWOOD DRIVE,
C		    HILTON, NY 14468  TEL:(716) 392-8152
C
C	VERSION: JULY 18,1982,  6:17 PM
C

	DIMENSION X(1),Y(1)
C
	LOGICAL X,Y,FCOLOR,BCOLOR,BLINK,BLA7OF,GPM,VECTOR
	LOGICAL FGOFL0,BGOFLO,PLEND,GREEN,BLACK
C
	DATA GPM,VECTOR,PLEND,FGOFL0,BGOFLO/2,242,255,29,30/
	DATA BLA7OF,BLINK,GREEN,BLACK/15,31,18,16/
C
	WRITE(3) BGOFLO,BCOLOR,FGOFL0,FCOLOR
C
	WRITE(3) BLA7OF
	IF(IBL .EQ. 1) WRITE(3) BLINK
C
	IF(IFL .EQ.1) WRITE(3) BGOFLO
C
	WRITE(3) GPM,X(1),Y(1),VECTOR
C
	DO 1 I=2,N
1	WRITE(3) X(I),Y(I)
C
	WRITE(3)PLEND,BGOFLO,BLACK,FGOFL0,GREEN,BLA7OF
C
	RETURN
	END
C
C	=======================================================
C
	SUBROUTINE PPLOT (X,Y,N,FCOLOR,BCOLOR,IBL,IFL)
C
C	THIS SUBROUTINE WILL PRODUCE POINT PLOTS WITH OPTIONS
C	  FOR COLOR,BLINKING, AND "EXCLUSIVE OR"-ING.
C
C	WRITTEN BY: JOSEPH J. CHARLES, 130 SHERWOOD DRIVE,
C		    HILTON, NY 14468  TEL:(716) 392-8152
C
C
C	VERSION: JULY 18,1982,  6:17 PM
C
	DIMENSION X(1),Y(1)
C
	LOGICAL X,Y,FGOFL0,BGOFLO,BLINK,GPM,POINT,BLA7OF
	LOGICAL FCOLOR,BCOLOR,PLEND,GREEN,BLACK
C
	DATA GPM,POINT,PLEND,FGOFL0,BGOFLO/2,253,255,29,30/
	DATA BLA7OF,BLINK,GREEN,BLACK/15,31,18,16/
C
	WRITE(3) BGOFLO,BCOLOR,FGOFL0,FCOLOR
C
	WRITE(3) BLA7OF
	IF(IBL .EQ. 1) WRITE(3) BLINK
C
	IF(IFL .EQ. 1) WRITE(3) BGOFLO
C
	WRITE(3) GPM,X(1),Y(1),POINT
C
	DO 1 I=2,N
1	WRITE(3) X(I),Y(I)
C
	WRITE(3) PLEND,BGOFLO,BLACK,FGOFL0,GREEN,BLA7OF
	RETURN
	END
C
C	======================================================
C
	SUBROUTINE SCALE(ARRAY1,ARRAY2,N,MIN,MAX)
C
C	THIS SUBROUTINE WILL SCALE ARRAY1 ,A REAL ARRAY, TO
C	  THE LOGICAL ARRAY, ARRAY2. ARRAY2 MAY BE SENT TO THE
C	  SCREEN VIA THE PLOT ROUTINES, LOGICAL AND PROPERLY SCALED.
C
C	WRITTEN BY: JOSEPH J. CHARLES, 130 SHERWOOD DRIVE,
C		    HILTON, NY 14468  TEL:(716) 392-8152
C
C
C	VERSION: JULY 18,1982,  6:17 PM
C
	DIMENSION ARRAY1(1)
	LOGICAL ARRAY2(1)
C
	ALOW=1.E30
	AHIGH=-1.E30
C
	DO 1 I=1,N
	IF(ARRAY1(I) .LT. ALOW) ALOW=ARRAY1(I)
1	IF(ARRAY1(I) .GT. AHIGH) AHIGH=ARRAY1(I)
C
	DELA=AHIGH-ALOW
	DELTA=MAX-MIN
	SCALER=DELTA/DELA
C
	DO 2 I=1,N
2	ARRAY2(I)=(ARRAY1(I)-ALOW)*SCALER+MIN
C
	RETURN
	END
C
C	=======================================================
C
	SUBROUTINE XBAR(X0,Y,XMAX,FCOLOR,BCOLOR,IBL,IFL)
C
C	THIS SUBROUTINE PRODUCES X-BAR-GRAPHS WITH OPTIONS
C	  FOR COLOR,BLINKING,AND "EXCLUSIVE OR"-ING.
C
C	WRITTEN BY: JOSEPH J. CHARLES, 130 SHERWOOD DRIVE,
C		    HILTON, NY 14468  TEL:(716) 392-8152
C
C
C	VERSION: JULY 18,1982,  6:17 PM
C
	LOGICAL GPM,XBARG,FCOLOR,BCOLOR,BLINK,X0,Y,XMAX,PLEND
	LOGICAL GREEN,BLACK,FGOFL0,BGOFLO,BLA7OF
C
	DATA GPM,XBARG,PLEND,BLINK/2,250,255,31/
	DATA FGOFL0,GREEN,BGOFLO,BLACK,BLA7OF/29,18,30,16,15/
C
	WRITE(3) BGOFLO,BCOLOR,FGOFL0,FCOLOR
C
	WRITE(3) BLA7OF
	IF (IBL .EQ. 1) WRITE(3) BLINK
C
	IF (IFL .EQ. 1) WRITE(3) BGOFLO
C
	WRITE(3) GPM,XBARG,X0,Y,XMAX,PLEND
C
	WRITE(3) BGOFLO,BLACK,FGOFL0,GREEN,BLA7OF
C
	RETURN
	END
C
C	======================================================
C
C
	SUBROUTINE YBAR(Y0,X,YMAX,FCOLOR,BCOLOR,IBL,IFL)
C
C	THIS SUBROUTINE PRODUCES Y-BAR-GRAPHS WITH OPTIONS
C	  FOR COLOR,BLINKING,AND "EXCLUSIVE OR"-ING.
C
C	WRITTEN BY: JOSEPH J. CHARLES, 130 SHERWOOD DRIVE,
C		    HILTON, NY 14468  TEL:(716) 392-8152
C
C
C	VERSION: JULY 18,1982,  6:17 PM
C
	LOGICAL GPM,YBARG,FCOLOR,BCOLOR,BLINK,Y0,X,YMAX,PLEND
	LOGICAL GREEN,BLACK,FGOFL0,BGOFLO,BLA7OF
C
	DATA GPM,YBARG,PLEND,BLINK/2,246,255,31/
	DATA FGOFL0,GREEN,BGOFLO,BLACK,BLA7OF/29,18,30,16,15/
C
	WRITE(3) BGOFLO,BCOLOR,FGOFL0,FCOLOR
C
	WRITE(3) BLA7OF
	IF (IBL .EQ. 1) WRITE(3) BLINK
C
	IF (IFL .EQ. 1) WRITE(3) BGOFLO
C
	WRITE(3) GPM,YBARG,Y0,X,YMAX,PLEND
C
	WRITE(3) BGOFLO,BLACK,FGOFL0,GREEN,BLA7OF
C
	RETURN
	END