Changeset 176 for branches/virtualcpu4


Ignore:
Timestamp:
Apr 12, 2019, 11:43:24 AM (6 years ago)
Author:
chronos
Message:
  • Modified: Optimization of draw only modified part of screen.
Location:
branches/virtualcpu4
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • branches/virtualcpu4

    • Property svn:ignore

      •  

        old new  
        44*.lps
        55*.res
         6heaptrclog.trc

  • branches/virtualcpu4/UFormMain.lfm

    r175 r176  
    11object FormMain: TFormMain
    2   Left = 350
    3   Height = 948
    4   Top = 247
    5   Width = 1718
     2  Left = 313
     3  Height = 790
     4  Top = 150
     5  Width = 1432
    66  Caption = 'VirtCpu4'
    7   ClientHeight = 948
    8   ClientWidth = 1718
    9   DesignTimePPI = 144
     7  ClientHeight = 790
     8  ClientWidth = 1432
     9  DesignTimePPI = 120
    1010  OnCreate = FormCreate
    1111  OnDestroy = FormDestroy
    … …  
    1313  LCLVersion = '2.0.0.4'
    1414  object ButtonStart: TButton
    15     Left = 1181
    16     Height = 37
    17     Top = 10
    18     Width = 113
     15    Left = 984
     16    Height = 31
     17    Top = 8
     18    Width = 94
    1919    Caption = 'Start'
    2020    OnClick = ButtonStartClick
    … …  
    2323  end
    2424  object ButtonStop: TButton
    25     Left = 1181
    26     Height = 37
    27     Top = 58
    28     Width = 113
     25    Left = 984
     26    Height = 31
     27    Top = 48
     28    Width = 94
    2929    Caption = 'Stop'
    3030    OnClick = ButtonStopClick
    … …  
    3333  end
    3434  object Label1: TLabel
    35     Left = 1181
    36     Height = 26
    37     Top = 115
    38     Width = 48
     35    Left = 984
     36    Height = 20
     37    Top = 96
     38    Width = 35
    3939    Caption = 'Ticks:'
    4040    ParentColor = False
    … …  
    4242  end
    4343  object ListViewRegisters: TListView
    44     Left = 10
    45     Height = 922
    46     Top = 10
    47     Width = 374
     44    Left = 8
     45    Height = 769
     46    Top = 8
     47    Width = 312
    4848    Anchors = [akTop, akLeft, akBottom]
    4949    Columns = <   
    5050      item
    5151        Caption = 'Register'
    52         Width = 120
     52        Width = 100
    5353      end   
    5454      item
    55         Width = 239
     55        Width = 199
    5656      end>
    57     Font.Height = -20
     57    Font.Height = -17
    5858    Font.Name = 'Liberation Mono'
    5959    OwnerData = True
    … …  
    6464  end
    6565  object ListViewMemory: TListView
    66     Left = 394
    67     Height = 922
    68     Top = 10
    69     Width = 778
     66    Left = 328
     67    Height = 769
     68    Top = 8
     69    Width = 648
    7070    Anchors = [akTop, akLeft, akBottom]
    7171    Columns = <   
    7272      item
    7373        Caption = 'Address'
    74         Width = 120
     74        Width = 100
    7575      end   
    7676      item
    77         Width = 643
     77        Width = 536
    7878      end>
    79     Font.Height = -20
     79    Font.Height = -17
    8080    Font.Name = 'Liberation Mono'
    8181    OwnerData = True
    … …  
    8686  end
    8787  object Memo1: TMemo
    88     Left = 1181
    89     Height = 344
    90     Top = 192
    91     Width = 518
     88    Left = 984
     89    Height = 287
     90    Top = 160
     91    Width = 432
    9292    OnKeyPress = Memo1KeyPress
    9393    ParentFont = False
    … …  
    9696  end
    9797  object Label2: TLabel
    98     Left = 1181
    99     Height = 26
    100     Top = 163
    101     Width = 73
     98    Left = 984
     99    Height = 20
     100    Top = 136
     101    Width = 56
    102102    Caption = 'Console:'
    103103    ParentColor = False
    104104    ParentFont = False
    105105  end
    106   object PaintBox1: TPaintBox
    107     Left = 1181
    108     Height = 374
    109     Top = 552
    110     Width = 518
    111     OnPaint = PaintBox1Paint
    112     OnResize = PaintBox1Resize
     106  object Image1: TImage
     107    Left = 984
     108    Height = 321
     109    Top = 457
     110    Width = 432
    113111  end
    114112  object Timer1: TTimer
    115113    Interval = 100
    116114    OnTimer = Timer1Timer
    117     left = 115
    118     top = 173
     115    left = 96
     116    top = 144
    119117  end
    120118  object TimerDraw: TTimer
    121119    OnTimer = TimerDrawTimer
    122     left = 104
    123     top = 304
     120    left = 87
     121    top = 253
    124122  end
    125123end

  • branches/virtualcpu4/UFormMain.pas

    r175 r176  
    1616    ButtonStart: TButton;
    1717    ButtonStop: TButton;
     18    Image1: TImage;
    1819    Label1: TLabel;
    1920    Label2: TLabel;
    … …  
    2122    ListViewRegisters: TListView;
    2223    Memo1: TMemo;
    23     PaintBox1: TPaintBox;
    2424    Timer1: TTimer;
    2525    TimerDraw: TTimer;
    … …  
    3232    procedure ListViewRegistersData(Sender: TObject; Item: TListItem);
    3333    procedure Memo1KeyPress(Sender: TObject; var Key: char);
    34     procedure PaintBox1Paint(Sender: TObject);
     34    procedure ScreenRepaing;
    3535    procedure PaintBox1Resize(Sender: TObject);
    3636    procedure Timer1Timer(Sender: TObject);
    … …  
    8383begin
    8484  LoadProgram;
     85  PaintBox1Resize(Self);
    8586end;
    8687
    … …  
    123124end;
    124125
    125 procedure TFormMain.PaintBox1Paint(Sender: TObject);
    126 var
    127   X, Y: Integer;
     126procedure TFormMain.ScreenRepaing;
     127var
    128128  B: Byte;
    129   MemorySizeTmp: Integer;
    130   Addr: Integer;
    131 begin
    132   MemorySizeTmp := Machine.MemorySize;
    133   with Machine, Screen do
    134   for Y := 0 to Size.Y - 1 do
    135   for X := 0 to Size.X - 1 do begin
    136     Addr := MemoryBase + Y * Size.X + X;
    137     if Addr < MemorySizeTmp then begin
    138       B := PByte(Memory + Addr)^;
    139       PaintBox1.Canvas.Pixels[X, Y] := B * $010101;
     129  P: Integer;
     130begin
     131  with Machine, Screen do begin
     132    if ChangedAreaFrom < ChangedAreaTo then begin
     133      if (Image1.Picture.Bitmap.Width <> Image1.Width) or
     134      (Image1.Picture.Bitmap.Height <> Image1.Height) then
     135        Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height);
     136      Image1.Picture.Bitmap.BeginUpdate(True);
     137      P := ChangedAreaFrom;
     138      while P <= ChangedAreaTo do begin
     139        B := PByte(Memory + MemoryBase + P)^;
     140        Image1.Canvas.Pixels[P mod Size.X, P div Size.X] := B * $010101;
     141        Inc(P);
     142      end;
     143      ChangedAreaTo := MemoryBase;
     144      ChangedAreaFrom := MemoryBase + MemorySize;
     145      Image1.Picture.Bitmap.EndUpdate;
    140146    end;
    141147  end;
    … …  
    144150procedure TFormMain.PaintBox1Resize(Sender: TObject);
    145151begin
    146   Machine.Screen.Size := Point(PaintBox1.Width, PaintBox1.Height);
     152  Machine.Screen.Size := Point(Image1.Width, Image1.Height);
    147153end;
    148154
    … …  
    160166procedure TFormMain.TimerDrawTimer(Sender: TObject);
    161167begin
    162   PaintBox1.Repaint;
     168  ScreenRepaing;
    163169end;
    164170
    … …  
    196202    Loadi(R2, 12);
    197203  LabelPrint := IP;
    198       DataPrefix8; LoadMem(R3, R1);
     204    DataPrefix8; LoadMem(R3, R1);
    199205    DataPrefix8; Output(0, R3);
    200206    Increment(R1);
    … …  
    213219    Test(R2);
    214220    JumpNotZero(LabelClearScreen);
     221
     222    // Update screen area
     223    Loadi(R1, 0);
     224    Output(4, R1);
     225    Loadi(R1, $10000);
     226    Output(5, R1);
    215227
    216228    // Read keyboard and print to console

  • branches/virtualcpu4/UMachine.pas

    r175 r176  
    1212    Size: TPoint;
    1313    MemoryBase: Integer;
     14    MemorySize: Integer;
     15    ChangedAreaFrom: Integer;
     16    ChangedAreaTo: Integer;
    1417  end;
    1518
    … …  
    1821  TMachine = class
    1922  private
     23    FMemorySize: Integer;
    2024    function CpuInput(Port: TAddress): TRegister;
    2125    procedure CpuOutput(Port: TAddress; Value: TRegister);
    … …  
    128132      bw64: Screen.MemoryBase := Value.Q;
    129133    end;
     134    4: case Cpu.DataSize of
     135      bw8: Screen.ChangedAreaFrom := Value.B;
     136      bw16: Screen.ChangedAreaFrom := Value.W;
     137      bw32: Screen.ChangedAreaFrom := Value.D;
     138      bw64: Screen.ChangedAreaFrom := Value.Q;
     139    end;
     140    5: case Cpu.DataSize of
     141      bw8: Screen.ChangedAreaTo := Value.B;
     142      bw16: Screen.ChangedAreaTo := Value.W;
     143      bw32: Screen.ChangedAreaTo := Value.D;
     144      bw64: Screen.ChangedAreaTo := Value.Q;
     145    end;
    130146  end;
    131147end;
    … …  
    133149function TMachine.GetMemorySize: Integer;
    134150begin
    135   Result := MemSize(Memory);
     151  Result := FMemorySize;
    136152end;
    137153
    138154procedure TMachine.SetMemorySize(AValue: Integer);
    139155begin
    140   Memory := ReAllocMem(Memory, AValue);
     156  if FMemorySize = AValue then Exit;
     157  FMemorySize := AValue;
     158  Memory := ReAllocMem(Memory, FMemorySize);
    141159end;
    142160

  • branches/virtualcpu4/virtucpu4.lpr

    r174 r176  
    55uses
    66  {$IFDEF UNIX}
    7   cthreads,
     7  cthreads, clocale,
    88  {$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, UFormMain, UCpu, UMachine
     10  SysUtils, Forms, UFormMain, UCpu, UMachine
    1111  { you can add units after this };
    1212
    1313{$R *.res}
    1414
     15{$if declared(UseHeapTrace)}
     16const
     17  HeapTraceLog = 'heaptrclog.trc';
     18{$ENDIF}
     19
    1520begin
     21  {$if declared(UseHeapTrace)}
     22  // Heap trace
     23  DeleteFile(ExtractFilePath(ParamStr(0)) + HeapTraceLog);
     24  SetHeapTraceOutput(ExtractFilePath(ParamStr(0)) + HeapTraceLog);
     25  {$ENDIF}
     26
    1627  RequireDerivedFormResource:=True;
    1728  Application.Scaled:=True;
Note: See TracChangeset for help on using the changeset viewer.