/*
  M3d and Texture Ressources - April 2000 - by Jocelyn DUMAY
  modified - April 2001 - by Macfly
  modified - October 2001 - by Macfly : adding box management
*/


struct Files=[
  Dimg          : S,           /* la bmp rescenssant tous les fichiers                             */
  Dfiles        : [S r1]       /* la liste de fichiers presents dans le repertoire [Name Fullpath] */
]mkFiles;;


struct NodePath=[
  NoSon         : NodePath,
  NoBro         : NodePath,
  NoRefPath     : S,           /* le chemin exact du repertoire */
  NoPath        : S,           /* le nom du repertoire          */
  NoM3d         : Files,       /* les fichiers m3d              */
  NoText        : Files,       /* les fichiers de texture       */
  NoBox         : Files        /* les fichiers box              */
]mkNodePath;;

struct Mini3d=[
  miniSession   : S3d,
  miniShell     : H3d,
  miniCam       : H3d,
  miniOb        : H3d,
  miniBuff      : ObjBitmap
]mkMini3d;;


typeof ExplRootSrv    = NodePath;;
typeof ExplRefPath    = S;;
typeof ExplRefBmpPath = S;;
typeof ExplSrvM3dFile = S;;
typeof ExplSrvTextFile= S;;
typeof ExplSrvBoxFile = S;;
typeof ExplBmpSize    = I;;
typeof ExplMini3d     = Mini3d;;

var M3D      = 1;;
var TEXTURE  = 2;;
var BOX      = 3;;

var m3dExt        = "m3d"::nil;;
var txtExt        = "jpg"::"jpeg"::"bmp"::nil;;
var boxExt        = "box"::nil;;
var ndx           = 0;;
var ExplCamFile   = "Dms/3d/cam1.m3d";;

var Defrefpath        ="lib";;
var Deftmppath        ="tmp/expl";;
var Defbmpsize        ="16";;

/* fonction qui renvoie le dernier path à partir du
   chemin complet full et de la reference ref
*/
fun getLastPath(full,ref)=
  substr full (strlen ref)+(if (strfind "/" full 0)!=nil then 1 else 0) strlen full;;

/* fonction qui renvoie le chemin p en fontion
   du referentiel global
*/
fun getPath(p)=
  if !(strcmp ExplRefPath "") then p
  else if !(strcmp p "") then ExplRefPath
  else strcatn ExplRefPath::"/"::p::nil;;

/* fonction qui renvoie la liste des derniers path à
   partir des chemins complets
*/
fun extractName(l,ref)=
  if l==nil then nil
  else let l -> [n nxt] in
      (getLastPath n ref)
      ::extractName nxt ref;;

fun StrCompare(s1,s2)=!(strcmp s1 s2);;

fun suppDoublon(s1,s2)=strcmp s1 s2;;

/* fonction qui à partir d'une liste de fichiers renvoie
   la liste des fichiers dont l'extension correspond à
   une extension presente dans la liste ext
*/
fun ListOfFiles(l,ext)=
  if l==nil then nil
  else
    let l -> [file nxt] in
    let strlen file -> len in
    let substr file len-3 3 -> three in
    let substr file len-4 4 -> four in
    if ((search_in_list ext @StrCompare three)!=nil)||
       ((search_in_list ext @StrCompare four)!=nil)
    then
       file::ListOfFiles nxt ext
    else
       ListOfFiles nxt ext;;

/* fonction de creation d'un nouveau Files */
fun newFiles(l,dir,type)=
  if l==nil then nil
  else
     mkFiles[strcatn ExplRefBmpPath::"/"::dir::"/list"::type::".bmp"::nil l];;


/* fonction ajoutant un noeud name au NodePath Noeud
   en tant que premier fils
*/
fun AddNodePath(Noeud,name)=
  let if Noeud!=nil then
      mkNodePath[nil
                 Noeud.NoSon
                 (if !(strcmp Noeud.NoRefPath "") then name else  strcatn Noeud.NoRefPath::"/"::name::nil )
                 name
                 nil
                 nil
                 nil
                ]
      else
      mkNodePath[nil
                 nil
                 ""
                 "Server"
                 nil
                 nil
                 nil
                ]
      -> newNoeud in
  let getPath newNoeud.NoRefPath -> dir in
  let extractName quicksort _listoffiles dir @suppDoublon dir -> l in
  {
    set Noeud.NoSon=newNoeud;
    set newNoeud.NoM3d=newFiles ListOfFiles l m3dExt dir "m3d";
    set newNoeud.NoText=newFiles ListOfFiles l txtExt dir "texture";
    set newNoeud.NoBox=newFiles ListOfFiles l boxExt dir "box";
    newNoeud
  };;

/* fonction creant l'arborescence des fils de Noeud à partir de la list
   ldir des repertoires
*/
fun CrNodePath(Noeud,ldir)=
  if ldir==nil then 0
  else
    let ldir -> [n nxt] in
    {
      let AddNodePath Noeud n -> newNoeud in
      let getPath newNoeud.NoRefPath -> dir in
        CrNodePath newNoeud extractName (quicksort _listofsubdir dir @suppDoublon) dir;
      CrNodePath Noeud nxt
    };;

