home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
8bitfiles.net/archives
/
archives.tar
/
archives
/
genie-commodore-file-library
/
C64Educational
/
GRT-CIR.V1.ARC
/
ITINERARY
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2019-04-13
|
6KB
|
211 lines
100 REM ITINERARY PRINTER
110 REM WRITTEN BY KURT BRANDON
120 DIMIN$(60):POKE53281,1:POKE53280,13:POKE646,0
130 DN=PEEK(186):REM DRIVE ADDRESS
140 PN=4:REM PRINTER DEVICE NUMBER
150 OA=5:REM OPEN ADDRESS FOR TRANSPARENT MODE
160 Z$=CHR$(0)
170 ES$=CHR$(27):REM PRINTER ESCAPE CODE
180 UL=223:REM ASCII VALUE OF UNDERLINE SYMBOL
190 FF$=CHR$(12):REM PAGE EJECT COMMAND
200 QT$=CHR$(34):REM QUOTE MARK
210 SE$=CHR$(68)+CHR$(10)+CHR$(17)+CHR$(29)+CHR$(45)+CHR$(51)+CHR$(63)+Z$
220 REM TABS: COL 10,17,19,45,51,63
230 LS$=CHR$(65)+CHR$(9):REM SET LINE SPACING TO 9/72 (1/8) INCH
240 TA$=CHR$(9):REM TAB COMMAND
250 RS$=CHR$(64):REM PRINTER RESET COMMAND
260 LF$=CHR$(10):REM LINEFEED COMMAND
270 DS$=ES$+CHR$(83)+CHR$(48)+"O"+ES$+CHR$(84)
280 REM DS$ IS A SUPERSCRIPT "O" AND IS USED FOR THE DEGREE SYMBOL
290 BS$=CHR$(8):REM BACKSPACE CHARACTER
300 :
310 :
320 :
330 PRINT"[147][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210]"
340 PRINT" ITINERARY PRINTER"
350 PRINT"[197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197]"
360 FORI=1TO30:EB$=EB$+CHR$(UL):NEXT
370 NP$=" "
380 POKE650,255
390 DEFFNDS(R)=(R-INT(R))
400 D=1:K=111.11:M=57.2957795:N=60:S=69.041
410 PRINT" PLACE NAMES (60 NAMES MAX)"
420 PRINT""QT$"PLACE NAME"QT$" RETURN[146] TO ENTER"
430 PRINTSPC(13)"RETURN[146] ALONE TO START"
440 INPUTIN$(KK)
450 IFIN$(KK)=""THEN470
460 KK=KK+1:GOTO440
470 OPEN15,DN,15,"I0"
480 PRINT"VERIFYING PRESENCE OF ALL LOCATIONS"
490 NE=0:FORI=1TO10:EE(I)=0:NEXT
500 FORI=0TOKK-1
510 SA$=IN$(I):HX$=SA$
520 GOSUB2010:GOSUB1870
530 IFNR=1THENNE=NE+1:EE(NE)=I:MF=1:PRINT""HX$"[144] IS NOT IN FILE"
540 NEXT
550 IFMF<>1THEN600
560 INPUT" ARE THESE SPELLING ERRORS (Y/N)";G$
570 IFG$<>"Y"ANDG$<>"N"THENPRINT"[145][145][145][145]":GOTO560
580 IFG$="N"THENFORI=1TO15:CLOSEI:NEXT:END
590 GOSUB2110:GOTO480
600 PRINT"[145] "
610 PRINT"ALL ABOARD! STARTING WORK"
620 OPEN1,PN,OA:PRINT#1,ES$LS$:PRINT#1,ES$SE$
630 SA$=IN$(0):GOSUB2010
640 GOSUB1870
650 N4$=SA$:F6=LA:F6$="N":IFLA<0THENF6$="S"
660 RV=LA:GOSUB1730:D6$=RV$
670 F7=LO:F7$="W":IFLO<0THENF7$="E"
680 RV=LO:GOSUB1730:D7$=RV$
690 FORI=1TOKK-1STEP2
700 A=F6/M:L1=F7:N1$=N4$:F0=F6:F0$=F6$:D0$=D6$:F1=F7:F1$=F7$:D1$=D7$
710 SA$=IN$(I):GOSUB2010:GOSUB1870
720 N2$=SA$:F2=LA:F2$="N":IFLA<0THENF2$="S"
730 RV=LA:GOSUB1730:D2$=RV$
740 F3=LO:F3$="W":IFLO<0THENF3$="E"
750 RV=LO:GOSUB1730:D3$=RV$
760 B=LA/M:L2=LO:GOSUB970
770 B1=C:GOSUB1090:BO$=D9$:W1=D
780 IFI=>KK-1THENGOSUB1280:GOTO2070
790 A=B:L1=L2:N3$=N2$:F4=F2:F4$=F2$:D4$=D2$:F5=F3:F5$=F3$:D5$=D3$
800 SA$=IN$(I+1):GOSUB2010:GOSUB1870
810 N4$=SA$:F6=LA:F6$="N":IFLA<0THENF6$="S"
820 RV=LA:GOSUB1730:D6$=RV$
830 F7=LO:F7$="W":IFLO<0THENF7$="E"
840 RV=LO:GOSUB1730:D7$=RV$
850 B=LA/M:L2=LO:GOSUB970:B2=C
860 GOSUB1090:BT$=D9$:W2=D
870 GOSUB1460
880 NP=NP+2:IFNP<8THEN920
890 PRINT"PUT A NEW SHEET IN THE PRINTER"
900 PRINT"AND HIT ANY KEY"
910 POKE198,0:WAIT198,1:NP=0
920 NEXT
930 GOTO2070
940 :
950 :
960 :
970 REM\ CALCULATIONS
980 L=(L1-L2)/M:E=SIN(A)*SIN(B)+COS(A)*COS(B)*COS(L)
990 D=-ATN(E/SQR(1-E*E))+1.57079:C=(SIN(B)-SIN(A)*E)/(COS(A)*SIN(D))
1000 IFC>=1THENC=0:GOTO1030
1010 IFC<=-1THENC=180/M:GOTO1030
1020 C=-ATN(C/SQR(1-C*C))+1.57079
1030 C=C*M
1040 IFSIN(L)<0THENC=360-C
1050 RETURN
1060 :
1070 :
1080 :
1090 REM\ CONVERT NUMBER BEARING TO STRING WITH SYMBOLS
1100 DG=INT(C):MZ=60*FNDS(C):SC=60*FNDS(MZ)
1110 IFSC=>30THENMZ=MZ+1
1120 IFMZ=>60THENMZ=MZ-60:DG=DG+1
1130 MZ=INT(MZ):D9$=STR$(DG)+DS$+STR$(MZ)+"'"
1140 RETURN
1150 :
1160 :
1170 :
1180 REM\ POSITION & ERROR SUB
1190 RH=INT(RN/256):RL=RN-(256*RH)
1200 PRINT#15,"P"+CHR$(96+8)+CHR$(RL)+CHR$(RH)+CHR$(1)
1210 INPUT#15,E,E$,AA,B
1220 IF E=0ORE=50THENRETURN
1230 PRINTE;E$;AA;B
1240 CLOSE8:CLOSE15:STOP
1250 :
1260 :
1270 :
1280 REM\ 1-COLUMN PRINTER OUTPUT SUB
1290 PRINT#1,TA$N1$:PRINT#1,LF$
1300 PRINT#1,TA$TA$ABS(INT(1000*F0))/1000F0$TA$D0$:PRINT#1,LF$
1310 PRINT#1,TA$TA$ABS(INT(1000*F1))/1000F1$TA$D1$:PRINT#1,LF$
1320 PRINT#1,TA$N2$:PRINT#1,LF$
1330 PRINT#1,TA$TA$ABS(INT(1000*F2))/1000F2$TA$D2$:PRINT#1,LF$
1340 PRINT#1,TA$TA$ABS(INT(1000*F3))/1000F3$TA$D3$:PRINT#1,LF$
1350 PRINT#1,TA$"BEARING":PRINT#1,LF$
1360 PRINT#1,TA$TA$INT(1000*B1)/1000BS$DS$:PRINT#1,LF$
1370 PRINT#1,TA$TA$BO$:PRINT#1,LF$:PRINT#1,TA$"DISTANCES":PRINT#1,LF$
1380 PRINT#1,TA$TA$INT(K*D*M)"KILOMETERS":PRINT#1,LF$
1390 PRINT#1,TA$TA$INT(S*D*M)"STATUTE MILES":PRINT#1,LF$
1400 PRINT#1,TA$TA$INT(N*D*M)"NAUTICAL MILES":PRINT#1,LF$
1410 PRINT#1,TA$EB$:PRINT#1,LF$:PRINT#1:PRINT#1,LF$
1420 RETURN
1430 :
1440 :
1450 :
1460 REM\ 2-COLUMN PRINTER OUTPUT SUB
1470 PRINT#1,TA$N1$TA$N3$:PRINT#1,LF$
1480 PRINT#1,TA$TA$ABS(INT(1000*F0))/1000F0$TA$D0$TA$TA$;
1490 PRINT#1,ABS(INT(1000*F4))/1000F4$TA$D4$:PRINT#1,LF$
1500 PRINT#1,TA$TA$ABS(INT(1000*F1))/1000F1$TA$D1$TA$TA$;
1510 PRINT#1,ABS(INT(1000*F5))/1000F5$TA$D5$:PRINT#1,LF$
1520 PRINT#1,TA$N2$TA$N4$:PRINT#1,LF$
1530 PRINT#1,TA$TA$ABS(INT(1000*F2))/1000F2$TA$D2$TA$TA$;
1540 PRINT#1,ABS(INT(1000*F6))/1000F6$TA$D6$:PRINT#1,LF$
1550 PRINT#1,TA$TA$ABS(INT(1000*F3))/1000F3$TA$D3$TA$TA$;
1560 PRINT#1,ABS(INT(1000*F7))/1000F7$TA$D7$:PRINT#1,LF$
1570 PRINT#1,TA$"BEARING"TA$TA$"BEARING":PRINT#1,LF$
1580 PRINT#1,TA$TA$INT(1000*B1)/1000BS$DS$TA$TA$TA$;
1590 PRINT#1,INT(1000*B2)/1000BS$DS$:PRINT#1,LF$
1600 PRINT#1,TA$TA$BO$TA$TA$TA$BT$:PRINT#1,LF$
1610 PRINT#1,TA$"DISTANCES"TA$TA$"DISTANCES":PRINT#1,LF$
1620 PRINT#1,TA$TA$INT(K*W1*M)" KILOMETERS"TA$TA$;
1630 PRINT#1,INT(K*W2*M)"KILOMETERS":PRINT#1,LF$
1640 PRINT#1,TA$TA$INT(S*W1*M)" STATUTE MILES"TA$TA$;
1650 PRINT#1,INT(S*W2*M)"STATUTE MILES":PRINT#1,LF$
1660 PRINT#1,TA$TA$INT(N*W1*M)" NAUTICAL MILES"TA$TA$;
1670 PRINT#1,INT(N*W2*M)"NAUTICAL MILES":PRINT#1,LF$
1680 PRINT#1,TA$EB$TA$EB$:PRINT#1,LF$:PRINT#1,LF$
1690 RETURN
1700 :
1710 :
1720 :
1730 REM\ DEGREES-MINUTES-SECONDS SUB
1740 RV=ABS(RV)
1750 DP=INT(RV):MP=60*FNDS(RV):SP=60*FNDS(MP):MP=INT(MP+.5):DM=1
1760 RV$=STR$(DP)+DS$+STR$(MP)+"'":RETURN
1770 :
1780 :
1790 :
1800 REM\ INVERT PLACE NAMES SUB
1810 TV=A1:A1=A2:A2=TV:TV$=H1$:H1$=H2$:H2$=TV$:TV$=AD$:AD$=A2$:A2$=TV$
1820 TV=L1:L1=L2:L2=TV:TV$=L1$:L1$=L2$:L2$=TV$:TV$=T2$:T2$=LT$:LT$=TV$
1830 TV$=N1$:N1$=N2$:N2$=TV$:TV=A:A=B:B=TV:RETURN
1840 :
1850 :
1860 :
1870 REM\ BINARY SEARCH SUB
1880 NR=0:OPEN8,DN,8,LEFT$(SA$,1):RN=1:GOSUB1180:GOSUB1200
1890 INPUT#8,MN:XI=LOG(MN)/LOG(2):XI=INT(XI)+1
1900 XM=XI-1:XI=2^XI:XX=XI/2
1910 IFXM<0THENNR=1:CLOSE8:RETURN
1920 XM=XM-1:RN=XX:GOSUB1180:GOSUB1200:INPUT#8,PL$,LA$,LO$
1930 IFSA$=PL$THENLA=VAL(LA$):LO=VAL(LO$):CLOSE8:RETURN
1940 IFSA$<PL$THENXX=XX-2^XM:GOTO1910
1950 XX=XX+2^XM
1960 IFXX>MNTHENXX=MN
1970 GOTO1910
1980 :
1990 :
2000 :
2010 REM\ FORMAT PLACE NAME SUB
2020 K2$="":FORII=1TOLEN(SA$):K2=ASC(MID$(SA$,II,1)):K2=K2AND127
2030 K2$=K2$+CHR$(K2):NEXT:SA$=K2$
2040 IFLEFT$(SA$,1)=" "THENSA$=RIGHT$(SA$,LEN(SA$)-1):GOTO2040
2050 IFLEN(SA$)<30THENSA$=SA$+LEFT$(NP$,30-LEN(SA$)):RETURN
2060 RETURN
2070 PRINT#1,ES$RS$:FORI=1TO15:CLOSEI:NEXT:END
2080 :
2090 :
2100 :
2110 REM\ CORRECT SPELLING ERRORS SUB
2120 PRINT"[147]THE MISPELLED NAME WILL BE GIVEN."
2130 PRINT"MAKE THE CORRECTION AND PRESS RETURN."
2140 FORJJ=1TONE
2150 PRINT""IN$(EE(JJ))
2160 INPUTIN$(EE(JJ))
2170 NEXT
2180 FORJJ=1TO10:EE(JJ)=0:NEXT:NE=0:NR=0:MF=0
2190 RETURN