Animated Tourbillon Watch in Red Programming Language (Red/Draw)

tourbillon-watch.red

Red [
	title: "Tourbillon Chronograph Watch"
	author: "hinjolicious"
	note: {
		Idea: @hiiamboris work on "Cellestial Clock".
		Collaborator: Gemini AI
		Tested: on Red/View 0.66 in Windows
		June 10th, 2026
	}
	needs: 'view
]

; main dial
back-plate: [pen coal line-width 1 circle 200x200 190]
pin-s: [circle 0x0 5]
pin: [circle 0x0 15]
scales-s: compose append/dup [] [line-width 1 pen gray [rotate 1 0x0 line 0x-185 0x-190]] 360
scales-m: compose append/dup [] [line-width 1 pen gray [rotate 6 0x0 line 0x-165 0x-190]] 100
;scales-h: compose append/dup [] [line-width 8 pen silver [rotate 30 0x0 line 0x-150 0x-180]] 12
scales-h: compose append/dup [] [rotate 30 0x0 shape [move 0x-150 line 4x-150 4x-180 -4x-180 -4x-150 close]] 12

h-sec:   [ rot-sec:  rotate 0 0x0 shape [
	move 0x-185 line 
	1x-183 1x-135  8x-110  2x-103  5x50 
	-5x50  -2x-103 -8x-110 -1x-135 -1x-183 close]]
h-min:   [ rot-min:  rotate 0 0x0 shape [move 0x-165 line 5x-155 5x0 -5x0 -5x-155 close]]
h-hour:  [ rot-hour: rotate 0 0x0 shape [move 0x-130 line 5x-120 5x0 -5x0 -5x-120 close]]

twelve: [shape [move 0x-135 line 12x-180 -12x-180 close]]
shadow: [translate (4, 4) pen off fill-pen 0.0.0.150]

; left sub-dial (month)
months: compose append/dup [][line-width 2 pen gray [rotate 30 0x0 line 0x-45 0x-55]] 12
h-month: [ rot-mon: rotate 0 0x0 shape [move 1x-35 line 5x5 -5x5 -1x-35 close]]

; right sub-dial (day of the week)
dow: compose append/dup [][line-width 2 pen gray [rotate 51.42857142857143 0x0 line 0x-45 0x-55]] 7
h-dow: [ rot-dow: rotate 0 0x0 shape [move 1x-35 line 5x5 -5x5 -1x-35 close]]

; tourbillon gears
escape-wheel-teeth: compose append/dup [][
	rotate 18 0x0 shape [move -1x-18 line 6x-27 7x-26 5x-23 7x-18 close]] 20
escape-wheel: compose [rot-escape-wheel: rotate 0 0x0
	pen off fill-pen silver 
	(escape-wheel-teeth) 
	box -2x-19 2x19 box -19x-2 19x2]

hairspring: collect [repeat r 30 [if r % 3 = 0 [keep compose [circle 0x0 (r)]] ]]
hairspring-scale: compose [
	pen gray line-width 1
	scale-hairspring: scale 1 1 (hairspring)]

; inner balance wheel
ballance-wheel-screws: compose append/dup [][rotate 90 0x0 box -2x-54 2x-46] 4
ballance-wheel: compose [rot-balance-wheel: rotate 0 0x0
	pen off fill-pen linear gold 0.0 black 1.5
	(ballance-wheel-screws) 
	rotate 45 box -4x-50 4x50
	pen gold line-width 4 fill-pen off circle 0x0 50
]

deep-gear-teeth: compose append/dup [][rotate 5 0x0 shape [move 0x-40 line 2x-35 -2x-35 close]] 72
deep-gear: compose [
	pen off fill-pen ;40.40.40 
	linear coal 0.0 black 1.5
	(deep-gear-teeth)
	circle 0x0 35]
	
cage-spokes: compose append/dup [] [rotate 120 0x0 
	fill-pen linear silver 0.0 black 1.5
	box -4x-60 4x0 
	circle 0x-60 7
	fill-pen #3333aa circle 0x-60 5
	] 3
cage-spokes-shadow: compose append/dup [] [rotate 120 0x0 
	box -4x-60 4x0 
	circle 0x-60 7
	] 3	

