main.oak

{
	println: println
	default: default
	range: range
	slice: slice
	map: map
	each: each
	filter: filter
	merge: merge
	append: append
	indexOf: indexOf
	partition: partition
} := import('std')
math := import('math')
sort := import('sort')
{
	integer: integer
	number: number
	choice: choice
} := import('random')

// rendering configs
DPI := window.devicePixelRatio |> default(1)
// every size is measured as a multiple of Scale, to allow
// for easily experimieneting with human size.
Scale := 3
// how long should a speech bubble stay visible?
SpeechDuration := 3
// how often should a speech bubble appear, scaled to the
// population size? A bit of a magic number from trial and
// error.
SpeechFrequency := 100
// cached for convenient access without expensive `get` calls to the global
// window object.
DrawWidth := window.innerWidth
DrawHeight := window.innerHeight

// "game" state
//
// tinyhuman uses a data-oriented architecture TODO: explain
Light := [DrawWidth, 0]
Origins := []
Heads := []
Torsos := []
LeftArms := []
RightArms := []
LeftLegs := []
RightLegs := []
SpeechBubbles := []

// DOM bindings
querySelector := bind(document, :querySelector)
querySelectorAll := bind(document, :querySelectorAll)
fn addHandler(el, name, handler) bind(el, :addEventListener)(string(name), handler)

// Canvas bindings
//
// For performance reasons, shadows (which are blurred in CSS) and the main
// human silhouettes are rendered on different canvas elements. For
// convenience, we use the same API wrapperes to draw to both canvases, and
// swap out the backing 2D canvas context (Ctx) dynamically. This is probably
// not the best idea for perf but seems ~fast enough.
SilhouetteCanvas := querySelector('#silhouettes')
SilhouetteCtx := bind(SilhouetteCanvas, :getContext)('2d')
ShadowCanvas := querySelector('#shadows')
ShadowCtx := bind(ShadowCanvas, :getContext)('2d')
Canvas <- SilhouetteCanvas
Ctx <- SilhouetteCtx

fn ctxCall(name, args...) bind(Ctx, name)(args...)

// path takes a list of [x, y] points and draws a path between them
fn path(points) {
	start := points.0
	ctxCall(:beginPath)
	ctxCall(:moveTo, start.0, start.1)
	points |> slice(1) |> with each() fn(pt) {
		ctxCall(:lineTo, pt.0, pt.1)
	}
	ctxCall(:stroke)
}

// fill takes a list of [x, y] points and draws a polygon across all of them
// that is then filled in
fn fill(points) {
	ctxCall(:beginPath)
	start := points.0
	ctxCall(:moveTo, start.0, start.1)
	points |> slice(1) |> with each() fn(pt) {
		ctxCall(:lineTo, pt.0, pt.1)
	}
	ctxCall(:fill)
}

// circle draws a filled circle
fn circle(center, radius) {
	ctxCall(:beginPath)
	ctxCall(:arc, center.0, center.1, radius, 0, 2 * math.Pi)
	ctxCall(:fill)
}

// angle takes an angle in degrees measured counterclockwise from south, and
// returns radians from the positive right axis, clockwise.
fn angle(deg)(-deg + 90) / 180 * math.Pi

// bearing takes an [x, y] point, an angle measured from south, and a distance;
// and returns the [x', y'] of the resulting point.
fn bearing(x, y, angle, dist) [
	x + cos(angle) * dist
	y + sin(angle) * dist
]

// limb is a helper that takes a start [x, y], and angles and lengths of the
// upper and lower limbs and returns a list of the three points that form the
// limb path.
//
// limb does not itself draw these points, so that we can take these points and
// transform them to render their shadows too.
fn limb(start, deg1, len1, deg2, len2) [
	p := start
	p := bearing(p.0, p.1, angle(deg1), len1)
	bearing(p.0, p.1, angle(deg1 + deg2), len2)
]

// shadow takes an [x, y] point and an origin, and returns an [x', y'] of the
// shadow that point casts relative to that origin. Practically, what this
// means is `pt` is a point on a person and `origin` is where they stand.
fn shadow(pt, origin) {
	[x, y] := origin
	[ox, oy] := pt
	squish := (y - Light.1) / DrawHeight * 1.5
	skew := (x - Light.0) / DrawWidth * 1.5
	[
		// skew horizontally
		ox + skew * (y - oy)
		// reflect over y, squish into y by squish factor
		y - (oy - y) * squish
	]
}

