langs a-z

Task/Bitmap-Read-a-PPM-file/OCaml/bitmap-read-a-ppm-file-1.ocaml

@@ -0,0 +1,38 @@
+let read_ppm ~filename =
+  let ic = open_in filename in
+  let line = input_line ic in
+  if line <> "P6" then invalid_arg "not a P6 ppm file";
+  let line = input_line ic in
+  let line =
+    try if line.[0] = '#'  (* skip comments *)
+    then input_line ic
+    else line
+    with _ -> line
+  in
+  let width, height =
+    Scanf.sscanf line "%d %d" (fun w h -> (w, h))
+  in
+  let line = input_line ic in
+  if line <> "255" then invalid_arg "not a 8 bit depth image";
+  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
+  for y = 0 to pred height do
+    for x = 0 to pred width do
+      r_channel.{x,y} <- (input_byte ic);
+      g_channel.{x,y} <- (input_byte ic);
+      b_channel.{x,y} <- (input_byte ic);
+    done;
+  done;
+  close_in ic;
+  (all_channels,
+   r_channel,
+   g_channel,
+   b_channel)

Task/Bitmap-Read-a-PPM-file/OCaml/bitmap-read-a-ppm-file-2.ocaml

@@ -0,0 +1,5 @@
+let () =
+  let img = read_ppm ~filename:"logo.ppm" in
+  let img = to_color(to_grayscale ~img) in
+  output_ppm ~oc:stdout ~img;
+;;

Task/Bitmap-Read-a-PPM-file/Oz/bitmap-read-a-ppm-file-1.oz

@@ -0,0 +1,84 @@
+functor
+import
+   Bitmap
+   Open
+export
+   Read
+   %% Write
+define
+   fun {Read Filename}
+      F = {New Open.file init(name:Filename)}
+
+      fun {ReadColor8 _}
+	 Bytes = {F read(list:$ size:3)}
+      in
+	 {List.toTuple color Bytes}
+      end
+
+      fun {ReadColor16 _}
+	 Bytes = {F read(list:$ size:6)}
+      in
+	 {List.toTuple color {Map {PairUp Bytes} FromBytes}}
+      end
+   in
+      try
+	 Magic = {F read(size:2 list:$)}
+	 if Magic \= "P6" then raise bitmapIO(read unsupportedFormat(Magic)) end end
+	 Width = {ReadNumber F}
+	 Height = {ReadNumber F}
+	 MaxVal = {ReadNumber F}
+	 MaxVal =< 0xffff = true
+	 Reader = if MaxVal =< 0xff then ReadColor8 else ReadColor16 end
+	 B = {Bitmap.new Width Height}
+      in
+	 {Bitmap.transform B Reader}
+	 B
+      finally
+	 {F close}
+      end
+   end
+
+   fun {ReadNumber F}
+      Ds
+   in
+      {SkipWS F}
+      Ds = for collect:Collect break:Break do
+	      [C] = {F read(list:$ size:1)}
+	   in
+	      if {Char.isDigit C} then {Collect C}
+	      else {Break}
+	      end
+	   end
+      {SkipWS F}
+      {String.toInt Ds}
+   end
+
+   proc {SkipWS F}
+      [C] = {F read(list:$ size:1)}
+   in
+      if {Char.isSpace C} then {SkipWS F}
+      elseif C == &# then
+	 {SkipLine F}
+      else
+	 {F seek(whence:current offset:~1)}
+      end
+   end
+
+   proc {SkipLine F}
+      [C] = {F read(list:$ size:1)}
+   in
+      if C \= &\n andthen  C \= &\r then {SkipLine F} end
+   end
+
+   fun {PairUp Xs}
+      case Xs of X1|X2|Xr then [X1 X2]|{PairUp Xr}
+      [] nil then nil
+      end
+   end
+
+   fun {FromBytes [C1 C2]}
+      C1 * 0x100 + C2
+   end
+
+   %% Omitted: Write
+end

Task/Bitmap-Read-a-PPM-file/Oz/bitmap-read-a-ppm-file-2.oz

@@ -0,0 +1,7 @@
+declare
+  [BitmapIO Grayscale] = {Module.link ['BitmapIO.ozf' 'Grayscale.ozf']}
+
+  B = {BitmapIO.read "image.ppm"}
+  G = {Grayscale.toGraymap B}
+in
+  {BitmapIO.write {Grayscale.fromGraymap G} "greyimage.ppm"}

Task/Bitmap-Read-a-PPM-file/PL-I/bitmap-read-a-ppm-file.pli

