1 {
2 *****************************************************************************
3 * TagsParamsHelper.pas *
4 * -------------- *
5 * Taglist and parameter handling for Amiga-sytle systems *
6 * *
7 *****************************************************************************
8
9 *****************************************************************************
10 This file is part of the Lazarus Component Library (LCL)
11
12 See the file COPYING.modifiedLGPL.txt, included in this distribution,
13 for details about the license.
14 *****************************************************************************
15 }
16 unit TagsParamsHelper;
17
18 {$mode objfpc}{$H+}
19
20 interface
21
22 uses
23 {$ifdef HASAMIGA}
24 Exec, Utility,
25 {$endif}
26 Classes, SysUtils, Math;
27
28 {$ifndef HASAMIGA}
29 type
30 TTagItem = record
31 ti_Tag: NativeUInt;
32 ti_Data: NativeUInt;
33 end;
34 PTagItem = ^TTagItem;
35
36 const
37 TAG_DONE = 0;
38 {$endif}
39
40 const
41 TagTrue = 1;
42 TagFalse = 0;
43
44 type
45
46 { TATagList }
47
48 TATagList = object
49 private
50 List: array of TTagItem;
51 procedure TagDbgOut(txt: string);
52 public
53 procedure Clear;
GetTagPointernull54 function GetTagPointer: PTagItem;
55 procedure AddTag(Tag: LongWord; Data: NativeUInt);
56 procedure AddTags(const AList: array of NativeUInt);
57 procedure DebugPrint;
58 end;
59
60 { TAParamList }
61
62 TAParamList = object
63 private
64 List: array of NativeUInt;
65 public
66 procedure SetParams(AList: array of NativeUInt);
GetParamPointernull67 function GetParamPointer: Pointer;
68 end;
69
70 operator := (AList: TATagList): PTagItem;
71 operator := (APList: TAParamList): Pointer;
72 operator := (APList: TAParamList): PNativeInt;
73
74 implementation
75
76 { TAParamList }
77
78 procedure TAParamList.SetParams(AList: array of NativeUInt);
79 var
80 i: Integer;
81 begin
82 SetLength(List, Length(AList));
83 for i := 0 to High(List) do
84 List[i] := AList[i];
85 end;
86
GetParamPointernull87 function TAParamList.GetParamPointer: Pointer;
88 begin
89 if Length(List) > 0 then
90 Result := @(List[0])
91 else
92 Result := nil;
93 end;
94
95
96 operator := (APList: TAParamList): Pointer;
97 begin
98 Result := APList.GetParamPointer;
99 end;
100
101 operator := (APList: TAParamList): PNativeInt;
102 begin
103 Result := APList.GetParamPointer;
104 end;
105
106 { TATagList }
107
108 procedure TATagList.Clear;
109 begin
110 SetLength(List, 1);
111 List[0].ti_Tag := TAG_DONE;
112 List[0].ti_Data := 0;
113 end;
114
GetTagPointernull115 function TATagList.GetTagPointer: PTagItem;
116 begin
117 //DebugPrint;
118 Result := @(List[0]);
119 end;
120
121 procedure TATagList.AddTag(Tag: LongWord; Data: NativeUInt);
122 var
123 CurIdx: Integer;
124 begin
125 if Tag = TAG_DONE then
126 Exit;
127 CurIdx := Max(0, High(List));
128 SetLength(List, CurIdx + 2);
129 List[CurIdx].ti_Tag := Tag;
130 List[CurIdx].ti_Data := Data;
131 List[CurIdx + 1].ti_Tag := TAG_DONE;
132 List[CurIdx + 1].ti_Data := TAG_DONE;
133 end;
134
135 procedure TATagList.AddTags(const AList: array of NativeUInt);
136 var
137 Tag: LongWord;
138 Data: NativeUInt;
139 i: Integer;
140 begin
141 i := 0;
142 while i <= High(AList) do
143 begin
144 Tag := AList[i];
145 Inc(i);
146 if i <= High(AList) then
147 begin
148 Data := AList[i];
149 Self.AddTag(Tag, Data);
150 Inc(i);
151 end else
152 begin
153 if Tag <> TAG_DONE then
154 {$ifdef HASAMIGA}
155 SysDebugln('AddTags called with odd number of Parameter (' + IntToStr(Length(AList)) + ')');
156 {$else}
157 Writeln('AddTags called with odd number of Parameter (' + IntToStr(Length(AList)) + ')');
158 {$endif}
159 end;
160 end;
161 end;
162
163 procedure TATagList.TagDbgOut(txt: string);
164 begin
165 {$ifdef HASAMIGA}
166 SysDebugln('TagList('+HexStr(@List[0]) + '):' + txt);
167 {$else}
168 Writeln('TagList('+HexStr(@List[0]) + '):' + txt);
169 {$endif}
170 end;
171
172 procedure TATagList.DebugPrint;
173 var
174 i: Integer;
175 begin
176 TagDbgOut('List with ' + IntToStr(Length(List)) + ' Entries.');
177 for i := 0 to High(List) do
178 begin
179 TagDbgOut('+ ' + IntToStr(i) + '. ' + HexStr(@List[i]));
180 TagDbgOut(' ' + IntToStr(i) + '. Tag: ' + HexStr(Pointer(List[i].ti_Tag)) + ' Data: ' + HexStr(Pointer(List[i].ti_Data)));
181 TagDbgOut('- ' + IntToStr(i) + '. ' + HexStr(@List[i]));
182 end;
183 TagDbgOut('End Of List');
184 end;
185
186
187 operator := (AList: TATagList): PTagItem;
188 begin
189 Result := AList.GetTagPointer;
190 end;
191
192 end.
193
194