/****************************************************************************
    File: SampDll.c
    Contains a simple example DLL to illustrate how DLLs are called from
    the CeSk programming lanaguage
*******************************************************************************/

#include "windows.h"
#include "windacts.h"
#include "sampdll.h"

long 	GetVarSize( union   varObj  FAR *);
void    process1array(double FAR *,union varObj FAR *);

/* Main entry point for the library - all libraries have this entry point */
/* Input: See Programmers Reference manual for details */
int FAR PASCAL LibMain(hModule, wDataSeg, cbHeapSize, lpszCmdLine)
HANDLE  hModule;
WORD    wDataSeg;
WORD    cbHeapSize;
LPSTR   lpszCmdLine;
{
    return 1;
}

/* Main exit routine for a DLL, tidies up any resources etc from DLL */
/* See Programmers reference manual for details and parameters */
int FAR PASCAL WEP (bSystemExit)
int  bSystemExit;
{
    return(1);
}

/**************************** Our DLL Code *******************************/

/* our example function for the DLL call, this function has been exported */
/* in the SAMPDLL.DEF file */
/* Input: hData - a handle to a global memory object containing a CeSk data */
/*        array */
/* Output: a HGLOBAL containing a CeSk double*/
/* This example adds up all the positive numbers to give a total and */
/* ignores any negative numbers, or non-numeric objects in the input array */
HGLOBAL FAR PASCAL sumofpos(hData)
        HGLOBAL hData;
        {
                DataObj   FAR *op1;
                double  total;
                HGLOBAL result;

                total=0e0;
                if (hData) {
                        op1=PtrContent(hData);
                        process1array(&total,op1);
                        GlobalUnlock(hData);
                };

                /* now package the result as a CeSk double */
                result=GlobalAlloc(GHND,sizeof(struct t_double));
                if (!result) return NULL;
                op1=(union varObj FAR *)GlobalLock(result);
                op1->tdouble.vtype=3;              /* type double */
                op1->tdouble.value=total;
                GlobalUnlock(result);
                return result;
        };

/****************** subsidiary routines used by this DLL *****************/

/* process one CeSk item in the array, this is a reentrant routine */
/* which processes an element, or an array of elements, adding the */
/* positive numbers together and ignoring the rest */
/* Input: ptotal - ptr to the current total */
/*        op1 - ptr to the item to process */
/* Output: adjusts the value pointed to by ptotal */
void    process1array(ptotal,op1)
        double  FAR *ptotal;
        union varObj    FAR *op1;
        {
                short   elements,i;
                double  val;

                if (op1->tint.vtype==11) {
                        /* process an array */
                        elements=op1->tarray.elements;
                        op1=(union varObj FAR *)(op1->tarray.value);
                        for (i=0; i<elements; i++) {
                                process1array(ptotal,op1);
                                op1=(union varObj FAR *)(((char FAR *)(op1))+GetVarSize(op1));
                        };
                } else {
                        /* process a single element */
                        switch (op1->tint.vtype) {
                                case 2: /* CeSk Float */
                                        val=(double)(op1->tfloat.value);
                                        break;
                                case 3: /* CeSk double */
                                        val=op1->tdouble.value;
                                        break;
                                case 1: /* CeSk integer */
                                        val=(double)(op1->tint.value);
                                        break;
                                case 9: /* CeSk Complex Number */
                                        val=op1->tcomplex.realpart;
                                        break;
                                default:
                                        val=0e0;
                                        break;
                        };
                        if (val>0e0) *ptotal+=val;
                };
        };