Add primitive use-image to use image by natural size

.github/workflows/ci.yml

@@ -76,3 +76,4 @@ jobs:
         run: |
           (cd demo; opam exec -- make)
           (cd doc; opam exec -- make)
+          (cd tests; opam exec -- make)

doc/doc-primitives.saty

@@ -658,9 +658,9 @@ document (|
         現在の実装では実行時エラーとなり処理を中止する．
         \subject-to-change;
       }
-      +command (`use-image-by-width`) (tIMG --> (tL --> tIB)) {
-        \code{use-image-by-width ${img} ${w}}で
-        画像\code{${img}}を幅\code{${w}}の大きさで描画したものをインラインボックス列として返す．
+      +command (`use-image`) (tIMG --> (tL --> tIB)) {
+        \code{use-image ${img}}で
+        画像\code{${img}}を自然な大きさで描画したものをインラインボックス列として返す．
       }
     >
     +subsection {グラフィックスに関する処理} <

lib-satysfi/dist/packages/pervasives.satyh

@@ -67,6 +67,23 @@ let-inline ctx \TeX =
     script-guard Latin (no-break ib)
 
 
+let use-image-by-width img wid =
+  let ib = use-image img in
+  let g = ib |> draw-text (0pt, 0pt) in
+  let ((_, mh), (w, d)) = get-graphics-bbox g in
+  let r = wid /' w in
+  let hgh = (0pt -' (mh *' r)) in
+  let dpt = d *' r in
+  inline-graphics wid hgh dpt (fun (x, y) -> (
+    [
+      g |> linear-transform-graphics r 0. 0. r
+        |> shift-graphics (x, y -' dpt)
+    ]
+  ))
+
+
+
+
 let length-max len1 len2 =
   if len1 <' len2 then len2 else len1
 

src/backend/imageInfo.ml

@@ -47,6 +47,14 @@ let get_height_from_width key wid =
     wid *% ((ymax -. ymin) /. (xmax -. xmin))
 
 
+let get_size key =
+  let (_,(_, _, pw, ph), _) = ImageHashTable.find key in
+  (* points to inches *)
+  let wid = pw /. 72. in
+  let hgt = ph /. 72. in
+  (Length.of_inch wid, Length.of_inch hgt)
+
+
 let get_ratio key wid hgt =
   let (_,bbox, valuemain) = ImageHashTable.find key in
     match valuemain with

src/backend/imageInfo.mli

@@ -14,6 +14,8 @@ val add_image : abs_path -> key
 
 val get_height_from_width : key -> length -> length
 
+val get_size : key -> Length.t * Length.t
+
 val get_ratio : key -> length -> length -> float * float
 
 val get_xobject_dictionary : Pdf.t -> Pdf.pdfobject

tests/Makefile

@@ -1,10 +1,2 @@
-DEPS=list.satyh math.satyh head.satyh
-
 all:
-	satysfi $(DEPS) first.saty -o output.pdf
-
-math1:
-	satysfi $(DEPS) math1.saty -o output-math1.pdf
-
-math2:
-	satysfi $(DEPS) math2.saty -o output-math2.pdf
+	satysfi -C ../lib-satysfi clip.saty

tests/clip.d

@@ -0,0 +1,2 @@
+/home/yasuo/ghq/github.com/yasuo-ozu/SATySFi/tests/clip.pdf:	/home/yasuo/ghq/github.com/yasuo-ozu/SATySFi/tests/clip.saty
+/home/yasuo/ghq/github.com/yasuo-ozu/SATySFi/tests/clip.pdf:	/home/yasuo/ghq/github.com/yasuo-ozu/SATySFi/tests/images/peppers-rgb.jpg

tests/clip.saty

@@ -3,16 +3,16 @@
 @import: ../lib-satysfi/dist/packages/color
 
 
-let-inline ctx \do-fill wid f =
-    let ib = use-image-by-width (load-image `images/peppers-rgb.jpg`) wid
+let-inline ctx \do-fill f =
+    let ib = use-image (load-image `images/peppers-rgb.jpg`)
     in
     let (w, h, d) = get-natural-metrics ib in
     inline-graphics w h d (fun (x, y) -> [
         fill (Color.blue) (f x y w (h +' d))
     ])
 
-let-inline ctx \do-clip wid f =
-    let ib = use-image-by-width (load-image `images/peppers-rgb.jpg`) wid
+let-inline ctx \do-clip f =
+    let ib = use-image (load-image `images/peppers-rgb.jpg`)
     in
     let (w, h, d) = get-natural-metrics ib in
     inline-graphics w h d (fun (x, y) -> [
@@ -42,11 +42,11 @@ document (|
   author = {\SATySFi; Contributors};
 |) '<
     +p {
-        \do-fill (5cm) (path-circle);
-        \do-clip (5cm) (path-circle);
+        \do-fill (path-circle);
+        \do-clip (path-circle);
     }
     +p {
-        \do-fill (5cm) (path-donut);
-        \do-clip (5cm) (path-donut);
+        \do-fill (path-donut);
+        \do-clip (path-donut);
     }
 >

tools/gencode/vminst.ml

@@ -548,24 +548,23 @@ let abspath = MyUtil.make_abs_path (Filename.concat (OptionState.job_directory (
 let imgkey = ImageInfo.add_image abspath in
 make_image_key imgkey
 |}
-    ; inst "BackendUseImageByWidth"
-        ~name:"use-image-by-width"
-        ~type_:Type.(tIMG @-> tLN @-> tIB)
+    ; inst "BackendUseImageByNaturalSize"
+        ~name:"use-image"
+        ~type_:Type.(tIMG @-> tIB)
         ~fields:[
         ]
         ~params:[
           param "valueimg";
-          param "wid" ~type_:"length";
         ]
         ~is_pdf_mode_primitive:true
         ~code:{|
 match valueimg with
 | BaseConstant(BCImageKey(imgkey)) ->
-    let hgt = ImageInfo.get_height_from_width imgkey wid in
+    let (wid, hgt) = ImageInfo.get_size imgkey in
     make_horz (HorzBox.([HorzPure(PHGFixedImage(wid, hgt, imgkey))]))
 
 | _ ->
-    report_bug_vm "BackendUseImage"
+    report_bug_vm "BackendUseImageByNaturalSize"
 |}
     ; inst "BackendHookPageBreak"
         ~name:"hook-page-break"