/* Tree Editor - aout.99 - par Sylvain Huet */

var file1="locked/voyager/img/tree.scol.bmp";;
var file2="locked/voyager/img/tree.folder.bmp";;


fun flaginsert()=TREE_INSERT_SORT;;

/* renaming structure */
struct Rename=
 [chRename:Chn,winRename:ObjWin,txtRename:ObjText,endRename:fun[S] I]
 mkRename;;

fun _okr(x,b)=
 let _GETtext b.txtRename -> s in
 (_DSwindow b.winRename;
  exec b.endRename with [s])
;;

fun lineokr(a,b,c)=_okr nil b;;

fun _cancr(x,b)=
 _DSwindow b.winRename;
 exec b.endRename with [nil]
;;

fun _destroyr(x,b)=
 exec b.endRename with [nil];;


fun iniRename(ch,father,x,y,title,end,old)=
 let _CRwindow ch father x y 300 80 WN_MENU+WN_MINBOX title -> win in
 let _CRtext ch win 80 5 215 20 ET_BORDER old -> oldtext in
 let _CReditLine ch win 80 30 215 20 ET_DOWN+ET_AHSCROLL old -> text in
 let _CRbutton ch win 5 55 70 20 0 loc "OK"-> ok in
 let _CRbutton ch win 80 55 70 20 0 loc "CANC"-> cancel in
 let mkRename [ch win text end]-> b in
 (_CRtext ch win 5 5 70 20 0 loc "OLD";
  _CRtext ch win 5 30 70 20 0 loc "NEW";
  _CBwinDestroy win @_destroyr b;
  _CBlineOk text @lineokr b;
  _CBbutton ok @_okr b;
  _CBbutton cancel @_cancr b;
  _SETtextFocus text;
  b)
;;

/* new ref structure */
struct Nref=
 [chNref:Chn,winNref:ObjWin,txtNref:ObjText,refNref:ObjText,endNref:fun[S S] I]
 mkNref;;


fun _okn(x,b)=
 let _GETtext b.txtNref -> s in
 let _GETtext b.refNref -> r in
 (_DSwindow b.winNref;
  exec b.endNref with [s r])
;;

fun _destroyE(x,b)=
 exec b.endNref with [nil nil];;

fun _canc(x,b)=
 _DSwindow b.winNref;
 _destroyE x b;;

fun _GetFile(d,b,s)=
 if s==nil then _canc nil b
 else
 (_SETtext b.txtNref _PtoScol s;
  _SETtext b.refNref _PtoScol s;
  nil);;

fun _browse(x,b)=
 _DLGrflopen (_DLGOpenFile b.chNref b.winNref nil nil "scol\0*.SCOL\0\0") 
  @_GetFile b;;

fun iniNref(ch,father,x,y,title,end,oldalias,oldref,browse,browseauto)=
 let _CRwindow ch father x y 300 105 WN_MENU+WN_MINBOX title -> win in
 let _CReditLine ch win 110 30 185 20 ET_DOWN+ET_AHSCROLL oldalias -> text in
 let if browse then _CRtext ch win 110 55 185 20 ET_DOWN|ET_AHSCROLL oldref
  else _CReditLine ch win 110 55 185 20 ET_DOWN|ET_AHSCROLL oldref -> ref in
 let _CRbutton ch win 5 80 70 20 0 loc "OK"-> ok in
 let _CRbutton ch win 80 80 70 20 0 loc "CANC"-> cancel in
 let mkNref [ch win text ref end]-> b in
 (_CRtext ch win 5 5 290 20 ET_BORDER title;
  _CRtext ch win 5 30 100 20 ET_BORDER loc "ALIAS";
  _CRtext ch win 5 55 100 20 ET_BORDER loc "REF";
  _CBwinDestroy win @_destroyE b;
  _CBbutton ok @_okn b;
  _CBbutton cancel @_canc b;
  _SETtextFocus text;
  if browseauto then _browse x b else nil;
  b)
;;

fun conc(p,q)=
 if p == nil then q
 else (hd p)::conc tl p q;;

struct BookEdit=[chBook:Chn,winBook:ObjWin,trBook:ObjTree,selectBook:ObjTreeItem,lBook:[[ObjTreeItem ObjTreeItem S] r1],
 endBook:fun [S] I,flagBook:I,
 bannerBook:ObjText,menuBook:ObjMenu,
 okBook:ObjButton,cancelBook:ObjButton,
 lbBook:ObjBitmapList,ichildBook:BitmapIndex,ifatherBook:BitmapIndex] mkBook;;

