Rainbow-Editor/forms/parametercurvesformunit.pas

unit parametercurvesformunit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls,
  StdCtrls, Spin, ButtonPanel, fpjson, BGRABitmap, BGRABitmapTypes,
  parametercurvegeneratorformunit, database, LCLTranslator;

type

  { TParameterCurvesForm }

  TParameterCurvesForm = class(TForm)
    SetValuesWithMouseCheckBox: TCheckBox;
    ResultButtonPanel: TButtonPanel;
    GenerateButton: TButton;
    ManualSettingsGroupBox: TGroupBox;
    AdvancedGenerationGroupBox: TGroupBox;
    GraphPaintBox: TPaintBox;
    ParamSpinEdit: TSpinEdit;
    ValueLabel: TLabel;
    LevelLabel: TLabel;
    PresetAButton: TButton;
    PresetBButton: TButton;
    PresetCButton: TButton;
    PresetDButton: TButton;
    PresetEButton: TButton;
    QuickGenerationGroupBox: TGroupBox;
    MainPanel: TPanel;
    ParamTabControl: TTabControl;
    LevelSpinEdit: TSpinEdit;
    procedure CancelButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure GenerateButtonClick(Sender: TObject);
    procedure GraphPaintBoxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GraphPaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure GraphPaintBoxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GraphPaintBoxPaint(Sender: TObject);
    procedure LevelSpinEditChange(Sender: TObject);
    procedure OKButtonClick(Sender: TObject);
    procedure ParamSpinEditChange(Sender: TObject);
    procedure ParamTabControlChange(Sender: TObject);
    procedure PresetButtonClick(Sender: TObject);
    procedure SetParamByMouse(X, Y: Integer);
    procedure UpdateParamNames(Db: TDatabase);
  private
    ResultWasAccepted: Boolean;
    IsSettingCurveByMouse: Boolean;
    EditedParams: TJSONArray;
    procedure PresetValues;
    procedure GetGraphData(var OffsetLeft: Integer; var BarWidth: Integer);
    { Generates a param as a curve from StartVal to EndVal. Steepness is a
      number from -10 to 10, -10 is the fastest growth, 10 is the slowest,
      0 is a straight line. }
    procedure GenerateParamCurve(StartVal, EndVal, Steepness: Integer);
  public
    procedure EditParams(Db: TDatabase; ClassObj: TJSONObject; StartingParamId: Integer);
  end;

var
  ParameterCurvesForm: TParameterCurvesForm;

implementation

uses
  constants, globals, Math;

{$R *.lfm}

{ TParameterCurvesForm }

procedure TParameterCurvesForm.PresetButtonClick(Sender: TObject);
var
  ParamId: Integer;
  FromVal, ToVal: Integer;
  Quality: Integer;
begin
  ParamId := ParamTabControl.TabIndex;
  Quality := (Sender as TButton).Tag;
  if ParamId < 2 then begin
    FromVal := 200 + Quality*100 + Random(100);
    ToVal := 4000 + Quality*1000 + Random(1000);
  end else begin
    FromVal := 20 + Quality*10 + Random(10);
    ToVal := 400 + Quality*100 + Random(100);
  end;

  GenerateParamCurve(FromVal, ToVal, 0);
  GraphPaintBox.Refresh
end;

procedure TParameterCurvesForm.ParamTabControlChange(Sender: TObject);
begin
  PresetValues;
  GraphPaintBox.Refresh
end;

procedure TParameterCurvesForm.GraphPaintBoxPaint(Sender: TObject);
var
  BarWidth: Integer = 0;
  OffsetLeft: Integer = 0;
  GraphHeight: Integer;
  Graph: TBGRABitmap;
  ParamId: Integer;
  I: Integer;
  Param: TJSONArray;
  ParamValue, BarHeight: Integer;
  MaxParamValue: Integer;
