From 1be7a027f676a0499aa79c3773e07af29fd3bda3 Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Thu, 6 Apr 2023 08:54:59 -0700
Subject: Added theme page

---
 fussy.lisp | 104 ++++++++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 68 insertions(+), 36 deletions(-)

(limited to 'fussy.lisp')

diff --git a/fussy.lisp b/fussy.lisp
index b81f320..3bc87f7 100644
--- a/fussy.lisp
+++ b/fussy.lisp
@@ -200,7 +200,7 @@ returns a list of those names."
 
 (defgeneric url-path (theme))
 (defmethod url-path ((theme theme-pkg))
-  (format nil "/theme/~a" (string-downcase (theme-pkg-name theme))))
+  (format nil "/package/~a" (string-downcase (theme-pkg-name theme))))
 (defmethod url-path ((theme string))
   (assert (theme-p theme))
   (format nil "/theme/~a/~a"
@@ -303,6 +303,7 @@ that they are not loaded during image gen.")
           theme
           (or variant (pathname-name (first (image-files-for-theme theme))))))
 
+
 (defun start (&key config-file)
   (unless config-file
     (setf config-file
@@ -334,9 +335,6 @@ that they are not loaded during image gen.")
   (parse-integer string))
 
 
-
-
-
 (defparameter +themes-per-page+ 21)
 
 (defun page-nav (page page-count)
@@ -350,13 +348,17 @@ that they are not loaded during image gen.")
                      (format nil "~a" (1+ pg)))
                  " "))))))
 
+(defun theme-preview-image (theme &optional variant)
+  (html:with-html 
+    (:img
+     :class "preview"
+     :src (theme-preview-image-path theme variant))))
+
 (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)))))
+          (theme-preview-image theme))))
 
 (defun style ()
   (html:with-html
@@ -432,7 +434,6 @@ nav {
 h1 {
   text-align: center;
 }
-
 ")
 
 (lzb:defendpoint* :get "/css/style.css" () ()
@@ -482,34 +483,65 @@ h1 {
                     (dolist (theme themes)
                       (theme-preview-card theme)))))))))
 
+(defun a-package (string)
+  (a:if-let (pkg
+             (theme-pkg-with-name
+              (intern (string-upcase string) :fussy)))
+    pkg
+    (lzb:http-err 404 (format nil "No such theme package: ~a" string))))
+
+(defun a-theme (string)
+  (if (theme-p string) string
+      (lzb:http-err 404 (format nil "No such theme: ~a" string))))
 
+(defun package-namestring (pkg)
+  (hq:>> () pkg theme-pkg-name symbol-name string-downcase))
 
-(lzb:defendpoint* :get "/package/:package:" () ()
+(lzb:defendpoint* :get "/package/:pkg a-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")))
+  (let ((themes
+          (themes-in-package pkg)))
+    (html:with-html-string
+      (:doctype)
+      (:html
+       (:head
+        (:title )
+        (style))
+       (:body
+        (:div :class "main"
+              (:h1 (package-namestring pkg) )
+              (: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:defendpoint* :get "/theme/:pkg a-package:/:theme a-theme:" () ()
+  "The page for a particular theme showing its previews for different prog langs"
+  (unless (member theme (themes-in-package pkg) :test #'string-equal)
+    (lzb:http-err 403 (format nil "The theme ~a is not in the package ~a" 
+                              theme (package-namestring pkg))))
+  (html:with-html-string
+    (:doctype)
+    (:html
+     (:head
+      (:title theme)
+      (style))
+     (:body
+      (:div :class "main"
+            (:h1 theme)
+            (:div
+             (:p "A theme in the package "
+                 (:a :href (url-path pkg) (package-namestring pkg))))
+            (:div :class "container"
+                  (dolist (variant (mapcar #'pathname-name (image-files-for-theme theme)))
+                    (theme-preview-image theme variant))))))))
-- 
cgit v1.2.3