create a Harbour class from C code

[Antonio Linares]

This is an example, in next posts we will check more advanced techniques from Manuel Expósito:

Code: Select all  Expand view  RUN

#include <hbapi.h>
#include <hbapicls.h>
#include <hbapiitm.h>
#include <hbstack.h>

typedef struct {
    int x;
    int y;
} Point;

// Set the x value for the Point object
HB_FUNC_STATIC( POINT_SETX )
{
   PHB_ITEM pSelf = hb_stackSelfItem();
   Point * p;

   hb_arrayGet( pSelf, 1, hb_stackReturnItem() );
   p = hb_parptr( -1 );

   if( p )
   {
      hb_retni( p->x );
      p->x = hb_parni( 1 );
   }
   else
      hb_retni( 0 ); // raise an error ?  
}

// Get the x value from the Point object
HB_FUNC_STATIC( POINT_GETX )
{
   PHB_ITEM pSelf = hb_stackSelfItem();
   Point * p;

   hb_arrayGet( pSelf, 1, hb_stackReturnItem() );
   p = hb_parptr( -1 );

   if( p )
      hb_retni( p->x );
   else
      hb_retni( 0 ); // raise an error ?
}

// Set the y value for the Point object
HB_FUNC_STATIC( POINT_SETY )
{
   PHB_ITEM pSelf = hb_stackSelfItem();
   Point * p;

   hb_arrayGet( pSelf, 1, hb_stackReturnItem() );
   p = hb_parptr( -1 );

   if( p )
   {
      hb_retni( p->y );
      p->y = hb_parni( 1 );
   }
   else
      hb_retni( 0 ); // raise an error ?  
}

// Get the y value from the Point object
HB_FUNC_STATIC( POINT_GETY )
{
   PHB_ITEM pSelf = hb_stackSelfItem();
   Point * p;

   hb_arrayGet( pSelf, 1, hb_stackReturnItem() );
   p = hb_parptr( -1 );

   if( p )
      hb_retni( p->y );
   else
      hb_retni( 0 ); // raise an error ?
}

HB_FUNC_STATIC( POINT_NEW )
{
    PHB_ITEM pSelf = hb_stackSelfItem();
    Point * p = ( Point * ) hb_xgrab( sizeof( Point ) );

    p->x = hb_parni( 1 );
    p->y = hb_parni( 2 );

    hb_arraySetPtr( pSelf, 1, p );
    hb_itemReturn( pSelf );  // return Self
}

HB_FUNC_STATIC( POINT_DESTROY )
{
   PHB_ITEM pSelf = hb_stackSelfItem();
   PHB_ITEM p = hb_itemNew( NULL );

   hb_arrayGet( pSelf, 1, p );
   if( hb_itemGetPtr( p ) )
   {
      hb_xfree( hb_itemGetPtr( p ) );
      hb_arraySetPtr( pSelf, 1, NULL );
   }  
   hb_itemRelease( p );
}

HB_FUNC_STATIC( POINT_GETPOINTDATA )
{
   PHB_ITEM pSelf = hb_stackSelfItem();

   hb_arrayGet( pSelf, 1, hb_stackReturnItem() );  // 1 for first DATA
}

// class creation
HB_FUNC( POINT )
{
   static HB_USHORT uiClass = 0;

   if( uiClass == 0 )
   {
      uiClass = hb_clsCreate( 1, "POINT" ); // just one DATA
      // Add methods to the class
      hb_clsAdd( uiClass, "POINTDATA", HB_FUNCNAME( POINT_GETPOINTDATA ) );  // the only DATA we are using
      hb_clsAdd( uiClass, "_X", HB_FUNCNAME( POINT_SETX ) );
      hb_clsAdd( uiClass, "X", HB_FUNCNAME( POINT_GETX ) );
      hb_clsAdd( uiClass, "_Y", HB_FUNCNAME( POINT_SETY ) );
      hb_clsAdd( uiClass, "Y", HB_FUNCNAME( POINT_GETY ) );
      hb_clsAdd( uiClass, "DESTROY", HB_FUNCNAME( POINT_DESTROY ) );
      hb_clsAdd( uiClass, "NEW", HB_FUNCNAME( POINT_NEW ) );
   }

   // create the object
   hb_clsAssociate( uiClass );
}

[xmanuel]

Para facilitar el uso de la creación de clases Harbour desde lenguaje
C yo uso este fichero include

Code: Select all  Expand view  RUN

/***
 * Proyecto: Clases HARBOUR desde C
 * Fichero: myclass.h
 * Descripcion: Implementacion clases HARBOUR en C
 * Autor: Manu Exposito 2014-22
 * Version 22.10
 * Fecha: 07/10/2022
 */

#pragma once
#ifndef MYCLASS_H
#define MYCLASS_H

#include "hbapicls.h"
#include "hbdefs.h"

//------------------------------------------------------------------------------
// Declaracion de clases desde C
//------------------------------------------------------------------------------

