1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
{ Control stack
CopyRight (C) 2004-2008 Ales Katona
This library is Free software; you can rediStribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version.
This program is diStributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; withOut even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a Copy of the GNU Library General Public License
along with This library; if not, Write to the Free Software Foundation,
Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
This license has been modified. See File LICENSE for more inFormation.
Should you find these sources withOut a LICENSE File, please contact
me at ales@chello.sk
}
unit lControlStack;
{$mode objfpc}
interface
const
TL_CSLENGTH = 3;
type
TLOnFull = procedure of object;
TLControlStack = class
private
FItems: array of Char;
FIndex: Byte;
FAllowInflation: Boolean;
FOnFull: TLOnFull;
function GetFull: Boolean;
function GetItem(const i: Byte): Char;
procedure SetItem(const i: Byte; const Value: Char);
procedure SetAllowInflation(const b: boolean);
public
constructor Create;
procedure Clear;
procedure Push(const Value: Char);
property ItemIndex: Byte read FIndex;
property AllowInflation: Boolean read FAllowInflation write SetAllowInflation;
property Items[i: Byte]: Char read GetItem write SetItem; default;
property Full: Boolean read GetFull;
property OnFull: TLOnFull read FOnFull write FOnFull;
end;
implementation
uses
lTelnet;
(* The normal situation is that there are up to TL_CSLENGTH items on the stack. *)
(* However this may be relaxed in cases (assumed to be rare) where subcommand *)
(* parameters are being accumulated. *)
constructor TLControlStack.Create;
begin
FOnFull:=nil;
FIndex:=0; (* Next insertion point, [0] when empty *)
FAllowInflation := false;
SetLength(FItems, TL_CSLENGTH);
end;
function TLControlStack.GetFull: Boolean;
begin
Result:=False; (* It's full when it has a complete *)
if FIndex >= TL_CSLENGTH then (* command, irrespective of whether the *)
Result:=True; (* stack's inflated by a subcommand. *)
end;
function TLControlStack.GetItem(const i: Byte): Char;
begin
Result:=TS_NOP;
if not FAllowInflation then begin
if i < TL_CSLENGTH then
Result:=FItems[i]
end else
if i < Length(FItems) then
Result:=FItems[i]
end;
procedure TLControlStack.SetItem(const i: Byte; const Value: Char);
begin
if not FAllowInflation then begin
if i < TL_CSLENGTH then
FItems[i]:=Value
end else begin
while i >= Length(FItems) do begin
SetLength(FItems, Length(FItems) + 1);
FItems[Length(FItems) - 1] := TS_NOP
end;
FItems[i] := Value
end
end;
procedure TLControlStack.SetAllowInflation(const b: boolean);
begin
FAllowInflation := b;
if not b then (* No more funny stuff please *)
Clear
end;
procedure TLControlStack.Clear;
begin
FIndex:=0;
FAllowInflation := false;
SetLength(FItems, TL_CSLENGTH) (* In case inflation was allowed *)
end;
procedure TLControlStack.Push(const Value: Char);
begin
if not FAllowInflation then
if FIndex < TL_CSLENGTH then begin
FItems[FIndex]:=Value;
Inc(FIndex)
end else begin end
else begin
SetLength(FItems, Length(FItems) + 1);
FItems[Length(FItems) - 1] := Value;
FIndex := Length(FItems)
end;
if Full and Assigned(FOnFull) then
FOnFull;
end;
end.
|
