(concord-assign-genre 'image-resource "/usr/local/var/photo/db")
-(defun concord-images-encode-url-as-id (url)
+(defun concord-images-encode-url-as-id (url &optional base)
(let (ret)
(cond
- ((string-match "^http://hng\\.chise\\.org/images/iiif/" url)
+ ((and base
+ (string-match (concat "^" (regexp-quote base)) 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\\.chise\\.org/images/" url)
+ ((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))
(t
url))))
-(defun concord-images-add-url (url &optional iiif iip)
+(defun concord-images-add-url (url &optional iiif iip base prefix prefer-iiif)
(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-id
+ (intern
+ (concat prefix
+ (if prefer-iiif
+ (concord-images-encode-url-as-id iiif base)
+ (concord-images-encode-url-as-id url base)))))
(setq img-cobj (concord-make-object 'image-resource img-id))
(concord-object-put img-cobj '=location url)
(when iiif
(goto-char (point-min))
(when (re-search-forward
"^[ \t]*\"width\"[ \t]*:[ \t]*\\([0-9]+\\)" nil t)
- (concord-object-put img-cobj 'width (string-to-int
- (match-string 1))))
+ (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 'height (string-to-int
- (match-string 1))))
+ (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)
+(defun concord-images-add-iiif (url &optional base)
(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-id (intern (concord-images-encode-url-as-id url base)))
(setq img-cobj (concord-make-object 'image-resource img-id))
(concord-object-put img-cobj '=location@iiif url))
img-cobj))
(format "%s#xywh=%d,%d,%d,%d"
(concord-object-get base-cobj '=location)
x y width height))
- (concord-object-put seg-cobj 'offset-x x)
- (concord-object-put seg-cobj 'offset-y y)
- (concord-object-put seg-cobj 'width width)
- (concord-object-put seg-cobj 'height 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 'width)
+ (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 'height)))
+ 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)