langs a-z

Task/Bitmap/OCaml/bitmap-1.ocaml

@@ -0,0 +1,15 @@
+let new_img ~width ~height =
+  let all_channels =
+    let kind = Bigarray.int8_unsigned
+    and layout = Bigarray.c_layout
+    in
+    Bigarray.Array3.create kind layout 3 width height
+  in
+  let r_channel = Bigarray.Array3.slice_left_2 all_channels 0
+  and g_channel = Bigarray.Array3.slice_left_2 all_channels 1
+  and b_channel = Bigarray.Array3.slice_left_2 all_channels 2
+  in
+  (all_channels,
+   r_channel,
+   g_channel,
+   b_channel)

Task/Bitmap/OCaml/bitmap-2.ocaml

@@ -0,0 +1,12 @@
+let new_img ~width ~height =
+  let r_channel, g_channel, b_channel =
+    let kind = Bigarray.int8_unsigned
+    and layout = Bigarray.c_layout
+    in
+    (Bigarray.Array2.create kind layout width height,
+     Bigarray.Array2.create kind layout width height,
+     Bigarray.Array2.create kind layout width height)
+  in
+  (r_channel,
+   g_channel,
+   b_channel)

Task/Bitmap/OCaml/bitmap-3.ocaml

@@ -0,0 +1,5 @@
+let fill_img ~img:(_, r_channel, g_channel, b_channel) ~color:(r,g,b) =
+  Bigarray.Array2.fill r_channel r;
+  Bigarray.Array2.fill g_channel g;
+  Bigarray.Array2.fill b_channel b;
+;;

Task/Bitmap/OCaml/bitmap-4.ocaml

@@ -0,0 +1,6 @@
+let put_pixel_unsafe (_, r_channel, g_channel, b_channel) (r,g,b) =
+  (fun x y ->
+    r_channel.{x,y} <- r;
+    g_channel.{x,y} <- g;
+    b_channel.{x,y} <- b;
+  )

Task/Bitmap/OCaml/bitmap-5.ocaml

@@ -0,0 +1,6 @@
+let get_pixel_unsafe (_, r_channel, g_channel, b_channel) =
+  (fun x y ->
+    (r_channel.{x,y},
+     g_channel.{x,y},
+     b_channel.{x,y})
+  )

Task/Bitmap/OCaml/bitmap-6.ocaml

@@ -0,0 +1,24 @@
+let put_pixel img color x y =
+  let _, r_channel,_,_ = img in
+  let width = Bigarray.Array2.dim1 r_channel
+  and height = Bigarray.Array2.dim2 r_channel in
+
+  if (x < 0) || (x >= width) then invalid_arg "x out of bounds";
+  if (y < 0) || (y >= height) then invalid_arg "y out of bounds";
+
+  let r, g, b = color in
+  if (r < 0) || (r > 255) then invalid_arg "red out of bounds";
+  if (g < 0) || (g > 255) then invalid_arg "green out of bounds";
+  if (b < 0) || (b > 255) then invalid_arg "blue out of bounds";
+
+  put_pixel_unsafe img color x y;
+;;
+
+let get_pixel ~img ~pt:(x, y) =
+  let _, r_channel,_,_ = img in
+  let width = Bigarray.Array2.dim1 r_channel
+  and height = Bigarray.Array2.dim2 r_channel in
+  if (x < 0) || (x >= width) then invalid_arg "x out of bounds";
+  if (y < 0) || (y >= height) then invalid_arg "y out of bounds";
+  get_pixel_unsafe img x y;
+;;

Task/Bitmap/OCaml/bitmap-7.ocaml

@@ -0,0 +1,4 @@
+let get_dims ~img:(_, r_channel, _, _) =
+  let width = Bigarray.Array2.dim1 r_channel
+  and height = Bigarray.Array2.dim2 r_channel in
+  (width, height)

Task/Bitmap/Octave/bitmap-1.octave

