procedure TElement.Pass(SourceIndex: integer);
var Source : TElement;
begin
if SourceIndex <> -1 then Source := Sources[SourceIndex];
DoBeforeTake(Self);
if SourceIndex <> -1 then Source.DoBeforeDrop(Source);
TakeParcel(SourceIndex);
DoAfterTake(Self);
if SourceIndex <> -1 then Source.DoAfterDrop(Source);
end;
function TElement.GetCanDropParcelFor(Destination: TElement): Boolean;
begin
Result := CanDrop;
if Assigned(OnDestinationValidate) then
Result := Result and OnDestinationValidate(Destination)
end;
function TElement.GetCanTakeParcelFrom(Source : TElement) : Boolean;
begin
if Assigned(OnSourceValidate) then
Result := OnSourceValidate(Source)
else Result := True;
end;
procedure TElement.AskForParcel;
var i : integer;
Source : TElement;
begin
for i := 0 to SourceCount - 1 do begin
Source := Sources[i];
if Source.CanDropParcelFor[Self] and CanTakeParcelFrom[Source] then
if CanTake then begin
Pass(i);
if Self is TShop then Exit;
end
else
if not (Source is TAccumulator) then RefuseParcel(i);
end;//for
end;
function TElement.GetParcelPresent: Boolean;
begin
Result := FContainer <> nil;
end;
procedure TElement.ClearContainer;
begin
DropParcel;
end;
procedure TElement.RefuseParcel(SourceIndex: integer);
begin
Sources[SourceIndex].Container.State := psRefused;
TQSheme(Sheme).NewEvent(EV_REFUSE,Self,Sources[SourceIndex],Sources[SourceIndex].Container.Info);
Sources[SourceIndex].DropParcel;
end;
procedure TElement.DropParcel;
begin
Container := nil;
end;
procedure TElement.DoBeforeDrop(Sender : TElement);
begin
if Assigned(FBeforeDrop) then FBeforeDrop(Sender);
end;
procedure TElement.DoAfterDrop(Sender : TElement);
begin
if Assigned(FAfterDrop) then FAfterDrop(Sender);
end;
procedure TElement.DoBeforeTake(Sender : TElement);
begin
if Assigned(FBeforeTake) then FBeforeTake(Sender);
end;
procedure TElement.DoAfterTake(Sender : TElement);
begin
if Assigned(FAfterTake) then FAfterTake(Sender);
end;
constructor TGenerator.Create;
begin
inherited;
FRandomType := rtPlane;
end;
function TGenerator.GetRandom: TCustTime;
var R : single;
begin
case FRandomType of
rtPlane: R := PlaneRND;
rtNormal: R := NormRND;
rtExponent: R := ExpRND
else
R := Random;
end;
Result := FMean - FDisp + Round(R * 2 * FDisp);
end;
constructor TShop.Create;
begin
inherited;
FGenerator := TGenerator.Create;
end;
destructor TShop.Destroy;
begin
FGenerator.Free;
inherited;
end;
procedure TShop.DropParcel;
begin
inherited;
FEndWorkTime := 0;
end;
procedure TShop.Pass(SourceIndex : integer);
begin
inherited;
Work;
end;
function TShop.GetProcessed: Boolean;
begin
Result := (TQSheme(Sheme).SysTime >= FEndWorkTime);
end;
function TShop.GetCanTake: Boolean;
begin
Result := not ParcelPresent and Processed;
end;
function TShop.GetCanDrop: Boolean;
begin
Result := ParcelPresent and Processed;
end;
procedure TShop.Work;
begin
FEndWorkTime := TQSheme(Sheme).SysTime + FGenerator.GetRandom;
end;
procedure TChannel.Pass(SourceIndex: integer);
begin
inherited;
Container.State := psWork;
end;
procedure TSource.TakeParcel(SourceIndex: integer);
begin
Container := TQSheme(Sheme).NewParcel;
end;
procedure TSource.Pass(SourceIndex : integer);
begin
inherited;
Container.State := psBorn;
end;
procedure TSource.AskForParcel;
begin
if CanTake then Pass(-1);
end;
constructor TAccumulator.Create;
begin
FLimited := False;
FParcels := TList.Create;
inherited;
end;
destructor TAccumulator.Destroy;
begin
FParcels.Free;
end;
function TAccumulator.GetParcel(Index : integer): TParcel;
begin
Result := FParcels[Index];
end;
function TAccumulator.GetCanDrop: Boolean;
begin
if Empty then AskForParcel;
if not Empty then Container := FParcels.First;
Result := not Empty;
end;
function TAccumulator.GetCanTake: Boolean;
begin
Result := FreeSpacePresent;
end;
function TAccumulator.GetFreeSpacePresent: Boolean;
begin
Result := (Capacity <> FParcels.Count) or (not Limited);
end;
function TAccumulator.GetEmpty: Boolean;
begin
Result := FParcels.Count = 0;
//if not Result then Container := FParcels.First;
end;
procedure TAccumulator.DropParcel;
begin
if not Empty then FParcels.Delete(0);
inherited;
end;
function TAccumulator.GetCapacity : integer;
begin
Result := FCapacity;
end;
function TAccumulator.GetParcelCount: integer;
begin
Result := FParcels.Count;
end;
procedure TAccumulator.SetCapacity(Value : integer);
begin
FLimited := True;
FCapacity := Value;
end;
procedure TAccumulator.ClearContainer;
begin
FParcels.Clear;
inherited;
end;
procedure TAccumulator.Pass(SourceIndex : integer);
begin
inherited;
Container.State := psStore;
end;
procedure TAccumulator.TakeParcel(Index : integer);
begin
FParcels.Add(Sources[Index].Container);
TQSheme(Sheme).NewEvent(EV_TAKE,Self,Sources[Index],Sources[Index].Container.Info);
Container := FParcels.Last;
Sources[Index].DropParcel;
end;
end.