fun _fooFiles(f,s)=
  if f==nil then nil
  else let f-> [n nxt] in
    (s::"****file:"::n::nil)::_fooFiles nxt s;;

fun _fooNodePath(Node,s)=
  if Node==nil then 0
  else
  {
    _fooS strcatn s::"--Node ref:"::Node.NoRefPath::nil;
    _fooS strbuild ("filem3d:"::Node.NoM3d.Dimg::nil)::_fooFiles Node.NoM3d.Dfiles strcat s "--";
    _fooS strbuild ("filetext:"::Node.NoText.Dimg::nil)::_fooFiles Node.NoText.Dfiles strcat s "--";
    _fooS strbuild ("filebox:"::Node.NoBox.Dimg::nil)::_fooFiles Node.NoBox.Dfiles strcat s "--";
    _fooNodePath Node.NoSon strcat s "--";
    _fooNodePath Node.NoBro s

  };;

/* fonctions de creation de la liste de sauvegarde de l'arborescence du serveur ********************/
fun CrStringDFiles(f)=
  if f==nil then nil
  else
    let f -> [n nxt] in
    ("elt"::n::nil)::CrStringDFiles nxt;;

fun CrStringFiles(f)=
  if f==nil then nil
  else
    ("res"::f.Dimg::nil)::CrStringDFiles f.Dfiles;;

fun GetFiles(Node,Type)=
  if (Type==M3D) then Node.NoM3d
  else if (Type==TEXTURE) then Node.NoText
  else if (Type==BOX) then Node.NoBox
  else nil
;;

fun CrStringNodePath(Node,Type)=
  if Node==nil then nil
  else
    let GetFiles Node Type -> ff in
    let conc (if Type == BOX then CrStringDFiles ff.Dfiles else CrStringFiles ff)
             CrStringNodePath Node.NoSon Type -> save in
    let !(strcmp Node.NoRefPath "") -> root in
    conc if save!=nil && !root then ("dir"::Node.NoPath::"{"::nil)::nil else nil
    conc save
    conc (if save!=nil && !root then ("}"::nil)::nil else nil)
         CrStringNodePath Node.NoBro Type;;

/* fonctions de creation des listes de bitmaps compressés representant chcune un directory **********/
fun LoadBitmap(Channel,file)=
  let _checkpack file -> pack in
  if pack==nil then nil
  else
    let _LDbitmap Channel pack -> bmp in
    if bmp==nil then
    {
      let _LDjpeg Channel pack -> jpeg in
      if jpeg==nil then nil
      else jpeg
    }
    else bmp;;

fun CrBmpFileText(bmpres,l,dir,i)=
  if l==nil then bmpres
  else
    let l -> [file nxt] in
    let LoadBitmap _channel (if (!strcmp dir "") then file
                             else strcatn dir::"/"::file::nil
                            ) -> bmpini in
    let _GETbitmapSize bmpini -> [w h] in
    {
      _SCPbitmap bmpres i*ExplBmpSize 0 (i+1)*ExplBmpSize-1 ExplBmpSize-1 bmpini 0 0 w-1 h-1 nil;
      _DSbitmap bmpini;
      CrBmpFileText bmpres nxt dir i+1
    };;


/* fonctions de construction de la liste compressés des m3d de chaque directory ************************/
fun initMini3d()=
  let mkMini3d [nil nil nil nil nil] -> mini in
  { set mini.miniSession=M3create _channel 1024 1024 1024 1024 1024*1024*4;
    if mini.miniSession==nil then nil
    else
    {
      set mini.miniShell=M3createShell mini.miniSession;
      set mini.miniOb=M3createShell mini.miniSession;
      M3link mini.miniSession mini.miniOb mini.miniShell;
      M3load mini.miniSession ExplCamFile mini.miniShell;
      set mini.miniCam = M3getObj mini.miniSession "camera";
      let M3getCamera mini.miniSession mini.miniCam->[dx _ z] in
      let ExplBmpSize/2 -> sx in
      M3setCamera mini.miniSession mini.miniCam [[ExplBmpSize ExplBmpSize] [sx sx] z];
      set mini.miniBuff= _CRbitmap _channel ExplBmpSize ExplBmpSize;
      mini
    }
  };;

fun destroyMini3d(mini)=
  M3destroy mini.miniSession;
  _DSbitmap mini.miniBuff;
  set mini=nil;;

fun remMini3dObj(mini)=
  if mini == nil then nil else
  let M3getFirstSon mini.miniSession mini.miniOb -> theObj in
    if theObj == nil then nil
    else M3delObj mini.miniSession theObj;;

