;
;  Check and return the portion of a string that
;   is a valid floating point number.
;
FUNCTION CW_FIELD_VALIDATE, Value
    ;   Look for invalid mantissa

    COMPILE_OPT hidden

    IF Value EQ '' THEN RETURN, ''

    Chars   = [ BYTE(Value), 0b ]
    Curr    = 0
    NeedDecimal = 1

    ;   Valid #s
    ;   [+-]<number>[exponent]
    ;   number ::= [0-9]+[.[0-9]*] or .[0-9]+
    ;   exponent ::= {eEdD}[+-][0-9]+

    ;   Signed value?
    IF Chars[Curr] EQ 43b OR Chars[Curr] EQ 45b THEN Curr = Curr + 1

    ;   Look for digits before the decimal point
    IF Chars[Curr] GE 48b AND Chars[Curr] LE 57b THEN BEGIN
    NeedDecimal = 0

    ;   while(isdigit(*p))++p;
    WHILE Chars[Curr] GE 48b AND Chars[Curr] LE 57b DO Curr = Curr + 1
    ENDIF

    ;   Must have .[0-9]+

    IF NeedDecimal THEN BEGIN
    IF Chars[Curr] NE 46b THEN RETURN,''    ; invalid #
    Curr    = Curr + 1
    IF Chars[Curr] LT 48b OR Chars[Curr] GT 57b THEN RETURN,''

    ;   while(isdigit(*p))++p;
    WHILE Chars[Curr] GE 48b AND Chars[Curr] LE 57b DO Curr = Curr + 1
    ENDIF ELSE BEGIN

    ;   Might have .[0-9]*

    IF Chars[Curr] EQ 46b THEN BEGIN
        Curr    = Curr + 1
        ;   while(isdigit(*p))++p;
        WHILE Chars[Curr] GE 48b AND Chars[Curr] LE 57b DO Curr = Curr + 1
    ENDIF
    ENDELSE

    ;   Exponent?
    Dummy   = WHERE(Chars[Curr] EQ BYTE("dDeE"), Count)
    IF Count THEN BEGIN
    ; Save exponent position in case the exponent is invalid
    ; and only mantissa is valid number.
    SaveCurr    = Curr - 1

    Curr        = Curr + 1  ; skip 'e'
    ;   Signed exponent?
    IF Chars[Curr] EQ 43b OR Chars[Curr] EQ 45b THEN Curr = Curr + 1

    ;   At least one digit after 'e' or exponent is malformed
    IF Chars[Curr] LT 48b OR Chars[Curr] GT 57b THEN BEGIN
        Curr    = SaveCurr  ; Revert -- invalid exponent
    ENDIF ELSE BEGIN
    ;   find end of exponent digits
        WHILE Chars[Curr] GE 48b AND Chars[Curr] LE 57b DO Curr = Curr + 1
    ENDELSE
    ENDIF

    RETURN,STRING(Chars[0:Curr])    ; Chars from 0-Curr are valid
END


FUNCTION CW_FIELD_VALUE, Value, Type

    COMPILE_OPT hidden

    IF Type EQ 0 THEN RETURN, Value

    NValue  = CW_FIELD_VALIDATE(Value[0])

    CASE Type OF
    1:  RETURN, FLOAT(NValue)
    2:  RETURN, FIX(NValue)
    3:  RETURN, LONG(NValue)
    ENDCASE
END

;
;   Procedure to set the value of a CW_FIELD
;
PRO CW_FIELD_SET, Base, Value

    COMPILE_OPT hidden

    sValue  = Value     ; Prevent alteration from reaching back to caller

    Sz  = SIZE(sValue)
    IF Sz[0] NE 7 THEN sValue = STRTRIM(Value,2)

    Child   = WIDGET_INFO(Base, /CHILD)
    WIDGET_CONTROL, Child, GET_UVALUE=State, /NO_COPY
    WIDGET_CONTROL, State.TextId, $
        SET_VALUE=STRTRIM(CW_FIELD_VALUE(sValue, State.Type),2)
    WIDGET_CONTROL, Child, SET_UVALUE=State, /NO_COPY
END

;
;   Function to get the value of a CW_FIELD
;
FUNCTION CW_FIELD_GET, Base

    COMPILE_OPT hidden

    Child   = WIDGET_INFO(Base, /CHILD)
    WIDGET_CONTROL, Child, GET_UVALUE=State, /NO_COPY
    WIDGET_CONTROL, State.TextId, GET_VALUE=Value

    Ret = CW_FIELD_VALUE(Value, State.Type)

    WIDGET_CONTROL, Child, SET_UVALUE=State, /NO_COPY
    RETURN, Ret
END

