/***************************************************************************************/
/*                                                                                     */
/*  SCS editor Version 2                                                               */
/*  File : def.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
- add DEFgetScsDef : returns a definition block with scs data (like module position)
- DEFparseScs : add calls to DEFgetScsDef in "mod" and "box" block
*/

struct DEF= /* DEF structure */
 [nameDEF:S, srvDEF:I, listDEF: [[S [[S r1] r1]] r1], subDEF:[DEF r1]] mkDEF;;

typeof siteDef=DEF;; /* site definition */
typeof srcDef=S;; /* definition data */

/*
fun defbyname(a,b)=!strcmp a.nameDEF b;;
*/

/* PARSING */
/* parsing of dms file */
fun DEFparseDef(l)=
 if l==nil then nil
 else let l->[[a b] nxt] in
 if !strcmp a ">" then
   let DEFparseDef nxt->[nxt2 x] in
    [nxt2 b::x]
 else if !strcmp a "enddef" then [nxt nil]
 else DEFparseDef nxt;;
 
fun DEFparseDms(res)=
 let res->[l defs0 subdef0] in
 if l==nil then res
 else let l->[[a [b [c _]]] nxt] in
 if !strcmp a "module" then
  let DEFparseDms [nxt nil nil] -> [nxt2 defs subdef] in
   DEFparseDms [nxt2 defs0 (mkDEF [b atoi c defs subdef])::subdef0]
 else if !strcmp a "endmod" then [nxt defs0 subdef0]
 else if !strcmp a "def" then
  let DEFparseDef nxt -> [nxt2 x] in
   DEFparseDms [nxt2 [b x]::defs0 subdef0]
 else DEFparseDms [nxt defs0 subdef0];;


/* parsing of scs file */
var headerScs=["name" 0]::["port" 0]::["timeout" 0]::nil;;

fun DEFparseHeadScs(ll)=
 if ll==nil then nil
 else let ll ->[l nxt] in
 if (switchstr headerScs hd l)!=nil then
   l::DEFparseHeadScs nxt
 else DEFparseHeadScs nxt;;

fun DEFparseDocSrv(file)=
 let _getpack _checkpack file -> dat in
 let strfind "doc server" dat 0 -> i in
 if i==nil then nil
 else strextr substr dat i strlen dat;;

fun DEFparseDocCli(file)=
 strextr _getpack _checkpack strcat substr file 0 (strlen file)-4 ".scc";;

var linkScs=["link" 0]::["linkCC" 0]::["linkCS" 0]::["linkSC" 0]::nil;;

/* returns a definition block with scs data (like module position) */
fun DEFgetScsDef(l)=
  ["scs" (("position"::(itoa ((atoi(nth_list l 2)) * 50))::(itoa ((atoi (nth_list l 3)) * 50))::nil)::nil)];;

fun DEFconvertDmiBox (dmi) =
  if dmi == nil then nil
  else
    ((if (!strcmpi (hd hd dmi) "event") || (!strcmpi (hd hd dmi) "eventC") then "in"
      else if (!strcmpi (hd hd dmi) "action") || (!strcmpi (hd hd dmi) "actionC") then "out"
      else hd hd dmi)::(tl hd dmi))::
    (DEFconvertDmiBox tl dmi)
;;

fun DEFparseScs(ll,master,module)=
 if ll==nil then nil
 else let ll->[l nxt] in
 let hd l -> s in
 if (!strcmp s "mod") then
  let nth_list l 1 -> dmifile in
  let strextr _getpack _checkpack dmifile -> dmi in
  let mkDEF [(getInfo dmi "name") 0 (DEFgetScsDef l)::["dmi" dmi]::nil nil] -> node in
  let strextr _getpack _checkpack strcat substr dmifile 0 (strlen dmifile)-4 ".dat" -> dat in
  (if dat==nil then nil else set node.listDEF=["dat" dat]::node.listDEF;
   set master.subDEF=node::master.subDEF;
   DEFparseScs nxt master node)
 else if (!strcmp s "box") then
  let strextr _getpack _checkpack nth_list l 1 -> dmi in
  let mkDEF [(getInfo dmi "name") 0 (DEFgetScsDef l)::["dmi" DEFconvertDmiBox dmi]::nil nil] -> node in
  let DEFparseScs nxt node node -> nxt2 in
  (set master.subDEF=node::master.subDEF;
   DEFparseScs nxt2 master node)
 else if (switchstr linkScs s)!=nil then
  let (nth_list l 1)::(nth_list l 2)::(nth_list l 3)::(nth_list l 4)::
   (nth_list l 5)::(nth_list l 6)::nil -> newlink in
  let getSwitchStr module.listDEF "link" -> def in
  (if def==nil then (set module.listDEF=["link" newlink::nil]::module.listDEF;nil)
   else let def->[_ links] in mutate def <- [_ newlink::links];
   DEFparseScs nxt master module)
 else if (!strcmp s "zoneS")||(!strcmp s "zoneC") then
  let getSwitchStr module.listDEF "zone" -> def in
  (if def==nil then (set module.listDEF=["zone" l::nil]::module.listDEF;nil)
   else let def->[_ zones] in mutate def <- [_ l::zones];
   DEFparseScs nxt master module)
 else if (!strcmp s "endbox") then nxt
 else DEFparseScs nxt master module;;

