Changeset 91 for trunk/Forms

Timestamp:

Jul 20, 2018, 9:41:37 AM (6 years ago)

Author:

chronos

Message:

• Added: Allow to enable individual code optimization from settings dialog.
• Added: Actions to format or shrink target BF code.

Location:

trunk/Forms

Files:

• . (modified) (1 prop)
• UFormMain.lfm (modified) (16 diffs)
• UFormMain.pas (modified) (5 diffs)
• UFormOptions.lfm (modified) (15 diffs)
• UFormOptions.pas (modified) (8 diffs)
• UFormTargetCode.lfm (modified) (2 diffs)
• UFormTargetCode.pas (modified) (3 diffs)

trunk/Forms/UFormMain.lfm

@@ -1 +1 @@
 object FormMain: TFormMain
-  Left = 490
+  Left = 405
   Height = 586
-  Top = 315
+  Top = 226
   Width = 860
   Caption = 'LazFuck'
-  ClientHeight = 554
+  ClientHeight = 561
   ClientWidth = 860
+  DesignTimePPI = 120
   Menu = MainMenu1
   OnClose = FormClose
@@ -13 +14 @@
   OnDestroy = FormDestroy
   OnShow = FormShow
-  LCLVersion = '1.6.4.0'
+  LCLVersion = '1.8.2.0'
   WindowState = wsMaximized
   object StatusBarMain: TStatusBar
     Left = 0
     Height = 28
-    Top = 526
+    Top = 533
     Width = 860
     Panels = <    
@@ -47 +48 @@
     end
     object ToolButton2: TToolButton
-      Left = 24
+      Left = 30
       Top = 2
       Action = AProjectOpen
@@ -54 +55 @@
     end
     object ToolButton3: TToolButton
-      Left = 59
+      Left = 74
       Top = 2
       Action = AProjectSave
     end
     object ToolButton4: TToolButton
-      Left = 82
+      Left = 103
       Top = 2
       Action = AProjectClose
     end
     object ToolButton5: TToolButton
-      Left = 128
-      Height = 22
-      Top = 2
-      Width = 10
+      Left = 161
+      Height = 28
+      Top = 2
       Style = tbsSeparator
     end
     object ToolButton6: TToolButton
-      Left = 161
+      Left = 198
       Top = 2
       Action = AProgramRun
     end
     object ToolButton7: TToolButton
-      Left = 138
+      Left = 169
       Top = 2
       Action = AProgramCompile
     end
     object ToolButton8: TToolButton
-      Left = 105
+      Left = 132
       Top = 2
       Action = AOptions
     end
     object ToolButton9: TToolButton
-      Left = 230
+      Left = 285
       Top = 2
       Action = ABreakpointToggle
     end
     object ToolButton10: TToolButton
-      Left = 184
+      Left = 227
       Top = 2
       Action = AProgramPause
     end
     object ToolButton11: TToolButton
-      Left = 207
+      Left = 256
       Top = 2
       Action = AProgramStop
     end
     object ToolButton12: TToolButton
-      Left = 253
+      Left = 314
       Top = 2
       Action = AProgramStepOver
     end
     object ToolButton13: TToolButton
-      Left = 276
+      Left = 343
       Top = 2
       Action = AProgramStepInto
     end
     object ToolButton14: TToolButton
-      Left = 299
+      Left = 372
       Top = 2
       Action = AProgramStepOut
     end
     object ToolButton15: TToolButton
-      Left = 322
+      Left = 401
       Top = 2
       Action = AProgramRunToCursor
     end
     object ToolButtonTarget: TToolButton
-      Left = 345
+      Left = 430
       Hint = 'Target select'
       Top = 2
@@ -131 +131 @@
   object PageControlRight: TPageControl
     Left = 467
-    Height = 500
+    Height = 507
     Top = 26
     Width = 393
@@ -141 +141 @@
     object TabSheetDebug: TTabSheet
       Caption = 'Debug'