@@ -0,0 +1,10 @@
+im = zeros(W, H, 3, "uint8"); % create an RGB image of width W and height H
+                              % and intensity from 0 to 255; black (all zeros)
+im(:,:,1) = 255;              % set R to 255
+im(:,:,2) = 100;              % set G to 100
+im(:,:,3) = 155;              % set B to 155
+im(floor(W/2), floor(H/2), :) = 0;  % pixel in the center made black
+disp(im(floor(W/3), floor(H/3), :)) % display intensities of the pixel
+                                    % at W/3, H/3
+p = im(40,40,:); % or just store it in the vector p, so that
+                 % p(1) is R, p(2) G and p(3) is B

Task/Bitmap/Octave/bitmap-2.octave

@@ -0,0 +1,21 @@
+function im = create_rgb_image(w, h)
+  im = zeros(w, h, 3, "uint8");
+endfunction
+
+function set_background(im, colorvector)
+  im(:,:,1) = colorvector(1);
+  im(:,:,2) = colorvector(2);
+  im(:,:,3) = colorvector(3);
+endfunction
+
+function set_pixel(im, coord, colorvector)
+  im(coord(1), coord(2), 1) = colorvector(1);
+  im(coord(1), coord(2), 2) = colorvector(2);
+  im(coord(1), coord(2), 3) = colorvector(3);
+endfunction
+
+function [r, g, b] = get_pixel(im, coord)
+  r = im(coord(1), coord(2), 1)
+  g = im(coord(1), coord(2), 2)
+  b = im(coord(1), coord(2), 3)
+endfunction

Task/Bitmap/Octave/bitmap-3.octave

@@ -0,0 +1,8 @@
+%example
+im = create_rgb_image(200,200);
+for x = 1:128
+   im = set_pixel(im, [x, x], [200, 50, 220]);
+endfor
+
+% it seems like saveimage wants double class on [0,1]
+saveimage("image.ppm", double(im)./256, "ppm");

Task/Bitmap/OxygenBasic/bitmap.oxy

@@ -0,0 +1,41 @@
+'GENERIC BITMAP
+
+type pixel byte r,g,b
+
+'===========
+class BitMap
+'===========
+
+% sp   sizeof(pixel)
+sys    wx,wy,px,py
+string buf
+sys    pb
+method Constructor(sys x=640,y=480) { wx=x : wy=y : buf=nuls x*y*sp : pb=strptr buf}
+method Destructor()                 {buf="" : wx=0 : wy=0 : pb=0}
+method GetPixel(sys x,y,pixel*p)    {copy @p,pb+(y*wx+x)*sp,sp}
+method SetPixel(sys x,y,pixel*p)    {copy pb+(y*wx+x)*sp,@p,sp}
+'
+method Fill(pixel*p)
+  sys i, e=wx*wy*sp+pb-1
+  for i=pb to e step sp {copy i,@p,sp}
+end method
+
+end class
+
+pixel p,q
+
+new BitMap m(400,400) 'width, height in pixels
+
+p<=100,120,140 'red,green,blue
+
+m.fill p
+
+m.getPixel 200,100,q
+print "" q.r "," q.g "," q.b 'result 100,120,140
+q<=10,20,40
+m.setPixel 200,100,q
+m.getPixel 200,100,p
+print "" p.r "," p.g "," p.b 'result 10,20,40
+
+
+del m

Task/Bitmap/Oz/bitmap-1.oz

@@ -0,0 +1,37 @@
+functor
+export
+   New
+   Get
+   Set
+   Transform
+define
+   fun {New Width Height Init}
+      C = {Array.new 1 Height unit}
+   in
+      for Row in 1..Height do
+	 C.Row := {Array.new 1 Width Init}
+      end
+
+      array2d(width:Width
+	      height:Height
+	      contents:C)
+   end
+
+   fun {Get array2d(contents:C ...) X Y}
+      C.Y.X
+   end
+
+   proc {Set array2d(contents:C ...) X Y Val}
+      C.Y.X := Val
+   end
+
+   proc {Transform array2d(contents:C width:W height:H ...) Fun}
+      for Y in 1..H do
+	 for X in 1..W do
+	    C.Y.X := {Fun C.Y.X}
+	 end
+      end
+   end
+
+   %% omitted: Clone, Map, Fold, ForAll
+end

