OpenEuphoria

1. Derek(or anyone), I need help again, please

• Posted by Judith <camping at txcyber.com> Sep 01, 2001
• 642 views

Hi, Derek (or anyone that knows the answer)

This is the program you fixed for me to use XPM in IDE. It worked fine 
except I had to modify it to work for cases where the user had the curly 
parenthesis used for the color code. That worked ok for most of the XPM. 
But I'm having a problem with the 2-wide color code that is in a member 
of IDE_xpm.ew.

Can you spot my error?

Thanks,

Judith


--from Derek Parnell

  --demo of reading xpm_icon.e and trapping the sequence of the xpm and
  --then adding to window at x,y
	--modified by Derek

  include win32lib.ew
  without warning
  constant win=create(Window,"test xpm",0,0,0,300,320,0)

  sequence XPM XPM = {}
  sequence XPMNames XPMNames = {}

  integer ok

function trims(sequence text)
      integer start, finish

      start = 1
      finish = length(text)
      --now trim text at right
      for i=length(text) to 1 by -1 do
          if text[i]!=' ' then
              finish = i
              exit
          end if
      end for

      --now trim text from left
      for i=1 to finish do
          if text[i]!=' ' then
              start = i
              exit
          end if
      end for

      return text[start .. finish]
end function

function clean_the_text( sequence text )
    --clean up the names list
--    for i=1 to length(text) do
        text=trims(text)
        if match( "{", text ) then
            text=text[1..length(text)-1]
            text=trims(text)
            if match( "=", text) then
                text=text[1..length(text)-1]
                text=trims(text)
            end if
        end if
--    end for

    return {text}
end function

function betweenQuotes( sequence text )
--Judith routine added

    integer at, at2, at3

    at=find('"', text )
    if at then
        text=text[1..at-1] & " " & text[at+1..length(text)]
        at2=find('"', text )
        if at2 then
            --check special case } at end of line; not in quotes
            at3=find('}', text)
            if at3 then
                if at3<at2 then
                    return 1
                else
                    return 0
                end if
            else
                return 1
            end if
        else
            return 0
        end if
    else
        return 0
    end if

end function

  atom hdib
  procedure onOpen_win()
      integer handle, ignore, at, answer, at2
      object text
      sequence fName, text2
      integer eof, XPMI,continue


      fName="Ide_xpm.ew"    --"XPM_Icon.e"
      XPM={}
      XPMNames = {}

      eof = False

      handle=open( fName, "r" )
      if handle = -1 then
          -- give message and exit
          ignore = message_box(   "Open File Error",
                                  "Unable to read the file " & fName,
                                  MB_ICONHAND+MB_TASKMODAL )
          return
      end if

      -- parse the file
      while not eof do

          -- get a line of text
          text = gets( handle )
          if atom( text ) then
              exit   --EOF
          end if

          -- remove line feed
          if text[length(text)] = '\n' then
              text= text[1 .. length(text) - 1]
          end if
          text=trims(text)
--judith          if length(text) >= 4 and equal(text[1 .. 4], "XPM_") 
then

          if length(text) then
             at=find( '{', text)
             if at then
                answer=betweenQuotes(text) --judith
                if answer then             --judith
                    continue=False         --judith
                else                       --judith
                    continue=True
                end if                     --judith
             else
                continue=False
             end if
          end if
          if continue=True then
                text=clean_the_text(text)
                XPMNames&=text
                XPM = append(XPM, {})
                XPMI = length(XPM)

             -- If ONLY we had a "continue" statement, this would look a 
lot cleaner.
          elsif length(XPM) != 0 then
              text = trims(text)
              at=find( '{', text )
              if at then
                    answer=betweenQuotes(text)      --judith
                    if not answer then              --judith
                        text=text[at+1..length(text)]
                    end if                          --judith
              else
                  at=find( '}', text )
                  if at then
                        answer=betweenQuotes(text)  --judith
                        if not answer then          --judith
                            text=text[1..at-1]
                        end if                      --judith
                  end if
              end if
              text = trims(text)
              if length(text) > 0 then
                  if text[1] = '"' then
                     text = text[2 .. length(text)-2]
                  end if
                  if length(text) > 0 then
                   XPM[XPMI] = append(XPM[XPMI], text)
--ok=message_box("adding:" & text,"",0)
                  end if
              end if
          end if
      end while

      repaintWindow( win )

  end procedure

  procedure paint_win(integer x1, integer y1, integer x2, integer y2)
      integer x, y

      -- These values are hard coded but
      -- you should really get the Rect size of each bitmap
      -- and window to adjust for full viewing.
      x = 10
      y = 10
      for i = 1 to length( XPM ) do
--ok=message_box(" doing " & XPMNames[i],"",0)
          hdib=xpmToPixmap(XPM[i])
          transBlt(win,x,y,hdib)
          x += 40
          if x > 260 then
             y += 40
             x = 10
          end if
          destroy(hdib)
      end for
  end procedure
  onPaint[win]=routine_id("paint_win")


  onOpen[win]=routine_id("onOpen_win")

  WinMain( win, Normal )