Version:0.9 StartHTML:0000000105 EndHTML:0000079752 StartFragment:0000001053 EndFragment:0000079736 mXScriptasHTML
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