pages: Update biography front-matter and project listing

2 files changed, 298 insertions, 91 deletions

diff --git a/haunt/pages/about.sxml b/haunt/pages/about.sxml
index c468721..be8114e 100644
--- a/haunt/pages/about.sxml
+++ b/haunt/pages/about.sxml
@@ -17,83 +17,227 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (use-modules (ice-9 match)
+             (ice-9 rdelim)
+             (ice-9 popen)
              (jakob theme)
-             (jakob utils sxml))
+             (jakob utils sxml)
+             (srfi srfi-1)
+             (srfi srfi-19)
+             (sxml simple))
 
 (define %software-projects
-  '(("Rebuild" "Dormant"
+  `(("Kona" rust
+     "https://git.sr.ht/~jakob/kona"
+     "./repositories/kona/"
+     ("Lightweight, self-hosted tagged image gallery."))
+    ("zerodaysfordays" ebuild
+     "https://git.sr.ht/~jakob/zerodaysfordays"
+     "./repositories/zerodaysfordays/"
+     ("My personal Gentoo overlay."))
+    ("My Website" scheme
+     "https://git.sr.ht/~jakob/blog"
+     "../"
+     ("The website you're reading right now. Effectively a massive 'contrib'
+module for " ,(hyperlink "https://dthompson.us/projects/haunt.html" "Haunt")
+"."))))
+
+(define %abandoned-software-projects
+  `(("ox-haunt" elisp
+     "https://git.sr.ht/~jakob/ox-haunt"
+     "./repositories/ox-haunt/"
+     ("Haunt-flavored HTML backend for the Org export engine")
+     ,(string->date "Apr 05 2020" "~b ~e ~Y"))
+    ("Mines" kotlin
+     "https://git.sr.ht/~jakob/mines"
+     "./repositories/mines/"
+     ("Android implementation of the classic video game \"Minesweeper\".")
+     ,(string->date "Apr 12 2019" "~b ~e ~Y"))
+    ("Slime the World" fennel
+     "https://git.sr.ht/~jakob/slime-the-world"
+     "./repositories/slime-the-world/"
+     ("My entry for the 2018 Autumn Lisp Game Jam; a game about covering everything in slime.")
+     ,(string->date "Jan 01 2019" "~b ~e ~Y"))
+    ("Rebuild" rust
      "https://git.sr.ht/~jakob/rebuild"
-     ("An attempt at reimplementing Ken Silverman's Build engine, with the goal of being modular enough to host a modern Blood source port."))
-    ("wildmidi" "Dormant"
+     "./repositories/rebuild/"
+     ("An attempt at reimplementing Ken Silverman's Build engine, with the goal of being modular enough to host a modern Blood source port.")
+     ,(string->date "Sep 23 2018" "~b ~e ~Y"))
+    ("wildmidi" rust
      "https://git.sr.ht/~jakob/wildmidi"
-     ("A simple [Rust] wrapper around the WildMIDI software synthesizer library."))
-    ("Slime the World" "Finished"
-     "https://git.sr.ht/~jakob/slime-the-world"
-     ("My entry for the 2018 Autumn Lisp Game Jam; a game about covering everything in slime."))
-    ("Nekopack" "Finished"
-     "https://git.sr.ht/~jakob/nekopack"
-     ("Tool for extracting game data from Nekopara's XP3 archives."))
-    ("skullfuck" "Finished"
-     "https://git.sr.ht/~jakob/skullfuck"
-     ("Optimizing compiler for Brainfuck, contained in a single C source file."))
-    ("Mines" "Abandoned"
-     "https://git.sr.ht/~jakob/mines"
-     ("Android implementation of the classic video game \"Minesweeper\"."))
-    ("Hypodermic" "Abandoned"
-     "https://git.sr.ht/~jakob/hypodermic"
-     ("Proof-of-concept shared object injector that will eventually be integrated with PINCE."))
-    ("Duke on FluidSynth" "Abandoned"
+     "./repositories/wildmidi/"
+     ("A simple [Rust] wrapper around the WildMIDI software synthesizer library.")
+     ,(string->date "Aug 31 2018" "~b ~e ~Y"))
+    ("Duke on FluidSynth" c++
      "https://git.sr.ht/~jakob/duke-on-fluidsynth"
-     ("Experimental FluidSynth MIDI driver for EDuke32."))))
-
-(define %emacs-projects
-  '(("ox-haunt" "Active"
-     "https://melpa.org/#/dired-rmjunk"
-     ("Haunt-flavored HTML backend for the Org export engine."))
-    ("dired-rmjunk" "Dormant"
-     "https://melpa.org/#/dired-rmjunk"
-     ("A port of Jakub Klinkovský's rmshit.py to Dired."))))
+     "./repositories/duke-on-fluidsynth/"
+     ("Experimental FluidSynth MIDI driver for EDuke32.")
+     ,(string->date "Apr 13 2018" "~b ~e ~Y"))
+    ("Hypodermic" python
+     "https://git.sr.ht/~jakob/hypodermic"
+     "./repositories/hypodermic/"
+     ("Proof-of-concept shared object injector that will eventually be integrated with PINCE.")
+     ,(string->date "Jan 22 2018" "~b ~e ~Y"))
+    ("skullfuck" c
+     "https://git.sr.ht/~jakob/skullfuck"
+     "./repositories/skullfuck/"
+     ("Optimizing compiler for Brainfuck, contained in a single C source file.")
+     ,(string->date "Jun 21 2017" "~b ~e ~Y"))
+    ("Nekopack" c
+     "https://git.sr.ht/~jakob/nekopack"
+     "./repositories/nekopack/"
+     ("Tool for extracting game data from Nekopara's XP3 archives.")
+     ,(string->date "Dec 01 2017" "~b ~e ~Y"))))
 
 (define %software-contributions
-  `(("GNU Guix" "Not Actively"
+  `(("GNU Guix" scheme
      "https://guix.gnu.org"
-     ("Functional package manager."))
-    ("Radare2" "Not Actively"
+     "./repositories/guix"
+     ("Functional cross-platform package manager and a tool to instantiate and manage
+Unix-like operating systems, based on the Nix package manager.")
+     ,(string->date "Dec 28 2019" "~b ~e ~Y"))
+    ("Radare2" c
      "https://www.radare.org/r/"
-     ("UNIX-like reverse engineering framework and command-line tools."))
-    ("Haiku" "Not Actively"
+     "./repositories/radare2"
+     ("UNIX-like reverse engineering framework and command-line tools.")
+     ,(string->date "Nov 09 2018" "~b ~e ~Y"))
+    ("Haiku" c++
      "https://www.haiku-os.org/"
-     ("The Haiku operating system."))))
+     "./repositories/haiku"
+     ("The Haiku operating system.")
+     ,(string->date "Jun 31 2019" "~b ~e ~Y"))
+    ("PINCE" python
+     "https://github.com/korcankaraokcu/PINCE"
+     "./repositories/pince"
+     ("A reverse engineering tool, comparable to Cheat Engine for GNU/Linux. I still
+maintain the Arch Linux package, which is unfortunate, as I no longer use Arch
+Linux.")
+     ,(string->date "Apr 15 2018" "~b ~e ~Y"))))
 