// makeHuman takes an [x, y] where a human should stand, and a posture
// configuration object, and adds a human at that point with the given posture.
// If no posture is given, a random one will be generated.
//
// NOTE: makeHuman does _not_ force a re-draw of the canvas. Call `draw()` to
// re-draw the canvas with new humans.
fn makeHuman(x, y, posture) {
	// the rest of this function assumes that [x, y] describe the _left corner_
	// of where a human stands, but we want to be able to pass in something
	// that feels closer to the center of where they stand. So we offset it by
	// Scale. Just an ergonomics thing.
	x := x - Scale

	posture := posture |> default({})
	facing := posture.facing |> default(choice([:forward, :left, :right]))
	posture := merge({
		// arms: if the human faces left (or right), we don't want their left
		// (or right) elbows to bend backwards. The same for the right elbow.
		leftShoulder: number(-80, 0)
		leftElbow: if facing {
			:left -> number(-135, 0)
			:right -> number(0, 30)
			_ -> number(-135, 20)
		}
		rightShoulder: number(0, 80)
		rightElbow: if facing {
			:right -> number(0, 135)
			:left -> number(-30, 0)
			_ -> number(-20, 135)
		}

		// legs: we don't want the human's knees to bend backwards if they're
		// facing left or right.
		leftHip: if facing {
			:left -> number(-70, 30)
			:right -> number(-80, 20)
			_ -> number(10, 10)
		}
		leftKnee: if facing {
			:left -> number(10, 80)
			:right -> number(-80, -10)
			_ -> number(0, 10)
		}
		rightHip: if facing {
			:right -> number(-30, 70)
			:left -> number(-20, 80)
			_ -> number(10, 10)
		}
		rightKnee: if facing {
			:right -> number(-80, -10)
			:left -> number(10, 80)
			_ -> number(-10, 0)
		}
	}, posture)

	Origins << [x, y]
	Heads << if posture.facing {
		:left -> [x + Scale, y - 11 * Scale]
		:right -> [x + 2 * Scale, y - 11 * Scale]
		_ -> [x + 1.5 * Scale, y - 11 * Scale]
	}
	Torsos << [
		[x, y - 9 * Scale]
		[x + 3 * Scale, y - 9 * Scale]
		[x + 3 * Scale, y - 4 * Scale]
		[x, y - 4 * Scale]
	]
	LeftArms << limb([x, y - 8 * Scale]
		posture.leftShoulder, 2 * Scale
		posture.leftElbow, 1.5 * Scale)
	RightArms << limb([x + 3 * Scale, y - 8 * Scale]
		posture.rightShoulder, 2 * Scale
		posture.rightElbow, 1.5 * Scale)
	LeftLegs << limb([x + Scale / 2, y - 4 * Scale]
		posture.leftHip, 2 * Scale
		posture.leftKnee, 2 * Scale)
	RightLegs << limb([x + Scale * 2.5, y - 4 * Scale]
		posture.rightHip, 2 * Scale
		posture.rightKnee, 2 * Scale)
}

// makeSpeech picks a random human, gives them a speech bubble, and re-draws
// the canvas to display it.
fn makeSpeech if len(Origins) {
	// if no humans exist, wait 2 seconds and check again
	0 -> with wait(2) fn {
		makeSpeech()
	}
	_ -> {
		// pick a random human's positino
		[x, y] := choice(Origins)
		speech := [
			x + 1.5 * Scale, y - 11 * Scale
			choice([:left, :right])
			choice([
				'Hello, World!'
				'What\'s up?'
				'How\'s it going?'
				'What a day!'
				'Excuse me!'
				'Thank you!'
				'I\'m sorry...'
				'No problem!'
				'Of course!'
				'You gotta see this!'
				'Sorry I\'m late,'
				'I love you!'
				'It\'s nothing.'
				'Have you both met?'
				'Never mind...'
				'What do you mean?'
				'You should join us!'
				'Goodbye!'
				'Have a safe flight!'
				'What the #!$?'
				'What happened?'
				'Did you see that tweet?'
				'Are you on Instagram?'
			])
		]

		SpeechBubbles << speech
		draw()

		// after `SpeechDuration`, delete this speech bubble
		with wait(SpeechDuration) fn {
			SpeechBubbles <- SpeechBubbles |> with filter() fn(sp) sp != speech
			draw()
		}

		// recursively call itself to loop. The more people, the more often
		// they should speak, so the shorter the timeout.
		with wait(math.min(SpeechFrequency / len(Origins), SpeechDuration + 1)) fn {
			makeSpeech()
		}
	}
}

