Post by tsh73 on Apr 27, 2024 16:21:47 GMT -5
I kept tweaking older version
it needs file "LatLon2.txt" posted by John earlier
(happened to be same file as "CityData.txt", same source)
1)
I got an idea that grid is a thing that does not actually change
So it could be used as a separate segment with instant on / off
Hence "Grid" checkbox
2)
"simpleCoord" checkbox changes lat/lon dispalay between
51°27'20.04"N
and
51.455567 N
3)
This version allow to rotate globe (longitude only)
You can either put number into textbox and press Redraw,
or you can use drag-n-drop. In that case, change will be rounded to 10 degrees (== grid size).
(drawing single globe takes a bit less then full second on old machine, expect 3x faster on recent ones)
4)
Right click puts current coordinateds on screen, and copies them to clipboard.
it needs file "LatLon2.txt" posted by John earlier
(happened to be same file as "CityData.txt", same source)
1)
I got an idea that grid is a thing that does not actually change
So it could be used as a separate segment with instant on / off
Hence "Grid" checkbox
2)
"simpleCoord" checkbox changes lat/lon dispalay between
51°27'20.04"N
and
51.455567 N
3)
This version allow to rotate globe (longitude only)
You can either put number into textbox and press Redraw,
or you can use drag-n-drop. In that case, change will be rounded to 10 degrees (== grid size).
(drawing single globe takes a bit less then full second on old machine, expect 3x faster on recent ones)
4)
Right click puts current coordinateds on screen, and copies them to clipboard.
'v05: segments, instant grid as segment redraw
'v06: better grid
'v07: move by drag
'v08: actualize buttons
'nomainwin
global pi: pi=3.14159265
global twoPi: twoPi = 2*pi
global pi2: pi2 = pi/2
global toRad: toRad = pi/180
global sav: global sto
global gri: gri=1
global simpleCoord: simpleCoord=0
'reportTime=1
fname$="LatLon2.txt"
N=7343
'dim L(N), P(N), pop(N)
dim LPpop(N,3)
dim col$(4), ptSz(4)
col$(1)="red":col$(2)="yellow":col$(3)="green":col$(4)="cyan"
WindowWidth =900: WindowHeight =740
graphicbox #w.g, 1, 1, 898, 738
'button #w.a, "Save bmps ",save, UL, 20, 10, 120, 25
checkbox #w.sc, "simpleCoord", simpleCoord, simpleCoord, 20, 10, 120, 20
statictext #w.coord, "", 20, 40, 300, 25
textbox #w.f, 160, 10, 50, 20
texteditor #w.hidden, -160, 10, 50, 20 'for copying coords to clipboard on right mouse click
button #w.e, "Redraw",[start], UL, 220, 10, 150, 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
'BackgroundColor$ = "darkblue"
'ForegroundColor$ = "lightgray"
checkbox #w.d, "Grid", gri, gri, 380, 10, 70, 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 "down; fill 60 60 60"
if gri then #w.d "set" 'grid on
if simpleCoord then #w.sc "set" 'simpleCoord on
#w.f L0
sh=3: #w.h, str$(sh): si=2: #w.i, str$(si): sj=1: #w.j, str$(sj): sk=1: #w.k, str$(sk)
ptSz(1)=sh:ptSz(2)=si:ptSz(3)=sj:ptSz(4)=sk
#w, "font courier 10 bold"
R =300 ' RADIUS OF GRAPHIC IN SCREEN PIXELS
'L0 = 80 ' LONGITUDE OF OBSERVER IN DEGREES.
gosub [makeBG]
gosub [makeGrid]
gosub [readData]
#w.g "flush points" 'dummy segment for first delsegment
'wait
goto [start]
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
ptSz(1)=sh:ptSz(2)=si:ptSz(3)=sj:ptSz(4)=sk
'#w.a, "!disable": #w.f, "!disable": nn=0
'L0=30
''for L0 =0 to 360 step 10
''if sto=1 then wait
#w.f "!contents? L0"
[redraw]
'#w.b, "!enable"
#w.g "discard; redraw bg"
if gri then #w.g "redraw grid"
[dataShow]
gosub [eventsOff]
#w.g "delsegment points"
'#w.g "color 180 180 100 ; size 2"
t0=time$("ms")
for k =2 to 7343
L=LPpop(k,1)'L(k)
P=LPpop(k,2)'P(k)
pop=LPpop(k,3)'pop(k)
gosub [findPoint]
next k
#w.g "flush points"
gosub [eventsOn]
t1=time$("ms")
if reportTime then notice "Time taken, ms ";t1-t0
if sav=1 then
#w.g "getbmp scr 1 1 898 738"
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 [redraw]
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) * toRad
P = P * toRad
' 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 RETURN ''S = 1:
''IF L >( pi /2) THEN RETURN ''S = 1:
IF abs(L) > pi2 THEN RETURN ''S = 1:
' 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)
X = R * sin( ( pi /2 -abs( P))) * sin( L)
Y = R * sin( P)
''LL=acs(X/R1): PP=acs(Y/R)
if pop then 'actual city, not grid point
oldLvl=lvl
select case
case pop >1E7
lvl=1
'col$ ="red": size =sh
case pop >1E6
lvl=2
'col$ ="yellow": size =si
case pop >1E5
lvl=3
'col$ ="green": size =sj
case else
lvl=4
'col$ ="cyan": size =sk
end select
if oldLvl<>lvl then #w.g "size "; ptSz(lvl);";color "; col$(lvl)
end if
#w.g "set "; int( 450 +X); " "; int( 350 -Y)
RETURN
[readData]
open fname$ for input as #fIn
line input #fIn, g$
for k =2 to 7343
line input #fIn, g$
'L(k) =val( word$( g$, 2, ","))
'P(k) =val( word$( g$, 1, ","))
'pop(k) =val( word$( g$, 3, ","))
LPpop(k,1) =val( word$( g$, 2, ","))
LPpop(k,2) =val( word$( g$, 1, ","))
LPpop(k,3) =val( word$( g$, 3, ","))
next k
close #fIn
sort LPpop(), N,2,3 'reverse sort
RETURN
[makeBG]
'#w.g "cls ; down ; fill 60 60 60"
'#w.g "fill 60 60 60"
'gosub [showLegend]
#w.g " place 450 350 ; size 1; color white ; circle 300"
#w.g, "backcolor 60 60 60"
#w.g, "down;color red;size 8": #w.g, "set 665 20":#w.g, "color lightgray"
#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 lightgray"
#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 lightgray"
#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 lightgray"
#w.g, "place 675 95": #w.g, "\Cyan point=Population < 1E5"
#w.g "flush bg"
return
[makeGrid]
' Add loop through range of P and LA to generate screen grid of lat /lon
#w.g "size 1; color lightgray"
for lat =-90 to 90 step 10 ' BOTH IN DEGREES. EAST OF MERIDIAN +ve. NORTH +ve.
for long = -180 to 180 step 1
L =long
P =lat
'#w.g "set "; int( 450 +2 *long); " "; int( 350 +3 *lat)
gosub [findPoint]
next long
next lat
for long = -180 to 180 step 10
for lat =-90 to 90 step 1
L =long
P =lat
'#w.g "set "; int( 450 +2 *long); " "; int( 350 +3 *lat)
gosub [findPoint]
next
next
#w.g "flush grid"
return
[eventsOff]
#w.g, "when rightButtonDown"
#w.g, "when mouseMove"
#w.g, "when leftButtonDown"
#w.g, "when leftButtonMove"
#w.g, "when leftButtonUp"
return
[eventsOn]
#w.g, "when rightButtonDown [plotCoord]"
#w.g, "when mouseMove [mMove]"
#w.g, "when leftButtonDown [startDrag]"
#w.g, "when leftButtonMove [mMove]"
#w.g, "when leftButtonUp [endDrag]"
return
[startDrag]
L00=lon
wait
[endDrag]
L01=lon
dL0=JBfloor((L00-L01)/10+.5)*10 'up to 10 deg
L0=(L0+dL0+360) mod 360 '0..360
if L0>180 then L0=L0-360
print L01, L00, L0
#w.f L0
if dL0<>0 then goto [redraw]
wait
[plotCoord]
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, "\ ";lat2deg$(lat)
#w.g, "place ";xx;" ";yy+20: #w.g, "\ ";lon2deg$(lon)
'copy to clipboard
#w.hidden "!cls"
#w.hidden lat2deg$(lat);" ";lon2deg$(lon);
#w.hidden "!selectall"
#w.hidden "!copy"
wait
[mMove]
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)) 'visible width at "y" level
if abs(xx/RR)<=1 then
lon=asn(xx/RR)/pi*180+L0
if lon<-180 then
lon=lon+360
else
if lon>180 then lon=lon-360
end if
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
END
sub save buttonhandle$
sav=1
end sub
sub sto buttonhandle$
sto=1': #w.b, "!disable"
end sub
sub simpleCoord hndl$
#w.sc "value? tmp$"
simpleCoord = (tmp$="set")
end sub
sub gri buttonhandle$
#w.d "value? gri$"
gri = (gri$="set")
'print "gri ";gri
if gri then
#w.g "redraw bg;redraw points;redraw grid"
else
#w.g "redraw bg;redraw points"
end if
end sub
sub quit h$
close #h$
end
end sub
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)
if simpleCoord then
deg2deg$=using("###.#####",deg)
exit function
end if
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
'--------------------------------------------------
'by uncleBen
function JBfloor(x)
JBfloor = int(x)
JBfloor = JBfloor - (x <> JBfloor and x < 0)
end function