{
********************************************************************************

YaPeTaVi - Yet another Periodic Table Viewer
Copyright (C) 2011 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
All rights reserved.
http://www.geoffray-levasseur.org/

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 3 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place - Suite 330, Boston, MA  02111-1307, USA.

********************************************************************************

Description:
   Component displaying electronic distribution and associated tools

}

unit uElecDistClass;

{$mode objfpc}

interface

uses
  Classes, SysUtils, ExtCtrls, Controls;

const
  ElecDiam = 11;

type
  TElecDist = array [1..7] of Byte;
  TElectronicCloud = array[1..7, 1..32] of TShape;

  TElecDistDisplay = class(TComponent)
    private
      FElecDist: TElecDist;
      FElecConf: string;
      FAtomShape: TShape;
      FLayer1Shape: TShape;
      FLayer2Shape: TShape;
      FLayer3Shape: TShape;
      FLayer4Shape: TShape;
      FLayer5Shape: TShape;
      FLayer6Shape: TShape;
      FLayer7Shape: TShape;
      FElectrons: TElectronicCloud;
      FExpandedElecConf: string;
      FOwner: TWinControl;
      procedure SetElecConf(AConf: string);
      procedure GetElecCoord(Layer, Num, Total: Integer; out Top, Left: Integer);
      procedure CreateElectron(var Shape: TShape; Top, Left: integer);
    public
      constructor Create(AOwner: TWinControl); virtual;
      property ElecronicConf: string read FElecConf write SetElecConf;
      property ExpandedElecConf: string read FExpandedElecConf;
    end;

function ExpandElecConf(S: string): string;
function ConvElecConfToDist(Conf: string; out Dist: TElecDist): Boolean;

implementation

uses
  uConst, uDebug, Graphics;

//This function is not generic... It only work with the syntax used in YaPeTaVi
function ExpandElecConf(S: string): string;
const
  ExtHe = '1s2';
  ExtNe = ExtHe + ' 2s2 2p6';
  ExtAr = ExtNe + ' 3s2 3p6';
  ExtKr = ExtAr + ' 3d10 4s2 4p6';
  ExtXe = ExtKr + ' 4d10 5s2 5p6';
  ExtRn = ExtXe + ' 4f14 5d10 6s2 6p6';
var
  Tmp: string;
begin
  PrintLnDbg('Expanding ' + S + '...', vlHigh);
  if (S[1] <> '[') and (S[4] <> ']') then
  begin
    if S[1] <> '1' then //the first layer must be 1s
      Result := ''
    else
      Result := S;
    Exit;
  end else
  begin
    if Pos('He', S) = 2 then
      Result := ExtHe + ' ' + Trim(Copy(S, 5, Length(S) - 4))
    else
      if Pos('Ne', S) = 2 then
        Result := ExtNe + ' ' + Trim(Copy(S, 5, Length(S) - 4))
      else
        if Pos('Ar', S) = 2 then
          Result := ExtAr + ' ' + Trim(Copy(S, 5, Length(S) - 4))
        else
          if Pos('Kr', S) = 2 then
            Result := ExtKr + ' ' + Trim(Copy(S, 5, Length(S) - 4))
          else
            if Pos('Xe', S) = 2 then
              Result := ExtXe + ' ' + Trim(Copy(S, 5, Length(S) - 4))
            else
              if Pos('Rn', S) = 2 then
                Result := ExtRn + ' ' + Trim(Copy(S, 5, Length(S) - 4))
              else
              begin
                Result := ''; //trigger a more explicit error (syntax)
                PrintLnDbg('Exited ExpandElecConf with syntax error!', vlHigh);
              end;
  end;
end;

function ConvElecConfToDist(Conf: string; out Dist: TElecDist): Boolean;
var
  I: Integer;
  Layer: Integer;

  procedure InitDist;
  var
    J: Integer;
  begin
    for J := 1 to 7 do
      Dist[J] := 0;
  end;

begin
  I := 1;
  InitDist;
  Conf := ExpandElecConf(Conf);
  Result := True;
  if Conf = '' then
  begin
    PrintLnDbg('Error while expanding ElecConf... Aborting!', vlLow);
    Result := False;
    Exit;
  end;
  while I <= Length(Conf) do
  begin
    if Conf[I] <> ' ' then
      if Conf[I] in ['1'..'7'] then
      begin
        Layer := StrToInt(Conf[I]);
        Inc(I, 2); //skip the letter as we don't need it for the use we have
        if Conf[I] in ['0'..'9'] then
        begin
          if Conf[I + 1] in ['0'..'9'] then
          begin
            Dist[Layer] := Dist[Layer] + StrToInt(Copy(Conf, I, 2));
            Inc(I, 2);
          end else
          begin
            Dist[Layer] := Dist[Layer] + StrToInt(Conf[I]);
            Inc(I);
          end;
        end else
        begin
          PrintLnDbg('Malformed electronic configuration "' + Conf +
            '" (second check)', vlLow);
          InitDist;
          Result := False;
          Exit;
        end;
      end else
      begin
        PrintLnDbg('Malformed electronic configuration "' + Conf +
          '" (first check)', vlLow);
        InitDist;
        Result := False;
        Exit;
      end
    else
      Inc(I);
  end;
