(concord-assign-genre 'image-resource "/usr/local/var/photo/db")

(defun concord-images-encode-url-as-id (url)
  (let (ret)
    (cond
     ((string-match "^http://\\(hng\\|image\\)\\.\\(chise\\.org\\|kanji\\.zinbun\\.kyoto-u\\.ac\\.jp\\)/images/iiif/" url)
      (setq ret (substring url (match-end 0)))
      (if (string-match "\\.[a-zA-Z0-9]+$" ret)
	  (substring ret 0 (match-beginning 0))
	ret)
      )
     ((string-match "^http://\\(hng\\|image\\)\\.\\(chise\\.org\\|kanji\\.zinbun\\.kyoto-u\\.ac\\.jp\\)/images/" url)
      (setq ret (substring url (match-end 0)))
      (if (string-match "\\.[a-zA-Z0-9]+$" ret)
	  (substring ret 0 (match-beginning 0))
	ret)
      )
     ((string-match "^http://" url)
      (substring url (match-end 0))
      )
     (t
      url))))

(defun concord-images-add-url (url &optional iiif iip)
  (let (img-id img-cobj)
    (unless (setq img-cobj (concord-decode-object '=location url
						  'image-resource))
      (setq img-id (intern (concord-images-encode-url-as-id url)))
      (setq img-cobj (concord-make-object 'image-resource img-id))
      (concord-object-put img-cobj '=location url)
      (when iiif
	(concord-object-put img-cobj '=location@iiif iiif)
	(with-temp-buffer
	  (call-process
	   "curl" nil (current-buffer) nil
	   "--silent"
	   (concat iiif "/info.json"))
	  (goto-char (point-min))
	  (when (re-search-forward
		 "^[ \t]*\"width\"[ \t]*:[ \t]*\\([0-9]+\\)" nil t)
	    (concord-object-put img-cobj 'image-width
				(string-to-int (match-string 1))))
	  (when (re-search-forward
		 "^[ \t]*\"height\"[ \t]*:[ \t]*\\([0-9]+\\)" nil t)
	    (concord-object-put img-cobj 'image-height
				(string-to-int (match-string 1))))
	  ))
      (when iip
	(concord-object-put img-cobj '=location@iip iip))
      )
    img-cobj))

(defun concord-images-add-iiif (url)
  (let (img-id img-cobj)
    (unless (setq img-cobj (concord-decode-object '=location url
						  'image-resource))
      (setq img-id (intern (concord-images-encode-url-as-id url)))
      (setq img-cobj (concord-make-object 'image-resource img-id))
      (concord-object-put img-cobj '=location@iiif url))
    img-cobj))

(defun concord-images-add-segments (base-cobj x y width height)
  (let ((base-id (concord-object-get base-cobj '=id))
	base-width base-width-f base-height-f
	base-iiif-url
	seg-id seg-iiif-url seg-cobj
	base-iip-url
	rel-x rel-y rel-w rel-h)
    (setq seg-id (intern (format "%s/xywh=%d,%d,%d,%d"
				 base-id
				 x y width height)))
    (unless (setq seg-cobj (concord-decode-object '=id seg-id
						  'image-resource))
      (setq seg-cobj (concord-make-object 'image-resource seg-id))
      (setq base-iiif-url (concord-object-get base-cobj '=location@iiif))
      (concord-object-put seg-cobj '=location
			  (format "%s#xywh=%d,%d,%d,%d"
				  (concord-object-get base-cobj '=location)
				  x y width height))
      (concord-object-put seg-cobj 'image-offset-x x)
      (concord-object-put seg-cobj 'image-offset-y y)
      (concord-object-put seg-cobj 'image-width width)
      (concord-object-put seg-cobj 'image-height height)
      (setq seg-iiif-url (format "%s/%d,%d,%d,%d/full/0/default.jpg"
				 base-iiif-url x y width height))
      (concord-object-put seg-cobj '=location@iiif seg-iiif-url)
      (when (setq base-iip-url (concord-object-get base-cobj '=location@iip))
	(setq base-width (concord-object-get base-cobj 'image-width)
	      base-width-f (float base-width)
	      base-height-f (float
			     (concord-object-get base-cobj 'image-height)))
	(setq rel-x (/ x base-width-f)
	      rel-y (/ y base-height-f)
	      rel-w (/ width base-width-f)
	      rel-h (/ height base-height-f))
	(if (string-match "&CVT=jpeg" base-iip-url)
	    (setq base-iip-url (substring base-iip-url 0 (match-beginning 0))))
	(concord-object-put
	 seg-cobj '=location@iip
	 (format "%s&RGN=%f,%f,%f,%f&WID=%d&CVT=jpeg"
		 base-iip-url rel-x rel-y rel-w rel-h width)))
      (concord-object-adjoin* seg-cobj '<-image-segment base-cobj)
      )
    seg-cobj))

(provide 'concord-images)