diff options
| -rw-r--r-- | haunt.scm | 625 | ||||
| -rw-r--r-- | highlight.scm | 31 | ||||
| -rw-r--r-- | markdown.scm | 53 | ||||
| -rw-r--r-- | projects.scm | 369 | ||||
| -rw-r--r-- | theme.scm | 194 | ||||
| -rw-r--r-- | utils.scm | 51 |
6 files changed, 704 insertions, 619 deletions
@@ -1,4 +1,4 @@ -;;; Copyright © 2018 David Thompson <davet@gnu.org> +;;; Copyright © 2018-2021 David Thompson <davet@gnu.org> ;;; ;;; This program is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU General Public License as @@ -18,288 +18,16 @@ (haunt builder blog) (haunt builder atom) (haunt builder assets) - (haunt html) - (haunt page) (haunt post) - (haunt reader) - (haunt reader commonmark) (haunt site) - (haunt utils) - (commonmark) - (syntax-highlight) - (syntax-highlight scheme) - (syntax-highlight xml) - (syntax-highlight c) - (sxml match) - (sxml transform) - (texinfo) - (texinfo html) - (srfi srfi-1) - (srfi srfi-19) - (ice-9 rdelim) - (ice-9 regex) - (ice-9 match) - (web uri)) - -(define (date year month day) - "Create a SRFI-19 date for the given YEAR, MONTH, DAY" - (let ((tzoffset (tm:gmtoff (localtime (time-second (current-time)))))) - (make-date 0 0 0 0 day month year tzoffset))) - -(define (stylesheet name) - `(link (@ (rel "stylesheet") - (href ,(string-append "/css/" name ".css"))))) - -(define* (anchor content #:optional (uri content)) - `(a (@ (href ,uri)) ,content)) - -(define %cc-by-sa-link - '(a (@ (href "https://creativecommons.org/licenses/by-sa/4.0/")) - "Creative Commons Attribution Share-Alike 4.0 International")) - -(define %cc-by-sa-button - '(a (@ (class "cc-button") - (href "https://creativecommons.org/licenses/by-sa/4.0/")) - (img (@ (src "https://licensebuttons.net/l/by-sa/4.0/80x15.png"))))) - -(define %piwik-code - '((script (@ (type "text/javascript") (src "/js/piwik.js"))) - (noscript - (p (img (@ (src "//stats.dthompson.us/piwik.php?idsite=1") - (style "border:0;") - (alt ""))))))) - -(define (link name uri) - `(a (@ (href ,uri)) ,name)) - -(define* (centered-image url #:optional alt) - `(img (@ (class "centered-image") - (src ,url) - ,@(if alt - `((alt ,alt)) - '())))) - -(define (first-paragraph post) - (let loop ((sxml (post-sxml post)) - (result '())) - (match sxml - (() (reverse result)) - ((or (('p ...) _ ...) (paragraph _ ...)) - (reverse (cons paragraph result))) - ((head . tail) - (loop tail (cons head result)))))) - -(define dthompson-theme - (theme #:name "dthompson" - #:layout - (lambda (site title body) - `((doctype "html") - (head - (meta (@ (charset "utf-8"))) - (title ,(string-append title " — " (site-title site))) - ,(stylesheet "reset") - ,(stylesheet "fonts") - ,(stylesheet "dthompson")) - (body - (div (@ (class "container")) - (div (@ (class "nav")) - (ul (li ,(link "David Thompson" "/")) - (li (@ (class "fade-text")) " ") - (li ,(link "About" "/about.html")) - (li ,(link "Blog" "/index.html")) - (li ,(link "Projects" "/projects.html")))) - ,body - (footer (@ (class "text-center")) - (p (@ (class "copyright")) - "© 2020 David Thompson" - ,%cc-by-sa-button) - (p "The text and images on this site are -free culture works available under the " ,%cc-by-sa-link " license.") - (p "This website is built with " - (a (@ (href "https://dthompson.us/projects/haunt.html")) - "Haunt") - ", a static site generator written in " - (a (@ (href "https://gnu.org/software/guile")) - "Guile Scheme") - "."))) - ,%piwik-code))) - #:post-template - (lambda (post) - `((h1 (@ (class "title")),(post-ref post 'title)) - (div (@ (class "date")) - ,(date->string (post-date post) - "~B ~d, ~Y")) - (div (@ (class "post")) - ,(post-sxml post)))) - #:collection-template - (lambda (site title posts prefix) - (define (post-uri post) - (string-append "/" (or prefix "") - (site-post-slug site post) ".html")) - - `((h1 ,title - (a (@ (href "/feed.xml")) - (img (@ (src "images/feed.png"))))) - ,(map (lambda (post) - (let ((uri (string-append "/" - (site-post-slug site post) - ".html"))) - `(div (@ (class "summary")) - (h2 (a (@ (href ,uri)) - ,(post-ref post 'title))) - (div (@ (class "date")) - ,(date->string (post-date post) - "~B ~d, ~Y")) - (div (@ (class "post")) - ,(first-paragraph post)) - (a (@ (href ,uri)) "read more ➔")))) - posts))))) + (markdown) + (projects) + (theme) + (utils)) (define %collections `(("Recent Blog Posts" "index.html" ,posts/reverse-chronological))) -(define parse-lang - (let ((rx (make-regexp "-*-[ ]+([a-z]*)[ ]+-*-"))) - (lambda (port) - (let ((line (read-line port))) - (match:substring (regexp-exec rx line) 1))))) - -(define (maybe-highlight-code lang source) - (let ((lexer (match lang - ('scheme lex-scheme) - ('xml lex-xml) - ('c lex-c) - (_ #f)))) - (if lexer - (highlights->sxml (highlight lexer source)) - source))) - -(define (sxml-identity . args) args) - -(define (highlight-code . tree) - (sxml-match tree - ((code (@ (class ,class) . ,attrs) ,source) - (let ((lang (string->symbol - (string-drop class (string-length "language-"))))) - `(code (@ ,@attrs) - ,(maybe-highlight-code lang source)))) - (,other other))) - -(define (highlight-scheme code) - `(pre (code ,(highlights->sxml (highlight lex-scheme code))))) - -(define (raw-snippet code) - `(pre (code ,(if (string? code) code (read-string code))))) - -;; Markdown doesn't support video, so let's hack around that! Find -;; <img> tags with a ".webm" source and substitute a <video> tag. -(define (media-hackery . tree) - (sxml-match tree - ((img (@ (src ,src) . ,attrs) . ,body) - (if (string-suffix? ".webm" src) - `(video (@ (src ,src) (controls "true"),@attrs) ,@body) - tree)))) - -(define %commonmark-rules - `((code . ,highlight-code) - (img . ,media-hackery) - (*text* . ,(lambda (tag str) str)) - (*default* . ,sxml-identity))) - -(define (post-process-commonmark sxml) - (pre-post-order sxml %commonmark-rules)) - -(define commonmark-reader* - (make-reader (make-file-extension-matcher "md") - (lambda (file) - (call-with-input-file file - (lambda (port) - (values (read-metadata-headers port) - (post-process-commonmark - (commonmark->sxml port)))))))) - -(define (static-page title file-name body) - (lambda (site posts) - (make-page file-name - (with-layout dthompson-theme site title body) - sxml->html))) - -(define* (project-page #:key name file-name description usage requirements - installation manual? license repo releases guix-package) - (define (tarball-url version) - (string-append "https://files.dthompson.us/" - repo "/" repo "-" version - ".tar.gz")) - (define body - `((h1 ,name) - ,description - ,@(if usage - `((h2 "Usage") - ,usage) - '()) - ,@(if manual? - `((h2 "Documentation") - (p ,(anchor "View the reference manual" - (string-append "/manuals/" repo "/index.html")))) - '()) - (h2 "Releases") - (ul ,(map (match-lambda - ((version date) - (let ((url (tarball-url version))) - `(li ,(date->string date "~Y-~m-~d") - " — " ,version " — " - ,(anchor (string-append repo "-" version ".tar.gz") - url) - " — " - ,(anchor "GPG signature" - (string-append url ".asc")))))) - releases)) - (h2 "Requirements") - (ul ,(map (lambda (requirement) - `(li ,requirement)) - requirements)) - (h2 "Installation") - ,@(if installation - (list installation) - (match (car releases) - ((version _) - `(,@(if guix-package - `((p "To install " ,name " with the GNU Guix package manager, run:") - (pre "guix install " ,guix-package)) - '()) - (p "To build and install " ,name " from source, run:") - (pre "wget " - ,(tarball-url version) - " -tar xf " - ,repo "-" ,version ".tar.gz" - " -cd " - ,repo "-" ,version - " -./configure -make -make install"))))) - (h2 "License") - (p ,license) - (h2 "Git Repository") - ,@(let ((url (string-append "https://git.dthompson.us/" repo ".git"))) - `((p ,name " is developed using the Git version control -system. The official repository is hosted at " - ,(anchor url url) ".") - (p "To clone the repository, run:") - (pre "git clone " ,url))) - (h2 "Community") - (p "Real-time discussion for " ,name " can be found on the " - (code "#guile") - " channel on the Freenode IRC network.") - (h2 "Contributing") - (p "Send patches and bug reports to " - ,(anchor "davet@gnu.org" "mailto:davet@gnu.org") - "."))) - - (static-page name (string-append "projects/" file-name) body)) - (define about-page (static-page "About Me" @@ -307,7 +35,7 @@ system. The official repository is hosted at " `((h2 "Hi.") (p "I am a professional software developer, hobbyist gardener, woodworker, and drummer from Worcester, Massachusetts.") - (p "I am currently a DevOps engineer at " ,(anchor "Vista Higher + (p "I am currently a Senior DevOps engineer at " ,(anchor "Vista Higher Learning" "http://vistahigherlearning.com") ", and formerly a web developer at the " ,(anchor "Free Software Foundation." "https://fsf.org")) @@ -336,347 +64,6 @@ Learning" "http://vistahigherlearning.com") (p ,(anchor "srt2vtt" "projects/srt2vtt.html") " — SRT to WebVTT subtitle converter")))) -(define sly-page - (project-page - #:name "Sly" - #:file-name "sly.html" - #:description - `((p (strong "note: this project is no longer being developed!")) - (p "Sly is a fun, free software 2D/3D game engine written in " - ,(anchor "Guile Scheme" "https://gnu.org/s/guile") ".") - ,(centered-image "/images/sly/logo.png" "Sly fox mascot") - (p "Sly differentiates itself from most other game engines by encouraging -and enabling the use of " - ,(anchor "live coding" - "http://toplap.org/about/") - " and " - ,(anchor "functional reactive programming" - "https://en.wikipedia.org/wiki/Functional_reactive_programming") - " techniques. Sly provides a dynamic live coding environment -that allows games to be built interactively and iteratively without -ever stopping the running program. A data structure called a “signal” -provides a method of modeling time-varying state that is declarative, -functional, and reactive.") - (p ,(centered-image "/images/sly/2048.png")) - (p ,(centered-image "/images/sly/mines.png"))) - #:requirements '("GNU Guile >= 2.0.11" - "guile-opengl_ >= 0.1.0" - "guile-sdl_ >= 0.5.0" - "SDL 1.2.x" - "FreeImage >= 3.0" - "GNU Scientific Library (GSL)") - #:license "GNU GPLv3+" - #:repo "sly" - #:manual? #t - #:releases - `(("0.1" ,(date 2015 11 12))))) - -(define guile-sdl2-page - (project-page - #:name "Guile-SDL2" - #:file-name "guile-sdl2.html" - #:repo "guile-sdl2" - #:guix-package "guile-sdl2" - #:description - `((p "Guile-SDL2 provides " - ,(anchor "Guile Scheme" "https://gnu.org/s/guile") - " bindings for the " - ,(anchor "SDL2" "http://libsdl.org") - " C shared library. The bindings are written in pure Scheme -using Guile's foreign function interface.")) - #:usage - `((p "Guile-SDL2 provides modules in the " - (code "(sdl2 ...)") - " namespace, roughly organized how the SDL2 C header files are -organized. Low-level bindings are available in the" - (code "(sdl2 bindings ...)") - " namespace, but these are not recommended for normal usage.") - (p "Additionally, SDL2 extension library bindings are available in the -following modules:") - (ul (li "SDL2_image: " (code "(sdl2 image)")) - (li "SDL2_mixer: " (code "(sdl2 mixer)")) - (li "SDL2_ttf: " (code "(sdl2 ttf)"))) - (p "Here is a short “hello, world” example program:") - ,(highlight-scheme - "(use-modules (sdl2) - (sdl2 render) - (sdl2 surface) - (sdl2 video)) - -(define (draw ren) - (let* ((surface (load-bmp \"hello.bmp\")) - (texture (surface->texture ren surface))) - (clear-renderer ren) - (render-copy ren texture) - (present-renderer ren) - (sleep 2))) - -(sdl-init) - -(call-with-window (make-window) - (lambda (window) - (call-with-renderer (make-renderer window) draw))) - -(sdl-quit)")) - #:requirements '("GNU Guile >= 2.0.9" - "SDL2 >= 2.0.0" - "SDL2_image >= 2.0.0" - "SDL2_mixer >= 2.0.0" - "SDL2_ttf >= 2.0.0" - "GNU Make" - "GNU pkg-config") - #:license "GNU LGPLv3+" - #:manual? #t - #:releases - `(("0.5.0" ,(date 2020 04 07)) - ("0.4.0" ,(date 2019 06 02)) - ("0.3.1" ,(date 2018 10 16)) - ("0.3.0" ,(date 2018 07 10)) - ("0.2.0" ,(date 2017 01 20)) - ("0.1.2" ,(date 2016 08 10)) - ("0.1.1" ,(date 2016 01 01)) - ("0.1.0" ,(date 2015 12 22))))) - -(define guile-syntax-highlight-page - (project-page - #:name "guile-syntax-highlight" - #:file-name "guile-syntax-highlight.html" - #:repo "guile-syntax-highlight" - #:description - `((p "guile-syntax-highlight is a general-purpose syntax -highlighting library for GNU Guile. It can parse code written in -various programming languages into a simple s-expression that can be -easily converted to HTML (via SXML) or any other format for -rendering.")) - #:usage - (highlight-scheme - "(use-modules (syntax-highlight) - (syntax-highlight scheme) - (sxml simple)) - -(define code - \"(define (square x) \\\"Return the square of X.\\\" (* x x))\") - -;; Get raw highlights list. -(define highlighted-code - (highlight scheme-highlighter code)) - -;; Convert to SXML. -(define highlighted-sxml - (highlights->sxml highlighted-code)) - -;; Write HTML to stdout. -(display (sxml->xml highlighted-sxml)) -(newline) -") - #:requirements '("GNU Guile >= 2.0" - "GNU Make" - "GNU pkg-config") - #:license "GNU LGPLv3+" - #:releases - `(("0.1" ,(date 2018 03 10))))) - -(define haunt-page - (project-page - #:name "Haunt" - #:file-name "haunt.html" - #:repo "haunt" - #:guix-package "haunt" - #:manual? #t - #:description - `((p "Haunt is a simple, functional, hackable static site generator -that gives authors the ability to treat websites as Scheme programs.") - ,(centered-image "/images/haunt/logo.png" "crudely drawn ghost") - (p "By giving authors the full expressive power of Scheme, they -are able to control every aspect of the site generation process. -Haunt provides a simple, functional build system that can be easily -extended for this purpose.") - (p "Haunt has no opinion about what markup language authors -should use to write posts, though it comes with support for the -popular Markdown format. Likewise, Haunt has no opinion about how -authors structure their sites. Though it comes with support for -building simple blogs or Atom feeds, authors should feel empowered to -tweak, replace, or create builders to do things that aren't provided -out-of-the-box.")) - #:usage - `((p "Here's what a simple Haunt configuration looks like:") - ,(call-with-input-file "snippets/haunt.scm" highlight-scheme) - (p "In a new directory, save the above to a file named " - (code "haunt.scm") ".") - (p "Create a subdirectory named " (code "posts") ".") - (p "Add the following to a new file named " (code "posts/hello.md") ":") - ,(call-with-input-file "snippets/haunt-hello.md" raw-snippet) - (p "Run " (code "haunt build") " to build the site.") - (p "Run " (code "haunt serve") " to a launch a web server to -preview your work.") - (p "Open " ,(anchor "http://localhost:8080") " in your web browser -and smile, because you've just generated your first Haunt site!")) - #:requirements - '("GNU Guile >= 2.0" - "guile-commonmark (for Markdown support, optional)" - "guile-reader (for Skribe support, optional)") - #:license "GNU GPLv3+" - #:releases - `(("0.2.4" ,(date 2018 11 29)) - ("0.2.3" ,(date 2018 11 25)) - ("0.2.2" ,(date 2018 03 10)) - ("0.2.1" ,(date 2017 01 23)) - ("0.2" ,(date 2016 04 24)) - ("0.1" ,(date 2015 08 08))))) - -(define chickadee-page - (project-page - #:name "Chickadee" - #:file-name "chickadee.html" - #:repo "chickadee" - #:guix-package "guile-chickadee" - #:manual? #t - #:description - `((p "Chickadee is a game development toolkit for " - ,(anchor "Guile Scheme" "https://gnu.org/s/guile") ".") - ,(centered-image "/images/chickadee/logo.png" "Chickadee logo") - (p "Chickadee provides all the essential tools that -parenthetically inclined game developers need to make games in -Scheme.") - (p "Here is the obligatory “Hello, world” program:") - ,(highlight-scheme - "(use-modules (chickadee) - (chickadee math vector) - (chickadee graphics font)) - -(define (draw alpha) - (draw-text \"Hello, world!\" (vec2 260.0 240.0))) - -(run-game #:draw draw) -") - (p "And here's how to draw a sprite:") - ,(highlight-scheme - "(use-modules (chickadee) - (chickadee math vector) - (chickadee graphics sprite) - (chickadee graphics texture)) - -(define sprite #f) - -(define (load) - (set! sprite (load-image \"images/chickadee.png\"))) - -(define (draw alpha) - (draw-sprite sprite (vec2 256.0 176.0))) - -(run-game #:load load #:draw draw) -") - (p "Features include:") - (ul - (li "extensible, fixed-timestep game loop") - (li "OpenGL-based rendering engine") - (li "keyboard, mouse, controller input events") - (li "vectors, matrices, bounding boxes, easing functions, etc.") - (li "asynchronous scripting")) - (p (small ,(anchor "chickadee sprite by Refuzzle, CC0" - "http://opengameart.org/content/winter-birds")))) - #:requirements '("GNU Guile >= 2.1.4" - "Guile-SDL2 >= 0.2.0" - "Guile-OpenGL >= 0.1.0") - #:license "GNU GPLv3+" - #:releases - `(("0.6.0" ,(date 2020 11 19)) - ("0.5.0" ,(date 2020 04 08)) - ("0.4.0" ,(date 2019 06 04)) - ("0.3.0" ,(date 2018 10 03)) - ("0.2.0" ,(date 2017 01 26)) - ("0.1.0" ,(date 2017 01 23))))) - -(define shroud-page - (project-page - #:name "Shroud" - #:file-name "shroud.html" - #:repo "shroud" - #:description - `((p "Shroud is a simple secret manager with a command line interface.") - (p "The password database is stored as a Scheme s-expression -and encrypted with a " - ,(anchor "GnuPG" "https://gnupg.org") - " key. Secrets consist of an arbitrary number of key/value -pairs, making Shroud suitable for more than just password storage. -For copying and pasting secrets into web browsers and other graphical -applications, there is xclip integration.")) - #:requirements '("GNU Guile >= 2.0.9" - "GnuPG >= 1.4" - "GNU Make" - "GNU pkg-config" - ("optional: xclip is needed for the " - (code "-c") - " flag of " - (code "shroud show") - " to work")) - #:usage - `((p "First, create a " (code ".shroud") - " file in your home directory to hold your -configuration settings. All you really need to set here is your GPG -user ID i.e. your email address:") - ,(highlight-scheme - "'((user-id . \"foo@example.com\"))") - (p "The " - (code ".shroud") - " file is Scheme source code, so any expression that evaluates -to an alist of valid configuration settings is usable by Shroud.") - (p "Once Shroud is configured, try out the following commands to -get a feel for how things work:") - (pre - "# Add a new secret: -shroud hide bank-account username=foobar password=hackme - -# Edit an existing secret: -shroud hide --edit bank-account password=hackmepls - -# List all secrets: -shroud list - -# Show all key/value pairs for a saved secret: -shroud show bank-account - -# Show a single value in a secret: -shroud show bank-account password - -# Copy a password directly to X clipboard: -shroud show -c bank-account password - -# Delete a secret: -shroud remove bank-account") - (p "Happy shrouding!")) - #:license "GNU GPLv3+" - #:releases - `(("0.1.1" ,(date 2015 10 01)) - ("0.1.0" ,(date 2015 09 29))))) - -(define srt2vtt-page - (project-page - #:name "srt2vtt" - #:file-name "srt2vtt.html" - #:repo "srt2vtt" - #:description - `((p "Convert SRT formatted subtitles to WebVTT format for use with -the HTML5 " - (code "<track>") " tag.")) - #:requirements '("GNU Guile >= 2.0.5") - #:usage - `((pre - "$ srt2vtt --help -Usage: srt2vtt [OPTIONS] -Convert SubRip formatted subtitles to WebVTT format. - - -h, --help display this help and exit - -v, --version display version and exit - -i, --input=FILE-NAME read input from FILE-NAME - -o, --output=FILE-NAME write output to FILE-NAME") - (p "If " (code "--input") - " or " (code "--output") - " is ommitted, read from stdin or stdout, respectively.")) - #:license "GNU GPLv3+" - #:releases - `(("0.1" ,(date 2015 02 7))))) - (site #:title "dthompson" #:domain "dthompson.us" #:default-metadata diff --git a/highlight.scm b/highlight.scm new file mode 100644 index 0000000..51f2b02 --- /dev/null +++ b/highlight.scm @@ -0,0 +1,31 @@ +(define-module (highlight) + #:use-module (ice-9 match) + #:use-module (sxml match) + #:use-module (syntax-highlight) + #:use-module (syntax-highlight scheme) + #:use-module (syntax-highlight xml) + #:use-module (syntax-highlight c) + #:export (highlight-code + highlight-scheme)) + +(define (maybe-highlight-code lang source) + (let ((lexer (match lang + ('scheme lex-scheme) + ('xml lex-xml) + ('c lex-c) + (_ #f)))) + (if lexer + (highlights->sxml (highlight lexer source)) + source))) + +(define (highlight-code . tree) + (sxml-match tree + ((code (@ (class ,class) . ,attrs) ,source) + (let ((lang (string->symbol + (string-drop class (string-length "language-"))))) + `(code (@ ,@attrs) + ,(maybe-highlight-code lang source)))) + (,other other))) + +(define (highlight-scheme code) + `(pre (code ,(highlights->sxml (highlight lex-scheme code))))) diff --git a/markdown.scm b/markdown.scm new file mode 100644 index 0000000..d1a70b4 --- /dev/null +++ b/markdown.scm @@ -0,0 +1,53 @@ +;;; Copyright © 2018-2021 David Thompson <davet@gnu.org> +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define-module (markdown) + #:use-module (commonmark) + #:use-module (haunt post) + #:use-module (haunt reader) + #:use-module (highlight) + #:use-module (sxml match) + #:use-module (sxml transform) + #:export (commonmark-reader*)) + +(define (sxml-identity . args) args) + +;; Markdown doesn't support video, so let's hack around that! Find +;; <img> tags with a ".webm" source and substitute a <video> tag. +(define (media-hackery . tree) + (sxml-match tree + ((img (@ (src ,src) . ,attrs) . ,body) + (if (string-suffix? ".webm" src) + `(video (@ (src ,src) (controls "true"),@attrs) ,@body) + tree)))) + +(define %commonmark-rules + `((code . ,highlight-code) + (img . ,media-hackery) + (*text* . ,(lambda (tag str) str)) + (*default* . ,sxml-identity))) + +(define (post-process-commonmark sxml) + (pre-post-order sxml %commonmark-rules)) + +(define commonmark-reader* + (make-reader (make-file-extension-matcher "md") + (lambda (file) + (call-with-input-file file + (lambda (port) + (values (read-metadata-headers port) + (post-process-commonmark + (commonmark->sxml port)))))))) diff --git a/projects.scm b/projects.scm new file mode 100644 index 0000000..e2b672e --- /dev/null +++ b/projects.scm @@ -0,0 +1,369 @@ +;;; Copyright © 2018-2021 David Thompson <davet@gnu.org> +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define-module (projects) + #:use-module (highlight) + #:use-module (theme) + #:use-module (utils) + #:export (chickadee-page + sly-page + guile-sdl2-page + guile-syntax-highlight-page + haunt-page + shroud-page + srt2vtt-page)) + +(define sly-page + (project-page + #:name "Sly" + #:file-name "sly.html" + #:description + `((p (strong "note: this project is no longer being developed!")) + (p "Sly is a fun, free software 2D/3D game engine written in " + ,(anchor "Guile Scheme" "https://gnu.org/s/guile") ".") + ,(centered-image "/images/sly/logo.png" "Sly fox mascot") + (p "Sly differentiates itself from most other game engines by encouraging +and enabling the use of " + ,(anchor "live coding" + "http://toplap.org/about/") + " and " + ,(anchor "functional reactive programming" + "https://en.wikipedia.org/wiki/Functional_reactive_programming") + " techniques. Sly provides a dynamic live coding environment +that allows games to be built interactively and iteratively without +ever stopping the running program. A data structure called a “signal” +provides a method of modeling time-varying state that is declarative, +functional, and reactive.") + (p ,(centered-image "/images/sly/2048.png")) + (p ,(centered-image "/images/sly/mines.png"))) + #:requirements '("GNU Guile >= 2.0.11" + "guile-opengl_ >= 0.1.0" + "guile-sdl_ >= 0.5.0" + "SDL 1.2.x" + "FreeImage >= 3.0" + "GNU Scientific Library (GSL)") + #:license "GNU GPLv3+" + #:repo "sly" + #:manual? #t + #:releases + `(("0.1" ,(date 2015 11 12))))) + +(define guile-sdl2-page + (project-page + #:name "Guile-SDL2" + #:file-name "guile-sdl2.html" + #:repo "guile-sdl2" + #:guix-package "guile-sdl2" + #:description + `((p "Guile-SDL2 provides " + ,(anchor "Guile Scheme" "https://gnu.org/s/guile") + " bindings for the " + ,(anchor "SDL2" "http://libsdl.org") + " C shared library. The bindings are written in pure Scheme +using Guile's foreign function interface.")) + #:usage + `((p "Guile-SDL2 provides modules in the " + (code "(sdl2 ...)") + " namespace, roughly organized how the SDL2 C header files are +organized. Low-level bindings are available in the" + (code "(sdl2 bindings ...)") + " namespace, but these are not recommended for normal usage.") + (p "Additionally, SDL2 extension library bindings are available in the +following modules:") + (ul (li "SDL2_image: " (code "(sdl2 image)")) + (li "SDL2_mixer: " (code "(sdl2 mixer)")) + (li "SDL2_ttf: " (code "(sdl2 ttf)"))) + (p "Here is a short “hello, world” example program:") + ,(highlight-scheme + "(use-modules (sdl2) + (sdl2 render) + (sdl2 surface) + (sdl2 video)) + +(define (draw ren) + (let* ((surface (load-bmp \"hello.bmp\")) + (texture (surface->texture ren surface))) + (clear-renderer ren) + (render-copy ren texture) + (present-renderer ren) + (sleep 2))) + +(sdl-init) + +(call-with-window (make-window) + (lambda (window) + (call-with-renderer (make-renderer window) draw))) + +(sdl-quit)")) + #:requirements '("GNU Guile >= 2.0.9" + "SDL2 >= 2.0.0" + "SDL2_image >= 2.0.0" + "SDL2_mixer >= 2.0.0" + "SDL2_ttf >= 2.0.0" + "GNU Make" + "GNU pkg-config") + #:license "GNU LGPLv3+" + #:manual? #t + #:releases + `(("0.5.0" ,(date 2020 04 07)) + ("0.4.0" ,(date 2019 06 02)) + ("0.3.1" ,(date 2018 10 16)) + ("0.3.0" ,(date 2018 07 10)) + ("0.2.0" ,(date 2017 01 20)) + ("0.1.2" ,(date 2016 08 10)) + ("0.1.1" ,(date 2016 01 01)) + ("0.1.0" ,(date 2015 12 22))))) + +(define guile-syntax-highlight-page + (project-page + #:name "guile-syntax-highlight" + #:file-name "guile-syntax-highlight.html" + #:repo "guile-syntax-highlight" + #:description + `((p "guile-syntax-highlight is a general-purpose syntax +highlighting library for GNU Guile. It can parse code written in +various programming languages into a simple s-expression that can be +easily converted to HTML (via SXML) or any other format for +rendering.")) + #:usage + (highlight-scheme + "(use-modules (syntax-highlight) + (syntax-highlight scheme) + (sxml simple)) + +(define code + \"(define (square x) \\\"Return the square of X.\\\" (* x x))\") + +;; Get raw highlights list. +(define highlighted-code + (highlight scheme-highlighter code)) + +;; Convert to SXML. +(define highlighted-sxml + (highlights->sxml highlighted-code)) + +;; Write HTML to stdout. +(display (sxml->xml highlighted-sxml)) +(newline) +") + #:requirements '("GNU Guile >= 2.0" + "GNU Make" + "GNU pkg-config") + #:license "GNU LGPLv3+" + #:releases + `(("0.1" ,(date 2018 03 10))))) + +(define haunt-page + (project-page + #:name "Haunt" + #:file-name "haunt.html" + #:repo "haunt" + #:guix-package "haunt" + #:manual? #t + #:description + `((p "Haunt is a simple, functional, hackable static site generator +that gives authors the ability to treat websites as Scheme programs.") + ,(centered-image "/images/haunt/logo.png" "crudely drawn ghost") + (p "By giving authors the full expressive power of Scheme, they +are able to control every aspect of the site generation process. +Haunt provides a simple, functional build system that can be easily +extended for this purpose.") + (p "Haunt has no opinion about what markup language authors +should use to write posts, though it comes with support for the +popular Markdown format. Likewise, Haunt has no opinion about how +authors structure their sites. Though it comes with support for +building simple blogs or Atom feeds, authors should feel empowered to +tweak, replace, or create builders to do things that aren't provided +out-of-the-box.")) + #:usage + `((p "Here's what a simple Haunt configuration looks like:") + ,(call-with-input-file "snippets/haunt.scm" highlight-scheme) + (p "In a new directory, save the above to a file named " + (code "haunt.scm") ".") + (p "Create a subdirectory named " (code "posts") ".") + (p "Add the following to a new file named " (code "posts/hello.md") ":") + ,(call-with-input-file "snippets/haunt-hello.md" raw-snippet) + (p "Run " (code "haunt build") " to build the site.") + (p "Run " (code "haunt serve") " to a launch a web server to +preview your work.") + (p "Open " ,(anchor "http://localhost:8080") " in your web browser +and smile, because you've just generated your first Haunt site!")) + #:requirements + '("GNU Guile >= 2.0" + "guile-commonmark (for Markdown support, optional)" + "guile-reader (for Skribe support, optional)") + #:license "GNU GPLv3+" + #:releases + `(("0.2.4" ,(date 2018 11 29)) + ("0.2.3" ,(date 2018 11 25)) + ("0.2.2" ,(date 2018 03 10)) + ("0.2.1" ,(date 2017 01 23)) + ("0.2" ,(date 2016 04 24)) + ("0.1" ,(date 2015 08 08))))) + +(define chickadee-page + (project-page + #:name "Chickadee" + #:file-name "chickadee.html" + #:repo "chickadee" + #:guix-package "guile-chickadee" + #:manual? #t + #:description + `((p "Chickadee is a game development toolkit for " + ,(anchor "Guile Scheme" "https://gnu.org/s/guile") ".") + ,(centered-image "/images/chickadee/logo.png" "Chickadee logo") + (p "Chickadee provides all the essential tools that +parenthetically inclined game developers need to make games in +Scheme.") + (p "Here is the obligatory “Hello, world” program:") + ,(highlight-scheme + "(use-modules (chickadee) + (chickadee math vector) + (chickadee graphics font)) + +(define (draw alpha) + (draw-text \"Hello, world!\" (vec2 260.0 240.0))) + +(run-game #:draw draw) +") + (p "And here's how to draw a sprite:") + ,(highlight-scheme + "(use-modules (chickadee) + (chickadee math vector) + (chickadee graphics sprite) + (chickadee graphics texture)) + +(define sprite #f) + +(define (load) + (set! sprite (load-image \"images/chickadee.png\"))) + +(define (draw alpha) + (draw-sprite sprite (vec2 256.0 176.0))) + +(run-game #:load load #:draw draw) +") + (p "Features include:") + (ul + (li "extensible, fixed-timestep game loop") + (li "OpenGL-based rendering engine") + (li "keyboard, mouse, controller input events") + (li "vectors, matrices, bounding boxes, easing functions, etc.") + (li "asynchronous scripting")) + (p (small ,(anchor "chickadee sprite by Refuzzle, CC0" + "http://opengameart.org/content/winter-birds")))) + #:requirements '("GNU Guile >= 2.1.4" + "Guile-SDL2 >= 0.2.0" + "Guile-OpenGL >= 0.1.0") + #:license "GNU GPLv3+" + #:releases + `(("0.6.0" ,(date 2020 11 19)) + ("0.5.0" ,(date 2020 04 08)) + ("0.4.0" ,(date 2019 06 04)) + ("0.3.0" ,(date 2018 10 03)) + ("0.2.0" ,(date 2017 01 26)) + ("0.1.0" ,(date 2017 01 23))))) + +(define shroud-page + (project-page + #:name "Shroud" + #:file-name "shroud.html" + #:repo "shroud" + #:description + `((p "Shroud is a simple secret manager with a command line interface.") + (p "The password database is stored as a Scheme s-expression +and encrypted with a " + ,(anchor "GnuPG" "https://gnupg.org") + " key. Secrets consist of an arbitrary number of key/value +pairs, making Shroud suitable for more than just password storage. +For copying and pasting secrets into web browsers and other graphical +applications, there is xclip integration.")) + #:requirements '("GNU Guile >= 2.0.9" + "GnuPG >= 1.4" + "GNU Make" + "GNU pkg-config" + ("optional: xclip is needed for the " + (code "-c") + " flag of " + (code "shroud show") + " to work")) + #:usage + `((p "First, create a " (code ".shroud") + " file in your home directory to hold your +configuration settings. All you really need to set here is your GPG +user ID i.e. your email address:") + ,(highlight-scheme + "'((user-id . \"foo@example.com\"))") + (p "The " + (code ".shroud") + " file is Scheme source code, so any expression that evaluates +to an alist of valid configuration settings is usable by Shroud.") + (p "Once Shroud is configured, try out the following commands to +get a feel for how things work:") + (pre + "# Add a new secret: +shroud hide bank-account username=foobar password=hackme + +# Edit an existing secret: +shroud hide --edit bank-account password=hackmepls + +# List all secrets: +shroud list + +# Show all key/value pairs for a saved secret: +shroud show bank-account + +# Show a single value in a secret: +shroud show bank-account password + +# Copy a password directly to X clipboard: +shroud show -c bank-account password + +# Delete a secret: +shroud remove bank-account") + (p "Happy shrouding!")) + #:license "GNU GPLv3+" + #:releases + `(("0.1.1" ,(date 2015 10 01)) + ("0.1.0" ,(date 2015 09 29))))) + +(define srt2vtt-page + (project-page + #:name "srt2vtt" + #:file-name "srt2vtt.html" + #:repo "srt2vtt" + #:description + `((p "Convert SRT formatted subtitles to WebVTT format for use with +the HTML5 " + (code "<track>") " tag.")) + #:requirements '("GNU Guile >= 2.0.5") + #:usage + `((pre + "$ srt2vtt --help +Usage: srt2vtt [OPTIONS] +Convert SubRip formatted subtitles to WebVTT format. + + -h, --help display this help and exit + -v, --version display version and exit + -i, --input=FILE-NAME read input from FILE-NAME + -o, --output=FILE-NAME write output to FILE-NAME") + (p "If " (code "--input") + " or " (code "--output") + " is ommitted, read from stdin or stdout, respectively.")) + #:license "GNU GPLv3+" + #:releases + `(("0.2" ,(date 2021 03 19)) + ("0.1" ,(date 2015 02 7))))) diff --git a/theme.scm b/theme.scm new file mode 100644 index 0000000..16f0c41 --- /dev/null +++ b/theme.scm @@ -0,0 +1,194 @@ +;;; Copyright © 2018-2021 David Thompson <davet@gnu.org> +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define-module (theme) + #:use-module (haunt builder blog) + #:use-module (haunt html) + #:use-module (haunt page) + #:use-module (haunt post) + #:use-module (haunt site) + #:use-module (ice-9 match) + #:use-module (srfi srfi-19) + #:use-module (utils) + #:export (dthompson-theme + static-page + project-page)) + +(define %cc-by-sa-link + '(a (@ (href "https://creativecommons.org/licenses/by-sa/4.0/")) + "Creative Commons Attribution Share-Alike 4.0 International")) + +(define %cc-by-sa-button + '(a (@ (class "cc-button") + (href "https://creativecommons.org/licenses/by-sa/4.0/")) + (img (@ (src "https://licensebuttons.net/l/by-sa/4.0/80x15.png"))))) + +(define (first-paragraph post) + (let loop ((sxml (post-sxml post)) + (result '())) + (match sxml + (() (reverse result)) + ((or (('p ...) _ ...) (paragraph _ ...)) + (reverse (cons paragraph result))) + ((head . tail) + (loop tail (cons head result)))))) + +(define dthompson-theme + (theme #:name "dthompson" + #:layout + (lambda (site title body) + `((doctype "html") + (head + (meta (@ (charset "utf-8"))) + (title ,(string-append title " — " (site-title site))) + ,(stylesheet "reset") + ,(stylesheet "fonts") + ,(stylesheet "dthompson")) + (body + (div (@ (class "container")) + (div (@ (class "nav")) + (ul (li ,(link "David Thompson" "/")) + (li (@ (class "fade-text")) " ") + (li ,(link "About" "/about.html")) + (li ,(link "Blog" "/index.html")) + (li ,(link "Projects" "/projects.html")))) + ,body + (footer (@ (class "text-center")) + (p (@ (class "copyright")) + "© 2020 David Thompson" + ,%cc-by-sa-button) + (p "The text and images on this site are +free culture works available under the " ,%cc-by-sa-link " license.") + (p "This website is built with " + (a (@ (href "https://dthompson.us/projects/haunt.html")) + "Haunt") + ", a static site generator written in " + (a (@ (href "https://gnu.org/software/guile")) + "Guile Scheme") + ".")))))) + #:post-template + (lambda (post) + `((h1 (@ (class "title")),(post-ref post 'title)) + (div (@ (class "date")) + ,(date->string (post-date post) + "~B ~d, ~Y")) + (div (@ (class "post")) + ,(post-sxml post)))) + #:collection-template + (lambda (site title posts prefix) + (define (post-uri post) + (string-append "/" (or prefix "") + (site-post-slug site post) ".html")) + + `((h1 ,title + (a (@ (href "/feed.xml")) + (img (@ (src "images/feed.png"))))) + ,(map (lambda (post) + (let ((uri (string-append "/" + (site-post-slug site post) + ".html"))) + `(div (@ (class "summary")) + (h2 (a (@ (href ,uri)) + ,(post-ref post 'title))) + (div (@ (class "date")) + ,(date->string (post-date post) + "~B ~d, ~Y")) + (div (@ (class "post")) + ,(first-paragraph post)) + (a (@ (href ,uri)) "read more ➔")))) + posts))))) + +(define (static-page title file-name body) + (lambda (site posts) + (make-page file-name + (with-layout dthompson-theme site title body) + sxml->html))) + +(define* (project-page #:key name file-name description usage requirements + installation manual? license repo releases guix-package) + (define (tarball-url version) + (string-append "https://files.dthompson.us/" + repo "/" repo "-" version + ".tar.gz")) + (define body + `((h1 ,name) + ,description + ,@(if usage + `((h2 "Usage") + ,usage) + '()) + ,@(if manual? + `((h2 "Documentation") + (p ,(anchor "View the reference manual" + (string-append "/manuals/" repo "/index.html")))) + '()) + (h2 "Releases") + (ul ,(map (match-lambda + ((version date) + (let ((url (tarball-url version))) + `(li ,(date->string date "~Y-~m-~d") + " — " ,version " — " + ,(anchor (string-append repo "-" version ".tar.gz") + url) + " — " + ,(anchor "GPG signature" + (string-append url ".asc")))))) + releases)) + (h2 "Requirements") + (ul ,(map (lambda (requirement) + `(li ,requirement)) + requirements)) + (h2 "Installation") + ,@(if installation + (list installation) + (match (car releases) + ((version _) + `(,@(if guix-package + `((p "To install " ,name " with the GNU Guix package manager, run:") + (pre "guix install " ,guix-package)) + '()) + (p "To build and install " ,name " from source, run:") + (pre "wget " + ,(tarball-url version) + " +tar xf " + ,repo "-" ,version ".tar.gz" + " +cd " + ,repo "-" ,version + " +./configure +make +make install"))))) + (h2 "License") + (p ,license) + (h2 "Git Repository") + ,@(let ((url (string-append "https://git.dthompson.us/" repo ".git"))) + `((p ,name " is developed using the Git version control +system. The official repository is hosted at " + ,(anchor url url) ".") + (p "To clone the repository, run:") + (pre "git clone " ,url))) + (h2 "Community") + (p "Real-time discussion for " ,name " can be found on the " + (code "#guile") + " channel on the Freenode IRC network.") + (h2 "Contributing") + (p "Send patches and bug reports to " + ,(anchor "davet@gnu.org" "mailto:davet@gnu.org") + "."))) + + (static-page name (string-append "projects/" file-name) body)) diff --git a/utils.scm b/utils.scm new file mode 100644 index 0000000..7b64cdc --- /dev/null +++ b/utils.scm @@ -0,0 +1,51 @@ +;;; Copyright © 2018-2021 David Thompson <davet@gnu.org> +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define-module (utils) + #:use-module (ice-9 rdelim) + #:use-module (srfi srfi-19) + #:export (date + stylesheet + anchor + link + centered-image + raw-snippet) + #:replace (link)) + +(define (date year month day) + "Create a SRFI-19 date for the given YEAR, MONTH, DAY" + (let ((tzoffset (tm:gmtoff (localtime (time-second (current-time)))))) + (make-date 0 0 0 0 day month year tzoffset))) + +(define (stylesheet name) + `(link (@ (rel "stylesheet") + (href ,(string-append "/css/" name ".css"))))) + +(define* (anchor content #:optional (uri content)) + `(a (@ (href ,uri)) ,content)) + +(define (link name uri) + `(a (@ (href ,uri)) ,name)) + +(define* (centered-image url #:optional alt) + `(img (@ (class "centered-image") + (src ,url) + ,@(if alt + `((alt ,alt)) + '())))) + +(define (raw-snippet code) + `(pre (code ,(if (string? code) code (read-string code))))) |