Data update
This commit is contained in:
Ingy döt Net
parent
72eb4943cb
commit
4d5544505c
2347 changed files with 62432 additions and 16731 deletions
|
|
@ -1,201 +1,202 @@
|
|||
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"
|
||||
Class Bitmap {
|
||||
{ // from version 14
|
||||
Var x As long, y As long, Import As boolean, P5 As boolean
|
||||
If match("NN") Then
|
||||
Read x, y
|
||||
Else.if Match("N") Then
|
||||
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)
|
||||
boolean getW=true, getH=true, getV=true
|
||||
long v
|
||||
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
|
||||
End If
|
||||
}
|
||||
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 If
|
||||
}
|
||||
End Select
|
||||
End If
|
||||
iF eof(f) Then Error "Not a ppm file"
|
||||
until getV=false
|
||||
Else
|
||||
Error "Not a P6 ppm or P5 ppm file"
|
||||
End If
|
||||
Import=True
|
||||
End if
|
||||
Else
|
||||
Error "No proper arguments"
|
||||
End If
|
||||
if x<1 or y<1 Then Error "Wrong dimensions"
|
||||
Buffer Clear Pad1 As Byte*3
|
||||
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
|
||||
aLines=Len(Raster)-Len(Rasterline)-Raster("linesB")
|
||||
blines=-Len(Rasterline)
|
||||
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
|
||||
Image1|linesB[where]=Pad1[0, 3] : where+=3
|
||||
Next
|
||||
Next
|
||||
End if
|
||||
}
|
||||
SetPixel=Lambda Image1, Pad, aLines, blines (x, y, c) ->{
|
||||
if c>0 Then c=color(c)
|
||||
c-!
|
||||
Return Pad, 0:=c As long
|
||||
Push pad[2] : pad[2]=pad[0]: pad[0]=Number
|
||||
Image1|linesB[alines+3*x+blines*y]=Pad[0, 3]
|
||||
}
|
||||
GetPixel=Lambda Image1,aLines, blines, Pad1 (x,y) ->{
|
||||
Pad1[0]=Image1|linesB[alines+3*x+blines*y, 3]
|
||||
=color(Pad1[2], Pad1[1],Pad1[0])
|
||||
}
|
||||
GetPixelGray=Lambda Image1,aLines, blines, Pad1 (x,y) ->{
|
||||
Pad1[0]=Image1|linesB[alines+3*x+blines*y, 3]
|
||||
grayval=round(0.2126*Pad1[2] + 0.7152*Pad1[1] + 0.0722*Pad1[0], 0)
|
||||
=color(grayval,grayval,grayval)
|
||||
}
|
||||
Image$=Lambda$ Image1, Raster ->Eval$(Image1, 0, Len(Raster))
|
||||
Copy=Lambda Image1 (image$) -> {
|
||||
if left$(image$,12)=Image1[0, 24] Then
|
||||
Return Image1, 0:=Image$
|
||||
Else
|
||||
Error "Can't Copy Image"
|
||||
End if
|
||||
}
|
||||
ToFile=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
|
||||
pad[0]=image1|linesB[where, 3]
|
||||
Push pad[2] : pad[2]=pad[0]: pad[0]=Number
|
||||
Put #f, pad : where+=3
|
||||
Next
|
||||
Next
|
||||
}
|
||||
ToFileGray=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
|
||||
Next
|
||||
Next
|
||||
}
|
||||
}
|
||||
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, 800 ' zoom 800%, 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, 800 ' zoom 800%
|
||||
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, 800 ' zoom 800%
|
||||
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, 800 ' zoom 800%, angle 30 degree
|
||||
}
|
||||
Print "Done"
|
||||
}
|
||||
P6P5
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue