Bitmap/Read a PPM file: Difference between revisions
→{{header|AutoHotkey}}
Thundergnat (talk | contribs) m (Automated syntax highlighting fixup (second round - minor fixes)) |
|||
Line 361:
Close (F2);
end;</syntaxhighlight>
=={{header|ATS}}==
For this you will need the static and dynamic ATS source files of [[Bitmap#ATS]], [[Grayscale_image#ATS]], and [[Bitmap/Write_a_PPM_file#ATS]]. (You do ''not'' need libnetpbm, although one easily could use it with ATS.)
There are three files here: a static file for the interface to <code>pixmap_read_ppm</code>, a dynamic file for the implementation of <code>pixmap_read_ppm</code>, and a file for the program that converts an image to grayscale. (The last is a dynamic file, but we will call it the program file.)
With <code>pixmap_read_ppm<rgb24></code> you should be able to read any valid PPM, whether raw or plain, and with any valid Maxval. The result is a <code>pixmap1(rgb24)</code> with implicit Maxval of 255. The reader tries to be ''very'' permissive, although there seems not much I can do about the strange way comments work in PPM.
===The ATS static file===
This file should be called <code>bitmap_read_ppm_task.sats</code>.
<syntaxhighlight lang="ats">
#define ATS_PACKNAME "Rosetta_Code.bitmap_read_ppm_task"
staload "bitmap_task.sats"
fn {a : t@ype}
pixmap_read_ppm :
(* On failure to read, the return is None_vt(). I do not currently
provide any indication of why the attempt failed, although in
practice you probably would wish to add that. *)
FILEref ->
Option_vt ([w, h : pos] [p : addr | null < p]
@(mfree_gc_v p | pixmap (a, w, h, p)))
</syntaxhighlight>
===The ATS dynamic file===
This file should be called <code>bitmap_read_ppm_task.dats</code>.
<syntaxhighlight lang="ats">
(*------------------------------------------------------------------*)
#define ATS_DYNLOADFLAG 0
#define ATS_PACKNAME "Rosetta_Code.bitmap_read_ppm_task"
#include "share/atspre_staload.hats"
staload "bitmap_task.sats"
(* You need to staload bitmap_task.dats, so the ATS compiler will have
access to its implementations of templates. But we staload it
anonymously, so the programmer will not have access. *)
staload _ = "bitmap_task.dats"
staload "bitmap_read_ppm_task.sats"
(*------------------------------------------------------------------*)
datavtype magic_number_vt =
| Netpbm_magic_number of int
| Unknown_magic_number of ()
fn {}
read_magic_number (inpf : FILEref) : magic_number_vt =
let
val i = fileref_getc inpf
in
if i <> char2int0 'P' then
Unknown_magic_number ()
else
let
val i = fileref_getc inpf
in
if i < char2int0 '1' && char2int0 '7' < i then
Unknown_magic_number ()
else
Netpbm_magic_number (i - char2int0 '0')
end
end
fn {}
get_next_char (inpf : FILEref) : int =
let
fnx
get_next () : int =
let
val i = fileref_getc inpf
in
if i = char2int0 '#' then
skip_through_newline ()
else
i
end
and
skip_through_newline () : int =
let
val i = fileref_getc inpf
in
if i < 0 then
i
else if i = char2int0 '\n' then
get_next ()
else
skip_through_newline ()
end
in
get_next ()
end
(* The only tokens we need to scan for, in P1 through P6, are unsigned
integers. P7 headers (Portable Arbitrary Map) have a completely
different arrangement, but we are not handling that. *)
fn {}
get_next_integer (inpf : FILEref)
(* A negative return value means we have reached the end. We do
not distinguish whitespace characters from anything else that
is not a digit or '#'. (Really I want to use intmax_t here,
rather than llint, but there is no intmax_t support in the
prelude. The ats2-xprelude package has support, but I am
avoiding the dependency. *)
: llint =
let
fnx
look_for_digit () : llint =
let
val i = get_next_char inpf
in
if i < char2int0 '0' || char2int0 '9' < i then
look_for_digit ()
else
read_digits (g0i2i (i - char2int0 '0'))
end
and
read_digits (x : llint) : llint =
let
val i = get_next_char inpf
in
if i < char2int0 '0' || char2int0 '9' < i then
(* I cannot find an "ungetc" in prelude/SATS/filebas.sats,
so I will use the foreign function interface directly. *)
let
typedef FILEstar = $extype"FILE *"
extern castfn FILEref2star : FILEref -<> FILEstar
in
ignoret ($extfcall (int, "ungetc", i, FILEref2star inpf));
x
end
else
let
val digit : llint = g0i2i (i - char2int0 '0')
in
read_digits ((10LL * x) + digit)
end
end
in
look_for_digit ()
end
fn {}
read_ppm_header (inpf : FILEref)
: Option_vt @(ullint, ullint, ullint) =
let
val width = get_next_integer inpf
in
if width < 0LL then
None_vt ()
else
let
val height = get_next_integer inpf
in
if height < 0LL then
None_vt ()
else
let
val maxval = get_next_integer inpf
in
if maxval < 0LL then
None_vt ()
else
begin
(* There is supposed to be a whitespace character (or
comments and whitespace character) after the
MAXVAL. We will accept anything, whitespace or
not. *)
ignoret (fileref_getc inpf);
Some_vt @(g0i2u width, g0i2u height, g0i2u maxval)
end
end
end
end
fn {}
get_next_single_byte (inpf : FILEref) : llint =
let
val i = fileref_getc inpf
in
if i < 0 then
~1LL
else
g0i2i i
end
fn {}
get_next_double_byte (inpf : FILEref) : llint =
let
val i1 = fileref_getc inpf
in
if i1 < 0 then
~1LL
else
let
val i0 = fileref_getc inpf
in
if i0 < 0 then
~1LL
else
let
val i1 : llint = g0i2i i1
and i0 : llint = g0i2i i0
in
(i1 * 256LL) + i0
end
end
end
(*------------------------------------------------------------------*)
(* Implementation is provided only for rgb24. *)
extern castfn ull2sz : {i : int} ullint i -<> size_t i
extern castfn ull2u : {i : int} ullint i -<> uint i
extern castfn ull2u8 : ullint -<> uint8
extern fn {}
read_raw_ppm_rgb24 : $d2ctype (pixmap_read_ppm<rgb24>)
extern fn {}
read_plain_ppm_rgb24 : $d2ctype (pixmap_read_ppm<rgb24>)
extern fn {}
read_general_ppm_rgb24 : $d2ctype (pixmap_read_ppm<rgb24>)
extern fn {}
read_general$width () : [i : pos] size_t i
extern fn {}
read_general$height () : [i : pos] size_t i
extern fn {}
read_general$maxval () : [i : pos | i <= 65535] uint i
extern fn {}
read_general$next_value : FILEref -> llint
implement
pixmap_read_ppm<rgb24> inpf =
case+ read_magic_number inpf of
| ~ Unknown_magic_number () => None_vt ()
| ~ Netpbm_magic_number num =>
begin
case+ num of
| 6 => read_raw_ppm_rgb24 inpf
| 3 => read_plain_ppm_rgb24 inpf
| _ => None_vt
end
implement {}
read_raw_ppm_rgb24 inpf =
case+ read_ppm_header inpf of
| ~ None_vt () => None_vt ()
| ~ Some_vt @(width, height, maxval) =>
let
val width = g1ofg0 width
and height = g1ofg0 height
and maxval = g1ofg0 maxval
in
if (width < 1LLU) + (height < 1LLU) +
(maxval < 1LLU) + (65535LLU < maxval) then
None_vt ()
else
let
val w : Size_t = ull2sz width
val h : Size_t = ull2sz height
val maxval : uInt = ull2u maxval
in
if maxval = 255u then
let
val @(pfgc | pix) = pixmap_make<rgb24> (w, h)
val success =
load<rgb24> (inpf, pix, rgb24_make (255, 0, 0))
in
if ~success then
begin
free (pfgc | pix);
None_vt ()
end
else
Some_vt @(pfgc | pix)
end
else if maxval < 256u then
let
implement read_general$width<> () = w
implement read_general$height<> () = h
implement read_general$maxval<> () = maxval
implement
read_general$next_value<> inpf =
get_next_single_byte inpf
in
read_general_ppm_rgb24<> inpf
end
else
let
implement read_general$width<> () = w
implement read_general$height<> () = h
implement read_general$maxval<> () = maxval
implement
read_general$next_value<> inpf =
get_next_double_byte inpf
in
read_general_ppm_rgb24<> inpf
end
end
end
implement {}
read_plain_ppm_rgb24 inpf =
case+ read_ppm_header inpf of
| ~ None_vt () => None_vt ()
| ~ Some_vt @(width, height, maxval) =>
let
val width = g1ofg0 width
and height = g1ofg0 height
and maxval = g1ofg0 maxval
in
if (width < 1LLU) + (height < 1LLU) +
(maxval < 1LLU) + (65535LLU < maxval) then
None_vt ()
else
let
val w : Size_t = ull2sz width
val h : Size_t = ull2sz height
val maxval : uInt = ull2u maxval
implement read_general$width<> () = w
implement read_general$height<> () = h
implement read_general$maxval<> () = maxval
implement
read_general$next_value<> inpf =
get_next_integer inpf
in
read_general_ppm_rgb24<> inpf
end
end
implement {}
read_general_ppm_rgb24 inpf =
let
val [w : int] w = read_general$width<> ()
and [h : int] h = read_general$height<> ()
and maxval = read_general$maxval<> ()
fn
scale_value (v : ullint) : uint8 =
if maxval = 255u then
ull2u8 v
else
let
val maxval : ullint = g0u2u maxval
val v = 255LLU * v
val v1 = v / maxval
and v0 = v mod maxval
in
if v0 + v0 < maxval then
ull2u8 v1
else if maxval < v0 + v0 then
ull2u8 (succ v1)
else if v1 mod 2LLU = 0LLU then
ull2u8 v1
else
ull2u8 (succ v1)
end
(* For easier programming, start with a fully initialized
pixmap. The routine probably is I/O-bound, anyway. *)
val @(pfgc | pix) =
pixmap_make<rgb24> (w, h, rgb24_make (255, 0, 0))
macdef between (i, j, v) =
let
val v = ,(v)
in
(,(i) <= v) * (v <= ,(j))
end
fun
loop {x, y : nat | x <= w; y <= h}
.<h - y, w - x>.
(pix : !pixmap (rgb24, w, h),
x : size_t x,
y : size_t y)
: bool (* success *) =
if y = h then
true
else if x = w then
loop (pix, i2sz 0, succ y)
else
let
val maxv : llint = g0u2i maxval
val vr = read_general$next_value<> inpf
in
if ~between (0LL, maxv, vr) then
false
else
let
val vg = read_general$next_value<> inpf
in
if ~between (0LL, maxv, vg) then
false
else
let
val vb = read_general$next_value<> inpf
in
if ~between (0LL, maxv, vb) then
false
else
let
val r = scale_value (g0i2u vr)
and g = scale_value (g0i2u vg)
and b = scale_value (g0i2u vb)
in
pix[x, y] := rgb24_make @(r, g, b);
loop (pix, succ x, y)
end
end
end
end
val success = loop (pix, i2sz 0, i2sz 0)
in
if ~success then
begin
free (pfgc | pix);
None_vt ()
end
else
Some_vt @(pfgc | pix)
end
(*------------------------------------------------------------------*)
#ifdef BITMAP_READ_PPM_TASK_TEST #then
staload "bitmap_write_ppm_task.sats"
staload _ = "bitmap_write_ppm_task.dats"
(* The test program converts a PPM at standard input to a raw PPM with
MAXVAL 255. *)
implement
main0 () =
let
val pix_opt = pixmap_read_ppm<rgb24> stdin_ref
in
case+ pix_opt of
| ~ None_vt () => ()
| ~ Some_vt @(pfgc | pix) =>
begin
ignoret (pixmap_write_ppm (stdout_ref, pix));
free (pfgc | pix)
end
end
#endif
(*------------------------------------------------------------------*)
</syntaxhighlight>
===The ATS program file===
This file should be called <code>bitmap_read_ppm_task_program.dats</code> (though it actually could be called by another name).
<syntaxhighlight lang="ats">
(* The program should be able to read a PPM in raw or plain format,
with any valid Maxval. The output will be a grayscale raw PPM with
Maxval=255.
Compile with "myatscc bitmap_read_ppm_task_program.dats", which
should give you a program named "bitmap_read_ppm_task_program". *)
(*
##myatsccdef=\
patscc -std=gnu2x -g -O2 -DATS_MEMALLOC_LIBC \
-o $fname($1) $1 \
bitmap{,_{{read,write}_ppm,grayscale}}_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_grayscale_task.sats"
staload _ = "bitmap_task.dats"
staload _ = "bitmap_read_ppm_task.dats"
staload _ = "bitmap_write_ppm_task.dats"
staload _ = "bitmap_grayscale_task.dats"
implement
main0 (argc, argv) =
let
val args = listize_argc_argv (argc, argv)
val nargs = length args
val inpf =
if nargs < 2 then
stdin_ref
else if args[1] = "-" then
stdin_ref
else
fileref_open_exn (args[1], file_mode_r)
val pix_opt = pixmap_read_ppm<rgb24> inpf
val () = fileref_close inpf
in
case+ pix_opt of
| ~ None_vt () =>
begin
free args;
println! ("For some reason, I failed to read the image.");
exit 1
end
| ~ Some_vt @(pfgc1 | pix1) =>
let
val @(pfgc2 | pix2) = pixmap_convert<rgb24,gray8> pix1
val () = free (pfgc1 | pix1)
val @(pfgc3 | pix3) = pixmap_convert<gray8,rgb24> pix2
val () = free (pfgc2 | pix2)
val outf =
if nargs < 3 then
stdout_ref
else if args[2] = "-" then
stdout_ref
else
fileref_open_exn (args[2], file_mode_w)
val success = pixmap_write_ppm<rgb24> (outf, pix3)
val () = fileref_close outf
val () = free (pfgc3 | pix3)
in
free args;
if ~success then
begin
println! ("For some reason, ",
"I failed to write a new image.");
exit 2
end
end
end
</syntaxhighlight>
=={{header|AutoHotkey}}==
{{works with | AutoHotkey_L}}
Line 422 ⟶ 968:
}
#include bitmap_storage.ahk ; from http://rosettacode.org/wiki/Basic_bitmap_storage/AutoHotkey</syntaxhighlight>
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
| |||