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
