http://fpcamigawiki.alb42.de/index.php?title=Experimental_Tags&feed=atom&action=historyExperimental Tags - Revision history2024-03-29T02:25:13ZRevision history for this page on the wikiMediaWiki 1.35.1http://fpcamigawiki.alb42.de/index.php?title=Experimental_Tags&diff=274&oldid=prevMolly: Corrected source for experimental unit modern tags2014-10-16T16:43:17Z<p>Corrected source for experimental unit modern tags</p>
<a href="http://fpcamigawiki.alb42.de/index.php?title=Experimental_Tags&diff=274&oldid=272">Show changes</a>Mollyhttp://fpcamigawiki.alb42.de/index.php?title=Experimental_Tags&diff=272&oldid=prevMolly: initial content2014-10-15T20:48:39Z<p>initial content</p>
<p><b>New page</b></p><div>One of the most annoying things about passing an array of const (needed for passing f.e. tagitems) is the somewhat awkward way of creating an tagitemlist.<br />
<br />
Not only is it awkward, but the current way that the ReadInTags() function is implemented is plain wrong. It is not possible to use/create two taglists at the same time.<br />
<br />
ALB42 tried to implement a more practical solution by creating additional functions AddTags() and GetTagPtr() [http://svn.freepascal.org/cgi-bin/viewvc.cgi/trunk/packages/arosunits/src/tagsarray.pas?view=markup].<br />
<br />
Now that Free Pascal has a more convenient way of working with record through advanced records [http://wiki.freepascal.org/FPC_New_Features_2.6.0#Advanced_record_syntax], i gave it an experimental try.<br />
<br />
And boy, are we in for some troubles along the way.<br />
<br />
# for reasons beyond me, we must use $MODE DELPHI otherwise we are unable to overload assignment operators. (and that's exactly the fun part we want to 'abuse' here).<br />
# for another reason beyond me, the code completely crashes when passed a NULL, and compiler does not warn on compilation.<br />
# compiler keeps complaining about uninitialized variables, which is technically correct but, which is highly annoying.<br />
# i'm unsure the 'resetting' of the item array is required to force freeing the internal array. Unfortunately an advanced record does not have a destructor (in opposite of an constructor, but which Free Pascal currently does not support).<br />
# there are so many different (extended) implementations possible, that i refrained from adding any additional functionality. The whole source is based on the literal implementation that was already in Free Pascal trunk.<br />
<br />
Let's start with wome code for a TagItems list.<br />
<source lang="pascal"><br />
unit aros_modern_tags;<br />
<br />
{ $MODESWITCH ADVANCEDRECORDS <- does not let us overload assignment operator}<br />
{$MODE DELPHI}{$H+}<br />
<br />
(*<br />
Very basic implementation of modern tags in form of an advanced record.<br />
Based on ALBs (and previously other people's) work.<br />
http://svn.freepascal.org/cgi-bin/viewvc.cgi/trunk/packages/arosunits/src/tagsarray.pas?view=markup<br />
*)<br />
<br />
<br />
interface<br />
<br />
// Some conditional code in case compiling for another platform.<br />
{$IFDEF AROS}<br />
uses<br />
exec, utility;<br />
{$ENDIF}<br />
<br />
{$IFNDEF AROS}<br />
Const<br />
TAG_END = 0;<br />
<br />
Type<br />
IPTR = NativeUInt;<br />
<br />
PTagItem = ^TTagItem;<br />
TTagItem = record<br />
ti_Tag : LongWord;<br />
ti_Data : LongWord;<br />
end;<br />
{$ENDIF} <br />
<br />
Type<br />
TTagsList = array of TTagitem;<br />
<br />
<br />
TArosTags = record<br />
private<br />
TagsList : TTagsList;<br />
public<br />
procedure Add(const Args: array of const);<br />
procedure Clear;<br />
<br />
// Assignment operators to TArosTags from another type<br />
class operator := (a: Integer): TArosTags;<br />
<br />
// Assignment operators from TArosTags to another type<br />
class operator := (a: TArosTags): PTagItem;<br />
end;<br />
<br />
<br />
implementation<br />
<br />
<br />
procedure TArosTags.Add(const args: array of const);<br />
var<br />
i : Integer;<br />
ii : integer;<br />
begin<br />
ii := Length(Self.TagsList);<br />
<br />
SetLength(Self.TagsList, Length(Self.TagsList) + (Length(Args) div 2));<br />
<br />
for i := 0 to High(Args) do<br />
begin<br />
if (not Odd(i)) then<br />
begin<br />
self.TagsList[ii].ti_tag := IPTR(Args[i].vinteger);<br />
end <br />
else<br />
begin<br />
case Args[i].vtype of<br />
vtinteger : Self.TagsList[ii].ti_data := IPTR(Args[i].vinteger);<br />
vtboolean : Self.TagsList[ii].ti_data := IPTR(byte(Args[i].vboolean));<br />
vtpchar : Self.TagsList[ii].ti_data := IPTR(Args[i].vpchar);<br />
vtchar : Self.TagsList[ii].ti_data := IPTR(Args[i].vchar);<br />
vtstring : Self.TagsList[ii].ti_data := IPTR(PChar(string(Args[i].vstring^)));<br />
vtpointer : Self.TagsList[ii].ti_data := IPTR(Args[i].vpointer);<br />
end;<br />
inc(ii);<br />
end;<br />
end;<br />
end;<br />
<br />
<br />
procedure TArosTags.Clear;<br />
begin<br />
SetLength(Self.TagsList, 0);<br />
end;<br />
<br />
<br />
class operator TArosTags.implicit(a: Integer): TArosTags;<br />
begin<br />
// dummy function clear<br />
Result.Clear;<br />
end;<br />
<br />
<br />
class operator TArosTags.Implicit(a: TArosTags): PTagItem;<br />
var<br />
i : Integer;<br />
begin<br />
// writeln('calling TArosTags Implicit assignment, length =', length(a.tagsList));<br />
<br />
i := Length(a.TagsList);<br />
(*<br />
make sure last tag is TAG_END<br />
Actually, this might not be a good idea if enduser expects to be adding <br />
new tags later on.<br />
In which case it would be better to make a copy of the tagslist first or <br />
alternatively with adding tags first check if there's an end tag and <br />
remove the tag before adding new tags<br />
if (TagsList[i].ti_tag <> TAG_END) then Add([TAG_END, TAG_END]);<br />
*)<br />
if (a.TagsList[i].ti_tag <> TAG_END) then a.Add([TAG_END, TAG_END]);<br />
<br />
result := @a.TagsList[0];<br />
end;<br />
<br />
end.<br />
</source><br />
<br />
<br />
And some code to test a the TagItems.<br />
<br />
<source lang="pascal"><br />
program TestTagItems;<br />
<br />
// A simple quick test for modern args<br />
Procedure Test;<br />
var<br />
Items1 : TArosTags;<br />
value : IPTR;<br />
answer : IPTR;<br />
begin<br />
Items1.Add([1,1000,2,2000,3,3000, TAG_END]);<br />
<br />
value := 666;<br />
Answer := GetTagData(1, IPTR(@value), Items1);<br />
writeln('answer = ', answer);<br />
end;<br />
<br />
Begin<br />
Test;<br />
end.<br />
</source><br />
<br />
And when put to practice, it can look somewhat similar like:<br />
<source lang="pascal"><br />
Function GetAttrs(rp: PRastPort; const Tags: array of const): ULONG;<br />
Var TagItems: TArosTags;<br />
begin<br />
TagItems := 0;<br />
TagItems.Add(Tags);<br />
Result := GetAttrsA(rp, TagItems);<br />
TagItems := 0;<br />
end;<br />
</source></div>Molly