(defvar *photogal/photoreel* nil) (defvar *photogal/tags* '( ("e" . (name "spokane" ;; pg will not display parent ("L" . (name "Location")))) ;; differences in the ("n" . (name "new-york" ;; names of tag parent ("L" . (name "Locution")))) ;; parents. they will be ("e" . (name "emma-chamberlain" ;; considered the same. parent ("C" . (name "Celebrity")))) ("x" . (name "lil-nas-x" parent ("C" . (name "Celebrity")))) ("a" . (name "art")) ("c" . (name "cityscape")) ("f" . (name "family")) ("g" . (name "good")) ("h" . (name "screenshot")) ("l" . (name "politics")) ("m" . (name "meme")) ("o" . (name "computer")) ("p" . (name "portrait")) ("r" . (name "reaction-photo")) ("t" . (name "photography")) ("s" . (name "selfie")))) (define-derived-mode photogal-mode text-mode "photogal" "Major mode for grouping and labeling images.") (defun photogal-create-photo-roll (photo-dir) (defun photogalroll--all-photos (directory) "Give me a list of all the photos in my operating directory." (directory-files directory t directory-files-no-dot-files-regexp)) (defun photogalroll--generate (destination-dir) (mapcar (apply-partially #'photogalroll--make-photo-entry destination-dir) (photogalroll--all-photos photo-dir))) (let ((destination-dir (concat photo-dir "-photogal")) (idx 0)) (mapcar (lambda (photo) (photogal--set-index photo (cl-incf idx))) (photogalroll--generate destination-dir)) )) (defun photogal-current-file (photoreel) "What is the file currently being operated on?" (car photoreel)) (defun photogal-advance-file (photoreel) "Move forward by one photo." (append (cdr photoreel) (list (car photoreel)))) (defun photogal-rewind-file (photoreel) "Reverse by one photo." (append (last photoreel) (butlast photoreel))) (defun photogal3 (photo-dir) (interactive (list (read-directory-name "where are ur photos? " photogal-default-directory))) (setq *photogal/photoreel* (photogal-create-photo-roll photo-dir)) (photogal-render *photogal/photoreel*)) (defun photogal-render (photoreel) (photogal-draw-buffer photoreel "photogal3" (photogal-top-level-tags) ) ) ;; // PHOTO DATAOBJECT \\ ;; (defun photogalroll--make-photo-entry (destination-dir filepath) `(filepath ,filepath tags ,nil name ,nil folders ,(list destination-dir) copy-to-dir ,nil index ,-1 )) (defun photogal--get-filepath (photo) (plist-get photo 'filepath)) (defun photogal--get-tags (photo) "What are all the tags for this file?" (plist-get photo 'tags)) (defun photogal--set-tags (photo tags) (plist-put photo 'tags tags)) (defun photogal--get-folders (photo) "What are all the folders for this file?" (plist-get photo 'folders)) (defun photogal--set-folders (photo folders) (plist-put photo 'folders folders)) (defun photogal--get-index (photo) (plist-get photo 'index)) (defun photogal--set-index (photo index) (plist-put photo 'index index)) (defun photogal--get-copy-to-dir? (photo) (plist-get photo 'copy-to-dir)) (defun photogal--set-copy-to-dir? (photo copy-to-dir) (plist-put photo 'copy-to-dir copy-to-dir)) ;; \\ // ;; (defun photogal-draw-buffer (photoreel buffer tags) (defun photogaldraw-index-tracker (photoreel) (let* ((current-file (photogal-current-file photoreel)) (current-index (photogal--get-index current-file)) (total-photos (length photoreel))) (insert " ur lookin at photo ") (photogal--insert-print-color current-index "red") (insert " of ") (photogal--insert-print-color total-photos "red"))) (defun photogaldraw--commit-message (photo) (if (photogal--get-copy-to-dir? photo) (progn (insert "\t\t\t\t will commit?: ") (photogal--insert-print-color "✓" "SeaGreen3")) (progn (insert "\t\t\t\t will commit?: ") (photogal--insert-print-color "✗" "red")))) (defun photogaldraw--insert-image (filepath) (insert " ") (insert-image (if resize-image (create-image filepath 'imagemagick nil :width (- (window-pixel-width) 75)) (create-image filepath 'imagemagick nil :height (/ (window-pixel-height) 2))))) (defun photogaldraw--newline () (insert "\n")) (defun photogal--pprint-key-command (key-to-type name-of-command padding &optional activated) "Make the low-level insertions to the buffer to render a key-command." (let ((length-of-unit (+ (length key-to-type) (length name-of-command) 3))) (when (> (+ (+ (current-column) length-of-unit) 10) (window-width)) (insert "\n")) (insert "[") (if activated (photogal--insert-print-color key-to-type "SeaGreen3") (photogal--insert-print-color key-to-type "dark gray")) (insert "] ") (photogal--insert-print-color name-of-command "blue" (- padding (length key-to-type))) (insert " "))) (defun photogaldraw--insert-tags (tags photo) (photogal--insert-print-color "Tag:\n" "red") (mapcar (lambda (tag) (let* ((key-command (photogal-tag-key tag)) (tag-name (photogal-tag-name tag)) (activated (photogal-file-has-tag? photo tag-name))) (photogal--pprint-key-command key-command tag-name 16 activated))) ;;(seq-sort (lambda (t1 t2) (string< (car t1) (car t2))) tags) tags ) ) (defun photogal--insert-print-color (string-to-insert-to-buffer color &optional padding) "Insert some text in this color." (let ((beg (point)) (padding (if padding (format "%s" padding) "0"))) (insert (format (concat "%-" padding "s") string-to-insert-to-buffer)) (put-text-property beg (point) 'font-lock-face `(:foreground ,color)))) (let* ((current-photo (photogal-current-file photoreel)) (resize-image nil) (photo-file-path (photogal--get-filepath current-photo)) (buf (get-buffer-create buffer))) (with-current-buffer buf (photogal-mode) (erase-buffer) (photogaldraw-index-tracker photoreel) (photogaldraw--commit-message current-photo) (photogaldraw--newline) (photogaldraw--insert-image (photogal--get-filepath current-photo)) (photogaldraw--newline) (photogaldraw--insert-tags tags current-photo) (switch-to-buffer buf)) ) ) (defun photogal-file-has-tag? (tag _) t) (defvar key-commands '( ;; ("G" . photogal-refresh-buffer) ;; ("RET" . photogal-next-file) ;; ("" . photogal-next-file) ("SPC" . photogal-next-file) ;; ("C-p" . photogal-prev-file) ;; ("" . photogal-prev-file) ;; ("C-a" . photogal-add-tag) ;; ("C-d" . photogal-delete-tag) ;; ("C-f" . photogal-show-filepath) ;; ("C-r" . photogal-resize-photo) ;; ("C-c" . photogal-compile-and-commit) ;; ("C-n" . photogal-name-the-file) ;; ("C-o" . photogal-give-a-folder) )) (defun photogal-next-file () (interactive) (setq *photogal/photoreel* (photogal-advance-file *photogal/photoreel*)) (photogal-render *photogal/photoreel*) ) (defvar photogal-mode-map nil "Keymap for `photogal-mode`") (progn (setq photogal-mode-map (make-sparse-keymap)) (map-do (lambda (key command) (eval `(define-key photogal-mode-map (kbd ,key) ',command))) key-commands)) ;; // tag shit (defun photogal-all-parents (tags) (seq-filter (lambda (x) x) (seq-uniq (mapcar (lambda (tag) (plist-get (cdr tag) 'parent)) tags) (lambda (a b) (string= (car a) (car b)))))) (defun photogal-tags-with-no-parents (tags) (seq-remove (lambda (tag) (plist-member (cdr tag) 'parent)) tags)) (defun photogal-top-level-tags () (append (photogal-all-parents *photogal/tags*) (photogal-tags-with-no-parents *photogal/tags*))) (defun photogal-tag-name (tag) (plist-get (cdr tag) 'name)) (defun photogal-tag-key (tag) (car tag))