;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; radio button widget
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-widget radio:
  lambda button-ctor ()
    define super new-basic-widget()
    define mouse-inside #f
    define group ""
    define marked #f
    define on-change-cb #nil
    ;;
    method-lambda radio-widget
      super: (self)
        super
      type: (self)
        radio:
      selectable?: (self)
        {not self[ignore?:]}
      text-set!: (self value)
        ;printf "button: new text: %o\n" value
        assert {string? value} "invalid text property"
        inherited text-set!: value
        {self[pref-width:] := {lgfx:text-width-hi(value) + 4}}
        self
      ;;
      group: (self)
        group
      group-set!: (self value)
        assert {string? value} "radio group id should be a string"
        {group := value}
        self
      ;;
      marked?: (self)
        marked
      mark-set!: (self value)
        assert {boolean? value} "radio group id should be a boolean"
        if {value and {not marked}}
          self[window-broadcast: radio-marked: group]
        if {{not value} and marked}
          then
            {marked := #f}
            need-repaint!()
            self[%call-on-change: #f]
        self
      ;;
      on-change: (self)
        on-change-cb
      on-change-set!: (self value)
        {on-change-cb := value}
        self
      ;;
      %call-on-change: (self value)
        assert {boolean? value}
        if {procedure? on-change-cb}
          on-change-cb self value
        self
      ;;
      pref-width-set!: (self value)
        define text self[text:]
        define tw {lgfx:text-width-hi(text) + lgfx:char-width(24) + 4 + 2}
        {value := max(value tw)}
        inherited pref-width-set!: value
        self
      ;;
      paint: (self)
        define wdt self[final-width:]
        define hgt self[final-height:]
        define tc self[style-color-prop: "text"]
        define hc self[style-color-prop: "hi"]
        define text self[text:]
        define tw {lgfx:text-width-hi(text) + lgfx:char-width(24) + 4}
        define xofs 1
        define yofs 0
        ;inc! xofs {{wdt - tw} div 2}
        inc! yofs {{{hgt - lgfx:text-height()} div 2} + lgfx:text-ascender()}
        lgfx:print-char xofs yofs (if marked 24 23) self[style-color-prop: "mark"]
        if {mouse-inside and {not-zero? mouse-button-state} and self[active?:]}
          then
            inc! xofs
            inc! yofs
        inc! xofs {lgfx:char-width(24) + 4}
        lgfx:print-str-hi xofs yofs text tc hc
        self
      ;;
      handle-event: (self evt)
        if {evt[alive?:] and self[active?:]}
          case evt[type:]
            (KEY-DOWN)
              if (or sdl:names-equal?("space" evt[keysym:])
                     sdl:names-equal?(self[hotkey:] evt[keysym:]))
                then
                  {mouse-inside := #f}
                  evt[eat!:]
                  {self[mark:] := #t}
            (MOUSE-MOTION)
              cond
                {zero? mouse-button-state}
                  if mouse-inside
                    then
                      evt[dirty!:]
                      {mouse-inside := #f}
                else
                  if {mouse-inside <> {{mouse-inside := self[xy-in-box?: evt[x:] evt[y:]]}}}
                    evt[dirty!:]
            (MOUSE-DOWN)
              if {mouse-inside <> {{mouse-inside := self[xy-in-box?: evt[x:] evt[y:]]}}}
                evt[dirty!:]
            (MOUSE-UP)
              if {mouse-inside <> {{mouse-inside := self[xy-in-box?: evt[x:] evt[y:]]}}}
                evt[dirty!:]
              if {evt[destination:] eq? self}
                then
                  evt[eat!:]
                  if (and {zero? mouse-button-state}
                          self[xy-in-box?: evt[x:] evt[y:]])
                    then
                      {mouse-inside := #f}
                      {self[mark:] := #t}
            else #void
        if {evt[alive?:] and {evt[type:] eq? 'BROADCAST}}
          case evt[broadcast-type:]
            (radio-marked:)
              ;printf "group: %o (%o); self: %o\n"
              ;  evt[user-data:]
              ;  {evt[user-data:] eqv? group}
              ;  {evt[source:] eq? self}
              if {evt[user-data:] eqv? group}
                if {evt[source:] eq? self}
                  if {not marked}
                    then
                      {marked := #t}
                      need-repaint!()
                      self[%call-on-change: #t]
                  if marked
                    then
                      {marked := #f}
                      need-repaint!()
                      self[%call-on-change: #f]
            (radio-get-marked:)
              if {marked and {evt[user-data:] eqv? group}}
                {evt[source:] := self}
            else #void
          ;; hotkey
          if (and evt[alive?:]
                  evt[key-broadcast?:]
                  {evt[type:] eq? 'KEY-DOWN})
            if sdl:names-equal?(self[hotkey:] evt[keysym:])
              then
                {mouse-inside := #f}
                evt[eat!:]
                self[top-widget:][activate-widget: self]
                {self[mark:] := #t}
        ;;
        if evt[alive?:]
          inherited handle-event: evt
      ;;
      handle-property: (self name value)
        self[property-changed: name value]
        case name
          (group:)
            {self[group:] := value}
            #t
          (marked:)
            {self[mark:] := value}
            #t
          (on-change:)
            {self[on-change:] := value}
            #t
          else
            inherited handle-property: name value
      ;;
      else
        super
