/* <Scol Technologies License> */
/* Copyright (c) 2003, organization : Scol Technologies Association, owner : Sylvain Huet */
/* For conditions of distribution and use, see copyright notice in dms/l/license.txt */
/* or on 'www.scol-technologies.org' */

/* sDHDMS - mar 00 - by Sylvain HUET */
/* document part */


typeof DMSdocs=DOC;;

var DOCpopup=1;;
var DOChomot=2;;
var DOCtiled=4;;
var DOCstretched=8;;

typeof Font=ObjFont;;
typeof StdCursor=ObjCursor;;
typeof HandCursor=ObjCursor;;
typeof CrossCursor=ObjCursor;;

struct Zone=
 [nameZone:S,coordZone:[I I I I I I I],usingZone:[[DMI fun [] I fun[[ObjWin I I I I]] I fun[] I]r1]
 ]mkZone;;

struct DOC=
 [sonsDOC:[DOC r1],fatherDOC:DOC,bmpnameDOC:S,bmpDOC:ObjBitmap,bmprscDOC:RSC,
  winDOC:ObjWin,nameDOC:S,typeDOC:I,coordDOC:[I I I I I I I],typebmpDOC:I,
  zonesDOC:[Zone r1]
 ]mkDOC;;

fun Otonil(s)=if s then s else nil;;

fun DocTreeLd(ll,m)=
 if ll==nil then nil
 else let ll->[l nxt] in
 let hd l -> s in if s==nil then DocTreeLd nxt m
 else if !strcmp s "doc" then
  let mkDOC [nil m Tunder nth_list l 10 nil nil nil nth_list l 1 atoi nth_list l 2
   [atoi nth_list l 3 atoi nth_list l 4 atoi nth_list l 5 atoi nth_list l 6 atoi nth_list l 7 atoi nth_list l 8 atoi nth_list l 9]
   atoi nth_list l 11 nil]-> a in
  (set m.sonsDOC=a::m.sonsDOC;
   DocTreeLd (DocTreeLd nxt a) m)
 else if (!strcmp s "enddoc") then nxt
 else if (!strcmp s "zone") then
 (set m.zonesDOC=
  (mkZone [nth_list l 1 [atoi nth_list l 2 atoi nth_list l 3 atoi nth_list l 4
    atoi nth_list l 5 atoi nth_list l 6 atoi nth_list l 7 atoi nth_list l 8] nil])::m.zonesDOC;
  DocTreeLd nxt m)
 else DocTreeLd nxt m;;

fun DocTreeLoader(l)=
 let mkDOC[nil nil nil nil nil nil nil nil nil nil nil] -> m in
 (DocTreeLd l m;
  m);;



/* server specific */
fun getbmpdoc(d,f)=
 set d.bmpDOC=_LDbitmap DMSserver _checkpack d.bmpnameDOC;
 if d.bmpDOC==nil then set d.bmpDOC=_LDjpeg DMSserver _checkpack d.bmpnameDOC
 else nil;
 exec f with [nil d];;
fun dontneedbmpdoc(d)=0;;

/* general part */
fun cbp(s,i,j)=
 if j>=strlen s then (substr s i j-i)::nil
 else if (nth_char s j)!='. then cbp s i j+1
 else (substr s i j-i)::if j+1 >= strlen s then nil else cbp s j+1 j+1;;

fun cutbypoint(s)=if s==nil then nil else cbp s 0 0;;

fun fullnamezone(d,z)= hd switchstr _DMSgetZones d z;;

fun findDoc(dl,l)=
 if dl==nil then nil
 else let dl->[d dnxt] in let l->[n nxt] in
 if strcmp d.nameDOC n then findDoc dnxt l
 else if (tl nxt)==nil then [d hd nxt]
 else findDoc d.sonsDOC nxt;;

fun zoneByName(z,n)=!strcmp z.nameZone n;;

fun findZone(d,n)=search_in_list d.zonesDOC @zoneByName n;;

fun calcDim(typ,x1,w,x2,l)=
 let max 1 (if typ&1 then x1 else 0)+(if typ&2 then w else 0)+(if typ&4 then x2 else 0) ->sum in
 [if typ&1 then (x1*(l-x1-x2-w+sum))/sum else x1
  if typ&2 then (w*(l-x1-x2-w+sum))/sum else w];;

