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


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

//$BLG - v5.11: Add
#define _WIN32_WINNT 0x0501
#include <Windows.h>

#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;
  //$BLG - v5.11: Add - FF_CLEARTYPE
  int Quality;

//***********************************
#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);
  //$BLG - v5.11: Add
  if (FF & FF_CLEARTYPE) Quality = CLEARTYPE_QUALITY; else Quality = NONANTIALIASED_QUALITY;


//***********************************
#if DEBUG_LIB2DOS
MMechostr (0, "\nNewObjFont end");
#endif
//***********************************
  
  //$BLG - v4.6a4: Modifications to implement rotation of Fonts
  //return CreateFont ( F->Height , 0 , 0 ,
  //F->Direction , Weight , Italic , Underline , Strike ,
  //DEFAULT_CHARSET , 0 , 0 , 0 , 0 , Name ) ;
  //
  //Changed nEscapement    (Line1, param3)  from 0 to F->Direction
  //Changed nOrientation   (Line2, param1)  from F->Direction to 0
  //-> The original code seemed logical regarding MSDN documentation.
  //-> However, the explanations may date back to Win95, when these two parameters were differenciated.
  //-> Found on a more recent developer site that only the first parameter was taken into account.
  //-> Seems to be ok like this on tested systems (Win98, WinMe, WinXP)
  //Changed nOutPrecision  (Line3, param2)  from OUT_DEFAULT_PRECIS (0) to OUT_TT_ONLY_PRECIS (7)
  //-> We force the use of TrueType Fonts. Only TTFs can be oriented. 
  //-> The few existing Raster Fonts will be replaced by approaching TTFs.
  //Changed nClipPrecision (Line3, param3)  from CLIP_DEFAULT_PRECIS (0) to CLIP_LH_ANGLES (16)
  //-> This is necessary to implement rotations
  //
  //$BLG - v5.11: Modif
  //return CreateFont(F->Height,0 ,F->Direction, 0, Weight, Italic, Underline, Strike, ANSI_CHARSET, 7, 16, 0, 0, Name);
  return CreateFont(F->Height, 0, F->Direction, 0, Weight, Italic, Underline, Strike, ANSI_CHARSET, 7, 16, Quality, 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(0,"----> _CRfont id:%d s:%d s2:%d res:%d\n", (int)F->WHandler, s, s2, res);

//***********************************
#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;
      
}