FIX: class QDateTime moved to QtCore (again)

/*

  Qt5xHb - bibliotecas de ligao entre Harbour/xHarbour e Qt Framework 5

  Copyright (C) 2012-2017 Marcos Antonio Gambeta <marcosgambeta@uol.com.br>

*/

#include "hbclass.ch"
#include "qt4xhb_clsid.ch"

REQUEST QDATE
REQUEST QTIME

CLASS QDateTime

   DATA pointer
   DATA class_id INIT Class_Id_QDateTime
   DATA class_flags INIT 0
   DATA self_destruction INIT .f.

   METHOD new1
   METHOD new2
   METHOD new3
   METHOD new4
   METHOD new
   METHOD delete
   METHOD addDays
   METHOD addMSecs
   METHOD addMonths
   METHOD addSecs
   METHOD addYears
   METHOD date
   METHOD daysTo
   METHOD isNull
   METHOD isValid
   METHOD msecsTo
   METHOD secsTo
   METHOD setDate
   METHOD setMSecsSinceEpoch
   METHOD setTime
   METHOD setTimeSpec
   METHOD setTime_t
   METHOD time
   METHOD timeSpec
   METHOD toLocalTime
   METHOD toMSecsSinceEpoch
   METHOD toString1
   METHOD toString2
   METHOD toString
   METHOD toTimeSpec
   METHOD toTime_t
   METHOD toUTC
   METHOD currentDateTime
   METHOD currentDateTimeUtc
   METHOD currentMSecsSinceEpoch
   METHOD fromMSecsSinceEpoch
   METHOD fromString1
   METHOD fromString2
   METHOD fromString
   METHOD fromTime_t
   METHOD newFrom
   METHOD newFromObject
   METHOD newFromPointer
   METHOD selfDestruction
   METHOD setSelfDestruction
   DESTRUCTOR destroyObject

END CLASS

PROCEDURE destroyObject () CLASS QDateTime
   IF ::self_destruction
      ::delete()
   ENDIF
RETURN

#pragma BEGINDUMP

/*

  Qt5xHb - bibliotecas de ligao entre Harbour/xHarbour e Qt Framework 5

  Copyright (C) 2012-2017 Marcos Antonio Gambeta <marcosgambeta@uol.com.br>

*/

#include <Qt>

#ifndef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,0,0))
#include <QDateTime>
#endif
#endif

#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
#include "hbvm.h"
#include "hbstack.h"

#ifndef __XHARBOUR__
#include "hbapicls.h"
#define ISNIL HB_ISNIL
#define ISLOG HB_ISLOG
#define ISNUM HB_ISNUM
#define ISCHAR HB_ISCHAR
#define ISPOINTER HB_ISPOINTER
#define ISOBJECT HB_ISOBJECT
#define ISARRAY HB_ISARRAY
#endif

#include "qt4xhb_clsid.h"
#include "qt4xhb_utils.h"

#ifdef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,0,0))
#include <QDateTime>
#endif
#endif

/*
QDateTime ()
*/
HB_FUNC_STATIC( QDATETIME_NEW1 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,0,0))
  QDateTime * o = new QDateTime (  );
  PHB_ITEM self = hb_stackSelfItem();
  PHB_ITEM ptr = hb_itemPutPtr( NULL,(QDateTime *) o );
  hb_objSendMsg( self, "_pointer", 1, ptr );
  hb_itemRelease( ptr );
  PHB_ITEM des = hb_itemPutL( NULL, true );
  hb_objSendMsg( self, "_SELF_DESTRUCTION", 1, des );
  hb_itemRelease( des );
  hb_itemReturn( self );
#endif
}

/*
QDateTime ( const QDate & date )
*/
HB_FUNC_STATIC( QDATETIME_NEW2 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,0,0))
  QDate * par1 = (QDate *) _qtxhb_itemGetPtr(1);
  QDateTime * o = new QDateTime ( *par1 );
  PHB_ITEM self = hb_stackSelfItem();
  PHB_ITEM ptr = hb_itemPutPtr( NULL,(QDateTime *) o );
  hb_objSendMsg( self, "_pointer", 1, ptr );
  hb_itemRelease( ptr );
  PHB_ITEM des = hb_itemPutL( NULL, true );
  hb_objSendMsg( self, "_SELF_DESTRUCTION", 1, des );
  hb_itemRelease( des );
  hb_itemReturn( self );
#endif
}

/*
QDateTime ( const QDate & date, const QTime & time, Qt::TimeSpec spec = Qt::LocalTime )
*/
HB_FUNC_STATIC( QDATETIME_NEW3 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,0,0))
  QDate * par1 = (QDate *) _qtxhb_itemGetPtr(1);
  QTime * par2 = (QTime *) _qtxhb_itemGetPtr(2);
  int par3 = ISNIL(3)? (int) Qt::LocalTime : hb_parni(3);
  QDateTime * o = new QDateTime ( *par1, *par2,  (Qt::TimeSpec) par3 );
  PHB_ITEM self = hb_stackSelfItem();
  PHB_ITEM ptr = hb_itemPutPtr( NULL,(QDateTime *) o );
  hb_objSendMsg( self, "_pointer", 1, ptr );
  hb_itemRelease( ptr );
  PHB_ITEM des = hb_itemPutL( NULL, true );
  hb_objSendMsg( self, "_SELF_DESTRUCTION", 1, des );
  hb_itemRelease( des );
  hb_itemReturn( self );
#endif
}

/*
QDateTime ( const QDateTime & other )
*/
HB_FUNC_STATIC( QDATETIME_NEW4 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,0,0))
  QDateTime * par1 = (QDateTime *) _qtxhb_itemGetPtr(1);
  QDateTime * o = new QDateTime ( *par1 );
  PHB_ITEM self = hb_stackSelfItem();
  PHB_ITEM ptr = hb_itemPutPtr( NULL,(QDateTime *) o );
  hb_objSendMsg( self, "_pointer", 1, ptr );
  hb_itemRelease( ptr );
  PHB_ITEM des = hb_itemPutL( NULL, true );
  hb_objSendMsg( self, "_SELF_DESTRUCTION", 1, des );
  hb_itemRelease( des );
  hb_itemReturn( self );
#endif
}

//[1]QDateTime ()
//[2]QDateTime ( const QDate & date )
//[3]QDateTime ( const QDate & date, const QTime & time, Qt::TimeSpec spec = Qt::LocalTime )
//[4]QDateTime ( const QDateTime & other )

HB_FUNC_STATIC( QDATETIME_NEW )
{
  if( ISNUMPAR(0) )
  {
    HB_FUNC_EXEC( QDATETIME_NEW1 );
  }
  else if( ISNUMPAR(1) && ISQDATE(1) )
  {
    HB_FUNC_EXEC( QDATETIME_NEW2 );
  }
  else if( ISBETWEEN(2,3) && ISQDATE(1) && ISQTIME(2) && (ISNUM(3)||ISNIL(3)) )
  {
    HB_FUNC_EXEC( QDATETIME_NEW3 );
  }
  else if( ISNUMPAR(1) && ISQDATETIME(1) )
  {
    HB_FUNC_EXEC( QDATETIME_NEW4 );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
}

HB_FUNC_STATIC( QDATETIME_DELETE )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,0,0))
  QDateTime * obj = (QDateTime *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    delete obj;
    obj = NULL;
    PHB_ITEM self = hb_stackSelfItem();
    PHB_ITEM ptr = hb_itemPutPtr( NULL, NULL );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
QDateTime addDays ( int ndays ) const
*/
HB_FUNC_STATIC( QDATETIME_ADDDAYS )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QDateTime * ptr = new QDateTime( obj->addDays ( (int) hb_parni(1) ) );
    _qt4xhb_createReturnClass ( ptr, "QDATETIME", true );
  }
}

/*
QDateTime addMSecs ( qint64 msecs ) const
*/
HB_FUNC_STATIC( QDATETIME_ADDMSECS )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QDateTime * ptr = new QDateTime( obj->addMSecs ( (qint64) hb_parni(1) ) );
    _qt4xhb_createReturnClass ( ptr, "QDATETIME", true );
  }
}

/*
QDateTime addMonths ( int nmonths ) const
*/
HB_FUNC_STATIC( QDATETIME_ADDMONTHS )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QDateTime * ptr = new QDateTime( obj->addMonths ( (int) hb_parni(1) ) );
    _qt4xhb_createReturnClass ( ptr, "QDATETIME", true );
  }
}

/*
QDateTime addSecs ( int s ) const
*/
HB_FUNC_STATIC( QDATETIME_ADDSECS )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QDateTime * ptr = new QDateTime( obj->addSecs ( (int) hb_parni(1) ) );
    _qt4xhb_createReturnClass ( ptr, "QDATETIME", true );
  }
}

/*
QDateTime addYears ( int nyears ) const
*/
HB_FUNC_STATIC( QDATETIME_ADDYEARS )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QDateTime * ptr = new QDateTime( obj->addYears ( (int) hb_parni(1) ) );
    _qt4xhb_createReturnClass ( ptr, "QDATETIME", true );
  }
}

/*
QDate date () const
*/
HB_FUNC_STATIC( QDATETIME_DATE )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QDate * ptr = new QDate( obj->date (  ) );
    _qt4xhb_createReturnClass ( ptr, "QDATE", true );
  }
}

/*
int daysTo ( const QDateTime & other ) const
*/
HB_FUNC_STATIC( QDATETIME_DAYSTO )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QDateTime * par1 = (QDateTime *) _qtxhb_itemGetPtr(1);
    hb_retni( obj->daysTo ( *par1 ) );
  }
}

/*
bool isNull () const
*/
HB_FUNC_STATIC( QDATETIME_ISNULL )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    hb_retl( obj->isNull (  ) );
  }
}

/*
bool isValid () const
*/
HB_FUNC_STATIC( QDATETIME_ISVALID )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    hb_retl( obj->isValid (  ) );
  }
}

/*
qint64 msecsTo ( const QDateTime & other ) const
*/
HB_FUNC_STATIC( QDATETIME_MSECSTO )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QDateTime * par1 = (QDateTime *) _qtxhb_itemGetPtr(1);
    hb_retni( obj->msecsTo ( *par1 ) );
  }
}

/*
int secsTo ( const QDateTime & other ) const
*/
HB_FUNC_STATIC( QDATETIME_SECSTO )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QDateTime * par1 = (QDateTime *) _qtxhb_itemGetPtr(1);
    hb_retni( obj->secsTo ( *par1 ) );
  }
}

/*
void setDate ( const QDate & date )
*/
HB_FUNC_STATIC( QDATETIME_SETDATE )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QDate * par1 = (QDate *) _qtxhb_itemGetPtr(1);
    obj->setDate ( *par1 );
  }
  hb_itemReturn( hb_stackSelfItem() );
}

/*
void setMSecsSinceEpoch ( qint64 msecs )
*/
HB_FUNC_STATIC( QDATETIME_SETMSECSSINCEEPOCH )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    obj->setMSecsSinceEpoch ( (qint64) hb_parni(1) );
  }
  hb_itemReturn( hb_stackSelfItem() );
}

/*
void setTime ( const QTime & time )
*/
HB_FUNC_STATIC( QDATETIME_SETTIME )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QTime * par1 = (QTime *) _qtxhb_itemGetPtr(1);
    obj->setTime ( *par1 );
  }
  hb_itemReturn( hb_stackSelfItem() );
}

/*
void setTimeSpec ( Qt::TimeSpec spec )
*/
HB_FUNC_STATIC( QDATETIME_SETTIMESPEC )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    int par1 = hb_parni(1);
    obj->setTimeSpec (  (Qt::TimeSpec) par1 );
  }
  hb_itemReturn( hb_stackSelfItem() );
}

/*
void setTime_t ( uint seconds )
*/
HB_FUNC_STATIC( QDATETIME_SETTIME_T )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    obj->setTime_t ( (uint) hb_parni(1) );
  }
  hb_itemReturn( hb_stackSelfItem() );
}

/*
QTime time () const
*/
HB_FUNC_STATIC( QDATETIME_TIME )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QTime * ptr = new QTime( obj->time (  ) );
    _qt4xhb_createReturnClass ( ptr, "QTIME", true );
  }
}

/*
Qt::TimeSpec timeSpec () const
*/
HB_FUNC_STATIC( QDATETIME_TIMESPEC )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    int i = obj->timeSpec (  );
    hb_retni( i );
  }
}

/*
QDateTime toLocalTime () const
*/
HB_FUNC_STATIC( QDATETIME_TOLOCALTIME )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QDateTime * ptr = new QDateTime( obj->toLocalTime (  ) );
    _qt4xhb_createReturnClass ( ptr, "QDATETIME", true );
  }
}

/*
qint64 toMSecsSinceEpoch () const
*/
HB_FUNC_STATIC( QDATETIME_TOMSECSSINCEEPOCH )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    hb_retni( obj->toMSecsSinceEpoch (  ) );
  }
}

/*
QString toString ( const QString & format ) const
*/
HB_FUNC_STATIC( QDATETIME_TOSTRING1 )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QString par1 = QLatin1String( hb_parc(1) );
    hb_retc( (const char *) obj->toString ( par1 ).toLatin1().data() );
  }
}

/*
QString toString ( Qt::DateFormat format = Qt::TextDate ) const
*/
HB_FUNC_STATIC( QDATETIME_TOSTRING2 )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    int par1 = ISNIL(1)? (int) Qt::TextDate : hb_parni(1);
    hb_retc( (const char *) obj->toString (  (Qt::DateFormat) par1 ).toLatin1().data() );
  }
}

//[1]QString toString ( const QString & format ) const
//[2]QString toString ( Qt::DateFormat format = Qt::TextDate ) const

