Celestial Clock (Extended)

celestial-clock-2.0.red

Red [
	title:		"Celestial clock"
	author:		hinjolicious
	note:		"Modified and improved from the work of @hiiamboris"
	license:	'BSD-3
	needs:		view
	icon:		%clock.ico
]

#include %../../common/sift-locate.red

; globals
;city: none
;lat: none
;lon: none
;utc: none

;; background reflects time of day
t: none ; noon-day
h: none ; half-day now/yearday 30
hr: none ; utc

timeline: none

_info: true ; stats info

;; formula: https://www.had2know.org/society/sunrise-sunset-time-calculator-formula.html
half-day: func [day lat] [1:0 / 15 * arccosine (tangent 0 - lat) * (tangent 23.44 * sine day + 284 * 360 / 365)]
xhalf-day: func [yearday lat] [
    ; 1. Calculate solar declination angle based on the day of the year
    ; (Approximate formula using Earth's 23.45 degree axial tilt)
    declination: 23.45 * sin (2 * pi * (yearday - 80) / 365)
    
    ; 2. Core sunrise/sunset ratio value
    arg: negate ((tan lat) * (tan declination))
    
    ; --- THE POLAR GUARD: Catch math boundaries ---
    if arg >= 1.0 [return 12.0]  ; Perpetual Daytime (Midnight Sun) -> 12hr Half-Day (24h full day)
    if arg <= -1.0 [return 0.0]   ; Perpetual Nighttime (Polar Night) -> 0hr Day length
    
    ; 3. Standard calculation if safely inside non-polar latitudes
    return (acos arg) / 15.0
]
;; Atmospheric Generators & Variables
day-intensity: none
night-intensity: none

location-init: func [_city _lat _lon _utc] [
	city: _city
	lat: to-float _lat
	lon: to-float _lon
	utc: to-float _utc
	hr: utc
	
	comment {
	; Exact Solar Noon math using time arrays: [hours minutes seconds]
	; 1. Start at absolute UTC Noon (12:00)
	; 2. Adjust for exact physical longitude (1 degree = 4 minutes of time)
	; 3. Add back the local civil Timezone offset hours
	solar-seconds: (12 * 3600) - (lon * 240) + (hr * 3600)
	
	; Rebuild cleanly into a proper Red time! value
	t: make time! reduce [
		to integer! (solar-seconds / 3600)
		to integer! (solar-seconds % 3600 / 60)
		to integer! (solar-seconds % 60)
	]
	
	; Calculate daylight duration factor using local latitude
	h: half-day now/yearday lat
	}
   
    ; Exact Solar Noon math using time arrays: [hours minutes seconds]
    solar-seconds: (12 * 3600) - (lon * 240) + (hr * 3600)
    
    ; Normalize to stay inside a 24-hour boundary
    while [solar-seconds < 0] [solar-seconds: solar-seconds + 86400]
    while [solar-seconds >= 86400] [solar-seconds: solar-seconds - 86400]
                                                
    ; Rebuild cleanly into a proper Red time! value
    t: make time! reduce [
        to integer! (solar-seconds / 3600)
        to integer! (solar-seconds % 3600 / 60)
        to integer! (solar-seconds % 60)
    ]
               
    ; --- Recalibrated Daylight Duration Math ---
    
    ; 1. Convert latitude from degrees to radians
    lat-rad: lat * (pi / 180.0)
    
    ; 2. Calculate solar declination (approximate for day of the year)
    ; Converting the inner angle bracket to radians for Red's sin function
    declination-deg: 23.45 * sin (2.0 * pi * (now/yearday - 80) / 365.0)
    dec-rad: declination-deg * (pi / 180.0)
    
    ; 3. Core sunrise/sunset ratio value
    arg: negate ((tan lat-rad) * (tan dec-rad))
    
    ; 4. Polar Safeguards (Stops polar night/midnight sun crashes)
; --- The Permanent Polar Correction ---
    either arg >= 1.0 [
        h: 0.0  ; <--- SWAPPED: If arg is high in the southern winter, it's 0 hours of daylight!
    ][
        either arg <= -1.0 [
            h: 12.0  ; <--- SWAPPED: Midnight Sun condition
        ][
            ; Standard non-polar formula
            acos-deg: (acos arg) * (180.0 / pi)
            h: half-day now/yearday lat
        ]
    ]
	timeline-init
]

;; geometry
mark1: [shape [move 0x-195
	'arc  10x10  15 15 0
	'arc -10x10  15 15 0
	'arc -10x-10 15 15 0
	'arc  10x-10 15 15 0  close]]
mark2: [circle 0x-190 5] ; origin is 0x0, so draw 0x-190 near the top drawing area
mark: mark2
marks: compose append/dup [] [rotate 30 0x0 (mark)] 12

sec-arrow1: [rot-sec: rotate 0 0x0  shape [
	move 0x-190  'line 5x5
	'arc  -4x45  4 45 0
	'line -1x135 -1x-135
	'arc  -4x-45 4 45 0  close]]
sec-arrow2: [rot-sec: rotate 0 0x0  shape [move 0x-190 'line 3x3 -3x187 -3x-187 close]]
sec-arrow: sec-arrow2

min-arrow2: [rot-min: rotate 0 0x0 shape [
	move 0x-175  'line 9x5  
	'arc -2x40 6 20 5  
	'arc -6x30 8 30 3  
	'line -1x95 -1x-95  
	'arc -6x-30 8 30 -3  
	'arc -2x-40 6 20 -5  close]]
min-arrow2: [rot-min: rotate 0 0x0  shape [move 0x-175 'line 5x5 -5x170 -5x-170 close]]
min-arrow: min-arrow2

hour-arrow1: [rot-hour: rotate 0 0x0 shape [
	move 0x-140 'line 11x7
	'arc  3x88   15 50   4
	'arc -14x45   8 35  11
	'arc -14x-45  8 35 -11
	'arc  3x-88  15 50  -4  close
]]

shadow: [scale 1.0 1.0 translate (4, 4) fill-pen 0.0.0.200]

; hour-arrow 2: simple, more modern style (shadow is moved here, so we can use other variants that don't need shadow!
_hour-arrow2: [shape [move 0x-140 'line 10x10 -10x130 -10x-130 close]]
hour-arrow2: compose/deep [rot-hour: rotate 0 0x0 push [(shadow) (_hour-arrow2)] (_hour-arrow2)]

; --- Shifted to outer radius (0x-125) to orbit near markings ---
sun-shape: [
	circle 0x-150 25                                    ; Orbiting core
	;shape [move 0x-139 'line 4x-147 0x-155 -4x-147 close] ; Outer ray
	;shape [move 0x-111 'line 4x-103 0x-95  -4x-103 close] ; Inner ray
	;shape [move -14x-125 'line -22x-121 -30x-125 -22x-129 close]
	;shape [move 14x-125  'line 22x-121  30x-125  22x-129  close]
]

moon-shape: [circle 0x-150 24]
moon-shape2: [circle 1x-140 10]
moon-shape3: [circle -10x-150 8]
moon-shape4: [circle -8x-165 6]

; sun and moon dial!
hour-arrow-draw: [rot-hour: rotate 0 0x0] ; don't clear all, use: clear skip hour-arrow-draw 4 
; or, after clear, initialize with the above commands

; hour arrow selection:
hour-arrow: hour-arrow-draw
;hour-arrow: hour-arrow2

; Dynamic Injectors for Stars and Clouds
star-draw:  []
cloud-draw: []

timeline-init: func [][
	; Pre-calculate explicit, clean time targets so the types don't scramble
	dawn-start: t - h - 1:00
	sunrise:    t - h
	morning:    t - h + 1:00
	afternoon:  t + h - 1:00
	sunset:     t + h
	dusk:       t + h + 1:00
	night:      t + h + 2:00

	timeline: compose [
		; --- TIME  | --- SKY COLORS --- | INTENSITIES | --- SUN INFO --- | --- MOON INFO ---
		;                                  [day  night]  [color    alpha]   [color    alpha]
		00:00         #02040a #080f21      0.0   1.0     #ffb03a   255      #C9AA65   0 ;0    ;Midnight Moon (Solid Moon, Hidden Sun)
		(dawn-start)  #050b1a #181d45      0.0   1.0     #ff4500   255      #816A38   0 ;127  ; Moon starts fading out
		(sunrise)     #ffaa44 #d03050      0.3   0.7     #ffcc00   135      #5D4A20   0 ;255  ; Red Sun waking up, Moon hidden
		(morning)     #e0f2fe #7dd3fc      1.0   0.0     #ffffee   0        #5D4A20   0 ;255  ; Crisp Day Sun (Solid Sun, Hidden Moon)
		(afternoon)   #bae6fd #38bdf8      1.0   0.0     #ffeeee   0        #5D4A20   0 ;255
		(sunset)      #ffb03a #e11d48      0.5   0.5     #ffee00   0        #5D4A20   0 ;250  ; Sun dipping/fading, Moon appearing
		(dusk)        #1e1b4b #0f172a      0.0   1.0     #ff0000   127      #7C6E50   0 ;225  ; Sun hidden, Moon waking up
		(night)       #080f21 #02040a      0.0   1.0     #ff0000   255      #A08E69   0 ;200  ; Solid Night Moon
		24:00         #02040a #080f21      0.0   1.0     #ff0000   255      #C9AA65   0
	]
]

random/seed now/time/precise

; Pre-generate random starry positions [x y size twist-offset]
stars-data: collect [
	loop 25 [
		keep/only reduce [
			random 400
			random 200 
			0.1 + random 1.75 
			random 10.0 
		]
	]
]

clouds: collect [
	loop 5 [
		keep/only reduce [
			200 - random 600 ; x center
			50 + random 300 ; y position
			_w: 100 + random 500 ; width
			2 + random 15 ; height
			0.05 + random 0.15 ; speed
			100 + random 100 ; transparency
		]
	]
]

renew-background: func [time] [
	; Unpack everything at once from the timeline block
	set [
		t1: sc1: sc2: di1: ni1: sun-c1: sun-a1: moon-c1: moon-a1: 
		t2: sc3: sc4: di2: ni2: sun-c2: sun-a2: moon-c2: moon-a2:
	] locate timeline [t1 - - - - - - - - | t2 .. t1 <= time time < t2]
	
	dt: (time - t1) / (t2 - t1)
	inv-dt: 1.0 - dt
	
	; 1. Interpolate Sky Gradients
	grad/3: (hex-to-rgb sc1) * inv-dt + ((hex-to-rgb sc4) * dt) ; Fixed index targets matching your layout
	grad/5: (hex-to-rgb sc2) * inv-dt + ((hex-to-rgb sc3) * dt)
	
	; 2. Interpolate Master Ambient Intensities 
	day-intensity:   (di1 * inv-dt) + (di2 * dt)
	night-intensity: (ni1 * inv-dt) + (ni2 * dt)
	
	; 3. Interpolate Dynamic Celestial Colors & Alpha Levels
	current-sun-color:  ((hex-to-rgb sun-c1)  * inv-dt) + ((hex-to-rgb sun-c2)  * dt)
	current-sun-alpha:  to integer! ((sun-a1  * inv-dt) + (sun-a2  * dt))
	
	current-moon-color: ((hex-to-rgb moon-c1) * inv-dt) + ((hex-to-rgb moon-c2) * dt)
	current-moon-alpha: to integer! ((moon-a1 * inv-dt) + (moon-a2 * dt))
	
	clear skip hour-arrow-draw 4
	;append hour-arrow-draw [translate 200x200]
	
	; Draw Moon if it isn't completely transparent
	if current-moon-alpha < 250 [
		c-moon: current-moon-color ;+ hex-to-rgb (to-hex current-moon-alpha)
		c-moon2: current-moon-color * 0.8 ;+ hex-to-rgb (to-hex current-moon-alpha)
		append hour-arrow-draw compose [pen off 
			fill-pen (c-moon) (moon-shape)
			fill-pen (c-moon2) (moon-shape2)
			fill-pen (c-moon2) (moon-shape3)
			fill-pen (c-moon2) (moon-shape4)
		]
	]
	
	; Draw Sun if it isn't completely transparent (255 is fully hidden)
	if current-sun-alpha < 250 [
		c-sun: current-sun-color + hex-to-rgb (to-hex current-sun-alpha)
		append hour-arrow-draw compose [pen off fill-pen (c-sun) (sun-shape)]
	]
]

update-celestial: func [clock-tick] [
	; 1. Draw Twinkling Stars
	clear star-draw
	if night-intensity > 0.6 [
		foreach star stars-data [
			x: star/1 y: star/2 sz: star/3 twist: star/4
			alpha: max 0 255 - to integer! night-intensity * 30 * sin (clock-tick + twist)
			append star-draw compose [
				pen off fill-pen (as-rgba 255 255 255 alpha)
				circle (as-pair x y) (sz)
			]
		]
	]
	
	; 2. Draw Translucent Streaky Elliptical Clouds
	clear cloud-draw
	;c-alpha: 150 + to integer! (night-intensity * 90)
	_c-color: case [
		day-intensity > 0.6 [[245 250 255]] ; day clouds
		day-intensity > 0.2 [[255 200 100]] ; sunset clouds
		day-intensity > 0.05 [[200 100 50]] ; sunset clouds
		true [[15 25 45]] ; night clouds
	]

	append cloud-draw [pen off]
	foreach cloud clouds [
		cx: cloud/1 ; x  
		cy: cloud/2 ; y
		cw: cloud/3 ; width
		ch: cloud/4 ; height
		ch: ch + (day-intensity * 3.0) ; cloud gets fatter as during the day
		cs: cloud/5
		if cx > 400 [ ; if a cloud left the screen, change it to a new cloud
			;cloud/1: 0 - cw
			cloud/2: 50 + random 300 ; y position
			cloud/3: _w: 100 + random 500 ; get the width first
			cloud/1: 0 - _w ; positioned of the screen
			cloud/4: 2 + random 15 ; height
			cloud/5: 0.05 + random 0.15 ; speed
			cloud/6: 100 + random 100 ; transparency
		]
		cloud/1: cloud/1 + (cs + (night-intensity / 2)) ; change it position, move faster as night progress
		c-color: apply :as-rgba (append _c-color (to-integer either day-intensity < 0.01 [cloud/6 * 0.5][cloud/6]))

		; Draw wispy cloud clusters using overlapping ellipses
		append cloud-draw compose [ 
			fill-pen (c-color)
			
			; Main cloud body
			ellipse (as-pair cx cy) (as-pair cw ch) 
			;ellipse (as-pair (cx - 30) (cy + 5)) (as-pair cw ch)
			
			; Secondary trailing puff for organic asymmetry
			ellipse (as-pair (cx + (cw / 3)) (cy - 6)) (as-pair (cw * 0.6) (ch * 0.7))
			ellipse (as-pair (cx + (cw / 3) - 15) (cy + 6)) (as-pair (cw * 0.6) (ch * 0.7))
		]
		if _info [
			append cloud-draw compose [
				pen (gray * night-intensity * 2)
				text 5x5 (rejoin [city " - " form now/date "  " form now/time])
				text 5x20 (rejoin ["Noon: " t])
				text 5x35 (rejoin ["Half-day: " h])
				text 5x50 (rejoin ["Day: " round/to day-intensity 0.01])
				pen off
			]
		]
	]
	;print ["day" day-intensity "night" night-intensity "c-alpha" c-alpha  ] 
]

view/tight/flags/no-sync [
	title "Celestial clock"  backdrop black
	do [
		i: 0
		location-init "Semarang" -7 110.42 7
		timeline-init
	]
	   
	box: box 400x400 
	
	draw compose/deep/only [
		;scale 0.5 0.5
	; draw sky gradient, updated by renew-background!
		grad: fill-pen linear 50.50.50 0.0 black 1.0  0x0 0x400 box 0x0 400x400
	; draw stars
		push [(star-draw)]
	; draw moon and sun
		;push [translate 200x200 rot-sunmoon: rotate 0 0x0 (hour-arrow-draw)]
	; draw clock hands
		push [
			translate 200x200 line-join bevel pen off fill-pen linear gold 0.0 black 1.5
			push [(shadow) (marks)] push (marks) ;-- every component's shadow is above another component
			;push [(shadow) (hour-arrow)] push (hour-arrow) 
			push (hour-arrow) 
			push [(shadow) (min-arrow )] push (min-arrow)
			push [(shadow) (sec-arrow )] push (sec-arrow)
		]
	; draw clouds 
		push [pen off (cloud-draw)]
	; burger menu: ☰
		push [pen gray text 385x5 "☰"]
	] ; / draw
	
	rate 60 on-time [
		;; all movement is smooth as in analog clock
		ftime: to float! time: now/time/precise
		rot-sec/2:  ftime % 60 * 6
		rot-min/2:  ftime % 3600 / 10
		rot-hour/2: ftime / 120
		;rot-sunmoon/2: ftime / 120
		if 1 = i: i + 1 % 300 [ ;-- once per 5 secs or so
			renew-background time ; sky gradients, sun, moon
		] 
		update-celestial ftime ; stars, clouds (update fast for smooth movements)
		; Update the hour arrow appearance using the newly calculated intensities!
		;draw-hour-hand day-intensity night-intensity
		show box
	] ; /on-time
	
	on-down [ mouse-pos: event/offset
		; check if the burger is clicked
		if all [mouse-pos/x >= 385  mouse-pos/x <= 400  mouse-pos/y >= 5  mouse-pos/y <= 15][
			cities-db: [
				; "City Name"      [Lat Lon UTC]
				"Semarang"         [-7.00   110.42   7]  ; Your baseline: Stable, humid tropical day/night cycles
				"Berlin"           [52.52   13.40    2]
				"Winnipeg"         [49.89   -97.13  -5]
				"Jakarta"          [-6.20   106.81  +7]
				"Tokyo"            [35.68   139.76   9]
				"London"           [51.50   -0.12    1]
				"New York"         [40.71   -74.01  -4]
				"Los Angeles"      [34.05   -118.24 -7]
				"Sydney"           [-33.87  151.21  10]
				"Paris"            [48.86   2.35     2]
				"Dubai"            [25.20   55.27    4]
				"Cape Town"        [-33.92  18.42    2]  ; Great for testing the southern hemisphere inversion
				; --- EXTREME ATMOSPHERIC & LIGHT VARIATIONS ---
				"Tromso"           [69.65   18.96    2]  ; Tromsø - Polar Circle: Extreme seasonal daylight variations (Midnight Sun right now!)
				"Atacama Desert"   [-22.91  -68.20  -4]  ; Hyper-Arid: The clearest, crispest, virtually cloudless sky on Earth
				"Lhasa"            [29.65   91.12    8]  ; High Altitude (3,650m): Thin, high-velocity upper atmosphere dynamics
				"Singapore"        [1.35    103.82   8]  ; Pure Equatorial: Eternal 12-hour day/night splits with massive afternoon humidity
				"Reykjavik"        [64.15   -21.94   0]  ; Sub-Arctic Sub-Polar: Rapidly shifting oceanic cloud speeds and low sun angles
				"McMurdo Station"  [-77.85  166.66  12]  ; Antarctica: Deep southern polar cycles—complete inversion of the northern skies
			]
						; 1. Grab just the strings for the dropdown header array
			city-names: extract cities-db 2
			
			view/flags/tight [ title "Location Settings" panel [
				origin 10x10 space 4x4
				style lbl: text 40 right 
				style fld: field 60 hint "0.0"
				
				; 2. Add this right inside your black-themed panel block:
				lbl "Presets:" 
				drop-down 110 data city-names on-change [
					; This code fires instantly when a city name is clicked!
					selected-name: face/text
					; Find the matching data block in our database
					if data-pos: select cities-db selected-name [
						city-in/text: selected-name
						; Extract the parameters cleanly
						target-lat: data-pos/1
						target-lon: data-pos/2
						target-utc: data-pos/3
						
						; Push the pre-baked values straight into your UI text fields!
						city-in/text: selected-name
						lat-in/text:  to string! target-lat
						lon-in/text:  to string! target-lon
						utc-in/text:  to string! target-utc
						
						; Force Red to repaint the updated input fields on screen
						show [city-in lat-in lon-in utc-in]
					]
				]
				return ; Drop down to the individual manual override fields below
				
				lbl "City:" city-in: field 100 "Semarang" return
				lbl "Lat:"  lat-in:  fld "52.52" return
				lbl "Lon:"  lon-in:  fld "13.40" return
				lbl "UTC:"  utc-in:  fld 50 "2" return
				;pad 40x10
				return
				button "Apply" [
					location-init city-in/text to-float lat-in/text to-float lon-in/text to-float utc-in/text
					timeline-init
					renew-background now/time/precise
					show box
					;unview
				]
				button "Toggle Info" [_info: not _info unview]
				button "QUIT!" [quit]
				return
				button "Clock hands" [alert "For now: Change manually in the code"]
				button "Resize" [alert "Not there yet!"]
				across button "On-top" [alert "How?"]
				button "Drag" [alert "Not yet?"]
			]] [modal popup]
		]
	]
	
	on-change [
		; When the mouse moves while held down, slide the entire window
		if event/type = 'drag [
			face/parent/offset: face/parent/offset + event/offset - drag-offset
		]
	]
	
	on-alt-down [
		popup [
			"Theme" [
				"Celestial" [current-theme: "Celestial" refresh-widget]
				"Classic"   [current-theme: "Classic"   refresh-widget]
				"Modern"    [current-theme: "Modern"    refresh-widget]
			]
			"Configure Location..." [show-location-dialog]
			---
			"Close Widget" [quit]
		]
	]
]
[ ; flags
	;no-title 
	;no-border
	;popup 
	;block-quit 
	;on-top 
	;all-over
]

Plan:
Give options to:

1. Change clock hands on-the-fly from the menu
2. Make it a widget, always on-top
3. Scale the size
4. etc.

NOTE: The "classic" clock hands and the newer simpler hands are there in the code.
You can simply assign the hour-arrow, min-arrow, sec-arrow to your preference.
xxx-arrow1 -> the classic style
xxx-arrow2 -> the simpler style
hour-arrow-draw -> a special hand to replace hour with sun and moon

Suggestions and helps?

Update: Cleaned up some unused codes

*** Script Error: cannot compare none with 0.6
*** Where: >
*** Near : if night-intensity > 0.6 [foreach star stars-data]
*** Stack: view do-events do-actor do-safe update-celestial 

Update: clean up unused code again :D

*** Script Error: cannot compare none with 0.6
*** Where: >
*** Near : if night-intensity > 0.6 [foreach star stars-data]
*** Stack: view do-events do-actor do-safe update-celestial 

probably a location input problem. what lan, lon, utc ?
but, it's about stars? usually, the problem is with some extreme places where half-day calculation get whacky.
i think it's that the "night-intensity" is not having a value, yet.
try, initialize it with some value (0.0) at the top line.
night=intensity is simply 1 - day-intensity, btw :)

Update: minor adjustment to slow down clouds movement at night time