REBOL [
  Title: "TOOLBAR style"
  Author: ["Henrik Mikael Kristensen"]
  Copyright: "2006 - HMK Design"
  Filename: %toolbar.r
  Version: 0.0.9
  Created: 02-May-2006
  Date: 05-Apr-2007
  License: {
    BSD (www.opensource.org/licenses/bsd-license.php)
    Use at your own risk.
  }
  Purpose: {
    Toolbar MacOSX style for VID
  }
  History: []
]

get-words: func [block /local words] [
  words: copy []
  parse block [
    any [
      'set | '| | 'opt | 'any | 'one | 'some | 'to | 'thru
      | set w word! (
        unless all [in system/words w value? w] [append words w]
      )
      | set sw set-word! (append words to word! sw)
      | set b block! (append words get-words b)
      | skip 
    ]
  ]
  unique words
]

local-function: func [block] [
  get-words block block
]

stylize/master [
  toolbar: FACE WITH [
    effect: none
    size: -1x-1
    orientation: 'up
    edge: none
    text: none
    text?: true
    icons?: true
    old-event: none
    switch?: false
    update?: true
    selected: none
    feel: none
    colors: copy [
      back-top          200.200.200
      back-middle       195.195.195
      back-bottom       180.180.180
      icon-frame-back   220.220.220.128
      lower-edge        160.160.160
      font-color        0.0.0
      notice-bg-color   255.0.0
      notice-text-color 255.255.255
    ]
    spacing: 2
    padding: 2
    frame-padding: 5
    color: none
    elements: none
    h-divider-image: make image! [1x3 #{000000000000000000} #{00FFFF}]
    v-divider-image: make image! [1x3 #{000000000000000000} #{00FFFF}]
    toolbar-font: make font compose [
      size: 11
      style: none
      shadow: none
      color: (colors/font-color)
      align: 'center
      colors: none
    ]
    set-background: does [
    effect: none
     effect: compose/deep [
       draw [
         pen none fill-pen linear 0x0 0 (size/y) 90 1 1
         (colors/back-top) (colors/back-middle) (colors/back-bottom)
         box 0x0 (as-pair size/x size/y - 1)
         pen (colors/lower-edge)
         line
           (as-pair -1 size/y - 1)
           (size - 0x1)
       ]
     ]
    ]
    set-backframe: func [face] [
      face/effect: [
        draw [
          pen none
          fill-pen colors/icon-frame-back
          box 2x1 5
        ] grayscale rotate 90 emboss rotate 90 merge
      ]
    ]
    unset-backframe: func [face] [
      face/effect: none
    ]
    str-size: func [string [string!]] [
      5 + first size-text make face [
        size: 1000x50
        font: make toolbar-font []
        text: string
      ]
    ]
    txt-height: 0
    enable: func [name [word!]] [
      if equal? 'disabled select data name [
        remove next find data name
      ]
      update
    ]
    disable: func [name [word!]] [
      unless equal? 'disabled select data name [
        insert next find data name 'disabled
      ]
      update
    ]
    data: []
    data-store: []

    ; ---------- Action Functions
    
    do-element: func [word [word!] /force] [
      if block? pane [
        all [not force equal? 'disabled select data word return]
        do-face pick pane index? find elements word none
        recycle
      ]
    ]

    ; ---------- Faces to build the toolbar with

    icon-frame-edge: make face/edge [
      size: 0x0
    ]

    spacer-face: make face [
      feel: none ; provide spacer feel here to drag it around
      type: 'spacer
      color: none
      edge: none
      feel: none
    ]
    divider-face: make face [
      image: v-divider-image
      type: 'divider
      effect: [tile merge]
      color: none
      edge: none
      feel: none
    ]

    ; ---------- The icon itself
    icon-face: make face [
      color: none
      edge: none
      feel: make feel [
        over: func [face act pos] [
        ; this is problematic if the show self is commented out in 'update
        ; the problem is that face/parent-face is set to none for some reason
        ; maybe this could be create-toolbar that does not set the parent-face
        ; properly in the first place?
;        probe type? face/parent-face
;        probe face/type
;        probe either attempt [in face/parent-face 'over-face] ['over-face][
;          face/parent-face
;        ]
;        probe index? find face/parent-face/pane face
          if all [
            in face 'parent-face
            object? face/parent-face
            in face/parent-face 'switch?
            face/parent-face
          ] [
            face/parent-face/over-face: pick reduce ['icon none] act
          ]
        ]
      ]
    ]
    notice-face: make face [
      color: none
      edge: none
      feel: none
    ]
    notice-text: make face compose/deep [
      color: (colors/notice-bg-color)
      edge: none
      feel: none
      text: make toolbar-font [color: (colors/notice-text-color)]
    ]
    
    ; ---------- This is always used
    icon-frame-face: make face [
      offset: 0x0
      pane: copy []
      var: none
      edge: make icon-frame-edge []
      color: none
      type: 'icon-frame
      action: none
      over-face: none
      mouse-down?: none
      detecting?: none
      old-evt-type: none
      highlight: does [
        if [none? pane/1/effect 'face <> pane/1/type] [
          pane/1/effect: [luma -30]
          font/shadow: 0x1
          show self
        ]
      ]
      unlight: does [
        if all [pane/1/effect 'face <> pane/1/type] [
          pane/1/effect: none
          font/shadow: none
          show self/parent-face
        ]
      ]
      backgroove: func [face] [
        if all [
          in face 'parent-face
          object? face/parent-face
          in face/parent-face 'switch?
          face/parent-face/switch?
          'face <> face/pane/1/type
        ] [
          face/parent-face/selected: face/var
          set-backframe face
        ]
      ]
      nogroove: func [face] [
        if all [
          in face 'parent-face
          object? face/parent-face
          in face/parent-face 'switch?
          face/parent-face/switch?
        ] [
          foreach f face/parent-face/pane [
            if f/type <> 'divider [
              unset-backframe f
            ]
          ]
        ]
      ]
      feel: make feel [
        engage: func [face act evt] [
          ; ---------- New Code
          switch evt/type [
            down [
              if 'face <> face/pane/1/type [
                face/highlight
                face/mouse-down?: true
              ]
            ]
            up [
              if 'face <> face/pane/1/type [
                nogroove face
                backgroove face
                face/unlight
                if face/mouse-down? [do face/action recycle]
                face/mouse-down?: false
              ]
            ]
            move [
              if all [
                face/mouse-down? 'move = face/old-evt-type
              ] [
                face/highlight
              ]
            ]
            face/old-evt-type: evt/type
          ]
          ; ---------- New Code End
;          face/over-face: either 'away = act [false][true]
;          either face/detecting? [face/detecting?: false][face/unlight]
;          if 'up = act [face/mouse-down?: none]
        ]
        ; this should probably be altered as it crashes rebol.
        ; this should be made into an engage, but the problem is events
        ; bubble in the wrong direction
        ; sometimes highlights twice
        ;detect: func [face evt] [
        ;  face/detecting?: true
        ;  switch evt/type [
        ;    down [
        ;      ; TODO: highlight is kept if we are leaving the face while we are mousing down
        ;      if 'face <> face/pane/1/type [
        ;        face/highlight
        ;        face/mouse-down?: true
        ;      ]
        ;    ]
        ;    up [
        ;      if 'face <> face/pane/1/type [
        ;        nogroove face
        ;        backgroove face
        ;        face/unlight
        ;        if face/mouse-down? [do face/action]
        ;        face/mouse-down?: false
        ;      ]
        ;    ]
        ;    ; the move event sometimes comes before up, if up is detected
        ;    ; perhaps this is due to bubbling
        ;    move [
        ;      if all [
        ;        face/mouse-down? 'move = face/old-evt-type
        ;      ] [
        ;        face/highlight
        ;      ]
        ;    ]
        ;  ]
        ;  face/old-evt-type: evt/type
        ;  evt
        ;]
      ]
    ]

    ; ---------- Self contained operations to place icons and size them up

    make-icon: func [
      word [word!] txt [string!] act [block!] contents [image! object!]
      /example
    ] [
      make icon-frame-face [
        var: (word)
        text: either text? [txt][none]
        font: make toolbar-font [valign: either icons? ['bottom]['middle]]
        para: make para [margin: 0x3 origin: 0x0]
        pane: reduce [
          make icon-face [
            type: either image? contents ['icon]['face]
            image: either image? contents [contents][none]
            pane: either image? contents [none][contents]
            size: either any [example icons?] [contents/size][0x0]
          ]
          ; ---------- Should make it possible here to make a notification face
          ; ---------- Should make it possible here to make a text face
        ]
        action: act
        size: as-pair
          add
            2 * frame-padding
            max
              either text? [str-size txt][0]
              either icons? [contents/size/x][0]
          0
      ]
    ]

    create-toolbar: has [
      attr txt th img fc bt fcs heights offsets widths spacers type btn-action
      btn-alt-action btn-txt btn-color btn-size btn-notifier button-rules
    ] [
      th: either text? [txt-height][0]
      pane: copy heights: copy widths: copy []
      offsets: copy to block! padding
      spacers: 0
      parse data [any [thru 'spacer (spacers: spacers + 1)]]
      foreach b data [
        switch/default b [
          spacer [
            insert tail pane make spacer-face []
            insert tail widths 'spacer
          ]
          divider [
            insert tail pane make divider-face []
            insert tail widths 1
          ]
          disabled [
            use [lp] [
              lp: last pane
              unless find [spacer divider] lp/type [
                lp/feel: none
                fcs: lp/pane
                either fcs [
                  if get in first fcs 'pane [
                    set in first fcs 'image to image! get in first fcs 'pane
                    set in first fcs 'pane none
                  ]
                  set in first fcs 'effect [grayscale contrast -50]
                ][
                  lp/image: yy: to image! lp
                  lp/effect: [merge grayscale contrast -50]
                ]
                lp/font/color: gray
              ]
            ]
          ]
        ][
          if attr: select data-store b [
            txt: attempt [first find attr string!]
            parse attr [
              set type [
                'image any [
                  [set txt string!]
                  | [set img word! (img: either value? img [get img][help.gif] )]
                  | [set action block!]
                ] (
                  insert tail heights either icons? [img/size/y][0]
                  ; perhaps this should be changed a bit so that make-icon becomes easier to make inputs for. build the face right here.
                  ; insert tail pane 
                  insert tail pane make-icon b txt action img
                )
                | 'button any [
                  [set btn-notifier 'notifier]
                  | [set btn-txt string!]
                  | [set btn-color tuple!]
                  | [set btn-size integer!]
                  | [set btn-size pair!]
                  | [set btn-action block! set btn-alt-action opt block!]
                ] (
                  unless value? 'btn-color [btn-color: 255.255.255]
                  if btn-txt [
                    insert tail pane make get-style 'btn [
                      text: btn-txt
                      color: btn-color
                      font: make toolbar-font [valign: 'middle]
                      action: (btn-action)
                      alt-action: (btn-alt-action)
                    ]
                    unless value? 'btn-size [btn-size: 100]
                    set in last pane 'size
                      either pair? btn-size [
                        btn-size
                      ][
                        as-pair btn-size second get in last pane 'size
                      ]
                    do get in last pane 'init
                    insert tail heights either icons? [24][0]
                  ]
                  unset [btn-action btn-txt btn-color btn-size]
                )
                | 'face any [
                  [set txt string!] | [set fc block! (fc: layout/tight fc)]
                ] (
                  if fc [
                    fc/color: none
                    insert tail heights either icons? [fc/size/y][0]
                    insert tail pane make-icon b txt copy [] fc
                  ]
                )
              ]
            ]
            unless empty? pane [
              insert tail widths first get in last pane 'size
            ]
          ]
        ]
      ]

      if -1 = size/y [
        size/y:
          add
            2 * frame-padding
            add
              add
                2 * padding
                th
              either all [not empty? heights icons?] [
                first maximum-of heights
              ][
                0
              ]
      ]

      ; ---------- Icon and text offsets
      if find widths 'spacer [
        replace/all
          widths
          'spacer
          max
            divide
              subtract
                subtract
                  size/x
                  do
                    replace/all
                      replace/all
                        form copy widths 'spacer 0 " " " + "
                add
                  2 * padding
                  multiply spacing subtract length? pane 1
              spacers
            0
      ]
      foreach w widths [insert tail offsets add add last offsets w spacing]
      repeat i length? pane [
        f: pick pane i
        f/offset: as-pair pick offsets i padding
        switch f/type [
          face [
;            f/offset/y: / subtract first maximum-of heights f/size/y 2
            f/offset/y: / subtract size/y f/size/y 2
          ]
          icon-frame [
            either all [switch? f/var = selected] [
              set-backframe f
            ][
              unset-backframe f
            ]
            f/size/y: add 2 * frame-padding add th first maximum-of heights
            f/pane/1/offset:
              divide
                as-pair
                  f/size/x - f/pane/1/size/x
                  f/size/y - f/pane/1/size/y - th
                2
          ]
          divider [
            f/size: as-pair 1 size/y - (2 * padding)
          ]
          spacer [
            f/size: as-pair pick widths index? pane size/y
          ]
        ]
      ]
      ; if size/x is zero, then grow it to fit, otherwise use size/x
      if size/x = -1 [size/x: last offsets]
      set-background
      elements: copy data
      remove-each e elements [find [disabled] e]
    ]

    create-data-store-window: does [
      
    ]

    update: does [
      txt-height: 4 + toolbar-font/size
      create-toolbar
      ; make a way to backgroove face before show
      if update? [show self]
;      if all [switch? selected] [
;        do get in pick pane index? find elements selected 'backgroove
; this no longer works properly and will result in an infinite loop
;        do-element/force selected
;      ]
    ]

    words: compose [
      data-store (func [new args][
        new/data-store: select args 'data-store
      ])
      data (func [new args][
        new/data: select args 'data
      ])
    ]
    
    init: [update]
  ]
  button-bar: TOOLBAR WITH [
    spacing: 5
    padding: 5
    size: -1x-1 ; button bars grow to fit
    frame-padding: 0
    text?: false
    data-store: [
      ok-btn [button "OK" 255.190.80 100 [hide-popup]]
      cancel-btn [button "Cancel" 144.174.240 100 [cancel-btn-action]]
      yes-btn [button "Yes" 255.190.80 100 [yes-btn-action]]
      no-btn [button "No" 144.174.240 100 [no-btn-action]]
      close-btn [button "Close" 144.174.240 100 [hide-popup]]
    ]
    set-background: does [
      effect: compose/deep [
        draw [
          pen none fill-pen linear 0x0 0 (size/y) 90 1 1
          (colors/back-top) (colors/back-middle) (colors/back-bottom)
          box 0x0 (as-pair size/x size/y)
          pen (colors/lower-edge)
          line 0x0 (as-pair size/x 0)
          pen (colors/back-top * 1.1)
          line 0x1 (as-pair size/x 1)
        ]
      ]
    ]
  ]
  ok-cancel-bar: BUTTON-BAR with [
    data: [ok-btn spacer cancel-btn]
  ]
  ok-bar: BUTTON-BAR with [
    data: [spacer ok-btn spacer]
  ]
]

unset [get-words]