;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; window frame.
;; this widget serves as main window controller.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-widget window-frame:
  lambda window-frame-ctor ()
    define super new-basic-widget()
    define moving #f
    define sizing #f  ;; with alt-mouse
    define moving-with-keyboard #f
    define moving-x-frac 0
    define moving-y-frac 0
    define desktop #nil
    define activate-widget-name #nil
    define mouse-grab-widget #nil
    ;;
    method-lambda window-frame-widget
      super: (self)
        super
      type: (self)
        window-frame:
      %parent-box-set!: (self box)
        assert {{null? box} or {box[type:] eq? desktop:}} "window cannot be turned to a child"
        inherited %parent-box-set!: box
        self
      activate-widget-name: (self)
        activate-widget-name
      activate-default-widget: (self)
        if (or {symbol? activate-widget-name}
               {string? activate-widget-name}
               {number? activate-widget-name})
          then
            define cbox self[find-child-widget: activate-widget-name]
            if {{not-null? cbox} and cbox[selectable?:]}
              self[activate-widget: cbox]
        self
      desktop: (self)
        desktop
      desktop-set!: (self value)
        assert {{null? value} or {value[box?:] and {null? value[parent:]}}}
            "invalid desktop box"
        assert {not {value eq? self}} "cannot set desktop to self"
        {desktop := value}
        self
      active-window?: (self)
        define desk self[desktop:]
        {{not-null? desk} and {desk[active-window:] eq? self}}
      top-widget?: (self)
        #t
      start-mouse-sizing: (self)
        {sizing := #t}
        {moving := #f}
        {moving-x-frac := 0}
        {moving-y-frac := 0}
        self
      stop-sizing: (self)
        {sizing := #f}
        {moving := #f}
        self
      start-mouse-moving: (self)
        {sizing := #f}
        {moving := #t}
        {moving-with-keyboard := #f}
        {moving-x-frac := 0}
        {moving-y-frac := 0}
        self
      start-keyboard-moving: (self)
        {sizing := #f}
        {moving := #t}
        {moving-with-keyboard := #t}
        self
      stop-moving: (self)
        {sizing := #f}
        {moving := #f}
        self
      real-frame-color: (self)
        if self[active-window?:]
          self[style-prop: frame-color:]
          self[style-prop: frame-color-inactive:]
      real-back-color: (self)
        if self[active-window?:]
          self[style-prop: back-color:]
          self[style-prop: back-color-inactive:]
      ;;
      paint: (self)
        define wdt self[final-width:]
        define hgt self[final-height:]
        if {{positive? wdt} and {positive? hgt} and {not self[ignore?:]}}
          lgfx:run-and-restore-clip
            lambda ()
              self[set-clip-rect:]
              define bc self[real-back-color:]
              define fc self[real-frame-color:]
              lgfx:draw-round-rect 0 0 wdt hgt fc
              self[set-clip-rect-with-inset:]
              lgfx:fill-rect 0 0 wdt hgt bc
              self[paint-children:]
              cond
                {moving or sizing}
                  lgfx:set-draw-blend-mode 'BLEND
                  lgfx:fill-rect 0 0 wdt hgt #@color:#5304
                  lgfx:set-draw-blend-mode 'NONE
                {not self[active-window?:]}
                  lgfx:shade-rect 0 0 wdt hgt self[style-prop: inactive-shade:]
                else #void
        self
      activate-widget: (self cbox)
        if {{not-null? cbox} and cbox[selectable?:]}
          then
            self[%send-widget-activation-event: cbox]
            need-repaint!()
            #t
          else
            #f
      first-tab-widget: (self)
        self[%send-first-tab-event:]
      last-tab-widget: (self)
        self[%send-last-tab-event:]
      prev-tab-widget: (self)
        define cbox self[%send-prev-tab-event:]
        if {null? cbox}
          self[last-tab-widget:]
          cbox
      next-tab-widget: (self)
        define cbox self[%send-next-tab-event:]
        if {null? cbox}
          self[first-tab-widget:]
          cbox
      ;;
      %do-resize!: (self dx dy)
        if {{not-zero? dx} or {not-zero? dy}}
          then
            define old-w self[final-width:]
            define old-h self[final-height:]
            define new-w clamp({old-w + dx} self[min-width:] self[max-width:])
            define new-h clamp({old-h + dy} self[min-height:] self[max-height:])
            ;printf "resizing! dx=%d; dy=%d; old: %dx%d; new:%dx%d\n" dx dy old-w old-h new-w new-h
            if {{old-w <> new-w} or {old-h <> new-h}}
              then
                define fx self[final-x:]
                define fy self[final-y:]
                {self[pref-width:] := new-w}
                {self[pref-height:] := new-h}
                do-layout self
                {self[final-x:] := fx}
                {self[final-y:] := fy}
                #t
              else
                #f
      ;;
      %do-move!: (self dx dy)
        define desk self[desktop:]
        define max-x max(0 {desk[max-width:] - self[final-width:]})
        define max-y max(0 {desk[max-height:] - self[final-height:]})
        define old-x self[final-x:]
        define old-y self[final-y:]
        define new-x clamp({old-x + dx} 0 max-x)
        define new-y clamp({old-y + dy} 0 max-y)
        if {{old-x <> new-x} or {old-y <> new-y}}
          then
            {self[final-x:] := new-x}
            {self[final-y:] := new-y}
            #t
          else
            #f
      %do-win-home!: (self h v)
        define desk self[desktop:]
        define old-x self[final-x:]
        define old-y self[final-y:]
        define new-x old-x
        define new-y old-y
        cond
          {{zero? h} and {zero? v}}
            ;; center
            {new-x := {{desk[max-width:] - self[final-width:]} div 2}}
            {new-y := {{desk[max-height:] - self[final-height:]} div 2}}
          else
            define max-x max(0 {desk[max-width:] - self[final-width:]})
            define max-y max(0 {desk[max-height:] - self[final-height:]})
            if {negative? h} {new-x := 0}
            if {positive? h} {new-x := max-x}
            if {negative? v} {new-y := 0}
            if {positive? v} {new-y := max-y}
        if {{old-x <> new-x} or {old-y <> new-y}}
          then
            {self[final-x:] := new-x}
            {self[final-y:] := new-y}
            #t
          else
            #f
      ;; event handler. should pass the event to the destination.
      ;; return value doesn't matter.
      handle-event: (self evt)
        define do-key-arrows(self evt)
          define keylist '(
            ;; fast movement
            ("left"  %do-move!: . (-10 .   0))
            ("right" %do-move!: . ( 10 .   0))
            ("up"    %do-move!: . (  0 . -10))
            ("down"  %do-move!: . (  0 .  10))
            ("kp-4"  %do-move!: . (-10 .   0))
            ("kp-6"  %do-move!: . ( 10 .   0))
            ("kp-8"  %do-move!: . (  0 . -10))
            ("kp-2"  %do-move!: . (  0 .  10))
            ;; slow movement
            ("S-left"  %do-move!: . (-1 .  0))
            ("S-right" %do-move!: . ( 1 .  0))
            ("S-up"    %do-move!: . ( 0 . -1))
            ("S-down"  %do-move!: . ( 0 .  1))
            ("S-kp-4"  %do-move!: . (-1 .  0))
            ("S-kp-6"  %do-move!: . ( 1 .  0))
            ("S-kp-8"  %do-move!: . ( 0 . -1))
            ("S-kp-2"  %do-move!: . ( 0 .  1))
            ;; fast resize
            ("M-left"  %do-resize!: . (-10 .   0))
            ("M-right" %do-resize!: . ( 10 .   0))
            ("M-up"    %do-resize!: . (  0 . -10))
            ("M-down"  %do-resize!: . (  0 .  10))
            ("M-kp-4"  %do-resize!: . (-10 .   0))
            ("M-kp-6"  %do-resize!: . ( 10 .   0))
            ("M-kp-8"  %do-resize!: . (  0 . -10))
            ("M-kp-2"  %do-resize!: . (  0 .  10))
            ;; slow resize
            ("M-S-left"  %do-resize!: . (-1 .  0))
            ("M-S-right" %do-resize!: . ( 1 .  0))
            ("M-S-up"    %do-resize!: . ( 0 . -1))
            ("M-S-down"  %do-resize!: . ( 0 .  1))
            ("M-S-kp-4"  %do-resize!: . (-1 .  0))
            ("M-S-kp-6"  %do-resize!: . ( 1 .  0))
            ("M-S-kp-8"  %do-resize!: . ( 0 . -1))
            ("M-S-kp-2"  %do-resize!: . ( 0 .  1))
            ;; return window to the origin (x)
            ("page-up"   %do-win-home!: . (0 . -1))
            ("kp-9"      %do-win-home!: . (0 . -1))
            ;; return window to the end (x)
            ("page-down" %do-win-home!: . (0 . 1))
            ("kp-3"      %do-win-home!: . (0 . 1))
            ;; return window to the origin (y)
            ("home"      %do-win-home!: . (-1 . 0))
            ("kp-7"      %do-win-home!: . (-1 . 0))
            ;; return window to the end (y)
            ("end"       %do-win-home!: . (1 . 0))
            ("kp-1"      %do-win-home!: . (1 . 0))
            ;; return window to the center
            ("kp-5"      %do-win-home!: . (0 . 0))
          )
          define ks evt[keysym:]
          define act keylist
          while {{not-null? act} and {not sdl:names-equal?(ks caar(act))}}
            {act := cdr(act)}
          {act := lax-cdar(act)}
          if {not-null? act}
            invoke self car(act) cadr(act) cddr(act)
            #f
        ;;
        define do-keydown(self evt)
          cond
            {moving and moving-with-keyboard}
              cond
                sdl:names-equal?(evt[keysym:] "escape")
                  self[stop-moving:]
                  evt[eat!:]
                sdl:names-equal?(evt[keysym:] "return")
                  self[stop-moving:]
                  evt[eat!:]
                do-key-arrows(self evt)
                  evt[eat!:]
                else
                  evt[cancel!:]
            {moving or sizing}
              evt[cancel!:]
            (and {not-null? mouse-grab-widget}
                 {null? evt[destination:]})
              {evt[destination:] := mouse-grab-widget}
              inherited handle-event: evt
            else
              inherited handle-event: evt
              if evt[alive?:]
                then
                  define ks evt[keysym:]
                  cond
                    {sdl:names-equal?(ks "S-f4") or sdl:names-equal?(ks "C-f4")}
                      self[start-keyboard-moving:]
                      evt[eat!:]
                    sdl:names-equal?(ks "tab")
                      if self[activate-widget: self[next-tab-widget:]]
                        evt[eat!:]
                    sdl:names-equal?(ks "S-tab")
                      if self[activate-widget: self[prev-tab-widget:]]
                        evt[eat!:]
                    else #void
        ;;
        define do-keyup(self evt)
          cond
            {moving or sizing}
              evt[cancel!:]
            (and {not-null? mouse-grab-widget}
                 {null? evt[destination:]})
              {evt[destination:] := mouse-grab-widget}
              inherited handle-event: evt
            else
              inherited handle-event: evt
        ;;
        define do-mouseup(self evt)
          cond
            moving
              if moving-with-keyboard
                evt[cancel!:]
                evt[eat!:]
              if {{not moving-with-keyboard} and {zero? mouse-button-state}}
                self[stop-moving:]
            sizing
              evt[eat!:]
              if {zero? mouse-button-state}
                self[stop-sizing:]
            (and {not-null? mouse-grab-widget}
                 {null? evt[destination:]})
              {evt[destination:] := mouse-grab-widget}
              inherited handle-event: evt
            else
              inherited handle-event: evt
          if {zero? mouse-button-state}
            {mouse-grab-widget := #nil}
        ;;
        define do-mousedown(self evt)
          cond
            moving
              if moving-with-keyboard
                evt[cancel!:]
                evt[eat!:]
            {sizing}
              evt[eat!:]
            (and {zero? mouse-button-state}
                 {evt[button:] = BUTTON-RIGHT}
                 {not-zero? bit-and(keyboard-mods-state KMOD-ALT-MASK)})
              evt[eat!:]
              self[start-mouse-sizing:]
            (and {not-null? mouse-grab-widget}
                 {null? evt[destination:]})
              {evt[destination:] := mouse-grab-widget}
              if {zero? mouse-button-state}
                {mouse-grab-widget := #nil}
              inherited handle-event: evt
            {zero? mouse-button-state}
              define cbox self[find-child-at: evt[x:] evt[y:]]
              cond
                {not-null? cbox}
                  if cbox[selectable?:]
                    self[activate-widget: cbox]
                  ;printf "***[%o] %o\n" evt[type:] cbox[type:]
                  {mouse-grab-widget := cbox}
                  {evt[destination:] := cbox}
                  evt[dirty!:]
                else
                  {mouse-grab-widget := #nil}
              inherited handle-event: evt
            else
              inherited handle-event: evt
        ;;
        define do-mousemotion(self evt)
          cond
            moving
              if {not moving-with-keyboard}
                then
                  inc! moving-x-frac evt[rel-x:]
                  inc! moving-y-frac evt[rel-y:]
                  self[final-shift!: int-part(moving-x-frac) int-part(moving-y-frac)]
                  if {{zero? int-part(moving-x-frac)} and {zero? int-part(moving-y-frac)}}
                    evt[cancel!:]
                    evt[eat!:]
                  {moving-x-frac := fract-part(moving-x-frac)}
                  {moving-y-frac := fract-part(moving-y-frac)}
                else
                  evt[cancel!:]
            sizing
              ;printf "xf: %o / %o\n" moving-x-frac evt[rel-x:]
              inc! moving-x-frac evt[rel-x:]
              inc! moving-y-frac evt[rel-y:]
              self[%do-resize!: int-part(moving-x-frac) int-part(moving-y-frac)]
              evt[eat!:]
              {moving-x-frac := fract-part(moving-x-frac)}
              {moving-y-frac := fract-part(moving-y-frac)}
            (and {not-null? mouse-grab-widget}
                 {null? evt[destination:]})
              {evt[destination:] := mouse-grab-widget}
              inherited handle-event: evt
            else
              inherited handle-event: evt
        ;;
        if evt[alive?:]
          case evt[type:]
            (KEY-DOWN)
              do-keydown self evt
            (KEY-UP)
              do-keyup self evt
            (MOUSE-UP)
              do-mouseup self evt
            (MOUSE-DOWN)
              do-mousedown self evt
            (MOUSE-MOTION)
              do-mousemotion self evt
            (WINDOW-FOCUS)
              self[stop-moving:]
              {mouse-grab-widget := #nil}
              if {null? self[active-top-child:]}
                self[activate-widget: self[first-tab-widget:]]
              inherited handle-event: evt
            (WINDOW-BLUR)
              self[stop-moving:]
              {mouse-grab-widget := #nil}
              inherited handle-event: evt
            (BROADCAST)
              if {evt[broadcast-type:] eq? 'GLOBAL-BLUR}
                then
                  self[stop-moving:]
                  {mouse-grab-widget := #nil}
              inherited handle-event: evt
            else
              ;; other unknown events are NOT "mouse grabbed"
              inherited handle-event: evt
      ;;
      handle-property: (self name value)
        ;printf "basic-hpp; self=%d; name=%o\n" box-debug-id(self) name
        ;printf "basic-prop: %o is %o\n" name value
        self[property-changed: name value]
        case name
          (activate-widget:)
            {activate-widget-name := value}
            #t
          else
            inherited handle-property: name value
      ;;
      else
        super
