Listing of file='FORDEM.FOR;01' on disk='vmedia/chip_61-sector.ccvf'
C
C
PROGRAM FORDEM
C
C THIS PROGRAM, FORTRAN-DEMO, IS TO DEMONSTRATE THE USE
C OF THE FORTRAN PLOT SUBROUTINES WRITTEN BY THE AUTHOR
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:55 PM
C
C
DIMENSION X(51),Y(51),X2(51),Y2(51),Y3(51)
C
LOGICAL BLACK,RED,GREEN,YELLOW,BLUE,MAGNTA,CYAN,WHITE
LOGICAL FGOFL0,BGOFLO,BLA7OF,BLINK,ERASE,SETBR,ESC
LOGICAL A7ON,BRC,PAGE,SCROLL,CURSOR,LX,LY,COLOR,HOME
LOGICAL X2,Y2,Y3,HR,MIN,SEC
C
DATA BLACK,RED,GREEN,YELLOW,BLUE,MAGNTA/16,17,18,19,20,21/
DATA CYAN,WHITE,ERASE,BLA7OF,BLINK,HOME/22,23,12,15,31,8/
DATA ESC,SETBR,A7ON,PAGE,SCROLL,CURSOR/27,18,14,24,11,3/
DATA BGOFLO,FGOFL0/30,29/
C
WRITE(3)BGOFLO,BLACK,FGOFL0,YELLOW,BLA7OF
C
WRITE(3,105)
105 FORMAT(' INPUT DATA MUST BE IN FORM INDICATED. FOR EXAMPLE'/
1 ' ## ## ## MEANS 3 TWO DIGIT NUMBERS ,RIGHT JUSTIFIED, WITH A',
2 ' SPACE BETWEEN THEM. E.G. 09 17 30')
C
WRITE(3,106)
106 FORMAT(' ENTER THE TIME (HOURS MINUTES SECONDS) ## ## ##')
READ(3,107) IHR,IMIN,ISEC
107 FORMAT(3(I2,1X))
C
C CONVERT TO ONE BYTE EACH
HR=IHR
MIN=IMIN
SEC=ISEC
C
C POKE TO 33211,33210,33209
C (X'81BB',X'81BA',X'81B9' IN HEX)
C
CALL POKE(X'81BB',HR)
CALL POKE(X'81BA',MIN)
CALL POKE(X'81B9',SEC)
C
WRITE(3,111)
111 FORMAT(' ENTER BAUD RATE CODE FOR YOUR PRINTER IF'/,
1 ' YOU WANT TO USE IT. (1-7) ENTER 0 OTHERWISE. # ')
C
READ(3,112) IBRC
112 FORMAT(I1)
C
IF( IBRC .EQ. 0) GO TO 2
C
BRC=IBRC
3 WRITE(3) ESC,SETBR,BRC
C
WRITE(3,113)
113 FORMAT(' ENTER NUMBER OF STOP BITS FOR YOUR PRINTER.'/,
1 ' (1 OR 2) # ')
READ(3,112) NSB
C
IF(NSB .EQ. 1) WRITE(3) A7ON
IF(NSB .EQ. 2) WRITE(3) BLA7OF
C
2 WRITE(3,130)
130 FORMAT(' FOR HOW MANY SECONDS WOULD YOU LIKE TO OBSERVE '/
1 ' EACH DEMONSTRATION PLOT? ## ')
READ (3,107) NSEC
C
WRITE(3,101)
101 FORMAT(' ENTER X,Y FOR LOWER LEFT CORNER: ### ###'/,
1 ' ENTER X GREATER THAN 127 TO END PROGRAM.')
C
READ (3,102)IXMIN,IYMIN
102 FORMAT(I3,1X,I3)
IF(IXMIN .GT. 127) GOTO 8
C
WRITE(3,103)
103 FORMAT(' ENTER X,Y FOR UPPER RIGHT CORNER: ### ###')
READ (3,102) IXMAX,IYMAX
C
C DEFINE GAUSSIAN FUNCTION:
C N(0,1) ( NOT NORMALIZED TO UNIT AREA )
C
Y(26)=1.
X(26)=0.
DO 1 I=1,25
X(I)=(I-26)/8.
Y(I)=EXP(-0.5*(X(I)**2))
X(I+26)=I/8.
1 Y(I+26)=EXP(-0.5*(X(I+26)**2))
C
C WRITE DATA TO PRINTER IF PRINTER IS THERE
IF(IBRC .EQ. 0) GO TO 4
C
6 WRITE(2,104)
104 FORMAT(' ',' I',5X,'X(I)',6X,'Y(I)',9X,'X(I+1) Y(I+1)')
C
WRITE(2,100) (I,X(I),Y(I),X(I+1),Y(I+1), I=1,49,2)
100 FORMAT(' ',I5,2(F10.4,F10.6,5X))
C
WRITE(2,110)
C
4 CALL SCALE(X,X2,51,IXMIN,IXMAX)
C
CALL SCALE(Y,Y2,51,IYMIN,IYMAX)
C
C WRITE SCALED VALUES TO PRINTER
IF( IBRC .EQ.0 ) GOTO 5
C
7 WRITE (2,108)
108 FORMAT(////' SCALED BYTE VALUES'/)
C
WRITE(2,109) (I,X2(I),Y2(I),X2(I+1),Y2(I+1), I=1,49,2)
109 FORMAT (' ',I5,5X,I3,7X,I3,12X,I3,7X,I3)
C
WRITE(2,110)
110 FORMAT(///)
C
5 WRITE(3) ESC,PAGE,ERASE
C
WRITE(3,140)
140 FORMAT(' PLAIN OLD BELL-SHAPED CURVE FOR STARTERS...')
CALL TIMER(2)
CALL LINE (X2,Y2,51,RED,BLACK,0,0)
CALL TIMER(NSEC)
WRITE(3) ERASE
C
WRITE(3,141)
141 FORMAT(' SAME, BUT IN POINT PLOT MODE WITH BLINKING.')
CALL TIMER(3)
WRITE(3) ERASE
CALL PPLOT(X2,Y2,51,GREEN,BLACK,1,0)
CALL TIMER(NSEC)
C
WRITE(3,142)
142 FORMAT(' PUT TWO CURVES UP...')
CALL TIMER(2)
WRITE(3) ERASE
CALL LINE (X2,Y2,51,YELLOW,BLACK,0,0)
DO 14 I=1,41
14 Y3(I)=Y2(I+10)
CALL LINE (X2,Y3,41,BLUE,BLACK,0,0)
CALL TIMER(NSEC)
C
WRITE(3) HOME
WRITE(3,143)
143 FORMAT(' ERASE ONE BY REPLOTTING WITH XOR-ING')
CALL TIMER(2)
CALL LINE (X2,Y2,51,YELLOW,BLACK,0,1)
CALL TIMER(NSEC)
WRITE(3) ERASE
C
WRITE(3,144)
144 FORMAT(' Y BAR-GRAPH MODE...ONE SUB CALL FOR EACH LINE')
CALL TIMER(4)
DO 13 I=1,51
13 CALL YBAR(Y2(1),X2(I),Y2(I),RED,BLACK,0,0)
CALL TIMER(NSEC)
WRITE(3) ERASE
C
WRITE(3,145)
145 FORMAT(' X BARS...')
CALL TIMER(2)
WRITE(3) ERASE
DO 9 I=1,51
9 CALL XBAR(Y2(1),X2(I),Y2(I),YELLOW,BLACK,0,0)
CALL TIMER(NSEC)
C
WRITE(3) HOME
WRITE(3,146)
146 FORMAT(' ERASE BY XOR-ING EVERY OTHER ONE...')
CALL TIMER(4)
DO 10 I=2,50,2
10 CALL XBAR(Y2(1),X2(I),Y2(I),YELLOW,BLACK,0,1)
CALL TIMER(NSEC)
C
WRITE(3) HOME
WRITE(3,147)
147 FORMAT(' REPLOT REMAINING ONES BLINKING YELLOW.')
CALL TIMER(4)
DO 11 I=1,51,2
11 CALL XBAR(Y2(1),X2(I),Y2(I),YELLOW,BLACK,1,0)
CALL TIMER(NSEC)
WRITE(3) ERASE
C
DO 12 K=1,5
DO 12 I=17,23
COLOR=I
12 WRITE(3)BGOFLO,COLOR,ERASE
C
LX=0
LY=16
WRITE(3)BGOFLO,BLACK,FGOFL0,RED,ERASE,BLINK,A7ON,CURSOR,LX,LY
WRITE(3,131)
131 FORMAT(17X,'TH..TH..THAT''S ALL, FOLKS!!! ')
C
CALL TIMER(15)
WRITE(3) ESC,SCROLL,FGOFL0,GREEN,BLA7OF
C
GOTO 2
C
8 END