/* Book Editor - juil.97 - par Sylvain Huet */

typeof Font=ObjFont;;

typedef BookTree=
 itemBook S
|folderBook [S [BookTree r1]]
|backBook [BookTree r1];;

proto ftb1=fun[[S r1] [BookTree r1]] [[BookTree r1] [S r1]];;

fun ftb2(l,first)=
 if l==nil then [nil nil]
 else let l->[s nxt] in
  if (nth_char s 0) == '> then
   let ftb1 nxt first -> [b2 nxt2] in
   let ftb2 nxt2 first -> [b3 nxt3] in
    [(folderBook [s b2])::b3 nxt3]
  else if !strcmp s "<" then [nil nxt]
  else let ftb2 nxt first -> [b2 nxt2] in
    [(itemBook s)::b2 nxt2];;

fun ftb1(l,first)=
 if l==nil then [nil nil]
 else
 let (backBook first)::nil-> shell in
 let ftb2 l shell -> [b nxt] in [ (mutate shell <- [_ b]) nxt];;

fun filetobook(s)=
 let lineextr s -> l in
 if l==nil then (backBook nil)::nil
 else let ftb1 l nil-> [b _] in b;;

fun removebook(l,i)=
 if l==nil then nil else
 if i==1 then mutate l <- [_ tl tl l]
 else removebook tl l i-1;;

fun additem(l,s,i)=
 if l==nil then nil else
 if i==1 then mutate l <- [_ [itemBook s tl l]]
 else additem tl l s i-1;;

fun addfolder(l,first,s,i)=
 if l==nil then nil else
 if i==1 then mutate l <- [_ [folderBook [s (backBook first)::nil] tl l]]
 else addfolder tl l first s i-1;;

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

fun rbb(l)=
 if l==nil then nil else let l->[b nxt] in
  match b with
   (itemBook s -> s::rbb nxt)
  |(folderBook [s bk] -> s:: conclist (rbb bk) "<"::rbb nxt)
  |(_->rbb nxt);;

fun rebuildbook(l)=
 linebuild rbb l;;

struct BookEdit=[chBook:Chn,winBook:ObjWin,listBook:ObjList,textBook:ObjText,
 treeBook:[BookTree r1],pntBook:[BookTree r1],endBook:fun [S] I,
 bannerBook:ObjText,addBook:ObjButton,remBook:ObjButton,
 okBook:ObjButton,cancelBook:ObjButton,browseBook:ObjButton] mkBook;;

fun dbook(list,l)=
 if l==nil then 0 else
 (match hd l with
   (itemBook s -> _ADDlist list 1000 s)
  |(folderBook [s _] -> _ADDlist list 1000 s)
  |(backBook b -> _ADDlist list 1000 if b==nil then "[..root..]" else "...");
  dbook list tl l);;

fun displaybook(b)=
 _RSTlist b.listBook;
 dbook b.listBook b.pntBook;
 _SELlist b.listBook 0;
 0;; 

fun _fetch(x,b)=
 let _GETlist b.listBook -> [i _] in
 match nth_list b.pntBook i with
   (itemBook s -> (_SETtext b.textBook s; removebook b.pntBook i; displaybook b))
  |(folderBook [s bk] -> if (sizelist bk)>1 then nil 
      else (_SETtext b.textBook s;removebook b.pntBook i; displaybook b))
  |(_->nil)
;;

fun _select(x,b,i,sel)=
 match nth_list b.pntBook i with
   (folderBook [_ bk] -> (set b.pntBook=bk; displaybook b))
  |(backBook bk -> if bk==nil then nil else (set b.pntBook=bk; displaybook b))
  |(itemBook _-> _fetch nil b)
;;

fun _store(x,b)=
 let _GETtext b.textBook -> s in
  if (strlen s)==0 then nil else
  let _GETlist b.listBook -> [i0 _] in
  let if i0==nil || i0<1 then 1 else i0+1 -> i in
  if (nth_char s 0) == '> then
   (addfolder b.pntBook b.pntBook s i; displaybook b)
  else (additem b.pntBook s i; displaybook b);
 _SETtext b.textBook ""
;;


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

fun _browse(x,b)=
 _DLGrflopen (_DLGOpenFile b.chBook b.winBook nil nil "scm\0*.SCM\0\0") 
  @_GetFile b;;

fun _ok(x,b)=
 _DSwindow b.winBook;
 exec b.endBook with [rebuildbook b.treeBook];;

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

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

fun _resize(a,b,x,y)=
 if (y<100) then nil else
 (_SIZEtext b.bannerBook x-10 20 5 5;
  _SIZElist b.listBook x-10 y-85 5 30;
  _SIZEtext b.textBook x-10 20 5 y-50;
  _SIZEbutton b.remBook 45 20 5 y-25;
  _SIZEbutton b.addBook 45 20 55 y-25;
  _SIZEbutton b.okBook 40 20 120 y-25;
  _SIZEbutton b.cancelBook 40 20 165 y-25;
  _SIZEbutton b.browseBook 60 20 230 y-25)
;;


fun inibook(ch,father,w,h,title,txt,new,end,file)=
 set Font= if Font!=nil then Font else _CRfont ch 14 0 0 "arial";
 let _CRwindow ch father nil nil 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 _CRlist ch win 5 30 w-10 h-85 LB_DOWN+LB_VSCROLL -> list in
 let _CReditLine ch win 5 h-50 w-10 20 ET_DOWN+ET_AHSCROLL new -> text in
 let _CRbutton ch win 5 h-25 45 20 0 "Remove" -> rem in
 let _CRbutton ch win 55 h-25 45 20 0 "Add" -> addb in
 let _CRbutton ch win 120 h-25 40 20 0 "Ok" -> ok in
 let _CRbutton ch win 165 h-25 40 20 0 "Cancel" -> cancel in
 let _CRbutton ch win 230 h-25 60 20 0 "Browse" -> browse in
 let filetobook file -> book in
 let mkBook [ch win list text book book end banner addb rem ok cancel browse] -> b in
 (_CBwinDestroy win @_destroy b;
  _CBwinSize win @_resize b;
  _CBlistDclick list @_select b;
  _AFFfontText banner Font;
  _AFFfontText text Font;
  _AFFfontList list Font;
  _AFFfontButton _CBbutton rem @_fetch b  Font;
  _AFFfontButton _CBbutton addb @_store b Font;
  _AFFfontButton _CBbutton ok @_ok b Font;
  _AFFfontButton _CBbutton cancel @_cancel b Font;
  _AFFfontButton _CBbutton browse @_browse b Font;
  displaybook b;
  b
 );;


fun _destroyevent(s)=_fooS s;_closemachine;;
fun main()=
 inibook _channel nil 300 400 "Book Editor" "Example" "" @_destroyevent
  _getpack _checkpack "custom.txt";;