$$$$$$$$     PN400013,JDLR     9PA                                      00000006
CALCOMP HCBS  PN400013*9-E  IPE PACKAGE FOR 907 CONTROLLER  F-77  METRIC        
C                                                                       DRVR0001
CALCOMP DRIVER PROGRAM FOR SUBROUTINES SAMPA, SAMPB                     DRVR0002
C                                                                       DRVR0003
C...PROGRAM    DRIVER         FORTRAN   VERAA  LIBRARY NUMBER ZBPAD006  DRVR0004
C                                                                       DRVR0005
      LDEV = 9                                                          DRVR0006
      CALL PLOTS(0,0,LDEV)                                              DRVR0007
      CALL SAMPA                                                        DRVR0008
      CALL SAMPB                                                        DRVR0009
      CALL PLOT(0.0,0.0,999)                                            DRVR0010
      STOP                                                              DRVR0011
      END                                                               DRVR0012
      SUBROUTINE SAMPA                                                  00000010
C...SUBROUTINE     SAMPA                VERAA  LIBRARY NUMBER ZBPAS501  00000020
CALIFORNIA COMPUTER PRODUCTS SAMPLE PROGRAM NUMBER A                    00000030
CALCOMP HCBS FOR  IPE F-77 METRIC     907 CONTROLLER        DEC, 1983 * 00000040
C     CALL TO SUBROUTINE 'OPMES' IS 907 CONTROLLER SPECIFIC             00000050
C                                                                       00000060
      INTEGER I,K,INTEQ                                                 00000070
      REAL XAR(62),YAR(62),DELX                                         00000080
      REAL X,Y,H,XC,YC,R,XT,YT,HT,XDUM                                  00000090
      INTEGER MACC,MNVEL,MXVEL                                          00000100
      REAL FCMI                                                         00000110
C                                                                       00000120
      CHARACTER *10 ICHR1                                               00000130
      CHARACTER *26 ICHR2                                               00000140
      CHARACTER *18 ICHR3                                               00000150
      CHARACTER *14 ICHR4                                               00000160
      CHARACTER *10 ICHR5                                               00000170
      CHARACTER *1  ICHR6                                               00000180
      CHARACTER *6  ICHR7                                               00000190
      CHARACTER *9  ICHR8                                               00000200
      CHARACTER *6  ICHR9                                               00000210
      CHARACTER *18 ICHR10                                              00000220
      CHARACTER *19 ICHR11                                              00000230
      CHARACTER *10 ICHR12                                              00000240
      CHARACTER *10 ICHR13                                              00000250
      CHARACTER *21 ICHR14                                              00000260
C                                                                       00000270
C  SET MACC,MNVEL,MXVEL FOR PARTICULAR INTELLIGENT PLOTTER SOFTWARE     00000280
C        MAXIMUM ACCELERATION(MACC) IS 4,                               00000290
C        MINIMUM VELOCITY(MNVEL) IS 5, MAXIMUM VELOCITY(MXVEL) IS 132   00000300
      DATA MACC,MNVEL,MXVEL /4,5,132/                                   00000310
      DATA FCMI/2.54/                                                   00000320
C                                                                       00000330
      ICHR1='0123456789'                                                00000340
      ICHR2='ABCDEFGHIJKLMNOPQRSTUVWXYZ'                                00000350
      ICHR3='TOLERANCE AND FONT'                                        00000360
      ICHR4='CIRCLE AND ARC'                                            00000370
      ICHR5='ROTATE 135'                                                00000380
      ICHR6='0'                                                         00000390
      ICHR7='NORMAL'                                                    00000400
      ICHR8='MIRROR XY'                                                 00000410
      ICHR9='WINDOW'                                                    00000420
      ICHR10='LOWEST VEL + ACCEL'                                       00000430
      ICHR11='HIGHEST VEL + ACCEL'                                      00000440
      ICHR12='X-ABSCISSA'                                               00000450
      ICHR13='Y-ORDINATE'                                               00000460
      ICHR14='  Y = X -0.7*X +0.1*X'                                    00000470
C                                                                       00000480
C TEST CHORDAL TOLERANCE FOR CHARACTERS                                 00000490
C ... DRAW DIGITS 0-9 WITH 10 CHORDAL LEVELS                            00000500
C                                                                       00000510
      CALL FACTOR(FCMI)                                                 00000520
      CALL NEWPEN(1)                                                    00000530
      CALL FONT(0.0)                                                    00000540
      CALL SYMBOL(2.0,6.0,0.4,ICHR3,INTEQ,0.0,18)                       00000550
      K=0                                                               00000560
      Y=5.0                                                             00000570
      CALL SETCHR(0.25,999.0,999.0,999.0,-999.0)                        00000580
      DO 100 I=1,10                                                     00000590
        CALL TLRNCE(1,K)                                                00000600
        CALL SYMBOL(1.5,Y,1.0,ICHR1,INTEQ,0.0,10)                       00000610
        K=K+1                                                           00000620
        Y=Y-0.5                                                         00000630
  100 CONTINUE                                                          00000640
      CALL SETCHR(0.25,999.0,999.0,999.0,0.0)                           00000650
      CALL FONT(-999.0)                                                 00000660
      CALL PLOT(0.0,0.0,-3)                                             00000670
C                                                                       00000680
C TEST CHORDAL TOLERANCE FOR ARC AND CIRCLES                            00000690
C ... DRAW FIVE INCH CIRCLES WITH 10 CHORDAL LEVELS                     00000700
C                                                                       00000710
      K=0                                                               00000720
      DO 200 I=1,10                                                     00000730
        CALL TLRNCE(K,2)                                                00000740
        CALL CIRCLE(4.5,3.0,7.0,3.0,XDUM,+1)                            00000750
        K=K+1                                                           00000760
  200 CONTINUE                                                          00000770
      CALL PLOT(0.0,0.0,-3)                                             00000780
C                                                                       00000790
C SELECT FONT                                                           00000800
C PLOT SYMBOL WITH ASPECT OF 1.2,                                       00000810
C             WITH TALICS OF 10 DEGREES,                                00000820
C             WITH SPACE OF 1.2 BETWEEN CHARACTERS                      00000830
C                                                                       00000840
      CALL FONT(0.0)                                                    00000850
      CALL SETCHR(0.2,1.2,10.0,999.0,-999.0)                            00000860
      CALL SYMBOL(4.0,0.1,1.2,ICHR2,INTEQ,0.0,26)                       00000870
      CALL SETCHR(0.20,-1.2,999.0,999.0,0.0)                            00000880
      CALL PLOT(0.0,0.0,-3)                                             00000890
C                                                                       00000900
C  TEST CIRCLE ROUTINE                                                  00000910
C                                                                       00000920
      H=0.4                                                             00000930
      R=20.0                                                            00000940
      XC=20.0                                                           00000950
      YC=0.0                                                            00000960
      CALL CIRCLE(XC,YC,0.0,180.0,R,+7)                                 00000970
      YC=0.2                                                            00000980
      XC=36.0                                                           00000990
      CALL TLRNCE(7,2)                                                  00001000
      CALL CIRCLE(XC,YC,XC,2.2,XDUM,+1)                                 00001010
      R=1.0                                                             00001020
      CALL CIRCLE(XC,2.2,180.0,360.0,R,+7)                              00001030
      R=0.25                                                            00001040
      CALL CIRCLE(35.25,2.95,0.0,180.0,R,+7)                            00001050
      CALL CIRCLE(36.75,2.95,0.0,180.0,R,+7)                            00001060
      CALL SYMBOL(34.0,4.4,0.3,ICHR4,INTEQ,0.0,14)                      00001070
C                                                                       00001080
C  TEST ROTATE ROUTINE, ROTATE 135 DEGREES                              00001090
C                                                                       00001100
      CALL NEWPEN(2)                                                    00001110
      CALL SYMBOL(26.2,14.0,H,ICHR5,INTEQ,0.0,10)                       00001120
      CALL SYMBOL(30.2,14.3,0.1,ICHR6,INTEQ,0.0,1)                      00001130
      CALL PLOT(35.0,9.0,-3)                                            00001140
      CALL ROTATE(135)                                                  00001150
      K=1                                                               00001160
C                                                                       00001170
C PLOT GRAPH ILLUSTRATING  SCALE                                        00001180
      DELX=0.08                                                         00001190
      XAR(1)=DELX                                                       00001200
      DO 300 I=1,60                                                     00001210
        YAR(I)=(XAR(I)**2)-0.7*(XAR(I)**3)+0.1*(XAR(I)**4)              00001220
        XAR(I+1)=XAR(I)+DELX                                            00001230
  300 CONTINUE                                                          00001240
      CALL SCALE(XAR(1),6.5*FCMI,60,1)                                  00001250
      CALL SCALE(YAR(1),10.0*FCMI,60,1)                                 00001260
C                                                                       00001270
  900 CONTINUE                                                          00001280
C                                                                       00001290
C PLOT GRAPH ILLUSTRATING  AXIS, AND LINE                               00001300
      CALL FACTOR(1.00)                                                 00001310
      CALL AXIS(0.,0.,ICHR12,-10,6.5*FCMI,0.0,XAR(61),XAR(62))          00001320
      CALL AXIS(0.,0.,ICHR13,10,9.0*FCMI,90.0,YAR(61),YAR(62))          00001330
      CALL LINE(XAR(1),YAR(1),60,1,1,1)                                 00001340
      XT=2.1*FCMI                                                       00001350
      YT=8.7*FCMI                                                       00001360
      HT=0.14*FCMI                                                      00001370
      CALL SYMBOL(XT,YT,HT,ICHR14,INTEQ,0.0,21)                         00001380
      XT=XT+0.98*FCMI                                                   00001390
      YT=8.8*FCMI                                                       00001400
      HT=0.1*FCMI                                                       00001410
      CALL NUMBER(XT,YT,HT,2.0,0.0,-1)                                  00001420
      XT=XT+0.98*FCMI                                                   00001430
      CALL NUMBER(XT,YT,HT,3.0,0.0,-1)                                  00001440
      XT=XT+0.98*FCMI                                                   00001450
      CALL NUMBER(XT,YT,HT,4.0,0.0,-1)                                  00001460
      CALL PLOT(0.0,0.0,3)                                              00001470
      CALL FACTOR(FCMI)                                                 00001480
      GO TO (400,500,600,700), K                                        00001490
  400 CONTINUE                                                          00001500
      CALL ROTATE(0)                                                    00001510
C                                                                       00001520
C  NORMAL PLOT                                                          00001530
C                                                                       00001540
      CALL PLOT(-18.0,0.5,-3)                                           00001550
      CALL NEWPEN(4)                                                    00001560
      CALL SYMBOL(1.5,9.3,H,ICHR7,INTEQ,0.0,6)                          00001570
      K=2                                                               00001580
      GO TO 900                                                         00001590
  500 CONTINUE                                                          00001600
C                                                                       00001610
C  TEST MIRROR ROUTINE, MIRROR ABOUT XY AXIS                            00001620
C                                                                       00001630
      CALL PLOT(-2.7,-8.5,-3)                                           00001640
      CALL NEWPEN(3)                                                    00001650
      CALL SYMBOL(1.0,6.9,H,ICHR8,INTEQ,0.0,9)                          00001660
      CALL PLOT(0.0,0.0,-3)                                             00001670
      CALL MIRROR(3)                                                    00001680
      K=3                                                               00001690
      GO TO 900                                                         00001700
  600 CONTINUE                                                          00001710
      CALL MIRROR(0)                                                    00001720
C                                                                       00001730
C  TEST WINDOW ROUTINE                                                  00001740
C                                                                       00001750
      CALL PLOT(-6.3,4.0,-3)                                            00001760
      CALL NEWPEN(2)                                                    00001770
      CALL SYMBOL(0.0,9.4,H,ICHR9,INTEQ,0.0,6)                          00001780
      CALL WINDOW(0,-1.0,5.2,4.0,9.0)                                   00001790
      K=4                                                               00001800
      GO TO 900                                                         00001810
  700 CONTINUE                                                          00001820
      CALL WINDOW(0,0.0,0.0,0.0,0.0)                                    00001830
      CALL PLOT(-8.0,-5.0,-3)                                           00001840
C                                                                       00001850
C  TEST PRFORM ROUTINE                                                  00001860
C                                                                       00001870
      R=20.0                                                            00001880
      XC=20.0                                                           00001890
      YC=0.0                                                            00001900
      CALL NEWPEN(1)                                                    00001910
      CALL TLRNCE(8,2)                                                  00001920
C                                                                       00001930
      CALL PRFORM(0,1,MNVEL)                                            00001940
      CALL OPMES(18,ICHR10)                                             00001950
      CALL CIRCLE(XC,YC,0.0,180.0,R,+7)                                 00001960
      CALL PLOT(40.0,0.0,2)                                             00001970
