From 1623543a666315f80e71d9a59e648ecae4883ec1 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Fri, 20 Aug 2021 19:25:33 -0400 Subject: graphics: mesh: Add make-sphere procedure. --- chickadee/graphics/mesh.scm | 205 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 205 insertions(+) diff --git a/chickadee/graphics/mesh.scm b/chickadee/graphics/mesh.scm index 44c670e..b0db1b4 100644 --- a/chickadee/graphics/mesh.scm +++ b/chickadee/graphics/mesh.scm @@ -22,6 +22,7 @@ ;;; Code: (define-module (chickadee graphics mesh) + #:use-module (chickadee math) #:use-module (chickadee math matrix) #:use-module (chickadee math vector) #:use-module (chickadee graphics blend) @@ -432,3 +433,207 @@ front0 front3 front2 front0 front2 front1 back0 back3 back2 back0 back2 back1) material))) + +(define* (make-sphere radius material #:key (quality 2)) + (define phi 1.618033988749895) ; the golden ratio + ;; Compute the vector halfway between A and B. + (define (halfway a b) + (vec3+ a (vec3* (vec3- b a) 0.5))) + ;; "Normalization" in this context refers to transforming each + ;; vertex such that it is a constant distance (as determined by the + ;; radius argument) away from the origin. + ;; + ;; The result is memoized so that vertex data is shared as much as + ;; possible in the final mesh. For example, a sphere of quality 3 + ;; requires 3840 vertices, but only 642 of them are unique. + ;; Memoization reduces the mesh vertex buffer size by ~82%. + (define normalize + (memoize + (lambda (p) + (let ((n (vec3-normalize p))) + (vertex (vec3* n radius) + (vec2 (+ (/ (atan (vec3-x n) (vec3-z n)) tau) 0.5) + (+ (/ (asin (vec3-y n)) pi) 0.5)) + n))))) + ;; When mapping UV's to the sphere's vertices, there is some + ;; distortion that occurs at the 6 triangles that form a pole. The + ;; polar vertex has a U coordinate of 0.5, but the U coordinates of + ;; the other vertices that form the triangles are the percentage of + ;; how far they have traversed a unit circle. Something like this: + ;; + ;; 0.588 0.412 + ;; *-----* + ;; / \ C / \ + ;; / D \ / B \ + ;; 0.75 *----*-0.5-* 0.25 + ;; \ E / \ A / + ;; \ / F \ / + ;; *-----* + ;; 0.911 0.089 + ;; + ;; There are 2 problems: + ;; + ;; 1) With the exception of triangle C, 0.5 is not the halfway point + ;; between the other 2 U values, which results in a very obvious + ;; visual artifact where the texture looks very compressed in the + ;; triangle. + ;; + ;; 2) Triangle F, in addition to suffering from issue 1, also has + ;; the issue that it spans the seam where there's a hard jump from + ;; U=1 to U=0, causing another compressed visual artifact. + ;; + ;; The solution is to duplicate the polar vertex for all triangles + ;; and supply unique UV coordinates for each one such that the U + ;; value lies halfway between the other 2 U values. Additionally, + ;; triangle F needs the vertex with the lowest U value (0.089 in the + ;; example) adjusted to extend past 1 (1.089 would be the fixed + ;; value in the example.) + ;; + ;; This UV map adjustment is not without it's own issues, but the + ;; result looks far more acceptable. + (define (find-minu v) + (let ((u (vec2-x (vertex-uv v)))) + ;; We don't want the center point to ever be considered the min. + (if (= u 0.5) 1.0 u))) + (define (find-maxu v) + (let ((u (vec2-x (vertex-uv v)))) + ;; We don't want the center point to ever be considered the max. + (if (= u 0.5) 0.0 u))) + (define (fix-pole a b c) + (let* ((minu (min (find-minu a) (find-minu b) (find-minu c))) + (maxu (max (find-maxu a) (find-maxu b) (find-maxu c))) + (seam? (and (< minu 0.25) (> maxu 0.75)))) + (define (fix v) + (let ((uv (vertex-uv v))) + (cond + ((and seam? (= (vec2-x uv) 0.5)) + (vertex (vertex-position v) + (vec2 (+ maxu minu) + (vec2-y uv)) + (vertex-normal v))) + ((= (vec2-x uv) 0.5) + (vertex (vertex-position v) + (vec2 (+ minu (/ (- maxu minu) 2.0)) (vec2-y uv)) + (vertex-normal v))) + ((and seam? (= minu (vec2-x uv))) + (vertex (vertex-position v) + (vec2 (+ maxu (* minu 2.0)) (vec2-y uv)) + (vertex-normal v))) + (else v)))) + (list (fix a) (fix b) (fix c)))) + ;; Triangles at the poles have a vertex with a V value of either 0 + ;; or 1. + (define (on-pole? a b c) + (let ((av (vec2-y (vertex-uv a))) + (bv (vec2-y (vertex-uv b))) + (cv (vec2-y (vertex-uv c)))) + (or (= av 0.0) (= av 1.0) (= bv 0.0) (= bv 1.0) (= cv 0.0) (= cv 1.0)))) + ;; When mapping UVs to the sphere's vertices, there's a smooth + ;; wrapping of U values from 0 to 1 around the sphere, but when it + ;; reaches the beginning again there is a hard jump from 1 back to + ;; 0. This creates a glaringly obvious, distorted seam when a + ;; texture is applied. To fix it, we must identify triangles that + ;; are in the back hemisphere (-Z values) with at least one vertex + ;; whose U coordinate is 1. These are the faces that span the seam. + ;; The UVs of each vertex are then adjusted as necessary to reduce + ;; the range of U values to the desired amount. + (define (on-seam? a b c) + (and (or (negative? (vec3-z (vertex-position a))) + (negative? (vec3-z (vertex-position b))) + (negative? (vec3-z (vertex-position c)))) + (or (= (vec2-x (vertex-uv a)) 1.0) + (= (vec2-x (vertex-uv b)) 1.0) + (= (vec2-x (vertex-uv c)) 1.0)))) + (define fix-seam-maybe + (memoize + (lambda (v) + (let* ((uv (vertex-uv v)) + (du (- 1.0 (vec2-x uv)))) + (if (< du 0.5) + (vertex (vertex-position v) + (vec2 (- du) (vec2-y uv)) + (vertex-normal v)) + v))))) + (define (fix-uvs a b c) + (cond + ((on-seam? a b c) + (list (fix-seam-maybe a) + (fix-seam-maybe b) + (fix-seam-maybe c))) + ((on-pole? a b c) + (fix-pole a b c)) + (else + (list a b c)))) + ;; Recursively subdivide a triangle into 4 sub-triangles n times. + (define (subdivide tri n) + (match tri + ((a b c) + (if (= n 0) + (fix-uvs (normalize a) (normalize b) (normalize c)) + ;; Subdivide one triangle into 4, like so: + ;; + ;; B + ;; * + ;; / \ + ;; / \ + ;; E *_____* F + ;; / \ / \ + ;; / \ / \ + ;; *_____*_____* + ;; A G C + (let ((e (halfway a b)) + (f (halfway b c)) + (g (halfway c a))) + (append (subdivide (list a g e) (- n 1)) + (subdivide (list e f b) (- n 1)) + (subdivide (list g c f) (- n 1)) + (subdivide (list e g f) (- n 1)))))))) + ;; Icosahedrons (picture a 20-sided die) have 12 vertices. The + ;; position of these vertices can be defined using 3 mutually + ;; centered, mutually orthogonal golden rectangles. See + ;; https://math.wikia.org/wiki/Icosahedron#Cartesian_coordinates for + ;; a visualization of this. + ;; + ;; Rectangle on the YZ plane + (let ((yz0 (vec3 0.0 -1.0 (- phi))) + (yz1 (vec3 0.0 1.0 (- phi))) + (yz2 (vec3 0.0 1.0 phi)) + (yz3 (vec3 0.0 -1.0 phi)) + ;; Rectangle on the XY plane + (xy0 (vec3 -1.0 (- phi) 0.0)) + (xy1 (vec3 1.0 (- phi) 0.0)) + (xy2 (vec3 1.0 phi 0.0)) + (xy3 (vec3 -1.0 phi 0.0)) + ;; Rectangle on the XZ plane + (xz0 (vec3 (- phi) 0.0 -1.0)) + (xz1 (vec3 phi 0.0 -1.0)) + (xz2 (vec3 phi 0.0 1.0)) + (xz3 (vec3 (- phi) 0.0 1.0))) + (build-mesh "sphere" + (append-map (lambda (tri) + (subdivide tri quality)) + ;; 20 triangles form the base icosahedron, + ;; which will be subdivided to form a + ;; higher resolution mesh that closely + ;; approximates a sphere. + (list (list xy3 xy2 yz1) + (list yz2 xy3 xy2) + (list yz2 xy3 xz3) + (list xy3 xz3 xz0) + (list xz0 xy3 yz1) ; 5 + (list xy2 yz1 xz1) + (list yz0 yz1 xz1) + (list yz0 yz1 xz0) + (list yz0 xz0 xy0) + (list xy0 xz0 xz3) ; 10 + (list xz3 xy0 yz3) + (list yz3 yz2 xz3) + (list yz3 yz2 xz2) + (list yz2 xz2 xy2) + (list xz2 xz1 xy2) ; 15 + (list xz2 xz1 xy1) + (list xz1 xy1 yz0) + (list xy0 xy1 yz0) + (list xy0 xy1 yz3) + (list xy1 yz3 xz2))) + material))) -- cgit v1.2.3