;   Ascii assumptions
;
;   + - .   = 43,45,46
;   0-9 = 48-57
;   DEde    = 68,69,100,101
;

;
;   Examine an input stream of characters.
;   Alter the field contents to reflect this.
;   If any character inserted in a single operation is invalid,
;       ignore the entire operation.
;   Consider that field may contain a (known) invalid state
;
PRO CW_FIELD_INT, Ch, State, Event, Altered

    COMPILE_OPT hidden

    Altered = 0     ; nothing so far
    Nil     = 0     ; field has contents
    Minus   = 0     ; field is not just a '-'
    Negate  = 0     ; new text has no '-'s in it
    TextId  = State.TextId

    ; Special Cases:
    ;   We don't actually care where in the input string a
    ;   '-' is.  If there is an odd number of them, we
    ;   negate the value (see below)
    ;
    ;   Current String      Char        Result
    ;   Nil         '-'     '-'
    ;   -           '-'     Nil
    ;   <any number>        '-'     -<number>

    WIDGET_CONTROL, TextId, GET_VALUE=Value
    Value   = Value[0]

    IF Value EQ '' THEN Nil = 1     ; Value is nil string
    IF Value EQ '-' THEN Minus = 1  ; Value is an invalid number


    ;   <CR>
    IF Ch EQ 10b THEN BEGIN
    Altered = 2
    RETURN
    ENDIF

    IF Ch EQ 45b THEN Negate = 1 $
    ELSE IF Ch GE 48b AND Ch LE 57b THEN BEGIN
    Nil = 0 & Minus = 0
    ENDIF ELSE RETURN   ; ![0-9]

    ;   Add new character (if any)

    Selection   = WIDGET_INFO(TextId, /TEXT_SELECT)
    TIP     = Selection[0]+1-Negate ; Text Insertion Point

    IF Negate EQ 0 THEN BEGIN
    WIDGET_CONTROL, TextId, SET_VALUE=STRING(Ch), /USE_TEXT_SELECT
    Altered = 1
    ENDIF

    IF Negate THEN BEGIN
    IF Nil THEN BEGIN
        WIDGET_CONTROL, TextId, SET_VALUE='-'
        TIP = 1
    ENDIF ELSE IF Minus THEN BEGIN
        WIDGET_CONTROL, TextId, SET_VALUE=''
    ENDIF ELSE BEGIN
        ;   We actually have a number to negate

        WIDGET_CONTROL, TextId, GET_VALUE=Value
        IValue  = LONG(Value)
        TIP     = TIP + (IValue GT 0) - (IValue LT 0)
        WIDGET_CONTROL, TextId, SET_VALUE=STRTRIM(-IValue,2)
    ENDELSE
    Altered = 1
    ENDIF

    ; Set selection point
    IF Altered THEN WIDGET_CONTROL, TextId, SET_TEXT_SELECT=[TIP,0]
END


FUNCTION CW_FIELD_EXPONENT, Value, Idx

    COMPILE_OPT hidden

    BValue  = BYTE(Value)

    Idx = WHERE(BValue EQ 68b, Count)
    IF Count EQ 1 THEN RETURN, 1
    Idx = WHERE(BValue EQ 69b, Count)
    IF Count EQ 1 THEN RETURN, 1
    Idx = WHERE(BValue EQ 100b, Count)
    IF Count EQ 1 THEN RETURN, 1
    Idx = WHERE(BValue EQ 101b, Count)
    IF Count EQ 1 THEN RETURN, 1
    RETURN, 0
END