-(define %packaging-projects
-  '(("zerodaysfordays" "Active"
-     "https://git.sr.ht/~jakob/zerodaysfordays"
-     ("My personal Gentoo ebuild overlay."))
-    ("PINCE" "Active"
-     "https://aur.archlinux.org/packages/pince-git/"
-     ("A Linux reverse engineering tool inspired by Cheat Engine. I was a former
-upstream contributor. I still maintain the Arch Linux package, which is
-unfortunate, as I no longer use Arch Linux."))))
+(define (lang-to-button lang)
+  (case lang
+    ((c)      '(button (@ (class "lang-c"))      "C"))
+    ((c++)    '(button (@ (class "lang-cpp"))    "C++"))
+    ((python) '(button (@ (class "lang-python")) "Python"))
+    ((rust)   '(button (@ (class "lang-rust"))   "Rust"))
+    ((kotlin) '(button (@ (class "lang-kotlin")) "Kotlin"))
+    ((fennel) '(button (@ (class "lang-fennel")) "Fennel"))
+    ((elisp)  '(button (@ (class "lang-elisp"))  "Elisp"))
+    ((scheme) '(button (@ (class "lang-scheme")) "Scheme"))
+    ((ebuild) '(button (@ (class "lang-ebuild")) "Ebuild"))))
+
+(define (date-of-first-commit repository-path)
+    "Return the date of the first commit in `repository-path'."
+    (let* ((command (format #f "bash -c 'cd \"~a\"; git log --author=\"[Jj]akob\" --reverse --pretty=\"format:%at\" | head -n 1'"
+                            repository-path))
+           (port (open-input-pipe command))
+           (str  (read-line port)))
+      (close-pipe port)
+      (time-utc->date (make-time 'time-utc 0 (string->number str)))))
+
+(define* (bin-commit-counts repository-path #:key start end)
+  "Count commits per month-long interval between `start' and `end'.
+
+Take `end' to be `(current-date)' if unspecified. Similarly, take `start' to be
+the date of the first commit in the repository if unspecified."
+  (define (date-in-past date)
+    "Return `#t' iff `date' is in the past.
+
+If `end' is specified, return `#t' iff `date' is prior to `end'."
+    (time<=? (date->time-utc date)
+             (if end
+                 (date->time-utc end)
+                 (current-time 'time-utc))))
+  (define (increment-date-by-month date)
+    "Return a SRFI-19 date one month in the future from `date'."
+    ;; Special handling for leap years.
+    (define (days-in-month date)
+      (if (= 2 (date-month date))
+          (if (and (or (zero? (remainder (date-year date) 400))
+                       (positive? (remainder (date-year date) 100)))
+                   (zero? (remainder (date-year date) 4)))
+              29
+              28)
+          (cadr
+           (assoc (date-month date)
+                  '((1 31) (3 31) (4 30) (5 31) (6 30) (7 31)
+                    (8 31) (9 30) (10 31) (11 30) (12 31))))))
+    (time-utc->date
+     (add-duration (date->time-utc date)
+                   (make-time 'time-duration 0 (* 60 60 24
+                                                  (days-in-month date))))))
+  (define (count-commits-in-month start-date)
+    "Return the number of commits in the month starting on `start-date'."
+    (let* ((end-date (increment-date-by-month start-date))
+           (command (format #f "bash -c 'cd \"~a\"; git rev-list --count HEAD --author=\"[Jj]akob\" --since=\"~a\" --before=\"~a\"'"
+                            repository-path
+                            (date->string start-date "~b ~e ~Y")
+                            (date->string end-date "~b ~e ~Y"))))
+      (let* ((port (open-input-pipe command))
+             (str  (read-line port)))
+        (close-pipe port)
+        str)))
+  (let loop ((bin '())
+             (date (or start (date-of-first-commit repository-path))))
+    (if (date-in-past date)
+        (loop (cons (count-commits-in-month date) bin)
+              (increment-date-by-month date))
+        (reverse! (map string->number bin)))))
+
+(define* (render-histogram summary #:key (width 60) (height 25))
+  "Render a list of intervals as an SVG histogram."
+  ;; Assuming an interval lasts a month, I'm lucky to get 50 commits in.
+  (define max-commits-per-interval 50)
+  (define (format-shapes shapes)
+    `(svg (@ (xmlns "http://www.w3.org/2000/svg")
+             (version "1.1")
+             (width  ,(number->string width))
+             (height ,(number->string height)))
+          ;; Border for the histogram.
+          (rect (@ (x "0") (y "0") (width ,width) (height ,height)
+                   (stroke "black") (stroke-width "1")
+                   (fill "transparent")))
+          ,@shapes))
+  (let* ((summary (if (> (length summary) 30)
+                      (take-right summary 30)
+                      summary))
+         (content-width (* 2 (length summary)))
+         (right-pad (max (- width content-width) 0))
+         (upper-bound (max max-commits-per-interval
+                           (apply max summary))))
+    (format-shapes
+     (map (match-lambda
+            ((commit-count i)
+             `(line (@ (stroke "black")
+                       (stroke-width "1")
+                       ;; Separate strokes by 2px and pad to the right.
+                       (x1 ,(+ right-pad (* i 2)))
+                       (x2 ,(+ right-pad (* i 2)))
+                       (y1 ,height)
+                       (y2 ,(exact->inexact
+                             (- height
+                                (* (/ commit-count upper-bound)
+                                   height))))))))
+          (zip summary (iota (length summary)))))))
 
-(define (project name status url description)
-  (let ((status-class (match status
-                        ("Active"       "good")
-                        ("Not Actively" "info")
-                        ("Finished"     "info")
-                        ("Dormant"      "okay")
-                        ("Abandoned"    "bad")
-                        (_              "info"))))
+(define* (project name lang url repository-path description #:optional end-date)
+  (let ((start-date (date-of-first-commit repository-path)))
     `(tr (td ,(hyperlink url name))
-         (td (button (@ (class ,(format #f "label-~a" status-class)))
-                     ,status))
+         (td ,(lang-to-button lang))
+         (td ,(render-histogram (bin-commit-counts repository-path #:end end-date)))
+         (td ,(if end-date
+                  (format #f "~a - ~a"
+                          (date->string start-date "~b ~e ~Y")
+                          (date->string end-date "~b ~e ~Y"))
+                  (format #f "~a - Present" (date->string start-date "~b ~e ~Y"))))
          (td (p ,@description)))))
 
-(define (project-section name projects)
-  `(section
-    (h4 ,name)
-    (table
+(define* (project-section title format items #:key subtitle folded)
+  #<(section
+    (h4 ,title)
+    ,(when subtitle `(p ,subtitle))
+    (table (@ (class "project-section"))
      (tbody
-      ,@(map (lambda (args) (apply project args)) projects)))))
+      ,@(map (lambda (args) (apply format args)) items)))))
 
 (theme
  #:title "About"
@@ -102,7 +246,7 @@ unfortunate, as I no longer use Arch Linux."))))
    (ul (@ (class "horizontal-list"))
        (li "Email: " (strong "zerodaysfordays at ‌​‌‌‌​‌‌‍‌​‌‌​​​​‍‌​‌‌​​​‌‍‌‌​‌‌​​​‍‌​‌​‌​‌‌‍‌‌​‌‌‌‌‌‍‌​‌‌‌​​‌‍‌​‌​‌​‌​‍‌​‌‌‌‌​​‍‌​‌‌​‌​​‍‌​‌‌​‌‌​‍‌​‌‌​​​‌‍‌​‌‌‌​​​‍‌‌​‌‌‌‌‌‍‌​‌​‌‌​​‍‌​‌​‌‌‌‌‍‌​‌‌‌‌‌​‍‌​‌‌​​‌​‍‌‌​‌‌‌‌‌‍‌​‌‌​​‌​‍‌​‌‌‌​‌​sdf.org"))
        (li "XMPP: " (strong "jakob at ‌​‌‌‌​‌‌‍‌​‌‌​​​​‍‌​‌‌​​​‌‍‌‌​‌‌​​​‍‌​‌​‌​‌‌‍‌‌​‌‌‌‌‌‍‌​‌‌‌​​‌‍‌​‌​‌​‌​‍‌​‌‌‌‌​​‍‌​‌‌​‌​​‍‌​‌‌​‌‌​‍‌​‌‌​​​‌‍‌​‌‌‌​​​‍‌‌​‌‌‌‌‌‍‌​‌​‌‌​​‍‌​‌​‌‌‌‌‍‌​‌‌‌‌‌​‍‌​‌‌​​‌​‍‌‌​‌‌‌‌‌‍‌​‌‌​​‌​‍‌​‌‌‌​‌​xmpp.is"))
-       (li "IRC: " (strong "tsarfox on freenode.net.")))
+       (li "IRC: " (strong "tsarfox on irc.libera.chat.")))
    (ul (@ (class "horizontal-list"))
        (li "GPG: " ,(hyperlink "/static/gpg.txt" "6581 A4FC 404F 6434 AEA3  008C 45ED 4DC3 05BA DA33")))
    (ul (@ (class "horizontal-list"))
@@ -113,31 +257,44 @@ unfortunate, as I no longer use Arch Linux."))))
        (li ,(hyperlink "http://zerodaysfordays.sdf.org/" "sdf"))
        (li ,(hyperlink "https://lobste.rs/u/jakob" "lobste.rs")))
    (main (@ (class "overline"))
-         (p "My name's Jakob. I'm a self-taught free software hacker currently
-studying computer science and mathematics at the University of Massachusetts
-Amherst. I'm into functional programming, computer security, permaculture,
-cooking, punk rock, and lifting weights.")
-         (p "I'm still in the process of putting things together, so this page is a bit empty.")
+         (p "My name's Jakob, and I'm a self-taught "
+            ,(hyperlink "https://www.gnu.org/philosophy/free-sw.html" "free software")
+            ,(hyperlink "https://en.wikipedia.org/wiki/Hacker_culture#Definition" " hacker")
+            ". I'm into functional programming, computer security, permaculture, and lifting
+weights.")
+         (p "That's the short version. I have a longer biography available " ,(hyperlink "/pages/about-complete.html" "here") ".")
          (p (b "N.B. ")
             "if you have sent an email to an address of mine
 ending in 'sdf.lonestar.org' between January 2nd, 2020 and now, I have not
 received it. SDF has discontinued mail service on that domain. As such, "
-            ,(hyperlink "https://paste.sr.ht/%7Ejakob/18c048600c26d125d6d743e6d5b44db852573242" "I have a new PGP key."))
-         ;; (p "I am paranoid about malicious web spiders indexing my resume, so if
-;; you are looking for that sort of thing, replace 'pages/about.html' with 'files
-;; forward slash resume dot P​​‍‌‌​‌‌‌‌‌‍‌​‌​‌‌​​‍‌​‌​‌‌‌‌‍‌​‌‌‌‌‌​‍‌​‌‌​​‌​‍‌‌​‌‌‌‌‌‍‌​‌‌​​‌​‍‌​‌‌‌​‌​ D‌‌‌‌‌‍‌​‌‌​​‌​‍‌​‌‌‌​‌​ F' in the URL bar.")
-         ;; (p "If you used that god-awful LinkedIn")
-         )
+            ,(hyperlink "https://paste.sr.ht/%7Ejakob/18c048600c26d125d6d743e6d5b44db852573242" "I have a new PGP key.")))
    (h3 "Site Map")
    (nav (@ (id "site-map"))
         (section (h4 ,(hyperlink "/blogroll" "Blogroll"))
                  (p "A noncomprehensive list of the blogs I follow."))
         (section (h4 ,(hyperlink "/bookmark" "Bookmarks"))
                  (p "Collection of some things that I especially enjoyed reading."))
-        (section (h4 ,(hyperlink "/outbox" "Webmention Outbox"))
-                 (p "List of all the Webmention replies I've sent. Probably uninteresting to most.")))
+        ;; (section (h4 ,(hyperlink "/outbox" "Webmention Outbox"))
+        ;;          (p "List of all the Webmention replies I've sent. Probably uninteresting to most."))
+        )
    (h3 "Projects")
-   ,(project-section "Software" %software-projects)
-   ,(project-section "Emacs" %emacs-projects)
-   ,(project-section "Packaging" %packaging-projects)
-   ,(project-section "Other Contributions" %software-contributions)))
+   ,(project-section
+     "Software"
+     project
+     %software-projects)
+   ,(project-section
+     "Other Contributions"
+     project
+     %software-contributions
+     #:subtitle
+     "There are a few non-trivial contributions I've made to various free software
+projects, which I enumerate here. I take pride in giving back code.")
+   ,(project-section
+     "Software (Abandoned)"
+     project
+     %abandoned-software-projects
+     #:subtitle
+     "The unfortunate reality of hobbyist programming is that projects to be
+abandoned once that coding itch is satisfied. That's true of many of my
+projects."
+     #:folded #t)))
diff --git a/haunt/static/css/style.css b/haunt/static/css/style.css
index a198a89..145c315 100644
--- a/haunt/static/css/style.css
+++ b/haunt/static/css/style.css
@@ -258,19 +258,6 @@ tr:nth-child(even) {
     background-color: #f2f2f2;
 }
 
-
-td:nth-child(1) {
-    width: 20%;
-}
-
-td:nth-child(2) {
-    width: 10%;
-}
-
-td:nth-child(3) {
-    width: 70%;
-}
-
 /* Buttons. */
 
 button {
@@ -314,3 +301,66 @@ button {
 .spoiler:hover {
     background-color: #f6f5f4;
 }
+
+/* Styles specific to the "about" page. */
+
+.project-section td:nth-child(1) {
+    width: 15%;
+}
+
+.project-section td:nth-child(2) {
+    width: 60px;
+}
+
+.project-section td:nth-child(3) {
+    width: 80px;
+}
+
+.project-section td:nth-child(4) {
+    width: 15%;
+}
+
+.lang-c {
+    background-color: #555555;
+    color: #fff;
+}
+
+.lang-cpp {
+    background-color: #f34b7d;
+    color: #fff;
+}
+
+.lang-python {
+    background-color: #3572a5;
+    color: #ffdb4e;
+}
+
+.lang-rust {
+    background-color: #dea584;
+    color: #fff;
+}
+
+.lang-kotlin {
+    background-color: #f89917;
+    color: #fff;
+}
+
+.lang-fennel {
+    background-color: #2ca02c;
+    color: #fff;
+}
+
+.lang-elisp {
+    background-color: #c065db;
+    color: #fff;
+}
+
+.lang-scheme {
+    background-color: #1e4aec;
+    color: #fff;
+}
+
+.lang-ebuild {
+    background-color: #4d4270;
+    color: #fff;
+}