(www-format-encode-string): Format &(A-)CDP-vddd-hhhh; and
[chise/est.git] / est-eval.el
index 3cd848a..d395637 100644 (file)
@@ -14,7 +14,7 @@
        ((eq spec 02) (concat value "巻"))
        ((eq spec 03) (concat value "号"))
        ((eq spec 04) (concat value "編"))
-       ((eq spec 05) (concat value "&HD-JA-4A53;"))
+       ((eq spec 05) (concat value "&MJ019590;"))
        ((eq spec 06) (concat value "集"))
        ((eq spec 07) (concat value "輯"))
        ((eq spec 08) (concat value "部"))
                value)))
     (est-eval-value-as-S-exp value)))
 
-(defun est-eval-value-as-image-resource (value)
+(defun est-eval-value-as-image-resource (value &optional accept-full-image)
   (let ((name (concord-object-get value 'name)))
-    (if (concord-object-get value 'image-offset-x)
-       (list 'img (list* :src (or (concord-object-get value '=location@iiif)
-                                  (concord-object-get value '=location))
-                         (if name
-                             (list :alt name))))
-      name)))
+    (cond
+     ((concord-object-get value 'image-offset-x)
+      (list 'img (list* :src (or (concord-object-get value '=location@iiif)
+                                (concord-object-get value '=location))
+                       (if name
+                           (list :alt name))))
+      )
+     (accept-full-image
+      (list 'img (list* :src (concord-object-get value '=location)
+                       (if name
+                           (list :alt name))))
+      )
+     (t
+      name))))
+
+(defun est-eval-value-as-glyph-image (value)
+  (let ((image-resource (car (concord-object-get value '->image-resource))))
+    (est-eval-value-as-image-resource image-resource)))
+
+(defun est-eval-value-as-image-object (value)
+  (let ((image-resource (car (concord-object-get value '->image-resource))))
+    (list 'object (list :object value)
+         (est-eval-value-as-image-resource
+          image-resource 'accept-full-image))))
 
 ;; (defun est-journal-volume-object-get-volume-format (spec feature)
 ;;   (when (integerp spec)
 ;;         ((string= spec "02") `((decimal (:feature ,feature)) "巻"))
 ;;         ((string= spec "03") `((decimal (:feature ,feature)) "号"))
 ;;         ((string= spec "04") `((decimal (:feature ,feature)) "&AJ1-03620;"))
-;;         ((string= spec "05") `((decimal (:feature ,feature)) "&HD-JA-4A53;"))
+;;         ((string= spec "05") `((decimal (:feature ,feature)) "&MJ019590;"))
 ;;         ((string= spec "06") `((decimal (:feature ,feature)) "集"))
 ;;         ((string= spec "07") `((decimal (:feature ,feature)) "輯"))
 ;;         ((string= spec "08") `((decimal (:feature ,feature)) "部"))
                 ((eq genre 'image-resource)
                  (est-eval-value-as-image-resource value)
                  )
+                 ((eq genre 'glyph-image)
+                 (est-eval-value-as-glyph-image value)
+                 )
                  (t
                  (setq genre-o (concord-decode-object '=id genre 'genre))
                  (or (and genre-o
            (mapconcat #'char-to-string ret ""))
     (est-eval-value-as-object value))))
 
+(defun est-eval-value-as-location (value)
+  (let (ret)
+  (if (and (concord-object-p value)
+          (setq ret (concord-object-get value '=location)))
+      (list 'object (list :object value)
+           ret)
+    (est-eval-value-as-object value))))
+
+(defun est-eval-value-as-name (value)
+  (let (ret)
+  (if (and (concord-object-p value)
+          (setq ret (concord-object-get value 'name)))
+      (list 'object (list :object value)
+           ret)
+    (est-eval-value-as-object value))))
+
 (defun est-eval-value-as-HEX (value)
   (if (integerp value)
       (list 'HEX nil (format "%X" value))
            (format "%c" (ideographic-radical value)))
     (est-eval-value-as-S-exp value)))
 
+(defun daijiten-page-number-to-ndl-950498 (page)
+  (+ (/ page 2)
+     (cond ((< page 229)
+           23)
+          ((< page 261)
+           24)
+          ((< page 263)
+           25)
+          ((< page 516) ; 284=285
+           26)
+          (t
+           27))))
+
+(defun est-eval-value-as-daijiten-page (value)
+  (if (integerp value)
+      (list 'link
+           (list :ref
+                 (format "http://image.chise.org/tify/?manifest=https://www.dl.ndl.go.jp/api/iiif/950498/manifest.json&tify={%%22pages%%22:[%d]}"
+                         (daijiten-page-number-to-ndl-950498 value)))
+           value)))
+
 (defun est-eval-value-as-object-list (value &optional separator subtype)
   (if (and (listp value)
           (listp (cdr value)))
        (error (format "%s" value)))
     (format "%s" value)))
 
+(defun est-eval-value-as-location-list (value &optional separator subtype)
+  (if (and (listp value)
+          (listp (cdr value)))
+      (condition-case nil
+         (let (props)
+           (if separator
+               (setq props (list :separator separator)))
+           (if subtype
+               (setq props (list* :subtype subtype props)))
+           (list* 'list props
+                  (mapcar #'est-eval-value-as-location value)))
+       (error (format "%s" value)))
+    (format "%s" value)))
+
+(defun est-eval-value-as-name-list (value &optional separator subtype)
+  (if (and (listp value)
+          (listp (cdr value)))
+      (condition-case nil
+         (let (props)
+           (if separator
+               (setq props (list :separator separator)))
+           (if subtype
+               (setq props (list* :subtype subtype props)))
+           (list* 'list props
+                  (mapcar #'est-eval-value-as-name value)))
+       (error (format "%s" value)))
+    (format "%s" value)))
+
+(defun est-eval-value-as-image-list (value &optional separator subtype)
+  (if (and (listp value)
+          (listp (cdr value)))
+      (condition-case nil
+         (let (props)
+           (if separator
+               (setq props (list :separator separator)))
+           (if subtype
+               (setq props (list* :subtype subtype props)))
+           (list* 'image-list props
+                  (mapcar #'est-eval-value-as-image-object value)))
+       (error (format "%s" value)))
+    (format "%s" value)))
+
 (defun est-eval-value-as-composition-list (value &optional separator subtype)
   (if (and (listp value)
           (listp (cdr value)))
                value)))
     (est-eval-value-default value)))
 
+(defun est-eval-value-as-daijiten-page-list (value &optional separator subtype)
+  (if (and (listp value)
+          (listp (cdr value)))
+      (condition-case nil
+         (let (props)
+           (if separator
+               (setq props (list :separator separator)))
+           (if subtype
+               (setq props (list* :subtype subtype props)))
+           (list* 'list props
+                  (mapcar #'est-eval-value-as-daijiten-page value)))
+       (error (format "%s" value)))
+    (format "%s" value)))
+
 (defun est-eval-value-as-creators-names (value &optional subtype)
   (if (listp value)
       (let (role-name)
                 '(:subtype unordered-list)
               '(:separator " "))
             (mapcar (lambda (creator)
-                      (est-eval-list
-                       '((value (:feature <-creator)))
-                       creator nil))
+                      (if (concord-object-p creator)
+                          (est-eval-list
+                           '((value (:feature <-creator)))
+                           creator nil)
+                        (est-eval-value-default creator)))
                     value))
     (est-eval-value-default value)))
 
         ((eq format 'wiki-text)
          (est-eval-list value object feature-name nil uri-object)
          )
+        ((eq format 'unordered-link-list)
+         (est-eval-list value object feature-name nil uri-object
+                        '(:subtype unordered-list :separator " "))
+         )
         ((eq format 'S-exp)
          (est-eval-value-as-S-exp value)
          )
          (est-eval-value-as-object-list value " "))
         ((eq format 'char-list)
          (est-eval-value-as-char-list value nil))
+        ((eq format 'location-list)
+         (est-eval-value-as-location-list value nil))
+        ((eq format 'name-list)
+         (est-eval-value-as-name-list value nil))
+        ((eq format 'image-list)
+         (est-eval-value-as-image-list value nil))
         ((eq format 'unordered-list)
          (est-eval-value-as-object-list value nil 'unordered-list))
         ((eq format 'unordered-composition-list)
          (est-eval-value-as-created-works value 'unordered-list))
         ((eq format 'journal-volume-list)
          (est-eval-value-as-journal-volumes value))
+        ((eq format 'space-separated-daijiten-page-list)
+         (est-eval-value-as-daijiten-page-list value " "))
         (t
          (est-eval-value-default value)
          ))
       exp)))))
 
 (defun est-eval-list (format-list object feature-name
-                                 &optional lang uri-object)
+                                 &optional lang uri-object list-props)
   (if (consp format-list)
       (let ((ret
             (mapcar
                (est-eval-unit exp object feature-name lang uri-object nil))
              format-list)))
        (if (cdr ret)
-           (list* 'list nil ret)
+           (list* 'list list-props ret)
          (car ret)))
     (est-eval-unit format-list object feature-name lang uri-object nil)))