var TREE_BROWSE=1;;

fun bytreeitem(a,i)= let a->[j _ _] in i==j;;

fun extractref(a)= let hd strextr a -> l in [hd l hd tl l];;
fun buildref(a,b)= let strbuild (a::b::nil)::nil -> s in substr s 0 (strlen s)-1;;

fun ftb1(b,l,pere)=
 if l==nil then nil
 else let l->[s nxt] in
 if (nth_char s 0) == '> then
  let substr s 1 strlen s -> ns in
  let _ADDtreeChild b.trBook pere flaginsert ns -> npere in
  (_SETtreeItemBitmap b.trBook npere b.ifatherBook b.ifatherBook;
   set b.lBook=[npere npere ns]::b.lBook;
   let ftb1 b nxt npere -> nnxt in
    ftb1 b nnxt pere)
 else if !strcmp s "<" then nxt
 else let extractref s ->[a _] in
  let _ADDtreeChild b.trBook pere flaginsert a -> child in
  (_SETtreeItemBitmap b.trBook child b.ichildBook b.ichildBook;
   set b.lBook=[child pere s]::b.lBook;
   ftb1 b nxt pere);;


fun filetobookex(b,s,pere)=
 let lineextr s -> l in ftb1 b l pere;;
 
fun filetobook(b,s)=filetobookex b s nil;;

fun rebuildbook(b,f,flag)=
 if f==nil then nil
 else let search_in_list b.lBook @bytreeitem f -> [_ pere s] in
 let if flag then nil else rebuildbook b _GETtreeBrother b.trBook f 0 -> suite in
 if f==pere then conc (strcat ">" s)::rebuildbook b _GETtreeChild b.trBook f 0 "<"::suite
 else s::suite;;

fun rebuildnode(b,f)=linebuild rebuildbook b f 1;;
fun rebuildtree(b)=
 linebuild rebuildbook b _GETtreeChild b.trBook nil 0;;


fun _drag(a,b,x,y)=
 if x==nil || y==nil || x==y then nil else
 let search_in_list b.lBook @bytreeitem y ->[_ pere _] in
 let rebuildnode b x -> s in
 (_DStreeItem b.trBook x;
  filetobookex b s pere;
  _SETtreeItemState b.trBook pere 1);;
 
fun _delete(a,b)=_DStreeItem b.trBook b.selectBook;;

fun resadd(alias,ref,b)=
 if alias==nil then nil
 else if (nth_char alias 0)=='> then 
 (_DLGMessageBox b.chBook b.winBook loc "WARN" loc "ALWARN" 0;
  nil)
 else let search_in_list b.lBook @bytreeitem b.selectBook ->[_ pere _] in
 let buildref alias ref -> s in
 let _ADDtreeChild b.trBook pere flaginsert alias -> child in
 (_SETtreeItemBitmap b.trBook child b.ichildBook b.ichildBook;
  set b.lBook=[child pere s]::b.lBook);
 0;;
 
fun _add(a,b)=
 let b.flagBook&TREE_BROWSE -> flag in
 iniNref b.chBook b.winBook 200 300 loc "NREF" mkfun3 @resadd b nil nil flag flag;;

fun resaddfolder(s,b)=
 if s==nil then nil
 else let search_in_list b.lBook @bytreeitem b.selectBook ->[_ pere _] in
 let _ADDtreeChild b.trBook pere flaginsert s -> child in
 (_SETtreeItemBitmap b.trBook child b.ifatherBook b.ifatherBook;
  set b.lBook=[child child s]::b.lBook;
  _SETtreeItemState b.trBook child 1);
 0;;

fun _addfolder(a,b)=
 iniRename b.chBook b.winBook 200 300 loc "NFOLD" mknode @resaddfolder b nil;;


fun resedit(alias,ref,b)=
 if alias==nil then nil
 else if (nth_char alias 0)=='> then 
 (_DLGMessageBox b.chBook b.winBook loc "WARN" loc "ALWARN" 0;
  nil)
 else let search_in_list b.lBook @bytreeitem b.selectBook ->x in
 let buildref alias ref -> s in
 (_SETtreeItemLabel b.trBook b.selectBook alias;
  mutate x<-[_ _ s]);
 0;; 