@@ -0,0 +1,64 @@
+/* BITMAP FILE: read in a file in PPM format, P6 (binary). 14/5/2010 */
+test: procedure options (main);
+   declare (m, n, max_color, i, j) fixed binary (31);
+   declare ch character (1), ID character (2);
+   declare 1 pixel union,
+            2 color bit(24) aligned,
+            2 primary_colors,
+               3 R char (1),
+               3 G char (1),
+               3 B char (1);
+   declare in file record;
+
+   open file (in) title ('/IMAGE.PPM,TYPE(FIXED),RECSIZE(1)' ) input;
+
+   call get_char;
+   ID = ch;
+   call get_char;
+   substr(ID, 2,1) = ch;
+   /* Read in the dimensions of the image */
+   call get_integer (m);
+   call get_integer (n);
+
+   /* Read in the maximum color size used */
+   call get_integer (max_color);
+      /* The previous call reads in ONE line feed or CR or other terminator */
+      /* character. */
+
+begin;
+   declare image (0:m-1,0:n-1) bit (24);
+
+   do i = 0 to hbound(image, 1);
+      do j = 0 to hbound(image,2);
+         read file (in) into (R);
+         read file (in) into (G);
+         read file (in) into (B);
+         image(i,j) = color;
+      end;
+   end;
+end;
+
+get_char: procedure;
+   do until (ch ^= ' ');
+      read file (in) into (ch);
+   end;
+end get_char;
+
+get_integer: procedure (value);
+   declare value fixed binary (31);
+
+   do until (ch = ' ');
+      read file (in) into (ch);
+   end;
+   value = 0;
+   do until (is_digit(ch));
+      value = value*10 + ch;
+      read file (in) into (ch);
+   end;
+end get_integer;
+
+is_digit: procedure (ch) returns (bit(1));
+   declare ch character (1);
+   return (index('0123456789', ch) > 0);
+end is_digit;
+end test;

Task/Bitmap-Read-a-PPM-file/PureBasic/bitmap-read-a-ppm-file-1.purebasic