/* MAC ICI : debut ajout */
var DOCpopup=1;;
var DOChomot=2;;
var DOCtiled=4;;
var DOCstretched=8;;

/* Resize behavior flags */
var ZONE_LW_FLEX = 1  ;; /* zone left border is at a flexible distance from the left border of the parent zone */
var ZONE_MW_FLEX = 2  ;; /* zone width is a flexible value */
var ZONE_RW_FLEX = 4  ;; /* zone right border is at a flexible distance from the right border of the parent zone */
var ZONE_LH_FLEX = 8  ;; /* zone top border is at a flexible distance from the top border of the parent zone */
var ZONE_MH_FLEX = 16 ;; /* zone height is a flexible value */
var ZONE_RH_FLEX = 32 ;; /* zone bottom border is at a flexible distance from the bottom border of the parent zone */
var ZONE_ALL_FLEX = 63;; /* all flexible !! MAC ICI pas terrible ca */

fun strFindList(l,a)=
 if l==nil then 0 else let l->[x n] in
 if !strcmp a x then 1 else strFindList n a;;

fun getfromzones(l,name)=
 if l==nil then nil
 else let l->[line nxt] in
 if !strcmp hd tl line name then
  let tl tl line->[dtype[x1[y1[x2[y2[w[h _]]]]]]] in
  [dtype x1 y1 x2 y2 w h]
 else getfromzones nxt name;;

fun switch_(ref,val)=if !strcmp ref "_" then val else ref;;

fun getDocline(line,father,zones)=
 let tl line ->[name[atype[w[h[x[y[wref[href[bitmap _]]]]]]]]] in
  let atoi atype->type in
  let if type&DOCpopup || father==nil then [itoa ZONE_RW_FLEX|ZONE_RH_FLEX x y itoa 0 itoa 0 w h]
      else getfromzones zones name -> newfather in
  let newfather->[dtype dx1 dy1 dx2 dy2 dw dh] in
  ["doc"::name::(itoa type&DOCpopup)::dtype::dx1::dy1::dx2::dy2::dw::dh::bitmap::(itoa type&(DOCtiled|DOCstretched))::nil
   [(itoa type&DOChomot) dx1 dy1 dx2 dy2 dw dh switch_ wref w switch_ href h]];;

fun calcdim(x1,x2,w)=
 if x1<0 then
  let if x2<0 then x2 else x2-w -> xx2 in  /* cas de conversion impossible */
    [ZONE_LW_FLEX w+x1+1 xx2-x1 (-xx2-1)]
 else
  if x2<0 then
  [ZONE_MW_FLEX x1 w+x2+1-x1 (-x2-1)]
 else
  [ZONE_RW_FLEX x1 x2-x1 w-x2];;

fun getZoneline(line,father)=
 let tl line->[name[ax1[ay1[ax2[ay2 _]]]]] in
 let [atoi ax1 atoi ay1 atoi ax2 atoi ay2] ->[x1 y1 x2 y2] in
 let father -> [adtype adx1 ady1 adx2 ady2 adw adh adwref adhref] in
 let [atoi adtype atoi adx1 atoi ady1 atoi adx2 atoi ady2 atoi adw atoi adh atoi adwref atoi adhref] ->[dtype dx1 dy1 dx2 dy2 dw dh dwref dhref] in
 if (dtype&DOChomot) then
  let [(x1*dw/max 1 dwref) (y1*dh/max 1 dhref) (x2*dw/max 1 dwref) (y2*dh/max 1 dhref)] ->[nx1 ny1 nx2 ny2] in
  "zone"::name::(itoa ZONE_ALL_FLEX)::(itoa nx1)::(itoa ny1)::(itoa dw-nx2)::(itoa dh-ny2)::(itoa nx2-nx1)::(itoa ny2-ny1)::nil
 else
  let calcdim x1 x2 dw ->[type xx1 ww xx2] in
  let calcdim y1 y2 dh ->[type2 yy1 hh yy2] in
   "zone"::name::(itoa (type2<<3)+type)::(itoa xx1)::(itoa yy1)::(itoa xx2)::(itoa yy2)::(itoa ww)::(itoa hh)::nil;;