HB_FUNC_STATIC( QDATETIME_TOSTRING )
{
  if( ISNUMPAR(1) && ISCHAR(1) )
  {
    HB_FUNC_EXEC( QDATETIME_TOSTRING1 );
  }
  else if( ISBETWEEN(0,1) && (ISNUM(1)||ISNIL(1)) )
  {
    HB_FUNC_EXEC( QDATETIME_TOSTRING2 );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
}

/*
QDateTime toTimeSpec ( Qt::TimeSpec specification ) const
*/
HB_FUNC_STATIC( QDATETIME_TOTIMESPEC )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    int par1 = hb_parni(1);
    QDateTime * ptr = new QDateTime( obj->toTimeSpec (  (Qt::TimeSpec) par1 ) );
    _qt4xhb_createReturnClass ( ptr, "QDATETIME", true );
  }
}

/*
uint toTime_t () const
*/
HB_FUNC_STATIC( QDATETIME_TOTIME_T )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    hb_retni( obj->toTime_t (  ) );
  }
}

/*
QDateTime toUTC () const
*/
HB_FUNC_STATIC( QDATETIME_TOUTC )
{
  QDateTime * obj = (QDateTime *) _qtxhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QDateTime * ptr = new QDateTime( obj->toUTC (  ) );
    _qt4xhb_createReturnClass ( ptr, "QDATETIME", true );
  }
}

/*
static QDateTime currentDateTime ()
*/
HB_FUNC_STATIC( QDATETIME_CURRENTDATETIME )
{
  QDateTime * ptr = new QDateTime( QDateTime::currentDateTime (  ) );
  _qt4xhb_createReturnClass ( ptr, "QDATETIME", true );
}

/*
static QDateTime currentDateTimeUtc ()
*/
HB_FUNC_STATIC( QDATETIME_CURRENTDATETIMEUTC )
{
  QDateTime * ptr = new QDateTime( QDateTime::currentDateTimeUtc (  ) );
  _qt4xhb_createReturnClass ( ptr, "QDATETIME", true );
}

/*
static qint64 currentMSecsSinceEpoch ()
*/
HB_FUNC_STATIC( QDATETIME_CURRENTMSECSSINCEEPOCH )
{
  hb_retni( QDateTime::currentMSecsSinceEpoch (  ) );
}

/*
static QDateTime fromMSecsSinceEpoch ( qint64 msecs )
*/
HB_FUNC_STATIC( QDATETIME_FROMMSECSSINCEEPOCH )
{
  QDateTime * ptr = new QDateTime( QDateTime::fromMSecsSinceEpoch ( (qint64) hb_parni(1) ) );
  _qt4xhb_createReturnClass ( ptr, "QDATETIME", true );
}

/*
static QDateTime fromString ( const QString & string, Qt::DateFormat format = Qt::TextDate )
*/
HB_FUNC_STATIC( QDATETIME_FROMSTRING1 )
{
  QString par1 = QLatin1String( hb_parc(1) );
  int par2 = ISNIL(2)? (int) Qt::TextDate : hb_parni(2);
  QDateTime * ptr = new QDateTime( QDateTime::fromString ( par1,  (Qt::DateFormat) par2 ) );
  _qt4xhb_createReturnClass ( ptr, "QDATETIME", true );
}

/*
static QDateTime fromString ( const QString & string, const QString & format )
*/
HB_FUNC_STATIC( QDATETIME_FROMSTRING2 )
{
  QString par1 = QLatin1String( hb_parc(1) );
  QString par2 = QLatin1String( hb_parc(2) );
  QDateTime * ptr = new QDateTime( QDateTime::fromString ( par1, par2 ) );
  _qt4xhb_createReturnClass ( ptr, "QDATETIME", true );
}

//[1]QDateTime fromString ( const QString & string, Qt::DateFormat format = Qt::TextDate )
//[2]QDateTime fromString ( const QString & string, const QString & format )

