/*******************************************************************************
 Plugin Image
 Client part
 Version: 1.0
 Authors: Laurent Plumat, Jeremy GIAIME
 Last update: 27/06/2001
 Image Plugin
*******************************************************************************/

typeof class=S;; /* Plugin class name (here is template) */

struct Tdata = 
[
  BMbitmap      : ObjBitmap,/*picture to use for texture*/
  Sbitmap       : S,        /*picture on string*/
  RSCdownload   : RSC,      /*RSC download active?*/
  INETdownload  : INET      /*INET download active?*/
] mkData;;

typeof myObs = [[Ob Tdata] r1];;
 

fun myObByName (e, b) =
  let e -> [o _] in
    !strcmp ObName o b
;;

fun myObByOb (e, b) =
  let e -> [o _] in
   o == b
;;

/********************************************************************************
  load the BMP or jpeg Bitmap
  name -> S                : name of the bitmap
  param -> [ObjBitmap S I] : variable to fill with the bitmap, name of the bitmap
*********************************************************************************/
fun openBMP(fichier)=
  if fichier == nil then
    nil
  else
  (
    let _LDbitmap _channel _checkpack fichier -> bmp in
    (
      if bmp==nil then
        set bmp = _LDjpeg _channel _checkpack fichier
      else
        bmp
    )
  )
;;

/************************************************
  apply the nex texture on the material
    anchor -> anchor
    param -> parameter : not used
*************************************************/
fun apply_on_mat(anchor, z)=
  match anchor with
  (
    objAnchor [_ mat _ _] ->
    (
      if mat!=nil then
      (  
        if (mat!=nil) then
          let _CRbitmap _channel 256 256 -> newBitmap in 
          let M3copyMaterialTexture session mat -> BMtxt in
          (
            let _GETbitmapSize z.BMbitmap -> [tempW tempH] in
            _SCPbitmap newBitmap 0 0 255 255 z.BMbitmap 0 0 tempW-1 tempH-1 nil;
            M3blitTexture16 session BMtxt newBitmap;
            M3chgMaterialTexture session mat BMtxt;
            0
          )  
        else
          nil
      )
      else
        nil
    )
  )
  |(_->nil);
   
  0
;;
    
/**********************************************
  apply the texture on all anchorlist
***********************************************/
fun change_anchor_mat (anchorlist, z) = 
  if anchorlist == nil then
    nil 
  else
    apply_on_list anchorlist @apply_on_mat z;
  M3freeMemory(session);
  0
;;             

/******************************************************************************
  apply the texture when it's download
******************************************************************************/
fun cbDownload (imageName, param) =
  let param -> [o z] in
  (
    set z.BMbitmap = openBMP imageName;
    change_anchor_mat ObAnchor o z; /*Change the texture in the anchor*/   
    set z.RSCdownload = nil;
    _DMSevent this strcatn (ObName o)::".imageShowed"::nil nil nil;
    _DMSevent this strcatn class::".imageShowed"::nil strbuild ("instance"::(ObName o)::nil)::nil nil
  );
  0
;;

/*******************************************************************************
  download the texture
  ui     -> UserI  : user instance
  action -> S      : action
  param  -> S      : parameters
         <- I      : not used
********************************************************************************/
fun cbApply_Bitmap (ui,action,param,obj)=
  let obj -> [o z] in
  if z.RSCdownload == nil then
    set z.RSCdownload = _RSCdownload this param param mkfun2 @cbDownload [o z] 0
  else
    nil;
  
  0
;;

/**************************************************
 INETGetURL Callback
  inet -> INET    : the http client
  o -> ob         : Object
  content -> S    : value 
  reason -> I     : end
**************************************************/    
fun cb_geturl (inet, o, content, reason, z) =
  if reason == 0 then
  (
    set z.Sbitmap = strcat z.Sbitmap content;    
    0
  )
  else if reason == 1 then
  (
    /*passage d'un texte a une image*/
    _storepack z.Sbitmap "tmp/image/image.tmp";
    set z.BMbitmap = openBMP "tmp/image/image.tmp";
    
    change_anchor_mat ObAnchor o z;
    _DMSevent this strcatn (ObName o)::".imageShowed"::nil nil nil;
    _DMSevent this strcatn class::".imageShowed"::nil strbuild ("instance"::(ObName o)::nil)::nil nil;
    set z.INETdownload = nil;
    0
  )
  else
  (
    set z.INETdownload = nil;
    0 /*error*/
  )
