Data commit

Task/Bitmap-Read-an-image-through-a-pipe/ATS/bitmap-read-an-image-through-a-pipe.ats

@@ -0,0 +1,129 @@
+(* I both read AND write the image through pipes connected to
+   ImageMagick. One can also pass options and such but I won't go into
+   the details. *)
+
+(*
+
+##myatsccdef=\
+patscc -std=gnu2x -g -O2 -DATS_MEMALLOC_LIBC \
+  -o $fname($1) $1 \
+  bitmap{,_{read,write}_ppm}_task.{s,d}ats
+
+*)
+
+#include "share/atspre_staload.hats"
+
+staload "bitmap_task.sats"
+staload "bitmap_read_ppm_task.sats"
+staload "bitmap_write_ppm_task.sats"
+
+staload _ = "bitmap_task.dats"
+staload _ = "bitmap_read_ppm_task.dats"
+staload _ = "bitmap_write_ppm_task.dats"
+
+(*------------------------------------------------------------------*)
+(* There is support for pipe-I/O in libats/libc, but I cannot (at
+   least when in a hurry) figure out how it is supposed to be
+   used. So, as elsewhere in the "raster graphics operations"
+   category, what is not in the prelude itself I implement with the
+   foreign function interfaces. :) Using FFI is a typical part of ATS
+   programming, and one should get used to doing it.
+
+   Anyway, here is some UNSAFE support for pipe-I/O. *)
+
+typedef charstar = $extype"char *"
+typedef FILEstar = $extype"FILE *"
+
+fn {}
+fileref_popen_unsafe (command : string,
+                      mode    : string)
+    : Option_vt FILEref =
+  let
+    val p = $extfcall (ptr, "popen", $UNSAFE.cast{charstar} command,
+                       $UNSAFE.cast{charstar} mode)
+  in
+    if iseqz p then
+      None_vt ()
+    else
+      Some_vt ($UNSAFE.cast{FILEref} p)
+  end
+
+fn {}
+fileref_pclose_unsafe (f : FILEref)
+    : int =              (* Returns the exit status of the command. *)
+  $extfcall (int, "pclose", $UNSAFE.cast{FILEstar} f)
+
+(*------------------------------------------------------------------*)
+
+implement
+main0 (argc, argv) =
+  let
+    val args = listize_argc_argv (argc, argv)
+    val nargs = length args
+
+    val inpf_name = if nargs < 2 then "-" else args[1]
+    val command = string_append ("magick ", inpf_name, " ppm:-")
+    val pipe_opt =
+      (* Temporarily treating a strptr as a string, just to make a
+         function call of this sort, is not actually unsafe. *)
+      fileref_popen_unsafe ($UNSAFE.strptr2string command, "r")
+    val () = free command
+  in
+    case+ pipe_opt of
+    | ~ None_vt () =>
+      begin
+        free args;
+        println! ("For some reason, I failed to open a pipe ",
+                  "for reading from magick.");
+        exit 1
+      end
+    | ~ Some_vt inpf =>
+      let
+        val pix_opt = pixmap_read_ppm<rgb24> inpf
+      in
+        ignoret (fileref_pclose_unsafe inpf);
+        case+ pix_opt of
+        | ~ None_vt () =>
+          begin
+            free args;
+            println! ("For some reason, I failed to pipe the image ",
+                      "from magick.");
+            exit 1
+          end
+        | ~ Some_vt @(pfgc1 | pix1) =>
+          let
+            val outf_name = if nargs < 3 then "-" else args[2]
+            val command = string_append ("magick ppm:- ", outf_name)
+            val () = free args
+            val pipe_opt =
+              (* Temporarily treating a strptr as a string, just to
+                 make a function call of this sort, is not actually
+                 unsafe. *)
+              fileref_popen_unsafe
+                ($UNSAFE.strptr2string command, "w")
+            val () = free command
+          in
+            case+ pipe_opt of
+            | ~ None_vt () =>
+              begin
+                free (pfgc1 | pix1);
+                println! ("For some reason, I failed to open a pipe ",
+                          "for writing to magick.");
+                exit 3
+              end
+            | ~ Some_vt outf =>
+              let
+                val success = pixmap_write_ppm<rgb24> (outf, pix1)
+              in
+                ignoret (fileref_pclose_unsafe outf);
+                free (pfgc1 | pix1);
+                if ~success then
+                  begin
+                    println! ("For some reason, I failed to pipe ",
+                              "the image to magick.");
+                    exit 2
+                  end
+              end
+          end
+      end
+  end