-      ClientHeight = 494
-      ClientWidth = 319
+      ClientHeight = 499
+      ClientWidth = 359
       object PanelInput: TPanel
         Left = 0
         Height = 64
         Top = 0
-        Width = 319
+        Width = 359
         Align = alTop
         BevelOuter = bvNone
@@ -157 +157 @@
         Height = 5
         Top = 64
-        Width = 319
+        Width = 359
         Align = alTop
         ResizeAnchor = akTop
@@ -165 +165 @@
         Height = 259
         Top = 69
-        Width = 319
+        Width = 359
         Align = alTop
         BevelOuter = bvNone
@@ -175 +175 @@
         Height = 5
         Top = 328
-        Width = 319
+        Width = 359
         Align = alTop
         ResizeAnchor = akTop
@@ -183 +183 @@
         Height = 86
         Top = 333
-        Width = 319
+        Width = 359
         Align = alTop
         BevelOuter = bvNone
@@ -193 +193 @@
         Height = 5
         Top = 419
-        Width = 319
+        Width = 359
         Align = alTop
         ResizeAnchor = akTop
@@ -199 +199 @@
       object PanelMemory: TPanel
         Left = 0
-        Height = 70
+        Height = 75
         Top = 424
-        Width = 319
+        Width = 359
         Align = alClient
         BevelOuter = bvNone
@@ -210 +210 @@
   object Splitter1: TSplitter
     Left = 462
-    Height = 500
+    Height = 507
     Top = 26
     Width = 5
@@ -218 +218 @@
   object PanelLeft: TPanel
     Left = 0
-    Height = 500
+    Height = 507
     Top = 26
     Width = 462
     Align = alClient
     BevelOuter = bvNone
-    ClientHeight = 500
+    ClientHeight = 507
     ClientWidth = 462
     TabOrder = 4
     object PageControlMain: TPageControl
       Left = 0
-      Height = 377
+      Height = 384
       Top = 0
       Width = 462
@@ -246 +246 @@
       Left = 0
       Height = 118
-      Top = 382
+      Top = 389
       Width = 462
       ActivePage = TabSheetMessages
@@ -261 +261 @@
       Left = 0
       Height = 5
-      Top = 377
+      Top = 384
       Width = 462
       Align = alBottom

trunk/Forms/UFormMain.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, SynEdit, Forms, Controls, Graphics, Dialogs,
-  Menus, ActnList, ComCtrls, ExtCtrls, UTarget, Registry, URegistry, Process,
+  Menus, ActnList, ComCtrls, ExtCtrls, UTarget, Registry, URegistry,
   LazFileUtils;
 
@@ -305 +305 @@
     if not Assigned(Core.CurrentTarget) then
       Core.CurrentTarget := TTarget(Core.Targets[0]);
+    Core.Optimizations.AddSub := ReadBoolWithDefault('OptimizationAddSubEnabled', True);
+    Core.Optimizations.Merge := ReadBoolWithDefault('OptimizationMerge', True);
+    Core.Optimizations.CopyMultiply := ReadBoolWithDefault('OptimizationCopyMultiplyEnabled', True);
+    Core.Optimizations.RelativeIndexes := ReadBoolWithDefault('OptimizationRelativeIndexesEnabled', True);
   finally
     Free;
@@ -317 +321 @@
     OpenKey(Key, True);
     WriteString('TargetName', Core.CurrentTarget.Name);
+    WriteBool('OptimizationAddSubEnabled', Core.Optimizations.AddSub);
+    WriteBool('OptimizationMerge', Core.Optimizations.Merge);
+    WriteBool('OptimizationCopyMultiplyEnabled', Core.Optimizations.CopyMultiply);
+    WriteBool('OptimizationRelativeIndexesEnabled', Core.Optimizations.RelativeIndexes);
   finally
     Free;
@@ -458 +466 @@
 procedure TFormMain.AOptionsExecute(Sender: TObject);
 begin
