X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fconcord-images.git;a=blobdiff_plain;f=concord-images.el;h=84a646142a055c1aff46fffdc8c8cd8d8a46a8b8;hp=3290595ecaac2354dcfd22b60c063bffbdf84970;hb=HEAD;hpb=64bf28e26648cecf3026b5c678ecf88b79a9578d

diff --git a/concord-images.el b/concord-images.el
index 3290595..2bb84c8 100644
--- a/concord-images.el
+++ b/concord-images.el
@@ -1,15 +1,22 @@
 (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))
@@ -21,11 +28,16 @@
      (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
@@ -38,23 +50,23 @@
 	  (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))
@@ -77,17 +89,18 @@
 			  (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)