180 lines
7.1 KiB
Plaintext
180 lines
7.1 KiB
Plaintext
Module P6 {
|
|
Function Bitmap {
|
|
def x as long, y as long, Import as boolean
|
|
If match("NN") then
|
|
Read x, y
|
|
else.if Match("N") Then
|
|
\\ is a file?
|
|
Read f as long
|
|
byte whitespace[0]
|
|
if not Eof(f) then
|
|
get #f, whitespace :P6$=chr$(whitespace[0])
|
|
get #f, whitespace : P6$+=chr$(whitespace[0])
|
|
boolean getW=true, getH=true, getV=true
|
|
long v
|
|
If p6$="P6" Then
|
|
do
|
|
get #f, whitespace
|
|
select case whitespace[0]
|
|
case 35
|
|
{do get #f, whitespace
|
|
until whitespace[0]=10
|
|
}
|
|
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
|
|
end if
|
|
}
|
|
case 48 to 57
|
|
{if getW then
|
|
x*=10
|
|
x+=whitespace[0]-48
|
|
else.if getH then
|
|
y*=10
|
|
y+=whitespace[0]-48
|
|
else.if getV then
|
|
v*=10
|
|
v+=whitespace[0]-48
|
|
end if
|
|
}
|
|
End Select
|
|
iF eof(f) then Error "Not a ppm file"
|
|
until getV=false
|
|
else
|
|
Error "Not a P6 ppm"
|
|
end if
|
|
Import=True
|
|
end if
|
|
else
|
|
Error "No proper arguments"
|
|
end if
|
|
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))
|
|
}
|
|
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
|
|
x0=x*3
|
|
structure rgbP6 {
|
|
r as byte
|
|
g as byte
|
|
b as byte
|
|
}
|
|
buffer Pad as rgbP6*x*y
|
|
For y1=y-1 to 0 {
|
|
Return pad, x*y1:=eval$(image1, 0!linesB!where, x0)
|
|
where+=x0
|
|
m=where mod 4 : if m<>0 then where+=4-m
|
|
}
|
|
For x1=0 to x*y-1 {
|
|
Push Eval(pad, x1!b) : Return pad, x1!b:=Eval(pad, x1!r), x1!r:=Number
|
|
}
|
|
Put #f, pad
|
|
}
|
|
if Import then {
|
|
x0=x-1 : where=0
|
|
structure rgbP6 {
|
|
r as byte
|
|
g as byte
|
|
b as byte
|
|
}
|
|
buffer Pad1 as rgbP6*x*y
|
|
Get #f, Pad1
|
|
For x1=0 to x*y-1 {
|
|
Push Eval(pad1, x1!b) : Return pad1, x1!b:=Eval(pad1, x1!r), x1!r:=Number
|
|
}
|
|
x1=x*3
|
|
For y1=y-1 to 0 {
|
|
Return Image1, 0!linesB!where:=Eval$(Pad1, y1*x, x1)
|
|
where+=3*(x0+1)
|
|
m=where mod 4 : if m<>0 then where+=4-m
|
|
}
|
|
}
|
|
Group Bitmap {
|
|
SetPixel=SetPixel
|
|
GetPixel=GetPixel
|
|
Image$=StrDib$
|
|
Copy=CopyImage
|
|
ToFile=Export2File
|
|
}
|
|
=Bitmap
|
|
}
|
|
A=Bitmap(150,100)
|
|
For i=0 to 98 {
|
|
Call A.SetPixel(i, i, 0)
|
|
Call A.SetPixel(99, i, 0)
|
|
}
|
|
Call A.SetPixel(i,i,0)
|
|
Copy 200*twipsx, 100*twipsy use A.Image$()
|
|
Profiler
|
|
Open "a.ppm" for output as #F
|
|
Call A.tofile(f)
|
|
Close #f
|
|
Print Filelen("a.ppm")
|
|
Print Timecount/1000;"sec"
|
|
Profiler
|
|
Image A.Image$() Export "a.jpg", 100 ' per cent quality
|
|
Print Filelen("a.jpg")
|
|
Image A.Image$() Export "a1.jpg", 10 ' per cent quality
|
|
Print Filelen("a1.jpg")
|
|
Image A.Image$() Export "a.bmp"
|
|
Print Filelen("a.bmp") ' no compression
|
|
Print Timecount/1000;"sec"
|
|
Move 5000,5000 ' twips
|
|
Image "a.jpg"
|
|
Move 5000,8000
|
|
Image "a1.jpg"
|
|
Move 8000, 5000
|
|
Image "a.bmp"
|
|
}
|
|
P6
|