C                                                                       00001980
      CALL PRFORM(0,MACC,MXVEL)                                         00001990
      CALL OPMES(19,ICHR11)                                             00002000
      CALL CIRCLE(XC,YC,0.0,180.0,R,+7)                                 00002010
      CALL PLOT(40.0,0.0,2)                                             00002020
C                                                                       00002030
      CALL TLRNCE(7,2)                                                  00002040
      CALL FONT(-999.0)                                                 00002050
      CALL PLOT(42.0,0.0,-3)                                            00002060
      CALL FACTOR(1.00)                                                 00002070
      RETURN                                                            00002080
      END                                                               00002090
      SUBROUTINE SAMPB                                                  SMPB0001
CALCOMP HCBS  IPE PKG    SAMPLE PROGRAM B   F-77   METRIC     ZBPAT501  SMPB0002
C     CALL THREE SUBROUTINES: ARCS, CUBE, FTEN                          SMPB0003
      CHARACTER * 5 STR1                                                SMPB0004
      CHARACTER * 9 STR2                                                SMPB0005
      CHARACTER *16 STR3                                                SMPB0006
      CHARACTER * 9 STR4                                                SMPB0007
      CHARACTER * 8 STR5                                                SMPB0008
      CHARACTER * 6 STR6                                                SMPB0009
      CHARACTER * 6 STR7                                                SMPB0010
      CHARACTER * 6 STR8                                                SMPB0011
      CHARACTER * 6 STR9                                                SMPB0012
      CHARACTER * 6 STR10                                               SMPB0013
      CHARACTER * 6 STR11                                               SMPB0014
      CHARACTER *13 STR12                                               SMPB0015
C     ALL CALCULATIONS ARE IN INCH, FACTOR BY 2.54 FOR METRIC PRODUCT   SMPB0016
      CALL FACTOR(2.54)                                                 SMPB0017
      STR1='USER '                                                      SMPB0018
      STR2='SELECTED '                                                  SMPB0019
      STR3='CURVE RESOLUTION'                                           SMPB0020
      STR4='CHARACTER'                                                  SMPB0021
      STR5=' SPACING'                                                   SMPB0022
      STR6='ASPECT'                                                     SMPB0023
      STR7=' RATIO'                                                     SMPB0024
      STR8=' ANGLE'                                                     SMPB0025
      STR9=' SLANT'                                                     SMPB0026
      STR10='MIRROR'                                                    SMPB0027
      STR11=' IMAGE'                                                    SMPB0028
      STR12='SYMBOL STYLES'                                             SMPB0029
      CALL FONT(1.0)                                                    SMPB0030
C *** TESTING DIFFERENT SYMBOL STYLES                                   SMPB0031
      CALL NEWPEN(4)                                                    SMPB0032
      CALL SETCHR(0.6,1.0,0.0,0.0,-999.0)                               SMPB0033
      CALL TLRNCE(3,0)                                                  SMPB0034
      CALL SYMBOL(0.2,19.0,1.0,STR1,INTEQ,-90.0,5)                      SMPB0035
      CALL TLRNCE(3,1)                                                  SMPB0036
      CALL SYMBOL(999.0,999.0,1.0,STR2,INTEQ,-90.0,9)                   SMPB0037
      CALL TLRNCE(3,5)                                                  SMPB0038
      CALL SYMBOL(999.0,999.0,1.0,STR3,INTEQ,-90.0,16)                  SMPB0039
      CALL SYMBOL(1.2,16.3,1.0,STR4,INTEQ,-90.0,9)                      SMPB0040
      CALL SYMBOL(999.0,999.0,1.5,STR5,INTEQ,-90.0,8)                   SMPB0041
      CALL SYMBOL(2.2,15.5,1.0,STR6,INTEQ,-90.0,6)                      SMPB0042
      CALL SETCHR(0.6,2.0,0.0,0.0,-999.0)                               SMPB0043
      CALL SYMBOL(999.0,999.0,2.0,STR7,INTEQ,-90.0,6)                   SMPB0044
C                                                                       SMPB0045
      CALL NEWPEN(2)                                                    SMPB0046
      CALL SETCHR(0.5,1.0,0.0,45.0,-999.0)                              SMPB0047
      CALL SYMBOL(3.3,14.4,1.167,STR4,INTEQ,-90.0,9)                    SMPB0048
      CALL SETCHR(0.5,1.0,0.0,-45.0,-999.0)                             SMPB0049
      CALL SYMBOL(3.5, 9.6,1.167,STR8,INTEQ,-90.0,6)                    SMPB0050
      CALL SETCHR(0.4,1.0,-40.0,0.0,-999.0)                             SMPB0051
      CALL SYMBOL(4.3,13.4,1.0,STR4,INTEQ,-90.0,9)                      SMPB0052
      CALL SETCHR(0.4,1.0,40.0,0.0,-999.0)                              SMPB0053
      CALL SYMBOL(999.0,999.0,1.0,STR9,INTEQ,-90.0,6)                   SMPB0054
      CALL NEWPEN(3)                                                    SMPB0055
      CALL SETCHR(0.4,-1.0,0.0,0.0,-999.0)                              SMPB0056
      CALL SYMBOL(5.2, 8.0,-1.0,STR10,INTEQ,-90.0,6)                    SMPB0057
      CALL SYMBOL(999.0,999.0,-1.0,STR11,INTEQ,-90.0,6)                 SMPB0058
      CALL NEWPEN(1)                                                    SMPB0059
      CALL SETCHR(.25,1.0,0.0,0.0,-999.0)                               SMPB0060
      CALL SYMBOL(6.1,11.95,1.0,STR12,INTEQ,-90.0,13)                   SMPB0061
C                                                                       SMPB0062
      CALL ARCS                                                         SMPB0063
      CALL CUBE                                                         SMPB0064
      CALL FTEN                                                         SMPB0065
      CALL PLOT(0.,0.,3)                                                SMPB0066
      CALL PLOT(19.,0.,2)                                               SMPB0067
      CALL PLOT(19.,20.,2)                                              SMPB0068
      CALL PLOT(0.,20.,2)                                               SMPB0069
      CALL PLOT(0.,0.,2)                                                SMPB0070
C *** RESET TO DEFAULT VALUES                                           SMPB0071
      CALL NEWPEN(1)                                                    SMPB0072
      CALL TLRNCE(7,2)                                                  SMPB0073
      CALL FONT(-999.0)                                                 SMPB0074
      CALL SETCHR(1.,1.,0.,0.,0.)                                       SMPB0075
      CALL PLOT(20.,0.,-3)                                              SMPB0076
      CALL FACTOR(1.0)                                                  SMPB0077
      RETURN                                                            SMPB0078
      END                                                               SMPB0079
      SUBROUTINE ARCS                                                   SMPB0080
C *** CHORDAL TOLERANCE OF CIRCLES AND ARCS                             SMPB0081
      DIMENSION D1(2),DUMM(2)                                           SMPB0082
      CHARACTER * 2 ISTR1                                               SMPB0083
      CHARACTER * 2 ISTR2                                               SMPB0084
      CHARACTER * 1 ISTR3                                               SMPB0085
      CHARACTER * 3 ISTR4                                               SMPB0086
      CHARACTER *37 ISTR5                                               SMPB0087
      DATA DUM,DUMM,D1/0.,0.,0.,-0.1,0.1/                               SMPB0088
      ISTR1='30'                                                        SMPB0089
      ISTR2='10'                                                        SMPB0090
      ISTR3='2'                                                         SMPB0091
      ISTR4='1/4'                                                       SMPB0092
      ISTR5='CHORDAL TOLERANCE OF CIRCLES AND ARCS'                     SMPB0093
C *** DRAW SOLID ARCS                                                   SMPB0094
      CALL SETCHR(0.4,1.0,0.0,0.0,-999.0)                               SMPB0095
      CALL NEWPEN(2)                                                    SMPB0096
      CALL TLRNCE(1,2)                                                  SMPB0097
      CALL CIRCLE( 3.3, 4.1, 7.9, 8.0,5.046,2)                          SMPB0098
      CALL CIRCLE( 9.0, 9.0, 0.0,DUM,0.9,-6)                            SMPB0099
      CALL SYMBOL( 8.8, 9.4,1.0,ISTR1,INTEQ,-90.0,2)                    SMPB0100
      CALL CIRCLE( 9.1, 8.4, 0.0,DUM,0.07, 6)                           SMPB0101
      CALL NEWPEN(3)                                                    SMPB0102
      CALL TLRNCE(4,5)                                                  SMPB0103
      CALL CIRCLE( 2.4, 2.9, 7.7, 5.7,4.991,2)                          SMPB0104
      CALL CIRCLE( 9.0, 6.5, 0.0,DUM,0.9,-6)                            SMPB0105
      CALL SYMBOL( 8.8, 6.9,1.0,ISTR2,INTEQ,-90.0,2)                    SMPB0106
      CALL CIRCLE( 9.1, 5.9, 0.0,DUM,0.07, 6)                           SMPB0107
      CALL NEWPEN(4)                                                    SMPB0108
      CALL TLRNCE(6,7)                                                  SMPB0109
      CALL CIRCLE( 1.8, 1.9, 7.6, 3.5,5.025,2)                          SMPB0110
      CALL CIRCLE( 9.0, 4.0, 0.0,DUM,0.9,-6)                            SMPB0111
      CALL SYMBOL( 8.8, 4.0,1.0,ISTR3,INTEQ,-90.0,1)                    SMPB0112
      CALL CIRCLE( 9.1, 3.4, 0.0,DUM,0.07, 6)                           SMPB0113
      CALL NEWPEN(1)                                                    SMPB0114
      CALL TLRNCE(9,9)                                                  SMPB0115
      CALL CIRCLE( 1.5, 1.5, 7.5, 1.5,4.705,2)                          SMPB0116
      CALL CIRCLE( 9.0, 1.5, 0.0,DUM,0.9,-6)                            SMPB0117
      CALL SYMBOL( 8.8, 2.3,1.0,ISTR4,INTEQ,-90.0,3)                    SMPB0118
      CALL CIRCLE( 9.1, 0.9, 0.0,DUM,0.07, 6)                           SMPB0119
C                                                                       SMPB0120
C *** DRAW DASHED ARCS                                                  SMPB0121
      CALL DASHS(DUMM,1001)                                             SMPB0122
      CALL NEWPEN(2)                                                    SMPB0123
      CALL TLRNCE(1,2)                                                  SMPB0124
      CALL CIRCLE( 3.3, 4.1, 7.9, 8.0,9.342,2)                          SMPB0125
      CALL CIRCLE( 9.0, 9.0, 0.0,DUM,1.0,-6)                            SMPB0126
      CALL NEWPEN(3)                                                    SMPB0127
      CALL TLRNCE(4,5)                                                  SMPB0128
      CALL CIRCLE( 2.4, 2.9, 7.7, 5.7,9.232,2)                          SMPB0129
      CALL CIRCLE( 9.0, 6.5, 0.0,DUM,1.0,-6)                            SMPB0130
      CALL NEWPEN(4)                                                    SMPB0131
      CALL TLRNCE(6,7)                                                  SMPB0132
      CALL CIRCLE( 1.8, 1.9, 7.6, 3.5, 9.30, 2)                         SMPB0133
      CALL CIRCLE( 9.0, 4.0, 0.0,DUM,1.0,-6)                            SMPB0134
      CALL NEWPEN(1)                                                    SMPB0135
      CALL TLRNCE(9,9)                                                  SMPB0136
      CALL CIRCLE( 1.5, 1.5, 7.5, 1.5, 8.66, 2)                         SMPB0137
      CALL CIRCLE( 9.0, 1.5, 0.0,DUM,1.0,-6)                            SMPB0138
      CALL DASHS(DUMM,1000)                                             SMPB0139
      CALL TLRNCE(4,5)                                                  SMPB0140
      CALL SETCHR(.25,1.0,0.0,0.0,-999.0)                               SMPB0141
      CALL SYMBOL(10.5,10.,1.,ISTR5,INTEQ,-90.0,37)                     SMPB0142
      RETURN                                                            SMPB0143
      END                                                               SMPB0144
      SUBROUTINE CUBE                                                   SMPB0145
C *** CUBE PLOT SHOWING DASHED LINES                                    SMPB0146
      DIMENSION D1(2),D2(2),DUMM(2),XARR(24),YARR(24),IARR(24)          SMPB0147
      DIMENSION XLIN(24),YLIN(24),ILIN(24)                              SMPB0148
      CHARACTER *11 CHR1                                                SMPB0149
      CHARACTER * 5 CHR2                                                SMPB0150
      CHARACTER * 5 CHR3                                                SMPB0151
      CHARACTER *10 CHR4                                                SMPB0152
      CHARACTER *13 CHR5                                                SMPB0153
      CHARACTER * 9 CHR6                                                SMPB0154
      CHARACTER *12 CHR7                                                SMPB0155
      CHARACTER * 8 CHR8                                                SMPB0156
      CHARACTER * 5 CHR9                                                SMPB0157
      CHARACTER * 6 CHR10                                               SMPB0158
      CHARACTER * 5 CHR11                                               SMPB0159
      DATA DUM,DUMM,D1,D2 /0.,0.,0.,-0.05,0.05,-0.1,0.1/                SMPB0160
      DATA XARR/8.2,8.4,8.2,8.4,5.4,5.6,5.4,5.6,5.1,5.0,4.9,5.0,        SMPB0161
     1  5.0, 5.1, 5.0, 4.9, 5.5, 5.4, 5.5, 5.4, 6.9, 6.8, 6.9, 6.8/     SMPB0162
      DATA YARR/19.5,19.4,19.3,19.4,19.4,19.5,19.4,19.3,18.8,19.0,18.8, SMPB0163
     1 19.0,16.0,16.2,16.0,16.2,15.6,15.6,15.4,15.6,14.1,14.1,14.1,14.3/SMPB0164
      DATA IARR/3,2,2,3,2,3,2,2,3,2,2,3,2,3,2,2,3,2,2,3,2,3,2,2/        SMPB0165
      DATA XLIN/8.4,8.4,5.4,5.4, 5.2, 4.8, 4.8, 4.8, 5.4, 5.4, 6.9, 6.9,SMPB0166
     1  5.4, 5.4, 6.9, 9.9, 9.9, 8.4, 5.4, 8.4, 8.4, 9.9, 8.4, 5.4/     SMPB0167
      DATA YLIN/19.6,19.2,19.6,19.2,19.0,19.0,16.0,16.0,15.8,15.4,14.3, SMPB0168
     1 13.9,19.0,16.0,14.5,14.5,17.5,19.0,19.0,19.0,16.,14.5,16.0,16.0/ SMPB0169
      DATA ILIN/3,2,3,2,3,2,3,2,3,2,3,2,3,2,2,2,2,2,2,3,2,2,3,2/        SMPB0170
      CHR1='LINE STYLES'                                                SMPB0171
      CHR2='SOLID'                                                      SMPB0172
      CHR3='WIDTH'                                                      SMPB0173
      CHR4='FIXED DASH'                                                 SMPB0174
      CHR5='ADAPTIVE DASH'                                              SMPB0175
      CHR6='FIXED/DOT'                                                  SMPB0176
      CHR7='ADAPTIVE/DOT'                                               SMPB0177
      CHR8='ADAPTIVE'                                                   SMPB0178
      CHR9='FIXED'                                                      SMPB0179
      CHR10='HEIGHT'                                                    SMPB0180
      CHR11='DEPTH'                                                     SMPB0181
C                                                                       SMPB0182
      CALL TLRNCE(6,4)                                                  SMPB0183
      CALL SYMBOL(10.50,19.50,1.0,CHR1,INTEQ,-90.0,11)                  SMPB0184
      CALL SETCHR(0.2,1.0,0.0,0.0,-999.0)                               SMPB0185
      CALL SYMBOL( 9.7,14.0,1.0,CHR2,INTEQ,-90.0,5)                     SMPB0186
      CALL SYMBOL( 5.1,18.0,1.0,CHR3,INTEQ,-90.0,5)                     SMPB0187
      CALL NEWPEN(2)                                                    SMPB0188
      CALL SYMBOL( 9.2,14.0,1.0,CHR4,INTEQ,-90.0,10)                    SMPB0189
      CALL NEWPEN(3)                                                    SMPB0190
      CALL SYMBOL( 8.7,14.0,1.0,CHR5,INTEQ,-90.0,13)                    SMPB0191
      CALL NEWPEN(4)                                                    SMPB0192
      CALL SYMBOL( 8.2,14.0,1.0,CHR6,INTEQ,-90.0,9)                     SMPB0193
      CALL SYMBOL( 7.7,14.0,1.0,CHR7,INTEQ,-90.0,12)                    SMPB0194
      CALL NEWPEN(1)                                                    SMPB0195
C                                                                       SMPB0196
C *** DIMENSION ARROWS AND LINES                                        SMPB0197
      DO 100 I=1,24                                                     SMPB0198
      CALL PLOT(XARR(I),YARR(I),IARR(I))                                SMPB0199
 100  CONTINUE                                                          SMPB0200
      DO 200 I=1,24                                                     SMPB0201
      CALL PLOT(XLIN(I),YLIN(I),ILIN(I))                                SMPB0202
 200  CONTINUE                                                          SMPB0203
      CALL CIRCLE( 6.9,16.5, 6.9,17.5,DUM,-1)                           SMPB0204
      CALL DASHS(D2,2)                                                  SMPB0205
      CALL NEWPEN(2)                                                    SMPB0206
      CALL DASHS(DUMM,1001)                                             SMPB0207
      CALL PLOT( 6.9,17.5,3)                                            SMPB0208
      CALL PLOT( 6.9,14.5,2)                                            SMPB0209
      CALL CIRCLE( 8.4,15.0, 8.4,16.0,DUM,-1)                           SMPB0210
      CALL DASHS(D1,2)                                                  SMPB0211
C *** TUBE HIDDEN LINES AND LEFT HIDDEN EDGE                            SMPB0212
      CALL DASHS(DUMM,1001)                                             SMPB0213
      CALL PLOT( 6.1929,16.7929,3)                                      SMPB0214
      CALL PLOT( 7.6929,15.2929,2)                                      SMPB0215
      CALL PLOT( 7.6071,18.2071,3)                                      SMPB0216
      CALL PLOT( 9.1071,16.7071,2)                                      SMPB0217
      CALL PLOT( 5.4,19.0,3)                                            SMPB0218
      CALL PLOT( 6.9,17.5,2)                                            SMPB0219
      CALL NEWPEN(3)                                                    SMPB0220
      CALL DASHS(DUMM,1003)                                             SMPB0221
      CALL PLOT( 6.9,17.5,3)                                            SMPB0222
      CALL PLOT( 9.9,17.5,2)                                            SMPB0223
      CALL DASHS(DUMM,1000)                                             SMPB0224
C                                                                       SMPB0225
      CALL SETCHR(0.1,1.0,0.0,90.0,-999.0)                              SMPB0226
      CALL SYMBOL( 9.7,17.45,1.4,CHR8,INTEQ,-180.0,8)                   SMPB0227
      CALL NEWPEN(2)                                                    SMPB0228
      CALL SETCHR(0.1,1.0,0.0,0.0,-999.0)                               SMPB0229
      CALL SYMBOL( 6.95,15.1,1.0,CHR9,INTEQ,-90.0,5)                    SMPB0230
      CALL NEWPEN(1)                                                    SMPB0231
      CALL SETCHR(0.2,1.0,0.0,90.0,-999.0)                              SMPB0232
      CALL SYMBOL( 7.3,19.7,1.4,CHR10,INTEQ,-180.0,6)                   SMPB0233
      CALL SETCHR(0.1414,1.0,44.4,0.0,-999.0)                           SMPB0234
      CALL SYMBOL( 5.90,15.20,1.0,CHR11,INTEQ,-45.0,5)                  SMPB0235
      CALL SETCHR (1.,1.,0.,0.,0.)                                      SMPB0236
      RETURN                                                            SMPB0237
      END                                                               SMPB0238
      SUBROUTINE FTEN                                                   SMPB0239
C *** PLOT FONT 0 TO 9 IN TEN BOXES                                     SMPB0240
      DIMENSION XARRAY(10), YARRAY(10)                                  SMPB0241
      CHARACTER * 11 CH1                                                SMPB0242
      CHARACTER *  6 CH2                                                SMPB0243
      CHARACTER * 12 CH3                                                SMPB0244
      CHARACTER * 10 CH4                                                SMPB0245
      CHARACTER *  6 CH5                                                SMPB0246
      CHARACTER *  6 CH6                                                SMPB0247
      CHARACTER *  7 CH7                                                SMPB0248
      CHARACTER *  7 CH8                                                SMPB0249
      CHARACTER *  8 CH9                                                SMPB0250
      CHARACTER *  7 CH10                                               SMPB0251
      CHARACTER *  7 CH11                                               SMPB0252
      CHARACTER *  9 CH12                                               SMPB0253
      CHARACTER *  6 CH13                                               SMPB0254
      CHARACTER *  7 CH14                                               SMPB0255
      CHARACTER * 15 CH15                                               SMPB0256
      CHARACTER *  1 CDUM                                               SMPB0257
      DATA XARRAY /16.,16.,16.,16.,16.,12.5,12.5,12.5,12.5,12.5/        SMPB0258
      DATA YARRAY /19.5,15.5,11.5, 7.5,3.5,19.5,15.5,11.5, 7.5,3.5/     SMPB0259
      CH1 = '960 DEFAULT'                                               SMPB0260
      CH2 = 'GOTHIC'                                                    SMPB0261
      CH3 = 'ENGINEERING/'                                              SMPB0262
      CH4 = 'SCIENTIFIC'                                                SMPB0263
      CH5 = 'GERMAN'                                                    SMPB0264
      CH6 = 'FRENCH'                                                    SMPB0265
      CH7 = 'SPANISH'                                                   SMPB0266
      CH8 = 'ITALIAN'                                                   SMPB0267
      CH9 = 'FINNISH/'                                                  SMPB0268
      CH10= 'SWEDISH'                                                   SMPB0269
      CH11= 'DANISH/'                                                   SMPB0270
      CH12= 'NORWEGIAN'                                                 SMPB0271
      CH13= 'UNITED'                                                    SMPB0272
      CH14= 'KINGDOM'                                                   SMPB0273
      CH15= 'CHARACTER FONTS'                                           SMPB0274
      CDUM=' '                                                          SMPB0275
      CALL SETCHR(1.,1.,0.,0.,0.)                                       SMPB0276
      DO 100 K = 1,10                                                   SMPB0277
      FNT = FLOAT(K-1)                                                  SMPB0278
      CALL FONT (FNT)                                                   SMPB0279
C*** PRINT SYMBOLS ***                                                  SMPB0280
      XT=XARRAY(K)                                                      SMPB0281
      YT=YARRAY(K)                                                      SMPB0282
      L=1                                                               SMPB0283
      M=16                                                              SMPB0284
      X = XT+1.8                                                        SMPB0285
      Y = YT-.05                                                        SMPB0286
      DO 3 N=1,8                                                        SMPB0287
      DO 2 I=L,M                                                        SMPB0288
      J = I-1                                                           SMPB0289
      CALL SYMBOL (X,Y,.17,CDUM,J,-90.,-1)                              SMPB0290
      Y = Y-.18                                                         SMPB0291
   2  CONTINUE                                                          SMPB0292
      X = X-.25                                                         SMPB0293
      Y = YT-.05                                                        SMPB0294
      L = M+1                                                           SMPB0295
      M = M+16                                                          SMPB0296
   3  CONTINUE                                                          SMPB0297
C*** DRAW BORDER ***                                                    SMPB0298
      CALL PLOT (XT+2.1, YT-2.98, 3)                                    SMPB0299
      CALL PLOT (XT,YT-2.98,2)                                          SMPB0300
      CALL PLOT (XT,YT,2)                                               SMPB0301
      CALL PLOT (XT+2.1,YT,2)                                           SMPB0302
      CALL PLOT (XT+2.1, YT-2.98, 2)                                    SMPB0303
      CALL PLOT (XT,YT,3)                                               SMPB0304
      HGT = .2                                                          SMPB0305
      CALL FONT(1.)                                                     SMPB0306
      GO TO (5,10,20,30,40,50,60,70,80,90), K                           SMPB0307
C                                                                       SMPB0308
C*** FONT =  0 1  2  2  4  5  6  7  8  9   ***                          SMPB0309
    5 CALL SYMBOL(XARRAY(K)-.35,YARRAY(K)-.4,HGT,CH1,INTEQ,-90.,11)     SMPB0310
      GO TO 100                                                         SMPB0311
   10 CALL SYMBOL (XARRAY(K)-.35,YARRAY(K)-.89,HGT,CH2,INTEQ,-90.,6)    SMPB0312
      GO TO 100                                                         SMPB0313
   20 CALL SYMBOL (XARRAY(K)-.35,YARRAY(K),HGT,CH3,INTEQ,-90.,12)       SMPB0314
      CALL SYMBOL(XARRAY(K)-.65,YARRAY(K)-.98,HGT,CH4,INTEQ,-90.,10)    SMPB0315
      GO TO 100                                                         SMPB0316
   30 CALL SYMBOL (XARRAY(K)-.35,YARRAY(K)-.89,HGT,CH5,INTEQ,-90.,6)    SMPB0317
      GO TO 100                                                         SMPB0318
   40 CALL SYMBOL (XARRAY(K)-.35,YARRAY(K)-.89,HGT,CH6,INTEQ,-90.,6)    SMPB0319
      GO TO 100                                                         SMPB0320
   50 CALL SYMBOL (XARRAY(K)-.35,YARRAY(K)-.79, HGT,CH7,INTEQ,-90.,7)   SMPB0321
      GO TO 100                                                         SMPB0322
   60 CALL SYMBOL (XARRAY(K)-.35,YARRAY(K)-.79, HGT,CH8,INTEQ,-90.,7)   SMPB0323
      GO TO 100                                                         SMPB0324
   70 CALL SYMBOL (XARRAY(K)-.35,YARRAY(K)-.4,HGT,CH9,INTEQ,-90.,8)     SMPB0325
      CALL SYMBOL (XARRAY(K)-.65,YARRAY(K)-1.18,HGT,CH10,INTEQ,-90.,7)  SMPB0326
      GO TO 100                                                         SMPB0327
   80 CALL SYMBOL (XARRAY(K)-.35,YARRAY(K)-.4,HGT,CH11,INTEQ,-90.,7)    SMPB0328
      CALL SYMBOL (XARRAY(K)-.65,YARRAY(K)-.78, HGT,CH12,INTEQ,-90.,9)  SMPB0329
      GO TO 100                                                         SMPB0330
   90 CALL SYMBOL (XARRAY(K)-.35,YARRAY(K)-.89,HGT,CH13,INTEQ,-90.,6)   SMPB0331
      CALL SYMBOL (XARRAY(K)-.65,YARRAY(K)-.79, HGT,CH14,INTEQ,-90.,7)  SMPB0332
  100 CONTINUE                                                          SMPB0333
      CALL SYMBOL (18.5,12.25,.30,CH15,INTEQ,-90.,15)                   SMPB0334
      RETURN                                                            SMPB0335
      END                                                               SMPB0336
      SUBROUTINE LINE (XARRAY,YARRAY,NPTS,INC,LINTYP,INTEQ)             LINE0001
