added some style

1 files changed, 224 insertions, 21 deletions

diff --git a/fussy.lisp b/fussy.lisp
index 10c5612..b81f320 100644
--- a/fussy.lisp
+++ b/fussy.lisp
@@ -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")))