codegen/QtQuickWidgets: updated

codegen/QtQuickWidgets: updated

Modified:
codegen/QtQuickWidgets/QQuickWidget.prg

%%
%% Qt5xHb - Bindings libraries for Harbour/xHarbour and Qt Framework 5
%%
%% Copyright (C) 2020 Marcos Antonio Gambeta <marcosgambeta AT outlook DOT com>
%%

$project=Qt5xHb
$module=QtQuickWidgets

$header

#include "hbclass.ch"

$addRequests

$beginClassFrom=QWidget

$addMethods

$addSignals

$endClass

$destructor

#pragma BEGINDUMP

$includes=5,3,0

#include <QtQml/QQmlError>
#include <QtQml/QQmlEngine>
#include <QtQml/QQmlContext>
#include <QtQuick/QQuickItem>

$prototype=explicit QQuickWidget(QWidget *parent = 0)
$internalConstructor=5,3,0|new1|QWidget *=0

$prototype=QQuickWidget(QQmlEngine* engine, QWidget *parent)
$internalConstructor=5,3,0|new2|QQmlEngine *,QWidget *

$prototype=QQuickWidget(const QUrl &source, QWidget *parent = 0)
$internalConstructor=5,3,0|new3|const QUrl &,QWidget *=0

/*
[1]explicit QQuickWidget(QWidget *parent = 0)
[2]QQuickWidget(QQmlEngine* engine, QWidget *parent)
[3]QQuickWidget(const QUrl &source, QWidget *parent = 0)
*/

HB_FUNC_STATIC( QQUICKWIDGET_NEW )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,3,0))
  if( ISBETWEEN(0,1) && ISOPTQWIDGET(1) )
  {
    QQuickWidget_new1();
  }
  else if( ISNUMPAR(2) && ISQQMLENGINE(1) && ISQWIDGET(2) )
  {
    QQuickWidget_new2();
  }
  else if( ISBETWEEN(1,2) && ISQURL(1) && ISOPTQWIDGET(2) )
  {
    QQuickWidget_new3();
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
#endif
}

$deleteMethod=5,3,0

$prototype=QUrl source() const
$method=5,3,0|QUrl|source|

$prototype=void setSource(const QUrl&)
$method=5,3,0|void|setSource|const QUrl &

$prototype=QQmlEngine* engine() const
$method=5,3,0|QQmlEngine *|engine|

$prototype=QQmlContext* rootContext() const
$method=5,3,0|QQmlContext *|rootContext|

$prototype=QQuickItem *rootObject() const
$method=5,3,0|QQuickItem *|rootObject|

$prototype=ResizeMode resizeMode() const
$method=5,3,0|QQuickWidget::ResizeMode|resizeMode|

$prototype=void setResizeMode(ResizeMode)
$method=5,3,0|void|setResizeMode|QQuickWidget::ResizeMode

$prototype=Status status() const
$method=5,3,0|QQuickWidget::Status|status|

$prototype=QList<QQmlError> errors() const
$method=5,3,0|QList<QQmlError>|errors|

$prototype=QSize sizeHint() const
$method=5,3,0|QSize|sizeHint|

$prototype=QSize initialSize() const
$method=5,3,0|QSize|initialSize|

$prototype=void setContent(const QUrl& url, QQmlComponent *component, QObject *item)
$method=5,3,0|void|setContent|const QUrl &,QQmlComponent *,QObject *

$prototype=QSurfaceFormat format() const
$method=5,3,0|QSurfaceFormat|format|

$prototype=void setFormat(const QSurfaceFormat &format)
$method=5,3,0|void|setFormat|const QSurfaceFormat &

$beginSignals
$signal=5,3,0|statusChanged(QQuickWidget::Status)
$signal=5,3,0|sceneGraphError(QQuickWindow::SceneGraphError,QString)
$endSignals

#pragma ENDDUMP

%%
%% Qt5xHb - Bindings libraries for Harbour/xHarbour and Qt Framework 5
%%
%% Copyright (C) 2020 Marcos Antonio Gambeta <marcosgambeta AT outlook DOT com>
%%

$project=Qt5xHb
$module=QtQuickWidgets

$header

#include "hbclass.ch"

$addRequests

$beginClassFrom=QWidget

$addMethods

$addSignals

$endClass

$destructor

#pragma BEGINDUMP

$includes=5,3,0

#include <QtQml/QQmlError>
#include <QtQml/QQmlEngine>
#include <QtQml/QQmlContext>
#include <QtQuick/QQuickItem>

$prototype=explicit QQuickWidget(QWidget *parent = 0)
$internalConstructor=5,3,0|new1|QWidget *=0

$prototype=QQuickWidget(QQmlEngine* engine, QWidget *parent)
$internalConstructor=5,3,0|new2|QQmlEngine *,QWidget *

$prototype=QQuickWidget(const QUrl &source, QWidget *parent = 0)
$internalConstructor=5,3,0|new3|const QUrl &,QWidget *=0

//[1]explicit QQuickWidget(QWidget *parent = 0)
//[2]QQuickWidget(QQmlEngine* engine, QWidget *parent)
//[3]QQuickWidget(const QUrl &source, QWidget *parent = 0)

HB_FUNC_STATIC( QQUICKWIDGET_NEW )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,3,0))
  if( ISBETWEEN(0,1) && ISOPTQWIDGET(1) )
  {
    QQuickWidget_new1();
  }
  else if( ISNUMPAR(2) && ISQQMLENGINE(1) && ISQWIDGET(2) )
  {
    QQuickWidget_new2();
  }
  else if( ISBETWEEN(1,2) && ISQURL(1) && ISOPTQWIDGET(2) )
  {
    QQuickWidget_new3();
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
#endif
}

$deleteMethod=5,3,0

$prototype=QUrl source() const
$method=5,3,0|QUrl|source|

$prototype=void setSource(const QUrl&)
$method=5,3,0|void|setSource|const QUrl &

$prototype=QQmlEngine* engine() const
$method=5,3,0|QQmlEngine *|engine|

$prototype=QQmlContext* rootContext() const
$method=5,3,0|QQmlContext *|rootContext|

$prototype=QQuickItem *rootObject() const
$method=5,3,0|QQuickItem *|rootObject|

$prototype=ResizeMode resizeMode() const
$method=5,3,0|QQuickWidget::ResizeMode|resizeMode|

$prototype=void setResizeMode(ResizeMode)
$method=5,3,0|void|setResizeMode|QQuickWidget::ResizeMode

$prototype=Status status() const
$method=5,3,0|QQuickWidget::Status|status|

$prototype=QList<QQmlError> errors() const
$method=5,3,0|QList<QQmlError>|errors|

$prototype=QSize sizeHint() const
$method=5,3,0|QSize|sizeHint|

$prototype=QSize initialSize() const
$method=5,3,0|QSize|initialSize|

$prototype=void setContent(const QUrl& url, QQmlComponent *component, QObject *item)
$method=5,3,0|void|setContent|const QUrl &,QQmlComponent *,QObject *

$prototype=QSurfaceFormat format() const
$method=5,3,0|QSurfaceFormat|format|

$prototype=void setFormat(const QSurfaceFormat &format)
$method=5,3,0|void|setFormat|const QSurfaceFormat &

$beginSignals
$signal=5,3,0|statusChanged(QQuickWidget::Status)
$signal=5,3,0|sceneGraphError(QQuickWindow::SceneGraphError,QString)
$endSignals

#pragma ENDDUMP


Added Mod() function + overloads

Added Mod() function + overloads

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//

/// <summary>
/// Return the absolute value of a strongly typed numeric expression, regardless of its sign.
/// </summary>
/// <param name="i"></param>
/// <returns>
/// </returns>
FUNCTION AbsInt(i AS LONGINT) AS LONG
	RETURN Math.Abs(i)

/// <summary>
/// Return the absolute value of a strongly typed numeric expression, regardless of its sign.
/// </summary>
/// <param name="li"></param>
/// <returns>
/// </returns>
FUNCTION AbsLong(li AS LONGINT) AS LONG
	RETURN Math.Abs(li)

/// <summary>
/// Return the absolute value of a strongly typed numeric expression, regardless of its sign.
/// </summary>
/// <param name="r4"></param>
/// <returns>
/// </returns>
FUNCTION AbsReal4(r4 AS REAL4) AS REAL4
	RETURN Math.Abs(r4)

/// <summary>
/// Return the absolute value of a strongly typed numeric expression, regardless of its sign.
/// </summary>
/// <param name="r8"></param>
/// <returns>
/// </returns>
FUNCTION AbsReal8(r8 AS REAL8) AS REAL8
	RETURN Math.Abs(r8)

/// <summary>
/// Return the absolute value of a strongly typed numeric expression, regardless of its sign.
/// </summary>
/// <param name="si"></param>
/// <returns>
/// </returns>
FUNCTION AbsShort(si AS SHORT) AS LONG
	RETURN Math.Abs(si)

/// <summary>
/// Return the remainder of one number divided by another number
/// </summary>
/// <param name="dividend">The dividend of the division operation</param>
/// <param name="divisor">The divisor of the division operation</param>
/// <returns>A number representing the remainder of <nDividend> divided by <nDivisor>.</returns>
FUNCTION Mod(dividend AS REAL8, divisor AS REAL8) AS real8
	RETURN dividend % divisor

/// <summary>
/// Return the remainder of one number divided by another number
/// </summary>
/// <param name="dividend">The dividend of the division operation</param>
/// <param name="divisor">The divisor of the division operation</param>
/// <returns>A number representing the remainder of <nDividend> divided by <nDivisor>.</returns>
FUNCTION Mod(dividend AS Int64, divisor AS Int64) AS Int64
	RETURN dividend % divisor

/// <summary>
/// Return the remainder of one number divided by another number
/// </summary>
/// <param name="dividend">The dividend of the division operation</param>
/// <param name="divisor">The divisor of the division operation</param>
/// <returns>A number representing the remainder of <nDividend> divided by <nDivisor>.</returns>
FUNCTION Mod(dividend AS LONG, divisor AS LONG) AS LONG
	RETURN dividend % divisor

/// <summary>
/// Exchange the right and left halves of a byte.
/// </summary>
/// <param name="b">The byte whose nibbles should be swaped.</param>
/// <returns>
/// New value with the nibbles swapped.
/// </returns>
FUNCTION SwapByte(b AS BYTE) AS BYTE
	RETURN (b << 4) | (b >> 4)

/// <summary>
/// Exchange the right and left halves of a double word.
/// </summary>
/// <param name="dw"></param>
/// <returns>
/// </returns>
function SwapDWord(dw as dword) as dword
	local dw1, dw2 as dword
	dw1 := (dw & 0x0000ffff) << 16
	dw2 := (dw >> 16) & 0x0000ffff
	dw := dw1 | dw2
