Changeset 9 for branches/ByteArray/Devices
- Timestamp:
- Aug 6, 2024, 10:31:16 PM (6 months ago)
- Location:
- branches/ByteArray
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/ByteArray
-
Property svn:ignore
set to
lib
heaptrclog.trc
ByteArray
ByteArray.dbg
ByteArray.lps
ByteArray.res
-
Property svn:ignore
set to
-
branches/ByteArray/Devices/Device.pas
r5 r9 4 4 5 5 uses 6 Classes, SysUtils, Channel, Forms, BigInt, Common.FormEx;6 Classes, SysUtils, Channel, Forms, Int, Common.FormEx, Generics.Collections; 7 7 8 8 type … … 12 12 TFormDevice = class; 13 13 14 TReadEvent = function (DataSize: TIntSize): TInt of object; 15 TWriteEvent = procedure (DataSize: TIntSize; Value: TInt) of object; 16 TReadEvents = TList<TReadEvent>; 17 TWriteEvents = TList<TWriteEvent>; 18 19 { THandlers } 20 21 THandlers = class 22 ReadHandlers: TReadEvents; 23 WriteHandlers: TWriteEvents; 24 constructor Create; 25 destructor Destroy; override; 26 end; 27 14 28 { TDevice } 15 29 … … 18 32 DeviceClass: TDeviceClass; 19 33 Form: TFormDevice; 20 BaseAddress: Integer; 21 function GetAddressCount: Integer; virtual; 22 procedure SetChannel(Channel: TChannel); virtual; 34 function GetHandlers: THandlers; virtual; 23 35 end; 24 36 … … 60 72 end; 61 73 74 { THandlers } 75 76 constructor THandlers.Create; 77 begin 78 ReadHandlers := TReadEvents.Create; 79 WriteHandlers := TWriteEvents.Create; 80 end; 81 82 destructor THandlers.Destroy; 83 begin 84 FreeAndNil(ReadHandlers); 85 FreeAndNil(WriteHandlers); 86 inherited; 87 end; 88 62 89 { TDevice } 63 90 64 function TDevice.Get AddressCount: Integer;91 function TDevice.GetHandlers: THandlers; 65 92 begin 66 Result := 0; 67 end; 68 69 procedure TDevice.SetChannel(Channel: TChannel); 70 begin 93 Result := nil; 71 94 end; 72 95 -
branches/ByteArray/Devices/DeviceMapper.pas
r5 r9 4 4 5 5 uses 6 Classes, SysUtils, Device, Channel, Generics.Collections, BigInt;6 Classes, SysUtils, Device, Channel, Generics.Collections, Int, Math; 7 7 8 8 type … … 12 12 TMappedDevice = class 13 13 Device: TDevice; 14 Count: Integer; 15 Channel: TChannel; 14 ReadCount: Integer; 15 WriteCount: Integer; 16 ReadBase: Integer; 17 WriteBase: Integer; 16 18 constructor Create; 17 19 destructor Destroy; override; … … 20 22 { TDeviceMapper } 21 23 22 TDeviceMapper = class 23 FreeBaseAddress: Integer; 24 TDeviceMapper = class(TChannelDevice) 25 private 26 function ChannelRead(Address: TInt; Size: TIntSize): TInt; 27 procedure ChannelWrite(Address: TInt; Size: TIntSize; Value: TInt); 28 function ChannelGetSize: TInt; 29 public 30 ReadHandlers: TList<TReadEvent>; 31 WriteHandlers: TList<TWriteEvent>; 24 32 MappedDevices: TObjectList<TMappedDevice>; 25 33 procedure RegisterDevice(Device: TDevice); 26 34 procedure UnregisterDevice(Device: TDevice); 27 function Read(Address: TBigInt; Size: TBigIntSize): TBigInt; 28 procedure Write(Address: TBigInt; Size: TBigIntSize; Value: TBigInt); 29 procedure SetChannel(Channel: TChannel); 35 procedure SetChannel(Channel: TChannel); override; 30 36 constructor Create; 31 37 destructor Destroy; override; … … 39 45 constructor TMappedDevice.Create; 40 46 begin 41 Channel := TChannel.Create;42 47 end; 43 48 44 49 destructor TMappedDevice.Destroy; 45 50 begin 46 FreeAndNil(Channel);47 51 inherited; 48 52 end; … … 53 57 var 54 58 NewMappedDevice: TMappedDevice; 59 Handlers: THandlers; 55 60 begin 61 Handlers := Device.GetHandlers; 62 56 63 NewMappedDevice := TMappedDevice.Create; 57 64 NewMappedDevice.Device := Device; 58 NewMappedDevice.Device.BaseAddress := FreeBaseAddress; 59 NewMappedDevice.Count := Device.GetAddressCount; 60 Device.SetChannel(NewMappedDevice.Channel); 65 NewMappedDevice.ReadBase := ReadHandlers.Count; 66 NewMappedDevice.WriteBase := WriteHandlers.Count; 67 NewMappedDevice.ReadCount := Handlers.ReadHandlers.Count; 68 NewMappedDevice.WriteCount := Handlers.WriteHandlers.Count; 61 69 MappedDevices.Add(NewMappedDevice); 62 Inc(FreeBaseAddress, NewMappedDevice.Count); 70 71 ReadHandlers.AddRange(Handlers.ReadHandlers); 72 WriteHandlers.AddRange(Handlers.WriteHandlers); 73 Handlers.Free; 63 74 end; 64 75 … … 74 85 end; 75 86 76 function TDeviceMapper.Read(Address: TBigInt; Size: TBigIntSize): TBigInt; 87 function TDeviceMapper.ChannelRead(Address: TInt; Size: TIntSize): TInt; 88 begin 89 if Address < ReadHandlers.Count then 90 Result := ReadHandlers[Address](Size) 91 else Result := 0; 92 end; 93 94 procedure TDeviceMapper.ChannelWrite(Address: TInt; Size: TIntSize; Value: TInt); 77 95 var 78 96 I: Integer; 79 97 begin 80 for I := 0 to MappedDevices.Count - 1 do 81 if (Integer(Address) >= MappedDevices[I].Device.BaseAddress) and (Integer(Address) >= MappedDevices[I].Device.BaseAddress + MappedDevices[I].Count) then begin 82 Result := MappedDevices[I].Channel.Read(Integer(Address) - MappedDevices[I].Device.BaseAddress, Size); 83 Break; 84 end; 98 if Address < WriteHandlers.Count then 99 WriteHandlers[Address](Size, Value); 85 100 end; 86 101 87 procedure TDeviceMapper.Write(Address: TBigInt; Size: TBigIntSize; Value: TBigInt); 88 var 89 I: Integer; 102 function TDeviceMapper.ChannelGetSize: TInt; 90 103 begin 91 for I := 0 to MappedDevices.Count - 1 do 92 if (Integer(Address) >= MappedDevices[I].Device.BaseAddress) and 93 (Integer(Address) < MappedDevices[I].Device.BaseAddress + MappedDevices[I].Count) then begin 94 MappedDevices[I].Channel.Write(Integer(Address) - MappedDevices[I].Device.BaseAddress, Size, Value); 95 Break; 96 end; 104 Result := Max(ReadHandlers.Count, WriteHandlers.Count); 97 105 end; 98 106 99 107 procedure TDeviceMapper.SetChannel(Channel: TChannel); 100 108 begin 101 Channel.Read := Read; 102 Channel.Write := Write; 109 Channel.Read := ChannelRead; 110 Channel.Write := ChannelWrite; 111 Channel.GetSize := ChannelGetSize; 103 112 end; 104 113 … … 106 115 begin 107 116 MappedDevices := TObjectList<TMappedDevice>.Create; 117 ReadHandlers := TList<TReadEvent>.Create; 118 WriteHandlers := TList<TWriteEvent>.Create; 108 119 end; 109 120 110 121 destructor TDeviceMapper.Destroy; 111 122 begin 123 FreeAndNil(ReadHandlers); 124 FreeAndNil(WriteHandlers); 112 125 FreeAndNil(MappedDevices); 113 126 inherited; -
branches/ByteArray/Devices/FrameBuffer.pas
r5 r9 4 4 5 5 uses 6 Classes, SysUtils, Device, Channel, Memory, BigInt;6 Classes, SysUtils, Device, Channel, Memory, Int; 7 7 8 8 type … … 15 15 FOnChange: TNotifyEvent; 16 16 procedure DoChange; 17 function ReadData(Size: TIntSize): TInt; 18 function ReadPosition(Size: TIntSize): TInt; 19 function ReadWidth(Size: TIntSize): TInt; 20 function ReadHeight(Size: TIntSize): TInt; 21 function ReadMode(Size: TIntSize): TInt; 22 procedure WriteData(Size: TIntSize; Value: TInt); 23 procedure WritePosition(Size: TIntSize; Value: TInt); 24 procedure WriteWidth(Size: TIntSize; Value: TInt); 25 procedure WriteHeight(Size: TIntSize; Value: TInt); 26 procedure WriteMode(Size: TIntSize; Value: TInt); 17 27 public 18 28 Memory: TMemory; … … 22 32 Mode: TScreenMode; 23 33 procedure UpdateMode; 24 function Read(Address: TBigInt; Size: TBigIntSize): TBigInt; 25 procedure Write(Address: TBigInt; Size: TBigIntSize; Value: TBigInt); 26 function GetAddressCount: Integer; override; 27 procedure SetChannel(Channel: TChannel); override; 34 function GetHandlers: THandlers; override; 28 35 constructor Create; 29 36 destructor Destroy; override; … … 41 48 end; 42 49 50 function TFrameBuffer.ReadData(Size: TIntSize): TInt; 51 begin 52 Result := Memory.Read(Position, Size); 53 Inc(Position, Size); 54 end; 55 56 function TFrameBuffer.ReadPosition(Size: TIntSize): TInt; 57 begin 58 Result := Position; 59 end; 60 61 function TFrameBuffer.ReadWidth(Size: TIntSize): TInt; 62 begin 63 Result := Width; 64 end; 65 66 function TFrameBuffer.ReadHeight(Size: TIntSize): TInt; 67 begin 68 Result := Height; 69 end; 70 71 function TFrameBuffer.ReadMode(Size: TIntSize): TInt; 72 begin 73 Result := Byte(Mode); 74 end; 75 76 procedure TFrameBuffer.WriteData(Size: TIntSize; Value: TInt); 77 begin 78 Memory.Write(Position, Size, Value); 79 Inc(Position, Size); 80 end; 81 82 procedure TFrameBuffer.WritePosition(Size: TIntSize; Value: TInt); 83 begin 84 Position := Value; 85 end; 86 87 procedure TFrameBuffer.WriteWidth(Size: TIntSize; Value: TInt); 88 begin 89 Width := Value; 90 UpdateMode; 91 end; 92 93 procedure TFrameBuffer.WriteHeight(Size: TIntSize; Value: TInt); 94 begin 95 Height := Value; 96 UpdateMode; 97 end; 98 99 procedure TFrameBuffer.WriteMode(Size: TIntSize; Value: TInt); 100 begin 101 Mode := TScreenMode(Integer(Value)); 102 UpdateMode; 103 end; 104 43 105 procedure TFrameBuffer.UpdateMode; 44 106 begin … … 47 109 end; 48 110 49 function TFrameBuffer. Read(Address: TBigInt; Size: TBigIntSize): TBigInt;111 function TFrameBuffer.GetHandlers: THandlers; 50 112 begin 51 case Integer(Address) of 52 0: begin 53 Result := Memory.Read(Position, Size); 54 Inc(Position, Size); 55 end; 56 1: Result := Position; 57 2: Result := Width; 58 3: Result := Height; 59 4: Result := Byte(Mode); 60 end; 61 end; 62 63 procedure TFrameBuffer.Write(Address: TBigInt; Size: TBigIntSize; Value: TBigInt); 64 begin 65 case Integer(Address) of 66 0: begin 67 Memory.Write(Position, Size, Value); 68 Inc(Position, Size); 69 end; 70 1: Position := Value; 71 2: begin 72 Width := Value; 73 UpdateMode; 74 end; 75 3: begin 76 Height := Value; 77 UpdateMode; 78 end; 79 4: begin 80 Mode := TScreenMode(Integer(Value)); 81 UpdateMode; 82 end; 83 end; 84 DoChange; 85 end; 86 87 function TFrameBuffer.GetAddressCount: Integer; 88 begin 89 Result := 5; 90 end; 91 92 procedure TFrameBuffer.SetChannel(Channel: TChannel); 93 begin 94 Channel.Read := Read; 95 Channel.Write := Write; 113 Result := THandlers.Create; 114 Result.ReadHandlers.Add(ReadData); 115 Result.ReadHandlers.Add(ReadPosition); 116 Result.ReadHandlers.Add(ReadWidth); 117 Result.ReadHandlers.Add(ReadHeight); 118 Result.ReadHandlers.Add(ReadMode); 119 Result.WriteHandlers.Add(WriteData); 120 Result.WriteHandlers.Add(WritePosition); 121 Result.WriteHandlers.Add(WriteWidth); 122 Result.WriteHandlers.Add(WriteHeight); 123 Result.WriteHandlers.Add(WriteMode); 96 124 end; 97 125 -
branches/ByteArray/Devices/Memory.pas
r5 r9 4 4 5 5 uses 6 Classes, SysUtils, BigInt, Channel, Device;6 Classes, SysUtils, Int, Channel, Device; 7 7 8 8 type … … 10 10 { TMemory } 11 11 12 TMemory = class(T Device)12 TMemory = class(TChannelDevice) 13 13 private 14 FSize: Integer;14 FSize: TInt; 15 15 FData: PByte; 16 function GetSize: Integer;17 procedure SetSize(AValue: Integer);16 function GetSize: TInt; 17 procedure SetSize(AValue: TInt); 18 18 procedure CheckGrow(Address: Integer); 19 19 public 20 Position: Integer;20 Position: TInt; 21 21 Grow: Boolean; 22 22 procedure Assign(Source: TMemory); 23 function Read(Address: T BigInt; ASize: TBigIntSize): TBigInt;24 function ReadPos(ASize: Byte): T BigInt;25 procedure Write(Address: T BigInt; ASize: TBigIntSize; Value: TBigInt);26 procedure WritePos(ASize: Byte; Value: T BigInt);23 function Read(Address: TInt; ASize: TIntSize): TInt; 24 function ReadPos(ASize: Byte): TInt; 25 procedure Write(Address: TInt; ASize: TIntSize; Value: TInt); 26 procedure WritePos(ASize: Byte; Value: TInt); 27 27 procedure WriteStringPos(Value: string); 28 28 procedure WriteMemoryPos(Memory: TMemory); 29 function GetAddressCount: Integer; override;30 29 procedure SetChannel(Channel: TChannel); override; 31 30 procedure SaveToFile(FileName: string); 31 procedure LoadFromFile(FileName: string); 32 32 procedure FillZero; 33 33 procedure Clear; 34 property Size: Integerread FSize write SetSize;34 property Size: TInt read FSize write SetSize; 35 35 destructor Destroy; override; 36 36 end; … … 44 44 { TMemory } 45 45 46 function TMemory.GetSize: Integer;46 function TMemory.GetSize: TInt; 47 47 begin 48 48 Result := MemSize(FData); 49 49 end; 50 50 51 procedure TMemory.SetSize(AValue: Integer);51 procedure TMemory.SetSize(AValue: TInt); 52 52 begin 53 53 FSize := AValue; … … 68 68 end; 69 69 70 function TMemory.Read(Address: T BigInt; ASize: TBigIntSize): TBigInt;70 function TMemory.Read(Address: TInt; ASize: TIntSize): TInt; 71 71 begin 72 72 if Address + ASize > FSize then raise Exception.Create(SOutOfRange); … … 79 79 end; 80 80 81 function TMemory.ReadPos(ASize: Byte): T BigInt;81 function TMemory.ReadPos(ASize: Byte): TInt; 82 82 begin 83 83 Result := Read(Position, ASize); … … 85 85 end; 86 86 87 procedure TMemory.Write(Address: T BigInt; ASize: TBigIntSize; Value: TBigInt);87 procedure TMemory.Write(Address: TInt; ASize: TIntSize; Value: TInt); 88 88 begin 89 89 if Address + ASize > FSize then raise Exception.Create(SOutOfRange); … … 96 96 end; 97 97 98 procedure TMemory.WritePos(ASize: Byte; Value: T BigInt);98 procedure TMemory.WritePos(ASize: Byte; Value: TInt); 99 99 begin 100 100 CheckGrow(Position + ASize); … … 126 126 end; 127 127 128 function TMemory.GetAddressCount: Integer;129 begin130 Result := FSize;131 end;132 133 128 procedure TMemory.SetChannel(Channel: TChannel); 134 129 begin 135 130 Channel.Read := Read; 136 131 Channel.Write := Write; 132 Channel.GetSize := GetSize; 137 133 end; 138 134 … … 168 164 end; 169 165 166 procedure TMemory.LoadFromFile(FileName: string); 167 var 168 F: TFileStream; 169 begin 170 F := TFileStream.Create(FileName, fmOpenRead); 171 try 172 if FSize < F.Size then Size := F.Size; 173 F.Read(FData[0], FSize); 174 finally 175 F.Free; 176 end; 177 end; 178 170 179 end. 171 180 -
branches/ByteArray/Devices/Mouse.pas
r5 r9 1 1 unit Mouse; 2 3 {$mode Delphi}4 2 5 3 interface -
branches/ByteArray/Devices/Serial.pas
r5 r9 4 4 5 5 uses 6 Classes, SysUtils, Device, BigInt, Channel;6 Classes, SysUtils, Device, Int, Channel; 7 7 8 8 type … … 17 17 FOnWrite: TWriteEvent; 18 18 public 19 function Read(Address: TBigInt; Size: TBigIntSize): TBigInt; 20 procedure Write(Address: TBigInt; Size: TBigIntSize; Value: TBigInt); 21 function GetAddressCount: Integer; override; 22 procedure SetChannel(Channel: TChannel); override; 19 function ReadData(Size: TIntSize): TInt; 20 procedure WriteData(Size: TIntSize; Value: TInt); 21 function GetHandlers: THandlers; override; 23 22 property OnWrite: TWriteEvent read FOnWrite write FOnWrite; 24 23 property OnRead: TReadEvent read FOnRead write FOnRead; … … 30 29 { TSerial } 31 30 32 function TSerial.Read (Address: TBigInt; Size: TBigIntSize): TBigInt;31 function TSerial.ReadData(Size: TIntSize): TInt; 33 32 begin 34 case Integer(Address) of 35 0: if Assigned(FOnRead) then Result := FOnRead; 36 end; 33 if Assigned(FOnRead) then Result := FOnRead; 37 34 end; 38 35 39 procedure TSerial.Write (Address: TBigInt; Size: TBigIntSize; Value: TBigInt);36 procedure TSerial.WriteData(Size: TIntSize; Value: TInt); 40 37 begin 41 case Integer(Address) of 42 0: if Assigned(FOnWrite) then FOnWrite(Value); 43 end; 38 if Assigned(FOnWrite) then FOnWrite(Value); 44 39 end; 45 40 46 function TSerial.Get AddressCount: Integer;41 function TSerial.GetHandlers: THandlers; 47 42 begin 48 Result := 1; 49 end; 50 51 procedure TSerial.SetChannel(Channel: TChannel); 52 begin 53 Channel.Read := Read; 54 Channel.Write := Write; 43 Result := THandlers.Create; 44 Result.ReadHandlers.Add(ReadData); 45 Result.WriteHandlers.Add(WriteData); 55 46 end; 56 47 -
branches/ByteArray/Devices/Storage.pas
r5 r9 4 4 5 5 uses 6 Classes, SysUtils, Device, Channel, BigInt;6 Classes, SysUtils, Device, Channel, Int; 7 7 8 8 type … … 19 19 FFile: TFileStream; 20 20 Position: Integer; 21 function ReadByte(Address: TBigInt): Byte; 22 function Read(Address: TBigInt; Size: TBigIntSize): TBigInt; 23 procedure Write(Address: TBigInt; Size: TBigIntSize; Value: TBigInt); 24 function GetAddressCount: Integer; override; 25 procedure SetChannel(Channel: TChannel); override; 21 function ReadByte(Address: TInt): Byte; 22 function ReadData(Size: TIntSize): TInt; 23 function ReadPosition(Size: TIntSize): TInt; 24 function ReadSize(Size: TIntSize): TInt; 25 procedure WriteData(Size: TIntSize; Value: TInt); 26 procedure WritePosition(Size: TIntSize; Value: TInt); 27 procedure WriteSize(Size: TIntSize; Value: TInt); 28 function GetHandlers: THandlers; override; 26 29 constructor Create; 27 30 destructor Destroy; override; … … 56 59 end; 57 60 58 function TStorage.ReadByte(Address: T BigInt): Byte;61 function TStorage.ReadByte(Address: TInt): Byte; 59 62 begin 60 63 Result := 0; … … 63 66 end; 64 67 65 function TStorage.Read(Address: TBigInt; Size: TBigIntSize): TBigInt; 66 var 67 Buffer: array of Byte; 68 function TStorage.ReadData(Size: TIntSize): TInt; 68 69 begin 69 case Integer(Address) of 70 0: begin 71 SetLength(Buffer, Size); 72 FFile.Position := Position; 73 FFile.Read(Buffer[0], Size); 74 Result.SetByteArray(Buffer, Size); 75 Inc(Position, Size); 76 end; 77 1: Result := Position; 78 2: Result := FFile.Size; 79 end; 70 FFile.Position := Position; 71 FFile.Read(Result, Size); 72 Inc(Position, Size); 80 73 end; 81 74 82 procedure TStorage.Write(Address: TBigInt; Size: TBigIntSize; Value: TBigInt); 83 var 84 Buffer: array of Byte; 75 function TStorage.ReadPosition(Size: TIntSize): TInt; 85 76 begin 86 case Integer(Address) of 87 0: begin 88 SetLength(Buffer, Size); 89 Value.GetByteArray(Buffer, Size); 90 FFile.Position := Position; 91 FFile.Write(Buffer[1], Size); 92 Inc(Position, Size); 93 end; 94 1: Position := Value; 95 2: FFile.Size := Value; 96 end; 77 Result := Position; 97 78 end; 98 79 99 function TStorage. GetAddressCount: Integer;80 function TStorage.ReadSize(Size: TIntSize): TInt; 100 81 begin 101 Result := 3;82 Result := FFile.Size; 102 83 end; 103 84 104 procedure TStorage. SetChannel(Channel: TChannel);85 procedure TStorage.WriteData(Size: TIntSize; Value: TInt); 105 86 begin 106 Channel.Read := Read; 107 Channel.Write := Write; 87 FFile.Position := Position; 88 FFile.Write(Value, Size); 89 Inc(Position, Size); 90 end; 91 92 procedure TStorage.WritePosition(Size: TIntSize; Value: TInt); 93 begin 94 Position := Value; 95 end; 96 97 procedure TStorage.WriteSize(Size: TIntSize; Value: TInt); 98 begin 99 FFile.Size := Value; 100 end; 101 function TStorage.GetHandlers: THandlers; 102 begin 103 Result := THandlers.Create; 104 Result.ReadHandlers.Add(ReadData); 105 Result.ReadHandlers.Add(ReadPosition); 106 Result.ReadHandlers.Add(ReadSize); 107 Result.WriteHandlers.Add(WriteData); 108 Result.WriteHandlers.Add(WritePosition); 109 Result.WriteHandlers.Add(WriteSize); 108 110 end; 109 111
Note:
See TracChangeset
for help on using the changeset viewer.