Grayscale image: Difference between revisions
no edit summary
No edit summary |
|||
Line 1,354:
return bitmap
end</syntaxhighlight>
=={{header|M2000 Interpreter}}==
<syntaxhighlight lang="m2000 interpreter">
Module P6P5 {
Function Bitmap {
def x as long, y as long, Import as boolean, P5 as boolean
If match("NN") then {
Read x, y
} else.if Match("N") Then {
\\ is a file?
Read f as long
buffer whitespace as byte
if not Eof(f) then {
get #f, whitespace :P6$=eval$(whitespace)
get #f, whitespace : P6$+=eval$(whitespace)
def boolean getW=true, getH=true, getV=true
def long v
\\ str$("P6") has 2 bytes. "P6" has 4 bytes
P5=p6$=str$("P5")
If p6$=str$("P6") or P5 Then {
do {
get #f, whitespace
if Eval$(whitespace)=str$("#") then {
do {get #f, whitespace} until eval(whitespace)=10
} else {
select case eval(whitespace)
case 32, 9, 13, 10
{ if getW and x<>0 then {
getW=false
} else.if getH and y<>0 then {
getH=false
} else.if getV and v<>0 then {
getV=false
}
}
case 48 to 57
{if getW then {
x*=10
x+=eval(whitespace, 0)-48
} else.if getH then {
y*=10
y+=eval(whitespace, 0)-48
} else.if getV then {
v*=10
v+=eval(whitespace, 0)-48
}
}
End Select
}
iF eof(f) then Error "Not a ppm file"
} until getV=false
} else Error "Not a P6 ppm or P5 ppm file"
Import=True
}
} else Error "No proper arguments"
if x<1 or y<1 then Error "Wrong dimensions"
structure rgb {
red as byte
green as byte
blue as byte
}
m=len(rgb)*x mod 4
if m>0 then m=4-m ' add some bytes to raster line
m+=len(rgb) *x
Structure rasterline {
{
pad as byte*m
}
hline as rgb*x
}
Structure Raster {
magic as integer*4
w as integer*4
h as integer*4
{
linesB as byte*len(rasterline)*y
}
lines as rasterline*y
}
Buffer Clear Image1 as Raster
Return Image1, 0!magic:="cDIB", 0!w:=Hex$(x,2), 0!h:=Hex$(y, 2)
if not Import then Return Image1, 0!lines:=Str$(String$(chrcode$(255), Len(rasterline)*y))
Buffer Clear Pad as Byte*4
SetPixel=Lambda Image1, Pad,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x, y, c) ->{
where=alines+3*x+blines*y
if c>0 then c=color(c)
c-!
Return Pad, 0:=c as long
Return Image1, 0!where:=Eval(Pad, 2) as byte, 0!where+1:=Eval(Pad, 1) as byte, 0!where+2:=Eval(Pad, 0) as byte
}
GetPixel=Lambda Image1,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x,y) ->{
where=alines+3*x+blines*y
=color(Eval(image1, where+2 as byte), Eval(image1, where+1 as byte), Eval(image1, where as byte))
}
GetPixelGray=Lambda Image1,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x,y) ->{
where=alines+3*x+blines*y
grayval=round(0.2126*Eval(image1, where+2 as byte) + 0.7152*Eval(image1, where+1 as byte) + 0.0722*Eval(image1, where as byte), 0)
=color(grayval,grayval,grayval)
}
StrDib$=Lambda$ Image1, Raster -> {
=Eval$(Image1, 0, Len(Raster))
}
CopyImage=Lambda Image1 (image$) -> {
if left$(image$,12)=Eval$(Image1, 0, 24 ) Then {
Return Image1, 0:=Image$
} Else Error "Can't Copy Image"
}
Export2File=Lambda Image1, x, y (f) -> {
Print #f, "P6";chr$(10);"# Created using M2000 Interpreter";chr$(10);
Print #f, x;" ";y;" 255";chr$(10);
x2=x-1 : where=0 : rasterline=x*3
m=rasterline mod 4 : if m<>0 then rasterline+=4-m
Buffer pad as byte*3
For y1=y-1 to 0 {
where=rasterline*y1
For x1=0 to x2 {
Return pad, 0:=eval$(image1, 0!linesB!where, 3)
Push Eval(pad, 2) : Return pad, 2:=Eval(pad, 0), 0:=Number
Put #f, pad : where+=3
}
}
}
Export2FileGray=Lambda Image1, x, y (f) -> {
Print #f, "P5";chr$(10);"# Created using M2000 Interpreter";chr$(10);
Print #f, x;" ";y;" 255";chr$(10);
x2=x-1 : where=0 : rasterline=x*3
m=rasterline mod 4 : if m<>0 then rasterline+=4-m
Buffer pad as byte*3
Buffer bytepad as byte
const R=0.2126, G=0.7152, B=0.0722
For y1=y-1 to 0 {
where=rasterline*y1
For x1=0 to x2 {
Return pad, 0:=eval$(image1, 0!linesB!where, 3)
Return bytepad, 0:=round(R*Eval(pad, 2) + G*Eval(pad, 1) + B*Eval(pad, 0), 0)
Put #f, bytepad : where+=3
}
}
}
if Import then {
x0=x-1 : where=0
Buffer Pad1 as byte*3
Buffer Pad2 as byte
local rasterline=x*3
m=rasterline mod 4 : if m<>0 then rasterline+=4-m
For y1=y-1 to 0 {
where=rasterline*y1
For x1=0 to x0 {
if p5 then
Get #f, Pad2: m=eval(Pad2,0) : Return pad1, 0:=m, 1:=m, 2:=m
else
Get #f, Pad1 : Push Eval(pad1, 2) : Return pad1, 2:=Eval(pad1, 0), 0:=Number
End if
Return Image1, 0!linesB!where:=Eval$(Pad1) : where+=3
}
}
}
Group Bitmap {
SetPixel=SetPixel
GetPixel=GetPixel
Image$=StrDib$
Copy=CopyImage
ToFile=Export2File
ToFileGray=Export2FileGray
GetPixelGray=GetPixelGray
}
=Bitmap
}
Cls 5,0
A=Bitmap(15,10)
B=Bitmap(15,10)
c1=color(100, 200, 255)
c2=color(180, 250, 128)
For i=0 to 8
Call A.SetPixel(i, i, c1)
Call A.SetPixel(9, i,c2)
Next
Call A.SetPixel(i,i,c1)
// make a new one GrayScale (but 24bit) as B
For i=0 to 14 { For J=0 to 9 {Call B.SetPixel(i, j, A.GetPixelGray(i,j))}}
// place image A at 200 pixel from left margin, 100 pixel from top margin
Copy 200*twipsX, 100*twipsY use A.Image$(), 0, 400 ' zoom 400%, angle 0
// place image B at 400 pixel from left margin, 100 pixel from top margin
Copy 400*twipsX, 100*twipsY use B.Image$(), 0, 400 ' zoom 400%
Try {
Open "P6example.ppm" For Output as #f
Call A.Tofile(f)
Close #f
Open "P5example.ppm" For Output as #f
Call A.TofileGray(f)
Close #f
Open "P5example.ppm" For Input as #f
C=Bitmap(f)
close #f
Copy 600*twipsX, 100*twipsY use C.Image$(), 0, 400 ' zoom 400%
Open "P6example.ppm" For Input as #f
C=Bitmap(f)
close #f
// use of Top clause to make the border color transparent at rotation
Copy 800*twipsX, 100*twipsY top C.Image$(), 30, 400 ' zoom 400%, angle 30 degree
}
Print "Done"
}
P6P5
</syntaxhighlight>
[[File:Grayscale.png|thumb|alt=M2000 Console Output|M2000 Console Output]]
=={{header|Maple}}==
| |||