RETURN	dw

/// <summary>
/// Exchange the right and left halves of an integer.
/// </summary>
/// <param name="li"></param>
/// <returns>
/// </returns>
FUNCTION SwapInt(li AS LONG) AS LONG
	RETURN SwapLong(li)

/// <summary>
/// Exchange the right and left halves of a long integer.
/// </summary>
/// <param name="li"></param>
/// <returns>
/// </returns>
FUNCTION SwapLong(li AS LONG) AS LONG
	local li1, li2 as LONG
	li1 := (li & 0x0000ffff) << 16
	li2 := (li >> 16) & 0x0000ffff
	li := li1 | li2
	return li

/// <summary>
/// Exchange the right and left halves of a Int64
/// </summary>
/// <param name="i64"></param>
/// <returns>
/// </returns>
FUNCTION SwapInt64( i64 AS INT64 ) AS INT64
   RETURN (INT64)  ( i64 << 32 ) | ( i64 >> 32 )

/// <summary>
/// Exchange the right and left halves of a short integer.
/// </summary>
/// <param name="si"></param>
/// <returns>
/// </returns>
FUNCTION SwapShort(si AS SHORT) AS SHORT
RETURN	 ((short)((si & 0x00ff) << 8) | ((si >> 8) & 0x00ff))

/// <summary>
/// Exchange the right and left halves of a word.
/// </summary>
/// <param name="w"></param>
/// <returns>
/// </returns>
FUNCTION SwapWord(w AS WORD) AS WORD
RETURN ((WORD)((w & 0x00ff) << 8) | ((w >> 8) & 0x00ff))

FUNCTION SwapQWord( qw AS UINT64 ) AS UINT64
   RETURN (UINT64)  ( qw << 32 ) | ( qw >> 32 )

 FUNCTION MakeDWord( wLow AS WORD, wHigh AS WORD ) AS DWORD
   RETURN DWORD( ( wHigh << 16 ) | wLow )

FUNCTION MakeLong( wLow AS WORD, wHigh AS WORD ) AS INT
   RETURN (INT)( ( wHigh << 16 ) | wLow )

FUNCTION MakeWord( bLow AS BYTE, bHigh AS BYTE ) AS WORD
	RETURN WORD( ( WORD(bHigh) << 8 ) | bLow )

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//

/// <summary>
/// Return the absolute value of a strongly typed numeric expression, regardless of its sign.
/// </summary>
/// <param name="i"></param>
/// <returns>
/// </returns>
FUNCTION AbsInt(i AS LONGINT) AS LONG
	RETURN Math.Abs(i)

/// <summary>
/// Return the absolute value of a strongly typed numeric expression, regardless of its sign.
/// </summary>
/// <param name="li"></param>
/// <returns>
/// </returns>
FUNCTION AbsLong(li AS LONGINT) AS LONG
	RETURN Math.Abs(li)

/// <summary>
/// Return the absolute value of a strongly typed numeric expression, regardless of its sign.
/// </summary>
/// <param name="r4"></param>
/// <returns>
/// </returns>
FUNCTION AbsReal4(r4 AS REAL4) AS REAL4
	RETURN Math.Abs(r4)

/// <summary>
/// Return the absolute value of a strongly typed numeric expression, regardless of its sign.
/// </summary>
/// <param name="r8"></param>
/// <returns>
/// </returns>
FUNCTION AbsReal8(r8 AS REAL8) AS REAL8
	RETURN Math.Abs(r8)

/// <summary>
/// Return the absolute value of a strongly typed numeric expression, regardless of its sign.
/// </summary>
/// <param name="si"></param>
/// <returns>
/// </returns>
FUNCTION AbsShort(si AS SHORT) AS LONG
	RETURN Math.Abs(si)

/// <summary>
/// Exchange the right and left halves of a byte.
/// </summary>
/// <param name="b">The byte whose nibbles should be swaped.</param>
/// <returns>
/// New value with the nibbles swapped.
/// </returns>
FUNCTION SwapByte(b AS BYTE) AS BYTE
	RETURN (b << 4) | (b >> 4)

/// <summary>
/// Exchange the right and left halves of a double word.
/// </summary>
/// <param name="dw"></param>
/// <returns>
/// </returns>
function SwapDWord(dw as dword) as dword
	local dw1, dw2 as dword
	dw1 := (dw & 0x0000ffff) << 16
	dw2 := (dw >> 16) & 0x0000ffff
	dw := dw1 | dw2
RETURN	dw

/// <summary>
/// Exchange the right and left halves of an integer.
/// </summary>
/// <param name="li"></param>
/// <returns>
/// </returns>
FUNCTION SwapInt(li AS LONG) AS LONG
	RETURN SwapLong(li)

/// <summary>
/// Exchange the right and left halves of a long integer.
/// </summary>
/// <param name="li"></param>
/// <returns>
/// </returns>
FUNCTION SwapLong(li AS LONG) AS LONG
	local li1, li2 as LONG
	li1 := (li & 0x0000ffff) << 16
	li2 := (li >> 16) & 0x0000ffff
	li := li1 | li2
	return li

/// <summary>
/// Exchange the right and left halves of a Int64
/// </summary>
/// <param name="i64"></param>
/// <returns>
/// </returns>
FUNCTION SwapInt64( i64 AS INT64 ) AS INT64
   RETURN (INT64)  ( i64 << 32 ) | ( i64 >> 32 )

/// <summary>
/// Exchange the right and left halves of a short integer.
/// </summary>
/// <param name="si"></param>
/// <returns>
/// </returns>
FUNCTION SwapShort(si AS SHORT) AS SHORT
RETURN	 ((short)((si & 0x00ff) << 8) | ((si >> 8) & 0x00ff))

/// <summary>
/// Exchange the right and left halves of a word.
/// </summary>
/// <param name="w"></param>
/// <returns>
/// </returns>
FUNCTION SwapWord(w AS WORD) AS WORD
RETURN ((WORD)((w & 0x00ff) << 8) | ((w >> 8) & 0x00ff))

FUNCTION SwapQWord( qw AS UINT64 ) AS UINT64
   RETURN (UINT64)  ( qw << 32 ) | ( qw >> 32 )

 FUNCTION MakeDWord( wLow AS WORD, wHigh AS WORD ) AS DWORD
   RETURN DWORD( ( wHigh << 16 ) | wLow )

FUNCTION MakeLong( wLow AS WORD, wHigh AS WORD ) AS INT
   RETURN (INT)( ( wHigh << 16 ) | wLow )

FUNCTION MakeWord( bLow AS BYTE, bHigh AS BYTE ) AS WORD
	RETURN WORD( ( WORD(bHigh) << 8 ) | bLow )


extgraft, almost done

extgraft, almost done

-- Modeling Opetopes
-- here is Eric's editor: http://sma.epfl.ch/~finster/opetope/opetope.html
--
-- Note: Kock et al. use a similar scheme, where
--          - dots    <-->   lines
--          - spheres <-->   dots
--          - lines disappear
--          -                spheres appear

-- Note: In Eric's new work (at IAS) there are no
--       dots any more, instead he uses 'output cards', so
--          - (output) cards   <-->  lines
--          - space between stacked cards <--> output cards
--          - lines disappear
--          -                (regular) cards appear

import "../tests/Nat.prg"

data ZoomComplex :: Tree e ~> Tree f ~> * where
  Nil :: ZoomComplex a a
  Cons :: Stack a b -> ZoomComplex b c -> ZoomComplex a c
 deriving List(cplx)

data Dir :: *2 where
  Hor :: Dir
  Ver :: Dir

-- define the Tree kind, a rose tree
-- note: we may need a two-level kind, since we need to track disjointness
--       of subtrees
-- todo: later we may want to have a label kind parameter too

data Tree :: Dir ~> *1 where
  Unit :: Tree Ver
  Ni :: Tree Hor
  Fork :: Tree d ~> Tree Hor ~> Tree Hor
 deriving syntax (tr) List(Ni, Fork) Unit(Unit)

-- make it singleton

data Tree' :: Tree d ~> * where
  In :: Tree' ()tr
  Fork :: Tree' head -> Tree' tail -> Tree' [head; tail]tr
  Done :: Tree' []tr
 deriving syntax (ar) List(Done, Fork) Unit(In) -- "arbre"
-- http://www.papoulipoesique.com/wp-content/uploads/2013/06/arbre.jpg

-- define a proposition for subtrees
-- to be checked: TakeHead must ensure that all the node is consumed

prop Subtree :: Tree d ~> Tree e ~> * where
  UnitSub :: Subtree ()tr tr
  BothNil :: Subtree []tr []tr
  TakeHead :: Subtree head head' -> Subtree tail tail' -> Subtree [head; tail]tr [head'; tail']tr

-- now we can stack cards (these are zooms in Kock et al. parlance)

