|
|
|
scroll-table - Source CodeThe scroll-table custom style, useful for showing single or multi-column lists of data. |
|
rebol [
Title: "Demo scroll-table style"
File: %demo-scroll-table.r
Date: 25-Mar-2004
Version: 1.0.6
Needs: [View]
Author: "Anton Rolls"
Language: 'English
Purpose: {Show the scroll-table style in the browser plugin}
Usage: {}
ToDo: {
- replace the main layout with a scroll-table itself.
- after downloader is finished, use only load-thru, not load-thru/update (no need to update)
}
History: [
1.0.0 [30-Oct-2003 {First version} "Anton"]
1.0.1 [30-Nov-2003 {resizable window} "Anton"]
1.0.2 [12-Jan-2004 {Made a "launcher" window} "Anton"]
1.0.3 [29-Feb-2004 {added more examples} "Anton"]
1.0.4 [11-Mar-2004 {commented query/clear, forced update of all necessary files} "Anton"]
1.0.5 [12-Mar-2004 {forked from gui/demo-scroll-table.r} "Anton"]
1.0.6 [25-Mar-2004 {added download progress bar and updated with gui/demo-scroll-table.r} "Anton"]
]
Notes: {}
]
view/new center-face layout [h1 "loading files" pr: progress]
bump-pr: func [v][pr/data: pr/data + v show pr]
site: select load-thru/update http://www.reboltech.com/index.r [folder "Anton"]
clear find site %index.r
bump-pr 0.1
do load-thru/update site/library/include.r
bump-pr 0.1
foreach file [scroll-table.r header-group.r list-sort-button.r check-label.r][
read-thru/update site/gui/:file
bump-pr 0.2
]
include [
site/gui/scroll-table.r [scroll-table-style]
site/gui/check-label.r [check-label-style]
]
unview
; create single-data, a block of the default colours
single-data: clear []
foreach word first system/words [
attempt [if tuple? word: get in system/words word [append single-data join word ""]]
]
; create multi-data, a block of data used in some of the examples
multi-data: clear []
foreach file read dir: join view-root %public/ [
append/only multi-data reduce [file size? dir/:file modified? dir/:file]
]
examples: [
"Simplest example with no data"
[scroll-table]
"Very short block of data"
[scroll-table data ["hello" "bonjour" "hallo"]]
"Inconsistent block of data"
[scroll-table data [bonjour [in a block] [] [1 2 3 4] hello]]
"Single-column"
[
scroll-table data single-data
]
"Single-column tabbing test"
[
across
scroll-table data single-data
scroll-table data single-data
return
field
]
"Single-column, with (single-click) action"
[
b: box 100x40
scroll-table data single-data [
pos: value
b/color: to-tuple b/text: pick face/list-data pos/2
show b
]
]
"Single-column, with double-click action"
[
scroll-table data single-data double-click [alert reform [pos pick face/list-data pos/2]]
]
"Single-column, with alt-click action"
[
scroll-table data single-data alt-click [alert reform [pos pick face/list-data pos/2]]
]
"Single-column, with header^/(column-width automatically calculated)"
[
scroll-table headers ["tuples"] data single-data
]
"Multi-column"
[
scroll-table data multi-data
]
"Multi-column, with headers, sizes specified^/and a big edge"
[
scroll-table 440x170 headers ["file" 100 "size" 80 "date" 190] data multi-data
;coal
edge [size: 8x8 color: sky effect: 'bevel]
]
"Multi-column, with sort column initially shown"
[
scroll-table headers ["file" "size" 80 "date"] data multi-data
with [sort-column: 1]
]
"Directory requester, restricts selection to directories,^/single-row select"
[
; this is like a directory requester
; multi-column, auto-sizing
scroll-table headers ["file" "size" 60 "date" ] data multi-data [
; action (called on a selection click)
; face = scroll-table face
; value = [col row]
;?? value ; = position
;print ["face/selection:" mold face/selection]
;print ["face/last-selected:" face/last-selected]
]
filter-click [
;?? pos
use [row][
row: pos/2
;print [ row mold multi-data/:row]
%"" <> find/last/tail multi-data/:row/1 #"/" ; not a directory ?
]
]
double-click [
;?? pos
use [row][
row: pos/2
alert reform ["Selected position:" pos "Directory:" multi-data/:row/1]
]
]
sort-comparator func [direc a b /local ret][
if file? a [
either %"" = find/last/tail a "/" [
if %"" <> find/last/tail b "/" [return direc = 'down]
][
if %"" = find/last/tail b "/" [return direc = 'up]
]
]
do reduce [either direc = 'up [:greater?][:lesser?] a b]
]
initial-sort [column 1]
with [selection-mode: [single row]]
]
"Multi-column selection-mode [single row]" [
scroll-table data multi-data
with [selection-mode: [single row]]
]
"Multi-column selection-mode [multi row]" [
scroll-table data multi-data
with [selection-mode: [multi row]]
]
"Multi-column selection-mode [single cell]" [
scroll-table data multi-data
with [selection-mode: [single cell]]
]
"Multi-column selection-mode [multi cell]" [
scroll-table data multi-data
with [selection-mode: [multi cell]]
]
"Multi-column selection-mode [single column]" [
scroll-table data multi-data
with [selection-mode: [single column]]
]
"Multi-column selection-mode [multi column]" [
scroll-table data multi-data headers ["file" "size" "date"]
with [selection-mode: [multi column]]
]
]
append examples ; debugging examples
[
"None data"
[scroll-table data (none)]
"Empty block of data"
[scroll-table data []]
"None data, with multiple headers"
[scroll-table data (none) headers ["hello" 80 "there" 90]]
"Empty data, with multiple headers"
[scroll-table data [] headers ["hello" "there"]]
"Empty data, with multiple headers (width specified)"
[scroll-table data [] headers ["hello" 80 "there" 90]]
"Sorting test" [
scroll-table data copy ["b" "c" "d" "a" "e" "f" "g"] headers ["file" 100]
with [selection-mode: [multi row]]
]
"Sorting test Multi-column" [
scroll-table data copy multi-data headers ["file" "size" "date"]
with [selection-mode: [multi row]]
]
"Single-column Multi-line"
[scroll-table data ["hello^/there" "bonjour" "hallo"]]
"Multi-column Multi-line"
[scroll-table data [["hello^/there" "bonjour"]["hallo"]]]
]
show-code: func [code][
context compose/only [
origin: 8x8
my-area: none
code: (code)
view/new/options center-face lay: layout [
origin (origin)
styles check-label-style
check-label "show common code" [
use [my-area][
my-area: face/parent-face/parent-face/feel/my-area
if my-area = system/view/focal-face [unfocus]
my-area/text: mold either face/data [build-code code][code]
show my-area
]
]
my-area: area 650x500 font-name font-fixed (mold code)
] 'resize
lay/feel: make lay/feel compose [
lay: (lay)
my-area: (my-area)
detect: func [face event][
if event/type = 'resize [
; resize the area
my-area/size: lay/size - my-area/offset - origin
show lay
]
event
]
]
]
]
build-code: func [code][
compose/only [
context (compose/only [
scroll-table: none
view/new/options lay: center-face layout (
append copy [
across
btn "set-face single" [set-face scroll-table single-data]
btn "set-face multi" [set-face scroll-table multi-data]
btn "reset-face" [reset-face scroll-table]
btn "get-face" [alert mold get-face scroll-table]
btn "clear-face" pink [clear-face scroll-table]
return
btn "show selection" [probe scroll-table/selection]
btn "copy selection" [probe scroll-table/feel/copy-selection scroll-table]
return
below
styles scroll-table-style
] code
) 'resize
; find the scroll-table
foreach face lay/pane [
if face/style = 'scroll-table [scroll-table: face break]
]
lay/feel: make lay/feel compose/deep [
detect: func [face event /local window scroll-table][
window: (lay)
scroll-table: (scroll-table)
if event/type = 'active [focus scroll-table]
if event/type = 'resize [
scroll-table/size: max 0x0 window/size - scroll-table/offset - 20x20
scroll-table/resize
show window
]
event
]
]
focus scroll-table
scroll-table/post-init
])
]
]
; make a block of blocks, such as scroll-table expects for multi-column data
examples-data: clear []
foreach [description example] examples [
append/only examples-data reduce [description trim/lines mold example]
]
lay-blk: [
;style code code as-is font [name: font-fixed colors: reduce [black yellow]] effect [merge luma 16]
;text as-is "Right-click to show code.^/Unless specified column widths are automatically calculated."
]
origin: 10x10
append lay-blk [
origin (origin)
styles scroll-table-style
eg-scroll-table: scroll-table data examples-data headers ["description" "example code"]
with [selection-mode: [single cell]]
double-click [
switch pos/x [
1 [do build-code pick examples (pos/y * 2)]
2 [ show-code pick examples (pos/y * 2)]
]
]
; <- alt-click action here
btn "notes on example code" [
view/new center-face layout [
across
style dot image 17x17 effect [draw [pen black fill-pen black circle 9x9 3]]
dot text "common code is a bit generic, to facilitate demonstrating so many examples" return
dot text "modifying window face feel to capture resize events" return
dot text "focus is necessary for scroll-wheel functionality (to receive scroll-line events)" return
dot text "post-init needs to be done after modifying the feel" return
]
]
]
main: center-face layout lay-blk
main/offset/x: 10
view/new/options main 'resize
main/feel: make main/feel [
detect: func [face event][
if find [down active] event/type [
if eg-scroll-table <> system/view/focal-face [focus eg-scroll-table]
]
if event/type = 'resize [
eg-scroll-table/size: main/size - eg-scroll-table/offset - origin - 0x30 ; origin + space for btns
eg-scroll-table/resize
; resize all the btns
foreach face main/pane [
if face/style = 'btn [face/offset/y: main/size/y - origin/y - face/size/y]
]
show main
]
event
]
]
focus eg-scroll-table
eg-scroll-table/post-init
wait none
|