@@ -0,0 +1,58 @@
+Structure PPMColor
+  r.c
+  g.c
+  b.c
+EndStructure
+
+Procedure LoadImagePPM(Image, file$)
+  ; Author Roger Rösch (Nickname Macros)
+  IDFile = ReadFile(#PB_Any, file$)
+  If IDFile
+    If CreateImage(Image, 1, 1)
+      Format$ = ReadString(IDFile)
+      ReadString(IDFile) ; skip comment
+      Dimensions$ = ReadString(IDFile)
+      w           = Val(StringField(Dimensions$, 1, " "))
+      h           = Val(StringField(Dimensions$, 2, " "))
+      ResizeImage(Image, w, h)
+      StartDrawing(ImageOutput(Image))
+      max = Val(ReadString(IDFile))           ; Maximal Value for a color
+      Select Format$
+        Case "P3" ; File in ASCII format
+          ; Exract everey number remaining in th file into an array using an RegEx
+          Stringlen = Lof(IDFile) - Loc(IDFile)
+          content$  = Space(Stringlen)
+          Dim color.s(0)
+          ReadData(IDFile, @content$, Stringlen)
+          CreateRegularExpression(1, "\d+")
+          ExtractRegularExpression(1, content$, color())
+          ; Plot color information on our empty Image
+          For y = 0 To h - 1
+            For x = 0 To w - 1
+              pos = (y*w + x)*3
+              r=Val(color(pos))*255 / max
+              g=Val(color(pos+1))*255 / max
+              b=Val(color(pos+2))*255 / max
+              Plot(x, y, RGB(r,g,b))
+            Next
+          Next
+        Case "P6" ;File In binary format
+          ; Read whole bytes into a buffer because its faster than reading single ones
+          Bufferlen = Lof(IDFile) - Loc(IDFile)
+          *Buffer   = AllocateMemory(Bufferlen)
+          ReadData(IDFile, *Buffer, Bufferlen)
+          ; Plot color information on our empty Image
+          For y = 0 To h - 1
+            For x = 0 To w - 1
+              *color.PPMColor = pos + *Buffer
+              Plot(x, y, RGB(*color\r*255 / max, *color\g*255 / max, *color\b*255 / max))
+              pos + 3
+            Next
+          Next
+      EndSelect
+      StopDrawing()
+      ; Return 1 if successfully loaded to behave as other PureBasic functions
+      ProcedureReturn 1
+    EndIf
+  EndIf
+EndProcedure

Task/Bitmap-Read-a-PPM-file/PureBasic/bitmap-read-a-ppm-file-2.purebasic

@@ -0,0 +1,8 @@
+Define file.s, file2.s, image = 3
+file = OpenFileRequester("Select source image file", "", "PPM image (*.ppm)|*.ppm", 0)
+If file And LCase(GetExtensionPart(file)) = "ppm"
+  LoadImagePPM(image, file)
+  ImageGrayout(image)
+  file2 = Left(file, Len(file) - Len(GetExtensionPart(file))) + "_grayscale." + GetExtensionPart(file)
+  SaveImageAsPPM(image, file2, 1)
+EndIf

Task/Bitmap-Read-a-PPM-file/Seed7/bitmap-read-a-ppm-file.seed7

@@ -0,0 +1,36 @@
+$ include "seed7_05.s7i";
+  include "draw.s7i";
+  include "color.s7i";
+
+const func PRIMITIVE_WINDOW: getPPM (in string: fileName) is func
+  result
+    var PRIMITIVE_WINDOW: aWindow is PRIMITIVE_WINDOW.value;
+  local
+    var file: ppmFile is STD_NULL;
+    var string: line is "";
+    var integer: width is 0;
+    var integer: height is 0;
+    var integer: x is 0;
+    var integer: y is 0;
+    var color: pixColor is black;
+  begin
+    ppmFile := open(fileName, "r");
+    if ppmFile <> STD_NULL then
+      if getln(ppmFile) = "P6" then
+        repeat
+          line := getln(ppmFile);
+        until line = "" or line[1] <> '#';
+        read(ppmFile, width);
+        readln(ppmFile, height);
+        aWindow := newPixmap(width, height);
+        for y range 0 to pred(height) do
+          for x range 0 to pred(width) do
+            pixColor.red_part   := ord(getc(ppmFile));
+            pixColor.green_part := ord(getc(ppmFile));
+            pixColor.blue_part  := ord(getc(ppmFile));
+          end for;
+        end for;
+      end if;
+      close(ppmFile);
+    end if;
+  end func;

Task/Bitmap-Read-a-PPM-file/Vedit-macro-language/bitmap-read-a-ppm-file-1.vedit

@@ -0,0 +1,17 @@
+//   Load a PPM file
+//     @10 = filename
+//   On return:
+//     #10 points to buffer containing pixel data,
+//     #11 = width,  #12 = height.
+
+:LOAD_PPM:
+File_Open(@10)
+BOF
+Search("|X", ADVANCE)		// skip "P6"
+#11 = Num_Eval(ADVANCE)		// #11 = width
+Match("|X", ADVANCE)		// skip separator
+#12 = Num_Eval(ADVANCE)		// #12 = height
+Match("|X", ADVANCE)
+Search("|X", ADVANCE)		// skip maxval (assume 255)
+Del_Block(0,CP)			// remove the header
+Return

Task/Bitmap-Read-a-PPM-file/Vedit-macro-language/bitmap-read-a-ppm-file-2.vedit

@@ -0,0 +1,19 @@
+// Load RGB image
+Reg_Set(10, "|(USER_MACRO)\example.ppm")
+Call("LOAD_PPM")
+
+// Convert to grayscale
+#10 = Buf_Num
+Call("RGB_TO_GRAYSCALE")
+Buf_Switch(#10) Buf_Quit(OK)
+
+// Convert to RGB
+Call("GRAYSCALE_TO_RGB")
+
+// Save the image
+Reg_Set(10, "|(USER_MACRO)\example_gray.ppm")
+Call("SAVE_PPM")
+
+// Cleanup and exit
+Buf_Switch(#20) Buf_Quit(OK)
+return

Task/Bitmap-Read-a-PPM-file/XPL0/bitmap-read-a-ppm-file.xpl0

@@ -0,0 +1,45 @@
+include c:\cxpl\codes;          \intrinsic 'code' declarations
+
+func OpenInFile;                \Open for input the file typed on command line
+int  CpuReg, Handle;
+char CmdTail($80);
+[CpuReg:= GetReg;
+Blit(CpuReg(11), $81, CpuReg(12), CmdTail, $7F);       \get copy of command line
+Trap(false);                    \turn off error trapping
+Handle:= FOpen(CmdTail, 0);     \open named file for input
+FSet(Handle, ^I);               \assign file to input device 3
+OpenI(3);                       \initialize input buffer pointers
+if GetErr then return false;
+Trap(true);
+return true;
+];
+
+int  C, X, Y, Width, Height, Max, Lum;
+real Red, Green, Blue;
+[if not OpenInFile then [Text(0, "File not found");  exit];
+if ChIn(3)#^P or ChIn(3)#^6 then [Text(0, "Not P6 PPM file");  exit];
+repeat  loop    [C:= ChIn(3);
+                if C # ^# then quit;
+                repeat C:= ChIn(3) until C=$0A\EOL\;
+                ];
+until   C>=^0 & C<=^9;
+Backup;                         \back up so IntIn re-reads first digit
+Width:=  IntIn(3);              \(skips any whitespace)
+Height:= IntIn(3);
+Max:=    IntIn(3) + 1;          \(255/15=17; 256/16=16)
+case of
+  Width<= 640 & Height<=480: SetVid($112);
+  Width<= 800 & Height<=600: SetVid($115);
+  Width<=1024 & Height<=768: SetVid($118)
+other SetVid($11B);             \1280x1024
+for Y:= 0 to Height-1 do
+    for X:= 0 to Width-1 do
+        [Red  := float(ChIn(3)*256/Max) * 0.21; \convert color to grayscale
+         Green:= float(ChIn(3)*256/Max) * 0.72;
+         Blue := float(ChIn(3)*256/Max) * 0.07;
+         Lum:= fix(Red) + fix(Green) + fix(Blue);
+         Point(X, Y, Lum<<16 + Lum<<8 + Lum);
+        ];
+X:= ChIn(1);                    \wait for keystroke
+SetVid(3);                      \restore normal text display
+]