Data update
This commit is contained in:
Ingy döt Net
parent
8e4e15fa56
commit
72eb4943cb
1853 changed files with 35514 additions and 9441 deletions
|
|
@ -1,7 +1,8 @@
|
|||
Dim As Integer ancho = 150, alto = 200
|
||||
Dim As Integer ancho, alto
|
||||
ancho = 150: alto = 200
|
||||
Dim As Integer x, y ' width, height
|
||||
Dim As Ubyte kolor
|
||||
Screenres ancho,alto,32
|
||||
Dim As Ulong kolor
|
||||
Screenres ancho, alto, 32
|
||||
|
||||
' Draw circles
|
||||
Screenlock
|
||||
|
|
@ -10,24 +11,26 @@ Circle (75, 100), 35, Rgb(0, 255, 0),,,, F
|
|||
Circle (75, 100), 20, Rgb(0, 0, 255),,,, F
|
||||
Screenunlock
|
||||
|
||||
' Create PPM file header
|
||||
Dim encabezado As String
|
||||
encabezado = "P6" & Chr(10) & Str(ancho) & " " & Str(alto) & Chr(10) & "255" & Chr(10)
|
||||
|
||||
' Open PPM file to write
|
||||
Dim As Integer ff = Freefile
|
||||
Open "i:\example.PPM" For Binary As #ff
|
||||
Put #ff, , encabezado
|
||||
Open "example.ppm" For Binary As #ff
|
||||
If Err > 0 Then Print "Error opening output file": End
|
||||
|
||||
' Create PPM file header
|
||||
Print #ff, "P6"
|
||||
Print #ff, "# Created using FreeBASIC"
|
||||
Print #ff, ancho & " " & alto
|
||||
Print #ff, "255"
|
||||
|
||||
' Write image data to PPM file
|
||||
For y = 0 To alto - 1
|
||||
For x = 0 To ancho - 1
|
||||
kolor = Point(x, y)
|
||||
Put #ff, , Chr( kolor And &HFF) ' Red
|
||||
Put #ff, , Chr((kolor Shr 8) And &HFF) ' Green
|
||||
Put #ff, , Chr((kolor Shr 16) And &HFF) ' Blue
|
||||
Next x
|
||||
Next y
|
||||
Put #ff, , Cbyte(kolor Shr 8) ' Green
|
||||
Put #ff, , Cbyte(kolor) ' Blue
|
||||
Put #ff, , Cbyte(kolor Shr 16) ' Red
|
||||
Next
|
||||
Next
|
||||
|
||||
Close #ff
|
||||
|
||||
|
|
|
|||
|
|
@ -50,26 +50,28 @@ Module Checkit {
|
|||
Return Image1, 0:=Image$
|
||||
} Else Error "Can't Copy Image"
|
||||
}
|
||||
Export2File=Lambda Image1, x, y (f) -> {
|
||||
Export2File=Lambda Image1, x, y, r=len(rasterline) (f) -> {
|
||||
\\ use this between open and close
|
||||
Print #f, "P3"
|
||||
Print #f,"# Created using M2000 Interpreter"
|
||||
Print #f, x;" ";y
|
||||
Print #f, 255
|
||||
x2=x-1
|
||||
where=24
|
||||
For y1= 0 to y-1 {
|
||||
For y1= y-1 to 0 {
|
||||
a$=""
|
||||
For x1=0 to x2 {
|
||||
Print #f, a$;Eval(Image1, where +2 as byte);" ";
|
||||
where=24+r*y1
|
||||
x1=0
|
||||
Print #f, Eval(Image1, where +2 as byte);" ";
|
||||
Print #f, Eval(Image1, where+1 as byte);" ";
|
||||
Print #f, Eval(Image1, where as byte);
|
||||
where+=3
|
||||
For x1=1 to x2 {
|
||||
Print #f, " ";Eval(Image1, where +2 as byte);" ";
|
||||
Print #f, Eval(Image1, where+1 as byte);" ";
|
||||
Print #f, Eval(Image1, where as byte);
|
||||
where+=3
|
||||
a$=" "
|
||||
}
|
||||
Print #f
|
||||
m=where mod 4
|
||||
if m<>0 then where+=4-m
|
||||
}
|
||||
}
|
||||
Group Bitmap {
|
||||
|
|
@ -81,31 +83,10 @@ Module Checkit {
|
|||
}
|
||||
=Bitmap
|
||||
}
|
||||
|
||||
A=Bitmap(10, 10)
|
||||
Call A.SetPixel(5,5, color(128,0,255))
|
||||
Open "A2.PPM" for Output as #F
|
||||
Call A.ToFile(F)
|
||||
Close #f
|
||||
' is the same as this one
|
||||
Try {
|
||||
Open "A.PPM" for Output as #F
|
||||
Print #f, "P3"
|
||||
Print #f,"# Created using M2000 Interpreter"
|
||||
Print #f, 10;" ";10
|
||||
Print #f, 255
|
||||
For y=10-1 to 0 {
|
||||
a$=""
|
||||
For x=0 to 10-1 {
|
||||
rgb=-A.GetPixel(x, y)
|
||||
Print #f, a$;Binary.And(rgb, 0xFF); " ";
|
||||
Print #f, Binary.And(Binary.Shift(rgb, -8), 0xFF); " ";
|
||||
Print #f, Binary.Shift(rgb, -16);
|
||||
a$=" "
|
||||
}
|
||||
Print #f
|
||||
}
|
||||
Close #f
|
||||
}
|
||||
}
|
||||
Checkit
|
||||
|
|
|
|||
|
|
@ -1,177 +1,180 @@
|
|||
Module PPMbinaryP6 {
|
||||
If Version<9.4 then 1000
|
||||
If Version=9.4 Then if Revision<19 then 1000
|
||||
Module Checkit {
|
||||
Function Bitmap {
|
||||
def x as long, y as long
|
||||
If match("NN") then {
|
||||
Read x, y
|
||||
} else.if Match("N") Then {
|
||||
E$="Not a ppm file"
|
||||
Read f as long
|
||||
buffer whitespace as byte
|
||||
if not Eof(f) then {
|
||||
get #f, whitespace : iF eof(f) then Error E$
|
||||
P6$=eval$(whitespace)
|
||||
get #f, whitespace : iF eof(f) then Error E$
|
||||
P6$+=eval$(whitespace)
|
||||
def boolean getW=true, getH=true, getV=true
|
||||
def long v
|
||||
\\ str$("P6") has 2 bytes. "P6" has 4 bytes
|
||||
If p6$=str$("P6") Then {
|
||||
do {
|
||||
get #f, whitespace
|
||||
if Eval$(whitespace)=str$("#") then {
|
||||
do {
|
||||
iF eof(f) then Error E$
|
||||
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 E$
|
||||
} until getV=false
|
||||
} else Error "Not a P6 ppm"
|
||||
}
|
||||
} 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
|
||||
}
|
||||
\\ union pad+hline
|
||||
hline as rgb*x
|
||||
}
|
||||
\\ we use union linesB and lines
|
||||
\\ so we can address linesb as bytes
|
||||
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
|
||||
\\ 24 chars as header to be used from bitmap render build in functions
|
||||
Return Image1, 0!magic:="cDIB", 0!w:=Hex$(x,2), 0!h:=Hex$(y, 2)
|
||||
\\ fill white (all 255)
|
||||
\\ Str$(string) convert to ascii, so we get all characters from words width to byte width
|
||||
if not valid(f) 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) -> {
|
||||
\\ use this between open and close
|
||||
Print #f, "P6";chr$(10);
|
||||
Print #f,"# Created using M2000 Interpreter";chr$(10);
|
||||
Print #f, x;" ";y;" 255";chr$(10);
|
||||
x2=x-1
|
||||
where=0
|
||||
Buffer pad as byte*3
|
||||
For y1= 0 to y-1 {
|
||||
For x1=0 to x2 {
|
||||
\\ use linesB which is array of bytes
|
||||
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
|
||||
}
|
||||
m=where mod 4
|
||||
if m<>0 then where+=4-m
|
||||
}
|
||||
}
|
||||
if valid(F) then {
|
||||
x0=x-1
|
||||
where=0
|
||||
Buffer Pad1 as byte*3
|
||||
For y1=y-1 to 0 {
|
||||
For x1=0 to x0 {
|
||||
Get #f, Pad1 ' Read binary
|
||||
\\ reverse rgb
|
||||
Push Eval(pad1, 2)
|
||||
Return pad1, 2:=Eval(pad1, 0), 0:=Number
|
||||
Return Image1, 0!linesB!where:=Eval$(Pad1)
|
||||
where+=3
|
||||
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
|
||||
}
|
||||
m=where mod 4
|
||||
if m<>0 then where+=4-m
|
||||
}
|
||||
}
|
||||
Group Bitmap {
|
||||
SetPixel=SetPixel
|
||||
GetPixel=GetPixel
|
||||
Image$=StrDib$
|
||||
Copy=CopyImage
|
||||
ToFile=Export2File
|
||||
}
|
||||
=Bitmap
|
||||
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
|
||||
}
|
||||
A=Bitmap(10, 10)
|
||||
Call A.SetPixel(5,5, color(128,0,255))
|
||||
Open "A.PPM" for Output as #F
|
||||
Call A.ToFile(F)
|
||||
Close #f
|
||||
|
||||
Print "Saved"
|
||||
Open "A.PPM" for Input as #F
|
||||
C=Bitmap(f)
|
||||
Copy 400*twipsx,200*twipsy use C.Image$()
|
||||
Close #f
|
||||
}
|
||||
Checkit
|
||||
End
|
||||
1000 Error "Need Version 9.4, Revision 19 or higher"
|
||||
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
|
||||
exit
|
||||
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"
|
||||
}
|
||||
PPMbinaryP6
|
||||
p6
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue