;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; extended list box widget
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-widget listbox:
  lambda listbox-ctor ()
    define super new-basic-widget()
    ;; item:
    ;; * just a string
    ;; * item object
    ;;     height: (self) -- called once when the item is added, and cached
    ;;     paint: (self widget x y wdt index selected)
    ;;     handle-event: (self widget evt)
    define items make-vector()
    define item-yofs make-vector(1 0)  ;; one more than items
    define top-skip-y 0
    define current-item 0
    define first-show #t
    define prev-click-time 0
    ;;
    method-lambda listbox-widget
      super: (self)
        super
      type: (self)
        listbox:
      selectable?: (self)
        {not self[ignore?:]}
      ;;
      v-scrollbar-min: (self)
        0
      v-scrollbar-max: (self)
        ;if {vector-length(items) < 2}
        ;  0
        ;  item-yofs[{vector-length(items) - 1}]
        max 0 {self[%max-height:] - self[%page-height:]}
      v-scrollbar-current: (self)
        ;item-yofs[current-item]
        top-skip-y
      v-scrollbar-scroll-to: (self position)
        ;TODO
        if {vector-length(items) > 1}
          then
            define yofs max(0 trunc(position))
            if {yofs <> top-skip-y}
              then
                {top-skip-y := yofs}
                self[%normalize-top-y:]
                need-repaint!() ;;FIXME: check if we really need to repaint anything
        self
      ;;
      clear-items: (self)
        if {positive? vector-length(items)}
          then
            self[send-desktop-notify: clear-items:]
            vector-resize! items 0
            vector-resize! item-yofs 1
            {item-yofs[0] := 0}
            {current-item := 0}
        ;assert {{vector-length(items) + 1} = vector-length(item-yofs)}
        self
      ;;
      %max-height: (self)
        ;printf "l0=%o; l1=%o\n" vector-length(items) vector-length(item-yofs)
        ;assert {{vector-length(items) + 1} = vector-length(item-yofs)}
        item-yofs[vector-length(items)]
      ;;
      ;; return index. index might be out of range.
      find-item-at-y: (self y)
        cond
          {negative? y}
            -1
          {y >= self[%max-height:]}
            vector-length items
          else
            define m
            define l 0
            define r vector-length(items)
            while {l < r}
              {m := {l + {{r - l} div 2}}}
              if {item-yofs[m] > y}
                {r := m}
                {l := {m + 1}}
            assert between?(r 1 vector-length(items))
            dec! r
      ;;
      item-selectable?: (self index)
        assert within?(index 0 vector-length(items)) "invalid item index"
        if {positive? self[item-height: index]}
          then
            define item items[index]
            if {string? item}
              #t
              item[selectable?:]
          else
            #f
      ;;
      append-item: (self value)
        assert {{procedure? value} or {string? value}} "invalid item value"
        self[send-desktop-notify: append-item: value]
        define ihgt
        cond
          {string? value}
            {ihgt := lgfx:text-height()}
          {procedure? value}
            {ihgt := max(0 value[height:])}
        vector-push! item-yofs {self[%max-height:] + ihgt}
        vector-push! items value
        ;assert {{vector-length(items) + 1} = vector-length(item-yofs)}
        if {vector-length(items) = 1}
          if self[item-selectable?: 0]
            self[send-desktop-notify: current-item-set!: 0]
          if {{not self[item-selectable?: self[current-item:]]} and
              self[item-selectable?: {vector-length(items) - 1}]}
            then
              {current-item := {vector-length(items) - 1}}
              self[send-desktop-notify: current-item-set!: current-item]
        self
      ;;
      item-refresh: (self index)
        define icount vector-length(items)
        assert within?(index 0 icount)
        define item items[index]
        define hgt (if {string? item} lgfx:text-height() max(0 item[height:]))
        define delta {hgt - self[item-height: index]}
        if {not-zero? delta}
          then
            inc! index
            inc! icount
            while {index <> icount}
              {item-yofs[index] := {item-yofs[index] + delta}}
              inc! index
        {self[current-item:] := self[current-item:]}
        need-repaint!()
        self
      ;;
      item-set!: (self index item)
        assert {{procedure? value} or {string? value}} "invalid item value"
        {items[index] := item}
        self[item-refresh:]
      ;;
      item-count: (self)
        vector-length items
      ;;
      item: (self index)
        assert {{fixnum? index} and within?(index 0 vector-length(items))} "invalid item index"
        items[index]
      ;;
      item-height: (self index)
        assert {{fixnum? index} and within?(index 0 vector-length(items))} "invalid item index"
        {item-yofs[{index + 1}] - item-yofs[index]}
      ;;
      current-item: (self)
        current-item
      ;; in pixels, never 0
      %page-height: (self)
        max(1 {self[final-height:] - 2})
      ;;
      end-bulk-operation: (self)
        define res inherited(end-bulk-operation:)
        if {zero? res}
          then
            self[send-desktop-notify: current-item-set!: self[current-item:]]
            need-repaint!() ;;FIXME: check if we really need to repaint anything
        res
      ;;
      %normalize-top-y: (self)
        define old-skip-y top-skip-y
        {top-skip-y := clamp(top-skip-y 0 {self[%max-height:] - self[%page-height:]})}
        {top-skip-y <> old-skip-y}
      ;;
      make-current-item-visible: (self centered)
        if {positive? vector-length(items)}
          then
            define index current-item
            assert within?(current-item 0 vector-length(items))
            define y0 item-yofs[current-item]
            define y1 item-yofs[{current-item + 1}]
            define ph self[%page-height:]
            define old-skip-y top-skip-y
            cond
              {y0 < top-skip-y}
                {top-skip-y := y0}
                if centered
                  dec! top-skip-y {ph div 2}
              {y1 >= {top-skip-y + ph}}
                {top-skip-y := {y1 - ph}}
                if centered
                  int! top-skip-y {ph div 2}
              centered
                {top-skip-y := {y0 + {ph div 2}}}
              else #void
            self[%normalize-top-y:]
            if {old-skip-y <> top-skip-y}
              need-repaint!() ;;FIXME: check if we really need to repaint anything
        self
      ;;
      %current-item-set!: (self index dy centered)
        assert {fixnum? index} "invalid item index"
        cond
          {zero? vector-length(items)}
            if {current-item <> 0}
              self[send-desktop-notify: current-item-set!: 0]
            {current-item := 0}
            {top-skip-y := 0}
          else
            define imax {vector-length(items) - 1}
            {index := clamp(index 0 imax)}
            while {between?(index 0 imax) and {not self[item-selectable?: index]}}
              if {negative? dy}
                dec! index
                inc! index
            if {between?(index 0 imax) and {current-item <> index}}
              then
                {current-item := index}
                self[send-desktop-notify: current-item-set!: index]
                need-repaint!() ;;FIXME: check if we really need to repaint anything
            self[make-current-item-visible: centered]
        self
      ;;
      current-item-set!:
        case-lambda
          (self index)
            {self[%current-item: index 1] := #f}
          (self index centered)
            assert {boolean? centered}
            {self[%current-item: index 1] := centered}
      ;;
      ;delete-item: (self index)
      ;TODO
      ;;
      paint: (self)
        define items self[item-count:]
        define wdt self[final-width:]
        define hgt self[final-height:]
        define bc self[style-color-prop: "back"]
        define fc self[style-color-prop: "frame"]
        lgfx:draw-round-rect 0 0 wdt hgt fc
        self[update-clip-rect: 1 1 {wdt - 2} {hgt - 2}]
        lgfx:fill-rect 0 0 wdt hgt bc
        define cit self[current-item:]
        define item-n self[find-item-at-y: top-skip-y]
        assert {item-n >= 0}
        define y0 {{- top-skip-y} + item-yofs[item-n] + 1}
        define asc lgfx:text-ascender()
        define item
        dec! wdt 2
        while {{y0 < hgt} and {item-n < items}}
          {item := self[item: item-n]}
          if {string? item}
            then
              cond
                {item-n = cit}
                  lgfx:fill-rect 1 y0 wdt th self[style-color-prop: "back-selection"]
                  lgfx:print-str 2 {y0 + asc} item self[style-color-prop: "text-selection"]
                {even? item-n}
                  lgfx:print-str 2 {y0 + asc} item tce
                else
                  lgfx:print-str 2 {y0 + asc} item tco
            else
              item[paint: self 1 y0 wdt item-n {item-n = cit}]
          inc! item-n
          inc! y0 {item-yofs[item-n] - item-yofs[{item-n - 1}]}
        self
      ;;
      %do-page-up: (self)
        define do-real-page-up(self)
          define ph self[%page-height:]
          define iidx self[current-item:]
          define iy item-yofs[iidx]
          define prev-iidx -666
          while {{prev-iidx <> {iidx := self[current-item:]}} and
                 {iy < {top-skip-y + ph}}}
            {prev-iidx := iidx}
            {self[%current-item: {iidx - 1} -1] := #f}
        ;;
        define icount self[item-count:]
        if {icount > 1}
          then
            define iidx self[current-item:]
            define top-idx self[find-item-at-y: top-skip-y]
            cond
              {iidx <> top-idx}
                {self[%current-item: top-idx 1] := #f}
                if {iidx = self[current-item:]}
                  do-real-page-up self
              else
                do-real-page-up self
      ;;
      %do-page-down: (self)
        define do-real-page-down(self)
          define iidx self[current-item:]
          define iy item-yofs[iidx]
          define prev-iidx -666
          while {{prev-iidx <> {iidx := self[current-item:]}} and
                 {iy >= top-skip-y}}
            {prev-iidx := iidx}
            {self[%current-item: {iidx + 1} 1] := #f}
        ;;
        define icount self[item-count:]
        if {icount > 1}
          then
            define iidx self[current-item:]
            define bot-idx self[find-item-at-y: {top-skip-y + self[%page-height:] + -1}]
            cond
              {iidx <> bot-idx}
                {self[%current-item: bot-idx -1] := #f}
                if {iidx = self[current-item:]}
                  do-real-page-down self
              else
                do-real-page-down self
      ;;
      handle-event: (self evt)
        ;printf "msg: %o\n" evt[type:]
        ;; pass event to the item first
        if {{positive? self[item-count:]} and evt[alive?:]}
          then
            define iit self[item: self[current-item:]]
            if {procedure? iit}
              iit[handle-event: self evt]
        ;; process event normally
        if evt[alive?:]
          case evt[type:]
            (KEY-DOWN)
              define ks evt[keysym:]
              cond
                self[active?:]
                  cond
                    {sdl:names-equal?("up" ks) or
                     sdl:names-equal?("kp-8" ks)}
                      evt[eat!:]
                      {self[%current-item: {self[current-item:] - 1} -1] := #f}
                    {sdl:names-equal?("down" ks) or
                     sdl:names-equal?("kp-2" ks)}
                      evt[eat!:]
                      {self[%current-item: {self[current-item:] + 1} 1] := #f}
                    {sdl:names-equal?("home" ks) or
                     sdl:names-equal?("kp-7" ks)}
                      evt[eat!:]
                      {self[%current-item: 0 1] := #f}
                    {sdl:names-equal?("end" ks) or
                     sdl:names-equal?("kp-1" ks)}
                      evt[eat!:]
                      {self[%current-item: {self[item-count:] - 1} -1] := #f}
                    {sdl:names-equal?("page-up" ks) or
                     sdl:names-equal?("kp-9" ks)}
                      evt[eat!:]
                      self[%do-page-up:]
                    {sdl:names-equal?("page-down" ks) or
                     sdl:names-equal?("kp-3" ks)}
                      evt[eat!:]
                      self[%do-page-down:]
                    {sdl:names-equal?("C-up" ks) or
                     sdl:names-equal?("C-kp-8" ks)}
                      evt[eat!:]
                      dec! top-skip-y lgfx:text-height()
                      self[%normalize-top-y:]
                    {sdl:names-equal?("C-down" ks) or
                     sdl:names-equal?("C-kp-2" ks)}
                      evt[eat!:]
                      inc! top-skip-y lgfx:text-height()
                      self[%normalize-top-y:]
                    {sdl:names-equal?("return" ks) and self[has-action?:]}
                      evt[eat!:]
                      self[perform-action:]
                    else
                      #void
                (and self[selectable?:]
                     evt[key-broadcast?:]
                     sdl:names-equal?(self[hotkey:] ks))
                  evt[eat!:]
                  self[top-widget:][activate-widget: self]
                else #void
            (MOUSE-DOWN)
              if {{zero? mouse-button-state} and {positive? self[item-count:]}}
                {self[current-item:] := self[find-item-at-y: {top-skip-y + evt[y:]}]}
              evt[eat!:]
            (MOUSE-UP)
              if (and {zero? mouse-button-state}
                      {positive? self[item-count:]})
                then
                  define ccit self[find-item-at-y: {top-skip-y + evt[y:]}]
                  if {{ccit = self[current-item:]} and {{evt[time:] - prev-click-time} < 400}}
                    then
                      {prev-click-time := 0}
                      self[perform-action:]
                    else
                      {prev-click-time := evt[time:]}
              evt[eat!:]
            (MOUSE-WHEEL)
              if {negative? evt[wheel-y:]}
                dec! top-skip-y lgfx:text-height()
                inc! top-skip-y lgfx:text-height()
              self[%normalize-top-y:]
              evt[eat!:]
            (WINDOW-FOCUS)
              self[make-current-item-visible: first-show]
              {first-show := #f}
            else #void
        if evt[alive?:]
          inherited handle-event: evt
      ;;
      handle-property: (self name value)
        self[property-changed: name value]
        case name
          (content:)
            ;pprint value
            assert {lax-car(value) eq? item-list:} "invalid listbox content"
            self[clear-items:]
            {value := cdr(value)}
            while {not-null? value}
              self[append-item: car(value)]
              {value := cdr(value)}
            #t
          else
            inherited handle-property: name value
      ;;
      else
        super

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; simple string item object
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
constant simple-item-object
  method-lambda simple-item-object
    ;; override this in the subclass
    text: (self)
      "<list item>"
    ;;
    height: (self)
      lgfx:text-height()
    ;;
    selectable?: (self)
      #t
    ;;
    paint: (self widget x y wdt index selected)
      define th lgfx:text-height()
      define asc lgfx:text-ascender()
      cond
        selected
          lgfx:fill-rect 1 y0 wdt th self[style-color-prop: "back-selection"]
          lgfx:print-str 2 {y0 + asc} item self[style-color-prop: "text-selection"]
        {even? index}
          lgfx:print-str 2 {y0 + asc} item self[style-color-prop: "text-even"]
        else
          lgfx:print-str 2 {y0 + asc} item self[style-color-prop: "text-odd"]
    ;;
    handle-event: (self widget evt)
      #void
