Bitmap: Difference between revisions
→{{header|AutoHotkey}}
m (BASIC256 and BBC BASIC moved to the BASIC section.) |
|||
Line 421:
ldrH r3,[r2]
bx lr</syntaxhighlight>
=={{header|ATS}}==
Because this code will be used in other tasks, I have separated it into "static" and "dynamic" source files. The former is the equivalent of an "interface" file in some other languages, and the latter is equivalent of an "implementation" file. I included some test code that gets compiled if you put the correct option on the compiler command line.
Here is the "static" file, <code>bitmap_task.sats</code>.
<syntaxhighlight lang="ats">
#define ATS_PACKNAME "Rosetta_Code.bitmap_task"
(*------------------------------------------------------------------*)
(* I am going to do this at the most primitive level. So here is the
"abstractified" type, or really a whole set of different types:
w-by-h pixmap of values of type a, with pixel storage at address
p. The type is linear (‘use it once and only once’). We will make
pixmap a boxed type, so its size will be equal to that of a
pointer. (This is actually a general 2-dimensional array type!
But let us ignore that.) *)
absvtype pixmap (a : t@ype, w : int, h : int, p : addr) = ptr
(* A shorthand for a pixmap with its pixel storage at "some"
address. *)
vtypedef pixmap (a : t@ype, w : int, h : int) =
[p : addr] pixmap (a, w, h, p)
(*------------------------------------------------------------------*)
(* Here are definitions for a small set of operations, including the
ones requested in the task document.
But note that, in ATS, we are careful about uninitialized data. It
is POSSIBLE to create an uninitialized pixmap, but NOT possible to
set or get individual pixels, if the pixmap is not already fully
initialized by some other means (such as "fill" or "load"). *)
fn {a : t@ype}
pixmap_make_array :
(* Make a new pixmap from an existing array. The array may be
anywhere (for instance, a stack frame or the heap), and need not
be initialized. *)
{w, h : int} {p : addr}
(array_v (a, p, w * h) | size_t w, size_t h, ptr p) ->
pixmap (a, w, h, p)
fn {a : t@ype}
pixmap_make_uninitized :
(* Make a new uninitialized pixmap, with the pixels stored in the
heap. *)
{w, h : int}
(size_t w, size_t h) ->
[p : addr | null < p] @(mfree_gc_v p | pixmap (a?, w, h, p))
fn {a : t@ype}
pixmap_make_elt :
(* Make a new pixmap, initialized with a given element, with the
pixels stored in the heap. *)
{w, h : int}
(size_t w, size_t h, a) ->
[p : addr | null < p] @(mfree_gc_v p | pixmap (a, w, h, p))
fn {}
pixmap_free_storage_return :
(* Free a pixmap, returning the storage array to the user. *)
{a : t@ype}
{w, h : int} {p : addr}
pixmap (a, w, h, p) -> @(array_v (a, p, w * h) | ptr p)
fn {}
pixmap_free_storage_free :
(* If a pixmap's pixels were allocated in the heap, then free its
storage. *)
{a : t@ype}
{w, h : int} {p : addr}
(mfree_gc_v p | pixmap (a, w, h, p)) -> void
fn {a : t@ype}
pixmap_fill_elt :
(* Fill a pixmap with the given element. (Technically speaking, the
value of the first argument is consumed, and replaced by a new
value. Its type before and after is linear.) *)
{w, h : int} {p : addr}
(* The question mark means that the pixmap elements can start out
uninitialized. *)
(!pixmap (a?, w, h, p) >> pixmap (a, w, h, p), a) -> void
fn {a : t@ype}
{tk : tkind}
pixmap_set_at_guint :
(* Set a pixel at unsigned integer coordinates. You can do this only
on a pixmap that has been initialized. (It would be prohibitively
tedious to safely work with randomly located pixels, if the array
were not already fully initialized.) *)
{w, h : int}
{x, y : int | x < w; y < h}
(!pixmap (a, w, h), g1uint (tk, x), g1uint (tk, y), a) -> void
fn {a : t@ype}
{tk : tkind}
pixmap_set_at_gint :
(* Set a pixel, but with signed integer coordinates. *)
{w, h : int}
{x, y : nat | x < w; y < h}
(!pixmap (a, w, h), g1int (tk, x), g1int (tk, y), a) -> void
fn {a : t@ype} {tk : tkind}
pixmap_get_at_guint :
(* Get a pixel at unsigned integer coordinates. You can do this only
on a pixmap that has been initialized. *)
{w, h : int}
{x, y : int | x < w; y < h}
(!pixmap (a, w, h), g1uint (tk, x), g1uint (tk, y)) -> a
fn {a : t@ype} {tk : tkind}
pixmap_get_at_gint :
(* Get a pixel, but with signed integer coordinates. *)
{w, h : int}
{x, y : nat | x < w; y < h}
(!pixmap (a, w, h), g1int (tk, x), g1int (tk, y)) -> a
fn {a : t@ype}
pixmap_dump :
(* Dump the contents of a pixmap to an output stream, row by row as
in a PPM. You must implement the pixmap$pixels_dump template
function. (We are anticipating the task to write a PPM file, and
wish to do it in a nice way. I am likely to end up actually using
this code, after all.) *)
{w, h : int}
(* I return a success-or-failure value, to avoid committing to using
an exception here. There are circumstances in which exceptions are
not the best approach. *)
(FILEref, !pixmap (a, w, h)) -> bool (* success *)
fn {a : t@ype}
pixmap$pixels_dump :
(* A function that the writes n pixels to an output stream. (It
could be one pixel, it could be the entire image. From the user's
standpoint, it makes no difference. It is an implementation
detail HOW the function is called by pixmap_dump.) *)
{n : int}
(FILEref, &array (a, n), size_t n) -> bool (* success *)
fn {a : t@ype}
pixmap_load :
(* Load the contents of a pixmap from an input stream, row by row as
in a PPM. You must implement the pixmap$pixels_load template
function. A value of type a has to be given, to initialize the
array with if the loading fails. *)
{w, h : int} {p : addr}
(FILEref, !pixmap (a?, w, h, p) >> pixmap (a, w, h, p), a) ->
bool (* success *)
fn {a : t@ype}
pixmap$pixels_load :
(* A function that the reads n pixels from an input stream. (It
could be one pixel, it could be the entire image. From the user's
standpoint, it makes no difference. It is an implementation
detail HOW the function is called by pixmap_load.) *)
{n : int}
(FILEref, &array (a?, n) >> array (a, n), size_t n, a) ->
bool (* success *)
overload pixmap_make with pixmap_make_array
overload pixmap_make with pixmap_make_uninitized
overload pixmap_make with pixmap_make_elt
overload pixmap_free with pixmap_free_storage_return
overload pixmap_free with pixmap_free_storage_free
overload free with pixmap_free_storage_free
overload fill with pixmap_fill_elt
overload pixmap_set_at with pixmap_set_at_guint
overload pixmap_set_at with pixmap_set_at_gint
overload [] with pixmap_set_at
overload pixmap_get_at with pixmap_get_at_guint
overload pixmap_get_at with pixmap_get_at_gint
overload [] with pixmap_get_at
overload dump with pixmap_dump
overload load with pixmap_load
(*------------------------------------------------------------------*)
(* Here is a type for 24-bit RGB data. *)
(* This type will be treated in C as a struct of three
atstype_uint8. There are implementations of
pixmap$pixels_dump<rgb24> and pixmap$pixels_load<rgb24> already
implemented. *)
typedef rgb24 = @(uint8, uint8, uint8)
(* Thus an RGB pixmap type can be written as
pixmap (rgb24, w, h, p)
*)
(*------------------------------------------------------------------*)
</syntaxhighlight>
Here is the "dynamic" file, <code>bitmap_task.dats</code>.
<syntaxhighlight lang="ats">
(*------------------------------------------------------------------*)
#define ATS_DYNLOADFLAG 0
#define ATS_PACKNAME "Rosetta_Code.bitmap_task"
#include "share/atspre_staload.hats"
staload "bitmap_task.sats"
(*------------------------------------------------------------------*)
(* The actual type, normally not seen by the user, is a boxed
record. *)
datavtype _pixmap (a : t@ype, w : int, h : int, p : addr) =
| _pixmap of
@{
pf = array_v (a, p, w * h) |
w = size_t w,
h = size_t h,
p = ptr p
}
(* Here is one of the ways to tie an abstract type to its
implementation: *)
assume pixmap (a, w, h, p) = _pixmap (a, w, h, p)
(* Another way is to use casts. *)
implement {a}
pixmap_make_array (pf | w, h, p) =
_pixmap @{pf = pf | w = w, h = h, p = p}
implement {a}
pixmap_make_uninitized {w, h} (w, h) =
let
prval () = lemma_g1uint_param w (* Proves w >= 0. *)
prval () = lemma_g1uint_param h (* Proves h >= 0. *)
prval () = mul_gte_gte_gte {w, h} () (* Proves w*h >= 0. *)
val @(pf, pfgc | p) = array_ptr_alloc<a> (w * h)
val pix = pixmap_make<a?> (pf | w, h, p)
in
@(pfgc | pix)
end
implement {a}
pixmap_make_elt (w, h, elt) =
let
val @(pfgc | pix) = pixmap_make<a> (w, h)
in
fill<a> (pix, elt);
@(pfgc | pix)
end
implement {}
pixmap_free_storage_return pix =
case+ pix of
| ~ _pixmap record => @(record.pf | record.p)
implement {}
pixmap_free_storage_free (pfgc | pix) =
let
val @(pf | p) = pixmap_free pix
in
array_ptr_free (pf, pfgc | p)
end
implement {a}
pixmap_fill_elt {w, h} {p} (pix, elt) =
case+ pix of
| @ _pixmap record =>
let
prval () = lemma_g1uint_param (record.w)
prval () = lemma_g1uint_param (record.h)
prval () = mul_gte_gte_gte {w, h} ()
stadef n = w * h
val n : size_t n = record.w * record.h
and p : ptr p = record.p
fun
loop {i : nat | i <= n}
.<n - i>.
(pf_lft : array_v (a, p, i),
pf_rgt : array_v (a?, p + (i * sizeof a), n - i) |
i : size_t i)
: @(array_v (a, p, n) | ) =
if i = n then
let
prval () = array_v_unnil pf_rgt
in
@(pf_lft | )
end
else
let
prval @(pf_elt, pf_rgt) = array_v_uncons pf_rgt
val () = ptr_set<a> (pf_elt | ptr_add<a> (p, i), elt)
prval pf_lft = array_v_extend (pf_lft, pf_elt)
in
loop (pf_lft, pf_rgt | succ i)
end
val @(pf | ) = loop (array_v_nil (), record.pf | i2sz 0)
prval () = record.pf := pf
prval () = fold@ pix
in
end
prfn
prove_index_bounds
{w, h : int}
{x, y : nat | x < w; y < h}
()
:<prf> [0 <= x + (y * w);
x + (y * w) < w * h]
void =
let
prval () = mul_gte_gte_gte {y, w} ()
prval () = mul_gte_gte_gte {h - (y + 1), w} ()
in
end
implement {a} {tk}
pixmap_set_at_guint {w, h} {x, y} (pix, x, y, elt) =
case+ pix of
| @ _pixmap record =>
let
prval () = lemma_g1uint_param x
prval () = lemma_g1uint_param y
stadef n = w * h
stadef i = x + (y * w)
prval () = prove_index_bounds {w, h} {x, y} ()
prval () = prop_verify {0 <= i && i < n} ()
(* I purposely store the data in an order such that you can
write something such as a PPM without looping separately
over x and y. Also, even if you did do an outer loop over y
and an inner loop over x, you would get the advantage of
data locality. *)
val i : size_t i = g1u2u x + (g1u2u y * record.w)
macdef pixels = !(record.p)
val () = pixels[i] := elt
prval () = fold@ pix
in
end
implement {a} {tk}
pixmap_set_at_gint (pix, x, y, elt) =
pixmap_set_at_guint<a><sizeknd> (pix, g1i2u x, g1i2u y, elt)
implement {a} {tk}
pixmap_get_at_guint {w, h} {x, y} (pix, x, y) =
case+ pix of
| @ _pixmap record =>
let
prval () = lemma_g1uint_param x
prval () = lemma_g1uint_param y
stadef n = w * h
stadef i = x + (y * w)
prval () = prove_index_bounds {w, h} {x, y} ()
prval () = prop_verify {0 <= i && i < n} ()
val i : size_t i = g1u2u x + (g1u2u y * record.w)
macdef pixels = !(record.p)
val elt = pixels[i]
prval () = fold@ pix
in
elt
end
implement {a} {tk}
pixmap_get_at_gint (pix, x, y) =
pixmap_get_at_guint<a><sizeknd> (pix, g1i2u x, g1i2u y)
implement {a}
pixmap_dump (outf, pix) =
case+ pix of
| @ _pixmap record =>
let
macdef pixels = !(record.p)
val n = record.w * record.h
val success = pixmap$pixels_dump<a> (outf, pixels, n)
prval () = fold@ pix
in
success
end
implement {a}
pixmap_load (inpf, pix, elt) =
case+ pix of
| @ _pixmap record =>
let
macdef pixels = !(record.p)
val n = record.w * record.h
val success = pixmap$pixels_load<a> (inpf, pixels, n, elt)
prval () = fold@ pix
in
success
end
(*------------------------------------------------------------------*)
typedef FILEstar = $extype"FILE *"
extern castfn FILEref2star : FILEref -<> FILEstar
implement
pixmap$pixels_dump<rgb24> (outf, pixels, n) =
let
val num_written =
$extfcall (size_t, "fwrite", addr@ pixels, sizeof<rgb24>, n,
FILEref2star outf)
in
num_written = n
end
implement
pixmap$pixels_load<rgb24> (inpf, pixels, n, elt) =
let
prval [n : int] EQINT () = eqint_make_guint n
val num_read =
$extfcall (size_t, "fread", addr@ pixels, sizeof<rgb24>, n,
FILEref2star inpf)
in
if num_read = n then
let
prval () = $UNSAFE.castvwtp2void{@[rgb24][n]} pixels
in
true
end
else
begin
array_initize_elt<rgb24> (pixels, n, elt);
false
end
end
(*------------------------------------------------------------------*)
#ifdef BITMAP_TASK_TEST #then
%{^
#include <limits.h>
%}
fn
test_sizeof_rgb24 () : void =
(* We want to be sure rgb24 takes up exactly 24 bits. Our dump and
load implementations depend on that. (If it prove not the case on
some platform, one can write, for that unanticipated platform,
special implementations of dump and load.) *)
let
val- true = sizeof<rgb24> = i2sz 3
val- true = sizeof<rgb24> * $extval (size_t, "CHAR_BIT") = i2sz 24
in
end
fn
test_pixel_load_copy_dump () : void =
(* Test loading, copying, and dumping of raw 24-bit RGB data from
SIPI image "Peppers", 4.2.07.tiff:
https://sipi.usc.edu/database/database.php?volume=misc&image=13#top
I have the data stored as "4.2.07.raw". *)
let
extern castfn i2u8 : int -<> uint8
val failure_color = @(i2u8 0xFF, i2u8 0x00, i2u8 0x00)
val @(pfgc1 | pix1) = pixmap_make<rgb24> (i2sz 512, i2sz 512)
val inpf = fileref_open_exn ("4.2.07.raw", file_mode_r)
val success = load<rgb24> (inpf, pix1, failure_color)
val () = fileref_close inpf
val- true = success
val @(pfgc2 | pix2) = pixmap_make<rgb24> (i2sz 512, i2sz 512,
failure_color)
fun
copy_pixels {x, y : nat | x <= 512; y <= 512}
.<512 - x, 512 - y>.
(pix1 : !pixmap (rgb24, 512, 512),
pix2 : !pixmap (rgb24, 512, 512),
x : int x,
y : int y) : void =
if x = 512 then
()
else if y = 512 then
copy_pixels (pix1, pix2, succ x, 0)
else
begin
pix2[x, y] := pix1[x, y];
copy_pixels (pix1, pix2, x, succ y)
end
val () = copy_pixels (pix1, pix2, 0, 0)
val outf = fileref_open_exn ("4.2.07.raw.dumped", file_mode_w)
val success = dump<rgb24> (inpf, pix2)
val () = fileref_close outf
val- true = success
val status = $extfcall (int, "system",
"cmp 4.2.07.raw 4.2.07.raw.dumped")
val- true = status = 0
in
free (pfgc1 | pix1);
free (pfgc2 | pix2)
end
implement
main0 () =
begin
test_sizeof_rgb24 ();
test_pixel_load_copy_dump ()
end
#endif
(*------------------------------------------------------------------*)
</syntaxhighlight>
A test can be run if one has a 786432-byte file and names it <code>4.2.07.raw</code>. I used the raw data from a commonly used 512x512 test image. You can compile and run the test program thus:
<pre>$ patscc -std=gnu2x -g -O2 -DATS_MEMALLOC_LIBC -DATS BITMAP_TASK_TEST bitmap_task.sats bitmap_task.dats
$ ./a.out</pre>
You should end up with a copy of the data in a file named <code>4.2.07.raw.dumped</code>.
=={{header|AutoHotkey}}==
{{works with|AutoHotkey_L}}
Line 516 ⟶ 1,043:
return clr.R << 16 | clr.G << 8 | clr.B
}</syntaxhighlight>
=={{header|Axe}}==
All of the functions specified in the task are built in to Axe. Note that bitmaps are always 96x64 black and white. Thus, since each pixel takes 1 bit, a complete bitmap is 768 bytes.
| |||