'OXIDEUTIL.INC

 uses FileDialogs

 '$ OpenGl

  macro MessageLoopProcesses
  ==========================

    int m=wm.message
    select m
    '
    case WM_LBUTTONDBLCLK
    =====================
      '
      SendMessage hwnd,WM_COMMAND,1100-0x200+m, wm.hwnd '1103
      if wm.hwnd=hchw[5] then continue while
      '
    case WM_KEYUP
    =============
      '
      m=wm.wparam
      a=m and 255
      key[a]=0
      '
    case WM_KEYDOWN
    ===============
      '
      m=wm.wparam
      select m
      a=m and 255
      key[a]=1
      '
      case VK_RETURN
        SendMessage hwnd,WM_COMMAND,2000+VK_RETURN, wm.hwnd
        if wm.hwnd=hchw[1] or wm.hwnd=hchw[2] or wm.hwnd=hchw[3] or wm.hwnd=hchw[4] then
          continue while
        end if
      case VK_F1 to VK_F10
        SendMessage hwnd,WM_COMMAND,1001+m-VK_F1, wm.hwnd
      case "A" to "Z"
        'if key[VK_CONTROL]
        if GetAsyncKeyState(VK_CONTROL)
          SendMessage hwnd,WM_COMMAND,2000+m, 0'wm.hwnd
          key(VK_CONTROL)=0
          select m
          case "A","E","F","G","O","R","S", "T"
            continue while
          end select
        end if
      case VK_ESCAPE
        SendMessage hwnd,WM_COMMAND,2200+VK_ESCAPE, wm.hwnd
        Continue do
     end select
      '
    end select
    '
  end macro



  macro keydown
  =============
    case 27 'escape: no special action
    case 32 'space:  no special action
  end macro

  sys sci, hsci
  sys hchw[128],nchw 'child windows

  uses Scintilla
  uses WinUtil
  uses SysUtil

  extern lib "oxygen.dll"
  uses oxygenAPI
  end extern


  string  o2dir, o2args
  string  projcommand[100]
  sys     hMenu,hMenuPopup
  sys     cdll,csd,projp
  sys     fnz,iu,iw
  string  fprj,sprj

  
  Function Sendm(sys hwnd,optional sys winMsg,sciMsg,wparam,lparam)
  =================================================================
  sys m
  if (hsci=hWnd) then m=sciMsg else m=winMsg
  if m then SendMessage hwnd,m,wparam,lparam
  end function


  Function SetText(sys hwnd, string s)
  ====================================
  Sendm hwnd,WM_SETTEXT,SCI_SETTEXT,len(s),strptr(s)
  End Function


  Function GetText(sys hwnd) as string
  ====================================
  int le
  bstring s
  le=sendm hwnd,WM_GETTEXTLENGTH,SCI_GETTEXTLENGTH
  s=nuls le
  sendm hwnd,WM_GETTEXT,SCI_GETTEXT,le+1,strptr(s)
  return s
  end function


  function SetFont(sys *hwnd,n,height,width,weight,string fontname) as sys
  ========================================================================
  indexbase 1
  sys hFont,i
  hfont=CreateFont( height,width,0,0,weight,0,0,0,0,0,0,0,0,fontname)
  int i
  for i=1 to n
    SendMessage hwnd(i),WM_SETFONT,hfont,0
  next
  return hFont
  end function


  sub SelectAll(sys hwnd)
  =======================
  SetFocus hwnd
  int le
  le=sendm hwnd,WM_GETTEXTLENGTH,SCI_GETTEXTLENGTH
  sendm hwnd,EM_SETSEL,SCI_SETSEL,0,le
  end sub


  function ExtractWord(string s,int *st,*en,*lw) as string
  ========================================================
  'alphanumeric underscore and '#'
  int le=len s
  int k=1
  int a,i
  for i=st to 1 step-1
    a=asc(s,i)
    select a
    case 35
    case 95
    case 0 to 32    : exit for
    case 33 to 47   : exit for
    case 58 to 64   : exit for
    case 91 to 96   : exit for
    case 123 to 126 : exit for 
    end select
    k=0
  next
  st=i+1-k 'k: support symbols
  if k then en=st+1 : jmp fwd nextract
  for i=st+1 to le
    a=asc(s,i)
    select a
    case 35
    case 95
    case 0 to 32    : exit for
    case 33 to 47   : exit for
    case 58 to 64   : exit for
    case 91 to 96   : exit for
    case 123 to 126 : exit for 
    end select
  next
  en=i
  nextract:
  lw=en-st
  return mid(s,st,lw)
  end function


  function ExtractBr(string s,int *st,*en,*lw) as string
  ======================================================
  int le=len s
  int i
  for i=st to 1 step-1
    select asc(s,i)
    case 0         : exit function
    case 91 : st=i : exit for
    end select
  next
  if i=0 then exit function
  for i=st+1 to le
    select asc(s,i)
    case 0  : exit function
    case 93 : exit for
    end select
  next
  en=i
  st++
  lw=en-st
  return mid(s,st,lw)
  end function


  function ExtractPath(string s,int *st,*en,*lw) as string
  ========================================================
  'format: [filename] ... [full path]
  int a,b,lw
  string w
  w=ExtractBr s,st,en,lw
  if (asc(s,st-2)=60)and(asc(s,en+1)=62) then
    a=en+1
    a=instr a,s,"["
    b=instr a,s,"]"
    if a then
      a++ : return mid s,a,b-a
    end if
  end if
  end function

  function oxypath(string f) as string
  ====================================
  if asc(f)=36 then
    return o2dir+mid(f,2)
  end if
  return f
  end function


  function GetOxyFile(string f) as string
  =======================================
  return getfile oxypath f 
  end function

  function PutOxyFile(string f,s)
  ===============================
  putfile oxypath(f),s
  end function

  function SetDirUsingPath(string f) as string
  ============================================
  string dir=ExtractDirName OxyPath f
  SetCurrentDirectory dir
  return dir
  end function


  sub UpdateProjFile(string*fprj)
  ===============================
  if not fprj then return
  string s,sprj
  indexbase 0
  sprj=GetText hchw[5]
  PutOxyFile fprj,sprj
  end sub


  function FindNext(int a, string t,w, optional int m,b) as int
  =============================================================
  int nw,aa,bb,st,lw=len w
  string wr,wf,s
  s =lcase t
  wr=lcase w
  if instr(wr," ") or m=0 then nw=1 'not words
  do
    if b then
      a=instrev a,s,wr 'backward search
      st=-1
    else
      a=instr a,s,wr
      st=1
    end if
    if a then
      if nw then
        wf=mid s,a,lw
      else
        aa=a : bb=a
        wf=ExtractWord s,aa,bb,lw
      end if
      if not wr=wf then
        a+=st
        if a=0 then exit do
        continue do
      end if
      return a
    end if
    exit do
  end do
  end function


  function FindReplace(int hw,hf,m,ck,hr=0) as int
  ================================================
  indexbase 0
  static int a,b,d,st,en,le,ls,lw
  static string s,wr,wrr
  s=GetText hw
  le=len s
  SendMessage hw,EM_GETSEL,@st,@en
  st++ : en++
  if ck and 2 'ctrl
    a=st : b=en
    if a=b then
      'wr=ExtractWord s,a,b,lw
      SelectAll hf
    else
      'extract highlighted block
      lw=b-a
      wr=mid(s,a,b-a)
      SendMessage hf,WM_SETTEXT,lw,wr
      SelectAll hf
      if hr then
        SendMessage hr,WM_SETTEXT,lw,wr
        SelectAll hr
      else
        SendMessage hchw[2],WM_SETTEXT,0,""
      end if
    end if
    SendMessage hw,EM_SETSEL,a-1,b-1
    return -1
  end if
  wr=GetText hf
  lw=len wr
  SetFocus hw
  a=0
  if lw
    if ck and 1 then d=1 else d=0 'shift REVERSE SEARCH
    a=FindNext st,s,wr,m,d
    if a=st then
      if hr then 'REPLACE
        wrr=GetText hr
        s=left(s,st-1)+wrr+mid(s,st+lw)
        SetText hw,s
        lw=len(wrr)
      end if
      if d 'REVERSE SEARCH
        st-=1
        if st<=0 then st=1
      else
        st+=lw
      end if
      a=FindNext st,s,wr,m,d
    end if
    if a
      SendMessage hw,EM_SETSEL,a-1,a+lw-1
      SendMessage hw,EM_SCROLLCARET,0,0
    end if
  end if
  return a
  end function

  function FindReplaceInBlock(sys hs,hf,hr) as sys
  ================================================
  indexbase 0
  static int a,st,en,le,lf,lr,ls
  static string ws,wf,wr
  ws=GetText hs
  SendMessage hs,EM_GETSEL,@st,@en
  if st=en then return 0
  st++ : en++
  wf=GetText hf
  lf=len wf
  if lf=0 then return 0
  ls=len ws
  if ls<lf then return 0
  wr=GetText hr
  lr=len wr
  do
    a=FindNext st,ws,wf
    if not a then exit do
    if a>=en then exit do
    st=a
    ws=left(ws,st-1)+wr+mid(ws,st+lf)
    st+=lr
  end do
  SetText hs,ws
  return -1
  end function
 

  sub FindLineNumber(sys hw,hg)
  =============================
  int a,b
  SendMessage hw,EM_GETSEL,@a,@b
  a=SendMessage hw,EM_LINEFROMCHAR,a,0
  string sl=str(a+1)
  SendMessage hg,WM_SETTEXT,len(sl),sl
  end sub


  sub GotoLine(sys hw,int v)
  ==========================
  if v>0 then
    if hsci then
      SendMessage hw,SCI_GOTOLINE,v-1,0
    else
      v=SendMessage hw,EM_LINEINDEX,v-1,0
      SendMessage hw,EM_SETSEL,v,v
      SendMessage hw,EM_SCROLLCARET,0,0
    end if
  end if
  SetFocus hw
  end sub


  sub ReadGotoLine(sys hw,hg)
  ===========================
  int v
  string g=nuls 24
  SendMessage hg,WM_GETTEXT,24,g
  v=val g
  GotoLine(hw,v)
  end sub


  function Clipname(string f) as string
  =====================================
  if len(f)>64
    return "..." mid f,-64
  else
    return f
  end if
  end function


  function filenameHTM(string nn) as string
  =========================================
  int a,i
  string s,n
  n=lcase nn
  int i
  for i=1 to len(n)
    a=asc(n,i)
    if a<97 or a>122 then
      s+="a"+str(a-31) 'supports ascii symbol encoding (space=a1)
    else
      s+=chr(a)
    end if
  next
  return s+".htm"
  end function

  sub insertsp(string*s, int i, string w)
  =======================================
  int le=len s
  if i-1>le then s+=space(i-1-le)
  inserts s,i,w
  end sub

  sub CompilerInfo(int mo, string wk="")
  ======================================
  indexbase 0
  int st,en,lw
  string s,wr
  s=GetText hchw[0] 'source code
  if not len ltrim s
    SetText hchw[6],"" : iu=1
    exit sub
  endif
  string finf=o2dir+"\_.txt"
  string qfinf=qu+finf+qu+" "
  SendMessage hchw[0],EM_GETSEL,@st,@en
  st++ : en++
  if wk then wr=wk else wr=ExtractWord s,st,en,lw
  wr=ltrim wr
  if not wr
    SetText hchw[6],"" : iu=1
    exit sub
  endif
  select mo
    case 0 : endline s,en : insertsp s,en+2,cr+"#list "+qfinf+wr+cr
    case 1 : endline s,en : insertsp s,en+2,cr+"#recordof "+qfinf+wr+cr
    case 2 : startline s,st : insertsp s,st,"#show "+qfinf
    end select
  o2_basic s 'COMPILE
  'if o2_errno then ...
  s=getfile finf
  SetText hchw[6],s
  if not wk then SetText hchw[4],wr
  iu=1 : iw=1
  end sub

  sub RecordLineNumber(string fo)
  ===============================
  indexbase 0
  if not fprj then exit sub
  if not fo then exit sub
  sprj=GetText hchw[5]
  int a,b,c,d
  string f1="["+lcase(fo)+"]"
  c=instr lcase(sprj),f1
  if c then
    c-=6 'position of line number
    SendMessage hchw,EM_GETSEL,@a,@b
    d=SendMessage hchw,EM_LINEFROMCHAR,a,0
    mid sprj,c,mid "0000"+str(d+1),-5
    SetText hchw[5],sprj
  end if
  end sub

  function MayPutFile(string fname,txt, optional qbox) as int
  ==========================================================
  int a
  string s,fo
  fo=fname
  if fo then
    s=GetOxyFile fo
  else
    fo="<current script>"
  end if
  if s<>txt then
    if qbox then
      a=MessageBox(0, "Save " fo, qbox, MB_YESNOCANCEL)
      if a<>IDYES then return a
    end if
    if asc(fo)=60 then fo=GetFileName "_.o2bas",1  
    if fo then PutOxyFile fo,txt
    RecordLineNumber fo
    return a
  end if
  end function

  sub LoadNewFile(string fi)
  ==========================
  string s
  s=GetOxyFile fi
  SetText hchw,s
  if sci then SendMessage hchw,SCI_EMPTYUNDOBUFFER,0,0 'ONLY REQUIRED FOR SCINTILLA CONTROL
  end sub

  sub SwitchFile(string kk,*fi,*fo, int mo=0)
  ===========================================
  indexbase 0
  int a,b,c
  int le,lw
  string f,f1,k,s,ss
  sprj=GetText hchw[5]
  le=len sprj
  if le<=1 then exit sub
  ss=lcase sprj
  k=lcase kk
  if mo then
    SendMessage hchw[5],EM_GETSEL,@a,@b
    a++ : b++
  else
    a=instr(ss,k)+2
    b=a+1
  end if
  f=ExtractPath ss,a,b,lw
  if f then
    s=GetText hchw
    a=MayPutFile fo,s,"Switching to Another File"
    if a=IDCANCEL then exit sub
    fi=f
    fo=f
    LoadNewFile fi
    SetWindowText hwndMain,"Switched to " fi
    'RETRIEVE LINE NUMBER
    f="["+lcase(fi)+"]"
    a=instr ss,f
    if a then
      b=valat a-7+strptr ss
      GotoLine hchw,b+20 'SCROLLING
      GotoLine hchw,b
    end if
  end if
  end sub
