summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcolin <colin@cicadas.surf>2023-04-08 12:13:32 -0700
committercolin <colin@cicadas.surf>2023-04-08 12:13:32 -0700
commit6183e4448eda7416e63436e0614c781260c68654 (patch)
treeeb1aa321ef02ae55badd14240a1e196654e2422a
parente217ceafff5766ba06dfa16aa80ae615c4537109 (diff)
altered .gitignore; added preview files
-rw-r--r--.gitignore6
-rw-r--r--files/bandleader.py271
-rw-r--r--files/conway.cpp95
-rw-r--r--files/fussy.lisp608
4 files changed, 976 insertions, 4 deletions
diff --git a/.gitignore b/.gitignore
index eb4c89a..ef59b22 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,4 @@
*~
*svg
-files/*
-files/*/*
-files/*/*/*
-files/*/*/*/* \ No newline at end of file
+files/themes/*
+files/store/*
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))))))))