fun calcZone(doc,coord)=
 let coord->[typ x1 y1 x2 y2 w h] in
 let if doc.fatherDOC==nil then _GETscreenSize
     else let _GETwindowSizePosition doc.winDOC -> [a b _ _] in [a b]
  -> [wwin hwin] in
 let calcDim typ x1 w x2 wwin ->[xx ww] in
 let calcDim typ>>3 y1 h y2 hwin ->[yy hh] in
 [doc.winDOC xx yy ww hh];;

fun resizeRun(x,y)=
 let x->[d _ f _] in execch if d.chnDMI==nil then _channel else d.chnDMI f [exec @calcZone with y];
 0;;

fun resizeZone(z,d)=apply_on_list z.usingZone @resizeRun [d z.coordZone];;

fun resizeDoc(d,f)=
 if d.typeDOC&DOCpopup then nil
 else let calcZone f d.coordDOC
  ->[_ x y w h] in _SIZEwindow d.winDOC w h x y;;

fun _resizeE(a,d,x,y)=
 if x==0 && y==0 then nil
 else
 (apply_on_list d.zonesDOC @resizeZone d;
  apply_on_list d.sonsDOC @resizeDoc d);;

fun destroyRun(x,y)=
 let x->[d _ _ f] in execch d.chnDMI f [];
 0;;

fun destroyZone(z,d)=apply_on_list z.usingZone @destroyRun d;;
fun destroyD(l)=
 if l==nil then 0 else let l->[d n] in
 (if d.winDOC==nil then nil
  else
  (set d.winDOC=nil;
   if d.bmpDOC==nil then nil
   else
   (_DSbitmap d.bmpDOC;
   set d.bmpDOC=nil);
   dontneedbmpdoc d;
   destroyD d.sonsDOC; 
   apply_on_list d.zonesDOC @destroyZone d);
  destroyD n);;

fun _destroyD(a,d)=destroyD d::nil;;

fun _paintdoc(a,d)=
 if d.bmpDOC==nil then nil
 else let _GETwindowSizePosition d.winDOC-> [ww hw _ _] in
 let _GETbitmapSize d.bmpDOC -> [wb hb] in
 if d.typebmpDOC & DOCtiled then
  let 0->i in while i <ww do
  (let 0->j in while j <hw do
   (_BLTbitmap d.winDOC d.bmpDOC i j;
    set j=j+hb);
   set i=i+wb)
 else if d.typebmpDOC&DOCstretched then
  let _CRbitmap DMSserver ww hw -> b in
  (_SCPbitmap b 0 0 ww-1 hw-1 d.bmpDOC 0 0 wb-1 hb-1 nil;
   _BLTbitmap d.winDOC b 0 0;
   _DSbitmap b;
   0)
 else
 (_BLTbitmap d.winDOC d.bmpDOC (ww-wb)>>1 (hw-hb)>>1;
  0);;

fun defbmpdoc(d)=
 if d.bmpnameDOC==nil then nil
 else
 (_CBwinPaint d.winDOC @_paintdoc d;
  getbmpdoc d @_paintdoc);;

fun createFathers(d)=
 if d==nil then nil
 else if d.winDOC!=nil then nil
 else
 (createFathers d.fatherDOC;
  set d.winDOC=if d.typeDOC&DOCpopup then
   let calcZone nil d.coordDOC ->[_ x y w h] in
   _CRwindow DMSserver d.fatherDOC.winDOC x y w h
    WN_MENU+WN_MINBOX+WN_SIZEBOX d.nameDOC
  else let calcZone d.fatherDOC d.coordDOC
    ->[win x y w h] in
   _CRwindow DMSserver win x y w h
     WN_CHILDINSIDE|WN_NOCAPTION|WN_NOBORDER d.nameDOC;
  _CBwinDestroy d.winDOC @_destroyD d;
  _CBwinSize d.winDOC @_resizeE d;
  defbmpdoc d
 );;

fun activZone(zone,flag)=
 let findDoc DMSdocs.sonsDOC cutbypoint zone ->[doc n] in
 let findZone doc n -> z in
 if z==nil then nil
 else
 (if flag then createFathers doc else nil;
  [doc z]);;

fun zoneUsed(l)=
 if l==nil then 0 else let l->[z n] in
 if z.usingZone==nil then zoneUsed n
 else 1;;

fun desactivDoc(dl)=
 if dl==nil then 0 else let dl->[d nxt] in
 let if (desactivDoc d.sonsDOC)||(zoneUsed d.zonesDOC) then 1 else 0 -> i in
 (if i || d.winDOC==DMSwin then nil
  else (_DSwindow d.winDOC; set d.winDOC=nil);
  i+desactivDoc nxt);;

