/****************************************************************************/
/*                                                                          */
/*  font.c                                                                  */
/*                                                                          */
/*  Implementation des fonctions du package font.pkg                        */
/*                                                                          */
/****************************************************************************/


//
// Modifications History
//
//$LB (07/02/2003) : flags debug
//


#include "x/Version.h"
#include "x/scolplugin.h"

#include <stdio.h>
#include <string.h>

#include "objstr.h"



   


HFONT DefaultFont = NULL ;




/****************************************************************************************/
/*                                                                                      */
/* HFONT NewObjFont ( PtrObjFont , char * Name ) ;                                      */
/*                                                                                      */
/* Cree une nouvelle font                                                               */
/*                                                                                      */
/****************************************************************************************/

HFONT NewObjFont ( PtrObjFont F , char * Name )
{

        int FF , Weight , Italic , Underline , Strike ;

//***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nNewObjFont");
#endif
//***********************************

        FF = F->Flags ;
        if ( FF & FF_WEIGHT ) Weight = 700 ; else Weight = 0 ;
        if ( FF & FF_ITALIC ) Italic = 1 ; else Italic = 0 ;
        if ( FF & FF_UNDERLINE ) Underline = 1 ; else Underline = 0 ;
        if ( FF & FF_STRIKED ) Strike = 1 ; else Strike = 0 ;
        if ( FF & FF_PIXEL ) F->Height=-MulDiv(F->Height , GetDeviceCaps(GetDC(NULL),LOGPIXELSY), 72);
     

//***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nNewObjFont end");
#endif
//***********************************
        
      return CreateFont ( F->Height , 0 , 0 ,
        F->Direction , Weight , Italic , Underline , Strike ,
        DEFAULT_CHARSET , 0 , 0 , 0 , 0 , Name ) ;
}



/*****************************************************************************/
/*                                                                           */
/*  int GRSetDefaultFont ( mmachine m )                                      */
/*                                                                           */
/*   correspond a la fonction magma ObjFont _SETdefaultFont ( ObjFont ) ;    */
/*   laquelle definit la police par default                                  */
/*                                                                           */
/*****************************************************************************/

int GRSetDefaultFont ( mmachine m ) 
{
    int s ;
    PtrObjVoid O ;
    PtrObjFont F ;

//***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nGRSetDefaultFont");
#endif
//***********************************

    s = MMpull(m);
    if ( s != NIL )
    {
        O = ( PtrObjVoid ) MMstart(m,(s>>1) ) ;
        F = ( PtrObjFont ) MMstart(m,(O->Buffer>>1) ) ;
        DefaultFont = F->WHandler ; 

    } else DefaultFont = NULL ;


//***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nGRSetDefaultFont end");
#endif
//***********************************

    return MMpush(m,s) ;
}
 
/*****************************************************************************/
/*                                                                           */
/*  int GRGetDefaultFont ( mmachine m ) ;                                    */
/*                                                                           */
/*  correspond a la fonction magma ObjFont _GETdefaultFont ( ) ;             */
/*  laquelle retourne la font par default                                    */
/*                                                                           */
/*****************************************************************************/

int GRGetDefaultFont ( mmachine m ) 
{
    int p ;


//***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nGRGetDefaultFont");
#endif
//***********************************

    if (DefaultFont == NULL) return MMpush(m,NIL);
    else
    {
        p = OBJfindTH(m,OBJTYPTEXT,(int)DefaultFont);
        if ( p != NIL ) p = MMfetch(m,p,OFFOBJMAG);
//***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nGRGetDefaultFont end");
#endif
//***********************************

        return MMpush(m,p);
    }
}









/*****************************************************************************/
/*                                                                           */
/* int GRCreateFont ( mmachine m )                                           */
/*                                                                           */
/* correspond a la fonction magma Obj _create_font ( I I I S )               */
/* laquelle cree un objet Font                                               */
/*                                                                           */
/*****************************************************************************/