fun DocTreeConv(l,father,zones)=
 if l==nil then nil
 else let l->[line nxt] in let hd line ->word in
 if !strcmp word "doc" then
  let getDocline line father zones ->[newline newfather] in
   let DocTreeConv nxt newfather nil ->[nxt2 subres _] in
   let DocTreeConv nxt2 father zones ->[nxt3 subres2 subdoc] in
   [nxt3 conc newline::subres subres2 (hd tl line)::subdoc]
 else if !strcmp word "enddoc" then
   [nxt ("enddoc"::nil)::nil nil]
 else if !strcmp word "zone" then
  let getZoneline line father ->newline in
  let DocTreeConv nxt father newline::zones ->[nxt2 subres subdoc] in
   [nxt2 (if strFindList subdoc hd tl line then subres else newline::subres) subdoc]
 else DocTreeConv nxt father zones;;

fun CONVERTzoneDef (listDef) =
  let DocTreeConv listDef nil nil ->[_ res _] in res;;

proto _DEFsave=fun[] S;;

fun DEFgetLocal()=
 let substr srcDef (strlen srcDef)-4 4 -> suff in
 if (!strcmpi suff ".dms") || (!strcmpi suff ".dme")
 then let DEFparseDms [strextr _getpack _checkpack srcDef nil nil] ->[_ _ l]
  in hd l
 else if !strcmpi suff ".scs"
 then let mkDEF [nil 0 nil nil] -> master in
  let strextr _getpack _checkpack srcDef -> l in
  (DEFparseScs l master master;
   set master=hd master.subDEF;
   set master.listDEF= conc
      ["docserver" CONVERTzoneDef (DEFparseDocSrv srcDef)]::
      ["docclient" CONVERTzoneDef (DEFparseDocCli srcDef)]::
      master.listDEF
    ["def" DEFparseHeadScs l]::nil;
   master)
 else if !strcmpi suff ".dmi"
 then let strextr _getpack _checkpack srcDef -> dmi in
  let mkDEF [(getInfo dmi "name") 0 (DEFgetScsDef "_"::"_"::"1"::"1"::nil)::["dmi" dmi]::nil nil] -> node in
  let strextr _getpack _checkpack strcat substr srcDef 0 (strlen srcDef)-4 ".dat" -> dat in
  (if dat==nil then nil else set node.listDEF=["dat" dat]::node.listDEF;
   node)
 else nil;;

/* UPDATING */
/*
fun DEFupdateLocal(d,name,defs)=
 let remove_from_list d.listDEF getSwitchStr d.listDEF name -> newtl in
 (set d.listDEF=if defs==nil then newtl else [name defs]::newtl;
  defs);;
*/

/* SAVING */

fun DEFbuildsup(l,res)=
 if l==nil then res
 else let l->[x nxt] in
  (">"::x)::DEFbuildsup nxt res;;
 
fun DEFrebuilddef(l,res)=
 if l==nil then res
 else let l->[[name def] nxt] in
  DEFrebuilddef nxt
  ("def"::name::nil)::DEFbuildsup def ("enddef"::nil)::res;;
  
fun DEFrebuild(l,res)=
 if l==nil then res
 else let l->[d nxt] in
 DEFrebuild nxt
 ("module"::d.nameDEF::(itoa d.srvDEF)::nil)::
  DEFrebuilddef d.listDEF
   DEFrebuild d.subDEF ("endmod"::nil)::nil::res;;


/* API */
fun _DEFinit(data)=
 set srcDef=data;
 set DMSpathname=substr data 0 (strlen data)-4;
 set DMSpath=_DMSgetpath data;;
 

fun _DEFget()=
 set siteDef=if _getServerNumber==MASTERNUMBER then DEFgetLocal
  else nil;
 let substr srcDef (strlen srcDef)-4 4 -> suff in
  if strcmpi suff ".dms" then _DEFsave /* always convert scs -> dms */
  else srcDef
;;

fun _DEFgetWithoutSave()=
 set siteDef=if _getServerNumber==MASTERNUMBER then DEFgetLocal
  else nil
;;

/*
fun _DEFgetRoot()=siteDef;;
*/
fun _DEFgetDef(d,name)=switchstr d.listDEF name;;
/*
fun _DEFgetSub(d)=d.subDEF;;

fun _DEFupdate(module,name,defs)=
 if _getServerNumber==MASTERNUMBER then DEFupdateLocal module name defs
 else nil;;
*/

/*proto ERRORS_AddError = fun [I I S] Errors ;;
proto GUI_SaveAs = fun [] I ;;*/

fun _DEFsave()=
/* _fooS strbuild DEFrebuild siteDef::nil nil;;*/
  let strcat DMSpathname ".dms" -> newfilename in
  (
    _storepack strbuild DEFrebuild siteDef::nil nil newfilename;
    newfilename
  )
;;

fun _DEFsaveDME()=
  let strcat DMSpathname ".dme" -> newfilename in
  (
    _storepack strbuild DEFrebuild siteDef::nil nil newfilename;
    newfilename
  )
;;

/* MAC ICI : attention écrase le dms existant éventuellement !! */