Task/Bitmap/Oz/bitmap-2.oz

@@ -0,0 +1,32 @@
+%% For real task prefer QTk's images:
+%% http://www.mozart-oz.org/home/doc/mozart-stdlib/wp/qtk/html/node38.html
+
+functor
+import
+   Array2D
+export
+   New
+   Fill
+   GetPixel
+   SetPixel
+define
+   Black = color(0x00 0x00 0x00)
+
+   fun {New Width Height}
+      bitmap( {Array2D.new Width Height Black} )
+   end
+
+   proc {Fill bitmap(Arr) Color}
+      {Array2D.transform Arr fun {$ _} Color end}
+   end
+
+   fun {GetPixel bitmap(Arr) X Y}
+      {Array2D.get Arr X Y}
+   end
+
+   proc {SetPixel bitmap(Arr) X Y Color}
+      {Array2D.set Arr X Y Color}
+   end
+
+   %% Omitted: MaxValue, ForAllPixels, Transform
+end

Task/Bitmap/PL-I/bitmap.pli

@@ -0,0 +1,26 @@
+/* Declaration for an image, suitable for BMP files. */
+declare image(0:500, 0:500) bit (24) aligned;
+
+image = '000000000000000011111111'b;
+   /* Sets the entire image to red. */
+
+image(10,40) = '111111110000000000000000'b;
+   /* Sets one pixel to blue. */
+
+declare color bit (24) aligned;
+color = image(20,50); /* Obtain the color of a pixel */
+
+
+
+/* To allocate an image of size (x,y) */
+allocate_image: procedure (image, x, y);
+   declare image (*, *) controlled bit (24) aligned;
+   declare (x, y) fixed binary (31);
+
+   allocate image (0:x, 0:y);
+end allocate_image;
+
+/* To use the above procedure, it's necessary to define   */
+/* the image in the calling program thus, for BMP images: */
+
+declare image(*,*) controlled bit (24) aligned;

Task/Bitmap/Pascal/bitmap.pascal

