Version:0.9 StartHTML:0000000105 EndHTML:0000079752 StartFragment:0000001053 EndFragment:0000079736
PROGRAM PPM2BitMap2ppmFix2PNG_V3;
//https://softwareschule.code.blog/2020/11/18/sphere-script/
//https://rosettacode.org/wiki/Bitmap/Write_a_PPM_file#Delphi
//http://paulcuth.me.uk/netpbm-viewer/
//https://rosettacode.org/wiki/Bitmap/Read_a_PPM_file#Delphi
{ write ppm ok - read from sphere ppm now solved! for Tutorial 78 }
//http://www.softwareschule.ch/download/maxbox_starter78.pdf
CONST SHADES ='.:!*oe&#%@' ;
procedure PlaySurpriseMedia2;
var wmp: Variant;
//Maybe you'll be more comfortable with automation.
//I believe it would provide most functionality as interfaces provide.
begin
wmp:= CreateOleObject('WMPlayer.OCX');
//wmp.OpenPlayer(Exepath+'examples\maxbox.wav');
if ISInternet then begin
wmp.URL:= 'http://www.kleiner.ch/download/you.mp3';
wmp.OpenPlayer(wmp.URL);
end else
wmp.OpenPlayer(Exepath+'examples\maxbox.wav');
//wmp.controls.play;
end;
procedure ColorToRGB4(const Color: Integer; out R, G, B: Byte);
begin
R:= Color and $FF;
G:= (Color shr 8) and $FF;
B:= (Color shr 16) and $FF;
end;
function ColorToRGB4Array(const Color: Integer): TBytes;
begin
result[0]:= Color and $FF;
result[1]:= (Color shr 8) and $FF;
result[2]:= (Color shr 16) and $FF;
end;
function InttoBytes(const Cint: Integer): TBytes;
begin
result[0]:= Cint and $FF;
result[1]:= (Cint shr 8) and $FF;
result[2]:= (Cint shr 16) and $FF;
end;
function RGBToColor4(const R, G, B: Byte): Integer;
begin
Result:= R or (G shl 8) or (B shl 16);
end;
function BytestoInt(const R: TBytes): Integer;
begin
Result:= R[0] or (R[1] shl 8) or (R[2] shl 16);
end;
function ColorToGray(Color: TColor): TColor;
var L: Byte;
begin
L:= round(0.2126*GetRValue(Color)+0.7152*GetGValue(Color)+0.0722*
GetBValue(Color));
Result:= RGB(L, L, L);
end;
procedure TBitmapHelperSaveAsPPM_4(FileName: TFileName; abit: TBitmap;
useGrayScale: Boolean);
var
i, j: Integer;
Header: AnsiString;
ppm: TMemoryStream;
agb: TBytes;
begin
ppm:= TMemoryStream.Create;
try
Header:= Format('P6'#10'%d %d'#10'255'#10,[abit.Width,abit.Height]);
writeln('Header: '+Header);
ppm.WriteBuffer((Header), Length(Header));
setlength(agb,3)
for i:= 0 to abit.Height- 1 do
for j:= 0 to abit.Width- 1 do begin
if useGrayScale then
agb:= InttoBytes(ColorToGray(ColorToRGB(abit.Canvas.Pixels[j,i])))
else
agb:= InttoBytes((abit.Canvas.Pixels[j,i]));
ppm.Write(stringOf(agb), 3);
//ppm.Write(BytetoString(rgb), 3);
end;
ppm.SaveToFile(FileName);
finally
ppm.Free;
end;
end;
function ReadCharM(ppm: TMemoryStream): AnsiChar;
var mystr: string;
begin
SetLength(mystr, 1);
//insize:= MemStream.read(strBuff2, length(strBuff2));
ppm.Read(mystr, length(mystr));
result:= mystr[1];
//writeln('res: '+(mystr)+itoa(ppm.size))
end;
procedure TBitmapHelperLoadFromPPM(FileName: TFileName; abit: TBitmap;
useGrayScale: Boolean);
var
p, W, H: Integer;
ppm: TMemoryStream;
sW, sH, buffstr, sign: string;
temp: AnsiChar;
Color: TColor;
begin
ppm:= TMemoryStream.Create;
ppm.LoadFromFile(FileName);
ppm.Seek(0,0);
sign:= ReadCharM(ppm) + ReadCharM(ppm);
writeln('sign: '+sign)
if (sign <> ('P2')) and (sign <> ('P6'))
then begin
writeln('read char format signature error exit')
exit;
end;
repeat
temp:= ReadCharM(ppm);
if temp in StrToCharSet('0123456789') then
sW:= sW + temp;
until temp = ' ';
repeat
temp:= ReadCharM(ppm);
if temp in StrToCharSet('0123456789') then
sH:= sH + temp;
until temp = #10;
W:= StrToInt(sW);
H:= StrToInt(sH);
if ReadCharM(ppm)+ ReadCharM(ppm)+ ReadCharM(ppm) <> '255' then Exit;
ReadCharM(ppm); //skip newLine
abit.SetSize(W, H);
p:= 0;
if sign = 'P6' then begin
SetLength(buffstr, 3);
while ppm.Read(buffstr, 3) > 0 do begin
//color:= Bytestoint(bytesof(buffstr))
color:= RGB(ord(buffstr[1]), ord(buffstr[2]), ord(buffstr[3]))
if useGrayScale then
Color:= (ColorToGray(Color));
abit.Canvas.Pixels[p mod W, p div W]:= Color;
inc(p);
end;
end;
if sign = 'P2' then begin
SetLength(buffstr, 3);
while ppm.Read(buffstr,3) > 0 do begin
try
color:= atoi((buffstr));
if color > 255 then color:= 255;
ppm.Read(buffstr,3)
except
color:= 0;
end; //background ReadCharM(ppm);
color:= RGB((color),(color),random(color)); //-random bw!
//if useGrayScale then Color:= ColorToGray(Color); //dark mode
abit.Canvas.Pixels[p mod W, p div W]:= (Color);
inc(p);
end;
ppm.Free;
end;
end;
//https://rosettacode.org/wiki/Draw_a_sphere#DWScript
type TFloat3 = array[0..2] of Float;
var alight : TFloat3; // = [ 30, 30, -50 ];
procedure normalize(var v: TFloat3);
var len: Double;
begin
len:= sqrt(v[0]*v[0] + v[1]*v[1] + v[2]*v[2]);
v[0]:= v[0] / len;
v[1]:= v[1] / len;
v[2]:= v[2] / len;
end;
function dot(x, y: TFloat3): Float;
begin
Result:= x[0]*y[0] + x[1]*y[1] + x[2]*y[2];
if Result<0 then
Result:=-Result
else Result:=0;
end;
procedure drawSpherePPM(R, k, ambient : Float);
var vec : TFloat3;
x, y, b : Float;
i, j, size, intensity : Integer;
begin
size:=Trunc(Ceil(R)-Floor(-R)+1);
PrintLn('P2');
PrintLn(IntToStr(size)+' '+IntToStr(size));
PrintLn('255');
for i := Floor(-R) to Ceil(R) do begin
x := i + 0.5;
for j := Floor(-R) to Ceil(R) do begin
y := j + 0.5;
if (x * x + y * y <= R * R) then begin
vec[0] := x;
vec[1] := y;
vec[2] := sqrt(R * R - x * x - y * y);
normalize(vec);
b := Power(dot(alight, vec), k)+ ambient;
//intensity := Trunc( Round(b*255),0,255); //ClampInt
intensity:= Trunc( Round(b*255));
Print(itoa(intensity));
Print(' ')
end else Print('0 ');
end;
PrintLn('');
end;
end;
procedure drawSpherePPM_Save(R,k,ambient: Float; filename:string);
var vec : TFloat3;
x, y, b: Float;
i, j, size, intensity : Integer;
Header: ansistring; ppm: TMemoryStream ;
agb: TBytes;
begin
size:=Trunc(Ceil(R)-Floor(-R)+1);
PrintLn('P2');
PrintLn(IntToStr(size)+' '+IntToStr(size));
PrintLn('255');
ppm:= TMemoryStream.Create;
try
Header:= Format('P2'#10'%d %d'#10'255'#10, [size, size]);
ppm.WriteBuffer((Header), Length(Header));
for i := Floor(-R) to Ceil(R) do begin
x := i + 0.5;
for j := Floor(-R) to Ceil(R) do begin
y := j + 0.5;
if (x * x + y * y <= R * R) then begin
vec[0]:= x;
vec[1]:= y;
vec[2]:= sqrt(R * R - x * x - y * y);
normalize(vec);
b := Power(dot(alight, vec), k) + ambient;
//intensity := Trunc( Round(b*255), 0, 255); //ClampInt
intensity:= trunc( Round(b*255));
//agb:= InttoBytes(ColorToRGB(intensity));
ppm.Write(itoa(intensity), 3);
//Print(' ')
ppm.Write(' ',3); //1
end else begin
ppm.Write('0 ',3); //2
//Print('0 ');
end;
end;
ppm.SaveToFile(filename);
//PrintLn('');
end;
finally
ppm.Free;
end;
end;
var bitmap: TBitmap ;
begin //@main
{if not (Fileexists('1004unixdict.txt') or
fileexists('unixdict.txt')) then
if IsInternet then begin
writeln(dictURL)
wGetX2(dictUrl,Exepath+'1004unixdict.txt');
openFile(Exepath+'1004unixdict.txt')
end; //}
//memo2.font.name:= 'arial'; //writeln(getworld)
(* bitmap:= TBitmap.Create;
bitmap.LoadFromFile(exepath+'\web\coffeemax.bmp');
//SaveAsPPM('Output.ppm');
writeln('bitmap size '+itoa(bitmap.width))
TBitmapHelperSaveAsPPM_4(exepath+'\web\coffeemaxg.ppm',bitmap,false); //gray
sleep(1000)
// Load as ppm and convert in grayscale
TBitmapHelperLoadFromPPM(exepath+'\web\coffeemaxg.ppm',bitmap,false)
// Save as bmp
bitmap.SaveToFile(exepath+'\web\coffeemaxgout.bmp');
openfile(exepath+'\web\coffeemaxgout.bmp')
bitmap.Free; //*)
// Second Scenario with Aspect Ratio not Square
(* bitmap:= TBitmap.Create;
bitmap.LoadFromFile(exepath+'\web\manmachine.bmp');
//SaveAsPPM('Output.ppm');
writeln('bitmap size '+itoa(bitmap.width))
TBitmapHelperSaveAsPPM_4(exepath+'\web\manmachine.ppm',bitmap,true); //grayscal
sleep(1000)
// Load as ppm and convert in grayscale
TBitmapHelperLoadFromPPM(exepath+'\web\manmachine.ppm',bitmap,false)
// Save as bmp
bitmap.SaveToFile(exepath+'\web\manmachine2.bmp');
openfile(exepath+'\web\manmachine2.bmp')
bitmap.Free; //*)
if Not DirectoryExists(exepath+'\web\') then CreateDir(exepath+'\web\');
alight[0]:= 30; alight[1]:= 30; alight[2]:= -50;
normalize(alight);
//ProcessmessagesOFF;
drawSpherePPM_Save(180,4,0.1, exepath+'\web\spheremaxsmall180.ppm');
//ProcessmessagesON; //}
bitmap:= TBitmap.Create;
// Load as ppm and convert in grayscale
TBitmapHelperLoadFromPPM(exepath+'\web\spheremaxsmall180.ppm',bitmap,false)
//TBitmapHelperLoadFromPPM(exepath+'\web\coffeemaxg.ppm',bitmap, false)
// Save as bmp and convert to png
bitmap.SaveToFile(exepath+'\web\spheremaxsmallout2.bmp');
openfile(exepath+'\web\spheremaxsmallout2.bmp')
bitmap.Free; //*)
ConvertImage(Exepath+'\web\spheremaxsmallout2.bmp',
Exepath+'\web\spheremaxsmallout2.png')
//drawSpherePPM(R, k, ambient : Float);
//PlaySound('.\web\bellsound.wav', hInstance, SND_ASYNC);
End.
Doc: The portable pixmap format (PPM), portable graymap format (PGM) and portable bitmap
format (PBM) are image file formats designed to be easily exchanged between platforms. They are
also sometimes referred to collectively as portable anymap format (PNM), not to be
confused with the related portable arbitrary map format (PAM).
Ref: http://www.softwareschule.ch/download/maxbox_starter78.pdf
mX4 executed: 10/12/2020 10:46:57 Runtime: 0:0:21.548 Memload: 73% use
ref: http://paulcuth.me.uk/netpbm-viewer/
ref: RNA: "AUGUUUUCUUAAAUG" =>
Codons: "AUG", "UUU", "UCU", "UAA", "AUG" =>
Protein: "Methionine", "Phenylalanine", "Serine"
Ref: https://planetcalc.com/2476/?events=0.75%200.25&message=Lorem%20ipsum%20dolor%20sit%20amet%2C%20consectetur%20adipisicing%20elit%2C%20sed%20do%20eiusmod%20tempor%20incididunt%20ut%20labore%20et%20dolore%20magna%20aliqua.&ignorecase=0&ignorespace=0
ref: https://natureofcode.com/book/chapter-10-neural-networks/
HttpReq.setRequestHeader('Content-Type', 'application/x-www-form-urlencoded');
https://docs.microsoft.com/en-us/windows/win32/winhttp/iwinhttprequest-setrequestheader
https://onlinehelp.opswat.com/mdcloud/2._API_Authentication_Mechanisms.html
https://github.com/maxkleiner/maXbox4/blob/master/objectdetector3.ipynb
http://www.softwareschule.ch/examples/detector2.htm
morse_codes = {
'A': '.-', 'B': '-...', 'C': '-.-.', 'D': '-..', 'E': '.', 'F': '..-.',
'G': '--.', 'H': '....', 'I': '..', 'J': '.---', 'K': '-.-', 'L': '.-..',
'M': '--', 'N': '-.', 'O': '---', 'P': '.--.', 'Q': '--.-', 'R': '.-.',
'S': '...', 'T': '-', 'U': '..-', 'V': '...-', 'W': '.--', 'X': '-..-',
'Y': '-.--', 'Z': '--..', ' ': ' ', '0': '-----',
'1': '.----', '2': '..---', '3': '...--', '4': '....-', '5': '.....',
'6': '-....', '7': '--...', '8': '---..', '9': '----.',
'&': '.-...', "'": '.----.', '@': '.--.-.', ')': '-.--.-', '(': '-.--.',
':': '---...', ',': '--..--', '=': '-...-', '!': '-.-.--', '.': '.-.-.-',
'-': '-....-', '+': '.-.-.', '"': '.-..-.', '?': '..--..', '/': '-..-.'
}
https://maxbox4.files.wordpress.com/2020/07/bastatv.png?w=576&h=&zoom=2
https://repl.it/@maxbox/machinelearning4#main.py