C...SUBROUTINE LINE                            LIBRARY NUMBER ZBPCC506  LINE0002
CALCOMP HCBS FOR  IPE ON/OFFLINE F-77 METRIC   VERAB         FEB, 1984  LINE0003
C                                                                       LINE0004
C.....     XARRAY  NAME OF ARRAY CONTAINING ABSCISSA OR X VALUES.       LINE0005
C.....     YARRAY  NAME OF ARRAY CONTAINING ORDINATE OR Y VALUES.       LINE0006
C.....     NPTS    NUMBER OF POINTS TO BE PLOTTED.                      LINE0007
C.....     INC     INCREMENT OF LOCATION OF SUCCESSIVE POINTS.          LINE0008
C.....     LINTYP  CONTROL TYPE OF LINE--SYMBOLS, LINE, OR COMBINATION. LINE0009
C.....     INTEQ   INTEGER EQUIVALENT OF SYMBOL TO BE USED, IF ANY.     LINE0010
C                                                                       LINE0011
      DIMENSION XARRAY(*),YARRAY(*)                                     LINE0012
      CHARACTER * 1 IBCD                                                LINE0013
      DATA XFONT /0.0/                                                  LINE0014
C***********************************************************************LINE0015
C***********************************************************************LINE0016
      LMIN = NPTS*INC+1                                                 LINE0017
      LDX  = LMIN+INC                                                   LINE0018
      NL   = LMIN-INC                                                   LINE0019
      FIRSTX = XARRAY(LMIN)                                             LINE0020
      DELTAX = XARRAY(LDX)                                              LINE0021
      FIRSTY = YARRAY(LMIN)                                             LINE0022
      DELTAY = YARRAY(LDX)                                              LINE0023
      CALL WHERE (XN,YN,DF)                                             LINE0024
      DF=AMAX1(ABS((XARRAY( 1)-FIRSTX)/DELTAX-XN),                      LINE0025
     1         ABS((YARRAY( 1)-FIRSTY)/DELTAY-YN) )                     LINE0026
      DL=AMAX1(ABS((XARRAY(NL)-FIRSTX)/DELTAX-XN),                      LINE0027
     1         ABS((YARRAY(NL)-FIRSTY)/DELTAY-YN) )                     LINE0028
      IPEN = 3                                                          LINE0029
      ICODE = -1                                                        LINE0030
      NT =IABS(LINTYP)                                                  LINE0031
      IF (LINTYP) 7,6,7                                                 LINE0032
    6 NT = 1                                                            LINE0033
    7 IF (DF-DL) 9,9,8                                                  LINE0034
    8 NF = NL                                                           LINE0035
      NA = ((NPTS-1)/NT)*NT+NT-(NPTS-1)                                 LINE0036
      KK = -INC                                                         LINE0037
      GO TO 10                                                          LINE0038
    9 NF = 1                                                            LINE0039
      NA = NT                                                           LINE0040
      KK = INC                                                          LINE0041
   10 IF (LINTYP) 11,12,13                                              LINE0042
   11 IPENA = 3                                                         LINE0043
      ICODEA = -1                                                       LINE0044
      LSW = 1                                                           LINE0045
      GO TO 15                                                          LINE0046
   12 NA=LDX                                                            LINE0047
   13 IPENA = 2                                                         LINE0048
      ICODEA = -2                                                       LINE0049
      LSW=0                                                             LINE0050
   15 DO 30 I =1,NPTS                                                   LINE0051
      XN = (XARRAY(NF)-FIRSTX)/DELTAX                                   LINE0052
      YN = (YARRAY(NF)-FIRSTY)/DELTAY                                   LINE0053
      IF (NA-NT) 20,21,22                                               LINE0054
   20 IF (LSW) 23,22,23                                                 LINE0055
C***********************************************************************LINE0056
C***********************************************************************LINE0057
C THIS PORTION OF PROGRAM FOR IPE PLOTTER                               LINE0058
   21 XFONT=99.0                                                        LINE0059
      CALL FONT(XFONT)                                                  LINE0060
      IF (XFONT.EQ.-999.) GO TO 220                                     LINE0061
      CALL FONT(-999.)                                                  LINE0062
      CALL SYMBOL (XN,YN,0.20,IBCD,INTEQ,0.0,ICODE)                     LINE0063
C RESET FONT BEING USED                                                 LINE0064
      CALL FONT(XFONT)                                                  LINE0065
      GO TO 230                                                         LINE0066
220   CALL SYMBOL (XN,YN,0.20,IBCD,INTEQ,0.0,ICODE)                     LINE0067
230   NA = 1                                                            LINE0068
      GO TO 25                                                          LINE0069
C***********************************************************************LINE0070
C***********************************************************************LINE0071
   22 CALL PLOT (XN,YN,IPEN)                                            LINE0072
   23 NA = NA + 1                                                       LINE0073
   25 NF = NF+KK                                                        LINE0074
      ICODE = ICODEA                                                    LINE0075
   30 IPEN = IPENA                                                      LINE0076
      RETURN                                                            LINE0077
      END                                                               LINE0078
      SUBROUTINE DASHS(ARRAY,ICTR)                                      00000010
C...SUBROUTINE DASHS                           LIBRARY NUMBER ZBPCM503  00000020
CALCOMP HCBS FOR  IPE ONLINE F-77 MI           VERAB         FEB, 1984  00000030
C                                                                       00000040
C    ARRAY - ARRAY OF FLOATING POINT VALUES WHICH DEFINE THE            00000050
C            PATTERN FOR THE DASHLINE                                   00000060
C                                                                       00000070
C    ICTR  -    -998    SPECIAL CALL FROM PLOT TO SET STEP SIZE         00000080
C               -999    SPECIAL CALL FROM PLOT TO RE-XMIT ARRAY         00000090
C            +2 TO +16  COUNT OF ELEMENTS IN ARRAY                      00000100
C            -2 TO -16  RETURN LAST ELEMENTS STORED                     00000110
C                0      TURN OFF DASHLINE MODE                          00000120
C               +1      RETURN TO DASHLINE MODE                         00000130
C                                                                       00000140
C               1000    TURN OFF DASHLINE MODE                          00000150
C               1001    TURN ON DASHLINE MODE                           00000160
C               1003    TURN ON ADAPTIVE MODE                           00000170
C               1005    TURN ON FIXED DOT MODE                          00000180
C               1007    TURN ON ADAPTIVE DOT MODE                       00000190
C                                                                       00000200
      SAVE                                                              00000210
      CHARACTER * 1 IBCD                                                00000220
      DIMENSION ARRAY(1),SARRAY(16)                                     00000230
C     COMMON /CDASH/  DPX  ,LSTCNT,SARRAY,STEPS,SCL,IDFLAG,NMODE        00000240
      DATA  DPX/32767.0/, LSTCNT/2/, IDFLAG/1/,NMODE/0/                 00000250
      DATA SARRAY/-0.1,0.1, 14*0.0/                                     00000260
C                                                                       00000270
C           SAVE INPUT ICTR                                             00000280
      ICNT = ICTR                                                       00000290
      IF (ICNT) 500,100,200                                             00000300
C            TURN OFF DASHLINE MODE                                     00000310
 100  CALL BUFF(2,0,6,IBCD)                                             00000320
      CALL BUFF(13,1,0,IBCD)                                            00000330
      CALL BUFF(1,1,0,IBCD)                                             00000340
      IDFLAG = 1                                                        00000350
      GO TO 900                                                         00000360
C                                                                       00000370
 200  IF (ICNT-1) 900,300,350                                           00000380
C            RETURN TO DASHLINE MODE                                    00000390
 300  CALL BUFF(2,0,6,IBCD)                                             00000400
      CALL BUFF(13,1,0,IBCD)                                            00000410
      CALL BUFF(0,1,0,IBCD)                                             00000420
      IDFLAG = 0                                                        00000430
      GO TO 900                                                         00000440
 350  IF(ICNT-16) 400,400,375                                           00000450
 375  NMODE = ICNT-1000                                                 00000460
      CALL BUFF( 3,0,6,IBCD)                                            00000470
      CALL BUFF(11,1,0,IBCD)                                            00000480
      CALL BUFF(8,1,0,IBCD)                                             00000490
      CALL BUFF(NMODE,1,0,IBCD)                                         00000500
C RESET IDFLAG FOR LATER USE                                            00000510
      IDFLAG = NMODE + 1000                                             00000520
      GO TO 900                                                         00000530
C            DEFINE DASHLINE PATTERN                                    00000540
 400  IF (ICNT-16) 420,420,900                                          00000550
C410  ICNT=16                                                           00000560
 420  ILIM=2+7*((ICNT+1)/2)                                             00000570
      IDFLAG = 0                                                        00000580
      CALL BUFF(ILIM,0,6,IBCD)                                          00000590
      CALL BUFF(13,1,0,IBCD)                                            00000600
      CALL BUFF(ICNT,1,0,IBCD)                                          00000610
      CALL PLOT (STEPS,SCL,1005)                                        00000620
      IF (SCL - 1.0) 421,422,422                                        00000630
 421  SCL = 1.0                                                         00000640
C            SAVE ARRAY AND ICNT                                        00000650
 422  LSTCNT=ICNT                                                       00000660
      DO 425 I=1,ICNT                                                   00000670
 425  SARRAY(I)=ARRAY(I)                                                00000680
      JCNT=ICNT+1                                                       00000690
      IF (JCNT-16) 428, 428, 430                                        00000700
 428  DO 429 I=JCNT,16                                                  00000710
 429  SARRAY(I)=0.0                                                     00000720
C            THE SEGMENT DELTAS ARE IN THE STANDARD 906 DELTA FORMAT    00000730
 430  DO 440 I=1,ICNT,2                                                 00000740
         DX=ARRAY(I)*(STEPS*SCL)                                        00000750
         IF (ABS(DX).LE.DPX) GO TO 432                                  00000760
         DX=SIGN(DPX,DX)                                                00000770
         SARRAY(I)=DX/(STEPS*SCL)                                       00000780
 432     IF (I-ICNT) 435,434,434                                        00000790
 434     DY=0.0                                                         00000800
         GO TO 440                                                      00000810
 435     DY=ARRAY(I+1)*(STEPS*SCL)                                      00000820
         IF (ABS(DY).LE.DPX) GO TO 438                                  00000830
         DY=SIGN(DPX,DY)                                                00000840
         SARRAY(I+1)=DY/(STEPS*SCL)                                     00000850
 438     DX = DX/SCL                                                    00000860
         DY = DY/SCL                                                    00000870
         IF (ABS(DX) .LT. 1.0) DX = SIGN(1.0,DX)                        00000880
         IF (ABS(DY) .LT. 1.0) DY = SIGN(1.0,DY)                        00000890
         IDX    =DX + SIGN(0.5,DX)                                      00000900
         IDY    =DY + SIGN(0.5,DY)                                      00000910
 440     CALL BUFF(IDX,IDY,2,IBCD)                                      00000920
      GO TO 900                                                         00000930
C              RETURN THE VALUES IN ARRAY TO THE USER                   00000940
 500  IF (ICNT+999) 501,800,501                                         00000950
 501  IF (ICNT+998) 502,850,502                                         00000960
 502  JCNT=IABS(ICNT)                                                   00000970
      IF (JCNT-1) 900, 900, 510                                         00000980
 510  IF (JCNT-16) 520, 520, 515                                        00000990
 515  JCNT=16                                                           00001000
 520  DO 530 I=1,JCNT                                                   00001010
 530  ARRAY(I)=SARRAY(I)                                                00001020
      JCNT=JCNT+1                                                       00001030
      IF (JCNT-16) 540, 540, 560                                        00001040
 540  DO 550 I=JCNT,16                                                  00001050
 550  ARRAY(I)=0.0                                                      00001060
 560  ARRAY(JCNT)=LSTCNT                                                00001070
      GO TO 900                                                         00001080