@@ -0,0 +1,131 @@
+Interface
+uses  crt,   { GetDir }
+      graph; { function GetPixel }
+
+type { integer numbers }
+  { from unit bitmaps XPERT software production Tamer Fakhoury }
+  _bit     = $00000000..$00000001; {number 1 bit   without sign = (0..1) }
+  _byte    = $00000000..$000000FF; {number 1 byte  without sign = (0..255)}
+  _word    = $00000000..$0000FFFF; {number 2 bytes without sign = (0..65 535)}
+  _dWord   = $00000000..$7FFFFFFF; {number 4 bytes without sign = (0..4 294 967 296)}
+  _longInt = $80000000..$7FFFFFFF; {number 4 bytes with sign
+                                    = (-2 147 483 648..2 147 483 648}
+
+  TbmpFileHeader =
+  record
+    ID: _word;             { Must be 'BM' =19778=$424D for windows }
+    FileSize: _dWord;      { Size of this file in bytes }
+    Reserved: _dWord;      { ??? }
+    bmpDataOffset: _dword; { = 54 = $36 from begining of file to begining of bmp data }
+  end;
+
+  TbmpInfoHeader =
+  record
+    InfoHeaderSize: _dword;      { Size of Info header
+                                   = 28h = 40 (decimal)
+                                   for windows }
+    Width,
+    Height: _longInt;    { Width and Height of image in pixels }
+    Planes,              { number of planes of bitmap }
+    BitsPerPixel: _word; { Bits can be 1, 4, 8, 24 or 32 }
+    Compression,
+    bmpDataSize: _dword;    { in bytes rounded to the next 4 byte boundary }
+    XPixPerMeter,           { horizontal resolution in pixels }
+    YPixPerMeter: _longInt; { vertical }
+    NumbColorsUsed,
+    NumbImportantColors: _dword;   {= NumbColorUsed}
+  end; { TbmpHeader = Record ... }
+
+  T32Color =
+  record { 4 byte = 32 bit }
+    Blue:  byte;
+    Green: byte;
+    Red:   byte;
+    Alfa:  byte
+  end;
+
+var directory,
+    bmpFileName:    string;
+    bmpFile:        file; { untyped file }
+    bmpFileHeader:  TbmpFileHeader;
+    bmpInfoHeader:  TbmpInfoHeader;
+    color32:        T32Color;
+    RowSizeInBytes: integer;
+    BytesPerPixel:  integer;
+
+const defaultBmpFileName = 'test';
+      DefaultDirectory   = 'c:\bp\';
+      DefaultExtension   = '.bmp';
+      bmpFileHeaderSize  = 14;
+      { compression specyfication }
+      bi_RGB             = 0;  { compression }
+      bi_RLE8            = 1;
+      bi_RLE4            = 2;
+      bi_BITFIELDS       = 3;
+
+      bmp_OK          = 0;
+      bmp_NotBMP      = 1;
+      bmp_OpenError   = 2;
+      bmp_ReadError   = 3;
+
+Procedure CreateBmpFile32(directory: string; FileName: string;
+                           iWidth, iHeight: _LongInt);
+
+{************************************************}
+Implementation  {-----------------------------}
+{************************************************}
+
+Procedure CreateBmpFile32(directory: string; FileName: string;
+                           iWidth, iHeight: _LongInt);
+  var
+    x, y: integer;
+  begin
+    if directory = '' then
+      GetDir(0, directory);
+    if FileName = '' then
+      FileName: = DefaultBmpFileName;
+    { create a new file on a disk in a given directory with given name }
+    Assign(bmpFile, directory + FileName + DefaultExtension);
+    ReWrite(bmpFile, 1);
+
+    { fill the headers }
+    with bmpInfoHeader, bmpFileHeader do
+    begin
+      ID := 19778;
+      InfoheaderSize := 40;
+      width := iWidth;
+      height := iHeight;
+      BitsPerPixel := 32;
+      BytesPerPixel := BitsPerPixel div 8;
+      reserved := 0;
+      bmpDataOffset := InfoHeaderSize + bmpFileHeaderSize;
+      planes := 1;
+      compression := bi_RGB;
+      XPixPerMeter := 0;
+      YPixPerMeter := 0;
+      NumbColorsUsed := 0;
+      NumbImportantColors := 0;
+
+      RowSizeInBytes := (Width * BytesPerPixel); { only for >=8 bits per pixel }
+      bmpDataSize := height * RowSizeinBytes;
+      FileSize := InfoHeaderSize + bmpFileHeaderSize + bmpDataSize;
+
+      { copy headers to disk file }
+      BlockWrite(bmpFile, bmpFileHeader, bmpFileHeaderSize);
+      BlockWrite(bmpFile, bmpInfoHeader, infoHeaderSize);
+
+      { fill the pixel data area }
+      for y := (height - 1) downto 0  do
+      begin
+	for x := 0 to (width - 1) do
+	begin { Pixel(x,y) }
+	  color32.Blue  := 255;
+	  color32.Green := 0;
+	  color32.Red   := 0;
+	  color32.Alfa  := 0;
+	  BlockWrite(bmpFile, color32, 4);
+	end; { for x ... }
+      end; { for y ... }
+      Close(bmpFile);
+    end; { with bmpInfoHeader, bmpFileHeader }
+   end; { procedure }

Task/Bitmap/Perl-6/bitmap.pl6

@@ -0,0 +1,37 @@
+class Pixel {
+	has Int $.R;
+	has Int $.G;
+	has Int $.B;
+}
+
+class Bitmap {
+	has Pixel @.data;
+	has Int $.width;
+	has Int $.height;
+
+	method fill(Pixel $p) {
+		for ^$.width X ^$.height -> $i, $j {
+			@.data[$i][$j] = $p.clone;
+		}
+	}
+
+	method set-pixel ( $i, $j, Pixel $value) {
+		fail unless 0 <= $i <= $.width && 0 <= $j <= $.height;
+		@.data[$i][$j] = $value;
+	}
+
+	method get-pixel ($i, $j) {
+		fail unless 0 <= $i <= $.width && 0 <= $j <= $.height;
+		@.data[$i][$j];
+	}
+}
+
+# Usage:
+
+my Bitmap $b = Bitmap.new( width => 10, height => 10);
+
+$b.fill( Pixel.new( R => 0, G => 0, B => 200) );
+
+$b.set-pixel( 7, 5, Pixel.new( R => 100, G => 200, B => 0) );
+
+say $b.perl;

Task/Bitmap/PureBasic/bitmap.purebasic

@@ -0,0 +1,12 @@
+w=800 : h=600
+CreateImage(1,w,h)
+;1 is internal id of image
+StartDrawing(ImageOutput(1))
+; fill with color red
+Box(0,0,w,h,$ff)
+; or using another (but slower) way in green
+FillArea(0,0,-1,$ff00)
+; a green Dot
+Plot(10,10,$ff0000)
+; check if we set it right (should be 255)
+Debug Blue(Point(10,10))

Task/Bitmap/REALbasic/bitmap.realbasic

@@ -0,0 +1,17 @@
+Function CreatePicture(width As Integer, height As Integer, depth As Integer) As Picture
+  'It is not possible to create a Picture object with dimensions without initializing it
+  Return New Picture(width, height, depth)
+End Function
+
+Sub FillPicture(ByRef p As Picture, FillColor As Color)
+  p.Graphics.ForeColor = FillColor
+  p.Graphics.FillRect(0, 0, p.Width, p.Height)
+End Sub
+
+Function GetPixelColor(p As Picture, x As Integer, y As Integer) As Color
+  Return p.Graphics.Pixel(x, y)
+End Function
+
+Sub SetPixelColor(p As Picture, x As Integer, y As Integer, pColor As Color)
+  p.Graphics.Pixel(x, y) = pColor
+End Sub

Task/Bitmap/RapidQ/bitmap.rapidq

@@ -0,0 +1,24 @@
+DECLARE SUB PaintCanvas
+
+CREATE form AS QForm
+    Width  = 640
+    Height = 480
+    CREATE canvas AS QCanvas
+        Height  = form.ClientHeight
+	Width   = form.ClientWidth
+	OnPaint = PaintCanvas
+    END CREATE
+END CREATE
+
+SUB PaintCanvas
+    ' Fill background
+    canvas.FillRect(0, 0, canvas.Width, canvas.Height, &H301000)
+
+    ' Draw a pixel
+    canvas.Pset(300, 200, &H00ddff)
+
+    ' Read pixel color
+    PRINT canvas.Pixel(300, 200)
+END SUB
+
+form.ShowModal

Task/Bitmap/Seed7/bitmap.seed7

@@ -0,0 +1,14 @@
+$ include "seed7_05.s7i";
+  include "draw.s7i";
+
+const proc: main is func
+  local
+    var PRIMITIVE_WINDOW: myPixmap is PRIMITIVE_WINDOW.value;
+    var color: myColor is black;
+  begin
+    myPixmap := newPixmap(300, 200);
+    clear(myPixmap, light_green);
+    point(myPixmap, 20, 30, color(256, 512, 768));
+    myColor := getPixelColor(myPixmap, 20, 30);
+    writeln(myColor.red_part <& " " <& myColor.green_part <& " " <& myColor.blue_part);
+  end func;

Task/Bitmap/Vedit-macro-language/bitmap.vedit

@@ -0,0 +1,67 @@
+#11 = 400		// Width of the image
+#12 = 300		// Height of the image
+
+// Create an empty RGB image and fill it with black color
+//
+File_Open("|(VEDIT_TEMP)\pixel.data", OVERWRITE+NOEVENT)
+BOF
+Del_Char(ALL)
+#10 = Buf_Num
+Repeat(#11 * #12) {
+    Ins_Char(0, COUNT, 3)
+}
+
+// Fill the image with dark blue color
+//
+#5 = 0				// Red
+#6 = 0				// Green
+#7 = 64				// Blue
+Call("FILL_IMAGE")
+
+// Draw one pixel in orange color
+//
+#1 = 100			// x
+#2 = 50				// y
+#5 = 255 #6 = 128 #7 = 0	// Orange color
+Call("DRAW_PIXEL")
+
+// Get the color of a pixel
+//
+#1 = 10
+#2 = 3
+Call("GET_COLOR")
+
+Buf_Switch(#10) Buf_Quit(OK)
+Return
+
+/////////////////////////////////////////////////////////////////////
+//
+//  Fill image with given color: #5 = Red, #6 = Green, #7 = Blue
+//
+:FILL_IMAGE:
+BOF
+Repeat (File_Size/3) {
+    IC(#5,OVERWRITE) IC(#6,OVERWRITE) IC(#7,OVERWRITE)
+}
+Return
+
+/////////////////////////////////////////////////////////////////////
+//
+//  Daw a pixel. #1 = x, #2 = y
+//
+:DRAW_PIXEL:
+Goto_Pos((#1 + #2*#11)*3)
+IC(#5,OVERWRITE) IC(#6,OVERWRITE) IC(#7,OVERWRITE)
+Return
+
+/////////////////////////////////////////////////////////////////////
+//
+//  Get color of a pixel. #1 = x, #2 = y
+//  Return: #5 = Red, #6 = Green, #7 = Blue
+//
+:GET_COLOR:
+Goto_Pos((#1 + #2*#11)*3)
+#5 = Cur_Char
+#6 = Cur_Char(1)
+#7 = Cur_Char(2)
+Return

Task/Bitmap/Visual-Basic-.NET/bitmap-1.visual

@@ -0,0 +1,23 @@
+' The StructLayout attribute allows fields to overlap in memory.
+<System.Runtime.InteropServices.StructLayout(LayoutKind.Explicit)> _
+Public Structure Rgb
+
+    <FieldOffset(0)> _
+    Public Rgb As Integer
+
+    <FieldOffset(0)> _
+    Public B As Byte
+
+    <FieldOffset(1)> _
+    Public G As Byte
+
+    <FieldOffset(2)> _
+    Public R As Byte
+
+    Public Sub New(ByVal r As Byte, ByVal g As Byte, ByVal b As Byte)
+        Me.R = r
+        Me.G = g
+        Me.B = b
+    End Sub
+
+End Structure

Task/Bitmap/Visual-Basic-.NET/bitmap-2.visual

@@ -0,0 +1,39 @@
+Public Class RasterBitmap
+
+    Private m_pixels() As Rgb
+
+    Private m_width As Integer
+    Public ReadOnly Property Width As Integer
+        Get
+            Return m_width
+        End Get
+    End Property
+
+    Private m_height As Integer
+    Public ReadOnly Property Height As Integer
+        Get
+            Return m_height
+        End Get
+    End Property
+
+    Public Sub New(ByVal width As Integer, ByVal height As Integer)
+        m_pixels = New Rgb(width * height - 1) {}
+        m_width = width
+        m_height = height
+    End Sub
+
+    Public Sub Clear(ByVal color As Rgb)
+        For i As Integer = 0 To m_pixels.Length - 1
+            m_pixels(i) = color
+        Next
+    End Sub
+
+    Public Sub SetPixel(ByVal x As Integer, ByVal y As Integer, ByVal color As Rgb)
+        m_pixels((y * m_width) + x) = color
+    End Sub
+
+    Public Function GetPixel(ByVal x As Integer, ByVal y As Integer) As Rgb
+        Return m_pixels((y * m_width) + x)
+    End Function
+
+End Class

Task/Bitmap/XPL0/bitmap.xpl0

@@ -0,0 +1,11 @@
+include c:\cxpl\codes;  \include 'code' declarations
+def Width=180, Height=135, Color=$123456;
+int X, Y;
+[SetVid($112);  \set display for 640x480 graphics in 24-bit RGB color
+for Y:= 0 to Height-1 do    \fill area with Color one pixel at a time
+    for X:= 0 to Width-1 do \(this takes 4.12 ms on a Duron 850)
+        Point(X, Y, Color);
+Move(60, 60); HexOut(6, ReadPix(0,0));  \show color of pixel at 0,0
+X:= ChIn(1);            \wait for keystroke
+SetVid(3);              \restore display to normal text mode
+]