;
;   Floating point number are even more complicated.
;   There are more invalid states available.
;   Currently, we are more lax.
;
PRO CW_FIELD_FLOAT, Ch, State, Event, Altered

    COMPILE_OPT hidden

    TextId  = State.TextId
    WIDGET_CONTROL, TextId, GET_VALUE=Value
    Value   = Value[0]

    IF Ch EQ 10b THEN BEGIN
    Value   = CW_FIELD_VALIDATE(Value)
    WIDGET_CONTROL, TextId, SET_VALUE=Value
    WIDGET_CONTROL, TextId, SET_TEXT_SELECT=[Strlen(Value),0]
    Altered = 2
    RETURN
    ENDIF

    ;   Unfortunately, we have a lot of invalid states
    ;   possible that aren't a problem.
    ;   We make sure of just a minimum number of
    ;   things:
    ;   One EeDd per field.
    ;   One decimal point, before the exponent
    ;   - sign must be 1st char or follow the exponent.

    Selection   = WIDGET_INFO(TextId, /TEXT_SELECT)

    IF Ch GE 48b AND Ch LE 57b THEN BEGIN
    WIDGET_CONTROL, TextId, SET_VALUE=STRING(Ch), /USE_TEXT_SELECT
    ENDIF ELSE BEGIN
    CASE Ch OF

    46b:    BEGIN
        ;   Ignore it if there is one already
        ;   New decimal point must precede exponent

        Idx = WHERE(BYTE(Value) EQ 46b, Count)
        IF Count EQ 1 THEN RETURN
        IF CW_FIELD_EXPONENT( Value, Idx ) THEN BEGIN
        IF Idx[0] LT Selection[0] THEN RETURN
        ENDIF
        WIDGET_CONTROL, TextId, SET_VALUE=STRING(Ch), /USE_TEXT_SELECT
    END
    43b:    BEGIN   ; + must follow exponent
        IF CW_FIELD_EXPONENT( Value, Idx ) THEN BEGIN
        IF Idx[0]+1 EQ Selection[0] THEN BEGIN
            WIDGET_CONTROL, TextId, SET_VALUE='+', /USE_TEXT_SELECT
        ENDIF ELSE RETURN
        ENDIF ELSE RETURN
    END
    45b:    BEGIN
        HaveExp = CW_FIELD_EXPONENT( Value, Idx )
        IF  (HaveExp AND Idx[0]+1 EQ Selection[0]) OR $
        (Selection[0] EQ 0 AND STRMID(Value,0,1) NE "-") THEN BEGIN
        WIDGET_CONTROL, TextId, SET_VALUE='-', /USE_TEXT_SELECT
        ENDIF ELSE RETURN
    END

    68b:    GOTO, Exponent
    69b:    GOTO, Exponent
    100b:   GOTO, Exponent
    101b:   BEGIN
    Exponent:

    ;   Replace if one exists. Otherwise allow it anywhere
    ;   AFTER the decimal point
        IF CW_FIELD_EXPONENT( Value, Idx ) THEN BEGIN
        Selection   = [ Idx, 1 ]
        WIDGET_CONTROL, TextId, SET_TEXT_SELECT=Selection
        ENDIF ELSE BEGIN
        Idx = WHERE(BYTE(Value) EQ 46b, Count)
        IF Count EQ 1 THEN BEGIN
            IF Selection[0] LE Idx[0] THEN RETURN
        ENDIF
        ENDELSE
        WIDGET_CONTROL, TextId, SET_VALUE=STRING(Ch), /USE_TEXT_SELECT
    END

    ELSE:   RETURN  ; Bad
    ENDCASE
    ENDELSE



    Altered = 1
    WIDGET_CONTROL, TextId, SET_TEXT_SELECT=[Selection[0]+1,0]
END

FUNCTION CW_FIELD_EVENT, Event

    COMPILE_OPT hidden

    StateHolder = WIDGET_INFO(Event.Handler, /CHILD)
    WIDGET_CONTROL, StateHolder, GET_UVALUE=State, /NO_COPY

    ;   At this point, we need to look at what kind of field
    ;   we have:

    Altered = 0

    ;   If the user has types <CR> then update field

    IF State.Type NE 0 THEN BEGIN       ; Not a String?

    IF Event.Type LE 1 THEN BEGIN       ; Insert Characters?

        IF State.Type EQ 1 THEN Procedure='CW_FIELD_FLOAT' $
        ELSE Procedure='CW_FIELD_INT'

        Altered = 0
        IF Event.Type EQ 0 THEN BEGIN
        CALL_PROCEDURE, Procedure, Event.Ch, State, Event, Altered
        ENDIF ELSE BEGIN
        Chars   = BYTE(Event.Str)
        FOR I=0,N_ELEMENTS(Chars)-1 DO $
            CALL_PROCEDURE, Procedure, Chars[I], State, Event, Altered
        ENDELSE

    ENDIF ELSE IF Event.Type EQ 2 THEN BEGIN    ; Delete Text

        IF Event.Length GT 0 THEN BEGIN ; Bug in widget
        WIDGET_CONTROL, State.TextId, $
            SET_TEXT_SELECT=[Event.Offset,Event.Length]
        WIDGET_CONTROL, State.TextId, SET_VALUE='', /USE_TEXT_SELECT

        ;   See if user wants an update
            Altered = 1
        ENDIF

    ENDIF
    ENDIF ELSE BEGIN
    ;   All delete/add char events effect the contents of
    ;   a string. <CR> is considered special.
    IF Event.Type GE 0 AND Event.Type LE 2 THEN Altered = 1
    IF Event.Type EQ 0 THEN $
       Altered  = 1 + (Event.Ch EQ 10b)
    ENDELSE


    Ret = 0

    ;   If the entry has been modified or <CR> was hit
    ;   And the user is interested in all event or
    ;   Just <CR> AND <CR> was the cause of update then
    ;   send it
    IF State.Update NE 0 AND $
       Altered GE State.Update THEN BEGIN

    WIDGET_CONTROL, State.TextId, GET_VALUE=Value
    RValue  = CW_FIELD_VALUE(Value, State.Type)

    Ret = {         $
        ID: Event.Handler,  $
        TOP: Event.Top,     $
        HANDLER: 0L,        $
        VALUE: RValue,      $
        TYPE: State.Type,   $
        UPDATE: Altered - 1 $   ; 0=any,1=CR
    }
    ENDIF

    efun = State.efun
    update = State.Update

    ;   Restore our state structure
    WIDGET_CONTROL, StateHolder, SET_UVALUE=State, /NO_COPY
    if efun eq '' then $
        return, ret $
    else begin
        IF update NE 0 AND $
            Altered GE update THEN BEGIN
            ; only call event handler if we are returning an event structure
            return, CALL_FUNCTION(efun, ret)
        ENDIF ELSE return, ret
    endelse
