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

/* add localisation (must define "loc" function) - may 2001 - by macfly */



typeof oldpath=S;;



struct MapEdit=

  [

    chMEd     : Chn,

    winMEd    : ObjWin,

    bannerMEd : ObjText,

    textMEd   : ObjText,

    bufMEd    : ObjBitmap,

    nameMEd   : S,

    okMEd     : ObjButton,

    cancelMEd : ObjButton,

    chgMEd    : ObjButton,

    newbmpMEd : ObjBitmap,

    endMEd    : fun [S] I,

    lfMEd     :[[I I] r1]

  ]mkMEd;;



fun _paintevent(a,b)= _BLTbitmap b.winMEd b.bufMEd 0 70;;



fun fmbyxy(f,t)=

  let f->[x y] in

  let t->[xt yt] in

    (x==xt) && (y==yt)

;;



fun lastslash(s)=

  let 0-> i in

  let 0-> l in

  (

    while i<strlen s do

    (

      if (nth_char s i) == '/ then

        set l=i

      else

        0;

      set i=i+1

    );

    l

  )

;;





fun BMPsizeNotMacth (ch, wn, w, h) =

  _DLGMessageBox  ch

                  wn

                  loc "WARNING" 

                  strcatn (loc "BITMAP_SIZE")::" <"::(itoa w)::"x"::(itoa h)::"> "::(loc "NOTMATCH")::nil 

                  0

;;



fun _OpenBmp(name,b)=

  let _checkpack name -> s in

  if s==nil then

    nil

  else

  (

    set oldpath=name;

    let _LDbitmap8 b.chMEd s -> newbmp in

      if newbmp!=nil then

        let _GETbitmap8Size newbmp -> [w h] in

          if b.lfMEd!=nil && nil==search_in_list b.lfMEd @fmbyxy [w h] then

          (

            BMPsizeNotMacth b.chMEd b.winMEd w h;

            nil

          )

          else

            let _CRbitmap b.chMEd w h -> newbmp16 in

            (

              _CPbitmap newbmp16 0 0 newbmp 0 0 w h nil;

              _DSbitmap8 newbmp;

              _SCPbitmap b.bufMEd 0 0 255 255 newbmp16 0 0 w-1 h-1 nil;

              _DSbitmap b.newbmpMEd;

              set b.newbmpMEd=newbmp16;

              set b.nameMEd=name;

              _SETtext b.textMEd strcatn name::" <"::(itoa w)::"x"::(itoa h)::">"::nil;

              _paintevent nil b

            )

      else

        let _LDjpeg b.chMEd s -> newbmp in

          if newbmp==nil then

          (

            _DLGMessageBox b.chMEd b.winMEd loc "WARNING" loc "NOTBITMAP" 0;

            nil

          )

          else

            let _GETbitmapSize newbmp -> [w h] in

            if b.lfMEd!=nil && nil==search_in_list b.lfMEd @fmbyxy [w h] then

            (

              BMPsizeNotMacth b.chMEd b.winMEd w h;

              nil

            )

            else

            (

              _SCPbitmap b.bufMEd 0 0 255 255 newbmp 0 0 w-1 h-1 nil;

              _DSbitmap b.newbmpMEd;

              set b.newbmpMEd=newbmp;

              set b.nameMEd=name;

              _SETtext b.textMEd strcatn name::" <"::(itoa w)::"x"::(itoa h)::">"::nil;

              _paintevent nil b

            )

  );

  0

;;



fun _change(x,b)=

  inibook b.chMEd b.winMEd 600 500 loc "TEXTU_SEL" mkfun2 @_OpenBmp b

          "" SEL_TEXTURE oldpath;;



fun lastpercent(n,i,l)=

  if i>=strlen n then

    l

  else

    lastpercent n i+1 if (nth_char n i)=='% then i else l

;;



fun cutnamefilter(n)=

  let lastpercent n 0 nil-> i in

    if i==nil then

      [n nil]

    else

      [substr n i+1 1000 substr n 1 i-1]

;;



fun _loadbmp(b,n)=

  let cutnamefilter n->[name filter] in

  (

    _OpenBmp name b;

    M3filter b.bufMEd filter;

    set b.nameMEd=n;

    _SETtext b.textMEd strcat

            (if filter==nil||0==strlen filter then nil else strcatn "%"::filter::"%"::nil)

            (_GETtext b.textMEd);

    _paintevent nil b

  )

;;



fun _ok(x,b)=

  _DSwindow b.winMEd;

  _DSbitmap b.bufMEd;

  _DSbitmap b.newbmpMEd;

  exec b.endMEd with [b.nameMEd]

;;



fun _cancel(x,b)=

  _DSwindow b.winMEd;

  _DSbitmap b.bufMEd;

  _DSbitmap b.newbmpMEd;

  exec b.endMEd with [nil]

;;



fun _SaveJpg(d,b,s)=

  if s==nil then

    nil

  else

  (

    _SAVEjpeg b.newbmpMEd s 75;

    _OpenBmp _PtoScol _WtoP s b

  )

;;



fun _savjpeg(x,b)=

  _DLGrflsave (_DLGSaveFile b.chMEd b.winMEd substr oldpath 0 lastslash oldpath nil 

              strcat loc "BITMAP_JPEG" " (*.jpg)\0*.JPG\0\0") @_SaveJpg b

;;



fun _destroy(x,b)=

  _DSbitmap b.bufMEd;

  _DSbitmap b.newbmpMEd;

  exec b.endMEd with [nil]

;;



fun addformat(a,z)=

  let a->[w h] in

  let z->[b sizes] in

    _APPitem b.chMEd sizes ME_ENABLED strcatn "<"::(itoa w)::"x"::(itoa h)::">"::nil

;;



fun iniMapEdit(ch,father,title,name,end,listformat)=

  let [256 256+130] -> [w h] in

  let _CRwindow ch father nil nil w h WN_MENU+WN_MINBOX title -> win in

  let _CRtext   ch win 5    5     w-10  20 ET_BORDER title -> banner in

  let _CRtext   ch win 5    25    w-10  40 ET_DOWN+ET_AHSCROLL+ET_HSCROLL "" -> text in

  let _CRbutton ch win 5    h-25  60    20 0 loc "OK" -> ok in

  let _CRbutton ch win 70   h-25  60    20 0 loc "CANCEL" -> cancel in

  let _CRbutton ch win 135  h-25  60    20 0 loc "CHANGE" -> change in

  let _CRbutton ch win 20   h-55  200   20 0 loc "TOJPEG" -> savjpeg in

  let _CRbitmap ch 256 256 -> buf in

  let mkMEd [ch win banner text buf nil ok cancel change nil end listformat] -> b in

  (

    _CBwinDestroy win @_destroy b;

    _CBwinPaint win @_paintevent b;

    let _CRmenu ch win -> menu in

      if listformat==nil then

        nil

      else

        let _APPpopup ch menu loc "SIZES"-> sizes in

          apply_on_list listformat @addformat [b sizes];

    _CBbutton ok @_ok b;

    _CBbutton cancel @_cancel b;

    _CBbutton change @_change b;

    _CBbutton savjpeg @_savjpeg b;

    _loadbmp b name;

    b

  )

;;





fun _destroyevent(s)=_closemachine;;



fun main()= iniMapEdit _channel nil loc "EDITOR_MAP" "trash.bmp" @_destroyevent nil;;