end;

constructor TElecDistDisplay.Create(AOwner: TWinControl);
var
  Max: Integer;
begin
  FOwner := AOwner;
  FElecConf := '';
  FExpandedElecConf := '';
  //make it square taking the lowest lenth of the owner
  if AOwner.Width > AOwner.Height then
    Max := AOwner.Height - 45
  else
    Max := AOwner.Width - 40;
  FLayer7Shape := TShape.Create(AOwner);
  FLayer7Shape.Shape := stCircle;
  FLayer7Shape.Color := clBlack;
  FLayer7Shape.Pen.Style := psSolid;
  FLayer7Shape.Brush.Style := bsClear;
  if AOwner.Width > AOwner.Height then
  begin
    FLayer7Shape.Left := (AOwner.Width - Max) div 2;
    FLayer7Shape.Width := Max;
    FLayer7Shape.Top := 30;
    FLayer7Shape.Height := Max;
  end else
  begin
    FLayer7Shape.Top := (AOwner.Height - Max) div 2;
    FLayer7Shape.Height := Max;
    FLayer7Shape.Left := 25;
    FLayer7Shape.Width := Max;
  end;
  FLayer7Shape.Parent := AOwner;
  FLayer7Shape.Visible := True;

  FLayer6Shape := TShape.Create(AOwner);
  FLayer6Shape.Shape := stCircle;
  FLayer6Shape.Color := clBlack;
  FLayer6Shape.Pen.Style := psSolid;
  FLayer6Shape.Brush.Style := bsClear;
  FLayer6Shape.Top := FLayer7Shape.Top + 17;
  FLayer6Shape.Width := FLayer7Shape.Width - 34;
  FLayer6Shape.Left := FLayer7Shape.Left + 17;
  FLayer6Shape.Height := FLayer7Shape.Height - 34;
  FLayer6Shape.Parent := AOwner;
  FLayer6Shape.Visible := True;

  FLayer5Shape := TShape.Create(AOwner);
  FLayer5Shape.Shape := stCircle;
  FLayer5Shape.Color := clBlack;
  FLayer5Shape.Pen.Style := psSolid;
  FLayer5Shape.Brush.Style := bsClear;
  FLayer5Shape.Top := FLayer6Shape.Top + 17;
  FLayer5Shape.Width := FLayer6Shape.Width - 34;
  FLayer5Shape.Left := FLayer6Shape.Left + 17;
  FLayer5Shape.Height := FLayer6Shape.Height - 34;
  FLayer5Shape.Parent := AOwner;
  FLayer5Shape.Visible := True;

  FLayer4Shape := TShape.Create(AOwner);
  FLayer4Shape.Shape := stCircle;
  FLayer4Shape.Color := clBlack;
  FLayer4Shape.Pen.Style := psSolid;
  FLayer4Shape.Brush.Style := bsClear;
  FLayer4Shape.Top := FLayer5Shape.Top + 17;
  FLayer4Shape.Width := FLayer5Shape.Width - 34;
  FLayer4Shape.Left := FLayer5Shape.Left + 17;
  FLayer4Shape.Height := FLayer5Shape.Height - 34;
  FLayer4Shape.Parent := AOwner;
  FLayer4Shape.Visible := True;

  FLayer3Shape := TShape.Create(AOwner);
  FLayer3Shape.Shape := stCircle;
  FLayer3Shape.Color := clBlack;
  FLayer3Shape.Pen.Style := psSolid;
  FLayer3Shape.Brush.Style := bsClear;
  FLayer3Shape.Top := FLayer4Shape.Top + 17;
  FLayer3Shape.Width := FLayer4Shape.Width - 34;
  FLayer3Shape.Left := FLayer4Shape.Left + 17;
  FLayer3Shape.Height := FLayer4Shape.Height - 34;
  FLayer3Shape.Parent := AOwner;
  FLayer3Shape.Visible := True;

  FLayer2Shape := TShape.Create(AOwner);
  FLayer2Shape.Shape := stCircle;
  FLayer2Shape.Color := clBlack;
  FLayer2Shape.Pen.Style := psSolid;
  FLayer2Shape.Brush.Style := bsClear;
  FLayer2Shape.Top := FLayer3Shape.Top + 17;
  FLayer2Shape.Width := FLayer3Shape.Width - 34;
  FLayer2Shape.Left := FLayer3Shape.Left + 17;
  FLayer2Shape.Height := FLayer3Shape.Height - 34;
  FLayer2Shape.Parent := AOwner;
  FLayer2Shape.Visible := True;

  FLayer1Shape := TShape.Create(AOwner);
  FLayer1Shape.Shape := stCircle;
  FLayer1Shape.Color := clBlack;
  FLayer1Shape.Pen.Style := psSolid;
  FLayer1Shape.Brush.Style := bsClear;
  FLayer1Shape.Top := FLayer2Shape.Top + 17;
  FLayer1Shape.Width := FLayer2Shape.Width - 34;
  FLayer1Shape.Left := FLayer2Shape.Left + 17;
  FLayer1Shape.Height := FLayer2Shape.Height - 34;
  FLayer1Shape.Parent := AOwner;
  FLayer1Shape.Visible := True;

  FAtomShape := TShape.Create(AOwner);
  FAtomShape.Shape := stCircle;
  FAtomShape.Color := clMaroon;
  FAtomShape.Pen.Style := psSolid;
  FAtomShape.Pen.Color := clMaroon;
  FAtomShape.Brush.Style := bsSolid;
  FAtomShape.Brush.Color := clMaroon;
  FAtomShape.Top := FLayer1Shape.Top + 20;
  FAtomShape.Width := FLayer1Shape.Width - 40;
  FAtomShape.Left := FLayer1Shape.Left + 20;
  FAtomShape.Height := FLayer1Shape.Height - 40;
  FAtomShape.Parent := AOwner;
  FAtomShape.Visible := True;