C  SEND DASHLINE ARRAY INFO                                             00001090
  800 CALL BUFF (ILIM,0,6,IBCD)                                         00001100
      CALL BUFF (13,1,0,IBCD)                                           00001110
      CALL BUFF (LSTCNT,1,0,IBCD)                                       00001120
      DO 810 I = 1,LSTCNT,2                                             00001130
      IDX = SARRAY(I)*STEPS                                             00001140
      IDY = SARRAY(I+1)*STEPS                                           00001150
      IF (IDX .EQ. 0) IDX = ISIGN(1,IDX)                                00001160
      IF (IDY .EQ. 0) IDY = ISIGN(1,IDY)                                00001170
      CALL BUFF (IDX,IDY,2,IBCD)                                        00001180
  810 CONTINUE                                                          00001190
      IF(IDFLAG.GE.1000) GO TO 830                                      00001200
C  TURN DASHLINE ON OR OFF                                              00001210
      CALL BUFF (2,0,6,IBCD)                                            00001220
      CALL BUFF (13,1,0,IBCD)                                           00001230
      CALL BUFF (IDFLAG,1,0,IBCD)                                       00001240
      GO TO 900                                                         00001250
 830  CALL BUFF( 3,0,6,IBCD)                                            00001260
      CALL BUFF(11,1,0,IBCD)                                            00001270
      CALL BUFF(8,1,0,IBCD)                                             00001280
      CALL BUFF(NMODE,1,0,IBCD)                                         00001290
      GO TO 900                                                         00001300
C  THIS SETS THE STEP SIZE FROM PLOTS AND FACTOR, CALLED BY PLOT.       00001310
  850 STEPS = ARRAY(1)                                                  00001320
C              RETURN TO THE USER                                       00001330
 900  RETURN                                                            00001340
      END                                                               00001350
      SUBROUTINE SETCHR(CHRHGT,ASPRTO,SLANG,CHRANG,SETMDE)              00000010
CALCOMP SETCHR SUBROUTINE                                    ZBPDA001   00000020
CALCOMP HCBS FOR 907 AND 951 CONTROLLERS (PCI) F-IV & F-77  DEC, 1983   00000030
C..CHRHGT HEIGHT OF CHARACTER                                           00000040
C..ASPECT RATIO                                                         00000050
C..SLANG SLANT ANGLE RELATIVE TO CHARACTER STRING ROTATION              00000060
C..CHRANG  CHARACTER ANGLE IN RELATION TO CHARACTER PATH ANGLE OF       00000070
C..        ROTATION. 90 DEGREES NORMAL                                  00000080
C..SETMDE SET CHARACTER ALTERATION MODE                                 00000090
C..0 RE-INITIALIZE TO DEFAULT PARAMETERS                                00000100
C..-999. MODICATION TO PARAMETERS                                       00000110
C SET DEFAULT VALUES                                                    00000120
C     COMMON /STCR/ HTINT,ASPINT,SLAINT,ROTINT,STMINT,HTVAL,ASPECT,     00000130
C    1TALICS,CRANG,SMODE,HTTEMP,ASPTMP,SLTEMP,ANGTMP                    00000140
      DATA HTINT /0.  /,ASPINT/16.0/,SLAINT/0.0/,ROTINT/0.0/            00000150
      DATA STMINT /0.0/                                                 00000160
C SAVE VARIABLES BEING USED                                             00000170
      DATA HTVAL/0.0/, ASPECT/16.0/,TALICS/0.0/,CRANG /0.0 /            00000180
      DATA SMODE/0.0 /                                                  00000190
      DATA HTTEMP,ASPTMP,SLTEMP,ANGTMP/4*0./                            00000200
C SAVE INPUT VALUES                                                     00000210
      IF (SETMDE.NE.99.0) GO TO 1                                       00000220
      SETMDE = SMODE                                                    00000230
      GO TO 999                                                         00000240
  1   CONTINUE                                                          00000250
      HTTEMP = CHRHGT                                                   00000260
      ASPTMP = ASPRTO                                                   00000270
      SLTEMP = SLANG                                                    00000280
      ANGTMP = CHRANG                                                   00000290
      IF (SETMDE.EQ.1000.)GO TO 4                                       00000300
      SMODE = SETMDE                                                    00000310
C CHECK FOR MODE                                                        00000320
  4   CONTINUE                                                          00000330
      IF (SETMDE) 5,50,40                                               00000340
C SET MODE FLAG                                                         00000350
  5   IF (HTTEMP) 10,999,18                                             00000360
 10   XFACT = ABS(HTTEMP)                                               00000370
      HTVAL = XFACT * HTVAL                                             00000380
      GO TO 19                                                          00000390
 18   IF(HTTEMP.EQ.999.) GO TO 19                                       00000400
      HTVAL = HTTEMP                                                    00000410
 19   IF (ASPTMP.EQ.999.) GO TO 28                                      00000420
      IF (ASPTMP) 25,20,25                                              00000430
 20   ASPTMP = 1.0                                                      00000440
 25   ASPECT = ASPTMP * 16.                                             00000450
      ASPECT = ASPECT + SIGN(.005,ASPECT)                               00000460
 28   IF (SLTEMP.EQ.999.) GO TO 38                                      00000470
      IF (SLTEMP.EQ. 0.)  GO TO 32                                      00000480
C CALCULATE SLANT RATIO                                                 00000490
C CALCULATE CHARACTER WIDTH                                             00000500
CHECK FOR ANGLE > +/- 45 DEGREES.                                       00000510
      IF(ABS(SLTEMP).LT.44.5) GO TO 29                                  00000520
C SET MAXIMUM ANGLE                                                     00000530
      IF(SLTEMP) 280,290,290                                            00000540
 280  SLTEMP = -44.5                                                    00000550
      GO TO 29                                                          00000560
 290  SLTEMP = 44.5                                                     00000570
29    ANG = SLTEMP*0.017453                                             00000580
      YSIN = SIN(ANG)                                                   00000590
      XCOS = COS(ANG)                                                   00000600
      XTLVAL =XCOS * HTVAL                                              00000610
      YTLVAL =YSIN * HTVAL                                              00000620
      TALICS = YTLVAL/XTLVAL                                            00000630
      GO TO 35                                                          00000640
 32   TALICS = 0.0                                                      00000650
C  SAVE ASPECT RATIO AND ITALIC RATIO                                   00000660
 35   TALICS = TALICS * 128.                                            00000670
C  SAVE  CHARACTER ANGLE                                                00000680
 38   IF(ANGTMP.EQ.999.) GO TO 999                                      00000690
      CRANG = ANGTMP                                                    00000700
      GO TO 999                                                         00000710
C VARIABLES TO BE USED BY SYMBOL                                        00000720
 40   CHRHGT = HTVAL                                                    00000730
      ASPRTO = ASPECT                                                   00000740
      SLANG  = TALICS                                                   00000750
      CHRANG = CRANG                                                    00000760
C     SETMDE = SMODE                                                    00000770
      GO TO 999                                                         00000780
C RE-INITIALIZE PARAMETERS                                              00000790
C SAVE MODE FLAG                                                        00000800
 50   CONTINUE                                                          00000810
      HTVAL =  HTINT                                                    00000820
      ASPECT= ASPINT                                                    00000830
      TALICS= SLAINT                                                    00000840
      CRANG = ROTINT                                                    00000850
      SMODE = STMINT                                                    00000860
 999  RETURN                                                            00000870
      END                                                               00000880
      SUBROUTINE SYMBOL(XPAGE,YPAGE,SSPACE,IBCD,INTEQ,ANGLE,NCHAR)      00000010
CALCOMP SYMBOL SUBROUTINE                                   ZBPCE506    00000020
CALCOMP HCBS FOR 907 AND 951 CONTROLLERS (PCI) F-77        DEC, 1983    00000030
      SAVE                                                              00000040
      CHARACTER * (*) IBCD                                              00000050
C     COMMON /CSYMB/ FCTMX,XP,YP,ICENT,IMIN,ICTRSY,IASCII,IOXA,IOYA,    00000060
C    1PX,PY,STEPS,SCL,YFONT,SETMD,CHRSPC,SINTH,COSTH,ICHRSP,IPFL,       00000070
C    2CHRHGT,ASPECT,TALICS,CRANG,OLDANG                                 00000080
      DATA FCTMX/16383.0/                                               00000090
      DATA XP,YP/2*0.0/                                                 00000100
      DATA ICENT/16/,IMIN/1000/,ICTRSY/288/,IASCII/95/                  00000110
      DATA STEPS/0.0/,YFONT/-999./, SETMD/0./,CHRSPC/1.0/               00000120
      DATA SINTH,COSTH/2*0.0/                                           00000130
      DATA NOFDEL /0/,ICHRSP/16/,IPFL/0/                                00000140
      DATA CHRHGT /0.0/,ASPECT/1.0/,TALICS,CRANG/2*0.0/,OLDANG/0./      00000150
C GET MODE FLAG                                                         00000160
      FNTFG = 99.                                                       00000170
      CALL FONT (FNTFG)                                                 00000180
      YFONT = FNTFG                                                     00000190
      SETFLG = 99.                                                      00000200
      CALL SETCHR(HGT,ASP,TAL,ANG,SETFLG)                               00000210
C SAVE FLAG                                                             00000220
      SETMD = SETFLG                                                    00000230
      IF(YFONT.EQ.-999.) GO TO 3                                        00000240
      IF(SETMD.NE.-999.) GO TO 3                                        00000250
C     CALL PLOT(FLAG1,FLAG2,1008)                                       00000260
C     IF (IFLAG1.NE.0) GO TO 690                                        00000270
C GET SET CHARACTER PARAMETERS                                          00000280
      CALL SETCHR(HGT,ASP,TAL,ANG,1000.)                                00000290
C CHECK FOR WHETHER TO SEND PARAMETERS AGAIN                            00000300
      IF(OLDANG.NE.ANGLE) GO TO 45                                      00000310
      IF(SSPACE.NE.CHRSPC) GO TO 45                                     00000320
      IF(HGT.NE.HEIGH) GO TO 45                                         00000330
      IF(ASP.NE.ASPECT) GO TO 45                                        00000340
      IF(TAL.NE.TALICS) GO TO 45                                        00000350
      IF(ANG.NE.CRANG) GO TO 45                                         00000360
C ALL PARAMETERS ARE THE SAME                                           00000370
      IPFL = 1                                                          00000380
      GO TO  4                                                          00000390
C HEIGH ARGUMENT IN SYMBOL BECOMES CHARACTER SPACE VARIABLE             00000400
  45  CHRSPC= SSPACE                                                    00000410
      HEIGH  = HGT                                                      00000420
      ASPECT = ASP                                                      00000430
      TALICS = TAL                                                      00000440
      CRANG  = ANG                                                      00000450
      OLDANG = ANGLE                                                    00000460
      GO TO 4                                                           00000470
   3  HEIGH = SSPACE                                                    00000480
   4  IF(HEIGH ) 5,999,5                                                00000490
    5 IPEN=3                                                            00000500
      NT=NCHAR                                                          00000510
      NC=1                                                              00000520
      XO=XPAGE                                                          00000530
      IF(ABS(XO-999.0)-0.1)10,20,20                                     00000540
   10 XO=XP                                                             00000550
   20 YO=YPAGE                                                          00000560
      IF(ABS(YO-999.0)-0.1)50,60,60                                     00000570
   50 YO=YP                                                             00000580
   60 TH=ANGLE*0.017453                                                 00000590
      SINTH=SIN(TH )                                                    00000600
      COSTH=COS(TH )                                                    00000610
C GET CHARACTER MODE                                                    00000620
      IF(YFONT.EQ.-999.) GO TO 700                                      00000630
      IF( SETMD.NE.-999.) GO TO 700                                     00000640
      IF(IPFL.EQ.0) GO TO 620                                           00000650
      IPFL = 0                                                          00000660
      GO TO 70                                                          00000670
C GET STEPSIZE FOR PLOTTER                                              00000680
 620  CALL PLOT(STEPS,SCL,1005)                                         00000690
C CALCULATE HEIGHT                                                      00000700
      CHRHT = HEIGH * STEPS                                             00000710
      ICHRHT = CHRHT                                                    00000720
C CALCULATE CHARACTER ANGLE                                             00000730
      XANGLE = COSTH * 32767.                                           00000740
 625  IXANG = XANGLE                                                    00000750
      YANGLE = SINTH * 32767.                                           00000760
 628  IYANG  = YANGLE                                                   00000770
      IASPEC = ASPECT + SIGN(.5,ASPECT)                                 00000780
      ITALIC = TALICS + SIGN(.5,TALICS)                                 00000790
      CHRSP  = CHRSPC * 16.                                             00000800
      ICHRSP = CHRSP      + SIGN(.5,CHRSP )                             00000810
      ICHANG = MOD(IFIX(CRANG),360)                                     00000820
