X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=est-eval.el;h=d39563716dd2135f5cf5cee57227f31f617b81da;hb=b1b1ea534020fa39be3f7b9fe4494440beba02dc;hp=3cd848a107936f695aaf8a4b4efce87081869c09;hpb=b2adc2d3e6b0150920d5f2961d0f663e1076339e;p=chise%2Fest.git

diff --git a/est-eval.el b/est-eval.el
index 3cd848a..d395637 100644
--- a/est-eval.el
+++ b/est-eval.el
@@ -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 "部"))
@@ -64,14 +64,32 @@
 		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)
@@ -83,7 +101,7 @@
 ;;         ((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)) "部"))
@@ -339,6 +357,9 @@
 		 ((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
@@ -366,6 +387,22 @@
 	    (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))
@@ -389,6 +426,27 @@
 	    (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)))
@@ -417,6 +475,48 @@
 	(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)))
@@ -577,6 +677,20 @@
 		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)
@@ -613,9 +727,11 @@
 		 '(: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)))
 
@@ -693,6 +809,10 @@
 	 ((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)
 	  )
@@ -711,6 +831,12 @@
 	  (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)
@@ -729,6 +855,8 @@
 	  (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)
 	  ))
@@ -872,7 +1000,7 @@
       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
@@ -880,7 +1008,7 @@
 		(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)))