-  OptionsForm.Load;
-  if OptionsForm.ShowModal = mrOK then begin
-    OptionsForm.Save;
-    if Assigned(Core.CurrentTarget) then begin
-      Core.CurrentTarget.OptimizationLevel := Core.OptimizationLevel;
-      if Core.CurrentTarget is TBFTarget then begin
-        TBFTarget(Core.CurrentTarget).CellSize := Core.CellSize;
-        TBFTarget(Core.CurrentTarget).MemorySize := Core.MemorySize;
+  FormOptions := TFormOptions.Create(nil);
+  try
+    FormOptions.Load;
+    if FormOptions.ShowModal = mrOK then begin
+      FormOptions.Save;
+      if Assigned(Core.CurrentTarget) then begin
+        Core.CurrentTarget.OptimizationLevel := Core.OptimizationLevel;
+        if Core.CurrentTarget is TBFTarget then begin
+          TBFTarget(Core.CurrentTarget).CellSize := Core.CellSize;
+          TBFTarget(Core.CurrentTarget).MemorySize := Core.MemorySize;
+        end;
       end;
     end;
+  finally
+    FormOptions.Free;
   end;
 end;
@@ -479 +492 @@
     ProjectFileName := Core.Project.FileName;
     ProgramName := ExtractFileNameOnly(Core.Project.FileName);
+    if Core.CurrentTarget is TBFTarget then
+      TBFTarget(Core.CurrentTarget).Optimizations := Core.Optimizations;
     Core.CurrentTarget.Messages.AddMessage(SCompileStart);
     Application.ProcessMessages;

trunk/Forms/UFormOptions.lfm

@@ -1 @@
-object OptionsForm: TOptionsForm
-  Left = 665
-  Height = 339
-  Top = 370
-  Width = 468
+object FormOptions: TFormOptions
+  Left = 510
+  Height = 418
+  Top = 324
+  Width = 511
   Caption = 'Options'
-  ClientHeight = 339
-  ClientWidth = 468
+  ClientHeight = 418
+  ClientWidth = 511
+  DesignTimePPI = 120
+  OnClose = FormClose
+  OnCreate = FormCreate
   OnShow = FormShow
-  LCLVersion = '1.5'
+  LCLVersion = '1.8.2.0'
   object ButtonOk: TButton
-    Left = 389
+    Left = 422
     Height = 25
-    Top = 307
+    Top = 386
     Width = 75
     Anchors = [akRight, akBottom]
@@ -21 +24 @@
   end
   object ButtonCancel: TButton
-    Left = 304
+    Left = 334
     Height = 25
-    Top = 307
+    Top = 386
     Width = 75
     Anchors = [akRight, akBottom]
@@ -32 +35 @@
   object SpinEditCellSize: TSpinEdit
     Left = 165
-    Height = 35
+    Height = 28
     Top = 40
     Width = 130
@@ -40 +43 @@
   object SpinEditMemorySize: TSpinEdit
     Left = 165
-    Height = 35
+    Height = 28
     Top = 6
     Width = 130
@@ -48 +51 @@
   object Label1: TLabel
     Left = 8
-    Height = 25
+    Height = 20
     Top = 8
-    Width = 123
+    Width = 87
     Caption = 'Memory size:'
     ParentColor = False
@@ -56 +59 @@
   object Label2: TLabel
     Left = 8
-    Height = 25
+    Height = 20
     Top = 40
-    Width = 79
+    Width = 57
     Caption = 'Cell size:'
     ParentColor = False
@@ -64 +67 @@
   object Label3: TLabel
     Left = 8
-    Height = 25
+    Height = 20
     Top = 95
-    Width = 179
+    Width = 127
     Caption = 'Interface language:'
     ParentColor = False
@@ -74 +77 @@
     Height = 27
     Top = 128
-    Width = 456
+    Width = 499
     Anchors = [akTop, akLeft, akRight]
     AutoSize = False
@@ -82 +85 @@
   object SpinEditDPIX: TSpinEdit
     Left = 104
-    Height = 35
+    Height = 28
     Top = 193
     Width = 80
@@ -92 +95 @@
   object LabelDPI: TLabel
     Left = 24
