/***************************************************************************************/
/*                                                                                     */
/*  SCS editor Version 2                                                               */
/*  File : doc.pkg                                                                     */
/*  Version : 26 Juin 2000                                                             */
/*  EXTRACTED FROM : sDHDMS - mar 00 - by Sylvain HUET                                 */
/*  (see CHANGELOG section for the list of modifications from the orginal code)        */
/*  Dms core functions                                                                 */
/*                                                                                     */
/***************************************************************************************/

/*
CHANGELOG
- unnecessary functions enclosed in comment blocks
- struct Zone: renamed oldZone to avoid redefinition with Scs 2's Zone struct
- _DOCparse: removed call to _DOCinit in this function
*/

typeof DMSdocs=DOC;;

var hidden_server=0;;

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

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

struct DOC=
 [sonsDOC:[DOC r1],fatherDOC:DOC,bmpnameDOC:S,bmpDOC:ObjBitmap,
  winDOC:ObjWin,nameDOC:S,typeDOC:I,coordDOC:[I I I I],refDOC:[I I],
  zonesDOC:[OldZone r1]
 ]mkDOC;;

/* document loader */
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 nth_list l 9 nil nil nth_list l 1 atoi nth_list l 2
   [atoi nth_list l 3 atoi nth_list l 4 atoi Tunder nth_list l 5 atoi Tunder nth_list l 6]
   [Otonil atoi Tunder nth_list l 7 Otonil atoi Tunder nth_list l 8] 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=
  (mkOldZone [nth_list l 1 [atoi nth_list l 2 atoi nth_list l 3 atoi nth_list l 4
    atoi nth_list l 5] 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] -> 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 calcZone(doc,z)=
 let z.coordZone->[x1 y1 x2 y2] in
 let _GETwindowSizePosition doc.winDOC -> [w h _ _] in
 let if doc.typeDOC&DOChomot then
 let doc.refDOC->[w1 h1] in
 let doc.coordDOC->[w2 h2 _ _] in
 let if w1==nil then w2 else w1->ww in
 let if h1==nil then h2 else h1->hh in
  [x1*w/ww y1*h/hh x2*w/ww y2*h/hh]
 else
  [(x1+if x1>=0 then 0 else w) (y1+if y1>=0 then 0 else h)
   (x2+if x2>=0 then 0 else w) (y2+if y2>=0 then 0 else h)]
 ->[xx1 yy1 xx2 yy2]
 in [doc.winDOC xx1 yy1 xx2-xx1+1 yy2-yy1+1];;

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

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

fun resizeDoc(d,f)=
 if d.typeDOC&DOCpopup then nil
 else let calcZone f findZone f d.nameDOC
  ->[_ 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.typeDOC & 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.typeDOC&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 d.coordDOC ->[w h x y] in
   _CRwindow DMSserver d.fatherDOC.winDOC x y w h
    WN_MENU+WN_MINBOX+WN_SIZEBOX d.nameDOC
  else let calcZone d.fatherDOC findZone d.fatherDOC d.nameDOC
    ->[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
  (conflictZone d z.usingZone;
   set z.usingZone=[d mkfun1 conflict zone mkfun2 resize zone mkfun1 close zone]::
    removeDmiZone d z.usingZone;
   calcZone doc z);;

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 _DMSremoveDmiDoc(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 d.coordDOC->[w h x y] in _SIZEwindow d.winDOC w h x y;
  _CBwinSize d.winDOC @_resizeE d;
  defbmpdoc d);
 0;;

/* main window */

fun _destroyE(a,b)=
/* _DMSdelete DMSdmiTree;*/
 _closemachine;;

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 nth_list a 9 -> b in
 if b==nil then extractbitmaps n
 else b::extractbitmaps n;;
*/

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

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