|
Post by tsh73 on Apr 3, 2024 3:10:28 GMT -5
Very cool. Small mod to have lat\lon grid as lines in modes 012:
EDIT OOPS it gets really WEIRD then rotating globe (set L0 to "10") Apparently it needs more thought...
after label 7000, drawing part just before RETURN
if grid then if firstGrid then #w.gb "set "; 410 + int( X ); " "; 330 - int( Y ) firstGrid=0 else #w.gb "goto "; 410 + int( X ); " "; 330 - int( Y ) end if else #w.gb "set "; 410 + int( X ); " "; 330 - int( Y ) end if
Grid drawing code (setting grid / firstGrid, changing loop order for green ones)
else grid=1 #w.gb "color 255 90 90" for long = -180 to 180 step 10 firstGrid=1 for lat = -90 to 90 step 0.5 L =long * pi / 180 ' both in radians P =lat * pi / 180
if J = 0 or J = 1 or J = 2 then gosub [doP1ot012] 'calldll #kernel32, "Sleep", 100 as long, ret as void ' if want to watch slowly! if J = 3 then gosub [doPlot3] if J = 4 then gosub [doPlot4] if J = 5 then gosub [doPlot5] scan next lat next long
#w.gb "color green" for lat = -90 to 90 step 10 firstGrid=1 for long = -180 to 180 step 0.5 L =long * pi / 180 ' both in radians P =lat * pi / 180 if J = 0 or J = 1 or J = 2 then gosub [doP1ot012] 'calldll #kernel32, "Sleep", 100 as long, ret as void ' if want to watch slowly! if J = 3 then gosub [doPlot3] if J = 4 then gosub [doPlot4] if J = 5 then gosub [doPlot5] scan next next grid=0 end if
Also, then no file selected, should default to existing one
if fIn$ ="" then fIn$ = "dataWc.csv"
|
|
honky
Junior Member
Posts: 63
|
Post by honky on Apr 3, 2024 4:05:59 GMT -5
I would like to display the coordonnées (Lat and Lon) by a right click on the version of the second message on page 2. And I don't get by. So on the latest version of page 3, it's not even I worth it. Anyone have an idea of how to do it ? Thank you for...
|
|
|
Post by tenochtitlanuk on Apr 3, 2024 4:32:37 GMT -5
Thanks Anatoly for the feedback. Will adapt my next version! As you can see from my code I probably should have coded from zero rather than forcing old code to suit my modern tastes!
EDIT I've mod'd so my version chooses smaller steps when you are at low altitudes- avoids 'joining the dots' line method and its problems!
Honky- I'll try to code the reverse action of clicking on a projection and displaying the relevant Lat/Lon pair. It's all still a work in progress.
If anyone finds other usable global databases of lat/long data with other associated things, like altitude or land use, let me know.
|
|
|
Post by tsh73 on Apr 3, 2024 6:13:45 GMT -5
I got mouse point to lat/lon on a program Honky worked on, just run it and move mouse.
nomainwin WindowWidth =900: WindowHeight =740 graphicbox #w.g, 1, 1, 898, 738 button #w.a, "Save bmps ",save, UL, 20, 10, 120, 25 statictext #w.coord, "", 20, 40, 300, 25 textbox #w.f, 160, 10, 30, 20 button #w.e, "Start",[start], UL, 200, 10, 50, 20 button #w.b, "Stop",sto, UL, 260, 10, 50, 20 button #w.c, "Go",[reme], UL, 320, 10, 50, 20 button #w.d, "Grid",gri, UL, 380, 10, 50, 20 textbox #w.h, 625, 10, 30, 20 textbox #w.i, 625, 36, 30, 20 textbox #w.j, 625, 62, 30, 20 textbox #w.k, 625, 87, 30, 20 open "World Views" for window as #w #w "trapclose quit" #w.g, "when rightButtonDown [coord]" #w.g, "when mouseMove [coord2]" global pi: pi =3.14159265 global twoPi: twoPi =2 *pi global sav: global sto: global gri #w.a, "!font courrier 10 bold": #w.e, "!font courrier 10 bold" #w.b, "!font courrier 10 bold": #w.c, "!font courrier 10 bold" #w.d, "!font courrier 10 bold": #w.h, "!font courrier 10 bold" #w.i, "!font courrier 10 bold": #w.j, "!font courrier 10 bold" #w.k, "!font courrier 10 bold" R =300 ' RADIUS OF GRAPHIC IN SCREEN PIXELS 'L0 = 80 ' LONGITUDE OF OBSERVER IN DEGREES. #w.g, "down;color red;size 8": #w.g, "set 665 20": #w.g, "color black" #w.g, "place 675 20": #w.g, "\Red point=Population > 1E7" #w.g, "color yellow;size 7": #w.g, "set 665 45": #w.g, "color black" #w.g, "place 675 45": #w.g, "\Yellow point=Population > 1E6" #w.g, "color green;size 7": #w.g, "set 665 70": #w.g, "color black" #w.g, "place 675 70": #w.g, "\Green point=Population > 1E5" #w.g, "color cyan;size 7": #w.g, "set 665 95": #w.g, "color black" #w.g, "place 675 95": #w.g, "\Cyan point=Population < 1E5" sh=3: #w.h, str$(sh): si=1: #w.i, str$(si): sj=1: #w.j, str$(sj): sk=1: #w.k, str$(sk)
goto [start] wait [coord] xx=MouseX: yy=MouseY LL=acs(X/R1): PP=acs(Y/R) #w.g, "color white;backcolor 60 60 60" #w.g, "place ";xx;" ";yy: #w.g, "\ ";str$(LL) #w.g, "place ";xx;" ";yy+20: #w.g, "\ ";str$(PP) wait [coord2] xx=MouseX-450: yy=350-MouseY 'R =300 if abs(yy/R)<=1 then lat$ = "";int(asn(yy/R)/pi*180) else lat$ = "" end if
RR=R*cos(asn(yy/R)) 'wisible width at "y" level if abs(xx/RR)<=1 then lon$ = "";int(asn(xx/RR)/pi*180) else lon$ = "" end if ' #w.coord xx;" ";yy;" ";lat$ #w.coord lon$;" ";lat$ wait
[start] #w.h, "!contents? sh$": sh=val(sh$): #w.i, "!contents? si$": si=val(si$) #w.j, "!contents? sj$": sj=val(sj$): #w.k, "!contents? sk$": sk=val(sk$) if sh > 3 then sh=3: if si > 3 then si=3: if sj > 3 then sj=3: if sk > 3 then sk=3 if sh < 1 then sh=1: if si < 1 then si=1: if sj < 1 then sj=1: if sk < 1 then sk=1
#w.a, "!disable": #w.f, "!disable": nn=0 for L0 =0 to 360 step 10 if sto=1 then wait [rema] #w.b, "!enable" #w.g "cls ; goto 450 350 ; down ; fill 60 60 60 ; size 1" #w.g " color white ; circle 300 ;color white ; size 1 ; down; flush" ' Add loop through range of P and LA to generate screen grid of lat /lon [grid] if gri=1 then [passgri] for lat =-90 to 90 step 10 ' BOTH IN DEGREES. EAST OF MERIDIAN +ve. NORTH +ve. for long = -180 to 180 step 10 L =long P =lat '#w.g "set "; int( 450 +2 *long); " "; int( 350 +3 *lat) gosub [findPoint] next long next lat [passgri] #w.g "flush" [dataShow] #w.g "color 180 180 100 ; size 2" open "LatLon2.txt" for input as #fIn line input #fIn, g$ for k =2 to 7343 line input #fIn, g$ L =val( word$( g$, 2, ",")) P =val( word$( g$, 1, ",")) pop =val( word$( g$, 3, ",")) gosub [findPoint] next k close #fIn #w.g "flush" #w.g "getbmp scr 1 1 898 738" if sav=1 then bmpsave "scr", "globe-" +right$( "000" +str$( L0), 3) +".bmp" end if scan nn=nn+1 #w.f, str$(nn) sto=1 '!! only one loop next L0 wait [reme] sto=0: goto [rema] wait [findPoint] ' SUBROUTINE TO COMPUTE MAP COORDINATES FOR ORTHOGRAPHIC EQUATORIAL PROJECTION.
' THE FOLLOWING VARIABLES MUST BE DEFINED BEFORE THIS SUBROUTINE IS CALLED: ' P IS THE GEOGRAPHIC LATITUDE IN DEGREES OF THE POINT BEING CONVERTED. ' L IS THE GEOGRAPHIC LONGITUDE IN DEGREES OF THE POINT BEING CONVERTED. ' R IS THE RADIUS OF THE FINISHED MAPS IN PIXELS.
' THE FOLLOWING VARIABLES ARE COMPUTED BY THIS SUBROUTINES ' S IS THE OFF-SCALE FLAG. S =0 MEANS ON-SCALE S =1 MEANS OFF-SCALE. ' R1 IS TEMPORARY STORAGE. ' X 1S THE MAP X-COORDINATE IN PIXELS. ' Y IS THE MAP Y=COORDINATE IN PIXELS. S = 0 ' ROTATE THE GEOGRAPHIC LONGITUDE OF THE POINT FROM THE DATA BASE TO REFERENCE IT TO THE MAP CENTER LONGITUDE ' AND CONVERT TO RADIANS. L = ( L -L0) *pi /180 P = P *pi /180 ' NORMALIZE THE ROTATED LONGITUDE BETWEEN ~180 DEGREES AND +180 DEGREES (-PI AND +PI) IF L >pi THEN L = L - twoPi IF L <( 0 -pi) THEN L = L + twoPi ' IF OFF-SCALE (OUTSIDE THE RANGE FROM -P1/2 TO +pi/2 SET FLAG AND RETURN IF L <( 0 -pi /2) THEN S = 1: RETURN IF L >( pi /2) THEN S = 1: RETURN ' COMPUTE THE MAP COORDINATES FROM THE GEOGRAPHIC COORDINATES. ' L IN RANGE -pi/2..pi/2 P IN RANGE -pi/pi. R1 = R * sin( ( pi /2 -abs( P))) X = R1 * sin( L) Y = R * sin( P) LL=acs(X/R1): PP=acs(Y/R) select case case pop >1E7 col$ ="red": size =sh case pop >1E6 col$ ="yellow": size =si case pop >1E5 col$ ="green": size =sj case else col$ ="cyan": size =sk end select #w.g "color "; col$ #w.g "size "; size #w.g "set "; int( 450 +X); " "; int( 350 -Y) RETURN END sub save buttonhandle$ sav=1 end sub sub sto buttonhandle$ sto=1: #w.b, "!disable" end sub sub gri buttonhandle$ gri=gri+1 if gri>1 then gri=0 end sub sub quit h$ close #h$ end end sub
|
|
|
Post by tsh73 on Apr 3, 2024 6:35:12 GMT -5
Speaking of "joining the dots" I suppose coast line mainly has close points so, if point is close I connect from previous Else I just put a dot Here what I got imgur.com/gtUabMX0.003 is trial and error value. You can tweak that. I think bigger will connect unrelated points... smaller will leave more unconnected dots. if ((X-lastX)*(X-lastX)+(Y-lastY)*(Y-lastY))>0.003*R1*R1 then #w.gb "set "; 410 + int( X ); " "; 330 - int( Y ) else #w.gb "goto "; 410 + int( X ); " "; 330 - int( Y ) end if
|
|
honky
Junior Member
Posts: 63
|
Post by honky on Apr 3, 2024 7:59:37 GMT -5
|
|
|
Post by tenochtitlanuk on Apr 3, 2024 8:43:58 GMT -5
There are indeed lots of free GIS databases around. Getting the data out in a form that LB can handle is a pain however. Natural disasters could be fun. Topography ( including ocean depths) too.
I wonder if I can download aircraft tracking data and show it 'on the globe'? It would show clearly the need for 'great circle' routes...
tsh73 ( Anatoly) seems to have implemented the Mouse position to Lat/Lon and worked on joining dots for coast if they are very close, and/or for the lat/lon grid.
Fun fun fun...
|
|
honky
Junior Member
Posts: 63
|
Post by honky on Apr 6, 2024 3:56:25 GMT -5
The meridian 0 is at Greenwich not elsewhere.. The rotation step is 9 ° 47 Latitudes are expressed in north and southern. Longitudes in the west and east. Almost good work.
|
|
|
Post by tsh73 on Apr 6, 2024 14:52:47 GMT -5
Aha-ha I did not even try. I fixed your problem "convert mouse coordinates to degrees" MouseX, MouseY to +/- 90 And it does work, doesn't it?
It was printed in same order, so x became longitude - first coord And meridian 0 indeed in Greenwich, but it was shown first coordinate.
Now, to cast it in correct form 51°28'40.12"N 0°00'05.31"W one needs some string handling, that's all Version below does it.
As for
this version does not rotate anything. (I deliberately broke it - I need single picture and needed it fast) You probably could re-enable it as you wish (or better copy that coordinate processing things to your working program)
nomainwin WindowWidth =900: WindowHeight =740 graphicbox #w.g, 1, 1, 898, 738 button #w.a, "Save bmps ",save, UL, 20, 10, 120, 25 statictext #w.coord, "", 20, 40, 300, 25 textbox #w.f, 160, 10, 30, 20 button #w.e, "Start",[start], UL, 200, 10, 50, 20 button #w.b, "Stop",sto, UL, 260, 10, 50, 20 button #w.c, "Go",[reme], UL, 320, 10, 50, 20 button #w.d, "Grid",gri, UL, 380, 10, 50, 20 textbox #w.h, 625, 10, 30, 20 textbox #w.i, 625, 36, 30, 20 textbox #w.j, 625, 62, 30, 20 textbox #w.k, 625, 87, 30, 20 open "World Views" for window as #w #w "trapclose quit" #w.g, "when rightButtonDown [coord]" #w.g, "when mouseMove [coord2]" global pi: pi =3.14159265 global twoPi: twoPi =2 *pi global sav: global sto: global gri #w.a, "!font courrier 10 bold": #w.e, "!font courrier 10 bold" #w.b, "!font courrier 10 bold": #w.c, "!font courrier 10 bold" #w.d, "!font courrier 10 bold": #w.h, "!font courrier 10 bold" #w.i, "!font courrier 10 bold": #w.j, "!font courrier 10 bold" #w.k, "!font courrier 10 bold" R =300 ' RADIUS OF GRAPHIC IN SCREEN PIXELS 'L0 = 80 ' LONGITUDE OF OBSERVER IN DEGREES. #w.g, "down;color red;size 8": #w.g, "set 665 20": #w.g, "color black" #w.g, "place 675 20": #w.g, "\Red point=Population > 1E7" #w.g, "color yellow;size 7": #w.g, "set 665 45": #w.g, "color black" #w.g, "place 675 45": #w.g, "\Yellow point=Population > 1E6" #w.g, "color green;size 7": #w.g, "set 665 70": #w.g, "color black" #w.g, "place 675 70": #w.g, "\Green point=Population > 1E5" #w.g, "color cyan;size 7": #w.g, "set 665 95": #w.g, "color black" #w.g, "place 675 95": #w.g, "\Cyan point=Population < 1E5" sh=3: #w.h, str$(sh): si=1: #w.i, str$(si): sj=1: #w.j, str$(sj): sk=1: #w.k, str$(sk)
goto [start] wait [coord] xx=MouseX: yy=MouseY LL=acs(X/R1): PP=acs(Y/R) #w.g, "color white;backcolor 60 60 60" #w.g, "place ";xx;" ";yy: #w.g, "\ ";str$(LL) #w.g, "place ";xx;" ";yy+20: #w.g, "\ ";str$(PP) wait [coord2] xx=MouseX-450: yy=350-MouseY 'R =300 lat=0:lon=0 if abs(yy/R)<=1 then lat =asn(yy/R)/pi*180 lat$ = "";int(lat) RR=R*cos(asn(yy/R)) 'wisible width at "y" level if abs(xx/RR)<=1 then lon=asn(xx/RR)/pi*180 lon$ = "";int(lon) else lon$ = "" end if else lat$ = "" end if
' #w.coord xx;" ";yy;" ";lat$ 'right form is 51°28'40.12"N 0°00'05.31"W #w.coord lat2deg$(lat) ;" ";lon2deg$(lon) wait
function lat2deg$(deg) lat2deg$=deg2deg$(deg) if deg>=0 then lat2deg$=lat2deg$;"N" else lat2deg$=lat2deg$;"S" end if end function
function lon2deg$(deg) lon2deg$=deg2deg$(deg) if deg>=0 then lon2deg$=lon2deg$;"E" else lon2deg$=lon2deg$;"W" end if end function
function deg2deg$(deg) 'to 51°28'40.12 deg = abs(deg) deg2deg$=int(deg);"°" deg = (deg mod 1)*60 deg2deg$=deg2deg$;right$("";100+int(deg),2);"'" deg = (deg mod 1)*60 'deg2deg$=deg2deg$;using("##.##", deg) deg2deg$=deg2deg$;right$(using("###.##",100+deg),5);chr$(34) end function
[start] #w.h, "!contents? sh$": sh=val(sh$): #w.i, "!contents? si$": si=val(si$) #w.j, "!contents? sj$": sj=val(sj$): #w.k, "!contents? sk$": sk=val(sk$) if sh > 3 then sh=3: if si > 3 then si=3: if sj > 3 then sj=3: if sk > 3 then sk=3 if sh < 1 then sh=1: if si < 1 then si=1: if sj < 1 then sj=1: if sk < 1 then sk=1
#w.a, "!disable": #w.f, "!disable": nn=0 for L0 =0 to 360 step 10 if sto=1 then wait [rema] #w.b, "!enable" #w.g "cls ; goto 450 350 ; down ; fill 60 60 60 ; size 1" #w.g " color white ; circle 300 ;color white ; size 1 ; down; flush" ' Add loop through range of P and LA to generate screen grid of lat /lon [grid] if gri=1 then [passgri] for lat =-90 to 90 step 10 ' BOTH IN DEGREES. EAST OF MERIDIAN +ve. NORTH +ve. for long = -180 to 180 step 10 L =long P =lat '#w.g "set "; int( 450 +2 *long); " "; int( 350 +3 *lat) gosub [findPoint] next long next lat [passgri] #w.g "flush" [dataShow] #w.g "color 180 180 100 ; size 2" open "LatLon2.txt" for input as #fIn line input #fIn, g$ for k =2 to 7343 line input #fIn, g$ L =val( word$( g$, 2, ",")) P =val( word$( g$, 1, ",")) pop =val( word$( g$, 3, ",")) gosub [findPoint] next k close #fIn #w.g "flush" #w.g "getbmp scr 1 1 898 738" if sav=1 then bmpsave "scr", "globe-" +right$( "000" +str$( L0), 3) +".bmp" end if scan nn=nn+1 #w.f, str$(nn) sto=1 '!! only one loop next L0 wait [reme] sto=0: goto [rema] wait [findPoint] ' SUBROUTINE TO COMPUTE MAP COORDINATES FOR ORTHOGRAPHIC EQUATORIAL PROJECTION.
' THE FOLLOWING VARIABLES MUST BE DEFINED BEFORE THIS SUBROUTINE IS CALLED: ' P IS THE GEOGRAPHIC LATITUDE IN DEGREES OF THE POINT BEING CONVERTED. ' L IS THE GEOGRAPHIC LONGITUDE IN DEGREES OF THE POINT BEING CONVERTED. ' R IS THE RADIUS OF THE FINISHED MAPS IN PIXELS.
' THE FOLLOWING VARIABLES ARE COMPUTED BY THIS SUBROUTINES ' S IS THE OFF-SCALE FLAG. S =0 MEANS ON-SCALE S =1 MEANS OFF-SCALE. ' R1 IS TEMPORARY STORAGE. ' X 1S THE MAP X-COORDINATE IN PIXELS. ' Y IS THE MAP Y=COORDINATE IN PIXELS. S = 0 ' ROTATE THE GEOGRAPHIC LONGITUDE OF THE POINT FROM THE DATA BASE TO REFERENCE IT TO THE MAP CENTER LONGITUDE ' AND CONVERT TO RADIANS. L = ( L -L0) *pi /180 P = P *pi /180 ' NORMALIZE THE ROTATED LONGITUDE BETWEEN ~180 DEGREES AND +180 DEGREES (-PI AND +PI) IF L >pi THEN L = L - twoPi IF L <( 0 -pi) THEN L = L + twoPi ' IF OFF-SCALE (OUTSIDE THE RANGE FROM -P1/2 TO +pi/2 SET FLAG AND RETURN IF L <( 0 -pi /2) THEN S = 1: RETURN IF L >( pi /2) THEN S = 1: RETURN ' COMPUTE THE MAP COORDINATES FROM THE GEOGRAPHIC COORDINATES. ' L IN RANGE -pi/2..pi/2 P IN RANGE -pi/pi. R1 = R * sin( ( pi /2 -abs( P))) X = R1 * sin( L) Y = R * sin( P) LL=acs(X/R1): PP=acs(Y/R) select case case pop >1E7 col$ ="red": size =sh case pop >1E6 col$ ="yellow": size =si case pop >1E5 col$ ="green": size =sj case else col$ ="cyan": size =sk end select #w.g "color "; col$ #w.g "size "; size #w.g "set "; int( 450 +X); " "; int( 350 -Y) RETURN END sub save buttonhandle$ sav=1 end sub sub sto buttonhandle$ sto=1: #w.b, "!disable" end sub sub gri buttonhandle$ gri=gri+1 if gri>1 then gri=0 end sub sub quit h$ close #h$ end end sub
|
|
honky
Junior Member
Posts: 63
|
Post by honky on Apr 7, 2024 2:26:01 GMT -5
Oh yesss, it's better bettter. Thank you. I will try to turn the coordinates.
|
|
|
Post by tenochtitlanuk on Apr 14, 2024 12:07:19 GMT -5
Sorry- only now posting latest version with all projections working. If you run it, I suggest you view the Help file while it completes the default initial map. File at forNow2.zip
|
|
|
Post by tsh73 on Apr 15, 2024 5:13:55 GMT -5
Really nice pictures, pleasure to view I will show it my fellow teachers so they probably could use it for motivating students. (I actually think Carl Gundel should include this as example of cool things done with Liberty BASIC)
|
|
|
Post by xxgeek on Apr 22, 2024 14:03:45 GMT -5
Here's something the kids and grand kids can play with.
- Expects LanLon4.csv and dataWc.csv in to be in DefaultDir$ - Lots of color variables to change, and a few sizes. - Grid, or no grid. - Fill Land, or OutLine Land. - Make the BMP's for a Gif - Watch it spin(after the .bmp's are made) - Making the GIF requires Gimp installed, and Google - How to make a GIF in GIMP for easy instructions. - Graphic updated after every change. When you like what you see, Make the BMP's (IT really does take a few minutes to make BMP files so, go make a coffee, or dinner)
No update to the help file, so wing it. - Making the .bmp files takes a while, even longer if OutLine Land is ON. - OutLine takes longer per pic than the Fill -as is 180 pics are saved if Make BMP's is pushed.(360/2) - can be changed in code -Lower 'step' number = more pics, and less spin speed - Higher 'step' number = less pics, and faster spin speed.
Enjoy! PS I do this for fun, not to annoy anyone, or steal their code. I hold no copyrights to any code, and never will.
'World Views by tenochtitlanuk 'https://libertybasiccom.proboards.com/threads/recent/2558
' ********************************************** ' *** *** ' *** GUIglobeOtherProjns05b.bas *** ' *** *** ' **********************************************
'To-dos:- ' <<< Height has no effect >>>> CORRECTED ' <<< Grid doesn't always fill globe >>>> CORRECTED ' <<< Need range checks on A H I LO >>>> DONE ' <<< Need to modify 'J' selector to allow more options. >>>> DONE ' <<< Add file selectors for loading data and saving image. >>>> DONE ' <<< Lat/l were reversed on original LatLon datafile >>>> CORRECTED ' <<< Investigate drawing grid with lines >>>> DONE ' <<< Add a help file option, and on-screen help. >>>> DONE ' <<< Add rectangular background and Cartesian Lat/Lon display >>>> DONE
' <<< Disable /enable 'New'/'Save' buttons appropriately >>>> Part done
' <<< Add button to opt for N or S polar view if J = 4 >>>>
nomainwin global fileOpen, pi, windowOpen, bakColor$, backGroundColor$, planetColor$ dim penSize$(10) penSize = 1 for n = 1 to 10 penSize$(penSize) = str$(n) penSize=penSize + 1 next n dim glowDepth$(101) glowDepth = 1 for n = 0 to 100 glowDepth$(glowDepth) = str$(n) glowDepth=glowDepth + 1 next n dim earthSize$(35) esize=1 for n= 10 to 350 step 10 earthSize$(esize)=str$(n) esize=esize+1 next n dim color$(18) color$(1)="Yellow" color$(2)="Brown" color$(3)="Red" color$(4)="DarkRed" color$(5)="Pink" color$(6)="DarkPink" color$(7)="Blue" color$(8)="DarkBlue" color$(9)="Green" color$(10)="DarkGreen" color$(11)="Cyan" color$(12)="DarkCyan" color$(13)="White" color$(14)="Black" color$(15)="LightGray" color$(16)="DarkGray" color$(17)="Buttonface"
planetColor$ = "Black" planetGlowColor$ = "Darkblue" continentsColor$ = "Green" backGroundColor$ = "Black" grid = 1 glowDepth = 5 penSize = 1 longitude = -360 fileOpen =0
pi =3.14159265 ' constants E = 6378.0 ' Earth radius K1 = 1.0 K2 = pi / 2 ' pi /2 K3 = pi ' pi K6 = 2 * pi ' 2 pi T = 0.00015 ' test value Z = 0.0 R = 200 ' map size in pixels /cm CR$ =chr$( 13 )
WindowWidth =1360 WindowHeight = 768 UpperLeftX = (DisplayWidth-WindowWidth)/2 UpperLeftY = (DisplayHeight-WindowHeight)/2 TextboxColor$ = "black" textbox #w.tb1, 320, 62, 80, 30 textbox #w.tb2, 320, 107, 80, 30 textbox #w.tb3, 320, 151, 80, 30 textbox #w.tb4, 320, 194, 80, 30 textbox #w.tb5, 320, 244, 80, 30 statictext #w.st1, " A -latitude /degrees" +CR$ +CR$_ +" H -height /m"_ +CR$ + CR$ +" I -azimuth /degrees" +CR$_ +CR$ +" LO -longitude /degrees"_ +CR$ + "--------------------" +CR$_ + " 0 =perspective" +CR$_ + " 1 =mod'd persp'ive" + CR$_ + " 2 =azimuthal equidistant"_ + CR$ + " 3 =polar equidistant" +CR$_ + " 4 =ortho equatorial"_ + CR$ + " 5 =Cartesian Lat /Lon", 9, 65, 300, 320 button #w.appear, "Fill Land", [fillCont],ul, 15, 390, 140, 20 button #w.appear2, "Outline Land", [outlineCont],ul, 200, 390, 160, 20 statictext #w.stfill, "", 163, 390, 30, 20 statictext #w.stoutline, "", 370, 390, 35, 20
button #w.grid, "No Grid", [noGrid],ul, 280, 350, 85, 25 statictext #w.stgrid, "Off", 370, 350, 35, 20 ComboboxColor$="black" combobox #w.extraColor,color$(,[extraColor], 220, 2, 140, 20 combobox #w.glowDepth,glowDepth$(,[glowDepth], 370, 2, 125, 20 combobox #w.penSize,penSize$(,[penSize], 510, 2, 110, 20 combobox #w.earthSize,earthSize$(,[earthSize], 630, 2, 130, 20 combobox #w.bakColor,color$(,[bakColor], 770, 0,130, 20 combobox #w.earthColor,color$(,[earthColor], 910, 2,145, 20 combobox #w.glowColor,color$(,[glowColor], 1065, 2,130, 20 combobox #w.contColor,color$(,[contColor], 1205, 2,135, 20 statictext #w.stextraColor, "", 220, 36, 130, 20 statictext #w.stglowDepth, "", 370, 36, 120, 20 statictext #w.stpenSize, "", 510, 36, 120, 20 statictext #w.stearthSize, "", 630, 36, 120, 20 statictext #w.stbakColor, "", 770, 36, 130, 20 statictext #w.stearthColor, "", 910, 36, 130, 20 statictext #w.stglowColor, "", 1065, 36, 130, 20 statictext #w.stcontColor, "", 1205, 36, 130, 20 graphicbox #w.gb, 410, 60, 940, 695 button #w.b1 "New Creation", [dataShow], ul, 120, 430, 160, 50 button #w.b2 "Save SnapShot", [saveScr], ul, 120, 490, 160, 40 statictext #w.st2, "Create a Spinning Globe GIF", 20, 550, 390, 30 statictext #w.st3, "Step #1", 30, 605, 80, 20 statictext #w.st4, "Step #2", 30, 662, 80, 20 statictext #w.st5, "Step #3", 30, 718, 80, 20 statictext #w.st6, "(Optional)", 285, 662, 110, 20 button #w.b5 "Make BMP's", [makeBMP], ul, 120, 590, 160, 40 button #w.b6 "Show Spinning", [showSpinningGlobe], ul, 120, 650, 160, 40 button #w.b7 "Make Gif", [makeGif], ul, 120, 710, 160, 40 button #w.b3, "&?", [guide], ul, 25, 0, 25, 30 button #w.b4, "X", quit , ul, 55, 0, 25, 30 ForegroundColor$ = "cyan" BackgroundColor$ = "black" open "Spinning Globe" for window_popup as #w #w "trapclose quit" #w "font Courier_New 14 bold" #w.stglowDepth " ";glowDepth #w.stpenSize " ";penSize #w.stearthSize " ";R #w.stbakColor " ";backGroundColor$ #w.stearthColor " ";planetColor$ #w.stglowColor " ";planetGlowColor$ #w.stcontColor " ";continentsColor$ #w.extraColor "!ExtraColor" #w.glowDepth "!GlowSize" #w.penSize "!PenSize" #w.earthSize "!GlobeSize" #w.bakColor "!BackColor" #w.glowColor "!GlowColor" #w.contColor "!LandColor" #w.earthColor "!GlobeColor" #w.stfill "On" #w.stoutline "Off" #w.st2 "!font Courier_New 20 bold" #w.tb1 "20" #w.tb2 "1e8" #w.tb3 "0" #w.tb4 "-90" #w.tb5 "0" #w.b1 "!disable" window = hwnd(#w) R =250 ' size of screen globe D = 3 ' dia in inches of map??<<<<<<<<<<<<<<<<<
[dataShow] #w.tb1 "!contents? inA$": A = val( inA$ ) *pi /180: #w.tb1 inA$: if A > 90 or A < 0 -90 then wait #w.tb2 "!contents? inH$": H = val( inH$ ): H2 = E * H: if H <0 then wait #w.tb3 "!contents? inI$": I = val( inI$ ) *pi /180: #w.tb3 inI$: if I < 0 -360 or I > 360 then wait #w.tb4 "!contents? inLO$": LO = val( inLO$ ) *pi /180: #w.tb4 inLO$: if LO > 180 or LO < 0 -180 then wait #w.tb5 "!contents? inJ$": J = val( inJ$ ): if J <> int( J ) or J > 5 or J < 0 then wait #w.gb "cls ; down ; fill ";backGroundColor$;" ;backcolor ";planetColor$;" ; up ; goto 480 350 ; down" #w.gb "color ";planetColor$;" ; circlefilled ";R if glowDepth <> 0 then #w.gb "size ";glowDepth #w.gb "color ";planetGlowColor$;" ; circle ";R+glowDepth end if #w.b1 "!disable" #w.gb "flush" ' A ( entered in +degrees) latitude above which we are viewing. ' LO ( longitude) and ' I ( azimuth) also entered in degrees to East and clockwise. ' all three internally converted to radians. A1 = sin( A ) A2 = cos( A ) H2 = E + H M = acs( E / H2 ) ' max possible angle from observer to outer visible ring G = E * ( H2 - E * cos( M ) ) ' scaling factor F = R / ( E * sin( M ) ) ' scaling factors for two cases F1 = R / M if grid then [skipgrid] [grid] if J = 5 then #w.gb "fill black ; backcolor darkblue ; goto 0 170 ; boxfilled 780 480" else #w.gb "color white ; size 1" for long = -180 to 180 step 10 for lat = -90 to 90 step 0.75 L =long * pi / 180 ' both in radians P =lat * pi / 180
if J = 0 or J = 1 or J = 2 then gosub [doP1ot012] 'calldll #kernel32, "Sleep", 100 as long, ret as void ' if want to watch slowly! if J = 3 then gosub [doPlot3] if J = 4 then gosub [doPlot4] if J = 5 then gosub [doPlot5] scan next lat next long
#w.gb "color lightgray" for long = -180 to 180 step 0.5 for lat = -90 to 90 step 10 L =long * pi / 180 ' both in radians P =lat * pi / 180 if J = 0 or J = 1 or J = 2 then gosub [doP1ot012] 'calldll #kernel32, "Sleep", 100 as long, ret as void ' if want to watch slowly! if J = 3 then gosub [doPlot3] if J = 4 then gosub [doPlot4] if J = 5 then gosub [doPlot5] scan next lat next long end if [skipgrid] if penSize <> 0 then #w.gb "size ";penSize;" ; color ";continentsColor$ 'if your file is LF separated, convert it first to CRLF ' eg "sed -i 's/$/\r/' file.txt" 'sed is a Linux stream editor, -i is used to edit the file in place, and ' s/$/\r/ is a substitution command that appends a carriage return (\r) ' to the end of each line. "file.txt" is the name of the file to convert. if fillCont = 1 then fln$ = DefaultDir$;"\dataWc.csv" else fln$ = DefaultDir$;"\LatLon4.csv" end if if fileExists(DefaultDir$, "dataWc.csv") then open fln$ for input as #fIn else notice "Can't find ";fln$;" in ";chr$(13);chr$(13);DefaultDir$ : close #fIn end if fileOpen =1 'line input #fIn, g$ ' discard title line gridDrawing = 0 do line input #fIn, g$ ' lat, lon P =val( word$( g$, 1, ",")) * pi / 180 L =val( word$( g$, 2, ",")) * pi / 180 if J = 0 or J = 1 or J = 2 then gosub [doP1ot012] if J = 3 then gosub [doPlot3] if J = 4 then gosub [doPlot4] if J = 5 then gosub [doPlot5] scan loop until eof( #fIn) close #fIn fileOpen =0 #w.b1 "!enable" if makeSpinPics =1 then [makeSpinPics] #w.b1 "!setfocus" wait
[makeBMP] makeSpinPics=1 goto [dataShow]
[saveScr] #w.gb "getbmp scr 0 0 920 705" filedialog "Choose a filename to save image as ", "*.bmp", fOut$ if fOut$ ="" then fOut$ = "Cancelled_SaveDialog" +str$( time$( "seconds" ) ) +".bmp" bmpsave "scr", fOut$ wait
[makeSpinPics] bmpNum=bmpNum+2 longitude=longitude+2 #w.gb "getbmp scr 0 0 920 705" fOut$ = longitude+359;".bmp" bmpsave "scr", fOut$ if longitude > 0 then makeSpinPics = 0 notice "Number of Pictures = ";bmpNum/2 goto [showSpinningGlobe] end if #w.tb4 longitude goto [dataShow] wait
[showSpinningGlobe] ' = 180 .bmp picture files(higher 'step' number = quicker spin = less .bmp files) for picName = 1 to 361 step 2 loadbmp "picName", picName;".bmp" #w.gb "drawbmp picName 10 10 ; flush currentImage" unloadbmp "picName" scan next picName Notice "BMP files are ready to make a GIF file." wait
[makeGif] if fileExists("C:\Program Files\GIMP 2\bin", "gimp-2.10.exe") then run "C:\Program Files\GIMP 2\bin\gimp-2.10.exe" else notice chr$(13);chr$(13);"You need to 'Install Gimp' in order to make GIF files.";chr$(34);chr$(34);_ "It's Best to Allow Gimp Installer to Install Where it Wants To" run "explorer https://www.gimp.org/downloads/" end if wait
[noGrid] if grid = 0 then grid = 1 : #w.grid "No Grid" : #w.stgrid "Off" else #w.grid "Grid" : grid = 0 : #w.stgrid "On" end if goto [dataShow]
[fillCont] #w.stfill "On" #w.stoutline "Off" fillCont = 0 goto [dataShow]
[outlineCont] #w.stfill "Off" #w.stoutline "On" fillCont = 1 goto [dataShow]
[extraColor] #w.extraColor "contents? extraColor$" ColorDialog extraColor$, Chosen$ extraColor$ = Chosen$ #w.extraColor "!ExtraColor" #w.stextraColor extraColor$ goto [dataShow]
[glowDepth] #w.glowDepth "contents? glowDepth$" glowDepth=val(glowDepth$) #w.glowDepth "!GlowSize" #w.stglowDepth " ";glowDepth goto [dataShow]
[earthSize] #w.earthSize "contents? earthSize$" R = val(earthSize$) #w.earthSize "!GlobeSize" #w.stearthSize " ";R goto [dataShow]
[penSize] #w.penSize "contents? penSize$" penSize=val(penSize$) #w.penSize "!PenSize" #w.stpenSize " ";penSize goto [dataShow]
[bakColor] #w.bakColor "contents? backGroundColor$" ColorDialog backGroundColor$, Chosen$ backGroundColor$ = Chosen$ #w.bakColor "!BakColor" #w.stbakColor Chosen$ goto [dataShow]
[earthColor] #w.earthColor "contents? earthColor$" ColorDialog earthColor$, Chosen$ planetColor$ = Chosen$ #w.earthColor "!GlobeColor" #w.stearthColor Chosen$ goto [dataShow]
[glowColor] #w.glowColor "contents? glowColor$" ColorDialog glowColor$, Chosen$ planetGlowColor$ = Chosen$ #w.glowColor "!GlowColor" #w.stglowColor Chosen$ goto [dataShow]
[contColor] #w.contColor "contents? continentsColor$" ColorDialog continentsColor$, Chosen$ continentsColor$ = Chosen$ #w.contColor "!LandColor" #w.stcontColor Chosen$ goto [dataShow]
[doP1ot012] '#w.b1 "!disable" scan S = Z L1 = L - LO if L1 >= 0 -K3 then goto 3000 L1 = L1 + K6 goto 5500
3000 if L1 <= K3 then goto 4000 L1 = L1 - K6
4000 B1 = abs( L1) if B1 > T then goto 4050 D = abs( A - P ) if D > M then goto 4300 D1 = sin( D ) D2 = cos( D ) C = Z if P >= A then goto 5000 C = K3 goto 5000 ' ??? is this the correct target? 4050 if abs( K3 - B1 ) > T then goto 4250 D = K3 - A - P if D > K3 then goto 4100 C = Z goto 4200 4100 D = K6 - D C = K3 4200 if D > M then goto 4300 D1 = sin( D) D2 = cos( D) goto 5000 4250 P1 = sin( P ) D2 = A1 * P1 + A2 * Cos( P ) * Cos( L1 ) D = acs( D2) if D <= M then goto 4500 4300 S = K1 return
4500 D1 = sin( D ) C1 = ( P1 - A1 * D2 ) / ( A2 * D1 ) if C1 < 0 -K1 then goto 4300 if C1 > K1 then goto 4300
C = acs( C1) if L1 >= Z then goto 5000 C = K6 - C 5000 if I = Z then goto 5500 C = C - I if C >= Z then goto 5500 C = K6 + C 5500 C = K2 -C
5600 if C >= 0 -K3 then goto 6000 C = C + K6 6000 if J <> Z then goto 6500 R1 = F * ( G * D1 ) / ( H2 -E * D2 ) 6250 goto 7000 6500 if J <> K1 then goto 6700 R1 = F * E * D1 6600 goto 7000 6700 R1 = F1 * D 7000 X = R1 * cos( C ) Y = R1 * sin( C )
#w.gb "color ";continentsColor$;" ; set "; 480 + int( X );" ";350 - int( Y ) if extraColor$ <> "" then #w.gb "color ";extraColor$;" ; set ";481 + int( X ); " ";351 - int( Y ) return
' _________________________________________________________________
[doPlot3] ' Map to polar equidistant coordinates H = 0 ' Northern hemisphere: = 1 for Southern hemisphere if H = 0 then goto 7490 if P > 0.0 then goto 7500 L = 0 - L goto 7540 7490 if P >= 0.0 then goto 7540 7500 S = 1 return 7540 F = 2 * R / pi R1 = F * ( 1.5707963 - abs( P )) X = R1 * cos( L ) Y = R1 * sin( L ) #w.gb "color ";continentsColor$;" ; set "; 480 + int( X ); " "; 350 - int( Y ) if extraColor$ <> "" then #w.gb "color ";extraColor$;" ; set "; 481 + int( X ); " "; 351 - int( Y ) return '_______________________________________________ [doPlot4] ' Map to ortho equatorial coordinates 'print P, L scan R = 300 S = 0 L = L - LO if L <= 3.14159265 then 9450 L = L - 6.2831853 goto 9490 9450 if L >= 0 - 3.14159265 then 9490 L = L + 6.2831853 9490 if L < 0 - 1.5707963 then 9510 if L <= 1.5707963 then 9550 9510 S = 1 return 9550 R1 = R * sin( 1.5707963 - abs( P )) X = R1 * sin( L ) Y = R * sin( P ) #w.gb "color ";continentsColor$;" ; set "; 480 + int( X ); " "; 350 - int( Y ) if extraColor$ <> "" then #w.gb "color ";extraColor$;" ; set "; 481 + int( X ); " "; 351 - int( Y ) return ' ______________________________________ [doPlot5] #w.gb "color ";continentsColor$;" ; set "; 434 + int( 2.15 * L * 180 / pi ); " "; 350 - int( 1.6 * P * 180 / pi ) if extraColor$ <> "" then #w.gb "color ";extraColor$;"set "; 435 + int( 2.15 * L * 180 / pi ); " "; 351 - int( 1.6 * P * 180 / pi ) return ' ______________________________________ [guide] WindowWidth =800 WindowHeight =800 open "Guidance and help" for text as #w2 windowOpen = 1 #w2 "!font Courier_New 12 bold" open "help.txt" for input as #fIn2 txt$ = input$( #fIn2, lof( #fIn2 )) close #fIn2 windowOpen = 1 #w2 txt$ wait ' ______________________________________ sub quit h$ if windowOpen = 1 then close #w2 if fileOpen = 1 then close #fIn close #w end end sub '_______________________________________________
'Verify file existence function function fileExists(path$, filename$) dim fileExistsInfo$(0,0) files path$, filename$, fileExistsInfo$() fileExists = val(fileExistsInfo$(0, 0)) 'non zero is true end function
|
|
|
Post by tsh73 on Apr 23, 2024 6:48:29 GMT -5
Hello xxgeek
It looks like variable 'window' in the line
window = hwnd(#w) never actually got any use afterwards.
So by removing this line you make program JB-compatible.
(also WindowWidth =1360 might be a bit too wide for some monitors )
|
|
|
Post by xxgeek on Apr 23, 2024 8:04:31 GMT -5
Done, and done TSH73. Still a work in progress. There is so much one can do with this code I keep getting new ideas.
- now 1200x750 - added ability to have Fill, AND Outline - added disable to all controls while drawing - added a bit more to Extra color - works with JB now
New ideas - ability to draw by hand onto picture - ability for user to adjust # of BMP's created (spin speed) - ability to change grid color independent of Land Color - ability to save each config, and select from list created Spinners
One issue perplexing me. I load a bmp, then draw it, then unload it, but if I spin more than one revolution, I get "out of mem" errors. Still working on it.
1200x750 - JB compatible {EDIT] - OOPS! - Error introduced created double vision - fixed.
'World Views by tenochtitlanuk 'https://libertybasiccom.proboards.com/threads/recent/2558
' ********************************************** ' *** *** ' *** GUIglobeOtherProjns05b.bas *** ' *** *** ' **********************************************
'To-dos:- ' <<< Height has no effect >>>> CORRECTED ' <<< Grid doesn't always fill globe >>>> CORRECTED ' <<< Need range checks on A H I LO >>>> DONE ' <<< Need to modify 'J' selector to allow more options. >>>> DONE ' <<< Add file selectors for loading data and saving image. >>>> DONE ' <<< Lat/l were reversed on original LatLon datafile >>>> CORRECTED ' <<< Investigate drawing grid with lines >>>> DONE ' <<< Add a help file option, and on-screen help. >>>> DONE ' <<< Add rectangular background and Cartesian Lat/Lon display >>>> DONE
' <<< Disable /enable 'New'/'Save' buttons appropriately >>>> Part done
' <<< Add button to opt for N or S polar view if J = 4 >>>>
nomainwin global fileOpen, pi, windowOpen, bakColor$, backGroundColor$, planetColor$ dim penSize$(10) penSize = 1 for n = 1 to 10 penSize$(penSize) = str$(n) penSize=penSize + 1 next n dim glowDepth$(101) glowDepth = 1 for n = 0 to 100 glowDepth$(glowDepth) = str$(n) glowDepth=glowDepth + 1 next n dim earthSize$(35) esize=1 for n= 10 to 350 step 10 earthSize$(esize)=str$(n) esize=esize+1 next n dim color$(18) color$(1)="Yellow" color$(2)="Brown" color$(3)="Red" color$(4)="DarkRed" color$(5)="Pink" color$(6)="DarkPink" color$(7)="Blue" color$(8)="DarkBlue" color$(9)="Green" color$(10)="DarkGreen" color$(11)="Cyan" color$(12)="DarkCyan" color$(13)="White" color$(14)="Black" color$(15)="LightGray" color$(16)="DarkGray" color$(17)="Buttonface"
planetColor$ = "Black" planetGlowColor$ = "Darkblue" continentsColor$ = "Green" backGroundColor$ = "Black" grid = 1 glowDepth = 5 penSize = 1 longitude = -360 fileOpen =0
pi =3.14159265 ' constants E = 6378.0 ' Earth radius K1 = 1.0 K2 = pi / 2 ' pi /2 K3 = pi ' pi K6 = 2 * pi ' 2 pi T = 0.00015 ' test value Z = 0.0 R = 250 ' map size in pixels /cm CR$ =chr$( 13 )
WindowWidth =1200 WindowHeight = 750'768 UpperLeftX = (DisplayWidth-WindowWidth)/2 UpperLeftY = (DisplayHeight-WindowHeight)/2 TextboxColor$ = "black" textbox #w.tb1, 320, 62, 80, 30 textbox #w.tb2, 320, 107, 80, 30 textbox #w.tb3, 320, 151, 80, 30 textbox #w.tb4, 320, 194, 80, 30 textbox #w.tb5, 320, 244, 80, 30 statictext #w.st1, " A -latitude /degrees" +CR$ +CR$_ +" H -height /m"_ +CR$ + CR$ +" I -azimuth /degrees" +CR$_ +CR$ +" LO -longitude /degrees"_ +CR$ + "--------------------" +CR$_ + " 0 =perspective" +CR$_ + " 1 =mod'd persp'ive" + CR$_ + " 2 =azimuthal equidistant"_ + CR$ + " 3 =polar equidistant" +CR$_ + " 4 =ortho equatorial"_ + CR$ + " 5 =Cartesian Lat /Lon", 9, 65, 300, 320 button #w.appear, "Fill Land", [fillCont],ul, 15, 390, 140, 20 button #w.appear2, "Outline Land", [outlineCont],ul, 200, 390, 160, 20 statictext #w.stfill, "", 163, 390, 30, 20 statictext #w.stoutline, "", 370, 390, 35, 20
button #w.grid, "No Grid", [noGrid],ul, 280, 350, 85, 25 statictext #w.stgrid, "Off", 370, 350, 35, 20 ComboboxColor$="black" combobox #w.extraColor,color$(,[extraColor], 220, 2, 140, 20 combobox #w.glowDepth,glowDepth$(,[glowDepth], 370, 2, 125, 20 combobox #w.penSize,penSize$(,[penSize], 510, 2, 110, 20 combobox #w.earthSize,earthSize$(,[earthSize], 630, 2, 130, 20 combobox #w.bakColor,color$(,[bakColor], 770, 0,130, 20 combobox #w.earthColor,color$(,[earthColor], 910, 2,145, 20 combobox #w.glowColor,color$(,[glowColor], 85, 2,130, 20 combobox #w.contColor,color$(,[contColor], 1065, 2,135, 20 statictext #w.stextraColor, "", 220, 36, 130, 20 statictext #w.stglowDepth, "", 370, 36, 120, 20 statictext #w.stpenSize, "", 510, 36, 120, 20 statictext #w.stearthSize, "", 630, 36, 120, 20 statictext #w.stbakColor, "", 770, 36, 130, 20 statictext #w.stearthColor, "", 910, 36, 130, 20 statictext #w.stglowColor, "", 85, 36, 130, 20 statictext #w.stcontColor, "", 1205, 36, 130, 20 graphicbox #w.gb, 420, 60, 770, 680 button #w.b1 "New Creation", [dataShow], ul, 120, 430, 160, 50 button #w.b2 "Save SnapShot", [saveScr], ul, 120, 490, 160, 40 statictext #w.st2, "Create a Spinning Globe GIF", 20, 550, 390, 30 statictext #w.st3, "Step #1", 30, 605, 80, 20 statictext #w.st4, "Step #2", 30, 662, 80, 20 statictext #w.st5, "Step #3", 30, 713, 80, 20 statictext #w.st6, "(Optional)", 285, 657, 110, 20 button #w.b5 "Make BMP's", [makeBMP], ul, 120, 590, 160, 40 button #w.b6 "Show Spinning", [showSpinningGlobe], ul, 120, 645, 160, 40 button #w.b7 "Make Gif", [makeGif], ul, 120, 700, 160, 40 button #w.b3, "&?", [guide], ul, 15, 0, 25, 30 button #w.b4, "X", quit , ul, 45, 0, 25, 30 ForegroundColor$ = "cyan" BackgroundColor$ = "black" open "Spinning Globe" for window_popup as #w #w "trapclose quit" #w "font Courier_New 14 bold" #w.stglowDepth " ";glowDepth #w.stpenSize " ";penSize #w.stearthSize " ";R #w.stbakColor " ";backGroundColor$ #w.stearthColor " ";planetColor$ #w.stglowColor " ";planetGlowColor$ #w.stcontColor " ";continentsColor$ #w.extraColor "!ExtraColor" #w.glowDepth "!GlowSize" #w.penSize "!PenSize" #w.earthSize "!GlobeSize" #w.bakColor "!BackColor" #w.glowColor "!GlowColor" #w.contColor "!LandColor" #w.earthColor "!GlobeColor" #w.stfill "On" #w.stoutline "Off" #w.st2 "!font Courier_New 20 bold" #w.tb1 "20" #w.tb2 "1e8" #w.tb3 "0" #w.tb4 "-90" #w.tb5 "0" #w.b1 "!disable" 'window = hwnd(#w) R =250 ' size of screen globe D = 3 ' dia in inches of map??<<<<<<<<<<<<<<<<<
[dataShow] #w.tb1 "!contents? inA$": A = val( inA$ ) *pi /180: #w.tb1 inA$: if A > 90 or A < 0 -90 then wait #w.tb2 "!contents? inH$": H = val( inH$ ): H2 = E * H: if H <0 then wait #w.tb3 "!contents? inI$": I = val( inI$ ) *pi /180: #w.tb3 inI$: if I < 0 -360 or I > 360 then wait #w.tb4 "!contents? inLO$": LO = val( inLO$ ) *pi /180: #w.tb4 inLO$: if LO > 180 or LO < 0 -180 then wait #w.tb5 "!contents? inJ$": J = val( inJ$ ): if J <> int( J ) or J > 5 or J < 0 then wait #w.gb "cls ; down ; fill ";backGroundColor$;" ;backcolor ";planetColor$;" ; up ; goto 410 350 ; down" #w.gb "color ";planetColor$;" ; circlefilled ";R if glowDepth <> 0 then #w.gb "size ";glowDepth #w.gb "color ";planetGlowColor$;" ; circle ";R+glowDepth end if #w.gb "flush" ' A ( entered in +degrees) latitude above which we are viewing. ' LO ( longitude) and ' I ( azimuth) also entered in degrees to East and clockwise. ' all three internally converted to radians. A1 = sin( A ) A2 = cos( A ) H2 = E + H M = acs( E / H2 ) ' max possible angle from observer to outer visible ring G = E * ( H2 - E * cos( M ) ) ' scaling factor F = R / ( E * sin( M ) ) ' scaling factors for two cases F1 = R / M if grid then [skipgrid] [grid] if J = 5 then #w.gb "fill black ; backcolor darkblue ; goto 0 170 ; boxfilled 780 410" else #w.gb "color white ; size 1" for long = -180 to 180 step 10 for lat = -90 to 90 step 0.75 L =long * pi / 180 ' both in radians P =lat * pi / 180
if J = 0 or J = 1 or J = 2 then gosub [doP1ot012] 'calldll #kernel32, "Sleep", 100 as long, ret as void ' if want to watch slowly! if J = 3 then gosub [doPlot3] if J = 4 then gosub [doPlot4] if J = 5 then gosub [doPlot5] scan next lat next long
#w.gb "color lightgray" for long = -180 to 180 step 0.5 for lat = -90 to 90 step 10 L =long * pi / 180 ' both in radians P =lat * pi / 180 if J = 0 or J = 1 or J = 2 then gosub [doP1ot012] 'calldll #kernel32, "Sleep", 100 as long, ret as void ' if want to watch slowly! if J = 3 then gosub [doPlot3] if J = 4 then gosub [doPlot4] if J = 5 then gosub [doPlot5] scan next lat next long end if [skipgrid] 'if your file is LF separated, convert it first to CRLF ' eg "sed -i 's/$/\r/' file.txt" 'sed is a Linux stream editor, -i is used to edit the file in place, and ' s/$/\r/ is a substitution command that appends a carriage return (\r) ' to the end of each line. "file.txt" is the name of the file to convert. if fillCont = 1 or both = 1 then fln$ = DefaultDir$;"\dataWc.csv" else fln$ = DefaultDir$;"\LatLon4.csv" end if [both] call safeDraw if penSize <> 0 then #w.gb "size ";penSize;" ; color ";continentsColor$ ' if fileExists(DefaultDir$, "dataWc.csv") then open fln$ for input as #fIn ' else 'notice "Can't find ";fln$;" in ";chr$(13);chr$(13);DefaultDir$ : close #fIn 'end if fileOpen =1 'line input #fIn, g$ ' discard title line gridDrawing = 0 do line input #fIn, g$ ' lat, lon P =val( word$( g$, 1, ",")) * pi / 180 L =val( word$( g$, 2, ",")) * pi / 180 if J = 0 or J = 1 or J = 2 then gosub [doP1ot012] if J = 3 then gosub [doPlot3] if J = 4 then gosub [doPlot4] if J = 5 then gosub [doPlot5] scan loop until eof( #fIn) close #fIn fileOpen =0 call safeDrawOff if makeSpinPics =1 then [makeSpinPics] #w.b1 "!setfocus" wait
[makeBMP] makeSpinPics=1 goto [dataShow]
[saveScr] #w.gb "getbmp scr 0 0 920 705" filedialog "Choose a filename to save image as ", "*.bmp", fOut$ if fOut$ ="" then fOut$ = "Cancelled_SaveDialog" +str$( time$( "seconds" ) ) +".bmp" bmpsave "scr", fOut$ wait
[makeSpinPics] bmpNum=bmpNum+2 longitude=longitude+2 #w.gb "getbmp scr 0 0 920 705" fOut$ = longitude+359;".bmp" bmpsave "scr", fOut$ if longitude > 0 then makeSpinPics = 0 notice "Number of Pictures = ";bmpNum/2 goto [showSpinningGlobe] end if #w.tb4 longitude goto [dataShow] wait
[showSpinningGlobe] ' = 180 .bmp picture files(higher 'step' number = quicker spin = less .bmp files) if fileExists(DefaultDir$, "1.bmp") then for picName = 1 to 361 step 2 loadbmp "picName", picName;".bmp" #w.gb "drawbmp picName 10 10 ; flush currentImage" unloadbmp "picName" scan next picName Notice "BMP files are ready to make a GIF file." else notice "You MUST first create the BMP Files." end if wait
[makeGif] if fileExists("C:\Program Files\GIMP 2\bin", "gimp-2.10.exe") then run "C:\Program Files\GIMP 2\bin\gimp-2.10.exe" else notice chr$(13);chr$(13);"You need to 'Install Gimp' in order to make GIF files.";chr$(34);chr$(34);_ "It's Best to Allow Gimp Installer to Install Where it Wants To" run "explorer https://www.gimp.org/downloads/" end if wait
[noGrid] if grid = 0 then grid = 1 : #w.grid "No Grid" : #w.stgrid "Off" else #w.grid "Grid" : grid = 0 : #w.stgrid "On" end if goto [dataShow]
[fillCont] both =1 #w.stfill "On" #w.stoutline "Off" fillCont = 0 fln$ = "LatLon4.csv" goto [both]
[outlineCont] both = 0 #w.stfill "Off" #w.stoutline "On" fillCont = 1 fln$ = "dataWc.csv" goto [both]
[extraColor] #w.extraColor "contents? extraColor$" ColorDialog extraColor$, Chosen$ extraColor$ = Chosen$ #w.stextraColor extraColor$ #w.extraColor "!ExtraColor" goto [dataShow]
[glowDepth] #w.glowDepth "contents? glowDepth$" glowDepth=val(glowDepth$) #w.glowDepth "!GlowSize" #w.stglowDepth " ";glowDepth goto [dataShow]
[earthSize] #w.earthSize "contents? earthSize$" R = val(earthSize$) #w.earthSize "!GlobeSize" #w.stearthSize " ";R goto [dataShow]
[penSize] #w.penSize "contents? penSize$" penSize=val(penSize$) #w.penSize "!PenSize" #w.stpenSize " ";penSize goto [dataShow]
[bakColor] #w.bakColor "contents? backGroundColor$" ColorDialog backGroundColor$, Chosen$ backGroundColor$ = Chosen$ #w.stbakColor Chosen$ #w.bakColor "!BakColor" goto [dataShow]
[earthColor] #w.earthColor "contents? earthColor$" ColorDialog earthColor$, Chosen$ earthColor$ = Chosen$ #w.stearthColor Chosen$ #w.earthColor "!earthColor" goto [dataShow]
[glowColor] #w.glowColor "contents? glowColor$" ColorDialog glowColor$, Chosen$ planetGlowColor$ = Chosen$ #w.stglowColor Chosen$ #w.glowColor "!GlowColor" goto [dataShow]
[contColor] #w.contColor "contents? continentsColor$" ColorDialog continentsColor$, Chosen$ continentsColor$ = Chosen$ #w.stcontColor Chosen$ #w.contColor "!LandColor" goto [dataShow]
[doP1ot012] '#w.b1 "!disable" scan S = Z L1 = L - LO if L1 >= 0 -K3 then goto 3000 L1 = L1 + K6 goto 5500
3000 if L1 <= K3 then goto 4000 L1 = L1 - K6
4000 B1 = abs( L1) if B1 > T then goto 4050 D = abs( A - P ) if D > M then goto 4300 D1 = sin( D ) D2 = cos( D ) C = Z if P >= A then goto 5000 C = K3 goto 5000 ' ??? is this the correct target? 4050 if abs( K3 - B1 ) > T then goto 4250 D = K3 - A - P if D > K3 then goto 4100 C = Z goto 4200 4100 D = K6 - D C = K3 4200 if D > M then goto 4300 D1 = sin( D) D2 = cos( D) goto 5000 4250 P1 = sin( P ) D2 = A1 * P1 + A2 * Cos( P ) * Cos( L1 ) D = acs( D2) if D <= M then goto 4500 4300 S = K1 return
4500 D1 = sin( D ) C1 = ( P1 - A1 * D2 ) / ( A2 * D1 ) if C1 < 0 -K1 then goto 4300 if C1 > K1 then goto 4300
C = acs( C1) if L1 >= Z then goto 5000 C = K6 - C 5000 if I = Z then goto 5500 C = C - I if C >= Z then goto 5500 C = K6 + C 5500 C = K2 -C
5600 if C >= 0 -K3 then goto 6000 C = C + K6 6000 if J <> Z then goto 6500 R1 = F * ( G * D1 ) / ( H2 -E * D2 ) 6250 goto 7000 6500 if J <> K1 then goto 6700 R1 = F * E * D1 6600 goto 7000 6700 R1 = F1 * D 7000 X = R1 * cos( C ) Y = R1 * sin( C )
#w.gb "color ";continentsColor$;" ; set "; 410 + int( X );" ";350 - int( Y ) if extraColor$ <> "" then #w.gb "color ";extraColor$;" ; set "; 410 + int( X ); " "; 352 - int( Y ) if extraColor$ <> "" then #w.gb "color ";extraColor$;" ; set ";411 + int( X ); " ";351 - int( Y ) return
' _________________________________________________________________
[doPlot3] ' Map to polar equidistant coordinates H = 1 ' Northern hemisphere: = 1 for Southern hemisphere if H = 0 then goto 7490 if P > 0.0 then goto 7500 L = 0 - L goto 7540 7490 if P >= 0.0 then goto 7540 7500 S = 1 return 7540 F = 2 * R / pi R1 = F * ( 1.5707963 - abs( P )) X = R1 * cos( L ) Y = R1 * sin( L ) #w.gb "color ";continentsColor$;" ; set "; 410 + int( X ); " "; 350 - int( Y ) if extraColor$ <> "" then #w.gb "color ";extraColor$;" ; set "; 411 + int( X ); " "; 351 - int( Y ) return '_______________________________________________ [doPlot4] ' Map to ortho equatorial coordinates 'print P, L scan 'R = 300 S = 0 L = L - LO if L <= 3.14159265 then 9450 L = L - 6.2831853 goto 9490 9450 if L >= 0 - 3.14159265 then 9490 L = L + 6.2831853 9490 if L < 0 - 1.5707963 then 9510 if L <= 1.5707963 then 9550 9510 S = 1 return 9550 R1 = R * sin( 1.5707963 - abs( P )) X = R1 * sin( L ) Y = R * sin( P ) #w.gb "color ";continentsColor$;" ; set "; 410 + int( X ); " "; 350 - int( Y ) if extraColor$ <> "" then #w.gb "color ";extraColor$;" ; set "; 411 + int( X ); " "; 351 - int( Y ) if extraColor$ <> "" then #w.gb "color ";extraColor$;" ; set "; 412 + int( X ); " "; 352 - int( Y ) return ' ______________________________________ [doPlot5]' #w.gb "color ";continentsColor$;" ; set "; 364 + int( 2.15 * L * 180 / pi ); " "; 350 - int( 1.6 * P * 180 / pi ) if extraColor$ <> "" then #w.gb "color ";extraColor$;"set "; 365 + int( 2.15 * L * 180 / pi ); " "; 351 - int( 1.6 * P * 180 / pi ) if extraColor$ <> "" then #w.gb "color ";extraColor$;"set "; 366 + int( 2.15 * L * 180 / pi ); " "; 352 - int( 1.6 * P * 180 / pi ) return ' ______________________________________
sub safeDraw #w.tb1 "!disable" #w.tb2 "!disable" #w.tb3 "!disable" #w.tb4 "!disable" #w.tb5 "!disable" #w.extraColor "disable" #w.glowDepth "disable" #w.penSize "disable" #w.earthSize "disable" #w.bakColor "disable" #w.glowColor "disable" #w.contColor "disable" #w.earthColor "disable" #w.b1 "!disable" #w.b2 "!disable" #w.b3 "!disable" #w.b5 "!disable" #w.b6 "!disable" #w.b7 "!disable" #w.grid "!disable" #w.appear "!disable" #w.appear2 "!disable" end sub
sub safeDrawOff #w.tb1 "!enable" #w.tb2 "!enable" #w.tb3 "!enable" #w.tb4 "!enable" #w.tb5 "!enable" #w.extraColor "enable" #w.glowDepth "enable" #w.penSize "enable" #w.earthSize "enable" #w.bakColor "enable" #w.glowColor "enable" #w.contColor "enable" #w.earthColor "enable" #w.b1 "!enable" #w.b2 "!enable" #w.b3 "!enable" #w.b5 "!enable" #w.b6 "!enable" #w.b7 "!enable" #w.grid "!enable" #w.appear "!enable" #w.appear2 "!enable" end sub
[guide] WindowWidth =800 WindowHeight =800 open "Guidance and help" for text as #w2 windowOpen = 1 #w2 "!font Courier_New 12 bold" open "help.txt" for input as #fIn2 txt$ = input$( #fIn2, lof( #fIn2 )) close #fIn2 windowOpen = 1 #w2 txt$ wait ' ______________________________________ sub quit h$ if windowOpen = 1 then close #w2 if fileOpen = 1 then close #fIn close #w end end sub '_______________________________________________
'Verify file existence function function fileExists(path$, filename$) dim fileExistsInfo$(0,0) files path$, filename$, fileExistsInfo$() fileExists = val(fileExistsInfo$(0, 0)) 'non zero is true end function
|
|