fun newMini3dObj(bmpres,l,dir,i,mini)=
  if l==nil then 0
  else
    let l -> [file nxt] in
    let (if (!strcmp dir "") then file
         else strcatn dir::"/"::file::nil)
        -> name in
    { remMini3dObj mini;
      M3load mini.miniSession name mini.miniOb;
      M3renameObj mini.miniSession mini.miniOb name;
      M3recursFillMatObj mini.miniSession mini.miniOb;
      let M3getFirstSon mini.miniSession mini.miniOb -> son in
      let M3calcPosRef mini.miniSession son mini.miniShell -> [[x y z] _] in
      let (1+M3getRadius mini.miniSession son)*2->k in
      let [[x y z-k] [0 0 0]] -> [v a] in
      {
        M3setObjVec mini.miniSession mini.miniCam v;
        M3setObjAng mini.miniSession mini.miniCam a;
      };
      M3scanline mini.miniSession mini.miniBuff mini.miniCam 0 0 make_rgb 255 255 255;
      _CPbitmap16 bmpres i*ExplBmpSize 0 mini.miniBuff 0 0 ExplBmpSize ExplBmpSize nil;
      newMini3dObj bmpres nxt dir i+1 mini
    };;

fun CrBmpFiles(f,dir,func)=
  if f==nil then nil
  else
    let sizelist f.Dfiles -> size in
    let _CRbitmap _channel ExplBmpSize*size ExplBmpSize -> bmpres in
    {
      exec func with  [bmpres f.Dfiles dir 0];
      _createpack _FILEbitmap bmpres _getmodifypack f.Dimg;
      _DSbitmap bmpres
    };;

typeof thetext = ObjText;;
typeof thewindow = ObjWin;;

fun ShowingText (msg) =
  _SETtext thetext msg;
  _PAINTwindow thewindow;
  0
;;

fun CrBmpConc(Node, param)=
  let getPath Node.NoRefPath -> dir in
  {
    ShowingText strcatn (loc "GENERATE_DIR" nil)::" :\n"::(dir)::nil;
    CrBmpFiles      Node.NoText dir @CrBmpFileText;
    let initMini3d -> mini in
    {
      CrBmpFiles      Node.NoM3d  dir mkfun5 @newMini3dObj mini;
      destroyMini3d   mini
    };
    0
  };;

fun apply_on_tree(n,func,param)=
  if n==nil then 0
  else
  { exec func with [n param];
    apply_on_tree n.NoSon func param;
    apply_on_tree n.NoBro func param;
  };;

fun End(win,b)=
  _closemachine;;

var    DESC_M3D         ="exp_m3d_srv.tmp";;
var    DESC_TEXTURE     ="exp_text_srv.tmp";;
var    DESC_BOX         ="exp_box_srv.tmp";;
var    DESC_BMPTEMP     ="bmp";;

fun STR_IsEmpty (str) = (strextr str) == nil;;

fun CrDirAndFiles(pathref, tmppath, bmpsize) =
  if STR_IsEmpty pathref then
    set pathref = Defrefpath
  else
     nil;
  if STR_IsEmpty tmppath then
    set tmppath = Deftmppath
  else
     nil;
  if (atoi bmpsize) == 0 then
    set bmpsize = Defbmpsize
  else
     nil;

  iniLocEditor;

  let _CBwinDestroy _CRwindow _channel nil 100 100 480 90 WN_MENU (loc "GENERATE" nil) @End nil -> win in
  let _tickcount -> i in
  (
    _CRtext _channel win 10 10 460 40 ET_ALIGN_CENTER (loc "WAIT" nil);
    set thetext = _CRtext _channel win 10 50 460 40 ET_ALIGN_CENTER (loc "INIT" nil);
    /* creation de l'arborescence des fichiers serveurs */
    set ExplSrvM3dFile= strcatn tmppath::"/"::DESC_M3D::nil;
    set ExplSrvTextFile= strcatn tmppath::"/"::DESC_TEXTURE::nil;
    set ExplSrvBoxFile= strcatn tmppath::"/"::DESC_BOX::nil;
    set ExplRefBmpPath= strcatn tmppath::"/"::DESC_BMPTEMP::nil;
    set ExplBmpSize=atoi bmpsize;
    set ExplRefPath= pathref;
    set ExplRootSrv=AddNodePath nil "";
    set thewindow = win;
    ShowingText (loc "SCAN_FILES" nil);
    CrNodePath ExplRootSrv extractName (quicksort _listofsubdir ExplRefPath @suppDoublon) ExplRefPath;
    ShowingText (loc "CREATE_ARBO_M3D" nil);
    /* creation du fichier client de l'arborescence des fichiers du serveur */
    _createpack mzip strbuild CrStringNodePath ExplRootSrv M3D
                _getmodifypack ExplSrvM3dFile;
    ShowingText (loc "CREATE_ARBO_TEXTURE" nil);
    _createpack mzip strbuild CrStringNodePath ExplRootSrv TEXTURE
                _getmodifypack ExplSrvTextFile;
    ShowingText (loc "CREATE_ARBO_BOX" nil);
    _createpack mzip strbuild CrStringNodePath ExplRootSrv BOX
                _getmodifypack ExplSrvBoxFile;
    apply_on_tree ExplRootSrv @CrBmpConc nil;
    _closemachine;
    0
  )
;;