Fancy message decoration

merry.red

Red [
	Date: 29-Dec-2020
	Purpose: "Fancy message decoration"
]

context [
	font: [size: 32 style: 'bold]
	size: 360x70
	text: "Merry Christmas!"
	area: make-face 'area [size: 1200x20 font: xfont]
	area/font: xfont: make font! font
	color: background: white
	pad: 4x0
	origin: 10x10
	flags: [no-min no-max]
	step: 5
	gradient: [blue green yellow red blue]
	gr-size: do gradient-size: [as-pair size/x - 1 0]
	gradient-length: 3 + length? gradient
	to-right: [
		gr/(gradient-length)/x: gr/(gradient-length)/x + (step) % (gr-size/x)
		gr/(gradient-length + 1)/x: gr/(gradient-length)/x + (gr-size/x)
	]
	to-left: [
		gr/(gradient-length)/x: gr/(gradient-length)/x - (step) % (gr-size/x)
		gr/(gradient-length + 1)/x: gr/(gradient-length)/x + (gr-size/x)
	]
	to-down: [
		gr/(gradient-length)/y: gr/(gradient-length)/y + (step) % (gr-size/y)
		gr/(gradient-length + 1)/y: gr/(gradient-length)/y + (gr-size/y)
	]
	to-up: [
		gr/(gradient-length)/y: gr/(gradient-length)/y - (step) % (gr-size/y)
		gr/(gradient-length + 1)/y: gr/(gradient-length)/y + (gr-size/y)
	]
	diagonally: [
		gr/(gradient-length): gr/(gradient-length) + (step) % (gr-size)
		gr/(gradient-length + 1): gr/(gradient-length) + (gr-size)
	]
	on-time: to-right
	rate: 30
	set 'make-merry func [/with opts /local alpha img][
		if with [
			foreach [opt val] opts [
				switch/default opt: to-word opt [
					color [
						color: reverse to-binary either word? background: opts/color [
							get background
						][background]
					]
					font [area/font: xfont: make font! opts/font]
					direction [
						switch opts/:opt [
							left right [
								if not opts/gradient-size [gradient-size: bind [as-pair size/x 0] self]
								on-time: get pick [to-right to-left] opts/direction = 'right
							]
							up down [
								if not opts/gradient-size [gradient-size: bind [as-pair 0 size/y] self]
								on-time: get pick [to-down to-up] opts/direction = 'down
							]
							diagonal [
								if not opts/gradient-size [gradient-size: bind [to-pair size/x] self]
								on-time: bind diagonally self
							]
						]
					]
					gradient [
						self/gradient: opts/:opt
						gradient-length: 3 + length? gradient
					]
				][	self/:opt: val ]
			]
		]
		size: size-text/with area text
		gr-size: do gradient-size
		img: draw size compose [font xfont text (pad) (text)]
		img/argb: to #{} parse img/argb [
			collect some [set alpha 3 skip keep (color) skip keep (alpha)]
		]
		system/view/auto-sync?: off
		
		view/tight/flags compose/deep [
			title "" 
			backdrop (background)
			origin (origin)
			box (size) draw [
				pen off 
				gr: fill-pen linear (gradient) 0x0 (gr-size) 
				box 0x0 (size - 1)
			] on-time [
				(compose on-time)
				show face
			] rate (rate) 
			at (origin) image img
		] flags
	]
]

E.g.:

make-merry
;or...
make-merry/with [
    gradient: [red orange yellow leaf navy violet red] 
    direction: diagonal 
    font: [size: 100 name: "Bodoni MT Black"] 
    origin: 100x60 
    step: 10 
    color: black 
    flags: [no-title]
]