top-cage: compose/deep/only [
	fill-pen off line-width 4 pen linear silver 0.0 black 1.5 shape [move 0x-60 arc -52x30 60 60 0 arc 52x30 60 60 0]
	pen off fill-pen silver [(cage-spokes)]
	pen off fill-pen silver circle 0x0 10
	fill-pen linear #ffaaff 0.0 #aa00aa 1.5 circle 0x0 7
]
top-cage-shadow: compose/deep/only [
	[(cage-spokes-shadow)]
	circle 0x0 10
]
cage: compose/deep/only [rot-cage: rotate 0 0x0 
	; no pallet-fork yet!
	translate 33x-19 [(escape-wheel)]
	push [ ; frame for the escape wheel
		translate 33x-18 
		line-width 8 pen linear silver 0.0 black 1.5 line 0x0 -33x18 ; support for escape-wheel
		pen off fill-pen linear silver 0.0 black 1.5 circle 0x0 8 
		fill-pen linear #ffaaff 0.0 #aa00aa 1.5 circle 0x0 5
	]
	push (ballance-wheel)
	push (hairspring-scale)
	push [(shadow) (top-cage-shadow)] push (top-cage)
]

view/tight compose [
	backdrop (coal * 0.3)
	box: box 400x400
	
	draw compose/deep/only [
		;(back-plate)
		push [pen off fill-pen 10.10.10 circle 200x200 197 fill-pen 20.20.20 circle 200x200 145]
		push [
			translate 200x200
			font (make font! [size: 20 style: 'normal]) pen red text -25x-116 "RED"
			font (make font! [size: 12 style: 'italic]) pen gray text -44x-85 "The Reducer"
			font (make font! [size: 10 style: 'normal]) text -47x-65 "PROFESSIONAL"
		]
		
		; draw left sub-dial
		push [pen off fill-pen 10.10.10 circle 115x200 59 fill-pen 20.20.20 circle 115x200 40]
		push [ 
			translate 115x200 
			push (months) 
			fill-pen linear white 0.0 black 1.5 
			push [(shadow) (h-month)] push (h-month)
			pen gray text -15x-35 "Month"
			font (make font! [size: 12 style: 'normal]) text -36x-12 (form now/day)
		]

		; draw right sub-dial
		push [pen off fill-pen 10.10.10 circle 285x200 59 fill-pen 20.20.20 circle 285x200 40]
		push [ 
			translate 285x200 
			push (dow) 
			fill-pen linear white 0.0 black 1.5 
			push [(shadow) (h-dow)] push (h-dow) 
			pen gray text -20x-35 "Weekday"
			font (make font! [size: 12 style: 'normal]) text 12x-12 (form either now/time > 12:0:0 ["PM"]["AM"])
		]
		
		; draw scales
		push [
			translate 200x200 pen off 
			push (scales-s) push (scales-m) 
			fill-pen linear silver 0.0 black 1.5
			push [(shadow) (scales-h)] push (scales-h)
			push [(shadow) (twelve)] push (twelve)
		]	
		
		; draw tourbillon
		push [ ; tourbillon window
			fill-pen linear black 0.0 silver 1.5 circle 200x300 70
			fill-pen 10.10.10 circle 200x300 65
		]
		
		push [ ; tourbillon 
			translate 200x300 
			push (deep-gear)
			push (cage)
		]
		
		; draw main dial
		push [	
			translate 200x200 
			line-join bevel pen off 
			fill-pen linear white 0.0 black 1.5
			push [(shadow) (h-hour)] push (h-hour) 
			push [(shadow) (h-min)] push (h-min) (pin)
			fill-pen linear red 0.0 black 1.5
			push [(shadow) (h-sec)] push (h-sec) (pin-s)
		]
	]
	
	rate 99 on-time [
		ftime: to-float time: now/time/precise
		; main dial calculations
		rot-sec/2:  ftime % 60 * 6
		rot-min/2:  ftime % 3600 / 10
		rot-hour/2: ftime / 120
		
		; left sub-dial
		mo: now/month 	rot-mon/2: mo % 12 * 30 
		; right sub-dial
		wd: now/weekday	rot-dow/2: wd % 7 * 51.42857142857143
		
		; tourbillon

		; --- HIGH-REALISM, BUTTERY-SMOOTH TOURBILLON ENGINE ---
        rot-cage/2: rot-sec/2
        
        ; 1. Smooth Balance Wheel Oscillation
        ; Dropping from 1000.0 to 12.0 slows down the raw radian velocity 
        ; to a perfectly rhythmic, hardware-frame-locked 3.8Hz beat.
        ; We use 80.0 degrees to ensure smooth frame steps on 60Hz displays.
        balance-angle: 80.0 * sin (ftime * 12.0)
        rot-balance-wheel/2: balance-angle
        
        ; 2. Fluid Escape Wheel Transmission
        ; Keeps the rapid step-vibration look but anchors it tightly to the cage rotation
        rot-escape-wheel/2: (rot-sec/2 * 4.0) + (4.0 * sin (ftime * 12.0))

        ; 3. Phase-Locked Hairspring Breathing
        ; Tied perfectly to the new smooth angle matrix
        scale-hairspring/2: 1.0 - (balance-angle / 600.0)
        scale-hairspring/3: scale-hairspring/2		
		
		show box
	]
]