From 6183e4448eda7416e63436e0614c781260c68654 Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Sat, 8 Apr 2023 12:13:32 -0700
Subject: altered .gitignore; added preview files

---
 files/bandleader.py | 271 +++++++++++++++++++++++
 files/conway.cpp    |  95 ++++++++
 files/fussy.lisp    | 608 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 974 insertions(+)
 create mode 100644 files/bandleader.py
 create mode 100644 files/conway.cpp
 create mode 100644 files/fussy.lisp

(limited to 'files')

diff --git a/files/bandleader.py b/files/bandleader.py
new file mode 100644
index 0000000..16e167d
--- /dev/null
+++ b/files/bandleader.py
@@ -0,0 +1,271 @@
+from selenium.webdriver import Firefox
+from selenium.webdriver.firefox.options import Options
+from collections import namedtuple, Counter
+from threading import Thread
+from time import sleep, ctime
+from os.path import isfile
+import csv
+
+
+BANDCAMP_FRONTPAGE='https://bandcamp.com/'
+
+TrackRec = namedtuple('TrackRec',
+                     ['track_url', # if available
+                      'title', 
+                      'artist',
+                      'artist_url', 
+                      'album',
+                      'album_url', 
+                      'timestamp'   # when you played it
+                     ])
+                              
+class BandLeader():
+
+    def __init__(self,csvpath=None):
+        
+        self.database_path=csvpath
+        self.database = []      # using a list b/c its simple 
+        
+        # load database from disk if possible
+        if isfile(self.database_path):
+            with open(self.database_path, newline='') as dbfile:
+                dbreader = csv.reader(dbfile)
+                next(dbreader)  # to ignore the header line
+                self.database = [TrackRec._make(rec) for rec in dbreader]
+
+        # create a headless browser
+        opts = Options()
+        opts.set_headless()     
+        self.browser = Firefox(options=opts)
+        self.browser.get(BANDCAMP_FRONTPAGE)
+        self.paused = True
+        
+        self.autoplay_on = False
+        self._current_track_record = None
+        self._current_track_number = 1
+        # create a thread that periodically maintains our database by
+        # consulting the browser's current state
+        self._has_quit = False
+        self.thread = Thread(target=self._maintain)
+        self.thread.daemon = True # kills the thread when the main process dies
+        self.thread.start()
+
+        self.tracks()
+
+    def _maintain(self):
+        while not self._has_quit:
+            self._update_db()
+            self._check_auto_advance()
+            sleep(1)
+
+
+    def log(self,where, err):
+        print(where, err)
+
+
+    def save_db(self):
+        with open(self.database_path,'w',newline='') as dbfile:
+            dbwriter = csv.writer(dbfile)
+            dbwriter.writerow(list(TrackRec._fields))
+            for entry in self.database:
+                dbwriter.writerow(list(entry))
+
+
+    def _update_db(self):
+        try:
+            check = (self._current_track_record is not None
+                     and self._current_track_record is not None
+                     and (len(self.database) == 0
+                          or self.database[-1] != self._current_track_record)
+                     and self.is_playing())
+            if check:
+                self.database.append(self._current_track_record)
+                self.save_db()                
+
+        except Exception as e:
+            self.log('_update_db',e)
+
+
+    def _check_auto_advance(self):
+        try:
+            if self.autoplay_on and not self.is_playing():
+                self.play_next()
+        except Exception as e:
+            self.log('_check_auto_advance', e)
+
+
+    def toggle_autoplay(self):
+        self.autoplay_on = not self.autoplay_on
+        if self.autoplay_on:
+            print('autoplay is ON')
+        else:
+            print('autoplay is OFF')
+
+
+    def currently_playing(self):
+        '''
+        returns the record for the currently playing track,
+        or None if nothing is playing
+        '''
+        try:
+            if self.is_playing():
+                track_title = self.browser.find_element_by_class_name('title').text
+                album_detail = self.browser.find_element_by_css_selector('.detail-album > a')
+                album_title = album_detail.text
+                album_url = album_detail.get_attribute('href').split('?')[0]
+                artist_detail = self.browser.find_element_by_css_selector('.detail-artist > a')
+                artist = artist_detail.text
+                artist_url = artist_detail.get_attribute('href').split('?')[0]
+                return TrackRec('',track_title,artist,artist_url,album_title,album_url,ctime())
+        except Exception as e:
+            print('there was an error: {}'.format(e))
+            
+        return None
+
+
+    def tracks(self):
+        '''
+        lists the tracks that are presently available for play and
+        associates a track number with each one.  You may use these
+        track numbers to as arguments to the `play` method.
+        '''
+        sleep(1)
+        discover_section = self.browser.find_element_by_class_name('discover-results')
+        left_x = discover_section.location['x']
+        right_x = left_x + discover_section.size['width']
+
+        discover_items = self.browser.find_elements_by_class_name('discover-item')
+        self.track_list = [t for t in discover_items
+                           if t.location['x'] >= left_x and t.location['x'] < right_x]
+        
+        for (i,track) in enumerate(self.track_list):
+            print('[{}]'.format(i+1))
+            lines = track.text.split('\n')
+            print('Album  : {}'.format(lines[0]))
+            print('Artist : {}'.format(lines[1]))
+            if len(lines) > 2:
+                print('Genre  : {}'.format(lines[2]))
+        
+        
+    def play(self,track=None):
+        '''
+        plays a track.  If `track` is not supplied, this method 
+        simulates pressing the play button somewhere on bandcamp's site.
+
+        If `track` is an `int`, this method plays the track with that 
+        track number.  See the `tracks` method.
+        '''
+
+        if track is None:
+            self.browser.find_element_by_class_name('playbutton').click()
+        elif type(track) is int and track <= len(self.track_list) and track >= 1:
+            self._current_track_number = track
+            self.track_list[self._current_track_number - 1].click()
+
+        sleep(0.5)
+        if self.is_playing():
+            self._current_track_record = self.currently_playing()
+            print("CURRENTLY PLAYING")
+            self.print_track()
+
+    def pause(self):
+        self.play()
+        self.paused = True
+
+
+    def resume(self):
+        if self.paused:
+            self.play()
+            self.paused = False
+        
+            
+    def is_playing(self):
+        '''
+        returns `True` if a track is presently playing
+        '''
+        playbtn = self.browser.find_element_by_class_name('playbutton')
+        return playbtn.get_attribute('class').find('playing') > -1
+
+        
+    def play_next(self):
+        '''
+        plays the next available track
+        '''
+        if self._current_track_number < len(self.track_list):
+            self.play(self._current_track_number+1)
+        else:
+            self.more_tracks()
+            self.play(1)
+
+
+    def play_prev(self):
+        '''
+        plays the previous available track
+        '''
+        if (self._current_track_number - 1) >= 0:
+            self.play(self._current_track_number -1)
+
+
+    def top_tracks(self,num=10):
+        '''
+        lists the top `num` tracks in order of frequency of listening
+        '''
+        c = Counter(t.title for t in self.database)
+        return c.most_common(num)
+
+    def top_albums(self,num=10):
+        c = Counter(t.album for t in self.database)
+        return c.most_common(num)
+
+    def top_artists(self,num=10):
+        c = Counter(t.artist for t in self.database)
+        return c.most_common(num)
+
+    def catalogue_pages(self):
+        '''
+        print the available pages in the catalogue that are presently
+        accessible
+        '''
+        print('PAGES')
+        for e in self.browser.find_elements_by_class_name('item-page'):
+            print(e.text)
+        print('')
+            
+            
+    def more_tracks(self,page='next'):
+        '''
+        finds more tracks in a contextual way.  
+
+        If on the main page, advances the listing in the 'Discover'
+        section.
+
+        If on an album page, looks to the next album in the
+        'Discography' section for the present artist.
+        '''
+        next_btn = [e for e in self.browser.find_elements_by_class_name('item-page')
+                    if e.text.lower().strip() == str(page)]
+        
+        if next_btn:
+            next_btn[0].click()
+            self.tracks()
+
+    def explore(self):
+        '''
+        visits the start page and lists tracks
+        '''
+        self.browser.get(BANDCAMP_FRONTPAGE)
+        self.tracks()
+
+
+    def quit(self):
+        self._has_quit = True
+        self.browser.close()
+        # flush db to disk
+
+    def print_track(self,tr=None):
+        if tr is None:
+            tr = self._current_track_record
+
+        if tr is not None:
+            print('{}\n by {}\n on the album {}'.format(tr.title,tr.artist,tr.album))
+            
diff --git a/files/conway.cpp b/files/conway.cpp
new file mode 100644
index 0000000..1e60014
--- /dev/null
+++ b/files/conway.cpp
@@ -0,0 +1,95 @@
+/* ======================================================================= */
+/*                                CONWAY.CPP                               */
+/* ======================================================================= */
+
+#include "assert.h"
+#include "iostream.h"
+#include "conio.h"
+#include "clheir.h"
+#include "screen.h"
+#include "conway.h"
+
+#define max(x,y)  ((x > y) ? x : y)
+#define min(x,y)  ((x > y) ? y : x)
+
+const int num_rows = min(50, NUM_ROWS);
+const int num_columns = 40;
+
+class site *field_of_play[num_rows][num_columns];
+
+int site::total_surrounding(void)
+    {
+    int i, j, imin, imax, jmin, jmax, total;
+
+    total = 0;
+    imin = max(0, x - 1);
+    imax = min(num_rows - 1, x + 1);
+    jmin = max(0, y - 1);
+    jmax = min(num_columns - 1, y + 1);
+
+    for (i = imin; i <= imax; i++)
+        for (j = jmin; j <= jmax; j++)
+            if (field_of_play[i][j]->read()) total++;
+    if (alive) total--;
+    return total;
+    }
+
+void display(void)
+    {
+    int i, j;
+
+    for (i = 0; i < num_rows; i++)
+        for (j = 0; j < num_columns; j++)
+            {
+            if (field_of_play[i][j]->read()) write_xyc(2*j, i, 'X');
+            else write_xyc(2*j, i, '.');
+            }
+    hide_cursor();
+    }
+
+void glider(int x, int y)
+    {
+    field_of_play[x - 1][y + 0]->set();
+    field_of_play[x - 1][y + 1]->set();
+    field_of_play[x + 0][y - 1]->set();
+    field_of_play[x + 0][y + 0]->set();
+    field_of_play[x + 1][y + 1]->set();
+    }
+
+void traffic_light(int x, int y)
+    {
+    field_of_play[x - 1][y]->set();
+    field_of_play[x + 0][y]->set();
+    field_of_play[x + 1][y]->set();
+    }
+
+
+void main(void)
+    {
+    int i, j, c;
+
+    init_registry();
+
+    for (i = 0; i < num_rows; i++)
+        for (j = 0; j < num_columns; j++)
+            field_of_play[i][j] = new site(i, j);
+
+start_over:
+    traffic_light(num_rows/2 - 8, num_columns/2 - 8);
+    glider(num_rows/2 + 8, num_columns/2 + 8);
+
+    clear_screen();
+    while (1)
+        {
+        display();
+        if ((c = getch()) == 'q') { clear_screen(); return; }
+        if (c == 'i')
+            {
+            for (i = 0; i < num_rows; i++)
+                for (j = 0; j < num_columns; j++)
+                    field_of_play[i][j]->clear();
+            goto start_over;
+            }
+        step_everybody();
+        }
+    }
diff --git a/files/fussy.lisp b/files/fussy.lisp
new file mode 100644
index 0000000..c7c8f84
--- /dev/null
+++ b/files/fussy.lisp
@@ -0,0 +1,608 @@
+;;;; fussy.lisp
+
+(in-package #:fussy)
+(defvar +default-emacs-package-archive+
+  "https://melpa.org/packages/archive-contents")
+
+(defun emacs-reader-readtable ()
+  "Return a readtable that will read the emacs package archive
+contents."
+  (let ((*readtable* (copy-readtable nil)))
+    (labels ((bracket-reader (stream char)
+               (declare (ignorable char))
+               (read-delimited-list #\] stream)))
+      (set-macro-character #\[ #'bracket-reader)
+      (set-macro-character #\] (get-macro-character #\) nil))
+      *readtable*)))
+
+(defun fetch-emacs-archive (&optional (archive +default-emacs-package-archive+))
+  "Fetch the package archive from ARCHIVE, a url, and read it in using
+the emacs' reader readtable."
+  ;; TODO: HANDLE HTTP ERRORS, HANDLE TIMEOUT, HANDLE READ ERRORS
+  (multiple-value-bind (stream status) (dexador:get archive :want-stream t)
+    (when (= 200 status)
+      (let* ((*package* (find-package :fussy))
+             (*readtable* (emacs-reader-readtable)))
+        (read stream)))))
+
+(defclass/std theme-pkg (db:store-object)
+  ((name
+    :with
+    :index-type bknr.indices:unique-index
+    :index-reader theme-pkg-with-name)
+   (commit
+    version
+    authors
+    maintainer
+    keywords
+    url
+    description
+    contained-themes
+    :with))
+  (:metaclass db:persistent-class)
+  (:documentation "Represents an Emacs theme package."))
+
+(defmethod print-object ((theme theme-pkg) stream)
+  (format stream "#<THEME-PKG ~a ~a>"
+          (theme-pkg-name theme)
+          (theme-pkg-version theme)))
+
+(defparameter +excludes+
+  '(tramp-theme color-theme airline-themes unobtrusive-magit-theme cycle-themes ))
+
+(defun theme-package-p (archive-object)
+  (when (consp archive-object)
+    (unless (member (first archive-object) +excludes+) 
+      (let ((name
+              (symbol-name (first archive-object)))) 
+        (or (a:ends-with-subseq "-theme" name :test #'char-equal)
+            (a:ends-with-subseq "-themes" name :test #'char-equal))))))
+
+(defun archive-theme-name (archive-pkg)
+  (first archive-pkg))
+
+(defun archive-theme-version (archive-pkg)
+  (second archive-pkg))
+
+(defun make-theme-pkg-from-archive-theme (archive-theme)
+  (destructuring-bind (name version _dontcare desc _dontcare2 meta-alist) archive-theme
+    (declare (ignore _dontcare _dontcare2))
+    (db:with-transaction ()
+      (make-instance
+       'theme-pkg
+       :name name
+       :version version
+       :description desc
+       :commit (cdr (assoc :commit meta-alist))
+       :maintainer (cdr (assoc :maintainer meta-alist))
+       :url (cdr (assoc :url meta-alist))
+       :authors (cdr (assoc :authors meta-alist))
+       :keywords (cdr (assoc :keywords meta-alist))))))
+
+(defun update-theme-pkg-from-archive-theme (pkg arch)
+  (destructuring-bind (name version _dontcare desc _dontcare2 meta-alist) arch
+    (declare (ignore _dontcare _dontcare2))
+    (db:with-transaction ()
+      (setf
+       (theme-pkg-name pkg) name
+       (theme-pkg-version pkg) version
+       (theme-pkg-description pkg) desc
+       (theme-pkg-commit pkg) (cdr (assoc :commit meta-alist))
+       (theme-pkg-maintainer pkg) (cdr (assoc :maintainer meta-alist))
+       (theme-pkg-url pkg) (cdr (assoc :url meta-alist))
+       (theme-pkg-authors pkg) (cdr (assoc :authors meta-alist))
+       (theme-pkg-keywords pkg) (cdr (assoc :keywords meta-alist))))))
+
+
+(defun process-archive-theme (archive-theme)
+  ;; ugg this is ugly. I hate it when code is all dense like this.
+  (a:if-let (pkg
+             (theme-pkg-with-name
+              (archive-theme-name archive-theme)))
+    (when (not (equalp (archive-theme-version archive-theme)
+                       (theme-pkg-version pkg)))
+      (update-theme-pkg-from-archive-theme pkg archive-theme))
+    (make-theme-pkg-from-archive-theme archive-theme)))
+
+(defun theme-needs-update-p (archive-theme)
+  "A theme should be updated if eithe it is new or if its version
+differs from the theme-pkg instance already in the data store."
+  (let ((pkg
+          (theme-pkg-with-name 
+           (archive-theme-name archive-theme))))
+    (not 
+     (and pkg
+          (equalp (archive-theme-version archive-theme)
+                  (theme-pkg-version pkg))))))
+
+(defun update-theme-packages ()
+  (let ((themes-to-update
+          (remove-if-not
+           (a:conjoin  #'theme-package-p #'theme-needs-update-p)
+           (fetch-emacs-archive))))
+    ;; just going to let this throw an error. will either introduce a
+    ;; restart-case with some restarts or something later, or will
+    ;; just catch the error in the caller of update-theme-packages
+    (when themes-to-update
+      ;; delete the temporary .emacs.d
+      (uiop:delete-directory-tree
+       (uiop:merge-pathnames* ".emacs.d/" (full-theme-image-directory))
+       :validate t
+       :if-does-not-exist :ignore)
+
+      (generate-images-for-packages
+       (mapcar #'archive-theme-name themes-to-update))
+      
+      ;; if we didn't error: update the db
+      (dolist (archive-theme themes-to-update)
+        (process-archive-theme archive-theme))
+
+      (reindex-themes-by-package))))
+
+(defun all-theme-keywords ()
+  (delete-duplicates
+   (copy-seq (mapcan (a:compose #'copy-seq #'theme-pkg-keywords)
+                     (db:store-objects-with-class 'theme-pkg)))
+   :test #'equal))
+
+(defun themes-with-keywords (&rest keywords)
+  (loop :for theme :in (db:store-objects-with-class 'theme-pkg)
+        :when (subsetp keywords (theme-pkg-keywords theme)
+                       :test #'string-equal)
+          :collect theme))
+
+(defun all-theme-packages ()
+  (db:store-objects-with-class 'theme-pkg))
+
+(defun just-the-directory-namestring (path)
+  "returns a string, the name of the directory that the path represents."
+  ;; 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
+stored beneath the directory that names the package.  This function
+returns a list of those names."
+  (mapcar #'just-the-directory-namestring
+          (uiop:subdirectories
+           (uiop:merge-pathnames*
+            (string-downcase (format nil "~a/" (theme-pkg-name pkg)))
+            (full-theme-image-directory config)))))
+
+(defun all-themes ()
+  (a:mappend #'themes-in-package (all-theme-packages)))
+
+(defun theme-mentions-anywhere (term)
+  (lambda (theme)
+    (or (search term theme)
+        (with-slots (name keywords description authors maintainer) (theme-package theme) 
+          (or (search term (symbol-name name) :test #'char-equal)
+              (search term description :test #'char-equal))))))
+
+(defun search-themes (&rest terms)
+  (remove-if-not
+   (apply #'a:conjoin (mapcar #'theme-mentions-anywhere terms))
+   (all-themes)))
+
+(defvar *theme->packages* nil
+  "A hash table indexing packages by the themes they contain.")
+
+(defun theme-package (theme) (gethash theme *theme->packages*))
+
+(defun reindex-themes-by-package ()
+  (let ((table (make-hash-table :test #'equal)))
+    (dolist (pkg (all-theme-packages))
+      (dolist (theme (themes-in-package pkg))
+        (setf (gethash theme table) pkg)))
+    (setf *theme->packages* table)))
+
+(defgeneric url-path (theme))
+(defmethod url-path ((theme theme-pkg))
+  (format nil "/package/~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
+    store-directory
+    fussy-el
+    :std ""
+    :documentation "These paths are by default equal to the config directory.")
+   (port :std 8888)
+   (domain :std "localhost")
+   (address :std "0.0.0.0")))
+
+
+(defvar *config* nil)
+(defvar *config-directory* nil
+  "The config dir is the directory where the config file is. This
+directory is used as a default directory for all relative paths
+mentioned in the config file. Any Absolute paths in the config file
+are treated as such.")
+
+(defun load-config-from-file (file)
+  (apply #'make-instance
+         'config
+         (read-from-string (a:read-file-into-string file))))
+
+(defun full-store-directory (&optional (config *config*))
+  (uiop:merge-pathnames* (store-directory config) *config-directory*))
+
+(defun full-theme-image-directory (&optional (config *config*))
+  (uiop:merge-pathnames* (theme-image-directory config) *config-directory*))
+
+(defun emacs-dot-d-directory (&optional (config *config*))
+  (uiop:merge-pathnames* ".emacs.d/" (full-theme-image-directory config)))
+
+(defun create-db ()
+  (unless (boundp 'db:*store* )
+    (ensure-directories-exist (full-store-directory))
+    (make-instance
+     'db:mp-store
+     :directory (full-store-directory)
+     :subsystems (list (make-instance 'db:store-object-subsystem)))))
+
+
+
+
+(defparameter +standard-themes+
+  '(adwaita deeper-blue dichromacy light-blue modus-operandi modus-vivendi tango-dark
+    wheatgrass manoj-dark tsdh-dark tsdh-light whiteboard
+    leuven misterioso tango wombat)
+  "these are built in themes - this list can be passed to the image
+generation script when you want to generate themes for just a single
+package - ordinarily the script generates images for all themes, but
+passing this list as the value of FUSSY-EXCLUDED-THEMES will ensure
+that they are not loaded during image gen.")
+
+
+(defun generate-elisp-to-fetch-and-exclude (package-names)
+  (let ((downcaser
+          (a:compose #'string-downcase #'symbol-name)))
+    (format nil "(setq fussy-themes-packages '(~{~a~^ ~}) fussy-excluded-themes '(~{~a~^ ~}))"
+            (mapcar downcaser package-names)
+            (mapcar downcaser +standard-themes+))))
+
+(defun fussy-elisp-script-location (&optional (config *config*))
+  (uiop:merge-pathnames* *config-directory* (fussy-el config)))
+
+(defun format-emacs-evocation-script (package-names)
+  (format
+   nil
+   "env HOME=~a emacs -q --eval ~s --load ~a"
+   (full-theme-image-directory)
+   (generate-elisp-to-fetch-and-exclude package-names)
+   (fussy-elisp-script-location)))
+
+
+(defun generate-images-for-packages (package-names)
+  (when package-names
+   (uiop:run-program
+    (format-emacs-evocation-script package-names))))
+
+(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"))))
+  (print config-file)
+  (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+ 20)
+
+(defun nav ()
+  (html:with-html
+    (:nav
+     (:a :href "/" (:h1 "FUSSY")))))
+
+(defun page-nav (page page-count &optional terms)
+  "relative pagination nav to current page."
+  (flet ((format-string (pg)
+           (if terms
+               (format nil "?page=~a&terms=~{~a~^+~}" pg terms)
+               (format nil "?page=~a" pg)))) 
+    (html:with-html 
+      (:div :class "bigger center" 
+            (:span (when (plusp page)
+                     (:a :href (format-string (1- page)) " <<---   "))
+                   " | "
+                   (when (< page (1- page-count))
+                     (:a :href (format-string (1+ page)) "   --->> "))))
+      (:div
+       :class "page-nav"
+       (dotimes (pg page-count)
+         (if (= pg page)
+             (:span (format nil "  ~a  " (1+ pg)))
+             (:span " "
+                    (:a :href (format-string pg) (format nil "~a" (1+ pg)))
+                    " ")))))))
+
+(defun theme-preview-image (theme &optional variant)
+  (html:with-html 
+    (:img
+     :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)
+              (theme-preview-image 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+
+ "
+html, body {
+  height: 100%;
+}
+
+.main {
+  height: 100%;
+  width: 100%;
+  background-color: #eeeeff;
+}
+
+.container {
+  width: 100%;
+  display: flex;
+  flex-wrap: wrap;
+  justify-content: space-evenly;
+}
+
+.card {
+  min-width: 500px;
+  max-width: 50%;
+}
+
+.card  > a > h4 {
+  color: green;
+  text-align: center;
+}
+
+.bigger {
+  font-size: 1.25em;
+}
+
+.center {
+  text-align: center;
+}
+
+.search {
+  margin-left: auto;
+  margin-right: auto;
+  width: 300px;
+}
+
+h1 {
+  text-align: center;
+}
+
+.header {
+  padding-top: 20px;
+  padding-bottom: 20px;
+  margin-top: 20px;
+  margin-bottom: 40px;
+}
+
+.page-nav {
+  text-align: center;
+  font-size: 1.3em;
+  margin-top: 10px;
+  margin-bottom: 20px;
+}
+
+
+")
+
+(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))
+
+(defun a-string (s) s)
+
+(lzb:defendpoint* :get "/" ((page an-integer) (terms a-string)) ()
+  "The landing page"
+  (let* ((page
+           (or page 0))
+         (terms
+           (when terms (str:split-omit-nulls #\space terms)))
+         (all-themes
+           (if terms
+               (apply #'search-themes terms)
+               (all-themes)))
+         (page-count
+           (ceiling (/ (length all-themes) +themes-per-page+)))
+         (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"
+              (nav)
+              (:div :class "center header"
+                     (:p
+                      "Emacs Themes Gallery for your Daily Procrastination Needs." (:br)
+                      (write-to-string (length all-themes)) " themes and counting..."))
+              (:div :class "search"
+               (:form :method "GET" :action "/"
+                      (:label :for "terms")
+                      (:input :name "terms" :value (format nil "~{~a ~}" terms))
+                      (:button :type "submit" "search")))
+              (when (< 1 page-count)
+                (page-nav page page-count terms))
+              (:div :class "container"
+                    (dolist (theme themes)
+                      (theme-preview-card theme)))
+              (:div :class "foooter"
+                    (when (< 1 page-count)
+                      (page-nav page page-count terms)))))))))
+
+(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/:pkg a-package:" ((page an-integer)) ()
+  "The page endpoint for a theme package"
+  (let ((themes
+          (themes-in-package pkg))
+        (page
+          (or page 0)))
+    (html:with-html-string
+      (:doctype)
+      (:html
+       (:head
+        (:title )
+        (style))
+       (:body
+        (:div :class "main"
+              (nav)
+              (:div :class "center header"
+                    (:h2 (package-namestring pkg) )
+                    (:p (theme-pkg-description pkg))
+                    (:p "This package contains"
+                        (length themes)
+                        (if (= 1 (length themes)) " theme" " themes"))
+                    (:p (:a :href (theme-pkg-url pkg)
+                            (theme-pkg-url pkg))))
+              (when (< +themes-per-page+ (length themes))
+                (page-nav page (floor (/ (length themes) +themes-per-page+))))
+              (:div :class "container"
+                    (dolist (theme (a:subseq* themes
+                                              (* page +themes-per-page+)
+                                              (* (1+ page) +themes-per-page+)))
+                      (theme-preview-card theme)))
+              (when (< +themes-per-page+ (length themes))
+                (page-nav page (floor (/ (length themes) +themes-per-page+))))))))))
+
+(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"
+            (nav)
+            (:div :class "center header"
+             (:h2 theme)
+             (: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