photogal/photogal3.el

(defvar *photogal/photoreel* nil)
(defvar *photogal/tags*
  '(
    ("e" . (name "spokane"                           ;; phg 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"))))

(defcustom photogal-default-directory "/Users/jwd/bench/photos/"
  "This is where photogal will look for photos.")


(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* *photogal/tags*))

(defun photogal-render (photoreel tags)
  (photogal-draw-buffer photoreel "photogal3" tags))

(defun photogal-refresh ()
  (photogal-render *photogal/photoreel* *photogal/tags*))

(defun photogal-tag-current-photo (tag)
  (photogaltag-toggle tag (photogal-current-file *photogal/photoreel*)))


(defun photogaltag-tags= (tag1 tag2)
  ;; tags are equal ONLY when their keys are the same
  (string= (photogal-tag-key tag1) (photogal-tag-key tag2)))

(defun photogaltag-tags< (tag1 tag2)
  (string< (photogal-tag-key tag1) (photogal-tag-key tag2)))

(defun photogaltag-is-parent (tag)
  ;; 91 is '[', right after 'Z' in the ascii table
  (< (string-to-char (photogal-tag-key tag))
     91))

(defun photogaltag-is-parent-or-child (mytag)
  (or (photogaltag-is-parent mytag)
      (photogal-tag-parent mytag)))

(defun photogaltag-add-tag (tag photo)
  (let ((tags (photogal--get-tags photo)))
    (photogal--set-tags
     photo
     (seq-sort #'photogaltag-tags<
	       (seq-uniq (cons tag tags) #'photogaltag-tags=)))))

(defun photogaltag-rm-tag (tag photo)
  (photogal--set-tags
   photo
   (seq-remove (apply-partially #'photogaltag-tags= tag)
	       (photogal--get-tags photo))))

(defun photogaltag-has-tag-p (tag photo)
  (seq-contains-p (photogal--get-tags photo)
		  tag
		  #'photogaltag-tags=))

(defun collapse-tag (tag)
	 (let* ((parent (photogal-tag-parent tag))
		(parent-key (photogal-tag-key parent))
		(parent-name (photogal-tag-name parent))
		(child-name (photogal-tag-name tag))
		(child-key (photogal-tag-key tag)))
	   (list child-key 'name (concat child-name parent-name))))

(defun photogaltag-toggle (tag photo)
  "If a photo has the tag, remove it. If it doesn't have it, add it."

  (if (photogaltag-has-tag-p tag photo)
      (photogaltag-rm-tag tag photo)
    (photogaltag-add-tag tag photo)))

;; //	  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-engage-keys-for-tags (tags)
  (mapcar (lambda (tag)
	    (let ((key (photogal-tag-key tag)))
	      (eval `(define-key photogal3-mode-map (kbd ,key)
		       (lambda () (interactive)
			 (photogal-tag-current-photo ',tag)
			 (photogal-refresh))))
	      ))
	  tags))

(defun photogal-engage-keys-for-parents (parent-tags)
  (mapcar (lambda (tag)
	    (let ((key (photogal-tag-key tag)))
	      (eval `(define-key photogal3-mode-map (kbd ,key)
		       (lambda () (interactive)
			 (photogal-tag-family ',tag)
			 ;; (photogal-refresh)
			 )))
	      ))
	  parent-tags))

(defun photogal-tag-family (parent-tag)
  (photogal-render
   *photogal/photoreel*
   (mapcar #'collapse-tag
    (photogal-child-tags-belonging-to parent-tag *photogal/tags*))))


;; //////////////// |||||||||||||||| //////////////// ;;
;;  ^^^^ ^^^^ ^^^^     work zone     ^^^^ ^^^^ ^^^^



(defun photogaldraw-activate-key-commands (active-tags)

  (photogal-engage-keys-for-tags (photogal-tags-with-no-parents active-tags))

  (photogal-engage-keys-for-parents (photogal-all-parents *photogal/tags*))

  (mapcar (lambda (key-command)
	    (let ((key (car key-command))
		  (function (cadr key-command))
		  (info-message (caddr key-command))
		  (display (cadddr key-command)))
	      (eval
	       `(define-key photogal3-mode-map (kbd ,key)
		  (lambda () (interactive)
		    (message ,info-message)
		    (funcall #',function))))))
	  key-commands)
  )

(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--insert-photo-tags (photo)
  (photogaldraw--newline)
  (photogaldraw--newline)
  (insert "Current tags: ")
  (insert (format "%s"
		  (mapcar #'photogal-tag-name (photogal--get-tags photo))))
  (photogaldraw--newline))

(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 (photogaltag-has-tag-p tag photo)))
	      (photogal--pprint-key-command key-command tag-name 16 activated)))
	  tags))

(defun photogaldraw--insert-commands-to-buffer (commands)
  "Pretty print the commands with their invoke key."
  (photogaldraw--newline)
  (photogaldraw--newline)
  (photogal--insert-print-color "Commands:" "red")
  (photogaldraw--newline)
  (mapcar (lambda (command)
	    (let ((key-command (car command))
		  (display-copy (caddr command)))
	      (when display-copy ;; only show command if it has description
		(photogal--pprint-key-command key-command display-copy 16))))
	  commands))

(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 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))))



(defun photogal-draw-buffer (photoreel buffer tags)
  (let* ((current-photo (photogal-current-file photoreel))
	 (resize-image nil)
	 (photo-file-path (photogal--get-filepath current-photo))
	 (buf (get-buffer-create buffer))
	 (display-tags (photogal-top-level-tags tags)))
    (with-current-buffer buf
      (photogal3-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-photo-tags current-photo)
      (photogaldraw--newline)
      (photogaldraw--insert-tags display-tags current-photo)
      (photogaldraw--newline)
      (photogaldraw--insert-commands-to-buffer key-commands)


      (switch-to-buffer buf)
      (photogaldraw-activate-key-commands tags))))

(defvar key-commands
  '(
    ("RET" photogal-next-file "next")
    ("<right>" photogal-next-file nil)
    ("SPC" photogal-next-file nil )
    ("C-p" photogal-prev-file "prev")
    ("<left>" photogal-prev-file nil)
    ;; ("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)
    ("C-g" photogal-refresh "redraw buffer!")
    ))

(defun photogal-next-file ()
  "Advance by one photo."
  (interactive)
  (setq *photogal/photoreel* (photogal-advance-file *photogal/photoreel*))
  (photogal-render *photogal/photoreel* *photogal/tags*))

(defun photogal-prev-file ()
  "Reverse by one photo."
  (interactive)
  (setq *photogal/photoreel*
	(append (last *photogal/photoreel*) (butlast *photogal/photoreel*)))
  (photogal-render *photogal/photoreel* *photogal/tags*))


;; // 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-child-tags-belonging-to (parent tags)
  (seq-filter
   (lambda (tag)
     (photogaltag-tags= parent (photogal-tag-parent tag)))
   tags))

(defun photogal-tags-with-parents (tags)
  (seq-filter (lambda (tag) (plist-member (cdr tag) 'parent))
	      *photogal/tags*))
(defun photogal-tags-with-no-parents (tags)
  (seq-remove (lambda (tag) (plist-member (cdr tag) 'parent)) tags))
(defun photogal-top-level-tags (tags)
  (append (photogal-all-parents tags)
	  (photogal-tags-with-no-parents tags)))

(defun photogal-tag-name (tag)
  (plist-get (cdr tag) 'name))
(defun photogal-tag-parent (tag)
  (plist-get (cdr tag) 'parent))
(defun photogal-tag-key (tag)
  (car tag))


(defvar photogal3-mode-map nil "Keymap for `photogal-mode`")
;; (setq photogal3-mode-map nil)
;; (setq photogal3-mode-map (make-sparse-keymap))
(define-derived-mode photogal3-mode text-mode "photogal3"
  "Major mode for grouping and labeling images.")




;; (progn
;;   (setq photogal-mode-map (make-sparse-keymap))
;;   (map-do (lambda (key command)
;; 	    (eval `(define-key photogal-mode-map (kbd ,key) ',command)))
;; 	  key-commands))