1' Goode Homolosine - Interrupted for Continents 2' Central longitude of map (Lambda0) = 0 Degrees 3' 4' =================================== 5' 6' Program Written by: 7' Paul B. Anderson (804) 853-7595 8' 3214 Chalfin Ave. 9' Norfolk, Va. 23513 10' 11' =================================== 12' 13' Main Map Formula From "AN ALBUM OF MAP PROJECTIONS" 14' by John P. Snyder & Philip M. Voxland, 1987. 15' (U.S. Geological Survey Professional Paper 1453) 16' 17' Function MollweideFormula# (Used in Mollweide Iteration) is from: 18' "MAP PROJECTIONS -- A WORKING MANUAL" 19' by John P. Snyder, 1987. 20' (U.S. Geological Survey Professional Paper 1395) 21' 22' ============== 23' Declarations 24' ============== 25' 26DECLARE SUB Alert () 27DECLARE SUB CRTColorMenu () 28DECLARE SUB DataPointsMenu () 29DECLARE SUB DrawGrid () 30DECLARE SUB DrawOutline () 31DECLARE SUB DrawProjection (PolyLine%) 32DECLARE SUB FeaturesMenu () 33DECLARE SUB GetMapData (FileName$) 34DECLARE SUB Goode (DeltaLambda#, Radius#, XCoord#, YCoord#) 35DECLARE SUB LatLongEntry (Title$, Note$) 36DECLARE SUB LatLongMenu () 37DECLARE SUB LongitudeFOR (Begin#, Finish#, Incr#) 38DECLARE SUB MakeLatitudeLines (LatRange%, LatDetail%) 39DECLARE SUB MakeLongitudeLines (LatRange%, LongDetail!) 40DECLARE SUB PlotFileColorMenu () 41DECLARE SUB ReadInfile (Byte%) 42DECLARE FUNCTION ArcCos# (n#) 43DECLARE FUNCTION ArcSin# (n#) 44DECLARE FUNCTION ArcTanH# (n#) 45DECLARE FUNCTION Atan2# (b#, a#) 46DECLARE FUNCTION Center% (Length%) 47DECLARE FUNCTION ConvertCoordToDecDeg# (coord#) 48DECLARE FUNCTION CoTan# (n#) 49DECLARE FUNCTION LN# (n#) 50DECLARE FUNCTION MollweideFormula# (ThetaPrime#, MPhi#) 51DECLARE FUNCTION Normalize# (LambdaVal#, Lambda0Val#) 52DECLARE FUNCTION PointCount& (PtCnt&) 53DECLARE FUNCTION PolyLineColor% (PolyLineHeader%) 54DECLARE FUNCTION Raise# (n#, Power#) 55DECLARE FUNCTION Round# (n#, PowerOfTen%) 56DECLARE FUNCTION Sec# (n#) 57DECLARE FUNCTION Sign# (n#) 58' 59' =========== 60' Constants 61' =========== 62' 63CONST FALSE = 0 64CONST TRUE = NOT FALSE 65CONST SQRT2 = 1.414213562373095# ' SQR(2) 66CONST DEG180 = 3.1415926535898# ' PI 67CONST DEG90 = 1.5707963267949# ' PI / 2 68CONST DEG360 = 6.2831853071796# ' PI * 2 69CONST DEG45 = .7853981633974501# ' PI / 4 70CONST RAD2DEG = 57.29577951308219# ' 180 / PI 71CONST DEG2RAD = 1.745329251994333D-02 ' PI / 180 72CONST MIN2RAD = 2.908882086657222D-04 ' DEG2RAD / 60 73CONST MERGEPOINT = .710988432654746# ' 40.73666 * DEG2RAD 74CONST TOLERANCE = .0000001# ' Tolerance value for Newton-Raphson routine 75CONST DTPINCR = .00001# ' Increment value for Delta Theta Prime 76' (inside Newton-Raphson routine) 77' 78' additional Degree Values used in this projection 79' Put Here to avoid repetitive calculation 80' 81CONST DEG10 = 10 * DEG2RAD 82CONST DEG20 = 20 * DEG2RAD 83CONST DEG30 = 30 * DEG2RAD 84CONST DEG40 = 40 * DEG2RAD 85CONST DEG50 = 50 * DEG2RAD 86CONST DEG60 = 60 * DEG2RAD 87CONST DEG80 = 80 * DEG2RAD 88CONST DEG100 = 100 * DEG2RAD 89CONST DEG140 = 140 * DEG2RAD 90CONST DEG160 = 160 * DEG2RAD 91 92CONST XCONST = .9003163161571041# ' (8# ^ .5#) / Deg180# 93CONST MOLLRFACTOR = .0528# ' Reduction factor applied to 94' Mollweide to match parallels 95' of sinusoidal portion of 96' the projection 97' 98CONST XCENTER = 320 ' VGA Center X 99CONST YCENTER = 240 ' VGA Center Y 100CONST ASPECT = 1 ' VGA mode 12 -- 640x480 aspect ratio = 1 101CONST CRTRADIUS = 100 ' Radius Value for CRT display 102CONST PLOTRADIUS = 1 ' Radius Value for Plot File 103CONST PLTXCENTER = 5588 ' (25.4 * 5.5#) / .025 104CONST PLTYCENTER = 4318 ' (25.4 * 4.25#) / .025 105CONST LAMBDA0 = 0 ' Central Longitude of map for Goode 106' Homolosine Interrupted for Continental 107' Lobes. 108' 109' ============================ 110' TYPE Definition For PNT file 111' ============================ 112' 113TYPE PNTRecord 114 Header AS INTEGER 115 Lat AS INTEGER 116 Lon AS INTEGER 117END TYPE 118' 119DIM SHARED PNTData AS PNTRecord 120' 121' ========================================= 122' Type Definition for Global Variables (G.) 123' ========================================= 124' 125TYPE GlobalVariables 126 CrtX AS DOUBLE ' Intermediate value for X Coordinate 127 CrtY AS DOUBLE ' Intermediate value for Y Coordinate 128 ModCrtX AS DOUBLE ' Modified to be centered on CRT 129 ModCrtY AS DOUBLE ' Modified to be centered on CRT 130 LastModCrtX AS DOUBLE 131 LastModCrtY AS DOUBLE 132 LastCrtY AS DOUBLE 133 Lambda AS DOUBLE ' Longitude in Radians 134 Lambda2 AS DOUBLE ' Central Longitude of Lobe 135 Phi AS DOUBLE ' Latitude in Radians 136 Visible AS INTEGER ' When True --> Draw PolyLine% 137 Grid AS INTEGER ' When True --> Draw Grid 138 Outline AS INTEGER ' When True --> Skip Lobe IF-Then statements 139 MapDataLevel AS INTEGER ' Levels 1 to 5 140 ExtensionLobe1 AS INTEGER ' When True --> Draw extension 1 141 ExtensionsLobe2 AS INTEGER ' When True --> Draw extensions 2 & 3 142 ColorVal AS INTEGER ' CRT Color Out 143 GridColor AS INTEGER ' CRT Color for Grid 144 CoastColor AS INTEGER ' CRT Color for Coasts 145 BorderColor AS INTEGER ' CRT Color for Political Borders 146 IslandColor AS INTEGER ' CRT Color for Islands 147 StateColor AS INTEGER ' CRT Color U.S. State borders 148 LakeColor AS INTEGER ' CRT Color for Lakes 149 RiverColor AS INTEGER ' CRT Color for Rivers 150 ProvinceColor AS INTEGER ' CRT Color for Canadian Provinces 151 AustColor AS INTEGER ' CRT Color for Australian States 152 MexicoColor AS INTEGER ' CRT Color for Mexican States 153 GridPen AS INTEGER ' Grid color for Plot File 154 CoastPen AS INTEGER ' Coast color for Plot File 155 BorderPen AS INTEGER ' Border color for Plot File 156 IslandPen AS INTEGER ' Island color for Plot File 157 StatePen AS INTEGER ' State color for Plot File 158 LakePen AS INTEGER ' Lake color for Plot File 159 RiverPen AS INTEGER ' River color for Plot File 160 ProvincePen AS INTEGER ' Canadian Province color for Plot File 161 AustPen AS INTEGER ' Australian State color for Plot File 162 MexicoPen AS INTEGER ' Mexican State color for Plot File 163 LastPlotPen AS STRING * 1 ' 164 PlotFile AS INTEGER ' When True Plot to a File 165 CoastSW AS INTEGER ' When True Plot to Crt or file 166 BorderSW AS INTEGER ' When True Plot to Crt or file 167 IslandSW AS INTEGER ' When True Plot to Crt or file 168 StateSW AS INTEGER ' When True Plot to Crt or file 169 LakeSW AS INTEGER ' When True Plot to Crt or file 170 RiverSW AS INTEGER ' When True Plot to Crt or file 171 ProvinceSW AS INTEGER ' When True Plot to Crt or file 172 AustSW AS INTEGER ' When True Plot to Crt or file 173 MexicoSW AS INTEGER ' When True Plot to Crt or file 174 LongStep AS INTEGER ' Grid Longitude Increment 175 LatStep AS DOUBLE ' Grid Latitude Increment 176 LongOption AS INTEGER ' 1 - Longitude to pole, 2 - ends at +/-85 deg. 177END TYPE 178 179DIM SHARED G AS GlobalVariables 180' 181' > variables used by GetPKDData example routines 182' 183' for the *.PKD file format 184' DIM SHARED Index AS DOUBLE 185' DIM SHARED PointsInLine AS LONG 186' DIM SHARED LonI AS DOUBLE 187' DIM SHARED LatI AS DOUBLE 188' DIM SHARED LonR AS DOUBLE 189' DIM SHARED LatR AS DOUBLE 190' DIM SHARED FeatureType AS INTEGER 191' DIM SHARED LoopCount AS LONG 192' DIM SHARED Infile$(23) 193 194' 195' ========================= 196' Program starting values 197' ========================= 198' 199' > Flags to tell the program when to draw the map inside the extensions 200' 201G.ExtensionLobe1 = FALSE 202G.ExtensionsLobe2 = FALSE 203' 204' > Starting CRT colors for Geographical features 205' 206G.GridColor = 0 ' Black 207G.CoastColor = 0 ' Black 208G.BorderColor = 4 ' Red 209G.IslandColor = 0 ' Black 210G.StateColor = 4 ' Red 211G.LakeColor = 1 ' Blue 212G.RiverColor = 1 ' Blue 213' 214' > Note: Color values for the following actually use U.S. State color 215' they are not hooked into the CRT color menu 216' 217G.ProvinceColor = 4 ' Red 218G.AustColor = 4 ' Red 219G.MexicoColor = 4 ' Red 220' 221' > Starting Plot File colors for Geographical features (Used by Corel Draw) 222' 223G.GridPen = 1 ' Black 224G.CoastPen = 1 ' Black 225G.BorderPen = 3 ' Red 226G.IslandPen = 1 ' Black 227G.StatePen = 3 ' Red 228G.LakePen = 2 ' Blue 229G.RiverPen = 2 ' Blue 230' 231' > Note: Color values for the following actually use U.S. State color 232' they are not hooked into the Pen color menu 233' 234G.ProvincePen = 3 ' Red 235G.AustPen = 3 ' Red 236G.MexicoPen = 3 ' Red 237' 238' > Starting Geographical Features (All ON) 239' 240G.CoastSW = TRUE 241G.BorderSW = TRUE 242G.IslandSW = TRUE 243G.StateSW = TRUE 244G.LakeSW = TRUE 245G.RiverSW = TRUE 246G.ProvinceSW = TRUE 247G.AustSW = TRUE 248G.MexicoSW = TRUE 249' 250' > Starting Latitude and longitude increment -- Traditional View 251' 252G.LongStep = 10# 253G.LatStep = 10# 254G.LongOption = 2 255' 256' > Starting Database level 257' 258G.MapDataLevel = 3 259' 260' > Plotting Variables, Plot Size = A 261' 262G.PlotFile = TRUE 263Plotpass% = 0 'WARNING: Will not write over existing file while in program. 264' 265' --------------- HOWEVER ------------------- 266' IF you EXIT the program and then restart it 267' It WILL write over existing Plot files!!!!! 268' ------------------------------------------- 269' 270UserQuits% = FALSE ' Don't Quit yet 271 272VIEW PRINT 1 TO 25 273' 274' { Main Program } 275' 276DO 277 MenuItem% = 0 ' No Menu Items Selected 278 COLOR 7, 9 279 CLS 280' 281 LOCATE 2, 29: PRINT "=======================" 282 LOCATE 3, 30: PRINT "W O R L D V I E W S" 283 LOCATE 4, 29: PRINT "=======================" 284 LOCATE 6, 24: PRINT "Map Projection Library, Volume 1" 285 LOCATE 8, 24: PRINT " 1. Draw" 286 LOCATE 16, 30: PRINT "World Views' Options" 287 LOCATE 18, 12: PRINT " 2. Change CRT Color of Geographical Features" 288 LOCATE 19, 12: PRINT " 3. Turn Geographical Features On/Off " 289 LOCATE 20, 12: PRINT " 4. Modify Latitude/Longitude Display" 290 LOCATE 21, 12: PRINT " 5. Increase/Decrease Amount of Points to Plot" 291 LOCATE 22, 12: PRINT " 6. Change Plot File Pen Colors of Geographical Features" 292 LOCATE 24, 21 293 INPUT "Select Menu Item (1-6) or 0 to Quit: ", MenuItem% 294' 295 SELECT CASE MenuItem% 296' 297 CASE 0 298 UserQuits% = TRUE 299 300 CASE 1 301 ' Draw the Map 302 Title$ = " Goode Homolosine Projection " 303 Note$ = "Central Longitude of Map is 0 Degrees" 304 CALL LatLongEntry(Title$, Note$) 305' 306 IF G.PlotFile THEN 307 Plotpass% = Plotpass% + 1 308 PlotFile$ = "C:\WV\WVPLOT" + LTRIM$(STR$(Plotpass%)) + ".PLT" 309 OPEN PlotFile$ FOR OUTPUT AS #1 310 PRINT #1, "IN; IP0,0,11176,8636; SP0;" 311 PRINT #1, "SC-5498,5498,-4249,4249;" 312 PRINT #1, "VS4; PT 0.1; SP1;" 313 G.LastPlotPen = "1" 314 END IF 315 316 SCREEN 12 ' Switch to VGA 480/640, 16 COLOR mode 317 VIEW (0, 0)-(639, 479), 7 318' 319 COLOR 10 320 Col% = Center%(LEN(Title$)) 321 LOCATE 1, Col%: PRINT Title$; 322 323 CALL DrawOutline 324 325' CALL GetPKDData 326 327 IF G.Grid THEN CALL DrawGrid 328 IF G.CoastSW THEN CALL GetMapData("PCoast.pnt") 329 IF G.IslandSW THEN CALL GetMapData("PIsland.pnt") 330 IF G.LakeSW THEN CALL GetMapData("Plake.pnt") 331 IF G.RiverSW THEN CALL GetMapData("River.pnt") 332 IF G.BorderSW THEN CALL GetMapData("PBorder.pnt") 333 IF G.StateSW THEN CALL GetMapData("PUSA48.pnt") 334 IF G.ProvinceSW THEN CALL GetMapData("PCanProv.pnt") 335 IF G.AustSW THEN CALL GetMapData("PAust.pnt") 336 IF G.MexicoSW THEN CALL GetMapData("PMexico.pnt") 337 338 G.ExtensionLobe1 = TRUE 339 IF G.CoastSW THEN CALL GetMapData("PCoast.pnt") 340 IF G.IslandSW THEN CALL GetMapData("PIsland.pnt") 341 342 G.ExtensionLobe1 = FALSE 343 G.ExtensionsLobe2 = TRUE 344 345 IF G.CoastSW THEN CALL GetMapData("PCoast.pnt") 346 IF G.IslandSW THEN CALL GetMapData("PIsland.pnt") 347 348 G.ExtensionsLobe2 = FALSE 349 350 IF G.PlotFile THEN 351 PRINT #1, "PU 0,0; SP00;" 352 CLOSE #1 353 END IF 354 355 CALL Alert ' BEEP 356 357 COLOR 12 358 LOCATE 1, Col%: PRINT Title$; 359 360 DO 361 Brk$ = INKEY$ 362 LOOP UNTIL Brk$ > "" 363 364 SCREEN 0 'Switch back to Text mode 365 VIEW PRINT 1 TO 25 366 367 CASE 2 368 ' Change Line Color of Geographical features 369 CALL CRTColorMenu 370 371 CASE 3 372 ' Turn Geographical features OFF or ON 373 CALL FeaturesMenu 374' 375 CASE 4 376 ' Change Latitude and Longitude Values 377 CALL LatLongMenu 378' 379 CASE 5 380 ' Change the Amount of Database Latitude and Longitude Values to plot 381 CALL DataPointsMenu 382' 383 CASE 6 384 ' Change the Line color of the Geographical features sent to the plot file 385 CALL PlotFileColorMenu 386' 387 CASE ELSE 388 PRINT CHR$(7); 389 390 END SELECT '{ MenuItem. } 391' 392LOOP UNTIL UserQuits% 393' 394END 395 396SUB Alert 397' { Sounds a tone when map is complete. } 398 399 SOUND 880, 36.4 400 401END SUB ' { Alert. } 402 403FUNCTION ArcCos# (n#) STATIC 404' 405IF n# <> 0 THEN 406 ArcCos# = ATN(Raise#(1 - (n# * n#), .5) / n#) + DEG180 * (n# - ABS(n#)) / (2 * n#) 407ELSE 408 n# = 0 409END IF 410' 411END FUNCTION '{ ArcCos#. } 412 413FUNCTION ArcSin# (n#) STATIC 414' 415 IF ABS(n#) < 1 THEN 416 ArcSin# = ATN(n# / Raise#(1 - (n# * n#), .5)) 417 EXIT FUNCTION 418 END IF 419 420 IF n# = 1 THEN 421 ArcSin# = DEG90 422 EXIT FUNCTION 423 END IF 424 425 IF n# = -1 THEN 426 ArcSin# = -DEG90 427 END IF 428' 429END FUNCTION ' { ArcSin#. } 430 431FUNCTION ArcTanH# (n#) STATIC 432' 433 AT1# = ABS(n#) 434' 435 IF AT1# < 1 THEN 436 AT2# = .5 * LN#((1 + AT1#) / (1 - AT1#)) 437 ArcTanH# = AT2# * Sign#(n#) 438 END IF 439' 440END FUNCTION ' { ArcTanH#.} 441 442FUNCTION Atan2# (b#, a#) 443' 444IF a# = 0 THEN 445 IF b# > 0 THEN 446 Atan2# = DEG90 447 ELSEIF b# < 0 THEN 448 Atan2# = -DEG90 449 ELSE 450 Atan2# = 0 451 END IF 452' 453ELSEIF b# = 0 THEN 454 IF a# < 0 THEN 455 Atan2# = DEG180 456 ELSE 457 Atan2# = 0 458 END IF 459' 460ELSE 461 IF a# < 0 THEN 462 IF b# > 0 THEN 463 Atan2# = ATN(b# / a#) + DEG180 464 ELSE 465 Atan2# = ATN(b# / a#) - DEG180 466 END IF 467' 468 ELSE 469 Atan2# = ATN(b# / a#) 470 END IF 471END IF 472' 473END FUNCTION '{ ATan2#. } 474 475FUNCTION Center% (Length%) 476' 477 IF Length% MOD 2 = 0 THEN 478 Column% = 40 - (Length% \ 2) 479 ELSE 480 Column% = (40 - (Length% \ 2)) + 1 481 END IF 482' 483 Center% = Column% 484' 485END FUNCTION '{ Center$. } 486 487FUNCTION ConvertCoordToDecDeg# (coord#) 488' Used by GetPKDData subroutine 489' 490 ConvertCoordToDecDeg# = coord# / 3600 491' 492END FUNCTION '{ ConvertCoordToDecDeg#. } 493 494FUNCTION CoTan# (n#) 495' 496 Sine# = SIN(n#) 497 IF ABS(Sine#) <= .0001 THEN 498 PRINT "Error: CoTan#(n#) Where n# <= 0" 499 SYSTEM 500 ELSE 501 CoTan# = COS(n#) / Sine# 502 END IF 503' 504END FUNCTION '{ CoTan#. } 505 506SUB CRTColorMenu 507' 508ExitMenu% = FALSE 509' 510DO 511 CLS 512 LOCATE 2, 18: PRINT "** Change CRT Color of Geographical Features **" 513 LOCATE 4, 36: PRINT "Color Codes" 514 LOCATE 5, 22: PRINT "0 - Black" 515 LOCATE 6, 22: PRINT "1 - Blue 6 - Brown 11 - Lt. Cyan " 516 LOCATE 7, 22: PRINT "2 - Green 7 - White 12 - Lt. Red " 517 LOCATE 8, 22: PRINT "3 - Cyan 8 - Dk. Grey 13 - Lt. Magenta" 518 LOCATE 9, 22: PRINT "4 - Red 9 - Lt. Blue 14 - Yellow" 519 LOCATE 10, 22: PRINT "5 - Magenta 10 - Lt. Green 15 - Br. White" 520 LOCATE 12, 28: PRINT "1. Grid Color is:"; G.GridColor 521 LOCATE 13, 28: PRINT "2. Coast Color is:"; G.CoastColor 522 LOCATE 14, 28: PRINT "3. Border Color is:"; G.BorderColor 523 LOCATE 15, 28: PRINT "4. Island Color is:"; G.IslandColor 524 LOCATE 16, 28: PRINT "5. State Border Color is:"; G.StateColor 525 LOCATE 17, 28: PRINT "6. Lake Color is:"; G.LakeColor 526 LOCATE 18, 28: PRINT "7. River Color is:"; G.RiverColor 527 LOCATE 20, 14 528 INPUT "Select Option (1-7) or 0 to Return to Main Menu: ", Menu% 529 530 SELECT CASE Menu% 531' 532 CASE 0 533 ExitMenu% = TRUE 534' 535 CASE 1 536 LOCATE 20, 1: PRINT SPACE$(80) 537 LOCATE 20, 14 538 INPUT "Change Grid Color to (0-15):", NewColor% 539' 540 IF NewColor% >= 0 AND NewColor% < 16 THEN 541 G.GridColor = NewColor% 542 ELSE 543 PRINT CHR$(7) 544 END IF 545' 546 CASE 2 547 LOCATE 20, 1: PRINT SPACE$(80) 548 LOCATE 20, 14 549 INPUT "Change Coastline Color to (0-15):", NewColor% 550' 551 IF NewColor% >= 0 AND NewColor% < 16 THEN 552 G.CoastColor = NewColor% 553 ELSE 554 PRINT CHR$(7) 555 END IF 556' 557 CASE 3 558 LOCATE 20, 1: PRINT SPACE$(80) 559 LOCATE 20, 14 560 INPUT "Change Border Color to (0-15):", NewColor% 561' 562 IF NewColor% >= 0 AND NewColor% < 16 THEN 563 G.BorderColor = NewColor% 564 ELSE 565 PRINT CHR$(7) 566 END IF 567' 568 CASE 4 569 LOCATE 20, 1: PRINT SPACE$(80) 570 LOCATE 20, 14 571 INPUT "Change Island Color to (0-15):", NewColor% 572' 573 IF NewColor% >= 0 AND NewColor% < 16 THEN 574 G.IslandColor = NewColor% 575 ELSE 576 PRINT CHR$(7) 577 END IF 578' 579 CASE 5 580 LOCATE 20, 1: PRINT SPACE$(80) 581 LOCATE 20, 14 582 INPUT "Change State Border Color to (0-15):", NewColor% 583' 584 IF NewColor% >= 0 AND NewColor% < 16 THEN 585 G.StateColor = NewColor% 586 ELSE 587 PRINT CHR$(7) 588 END IF 589' 590 CASE 6 591 LOCATE 20, 1: PRINT SPACE$(80) 592 LOCATE 20, 14 593 INPUT "Change Lake Color to (0-15):", NewColor% 594' 595 IF NewColor% >= 0 AND NewColor% < 16 THEN 596 G.LakeColor = NewColor% 597 ELSE 598 PRINT CHR$(7) 599 END IF 600' 601 CASE 7 602 LOCATE 20, 1: PRINT SPACE$(80) 603 LOCATE 20, 14 604 INPUT "Change River Color to (0-15):", NewColor% 605' 606 IF NewColor% >= 0 AND NewColor% < 16 THEN 607 G.RiverColor = NewColor% 608 ELSE 609 PRINT CHR$(7) 610 END IF 611' 612 CASE ELSE 613 PRINT CHR$(7) 614' 615 END SELECT '{ Menu. } 616' 617 LOOP UNTIL ExitMenu% 618' 619END SUB ' { CRTColor. } 620 621SUB DataPointsMenu 622' 623ExitMenu% = FALSE 624' 625DO 626 CLS 627' 628 LOCATE 2, 16: PRINT "** Increase/Decrease Amount of Points to Plot **" 629 LOCATE 4, 27: PRINT "Current Database Level is"; G.MapDataLevel 630 LOCATE 6, 25: PRINT "1. 179,331 X-Y Coordinate Pairs" 631 LOCATE 7, 25: PRINT "2. 109,992 X-Y Coordinate Pairs" 632 LOCATE 8, 25: PRINT "3. 27,393 X-Y Coordinate Pairs" 633 LOCATE 9, 25: PRINT "4. 14,867 X-Y Coordinate Pairs" 634 LOCATE 10, 25: PRINT "5. 5,365 X-Y Coordinate Pairs" 635 LOCATE 12, 18 636 PRINT "Select Option (1-5) to Change Database Level" 637 LOCATE 13, 18 638 INPUT " or 0 to Return to Previous Menu: ", Menu% 639' 640 SELECT CASE Menu% 641' 642 CASE 0 643 ExitMenu% = TRUE 644' 645 CASE 1 TO 5 646 G.MapDataLevel = Menu% 647' 648 CASE ELSE 649 PRINT CHR$(7) 650' 651 END SELECT '{ Menu. } 652' 653 LOOP UNTIL ExitMenu% 654' 655END SUB '{ DataPointsMenu. } 656 657SUB DrawGrid 658' 659 G.LastModCrtX = 0 660 G.LastModCrtY = 0 661 G.ColorVal = G.GridColor 662 663 LatRange% = 90 ' 664 LatDetail% = 5 ' Since Latitude Lines are straight no need to change 665 LongDetail! = .25 ' For Faster Screen Draws this variable can be increased 666 ' For "Publication" Quality vector Graphics try .1# 667 ' (slows screen draws and large increase 668 ' in plot file size) 669' 670' 671' > If G.LongOption is 1 - All Longitude lines converge at pole 672' If G.LongOption is 2 - Only draw longitude lines to within 5 Degrees 673' of the pole (Default value) 674' 675 SELECT CASE G.LongOption 676 677 CASE IS = 1 678 LatStop% = 90 679' 680 CASE IS = 2 681 LatStop% = 85 682' 683 END SELECT '{ G.LongOption. } 684' 685 CALL MakeLongitudeLines(LatStop%, LongDetail!) 686 CALL MakeLatitudeLines(LatRange%, LatDetail%) 687' 688END SUB '{ DrawGrid. } 689 690SUB DrawOutline STATIC 691' 692 G.Outline = TRUE 693 G.ColorVal = G.GridColor 694 G.LastModCrtX = 0 695 696 PolyLine% = TRUE 697 Increment# = DEG2RAD / 4 698 699 G.Lambda = -DEG180 700 G.Lambda2 = -DEG160 701 CALL LongitudeFOR(-DEG90, 0, Increment#) 702 G.Lambda2 = -DEG100 703 CALL LongitudeFOR(0, DEG90, Increment#) 704' 705' ================== 706' Insert 1 Longitude 707' ================== 708' 709 G.Lambda = -DEG10 710 G.Lambda2 = -DEG100 711 CALL LongitudeFOR(DEG90, DEG60, -Increment#) 712' 713' ================================= 714' Insert 1 Latitude (Bottom Border) 715' ================================= 716' 717 G.Phi = DEG60 718 G.Lambda2 = -DEG100 719 G.Lambda = -DEG10 720' 721 DO 722 CALL DrawProjection(PolyLine%) 723 G.Lambda = G.Lambda - Increment# 724 IF G.Lambda < -DEG40 THEN EXIT DO 725 LOOP 726' 727' ================================= 728' 729' ================================= 730' 731 G.Lambda = -DEG40 732 G.Lambda2 = -DEG100 733 CALL LongitudeFOR(DEG60, 0, -Increment#) 734 G.Lambda2 = DEG30 735 CALL LongitudeFOR(0, DEG60, Increment#) 736' 737' ================================= 738' Insert 2 Latitude (Bottom Border) 739' ================================= 740' 741 G.Phi = DEG60 742 G.Lambda2 = DEG30 743 G.Lambda = -DEG40 744 745 DO 746 CALL DrawProjection(PolyLine%) 747 G.Lambda = G.Lambda - Increment# 748 IF G.Lambda < -DEG50 THEN EXIT DO 749 LOOP 750' 751' ================== 752' Insert 2 Longitude 753' ================== 754' 755 G.Lambda = -DEG50 756 G.Lambda2 = DEG30 757 CALL LongitudeFOR(DEG60, DEG90, Increment#) 758' 759' ================== 760' Insert 3 Longitude 761' ================== 762' 763 G.Lambda = -DEG160 764 G.Lambda2 = DEG30 765 CALL LongitudeFOR(DEG90, DEG50, -Increment#) 766' 767' ================================= 768' Insert 3 Latitude (Bottom Border) 769' ================================= 770' 771 G.Phi = DEG50 772 G.Lambda2 = DEG30 773 G.Lambda = -DEG160 774 775 DO 776 CALL DrawProjection(PolyLine%) 777 G.Lambda = G.Lambda - Increment# 778 IF G.Lambda < -DEG180 THEN EXIT DO 779 LOOP 780 781' ================== 782' 783' ================== 784' 785 G.Lambda = DEG180 786 G.Lambda2 = DEG30 787 CALL LongitudeFOR(DEG50, 0, -Increment#) 788 G.Lambda2 = DEG140 789 CALL LongitudeFOR(0, -DEG90, -Increment#) 790 791 G.Lambda = DEG80 792 G.Lambda2 = DEG140 793 CALL LongitudeFOR(-DEG90, 0, Increment#) 794 G.Lambda2 = DEG20 795 CALL LongitudeFOR(0, -DEG90, -Increment#) 796 797 G.Lambda = -DEG20 798 G.Lambda2 = DEG20 799 CALL LongitudeFOR(-DEG90, 0, Increment#) 800 G.Lambda2 = -DEG60 801 CALL LongitudeFOR(0, -DEG90, -Increment#) 802 803 G.Lambda = -DEG100 804 G.Lambda2 = -DEG60 805 CALL LongitudeFOR(-DEG90, 0, Increment#) 806 G.Lambda2 = -DEG160 807 CALL LongitudeFOR(0, -DEG90, -Increment#) 808 809 PolyLine% = FALSE 810 CALL DrawProjection(PolyLine%) 811 812 G.Outline = FALSE '* 813' 814END SUB '{ DrawOutline. } 815 816SUB DrawProjection (PolyLine%) STATIC 817' 818IF G.ExtensionLobe1 THEN 819 G.Outline = FALSE 820 LongDeg# = CSNG(G.Lambda * RAD2DEG) 821 822 IF LongDeg# >= -40 AND LongDeg# <= -10 THEN 823 IF CSNG(G.Phi * RAD2DEG) >= 60 THEN 824 G.Lambda2 = -DEG100 825 G.Outline = TRUE 826 END IF 827 END IF 828 829 IF LongDeg# >= -180 AND LongDeg# <= -160 THEN 830 IF CSNG(G.Phi * RAD2DEG) >= 50 THEN 831 G.Lambda2 = DEG30 832 G.Outline = TRUE 833 END IF 834 END IF 835 IF G.Outline = FALSE THEN EXIT SUB 836END IF 837 838IF G.ExtensionsLobe2 THEN 839 G.Outline = FALSE 840 LongDeg# = CSNG(G.Lambda * RAD2DEG) 841 IF LongDeg# >= -50 AND LongDeg# <= -40 THEN 842 IF CSNG(G.Phi * RAD2DEG) >= 60 THEN 843 G.Lambda2 = DEG30 844 G.Outline = TRUE 845 END IF 846 END IF 847 IF G.Outline = FALSE THEN EXIT SUB 848END IF 849 850CALL Goode(G.Lambda, CRTRADIUS, G.CrtX, G.CrtY) 851 852IF G.PlotFile THEN 853 CALL Goode(G.Lambda, PLOTRADIUS, PlotX#, PlotY#) 854 PlotX# = ((25.4# * PlotX#) / .025#) '+ PltXCenter# 855 PlotY# = ((25.4# * PlotY#) / .025#) '+ PltYCenter# 856END IF 857' 858G.ModCrtX = FIX((G.CrtX * ASPECT) + XCENTER) 859G.ModCrtY = CINT(YCENTER) - FIX(G.CrtY) 860' 861IF PolyLine% = FALSE THEN G.Visible = FALSE 862' 863' > This statement eliminates the stray lines going from top to bottom 864' > for the Transverse Mercator and Cassini Projections 865' 866IF ABS(G.ModCrtY - G.LastModCrtY) > 120 THEN G.Visible = FALSE 867' 868' > This statement eliminates the stray lines for the Azimuthal Projections 869' 870IF ABS(G.LastModCrtX - G.ModCrtX) > 120 THEN G.Visible = FALSE 871 872IF G.LastModCrtX < -2000 OR G.ModCrtX < -2000 THEN G.Visible = FALSE 873 874IF G.Visible THEN 875 Y2# = (G.ModCrtY - G.LastModCrtY) * (G.ModCrtY - G.LastModCrtY) 876 X2# = (G.ModCrtX - G.LastModCrtX) * (G.ModCrtX - G.LastModCrtX) 877 Distance# = Raise#(X2# + Y2#, .5) 878 IF ABS(Distance#) > 20 THEN 879 G.Visible = FALSE 880 END IF 881END IF 882 883IF G.PlotFile THEN 884 IF G.Visible THEN 885 PRINT #1, "PD"; STR$(CINT(PlotX#)); ","; STR$(CINT(PlotY#)); ";" 886 ELSE 887 PRINT #1, "PU"; STR$(CINT(PlotX#)); ","; STR$(CINT(PlotY#)); ";" 888 END IF 889END IF 890 891IF G.Visible THEN 892 LINE (G.LastModCrtX, G.LastModCrtY)-(G.ModCrtX, G.ModCrtY), G.ColorVal 893END IF 894 895G.Visible = TRUE 896G.LastModCrtX = G.ModCrtX 897G.LastModCrtY = G.ModCrtY 898' 899END SUB ' { DrawProjection. } 900 901SUB FeaturesMenu 902' 903ExitMenu% = FALSE 904' 905DO 906 CLS 907' 908 LOCATE 2, 19 909 PRINT "** Turn Geographical Features On or Off **" 910' 911 LOCATE 5, 22: PRINT "1. Coastlines are"; 912 IF G.CoastSW THEN 913 PRINT " On " 914 ELSE 915 PRINT " Off" 916 END IF 917' 918 LOCATE 6, 22: PRINT "2. Islands are"; 919 IF G.IslandSW THEN 920 PRINT " On " 921 ELSE 922 PRINT " Off" 923 END IF 924' 925 LOCATE 7, 22: PRINT "3. Lakes are"; 926 IF G.LakeSW THEN 927 PRINT " On " 928 ELSE 929 PRINT " Off" 930 END IF 931' 932 LOCATE 8, 22: PRINT "4. Rivers are"; 933 IF G.RiverSW THEN 934 PRINT " On " 935 ELSE 936 PRINT " Off" 937 END IF 938' 939 LOCATE 9, 22: PRINT "5. Country Borders are"; 940 IF G.BorderSW THEN 941 PRINT " On " 942 ELSE 943 PRINT " Off" 944 END IF 945' 946 LOCATE 10, 22: PRINT "6. U.S. State Borders are"; 947 IF G.StateSW THEN 948 PRINT " On " 949 ELSE 950 PRINT " Off" 951 END IF 952' 953 LOCATE 11, 22: PRINT "7. Canadian Province Borders are"; 954 IF G.ProvinceSW THEN 955 PRINT " On " 956 ELSE 957 PRINT " Off" 958 END IF 959' 960 LOCATE 12, 22: PRINT "8. Austrailian State Borders are"; 961 IF G.AustSW THEN 962 PRINT " On " 963 ELSE 964 PRINT " Off" 965 END IF 966' 967 LOCATE 13, 22: PRINT "9. Mexican State Borders are"; 968 IF G.AustSW THEN 969 PRINT " On " 970 ELSE 971 PRINT " Off" 972 END IF 973' 974 LOCATE 16, 23: PRINT "Select Option (1-9) to toggle Feature" 975' 976 LOCATE 17, 37: PRINT "- Or -" 977' 978 LOCATE 18, 24: INPUT "0 to Return to Previous Menu: ", Menu% 979' 980 SELECT CASE Menu% 981' 982 CASE 0 983 ExitMenu% = TRUE 984' 985 CASE 1 986 IF G.CoastSW THEN 987 G.CoastSW = FALSE 988 ELSE 989 G.CoastSW = TRUE 990 END IF 991' 992 CASE 2 993 IF G.IslandSW THEN 994 G.IslandSW = FALSE 995 ELSE 996 G.IslandSW = TRUE 997 END IF 998' 999 CASE 3 1000 IF G.LakeSW THEN 1001 G.LakeSW = FALSE 1002 ELSE 1003 G.LakeSW = TRUE 1004 END IF 1005' 1006 CASE 4 1007 IF G.RiverSW THEN 1008 G.RiverSW = FALSE 1009 ELSE 1010 G.RiverSW = TRUE 1011 END IF 1012' 1013 CASE 5 1014 IF G.BorderSW THEN 1015 G.BorderSW = FALSE 1016 ELSE 1017 G.BorderSW = TRUE 1018 END IF 1019' 1020 CASE 6 1021 IF G.StateSW THEN 1022 G.StateSW = FALSE 1023 ELSE 1024 G.StateSW = TRUE 1025 END IF 1026' 1027 CASE 7 1028 IF G.ProvinceSW THEN 1029 G.ProvinceSW = FALSE 1030 ELSE 1031 G.ProvinceSW = TRUE 1032 END IF 1033' 1034 CASE 8 1035 IF G.AustSW THEN 1036 G.AustSW = FALSE 1037 ELSE 1038 G.AustSW = TRUE 1039 END IF 1040' 1041 CASE 9 1042 IF G.MexicoSW THEN 1043 G.MexicoSW = FALSE 1044 ELSE 1045 G.MexicoSW = TRUE 1046 END IF 1047' 1048 CASE ELSE 1049 PRINT CHR$(7) 1050' 1051 END SELECT '{ Menu. } 1052' 1053 LOOP UNTIL ExitMenu% 1054' 1055END SUB '{ FeaturesMenu. } 1056 1057SUB GetFullCoords (LonI#, LatI#) 1058' Used by GetPKDData subroutine 1059' 1060STATIC Temp# 1061STATIC Temp2# 1062' 1063' Longitude Degree1 1064CALL ReadInfile(Byte%) 1065Temp# = Byte% 1066Temp# = Temp# * 7200! 1067' 1068' Longitude Degree2 1069CALL ReadInfile(Byte%) 1070Temp2# = Byte% 1071Temp# = Temp# + (Temp2# * 3600!) 1072' 1073' Longitude Minutes 1074CALL ReadInfile(Byte%) 1075Temp2# = Byte% 1076Temp# = Temp# + (Temp2# * 60!) 1077' 1078' Longitude Seconds 1079CALL ReadInfile(Byte%) 1080Temp2# = Byte% 1081Temp# = Temp# + Temp2# 1082LonI# = Temp# 1083' 1084' Latitude Degrees 1085Temp# = 0 1086Temp2# = 0 1087CALL ReadInfile(Byte%) 1088Temp# = Byte% 1089Temp# = Temp# * 3600! 1090' 1091' Latitude Minutes 1092CALL ReadInfile(Byte%) 1093Temp2# = Byte% 1094Temp# = Temp# + (Temp2# * 60!) 1095' 1096' Latitude Seconds 1097CALL ReadInfile(Byte%) 1098Temp2# = Byte% 1099Temp# = Temp# + Temp2# 1100LatI# = Temp# 1101' 1102END SUB '{ GetFullCoords. } 1103 1104SUB GetMapData (FileName$) STATIC 1105' 1106G.Visible = FALSE 1107G.LastModCrtX = 0 1108 1109OPEN "C:\WORK\" + FileName$ FOR RANDOM AS #2 LEN = LEN(PNTData) 1110 1111TotalRecords& = LOF(2) / LEN(PNTData) 1112 1113FOR RecordCounter& = 1 TO TotalRecords& 1114 1115 GET #2, RecordCounter&, PNTData 1116 1117 IF PNTData.Header >= G.MapDataLevel THEN 1118 1119 IF PNTData.Header > 5 THEN 1120 G.ColorVal = PolyLineColor%(PNTData.Header) 1121 PolyLine% = FALSE 1122 ELSE 1123 PolyLine% = TRUE 1124 END IF 1125 1126 G.Phi = PNTData.Lat * MIN2RAD 1127 G.Lambda = PNTData.Lon * MIN2RAD 1128 1129 CALL DrawProjection(PolyLine%) 1130 1131 END IF 1132 1133NEXT RecordCounter& 1134 1135CLOSE #2 1136 1137END SUB '{ GetMapData. } 1138 1139SUB GetMP1Data 1140' This module contains both the GetMP1Data and ParseWord Subroutines. 1141' They are not hooked into the program, but are provided in case the user 1142' wishes to install them and create his or her own coordinate database. 1143' 1144' An *.MP1 file is nothing more than an ASCII file that can be 1145' created with a Text editor containing Latitude in Decimal Degrees 1146' then Longitude in Decimal Degrees separated by a comma or a space. 1147' Comments can also be included on each line as long as they are set 1148' off by an apostrophe (') and are at the end of the line. 1149' 1150' The first set of coordinates in the file are understood to be the beginning 1151' of the first PolyLine%. A new PolyLine% is indicated by a blank line at the 1152' beginning of the series of coordinates making up the new line. 1153' 1154' OPEN "C:EXAMPLE.PRN" FOR INPUT AS #1 1155' 1156' G.Visible = False 1157' G.LastModCRTX = 0 1158' SEEK #1, 1 1159' 1160' WHILE NOT EOF(1) 1161' 1162' LINE INPUT #1, MP1Rec$ 1163' 1164' CALL ParseWord(MP1Rec$, TLat$) 1165' LatR = VAL(TLat$) * Deg2Rad 1166' 1167' CALL ParseWord(MP1Rec$, TLong$) 1168' LongR = VAL(TLong$) * Deg2Rad 1169' 1170' IF VAL(TLong$) = 0 AND VAL(TLat$) = 0 THEN 1171' PolyLine% = False 1172' LINE INPUT #1, MP1Rec$ 1173' 1174' CALL ParseWord(MP1Rec$, TLat$) 1175' LatR = VAL(TLat$) * Deg2Rad 1176' 1177' CALL ParseWord(MP1Rec$, TLong$) 1178' LongR = VAL(TLong$) * Deg2Rad 1179' 1180' ELSE 1181' PolyLine% = True 1182' END IF 1183' CALL DrawProjection(PolyLine%) 1184 1185' WEND 1186' 1187'END SUB '{ GetMP1Data. } 1188' 1189' SUB ParseWord (PointLine$, Coord$) STATIC 1190' Subroutine to Parse text for *.MP1 Format 1191' 1192' Sep$ = " ," 1193' Coord$ = "" 1194' PointLine$ = RTRIM$(LTRIM$(PointLine$)) 1195' LenPointLine% = LEN(PointLine$) 1196' IF PointLine$ = "" OR PointLine$ = "'" THEN 1197' EXIT SUB 1198' END IF 1199' FOR Cnt1% = 1 TO LenPointLine% 1200' IF INSTR(Sep$, MID$(PointLine$, Cnt1%, 1)) = 0 THEN 1201' EXIT FOR 1202' END IF 1203' NEXT Cnt1% 1204' FOR Cnt2% = Cnt1% TO LenPointLine% 1205' IF INSTR(Sep$, MID$(PointLine$, Cnt2%, 1)) THEN ' = 0 1206' EXIT FOR 1207' END IF 1208' NEXT Cnt2% 1209' FOR Cnt3% = Cnt2% TO LenPointLine% 1210' IF INSTR(Sep$, MID$(PointLine$, Cnt3%, 1)) = 0 THEN 1211' EXIT FOR 1212' END IF 1213' NEXT Cnt3% 1214' IF Cnt1% > LenPointLine% THEN 1215' PointLine$ = "" 1216' EXIT SUB 1217' END IF 1218' IF Cnt2% > LenPointLine% THEN 1219' Coord$ = MID$(PointLine$, Cnt1%) 1220' PointLine$ = "" 1221' EXIT SUB 1222' END IF 1223' Coord$ = MID$(PointLine$, Cnt1%, Cnt2% - Cnt1%) 1224' IF Cnt3% > LenPointLine% THEN 1225' PointLine$ = "" 1226' ELSE 1227' PointLine$ = MID$(PointLine$, Cnt3%) 1228' END IF 1229' 1230' END SUB ' { ParseWord. } 1231END SUB '{ GetMP1Data. } 1232 1233SUB GetNextCoords (LonI AS DOUBLE, LatI AS DOUBLE) 1234' Used by GetPKDData subroutine 1235' 1236'Extract Longitude Delta 1237CALL ReadInfile(Byte%) 1238LonI = LonI + Byte% 1239' 1240'Extract Latitude Delta 1241CALL ReadInfile(Byte%) 1242LatI = LatI + Byte% 1243' 1244END SUB '{GetNextCoords} 1245 1246SUB GetPKDData 1247 1248' extracts data from *.PKD files 1249' This uses the South America Database Only 1250 1251' G.Visible = False 1252' PreviousScreenX# = 0# 1253 1254' Infile$(1) = "SAC1.PKD" 1255' Infile$(2) = "SAC2.PKD" 1256' Infile$(3) = "SAC3.PKD" 1257' Infile$(4) = "SAC4.PKD" 1258' Infile$(5) = "SAC7.PKD" 1259' Infile$(6) = "SAC8.PKD" 1260' Infile$(7) = "SAC9.PKD" 1261' Infile$(8) = "SAC13.PKD" 1262' Infile$(9) = "SAC14.PKD" 1263' Infile$(10) = "SAC10.PKD" 1264' Infile$(11) = "SAB01.PKD" 1265' Infile$(12) = "SAB2.PKD" 1266' Infile$(13) = "SAB3.PKD" 1267' Infile$(14) = "SAR1.PKD" 1268' Infile$(15) = "SAR2.PKD" 1269' Infile$(16) = "SAR3.PKD" 1270' Infile$(17) = "SAR4.PKD" 1271' Infile$(18) = "SAR5.PKD" 1272' Infile$(19) = "SAR06.PKD" 1273' Infile$(20) = "SAR7.PKD" 1274' Infile$(21) = "SAR8.PKD" 1275' Infile$(22) = "SAR10.PKD" 1276 1277' FOR Infil% = 1 TO 22 1278' OPEN "C:\SA\" + Infile$(Infil%) FOR BINARY AS #1 1279' 1280' DO 1281' CALL ReadInfile(FeatureType) 1282 1283' IF MID$(Infile$(Infil%), 3, 1) = "C" THEN G.ColorVal = 0 1284' IF MID$(Infile$(Infil%), 3, 1) = "B" THEN G.ColorVal = 4 1285' IF MID$(Infile$(Infil%), 3, 1) = "R" THEN G.ColorVal = 1 1286' 1287' PointsInLine& = PointCount&(PtCnt&) 1288' 1289' CALL GetFullCoords(LonI, LatI) ' - Max Place Holder (Max not used in program) 1290' 1291' CALL GetFullCoords(LonI, LatI) ' - Min Place Holder (Min not used in Program) 1292' 1293' PolyLine% = False 1294 1295' CALL GetFullCoords(LonI, LatI) ' - Use First Coordinate 1296 1297' LonR = ConvertCoordToDecDeg#(LonI) 1298' LatR = ConvertCoordToDecDeg#(LatI) 1299 1300' G.Phi = LatR * Deg2Rad 1301' G.Lambda = LonR * Deg2Rad 1302' CALL DrawProjection(PolyLine%) 1303' 1304' PointsInLine& = PointsInLine& - 1 1305' 1306' PolyLine% = True 1307' FOR LoopCount = 1 TO PointsInLine& 1308' 1309' CALL GetNextCoords(LonI, LatI) '- Use next coordinates 1310' LonR = ConvertCoordToDecDeg#(LonI) 1311' LatR = ConvertCoordToDecDeg#(LatI) 1312 1313' G.Phi = LatR * Deg2Rad 1314' G.Lambda = LonR * Deg2Rad 1315' CALL DrawProjection(PolyLine%) 1316' 1317' NEXT LoopCount 1318' 1319' LOOP UNTIL Index = LOF(1) 1320' 1321' Index = 0 1322' CLOSE #1 1323' NEXT Infil% 1324' 1325END SUB '{ GetPKDData. } 1326 1327SUB Goode (DeltaLambda#, Radius#, XCoord#, YCoord#) STATIC 1328' 1329' When drawing the outline and the extensions there are a number 1330' of duplications that would be drawn over each other if the following 1331' groups of IF-THEN statements were used. It was easier to define the 1332' necessary Lobe Central Longitude (G.Lambda2) values in the Outline 1333' and DrawProjection (extensions) subroutines and use the Outline 1334' variable as a flag to skip over the following IF-THENs. 1335 1336 IF G.Outline THEN 1337 GOTO XYPlot 1338 END IF 1339 1340IF G.Phi >= 0 THEN 1341 IF (G.Lambda > -DEG180) AND (G.Lambda <= -DEG40) THEN 1342 G.Lambda2 = -DEG100 1343 GOTO XYPlot 1344 END IF 1345 1346 IF (G.Lambda > -DEG40) AND (G.Lambda <= DEG180) THEN 1347 G.Lambda2 = DEG30 1348 GOTO XYPlot 1349 END IF 1350END IF 1351 1352 IF (G.Lambda >= -DEG180) AND (G.Lambda <= -DEG100) THEN 1353 G.Lambda2 = -DEG160 1354 GOTO XYPlot 1355 END IF 1356 1357 IF (G.Lambda >= -DEG100) AND (G.Lambda <= -DEG20) THEN 1358 G.Lambda2 = -DEG60 1359 GOTO XYPlot 1360 END IF 1361 1362 IF (G.Lambda >= -DEG20) AND (G.Lambda <= DEG80) THEN 1363 G.Lambda2 = DEG20 1364 GOTO XYPlot 1365 END IF 1366 1367 IF (G.Lambda >= DEG80) AND (G.Lambda <= DEG180) THEN 1368 G.Lambda2 = DEG140 1369 GOTO XYPlot 1370 END IF 1371' 1372' ---------------------------------- 1373' 1374XYPlot: 1375' The DeltaLambda# value is computed at the top of the DrawProjection 1376' subroutine to place the Longitude (G.Lambda#) Value into the correct 1377' quadrant of the map in relation to the center of the full map. It is 1378' used here to establish the same Longitude relationship for the lobe. 1379 1380 Lambda1# = Normalize#(DeltaLambda#, G.Lambda2) 1381 1382 IF ABS(G.Phi) < MERGEPOINT THEN ' (40.73666# * Deg2Rad) 1383 ' Sinusoidal Projection 1384 XCoord# = Radius# * Lambda1# * COS(G.Phi) 1385 YCoord# = Radius# * G.Phi 1386 ELSE 1387' Part of the MollweideFormula# Function 1388' Placed here to reduce amount of calculations 1389 SinPhi# = DEG180 * SIN(G.Phi) 1390' 1391' This subroutine uses Newton-Raphson iteration to derive the Theta# value 1392' 1393' Mollweide Projection 1394 Start# = G.Phi * .5 1395 DeltaThetaPrime# = Start# 1396 DO 1397 FirstGuess# = MollweideFormula#(DeltaThetaPrime#, SinPhi#) 1398 DeltaThetaPrime# = DeltaThetaPrime# + DTPINCR# 1399' MollweideFormula# is a user defined function - use The Menu Bar - View 1400' Menu to find it. 1401 SecondGuess# = (MollweideFormula#(DeltaThetaPrime#, SinPhi#) - FirstGuess#) / DTPINCR# 1402 Start# = Start# - FirstGuess# / SecondGuess# 1403 DeltaThetaPrime# = Start# 1404 LOOP WHILE ABS(MollweideFormula#(DeltaThetaPrime#, SinPhi#)) >= TOLERANCE# 1405' 1406 Theta# = DeltaThetaPrime# * .5 1407' 1408 XCoord# = Radius# * XCONST * Lambda1# * COS(Theta#) 1409 YCoord# = Radius# * (SQRT2 * SIN(Theta#) - MOLLRFACTOR * Sign#(G.Phi)) 1410' 1411 END IF 1412' 1413' In addition to the extensive use of IF-THEN statements to define the 1414' Boundries and Central Longitudes of each lobe, the TRICK to 1415' Interrupting and recentering a projection is in the following 1416' line of code. As you know the Homolosine consists of 2 projections that 1417' are merged at 40 Deg. 44 Min. and 11.89 Sec.(40.73666# Decimal Deg.). 1418' The X Coordinate formula of the center projection (Sinusoidal) is copied 1419' and modified by making the G.Phi# (Latitude) value always equal to 0 (Cosine 1420' of 0 is 1) and using the central longitude (G.Lambda2#) of the lobe the 1421' Current Longitude (G.Lambda#) value is within. This value is then added to 1422' the Normal X coordinate output of both projections. 1423' 1424' Normal X OUT | Modified X coord of center Projection 1425 XCoord# = XCoord# + (G.Lambda2 * Radius#) 1426 1427' This line of code is used to turn off PolyLine%s that cross into different 1428' lobes. It could be better (When crossing the equator)! 1429 1430 IF (PreviousPhi# > 0 AND G.Phi < 0) OR (PreviousPhi# < 0 AND G.Phi > 0) THEN 1431 G.Visible = TRUE 1432 ELSE 1433 IF (PreviousLambda2# <> G.Lambda2) THEN 1434 G.Visible = FALSE 1435 END IF 1436 END IF 1437' 1438 PreviousPhi# = G.Phi 1439 PreviousLambda2# = G.Lambda2 1440' 1441END SUB '{ Goode. } 1442 1443SUB LatLongEntry (Title$, Note$) 1444' 1445 CLS 1446 1447 IF Title$ <> "" THEN 1448 Col = Center%(LEN(Title$)) 1449 LOCATE 2, Col: PRINT Title$ 1450 END IF 1451' 1452 IF Note$ <> "" THEN 1453 Col = Center%(LEN(Note$)) 1454 LOCATE 4, Col: PRINT Note$ 1455 END IF 1456' 1457 LOCATE CSRLIN + 1, 20 1458' 1459 INPUT "Do you want Grid Lines (Y/N)? ", Answer$ 1460 Answer$ = UCASE$(Answer$) 1461 1462 IF Answer$ = "Y" OR Answer$ = "" THEN 1463 G.Grid = TRUE 1464 ELSE 1465 G.Grid = FALSE 1466 END IF 1467 1468' 1469 LOCATE CSRLIN + 1, 19 1470 INPUT "Send Output to Plot File (Y/N)? ", Answer$ 1471 Answer$ = UCASE$(Answer$) 1472 1473 IF Answer$ = "Y" THEN 1474 G.PlotFile = TRUE 1475 ELSE 1476 G.PlotFile = FALSE 1477 END IF 1478 1479' 1480END SUB '{ LatLongEntry. } 1481 1482SUB LatLongMenu 1483' 1484ExitMenu% = FALSE 1485 1486DO 1487 CLS 1488' 1489 LOCATE 2, 20 1490 PRINT "** Modify Latitude/ Longitude Display **" 1491' 1492 SELECT CASE G.LongOption 1493 1494 CASE 1 1495 LOCATE 4, 17 1496 PRINT "Currently all Longitude lines converge at Pole" 1497 1498 CASE 2 1499 LOCATE 4, 11 1500 PRINT "Currently all Longitude lines end 5 Degrees away from Pole" 1501 1502 END SELECT '{ G.LongOption. } 1503 1504 LOCATE 6, 12 1505 PRINT "1. Change Latitude increment (Currently"; G.LatStep; "Degrees)" 1506 1507 LOCATE 7, 12 1508 PRINT "2. Change Longitude increment (Currently"; G.LongStep; "Degrees)" 1509 1510 LOCATE 8, 12 1511 PRINT "3. All Longitude lines converge at Pole" 1512 1513 LOCATE 9, 12 1514 PRINT "4. Longitude lines end 5 Degrees away from Pole" 1515 1516 LOCATE 11, 14 1517 INPUT "Select Option (1-4) or 0 to Return to Previous Menu: ", Menu% 1518' 1519 SELECT CASE Menu% 1520' 1521 CASE 0 1522 ExitMenu% = TRUE 1523' 1524 CASE 1 1525 LOCATE 12, 1: PRINT SPACE$(80) 1526 LOCATE 13, 1: PRINT SPACE$(80) 1527 1528 LOCATE 12, 20 1529 INPUT "Change Latitude Increment to (5 to 90): ", Increment% 1530 1531 IF Increment% >= 5 AND Increment% <= 90 THEN 1532 G.LatStep = Increment% 1533 ELSE 1534 PRINT CHR$(7) 1535 END IF 1536' 1537 CASE 2 1538 LOCATE 12, 1: PRINT SPACE$(80) 1539 LOCATE 13, 1: PRINT SPACE$(80) 1540 1541 LOCATE 12, 19 1542 INPUT "Change Longitude Increment to (5 to 90): ", Increment% 1543 1544 IF Increment% >= 5 AND Increment% <= 90 THEN 1545 G.LongStep = Increment% 1546 ELSE 1547 PRINT CHR$(7) 1548 END IF 1549' 1550 CASE 3 1551 G.LongOption = 1 1552' 1553 CASE 4 1554 G.LongOption = 2 1555' 1556 CASE ELSE 1557 PRINT CHR$(7) 1558' 1559 END SELECT '{ Menu. } 1560' 1561 LOOP UNTIL ExitMenu% 1562' 1563END SUB '{ LatLongMenu. } 1564 1565FUNCTION LN# (n#) STATIC 1566' 1567IF n# > 0 THEN 1568 LN# = LOG(n#) 1569ELSE 1570 PRINT "Error: LN#(n#) Where n# <= 0# " 1571 SYSTEM 1572END IF 1573' 1574END FUNCTION ' { LN#. } 1575 1576SUB LongitudeFOR (Begin#, Finish#, Incr#) STATIC 1577' 1578 PolyLine% = TRUE 1579 1580 FOR LatGrid# = Begin# TO Finish# STEP Incr# 1581 G.Phi = LatGrid# 1582 CALL DrawProjection(PolyLine%) 1583 NEXT LatGrid# 1584' 1585END SUB '{ LongitudeFOR. } 1586 1587SUB MakeLatitudeLines (LatRange%, LatDetail%) 1588' 1589 G.Outline = TRUE 1590 FOR LatGrid% = LatRange% TO -LatRange% STEP -1 1591 1592 IF ABS(LatGrid%) < 90 THEN 1593 1594 Even% = (LatGrid% MOD G.LatStep = 0) 1595 IF Even% THEN 1596 G.Phi = LatGrid% * DEG2RAD 1597 PolyLine% = FALSE 1598 CALL DrawProjection(PolyLine%) 1599 PolyLine% = TRUE 1600 1601 IF LatGrid% <= 0 THEN 1602' 1603' > Southern Lobe 1 1604' 1605 G.Lambda2 = -DEG160 1606 PolyLine% = FALSE 1607 CALL DrawProjection(PolyLine%) 1608 PolyLine% = TRUE 1609 1610 FOR LongGrid% = -180 TO -100 STEP 5 1611 G.Lambda = LongGrid% * DEG2RAD 1612 CALL DrawProjection(PolyLine%) 1613 NEXT LongGrid% 1614' 1615' > Southern Lobe 2 1616' 1617 G.Lambda2 = -DEG60 1618 PolyLine% = FALSE 1619 CALL DrawProjection(PolyLine%) 1620 PolyLine% = TRUE 1621 1622 FOR LongGrid% = -100 TO -20 STEP 5 1623 G.Lambda = LongGrid% * DEG2RAD 1624 CALL DrawProjection(PolyLine%) 1625 NEXT LongGrid% 1626' 1627' > Southern Lobe 3 1628' 1629 G.Lambda2 = DEG20 1630 PolyLine% = FALSE 1631 CALL DrawProjection(PolyLine%) 1632 PolyLine% = TRUE 1633 1634 FOR LongGrid% = -20 TO 80 STEP 5 1635 G.Lambda = LongGrid% * DEG2RAD 1636 CALL DrawProjection(PolyLine%) 1637 NEXT LongGrid% 1638' 1639' > Southern Lobe 4 1640' 1641 G.Lambda2 = DEG140 1642 PolyLine% = FALSE 1643 CALL DrawProjection(PolyLine%) 1644 PolyLine% = TRUE 1645 1646 FOR LongGrid% = 80 TO 180 STEP 5 1647 G.Lambda = LongGrid% * DEG2RAD 1648 CALL DrawProjection(PolyLine%) 1649 NEXT LongGrid% 1650 1651 ELSE 1652' 1653' > Northern Lobe 1 1654' 1655 G.Lambda2 = -DEG100 1656 IF LatGrid% < 60 THEN 1657 PolyLine% = FALSE 1658 CALL DrawProjection(PolyLine%) 1659 PolyLine% = TRUE 1660 1661 FOR LongGrid% = -180 TO -40 STEP 5 1662 G.Lambda = LongGrid% * DEG2RAD 1663 CALL DrawProjection(PolyLine%) 1664 NEXT LongGrid% 1665 ELSE 1666 PolyLine% = FALSE 1667 CALL DrawProjection(PolyLine%) 1668 PolyLine% = TRUE 1669 1670 FOR LongGrid% = -180 TO -10 STEP 5 1671 G.Lambda = LongGrid% * DEG2RAD 1672 CALL DrawProjection(PolyLine%) 1673 NEXT LongGrid% 1674 END IF 1675' 1676' > Northern Lobe 2 1677' 1678 G.Lambda2 = DEG30 1679 IF LatGrid% < 50 THEN 1680 PolyLine% = FALSE 1681 CALL DrawProjection(PolyLine%) 1682 PolyLine% = TRUE 1683 1684 FOR LongGrid% = -40 TO 180 STEP 5 1685 G.Lambda = LongGrid% * DEG2RAD 1686 CALL DrawProjection(PolyLine%) 1687 NEXT LongGrid% 1688 END IF 1689 1690 IF LatGrid% >= 50 AND LatGrid% < 60 THEN 1691 PolyLine% = FALSE 1692 CALL DrawProjection(PolyLine%) 1693 PolyLine% = TRUE 1694 1695 FOR LongGrid% = -40 TO 180 STEP 5 1696 G.Lambda = LongGrid% * DEG2RAD 1697 CALL DrawProjection(PolyLine%) 1698 NEXT LongGrid% 1699 1700 FOR LongGrid% = -180 TO -160 STEP 5 1701 G.Lambda = LongGrid% * DEG2RAD 1702 CALL DrawProjection(PolyLine%) 1703 NEXT LongGrid% 1704 END IF 1705 1706 IF LatGrid% >= 60 THEN 1707 PolyLine% = FALSE 1708 CALL DrawProjection(PolyLine%) 1709 PolyLine% = TRUE 1710 1711 FOR LongGrid% = -50 TO 180 STEP 5 1712 G.Lambda = LongGrid% * DEG2RAD 1713 CALL DrawProjection(PolyLine%) 1714 NEXT LongGrid% 1715 1716 FOR LongGrid% = -180 TO -160 STEP 5 1717 G.Lambda = LongGrid% * DEG2RAD 1718 CALL DrawProjection(PolyLine%) 1719 NEXT LongGrid% 1720 END IF 1721 END IF 1722 END IF 1723 END IF 1724 1725 NEXT LatGrid% 1726 G.Outline = FALSE 1727' 1728END SUB 1729 1730SUB MakeLongitudeLines (LatRange%, LongDetail!) 1731' 1732' =========================================== 1733' Extension 3 (Right side of Northern Lobe 2) 1734' =========================================== 1735' 1736 G.Outline = TRUE 1737 G.Lambda2 = DEG30 1738 1739 FOR LongGrid% = -160 TO -180 STEP -1 1740 Even% = (LongGrid% MOD G.LongStep = 0) 1741 IF Even% THEN 1742 IF LongGrid% >= -180 AND LongGrid% < -160 THEN 1743 G.Lambda = LongGrid% * DEG2RAD 1744 PolyLine% = FALSE 1745' 1746 FOR LatGrid! = LatRange% TO 50 STEP -LongDetail! 1747 G.Phi = LatGrid! * DEG2RAD 1748 CALL DrawProjection(PolyLine%) 1749 PolyLine% = TRUE 1750 NEXT LatGrid! 1751 END IF 1752 END IF 1753 NEXT LongGrid% 1754 1755 G.Outline = FALSE 1756' 1757' =============================================== 1758' Longitude Lines from 180 degrees to -40 Degrees 1759' =============================================== 1760' 1761 FOR LongGrid% = 180 TO -40 STEP -1 1762 1763 IF LongGrid% < 180 THEN 1764 Even% = (LongGrid% MOD G.LongStep = 0) 1765 IF Even% THEN 1766 IF LongGrid% = -40 THEN 1767 G.Lambda2 = DEG30 1768 G.Outline = TRUE 1769 ELSE 1770 G.Outline = FALSE 1771 END IF 1772 1773 G.Lambda = LongGrid% * DEG2RAD 1774 PolyLine% = FALSE 1775' 1776 North# = LatRange% * DEG2RAD 1777 South# = -LatRange% * DEG2RAD 1778 1779 IF LatRange% = 85 THEN 1780 IF G.Lambda = DEG30 THEN 1781 North# = DEG90 1782 END IF 1783 1784 IF G.Lambda = DEG140 THEN 1785 South# = -DEG90 1786 END IF 1787 1788 IF G.Lambda = DEG20 THEN 1789 South# = -DEG90 1790 END IF 1791 END IF 1792 1793 IF LongGrid% = -40 THEN 1794 South# = DEG60 1795 END IF 1796 1797 IF LongGrid% = 80 OR LongGrid% = -20 THEN 1798 South# = 0 1799 END IF 1800 1801 CALL LongitudeFOR(North#, South#, -LongDetail! * DEG2RAD) 1802 END IF 1803 END IF 1804 NEXT LongGrid% 1805' 1806' =========== 1807' Extension 2 (Left side of Northern Lobe 2) 1808' =========== 1809' 1810 G.Outline = TRUE 1811 G.Lambda2 = DEG30# 1812 1813 FOR LongGrid% = -40 TO -50 STEP -1 1814 Even% = (LongGrid% MOD G.LongStep = 0) 1815 IF Even% THEN 1816 IF LongGrid% > -50 AND LongGrid% < -40 THEN 1817 G.Lambda = LongGrid% * DEG2RAD 1818 PolyLine% = FALSE 1819' 1820 FOR LatGrid! = LatRange% TO 60 STEP -LongDetail! 1821 G.Phi = LatGrid! * DEG2RAD 1822 CALL DrawProjection(PolyLine%) 1823 PolyLine% = TRUE 1824 NEXT LatGrid! 1825 END IF 1826 END IF 1827 NEXT LongGrid% 1828' 1829' =========================================== 1830' Extension 1 (Right side of Northern Lobe 1) 1831' =========================================== 1832' 1833 G.Outline = TRUE 1834 G.Lambda2 = -DEG100 1835 1836 FOR LongGrid% = -10 TO -40 STEP -1 1837 Even% = (LongGrid% MOD G.LongStep = 0) 1838 IF Even% THEN 1839 IF LongGrid% > -40 AND LongGrid% < -10 THEN 1840 G.Lambda = LongGrid% * DEG2RAD 1841 PolyLine% = FALSE 1842' 1843 FOR LatGrid! = LatRange% TO 60 STEP -LongDetail! 1844 G.Phi = LatGrid! * DEG2RAD 1845 CALL DrawProjection(PolyLine%) 1846 PolyLine% = TRUE 1847 NEXT LatGrid! 1848 END IF 1849 END IF 1850' 1851 NEXT LongGrid% 1852 G.Outline = FALSE 1853' 1854' ============================================== 1855' Longitude Lines from 0 degrees to -180 Degrees 1856' ============================================== 1857' 1858 FOR LongGrid% = -40 TO -180 STEP -1 1859 1860 IF LongGrid% = -180 THEN EXIT FOR ' no real need to redraw -180 1861 1862 Even% = (LongGrid% MOD G.LongStep = 0) 1863 IF Even% THEN 1864 IF LongGrid% <= -40 THEN 1865 G.Lambda = LongGrid% * DEG2RAD 1866 PolyLine% = FALSE 1867' 1868 North# = LatRange% * DEG2RAD 1869 South# = -LatRange% * DEG2RAD 1870 1871 IF LatRange% = 85 THEN 1872 IF G.Lambda = -DEG100 THEN 1873 North# = DEG90 1874 END IF 1875 1876 IF G.Lambda = -DEG60 THEN 1877 South# = -DEG90 1878 END IF 1879 1880 IF G.Lambda = -DEG160 THEN 1881 South# = -DEG90 1882 END IF 1883 END IF 1884 1885 IF LongGrid% = -100 THEN 1886 South# = 0 1887 END IF 1888 1889 CALL LongitudeFOR(North#, South#, -LongDetail! * DEG2RAD) 1890 1891 END IF 1892 END IF 1893' 1894 NEXT LongGrid% 1895' 1896END SUB '{ MakeLongitudeLines. } 1897 1898FUNCTION MollweideFormula# (ThetaPrime#, MPhi#) STATIC 1899' From John Snyder's "Map Projections -- A Working Manual" 1900' Used by the Newton-Raphson iteration in the Mollweide portion 1901' of the Map subroutine 1902' 1903 MollweideFormula# = -(ThetaPrime# + SIN(ThetaPrime#) - MPhi#) / (1 + COS(ThetaPrime#)) 1904' 1905END FUNCTION '{ MollweideFormula#. } 1906 1907FUNCTION Normalize# (LambdaVal#, Lambda0Val#) STATIC 1908' 1909' This subroutine is responsible for placing the Longitude (Lambda) 1910' value into the correct part of the map in relation to the selected 1911' Central Longitude (Lambda0) of the map. 1912' 1913LambdaDiff# = LambdaVal# - Lambda0Val# 1914 1915DO WHILE ABS(LambdaDiff#) > DEG180 1916 IF LambdaDiff# < 0 THEN 1917 LambdaDiff# = LambdaDiff# + DEG360 1918 ELSE 1919 LambdaDiff# = LambdaDiff# - DEG360 1920 END IF 1921LOOP 1922 1923Normalize# = LambdaDiff# 1924' 1925END FUNCTION ' { Normalize#. } 1926 1927SUB PlotFileColorMenu 1928' 1929ExitMenu% = FALSE 1930' 1931DO 1932 CLS 1933' 1934 LOCATE 2, 11 1935 PRINT "** Change Plot File Pen Colors of Geographical Features **" 1936 LOCATE 4, 33: PRINT "Pen Color Codes" 1937 LOCATE 6, 29: PRINT "1 - Black 5 - Magenta" 1938 LOCATE 7, 29: PRINT "2 - Blue 6 - Yellow" 1939 LOCATE 8, 29: PRINT "3 - Red 7 - Cyan" 1940 LOCATE 9, 29: PRINT "4 - Green 8 - Brown" 1941 1942 LOCATE 12, 27: PRINT "1. Grid Pen is:"; G.GridPen 1943 LOCATE 13, 27: PRINT "2. Coast Pen is:"; G.CoastPen 1944 LOCATE 14, 27: PRINT "3. Country Border Pen is:"; G.BorderPen 1945 LOCATE 15, 27: PRINT "4. Island Pen is:"; G.IslandPen 1946 LOCATE 16, 27: PRINT "5. State Border Pen is:"; G.StatePen 1947 LOCATE 17, 27: PRINT "6. Lake Pen is:"; G.LakePen 1948 LOCATE 18, 27: PRINT "7. River Pen is:"; G.RiverPen 1949 LOCATE 20, 14 1950 INPUT "Select Option (1-7) or 0 to Return to Main Menu: ", Menu% 1951 1952 SELECT CASE Menu% 1953' 1954 CASE 0 1955 ExitMenu% = TRUE 1956 1957 CASE 1 1958 LOCATE 20, 1: PRINT SPACE$(80) 1959 LOCATE 20, 26 1960 INPUT "Change Grid Pen to (1-8):", NewPen% 1961 IF NewPen% >= 1 AND NewPen% < 9 THEN 1962 G.GridPen = NewPen% 1963 ELSE 1964 PRINT CHR$(7) 1965 END IF 1966' 1967 CASE 2 1968 LOCATE 20, 1: PRINT SPACE$(80) 1969 LOCATE 20, 23 1970 INPUT "Change Coastline Pen to (1-8):", NewPen% 1971 IF NewPen% >= 1 AND NewPen% < 9 THEN 1972 G.CoastPen = NewPen% 1973 ELSE 1974 PRINT CHR$(7) 1975 END IF 1976' 1977 CASE 3 1978 LOCATE 20, 1: PRINT SPACE$(80) 1979 LOCATE 20, 21 1980 INPUT "Change Country Border Pen to (1-8):", NewPen% 1981 IF NewPen% >= 1 AND NewPen% < 9 THEN 1982 G.BorderPen = NewPen% 1983 ELSE 1984 PRINT CHR$(7) 1985 END IF 1986' 1987 CASE 4 1988 LOCATE 20, 1: PRINT SPACE$(80) 1989 LOCATE 20, 25 1990 INPUT "Change Island Pen to (1-8):", NewPen% 1991 IF NewPen% >= 1 AND NewPen% < 9 THEN 1992 G.IslandPen = NewPen% 1993 ELSE 1994 PRINT CHR$(7) 1995 END IF 1996' 1997 CASE 5 1998 LOCATE 20, 1: PRINT SPACE$(80) 1999 LOCATE 20, 22 2000 INPUT "Change State Border Pen to (1-8):", NewPen% 2001 IF NewPen% >= 1 AND NewPen% < 9 THEN 2002 G.StatePen = NewPen% 2003 ELSE 2004 PRINT CHR$(7) 2005 END IF 2006' 2007 CASE 6 2008 LOCATE 20, 1: PRINT SPACE$(80) 2009 LOCATE 20, 26 2010 INPUT "Change Lake Pen to (1-8):", NewPen% 2011 IF NewPen% >= 1 AND NewPen% < 9 THEN 2012 G.LakePen = NewPen% 2013 ELSE 2014 PRINT CHR$(7) 2015 END IF 2016' 2017 CASE 7 2018 LOCATE 20, 1: PRINT SPACE$(80) 2019 LOCATE 20, 26 2020 INPUT "Change River Pen to (1-8):", NewPen% 2021 IF NewPen% >= 1 AND NewPen% < 9 THEN 2022 G.RiverPen = NewPen% 2023 ELSE 2024 PRINT CHR$(7) 2025 END IF 2026' 2027 CASE ELSE 2028 PRINT CHR$(7) 2029 2030 END SELECT '{ Menu. } 2031' 2032LOOP UNTIL ExitMenu% 2033' 2034END SUB '{ PlotFileColorMenu. } 2035 2036FUNCTION PointCount& (PtCnt&) 2037' Used by GetPKDData subroutine 2038' 2039 CALL ReadInfile(Byte%) 2040 PtCnt& = Byte% * 100 2041 CALL ReadInfile(Byte%) 2042 PtCnt& = PtCnt& + Byte% 2043 PointCount& = PtCnt& 2044' 2045END FUNCTION '{ PointCount&. } 2046 2047FUNCTION PolyLineColor% (PolyLineHeader%) STATIC 2048' 2049SELECT CASE PolyLineHeader% 2050' 2051 CASE 1000 TO 1999 2052' Coast 2053 PolyLineColor% = G.CoastColor 2054 PlotPen$ = LTRIM$(STR$(G.CoastPen)) 2055' 2056 CASE 2000 TO 2999 2057' Country Borders 2058 PolyLineColor% = G.BorderColor 2059 PlotPen$ = LTRIM$(STR$(G.BorderPen)) 2060 2061 CASE 3000 TO 3999 2062' Canadian Provinces 2063 PolyLineColor% = G.StateColor 2064 PlotPen$ = LTRIM$(STR$(G.StatePen)) 2065 2066 CASE 4000 TO 4999 2067' U.S. State borders 2068 PolyLineColor% = G.StateColor 2069 PlotPen$ = LTRIM$(STR$(G.StatePen)) 2070 2071 CASE 5000 TO 5999 2072' Islands 2073 PolyLineColor% = G.IslandColor 2074 PlotPen$ = LTRIM$(STR$(G.IslandPen)) 2075 2076 CASE 6000 TO 6999 2077' Lakes 2078 PolyLineColor% = G.LakeColor 2079 PlotPen$ = LTRIM$(STR$(G.LakePen)) 2080 2081 CASE 7000 TO 7999 2082' Rivers 2083 PolyLineColor% = G.RiverColor 2084 PlotPen$ = LTRIM$(STR$(G.RiverPen)) 2085 2086 CASE 8000 TO 8999 2087' Australian States 2088 PolyLineColor% = G.StateColor 2089 PlotPen$ = LTRIM$(STR$(G.StatePen)) 2090' 2091END SELECT '{ PlineHeader. } 2092 2093IF G.PlotFile THEN 2094 IF G.LastPlotPen <> PlotPen$ THEN 2095 PRINT #1, "SP" + PlotPen$ + ";" 2096 END IF 2097 2098 G.LastPlotPen = PlotPen$ 2099END IF 2100' 2101END FUNCTION '{ PolyLineColor%. } 2102 2103FUNCTION Raise# (n#, Power#) 2104' Raise a number to a power 2105' (even negative numbers raised to a non-integer power) 2106' 2107IF n# = 0 THEN 2108 IF Power# = 0 THEN 2109 Raise# = 1 2110 ELSE 2111 Raise# = 0 2112 END IF 2113ELSE 2114 Raise# = Sign#(n#) * EXP(Power# * LN#(ABS(n#))) 2115END IF 2116' 2117END FUNCTION '{ Raise. } 2118 2119SUB ReadInfile (Byte%) 2120STATIC Rec AS STRING * 1 2121' Used by GetPKDData subroutine 2122' 2123 Index = Index + 1 'Record Count 2124 GET #1, , Rec 2125 Byte% = ASC(Rec) 2126' 2127' Convert to Signed Char 2128 IF Byte% > 127 THEN 2129 Byte% = Byte% - 256 2130 END IF 2131' 2132END SUB '{ ReadInFile. } 2133 2134FUNCTION Round# (n#, PowerOfTen%) STATIC 2135' 2136pTen# = 10 ^ PowerOfTen% 2137RTemp# = INT(n# / pTen# + .5) * pTen# 2138Temp$ = STR$(RTemp#) 2139Temp$ = MID$(Temp$, 1, ABS(PowerOfTen%) + 4) 2140Round# = VAL(Temp$) 2141' 2142END FUNCTION 2143 2144FUNCTION Sec# (n#) 2145' 2146Cosine# = COS(n#) 2147IF ABS(Cosine#) <= 0# THEN 2148 PRINT "Error: Sec#(n#) where n# ="; n# 2149 PRINT " Cosine# ="; Cosine# 2150 SYSTEM 2151ELSE 2152 Sec# = (1 / Cosine#) 2153END IF 2154 2155END FUNCTION 2156 2157FUNCTION Sign# (n#) 2158' Return -1 if n# < 0, or +1 if n# >= 0 2159' 2160IF n# = 0 THEN 2161 Sign# = 1 2162ELSE 2163 Sign# = ABS(n#) / n# 2164END IF 2165' 2166END FUNCTION '{ Sign. } 2167 2168