(www-display-object-desc): Add code to clickable image of clipped

source image for SW-JIGUGE[45]-ddddd character objects.

diff --git a/cwiki-view.el b/cwiki-view.el
index e868df9..6d48331 100644 (file)
--- a/cwiki-view.el
+++ b/cwiki-view.el
@@ -69,6 +69,7 @@ size=\"64\" maxlength=\"256\" value=\"%s\">
        logical-feature chise-wiki-displayed-features
        parents
        GlyphWiki-id HNG-card HNG-card-id HNG-card-cobj ret object-spec
+       item-code page char-num glyph-image-id
        width height image-cobj base-image x y w h)
     (if (eq level 0)
        (setq level 1
@@ -277,9 +278,34 @@ li { margin: 0 0 0 2em; }
           (format "<img alt=\"%s\" src=\"%s\" />"
                   ret ret)))
        )
-       ((and (eq genre 'glyph-image)
-            (setq image-cobj
-                  (car (concord-object-get object '->image-resource))))
+       ((or (and (eq genre 'glyph-image)
+                (setq image-cobj
+                      (car (concord-object-get object '->image-resource))))
+           (and (eq genre 'character)
+                (setq ret (www-format-encode-string
+                           (est-format-object object 'readable)))
+                (string-match
+                 "<img alt=\"SW-JIGUGE\\([45]\\)-\\([0-9][0-9][0-9]\\)\\([0-9][0-9]\\)"
+                 ret)
+                (setq item-code (string-to-int (match-string 1 ret))
+                      page (string-to-int (match-string 2 ret))
+                      char-num (string-to-int (match-string 3 ret)))
+                (setq glyph-image-id
+                      (cond ((eq item-code 4)
+                             (intern
+                              (format "zinbun/toho/A024/A024%04d/char=%d"
+                                      (+ page 18) char-num))
+                             )
+                            ((eq item-code 5)
+                             (intern
+                              (format "zinbun/toho/A020/A020%04d/char=%d"
+                                      (+ page 16) char-num))
+                             )))
+                (setq image-cobj
+                      (concord-decode-object '=id glyph-image-id 'glyph-image))
+                (setq image-cobj
+                      (car (concord-object-get image-cobj '->image-resource)))
+                ))
        (if (and (setq ret (concord-object-get image-cobj '=location@iiif))
                 (setq base-image
                       (car (concord-object-get image-cobj '<-image-segment))))