diff options
Diffstat (limited to 'fussy.lisp')
| -rw-r--r-- | fussy.lisp | 245 |
1 files changed, 224 insertions, 21 deletions
@@ -159,7 +159,6 @@ differs from the theme-pkg instance already in the data store." ;; directory-namestring is taken, seems to peel off any file at the end (first (last (pathname-directory path)))) - (defun themes-in-package (pkg &optional (config *config*)) "Themes that belong to a particular package are stored as the names of directories that contain the theme's images. These directories are @@ -199,6 +198,16 @@ returns a list of those names." (setf (gethash theme table) pkg))) (setf *theme->packages* table))) +(defgeneric url-path (theme)) +(defmethod url-path ((theme theme-pkg)) + (format nil "/theme/~a" (string-downcase (theme-pkg-name theme)))) +(defmethod url-path ((theme string)) + (assert (theme-p theme)) + (format nil "/theme/~a/~a" + (string-downcase (theme-pkg-name (theme-package theme))) + theme)) + +(defun theme-p (string) (not (null (theme-package string))) ) (defclass/std config () ((theme-image-directory @@ -278,35 +287,229 @@ that they are not loaded during image gen.") (uiop:run-program (format-emacs-evocation-script package-names)))) -(defvar *server* - (lzb:create-server)) - - - -(lzb:defendpoint* :get "/hello" () () - "what in the fuck? is fucking hjappening?") - - (lzb:provision-app () - :title "Emacs Themes Library" - :content-type "text/html") +(defvar *server* nil) +(defun image-files-for-theme (theme) + (uiop:directory-files + (format nil "~a/~a/~a/" + (full-theme-image-directory) + (string-downcase (theme-pkg-name (theme-package theme))) + theme))) +(defun theme-preview-image-path (theme &optional variant) + (assert (theme-p theme)) + (format nil "/images/~a/~a/~a.svg" + (string-downcase (theme-pkg-name (theme-package theme))) + theme + (or variant (pathname-name (first (image-files-for-theme theme)))))) (defun start (&key config-file) (unless config-file (setf config-file (or (uiop:getenv "FUSSY_CONFIG") (asdf:system-relative-pathname :fussy "config.sexp")))) - (setf *config* - (load-config-from-file config-file) - *config-directory* - (uiop:pathname-directory-pathname config-file)) - (setf *server* - (lzb:create-server - :port (port *config*) - :address (address *config*) - :domain (domain *config*))) + (unless *config* + (setf *config* + (load-config-from-file config-file) + *config-directory* + (uiop:pathname-directory-pathname config-file))) + (unless *server* + (setf *server* + (lzb:create-server + :port (port *config*) + :address (address *config*) + :domain (domain *config*)))) (create-db) (update-theme-packages) (lzb:install-app *server* (lzb:app)) (lzb:start-server *server*)) + +(lzb:provision-app () + :title "Emacs Themes Library" + :content-type "text/html") + +;;; pages + +(defun an-integer (string) + (parse-integer string)) + + + + + +(defparameter +themes-per-page+ 21) + +(defun page-nav (page page-count) + (html:with-html + (:nav + (dotimes (pg (ceiling (/ page-count +themes-per-page+))) + (if (= pg page) + (:span (format nil " ~a " (1+ pg))) + (:span " " + (:a :href (format nil "/?page=~a" pg) + (format nil "~a" (1+ pg))) + " ")))))) + +(defun theme-preview-card (theme) + (html:with-html + (:div :class "card" + (:a :href (url-path theme) (:h4 theme)) + (:img + :class "preview" + :src (theme-preview-image-path theme))))) + +(defun style () + (html:with-html + (:link :rel "stylesheet" :type "text/css" :href "/css/style.css"))) + +(defparameter +css-reset+ + " +html { + box-sizing: border-box; + font-size: 16px; +} + +*, *:before, *:after { + box-sizing: inherit; +} + +body, h1, h2, h3, h4, h5, h6, p, ol, ul { + margin: 0; + padding: 0; + font-weight: normal; +} + +ol, ul { + list-style: none; +} + +img { + max-width: 100%; + height: auto; +} + +") + + +(defparameter +style-css+ + " +.main { + width: 100%; + background-color: #eeeeff; +} + +.preview { + max-width: 400px; +} + +.container { + width: 100%; + display: flex; + flex-wrap: wrap; + justify-content: space-evenly; +} + +.card { + padding: 10px; +} + +.card > a > h4 { + color: green; + text-align: center; +} + +.center { + text-align: center; +} + +nav { + margin-left: auto; + margin-right: auto; + width: 60%; + font-size: 1.3em; +} + +h1 { + text-align: center; +} + +") + +(lzb:defendpoint* :get "/css/style.css" () () + "Endpoint generating and serving main css" + (setf (lzb:response-header :content-type) "text/css") + (concatenate 'string + +css-reset+ + '(#\newline) + +style-css+)) + +(lzb:defendpoint* :get "/images/:pkg:/:theme:/:image:" () () + "Endpoint for serving theme preview images" + (let ((file-path + (pathname + (format nil "~a/~a/~a/~a" + (full-theme-image-directory) + pkg + theme + image)))) + (unless (uiop:file-exists-p file-path) + (lzb:http-err 404 "no such file")) + file-path)) + +(lzb:defendpoint* :get "/" ((page an-integer)) () + "The landing page" + (let* ((page + (or page 0)) + (all-themes + (all-themes)) + (themes + (a:subseq* all-themes + (* page +themes-per-page+) + (* (1+ page) +themes-per-page+)))) + (html:with-html-string + (:doctype) + (:html + (:head + (:title "Fussy - Emacs Themes Gallery") + (style)) + (:body + (:div :class "main" + (:h1 "FUSSY") + (:p :class "center" + "Emacs Themes Gallery for your Daily Procrastination Needs") + (page-nav page (length all-themes)) + (:div :class "container" + (dolist (theme themes) + (theme-preview-card theme))))))))) + + + +(lzb:defendpoint* :get "/package/:package:" () () + "The page endpoint for a theme package" + (a:if-let (pkg + (theme-pkg-with-name + (intern (string-upcase package) :fussy))) + (let ((themes + (themes-in-package pkg))) + (html:with-html-string + (:doctype) + (:html + (:head + (:title package) + (style)) + (:body + (:div :class "main" + (:h1 package) + (:div :class "info" + (:dl + (:dt "Description") + (:dd (theme-pkg-description pkg)) + (:dt "URL") + (:dd (:a :href (theme-pkg-url pkg) + (theme-pkg-url pkg))) + (:dt "Number of Themes") + (:dd (length themes)))) + (:div :class "container" + (dolist (theme themes) + (theme-preview-card theme)))))))) + (lzb:http-err 404 "No such theme"))) |