begin
  GetGraphData(OffsetLeft, BarWidth);
  GraphHeight := GraphPaintBox.Height;
  Graph := TBGRABitmap.Create(BarWidth * 99, GraphHeight, clWhite);

  ParamId := ParamTabControl.TabIndex;
  Param := EditedParams.Arrays[ParamId];
  MaxParamValue := GetMaxParamValue(ParamId);

  Graph.CanvasBGRA.Brush.Color := ColorToBGRA(ParameterColours[ParamId]);
  for I := 0 to 98 do begin
    ParamValue := Param.Integers[I + 1];
    BarHeight := GraphHeight * ParamValue div MaxParamValue;
    Graph.CanvasBGRA.FillRect(BarWidth * I, GraphHeight, BarWidth * (I+1), GraphHeight - BarHeight);
  end;

  Graph.Draw(GraphPaintBox.Canvas, OffsetLeft, 0);

  Graph.Free;
end;

procedure TParameterCurvesForm.CancelButtonClick(Sender: TObject);
begin
  ResultWasAccepted := False;
  Close
end;

procedure TParameterCurvesForm.FormCreate(Sender: TObject);
begin
  {In WinXP, if the top bar is too large, the rest is filled with black (in
   Win10 it's form colour so that works somehow). But in GTK+, if the top bar
   is too small, an exception is triggered.

   So, we use GTK+ size but change the size in Windows}
  {$IF Defined(LCLWin32)}
    ParamTabControl.Height := 20;
  {$ENDIF}
end;

procedure TParameterCurvesForm.GenerateButtonClick(Sender: TObject);
var
  ParamId: Integer;
  Param: TJSONArray;
begin
  ParamId := ParamTabControl.TabIndex;
  Param := EditedParams.Arrays[ParamId];
  if ParameterCurveGeneratorForm.ShowChoice(Param.Integers[0+1],
  Param.Integers[98 + 1], 0, GetMaxParamValue(ParamId)) then
    with ParameterCurveGeneratorForm do begin
      GenerateParamCurve(Level1Value, Level99Value, Smoothness);
      GraphPaintBox.Refresh
    end;
end;

procedure TParameterCurvesForm.GraphPaintBoxMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  IsSettingCurveByMouse := True;
  SetParamByMouse(X, Y);
  GraphPaintBox.Refresh
end;

procedure TParameterCurvesForm.GraphPaintBoxMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if IsSettingCurveByMouse then begin
    SetParamByMouse(X, Y);
    GraphPaintBox.Refresh
  end;
end;

procedure TParameterCurvesForm.GraphPaintBoxMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  IsSettingCurveByMouse := False
end;

procedure TParameterCurvesForm.SetParamByMouse(X, Y: Integer);
var
  ParamId: Integer;
  Param: TJSONArray;
  BarWidth: Integer = 0;
  OffsetLeft: Integer = 0;
  ParamLevel, ParamValue: Integer;
begin
  ParamId := ParamTabControl.TabIndex;
  GetGraphData(OffsetLeft, BarWidth);
  ParamLevel := (X - OffsetLeft) div BarWidth + 1;

  if SetValuesWithMouseCheckBox.Checked then begin
    Param := EditedParams.Arrays[ParamId];
    if (ParamLevel >= 1) and (ParamLevel <= 99) then begin
      ParamValue := (GraphPaintBox.Height - Y) * GetMaxParamValue(ParamId) div GraphPaintBox.Height;
      if ParamValue > GetMaxParamValue(ParamId) then
        ParamValue := GetMaxParamValue(ParamId);

      if ParamValue < 1 then
        ParamValue := 1;

      Param.Integers[ParamLevel] := ParamValue
    end;
  end;

  if (ParamLevel >= 1) and (ParamLevel <= 99) then
    LevelSpinEdit.Value := ParamLevel;
end;

procedure TParameterCurvesForm.LevelSpinEditChange(Sender: TObject);
var
  ParamId: Integer;
  Param: TJSONArray;
begin
  ParamId := ParamTabControl.TabIndex;
  Param := EditedParams.Arrays[ParamId];

  ParamSpinEdit.Value := Param.Integers[LevelSpinEdit.Value];
end;

procedure TParameterCurvesForm.OKButtonClick(Sender: TObject);
begin
  ResultWasAccepted := True;
  Close
end;

procedure TParameterCurvesForm.ParamSpinEditChange(Sender: TObject);
var
  ParamId: Integer;
  Param: TJSONArray;
begin
  ParamId := ParamTabControl.TabIndex;
  Param := EditedParams.Arrays[ParamId];

  Param.Integers[LevelSpinEdit.Value] := ParamSpinEdit.Value;
  GraphPaintBox.Refresh;
end;

procedure TParameterCurvesForm.EditParams(Db: TDatabase; ClassObj: TJSONObject;
  StartingParamId: Integer);
begin
  ResultWasAccepted := False;
  UpdateParamNames(Db);
  EditedParams := ClassObj.Arrays['params'].Clone as TJSONArray;

  ParamTabControl.TabIndex := StartingParamId;

  PresetValues;

  ShowModal;

  if ResultWasAccepted then begin
    ClassObj.Delete('params');
    ClassObj.Add('params', EditedParams);
  end else
    EditedParams.Free;
end;

procedure TParameterCurvesForm.PresetValues;
var
  ParamId: Integer;
  Param: TJSONArray;
begin
  ParamId := ParamTabControl.TabIndex;
  Param := EditedParams.Arrays[ParamId];

  if ParamId < 2 then
    ParamSpinEdit.MaxValue := 9999
  else
    ParamSpinEdit.MaxValue := 999;

  LevelSpinEdit.Value := 1;
  ParamSpinEdit.Value := Param.Integers[1];

  //TODO
end;

procedure TParameterCurvesForm.GetGraphData(var OffsetLeft: Integer;
  var BarWidth: Integer);
var
  GraphWidth: Integer;
begin
  BarWidth := GraphPaintBox.Width div 99;
  GraphWidth := BarWidth * 99;

  OffsetLeft := (GraphPaintBox.Width - GraphWidth) div 2;
end;

procedure TParameterCurvesForm.GenerateParamCurve(StartVal, EndVal, Steepness: Integer);
var
  ParamId: Integer;
  Param: TJSONArray;
  I, Value: Integer;
  PowerVal, Divisor: Double;
begin
  ParamId := ParamTabControl.TabIndex;
  Param := EditedParams.Arrays[ParamId];

  if Steepness <> 0 then begin
    if Steepness > 0 then
      PowerVal := 1 + 1 * Steepness / 10
    else
      PowerVal := 1 + 1/2 * Steepness / 10;


    Divisor := Power(99, PowerVal);
  end;

  for I := 1 to 99 do begin
    if Steepness = 0 then
      Value := StartVal + (EndVal - StartVal) * (I) div 99
    else
      Value := Round(
        StartVal +
          (Power((I), PowerVal) / Divisor) * (EndVal - StartVal)
        );

    Param.Integers[I] := Value;
  end;

  (* Hack: the function above is sometimes generating numbers where startval and
     endval are not the expected ones. This is a bug, but the function doesn't
     require precision so I'll just set the start and end value to
     to StartVal and EndVal for now. More mathematically-inclined people are
     welcome to fix the function above. (Or maybe it's just a rounding issue?) *)
  Param.Integers[1] := StartVal;
  Param.Integers[99] := EndVal;
end;

procedure TParameterCurvesForm.UpdateParamNames(Db: TDatabase);
var
  I: Integer;
begin
  //TODO: set param names from vocabulary
  ParamTabControl.Tabs.BeginUpdate;
  for I := 0 to 7 do begin
    ParamTabControl.Tabs[I] := Db.GetParamName(I);
  end;
  ParamTabControl.Tabs.EndUpdate;
end;

end.