fun reseditfolder(s,b)=
 if s==nil then nil
 else let search_in_list b.lBook @bytreeitem b.selectBook ->x in
 (_SETtreeItemLabel b.trBook b.selectBook s;
  mutate x<-[_ _ s]);
 0;; 
 
fun _edit(a,b)=
 let search_in_list b.lBook @bytreeitem b.selectBook ->[child pere s] in
 if child==pere then
  (iniRename b.chBook b.winBook 200 300 loc "EFOLD" mknode @reseditfolder b s;
   0)
 else
  let b.flagBook&TREE_BROWSE -> flag in
  let extractref s ->[x y] in
  (iniNref b.chBook b.winBook 200 300 loc "EREF" mkfun3 @resedit b x y flag 0;
   0);;

fun _dclick(a,b,w,x,y)=
 let search_in_list b.lBook @bytreeitem w ->[_ pere _] in
 if pere==w then nil
 else
 (set b.selectBook=w;
  _edit nil b);;

fun _click(a,b,w,x,y,z)=
 _SETfocus b.winBook;
 set b.selectBook=w;
 let _GETscreenPos->[x y] in
  _DRAWmenu b.winBook b.menuBook x y PM_SCREEN|PM_LEFT_ALIGN|PM_TOP_ALIGN;;

fun _ok(x,b)=
 let rebuildtree b -> s in
 (_DSwindow b.winBook;
  _DSmenu b.menuBook;
  exec b.endBook with [s]);;

fun _cancel(x,b)=
 _DSwindow b.winBook;
 _DSmenu b.menuBook;
 exec b.endBook with [nil];;

fun _destroy(x,b)=
 _DSmenu b.menuBook;
 exec b.endBook with [nil];;

fun _resize(a,b,x,y)=
 if (y<120) then nil else
 (_SIZEtext b.bannerBook x-10 20 5 5;
  _SIZEtree b.trBook x-10 y-60 5 30;
  _SIZEbutton b.okBook 60 20 10 y-25;
  _SIZEbutton b.cancelBook 60 20 80 y-25)
;;


fun inibook(ch,father,w,h,title,txt,end,file,flag,newref)=
 let _CRwindow ch father 100 100 w h WN_MENU+WN_MINBOX+WN_SIZEBOX title -> win in
 let _CRtext ch win 5 5 w-10 20 ET_BORDER txt -> banner in
 let _CRtree ch win 5 30 w-10 h-60 TV_DOWN|TV_VSCROLL|TV_BUTTON -> tr in
 let _CRbutton ch win 10 h-25 60 20 0 loc "OK" -> ok in
 let _CRbutton ch win 80 h-25 60 20 0 loc "CANC" -> cancel in
 let _CRbitmapList ch 16 16 -> lb in
 let mkBook [ch win tr nil nil end flag banner nil ok cancel lb nil nil] -> b in
 (_CBwinDestroy win @_destroy b;
  _CBwinSize win @_resize b;
  let _CRpopupMenu ch -> root in
  (_CBmenu _APPitem ch root ME_ENABLED loc "ADREF" @_add b;
   _CBmenu _APPitem ch root ME_ENABLED loc "CRFOLD" @_addfolder b;
   _CBmenu _APPitem ch root ME_ENABLED loc "DEL" @_delete b;
   _CBmenu _APPitem ch root ME_ENABLED loc "EDIT" @_edit b;
   _APPitem ch root ME_ENABLED loc "CANC";
   set b.menuBook=root);
  _CBtreeRClick tr @_click b;
  _CBtreeDrag tr @_drag b;
  _CBtreeDClick tr @_dclick b;
  _CBbutton ok @_ok b;
  _CBbutton cancel @_cancel b;
  set b.ichildBook=_ADDbitmapList lb _LDbitmap ch _checkpack file1;
  set b.ifatherBook=_ADDbitmapList lb _LDbitmap ch _checkpack file2;
  _SETtreeBitmaps tr lb;
  filetobook b file;
  if newref!=nil then let extractref newref ->[alias ref] in
   let b.flagBook&TREE_BROWSE -> flag in
   iniNref b.chBook b.winBook 200 300 loc "NREF" mkfun3 @resadd b alias ref flag 0
  else nil;
  b
 );;
 
/*
fun _destroyevent(s)=_showconsole; _fooS s;0;;

fun main()=
 inibook _channel nil 300 400 "Book Editor" "Example" @_destroyevent
  _getpack _checkpack "locked/etc/custom.txt" 1 strbuild ("abc"::"def"::nil)::nil;;
*/