I need to cheate array of events with win32 help. Language: Ada.
What I do:
p:integer := 4;
Type EvArr1 is array (1..p) of HANDLE;
procedure Start (Tid : in integer) is
Task T1;
task body T1 is
Bl:bool;
temp:Dword;
...
begin
...
Bl:=(EvArr1(Tid));
temp:=WaitForMultipleObjects(EvArr1, infinite);
...
end T1;
end start;
BEGIN
...
for i in 1..p loop
EvArr1(i) := CreateEvent(null, 1, 0, null); -- error
EvArr2(i) := CreateEvent(null, 1, 0, null); -- error
start(i);
end loop;
Error:
The types are not convertible; the operand type must be an array type, Continuing
As declared, EvArr1 is a type, not an object.
Try
EvArr1 : array (1 .. p) of HANDLE;
or
type Event_Array is array (1 .. p) of HANDLE;
EvArr1 : Event_Array;
The second is good if you want to have subprograms/entries with parameters of the type. Even better,
type Event_Array is array (Positive range <>) of HANDLE;
EvArr1 : Event_Array (1 .. p);
Related
I am trying to read two strings of varying length from a TMemoryStream, but both streams end up being the same length. So if, for example, the first string is 'abcdefghijkl', and the second one is 'wxyz', the value I get for the second string is 'wxyzefghijkl' (the first four characters of my new string ('wxyz') followed by the remaining characters of the 1st string that have not been replaced by 'wxyz'
My code is:-
var
L : LongInt
S : string;
...
msRecInfo.Position := 0;
msRecInfo.Read(L, SizeOf(L)); // read size of following string ...
SubStream.Clear;
SubStream.CopyFrom(msRecInfo, L); // copy next block of data to a second TMemoryStream
if (L > 0) then S := StreamToString(SubStream); //convert the stream into a string
msRecInfo.Read(L, SizeOf(L)); // get size of following string ...
SubStream.CopyFrom(msRecInfo, L);
if (L > 0) then S := StreamToString(SubStream);
I have been battling with this for hours without success. Can anyone point out what I am doing wrong?
You are not calling SubStream.Clear() before the 2nd call to SubStream.CopyFrom(). So, the 1st call to StreamToString(SubStream) leaves SubStream.Position at the end of the stream, then the subsequent SubStream.CopyFrom() adds more data to the stream, preserving the existing data. Then the subsequent StreamToString(SubStream) reads all of the data from SubStream.
Also, be aware that if L is 0 when you pass it to SubStream.CopyFrom(), it will copy the entire msRecInfo stream. This is documented behavior:
https://docwiki.embarcadero.com/Libraries/en/System.Classes.TStream.CopyFrom
If Count is 0, CopyFrom sets Source position to 0 before reading and then copies the entire contents of Source into the stream. If Count is greater than or less than 0, CopyFrom reads from the current position in Source.
So, you need to move up your L > 0 check, eg:
msRecInfo.Read(L, SizeOf(L));
if (L > 0) then
begin
SubStream.Clear;
SubStream.CopyFrom(msRecInfo, L);
S := StreamToString(SubStream);
end
else
S := '';
I would suggest wrapping this logic into a reusable function, eg:
var
L : LongInt;
S : string;
function ReadString: string;
begin
msRecInfo.Read(L, SizeOf(L)); // read size of following string ...
if (L > 0) then
begin
SubStream.Clear;
SubStream.CopyFrom(msRecInfo, L); // copy next block of data to a second TMemoryStream
Result := StreamToString(SubStream); //convert the stream into a string
end else
Result := '';
end;
begin
...
msRecInfo.Position := 0;
S := ReadString;
S := ReadString;
...
Although, if feasible, I would suggest just getting rid of SubStream altogether, update StreamToString() to take L as an input parameter, so that you can read the string from msRecInfo directly, eg:
msRecInfo.Read(L, SizeOf(L));
S := StreamToString(msRecInfo, L);
No need for a 2nd TMemoryStream if you can avoid it.
I need to test if a point hits a polygon with holes and isles. I'd like to understand how I'm supposed to do this. That's not documented and I can't find any explanation or examples.
What I do is count +1 for every outer polygon hit and -1 for every inner polygon hit. The resulting sum is:
> 0: hit;
<= 0: miss (outside or in a hole).
The HitData class separates paths based on winding number to avoid unnecessary recomputation of orientation. With Clipper.PointInPolygon() applied to every path the sum is easy to compute.
But there are two major drawbacks:
I have to apply Clipper.PointInPolygon() to EVERY path;
I can't leverage the hierarchy of PolyTree.
Can someone who has hands-on experience with Clipper (#angus-johnson?) clear up this confusion?
Again, my question is: how am I supposed to implement this? Am I re-inventing the wheel, while there's an actual solution readily available in the Clipper Library?
Side note: PolyTree still requires to test EVERY path to determine which PolyNode the point is in. There's no Clipper.PointInPolyTree() method and, thus, AFAIK PolyTree doesn't help.
The structure that separates outer and inner polygons:
public class HitData
{
public List<List<IntPoint>> Outer, Inner;
public HitData(List<List<IntPoint>> paths)
{
Outer = new List<List<IntPoint>>();
Inner = new List<List<IntPoint>>();
foreach (List<IntPoint> path in paths)
{
if (Clipper.Orientation(path))
{
Outer.Add(path);
} else {
Inner.Add(path);
}
}
}
}
And this is the algorithm that tests a point:
public static bool IsHit(HitData data, IntPoint point)
{
int hits;
hits = 0;
foreach (List<IntPoint> path in data.Outer)
{
if (Clipper.PointInPolygon(point, path) != 0)
{
hits++;
}
}
foreach (List<IntPoint> path in data.Inner)
{
if (Clipper.PointInPolygon(point, path) != 0)
{
hits--;
}
}
return hits > 0;
}
Can someone who has hands-on experience with Clipper (#angus-johnson?) clear up this confusion?
It's not clear to me what your confusion is. As you've correctly observed, the Clipper library does not provide a function to determine whether a point is inside multiple paths.
Edit (13 Sept 2019):
OK, I've now created a PointInPaths function (in Delphi Pascal) that determines whether a point is inside multiple paths. Note that this function accommodates the different polygon filling rules.
function CrossProduct(const pt1, pt2, pt3: TPointD): double;
var
x1,x2,y1,y2: double;
begin
x1 := pt2.X - pt1.X;
y1 := pt2.Y - pt1.Y;
x2 := pt3.X - pt2.X;
y2 := pt3.Y - pt2.Y;
result := (x1 * y2 - y1 * x2);
end;
function PointInPathsWindingCount(const pt: TPointD;
const paths: TArrayOfArrayOfPointD): integer;
var
i,j, len: integer;
p: TArrayOfPointD;
prevPt: TPointD;
isAbove: Boolean;
crossProd: double;
begin
//nb: returns MaxInt ((2^32)-1) when pt is on a line
Result := 0;
for i := 0 to High(paths) do
begin
j := 0;
p := paths[i];
len := Length(p);
if len < 3 then Continue;
prevPt := p[len-1];
while (j < len) and (p[j].Y = prevPt.Y) do inc(j);
if j = len then continue;
isAbove := (prevPt.Y < pt.Y);
while (j < len) do
begin
if isAbove then
begin
while (j < len) and (p[j].Y < pt.Y) do inc(j);
if j = len then break
else if j > 0 then prevPt := p[j -1];
crossProd := CrossProduct(prevPt, p[j], pt);
if crossProd = 0 then
begin
result := MaxInt;
Exit;
end
else if crossProd < 0 then dec(Result);
end else
begin
while (j < len) and (p[j].Y > pt.Y) do inc(j);
if j = len then break
else if j > 0 then prevPt := p[j -1];
crossProd := CrossProduct(prevPt, p[j], pt);
if crossProd = 0 then
begin
result := MaxInt;
Exit;
end
else if crossProd > 0 then inc(Result);
end;
inc(j);
isAbove := not isAbove;
end;
end;
end;
function PointInPaths(const pt: TPointD;
const paths: TArrayOfArrayOfPointD; fillRule: TFillRule): Boolean;
var
wc: integer;
begin
wc := PointInPathsWindingCount(pt, paths);
case fillRule of
frEvenOdd: result := Odd(wc);
frNonZero: result := (wc <> 0);
end;
end;
With regards leveraging the PolyTree structure:
The top nodes in PolyTree are outer nodes that together contain every (nested) polygon. So you'll only need to perform PointInPolygon on these top nodes until a positive result is found. Then repeat PointInPolygon on that nodes nested paths (if any) looking for a positive match there. Obviously when an outer node fails PointInPolygon test, then its nested nodes (polygons) will also fail. Outer nodes will increment the winding count and inner holes will decrement the winding count.
I have this Ada package code which theoretically is well written:
with Ada.Text_IO;
with Ada.Characters.Handling;
package body pkg_procedure is
procedure Read_Integer(Num : out Integer) is
Intro : constant Character := ASCII.LF;
Back : constant Character := ASCII.Del;
Char : Character;
Fin : Boolean := False;
Number : Natural := 0;
String_Number : String (1 .. Integer'Width – 1);
begin
Ada.Text_IO.New_line;
Ada.Text_IO.Put ("Write down a number and press Enter: ");
while not Fin loop
Ada.Text_IO.Get_Immediate (Char);
if Ada.Characters.Handling.Is_Digit (Char) then
Number := Number + 1;
String_Number(Number) := Char;
Ada.Text_IO.Put (Char);
elsif Char = Intro then
Fin := True;
elsif Number > 0 and Char = Back then
Ada.Text_IO.Put (ASCII.BS & ' ' & ASCII.BS);
Number := Number + 1;
end if;
end loop;
Number := Integer'Value (String_Number (1 .. Number));
Ada.Text_IO.New_line;
Num := Number;
exception
when Constraint_Error =>
Ada.Text_IO.New_line;
Ada.Text_IO.Put_Line ("Sorry: " & String_Number & " is too long to store it");
Num := 0;
end Read_Integer;
end pkg_procedure;
When I compile the program I obtain an error on this instruction which says: binary operator expected.
I can't fix it. I am totally new to this programming language.
The problem turns out to be that the - in
String_Number : String (1 .. Integer'Width – 1);
isn’t a plain - but a wide character with encoding e28093 - EN DASH.
I found this because, having seen that various exploratory changes didn’t show the error, I reverted to your original and tried compiling with -gnatw8 (input is UTF-8) as well as -gnatl for mixing messages with the program text, which resulted in
13. String_Number : String (1 .. Integer'Width – 1);
12
>>> binary operator expected
>>> illegal wide character
I suspect you provided us the wrong part of your code as this
with Ada.Text_Io; use Ada.Text_Io;
procedure TestInt is
number : String (1 .. Integer'Width - 1);
begin
Put_Line("Width=" & Integer'Image(Integer'Width - 1));
end TestInt;
works like a charm, if we ignore the warning on number which is not used, and return as expected :
Width= 10
Please be more precise and provide a full compilable sample.
I might also be interesting to tell us which compiler you use and on which operating system.
Problem
There are multiple ways to store string reference, so how would you do it in the example code? Currently the problem is with storing access to string because it is causing non-local pointer cannot point to local object. Is storing 'First and 'Last to reference a string a preferable way?
String reference storage
This record stores reference to a string. The First and Last is supposed to point to a string. The Name should be able to the same I think, but that will cause non-local pointer cannot point to local object when a local string is assigned to that. So the current work around solution is to use First and Last.
type Segment is record
First : Positive;
Last : Positive;
Length : Natural := 0;
Name : access String;
end record;
Assigning sub string reference
The commented line is causing non-local pointer cannot point to local object. This is because Item is local. Source is not local and that is the string I want sub string references from.
procedure Find (Source : aliased String; Separator : Character; Last : out Natural; Item_Array : out Segment_Array) is
P : Positive := Source'First;
begin
for I in Item_Array'Range loop
declare
Item : aliased String := Separated_String_Next (Source, Separator, P);
begin
exit when Item'Length = 0;
Item_Array (I).Length := Item'Length;
Item_Array (I).First := Item'First;
Item_Array (I).Last := Item'Last;
--Item_Array (I).Name := Item'Access;
Last := I;
end;
end loop;
end;
Example
with Ada.Text_IO;
with Ada.Integer_Text_IO;
procedure Main is
use Ada.Text_IO;
use Ada.Integer_Text_IO;
function Separated_String_Next (Source : String; Separator : Character; P : in out Positive) return String is
A : Positive := P;
B : Positive;
begin
while A <= Source'Last and then Source(A) = Separator loop
A := A + 1;
end loop;
P := A;
while P <= Source'Last and then Source(P) /= Separator loop
P := P + 1;
end loop;
B := P - 1;
while P <= Source'Last and then Source(P) = Separator loop
P := P + 1;
end loop;
return Source (A .. B);
end;
type Segment is record
First : Positive;
Last : Positive;
Length : Natural := 0;
Name : access String;
end record;
type Segment_Array is array (Integer range <>) of Segment;
procedure Find (Source : String; Separator : Character; Last : out Natural; Item_Array : out Segment_Array) is
P : Positive := Source'First;
begin
for I in Item_Array'Range loop
declare
Item : aliased String := Separated_String_Next (Source, Separator, P);
begin
exit when Item'Length = 0;
Item_Array (I).Length := Item'Length;
Item_Array (I).First := Item'First;
Item_Array (I).Last := Item'Last;
--Item_Array (I).Name := Item'Access;
Last := I;
end;
end loop;
end;
Source : String := ",,Item1,,,Item2,,Item3,,,,,,";
Item_Array : Segment_Array (1 .. 100);
Last : Natural;
begin
Find (Source, ',', Last, Item_Array);
Put_Line (Source);
Put_Line ("Index First Last Name");
for I in Item_Array (Item_Array'First .. Last)'Range loop
Put (I, 5);
Put (Item_Array (I).First, 6);
Put (Item_Array (I).Last, 5);
Put (" ");
Put (Source (Item_Array (I).First .. Item_Array (I).Last));
New_Line;
end loop;
end;
Output
,,Item1,,,Item2,,Item3,,,,,,
Index First Last Name
1 3 7 Item1
2 11 15 Item2
3 18 22 Item3
The error message tells you exactly what is wrong : Item is a string declared locally, i.e. on the stack, and you are assigning its address to an access type (pointer). I hope I don't need to explain why that won't work.
The immediate answer - which isn't wrong but isn't best practice either, is to allocate space for a new string - in a storage pool or on the heap - which is done with new.
Item : access String := new String'(Separated_String_Next (Source, Separator, P));
...
Item_Array (I).Name := Item;
Note that some other record members, at least, Length all appear to be completely redundant since it is merely a copy of its eponymous attributes, so should probably be eliminated (unless there's a part of the picture I can't see).
There are better answers. Sometimes you need to use access types, and handle their object lifetimes and all the ways they can go wrong. But more often their appearance is a hint that something in the design can be improved : for example:
the Unbounded_String may manage your strings more simply
You could use the length as a discriminant on the Segment record, and store the actual string (not an Access) in the record itself
Ada.Containers are a standard library of containers to abstract over handling the storage yourself (much as the STL is used in C++).
If you DO decide you need access types, it's better to use a named access type type Str_Access is access String; - then you can create a storage pool specific to Str_Acc types, and release the entire pool in one operation, to simplify object lifetime management and eliminate memory leaks.
Note the above essentially "deep copies" the slices of the Source string. If there is a specific need to "shallow copy" it - i.e. refer to the specific substrings in place - AND you can guarantee its object lifetime, this answer is not what you want. If so, please clarify the intent of the question.
For a "shallow copy" the approach in the question essentially fails because Item is already a deep copy ... on the stack.
The closest approach I can see is to make the source string aliassed ... you MUST do as you want each Segment to refer to it ... and pass its access to the Find procedure.
Then each Segment becomes a tuple of First, Last, (redundant Length) and access to the entire string (rather than a substring).
procedure Find (Source : access String; Separator : Character;
Last : out Natural; Item_Array : out Segment_Array) is
P : Positive := Source'First;
begin
for I in Item_Array'Range loop
declare
Item : String := Separated_String_Next (Source.all, Separator, P);
begin
exit when Item'Length = 0;
...
Item_Array (I).Name := Source;
Last := I;
end;
end loop;
end;
Source : aliased String := ",,Item1,,,Item2,,Item3,,,,,,";
...
Find (Source'access, ',', Last, Item_Array);
for I in Item_Array (Item_Array'First .. Last)'Range loop
...
Put (Item_Array (I).Name(Item_Array (I).First .. Item_Array (I).Last));
New_Line;
end loop;
A helper to extract a string from a Segment would probably be useful:
function get(S : Segment) return String is
begin
return S.Name(S.First .. S.Last);
end get;
...
Put (get(Item_Array (I));
The only rationale I can see for such a design is where the set of strings to be parsed or dissected will barely fit in memory so duplication must be avoided. Perhaps also embedded programming or some such discipline where dynamic (heap) allocation is discouraged or even illegal.
I see no solution involving address arithmetic within a string, since an array is not merely its contents - if you point within it, you lose the attributes. You can make the same criticism of the equivalent C design : you can identify the start of a substring with a pointer, but you can't just stick a null terminator at the end of the substring without breaking the original string.
Given the bigger picture ... what you need, rather than the low level details of how you want to achieve it, there are probably better solutions.
How to Split the given String for the given Delimiter.
Ex:
INPUT
String => '1,2,3,4,5'
Delimiter => ','
OUTPUT
1
2
3
4
5
What about this? The regular expression allows for null list elements too.
SQL> with tbl(str) as (
2 select '1,2,,4,5' from dual
3 )
4 select regexp_substr(str, '(.*?)(,|$)', 1, level, null, 1) element
5 from tbl
6 connect by level <= regexp_count(str, ',')+1;
ELEMENT
--------
1
2
4
5
SQL>
See this post for a function that returns a list element: REGEX to select nth value from a list, allowing for nulls
I have found my own way to split the given String using a FUNCTION
A TYPE should be declared as belows:
TYPE tabsplit IS TABLE OF VARCHAR2 (50)
INDEX BY BINARY_INTEGER;
And the FUNCTION should be written like this:
FUNCTION fn_split (mp_string IN VARCHAR2, mp_delimiter IN VARCHAR2)
RETURN tabsplit
IS
ml_point NUMBER (5, 0) := 1;
ml_sub_str VARCHAR2 (50);
i NUMBER (5, 0) := 1;
taboutput tabsplit;
ml_count NUMBER (5, 0) := 0;
BEGIN
WHILE i <= LENGTH (mp_string)
LOOP
FOR j IN i .. LENGTH (mp_string)
LOOP
IF SUBSTR (mp_string, j, 1) = mp_delimiter
THEN
ml_sub_str := SUBSTR (mp_string, ml_point, j - ml_point);
ml_point := j + 1;
i := ml_point;
i := i - 1;
taboutput (ml_count) := ml_sub_str;
ml_count := ml_count + 1;
EXIT;
END IF;
END LOOP;
i := i + 1;
END LOOP;
ml_sub_str := SUBSTR (mp_string, ml_point, LENGTH (mp_string));
taboutput (ml_count) := ml_sub_str;
RETURN taboutput;
END fn_split;
This FUNCTION can be used as belows:
DECLARE
taboutput tabsplit;
BEGIN
taboutput := fn_split ('1,2,3,4,5', ',');
FOR i IN 0 .. taboutput.COUNT - 1
LOOP
DBMS_OUTPUT.put_line (taboutput (i));
END LOOP;
END;
SELECT LEVEL AS id, REGEXP_SUBSTR('A,B,C,D', '[^,]+', 1, LEVEL) AS data
FROM dual
CONNECT BY REGEXP_SUBSTR('A,B,C,D', '[^,]+', 1, LEVEL) IS NOT NULL;