END


FUNCTION CW_FIELD, Parent, COLUMN=Column, ROW=Row, $
    EVENT_FUNC = efun, $
    FLOATING=Float, INTEGER=Int, LONG=Long, STRING=String, $
    FONT=LabelFont, FRAME=Frame, TITLE=Title, UVALUE=UValue, VALUE=TextValueIn, $
    RETURN_EVENTS=ReturnEvents, ALL_EVENTS=AllUpdates, $
    FIELDFONT=FieldFont, NOEDIT=NoEdit, TEXT_FRAME=Text_Frame, $
    XSIZE=XSize, YSIZE=YSize, UNAME=uname, TAB_MODE=tab_mode
;   FLOOR=vmin, CEILING=vmax

    ;   Examine our keyword list and set default values
    ;   for keywords that are not explicitly set.

    Column      = KEYWORD_SET(Column)
    Row         = 1 - Column
    AllEvents       = 1 - KEYWORD_SET(NoEdit)

    ; Enum Update { None, All, CRonly }
    Update      = 0
    IF KEYWORD_SET(AllUpdates) THEN Update  = 1
    IF KEYWORD_SET(ReturnEvents) THEN Update    = 2

    IF N_ELEMENTS(efun) LE 0 THEN efun = ''
    IF N_ELEMENTS(Title) EQ 0 THEN Title='Input Field:'
    TextValue = (N_ELEMENTS(TextValueIn) gt 0) ? TextValueIn : ''
    ; Convert non-string values to strings.
    if (SIZE(TextValue, /TNAME) ne 'STRING') then $
        TextValue = STRTRIM(TextValue,2)
    IF N_ELEMENTS(YSize) EQ 0 THEN YSize=1
    IF N_ELEMENTS(uname) EQ 0 THEN uname='CW_FIELD_UNAME'

    Type    = 0 ; string is default
    IF KEYWORD_SET(Float) THEN  Type    = 1
    IF KEYWORD_SET(Int) THEN    Type    = 2
    IF KEYWORD_SET(Long) THEN   Type    = 3

    ;   Don't allow multiline non string widgets
    if (Type ne 0) then $
        YSize=1
    YSize = YSize > 1

    ;   Build Widget

    Base    = WIDGET_BASE(Parent, ROW=Row, COLUMN=Column, UVALUE=UValue, $
            EVENT_FUNC='CW_FIELD_EVENT', $
            PRO_SET_VALUE='CW_FIELD_SET', $
            FUNC_GET_VALUE='CW_FIELD_GET', $
            FRAME=Frame, UNAME=uname )

    if ( N_ELEMENTS(tab_mode) ne 0 ) then $
        WIDGET_CONTROL, Base, TAB_MODE = tab_mode

    if strlen(Title) gt 0 then $
        Label   = WIDGET_LABEL(Base, VALUE=Title, FONT=LabelFont, $
            UNAME=uname+'_LABEL')
    Text    = WIDGET_TEXT(Base, VALUE=TextValue, $
            XSIZE=XSize, YSIZE=YSize, FONT=FieldFont, $
            ALL_EVENTS=AllEvents, $
            EDITABLE=(AllEvents AND TYPE EQ 0), $
            FRAME=Text_Frame , $
            UNAME=uname+'_TEXT')

            ; NO_ECHO=(AllEvents AND (TYPE NE 0)))

    ; Save our internal state in the first child widget
    State   = {     $
    efun: efun,         $
    TextId:Text,        $
    Title:Title,        $
    Update:Update,      $
    Type:Type       $
    }
    WIDGET_CONTROL, WIDGET_INFO(Base, /CHILD), SET_UVALUE=State, /NO_COPY
    RETURN, Base
END