(concord-kaisei-add-takuhon): Refer feature `->HNG@zinbun/takuhon' as
[chise/concord-images.git] / concord-images.el
1 (concord-assign-genre 'image-resource "/usr/local/var/photo/db")
2
3 (defun concord-images-encode-url-as-id (url)
4   (let (ret)
5     (cond
6      ((string-match "^http://hng\\.chise\\.org/images/iiif/" url)
7       (setq ret (substring url (match-end 0)))
8       (if (string-match "\\.[a-zA-Z0-9]+$" ret)
9           (substring ret 0 (match-beginning 0))
10         ret)
11       )
12      ((string-match "^http://hng\\.chise\\.org/images/" url)
13       (setq ret (substring url (match-end 0)))
14       (if (string-match "\\.[a-zA-Z0-9]+$" ret)
15           (substring ret 0 (match-beginning 0))
16         ret)
17       )
18      ((string-match "^http://" url)
19       (substring url (match-end 0))
20       )
21      (t
22       url))))
23
24 (defun concord-images-add-url (url &optional iiif iip)
25   (let (img-id img-cobj)
26     (unless (setq img-cobj (concord-decode-object '=location url
27                                                   'image-resource))
28       (setq img-id (intern (concord-images-encode-url-as-id url)))
29       (setq img-cobj (concord-make-object 'image-resource img-id))
30       (concord-object-put img-cobj '=location url)
31       (when iiif
32         (concord-object-put img-cobj '=location@iiif iiif)
33         (with-temp-buffer
34           (call-process
35            "curl" nil (current-buffer) nil
36            "--silent"
37            (concat iiif "/info.json"))
38           (goto-char (point-min))
39           (when (re-search-forward
40                  "^[ \t]*\"width\"[ \t]*:[ \t]*\\([0-9]+\\)" nil t)
41             (concord-object-put img-cobj 'image-width
42                                 (string-to-int (match-string 1))))
43           (when (re-search-forward
44                  "^[ \t]*\"height\"[ \t]*:[ \t]*\\([0-9]+\\)" nil t)
45             (concord-object-put img-cobj 'image-height
46                                 (string-to-int (match-string 1))))
47           ))
48       (when iip
49         (concord-object-put img-cobj '=location@iip iip))
50       )
51     img-cobj))
52
53 (defun concord-images-add-iiif (url)
54   (let (img-id img-cobj)
55     (unless (setq img-cobj (concord-decode-object '=location url
56                                                   'image-resource))
57       (setq img-id (intern (concord-images-encode-url-as-id url)))
58       (setq img-cobj (concord-make-object 'image-resource img-id))
59       (concord-object-put img-cobj '=location@iiif url))
60     img-cobj))
61
62 (defun concord-images-add-segments (base-cobj x y width height)
63   (let ((base-id (concord-object-get base-cobj '=id))
64         base-width base-width-f base-height-f
65         base-iiif-url
66         seg-id seg-iiif-url seg-cobj
67         base-iip-url
68         rel-x rel-y rel-w rel-h)
69     (setq seg-id (intern (format "%s/xywh=%d,%d,%d,%d"
70                                  base-id
71                                  x y width height)))
72     (unless (setq seg-cobj (concord-decode-object '=id seg-id
73                                                   'image-resource))
74       (setq seg-cobj (concord-make-object 'image-resource seg-id))
75       (setq base-iiif-url (concord-object-get base-cobj '=location@iiif))
76       (concord-object-put seg-cobj '=location
77                           (format "%s#xywh=%d,%d,%d,%d"
78                                   (concord-object-get base-cobj '=location)
79                                   x y width height))
80       (concord-object-put seg-cobj 'image-offset-x x)
81       (concord-object-put seg-cobj 'image-offset-y y)
82       (concord-object-put seg-cobj 'image-width width)
83       (concord-object-put seg-cobj 'image-height height)
84       (setq seg-iiif-url (format "%s/%d,%d,%d,%d/full/0/default.jpg"
85                                  base-iiif-url x y width height))
86       (concord-object-put seg-cobj '=location@iiif seg-iiif-url)
87       (when (setq base-iip-url (concord-object-get base-cobj '=location@iip))
88         (setq base-width (concord-object-get base-cobj 'image-width)
89               base-width-f (float base-width)
90               base-height-f (float
91                              (concord-object-get base-cobj 'image-height)))
92         (setq rel-x (/ x base-width-f)
93               rel-y (/ y base-height-f)
94               rel-w (/ width base-width-f)
95               rel-h (/ height base-height-f))
96         (if (string-match "&CVT=jpeg" base-iip-url)
97             (setq base-iip-url (substring base-iip-url 0 (match-beginning 0))))
98         (concord-object-put
99          seg-cobj '=location@iip
100          (format "%s&RGN=%f,%f,%f,%f&WID=%d&CVT=jpeg"
101                  base-iip-url rel-x rel-y rel-w rel-h width)))
102       (concord-object-adjoin* seg-cobj '<-image-segment base-cobj)
103       )
104     seg-cobj))
105
106 (provide 'concord-images)