fun _DMSdesactivDoc()=
 desactivDoc DMSdocs.sonsDOC;;

fun conflictZone(d,l)=
 if l==nil then 0 else let l->[[dd conf _ _]nxt] in
  (if dd==d then nil else execch dd.chnDMI conf [];
   conflictZone d nxt);;

fun removeDmiZone(d,l)=
 if l==nil then nil else let l->[a n] in
 let a->[dd _ _ _] in if dd==d then n
 else a::removeDmiZone d n;;

fun removeDmiZones(zl,dm)=
 if zl==nil then 0 else let zl->[z nxt] in
 (set z.usingZone=removeDmiZone dm z.usingZone;
  removeDmiZones nxt dm);;

fun removeDmiDoc(dl,dm)=
 if dl==nil then 0 else let dl->[d nxt] in
 (removeDmiZones d.zonesDOC dm;
  removeDmiDoc d.sonsDOC dm;
  removeDmiDoc nxt dm);;

fun _DMSgetZone(d,zone,conflict,resize,close)=
 let if d==nil then zone else fullnamezone d zone -> s in
 let activZone s 1 -> [doc z] in
 if z==nil then nil
 else
  (set z.usingZone=[d mkfun1 conflict zone mkfun2 resize zone mkfun1 close zone]::
    removeDmiZone d z.usingZone;
   conflictZone d tl z.usingZone;
   calcZone doc z.coordZone);;

fun _DMSreleaseZone(d,zone)=
 let fullnamezone d zone -> s in
 let activZone s 0 -> [doc z] in
 if z==nil then nil
 else
 (set z.usingZone=removeDmiZone d z.usingZone;
  _DMSdesactivDoc;
  0);;

fun _DOCremoveDmiDoc(d)=
 removeDmiDoc DMSdocs.sonsDOC d;
 _DMSdesactivDoc;;

fun _DMSiniDoc(name)=
 let findDoc DMSdocs.sonsDOC name::"x"::nil -> [d _] in
 if d==nil then nil
 else
 (set d.winDOC=DMSwin;
  let calcZone nil d.coordDOC ->[_ x y w h] in _SIZEwindow d.winDOC w h x y;
  _CBwinSize d.winDOC @_resizeE d;
  defbmpdoc d);
 0;;

/* main window */

fun _destroyE(a,b)=
 _dmscloseserver;;

fun _DOCiniWindow(w,h)=
 set DMSwin = _CRwindow _channel nil nil nil w h
  WN_MENU+WN_MINBOX+WN_MAXBOX+WN_SIZEBOX+if hidden_server then WN_HIDDEN else 0 "DMS Manager";
 _CBwinDestroy DMSwin @_destroyE nil;
 _SETdefaultFont set Font=_CRfont _channel 14 0 0 "arial";
 set StdCursor=_GETcursorWin DMSwin;
 let [_GETcursorSize
     (_LDbitmap _channel _checkpack "dms/lib/hand.bmp")
     (_LDbitmap _channel _checkpack "dms/lib/cross.bmp")]
   -> [[X Y] GBmp GBmp2] in
 let _CRbitmap _channel X Y -> CursorBmp in
  (_SCPbitmap CursorBmp 0 0 (X-1) (Y-1) GBmp 0 0 31 31 nil;
   set HandCursor=_CRcursor _channel CursorBmp 12 6 0 32767;
   _SCPbitmap CursorBmp 0 0 (X-1) (Y-1) GBmp2 0 0 31 31 nil;
   set CrossCursor=_CRcursor _channel CursorBmp 15 15 0 32767
   );;

fun extractbitmaps(l)=
 if l==nil then nil
 else let l->[a n] in
 if strcmp hd a "doc" then extractbitmaps n
 else let Tunder nth_list a 10 -> b in
 if b==nil then extractbitmaps n
 else b::extractbitmaps n;;

fun _DOCparse()=
 set DMSdocs=DocTreeLoader _DEFgetDef siteDef "docserver";
 _DMSiniDoc "server";;

fun _DOCregbitmaps()=
 _SETwindowName DMSwin webtostr DMSname;
 _RSregisterfiles _DMSrootModule
   extractbitmaps _DEFgetDef siteGRAPH.defGRAPH "docclient" RScontrol;;