110     !---------------------------------------------------------------------
120     !               Dahlgren, Shardlow, & Uban, Inc.
130     !                       1 Groveland Terrace
140     !                       Minneapolis, MN 55403
150     ! ==========            tel (612)-377-3536
160     ! CURVE1.BAS    WRITTEN BY PAUL BLAIS  ON MAY     6,1984
170     ! ==========    REVISED BY PAUL BLAIS  ON JULY   23,1984
180     !               DONATED TO: AMUS For Members Use
190     ! CALCULATES HORIZONTAL CURVE DATA:
200     ! This program provides the technical data required by Surveyors and Enginerrs
210     ! in the preparation of road construction plans.  It will be nessecary
220     ! to change to value of PR'NAME in the Map statement to the name of your printer
230     ! The program will optionally save the data on disk.  All output is directed
240     ! to both the screen and the spooler.  This program is suitable for AMOS/L 1.1A
250     ! and later.  Earlier versions may also be supported, but have not been tested.
260     !
270     !---------------  L I S T   O F   V A R I A B L E S  -----------------
280     MAP1 PR'NAME,S,6,"DPPRT"                ! THE NAME OF YOUR PRINTER - CHANGE AS YOU REQUIRE
290     !---------------------------------------------------------------------
300     MAP1 SAVE'OUTPUT,S,1                    ! Kills The Output File If = No
310     MAP1 COMPASS'IN,S,1                     ! Incomming Tangent Bearing
320     MAP1 DEFLECTION'IN,S,1                  ! Incomming Tangent Deflection
330     MAP1 ANGLE'IN,F                         ! Incomming Tan. Def. Angle
340     MAP1 COMPASS'OUT,S,1                    ! Outgoing Tangent Bearing
350     MAP1 DEFLECTION'OUT,S,1                 ! Outgoing Tangent Deflection
360     MAP1 ANGLE'OUT,F                        ! Outgoing Tan. Def. Angle
370     MAP1 DEGREES,F                          ! Degrees Of Input Angle
380     MAP1 MINUTES,F                          ! Minutes Of Input Angle
390     MAP1 SECONDS,F                          ! Seconds Of Input Angle
400     MAP1 ANGLE,F                            ! Used To Calc. Interior Angle
410     MAP1 QUERY,S,1                          ! Answer From A Query
420     MAP1 MINIT,F                            ! Scratch Var. Conv.
430     MAP1 X,F                                ! Counter In Print Loop
440     MAP1 SETS'OF'DATA'ON'PAGE,F             ! Number Used To Set Page Splits
450     MAP1 TIMES'CALLED,F                     ! Number To Set Page Number
460     MAP1 PAGE,S,2                           ! The Page Number
470                                             ! Also Sets File Channle Number
480     MAP1 FILE'HEADER
490          MAP2 TODAYS'DATE,S,30              ! Date Calculated by the system
500          MAP2 YOUR'NAME,S,30                ! Name Entered By User
510          MAP2 JOB'NAME,S,30                 ! Name Entered By User
520          MAP2 OUT'FILE,S,6                  ! Output File Entered By User
530          MAP2 LOOK'FOR,F                    ! Result From Lookup Function
540          MAP2 OUT'FILE'SPEC,S,10
550     MAP1 CURVE'DATA                         ! Overlay Memory
560          MAP2 CURVE'NUMBER,F                ! Curve I.D. Number
570          MAP2 P'OF'C,F                      ! Point Of Curvature
580          MAP2 P'OF'I,F                      ! Point Of Intersection
590          MAP2 P'OF'T,F                      ! Point Of Tangency
600          MAP2 INT'ANGLE,F                   ! Interior Angle
610          MAP2 DEGREE,F                      ! Degree Of Curve
620          MAP2 TANGENT,F                     ! Tangent Length
630          MAP2 LENGTH,F                      ! Length Of Arc
640          MAP2 EXTERNAL,F                    ! External Distance
650          MAP2 RADIUS,F                      ! Radius Length
660          MAP2 MID'ORD,F                     ! Middle Ordinate
670          MAP2 CHORD,F                       ! Chord Length
680     MAP1 BINDATE,B,4
690     MAP1 THE'DATE,@BINDATE                  ! Overlay in memory the Binary Date
700             MAP2 MONTH,B,1                  ! month part of date in Binary
710             MAP2 DAY,B,1                    ! Day # part of Date in Binary
720             MAP2 YEAR,B,1                   ! Last two digits of the year in Binary
730             MAP2 DAY'NAME,B,1               ! Day name part of date in Binary
740     MAP1 MO$,S,10                           ! Month name
750     MAP1 DAY$,S,9                           ! Name of the day of the week
760     !---------------------------------------------------------------------
770     !
780     ! Print the header on the users terminal
790     !
800     ? TAB(-1,0); : ? TAB(4,1);
810     ? TAB(40);"***************************"
820     ? TAB(40);"*    HORIZONTAL  CURVE    *"
830     ? TAB(40);"*       CALCULATION       *"
840     ? TAB(40);"*                         *"
850     ? TAB(40);"*      --CURVE1.RUN--     *"
860     ? TAB(40);"*      Version   1.10     *"
870     ? TAB(40);"***************************"
880     ? TAB(14,1); : ? TAB(10);
890     ? "This Program Computes Curve Data For Horizontal Curves" : ? TAB(10);
900     ? "------------------------------------------------------" : ?
910     !
920     ! Get todays date, jobname, users name, and output file name
930     !
940     CALL CALC'DATE
950     ? TAB(10);
960     ? TODAYS'DATE
970     ? : ? TAB(15);
980     ? "For the user name and job name entries" : ? TAB(15);
990     ? "Enter up to 30 characters of your choice"
1000    ? : ? : ? TAB(20);
1010    INPUT LINE "     ENTER YOUR NAME : ",YOUR'NAME
1020    ? TAB(20);
1030    INPUT LINE " ENTER YOUR PROJECT NAME : ",JOB'NAME
1040    ? : ? TAB(12);
1050    !-------------------------
1060    INPUT'OUT'FILE:
1070    !-------------------------
1080    INPUT "INPUT A 6 CHARACTER NAME FOR THE OUTPUT FILE : ",OUT'FILE
1090    ?
1100    OUT'FILE'SPEC =  UCS(OUT'FILE)  + ".CRV"
1110    LOOKUP OUT'FILE'SPEC,LOOK'FOR
1120    IF LOOK'FOR = 0 THEN GOTO KILL'THE'OUTPUT'IF
1130    ? TAB(10);
1140    ? "  ********* THE FILE NAMED ";OUT'FILE'SPEC;" ALREADY EXISTS *********"
1150    ? : ? TAB(12);
1160    GOTO INPUT'OUT'FILE
1170    !-------------------------
1180    KILL'THE'OUTPUT'IF:
1190    !-------------------------
1200    ? TAB(12);
1210    INPUT "DO YOU WANT TO SAVE THE DATA ON DISK - Y or N :",SAVE'OUTPUT
1220    SAVE'OUTPUT = UCS(SAVE'OUTPUT)
1230    ? : ? TAB(12);
1240    !-------------------------
1250    ! Open the output file for output
1260    !-------------------------
1270    OPEN #1,OUT'FILE'SPEC,OUTPUT
1280    !-----------------------
1290    ENTER'CURVE'DATA:
1300    !-----------------------
1310    ? TAB(10);
1320    ? "ENTER YOUR CURVE I.D. NUMBER -enter whole or decimal numbers"
1330    ? TAB(10);
1340    INPUT "If you are done entering curves ENTER 0 : ",CURVE'NUMBER
1350    IF CURVE'NUMBER = 0 THEN GOTO ALL'DONE
1360    !-----------------------
1370    QUERY'INT'ANGLE:
1380    !-----------------------
1390    ? : ? TAB(12);
1400    ? "WHAT IS THE STATION NUMBER OF THE POINT OF INTERSECTION"
1410    ? TAB(12);
1420    INPUT "     enter a decimal number without a plus sign : ",P'OF'I
1430    ? : ? TAB(12);
1440    ? "DO YOU KNOW THE INTERIOR ANGLE ?"
1450    ? TAB(18);
1460    INPUT "     enter a Y or N : ",QUERY
1470    IF UCS(QUERY) = "N" THEN GOTO DETERMINE'INT'ANGLE
1480    IF UCS(QUERY) = "Y" THEN GOTO ENTER'INT'ANGLE
1490    ? : ? TAB(18);
1500    ? "*****  ANSWER MUST be a Y or N  *****"
1510    GOTO QUERY'INT'ANGLE
1520    !------------------------
1530    DETERMINE'INT'ANGLE:
1540    !------------------------
1550    ?
1560    ? "We  will  now  calculate  the  INTERIOR ANGLE.  In order"
1570    ? "to calculate it  we must  know  the TWO TANGENT BEARINGS"
1580    ? "Go back to your desk and get them if you do not have them."
1590    ?
1600    ? "WHAT IS THE BEARING OF THE INCOMING TANGENT N or S"
1610    INPUT "       COMPASS POINT : ",COMPASS'IN
1620    ? "       ANGLE : "
1630    CALL INPUT'ANGLE
1640    ANGLE'IN=ANGLE
1650    INPUT "       COMPASS POINT OF DEFLECTION E or W : ",DEFLECTION'IN
1660    ?
1670    ? "WHAT IS THE BEARING OF THE OUTGOING TANGENT N or S"
1680    INPUT "       COMPASS POINT : ",COMPASS'OUT
1690    ? "       ANGLE : "
1700    CALL INPUT'ANGLE
1710    ANGLE'OUT=ANGLE
1720    INPUT "       COMPASS POINT OF DELECTION E or W : ",DEFLECTION'OUT
1730    ?
1740    !
1750    ! angle calculations
1760    !
1770    IF UCS(COMPASS'IN)<>UCS(COMPASS'OUT) THEN GOTO COMPASS'IN'OUT'UNEQUAL
1780    IF UCS(DEFLECTION'IN)=UCS(DEFLECTION'OUT) THEN &
               INT'ANGLE=ABS(ANGLE'IN-ANGLE'OUT) ELSE &
               INT'ANGLE=ANGLE'IN+ANGLE'OUT
