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