int GRCreateFont ( mmachine m )
{
    PtrObjVoid O ;
    PtrObjFont F ;
    int s , l , s2 , res ;
    HFONT HW ;
    char Name [ 256 ] ;

//***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nGRCreateFont");
#endif
//***********************************

    /* teste le channel */
    if (MMget(m,4)==NIL)
    {
        MMechostr(MSKDEBUG,"_CRfont : Channel is NIL\n") ;
        m->pp+=4;
        return 0;
    }


    s = MMpull(m) ;
    if (( s == NIL )||(MMsizestr(m,s>>1)>128)) strcpy ( Name , "" ) ;
    else strcpy ( Name , ( char * ) MMstartstr(m, (s>>1)) ) ;
    Mpushstrbloc ( m , Name ) ;


    l = ( sizeof ( struct ObjVoid ) + 3 ) >> 2 ;
    s = MMmallocCLR (m,l,TYPETAB) ;
    if( s == NIL ) return MERRMEM ;
    if ( MMpush(m,(s<<1)+1)) return MERRMEM ;
    l = ( sizeof ( struct ObjFont ) + 3 ) >> 2 ;
    s2 = MMmalloc ( m,l,TYPEBUF ) ;
    if ( s2 == NIL ) return MERRMEM ;
    s = MMpull(m) ;

    O = ( PtrObjVoid ) MMstart(m, (s>>1) ) ;
    F = ( PtrObjFont ) MMstart(m, s2 ) ;
    O->Type = OBJ_TYPE_FONT << 1 ;
    O->Tab = NIL; MMpull(m) ;  //   SH000111
    O->Buffer = ( s2 << 1 ) + 1 ;  
    F->Flags = MMpull(m) >> 1 ;
    F->Direction = MMpull(m) >> 1 ;
    F->Height = MMpull(m) >> 1 ;   
    O->Father = NIL ;

    HW = NewObjFont ( F , Name ) ;    
    if ( ! HW )
    {
        MMechostr(MSKDEBUG,"ERROR : _create_font : WIN95 can't create the font : Check the values\n" ) ;
        MMset(m,0,NIL);
        return 0 ;
    }
    F->WHandler = HW ;
    MMpush(m,s) ;
    res = OBJcreate (m,OBJTYPFONT,(int)HW,0,(int)NULL) ;
	//MMechostr(1,"----> _CRfont id:%d\n",(int)F->WHandler);

//***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nGRCreateFont end");
#endif
//***********************************

    return res ;
}




/*****************************************************************************/
/*                                                                           */
/* int GRAffectGFont ( mmachine m ) ;                                        */
/*                                                                           */
/* correspond a la fonction magma Obj _affect_font [ Obj Obj ]               */
/* laquelle affecte une police de caractere a un objet contenant du texte    */
/*                                                                           */
/*****************************************************************************/

int GRAffectFont ( mmachine m )
{

    PtrObjVoid OF , OC ;
    PtrObjFont FF ;    
    int s , s2 , res ;
    HWND H ;

//***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nGRAffectFont");
#endif
//***********************************

    s2 = MMpull(m) ;
    s = MMpull(m) ;
    if ( s2 == NIL )
    {
        MMechostr ( 1 , "AffectFont : Font object is NIL\n" ) ;
        return MMpush(m,s) ;
    }
    OF = ( PtrObjVoid ) MMstart(m,(s2>>1) ) ;    
    
    if ( s == NIL )
    {
        MMechostr ( 1 , "AffectFont : Affetect object is NIL\n" ) ;
        return MMpush(m,s) ;
    }
    OC = ( PtrObjVoid ) MMstart(m,(s>>1) ) ;
    FF = ( PtrObjFont ) MMstart(m,(OF->Buffer>>1) ) ;

    switch ( OC->Type >> 1 )
    {
        case OBJ_TYPE_TEXT :
        case OBJ_TYPE_EDIT_LINE :
        case OBJ_TYPE_EDIT_TEXT :

            H = (( PtrObjText ) MMstart(m,(OC->Buffer>>1) )) ->WHandler ;
            break ;

        case OBJ_TYPE_PUSHBUTTON :
        case OBJ_TYPE_CHECK_BOX :
            H = ((PtrObjButton ) MMstart(m,(OC->Buffer>>1) )) ->WHandler ;
            break ;


        case OBJ_TYPE_COMBO_BOX :
        case OBJ_TYPE_LIST_BOX :
            H = (( PtrObjCombo ) MMstart(m,(OC->Buffer>>1) )) ->WHandler ;
            break ;

        case OBJ_TYPE_WINDOW :
            H = ((PtrObjWindow ) MMstart(m,(OC->Buffer>>1)))->WHandler ;
            break ;
       
        default :
            MMechostr ( 1 , "You can't affect a font to this type of object\n" ) ;
            H = NULL ;
        
        break ;
    }
    
    if ( H )  SendMessage ( H , WM_SETFONT , ( WPARAM ) FF->WHandler , ( LPARAM ) TRUE ) ;      

    res = MMpush(m,s) ;

//***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nGRAffectFont end");
#endif
//***********************************

    return res ;
}
      

