photogal/photogal3.el

(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)
    ;; ("<right>" . photogal-next-file)
    ("SPC" . photogal-next-file)
    ;; ("C-p" . photogal-prev-file)
    ;; ("<left>" . 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))