-    Height = 25
+    Height = 20
     Top = 201
-    Width = 39
+    Width = 26
     Caption = 'DPI:'
     ParentColor = False
@@ -100 +103 @@
   object SpinEditDPIY: TSpinEdit
     Left = 208
-    Height = 35
+    Height = 28
     Top = 193
     Width = 80
@@ -110 +113 @@
   object LabelX: TLabel
     Left = 192
-    Height = 25
+    Height = 20
     Top = 201
-    Width = 10
+    Width = 7
     Caption = 'x'
     ParentColor = False
@@ -120 +123 @@
     Height = 27
     Top = 168
-    Width = 448
+    Width = 491
     Anchors = [akTop, akLeft, akRight]
     AutoSize = False
@@ -129 +132 @@
   object Label4: TLabel
     Left = 16
-    Height = 25
+    Height = 20
     Top = 248
-    Width = 221
+    Width = 159
     Caption = 'Compiler optimizations:'
     ParentColor = False
@@ -137 +140 @@
   object ComboBoxLanguage: TComboBox
     Left = 248
-    Height = 37
+    Height = 28
     Top = 83
     Width = 188
-    ItemHeight = 0
+    ItemHeight = 20
     Style = csDropDownList
     TabOrder = 8
   end
-  object ComboBoxOptimizatipn: TComboBox
+  object CheckBoxOptimizeAddSub: TCheckBox
+    Left = 39
+    Height = 24
+    Top = 280
+    Width = 189
+    Caption = 'Addition and subtraction'
+    TabOrder = 9
+  end
+  object CheckBoxOptimizeMerge: TCheckBox
+    Left = 39
+    Height = 24
+    Top = 304
+    Width = 181
+    Caption = 'Merge same operations'
+    TabOrder = 10
+  end
+  object CheckBoxOptimizeRelativeIndexes: TCheckBox
+    Left = 39
+    Height = 24
+    Top = 328
+    Width = 131
+    Caption = 'Relative indexes'
+    TabOrder = 11
+  end
+  object CheckBoxOptimizeCopyMultiply: TCheckBox
+    Left = 39
+    Height = 24
+    Top = 352
+    Width = 116
+    Caption = 'Copy multiply'
+    TabOrder = 12
+  end
+  object ComboBoxOptimization: TComboBox
     Left = 256
-    Height = 37
-    Top = 240
+    Height = 28
+    Top = 248
     Width = 188
-    ItemHeight = 0
+    ItemHeight = 20
     Items.Strings = (
       'None'
       'Normal'
     )
+    OnSelect = CheckBoxDPIAutoChange
     Style = csDropDownList
-    TabOrder = 9
+    TabOrder = 13
   end
 end

trunk/Forms/UFormOptions.pas

@@ -11 +11 @@
 type
 
-  { TOptionsForm }
+  { TFormOptions }
 
-  TOptionsForm = class(TForm)
+  TFormOptions = class(TForm)
     ButtonOk: TButton;
     ButtonCancel: TButton;
     CheckBox1: TCheckBox;
+    CheckBoxOptimizeAddSub: TCheckBox;
     CheckBoxDPIAuto: TCheckBox;
+    CheckBoxOptimizeMerge: TCheckBox;
+    CheckBoxOptimizeRelativeIndexes: TCheckBox;
+    CheckBoxOptimizeCopyMultiply: TCheckBox;
     ComboBoxLanguage: TComboBox;
-    ComboBoxOptimizatipn: TComboBox;
+    ComboBoxOptimization: TComboBox;
     Label1: TLabel;
     Label2: TLabel;
@@ -32 +36 @@
     procedure ButtonOkClick(Sender: TObject);
     procedure CheckBoxDPIAutoChange(Sender: TObject);
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormCreate(Sender: TObject);
     procedure FormShow(Sender: TObject);
   private
@@ -42 +48 @@
 
 var
-  OptionsForm: TOptionsForm;
+  FormOptions: TFormOptions;
 
 implementation
@@ -51 +57 @@
   UCore, ULanguages;
 