/**********************************************************************/
/*                                                                    */
/*  int GRDestroyObjFont ( mmachine m )                               */
/*                                                                    */
/* correspond a la fonction magma I _destroy_obj_font ( ObjFont )     */
/* laquelle detruit une police de caractere                           */
/*                                                                    */
/**********************************************************************/

int GRDestroyObjFont ( mmachine m )
{
    int s ;
    PtrObjVoid O ;
    HFONT h ;

//***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nGRDestroyObjFont");
#endif
//***********************************

    s = MMget(m,0) ;
    if ( s != NIL )
    {
        O = ( PtrObjVoid ) MMstart(m,(s>>1) ) ;
        h = (( PtrObjFont ) ( MMstart(m, (O->Buffer>>1 )) ))->WHandler ;
        MMechostr(1,"----> _DSfont id:%d\n",(int)h);
		OBJdelTH(m,OBJTYPFONT,(int)h) ;
    }
    
//***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nGRDestroyObjFont end");
#endif
//***********************************

    MMset(m,0,0) ;
    return 0 ;
}


/**************************************************************************************/
/*                                                                                    */
/*      int GRGetStringSize ( mmachine m ) ;                                          */
/*                                                                                    */
/*  correspond a la fonction magma [I I ] _GETstringSize ( font , strinf ) ;          */
/*                                                                                    */
/**************************************************************************************/

int GRGetStringSize ( mmachine m ) 
{
    int s , w , h ;
    PtrObjVoid  O ;
    PtrObjFont F ;
    char * text ;
    SIZE R ;
    HDC H ;
    HFONT oldfont;

 //***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nGRGetStringSize");
#endif
//***********************************

    s = MMpull ( m ) ;
    if ( s == NIL )
    {
       MMpull(m) ;
       w = 0 ; 
       h = 0 ; 
    } else
    {
        text = ( char * ) MMstart(m,(s>>1)+1) ;
        s = MMpull ( m ) ;
        if ( s == NIL )
        {
            w = 0 ; 
            h = 0 ;
        } else 
        {
            O = ( PtrObjVoid ) MMstart(m,(s>>1));
            F = ( PtrObjFont ) MMstart(m,(O->Buffer>>1)) ;
            H = CreateCompatibleDC ( NULL ) ;
            oldfont = SelectObject (H,F->WHandler);
            GetTextExtentPoint32 ( H , text , strlen ( text ) , &R ) ;
            SelectObject(H,oldfont);
            DeleteDC ( H ) ;
            w = R.cx ;
            h = R.cy ;
        }
    }

    if ( MMpush(m,w<<1)) return MERRMEM ;
    if ( MMpush(m,h<<1)) return MERRMEM ;
    if ( MMpush(m,4)) return MERRMEM ;
    s = MBdeftab ( m ) ;

 //***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nGRGetStringSize end");
#endif
//***********************************
		return s;
      
}
