{ Protein renderer that parses rendering info from the Biochemfusion
  protein cartridge and produces a graphical output on a standard
  TCanvas.

(C) 2008 Jan Holst Jensen, jan@biochemfusion.com.

This pascal source code unit (ProteinRenderer.pas) is released under a BSD-style
license:

* Copyright (C) 2008, Biochemfusion (http://www.biochemfusion.com)
* All rights reserved.
*
* Redistribution and use for any purpose in source and binary forms, with or
* without modification, are permitted, subject to the following restrictions:
*
* 1. The origin of this software must not be misrepresented; you must not
*    claim that you wrote the original software. If you use this software
*    in a product, an acknowledgment in the product documentation would be
*    appreciated but is not required.
* 2. Altered source versions must be plainly marked as such, and must not be
*    misrepresented as being the original software.
* 3. This notice may not be removed or altered from any source distribution. 
*
* THIS SOFTWARE IS PROVIDED BY Biochemfusion ``AS IS'' AND ANY
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
* DISCLAIMED. IN NO EVENT SHALL Biochemfusion BE LIABLE FOR ANY
* DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

}
unit ProteinRenderer;

interface

uses
  Windows, SysUtils, Classes, Graphics;

type
  EProteinRenderer = class(Exception);

  TProteinRenderer = class
  protected
    CellSize: Integer;
    LineSpacing: Integer;
    LettersPerLine: Integer;
    NumRows: Integer;
    ResidueCount: Integer;
    procedure Check(Condition: Boolean; const ErrMsg: String);
  public
    procedure Render(const RenderInfo: String; Rect: TRect; ACanvas: TCanvas);
  end;

implementation

uses
  Math, ProteinRendererConsts;

{ TProteinRenderer }

const
  { Maximum number of digits in numbering. }
  MAX_NUM_DIGITS = 5;
  MAX_NUM_DIGITS_FORMATSTR = '%5d';

  NUM_CHAIN_BACKGND_COLORS = 2;
  CHAIN_BACKGND_COLORS: array [0..NUM_CHAIN_BACKGND_COLORS - 1] of TColor =
    (clMoneyGreen, clSkyBlue);

  NUM_CHAIN_HILITE_COLORS = 2;
  CHAIN_HILITE_COLORS: array [0..NUM_CHAIN_HILITE_COLORS - 1] of TColor =
    (clLime, clAqua);

  NUM_DISULFIDE_COLORS = 3;
  DISULFIDE_COLORS: array [0..NUM_DISULFIDE_COLORS - 1] of TColor =
     { RGB(255, 0, 0), RGB(255, 100, 0), RGB(255, 0, 100) }
    ( 255, 25855, 6553855 );

  NUM_CYCLE_COLORS = 3;
  CYCLE_COLORS: array [0..NUM_CYCLE_COLORS - 1] of TColor =
     { RGB(0, 220, 0), RGB(150, 220, 0), RGB(0, 220, 150) }
    ( 56320, 56470, 9886720);

procedure TProteinRenderer.Check(Condition: Boolean; const ErrMsg: String);
begin
  if not Condition then
    raise EProteinRenderer.Create(ErrMsg);
end;

procedure TProteinRenderer.Render(const RenderInfo: String; Rect: TRect; ACanvas: TCanvas);
var
  FromPos, ToPos: Integer;

  procedure NextDelim(const Delims: String; MustExist: Boolean);
  begin
    while (ToPos <= Length(RenderInfo)) and (not IsDelimiter(Delims, RenderInfo, ToPos)) do
      inc(ToPos);
    if MustExist then
      Check(ToPos <= Length(RenderInfo), 'Missing "' + Delims + '".');
  end;

  function NextInt: Integer;
  begin
    ToPos := FromPos;
    NextDelim(SEQ_RNDR_DELIM, true);
    Check(ToPos <> FromPos, 'Missing value.');
    Result := StrToInt(copy(RenderInfo, FromPos, ToPos - FromPos));
    FromPos := ToPos + 1;
  end;

  function LastInt: Integer;
  begin
    ToPos := FromPos;
    NextDelim(SEQ_RNDR_TAG_START, true);
    Check(ToPos <> FromPos, 'Missing value.');
    Result := StrToInt(copy(RenderInfo, FromPos, ToPos - FromPos));
    FromPos := ToPos;
  end;

  function NextOrLastInt: Integer;
  begin
    ToPos := FromPos;
    NextDelim(SEQ_RNDR_DELIM + SEQ_RNDR_TAG_START, true);
    Check(ToPos <> FromPos, 'Missing value.');
    Result := StrToInt(copy(RenderInfo, FromPos, ToPos - FromPos));
    FromPos := ToPos;
    if RenderInfo[FromPos] = SEQ_RNDR_DELIM then
      inc(FromPos);
  end;

var
  XScale: Double;
  YScale: Double;
  XOffset: Integer;

  function XToPixels(X: Integer): Integer;
  begin
    Result := round(X * XScale);
  end;

  function YToPixels(Y: Integer): Integer;
  begin
    Result := round(Y * YScale);
  end;

  function XToScreen(X: Integer): Integer;
  begin
    Result := XToPixels(X) + XOffset + Rect.Left;
  end;

  function YToScreen(Y: Integer): Integer;
  begin
    Result := YToPixels(Y) + YToPixels(LineSpacing) + Rect.Top;
  end;


  procedure ReadHeader;
  begin
    // Valid render info at all ?
    Check(
      copy(RenderInfo, 1, Length(SEQ_RNDR_TAG_INFO_BEGIN)) = SEQ_RNDR_TAG_INFO_BEGIN,
      'Rendering info must start with header "' + SEQ_RNDR_TAG_INFO_BEGIN + '".'
    );
    Check(
      copy(RenderInfo, Length(SEQ_RNDR_TAG_INFO_BEGIN) + 1, 3) = SEQ_RNDR_TAG_BOUNDBOX,
      'Rendering header must be followed by a bounding box "' + SEQ_RNDR_TAG_BOUNDBOX + '".'
    );
    Check(
      copy(RenderInfo, Length(RenderInfo) - 2, 3) = SEQ_RNDR_TAG_INFO_END,
      'Rendering info must end with an End-of-Data tag "' + SEQ_RNDR_TAG_INFO_END + '".'
    );

    // Read bounding box values.
    FromPos := Length(SEQ_RNDR_TAG_INFO_BEGIN) + Length(SEQ_RNDR_TAG_BOUNDBOX) + 1;
    try
      CellSize       := NextInt;
      LineSpacing    := NextInt;
      LettersPerLine := NextInt;
      NumRows        := NextInt;
      ResidueCount   := LastInt;
    except
      on E: Exception do
        raise EProteinRenderer.CreateFmt('Error reading bounding box: %s', [E.Message]);
    end;
  end;

  procedure RenderFrame;
  begin
    ACanvas.MoveTo(Rect.Left, Rect.Top);
    ACanvas.LineTo(XToScreen(CellSize * (LettersPerLine + 1)), Rect.Top);
    ACanvas.LineTo(XToScreen(CellSize * (LettersPerLine + 1)), Rect.Top + YToPixels((CellSize + LineSpacing) * NumRows + LineSpacing));
    ACanvas.LineTo(Rect.Left, Rect.Top + YToPixels((CellSize + LineSpacing) * NumRows + LineSpacing));
    ACanvas.LineTo(Rect.Left, Rect.Top);
  end;

  procedure RenderNumbers;
  var
    i: Integer;
  begin
    for i := 0 to NumRows - 1 do
      ACanvas.TextOut(
        XToScreen((-MAX_NUM_DIGITS + 1) * CellSize),
		YToScreen(i * (CellSize + LineSpacing)),
        Format(MAX_NUM_DIGITS_FORMATSTR, [i * LettersPerLine + 1])
      );
  end;

  procedure RenderTermModMarks(ColorIdx, TermModBits, FromResidueIndex, ToResidueIndex: Integer);

    function ResPosX(ResIdx, XOffset: Integer): Integer;
    begin
      Result := XToScreen( (ResIdx mod LettersPerLine) * CellSize + XOffset );
    end;

    function ResPosY(ResIdx: Integer): Integer;
    begin
      Result := YToScreen( (ResIdx div LettersPerLine) * (CellSize + LineSpacing));
    end;

  var
    RectWidth: Integer;
    X: Integer;
    Y: Integer;
  begin
    ACanvas.Pen.Style   := psDot;
    ACanvas.Pen.Width   := 1;
    ACanvas.Pen.Color   := clGray;
    ACanvas.Brush.Color :=
      CHAIN_HILITE_COLORS[ColorIdx mod NUM_CHAIN_HILITE_COLORS];

    RectWidth := Max(XToPixels(CellSize) div 4, 1);

    if TermModBits and 1 <> 0 then begin
      X := ResPosX(FromResidueIndex, 0);
      Y := ResPosY(FromResidueIndex);
      ACanvas.Rectangle(X, Y, X + RectWidth, Y + YToPixels(CellSize));
    end;
    if TermModBits and 2 <> 0 then begin
      X := ResPosX(ToResidueIndex, CellSize);
      Y := ResPosY(ToResidueIndex);
      ACanvas.Rectangle(X, Y, X - RectWidth, Y + YToPixels(CellSize));
    end;
  end;

  procedure RenderChainBackground(ColorIdx: Integer; TermModBits: Integer; FromResidueIndex, ToResidueIndex: Integer);
  var
    SavedFromIdx: Integer;
    SavedToIdx: Integer;
    RectHeight: Integer;

    ColFrom: Integer;
    ColTo: Integer;
    RectXFrom: Integer;
    RectXTo: Integer;
    RectY: Integer;
  begin
    ACanvas.Pen.Color :=
      CHAIN_BACKGND_COLORS[ColorIdx mod NUM_CHAIN_BACKGND_COLORS];
    ACanvas.Brush.Color :=
      CHAIN_BACKGND_COLORS[ColorIdx mod NUM_CHAIN_BACKGND_COLORS];

    RectHeight   := YToPixels(CellSize) + 1;
    SavedFromIdx := FromResidueIndex;
    SavedToIdx   := ToResidueIndex;

    while FromResidueIndex <= ToResidueIndex do begin
      ColFrom := FromResidueIndex mod LettersPerLine;
      ColTo   := ColFrom + (ToResidueIndex - FromResidueIndex);
      // Wrap onto next line ?
      if ColTo >= LettersPerLine then
        ColTo := LettersPerLine - 1;

      RectXFrom := XToScreen(ColFrom * CellSize);
      RectXTo   := XToScreen(ColTo * CellSize + CellSize);
      RectY     := YToScreen( (FromResidueIndex div LettersPerLine) * (CellSize + LineSpacing) );
      ACanvas.Rectangle(RectXFrom, RectY, RectXTo, RectY + RectHeight);

      FromResidueIndex := FromResidueIndex + ColTo - ColFrom + 1;
    end;

    RenderTermModMarks(ColorIdx, TermModBits, SavedFromIdx, SavedToIdx);
  end;

  procedure RenderChain(var ResidueIndex: Integer);
  var
    i: Integer;
    ChainNo: Integer;
    Chain: String;
    TermModBits: Integer;
    ModFlags: array of Byte;
    //
    VirtX: Integer;
    VirtY: Integer;
    TextXOffset: Integer;
  begin
    ChainNo := NextInt;
    NextDelim(SEQ_RNDR_TAG_START, true);
    Chain   := copy(RenderInfo, FromPos, ToPos - FromPos);
    FromPos := ToPos;

    Check(Length(Chain) > 3, 'Empty chain');
    Check(Chain[1] in ['0', '1'], 'Invalid N-terminal modification flag.');
    Check(Chain[2] in ['0', '1'], 'Invalid C-terminal modification flag.');
    Check(Chain[3] = SEQ_RNDR_DELIM, 'Invalid delimiter after terminal modification flags.');
    TermModBits := 1 * StrToInt(Chain[1]) + 2 * StrToInt(Chain[2]);
    Delete(Chain, 1, 3);

    { Move modification flags into a separate byte array. Note that an extra
      element is added, so 1-based indices can be used like the indices into
      the Chain string - simplifies the logic. }
    SetLength(ModFlags, Length(Chain) + 1);
    { ModFlags may end up being much longer than Length(Chain) if there are
      lots of modifications, but it won't do any harm. Rather that than
      re-allocating memory. }
    FillChar(ModFlags[0], Length(ModFlags), 0);
    for i := 1 to Length(Chain) do
      if Chain[i] in ['1'..'3'] then begin
        ModFlags[i] := StrToInt(Chain[i]);
        Delete(Chain, i, 1);
      end;

    if ChainNo <> 0 then
      RenderChainBackground((ChainNo - 1) mod NUM_CHAIN_BACKGND_COLORS, TermModBits, ResidueIndex, ResidueIndex + Length(Chain) - 1);

    // Render amino acid codes.
    TextXOffset := ACanvas.TextWidth('W') div 2;

    VirtX := (ResidueIndex mod LettersPerLine) * CellSize + CellSize div 2;
    VirtY := (ResidueIndex div LettersPerLine) * (CellSize + LineSpacing);

    ACanvas.Brush.Style := bsClear;
    for i := 1 to Length(Chain) do begin
      if ModFlags[i] and SEQ_RNDR_BITFLAG_DFORM <> 0 then begin
        ACanvas.Pen.Style := psSolid;
        ACanvas.Pen.Color := clWhite;
        ACanvas.MoveTo(XToScreen(VirtX - CellSize div 2), YToScreen(VirtY + CellSize));
        ACanvas.LineTo(XToScreen(VirtX - CellSize div 2 + CellSize), YToScreen(VirtY));
      end;

      if ModFlags[i] and SEQ_RNDR_BITFLAG_MODRES <> 0 then
        ACanvas.Font.Color := clRed
      else
        ACanvas.Font.Color := clBlack;

      ACanvas.TextOut(
        XToScreen(VirtX) - TextXOffset,
        YToScreen(VirtY),
        Chain[i]
      );

      VirtX := VirtX + CellSize;
      if VirtX > CellSize * LettersPerLine then begin
        VirtX := CellSize div 2;
        VirtY := VirtY + CellSize + LineSpacing;
      end;
    end;

    ACanvas.Font.Color := clBlack;
    ResidueIndex := ResidueIndex + Length(Chain);
  end;

  procedure RenderLine(Color: TColor);
  var
    X: Integer;
    Y: Integer;
  begin
    // Currently discard 'from' and 'to' information.
    NextInt;
    NextInt;
    X := NextInt;
    Y := NextInt;
    ACanvas.Pen.Style := psSolid;
    ACanvas.Pen.Width := Max(XToPixels(CellSize) div 4, 2);
    ACanvas.Pen.Color := Color;
    ACanvas.MoveTo(XToScreen(X), YToScreen(Y));
    // Read (X, Y) points of bridge lines.
    while RenderInfo[FromPos] <> SEQ_RNDR_TAG_START do begin
      X := NextInt;
      Y := NextOrLastInt;
      ACanvas.LineTo(XToScreen(X), YToScreen(Y));
    end;
  end;

var
  Tag: String;
  ResidueIndex: Integer;
  DisulfideCount: Integer;
  CycleCount: Integer;
  CycleTerminalFlags: String;
begin
  if RenderInfo = '' then
    Exit;

  ACanvas.Brush.Style := bsSolid;
  try
    ReadHeader;

    XScale  := ACanvas.TextWidth('W') / CellSize * (1 + LineSpacing / CellSize);
    YScale  := ACanvas.TextHeight('W') / CellSize;
    XOffset := ACanvas.TextWidth('W') * (MAX_NUM_DIGITS + 2);

//(**    RenderFrame;
    RenderNumbers;

    ResidueIndex   := 0;
    DisulfideCount := 0;
    CycleCount     := 0;

    Tag     := copy(RenderInfo, FromPos, 3);
    FromPos := FromPos + 3;
    while Tag <> SEQ_RNDR_TAG_INFO_END do begin
      if Tag = SEQ_RNDR_TAG_CHAIN then begin
        try
          RenderChain(ResidueIndex);
        except
          on E: Exception do
            raise EProteinRenderer.CreateFmt('Error rendering chain: %s', [E.Message]);
        end;
      end
      else
      if Tag = SEQ_RNDR_TAG_DISULFIDE then begin
        try
          RenderLine(DISULFIDE_COLORS[DisulfideCount mod NUM_DISULFIDE_COLORS]);
          inc(DisulfideCount);
        except
          on E: Exception do
            raise EProteinRenderer.CreateFmt('Error rendering disulfide bridge: %s', [E.Message]);
        end;
      end
      else
      if Tag = SEQ_RNDR_TAG_CROSSLINK then begin
        try
          { Check validity of terminal flags, but ignore them. }
          CycleTerminalFlags := copy(RenderInfo, FromPos, 3);
          Check(Length(CycleTerminalFlags) = 3, 'Invalid cyclization terminal flags.');
          Check(CycleTerminalFlags[1] in ['0', '1'], 'Invalid cyclization terminal flag.');
          Check(CycleTerminalFlags[2] in ['0', '1'], 'Invalid cyclization terminal flag.');
          Check(CycleTerminalFlags[3] = SEQ_RNDR_DELIM, 'Invalid cyclization terminal flag end delimiter.');
          FromPos := FromPos + 3;
          RenderLine(CYCLE_COLORS[CycleCount mod NUM_CYCLE_COLORS]);
          inc(CycleCount);
        except
          on E: Exception do
            raise EProteinRenderer.CreateFmt('Error reading cycle: %s', [E.Message]);
        end;
      end
      else
        raise EProteinRenderer.CreateFmt('Unsupported render info tag "%s".', [Tag]);
      // Process next tag.
      Tag := copy(RenderInfo, FromPos, 3);
      FromPos := FromPos + 3;
    end;

  except
    on E: Exception do begin
      ACanvas.Pen.Color := clBlack;
      ACanvas.Pen.Style := psSolid;
      ACanvas.Brush.Style := bsSolid;
      ACanvas.Brush.Color := clWindow;
      ACanvas.TextOut(10, 10, E.ClassName + ': ' + E.Message);
    end;
  end;
end;

end.