-{ TOptionsForm }
+{ TFormOptions }
 
-procedure TOptionsForm.FormShow(Sender: TObject);
+procedure TFormOptions.FormShow(Sender: TObject);
 begin
+  Core.PersistentForm1.Load(Self);
+
   Core.CoolTranslator1.LanguageListToStrings(ComboBoxLanguage.Items);
   ComboBoxLanguage.ItemIndex := ComboBoxLanguage.Items.IndexOfObject(Core.CoolTranslator1.Language);
@@ -61 +69 @@
 end;
 
-procedure TOptionsForm.UpdateInterface;
+procedure TFormOptions.UpdateInterface;
 begin
   SpinEditDPIX.Enabled := not CheckBoxDPIAuto.Checked;
@@ -71 +79 @@
     SpinEditDPIY.Value := ScreenInfo.PixelsPerInchY;
   end;
+  CheckBoxOptimizeAddSub.Enabled := ComboBoxOptimization.ItemIndex > 0;
+  CheckBoxOptimizeMerge.Enabled := ComboBoxOptimization.ItemIndex > 0;
+  CheckBoxOptimizeRelativeIndexes.Enabled := ComboBoxOptimization.ItemIndex > 0;
+  CheckBoxOptimizeCopyMultiply.Enabled := ComboBoxOptimization.ItemIndex > 0;
 end;
 
-procedure TOptionsForm.Load;
+procedure TFormOptions.Load;
 begin
+  CheckBoxOptimizeAddSub.Checked := Core.Optimizations.AddSub;
+  CheckBoxOptimizeMerge.Checked := Core.Optimizations.Merge;
+  CheckBoxOptimizeRelativeIndexes.Checked := Core.Optimizations.RelativeIndexes;
+  CheckBoxOptimizeCopyMultiply.Checked := Core.Optimizations.CopyMultiply;
   SpinEditDPIX.Value := Core.ScaleDPI1.DPI.X;
   SpinEditDPIY.Value := Core.ScaleDPI1.DPI.Y;
   CheckBoxDPIAuto.Checked := Core.ScaleDPI1.AutoDetect;
-  ComboBoxOptimizatipn.ItemIndex := Integer(Core.OptimizationLevel);
+  ComboBoxOptimization.ItemIndex := Integer(Core.OptimizationLevel);
   SpinEditCellSize.Value := Core.CellSize;
   SpinEditMemorySize.Value := Core.MemorySize;
@@ -84 +100 @@
 end;
 
-procedure TOptionsForm.Save;
+procedure TFormOptions.Save;
 begin
   Core.ScaleDPI1.DPI := Point(SpinEditDPIX.Value, SpinEditDPIY.Value);
   Core.ScaleDPI1.AutoDetect := CheckBoxDPIAuto.Checked;
-  Core.OptimizationLevel := TCompilerOptimization(ComboBoxOptimizatipn.ItemIndex);
+  Core.OptimizationLevel := TCompilerOptimization(ComboBoxOptimization.ItemIndex);
   Core.CellSize := SpinEditCellSize.Value;
   Core.MemorySize := SpinEditMemorySize.Value;
+  Core.Optimizations.AddSub := CheckBoxOptimizeAddSub.Checked;
+  Core.Optimizations.Merge := CheckBoxOptimizeMerge.Checked;
+  Core.Optimizations.RelativeIndexes := CheckBoxOptimizeRelativeIndexes.Checked;
+  Core.Optimizations.CopyMultiply := CheckBoxOptimizeCopyMultiply.Checked;
 end;
 
-procedure TOptionsForm.ButtonOkClick(Sender: TObject);
+procedure TFormOptions.ButtonOkClick(Sender: TObject);
 begin
   if ComboBoxLanguage.ItemIndex <> -1 then
@@ -100 +120 @@
 end;
 
-procedure TOptionsForm.CheckBoxDPIAutoChange(Sender: TObject);
+procedure TFormOptions.CheckBoxDPIAutoChange(Sender: TObject);
 begin
   UpdateInterface;
 end;
 
