OpenEuphoria

Pastey pGUIC.e

• Posted by petelomax Feb 04, 2021

--
-- demo/pGUI/pGUIC.e 
-- ================= 
-- 
--  A quick and dirty class-based wrapper/drop-in replacement for pGUI.e 
--  This is a proof-of-concept: there is no proper error handling and only 
--  those items/features needed for a single demo were included.  
--  I have no immediate plans to do anything more with this. 
-- 
include pGUI.e  
 
integer hdict = new_dict("handle lookup")  
 
class Element nullable 
    Ihandln handle 
    string title 
    string image 
    string padding 
    string tooltip_text 
    procedure set_handle(Ihandle handle) 
        this.handle = handle 
--      printf(1,"Adding %v %d\n",{this,this.handle}) 
        setd(this.handle,this,hdict)  
    end procedure 
    function get_handle() 
        return this.handle 
    end function 
    procedure set_title(string title) 
        this.title = title 
        IupSetAttribute(this.handle,"TITLE",title) 
    end procedure 
    procedure set_image(string image) 
        this.image = image 
        IupSetAttribute(this.handle,"IMAGE",image) 
    end procedure 
    procedure set_padding(string padding) 
        this.padding = padding 
        IupSetAttribute(this.handle,"PADDING",padding) 
    end procedure 
    function get_tooltip_text() 
        return IupGetAttribute(this.handle,"TIP") 
    end function 
    procedure set_tooltip_text(string tip) 
        this.tooltip_text = tip 
        IupSetAttribute(this.handle,"TIP",tip) 
    end procedure 
    procedure discard() 
        while IupGetChildCount(this.handle) do 
            Ihandln child = IupGetChild(this.handle,0) 
            IupDetach(child) 
            Element ce = getd(child,hdict) 
            -- Check for eg IupExpander uses an IupBackgroundBox, 
            -- neither created by nor accounted for by this code. 
            if ce!=NULL then 
                ce.discard() 
                delete(ce) 
            end if 
        end while 
--      printf(1,"Deleting %v %d\n",{this,this.handle}) 
        deld(this.handle,hdict)  
        this.handle = IupDestroy(this.handle) 
    end procedure 
    procedure add(Element e) 
        IupAppend(this.handle,e.handle) 
    end procedure 
    function handles(sequence s) 
        for i=1 to length(s) do 
            Element si = s[i] 
            s[i] = si.handle 
        end for 
        return s 
    end function 
    procedure set_data(string name, data) 
        IupSetAttribute(this.handle,upper(name),data) 
    end procedure 
    function get_data(string name) 
        string data = IupGetAttribute(this.handle,upper(name)) 
        return data 
    end function 
end class 
 
function get_element_by_handle(Ihandle handle) 
    Element element = getd(handle,hdict) 
    return element 
end function  
 
class Window extends Element 
    string size 
    Ihandln parent 
    function Window(Element child=NULL,string attr="") 
        set_handle(IupDialog(iff(child!=NULL?child.handle:child),attr)) 
        return this 
    end function 
    procedure ~Window() 
        -- (destructors on other elements may also be desired...) 
        this.discard() 
    end procedure 
    procedure set_size(string size) 
        this.size = size 
        IupSetAttribute(this.handle,"RASTERSIZE",size) 
    end procedure 
    procedure set_parent(Ihandle parent) 
        this.parent = parent 
        IupSetAttributeHandle(this.handle,"PARENTDIALOG",parent) 
    end procedure 
    procedure show() 
        IupShow(this.handle) 
    end procedure 
    procedure popup(integer x = IUP_CURRENT, y = IUP_CURRENT) 
        IupPopup(this.handle,x,y) 
    end procedure 
end class 
 
class Fill extends Element 
    function Fill() 
        set_handle(IupFill()) 
        return this 
    end function 
end class 
 
function Filler() return new(Fill) end function 
 
class Container extends Element 
    integer gap 
    string margin 
    string normalizesize 
    procedure set_gap(integer gap) 
        this.gap = gap 
        IupSetInt(this.handle,"GAP",gap) 
    end procedure 
    procedure set_margin(string margin) 
        this.margin = margin 
        IupSetAttribute(this.handle,"MARGIN",margin) 
    end procedure 
    procedure set_normalizesize(string normalizesize) 
        this.normalizesize = normalizesize 
        IupSetAttribute(this.handle,"NORMALIZESIZE",upper(normalizesize)) 
    end procedure 
end class 
 
class Vbox extends Container 
    function Vbox(sequence children={}, string attr="") 
        set_handle(IupVbox(handles(children),attr)) 
        return this 
    end function 
end class 
 
class Hbox extends Container 
    function Hbox(sequence children={}, string attr="") 
        set_handle(IupHbox(handles(children),attr)) 
        return this 
    end function 
end class 
 
class Button extends Element 
    integer action 
    procedure set_action(integer action) 
        this.action = action 
        IupSetCallback(this.handle,"ACTION",iff(action?Icallback(action):action)) 
    end procedure 
    function Button(string title="", atom action=NULL, string attr="", sequence data={}) 
        set_handle(IupButton(title,attr,data)) 
        if action!=NULL then set_action(action) end if 
        return this 
    end function 
end class 
 
class Label extends Element 
    string font 
    function Label(string title="", string attr="", sequence data={}) 
        set_handle(IupLabel(title,attr,data)) 
        return this 
    end function 
    procedure set_font(string font) 
        this.font = font 
        IupSetAttribute(this.handle,"FONT",font) 
    end procedure 
end class 
 
class Expander extends Element 
    string state 
    function Expander(Element child=NULL, string attr="") 
        set_handle(IupExpander(iff(child!=NULL?child.handle:child),attr)) 
        return this 
    end function 
    procedure set_state(string state) 
        this.state = state 
        IupSetAttribute(this.handle,"STATE",state) 
    end procedure 
end class