langs a-z
This commit is contained in:
Ingy döt Net
parent
db842d013d
commit
d066446780
11389 changed files with 98361 additions and 1020 deletions
39
Task/Bitmap-Write-a-PPM-file/Oz/bitmap-write-a-ppm-file.oz
Normal file
39
Task/Bitmap-Write-a-PPM-file/Oz/bitmap-write-a-ppm-file.oz
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
functor
|
||||
import
|
||||
Bitmap
|
||||
Open
|
||||
export
|
||||
%% Read
|
||||
Write
|
||||
define
|
||||
%% Omitted: Read
|
||||
|
||||
proc {Write B=bitmap(array2d(width:W height:H ...)) Filename}
|
||||
F = {New Open.file init(name:Filename flags:[write create truncate binary])}
|
||||
|
||||
proc {WriteColor8 color(R G B)}
|
||||
{F write(vs:[R G B])}
|
||||
end
|
||||
|
||||
fun {ToBytes C}
|
||||
[C div 0x100 C mod 0x100]
|
||||
end
|
||||
|
||||
proc {WriteColor16 color(R G B)}
|
||||
{F write(vs:{Flatten {Map [R G B] ToBytes}})}
|
||||
end
|
||||
|
||||
MaxCol = {Bitmap.maxValue B}
|
||||
MaxVal#Writer = if MaxCol =< 0xff then 0xff#WriteColor8
|
||||
else 0xffff#WriteColor16
|
||||
end
|
||||
Header = "P6\n"#W#" "#H#" "#MaxVal#"\n"
|
||||
in
|
||||
try
|
||||
{F write(vs:Header)}
|
||||
{Bitmap.forAllPixels B Writer}
|
||||
finally
|
||||
{F close}
|
||||
end
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
/* BITMAP FILE: write out a file in PPM format, P6 (binary). 14/5/2010 */
|
||||
test: procedure options (main);
|
||||
declare image (0:19,0:19) bit (24);
|
||||
declare 1 pixel union,
|
||||
2 color bit (24) aligned,
|
||||
2 primaries,
|
||||
3 R character (1),
|
||||
3 G character (1),
|
||||
3 B character (1);
|
||||
declare ch character (1);
|
||||
declare (i, j) fixed binary;
|
||||
declare out file record;
|
||||
|
||||
open file (out) title ('/IMAGE.PPM,TYPE(FIXED),RECSIZE(1)' ) OUTPUT;
|
||||
|
||||
ch = 'P'; write file (out) from (ch);
|
||||
ch = '6'; write file (out) from (ch);
|
||||
|
||||
call put_integer (hbound(image, 1));
|
||||
call put_integer (hbound(image, 2));
|
||||
call put_integer (255);
|
||||
|
||||
do i = 0 to hbound(image,1);
|
||||
do j = 0 to hbound(image, 2);
|
||||
color = image(i,j);
|
||||
write file (out) from (R);
|
||||
write file (out) from (G);
|
||||
write file (out) from (B);
|
||||
end;
|
||||
end;
|
||||
|
||||
put_integer: procedure (k);
|
||||
declare k fixed binary;
|
||||
declare s character (30) varying;
|
||||
declare i fixed binary;
|
||||
declare ch character (1);
|
||||
|
||||
s = k;
|
||||
s = trim(s);
|
||||
do i = 1 to length(s);
|
||||
ch = substr(s, i, 1);
|
||||
write file (out) from (ch);
|
||||
end;
|
||||
ch = '09'x;
|
||||
write file (out) from (ch);
|
||||
end put_integer;
|
||||
end test;
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
sub MAIN ($filename = 'default.ppm') {
|
||||
my $width = my $height = 125;
|
||||
|
||||
# Since P6 is a binary format, open in binary mode
|
||||
my $out = open( $filename, :w, :bin ) or die "$!\n";
|
||||
|
||||
$out.say("P6\n$width $height\n255");
|
||||
|
||||
for ^$height X ^$width -> $r, $g {
|
||||
$out.printf("%c%c%c", $r*2, $g*2, 255-$r*2);
|
||||
}
|
||||
$out.close;
|
||||
}
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
Procedure SaveImageAsPPM(Image, file$, Binary = 1)
|
||||
; Author Roger Rösch (Nickname Macros)
|
||||
IDFiIe = CreateFile(#PB_Any, file$)
|
||||
If IDFiIe
|
||||
If StartDrawing(ImageOutput(Image))
|
||||
WriteStringN(IDFiIe, "P" + Str(3 + 3*Binary))
|
||||
WriteStringN(IDFiIe, "#Created with PureBasic using a Function created from Macros for Rosettacode.org ")
|
||||
width = ImageWidth(Image)
|
||||
height = ImageHeight(Image)
|
||||
WriteStringN(IDFiIe, Str(width) + " " + Str(height))
|
||||
WriteStringN(IDFiIe, "255")
|
||||
If Binary = 0
|
||||
For y = 0 To height - 1
|
||||
For x = 0 To width - 1
|
||||
color = Point(x, y)
|
||||
WriteString(IDFiIe, Str(Red(color)) + " " + Str(Green(color)) + " " + Str(Blue(color)) + " ")
|
||||
Next
|
||||
WriteStringN(IDFiIe, "")
|
||||
Next
|
||||
Else ; Save in Binary Format
|
||||
For y = 0 To height - 1
|
||||
For x = 0 To width - 1
|
||||
color = Point(x, y)
|
||||
WriteByte(IDFiIe, Red(color))
|
||||
WriteByte(IDFiIe, Green(color))
|
||||
WriteByte(IDFiIe, Blue(color))
|
||||
Next
|
||||
Next
|
||||
EndIf
|
||||
StopDrawing()
|
||||
EndIf
|
||||
CloseFile(IDFiIe)
|
||||
EndIf
|
||||
EndProcedure
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
$ include "seed7_05.s7i";
|
||||
include "draw.s7i";
|
||||
include "color.s7i";
|
||||
|
||||
const proc: writePPM (in string: fileName, in PRIMITIVE_WINDOW: aWindow) is func
|
||||
local
|
||||
var file: ppmFile is STD_NULL;
|
||||
var integer: x is 0;
|
||||
var integer: y is 0;
|
||||
var color: pixColor is black;
|
||||
begin
|
||||
ppmFile := open(fileName, "w");
|
||||
if ppmFile <> STD_NULL then
|
||||
writeln(ppmFile, "P6");
|
||||
writeln(ppmFile, width(aWindow) <& " " <& height(aWindow));
|
||||
writeln(ppmFile, "255");
|
||||
for y range 0 to pred(height(aWindow)) do
|
||||
for x range 0 to pred(width(aWindow)) do
|
||||
pixColor := getPixelColor(aWindow, x, y);
|
||||
write(ppmFile, str(chr(pixColor.red_part)) <& chr(pixColor.green_part) <& chr(pixColor.blue_part));
|
||||
end for;
|
||||
end for;
|
||||
close(ppmFile);
|
||||
end if;
|
||||
end func;
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
Public Shared Sub SaveRasterBitmapToPpmFile(ByVal rasterBitmap As RasterBitmap, ByVal filepath As String)
|
||||
Dim header As String = String.Format("P6{0}{1}{2}{3}{0}255{0}", vbLf, rasterBitmap.Width, " "c, rasterBitmap.Height)
|
||||
Dim bufferSize As Integer = header.Length + (rasterBitmap.Width * rasterBitmap.Height * 3)
|
||||
Dim bytes(bufferSize - 1) As Byte
|
||||
Buffer.BlockCopy(Encoding.ASCII.GetBytes(header.ToString), 0, bytes, 0, header.Length)
|
||||
Dim index As Integer = header.Length
|
||||
For y As Integer = 0 To rasterBitmap.Height - 1
|
||||
For x As Integer = 0 To rasterBitmap.Width - 1
|
||||
Dim color As Rgb = rasterBitmap.GetPixel(x, y)
|
||||
bytes(index) = color.R
|
||||
bytes(index + 1) = color.G
|
||||
bytes(index + 2) = color.B
|
||||
index += 3
|
||||
Next
|
||||
Next
|
||||
My.Computer.FileSystem.WriteAllBytes(filepath, bytes, False)
|
||||
End Sub
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
include c:\cxpl\codes; \intrinsic 'code' declarations
|
||||
def Width=180, Height=135, Color=$123456;
|
||||
|
||||
proc WriteImage; \Write screen image to a a PPM file
|
||||
int X, Y, C;
|
||||
[Text(3,"P6 "); IntOut(3,Width); ChOut(3,^ ); IntOut(3,Height); Text(3," 255
|
||||
");
|
||||
for Y:= 0 to Height-1 do
|
||||
for X:= 0 to Width-1 do
|
||||
[C:= ReadPix(X, Y);
|
||||
ChOut(3, C>>16);
|
||||
ChOut(3, C>>8);
|
||||
ChOut(3, C);
|
||||
];
|
||||
];
|
||||
|
||||
proc OpenOutFile(FN); \Open for output the named file
|
||||
char FN; \file name string
|
||||
int H; \handle
|
||||
[H:= FOpen(FN, 1);
|
||||
FSet(H, ^o); \small buffer allows multiple files, and it is
|
||||
OpenO(3); \ closed automatically when the program exits
|
||||
];
|
||||
|
||||
proc MakeImage; \Make a bitmap image
|
||||
int X, Y;
|
||||
[for Y:= 0 to Height-1 do \fill area with Color
|
||||
for X:= 0 to Width-1 do
|
||||
Point(X, Y, Color);
|
||||
Move(60, 60); HexOut(6, ReadPix(0,0)); \show hex value of color of pixel at 0,0
|
||||
];
|
||||
|
||||
[SetVid($112); \set display for 640x480 graphics in 24-bit RGB color
|
||||
MakeImage;
|
||||
OpenOutFile("IMAGE.PPM");
|
||||
WriteImage;
|
||||
SetVid(3); \restore display to normal text mode
|
||||
]
|
||||
Loading…
Add table
Add a link
Reference in a new issue