1790    GOTO PRINT'INT'ANGLE
1800    !-------------------------
1810    COMPASS'IN'OUT'UNEQUAL:
1820    !-------------------------
1830    IF UCS(DEFLECTION'IN)<>UCS(DEFLECTION'OUT) THEN GOTO ANGLE'CALC
1840    INT'ANGLE=180-ANGLE'IN-ANGLE'OUT
1850    GOTO PRINT'INT'ANGLE
1860    !-------------------------
1870    ANGLE'CALC:
1880    !-------------------------
1890    ANGLE=180+ANGLE'IN-ANGLE'OUT
1900    IF ANGLE>180 THEN INT'ANGLE=360-ANGLE
1910    IF ANGLE<=180 THEN INT'ANGLE=ANGLE
1920    !-------------------------
1930    PRINT'INT'ANGLE:
1940    !-------------------------
1950    ? "THE INTERIOR ANGLE I = ";INT'ANGLE
1960    ?
1970    GOTO SET'RAD'OR'TAN
1980    !-------------------------
1990    ENTER'INT'ANGLE:
2000    !-------------------------
2010    ? "ENTER THE INTERIOR ANGLE" : ?
2020    CALL INPUT'ANGLE
2030    INT'ANGLE=ANGLE
2040    GOTO PRINT'INT'ANGLE
2050    !-------------------------
2060    SET'RAD'OR'TAN:
2070    !-------------------------
2080    ?
2090    INPUT "WHICH DO YOU WHISH TO SET THE RADIUS OR THE TANGENT : ",QUERY
2100    ?
2110    IF UCS(QUERY) <> "R" THEN GOTO SET'TANGENT
2120    INPUT "WHAT IS THE RADIUS LENGTH : ",RADIUS : QUERY = "N"
2130    GOTO CALC'T'AND'C
2140    !-------------------------
2150    SET'TANGENT:
2160    !-------------------------
2170    IF UCS(QUERY) <> "T" THEN GOTO SET'RAD'OR'TAN
2180    INPUT "WHAT IS THE TANGENT LENGTH :",TANGENT : QUERY = "N"
2190    CHORD=2*TANGENT*COS(INT'ANGLE/(2*57.29578))
2200    RADIUS=CHORD/(2*SIN(INT'ANGLE/(2*57.29578)))
2210    GOTO CALC'L'AND'D
2220    !-------------------------
2230    CALC'T'AND'C:
2240    !-------------------------
2250    TANGENT=RADIUS*TAN(INT'ANGLE/(2*57.29578))
2260    CHORD=2*RADIUS*SIN(INT'ANGLE/(2*57.29578))
2270    !-------------------------
2280    CALC'L'AND'D:
2290    !-------------------------
2300    LENGTH=0.01745329*RADIUS*INT'ANGLE
2310    DEGREE=5729.578/RADIUS
2320    !
2330    CALL CALC'E'M'PC'AND'PT
2340    CALL PRINT'TO'SCREEN'AND'OUTPUT'FILE
2350    !
2360    ? TAB(12);
2370    !-------------------------
2380    QUERY'ADJUST'D:
2390    !-------------------------
2400    ? "DO YOU WHISH TO READJUST THE DEGREE OF CURVE TO A WHOLE NUMBER?"
2410    ? TAB(12);
2420    INPUT "       enter a Y or N : ",QUERY
2430    IF UCS(QUERY)="N" THEN GOTO ENTER'CURVE'DATA
2440    IF UCS(QUERY)<>"Y" THEN GOTO QUERY'ADJUST'D
2450    ? #1 : ? #1
2460    ? : ? TAB(12);
2470    INPUT "ENTER THE NEW DEGREE OF CURVE : ",DEGREE
2480    !
2490    ! re calculate the new curve data
2500    !
2510    LENGTH=100*INT'ANGLE/DEGREE
2520    RADIUS=57.2957795*LENGTH/INT'ANGLE
2530    TANGENT=RADIUS*TAN(INT'ANGLE/(2*57.29578))
2540    CHORD=2*RADIUS*SIN(INT'ANGLE/(2*57.29578))
2550    CALL CALC'E'M'PC'AND'PT
2560    !
2570    ! redisplay the curve data and write it to the output file
2580    ! then go back to the beginning to enter a new curve
2590    !
2600    CALL PRINT'TO'SCREEN'AND'OUTPUT'FILE
2610    GOTO ENTER'CURVE'DATA
2620    !-------------------------
2630    ALL'DONE:
2640    !-------------------------
2650    CLOSE #1
2660    XCALL SPOOL,OUT'FILE'SPEC,PR'NAME,64
2670    IF SAVE'OUTPUT = "N" THEN KILL OUT'FILE'SPEC
2680    ? TAB(-1,0) : ? TAB(10,16);
2690    ? "--------------------------------------------" : ? TAB(15);
2700    ? "-  YOUR DATA HAS BEEN SENT TO THE PRINTER  -" : ? TAB(15);
2710    ? "-    S O     L O N G     F O R     N O W   -" : PRINT TAB(15);
2720    ? "--------------------------------------------"
2730    END
2740    !*************  S U B R O U T I N E S   S T A R T   H E R E  *********
2750    INPUT'ANGLE:
2760    ? TAB(11);
2770    INPUT "        DEGREES : ",DEGREES : ? TAB(11);
2780    INPUT "        MINUTES : ",MINUTES : ? TAB(11);
2790    INPUT "        SECONDS : ",SECONDS
2800    MINIT = SECONDS/60+MINUTES
2810    ANGLE = MINIT/60+DEGREES
2820    ? : ? TAB(18);
2830    ? USING "        ANGLE = ###.## IN DECIMAL",ANGLE
2840    ?
2850    SECONDS = 0 : MINUTES = 0 : MINIT = 0 : DEGREES = 0
2860    RETURN
2870    !-------------------------------------------------------------
2880    CALC'E'M'PC'AND'PT:
2890    EXTERNAL=TANGENT*TAN(INT'ANGLE/(4*57.29578))
2900    MID'ORD=EXTERNAL*COS(INT'ANGLE/(2*57.29578))
2910    P'OF'C=P'OF'I-TANGENT
2920    P'OF'T=P'OF'C+LENGTH
2930    RETURN
2940    !-------------------------------------------------------------
2950    PRINT'TO'SCREEN'AND'OUTPUT'FILE:
2960    !---------------------------------
2970    FOR X=0 TO 1            ! ****** LOOP ********
2980    !
2990    IF X = 0 THEN GOTO PRINT'CURVE'DATA
3000    TIMES'CALLED = TIMES'CALLED + 1 : PAGE = INT((TIMES'CALLED/3) + 1)
3010    SETS'OF'DATA'ON'PAGE = SETS'OF'DATA'ON'PAGE + 1
3020    IF TIMES'CALLED = 1 GOTO PRINT'HEADER
3030    IF SETS'OF'DATA'ON'PAGE < 4 GOTO PRINT'CURVE'DATA
3040    SETS'OF'DATA'ON'PAGE = 1
3050    !-------------------------
3060    PRINT'HEADER:
3070    !-------------------------
3080    ? #1
3090    ? #1
3100    ? #1,"H O R I Z O N T A L    C U R V E    D A T A        Page # ";PAGE
3110    ? #1,"-------------------------------------------"
3120    ? #1
3130    ? #1,"Data  Created  For : ";JOB'NAME
3140    ? #1,"                On : ";TODAYS'DATE
3150    ? #1,"                By : ";YOUR'NAME
3160    IF SAVE'OUTPUT = "N" GOTO NO'PRINT
3170    ? #1,"This Data Saved On : ";OUT'FILE'SPEC
3180    !-------------------------
3190    NO'PRINT:
3200    !-------------------------
3210    IF SAVE'OUTPUT = "N" THEN ? #1,"No Data File Was Saved"
3220    ? #1
3230    ? #1
3240    !------------------------
3250    PRINT'CURVE'DATA:
3260    !------------------------
3270    IF X = 0 THEN ? TAB(-1,0);
3280    IF X = 0 THEN ? TAB(12,1);
3290    IF QUERY = "Y" AND X = 1 THEN ? #1"THIS IS THE NEW ADJUSTED CURVE"
3300    IF QUERY = "Y" AND X = 0 THEN ? " THIS IS THE NEW ADJUSTED CURVE"
3310    ? #X,USING " DATA FOR CURVE NUMBER : ####,.##",CURVE'NUMBER
3320    ? #X
3330    ? #X,USING "     PC = ######,.##      Point Of Curvature",P'OF'C
3340    ? #X,USING "     PI = ######,.##      Point Of Intersection",P'OF'I
3350    ? #X,USING "     PT = ######,.##      Point Of Tangency",P'OF'T
3360    ? #X
3370    ? #X,USING "      I =     ###.##      Interior Angle",INT'ANGLE
3380    ? #X,USING "      D =     ###.##      Degree Of Curve",DEGREE
3390    ? #X,USING "      T =  #####,.##      Tangent Length",TANGENT
3400    ? #X,USING "      L =  #####,.##      Arc Length",LENGTH
3410    ? #X,USING "      E =  #####,.##      External Distance",EXTERNAL
3420    ? #X,USING "      R =  #####,.##      Radius Length",RADIUS
3430    ? #X,USING "      M =  #####,.##      Middle Ordinate",MID'ORD
3440    ? #X,USING "      C =  #####,.##      Chord Length",CHORD
3450    ? #X : ? #X : ? #X
3460    NEXT X
3470    RETURN
3480    !
3490    !---------
3500    CALC'DATE:
3510    !---------
3520    !
3530    ! This SUBROUTINE will display the date in the following form:
3540    ! DAY NAME ,  MONTH NAME , DAY # , YEAR , HOUR , MIN , SEC , AM or PM
3550    ! All this data is displayed on one line
3560    ! Written by: Paul Blais   H.D.A.  Inc.
3570    !      Date : July 22,1984
3580    !
3590    !
3600    !
3610    !
3620    !C A L C U L A T E    T H E    D A T E
3630    !
3640    BINDATE = DATE                          ! DATE IS A BASIC VARIABLE
3650                                            ! IT CONTAINS THE BINARY VALUE
3660                                            ! WE MUST NOW CONVERT
3670    !
3680    !C O N V E R T   T O    T H E    D A Y    N A M E
3690    !
3700    IF DAY'NAME = 6 THEN DAY$ = "Sunday" : GOTO CALC'MONTH
3710    IF DAY'NAME = 5 THEN DAY$ = "Saturday" : GOTO CALC'MONTH
3720    IF DAY'NAME = 4 THEN DAY$ = "Friday" : GOTO CALC'MONTH
3730    IF DAY'NAME = 3 THEN DAY$ = "Thursday" : GOTO CALC'MONTH
3740    IF DAY'NAME = 2 THEN DAY$ = "Wednesday" : GOTO CALC'MONTH
3750    IF DAY'NAME = 1 THEN DAY$ = "Tuesday" : GOTO CALC'MONTH
3760    IF DAY'NAME = 0 THEN DAY$ = "Monday" : GOTO CALC'MONTH
3770    !
3780    !C O N V E R T   T O    T H E    M O N T H    N A M E
3790    !
3800    CALC'MONTH:
3810    IF MONTH = 1 THEN MO$ =  "January" : GOTO PUT'ALL
3820    IF MONTH = 2 THEN MO$ =  "February" : GOTO PUT'ALL
3830    IF MONTH = 3 THEN MO$ =  "March" : GOTO PUT'ALL
3840    IF MONTH = 4 THEN MO$ =  "April" : GOTO PUT'ALL
3850    IF MONTH = 5 THEN MO$ =  "May" : GOTO PUT'ALL
3860    IF MONTH = 6 THEN MO$ =  "June" : GOTO PUT'ALL
3870    IF MONTH = 7 THEN MO$ =  "July" : GOTO PUT'ALL
3880    IF MONTH = 8 THEN MO$ =  "August" : GOTO PUT'ALL
3890    IF MONTH = 9 THEN MO$ =  "September" : GOTO PUT'ALL
3900    IF MONTH = 10 THEN MO$ = "October" : GOTO PUT'ALL
3910    IF MONTH = 11 THEN MO$ = "November" : GOTO PUT'ALL
3920    IF MONTH = 12 THEN MO$ = "December"
3930    PUT'ALL:
3940    !
3950    !P U T   I T    A L L   T O G E T H E R
3960    !
3970    TODAYS'DATE = DAY$+"  "+MO$+" "+DAY+",19"+YEAR  ! Put all this data into one string
3980    !
3990    RETURN