#define DEFINE_CLASS( clsName, uiVar ) \
    HB_FUNC( clsName ) { static HB_USHORT usClassH = 0; \
        if( usClassH == 0 ) { usClassH = hb_clsCreate( uiVar, #clsName );
#define CREATE_CLASS( clsName, uiVar )  DEFINE_CLASS( clsName , uiVar )

/* Esta es para DATAs que van a tener una funcion get y otra set */
#define VAR( clsName, szDataName, pGetFuncName, pSetFuncName ) \
    hb_clsAdd( usClassH, #szDataName, HB_FUNCNAME( clsName##_##pGetFuncName ) ); \
    hb_clsAdd( usClassH, "_"#szDataName, HB_FUNCNAME( clsName##_##pSetFuncName ) );
#define DATA( szDataName, pGetFuncName, pSetFuncName ) \
    VAR( szDataName, pGetFuncName, pSetFuncName );
/* Esta es para DATAs que van a tener una funcion unica para get y set */
#define SETGETVAR( clsName, szDataName, pFuncName ) \
    VAR( clsName, szDataName, pFuncName, pFuncName );
#define SETGETDATA( clsName, szDataName, pFuncName ) \
    VAR( clsName, szDataName, pFuncName, pFuncName );

/* Metodos */
#define METHOD( clsName, szName ) \
    hb_clsAdd( usClassH, #szName, HB_FUNCNAME( clsName##_##szName ) );
#define MESSAGE( clsName, szName, szMethod ) \
    hb_clsAdd( usClassH, #szName, HB_FUNCNAME( clsName##_##szMethod ) );
#define EXTERNAL_METHOD( szName, pFuncName ) \
    hb_clsAdd( usClassH, #szName, HB_FUNCNAME( pFuncName ) );

#define END_CLASS } hb_clsAssociate( usClassH ); }

//------------------------------------------------------------------------------
// Definicion de objetos de una clase
//------------------------------------------------------------------------------

/* Crea un objeto */
#define HB_CREATE_OBJECT( pCls, o ) \
    HB_FUNC_EXEC( pCls ); o = hb_itemNew( hb_stackReturnItem() )
/* Crea un objeto a partir de un item ya existente */
#define HB_CREATE_OBJECT_ITEM( pCls, o ) \
    HB_FUNC_EXEC( pCls ); hb_itemMove( ( o ), hb_stackReturnItem() )

//------------------------------------------------------------------------------
//  Varios
//------------------------------------------------------------------------------

/* Añade metodos a una clase pCls ya existente */
#define ADD_METHOD( pCls, szMethodName, pFuncName ) \
    ( hb_clsAdd( hb_objGetClass( pCls ), szMethodName, HB_FUNCNAME( pFuncName ) ) )

/* Obtiene Self en la implemantacion de los metodos de la clase */
#define HB_PSELF()          hb_stackSelfItem()
#define HB_RETURNOBJ( pSelf )       hb_itemReturnForward( ( pSelf ) )
#define HB_RETURNSELF( pSelf )      HB_RETURNOBJ( pSelf )

/* Implementacion */
#define HB_METHOD( clsName, szName )    HB_FUNC_STATIC( clsName##_##szName )
#define HB_PROCEDURE( clsName, szName ) HB_METHOD( clsName, szName )

#define HB_VAR( clsName, szName )   HB_METHOD( clsName, szName )
#define HB_DATA( clsName, szName )  HB_METHOD( clsName, szName )

/* Propiedad reflexiva */
#define HB_ISCLSOBJ( o )            HB_IS_OBJECT( ( o ) )
#define HB_CLASSNAME( o )           hb_objGetClsName( ( o ) )
#define HB_CLASSNAMESELF()          hb_stackSelfItem()

/* Ejecuta un metodo del objeto pasado */
#define HB_SENDMSG                      hb_objSendMsg

/* Ejecuta metodos dentro de la clase */
#define HB_SELF_EXEC( clsName, mtd )    HB_FUNC_EXEC( clsName##_##mtd )

/* Devuelve el nombre interno del metodo */
#define HB_METHODNAME( clsName, pName ) ( clsName##_##pName )

/* Clona un objeto "o" con otro objeto "wo" */
#define HB_OBJCLONE( o, wo )            hb_arrayCloneTo( ( o ), ( wo ) )

/* Obtiene el valor de una data directamente por su posicion */
/* Nota: Devuelve un puntero.
   void *HB_OBJGETPTR( PHB_ITEM obj, HB_UINT nPosData ) */
#define HB_OBJGETPTR( o, n )            hb_arrayGetPtr( ( o ), ( n ) )
/* Nota: Devuelve un PHB_ITEM.
   PHB_ITEM HB_OBJGETITEM( PHB_ITEM obj, HB_UINT nPosData ) */
#define HB_OBJGETITEM( o, n )       hb_arrayGetItemPtr( ( o ), ( n ) )
#define HB_OBJGETDATA( o, n )       HB_OBJGETITEM( o, n )
#define HB_OBJGETVAR( o, n )        HB_OBJGETITEM( o, n )
/* Asigna un valor directamente a una data del objeto por su posicion */
/* Este para asignar un puntero */
#define HB_OBJSETPTR( o, n, p )     hb_arraySetPtr( ( o ), ( n ), ( p ) )
/* Este para asignar un ITEM */
#define HB_OBJSETITEM( o, n, v )    hb_arraySet( ( o ), ( n ), ( v ) )
#define HB_OBJSETDATA( o, n, v )    HB_OBJSETITEM( o, n, v )
#define HB_OBJSETVAR( o, n, v )         HB_OBJSETITEM( o, n, v )

//------------------------------------------------------------------------------
#endif /* MYCLASS_H */
//------------------------------------------------------------------------------

[xmanuel]

Antonio me pidió que pusiese un ejemplo de myClass.h y aquí va, por cierto te neis que agregar una linea en myClass.h

Code: Select all  Expand view  RUN

#define HB_VAR( clsName, szName )   HB_METHOD( clsName, szName )
#define HB_DATA( clsName, szName )  HB_METHOD( clsName, szName )
#define HB_SETGETDATA( clsName, szName ) HB_METHOD( clsName, szName ) // Esta linea hay que agregarla
 

Vamos ver como se diseña una clase para usar desde PRG en C, se trata de un ejemplo de la clase TPoint

Code: Select all  Expand view  RUN

#include <hbapi.h>
#include <hbapicls.h>
#include <hbapiitm.h>
#include <hbstack.h>

#include "myClass.h"

typedef struct
{
    int x;
    int y;
} Point;

//-----------------------------------------------------------------------------
// Predefinicion de las datas y metodos para poder usarlos en cualquier lugar
// del codigo
//-----------------------------------------------------------------------------

HB_DATA( TPOINT, GET_X );
HB_DATA( TPOINT, SET_X );
HB_SETGETDATA( TPOINT, GETSET_Y );
HB_METHOD( TPOINT, INIT );
HB_METHOD( TPOINT, END );

HB_FUNC( QOUT );

//-----------------------------------------------------------------------------
// Definicion de la clase (funcion de clase)

DEFINE_CLASS( TPOINT, 1 )
    // Datas:
    VAR( TPOINT, X, GET_X, SET_X )
    SETGETDATA( TPOINT, Y, GETSET_Y )

    // Metodo constructor
    METHOD( TPOINT, INIT )
    MESSAGE( TPOINT, NEW, INIT )   // Sinonimo de init

    EXTERNAL_METHOD( DISPLAY, QOUT )

    METHOD( TPOINT, END )
END_CLASS

//-----------------------------------------------------------------------------
// DATAS
//-----------------------------------------------------------------------------
// Por separado el GET y el SET

HB_DATA( TPOINT, GET_X )
{
    PHB_ITEM pSelf = HB_PSELF();
    Point *p = HB_OBJGETPTR( pSelf, 1 );

    hb_retni( p->x );
}

//------------------------------------------------------------------------------

HB_DATA( TPOINT, SET_X )
{
    PHB_ITEM x = hb_param( 1, HB_IT_INTEGER );

    if( x )
    {
        PHB_ITEM pSelf = HB_PSELF();
        Point *p = HB_OBJGETPTR( pSelf, 1 );

        p->x = hb_itemGetNI( x );
    }
}

//------------------------------------------------------------------------------
// Juntos el get y el set

HB_SETGETDATA( TPOINT, GETSET_Y )
{
    PHB_ITEM pSelf = HB_PSELF();
    Point *p = HB_OBJGETPTR( pSelf, 1 );
    PHB_ITEM y = hb_param( 1, HB_IT_INTEGER );

    if( y ) // Si se pasa un valor es asignar
    {
        p->y = hb_itemGetNI( y );
    }

    // Siempre vamos a devolver el valor de Y
    hb_retni( p->y );
}

//------------------------------------------------------------------------------
// METODOS
//------------------------------------------------------------------------------

HB_METHOD( TPOINT, INIT )
{
    PHB_ITEM pSelf = HB_PSELF();
    Point *p = ( Point * ) hb_xgrab( sizeof( Point ) );

    if( p )
    {
        p->x = 0;
        p->y = 0;
    }

    // Asigna la estructura recien creada a la clase
    HB_OBJSETPTR( pSelf, 1, p );

    // Un constructor siempre devuelve SELF
    HB_RETURNSELF( pSelf );
}

//------------------------------------------------------------------------------

HB_METHOD( TPOINT, END )
{
    PHB_ITEM pSelf = HB_PSELF();
    Point *p = ( Point * ) HB_OBJGETPTR( pSelf, 1 );

    if( p )
    {
        hb_xfree( p );
        HB_OBJSETPTR( pSelf, 1, NULL );
    }
}

//------------------------------------------------------------------------------
 

y ahora un ejemplo de uso en el que se ve que funciona como una clase hecha en PRG:

Code: Select all  Expand view  RUN

procedure main

    local p := Tpoint():new()

    Cls

    p:display( "Antes de asignar" )
    p:display( "x", p:x )
    p:display( "y", p:y )

    p:x := 10
    p:y := 25

    p:display( "Despues de asignar" )
    p:display( "x", p:x )
    p:display( "y", p:y )

    p:end()

    inkey( 100 )
return
 

Posiblemente sólo deberíais hacer eso en clases crítica para acelerar el proceso o si estais familiarizados con el Lenguaje C.

Salu2