end;

procedure TElecDistDisplay.CreateElectron(var Shape: TShape;
   Top, Left: integer);
begin
  if Shape = nil then
    Shape := TShape.Create(FOwner);
  Shape.Top := Top;
  Shape.Left := Left;
  Shape.Width := ElecDiam;
  Shape.Height := ElecDiam;
  Shape.Color := clBlue;
  Shape.Shape := stCircle;
  Shape.Brush.Color := clBlue;
  Shape.Brush.Style := bsSolid;
  Shape.Pen.Color := clBlue;
  Shape.Pen.Style := psSolid;
  Shape.Visible := True;
  Shape.Parent := FOwner;
end;

procedure TElecDistDisplay.GetElecCoord(Layer, Num, Total: integer;
  out Top, Left: integer);
var
  Teta: Real;
  Shape: TShape;
begin
  case Layer of
    1: Shape := FLayer1Shape;
    2: Shape := FLayer2Shape;
    3: Shape := FLayer3Shape;
    4: Shape := FLayer4Shape;
    5: Shape := FLayer5Shape;
    6: Shape := FLayer6Shape;
    7: Shape := FLayer7Shape;
  end;
  Teta := (Pi / 2) + (2 * Pi * Num) / Total; //calc angle
  Top := Round((Shape.Width / 2) * - Sin(Teta)) +
    Shape.Top + (Shape.Height div 2) - (ElecDiam div 2);
  Left := Round((Shape.Width / 2) * Cos(Teta)) +
    Shape.Left + (Shape.Width div 2) - (ElecDiam div 2);
end;

procedure TElecDistDisplay.SetElecConf(AConf: string);
var
  Layer, I: integer;
  EX, EY: integer;
  LayerShape: TShape;
begin
  for Layer := 1 to 7 do
    for I := 1 to 32 do
    begin
      FElectrons[Layer, I].Free;
      FElectrons[Layer, I] := nil;
    end;
  FElecConf := AConf;
  FExpandedElecConf := ExpandElecConf(AConf);
  if not ConvElecConfToDist(AConf, FElecDist) then
    FElecConf := '';
  //Draw it
  PrintDbg('Distribution is ', vlHigh);
  for I := 1 to 7 do
    PrintDbgResult(IntToStr(FElecDist[I]) + ' ', vlHigh);
  PrintLnDbg(vlHigh);
  for Layer := 1 to 7 do
  begin
    case Layer of
      1: LayerShape := FLayer1Shape;
      2: LayerShape := FLayer2Shape;
      3: LayerShape := FLayer3Shape;
      4: LayerShape := FLayer4Shape;
      5: LayerShape := FLayer5Shape;
      6: LayerShape := FLayer6Shape;
      7: LayerShape := FLayer7Shape;
    end;
    LayerShape.Visible := FElecDist[Layer] > 0;
    if FElecDist[Layer] > 0 then
      for I := 1 to FElecDist[Layer] do
      begin
        GetElecCoord(Layer, I, FElecDist[Layer], EX, EY);
        PrintLnDbg('Showing electron ' + IntToStr(I) + ' on layer ' +
          IntToStr(Layer) + ' at coord ' + IntToStr(EX) + ', ' + IntToStr(EY),
          vlHigh);
        CreateElectron(FElectrons[Layer, I], EX, EY);
      end;
  end;
end;

end.