C *** UPDATE FOR NEGATIVE ANGLES - DEC, 1983                            00000830
      IF (ICHANG.LT.0) ICHANG = 360 + ICHANG                            00000840
      IF (ITALIC .NE. 0) GO TO 680                                      00000850
      IF (ICHRSP .NE. 0) GO TO 680                                      00000860
      NOFDEL = 0                                                        00000870
      NCX = 999                                                         00000880
      GO TO 690                                                         00000890
 680  NOFDEL = 1                                                        00000900
      NCX = 0                                                           00000910
 690  CALL BUFF(20,0,6,IBCD)                                            00000920
      CALL BUFF(11,1,0,IBCD)                                            00000930
      CALL BUFF(5,1,0,IBCD)                                             00000940
C OUTPUT PARAMETERS                                                     00000950
      CALL BUFF(14+NOFDEL,1,0,IBCD)                                     00000960
C OUTPUT HEIGHT                                                         00000970
      CALL BUFF (0,ICHRHT,2,IBCD)                                       00000980
C OUTPUT ANGLE INFORMATION                                              00000990
      CALL BUFF (IXANG,IYANG,2,IBCD)                                    00001000
C OUTPUT ROTATIONAL ANGLE AND ASPECT RATIO                              00001010
      CALL BUFF (ICHANG,IASPEC,2,IBCD)                                  00001020
      IF (NOFDEL .EQ. 0) GO TO 70                                       00001030
C OUTPUT ITALICS AND INTER CHARACTER SPACING                            00001040
      CALL BUFF (ITALIC,ICHRSP,2,IBCD)                                  00001050
C CHECK FOR WHICH FONT TO USE                                           00001060
      GO TO 70                                                          00001070
C OUTPUT FOR CODE FOR 907 SYMBOL                                        00001080
 700  IF(NT) 61,80,70                                                   00001090
  61  IF(NT+1) 62,63,63                                                 00001100
  62  IPEN=2                                                            00001110
C                 SPECIAL (-1) SYMBOL CALL                              00001120
C *** UPDATE FOR SOFTWARE BULLETIN 83-001                               00001130
  63  IF (YFONT.EQ.-999.) GO TO 630                                     00001140
      K = INTEQ                                                         00001150
      XNC = 1.0                                                         00001160
      GO TO 85                                                          00001170
  630 K = INTEQ - ICENT                                                 00001180
      XNC = 1.0                                                         00001190
      IF ( K ) 66,85,64                                                 00001200
  64  IF (K-ICTRSY+ICENT) 85, 65, 65                                    00001210
C                 USER-DEFINED SYMBOLS ARE CENTERED SYMBOLS             00001220
  65  K = K + ICENT                                                     00001230
      XNC = 0.0                                                         00001240
      GO TO 85                                                          00001250
  66  K = K + ICTRSY                                                    00001260
      XNC = 0.0                                                         00001270
      GO TO 85                                                          00001280
   70 NC=MOD(NT,1000)                                                   00001290
      IF (NCX .NE. 999) GO TO 80                                        00001300
      XNC = 1.                                                          00001310
      GO TO 85                                                          00001320
   80 XNC=NC                                                            00001330
C                                                                       00001340
   85 CALL PLOT(XO,YO,IPEN)                                             00001350
   87 CALL PLOT(STEPS,SCL,1005)                                         00001360
      IF (SCL.LT.1.0) SCL = 1.0                                         00001370
      ISCL = SCL                                                        00001380
      FCT=HEIGH*STEPS                                                   00001390
      FCTMXX = FLOAT ( IFIX ( FCTMX/SCL ) )                             00001400
      IF(FCT-FCTMXX)100,100,90                                          00001410
   90 FCT=FCTMXX                                                        00001420
  100 IF(YFONT.EQ.-999.) GO TO 1100                                     00001430
      IF(SETMD.EQ. 0.)   GO TO 1100                                     00001440
      ISIN = SINTH * 32767.                                             00001450
      ICOS = COSTH * 32767.                                             00001460
      IFCT = FCT
      IHT  = FLOAT(IFCT) * FLOAT(ICHRSP)/16.                            00001470
      IXA = FLOAT(ICOS)*FLOAT(IHT)/32768.                               00001480
      IYA = FLOAT(ISIN)*FLOAT(IHT)/32768.                               00001490
      GO TO 115                                                         00001500
 1100 XA=FCT*COSTH                                                      00001510
      YA=FCT*SINTH                                                      00001520
      IXA=XA+SIGN(0.5,XA)                                               00001530
      IYA=YA+SIGN(0.5,YA)                                               00001540
      IF(YFONT.NE.-999.) GO TO 105                                      00001550
      IADD = 0                                                          00001560
      IF (IXA.GT.0) IADD = 14                                           00001570
      IXA = IXA + (IXA + IADD)/15                                       00001580
      IADD = 0                                                          00001590
      IF (IYA.GT.0) IADD = 14                                           00001600
      IYA = IYA + (IYA + IADD)/15                                       00001610
C          CHECK IF NEED TO SEND SIZE INFORMATION                       00001620
C     CALL PLOT(FLAG1,FLAG2,1008)                                       00001630
C     IF (IFLAG1.NE.0) GO TO 107                                        00001640
  101 IF (IXA-IOXA) 107,102,107                                         00001650
  102 IF (IYA-IOYA) 107,108,107                                         00001660
C FONT SELECTED NO CHARACTER MODIFICATIONS                              00001670
C 105 CALL PLOT(FLAG1,FLAG2,1008)                                       00001680
C     IF (IFLAG1.NE.0) GO TO 205                                        00001690
  105 IF (IXA-IOXA1) 205,200,205                                        00001700
  200 IF (IYA-IOYA1) 205,115,205                                        00001710
  205 CALL BUFF(10,0,6,IBCD)                                            00001720
      CALL BUFF(11,1,0,IBCD)                                            00001730
      CALL BUFF(7,1,0,IBCD)                                             00001740
      IOXA1 = IXA                                                       00001750
      IOYA1 = IYA                                                       00001760
      GO TO 1074                                                        00001770
C 907 CHARACTER SET SELECTED                                            00001780
 107  CALL BUFF(10,0,6,IBCD)                                            00001790
      CALL BUFF(14,1,0,IBCD)                                            00001800
      CALL BUFF( 8,1,0,IBCD)                                            00001810
      IOXA = IXA                                                        00001820
      IOYA = IYA                                                        00001830
C OUTPUT SCALING PARAMETER                                              00001840
 1074 CALL BUFF(6,1,0,IBCD)                                             00001850
      CALL BUFF (IXA,IYA,2,IBCD)                                        00001860
      IF(YFONT.NE.-999.) GO TO 115                                      00001870
108   IF (NT) 110,120,130                                               00001880
C                   SPECIAL SYMBOL CALL - DECIDE HOW TO CALL IT         00001890
  110 IF (K-IASCII) 119,119,111                                         00001900
C             OUTPUT SPECIAL EXTENDED SYMBOL CALL                       00001910
  111 CALL BUFF ( 4,0,6,IBCD)                                           00001920
      CALL BUFF ( 14,1,0,IBCD)                                          00001930
      CALL BUFF ( 15,1,0,IBCD)                                          00001940
      K1 = K / 16                                                       00001950
      CALL BUFF ( K1,1,0,IBCD)                                          00001960
      K1 = MOD ( K, 16 )                                                00001970
      CALL BUFF ( K1,1,0,IBCD)                                          00001980
      GO TO 900                                                         00001990
C *** UPDATE FOR SOFTWARE BULLETIN 83-001                               00002000
 115  IF (NT) 118,120,130                                               00002010
 118  IF (INTEQ - 31) 500,500,129                                       00002020
 129  K = K - 32                                                        00002030
      GO TO 119                                                         00002040
 500  CALL BUFF(3,0,6,IBCD)                                             00002050
      CALL BUFF(14,1,0,IBCD)                                            00002060
      K2 = INTEQ                                                        00002070
      KH2 = K2 / 16                                                     00002080
      CALL BUFF(KH2,1,0,IBCD)                                           00002090
      KL2 = MOD (K2,16)                                                 00002100
      CALL BUFF(KL2,1,0,IBCD)                                           00002110
      GO TO 900                                                         00002120
  119 CALL BUFF(K+IMIN,1,4,IBCD)                                        00002130
      GO TO 900                                                         00002140
  120 CALL BUFF(IDUM,   NC,3,IBCD)                                      00002150
      GO TO 900                                                         00002160
  130 IF(NT-1000)140,140,150                                            00002170
  140 CALL BUFF(IDUM   ,NC,3,IBCD)                                      00002180
      GO TO 900                                                         00002190
  150 CALL BUFF(IDUM   ,NC,3,IBCD)                                      00002200
C                   ADJUST FINAL POSITION                               00002210
  900 PX = 0.0                                                          00002220
      PY = 0.0                                                          00002230
      IF(YFONT.EQ.-999.) GO TO 905                                      00002240
      PX = XNC * FLOAT(IXA)                                             00002250
      PY = XNC * FLOAT(IYA)                                             00002260
      GO TO 960                                                         00002270
  905 XADD = 0.0                                                        00002280
      IF (IXA) 910,930,920                                              00002290
  910 XADD = -15.0                                                      00002300
  920 PX = XNC * FLOAT(IFIX((XADD+15.*FLOAT(IXA))/16.))                 00002310
  930 XADD = 0.0                                                        00002320
      IF (IYA) 940,960,950                                              00002330
  940 XADD = -15.0                                                      00002340
  950 PY = XNC * FLOAT(IFIX((XADD+15.*FLOAT(IYA))/16.))                 00002350
  960 CONTINUE                                                          00002360
C THE FOLLOWING CALL UPDATES OLDX & OLDY  IN PLOT ROUTINE               00002370
      CALL PLOT(PX,PY,1006)                                             00002380
C THE FOLLOWING CALL GETS THE OLDX & OLDY VALUE FROM PLOT ROUTINE.      00002390
      CALL PLOT(XP,YP,1002)                                             00002400
  999 RETURN                                                            00002410
      END                                                               00002420
      SUBROUTINE FONT(CHFNT)                                            00000010
C...SUBROUTINE FONT                            LIBRARY NUMBER ZBPDB501  00000020
CALCOMP HCBS FOR  IPE ONLINE F-77 MI           VERAB         FEB, 1984  00000030
C                                                                       00000040
C.. 0-9 SELECTS 9X5 FONTS                                               00000050
C..   99. RETURNS CURRENT VALUE OF CHARACTER SET                        00000060
C.. -999. DEFAULTS TO 907 CHARACTER SET                                 00000070
C                                                                       00000080
      SAVE                                                              00000090
      CHARACTER * 1 IBCD                                                00000100
C     COMMON /CFNT/ FNT                                                 00000110
      DATA FNT /-999.0/                                                 00000120
C                                                                       00000130
      IF(CHFNT.LT. 0.0) GO TO 20                                        00000140
      IF(CHFNT.GT.10.0) GO TO 10                                        00000150
      CALL BUFF ( 6,0,6,IBCD)                                           00000160
      CALL BUFF (11,1,0,IBCD)                                           00000170
      CALL BUFF ( 0,1,0,IBCD)                                           00000180
      CALL BUFF ( 9,1,0,IBCD)                                           00000190
      CALL BUFF (11,1,0,IBCD)                                           00000200
      CALL BUFF ( 7,1,0,IBCD)                                           00000210
      IFONT = CHFNT                                                     00000220
      CALL BUFF (IFONT,1,0,IBCD)                                        00000230
      FNT = CHFNT                                                       00000240
      GO TO 999                                                         00000250
   10 CHFNT = FNT                                                       00000260
      GO TO 999                                                         00000270
   20 CALL BUFF ( 2,0,6,IBCD)                                           00000280
      CALL BUFF (14,1,0,IBCD)                                           00000290
      CALL BUFF ( 8,1,0,IBCD)                                           00000300
      FNT = CHFNT                                                       00000310
  999 RETURN                                                            00000320
      END                                                               00000330
      SUBROUTINE TLRNCE(LVARCS,LVCHAR)                                  00000010
CALCOMP TLRNCE SUBROUTINE                                   ZBPDC501    00000020
CALCOMP HCBS FOR 907 AND 951 CONTROLLERS (PCI) F-77        OCT, 1983    00000030
C             PROPRIETARY SOFTWARE NOTIFICATION                         00000040
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        00000050
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  00000060
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      00000070
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR 00000080
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              00000090
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      00000100
C                 RESTRICTED RIGHTS LEGEND                              00000110
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       00000120
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     00000130
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      00000140
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        00000150
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 00000160
C.. DEFAULT TOLERANCE LEVEL FOR ARCS AND CIRCLES 30 (03)                00000170
C.. DEFAULT TOLERANCE LEVEL FOR CHARACTERS 30 DEGREE (02)               00000180
C.. BOTH LEVELS MUST BE SENT EVEN IF ONLY ONE LEVEL IS BEING CHANGED    00000190
C.. CHECK FOR SPACE IN BUFFER                                           00000200
      SAVE                                                              00000210
      CHARACTER * 1 IBCD                                                00000220
