ATLAS.BAS

1000 A=100: GOTO 20: REM ## ATLAS ##
1010 SR$="ATLAS": HO=INT((HO-LEN(SR$)-6)/2): VE=0: CN=0
1020 GOSUB 110: GOSUB 150: PRINT: C=(3>2): P1=3.14159
1030 INPUT"0=Welt; 1=Karte; 2=Globus =";A: IF A=2 THEN 1320
1040 IF A=0 THEN XX=1/360:YY=-1/205:XL=180:YL=-100:GOTO 1090
1050 PRINT"Laengen":INPUT"Anfang =";XL:XL=-XL
1060 INPUT"Ende =";XX:XX=1/(XX+XL)
1070 PRINT"Breite =":INPUT"Anfang =";YY
1080 INPUT"Ende =";YL:YY=1/(YY-YL): YL=-YL
1090 RESTORE: GOSUB 600
1100 FOR I=1 TO 1000
1110 IF C THEN READ H,V:D=V>INT(V):HO=(XL+H)*XX
1120 IF C THEN VE=(YL+V)*YY:GOSUB 620:C=D:IF C THEN 1110
1130 READ H,V: IF H=1.5 THEN I=1000: GOTO 1180
1140 C=V>INT(V):H=(XL+H)*XX:V=(YL+V)*YY
1150 D=(ABS(HO-H)>.7)OR(ABS(VE-V)>.7) 
1160 IF D THEN HO=H:VE=V:GOSUB 620:GOTO 1180
1170 HO=H:VE=V:GOSUB 630
1180 NEXT
1190 INPUT Taste";A: GOSUB 110: GOTO 1030
1200 !------- KUGEL->POLAR -----
1210 Y=R*CP:X=Y*CL:Y=Y*SL:Z=R*SP
1220 XX=AX*X+AY*Y+AZ*Z:YY=BX*X+BY*Y+BZ*Z
1230 ZZ=CX*X+CY*Y+CZ*Z:IF YY>0 THEN F2=0:F1=0:RETURN 
1240 X2=X0+XX*3/4:Y2=Y0-ZZ:F2=1
1250 IF F1=0 THEN X1=X2:Y1=Y2:F1=1:RETURN
1260 REM------- Gerade ---------
1270 HO=X1:VE=1-Y1:GOSUB 620:IF F4=1 THEN 1290
1280 HO=X2: VE=1-Y2: GOSUB 630
1290 X1=X2:Y1=Y2:F4=0:IF F3=1 THEN F4=1
1300 RETURN
1310 REM------- Globus ----------
1320 PRINT"Teil Globus":PRINT
1330 PRINT"alle Winkel in Grad":BM=P1/180
1340 INPUT"Geografische Laenge=";CW:C=-(CW+90)*BM
1350 INPUT"Geografische Breite=";AW:A=-AW*BM
1360 INPUT"Achs-Neigung=";BW:B=-BW*BM
1370 INPUT"Raster-Abstand=";QW:Q=QW*BM
1380 RESTORE:GOSUB 600:X0=.5:Y0=.5:R=.45
1390 S1=SIN(A):S2=SIN(B):S3=SIN(C)
1400 C1=COS(A):C2=COS(B):C3=COS(C)
1410 AX=C2*C3:AY=-C2*S3:AZ=S2
1420 BX=C1*S3+S1*S2*C3:BY=C1*C3-S1*S2*S3
1430 BZ=-S1*C2:CX=S1*S3-C1*S2*C3
1440 CY=S1*C3+C1*S2*S3:CZ=C1*C2
1450 R2=R*3/4:HO=X0+R2:VE=Y0:GOSUB 620
1460 FOR I=P1/50 TO 2.01*P1 STEP P1/50
1470   HO=X0+R2*COS(I):VE=Y0+R*SIN(I)
1480   GOSUB 630
1490 NEXT I
1500 REM------- Karte ----------
1510 F1=0:C0=1
1520 FOR I=1 TO 1000
1530   READ A,B: IF A<0 THEN A=360+A
1540   F3=0: IF B<>INT(B) THEN F3=1
1550   IF A=1.5 THEN I=1000: GOTO 1580
1560   L=A*BM:P=-B*BM:CL=COS(L):SL=SIN(L)
1570   CP=COS(P):SP=SIN(P):GOSUB 1210
1580 NEXT I
1590 REM------ Laengenkreise -----
1600 FOR L=0 TO P1-Q/2 STEP Q
1610  F1=0:CL=COS(L):SL=SIN(L)
1620   FOR P=0 TO P1+P1+BM STEP 2.5*BM
1630    CP=COS(P):SP=SIN(P): GOSUB 1210
1640   NEXT P
1650 NEXT L
1660 REM------ Breitenkreise -----
1670 FOR P=-P1/2+Q TO P1/2-Q/2 STEP Q
1680  F1=0:CP=COS(P):SP=SIN(P)
1690   FOR L=0 TO P1+P1+BM STEP 2.5*BM
1700    CL=COS(L):SL=SIN(L): GOSUB 1210
1710   NEXT L
1720 NEXT P
1730 PRINT"Laenge  =";CW:PRINT"Breite  =";AW
1740 PRINT"Neigung =";BW:PRINT"Raster  =";QW
1750 INPUT"Taste";A$
1760 GOSUB 110:GOTO 1030
25000 REM---------- Daten ---------
25010 DATA -6,50,-6,50,-2,51,2,52,2,54,-2,56,-3,58
25020 DATA -6,56,-4,54,-6,52,-3,52,-6,50.1,-10,52
25030 DATA -6,52,-6,55,-10,54,-10,52.1,-1,60.1,-6,63.1
25040 DATA 16,76,11,80,20,81,27,80,16,76.1,60,82.1
25050 DATA -18,64,-14,66,-15,67,-21,66,-24,67,-24,65
25060 DATA -18,64.1,-8,37,-9,40,-9,43,-5,43,-2,43
25070 DATA -2,46,-5,48,-2,48,-2,50,2,50,2,51
25080 DATA 6,54,8,54,8,57,11,57,10,55,11,54
25090 DATA 13,55,15,54,18,55,22,55,23,57,24,56
25100 DATA 24,59,27,59,30,60,27,61,23,60,22,63
25110 DATA 26,65,24,66,19,63,20,60,17,58,16,56
25120 DATA 13,56,11,60,7,57,7,62,10,64,13,67 
25130 DATA 18,70,22,70,26,72,32,70,35,69,42,68
25140 DATA 38,67,33,67,35,65,37,67,35,66,40,65
25150 DATA 42,67,44,69,46,68,47,67,54,69,60,70
25160 DATA 53,73,60,76,68,77,60,75,55,72,60,70
25170 DATA 68,68,69,73,73,73,70,67,75,71,80,74
25180 DATA 86,73,90,76,95,76,100,76,105,77,110,76
25190 DATA 113,74,118,73,123,73,128,73,131,71,135,72
25200 DATA 140,72,145,73,150,73,155,71,160,71,165,69
25210 DATA 170,70,175,70,180,68,-175,68,-171,67,-173,64
25220 DATA -176,66,180,67,178,65,180,63,175,62,170,60
25230 DATA 165,60,162,58,162,55,160,53,157,51,155,55
25240 DATA 157,57,160,59,165,63,160,61,157,62,155,59
25250 DATA 150,59,145,59,140,58,135,55,140,54,141,51
25260 DATA 140,48,136,44,133,43,130,43,128,39,129,35
25270 DATA 126,34,126,38,124,40,121,38,122,41,117,39
25280 DATA 119,37,123,37,119,35,122,32,120,30,122,30
25290 DATA 120,27,117,23,114,22,110,21,108,22,106,20
25300 DATA 108,16,109,13,105,9,103,11,100,13,100,9
25310 DATA 103,5,104,1,101,5,98,10,98,14,97,17,94,16
25320 DATA 93,20,92,23,87,22,85,19,81,16,80,13
25330 DATA 80,10,77,8,75,13,73,17,73,22,71,21
25340 DATA 68,23,66,25,62,25,57,26,54,26,51,29
25350 DATA 50,30,48,29,51,26,52,24,56,26,60,23
25360 DATA 57,19,52,16,47,14,43,13,43,17,39,22
25370 DATA 37,25,35,28,35,25,37,22,38,18,41,15
25380 DATA 44,12,47,12,51,13,49,6,46,3,43,0
25390 DATA 40,-4,39,-7,41,-11,41,-16,37,-17,35,-20
25400 DATA 35,-24,33,-26,32,-30,28,-33,25,-34,20,-35
25410 DATA 18,-33,16,-28,14,-23,13,-20,12,-17,13,-14
25420 DATA 14,-11,14,-8,12,-4,9,0,10,5,6,5,4,6
25430 DATA -1,5,-7,4,-11,6,-14,10,-16,13,-16,17
25440 DATA -16,21,-14,24,-10,30,-6,33,-5,36,-2,35
25450 DATA 1,37,5,37,10,37,10,33,15,32,20,31
25460 DATA 20,33,22,33,26,32,31,32,34,32,36,37
25470 DATA 31,37,27,37,26,41,23,40,25,36,23,35
25480 DATA 20,40,19,42,13,45,12,44,18,40,16,38
25490 DATA 16,40,12,42,8,44,5,43,3,43,0,40
25500 DATA -3,36,-6,36,-8,37.1,100,78,105,78,95,82
25510 DATA 91,80,100,78.1,137,75,150,75,138,76,137,75.1
25520 DATA 142,46,142,50,142,54,144,49,142,46,140,41
25530 DATA 140,38,136,36,133,35,130,34,131,31,132,33
25540 DATA 136,34,140,35,141,38,141,42,145,43,142,45.1
25550 DATA 121,23.1,121,18,124,13,125,6.1,105,-5,100,0
25560 DATA 95,5,100,3,103,0,105,-5,110,-7,115,-8
25570 DATA 120,-9,125,-8.1,115,8,110,2,110,-3,115,-4
25580 DATA 118,0,118,5,115,8.1,125,2,120,0,120,-5.1
25590 DATA 123,-5,120,-2,125,-2,130,-3,135,-6,138,-8
25600 DATA 142,-8,145,-5,150,-10,145,-3,140,-3,135,-2
25610 DATA 130,-3.1,148,-5,155,-8,160,-10.1,165,-22.1
25620 DATA 175,-18.1,110,19.1,80,10,80,6,82,7,80,10.1
25630 DATA 49,-12,44,-16,44,-21,43,-23,45,-26,47,-25,48,-20
25640 DATA 51,-15,49,-12.1,33,35.1,25,35.1,14,37.1,9,40.1
25650 DATA 9,42.1,3,39.1,38,47,34,45,36,45,34,44,33,46
25660 DATA 28,43,30,42,35,43,40,42,42,43,36,45
25670 DATA 38,47.1,50,41,48,37,53,36,53,42,50,46
25680 DATA 53,47,47,46,50,41.1,58,44,61,44,62,47
25690 DATA 59,46,58,44.1,74,46,79,46.1,104,52,110,56.1
25700 DATA 143,-11,145,-15,147,-20,152,-24,153,-28,153,-32
25710 DATA 150,-37,146,-38,141,-37,138,-35,136,-35,132,-32
25720 DATA 127,-33,123,-34,118,-35,115,-33,115,-29,114,-25
25730 DATA 114,-22,118,-21,121,-20,123,-16,126,-14
25740 DATA 130,-15,131,-12,136,-13,135,-15,140,-17
25750 DATA 142,-15,143,-11.1,175,-42
25760 DATA 178,-38,173,-35,175,-42,170,-45,166,-45
25770 DATA 172,-41,175,-42.1,147,-43.1,-70,76,-60,76
25780 DATA -55,73,-54,68,-51,63,-44,60,-40,65,-33,67,-23,70
25790 DATA -20,74,-20,78,-15,82,-30,83,-40,83,-50,83
25800 DATA -60,83,-70,83,-80,83,-90,83,-97,80,-90,75
25810 DATA -80,75,-70,76.1,-125,75.1,-100,73.1,-93,74.1
25820 DATA -80,70,-74,67,-78,65,-72,64,-65,63,-62,67,-70,71
25830 DATA -80,73,-90,73,-86,70,-80,70,-84,66,-80,64
25840 DATA -90,64,-95,60,-90,57,-86,56,-82,56,-80,52
25850 DATA -79,56,-76,58,-76,62,-70,62,-68,58,-64,61
25860 DATA -62,56,-57,54,-55,52,-54,48,-59,48,-54,52
25870 DATA -62,50,-66,50,-71,47,-66,49,-65,46,-60,46
25880 DATA -65,45,-70,45,-74,40,-76,36,-82,32,-80,27
25890 DATA -82,25,-84,30,-89,30,-94,29,-97,26,-97,22
25900 DATA -95,18,-91,18,-90,21,-86,21,-88,16,-84,16
25910 DATA -84,10,-80,10,-76,8,-72,12,-67,11,-62,10
25920 DATA -58,7,-53,5,-50,1,-46,-2,-42,-3,-37,-5
25930 DATA -35,-8,-37,-12,-38,-17,-40,-20,-43,-23,-47,-24
25940 DATA -48,-28,-52,-32,-55,-35,-58,-35,-56,-37,-60,-39
25950 DATA -65,-42,-66,-46,-65,-47,-67,-50,-65,-55,-70,-55
25960 DATA -74,-52,-74,-47,-74,-42,-74,-38,-72,-33,-72,-28
25970 DATA -71,-23,-71,-18,-75,-15,-78,-11,-81,-6,-81,-1
25980 DATA -78,2,-77,5,-77,8,-82,7,-86,10,-90,13
25990 DATA -95,16,-97,16,-102,17,-106,20,-106,23,-110,27
26000 DATA -113,32,-113,27,-110,23,-115,27,-116,32,-120,34
26010 DATA -123,37,-124,43,-125,47,-127,51,-131,54,-138,58
26020 DATA -144,60,-150,60,-155,56,-163,55,-157,58,-163,58
26030 DATA -166,62,-161,65,-168,66,-162,67,-165,68,-158,72
26040 DATA -149,71,-140,69,-135,68,-130,70,-122,69,-115,68
26050 DATA -108,68,-100,68,-95,70,-88,72,-80,70.1
26060 DATA -125,74,-125,72,-115,72,-115,69,-110,68,-101,69
26070 DATA -105,74,-115,73,-125,74.1,-85,22,-80,23,-75,20
26080 DATA -70,18,-65,18,-62,15.1,-60,-63,-65,-66,-60,-72
26090 DATA -50,-75,-40,-76,-30,-75,-20,-72,-10,-70,0,-70
26100 DATA 10,-70,20,-72,30,-69,40,-70,50,-65,60,-67
26110 DATA 70,-70,80,-68,90,-66,100,-65,110,-67,120,-67
26120 DATA 130,-65,140,-65,150,-70,160,-70,170,-73,165,-78
26130 DATA 177,-78,-171,-78.1,-169,-78,-160,-78,-150,-74
26140 DATA -140,-73,-130,-72,-120,-70,-110,-72
26150 DATA -100,-70,-90,-70,-80,-70,-75,-68
26160 DATA -63,-65,-60,-63,1.5,5,6
30000 REM -------- Anmerkungen --------------
30010 REM Dies Programm geht auf eine Fassung vom
30020 REM 13.4.85 von mir zurueck, die im BASIC
30030 REM 1*1 des Programmierens verwendet wurde.
30040 REM Dabei wurde ein groesser Datensatz
30050 REM von B.Biener, Erfurt verwendet, der
30060 REM Die Daten sind wie folgt kodiert:
30070 REM Winkelangaben: geogr. Breite, Laenge
30080 REM Wenn eine Linie endet, dann Breite+.1
30090 REM die letzten Werte muessen 1.5,5 sein
30100 REM So kann die Karte beliebig verbessert
30110 REM werden. Gewuenscht waere ein etwa
30120 REM 3-mal so grosser Datensatz. Wer
30130 REM erzeugt ihn?
30140 REM Relativ leicht lassen sich mit dem
30150 REM Datensatz vielfaeltige andere Karten
30160 REM erzeugen.
32000 REM --------- Autorschaft ---------
32010 REM siehe oben. H.Voelz; 23.7.89
32020 REM fuer Buch BASICODE
32030 REM IBM-compatibler Rechner