data Stack :: Tree d ~> Tree e ~> * where
  Empty :: Corolla tr => Tree' tr -> Stack tr ()tr
  SubDone :: Stack ()tr []tr
  SubCont :: Stack ()tr tr -> Stack ()tr [tr]tr
  --Subdivision :: Stack ()tr sub -> Stack tr rest -> Stack tr [sub; rest]tr
  Encompass :: Subtree consumed tr => Stack consumed prod -> Stack tr prod
  -- the following three grab a node (and possibly its offsprings) and incorporate it into a single card
  NodeDone :: Stack []tr [()tr]tr
  Pick :: {- EntireNode => -} Stack head prodhead -> Stack tail prodtail -> Stack [head; tail]tr [prodhead; prodtail]tr
  Exclude :: {- EntireNode => -} Stack tail prod -> Stack [()tr; tail]tr prod
  -- we need a way to sequence cards
  -- MultiCard :: ??? Disjoint a b 0 => Subtree a -> Subtree b -> Stack tr a [proda, prodb]tr

  On :: (Subtree tr' tr, Pointers 1t at out) => Stack tr' out' -> Stack tr out -> Tree' at -> Stack tr {graft out' at out}
  Beside :: () -- (Pointers 1t at tr, Pointers 1t {graft skipping at at} {graft skipping at tr})
         => Tree' at -> Tree' skipping -> Stack tr' [out']tr -> Stack tr out -> Stack {graft tr' {graft skipping at at} {graft skipping at tr}} [out'; out]tr

  -- WARNING: [out']tr ---> one sibling for now

-- it remains to define corollas

prop Corolla :: Tree d ~> * where
  None' :: Corolla []tr
  One' :: Corolla tail -> Corolla [()tr; tail]tr

--  o   --->  |
--  |         |

lolliCell :: Stack []tr ()tr
lolliCell = Empty Done

--  |         |
--  o   --->  |
--  |         |

dolliCell :: Stack [()tr]tr ()tr
dolliCell = Empty $ Fork In Done

--              |
--  [o]   --->  o
--   |          |

lolliFrame :: Stack []tr [()tr]tr
lolliFrame = Encompass NodeDone

--   |          |
--  [o]   --->  o
--   |          |

dolliFrame :: Stack [()tr]tr [()tr]tr
dolliFrame = Encompass (Exclude NodeDone)

--   |          |
--   |          o
-- [[o]]  --->  |
--   |          o
--   |          |

stacked :: Stack [()tr]tr [[()tr]tr]tr
stacked = (dolliFrame `On` dolliFrame) (In `Fork` Done)

--   |
--  [|]   --->  o
--   |          |

crossed :: Stack ()tr []tr
crossed = SubDone

-- we can now join things
--
dolliForever = [dolliFrame; dolliForever]cplx
nopetope = [crossed, lolliFrame; dolliForever]cplx

-- back to unit as fast as possible...
--
stopetope = [crossed, lolliFrame, dolliCell]cplx
neverstopetope = [crossed, lolliFrame, dolliCell; neverstopetope]cplx

--   |          o
-- [[|]]  --->  |
--   |          o
--   |          |

drossed :: Stack ()tr [[]tr]tr
drossed = SubCont SubDone
-- drossed = (SubDone `On` NodeDone) In
-- Note: can we find a way to graft here? Then On would be feasible

--                    |
--    |           o   o
-- | [o] |  --->   \ /
-- | [|] |          o
--    |             |

--cyclops :: Stack [()tr]tr [[]tr, ()tr]tr
--cyclops = Pick (Beside ()ar ()ar SubDone (Exclude NodeDone)) NodeDone

-- Stacking, Valence, Affine subtree, Substitute at an affine position

-- counting Units in a tree

valence :: Tree d ~> Nat
{valence []tr} = 0t
{valence [head; tail]tr} = {plus {valence head} {valence tail}}
{valence ()tr} = 1t

-- counting siblings of a tree

nodeValence :: Tree d ~> Nat
{nodeValence []tr} = 0t
{nodeValence [head; tail]tr} = (1+{nodeValence tail})t

-- nodeValenceAt: given a (multi)pointer, determine the node valences at those positions
--               WHERE     IN
nodeValenceAt :: Tree d ~> Tree e ~> Nat
{nodeValenceAt ()tr tree} = {nodeValence tree}
{nodeValenceAt []tr []tr} = 0t
{nodeValenceAt [head'; tail']tr [head; tail]tr} = {plus {nodeValenceAt head' head} {nodeValenceAt tail' tail}}

-- a pointer is a valence-1 subtree of a tree
-- it is used to mark a unit in a tree where substitution will occur
--
prop Pointers :: Nat ~> Tree d ~> Tree e ~> * where
  Finger :: Pointers 1t ()tr ()tr
  Finished :: Pointers 0t []tr []tr
  ThisWay :: Pointers 1t head' head -> Pointers n tail' tail -> Pointers (1+n)t [head'; tail']tr [head; tail]tr
  ElseWhere :: Pointers n tail' tail -> Pointers n [[]tr; tail']tr [head; tail]tr

-- http://en.wikipedia.org/wiki/Grafting
--
-- graft WHAT      WHERE     IN
graft :: Tree d ~> Tree e ~> Tree f ~> Tree f
{graft what ()tr ()tr} = what
{graft what []tr tr} = tr
{graft what [head'; tail']tr [head; tail]tr} = [{graft what head' head}; {graft what tail' tail}]tr

extgraft :: Tree what ~> Tree wher ~> Tree tree ~> Tree tree'
{extgraft what ()tr ()tr} = what
{extgraft what []tr ()tr} = ()tr
{extgraft what [head; tail]tr ()tr} = [{extgraft what head ()tr}; {extgraft what tail ()tr}]tr
--{extgraft what []tr tr} = tr
{extgraft what [head'; tail']tr [head; tail]tr} = [{extgraft what head' head}; {extgraft what tail' tail}]tr

{- TODO? multiGraft :: Treelist -> where -> in -}

{- NOTE: we have an Omega bug here:

prompt> :norm {graft []tr ()tr ()tr}
Normalizes to:
  []tr

prompt> :kind []tr
[]tr :: Tree Hor  = []tr

prompt> :kind {graft []tr ()tr ()tr}
{graft []tr ()tr ()tr} :: Tree Ver  = {graft []tr ()tr ()tr}

... BUT: Hor /= Ver :-(
-}

-- substitution: replace a pointed node (of valence n) in a tree with an
-- other tree of (valence n) -- TODO

-- HERE IS A NICE RESEARCH QUESTION:
-- is it possible to "proof search" a Zoom?
-- i.e.
{-

class ZoomLike (int :: Tree) (out :: Tree) where
  zoom :: (Nodes int ~ Valence out) => Zoom int out

-}

-- Modeling Opetopes
-- here is Eric's editor: http://sma.epfl.ch/~finster/opetope/opetope.html
--
-- Note: Kock et al. use a similar scheme, where
--          - dots    <-->   lines
--          - spheres <-->   dots
--          - lines disappear
--          -                spheres appear

-- Note: In Eric's new work (at IAS) there are no
--       dots any more, instead he uses 'output cards', so
--          - (output) cards   <-->  lines
--          - space between stacked cards <--> output cards
--          - lines disappear
--          -                (regular) cards appear

import "../tests/Nat.prg"

data ZoomComplex :: Tree e ~> Tree f ~> * where
  Nil :: ZoomComplex a a
  Cons :: Stack a b -> ZoomComplex b c -> ZoomComplex a c
 deriving List(cplx)

data Dir :: *2 where
  Hor :: Dir
  Ver :: Dir

-- define the Tree kind, a rose tree
-- note: we may need a two-level kind, since we need to track disjointness
--       of subtrees
-- todo: later we may want to have a label kind parameter too

data Tree :: Dir ~> *1 where
  Unit :: Tree Ver
  Ni :: Tree Hor
  Fork :: Tree d ~> Tree Hor ~> Tree Hor
 deriving syntax (tr) List(Ni, Fork) Unit(Unit)

-- make it singleton

data Tree' :: Tree d ~> * where
  In :: Tree' ()tr
  Fork :: Tree' head -> Tree' tail -> Tree' [head; tail]tr
  Done :: Tree' []tr
 deriving syntax (ar) List(Done, Fork) Unit(In) -- "arbre"
-- http://www.papoulipoesique.com/wp-content/uploads/2013/06/arbre.jpg

-- define a proposition for subtrees
-- to be checked: TakeHead must ensure that all the node is consumed

prop Subtree :: Tree d ~> Tree e ~> * where
  UnitSub :: Subtree ()tr tr
  BothNil :: Subtree []tr []tr
  TakeHead :: Subtree head head' -> Subtree tail tail' -> Subtree [head; tail]tr [head'; tail']tr

-- now we can stack cards (these are zooms in Kock et al. parlance)

data Stack :: Tree d ~> Tree e ~> * where
  Empty :: Corolla tr => Tree' tr -> Stack tr ()tr
  SubDone :: Stack ()tr []tr
  SubCont :: Stack ()tr tr -> Stack ()tr [tr]tr
  --Subdivision :: Stack ()tr sub -> Stack tr rest -> Stack tr [sub; rest]tr
  Encompass :: Subtree consumed tr => Stack consumed prod -> Stack tr prod
  -- the following three grab a node (and possibly its offsprings) and incorporate it into a single card
  NodeDone :: Stack []tr [()tr]tr
  Pick :: {- EntireNode => -} Stack head prodhead -> Stack tail prodtail -> Stack [head; tail]tr [prodhead; prodtail]tr
  Exclude :: {- EntireNode => -} Stack tail prod -> Stack [()tr; tail]tr prod
  -- we need a way to sequence cards
  -- MultiCard :: ??? Disjoint a b 0 => Subtree a -> Subtree b -> Stack tr a [proda, prodb]tr

  On :: (Subtree tr' tr, Pointers 1t at out) => Stack tr' out' -> Stack tr out -> Tree' at -> Stack tr {graft out' at out}
  Beside :: () -- (Pointers 1t at tr, Pointers 1t {graft skipping at at} {graft skipping at tr})
         => Tree' at -> Tree' skipping -> Stack tr' [out']tr -> Stack tr out -> Stack {graft tr' {graft skipping at at} {graft skipping at tr}} [out'; out]tr

  -- WARNING: [out']tr ---> one sibling for now

-- it remains to define corollas

prop Corolla :: Tree d ~> * where
  None' :: Corolla []tr
  One' :: Corolla tail -> Corolla [()tr; tail]tr

--  o   --->  |
--  |         |

lolliCell :: Stack []tr ()tr
lolliCell = Empty Done

--  |         |
--  o   --->  |
--  |         |

dolliCell :: Stack [()tr]tr ()tr
dolliCell = Empty $ Fork In Done

--              |
--  [o]   --->  o
--   |          |

lolliFrame :: Stack []tr [()tr]tr
lolliFrame = Encompass NodeDone

--   |          |
--  [o]   --->  o
--   |          |

dolliFrame :: Stack [()tr]tr [()tr]tr
dolliFrame = Encompass (Exclude NodeDone)

--   |          |
--   |          o
-- [[o]]  --->  |
--   |          o
--   |          |

stacked :: Stack [()tr]tr [[()tr]tr]tr
stacked = (dolliFrame `On` dolliFrame) (In `Fork` Done)

--   |
--  [|]   --->  o
--   |          |

crossed :: Stack ()tr []tr
crossed = SubDone

-- we can now join things
--
dolliForever = [dolliFrame; dolliForever]cplx
nopetope = [crossed, lolliFrame; dolliForever]cplx

-- back to unit as fast as possible...
--
stopetope = [crossed, lolliFrame, dolliCell]cplx
neverstopetope = [crossed, lolliFrame, dolliCell; neverstopetope]cplx

--   |          o
-- [[|]]  --->  |
--   |          o
--   |          |

drossed :: Stack ()tr [[]tr]tr
drossed = SubCont SubDone
-- drossed = (SubDone `On` NodeDone) In
-- Note: can we find a way to graft here? Then On would be feasible

--                    |
--    |           o   o
-- | [o] |  --->   \ /
-- | [|] |          o
--    |             |

--cyclops :: Stack [()tr]tr [[]tr, ()tr]tr
--cyclops = Pick (Beside ()ar ()ar SubDone (Exclude NodeDone)) NodeDone

-- Stacking, Valence, Affine subtree, Substitute at an affine position

-- counting Units in a tree

valence :: Tree d ~> Nat
{valence []tr} = 0t
{valence [head; tail]tr} = {plus {valence head} {valence tail}}
{valence ()tr} = 1t

-- counting siblings of a tree

nodeValence :: Tree d ~> Nat
{nodeValence []tr} = 0t
{nodeValence [head; tail]tr} = (1+{nodeValence tail})t

-- nodeValenceAt: given a (multi)pointer, determine the node valences at those positions
--               WHERE     IN
nodeValenceAt :: Tree d ~> Tree e ~> Nat
{nodeValenceAt ()tr tree} = {nodeValence tree}
{nodeValenceAt []tr []tr} = 0t
{nodeValenceAt [head'; tail']tr [head; tail]tr} = {plus {nodeValenceAt head' head} {nodeValenceAt tail' tail}}

-- a pointer is a valence-1 subtree of a tree
-- it is used to mark a unit in a tree where substitution will occur
--
prop Pointers :: Nat ~> Tree d ~> Tree e ~> * where
  Finger :: Pointers 1t ()tr ()tr
  Finished :: Pointers 0t []tr []tr
  ThisWay :: Pointers 1t head' head -> Pointers n tail' tail -> Pointers (1+n)t [head'; tail']tr [head; tail]tr
  ElseWhere :: Pointers n tail' tail -> Pointers n [[]tr; tail']tr [head; tail]tr

-- http://en.wikipedia.org/wiki/Grafting
--
-- graft WHAT      WHERE     IN
graft :: Tree d ~> Tree e ~> Tree f ~> Tree f
{graft what ()tr ()tr} = what
{graft what []tr tr} = tr
{graft what [head'; tail']tr [head; tail]tr} = [{graft what head' head}; {graft what tail' tail}]tr

{- TODO! multiGraft :: Treelist -> where -> in -}

{- NOTE: we have an Omega bug here:

prompt> :norm {graft []tr ()tr ()tr}
Normalizes to:
  []tr

prompt> :kind []tr
[]tr :: Tree Hor  = []tr

prompt> :kind {graft []tr ()tr ()tr}
{graft []tr ()tr ()tr} :: Tree Ver  = {graft []tr ()tr ()tr}

... BUT: Hor /= Ver :-(
-}

-- substitution: replace a pointed node (of valence n) in a tree with an
-- other tree of (valence n) -- TODO

-- HERE IS A NICE RESEARCH QUESTION:
-- is it possible to "proof search" a Zoom?
-- i.e.
{-

class ZoomLike (int :: Tree) (out :: Tree) where
  zoom :: (Nodes int ~ Valence out) => Zoom int out

-}


[Runtime] Added Transform() with one argument to the XSharp.VFP library

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//

// String Functions

USING System
USING System.Collections.Generic
USING System.Text
USING System.IO

INTERNAL STATIC CLASS PathHelpers
    INTERNAL STATIC PROPERTY PathChar AS STRING AUTO
    STATIC CONSTRUCTOR()
        PathChar := Path.DirectorySeparatorChar:ToString()
END CLASS

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/addbs/*" />
/// <seealso cref='O:XSharp.VFP.Functions.DefaultExt' />
/// <seealso cref='O:XSharp.VFP.Functions.JustDrive' />
/// <seealso cref='O:XSharp.VFP.Functions.JustExt' />
/// <seealso cref='O:XSharp.VFP.Functions.JustFName' />
/// <seealso cref='O:XSharp.VFP.Functions.JustPath' />
/// <seealso cref='O:XSharp.VFP.Functions.JustStem' />
FUNCTION AddBs (cPath AS STRING) AS STRING
    IF String.IsNullOrEmpty(cPath)
        RETURN ""
    ENDIF
    cPath := cPath:TrimEnd()
    IF ! cPath.EndsWith(PathHelpers.PathChar)
        cPath += PathHelpers.PathChar
    ENDIF
    RETURN cPath

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/forceext/*" />
FUNCTION ForceExt( cFileName AS STRING, cExtension AS STRING) AS STRING
    IF String.IsNullOrEmpty(cFileName)
        RETURN ""
    ENDIF
    VAR result := Path.ChangeExtension(cFileName,cExtension)
    RETURN result

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/forceext/*" />
FUNCTION ForceExt( cFileName AS STRING, cExtension AS STRING, tlOptAsVfp9 AS LOGIC) AS STRING
    *-- current take on matters is that the Dotnet-Version should be Default behaviour
    *-- as vfp9 version behaviour in edge cases could be seen as erroneous
    *-- work in progress and not tested, as existing code should only call 2-parameter overload should be safe
    IF tlOptAsVfp9 == .f.
        RETURN ForceExt( cFileName, cExtension)
    ENDIF
    cFileName := JustFName(cFileName)
    IF cFileName:EndsWith(".")
        *-- if filename ends with dot, cut that
        *-- but only rightmost one, ending in several dots cuts still only 1
        cFileName := cFileName:Substring(0 , cFileName:Length-1)
    ENDIF
    IF cExtension:StartsWith(".")
        cExtension := cExtension:Substring(1)
    ENDIF
    LOCAL cResult AS STRING
    IF Min(cFileName:Length, cExtension:Length)>0
        cResult := cFileName + "." + cExtension
    ELSE
        cResult := ""
    ENDIF
    RETURN cResult

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/forcepath/*" />
FUNCTION ForcePath( cFileName AS STRING, cPath AS STRING) AS STRING
    *-- check if path needs also check...
    IF String.IsNullOrEmpty(cFileName)
        RETURN ""
    ENDIF
    VAR cReturn := AddBs(cPath) + JustFName(cFileName)
    RETURN cReturn

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justdrive/*" />
/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justcommon/*" />
FUNCTION JustDrive(cPath AS STRING) AS STRING
    IF String.IsNullOrEmpty(cPath)
        RETURN ""
    ENDIF
    VAR result := System.IO.Directory.GetDirectoryRoot(cPath)
    result := result:Replace(PathHelpers.PathChar,"")
    RETURN result

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justext/*" />
/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justcommon/*" />
FUNCTION JustExt(cPath AS STRING) AS STRING
    *-- Default for new parameter  lOptWithLeadingDot ist .f.
    *-- As returning all extensions with leading dot could lead to breaking changes
    RETURN JustExt(cPath, .f.)

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justdrive/*" />
/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justcommon/*" />
FUNCTION JustExt(cPath AS STRING, lOptWithLeadingDot AS LOGIC) AS STRING
    IF String.IsNullOrEmpty(cPath)
        RETURN ""
    ENDIF
    VAR result := Path.GetExtension(cPath)
    IF lOptWithLeadingDot == .f. AND result:StartsWith(".")
        result := result:Substring(1)
    ENDIF
    RETURN result

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justfname/*" />
/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justcommon/*" />
FUNCTION JustFName(cPath AS STRING) AS STRING
    IF String.IsNullOrEmpty(cPath)
        RETURN ""
    ENDIF
    VAR result := Path.GetFileName(cPath)
    RETURN result

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justpath/*" />
/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justcommon/*" />
FUNCTION JustPath(cPath AS STRING) AS STRING
    IF String.IsNullOrEmpty(cPath)
        RETURN ""
    ENDIF
    LOCAL result := cPath AS STRING
    LOCAL nPos := result:LastIndexOf(PathHelpers.PathChar) AS LONG
    IF  nPos >= 0
        result := result:Substring(0, nPos )
    ENDIF
    RETURN result

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/juststem/*" />
/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justcommon/*" />
FUNCTION JustStem(cPath AS STRING) AS STRING
    IF String.IsNullOrEmpty(cPath)
        RETURN ""
    ENDIF
    VAR result := Path.GetFileNameWithoutExtension(cPath)
    RETURN result

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/leftc/*" />
FUNCTION LeftC( cExpression AS STRING, nExpression AS DWORD) AS STRING
    RETURN Left(cExpression, nExpression)

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/lenc/*" />
FUNCTION LenC( cExpression AS STRING ) AS DWORD
    RETURN SLen(cExpression)

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/likec/*" />
FUNCTION LikeC( cExpression1, cExpression2) AS LOGIC CLIPPER
    RETURN Like(cExpression1, cExpression2)

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/rightc/*" />
FUNCTION RightC( cExpression AS STRING, nCharacters AS DWORD) AS STRING
    RETURN Right(cExpression, nCharacters)

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/stuffc/*" />
FUNCTION StuffC( cExpression, nStartReplacement, nCharactersReplaced, cReplacement) AS STRING CLIPPER
    RETURN Stuff(cExpression, nStartReplacement, nCharactersReplaced, cReplacement)

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/substrc/*" />
FUNCTION SubStrC(cExpression, nStartPosition , nCharactersReturned ) AS STRING CLIPPER
    RETURN SubStr(cExpression, nStartPosition, nCharactersReturned)

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/ratc/*" />
FUNCTION RAtC(cSearchExpression AS STRING , cExpressionSearched AS STRING , nOccurrence := 1 AS INT ) AS INT
	RETURN RAt(cSearchExpression , cExpressionSearched , nOccurrence )

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/rat/*" />
FUNCTION RAt(cSearchExpression AS STRING , cExpressionSearched AS STRING , nOccurrence := 1 AS INT ) AS INT
    LOCAL iPosition  AS INT
    LOCAL i , dwPosition, dwOccurred AS INT
    dwOccurred := 0
 	dwPosition := 0
	IF ! String.IsNullOrEmpty(cExpressionSearched) .AND. ! String.IsNullOrEmpty(cSearchExpression)

		iPosition := cExpressionSearched:Length

		FOR i := 1 UPTO nOccurrence

     		IF ( iPosition := cExpressionSearched:LastIndexOf(cSearchExpression,iPosition,StringComparison.Ordinal) ) == -1
				EXIT
			ENDIF

			dwOccurred++

			IF dwOccurred == nOccurrence
				// Assign the found position before leaving the loop.
				dwPosition := iPosition + 1
				EXIT
			ENDIF

			//  Doing always a
			//
			//  iPosition--
			//
			//	, like the c# sources do, is not correct.
			//  That's only necessary if the len of the search string
			//  is 1.

			IF cSearchExpression:Length == 1 .AND. --iPosition < 0

				// something like:
				//
				// RAt("a","abracadabra", 12 )
				//
				// ends up here. If you do not check the iPosition value
				// the next search loop would cause a exception.
				//

				EXIT
			ENDIF
		NEXT
	ENDIF
	RETURN dwPosition

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/chrtranc/*" />
FUNCTION ChrTranC( cSearchIn AS STRING , cSearchFor AS STRING, cReplaceWith  AS STRING ) AS STRING
	RETURN ChrTran( cSearchIn , cSearchFor , cReplaceWith )

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/chrtran/*" />
FUNCTION ChrTran( cSearchIn AS STRING , cSearchFor AS STRING, cReplaceWith  AS STRING ) AS STRING
    LOCAL cRetVal ,cReplaceChar AS STRING
    LOCAL i AS INT
	cRetVal := ""

	IF  cSearchIn != NULL  .AND. cSearchFor != NULL .AND. cReplaceWith != NULL

		cRetVal := cSearchIn

		FOR i := 1 UPTO cSearchFor:Length

			IF cReplaceWith:Length <= i-1
				cReplaceChar := ""
			ELSE
				cReplaceChar := cReplaceWith[i-1]:ToString()
			ENDIF

		    cRetVal := cRetVal:Replace(cSearchFor[i-1]:ToString(), cReplaceChar )
	//	    cRetVal := StrTran(cRetVal , cSearchFor[i-1]:ToString(), cReplaceChar , , SLen ( cRetVal ) )

		NEXT

	ENDIF

	RETURN cRetVal

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/at/*" />
FUNCTION At(cSearchExpression AS STRING, cExpressionSearched AS STRING, nOccurrence := 1 AS DWORD) AS DWORD
	LOCAL position := 0 AS DWORD
	IF ( cExpressionSearched != NULL .AND. cSearchExpression != NULL )
		IF cExpressionSearched:Length != 0 .AND. cSearchExpression:Length != 0
            DO WHILE nOccurrence  > 0
                IF ( position := (DWORD) cExpressionSearched:IndexOf(cSearchExpression, (INT) position,StringComparison.Ordinal) + 1) == 0
                    EXIT
                ENDIF
                nOccurrence -= 1
            ENDDO
		END IF
	ENDIF
	RETURN position

/// <inheritdoc cref="M:XSharp.VFP.Functions.At(System.String,System.String,System.UInt32)" />
/// <remarks>This is an alias for the At() function. X# works with unicode and the difference
/// between single byte and multi byte characters does not exist in Unicode</remarks>
FUNCTION At_C(cSearchExpression AS STRING, cExpressionSearched AS STRING, nOccurrence := 1 AS DWORD) AS DWORD
	RETURN At(cSearchExpression, cExpressionSearched, nOccurrence)

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/atc/*" />
FUNCTION AtC(cSearchExpression AS STRING, cExpressionSearched AS STRING, nOccurrence := 1 AS DWORD) AS DWORD
	LOCAL position := 0 AS DWORD
	IF ( cExpressionSearched != NULL .AND. cSearchExpression != NULL )
		IF cExpressionSearched:Length != 0 .AND. cSearchExpression:Length != 0
            DO WHILE nOccurrence  > 0
                IF ( position := (DWORD) cExpressionSearched:IndexOf(cSearchExpression, (INT) position,StringComparison.OrdinalIgnoreCase) + 1) == 0
                    EXIT
                ENDIF
                nOccurrence -= 1
            ENDDO
		END IF
	ENDIF
	RETURN position

/// <inheritdoc cref="M:XSharp.VFP.Functions.AtC(System.String,System.String,System.UInt32)" />
/// <remarks>This is an alias for the AtC() function. X# works with unicode and the difference
/// between single byte and multi byte characters does not exist in Unicode</remarks>

FUNCTION AtCC(cSearchExpression AS STRING, cExpressionSearched AS STRING, nOccurrence := 1 AS DWORD) AS DWORD
	RETURN AtC(cSearchExpression, cExpressionSearched, nOccurrence)

/// <inheritdoc cref="M:XSharp.Core.Functions.AllTrim(System.String)" />
/// <param name="Expression">Specifies an expression to remove leading and trailing spaces or 0 bytes from</param>
/// <param name="Flags">Specifies if trimming is case-sensitive when one or more parse characters
/// (cParseChar, cParseChar2,  are included. Trimming is case-sensitive if nFlags is zero or is omitted.
/// Trimming is case-insensitive if nFlags = 1.</param>
/// <param name="TrimChars">Specifies one or more character strings that are trimmed from the beginning of cExpression.
/// If cParseChar isn't included, then leading spaces or 0 bytes are removed from Expression. </param>
FUNCTION AllTrim(Expression AS STRING, Flags AS INT, TrimChars PARAMS STRING[]) AS STRING STRICT
	RETURN Trim_helper(.T., .T., Expression, Flags, TrimChars)

/// <inheritdoc cref="M:XSharp.Core.Functions.LTrim(System.String)" />
/// <param name="Expression">Specifies an expression to remove leading spaces or 0 bytes from, respectively</param>
/// <param name="TrimChars">Specifies one or more character strings that are trimmed from the beginning of cExpression.
/// If cParseChar isn't included, then leading spaces or 0 bytes are removed from Expression. </param>
FUNCTION LTrim(Expression AS STRING, Flags AS INT, TrimChars PARAMS STRING[]) AS STRING STRICT
	RETURN Trim_helper(.T., .F., Expression, Flags, TrimChars)

/// <inheritdoc cref="M:XSharp.Core.Functions.RTrim(System.String)" />
/// <param name="Expression">Specifies an expression to remove leading spaces or 0 bytes from, respectively</param>
/// <param name="TrimChars">Specifies one or more character strings that are trimmed from the beginning of cExpression.
/// If cParseChar isn't included, then leading spaces or 0 bytes are removed from Expression. </param>
FUNCTION RTrim(Expression AS STRING, Flags AS INT, TrimChars PARAMS STRING[]) AS STRING STRICT
	RETURN Trim_helper(.F., .T., Expression, Flags, TrimChars)

/// <inheritdoc cref="M:XSharp.Core.Functions.Trim(System.String)" />
/// <param name="Expression">Specifies an expression to remove trailing spaces or 0 bytes from</param>
/// <param name="Flags">Specifies if trimming is case-sensitive when one or more parse characters
/// (cParseChar, cParseChar2,  are included. Trimming is case-sensitive if nFlags is zero or is omitted.
/// Trimming is case-insensitive if nFlags = 1.</param>
/// <param name="TrimChars">Specifies one or more character strings that are trimmed from the beginning of cExpression.
/// If cParseChar isn't included, then leading spaces or 0 bytes are removed from Expression. </param>
FUNCTION Trim(Expression AS STRING, Flags AS INT, TrimChars PARAMS STRING[]) AS STRING STRICT
	RETURN Trim_helper(.F., .T., Expression, Flags, TrimChars)

STATIC FUNCTION Trim_helper(TrimLeft AS Boolean, TrimRight AS Boolean, Expression AS STRING, Flags AS INT, TrimChars PARAMS STRING[]) AS STRING STRICT

    LOCAL parmNdx AS INT
    LOCAL Trimmed = .T. AS Boolean
    LOCAL LRTrimmed AS INT
    LOCAL comparison = StringComparison.Ordinal AS System.StringComparison
    LOCAL compared AS STRING

    IF Expression = NULL
        RETURN Expression
    END IF

    IF Flags = 1
         comparison = StringComparison.OrdinalIgnoreCase
    END IF

    DO WHILE Trimmed

        Trimmed = .F.

        FOR parmNdx = 1 TO TrimChars:Length

            compared = TrimChars[parmNdx]

            IF TrimLeft
                LRTrimmed = 0

                DO WHILE String.Compare(Expression, LRTrimmed, compared, 0, compared:Length, comparison) = 0
                    LRTrimmed += compared:Length
                END DO
                IF LRTrimmed > 0
                    Expression = Expression:Substring(LRTrimmed)
                    Trimmed = .T.
                END IF
            END IF

            IF TrimRight
                LRTrimmed = Expression:Length - compared:Length

                DO WHILE LRTrimmed >= 0 AND String.Compare(Expression, LRTrimmed, compared, 0, compared:Length, comparison) = 0
                    LRTrimmed -= compared:Length
                END DO
                IF LRTrimmed < (Expression:Length - compared:Length)
                    Expression = Expression:Substring(0, LRTrimmed + compared:Length)
                    Trimmed = .T.
                END IF
            END IF

        NEXT

    END DO

    RETURN Expression

END FUNCTION

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/transform/*" />
FUNCTION Transform( uValue AS USUAL ) AS STRING
    RETURN AsString(uValue)


codegen/QtQuickWidgets/QQuickWidget.prg: fixed

Modified:
codegen/QtQuickWidgets/QQuickWidget.prg

%%
%% Qt5xHb - Bindings libraries for Harbour/xHarbour and Qt Framework 5
%%
%% Copyright (C) 2018 Marcos Antonio Gambeta <marcosgambeta AT outlook DOT com>
%%

$header

#include "hbclass.ch"

#ifndef QT5XHB_NO_REQUESTS
REQUEST QURL
REQUEST QQMLENGINE
REQUEST QQMLCONTEXT
REQUEST QQUICKITEM
REQUEST QQMLERROR
REQUEST QSIZE
REQUEST QSURFACEFORMAT
#endif

CLASS QQuickWidget INHERIT QWidget

   METHOD new
   METHOD delete
   METHOD source
   METHOD setSource
   METHOD engine
   METHOD rootContext
   METHOD rootObject
   METHOD resizeMode
   METHOD setResizeMode
   METHOD status
   METHOD errors
   METHOD sizeHint
   METHOD initialSize
   METHOD setContent
   METHOD format
   METHOD setFormat

   METHOD onStatusChanged
   METHOD onSceneGraphError

   DESTRUCTOR destroyObject

END CLASS

$destructor

#pragma BEGINDUMP

$includes=5,3,0

#include <QQmlError>
#include <QQmlEngine>
#include <QQmlContext>
#include <QQuickItem>

$prototype=explicit QQuickWidget(QWidget *parent = 0)
$internalConstructor=5,3,0|new1|QWidget *=0

$prototype=QQuickWidget(QQmlEngine* engine, QWidget *parent)
$internalConstructor=5,3,0|new2|QQmlEngine *,QWidget *

$prototype=QQuickWidget(const QUrl &source, QWidget *parent = 0)
$internalConstructor=5,3,0|new3|const QUrl &,QWidget *=0

//[1]explicit QQuickWidget(QWidget *parent = 0)
//[2]QQuickWidget(QQmlEngine* engine, QWidget *parent)
//[3]QQuickWidget(const QUrl &source, QWidget *parent = 0)

HB_FUNC_STATIC( QQUICKWIDGET_NEW )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,3,0))
  if( ISBETWEEN(0,1) && ISOPTQWIDGET(1) )
  {
    QQuickWidget_new1();
  }
  else if( ISNUMPAR(2) && ISQQMLENGINE(1) && ISQWIDGET(2) )
  {
    QQuickWidget_new2();
  }
  else if( ISBETWEEN(1,2) && ISQURL(1) && ISOPTQWIDGET(2) )
  {
    QQuickWidget_new3();
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
#endif
}

$deleteMethod=5,3,0

$prototype=QUrl source() const
$method=5,3,0|QUrl|source|

$prototype=void setSource(const QUrl&)
$method=5,3,0|void|setSource|const QUrl &

$prototype=QQmlEngine* engine() const
$method=5,3,0|QQmlEngine *|engine|

$prototype=QQmlContext* rootContext() const
$method=5,3,0|QQmlContext *|rootContext|

$prototype=QQuickItem *rootObject() const
$method=5,3,0|QQuickItem *|rootObject|

$prototype=ResizeMode resizeMode() const
$method=5,3,0|QQuickWidget::ResizeMode|resizeMode|

$prototype=void setResizeMode(ResizeMode)
$method=5,3,0|void|setResizeMode|QQuickWidget::ResizeMode

$prototype=Status status() const
$method=5,3,0|QQuickWidget::Status|status|

$prototype=QList<QQmlError> errors() const
$method=5,3,0|QList<QQmlError>|errors|

$prototype=QSize sizeHint() const
$method=5,3,0|QSize|sizeHint|

$prototype=QSize initialSize() const
$method=5,3,0|QSize|initialSize|

$prototype=void setContent(const QUrl& url, QQmlComponent *component, QObject *item)
$method=5,3,0|void|setContent|const QUrl &,QQmlComponent *,QObject *

$prototype=QSurfaceFormat format() const
$method=5,3,0|QSurfaceFormat|format|

$prototype=void setFormat(const QSurfaceFormat &format)
$method=5,3,0|void|setFormat|const QSurfaceFormat &

#pragma ENDDUMP

%%
%% Qt5xHb - Bindings libraries for Harbour/xHarbour and Qt Framework 5
%%
%% Copyright (C) 2018 Marcos Antonio Gambeta <marcosgambeta AT outlook DOT com>
%%

$header

#include "hbclass.ch"

#ifndef QT5XHB_NO_REQUESTS
REQUEST QURL
REQUEST QQMLENGINE
REQUEST QQMLCONTEXT
REQUEST QQUICKITEM
REQUEST QQMLERROR
REQUEST QSIZE
REQUEST QSURFACEFORMAT
#endif

CLASS QQuickWidget INHERIT QWidget

   METHOD new
   METHOD delete
   METHOD source
   METHOD setSource
   METHOD engine
   METHOD rootContext
   METHOD rootObject
   METHOD resizeMode
   METHOD setResizeMode
   METHOD status
   METHOD errors
   METHOD sizeHint
   METHOD initialSize
   METHOD setContent
   METHOD format
   METHOD setFormat

   METHOD onStatusChanged
   METHOD onSceneGraphError

   DESTRUCTOR destroyObject

END CLASS

$destructor

#pragma BEGINDUMP

$includes=5,3,0

#include <QQmlError>

$prototype=explicit QQuickWidget(QWidget *parent = 0)
$internalConstructor=5,3,0|new1|QWidget *=0

$prototype=QQuickWidget(QQmlEngine* engine, QWidget *parent)
$internalConstructor=5,3,0|new2|QQmlEngine *,QWidget *

$prototype=QQuickWidget(const QUrl &source, QWidget *parent = 0)
$internalConstructor=5,3,0|new3|const QUrl &,QWidget *=0

//[1]explicit QQuickWidget(QWidget *parent = 0)
//[2]QQuickWidget(QQmlEngine* engine, QWidget *parent)
//[3]QQuickWidget(const QUrl &source, QWidget *parent = 0)

HB_FUNC_STATIC( QQUICKWIDGET_NEW )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,3,0))
  if( ISBETWEEN(0,1) && ISOPTQWIDGET(1) )
  {
    QQuickWidget_new1();
  }
  else if( ISNUMPAR(2) && ISQQMLENGINE(1) && ISQWIDGET(2) )
  {
    QQuickWidget_new2();
  }
  else if( ISBETWEEN(1,2) && ISQURL(1) && ISOPTQWIDGET(2) )
  {
    QQuickWidget_new3();
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
#endif
}

$deleteMethod=5,3,0

$prototype=QUrl source() const
$method=5,3,0|QUrl|source|

$prototype=void setSource(const QUrl&)
$method=5,3,0|void|setSource|const QUrl &

$prototype=QQmlEngine* engine() const
$method=5,3,0|QQmlEngine *|engine|

$prototype=QQmlContext* rootContext() const
$method=5,3,0|QQmlContext *|rootContext|

$prototype=QQuickItem *rootObject() const
$method=5,3,0|QQuickItem *|rootObject|

$prototype=ResizeMode resizeMode() const
$method=5,3,0|QQuickWidget::ResizeMode|resizeMode|

$prototype=void setResizeMode(ResizeMode)
$method=5,3,0|void|setResizeMode|QQuickWidget::ResizeMode

$prototype=Status status() const
$method=5,3,0|QQuickWidget::Status|status|

$prototype=QList<QQmlError> errors() const
$method=5,3,0|QList<QQmlError>|errors|

$prototype=QSize sizeHint() const
$method=5,3,0|QSize|sizeHint|

$prototype=QSize initialSize() const
$method=5,3,0|QSize|initialSize|

$prototype=void setContent(const QUrl& url, QQmlComponent *component, QObject *item)
$method=5,3,0|void|setContent|const QUrl &,QQmlComponent *,QObject *

$prototype=QSurfaceFormat format() const
$method=5,3,0|QSurfaceFormat|format|

$prototype=void setFormat(const QSurfaceFormat &format)
$method=5,3,0|void|setFormat|const QSurfaceFormat &

#pragma ENDDUMP


add URL to source

add URL to source

data Dir :: *2 where
  Hor :: Dir
  Ver :: Dir

{-
data TreeF :: * ~> Dir ~> *1 where
  Unit :: TreeF f Ver
  Ni :: TreeF f Hor
  Fork :: f ~> TreeF f Hor ~> TreeF f Hor
 deriving syntax (tr) List(Ni, Fork) Unit(Unit)

--kind Id d k = Id k

kind Fix t f = In (f (Fix t f))

type Tree = Fix TreeF
-}

kind T r a = Nix | F r a r

kind Fix f a = X (f (Fix f a) a)
                  ^
------------------+
--- here is the bug!

type Tree a = Fix T a

{- Triggers omega bug:

omega.exe: RankN.hs:(1704,1)-(1708,23): Non-exhaustive patterns in function matchKind

>>> http://code.google.com/p/omega/source/browse/trunk/src/RankN.hs#1704

-}

data Dir :: *2 where
  Hor :: Dir
  Ver :: Dir

{-
data TreeF :: * ~> Dir ~> *1 where
  Unit :: TreeF f Ver
  Ni :: TreeF f Hor
  Fork :: f ~> TreeF f Hor ~> TreeF f Hor
 deriving syntax (tr) List(Ni, Fork) Unit(Unit)

--kind Id d k = Id k

kind Fix t f = In (f (Fix t f))

type Tree = Fix TreeF
-}

kind T r a = Nix | F r a r

kind Fix f a = X (f (Fix f a) a)
                  ^
------------------+
--- here is the bug!

type Tree a = Fix T a

{- Triggers omega bug:

omega.exe: RankN.hs:(1704,1)-(1708,23): Non-exhaustive patterns in function matchKind

-}


(Dbf Rdd) Corrections in Tests

(Dbf Rdd) Corrections in Tests

// TestDbfNtx.prg
// Created by    : fabri
// Creation Date : 9/16/2018 4:17:53 PM
// Created for   :
// WorkStation   : FABPORTABLE

USING System
USING System.Collections.Generic
USING System.Text
USING Xunit
USING XSharp.RDD
USING XSharp.Rdd.Support
USING System.Diagnostics
USING Xsharp.Core

BEGIN NAMESPACE XSharp.RDD.Tests

	/// <summary>
	/// The TestDbfNtx class.
	/// </summary>
	CLASS TestDbfNtx

		[Fact, Trait("DbfNtx", "Create")];
		METHOD CreateDBFNtx() AS VOID
			LOCAL fieldDefs := "ID,N,5,0;NAME,C,20,0;MAN,L,1,0;BIRTHDAY,D,8,0" AS STRING
			LOCAL fields := fieldDefs:Split( ';' ) AS STRING[]
			VAR dbInfo := DbOpenInfo{ "TestNtx1.DBF", "TestNtx1", 1, FALSE, FALSE }
			//
			LOCAL myDBF AS DbfNtx
			LOCAL fieldInfo AS STRING[]
			LOCAL rddInfo AS RddFieldInfo[]
			rddInfo := RddFieldInfo[]{fields:Length}
			FOR VAR i := __ARRAYBASE__ TO fields:Length - (1-__ARRAYBASE__)
				//
				LOCAL currentField AS RddFieldInfo
				fieldInfo := fields[i]:Split( ',' )
				currentField := RddFieldInfo{ fieldInfo[DBS_NAME], fieldInfo[DBS_TYPE], Convert.ToInt32(fieldInfo[DBS_LEN]), Convert.ToInt32(fieldInfo[DBS_DEC]) }
				rddInfo[i] := currentField
			NEXT
			//
			myDBF := DbfNtx{}
			myDBF:SetFieldExtent( fields:Length )
			myDBF:CreateFields( rddInfo )
			// Now Check
			Assert.Equal( TRUE, myDBF:Create( dbInfo ) )
			// WE HAVE TO SET THE WORKAREA INFO !!!!
			dbInfo:WorkArea  := RuntimeState.Workareas:FindEmptyArea(TRUE)
			RuntimeState.Workareas:SetArea(dbInfo:WorkArea, myDBF)
			//
			LOCAL ntxInfo AS DbOrderCreateInfo
			ntxInfo := DbOrderCreateInfo{}
			ntxInfo:BagName := "TestNtx1"
			ntxInfo:Order := "TestNtx1"
			ntxInfo:Expression := "_FIELD->ID"
			//
			Assert.Equal( TRUE, myDBF:OrderCreate( ntxInfo ) )
			//
			RuntimeState.Workareas:CloseArea( dbInfo:WorkArea )
			RETURN

		[Fact, Trait("DbfNtx", "Open")];
		METHOD OpenDBFNtx() AS VOID
			// ID,N,5,0;NAME,C,20,0
			VAR dbInfo := DbOpenInfo{ "TestNTX2.DBF", "customer", 1, FALSE, FALSE }
			//
			LOCAL myDBF AS DbfNtx
			myDBF := DbfNtx{}
			Assert.Equal( TRUE, myDBF:Open( dbInfo ) )
			// WE HAVE TO SET THE WORKAREA INFO !!!!
			LOCAL area  := 0    AS DWORD
			area  := RuntimeState.Workareas:FindEmptyArea(TRUE)
			RuntimeState.Workareas:SetArea(area, myDBF)
			RuntimeState.Workareas:CurrentWorkAreaNO := area
			dbInfo:WorkArea := area
			//
			LOCAL ntxInfo AS DbOrderInfo
			ntxInfo := DbOrderInfo{}
			ntxInfo:BagName := "TestNTX2"
			ntxInfo:Order := "TestNTX2"
			// FilePath NullOrEmpty => Will get the FilePath of the DBF
			Assert.Equal( TRUE, myDBF:OrderListAdd( ntxInfo ) )
			//
			RuntimeState.Workareas:CloseArea( dbInfo:WorkArea )
			RETURN

		[Fact, Trait("DbfNtx", "Read")];
		METHOD ReadDBFNtx() AS VOID
			//
			SELF:CheckOrder( "TestNTX2" )
			RETURN

		[Fact, Trait("DbfNtx", "CreateAppend")];
		METHOD CreateAppend() AS VOID
			LOCAL fieldDefs := "ID,N,5,0;NAME,C,20,0;MAN,L,1,0;BIRTHDAY,D,8,0" AS STRING
			LOCAL fields := fieldDefs:Split( ';' ) AS STRING[]
			VAR dbInfo := DbOpenInfo{ "XMenTest.DBF", "XMenTest", 1, FALSE, FALSE }
			//
			LOCAL myDBF AS DbfNtx
			LOCAL fieldInfo AS STRING[]
			LOCAL rddInfo AS RddFieldInfo[]
			rddInfo := RddFieldInfo[]{fields:Length}
			FOR VAR i := __ARRAYBASE__ TO fields:Length - (1-__ARRAYBASE__)
				//
				LOCAL currentField AS RddFieldInfo
				fieldInfo := fields[i]:Split( ',' )
				currentField := RddFieldInfo{ fieldInfo[DBS_NAME], fieldInfo[DBS_TYPE], Convert.ToInt32(fieldInfo[DBS_LEN]), Convert.ToInt32(fieldInfo[DBS_DEC]) }
				rddInfo[i] := currentField
			NEXT
			//
			myDBF := DbfNtx{}
			myDBF:SetFieldExtent( fields:Length )
			myDBF:CreateFields( rddInfo )
			// Now Check
			Assert.Equal( TRUE, myDBF:Create( dbInfo ) )
			// WE HAVE TO SET THE WORKAREA INFO !!!!
			dbInfo:WorkArea  := RuntimeState.Workareas:FindEmptyArea(TRUE)
			RuntimeState.Workareas:SetArea(dbInfo:WorkArea, myDBF)
			//
			LOCAL ntxInfo AS DbOrderCreateInfo
			ntxInfo := DbOrderCreateInfo{}
			ntxInfo:BagName := "XMenTest"
			ntxInfo:Order := "XMenTest"
			ntxInfo:Expression := "ID"
			//
			Assert.Equal( TRUE, myDBF:OrderCreate( ntxInfo ) )
			//
			// Now, Add some Data
			//"ID,N,5,0;NAME,C,20,0;MAN,L,1,0;BIRTHDAY,D,8,0"
			LOCAL datas := "5,Diablo,T;2,Wolverine,T;4,Cyclops,T;3,Tornade,F;1,Professor Xavier,T" AS STRING
			LOCAL data := datas:Split( ';' ) AS STRING[]
			//
			FOR VAR i := __ARRAYBASE__ TO data:Length - (1-__ARRAYBASE__)
				//
				LOCAL elt := data[i]:Split( ',' ) AS STRING[]
				myDBF:Append( FALSE )
				myDBF:PutValue( 1, Convert.ToInt32(elt[__ARRAYBASE__] ))
				myDBF:PutValue( 2, elt[__ARRAYBASE__+1])
				myDBF:PutValue( 3, String.Compare(elt[__ARRAYBASE__+2],"T",TRUE)==0 )
				myDBF:PutValue( 4, DateTime.Now )
			NEXT
			//myDBF:Close()
			RuntimeState.Workareas:CloseArea( dbInfo:WorkArea )
			// Now, Verify
			SELF:CheckOrder( "XMenTest" )
			RETURN

		[Fact, Trait("DbfNtx", "BigCreateAppend")];
		METHOD BigCreateAppend() AS VOID
			LOCAL fieldDefs := "ID,N,5,0;NAME,C,20,0;MAN,L,1,0;BIRTHDAY,D,8,0" AS STRING
			LOCAL fields := fieldDefs:Split( ';' ) AS STRING[]
			VAR dbInfo := DbOpenInfo{ "XMenTest.DBF", "XMenTest", 1, FALSE, FALSE }
			//
			LOCAL myDBF AS DbfNtx
			LOCAL fieldInfo AS STRING[]
			LOCAL rddInfo AS RddFieldInfo[]
			rddInfo := RddFieldInfo[]{fields:Length}
			FOR VAR i := __ARRAYBASE__ TO fields:Length - (1-__ARRAYBASE__)
				//
				LOCAL currentField AS RddFieldInfo
				fieldInfo := fields[i]:Split( ',' )
				currentField := RddFieldInfo{ fieldInfo[DBS_NAME], fieldInfo[DBS_TYPE], Convert.ToInt32(fieldInfo[DBS_LEN]), Convert.ToInt32(fieldInfo[DBS_DEC]) }
				rddInfo[i] := currentField
			NEXT
			//
			myDBF := DbfNtx{}
			myDBF:SetFieldExtent( fields:Length )
			myDBF:CreateFields( rddInfo )
			// Now Check
			Assert.Equal( TRUE, myDBF:Create( dbInfo ) )
			// WE HAVE TO SET THE WORKAREA INFO !!!!
			dbInfo:WorkArea  := RuntimeState.Workareas:FindEmptyArea(TRUE)
			RuntimeState.Workareas:SetArea(dbInfo:WorkArea, myDBF)
			//
			LOCAL ntxInfo AS DbOrderCreateInfo
			ntxInfo := DbOrderCreateInfo{}
			ntxInfo:BagName := "XMenTest"
			ntxInfo:Order := "XMenTest"
			ntxInfo:Expression := "ID"
			//
			Assert.Equal( TRUE, myDBF:OrderCreate( ntxInfo ) )
			//
			// Now, Add some Data
			LOCAL rnd AS Random
			//
			rnd := Random{ (LONG)DateTime.Now.Ticks }
			//"ID,N,5,0;NAME,C,20,0;MAN,L,1,0;BIRTHDAY,D,8,0"
			// 3000 samples
			FOR VAR i := 1 TO 3000
				//
				myDBF:Append( FALSE )
				myDBF:PutValue( 1,  rnd:@@NEXT( 1, 5000 ))
				myDBF:PutValue( 2,  LoremIpsum(20) )
				myDBF:PutValue( 3,  rnd:@@NEXT(0,2) == 1 )
				myDBF:PutValue( 4, DateTime.Now )
			NEXT
			//myDBF:Close()
			RuntimeState.Workareas:CloseArea( dbInfo:WorkArea )
			// Now, Verify
			SELF:CheckOrder( "XMenTest" )
			RETURN

		// Read a DBF/NTX who's first Field is a Number used as Index Key
		METHOD CheckOrder( baseFileName AS STRING ) AS VOID
			//
			VAR dbInfo := DbOpenInfo{ baseFileName, "customer", 1, FALSE, FALSE }
			//
			LOCAL myDBF AS DbfNtx
			myDBF := DbfNtx{}

			VAR success := myDBF:Open( dbInfo )
			Assert.Equal( TRUE, success )
			// WE HAVE TO SET THE WORKAREA INFO !!!!
			LOCAL area  := 0    AS DWORD
			area  := RuntimeState.Workareas:FindEmptyArea(TRUE)
			RuntimeState.Workareas:SetArea(area, myDBF)
			RuntimeState.Workareas:CurrentWorkAreaNO := area
			dbInfo:WorkArea := area
			//
			//FieldPos( "ID" )
			LOCAL ntxInfo AS DbOrderInfo
			ntxInfo := DbOrderInfo{}
			ntxInfo:BagName := baseFileName
			ntxInfo:Order := baseFileName
			// FilePath NullOrEmpty => Will get the FilePath of the DBF
			Assert.Equal( TRUE, myDBF:OrderListAdd( ntxInfo ) )
			myDBF:GoTop()
			//
			LOCAL idList AS List<INT>
			idList := List<INT>{}
			WHILE ! myDBF:EoF
				//				Debug.Write( "---===---" + Environment.NewLine )
				//				FOR VAR i := 1 TO myDBF:FIELDCount
				//					//
				//					LOCAL oData AS OBJECT
				//					oData := myDBF:GetValue( i )
				//					LOCAL str AS STRING
				//					str := oData:ToString()
				//					Debug.Write( str +" - " )
				//				NEXT
				//				Debug.Write( Environment.NewLine )
				LOCAL oData AS OBJECT
				// Field 1 == ID
				oData := myDBF:GetValue( 1 )
				idList:Add( (INT)oData )
				myDBF:Skip(1)
			ENDDO
			// Check that the ID are sorted by value
			FOR VAR i := 0 TO (idList:Count-2)
				Assert.Equal( TRUE, idList[i] <= idList[i+1] )
			NEXT
			//
			RuntimeState.Workareas:CloseArea( area )
			//myDBF:Close()
			RETURN

	END CLASS
END NAMESPACE // XSharp.RDD.Tests

// TestDbfNtx.prg
// Created by    : fabri
// Creation Date : 9/16/2018 4:17:53 PM
// Created for   :
// WorkStation   : FABPORTABLE

USING System
USING System.Collections.Generic
USING System.Text
USING Xunit
USING XSharp.RDD
USING XSharp.Rdd.Support
USING System.Diagnostics
USING Xsharp.Core

BEGIN NAMESPACE XSharp.RDD.Tests

	/// <summary>
	/// The TestDbfNtx class.
	/// </summary>
	CLASS TestDbfNtx

		[Fact, Trait("DbfNtx", "Create")];
		METHOD CreateDBFNtx() AS VOID
			LOCAL fieldDefs := "ID,N,5,0;NAME,C,20,0;MAN,L,1,0;BIRTHDAY,D,8,0" AS STRING
			LOCAL fields := fieldDefs:Split( ';' ) AS STRING[]
			VAR dbInfo := DbOpenInfo{ "TestNtx1.DBF", "TestNtx1", 1, FALSE, FALSE }
			//
			LOCAL myDBF AS DbfNtx
			LOCAL fieldInfo AS STRING[]
			LOCAL rddInfo AS RddFieldInfo[]
			rddInfo := RddFieldInfo[]{fields:Length}
			FOR VAR i := __ARRAYBASE__ TO fields:Length - (1-__ARRAYBASE__)
				//
				LOCAL currentField AS RddFieldInfo
				fieldInfo := fields[i]:Split( ',' )
				currentField := RddFieldInfo{ fieldInfo[DBS_NAME], fieldInfo[DBS_TYPE], Convert.ToInt32(fieldInfo[DBS_LEN]), Convert.ToInt32(fieldInfo[DBS_DEC]) }
				rddInfo[i] := currentField
			NEXT
			//
			myDBF := DbfNtx{}
			myDBF:SetFieldExtent( fields:Length )
			myDBF:CreateFields( rddInfo )
			// Now Check
			Assert.Equal( TRUE, myDBF:Create( dbInfo ) )
			// WE HAVE TO SET THE WORKAREA INFO !!!!
			dbInfo:WorkArea  := RuntimeState.Workareas:FindEmptyArea(TRUE)
			RuntimeState.Workareas:SetArea(dbInfo:WorkArea, myDBF)
			//
			LOCAL ntxInfo AS DbOrderCreateInfo
			ntxInfo := DbOrderCreateInfo{}
			ntxInfo:BagName := "TestNtx1"
			ntxInfo:Order := "TestNtx1"
			ntxInfo:Expression := "_FIELD->ID"
			//
			Assert.Equal( TRUE, myDBF:OrderCreate( ntxInfo ) )
			//
			RuntimeState.Workareas:CloseArea( dbInfo:WorkArea )
			RETURN

		[Fact, Trait("DbfNtx", "Open")];
		METHOD OpenDBFNtx() AS VOID
			// ID,N,5,0;NAME,C,20,0
			VAR dbInfo := DbOpenInfo{ "TestNTX2.DBF", "customer", 1, FALSE, FALSE }
			//
			LOCAL myDBF AS DbfNtx
			myDBF := DbfNtx{}
			Assert.Equal( TRUE, myDBF:Open( dbInfo ) )
			// WE HAVE TO SET THE WORKAREA INFO !!!!
			LOCAL area  := 0    AS DWORD
			area  := RuntimeState.Workareas:FindEmptyArea(TRUE)
			RuntimeState.Workareas:SetArea(area, myDBF)
			RuntimeState.Workareas:CurrentWorkAreaNO := area
			dbInfo:WorkArea := area
			//
			LOCAL ntxInfo AS DbOrderInfo
			ntxInfo := DbOrderInfo{}
			ntxInfo:BagName := "TestNTX2"
			ntxInfo:Order := "TestNTX2"
			// FilePath NullOrEmpty => Will get the FilePath of the DBF
			Assert.Equal( TRUE, myDBF:OrderListAdd( ntxInfo, "" ) )
			//
			RuntimeState.Workareas:CloseArea( dbInfo:WorkArea )
			RETURN

		[Fact, Trait("DbfNtx", "Read")];
		METHOD ReadDBFNtx() AS VOID
			//
			SELF:CheckOrder( "TestNTX2" )
			RETURN

		[Fact, Trait("DbfNtx", "CreateAppend")];
		METHOD CreateAppend() AS VOID
			LOCAL fieldDefs := "ID,N,5,0;NAME,C,20,0;MAN,L,1,0;BIRTHDAY,D,8,0" AS STRING
			LOCAL fields := fieldDefs:Split( ';' ) AS STRING[]
			VAR dbInfo := DbOpenInfo{ "XMenTest.DBF", "XMenTest", 1, FALSE, FALSE }
			//
			LOCAL myDBF AS DbfNtx
			LOCAL fieldInfo AS STRING[]
			LOCAL rddInfo AS RddFieldInfo[]
			rddInfo := RddFieldInfo[]{fields:Length}
			FOR VAR i := __ARRAYBASE__ TO fields:Length - (1-__ARRAYBASE__)
				//
				LOCAL currentField AS RddFieldInfo
				fieldInfo := fields[i]:Split( ',' )
				currentField := RddFieldInfo{ fieldInfo[DBS_NAME], fieldInfo[DBS_TYPE], Convert.ToInt32(fieldInfo[DBS_LEN]), Convert.ToInt32(fieldInfo[DBS_DEC]) }
				rddInfo[i] := currentField
			NEXT
			//
			myDBF := DbfNtx{}
			myDBF:SetFieldExtent( fields:Length )
			myDBF:CreateFields( rddInfo )
			// Now Check
			Assert.Equal( TRUE, myDBF:Create( dbInfo ) )
			// WE HAVE TO SET THE WORKAREA INFO !!!!
			dbInfo:WorkArea  := RuntimeState.Workareas:FindEmptyArea(TRUE)
			RuntimeState.Workareas:SetArea(dbInfo:WorkArea, myDBF)
			//
			LOCAL ntxInfo AS DbOrderCreateInfo
			ntxInfo := DbOrderCreateInfo{}
			ntxInfo:BagName := "XMenTest"
			ntxInfo:Order := "XMenTest"
			ntxInfo:Expression := "ID"
			//
			Assert.Equal( TRUE, myDBF:OrderCreate( ntxInfo ) )
			//
			// Now, Add some Data
			//"ID,N,5,0;NAME,C,20,0;MAN,L,1,0;BIRTHDAY,D,8,0"
			LOCAL datas := "5,Diablo,T;2,Wolverine,T;4,Cyclops,T;3,Tornade,F;1,Professor Xavier,T" AS STRING
			LOCAL data := datas:Split( ';' ) AS STRING[]
			//
			FOR VAR i := __ARRAYBASE__ TO data:Length - (1-__ARRAYBASE__)
				//
				LOCAL elt := data[i]:Split( ',' ) AS STRING[]
				myDBF:Append( FALSE )
				myDBF:PutValue( 1, Convert.ToInt32(elt[__ARRAYBASE__] ))
				myDBF:PutValue( 2, elt[__ARRAYBASE__+1])
				myDBF:PutValue( 3, String.Compare(elt[__ARRAYBASE__+2],"T",TRUE)==0 )
				myDBF:PutValue( 4, DateTime.Now )
			NEXT
			//myDBF:Close()
			RuntimeState.Workareas:CloseArea( dbInfo:WorkArea )
			// Now, Verify
			SELF:CheckOrder( "XMenTest" )
			RETURN

		[Fact, Trait("DbfNtx", "BigCreateAppend")];
		METHOD BigCreateAppend() AS VOID
			LOCAL fieldDefs := "ID,N,5,0;NAME,C,20,0;MAN,L,1,0;BIRTHDAY,D,8,0" AS STRING
			LOCAL fields := fieldDefs:Split( ';' ) AS STRING[]
			VAR dbInfo := DbOpenInfo{ "XMenTest.DBF", "XMenTest", 1, FALSE, FALSE }
			//
			LOCAL myDBF AS DbfNtx
			LOCAL fieldInfo AS STRING[]
			LOCAL rddInfo AS RddFieldInfo[]
			rddInfo := RddFieldInfo[]{fields:Length}
			FOR VAR i := __ARRAYBASE__ TO fields:Length - (1-__ARRAYBASE__)
				//
				LOCAL currentField AS RddFieldInfo
				fieldInfo := fields[i]:Split( ',' )
				currentField := RddFieldInfo{ fieldInfo[DBS_NAME], fieldInfo[DBS_TYPE], Convert.ToInt32(fieldInfo[DBS_LEN]), Convert.ToInt32(fieldInfo[DBS_DEC]) }
				rddInfo[i] := currentField
			NEXT
			//
			myDBF := DbfNtx{}
			myDBF:SetFieldExtent( fields:Length )
			myDBF:CreateFields( rddInfo )
			// Now Check
			Assert.Equal( TRUE, myDBF:Create( dbInfo ) )
			// WE HAVE TO SET THE WORKAREA INFO !!!!
			dbInfo:WorkArea  := RuntimeState.Workareas:FindEmptyArea(TRUE)
			RuntimeState.Workareas:SetArea(dbInfo:WorkArea, myDBF)
			//
			LOCAL ntxInfo AS DbOrderCreateInfo
			ntxInfo := DbOrderCreateInfo{}
			ntxInfo:BagName := "XMenTest"
			ntxInfo:Order := "XMenTest"
			ntxInfo:Expression := "ID"
			//
			Assert.Equal( TRUE, myDBF:OrderCreate( ntxInfo ) )
			//
			// Now, Add some Data
			LOCAL rnd AS Random
			//
			rnd := Random{ (LONG)DateTime.Now.Ticks }
			//"ID,N,5,0;NAME,C,20,0;MAN,L,1,0;BIRTHDAY,D,8,0"
			// 3000 samples
			FOR VAR i := 1 TO 3000
				//
				myDBF:Append( FALSE )
				myDBF:PutValue( 1,  rnd:@@NEXT( 1, 5000 ))
				myDBF:PutValue( 2,  LoremIpsum(20) )
				myDBF:PutValue( 3,  rnd:@@NEXT(0,2) == 1 )
				myDBF:PutValue( 4, DateTime.Now )
			NEXT
			//myDBF:Close()
			RuntimeState.Workareas:CloseArea( dbInfo:WorkArea )
			// Now, Verify
			SELF:CheckOrder( "XMenTest" )
			RETURN

		// Read a DBF/NTX who's first Field is a Number used as Index Key
		METHOD CheckOrder( baseFileName AS STRING ) AS VOID
			//
			VAR dbInfo := DbOpenInfo{ baseFileName, "customer", 1, FALSE, FALSE }
			//
			LOCAL myDBF AS DbfNtx
			myDBF := DbfNtx{}

			VAR success := myDBF:Open( dbInfo )
			Assert.Equal( TRUE, success )
			// WE HAVE TO SET THE WORKAREA INFO !!!!
			LOCAL area  := 0    AS DWORD
			area  := RuntimeState.Workareas:FindEmptyArea(TRUE)
			RuntimeState.Workareas:SetArea(area, myDBF)
			RuntimeState.Workareas:CurrentWorkAreaNO := area
			dbInfo:WorkArea := area
			//
			//FieldPos( "ID" )
			LOCAL ntxInfo AS DbOrderInfo
			ntxInfo := DbOrderInfo{}
			ntxInfo:BagName := baseFileName
			ntxInfo:Order := baseFileName
			// FilePath NullOrEmpty => Will get the FilePath of the DBF
			Assert.Equal( TRUE, myDBF:OrderListAdd( ntxInfo, "" ) )
			myDBF:GoTop()
			//
			LOCAL idList AS List<INT>
			idList := List<INT>{}
			WHILE ! myDBF:EoF
				//				Debug.Write( "---===---" + Environment.NewLine )
				//				FOR VAR i := 1 TO myDBF:FIELDCount
				//					//
				//					LOCAL oData AS OBJECT
				//					oData := myDBF:GetValue( i )
				//					LOCAL str AS STRING
				//					str := oData:ToString()
				//					Debug.Write( str +" - " )
				//				NEXT
				//				Debug.Write( Environment.NewLine )
				LOCAL oData AS OBJECT
				// Field 1 == ID
				oData := myDBF:GetValue( 1 )
				idList:Add( (INT)oData )
				myDBF:Skip(1)
			ENDDO
			// Check that the ID are sorted by value
			FOR VAR i := 0 TO (idList:Count-2)
				Assert.Equal( TRUE, idList[i] <= idList[i+1] )
			NEXT
			//
			RuntimeState.Workareas:CloseArea( area )
			//myDBF:Close()
			RETURN

	END CLASS
END NAMESPACE // XSharp.RDD.Tests