C     COMMON /CTLR/ LARC,LCHR                                           00000230
      DATA LARC,LCHR /7,2/                                              00000240
      IF (LVARCS.NE.99) GO TO 10                                        00000250
      LVARCS = LARC                                                     00000260
      LVCHAR = LCHR                                                     00000270
      GO TO 20                                                          00000280
 10   IF(LVARCS.EQ.999) GO TO 15                                        00000290
      LARC = LVARCS                                                     00000300
 15   IF(LVCHAR.EQ.999) GO TO 18                                        00000310
      LCHR = LVCHAR                                                     00000320
 18   CALL BUFF ( 6,0,6,IBCD)                                           00000330
      CALL BUFF (11,1,0,IBCD)                                           00000340
      CALL BUFF (0,1,0,IBCD)                                            00000350
      CALL BUFF (8,1,0,IBCD)                                            00000360
      CALL BUFF (11,1,0,IBCD)                                           00000370
      CALL BUFF (LARC,1,0,IBCD)                                         00000380
      CALL BUFF (LCHR,1,0,IBCD)                                         00000390
20    RETURN                                                            00000400
      END                                                               00000410
      SUBROUTINE CIRCLE (P1, P2, P3, P4, RADIUS, MODE)                  00000001
CALCOMP CIRCLE SUBROUTINE (24 BITS)                           ZBPCN503  00000002
CALCOMP HCBS FOR 907 AND 951 CONTROLLER (PCI) F-77           DEC, 1984  00000003
C  LAST UPDATE: DEC, 84  STAR 3509 (PLOTTER STEP LESS THAN 1)           00000004
C                                                                       00000005
C  THIS SUBROUTINE WILL DRAW CIRCLES OR CIRCULAR ARCS                   00000006
C                                                                       00000007
C  THE MEANINGS OF PARAMETERS P1 - P4 WILL VARY DEPENDING ON            00000008
C  THE VALUE OF MODE                                                    00000009
C                                                                       00000010
C     COMMON /CCIR/ DMAX,DMAX1,SHFT                                     00000011
      CHARACTER * 1 IBCD                                                00000012
      DATA DMAX /32767.0/                                               00000013
      DATA DMAX1/8388607./,SHFT/4096./                                  00000014
      CALL PLOT (STEPS, YDUM, 1005)                                     00000015
      AS = 0.0                                                          00000016
      AE = 0.0                                                          00000017
      ARCANG = 0.0                                                      00000018
C SET FLAG FOR 16 BIT PRECISION                                         00000019
      IBIT = 0                                                          00000020
      IMODE = IABS(MODE)                                                00000021
C               1 <= IMODE <= 7                                         00000022
      IF (IMODE) 9000, 9000, 10                                         00000023
   10 IF (IMODE-7) 20, 20, 9000                                         00000024
   20 GO TO (100, 200, 200, 400, 500, 600, 700),IMODE                   00000025
C                                                                       00000026
  100 XS = P1                                                           00000027
      YS = P2                                                           00000028
      XC = P3                                                           00000029
      YC = P4                                                           00000030
      GO TO 1000                                                        00000031
C                                                                       00000032
  200 XS = P1                                                           00000033
      YS = P2                                                           00000034
      XE = P3                                                           00000035
      YE = P4                                                           00000036
      GO TO 1000                                                        00000037
C                                                                       00000038
  400 XS = P1                                                           00000039
      YS = P2                                                           00000040
      AS = P3                                                           00000041
      GO TO 1000                                                        00000042
C                                                                       00000043
  500 XS = P1                                                           00000044
      YS = P2                                                           00000045
      AS = P3                                                           00000046
      AE = P4                                                           00000047
      GO TO 1000                                                        00000048
C                                                                       00000049
  600 XC = P1                                                           00000050
      YC = P2                                                           00000051
      AS = P3                                                           00000052
      GO TO 1000                                                        00000053
C                                                                       00000054
  700 XC = P1                                                           00000055
      YC = P2                                                           00000056
      AS = P3                                                           00000057
      AE = P4                                                           00000058
C                                                                       00000059
C                                                                       00000060
 1000 GO TO (1100, 1100, 1100, 1030, 1010, 1030, 1010),IMODE            00000061
C               REDUCE ANGLES TO +/- 180 DEGREES                        00000062
 1010 I = IFIX(AE /360.0)                                               00000063
      RAE = AE - FLOAT(I * 360)                                         00000064
      IF (RAE - 180.0) 1025, 1025, 1020                                 00000065
 1020 RAE = RAE - 360.0                                                 00000066
 1025 RAE = 0.017453 * RAE                                              00000067
 1030 I = IFIX(AS/360.0)                                                00000068
      RAS = AS - FLOAT(I * 360)                                         00000069
      IF (RAS -180.0) 1050, 1050, 1040                                  00000070
 1040 RAS = RAS - 360.0                                                 00000071
C                CONVERT ANGLES TO RADIANS                              00000072
 1050 RAS = 0.017453 * RAS                                              00000073
C                                                                       00000074
C                                                                       00000075
 1100 GO TO (1200, 1110, 1110, 1110, 1110, 1110, 1110),IMODE            00000076
C               CHECK RADIUS FOR TOO LARGE                              00000077
 1110 R = RADIUS                                                        00000078
      R2 = R * STEPS                                                    00000079
      IF (R2 -DMAX) 1200, 1200, 1120                                    00000080
 1120 IBIT = 99                                                         00000081
      IF (R2 -DMAX1)1200,1200,1140                                      00000082
 1140 R = DMAX1/STEPS                                                   00000083
C                                                                       00000084
C                                                                       00000085
 1200 GO TO (1220, 1250, 1250, 1210, 1210, 1210, 1210),IMODE            00000086
C               COMPUTE DISTANCE FROM CENTER TO START                   00000087
 1210 DXC = R * COS(RAS)                                                00000088
      DYC = R * SIN(RAS)                                                00000089
      GO TO 1300                                                        00000090
 1220 DXC = XS - XC                                                     00000091
      DYC = YS - YC                                                     00000092
C               CHECK RADIUS TOO LARGE                                  00000093
      R = SQRT(DXC**2 + DYC**2)                                         00000094
      R2 = R * STEPS                                                    00000095
      IF (R2 - DMAX) 1300, 1300, 1230                                   00000096
 1230 IBIT = 99                                                         00000097
      IF (R2 - DMAX1) 1300, 1300,1240                                   00000098
 1240 RMAX = DMAX1/STEPS                                                00000099
      DXC = RMAX * DXC / R                                              00000100
      DYC = RMAX * DYC / R                                              00000101
      GO TO 1300                                                        00000102
C                                                                       00000103
C               FIND MIDPOINT OF CHORD                                  00000104
 1250 XM = (XS-XE) / 2 + XE                                             00000105
      YM = (YS-YE) / 2 + YE                                             00000106
      SDIST = (XS-XM)**2 + (YS-YM)**2                                   00000107
C               LENGTH OF PERPENDICULAR TO CHORD                        00000108
      PDIST = R**2 - SDIST                                              00000109
      SLOPE = 0.0                                                       00000110
      IF (YS-YE) 1255, 1256, 1255                                       00000111
C               FIND SLOPE OF PERPENDICULAR TO CHORD                    00000112
 1255 SLOPE = - (XS-XE) / (YS-YE)                                       00000113
C               CHECK FOR RADIUS TOO SHORT                              00000114
 1256 IF (PDIST) 1260, 1270, 1270                                       00000115
 1260 R = SQRT(SDIST)                                                   00000116
      XC = XM                                                           00000117
      YC = YM                                                           00000118
      GO TO 1290                                                        00000119
C                                                                       00000120
 1270 SQ = SQRT(PDIST / (SLOPE**2 + 1))                                 00000121
      IF (YS-YE) 1271, 1280, 1275                                       00000122
 1271 IF (MODE+2) 1272, 1277, 1272                                      00000123
 1272 IF (MODE-3) 1278, 1277, 1278                                      00000124
 1275 IF (MODE-2) 1276, 1277, 1276                                      00000125
 1276 IF (MODE+3) 1278, 1277, 1278                                      00000126
 1277 XC = SQ + XM                                                      00000127
      GO TO 1279                                                        00000128
 1278 XC = -SQ + XM                                                     00000129
 1279 YC = (XC-XM) * SLOPE + YM                                         00000130
      GO TO 1290                                                        00000131
C                                                                       00000132
C               SPECIAL CASE WHERE CHORD IS HORIZONTAL                  00000133
C                                (SLOPE OF PERPENDICULAR IS UNDEFINED)  00000134
 1280 XC = XM                                                           00000135
      IF (XS-XE) 1281, 9000, 1285                                       00000136
 1281 IF (MODE+2) 1282, 1287, 1282                                      00000137
 1282 IF (MODE-3) 1288, 1287, 1288                                      00000138
 1285 IF (MODE-2) 1286, 1287, 1286                                      00000139
 1286 IF (MODE+3) 1288, 1287, 1288                                      00000140
 1287 YC = YM - SQ                                                      00000141
      GO TO 1290                                                        00000142
 1288 YC = YM + SQ                                                      00000143
C               FIND DXC, DYC, DXE, DYE                                 00000144
 1290 DXC = XS - XC                                                     00000145
      DYC = YS - YC                                                     00000146
      DXE = XE - XC                                                     00000147
      DYE = YE - YC                                                     00000148
C                                                                       00000149
C                                                                       00000150
 1300 GO TO (1310, 1310, 1310, 1310, 1310, 1320, 1320),IMODE            00000151
C               MOVE TO START POSITION WITH PEN UP                      00000152
 1310 CALL PLOT (XS, YS, 3)                                             00000153
      GO TO 1400                                                        00000154
C                                                                       00000155
 1320 CALL PLOT (XC+DXC, YC+DYC, 3)                                     00000156
C                                                                       00000157
 1400 CONTINUE                                                          00000158
C               COMPUTE NO. OF STEPS FROM START TO CENTER               00000159
 1410 DXC = -DXC * STEPS                                                00000160
      DYC = -DYC * STEPS                                                00000161
C                                                                       00000162
C**** CHECK IF RADIUS IS GREATER THAN 1 PLOTTER STEP (STAR 3509)        00000163
      IF (ABS(DXC).GE.1.0) GO TO 1500                                   00000164
      IF (ABS(DYC).LT.1.0) GO TO 9000                                   00000165
C                                                                       00000166
 1500 GO TO (3000, 1525, 1525, 3000, 1510, 3000, 1510),IMODE            00000167
C               COMPUTE INCLUDED ANGLE OF REQUESTED ARC                 00000168
 1510 ARCANG = AE -AS                                                   00000169
      ABSARC = ABS(ARCANG)                                              00000170
      IF (ABSARC - 360.0) 1520, 3000, 3000                              00000171
C               FIND DELTA TO END OF ARC                                00000172
 1520 DXE = R * COS(RAE)                                                00000173
      DYE = R * SIN(RAE)                                                00000174
C                                                                       00000175
 1525 DXE = DXE * STEPS                                                 00000176
      DYE = DYE * STEPS                                                 00000177
C     IDXE = DXE + SIGN(0.5, DXE)                                       00000178
C     IDYE = DYE + SIGN(0.5, DYE)                                       00000179
      DXX =       DXC +       DXE                                       00000180
      DYY =       DYC +       DYE                                       00000181
      IF (ARCANG-180.0) 1530, 2000, 2000                                00000182
C                                                                       00000183
C**** CHECK IF RADIUS IS GREATER THAN 1 PLOTTER STEP (STAR 3509)        00000184
 1530 IF (ABS(DXX).GE.1.0) GO TO 2000                                   00000185
      IF (ABS(DYY).LT.1.0) GO TO 9000                                   00000186
C                                                                       00000187
C       GENERATE ARC COMMAND SEQUENCE                                   00000188
 2000 IF(IBIT.EQ.99) GO TO 4000                                         00000189
      KMD = 0                                                           00000190
      IF (MODE) 2040, 9000, 2010                                        00000191
 2010 IF (MODE-3) 2030, 2030, 2020                                      00000192
 2020 IF (ARCANG) 2040, 2040, 2030                                      00000193
 2030 KMD = 1                                                           00000194
C               CALL BUFF TO STUFF CIRCLE COMMAND                       00000195
 2040 IDXC = DXC                                                        00000196
      IDYC = DYC                                                        00000197
      IDXE = DXE                                                        00000198
      IDYE = DYE                                                        00000199
      CALL BUFF(16, 0, 6,IBCD)                                          00000200
      CALL BUFF(12, 1, 0,IBCD)                                          00000201
      CALL BUFF(KMD, 1, 0,IBCD)                                         00000202
      CALL BUFF(IDXC, IDYC, 2,IBCD)                                     00000203
      CALL BUFF(IDXE, IDYE, 2,IBCD)                                     00000204