// draw clears the canvas, takes the whole "game" state, and re-draws it all on
// the new canvas. Note that there are really two canvases, one for the shadows
// and one for the silhouettes and speech bubbles.
fn draw {
	Ctx <- ShadowCtx
	Ctx.lineWidth := Scale
	Ctx.strokeStyle := 'rgba(0, 0, 0, .3)'
	Ctx.fillStyle := 'rgba(0, 0, 0, .3)'
	ctxCall(:setTransform, DPI, 0, 0, DPI, 0, 0)
	ctxCall(:clearRect, 0, 0, Canvas.width, Canvas.height)

	// contact shadows
	//
	// take each list of points, transform it with `shadow()` with respect to
	// the human's origin, and render.
	Heads |> with each() fn(head, i) {
		circle(head |> shadow(Origins.(i)), Scale)
	}
	Torsos |> with each() fn(torso, i) {
		origin := Origins.(i)
		fill(torso |> map(fn(pt) shadow(pt, origin)))
	}
	LeftArms |> with each() fn(arm, i) {
		origin := Origins.(i)
		path(arm |> map(fn(pt) shadow(pt, origin)))
	}
	RightArms |> with each() fn(arm, i) {
		origin := Origins.(i)
		path(arm |> map(fn(pt) shadow(pt, origin)))
	}
	LeftLegs |> with each() fn(leg, i) {
		origin := Origins.(i)
		path(leg |> map(fn(pt) shadow(pt, origin)))
	}
	RightLegs |> with each() fn(leg, i) {
		origin := Origins.(i)
		path(leg |> map(fn(pt) shadow(pt, origin)))
	}

	Ctx <- SilhouetteCtx
	Ctx.lineWidth := Scale
	Ctx.lineCap := 'round'
	Ctx.lineJoin := 'round'
	Ctx.fillStyle := '#000000'
	Ctx.filter := 'none'
	ctxCall(:setTransform, DPI, 0, 0, DPI, 0, 0)
	ctxCall(:clearRect, 0, 0, Canvas.width, Canvas.height)

	// tight contact shadow
	//
	// For shadows to be realistic, it can't have equal Gaussian blur all the
	// way through -- parts of the shadow that are closer to the human figure
	// should look more defined, with a darker shade and less blur.
	//
	// Because we cannot have such fine-grained control over the shadow's blur
	// using well-supported 2D Canvas APIs, instead we use the trick of
	// rendering a non-blurred shadow of the legs and cross-fading it into the
	// real shadow with a transparent linear gradient.
	Gradients := Origins |> with map() fn(origin) {
		[x, y] := origin
		grad := ctxCall(:createLinearGradient
			x + Scale, y
			shadow([x + 1 * Scale, y - 4 * Scale], [x + Scale, y])...)
		bind(grad, :addColorStop)(0, 'rgba(0, 0, 0, .2)')
		bind(grad, :addColorStop)(1, 'rgba(0, 0, 0, 0)')
		grad
	}
	LeftLegs |> with each() fn(leg, i) {
		origin := Origins.(i)
		grad := Gradients.(i)
		Ctx.strokeStyle := grad
		path(leg |> map(fn(pt) shadow(pt, origin)))
	}
	RightLegs |> with each() fn(leg, i) {
		origin := Origins.(i)
		grad := Gradients.(i)
		Ctx.strokeStyle := grad
		path(leg |> map(fn(pt) shadow(pt, origin)))
	}

	// silhouettes
	Ctx.strokeStyle := '#000000'
	Heads |> with each() fn(head) circle(head, Scale)
	Torsos |> with each() fn(torso) fill(torso)
	LeftArms |> with each() fn(arm) path(arm)
	RightArms |> with each() fn(arm) path(arm)
	LeftLegs |> with each() fn(leg) path(leg)
	RightLegs |> with each() fn(leg) path(leg)

	// speech bubbles
	Ctx.lineWidth := 1
	Ctx.textAlign := 'center'
	Ctx.font := 'normal 12px system-ui, sans-serif'
	SpeechBubbles |> with each() fn(speech) {
		[x, y, dir, text] := speech

		// a speech bubble's "line" is two line segments imitating a curve. It
		// starts a little away from the head, and reaches just below the text.
		start := bearing(
			x, y
			if dir {
				:left -> angle(-90)
				_ -> angle(90)
			}
			2.5 * Scale
		)
		midpoint := bearing(
			x, y
			if dir {
				:left -> angle(-105)
				_ -> angle(100)
			}
			5 * Scale
		)
		endpoint := bearing(
			midpoint.0, midpoint.1
			if dir {
				:left -> angle(-150)
				_ -> angle(150)
			}
			3 * Scale
		)

		path([start, midpoint, endpoint])
		ctxCall(:fillText, text, endpoint.0, endpoint.1 - 2 * Scale)
	}
}