HB_FUNC_STATIC( QDATETIME_FROMSTRING )
{
  if( ISBETWEEN(1,2) && ISCHAR(1) && (ISNUM(2)||ISNIL(2)) )
  {
    HB_FUNC_EXEC( QDATETIME_FROMSTRING1 );
  }
  else if( ISNUMPAR(2) && ISCHAR(1) && ISCHAR(2) )
  {
    HB_FUNC_EXEC( QDATETIME_FROMSTRING2 );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
}

/*
static QDateTime fromTime_t ( uint seconds )
*/
HB_FUNC_STATIC( QDATETIME_FROMTIME_T )
{
  QDateTime * ptr = new QDateTime( QDateTime::fromTime_t ( (uint) hb_parni(1) ) );
  _qt4xhb_createReturnClass ( ptr, "QDATETIME", true );
}

HB_FUNC_STATIC( QDATETIME_NEWFROM )
{
  PHB_ITEM self = hb_stackSelfItem();
  if( hb_pcount() == 1 && ISOBJECT(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_objSendMsg( hb_param(1, HB_IT_OBJECT ), "POINTER", 0 ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  else if( hb_pcount() == 1 && ISPOINTER(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_param(1, HB_IT_POINTER ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  hb_itemReturn( self );
}

HB_FUNC_STATIC( QDATETIME_NEWFROMOBJECT )
{
  //PHB_ITEM self = hb_stackSelfItem();
  //if( hb_pcount() == 1 && ISOBJECT(1) )
  //{
  //  PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_objSendMsg( hb_param(1, HB_IT_OBJECT ), "POINTER", 0 ) ) );
  //  hb_objSendMsg( self, "_pointer", 1, ptr );
  //  hb_itemRelease( ptr );
  //  PHB_ITEM des = hb_itemPutL( NULL, false );
  //  hb_objSendMsg( self, "_self_destruction", 1, des );
  //  hb_itemRelease( des );
  //}
  //hb_itemReturn( self );
  HB_FUNC_EXEC( QDATETIME_NEWFROM );
}

HB_FUNC_STATIC( QDATETIME_NEWFROMPOINTER )
{
  //PHB_ITEM self = hb_stackSelfItem();
  //if( hb_pcount() == 1 && ISPOINTER(1) )
  //{
  //  PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_param(1, HB_IT_POINTER ) ) );
  //  hb_objSendMsg( self, "_pointer", 1, ptr );
  //  hb_itemRelease( ptr );
  //  PHB_ITEM des = hb_itemPutL( NULL, false );
  //  hb_objSendMsg( self, "_self_destruction", 1, des );
  //  hb_itemRelease( des );
  //}
  //hb_itemReturn( self );
  HB_FUNC_EXEC( QDATETIME_NEWFROM );
}

HB_FUNC_STATIC( QDATETIME_SELFDESTRUCTION )
{
  hb_retl( (bool) hb_itemGetL( hb_objSendMsg( hb_stackSelfItem(), "SELF_DESTRUCTION", 0 ) ) );
}

HB_FUNC_STATIC( QDATETIME_SETSELFDESTRUCTION )
{
  PHB_ITEM self = hb_stackSelfItem();
  if( hb_pcount() == 1 && ISLOG(1) )
  {
    PHB_ITEM des = hb_itemPutL( NULL, hb_parl(1) );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  hb_itemReturn( self );
}

#pragma ENDDUMP

error: pathspec 'source/QtCore/QDateTime.prg' did not match any file(s) known to git


start with this

start with this

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

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)

error: pathspec 'tests/TwoLevelKinds.prg' did not match any file(s) known to git


New test case

New test case

error: pathspec 'src/test/resources/prg/castle.prg' did not match any file(s) known to git


New example show use GtkSourceView

New example show use GtkSourceView

/*
  Show use GtkViewSource in Harbour using library HBGI
  2016 Rafa Carmona
*/

#define TRUE  .T.
#define FALSE .F.

MEMVAR gtk, gtkSource, gLib, WebKit

INIT PROCEDURE my_init()

   PUBLIC gtk := hbgi_import( "Gtk" )
   PUBLIC gtkSource := hbgi_import("GtkSource")

   RETURN

FUNCTION Main()

   LOCAL win, button, box, scroll, sourceview, statusbar, contextid

   gtk:init( hb_AParams() )

   /* Create window */
   win := gtk:Window:new( gtk:WindowType:TOPLEVEL )

   /* Add Title at the window */
   win:set_title( "Harbour HBGI with WebKit" )

   /* Center Position window */
   win:set_position( gtk:WindowPosition:CENTER )

   /* Size by Default*/
   win:set_default_size( 800, 600 )

   /* Connect event delete-event for destroy window */
   win:connect( 'delete-event', {|| gtk:main_quit() } )

   /* Create Box vertical  */
   box := gtk:vbox:new( .F., 0 )

   /* Box add at Window */
   win:add( box )

   /* Create scroll*/
   scroll := gtk:scrolledWindow:New( NIL, NIL )

   /* Border 10*/
   scroll:set_border_width( 10 )

   /* Show ALWAYS scrollbar*/
   scroll:set_policy( gtk:PolicyType:AUTOMATIC, Gtk:PolicyType:ALWAYS )

   /* Add scroll at box*/
   box:add( scroll )

   /* Create Widget GVtkViewSource */
   sourceview := gtkSource:View:New()

   /*Show line numbers */
   sourceview:set_show_line_numbers(.t.)

   /*Set highlight current line*/
   sourceview:set_highlight_current_line( TRUE )

   /*Add sourceview at scroll */
   scroll:add( sourceview )

   /* Simple button , connect event clicked, exit app */
   button := gtk:button:new_with_label( "Exit" )
   button:connect( 'clicked', {|| gtk:main_quit() } )
   box:pack_start( button, FALSE, FALSE, 0 )

   /* Status Bar*/
   statusbar := gtk:statusbar:new()
   box:pack_end( statusbar, FALSE, TRUE, 0 )

   /*Push message in StatusBar*/
   contextid := statusbar:get_context_id( "Statusbar example" )
   statusbar:push( contextid, "GtkViewSource example running with HBGI (c)2016 Rafa Carmona" )

   /* Show ALL widgets */
   win:show_all()

   /* Here, loop main events of GTK*/
   gtk:Main()
   win := NIL
   button := NIL
   sourceview := NIL
   scroll := NIL

   RETURN 0

error: pathspec 'demo/sourceview.prg' did not match any file(s) known to git


KApplication: class updated

KApplication: class updated

- method new1 removed
- formatting

Modified:
source/KDEUI/KApplicationClass.prg

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/marcosgambeta/KDE4xHb.git/'


colocado foto na atualizadao do fle

colocado foto na atualizadao do fle

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/alvarocneto/prestconthack.git/'


[VOXporter] Suppress compiler warning

[VOXporter] Suppress compiler warning

error: pathspec 'Tools/VOXporter/Source/Fab_VO_Entities/MEF' did not match any file(s) known to git
error: pathspec 'File.prg' did not match any file(s) known to git


added new example clipboard.prg

added new example clipboard.prg

/*

  Qt5xHb Project - Example Program

  Copyright (C) 2012-2017 Marcos Antonio Gambeta

  E-mail:
  marcosgambeta AT outlook DOT com
  marcosgambeta AT gmail DOT com

  Website:
  https://github.com/marcosgambeta/Qt5xHb

  Users Groups:
  https://groups.google.com/forum/?hl=pt-BR#!forum/qtxhb    [ENGLISH]
  https://groups.google.com/forum/?hl=pt-BR#!forum/qtxhb-br [PORTUGUESE]

*/

#include "qt5xhb.ch"

PROCEDURE Main ()

   LOCAL oApp
   LOCAL oWindow
   LOCAL oLineEdit1
   LOCAL oLineEdit2
   LOCAL oPushButtonCopy
   LOCAL oPushButtonPaste
   LOCAL oClipboard

   oApp := QApplication():new()

   oWindow := QWidget():new():setWindowTitle("Exemplo de uso do objeto QClipboard"):resize(640,480)

   oLineEdit1 := QLineEdit():new(oWindow):move(20,20):setText("teste")

   oPushButtonCopy := QPushButton():new("Copiar",oWindow):move(20,120)

   oLineEdit2 := QLineEdit():new(oWindow):move(20,220)

   oPushButtonPaste := QPushButton():new("Colar",oWindow):move(20,320)

   // Obtm o objeto QClipboard.
   oClipboard := oApp:clipboard()

   // Quando clicado, copia o texto do QLineEdit1 para o clipboard.
   // O texto  copiado para o clipboard atravs do mtodo 'setText'.
   oPushButtonCopy:onClicked({||oClipboard:setText(oLineEdit1:text())})

   // Quando clicado, copia o texto do clipboard para o QLineEdit2.
   // O texto  copiado do clipboard atravs do mtodo 'text'.
   oPushButtonPaste:onClicked({||oLineEdit2:setText(oClipboard:text())})

   // avisa se o dados no clipboard foram modificados
   oClipboard:onDataChanged({||qout("os dados no clipboard foram alterados"),qout("conteudo atual="+oClipboard:text())})

   oWindow:show()

   oApp:exec()

   oWindow:delete()

   oApp:delete()

RETURN

error: pathspec 'examples/clipboard.prg' did not match any file(s) known to git


example USA program

example USA program

# july 4th, memorial day, presidents' day, etc.
STEP 255 0 0 1000
STEP 200 200 200 1000
STEP 0 0 255 1000
STEP 0 0 0 3000

error: pathspec 'programs/red_white_blue.prg' did not match any file(s) known to git


St. Patricks day program introduced

St. Patricks day program introduced

error: pathspec 'programs/paddy_day.prg' did not match any file(s) known to git


KAction: class updated

KAction: class updated

- methods new1, new2 and new3 removed
- methods setShortcut1 and setShortcut2 removed
- formatting

Modified:
source/KDEUI/KActionClass.prg


64-bit variant

64-bit variant

import "../src/LangPrelude.prg"

data Mark = FullStop | Stop | Digit Bool

data Way = Arrived | Step Mark Way deriving List(w)

etalon = "1s100000s11010s10100s1111s1010s110s11s1S"

w1 = [FullStop]w
w2 = [Digit True, FullStop]w
w3 = [Stop, Digit True, FullStop]w

countSteps (way@[_;_]w) = howmanysteps 0 way

howmanysteps :: Int -> Way -> Int
howmanysteps 0 []w = 0
howmanysteps corr [FullStop]w = corr + 1
howmanysteps corr [Stop, Digit True; way]w = pickupMarks (trace ("corr: "++show corr) corr + 2) way 1
  where pickupMarks corr [FullStop]w acc = corr + acc
        pickupMarks corr [Stop; _]w acc = trace (show corr) corr + acc
        pickupMarks corr [Digit False; more]w acc = pickupMarks (corr + 1) more $ acc + acc
        pickupMarks corr [Digit True; more]w acc = pickupMarks (corr + 1) more $ acc + acc + 1
howmanysteps corr [Digit _; more]w = howmanysteps (corr + 1) more

l2w = foldr (Step . c2m) Arrived
  where c2m 'S' = FullStop
        c2m 's' = Stop
        c2m '0' = Digit False
        c2m '1' = Digit True

foldw :: (Mark -> b -> b) -> b -> Way -> b
foldw _ b []w = b
foldw f b [m; ms]w = f m $ foldw f b ms

w2l = foldw ((:) . m2c) []
  where m2c FullStop = 'S'
        m2c Stop = 's'
        m2c (Digit False) = '0'
        m2c (Digit True) = '1'

etalon' = l2w etalon

countAlongTheWay = foldw tupled (0,[(0,[]w)])
  where tupled m (c, l@[(_,w);_]) = (countSteps [m;w]w, (countSteps [m;w]w,[m;w]w) : l)

error: pathspec 'tests/WayMarking64.prg' did not match any file(s) known to git


Working on LabelExpWithTerminationWitness.prg

--------------------------------------------------------
-- Stages (depth or size of inductively defined data)

data Stage:: Tag ~> *1 where
  V:: Tag ~> Stage t
  N:: Stage t ~> Stage t
  Inf:: Stage t

data Stage':: Stage n ~> *0 where
  V:: Label n -> Stage' (V n)
  N :: Stage' s -> Stage' (N s)
  Inf :: Stage' Inf

----------------------------------------------------
-- Types and Type Indexes
-- (Types are singletons) and Environments

data TypeIndex:: *1 where
  VarT :: Tag ~> TypeIndex
  NatT :: Stage n ~> TypeIndex
  ListT :: Stage n ~> TypeIndex ~> TypeIndex
  ArrT :: TypeIndex ~> TypeIndex ~> TypeIndex

data Typ :: TypeIndex ~> *0 where
  VarT :: Label n -> Typ (VarT n)
  NatT :: Stage' s -> Typ (NatT s)
  List :: Stage' s -> Typ t -> Typ (ListT s t)
  ArrT :: Typ t -> Typ u -> Typ (ArrT t u)

data Env:: *2 where
  Closed :: Env
  ConsEnv :: Tag ~> TypeIndex ~> Env ~> Env
 deriving Record(e)

------------------------------------------------
-- Semantic Equality Witness for Stages

data StageEQ :: Stage s ~> Stage s ~> *0 where
  StEq :: StageEQ s s
  StStep :: StageEQ s1 s2 -> StageEQ (N s1) (N s2)
  StTrans :: StageEQ s1 s2 -> StageEQ s2 s3 -> StageEQ s1 s3
  StSymm :: StageEQ s1 s2 -> StageEQ s2 s1
  StInf :: StageEQ s Inf -> StageEQ (N s) Inf
           -- Here is where semantic equality differs from syntactic equality

------------------------------------------------
-- Less Than or Equal Witness for Stages

data LeqSt:: Stage a ~> Stage b ~> *0 where
  Same :: LeqSt x x
  Reach :: LeqSt x y -> LeqSt x (N y)
  All :: LeqSt x Inf
  Both :: LeqSt x y -> LeqSt (N x) (N y)

-- Equal Witness for TypeIndex

data LeqTy :: TypeIndex ~> TypeIndex ~> *0 where
  EqTy :: LeqTy t t
  LeqTy0 :: LeqSt i j -> LeqTy (NatT i) (NatT j)
  LeqTy1s :: LeqSt i j -> LeqTy (ListT i x) (ListT j x)
  LeqTy1t :: LeqTy a b -> LeqTy (ListT i a) (ListT i b)
  LeqTyArr :: LeqTy t' t -> LeqTy u u' -> LeqTy (ArrT t u) (ArrT t' u')

------------------------------------------------
-- Does a Stage Variable Occur in a TypeIndex?

data AppearsPos :: Tag ~> TypeIndex ~> *0 where
  SPVar :: AppearsPos i (VarT x)
  SPArr :: AppearsNeg i t -> AppearsPos i u -> AppearsPos i (ArrT t u)
  SPNat :: AppearsPos i (NatT s)
  SPList :: AppearsPos i t -> AppearsPos i (ListT s t)

data AppearsNeg :: Tag ~> TypeIndex ~> *0 where
  SN1 :: AppearsNeg i (VarT x)
  SN2 :: AppearsPos i t -> AppearsNeg i u -> AppearsNeg i (ArrT t u)
  SNNat :: NoOcc i s -> AppearsNeg i (NatT s)
  SNList :: NoOcc i s -> AppearsNeg i t -> AppearsNeg i (ListT s t)

-- no occurrences of stage variable names in a type

data NoOcc :: Tag ~> Stage y ~> *0 where
  NoOccV :: DiffLabel i j -> NoOcc i (V j)
  NoOccN :: NoOcc i s -> NoOcc i (N s)
  NoOccInf :: NoOcc i Inf

--------------------------------------------------
-- Relations that stages and type indexes are related
-- by substitution of stage variables

data SubsSt:: Tag ~> Stage a ~> Stage b ~> Stage c ~> *0 where
  Sub0 :: NoOcc x a -> StageEQ a b -> SubsSt x y a b
  SubV :: SubsSt x y (V x) y
  SubN :: SubsSt x y a b -> SubsSt x y (N a) (N b)

data SubsTy :: Tag ~> Stage a ~> TypeIndex ~> TypeIndex ~> *0 where
  SubVar :: SubsTy n s (VarT x) (VarT x)
  SubTC0 :: SubsSt n s s1 s2 -> SubsTy n s (NatT s1) (NatT s2)
  SubTC1 :: SubsSt n s s1 s2
         -> SubsTy n s t1 t2 -> SubsTy n s (ListT s1 t1) (ListT s2 t2)
  SubArr :: SubsTy n s t1 t2 -> SubsTy n s u1 u2
         -> SubsTy n s (ArrT t1 u1) (ArrT t2 u2)

------------------------------------------------------------
-- Abstract syntax for patterns, case arms, and terms

data Pat:: Env ~> Env ~> TypeIndex ~> *0 where -- Inf problem? don't have coerce
  Wp :: Pat e e t
  Vp :: Label n -> Pat e (ConsEnv n t e) t
  Zp :: Pat e e (NatT (N x))
  Sp :: Pat e f (NatT x) -> Pat e f (NatT (N x))
  NilP :: Pat e e (ListT (N x) a)
  ConsP :: Pat e f a -> Pat f g (ListT x a) -> Pat e g (ListT (N x) a)
  CastP :: Pat e1 e2 a -> LeqTy b a -> Pat e1 e2 b
           -- OK for patterns to match smaller things when needed

data Arms:: Env ~> TypeIndex ~> TypeIndex ~> *0  where
  NilArm :: Arms e x y
  ConsArm:: Pat e1 e2 x -> Exp e2 y -> Arms e1 x y -> Arms e1 x y
 deriving Record(a)

data Exp:: Env ~> TypeIndex ~> *0 where
  Ze :: Exp env (NatT (N s))
  Se :: Exp env (NatT s) -> Exp env (NatT (N s))
  NilE :: Exp env (ListT (N s) a)
  ConsE :: Exp env a -> Exp env (ListT s a) -> Exp env (ListT (N s) a)

  App :: Exp env (ArrT s t) -> Exp env s -> Exp env t

  Var :: Label s -> Exp {s=t; env}e t
  Sh :: Exp env t -> Exp {s=q;env}e t
  Fn :: Arms e s t -> Exp e (ArrT s t)

  Fix0 :: Exp {f=ArrT (tc (V i)) a; env}e (ArrT (tc (N (V i))) b)
       -> SubsTy i (N (V i)) a b -> SubsTy i s a c -> AppearsPos i a
       -> Exp env (ArrT (tc s) c)

  Fix1 :: Exp {f=ArrT (tc (V i) t) a; env}e (ArrT (tc (N (V i)) t) b)
       -> SubsTy i (N (V i)) a b -> SubsTy i s a c -> AppearsPos i a
       -> Exp env (ArrT (tc s t) c)
  Coerce:: LeqTy a b -> Exp env a -> Exp env b

------------------------------------------------
-- Examples

v0 x = Var x
v1 x = Sh (v0 x)
v2 x = Sh (v1 x)
v3 x = Sh (v2 x)
v4 x = Sh (v3 x)

-- shorthands

ap = App

caseE e alts = Fn alts `ap` e

lamE x e = Fn {Vp x=e}a

eqInf0 :: SubsSt a b Inf Inf
eqInf0 = Sub0 NoOccInf StEq -- e.g., (Nat Inf) is equal to (Nat Inf)

-----------------------------------------------
-- Small Programs

-- copy = Fix copy (\ Z -> Z | (S m) -> S (copy m))
copy = Fix0 (Fn { Zp = Ze
                , Sp (Vp `m) = Se (v1 `copy `ap` v0 `m) }a)
            p1 p1 p3
  where p1 = (SubTC0 SubV)
        p3 = SPNat

---------------------------------------------
-- mymap = \ f -> Fix map (\ Nil -> Nil
--                         | Cons x xs -> Cons (f x) (map xs))
mymap = lamE `f $
          Fix1 (Fn { NilP = NilE
                   , ConsP (Vp `x) (Vp `xs) = ConsE (v3 `f `ap` v1 `x)
                                                    (v2 `map `ap` v0 `xs)
                   }a) p1 p2 p3
  where p1 = (SubTC1 SubV SubVar)
        p2 = (SubTC1 SubV SubVar)
        p3 = (SPList SPVar)

------------------------------------
-- half = Fix half (\ Z -> Z
--                  | (S Z) -> Z
--                  | (S (S n)) -> half n))

body4a = Fn{ Zp              = Ze
          , Sp Zp           = Ze
          , Sp (Sp (Vp `n)) = Se(ap (v1 `half) (v0 `n))
          }a

body4b = Coerce (LeqTyArr (LeqTy0 (Reach Same)) EqTy) body4a

body4c= Fn{ Zp         = Ze
          , Sp (Vp `m) = caseE (Coerce (LeqTy0 (Reach Same)) (v0 `m))
                             { Zp          = Ze
                             , Sp (Vp `n) = Se (v2 `half `ap` v0 `n)
                             }a
          }a

body4d = Fn{ Zp                         = Ze
           , CastP (Sp Zp) p1           = Ze
           , CastP (Sp (Sp (Vp `n))) p1 = Se(ap (v1 `half) (v0 `n))
           }a
  where p1 = LeqTy0 (Reach Same)

showSameType = [body4b, body4c, body4d]

half = Fix0 body4c p1 p2 p3
  where p1 = (SubTC0 SubV)
        p2 = (SubTC0 SubV)
        p3 = SPNat

-------------------------------------------
-- double = Fix double (\ Z -> Z
--                      | (S n) -> S (S (double n)))

body5 = Fn { Zp         = Ze
           , Sp (Vp `x) = Se (Se (v1 `double `ap` v0 `x))
           }a

double = Fix0 (Coerce (EqTy `LeqTyArr` LeqTy0 All) body5) p1 p2 p3
   where p1 = (SubTC0 eqInf0)
         p2 = (SubTC0 eqInf0)
         p3 = SPNat

--------------------------------------------
-- plus = Fix plus (\ Z -> (\ y -> y)
--                  | (S x) -> \ y -> S(plus x y))

body6 = Fn { Zp         = lamE `y (v0 `y)
           , Sp (Vp `x) = lamE `y (Coerce (LeqTy0 All)
                                          (Se (v2 `plus `ap` v1 `x `ap` v0 `y)))
           }a

plus = Fix0 body6 p1 p2 p3
  where p1 = (SubArr (SubTC0 eqInf0) (SubTC0 eqInf0))
        p2 = (SubArr (SubTC0 eqInf0) (SubTC0 eqInf0))
        p3 = (SPArr (SNNat NoOccInf) SPNat)

------------------------------------------------
-- plus' = Fix plus (\ x y -> case x of
--                              Z -> y
--                              (S z) -> S(plus z y))

body6' = lamE `x $ lamE `y $
  caseE (v1 `x)
      { Zp         = Coerce (LeqTy0 All) $ v0 `y
      , Sp (Vp `z) = Coerce (LeqTy0 All) $ Se (v3 `plus' `ap` v0 `z `ap` v1 `y)
      }a

plus' = Fix0 body6' p1 p2 p3
  where p1 = (SubArr (SubTC0 eqInf0) (SubTC0 eqInf0))
        p2 = (SubArr (SubTC0 eqInf0) (SubTC0 eqInf0))
        p3 = (SPArr (SNNat NoOccInf) SPNat)

-----------------------------------------------------
-- append = Fix append (\ Nil -> (\ ys -> ys)
--                      | (Cons x xs) -> (\ ys -> Cons x (append xs ys)))

body7 = Fn { NilP = lamE `ys (v0 `ys)
           , ConsP (Vp `x) (Vp `xs)
                  = lamE `ys (Coerce (LeqTy1s All)
                                     (ConsE (v2 `x) (v3 `append `ap` v1 `xs `ap` v0 `ys)))
           }a

append = Fix1 body7 p1 p2 p3
  where p1 = (SubArr (SubTC1 eqInf0 SubVar) (SubTC1 eqInf0 SubVar))
        p2 = (SubArr (SubTC1 eqInf0 SubVar) (SubTC1 eqInf0 SubVar))
        p3 = (SPArr (SNList NoOccInf SN1) (SPList SPVar))

----------------------------------------------------
-- length = Fix length (\ Nil -> Z
--                      | (Cons x xs) -> S(length xs)

body9 = Fn { NilP                  = Ze
           , ConsP (Vp `x) (Vp `xs) = Se (v2 `length `ap` v0 `xs)
           }a

length = Fix1 body9 p1 p2 p3
  where p1 = (SubTC0 SubV)
        p2 = (SubTC0 SubV)
        p3 = SPNat

----------------------------------------
-- minus = Fix minus
--             (\ x y -> case x of
--                         Z -> x
--                        (S n) -> case y of
--                                   Z -> x
--                                   (S m) -> minus n m)

body10 = lamE `x $ lamE `y $
  caseE (v1 `x)
      { Zp         = v1 `x
      , Sp (Vp `n) = caseE (v1 `y)
                          { Zp         = v2 `x
                          , Sp (Vp `m) = Coerce (LeqTy0 (Reach Same))
                                                (v4 `minus `ap` v1 `n `ap` v0 `m)
                          }a
      }a

minus = Fix0 body10
      (SubArr (SubTC0 (Sub0 NoOccInf (StSymm $ StInf StEq))) (SubTC0 SubV))
      (SubArr (SubTC0 (Sub0 NoOccInf (StSymm $ StInf StEq))) (SubTC0 SubV))
      (SNNat NoOccInf `SPArr` SPNat)

minusCoerced = Coerce (EqTy `LeqTyArr` ( (LeqTy0 (Reach Same)) `LeqTyArr` EqTy)) minus

-- Alternate minus

body10' =
  Coerce (EqTy `LeqTyArr` ((LeqTy0 (Reach Same)) `LeqTyArr` EqTy))
         (Fn { Zp         = Fn { Vp `m      = Ze }a
             , Sp (Vp `n) = Fn { Zp         = Se (v0 `n)
                               , Sp (Vp `m) = Coerce (LeqTy0 (Reach Same))
                                                     (v2 `minus `ap` v1 `n `ap` v0 `m)
                               }a
             }a)

minus' = Fix0 body10' p1 p2 p3
  where p1 = (SubArr (SubTC0 eqInf0) (SubTC0 SubV))
        p2 = (SubArr (SubTC0 eqInf0) (SubTC0 SubV))
        p3 = (SNNat NoOccInf `SPArr` SPNat)

---------------------------------------------
-- divide = Fix divide (\ Z -> (\ m -> Z)
--                      | (S n) -> (\ m -> S(divide (minus n m)  m)))

body11 =
  Fn { Zp         = lamE `m Ze
     , Sp (Vp `n) = lamE `m $
                      Se (v2 `dv `ap` (minus' `ap` v1 `n `ap` v0 `m) `ap` v0 `m)
     }a

divide = Fix0 body11 p1 p2 p3
  where p1 = (SubArr (SubTC0 eqInf0) (SubTC0 SubV))
        p2 = (SubArr (SubTC0 eqInf0) (SubTC0 SubV))
        p3 = (SPArr (SNNat NoOccInf) SPNat)

-----------------------------------------------------
-- ack =
--   Fix ack
--       (\ Z -> (\ m -> m)
--        | (S n) -> Fix ack_x (\ Z -> ack n (S Z)
--                              | (S m) -> ack n (ack_x m)))

body12 = Fn { Zp         = lamE `m (v0 `m)
            , Sp (Vp `n) = Fix0 body13 (SubTC0 eqInf0) (SubTC0 eqInf0) SPNat
            }a

-- body13 in the context of second arm of body12
-- we use names 3m for ack and 4m for ack_x

body13 =
  Fn { Zp         = v2 `ack `ap` v1 `n `ap` Coerce (LeqTy0 All) (Se Ze)
     , Sp (Vp `m) = v3 `ack `ap` v2 `n `ap` Coerce (LeqTy0 All) (v1 `ack_x `ap` v0 `m)
     }a

ack = Fix0 body12 p1 p2 p3
  where p1 = (SubArr (SubTC0 eqInf0) (SubTC0 eqInf0))
        p2 = (SubArr (SubTC0 eqInf0) (SubTC0 eqInf0))
        p3 = (SPArr (SNNat NoOccInf) SPNat)

-------------------------------------------------------------
-- weird1 = Fix weird1 (\ Z -> Z
--                      | (S n) -> S(weird1 (copy n)))
-- works because copy is size preserving!!

body14 = Fn { Zp = Ze
            , Sp (Vp `n) = Se (v1 `weird1 `ap` (copy `ap` v0 `n)) }a

body14b = Fn { Zp = Ze -- This is the constant zero function
            , Sp (Vp `n) = Coerce (LeqTy0 (Reach Same))
                                  (v1 `weird1 `ap` (copy `ap` v0 `n)) }a

sameType14 = [body14, body14b]

weird1 = Fix0 body14 (SubTC0 SubV) (SubTC0 SubV) SPNat

error: pathspec 'work/LabelExpsWithTerminationWitnesses.prg' did not match any file(s) known to git


monotone increasing naturals

monotone increasing naturals

import "../tests/NatList.prg"

prop LE :: Nat ~> Nat ~> * where
  Klar :: LE Z x
  Schritt :: LE m n -> LE (S m) (S n)

-- proposition whether we can join a Nat with an already strictly monotone inventory
--
prop LEInv :: Inventory Nat ~> Nat ~> * where
  Egal :: LEInv []i n
  Laenger :: LE (S m) n -> LEInv inv m -> LEInv [inv; m]i n

-- value-level data types
--
data AscendingNats :: Inventory Nat ~> * where
  EmptyNats :: AscendingNats  []i
  MoreNats :: LEInv inv n => AscendingNats inv -> Nat' n -> AscendingNats [inv; n]i
 deriving LeftList(an)

-- merging of AscendingNats
--
mergeAscending :: AscendingNats linv -> AscendingNats rinv -> Maybe (AscendingNats {merge linv rinv})
mergeAscending []an r = Just r
mergeAscending (l@[lrest; ltop]an) []an = Just l
mergeAscending (linv@[lrest; ltop]an) (rinv@[rrest; rtop]an) = merge' ltop rtop linv rinv
  where merge' :: Nat' l -> Nat' r -> AscendingNats linv -> AscendingNats rinv
                         -> Maybe (AscendingNats {arrange l r linv rinv})
        merge' 0v (1+_)v (linv@[lrest; ltop]an) [rrest; rtop]an = do llr <- mergeAscending linv rrest
                                                                     lei <- tryLEInv llr rtop
                                                                     return [llr; rtop]an
        merge' (1+_)v 0v [lrest; ltop]an (rinv@[rrest; rtop]an) = do lrr <- mergeAscending lrest rinv
                                                                     lei <- tryLEInv lrr ltop
                                                                     return [lrr; ltop]an
        merge' (1+l)v (1+r)v linv rinv = merge' l r linv rinv
        merge' _ _ _ _ = Nothing

mergeAscending _ _ = Nothing

tryLE :: Nat' a -> Nat' b -> Maybe (LE a b)
tryLE 0v b = Just Klar
tryLE (1+a)v 0v = Nothing
tryLE (1+a)v (1+b)v = do { le <- tryLE a b; return (Schritt le) }

tryLEInv :: AscendingNats i -> Nat' b -> Maybe (LEInv i b)
tryLEInv []an b = Just Egal
tryLEInv [rest; a]an b = do le <- tryLE (S a) b
                            lei <- tryLEInv rest a
                            return (Laenger le lei)

error: pathspec 'tests/Ascending.prg' did not match any file(s) known to git


concept of a strictly scoped calculus where
   * lambdas and 'let' introduce names
   * variables are deBruijn indices

this is an untyped variant

import "Inventory.prg"

data Tm :: Inventory Tag ~> * where
  -- lambda
  Lm :: Label t -> Tm [inv; t]i -> Tm inv
  -- argument access
  Arg :: Tm [ups; t]i
  Up :: Tm [ups; t]i -> Tm [ups; t, t']i
  -- application
  App :: Tm inv -> Tm inv -> Tm inv
  -- recursive let
  Let :: Label t -> Tm [inv; t]i ->  Tm [inv; t]i -> Tm inv
 deriving syntax (tm) Nat(Arg, Up) LeftPair(App)

-- identity function
--
id :: Tm []i
id = Lm `a 0tm

-- ($) = \f . \a . f a
--
dollar :: Tm []i
dollar = Lm `f (Lm `a (1tm, 0tm)tm)

-- let a = a in a
leta :: Tm []i
leta = Let `a 0tm 0tm

error: pathspec 'tests/LabeledDeBruijn.prg' did not match any file(s) known to git


delete unused file

delete unused file

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/djinn-games/djinn-parser.git/'


Stringモジュールを追加した

Stringモジュールを追加した

' String

def gsub$(string$, pattern$, replacement$)
end

def upcase$(string$)
end

def downcase$(string$)
end

def insert$(string$, index, otherStr$)
end

error: pathspec 'string.prg' did not match any file(s) known to git


tests/resizeevent.prg: new test

tests/resizeevent.prg: new test

Added:
tests/resizeevent.prg

/*

  Qt4xHb Project - Test Program

  Copyright (C) 2018 Marcos Antonio Gambeta

  E-mail:
  marcosgambeta AT outlook DOT com

  Website:
  https://github.com/marcosgambeta/Qt4xHb

*/

#include "qt4xhb.ch"

PROCEDURE Main ()

   LOCAL oApp
   LOCAL oWindow
   LOCAL oLabelWidth
   LOCAL oLabelHeight

   oApp := QApplication():new()

   oWindow := QWidget():new():setWindowTitle("Teste do evento resize"):resize(640,480)

   oLabelWidth := QLabel():new("0",oWindow):move(20,20):resize(100,30)
   oLabelHeight := QLabel():new("0",oWindow):move(20,80):resize(100,30)

   oWindow:onResizeEvent({|oSender,oResizeEvent|
      oLabelWidth:setText( alltrim(str(oResizeEvent:size():width())) )
      oLabelHeight:setText( alltrim(str(oResizeEvent:size():height())) )
      })

   oWindow:show()

   oApp:exec()

   oWindow:delete()

   oApp:delete()

RETURN

error: pathspec 'tests/resizeevent.prg' did not match any file(s) known to git


Implemented VFP SCATTER and GATHER udc functions #X-Sharp/XSharpPublic/issues/387

//
// 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.
//

// Support functions for the GATHER and SCATTER UDCs
//SCATTER [FIELDS] [FieldNameList | LIKE Skeleton
//   | EXCEPT Skeleton] [MEMO] [BLANK]
//   TO ArrayName | TO ArrayName | MEMVAR
//   | NAME ObjectName [ADDITIVE]

// GATHER FROM ArrayName | MEMVAR | NAME ObjectName
//     [FIELDS] FieldList | LIKE Skeleton | EXCEPT Skeleton]
//   [MEMO]

// APPEND FROM ARRAY ArrayName [FOR lExpression]
// [FIELDS] FieldList | LIKE Skeleton | EXCEPT Skeleton

// THere are several variations of these commands:
// 1) Explicit fields list
// 2) Skeleton of fields to be INcluded
// 3) Skeleton of fields to be EXcluded
// 4) no fields
// 5) MEMO clause which includes MEMO fields in the gather/scatter
// Note that LIKE and EXCEPT can be combined
// APPEND FROM ARRAY aMyArray FIELDS LIKE A*,P* EXCEPT PARTNO*
// SCATTER FIELDS LIKE A*,P* EXCEPT PARTNO* TO myArray

// so the recommented parameters are:
//  1) List of field names
//  2) Include Skeleton
//  3) Exclude Skeleton
//  4) IncludeMemo

// The targets/source  of the Scatter/Gather can be:
//  1) Array
//  2) MemVar
//  3) Object (Add Property). Creates a new object with Scatter.
//  SCATTER NAME oTest BLANK gets translated to something like oTest := __ScatterObject(...)

USING System.Collections.Generic
USING System.Diagnostics
USING System.Reflection

[DebuggerDisplay("{Name,nq}={Value}")];
    INTERNAL STRUCTURE NameValuePair
INTERNAL Name  as STRING
    INTERNAL Value AS USUAL
END STRUCTURE

INTERNAL FUNCTION __GetFieldValues(cFieldList AS STRING, cIncludedFields AS STRING, ;
    cExcludedFields AS STRING, lIncludeMemo AS LOGIC, lBlank AS LOGIC) AS NameValuePair[]
    var fields :=  __BuildFieldList(cFieldList, cIncludedFields, cExcludedFields, lIncludeMemo)
    var values := List<NameValuePair>{}
    FOREACH var cName in fields
        VAR uValue := __FieldGet(cName)
        if lBlank
            uValue := EmptyUsual(UsualType(uValue))
        endif
        values:Add( NameValuePair{} {Name := cName, Value := uValue})
    NEXT
RETURN values:ToArray()

INTERNAL FUNCTION __GetAllElements(cSource as STRING) AS STRING[]
    cSource := cSource:ToUpperInvariant()
RETURN cSource:Split(<Char>{c' ',c',',c'\t'}, StringSplitOptions.RemoveEmptyEntries)
INTERNAL FUNCTION __BuildFieldList(cFieldList AS STRING, cIncludedFields AS STRING, cExcludedFields AS STRING, lIncludeMemo AS LOGIC) AS IList<String>
    VAR allfields := List<string>{}	// Contains all fields in UPPER case
    VAR selected := List<string>{}
    LOCAL lAll as LOGIC
    lAll := String.IsNullOrEmpty(cFieldList) .and. String.IsNullOrEmpty(cIncludedFields)
    LOCAL fCount as DWORD
    fCount := FCount()
    FOR VAR nFld := 1u to fCount
        LOCAL lInclude AS LOGIC
        LOCAL cType := NIL as USUAL
        VoDb.FieldInfo(DBS_TYPE, nFld,@cType)
        SWITCH (STRING) cType
            CASE "M"
                lInclude := lIncludeMemo
            CASE "G"
                lInclude := FALSE
            OTHERWISE
                lInclude := TRUE
        END SWITCH
        IF lInclude
            allfields:Add(VoDb.FieldName(nFld):ToUpperInvariant())
        ENDIF
    NEXT
    IF lAll
        selected:AddRange(allfields)
    ELSEIF ! String.IsNullOrEmpty(cFieldList)
        cFieldList := cFieldList:ToUpperInvariant()
        IF cFieldList:Contains(",")
                var tokens := cFieldList:Split(<char>{c','}, StringSplitOptions.RemoveEmptyEntries)
                foreach var token in tokens
                    selected:Add(token:Trim())
            next
        ELSE
            selected:Add(cFieldList)
        ENDIF
    ENDIF
    IF ! String.IsNullOrEmpty(cIncludedFields)
        VAR aElements := __GetAllElements(cIncludedFields)
        FOREACH VAR cElement IN aElements
            FOREACH VAR cField in allfields
                IF selected:IndexOf(cField) == -1
                    IF Like(cElement, cField)
                        selected:Add(cField)
                    ENDIF
                ENDIF
            NEXT
        NEXT
    ENDIF
    IF ! String.IsNullOrEmpty(cExcludedFields)
        allfields:Clear()
        // now we only process the names that were selected before
        allfields:AddRange(selected)
        selected:Clear()
        VAR aElements := __GetAllElements(cExcludedFields)
        FOREACH VAR cElement IN aElements
            FOREACH VAR cField in allfields
                IF !Like(cElement, cField)
                    selected:Add(cField)
                ENDIF
            NEXT
        NEXT
    ENDIF
return selected
FUNCTION __ScatterMemVar(cFieldList, cIncludedFields, cExcludedFields, lIncludeMemo, lBlank) AS LOGIC
    VAR aFields := __GetFieldValues(cFieldList, cIncludedFields, cExcludedFields, lIncludeMemo, lBlank)
    FOREACH var oField in aFields
        __MemVarDecl(oField:Name, TRUE)
        __MemVarPut(oField:Name, oField:Value)
    NEXT
    RETURN TRUE

FUNCTION __GatherMemVar(cFieldList, cIncludedFields, cExcludedFields, lIncludeMemo) AS LOGIC
    VAR aFields := __BuildFieldList(cFieldList, cIncludedFields, cExcludedFields, lIncludeMemo)
    FOREACH var cField in aFields
        __FieldSet(cField, MemVarGet(cField))
    NEXT
    RETURN TRUE
    #pragma options ("az", on)

FUNCTION __ScatterArray(cFieldList, cIncludedFields, cExcludedFields, lIncludeMemo, lBlank) AS ARRAY
    VAR aFields := __GetFieldValues(cFieldList, cIncludedFields, cExcludedFields, lIncludeMemo, lBlank)
    VAR aResult := {}
    FOREACH var oField in aFields
        AAdd(aResult, oField:Value)
    NEXT
    RETURN aResult

FUNCTION __GatherArray(uSource, cFieldList, cIncludedFields, cExcludedFields, lIncludeMemo) AS LOGIC
    VAR aFields := __BuildFieldList(cFieldList, cIncludedFields, cExcludedFields, lIncludeMemo)
    VAR current := 0
    IF ! IsArray(uSource)
        RETURN FALSE
    ENDIF
    LOCAL aSource := uSource as ARRAY
    var found    := FALSE
    FOREACH var cField in aFields
        if aSource:Length > current
            __FieldSet(cField, aSource[current++])
            found    := TRUE

        endif
    NEXT
    RETURN found

    #pragma options ("az", default)

FUNCTION __ScatterObject(cFieldList, cIncludedFields, cExcludedFields, lIncludeMemo, lBlank, cObject, lAdditive) AS OBJECT
    VAR aFields := __GetFieldValues(cFieldList, cIncludedFields, cExcludedFields, lIncludeMemo, lBlank)
    LOCAL oResult := NULL_OBJECT as OBJECT
    IF !IsLogic(lAdditive)
        lAdditive := FALSE
    ENDIF
    IF IsString(cObject) .and. lAdditive
        TRY
                LOCAL uObject := VarGet(cObject)
                IF IsObject(uObject)
                    oResult := uObject
            ENDIF
        CATCH
            oResult := NULL_OBJECT
        END TRY
    ENDIF
    IF oResult == NULL_OBJECT
        oResult := XSharp.VFP.Empty{}
    ENDIF
    IF oResult IS XSharp.VFP.Empty VAR oEmpty
            FOREACH var oField in aFields
                oEmpty:AddProperty(oField:Name, oField:Value)
        NEXT
    ELSE
        FOREACH var oField in aFields
            AddProperty(oResult, oField:Name, oField:Value)
        NEXT
    ENDIF
    RETURN oResult

FUNCTION __GatherObject(oObject, cFieldList, cIncludedFields, cExcludedFields, lIncludeMemo ) AS LOGIC
    VAR aFields := __BuildFieldList(cFieldList, cIncludedFields, cExcludedFields, lIncludeMemo)
    LOCAL oLocal as OBJECT
    IF ! IsObject(oObject)
        RETURN FALSE
    ENDIF
    oLocal := oObject
    IF oLocal IS XSharp.IDynamicProperties VAR oDynamic
            var props := List<String>{}
            props:AddRange(oDynamic:GetPropertyNames())
            FOREACH var cField in aFields
                if props:IndexOf(cField:ToUpper()) >= 0
                    var value := oDynamic:NoIvarGet(cField)
                    __FieldSet(cField, value)
                endif

        NEXT
    ELSE
        FOREACH var cField in aFields
            var value := IVarGet(oLocal, cField)
            __FieldSet(cField, value)
        NEXT
    ENDIF
    RETURN TRUE

error: pathspec 'Runtime/XSharp.VFP/GatherScatter.prg' did not match any file(s) known to git


KBreadcrumbSelectionModel: class updated

- methods new1 and new2 removed
- methods select1 and select2 removed

Modified:
source/KDEUI/KBreadcrumbSelectionModelClass.prg


Rotina de prestação de contas com load da foto.


start the iceberg in Haskell

start the iceberg in Haskell

-- implement the idea described in
-- https://code.google.com/p/omega/wiki/IcebergTypes
--

import "../src/LangPrelude.prg" (maybeM)

data Thrist :: (l ~> l ~> *) ~> l ~> l ~> * where
  Nil :: Thrist k a a
  Cons :: k a b -> Thrist k b c -> Thrist k a c
 deriving List(t)

data Multiplicity :: *2 where
  Mono :: Multiplicity
  Poly :: Multiplicity

data Lev :: Multiplicity ~> *1 where
  ValueLevel :: Lev Mono
  LevelUp :: Lev m ~> Lev m
  PolyLevel :: Lev Poly -- level n .
 deriving syntax (lev) Nat(ValueLevel, LevelUp)

data Level :: Lev n ~> * where
  ValueLevel :: Level ValueLevel
  LevelUp :: Level l -> Level (LevelUp l)
  PolyLevel :: Level PolyLevel
 deriving syntax (l) Nat(ValueLevel, LevelUp)

data Signature :: * where
  Sig :: Signature -- some signature (for now)
  SigCtor :: Label t -> Signature
  SigFun :: Label t -> Signature
  SigVar :: Label t -> Signature
  SigApp :: Signature -> Signature -> Signature

data Iceberg :: * ~> * ~> * where
  Constructor :: Label t -> Level l -> Signature -> Iceberg () ()

data Icename :: Tag ~> Tag ~> * where -- entities with certain name
  NamedConstructor :: Label t -> Level l -> Signature -> Icename t t

data Icelevel :: Lev n ~> Lev n ~> * where -- entities with certain level
  LevelConstructor :: LevelFits l' l => Label t -> Level l -> Signature -> Icelevel l' l'

data TagLev :: Multiplicity ~> *1 where
  TL :: Tag ~> Lev m ~> TagLev m

data Icenamelevel :: TagLev n ~> TagLev n ~> * where -- entities with certain level and name
  NamedLevelConstructor :: LevelFits l' l => Label t -> Level l -> Signature -> Icenamelevel (TL t l') (TL t l')

builtIns :: Thrist Iceberg () ()
builtIns = [ Constructor `Z 0l $ SigApp natPrimeCtor (SigCtor `Z)
           , Constructor `S 0l $ SigApp (SigApp varrowCtor (SigApp natPrimeCtor $ SigVar `a)) (SigApp natPrimeCtor $ (SigApp (SigCtor `S) $ SigVar `a))
           , Constructor natPrime 0l $ SigApp (SigApp karrowCtor natCtor) starCtor
           , Constructor `Z 1l $ natCtor
           , Constructor `S 1l $ SigApp (SigApp karrowCtor natCtor) natCtor
           , Constructor `Nat 2l Sig
           , Constructor starN (LevelUp (LevelUp PolyLevel)) Sig
           , Constructor constraintN (LevelUp (LevelUp PolyLevel)) Sig
           , Constructor varrow 1l Sig
           , Constructor `MultValueAndUp PolyLevel Sig]t
  where HideLabel natPrime = newLabel "Nat'"
        HideLabel starN = newLabel "*n"
        HideLabel constraintN = newLabel "#n"
        HideLabel varrow = newLabel "->"
        HideLabel karrow = newLabel "~>"
        starCtor = SigCtor starN
        natPrimeCtor = SigCtor natPrime
        varrowCtor = SigCtor varrow
        karrowCtor = SigCtor karrow
        natCtor = SigCtor `Nat

projectName :: Label l -> Thrist Iceberg () () -> Thrist Icename l l
projectName _ []t = []t
projectName l [Constructor l' lev sig; rest]t = case l `sameLabel` l' of
                                                L Eq -> [NamedConstructor l' lev sig; projectName l rest]t
                                                _ -> projectName l rest

projectName' :: Label t -> Thrist Icelevel l l -> Thrist Icenamelevel (TL t l) (TL t l)
projectName' _ []t = []t
projectName' t [LevelConstructor t' lev sig; rest]t = case t `sameLabel` t' of
                                                      L Eq -> [NamedLevelConstructor t' lev sig; projectName' t rest]t
                                                      _ -> projectName' t rest

-- inclusion relation on levels
--
prop LevelFits :: Lev n ~> Lev n' ~> * where
  BothValue :: LevelFits ValueLevel ValueLevel
  InPoly :: LevelFits k PolyLevel
  BothUp :: LevelFits k k' -> LevelFits (LevelUp k) (LevelUp k')

-- runtime compute level inclusion
--
fits :: Level l -> Level l' -> Maybe (LevelFits l l')
fits ValueLevel ValueLevel = Just BothValue
fits (LevelUp l) (LevelUp l') = do ev <- fits l l'
                                   return $ BothUp ev
                                 where monad maybeM
fits _ PolyLevel = Just InPoly
fits _ _ = Nothing

multiplicity :: Multiplicity ~> Multiplicity ~> Multiplicity
{multiplicity Mono b} = Mono
{multiplicity Poly b} = b

unilev :: Lev a ~> Lev b ~> Lev {multiplicity a b}
{unilev ValueLevel ValueLevel} = ValueLevel
{unilev ValueLevel PolyLevel} = ValueLevel
{unilev (LevelUp a) (LevelUp b)} = LevelUp {unilev a b}
{unilev (LevelUp a) PolyLevel} = LevelUp {unilev a PolyLevel}
{unilev PolyLevel ValueLevel} = ValueLevel
{unilev PolyLevel (LevelUp b)} = LevelUp {unilev PolyLevel b}
{unilev PolyLevel PolyLevel} = PolyLevel

-- prove commutativity
--
unifyCommutes :: Level k -> Level l -> Equal {unilev k l} {unilev l k}
unifyCommutes ValueLevel ValueLevel = Eq
unifyCommutes ValueLevel PolyLevel = Eq
unifyCommutes (LevelUp a) (LevelUp b) = Eq where theorem hyp = unifyCommutes a b
unifyCommutes (LevelUp a) PolyLevel = Eq where theorem hyp = unifyCommutes a PolyLevel
unifyCommutes PolyLevel ValueLevel = Eq
unifyCommutes PolyLevel (LevelUp b) = Eq where theorem hyp = unifyCommutes PolyLevel b
unifyCommutes PolyLevel PolyLevel = Eq

unifyLevels :: Level k -> Level l -> Maybe (Level {unilev k l})
unifyLevels ValueLevel (LevelUp b) = Nothing
unifyLevels ValueLevel ValueLevel = Just ValueLevel
unifyLevels ValueLevel PolyLevel = Just ValueLevel
unifyLevels (LevelUp a) (LevelUp b) = do yes <- unifyLevels a b
                                         return $ LevelUp yes
                                       where monad maybeM
unifyLevels (LevelUp a) ValueLevel = Nothing
unifyLevels (LevelUp a) PolyLevel = do yes <- unifyLevels a PolyLevel
                                       return $ LevelUp yes
                                     where monad maybeM
unifyLevels PolyLevel ValueLevel = unifyLevels ValueLevel PolyLevel
unifyLevels PolyLevel (LevelUp b) = unifyLevels (LevelUp b) PolyLevel
  where theorem comm = unifyCommutes PolyLevel b
unifyLevels PolyLevel PolyLevel = Just PolyLevel

projectLevel :: Level l -> Thrist Iceberg () () -> Thrist Icelevel l l
projectLevel _ []t = []t
projectLevel l [Constructor t l' sig; rest]t = case l `fits` l' of
                                               Just BothValue -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just InPoly -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just (BothUp below) -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               _ -> projectLevel l rest

projectLevel' :: Level l -> Thrist Icename t t -> Thrist Icenamelevel (TL t l) (TL t l)
projectLevel' _ []t = []t
projectLevel' l [NamedConstructor t l' sig; rest]t = case l `fits` l' of
                                                     Just BothValue -> [NamedLevelConstructor t l' sig; projectLevel' l rest]t
                                                     Just InPoly -> [NamedLevelConstructor t l' sig; projectLevel' l rest]t
                                                     Just (BothUp below) -> [NamedLevelConstructor t l' sig; projectLevel' l rest]t
                                                     _ -> projectLevel' l rest

data Levels :: Lev m ~> Lev m ~> * where
  InLevel :: Thrist Icelevel l l -> Levels l (1+l)l

t3 :: Thrist Levels 0l 2l
t3 = [InLevel $ projectLevel 0l builtIns, InLevel $ projectLevel 1l builtIns]t

fibrateLevels :: Level l -> Thrist Iceberg () () -> Thrist Levels l a
fibrateLevels l berg = [InLevel $ projectLevel l berg; lazy (fibrateLevels (1+l)l berg)]t

[t30, t31, t32, t33; t34]t = fibrateLevels 0l builtIns
[t40, t41, t42, t43; t44]t = fibrateLevels PolyLevel builtIns

error: pathspec 'mosaic/Iceberg.prg' did not match any file(s) known to git


Servico rest do tipo de despesa

Servico rest do tipo de despesa


Tests for levelpolymorhpism

Tests for levelpolymorhpism

------------------------------------------
-- level polymorphism

prop Eqz:: level n. forall (t:: *(1+n)) .t ~> t ~> *0 where
  E :: Eqz a a

prop Eqw:: t ~> t ~> *0 where
  Ew :: Eqw a a

data Mx:: *1 where
 F :: Int ~> Mx

fe:: a -> Eqz a a
fe x = E

----------------------------------------------------

##test "level too low"
 data Natural:: level n . *n  where
   Zero :: Natural
   Succ :: Natural ~> Natural
   D :: Int ~> Natural

data Natural:: level n . *n where
   Zero :: Natural
   Succ :: Natural ~> Natural
 deriving Nat(n)

-- Singleton

data Natural' :: level n . Natural_(1) ~> *n where
  Zero' :: Natural' Zero
  Succ' :: Natural' n ~> Natural' (Succ n)
    deriving Nat(m)

---------------------------------------------

data L:: level n . *n ~> *n where
   Nil :: L x
   Cons :: x ~> L x ~> L x
  deriving List(x)

data Bush:: level n . *n ~> *n where
   Fork:: L x ~> Bush x

data L2:: level n . (x:: *(n+1)) ~> *n where
   Nil2 :: L2 x
   Cons2 :: x ~> L2 x ~> L2 x

error: pathspec 'tests/LevelPoly.prg' did not match any file(s) known to git


KCharSelect: class updated

KCharSelect: class updated

- methods new1 and new2 removed
- method new fixed
- formatting

Modified:
source/KDEUI/KCharSelectClass.prg


Added an example sport's team color

Added an example sport's team color

error: pathspec 'programs/seahawks.prg' did not match any file(s) known to git


add a classic algo

add a classic algo

import "../src/LangPrelude.prg"

data Mark = FullStop | Stop | Digit Bool

data Way = Arrived | Step Mark Way deriving List(w)

etalon = "1s100000s11010s10100s1111s1010s110s11s1S"

w1 = [FullStop]w
w2 = [Digit True, FullStop]w
w3 = [Stop, Digit True, FullStop]w

countSteps = howmanysteps 0

howmanysteps :: Int -> Way -> Int
howmanysteps corr [FullStop]w = corr + 1
howmanysteps corr [Stop; way]w = corr + pickupMarks way 1
  where pickupMarks [FullStop]w acc = acc
        pickupMarks [Stop; _]w acc = acc
        pickupMarks [Digit False; more]w acc = pickupMarks more $ acc + acc
        pickupMarks [Digit True; more]w acc = pickupMarks more $ acc + acc + 1
howmanysteps corr [Digit _; more]w = howmanysteps (corr + 1) more

etalon' = foldr (Step . c2m) Arrived etalon
  where c2m 'S' = FullStop
        c2m 's' = Stop
        c2m '0' = Digit False
        c2m '1' = Digit True

error: pathspec 'tests/WayMarking.prg' did not match any file(s) known to git


dabbling toward issue 62

dabbling toward issue 62

-- simulate classes as propositions first

-- issue 87:
--isFunctor :: (* ~> *) ~> (* ~> *)
--{isFunctor []} = []

isFunctor :: (* ~> *) ~> Prop
{isFunctor []} = Success

prop Functor :: (* ~> *) ~> Prop ~> * where
  Lfunctor :: Functor [] Success
--  Lfunctor :: Functor a {isFunctor a}

prop Monad' :: (* ~> *) ~> Prop ~> * where
  M :: Functor a Success => Monad' a Success

data Tree a = Node a | Fork (Tree a) (Tree a)

--data Test :: forall (a :: * ~> *) . Monad' a Success => a ~> * where
data Test :: * where
  Test :: forall (a :: * ~> *) (t :: *) . Monad' a Success => a t -> Test

error: pathspec 'work/classes.prg' did not match any file(s) known to git


emulating an infinite hierarchy of polynomial (non-star) kinds; because of issue 70 we need all foralls to be spelled out for now

data Pat :: *4 where
  Y :: Pat
  Q :: Pat ~> Pat
 deriving Nat(p)

data Pat' :: Pat ~> *3 where
  Y' :: Pat' Y
  Q' :: Pat' n ~> Pat' (Q n)
 deriving Nat(q)

data Pat'' :: Pat' a ~> *2 where
  Y'' :: Pat'' Y'
  Q'' :: Pat'' m ~> Pat'' (Q' m)
 deriving Nat(r)

data Pat''' :: forall a (b::Pat' a) . Pat'' b ~> *1 where
  Y''' :: Pat''' Y''
  Q''' :: Pat''' w ~> Pat''' (Q'' w)
 deriving Nat(s)

data Pat'''' :: forall a (b::Pat' a) (c::Pat'' b) . Pat''' c ~> * where
  Y :: Pat'''' Y'''
  Q :: Pat'''' z -> Pat'''' (Q''' z)
 deriving Nat(u)

plus :: Pat ~> Pat ~> Pat
{plus 0p n} = n
{plus (1+m)p n} = {plus m (1+n)p}

plus' :: Pat' a ~> Pat' b ~> Pat' {plus a b}
{plus' 0q n} = n
{plus' (1+m)q n} = {plus' m (1+n)q}

plus'' :: forall a (a'::Pat' a) b (b'::Pat' b) . Pat'' a' ~> Pat'' b' ~> Pat'' {plus' a' b'}
{plus'' 0r n} = n
{plus'' (1+m)r n} = {plus'' m (1+n)r}

plus''' :: forall a (a'::Pat' a) (a''::Pat'' a') b (b'::Pat' b) (b''::Pat'' b') . Pat''' a'' ~> Pat''' b'' ~> Pat''' {plus'' a'' b''}
{plus''' 0s n} = n
{plus''' (1+m)s n} = {plus''' m (1+n)s}

pl :: forall a (a'::Pat' a) (a''::Pat'' a') (a'''::Pat''' a'') b (b'::Pat' b) (b''::Pat'' b') (b'''::Pat''' b'') . Pat'''' a''' -> Pat'''' b''' -> Pat'''' {plus''' a''' b'''}
pl 0u n = n
pl (1+m)u n = pl m (1+n)u

error: pathspec 'tests/AutoLevelled.prg' did not match any file(s) known to git


Correção

Correção

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/alvarocneto/prestconthack.git/'


initial sketch, to be filled in

initial sketch, to be filled in

-- See Uustalu, Ghani, Hamana (Explicit...)

kind Discipline = Regular | Explicit

data Calc :: Discipline ~> * ~> * where
  Var :: a -> Calc Regular a
  App :: Calc d a -> Calc d a -> Calc d a
  Abs :: Calc d a -> Calc d (Maybe a)

-- define Explicit to Regular conv
-- define ev. (Krivine etc.)

error: pathspec 'tests/Explicit.prg' did not match any file(s) known to git


update

update

   // comment

          /*

      */

// zuzuok

                zzaac

    = 32

///*commentb */  bgbbbb/*ccccc */

error: pathspec 'examples/test1.prg' did not match any file(s) known to git


ajuste

ajuste


very humble beginning for specifying opetopes

-- Modeling Opetopes

import "../tests/NatList.prg"

-- Node Types

kind NodeType = Regular | Universal

-- Node Labels (parametrized by dimension?)

data NodeLabel = Named (Label n)
               | Comp NodeLabel NodeLabel

-- Node: named faces as inputs and an output (face)

-- Consuming some twig

data Eat :: Twig ~> * where
  NoDot :: Eat None  -- do not extend till next sprouting point
  Sub :: Eat (Sprout l)

-- A connected deck of cards

data Deck :: Twig ~> Twig ~> * where
  Air :: Deck t None
  Card :: Eat t -> Deck subt out -> Deck t (Sprout [out]w)

-- A forest: trees in each dimension up to n
--   o when it ends in a corolla then it is a cell (n-dimensional)
--

--data Forest

-- Idea: each tree must have two type parameters
--       o left: set of nodes from dim (n - 1) is our (tree of) lines
--       o right: my set of nodes is the tree I push to dim n + 1

-- HAH! we have a thrist!

-- trees live at the type level

-- have these forms
--      O  |
--   o  |  o
--      o

--         |
-- List of o starts at O

data List :: *1 where
  No :: List
  Ext :: List ~> Twig ~> List
 deriving LeftList(w)

data Twig :: *1 where
  None :: Twig
  Sprout :: List ~> Twig

-- an Opetope is a LeftThrist of Decks

-- Dimension Zero is always:

dim0 = Card NoDot Air

dim1 = Card Sub Air

upto1 = [dim0, dim1]lt

error: pathspec 'tests/Opetope.prg' did not match any file(s) known to git


codegen/KTextWidgets: updated

codegen/KTextWidgets: updated

Modified:
codegen/KTextWidgets/KRegExpEditorInterface.prg

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/marcosgambeta/KDE5xHb.git/'


added 'examples' folder and first example (calcdifdat.prg)

/*

  Qt5xHb Project - Example Program

  Copyright (C) 2012-2017 Marcos Antonio Gambeta

  E-mail:
  marcosgambeta AT outlook DOT com
  marcosgambeta AT gmail DOT com

  Website:
  https://github.com/marcosgambeta/Qt5xHb

  Users Groups:
  https://groups.google.com/forum/?hl=pt-BR#!forum/qtxhb    [ENGLISH]
  https://groups.google.com/forum/?hl=pt-BR#!forum/qtxhb-br [PORTUGUESE]

*/

/*
  Clculo da diferena entre duas datas
*/

#include "qt5xhb.ch"

PROCEDURE Main ()

   LOCAL oApp
   LOCAL oWindow
   LOCAL oCalendar1
   LOCAL oCalendar2
   LOCAL oButton
   LOCAL oGrid

   // cria um objeto da classe QApplication
   oApp := QApplication():new()

   // cria um objeto (uma janela) da classe QWidget
   oWindow := QWidget():new()

   // define o ttulo da janela
   oWindow:setWindowTitle("Clculo da diferena entre datas")

   // cria dois objetos (calendrios) da classe QCalendarWidget
   oCalendar1 := QCalendarWidget():new()
   oCalendar2 := QCalendarWidget():new()

   // cria um objeto (boto) da classe QPushButton
   oButton := QPushButton():new("Calcular diferena")

   // cria um objeto, da classe QGridLayout, tendo o objeto oWindow como "pai"
   oGrid := QGridLayout():new(oWindow)

   // adiciona os dois calendrios e o boto ao objeto oGrid

   // primeiro calendrio na linha 0 e coluna 0
   oGrid:addWidget(oCalendar1, 0, 0)

   // segundo calendrio na linha 0 e coluna 1
   oGrid:addWidget(oCalendar2, 0, 1)

   // boto na linha 1 e coluna 0, ocupando 1 linha e 2 colunas
   oGrid:addWidget(oButton, 1, 0, 1, 2)

   // define a ao executada pelo boto quando clicado:
   // chamar a funo CalculaDiferenca, passandos os objetos oCalendar1 e
   // oCalendar2 como parmetros
   oButton:onClicked( {||CalculaDiferenca(oCalendar1,oCalendar2)} )

   // deixa a janela visvel, incluindo seu contedo
   oWindow:show()

   // inicia o processamento de eventos
   oApp:exec()

   // destri o objeto oWindow
   oWindow:delete()

   // destri o objeto oApp
   oApp:delete()

RETURN

/*
  A funo CalculaDiferenca obtm as datas dos calendrios
  e mostra a diferena entre as duas, usando uma janela de
  mensagem.
*/

STATIC FUNCTION CalculaDiferenca (oCalendar1, oCalendar2)

   LOCAL oMessageBox
   LOCAL oData1
   LOCAL oData2
   LOCAL nDias

   // obtm as datas selecionadas em cada um dos calendrios (note que o mtodo
   // selectDate, da classe QCalendarWidget, retorna um objeto da classe QDate)
   oData1 := oCalendar1:selectedDate()
   oData2 := oCalendar2:selectedDate()

   // obtm o nmero de dias entre as duas datas atravs do mtodo daysTo
   // da classe QDate
   nDias := oData1:daysTo(oData2)

   // cria um objeto (uma janela de mensagem) da classe QMessageBox
   oMessageBox := QMessageBox():new()

   // define o ttulo da janela de mensagem
   oMessageBox:setWindowTitle("Diferena entre as datas")

   // define o texto da janela de mensagem
   oMessageBox:setInformativeText("A diferena entre as datas  de "+AllTrim(Str(nDias))+" dia(s)")

   // mostra a janela de mensagem
   oMessageBox:exec()

   // destri o objeto oMessageBox
   oMessageBox:delete()

RETURN NIL

error: pathspec 'examples/calcdifdat.prg' did not match any file(s) known to git


Alterada a forma de trabalhar com os limites, considerando valores diferentes de zero.


tests/HStyledItemDelegate.prg: new test

tests/HStyledItemDelegate.prg: new test

/*

  Qt4xHb Project - Test Program

  Copyright (C) 2020 Marcos Antonio Gambeta

  E-mail:
  marcosgambeta AT outlook DOT com

  Website:
  https://github.com/marcosgambeta/Qt4xHb

*/

#include "qt4xhb.ch"

PROCEDURE Main()

   LOCAL oApp
   LOCAL oDB
   LOCAL oWindow
   LOCAl oModel
   LOCAL oView
   LOCAL oTextDelegate
   LOCAL oValueDelegate

   oApp := QApplication():new()

   // cria um objeto da classe QSqlDatabase
   oDB := QSqlDatabase():addDatabase("QSQLITE","connection")

   // configura
   oDB:setHostName("localhost")
   oDB:setDatabaseName("HStyledItemDelegate.db")

   // abre o arquivo
   IF !oDB:open()
      oApp:delete()
      QUIT
   ENDIF

   IF ascan(oDB:tables(QSql_Tables), "cadastro") == 0
      // cria a tabela
      oDB:exec("CREATE TABLE cadastro( id INTEGER PRIMARY KEY AUTOINCREMENT, nome TEXT, saldo REAL )")
      // insere dados
      oDB:transaction()
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Antonio',   12345.67 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Bernardo',      0.01 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Carlos',        0.10 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Diogo',         1.00 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Elias',        10.00 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Fernando',    100.00 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Gabriel',     200.00 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Henrique',    300.00 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Ismael',      400.00 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Jonas',       500.00 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Leonardo',   -500.00 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Marcos',     -400.00 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Norberto',   -300.00 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Odecio',     -200.00 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Paulo',      -100.00 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Renato',      -10.00 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Silvio',       -1.00 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Tiago',        -0.10 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Ulisses',      -0.01 )")
      oDB:exec("INSERT INTO cadastro( nome, saldo ) VALUES( 'Valdir',   -12345.67 )")
      oDB:commit()
   ENDIF

   // cria o modelo
   oModel := QSqlTableModel():new(,oDB)

   // define a tabela
   oModel:setTable("cadastro")

   // define as alteracoes para serem imediatas
   oModel:setEditStrategy(QSqlTableModel_OnFieldChange)

   // preenche o modelo com os dados da tabela
   oModel:select()

   // define os titulos dos cabecalhos
   oModel:setHeaderData(1,Qt_Horizontal,QVariant():new("Nome"))
   oModel:setHeaderData(2,Qt_Horizontal,QVariant():new("Saldo"))

   // cria a janela
   oWindow := QWidget():new():setWindowTitle("Teste"):resize(640,480)

   // cria um objeto da classe QTableView
   oView := QTableView():new(oWindow):move(10,10):resize(640-20,480-20)

   // liga o modelo ao visualizador
   oView:setModel(oModel)

   // esconde a coluna 0 'Id'
   oView:hideColumn(0)

   // cria um objeto da classe TextDelegate para uso na coluna 1
   oTextDelegate := TextDelegate():new(oView)
   oTextDelegate:onCloseEditor({|oSender,oEditor,nHint|qout("oTextDelegate - closeEditor - "+alltrim(str(nHint)))})
   oTextDelegate:onCommitData({|oSender,oEditor|qout("oTextDelegate - commitData")})
   oView:setItemDelegateForColumn(1, oTextDelegate)

   // cria um objeto da classe ValueDelegate para uso na coluna 2
   oValueDelegate := ValueDelegate():new(oView)
   oValueDelegate:onCloseEditor({|oSender,oEditor,nHint|qout("oValueDelegate - closeEditor - "+alltrim(str(nHint)))})
   oValueDelegate:onCommitData({|oSender,oEditor|qout("oValueDelegate - commitData")})
   oView:setItemDelegateForColumn(2, oValueDelegate)

   oWindow:show()

   oApp:exec()

   oWindow:delete()

   oModel:delete()

   oApp:delete()

RETURN

#include "hbclass.ch"

/*
  Class TextDelegate
*/

CLASS TextDelegate INHERIT HStyledItemDelegate

   METHOD new
   METHOD displayText
   METHOD createEditor
   METHOD setEditorData
   METHOD setModelData

END CLASS

METHOD new(...) CLASS TextDelegate

   ::super:new(...)

   ::setDisplayTextCB( {|...|::displayText(...)} )
   ::setCreateEditorCB( {|...|::createEditor(...)} )
   ::setEditorDataCB( {|...|::setEditorData(...)} )
   ::setModelDataCB( {|...|::setModelData(...)} )

RETURN self

METHOD displayText(pVariant, pLocale) CLASS TextDelegate

RETURN QVariant():newFrom(pVariant):toString()

METHOD createEditor(pParent, pOption, pIndex) CLASS TextDelegate

   LOCAL oParent := QWidget():newFrom(pParent)
   LOCAL oOption := QStyleOptionViewItem():newFrom(pOption)
   LOCAL oIndex := QModelIndex():newFrom(pIndex)
   LOCAL oEditor

   oEditor := QLineEdit():new(oParent)

RETURN oEditor

METHOD setEditorData(pEditor, pIndex) CLASS TextDelegate

   LOCAL oEditor := QLineEdit():newFrom(pEditor)
   LOCAL oIndex := QModelIndex():newFrom(pIndex)
   LOCAL cValue

   cValue := oIndex:model():data(oIndex, Qt_EditRole):toString()

   oEditor:setText( cValue )

RETURN NIL

METHOD setModelData(pEditor, pModel, pIndex) CLASS TextDelegate

   LOCAL oEditor := QLineEdit():newFrom(pEditor)
   LOCAL oModel := QSqlTableModel():newFrom(pModel)
   LOCAL oIndex := QModelIndex():newFrom(pIndex)
   LOCAL cValue

   cValue := oEditor:text()

   oModel:setData( oIndex, QVariant():new( cValue ), Qt_EditRole )

RETURN NIL

/*
  Class ValueDelegate
*/

CLASS ValueDelegate INHERIT HStyledItemDelegate

   METHOD new
   METHOD paint
   METHOD createEditor
   METHOD setEditorData
   METHOD setModelData

END CLASS

METHOD new(...) CLASS ValueDelegate

   ::super:new(...)

   ::setPaintCB( {|...|::paint(...)} )
   ::setCreateEditorCB( {|...|::createEditor(...)} )
   ::setEditorDataCB( {|...|::setEditorData(...)} )
   ::setModelDataCB( {|...|::setModelData(...)} )

RETURN self

METHOD paint(pPainter, pOption, pIndex) CLASS ValueDelegate

   LOCAL oPainter := QPainter():newFrom(pPainter)
   LOCAL oOption := QStyleOptionViewItem():newFrom(pOption)
   LOCAL oIndex := QModelIndex():newFrom(pIndex)
   LOCAL nValue

   // checa se o estado da celula = selecionado e preenche o fundo de acordo
   IF hb_bitand( oOption:state(), QStyle_State_Selected ) != 0
      oPainter:fillRect( oOption:rect(), oOption:palette():highlight() )
   ENDIF

   // obtem o valor da celula
   nValue := oIndex:data( Qt_DisplayRole ):toReal()

   // formata o valor
   cValue := transform(nValue, "@E 999,999,999.99") + space(1)

   IF nValue < 0
      oPen := oPainter:pen()
      oPen:setColor( QColor():new("red") )
      oPainter:setPen(oPen)
   ELSE
      oPen := oPainter:pen()
      oPen:setColor( QColor():new("blue") )
      oPainter:setPen(oPen)
   ENDIF

   // alinha o texto na celula
   oPainter:drawText( oOption:rect(), Qt_AlignRight+Qt_AlignVCenter, cValue )

RETURN NIL

METHOD createEditor(pParent, pOption, pIndex) CLASS ValueDelegate

   LOCAL oParent := QWidget():newFrom(pParent)
   LOCAL oOption := QStyleOptionViewItem():newFrom(pOption)
   LOCAL oIndex := QModelIndex():newFrom(pIndex)
   LOCAL oEditor

   oEditor := QDoubleSpinBox():new(oParent)
   oEditor:setSingleStep(0.01)
   oEditor:setMinimum(-99999999.99)
   oEditor:setMaximum(999999999.99)

RETURN oEditor

METHOD setEditorData(pEditor, pIndex) CLASS ValueDelegate

   LOCAL oEditor := QDoubleSpinBox():newFrom(pEditor)
   LOCAL oIndex := QModelIndex():newFrom(pIndex)
   LOCAL nValue

   nValue := oIndex:model():data( oIndex, Qt_EditRole ):toReal()

   oEditor:setValue( nValue )

RETURN NIL

METHOD setModelData(pEditor, pModel, pIndex) CLASS ValueDelegate

   LOCAL oEditor := QDoubleSpinBox():newFrom(pEditor)
   LOCAL oModel := QSqlTableModel():newFrom(pModel)
   LOCAL oIndex := QModelIndex():newFrom(pIndex)
   LOCAL nValue

   nValue := oEditor:value()

   oModel:setData( oIndex, QVariant():new( nValue ), Qt_EditRole )

RETURN NIL

error: pathspec 'tests/HStyledItemDelegate.prg' did not match any file(s) known to git


added new example standarddialogs.prg

added new example standarddialogs.prg

/*

  Qt5xHb Project - Example Program

  Copyright (C) 2012-2017 Marcos Antonio Gambeta

  E-mail:
  marcosgambeta AT outlook DOT com
  marcosgambeta AT gmail DOT com

  Website:
  https://github.com/marcosgambeta/Qt5xHb

  Users Groups:
  https://groups.google.com/forum/?hl=pt-BR#!forum/qtxhb    [ENGLISH]
  https://groups.google.com/forum/?hl=pt-BR#!forum/qtxhb-br [PORTUGUESE]

*/

/*
  Baseado no exemplo "Standard Dialogs" do Qt Framework
*/

#include "qt5xhb.ch"
#include "hbclass.ch"

#define MESSAGE "
Message boxes have a caption, a text, "+;
                "and any number of buttons, each with standard or custom texts."+;
                "
Click a button to close the message box. Pressing the Esc button "+;
                "will activate the detected escape button (if any)."

PROCEDURE Main ()

   LOCAL oApp
   LOCAL oDialog

   oApp := QApplication():new()

   oDialog := Dialog():new()

   oDialog:show()

   oApp:exec()

   oDialog:delete()

   oApp:delete()

RETURN

CLASS Dialog INHERIT QWidget

   DATA oNative              // QCheckBox

   DATA oIntegerLabel        // QLabel
   DATA oDoubleLabel         // QLabel
   DATA oItemLabel           // QLabel
   DATA oTextLabel           // QLabel
   DATA oColorLabel          // QLabel
   DATA oFontLabel           // QLabel
   DATA oDirectoryLabel      // QLabel
   DATA oOpenFileNameLabel   // QLabel
   DATA oOpenFileNamesLabel  // QLabel
   DATA oSaveFileNameLabel   // QLabel
   DATA oCriticalLabel       // QLabel
   DATA oInformationLabel    // QLabel
   DATA oQuestionLabel       // QLabel
   DATA oWarningLabel        // QLabel
   DATA oErrorLabel          // QLabel

   DATA oIntegerButton       // QPushButton
   DATA oDoubleButton        // QPushButton
   DATA oItemButton          // QPushButton
   DATA oTextButton          // QPushButton
   DATA oColorButton         // QPushButton
   DATA oFontButton          // QPushButton
   DATA oDirectoryButton     // QPushButton
   DATA oOpenFileNameButton  // QPushButton
   DATA oOpenFileNamesButton // QPushButton
   DATA oSaveFileNameButton  // QPushButton
   DATA oCriticalButton      // QPushButton
   DATA oInformationButton   // QPushButton
   DATA oQuestionButton      // QPushButton
   DATA oWarningButton       // QPushButton
   DATA oErrorButton         // QPushButton

   DATA oErrorMessageDialog  // QErrorMessage

   DATA cOpenFilesPath INIT ""

   METHOD new (oParent)
   METHOD setInteger ()
   METHOD setDouble ()
   METHOD setItem ()
   METHOD setText ()
   METHOD setColor ()
   METHOD setFont ()
   METHOD setExistingDirectory ()
   METHOD setOpenFileName ()
   METHOD setOpenFileNames ()
   METHOD setSaveFileName ()
   METHOD criticalMessage ()
   METHOD informationMessage ()
   METHOD questionMessage ()
   METHOD warningMessage ()
   METHOD errorMessage ()

   METHOD delete ()

END CLASS

METHOD new (oParent) CLASS Dialog

   LOCAL nFrameStyle
   LOCAL oLayout

   ::super:new(oParent)

   ::oErrorMessageDialog := QErrorMessage():new(SELF)

   nFrameStyle := QFrame_Sunken + QFrame_Panel

   ::oIntegerLabel := QLabel():new()
   ::oIntegerLabel:setFrameStyle(nFrameStyle)
   ::oIntegerButton := QPushButton():new("QInputDialog::get&Int()")

   ::oDoubleLabel := QLabel():new()
   ::oDoubleLabel:setFrameStyle(nFrameStyle)
   ::oDoubleButton := QPushButton():new("QInputDialog::get&Double()")

   ::oItemLabel := QLabel():new()
   ::oItemLabel:setFrameStyle(nFrameStyle)
   ::oItemButton := QPushButton():new("QInputDialog::getIte&m()")

   ::oTextLabel := QLabel():new()
   ::oTextLabel:setFrameStyle(nFrameStyle)
   ::oTextButton := QPushButton():new("QInputDialog::get&Text()")

   ::oColorLabel := QLabel():new()
   ::oColorLabel:setFrameStyle(nFrameStyle)
   ::oColorButton := QPushButton():new("QColorDialog::get&Color()")

   ::oFontLabel := QLabel():new()
   ::oFontLabel:setFrameStyle(nFrameStyle)
   ::oFontButton := QPushButton():new("QFontDialog::get&Font()")

   ::oDirectoryLabel := QLabel():new()
   ::oDirectoryLabel:setFrameStyle(nFrameStyle)
   ::oDirectoryButton := QPushButton():new("QFileDialog::getE&xistingDirectory()")

   ::oOpenFileNameLabel := QLabel():new()
   ::oOpenFileNameLabel:setFrameStyle(nFrameStyle)
   ::oOpenFileNameButton := QPushButton():new("QFileDialog::get&OpenFileName()")

   ::oOpenFileNamesLabel := QLabel():new()
   ::oOpenFileNamesLabel:setFrameStyle(nFrameStyle)
   ::oOpenFileNamesButton := QPushButton():new("QFileDialog::&getOpenFileNames()")

   ::oSaveFileNameLabel := QLabel():new()
   ::oSaveFileNameLabel:setFrameStyle(nFrameStyle)
   ::oSaveFileNameButton := QPushButton():new("QFileDialog::get&SaveFileName()")

   ::oCriticalLabel := QLabel():new()
   ::oCriticalLabel:setFrameStyle(nFrameStyle)
   ::oCriticalButton := QPushButton():new("QMessageBox::critica&l()")

   ::oInformationLabel := QLabel():new()
   ::oInformationLabel:setFrameStyle(nFrameStyle)
   ::oInformationButton := QPushButton():new("QMessageBox::i&nformation()")

   ::oQuestionLabel = QLabel():new()
   ::oQuestionLabel:setFrameStyle(nFrameStyle)
   ::oQuestionButton := QPushButton():new("QMessageBox::&question()")

   ::oWarningLabel := QLabel():new()
   ::oWarningLabel:setFrameStyle(nFrameStyle)
   ::oWarningButton := QPushButton():new("QMessageBox::&warning()")

   ::oErrorLabel := QLabel():new()
   ::oErrorLabel:setFrameStyle(nFrameStyle)
   ::oErrorButton := QPushButton():new("QErrorMessage::showM&essage()")

   ::oIntegerButton:onClicked({||::setInteger()})
   ::oDoubleButton:onClicked({||::setDouble()})
   ::oItemButton:onClicked({||::setItem()})
   ::oTextButton:onClicked({||::setText()})
   ::oColorButton:onClicked({||::setColor()})
   ::oFontButton:onClicked({||::setFont()})
   ::oDirectoryButton:onClicked({||::setExistingDirectory()})
   ::oOpenFileNameButton:onClicked({||::setOpenFileName()})
   ::oOpenFileNamesButton:onClicked({||::setOpenFileNames()})
   ::oSaveFileNameButton:onClicked({||::setSaveFileName()})
   ::oCriticalButton:onClicked({||::criticalMessage()})
   ::oInformationButton:onClicked({||::informationMessage()})
   ::oQuestionButton:onClicked({||::questionMessage()})
   ::oWarningButton:onClicked({||::warningMessage()})
   ::oErrorButton:onClicked({||::errorMessage()})

   ::oNative := QCheckBox():new(SELF)
   ::oNative:setText("Use native file dialog.")
   ::oNative:setChecked(.T.)

   oLayout := QGridLayout():new()
   oLayout:setColumnStretch(1, 1)
   oLayout:setColumnMinimumWidth(1, 250)
   oLayout:addWidget(::oIntegerButton, 0, 0)
   oLayout:addWidget(::oIntegerLabel, 0, 1)
   oLayout:addWidget(::oDoubleButton, 1, 0)
   oLayout:addWidget(::oDoubleLabel, 1, 1)
   oLayout:addWidget(::oItemButton, 2, 0)
   oLayout:addWidget(::oitemLabel, 2, 1)
   oLayout:addWidget(::oTextButton, 3, 0)
   oLayout:addWidget(::oTextLabel, 3, 1)
   oLayout:addWidget(::oColorButton, 4, 0)
   oLayout:addWidget(::oColorLabel, 4, 1)
   oLayout:addWidget(::oFontButton, 5, 0)
   oLayout:addWidget(::oFontLabel, 5, 1)
   oLayout:addWidget(::oDirectoryButton, 6, 0)
   oLayout:addWidget(::oDirectoryLabel, 6, 1)
   oLayout:addWidget(::oOpenFileNameButton, 7, 0)
   oLayout:addWidget(::oOpenFileNameLabel, 7, 1)
   oLayout:addWidget(::oOpenFileNamesButton, 8, 0)
   oLayout:addWidget(::oOpenFileNamesLabel, 8, 1)
   oLayout:addWidget(::oSaveFileNameButton, 9, 0)
   oLayout:addWidget(::oSaveFileNameLabel, 9, 1)
   oLayout:addWidget(::oCriticalButton, 10, 0)
   oLayout:addWidget(::oCriticalLabel, 10, 1)
   oLayout:addWidget(::oInformationButton, 11, 0)
   oLayout:addWidget(::oInformationLabel, 11, 1)
   oLayout:addWidget(::oQuestionButton, 12, 0)
   oLayout:addWidget(::oQuestionLabel, 12, 1)
   oLayout:addWidget(::oWarningButton, 13, 0)
   oLayout:addWidget(::oWarningLabel, 13, 1)
   oLayout:addWidget(::oErrorButton, 14, 0)
   oLayout:addWidget(::oErrorLabel, 14, 1)
   oLayout:addWidget(::oNative, 15, 0)
   ::setLayout(oLayout)

   ::setWindowTitle("Standard Dialogs")

RETURN SELF

METHOD setInteger () CLASS Dialog

   LOCAL lOk := .F.
   LOCAL nValue

   nValue := QInputDialog():getInt(SELF, "QInputDialog::getInteger()", "Percentage:", 25, 0, 100, 1, @lOk)

   IF lOk
      ::oIntegerLabel:setText(alltrim(str(nValue)))
   ENDIF

RETURN NIL

METHOD setDouble () CLASS Dialog

   LOCAL lOk := .F.
   LOCAL nValue

   nValue := QInputDialog():getDouble(SELF, "QInputDialog::getDouble()", "Amount:", 37.56, -10000, 10000, 2, @lOk)

   IF lOk
      ::oDoubleLabel:setText(alltrim(str(nValue)))
   ENDIF

RETURN NIL

METHOD setItem () CLASS Dialog

   LOCAL aItems := {"Spring","Summer","Fall","Winter"}
   LOCAL lOk := .F.
   LOCAL cItem

   cItem := QInputDialog():getItem(SELF, "QInputDialog::getItem()", "Season:", aItems, 0, .F., @lOk)

   IF lOk .AND. !empty(cItem)
      ::oItemLabel:setText(cItem)
   ENDIF

RETURN NIL

METHOD setText () CLASS Dialog

   LOCAL lOk := .F.
   LOCAL cText

   cText := QInputDialog():getText(SELF, "QInputDialog::getText()", "User name:", QLineEdit_Normal, QDir():home():dirName(), @lOk)

   IF lOk .AND. !empty(cText)
      ::oTextLabel:setText(cText)
   ENDIF

RETURN NIL

METHOD setColor () CLASS Dialog

   LOCAL oColor

   IF ::oNative:isChecked()
      oColor := QColorDialog():getColor("green", SELF)
   ELSE
      oColor := QColorDialog():getColor("green", SELF, "Select Color", QColorDialog_DontUseNativeDialog)
   ENDIF

   IF oColor:isValid()
      ::oColorLabel:setText(oColor:name())
      ::oColorLabel:setPalette(QPalette():new(oColor))
      ::oColorLabel:setAutoFillBackground(.T.)
   ENDIF

RETURN NIL

METHOD setFont () CLASS Dialog

   LOCAL lOk := .F.
   LOCAL oFont

   oFont := QFontDialog():getFont(@lOk, QFont():new(::oFontLabel:text()), SELF)

   IF lOk
      ::oFontLabel:setText(oFont:key())
      ::oFontLabel:setFont(oFont)
   ENDIF

RETURN NIL

METHOD setExistingDirectory () CLASS Dialog

   LOCAL nOptions := QFileDialog_DontResolveSymlinks + QFileDialog_ShowDirsOnly
   LOCAl cDirectory

   IF !::oNative:isChecked()
      nOptions -= QFileDialog_DontUseNativeDialog
   ENDIF

   cDirectory := QFileDialog():getExistingDirectory(SELF, "QFileDialog::getExistingDirectory()", ::oDirectoryLabel:text(), nOptions)

   IF !empty(cDirectory)
      ::oDirectoryLabel:setText(cDirectory)
   ENDIF

RETURN NIL

METHOD setOpenFileName () CLASS Dialog

   LOCAL nOptions := 0
   LOCAL cSelectedFilter := ""
   LOCAL cFileName

   IF !::oNative:isChecked()
      nOptions -= QFileDialog_DontUseNativeDialog
   ENDIF

   cFileName := QFileDialog():getOpenFileName(SELF, "QFileDialog::getOpenFileName()", ::oOpenFileNameLabel:text(), "All Files (*);;Text Files (*.txt)", @cSelectedFilter, nOptions)

   IF !empty(cFileName)
      ::oOpenFileNameLabel:setText(cFileName)
   ENDIF

RETURN NIL

METHOD setOpenFileNames () CLASS Dialog

   LOCAL nOptions := 0
   LOCAL cSelectedFilter := ""
   LOCAL aFiles

   IF !::oNative:isChecked()
      nOptions -= QFileDialog_DontUseNativeDialog
   ENDIF

   aFiles := QFileDialog():getOpenFileNames(SELF, "QFileDialog::getOpenFileNames()", ::cOpenFilesPath, "All Files (*);;Text Files (*.txt)", @cSelectedFilter, nOptions)

   IF len(afiles) > 0
      ::cOpenFilesPath := aFiles[1]
      ::oOpenFileNamesLabel:setText("["+join(aFiles,", ")+"]")
   ENDIF

RETURN NIL

STATIC FUNCTION Join (aItens, cDelim)

   LOCAL nIndex
   LOCAL cRet := ""

   FOR nIndex := 1 TO len(aItens)
      IF empty(cRet)
         cRet += aItens[nIndex]
      ELSE
         cRet += cDelim + aItens[nIndex]
      ENDIF
   NEXT nIndex

RETURN cRet

METHOD setSaveFileName () CLASS Dialog

   LOCAL nOptions := 0
   LOCAL cSelectedFilter := ""
   LOCAL cFileName

   IF !::oNative:isChecked()
      nOptions -= QFileDialog_DontUseNativeDialog
   ENDIF

   cFileName := QFileDialog():getSaveFileName(SELF, "QFileDialog::getSaveFileName()", ::oSaveFileNameLabel:text(), "All Files (*);;Text Files (*.txt)", @cSelectedFilter, nOptions)

   IF !empty(cFileName)
      ::oSaveFileNameLabel:setText(cFileName)
   ENDIF

RETURN NIL

METHOD criticalMessage () CLASS Dialog

   LOCAL nReply

   nReply := QMessageBox():critical(SELF, "QMessageBox::critical()", MESSAGE, QMessageBox_Abort + QMessageBox_Retry + QMessageBox_Ignore)

   IF nReply == QMessageBox_Abort
      ::oCriticalLabel:setText("Abort")
   ELSEIF nReply == QMessageBox_Retry
      ::oCriticalLabel:setText("Retry")
   ELSE
      ::oCriticalLabel:setText("Ignore")
   ENDIF

RETURN NIL

METHOD informationMessage () CLASS Dialog

   LOCAL nReply

   nReply := QMessageBox():information(SELF, "QMessageBox::information()", MESSAGE)

   IF nReply == QMessageBox_Ok
      ::oInformationLabel:setText("OK")
   ELSE
      ::oInformationLabel:setText("Escape")
   ENDIF

RETURN NIL

METHOD questionMessage () CLASS Dialog

   LOCAL nReply

   nReply := QMessageBox():question(SELF, "QMessageBox::question()", MESSAGE, QMessageBox_Yes + QMessageBox_No + QMessageBox_Cancel)

   IF nReply == QMessageBox_Yes
      ::oQuestionLabel:setText("Yes")
   ELSEIF nReply == QMessageBox_No
      ::oQuestionLabel:setText("No")
   ELSE
      ::oQuestionLabel:setText("Cancel")
   ENDIF

RETURN NIL

METHOD warningMessage () CLASS Dialog

   LOCAL oMsgBox

   oMsgBox := QMessageBox():new(QMessageBox_Warning, "QMessageBox::warning()", MESSAGE, 0, SELF)
   oMsgBox:addButton("Save &Again", QMessageBox_AcceptRole)
   oMsgBox:addButton("&Continue", QMessageBox_RejectRole)

   IF oMsgBox:exec() == QMessageBox_AcceptRole
      ::oWarningLabel:setText("Save Again")
   ELSE
      ::oWarningLabel:setText("Continue")
   ENDIF

RETURN NIL

METHOD errorMessage () CLASS Dialog

   ::oErrorMessageDialog:showMessage(;
            "This dialog shows and remembers error messages. "+;
            "If the checkbox is checked (as it is by default), "+;
            "the shown message will be shown again, "+;
            "but if the user unchecks the box the message "+;
            "will not appear again if QErrorMessage::showMessage() "+;
            "is called with the same message.")

   ::oErrorLabel:setText("If the box is unchecked, the message won't appear again.")

RETURN NIL

METHOD delete () CLASS Dialog

   // desconecta sinais
   ::oIntegerButton:onClicked()
   ::oDoubleButton:onClicked()
   ::oItemButton:onClicked()
   ::oTextButton:onClicked()
   ::oColorButton:onClicked()
   ::oFontButton:onClicked()
   ::oDirectoryButton:onClicked()
   ::oOpenFileNameButton:onClicked()
   ::oOpenFileNamesButton:onClicked()
   ::oSaveFileNameButton:onClicked()
   ::oCriticalButton:onClicked()
   ::oInformationButton:onClicked()
   ::oQuestionButton:onClicked()
   ::oWarningButton:onClicked()
   ::oErrorButton:onClicked()

   // destri objeto
   ::super:delete()

RETURN NIL

error: pathspec 'examples/standarddialogs.prg' did not match any file(s) known to git


Added CSMENU with Wi-Fi Modem Fix

Added CSMENU with Wi-Fi Modem Fix

error: pathspec 'Software/C64/csmenu-fixed.prg' did not match any file(s) known to git


Status no Rest

Status no Rest


KActionMenu: updates

KActionMenu: updates

- methods new1, new2 and new3 removed
- parameters checking
- formatting

Modified:
source/KWidgetsAddons/KActionMenu.prg


preseasonal winter blue green

preseasonal winter blue green

error: pathspec 'programs/winter.prg' did not match any file(s) known to git


Retirado comentários

Retirado comentários