C               ADJUST PEN POSITION TO FINAL                            00000205
      CALL PLOT(DXX,DYY, 1006)                                          00000206
      GO TO 9000                                                        00000207
C                                                                       00000208
C       GENERATE FULL CIRCLE COMMAND                                    00000209
 3000 IF(IBIT.EQ.99) GO TO 5000                                         00000210
      KMD = 4                                                           00000211
      IF (MODE) 3020, 9000, 3010                                        00000212
 3010 KMD = 5                                                           00000213
C               CALL BUFF TO STUFF CIRCLE COMMAND                       00000214
 3020 IDXC = DXC                                                        00000215
      IDYC = DYC                                                        00000216
      CALL BUFF(9, 0, 6,IBCD)                                           00000217
      CALL BUFF(12, 1, 0,IBCD)                                          00000218
      CALL BUFF(KMD, 1, 0,IBCD)                                         00000219
      CALL BUFF(IDXC, IDYC, 2,IBCD)                                     00000220
C                       (PEN RETURNS TO START POINT)                    00000221
C                                                                       00000222
C       ALL DONE                                                        00000223
      GO TO 9000                                                        00000224
 4000 KMD = 8                                                           00000225
      IF (MODE) 4040, 9000, 4010                                        00000226
 4010 IF (MODE-3) 4030, 4030, 4020                                      00000227
 4020 IF (ARCANG) 4040, 4040, 4030                                      00000228
 4030 KMD = 9                                                           00000229
C               CALL BUFF TO STUFF CIRCLE COMMAND                       00000230
 4040 IF(DXC.GE.0.) GO TO 4060                                          00000231
 4050 DXC = ABS(DXC)                                                    00000232
      DXC1 = DXC/SHFT                                                   00000233
      IDXC1 = -DXC1                                                     00000234
      DXC2 = AMOD(DXC,SHFT)                                             00000235
      IDXC2 = -DXC2                                                     00000236
      GO TO 4070                                                        00000237
 4060 IDXC1 = DXC/SHFT                                                  00000238
      IDXC2 = AMOD(DXC,SHFT)                                            00000239
 4070 IF(DYC.GE.0.) GO TO 4090                                          00000240
 4080 DYC = ABS(DYC)                                                    00000241
      DYC1 = DYC/SHFT                                                   00000242
      IDYC1 = -DYC1                                                     00000243
      DYC2 = AMOD(DYC,SHFT)                                             00000244
      IDYC2 = -DYC2                                                     00000245
      GO TO 4100                                                        00000246
 4090 IDYC1 = DYC/SHFT                                                  00000247
      IDYC2 = AMOD(DYC,SHFT)                                            00000248
 4100 IF(DXE.GE.0.) GO TO 4160                                          00000249
 4150 DXE = ABS(DXE)                                                    00000250
      DXE1 = DXE/SHFT                                                   00000251
      IDXE1 = -DXE1                                                     00000252
      DXE2 = AMOD(DXE,SHFT)                                             00000253
      IDXE2 = -DXE2                                                     00000254
      GO TO 4170                                                        00000255
 4160 IDXE1 = DXE/SHFT                                                  00000256
      IDXE2 = AMOD(DXE,SHFT)                                            00000257
 4170 IF(DYE.GE.0.) GO TO 4190                                          00000258
 4180 DYE = ABS(DYE)                                                    00000259
      DYE1 = DYE/SHFT                                                   00000260
      IDYE1 = -DYE1                                                     00000261
      DYE2 = AMOD(DYE,SHFT)                                             00000262
      IDYE2 = -DYE2                                                     00000263
      GO TO 4200                                                        00000264
 4190 IDYE1 = DYE/SHFT                                                  00000265
      IDYE2 = AMOD(DYE,SHFT)                                            00000266
 4200 CALL BUFF(22, 0, 6,IBCD)                                          00000267
      CALL BUFF(12, 1, 0,IBCD)                                          00000268
      CALL BUFF(KMD, 1, 0,IBCD)                                         00000269
      CALL BUFF(IDXC1,IDYC1,2,IBCD)                                     00000270
      CALL BUFF(IDXC2,IDYC2,2,IBCD)                                     00000271
      CALL BUFF(IDXE1,IDYE1,2,IBCD)                                     00000272
      CALL BUFF(IDXE2,IDYE2,2,IBCD)                                     00000273
C               ADJUST PEN POSITION TO FINAL                            00000274
      CALL PLOT(DXX,DYY, 1006)                                          00000275
      GO TO 9000                                                        00000276
C                                                                       00000277
C       GENERATE FULL CIRCLE COMMAND                                    00000278
C                                                                       00000279
 5000 KMD = 12                                                          00000280
      IF (MODE) 5020, 9000, 5010                                        00000281
 5010 KMD = 13                                                          00000282
C               CALL BUFF TO STUFF CIRCLE COMMAND                       00000283
 5020 IF(DXC.GE.0.) GO TO 5060                                          00000284
 5050 DXC = ABS(DXC)                                                    00000285
      DXC1 = DXC/SHFT                                                   00000286
      IDXC1 = -DXC1                                                     00000287
      DXC2 = AMOD(DXC,SHFT)                                             00000288
      IDXC2 = -DXC2                                                     00000289
      GO TO 5070                                                        00000290
 5060 IDXC1 = DXC/SHFT                                                  00000291
      IDXC2 = AMOD(DXC,SHFT)                                            00000292
 5070 IF(DYC.GE.0.) GO TO 5090                                          00000293
 5080 DYC = ABS(DYC)                                                    00000294
      DYC1 = DYC/SHFT                                                   00000295
      IDYC1 = -DYC1                                                     00000296
      DYC2 = AMOD(DYC,SHFT)                                             00000297
      IDYC2 = -DYC2                                                     00000298
      GO TO 5100                                                        00000299
 5090 IDYC1 = DYC/SHFT                                                  00000300
      IDYC2 = AMOD(DYC,SHFT)                                            00000301
 5100 CALL BUFF(15,0, 6,IBCD)                                           00000302
      CALL BUFF(12, 1, 0,IBCD)                                          00000303
      CALL BUFF(KMD, 1, 0,IBCD)                                         00000304
      CALL BUFF(IDXC1,IDYC1,2,IBCD)                                     00000305
      CALL BUFF(IDXC2,IDYC2,2,IBCD)                                     00000306
C               (PEN RETURNS TO START POINT)                            00000307
C                                                                       00000308
 9000 RETURN                                                            00000309
      END                                                               00000310
      SUBROUTINE ROTATE(IROTAT)                                         00000010
CALCOMP ROTATE SUBROUTINE                                     ZBPCP501  00000020
CALCOMP HCBS FOR 907 AND PCI CONTROLLER (PCI) F-77           APR, 1985  00000030
C     COMMON CROT/IOLDR/                                                00000040
      CHARACTER * 1 IBCD                                                00000050
      DATA IOLDR/0/                                                     00000060
      IROT = MOD(IROTAT,360)                                            00000070
      IF (IROT.EQ.IOLDR) GO TO 999                                      00000080
      CALL BUFF(4 ,0,6,IBCD)                                            00000090
      CALL BUFF(14,1,0,IBCD)                                            00000100
      CALL BUFF(31,1,0,IBCD)                                            00000110
      JROT = IROT/16                                                    00000120
      CALL BUFF(JROT,1,0,IBCD)                                          00000130
      JROT =MOD(IROT,16)                                                00000140
      CALL BUFF(JROT,1,0,IBCD)                                          00000150
      IOLDR = IROT                                                      00000160
  999 RETURN                                                            00000170
      END                                                               00000180
      SUBROUTINE MIRROR(IMIR)                                           00000010
CALCOMP MIRROR SUBROUTINE                                     ZBPCX501  00000020
CALCOMP HCBS FOR 907 AND 951 CONTROLLER (PCI) F-77           OCT, 1983  00000030
C             PROPRIETARY SOFTWARE NOTIFICATION                         00000040
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        00000050
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  00000060
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      00000070
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR 00000080
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              00000090
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      00000100
C                 RESTRICTED RIGHTS LEGEND                              00000110
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       00000120
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     00000130
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      00000140
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        00000150
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 00000160
      CHARACTER * 1 IBCD                                                00000170
      IF(IMIR.LT.0.OR.IMIR.GT.3) GO TO 999                              00000180
      CALL BUFF(3,0,6,IBCD)                                             00000190
      CALL BUFF(14,1,0,IBCD)                                            00000200
      CALL BUFF(29,1,0,IBCD)                                            00000210
      CALL BUFF (IMIR,1,0,IBCD)                                         00000220
  999 RETURN                                                            00000230
      END                                                               00000240
      SUBROUTINE WINDOW(INEX,XMIN,YMIN,XMAX,YMAX)                       00000010
CALCOMP WINDOW SUBROUTINE                                   ZBPCY501    00000020
CALCOMP HCBS FOR 907 AND 951 CONTROLLERS (PCI) F-77        OCT, 1983    00000030
C             PROPRIETARY SOFTWARE NOTIFICATION                         00000040
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        00000050
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  00000060
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      00000070
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR 00000080
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              00000090
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      00000100
C                 RESTRICTED RIGHTS LEGEND                              00000110
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       00000120
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     00000130
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      00000140
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        00000150
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 00000160
C                                                                       00000170
C     COMMON /CWIN/ XORG,YORG                                           00000180
      CHARACTER * 1 IBCD                                                00000190
      DATA XORG,YORG /2*0.0/                                            00000200
      IF (INEX.LT.0.OR.INEX.GT.1) GO TO 999                             00000210
      XMINI = XMIN                                                      00000220
      YMINI = YMIN                                                      00000230
      XMAXI = XMAX                                                      00000240
      YMAXI = YMAX                                                      00000250
      CALL WHERE(XORG,YORG,FACT)                                        00000260
      CALL PLOT(XMINI,YMINI,3)                                          00000270
      CALL BUFF(4,0,6,IBCD)                                             00000280
      CALL BUFF(14,1,0,IBCD)                                            00000290
      CALL BUFF(30,1,0,IBCD)                                            00000300
      CALL BUFF(INEX,1,0,IBCD)                                          00000310
      CALL BUFF(0,1,0,IBCD)                                             00000320
C                                                                       00000330
      CALL PLOT(XMAXI,YMAXI,3)                                          00000340
      CALL BUFF(4,0,6,IBCD)                                             00000350
      CALL BUFF(14,1,0,IBCD)                                            00000360
      CALL BUFF(30,1,0,IBCD)                                            00000370
      CALL BUFF(INEX,1,0,IBCD)                                          00000380
      CALL BUFF(1,1,0,IBCD)                                             00000390
      CALL PLOT(XORG,YORG,3)                                            00000400
 999  RETURN                                                            00000410
      END                                                               00000420
      SUBROUTINE PRFORM(IPNUM,IACCL,MAXVEL)                             00000010
CALCOMP PRFORM SUBROUTINE                                     ZBPDL500  00000020
CALCOMP HCBS FOR 907 AND 951 CONTROLLER (PCI) F-77           NOV, 1983  00000030
      CHARACTER * 1 IBCD                                                00000040
      IP = MOD(IPNUM,5)                                                 00000050
      LVACC = IACCL                                                     00000060
      MXVEL = MAXVEL                                                    00000070
      CALL BUFF(9,0,6,IBCD)                                             00000080
      CALL BUFF(11,1,0,IBCD)                                            00000090
      CALL BUFF( 0,1,0,IBCD)                                            00000100
      CALL BUFF( 5,1,0,IBCD)                                            00000110
      CALL BUFF(11,1,0,IBCD)                                            00000120
      CALL BUFF(IP,1,0,IBCD)                                            00000130
      CALL BUFF(LVACC,1,0,IBCD)                                         00000140
      CALL BUFF(11,1,0,IBCD)                                            00000150
      MVX = MXVEL/16                                                    00000160
      CALL BUFF(MVX,1,0,IBCD)                                           00000170
      MVX = MOD(MXVEL,16)                                               00000180
      CALL BUFF(MVX,1,0,IBCD)                                           00000190
      RETURN                                                            00000200
      END                                                               00000210
      SUBROUTINE NEWPLT                                                 NPLT0010
C     HCBS FOR ONLINE CONTROLLERS  IPE   F-77   MI           ZBPDS500   NPLT0020
      CHARACTER * 1 IBCD                                                NPLT0030
      CALL BUFF(3,0,6,IBCD)                                             NPLT0040
      CALL BUFF(11,1,0,IBCD)                                            NPLT0050
      CALL BUFF(0,1,0,IBCD)                                             NPLT0060
      CALL BUFF(6,1,0,IBCD)                                             NPLT0070
      RETURN                                                            NPLT0080
      END                                                               NPLT0090