+procedure TFormOptions.FormClose(Sender: TObject; var CloseAction: TCloseAction
+  );
+begin
+  Core.PersistentForm1.Save(Self);
+end;
+
+procedure TFormOptions.FormCreate(Sender: TObject);
+begin
+  Core.CoolTranslator1.TranslateComponentRecursive(Self);
+end;
+
 end.
 

trunk/Forms/UFormTargetCode.lfm

@@ -1 +1 @@
 object FormTargetCode: TFormTargetCode
-  Left = 306
+  Left = 682
   Height = 240
-  Top = 75
+  Top = 485
   Width = 320
   Caption = 'Target code'
   ClientHeight = 240
   ClientWidth = 320
-  LCLVersion = '1.3'
+  DesignTimePPI = 120
+  LCLVersion = '1.8.2.0'
   object MemoTarget: TMemo
     Left = 0
@@ -22 +23 @@
   end
   object PopupMenuTarget: TPopupMenu
-    Images = MainForm.ImageListMain
+    Images = Core.ImageListMain
     left = 84
     top = 100
     object MenuItem20: TMenuItem
-      Action = MainForm.AShowSourcePosition
+      Action = AFormatCode
+    end
+    object MenuItem1: TMenuItem
+      Action = AShrinkCode
+    end
+  end
+  object ActionList1: TActionList
+    Images = Core.ImageListMain
+    left = 199
+    top = 39
+    object AFormatCode: TAction
+      Caption = 'Format code'
+      OnExecute = AFormatCodeExecute
+    end
+    object AShrinkCode: TAction
+      Caption = 'Shrink code'
+      OnExecute = AShrinkCodeExecute
     end
   end

trunk/Forms/UFormTargetCode.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  Menus;
+  Menus, ActnList, strutils;
 
 type
@@ -14 +14 @@
 
   TFormTargetCode = class(TForm)
+    AShrinkCode: TAction;
+    AFormatCode: TAction;
+    ActionList1: TActionList;
     MemoTarget: TMemo;
+    MenuItem1: TMenuItem;
     MenuItem20: TMenuItem;
     PopupMenuTarget: TPopupMenu;
+    procedure AFormatCodeExecute(Sender: TObject);
+    procedure AShrinkCodeExecute(Sender: TObject);
   private
     { private declarations }
@@ -30 +36 @@
 {$R *.lfm}
 
+{ TFormTargetCode }
+
+procedure TFormTargetCode.AFormatCodeExecute(Sender: TObject);
+var
+  Source: string;
+  NewSource: string;
+  Indent: Integer;
+  I: Integer;
+const
+  IndentText = '  ';
+begin
+  Source := MemoTarget.Text;
+  NewSource := '';
+  Indent := 0;
+  for I := 1 to Length(Source) do begin
+    if Source[I] = '[' then begin
+      NewSource := NewSource + LineEnding + DupeString(IndentText, Indent) + Source[I] + LineEnding ;
+      Inc(Indent);
+      NewSource := NewSource + DupeString(IndentText, Indent);
+    end
+    else if Source[I] = ']' then begin
+      Dec(Indent);
+      NewSource := NewSource + LineEnding + DupeString(IndentText, Indent) + Source[I] + LineEnding + DupeString(IndentText, Indent);
+    end
+    else if Ord(Source[I]) > $20 then
+      NewSource := NewSource + Source[I];
+  end;
+  MemoTarget.Text := NewSource;
+end;
+
+procedure TFormTargetCode.AShrinkCodeExecute(Sender: TObject);
+var
+  Source: string;
+  Pos: Integer;
+  I: Integer;
+begin
+  Source := MemoTarget.Text;
+  Pos := 1;
+  for I := 1 to Length(Source) do begin
+    if Source[I] > ' ' then begin
+      Source[Pos] := Source[I];
+      Inc(Pos);
+    end;
+  end;
+  SetLength(Source, Pos - 1);
+  MemoTarget.Text := Source;
+end;
+
 end.