// handleResize resets and re-renders the canvas when something about the
// screen changes.
fn handleResize {
	DrawWidth <- window.innerWidth
	DrawHeight <- window.innerHeight

	SilhouetteCanvas.width := int(window.innerWidth * DPI)
	SilhouetteCanvas.height := int(window.innerHeight * DPI)
	SilhouetteCanvas.style.width := string(DrawWidth) + 'px'
	SilhouetteCanvas.style.height := string(DrawHeight) + 'px'
	ShadowCanvas.width := int(window.innerWidth * DPI)
	ShadowCanvas.height := int(window.innerHeight * DPI)
	ShadowCanvas.style.width := string(DrawWidth) + 'px'
	ShadowCanvas.style.height := string(DrawHeight) + 'px'

	draw()
}

// addRandomHumans draws `n` randomly positioned humans on the map. Humans are
// guaranteed not to lie within some margin of the screen edges, and guaranteed
// not to overlap with the center bit of text.
fn addRandomHumans(n) {
	margin := Scale * 12

	fn randomCoord [
		integer(margin, DrawWidth - margin)
		integer(margin, DrawHeight - margin)
	]

	// avoid spawning over the title text, in the middle area
	cx := DrawWidth / 2
	cy := DrawHeight / 2
	fn inCenter?(pt) {
		[x, y] := pt
		// we add some scaled padding in vertical directions because shadows
		// and tiny human height extend vertically beyond their origins.
		cx - 110 < x & cx + 110 > x &
			cy - 50 - 5 * Scale < y & cy + 50 + 14 * Scale > y
	}

	range(n) |>
		map(randomCoord) |>
		filter(fn(pt) !inCenter?(pt)) |>
		each(fn(pt) makeHuman(pt.0, pt.1))
	draw()
}

// main
handleResize()
window |> addHandler(:resize, handleResize)
Canvas |> with addHandler(:click) fn(evt) if {
	// Ctrl/Cmd means move the light source here
	evt.altKey, evt.metaKey -> {
		{ clientX: x, clientY: y } := evt
		Light <- [x, y]
		draw()
	}
	// Shift means delete the closest human
	evt.shiftKey -> {
		{ clientX: x, clientY: y } := evt
		closestHumanOrigin := sort.sort(Origins, fn(origin) {
			[ox, oy] := origin
			(x - ox) * (x - ox) + (y - oy) * (y - oy)
		}).0
		closestHumanIndex := Origins |> indexOf(closestHumanOrigin)
		atIndex? := fn(_, i) i != closestHumanIndex

		// "delete" the human by filtering the points at that index out of the
		// global lists.
		Origins <- Origins |> filter(atIndex?)
		Heads <- Heads |> filter(atIndex?)
		Torsos <- Torsos |> filter(atIndex?)
		LeftArms <- LeftArms |> filter(atIndex?)
		RightArms <- RightArms |> filter(atIndex?)
		LeftLegs <- LeftLegs |> filter(atIndex?)
		RightLegs <- RightLegs |> filter(atIndex?)
		draw()
	}
	// normal click adds a human
	_ -> {
		makeHuman(evt.clientX, evt.clientY)
		draw()
	}
}

// link up button actions
querySelector('.clickMapButton') |> with addHandler(:click) fn(evt) {
	originalText := evt.target.textContent
	evt.target.textContent := 'not here! the map!!'
	with wait(2) fn {
		evt.target.textContent := originalText
	}
}
querySelector('.randomizeButton') |> with addHandler(:click) fn {
	addRandomHumans(10)
}
querySelector('.clearButton') |> with addHandler(:click) fn {
	Origins <- []
	Heads <- []
	Torsos <- []
	LeftArms <- []
	RightArms <- []
	LeftLegs <- []
	RightLegs <- []
	SpeechBubbles <- []
	draw()
}
querySelector('.hideButton') |> with addHandler(:click) fn {
	app := querySelector('#app')
	bind(app.parentNode, :removeChild)(app)
}

// random first generation of humans
math.max(
	12
	int(window.innerWidth * window.innerHeight / 40000)
) |> addRandomHumans()

// start the speech-generating loop
makeSpeech()