;;

/*******************************************************************************
  download an url for texture
  ui     -> UserI  : user instance
  action -> S      : action
  param  -> S      : parameters
         <- I      : not used
********************************************************************************/
fun cbApply_Url (ui,action,url,obj)=
  let obj -> [o z] in
  if z.INETdownload == nil then
    set z.INETdownload = INETGetURL _channel url 0 mkfun5 @cb_geturl z o 
  else
    nil;
  0
;;

/*******************************************************************************
  show the value of contents
    value -> picture in string format
    o -> Ob
    z -> data
*******************************************************************************/
fun showContents (value, o, z)=
  set z.BMbitmap = _CRbitmap _channel 400 300;
  _SETbitmap z.BMbitmap value;
  change_anchor_mat ObAnchor o z
;;

/*******************************************************************************
   apply the given position of a texture on texture list
   
   o            ->  Ob        : 
   from         ->            :
   action       ->  S         :
   param        ->            :
   reply        ->            :
   MyStruct     -> TmyParam   : structure
*******************************************************************************/    
fun cbshowImage (o, from, action, param, reply, z) =
  let strextr param -> l in
  let getInfo l "type" -> type in
  let getInfo l "value" -> value in  
    if !strcmp type "file" then
      cbDownload value [o z]
    else if !strcmp type "contents" then
      showContents value o z
    else if !strcmp type "url" then
      cbApply_Url nil nil value [o z]
    else
      0
;;

fun cbDestroyImage (o, z) =
  set myObs = removef_from_list myObs @myObByOb o;
  0
;;

fun cbClickLink (o, obj, mat, button) =
  _DMSevent this strcat class ".click" strbuild ("instance"::(ObName o)::nil)::nil nil
;;

/*******************************************************************************
  Defines the callbacks of the links in the anchor, and return the list of them
    <- [[H3d HMat3d S ObjCursor fun [Ob H3d HMat3d I] I fun [Ob H3d HMat3d I] I fun [Ob H3d HMat3d] I] r1] 
*******************************************************************************/
proto GetLinks = 
  fun [[Anchor r1]] [[H3d HMat3d S ObjCursor fun [Ob H3d HMat3d I] I fun [Ob H3d HMat3d I] I fun [Ob H3d HMat3d] I] r1];;
  
fun GetLinks(l)=
  if l==nil then
    nil
  else
    match hd l with
	    (objAnchor [ah am name _] -> ([ah am nil HandCursor @cbClickLink nil nil]::(GetLinks tl l)))
    | (_->(GetLinks tl l))
;;


/*******************************************************************************
  New object creation
  o -> Ob  : object
    <- I   : not used
*******************************************************************************/
fun newOb(o)=
  let mkData [nil nil nil nil] -> z in
  (
    set myObs = [o z]::myObs;

    let (hd UgetParam ObUi o "type") -> type in
      if !strcmp type "file" then
        cbApply_Bitmap nil nil hd UgetParam ObUi o "value" [o z]
      else if !strcmp type "url" then
        cbApply_Url nil nil hd UgetParam ObUi o "value" [o z]
      else
        nil;
  
    ObRegisterAction o (strcatn (ObName o)::".showImage"::nil) mkfun6 @cbshowImage z;
    
    ObSetLinks o GetLinks ObAnchor o;
    
    ObCbDestroy o mkfun2 @cbDestroyImage z;
    
    UcbMessage ObUi o ["BitmapReady" mkfun4 @cbApply_Bitmap [o z]]::
                      ["UrlReady" (mkfun4 @cbApply_Url [o z])]::nil
  );
  0
;;

fun cbGlobalShow (from, action, param, ulist, tag) =
  let strextr param -> l in
  let hd switchstr l "url" -> url in
  let hd switchstr l "instance" -> instance in
  let search_in_list myObs @myObByName instance -> e in
    if e == nil then
      nil
    else
      let e -> [o z] in
        cbApply_Url nil nil url [o z];
  0
;;

/*******************************************************************************
  Function to define in all plugins for registration
  file -> S : '*.plug' file name
       <- I : not used
*******************************************************************************/
fun IniPlug(file)=
  set class=getInfo strextr _getpack _checkpack file "name";
  
  _DMSdefineActions this [strcat class ".showImage" @cbGlobalShow]::nil;
  
  PlugRegister class @newOb nil;
  0
;;