A-M baby

Task/Bitmap/Factor/bitmap.factor

@@ -0,0 +1,25 @@
+USING: arrays fry kernel math.matrices sequences ;
+IN: rosettacode.raster.storage
+
+! Various utilities
+: meach ( matrix quot -- ) [ each ] curry each ; inline
+: meach-index ( matrix quot -- )
+    [ swap 2array ] prepose
+    [ curry each-index ] curry each-index ; inline
+: mmap ( matrix quot -- matrix' ) [ map ] curry map ; inline
+: mmap! ( matrix quot -- matrix' ) [ map! ] curry map! ; inline
+: mmap-index ( matrix quot -- matrix' )
+    [ swap 2array ] prepose
+    [ curry map-index ] curry map-index ; inline
+
+: matrix-dim ( matrix -- i j ) [ length ] [ first length ] bi ;
+: set-Mi,j ( elt {i,j} matrix -- ) [ first2 swap ] dip nth set-nth ;
+: Mi,j ( {i,j} matrix -- elt ) [ first2 swap ] dip nth nth ;
+
+! The storage functions
+: <raster-image> ( width height -- image )
+    zero-matrix [ drop { 0 0 0 } ] mmap ;
+: fill-image ( {R,G,B} image -- image )
+    swap '[ drop _ ] mmap! ;
+: set-pixel ( {R,G,B} {i,j} image -- ) set-Mi,j ; inline
+: get-pixel ( {i,j} image -- pixel ) Mi,j ; inline

Task/Bitmap/Icon/bitmap.icon

@@ -0,0 +1,15 @@
+procedure makebitmap(width,height)
+   return open("bitmap", "g", "canvas=hidden",
+             "size="||width||","||height)
+end
+procedure fillimage(w,color)
+   Fg(w,color)
+   FillRectangle(w)
+end
+procedure setpixel(w,x,y,color)
+   Fg(w,color)
+   DrawPixel(x,y)
+end
+procedure getpixel(w,x,y)
+   return Pixel(w,x,y)
+end

Task/Bitmap/J/bitmap-1.j

@@ -0,0 +1,4 @@
+makeRGB=: 0&$: : (($,)~ ,&3)
+fillRGB=: makeRGB }:@$
+setPixels=: (1&{::@[)`(<"1@(0&{::@[))`]}
+getPixels=: <"1@[ { ]

Task/Bitmap/J/bitmap-2.j

@@ -0,0 +1,15 @@
+   myimg=: makeRGB 5 8               NB. create a bitmap with height 5 and width 8 (black)
+   myimg=: 255 makeRGB 5 8           NB. create a white bitmap with height 5 and width 8
+   myimg=: 0 255 0 makeRGB 5 8       NB. create a green bitmap with height 5 and width 8
+   myimg=: 0 0 255 fillRGB myimg     NB. fill myimg with blue
+   colors=: 0 255 {~ #: i.8          NB. black,blue,green,cyan,red,magenta,yellow,white
+   myimg=: colors fillRGB myimg      NB. fill myimg with vertical stripes of colors
+   2 4 getPixels myimg               NB. get the pixel color from point (2, 4)
+255 0 0
+
+   myimg=: (2 4 ; 255 255 255) setPixels myimg   NB. set pixel at point (2, 4) to white
+   2 4 getPixels myimg               NB. get the pixel color from point (2, 4)
+255 255 255
+
+   }:$ myimg                         NB. get height and width of the image
+5 8

Task/Bitmap/J/bitmap-3.j

@@ -0,0 +1,7 @@
+pixellist=: ,"0/~ i. 10  NB. row and column indices for 10 by 10 block of pixels
+
+NB. create 10 by 10 block of magenta pixels in the middle of a 300 by 300 green image
+myimg=: ((145 + pixellist) ; 255 0 255) setPixels 0 255 0 makeRGB 300 300
+
+NB. get pixel color for 10x10 block offset from magenta block
+subimg=: (140 + pixellist) getPixels myimg

Task/Bitmap/J/bitmap-4.j

@@ -0,0 +1,4 @@
+require 'viewmat'
+viewRGB=: [: viewrgb 256&#.
+
+viewRGB myimg

Task/Bitmap/KonsolScript/bitmap.konso

@@ -0,0 +1,13 @@
+function main() {
+  Var:Number shape;
+
+  Image:New(50, 50, shape)
+  Draw:RectFill(0, 0, 50, 50, 0xFF0000, shape)  //one to fill an image with a plain RED color
+
+  Draw:Pixel(30, 30, 0x0000FF, shape)           //set a given pixel at (30,30) with a BLUE color
+
+  while (B1 == false) {
+    Image:Blit(10, 10, shape, screen)
+    Screen:Render()
+  }
+}

Task/Bitmap/MAXScript/bitmap-1.max

@@ -0,0 +1 @@
+local myBitmap = bitmap 512 512

Task/Bitmap/MAXScript/bitmap-2.max

@@ -0,0 +1 @@
+local myBitmap = bitmap 512 512 color:(color 128 128 128)

Task/Bitmap/MAXScript/bitmap-3.max

@@ -0,0 +1 @@
+setPixels myBitmap [256, 256] #((color 255 255 255))

Task/Bitmap/MAXScript/bitmap-4.max

@@ -0,0 +1 @@
+local myPixel = getPixels myBitmap [256, 256] 1

Task/Bitmap/Mathematica/bitmap-1.mathematica

@@ -0,0 +1,3 @@
+img = Image[ConstantArray[{1, 0, 0}, {1000, 1000}]];
+img = ReplacePart[img, {1, 1, 1} -> {0, 0, 1}];
+ImageValue[img, {1, 1}]

Task/Bitmap/Mathematica/bitmap-2.mathematica

@@ -0,0 +1,3 @@
+img = Image[ConstantArray[{1, 0, 0}, {1000, 1000}]];
+img = ReplacePixelValue[img, {1, 1} -> {0, 0, 1}];
+ImageValue[img, {1, 1}]

Task/Bitmap/Modula-3/bitmap-1.mod3

@@ -0,0 +1,24 @@
+INTERFACE Bitmap;
+
+TYPE UByte = BITS 8 FOR [0 .. 16_FF];
+     Pixel = RECORD R, G, B: UByte; END;
+     Point = RECORD x, y: UByte; END;
+     T = REF ARRAY OF ARRAY OF Pixel;
+
+CONST
+  Black = Pixel{0, 0, 0};
+  White = Pixel{255, 255, 255};
+  Red = Pixel{255, 0, 0};
+  Green = Pixel{0, 255, 0};
+  Blue = Pixel{0, 0, 255};
+  Yellow = Pixel{255, 255, 0};
+
+EXCEPTION BadImage;
+          BadColor;
+
+PROCEDURE NewImage(height, width: UByte): T RAISES {BadImage};
+PROCEDURE Fill(VAR pic: T; color: Pixel);
+PROCEDURE GetPixel(VAR pic: T; point: Point): Pixel RAISES {BadColor};
+PROCEDURE SetPixel(VAR pic: T; point: Point; color: Pixel);
+
+END Bitmap.

Task/Bitmap/Modula-3/bitmap-2.mod3

@@ -0,0 +1,48 @@
+MODULE Bitmap;
+
+PROCEDURE NewImage(height, width: UByte): T RAISES {BadImage} =
+  (* To make things easier, limit image size to also
+     be UByte (0 to 255), and to have equal dimensions. *)
+  BEGIN
+    IF height # width THEN
+      RAISE BadImage;
+    END;
+    RETURN NEW(T, height, width);
+  END NewImage;
+
+PROCEDURE Fill(VAR pic: T; color: Pixel) =
+  BEGIN
+    FOR i := FIRST(pic^) TO LAST(pic^) DO
+      FOR j := FIRST(pic[0]) TO LAST(pic[0]) DO
+        pic[i,j] := color;
+      END;
+    END;
+  END Fill;
+
+PROCEDURE GetPixel(VAR pic: T; point: Point): Pixel RAISES {BadColor} =
+  VAR pixel := pic[point.x, point.y];
+  BEGIN
+    IF pixel = White THEN
+      RETURN White;
+    ELSIF pixel = Black THEN
+      RETURN Black;
+    ELSIF pixel = Red THEN
+      RETURN Red;
+    ELSIF pixel = Green THEN
+      RETURN Green;
+    ELSIF pixel = Blue THEN
+      RETURN Blue;
+    ELSIF pixel = Yellow THEN
+      RETURN Yellow;
+    ELSE
+      RAISE BadColor;
+    END;
+  END GetPixel;
+
+PROCEDURE SetPixel(VAR pic: T; point: Point; color: Pixel) =
+  BEGIN
+    pic[point.x, point.y] := color;
+  END SetPixel;
+
+BEGIN
+END Bitmap.