[REBOL] Hightlighting lines in a text list
From: ammon:rcslv at: 6-Aug-2002 11:22
Hi,
Yes you can do that, have a look at Chypre's code...
<Chypre's Cod>
REBOL [
title: "text-list style"
author: [cyphre--seznam--cz]
]
stylize/master [
text-list: text-list with [
fx: 100
gfade: fro: 0
rng: -1
drag-sel?: shift?: ctrl?: true
last-shown-lines: -1
dbak: color: none
ovr: copy []
colors: reduce [0.0.0 none none 115.140.173]
edge: make object! [
color: 0.0.0
effect: none
size: 1x1
]
words: [
data [new/text: pick new/texts: second args 1 next args]
no-drag [new/drag-sel?: false args]
no-shift [new/shift?: false args]
no-ctrl [new/ctrl?: false args]
fx-delay [new/fx: first next args next args]
]
text-pane: func [face id][
if pair? id [return 1 + second id / iter/size]
iter/offset: iter/old-offset: id - 1 * iter/size * 0x1
if iter/offset/y + iter/size/y > size/y [return none]
cnt: id: id + sn
if id <= length? head lines [
iter/text: form first lines: at head lines id
iter
]
]
update: has [item value] [
lines: data
either all [item: find data picked/1 lc < (length? head lines)] [
sld/data: min 1 (index? item) / (max 1 lc)
sn: to-integer sld/data * ((1 + length? head lines) - lc)
] [
sld/data: 0
sn: 0
]
sld/redrag lc / max 1 length? head lines
last-shown-lines: length? data
self
]
init: [
if not color [color: 255.255.255]
if not colors/2 [colors/1: font/color]
if all [not flag-face? self as-is string? text] [trim/lines text]
if none? text [text: copy ""]
change font/colors font/color
if :action [feel: svvf/hot saved-area: true]
data: size
if any [none? size size/x < 0 size/y < 0] [
state: max 1x1 pane-size * 9 / 10 - offset - para/margin
if none? size [size: state]
if size/x < 0 [size/x: state/x]
if size/y < 0 [size/y: state/y]
size: size-text self
all [
para para/origin size: size + para/origin
para/margin size: size + para/margin
]
]
if all [data data/y < 0] [size/x: data/x]
data: none
sz: size
sn: 0
slf: :self
act: :action
if none? data [data: texts]
if none? data [data: copy []]
lines: data
dbak: copy data
picked: copy []
iter: make-face/size 'txt sz * 1x0 + -16x20
iter/para: make self/para [origin: 2x0]
iter/font: make self/font []
lc: to-integer sz/y / iter/size/y: second size-text iter
iter/feel: make iter/feel [
over: func [f a o][
if all [a f/state drag-sel?] [
; print [rng (1 + absolute (cnt - fro))]
; if rng > (1 + absolute (cnt - fro)) [alter picked last picked]
alter picked reduce [f/text cnt]
; rng: 1 + absolute (cnt - fro)
]
if find ovr cnt [remove/part find ovr cnt 2]
insert tail ovr reduce [cnt pick reduce [255 max 0 min 250 250 - fx] a]
f/rate: 20
show f
]
redraw: func [f a i /local idx vl fnd] [
fnd: find picked reduce [f/text cnt]
f/font/color: either fnd [white][slf/colors/1]
f/color: either fnd [slf/colors/4][slf/colors/2]
f/size/x: f/parent-face/size/x
if all [not fnd idx: find ovr cnt (vl: select ovr cnt) < 254][
f/color: slf/gfade/:vl
poke ovr (index? idx) + 1 vl + 10
if vl > 235 [remove/part find ovr cnt 2]
]
if all [not fnd (select ovr cnt) = 255][
f/color: 60 + any [slf/colors/4 55.80.113]
]
if (length? ovr) = 0 [f/rate: none]
]
engage: func [f a e] [
if a = 'down [
remove/part find ovr cnt 2
if cnt > length? head lines [exit]
f/state: cnt
if any [not e/control not ctrl?] [clear picked]
either all [shift? e/shift fro][
for n min fro cnt max fro cnt 1 [
alter picked reduce [form slf/data/:n fro]
fro: fro + 1
]
][alter picked reduce [f/text cnt]]
do :act slf f/text
fro: cnt
]
if a = 'up [f/state: none]
show pane
]
]
pane: layout/size [
origin 0 space 0
sub-area: box slf/color with [edge: make edge [size: 1x1 effect: 'ibevel color: slf/color]
pane: :text-pane]
sld: slider 206.206.206 any [colors/3 ""] [
ovr: copy []
value: to-integer value * ((1 + length? head lines) - lc)
if sn <> value [sn: value]
show sub-area
]
] size
sub-area/feel: make sub-area/feel [
redraw: func [f a i /local tmp cols] [
sld/colors/2: slf/colors/3
gfade: to-image make face compose/deep [size: 256x1 edge:none effect: [gradient 1x0
(60 + any [colors/4 55.80.113]) (any [colors/2 255.255.255])]]
f/size: -17x-2 + f/parent-face/size: f/parent-face/parent-face/size
sld/offset: (f/size * 1x0) - 0x1
sld/size: (f/size * 0x1) + 16x2
if not-equal? lc tmp: to-integer f/size/y / iter/size/y: second size-text iter [
lc: tmp
sld/redrag lc / max 1 length? head lines
]
if any [not equal? dbak data last-shown-lines <> length? data][
dbak: copy data
show update
]
]
]
sld/redrag lc / max 1 length? head lines
pane/offset: 0x0
]
]
slider: slider with [
;== Default color values should be obtained from skin.
color: 238.237.229
colors: [#[none] 196.213.255]
;== Use RATE field (it's part of the object, so might as well use it.)
repeat: 0
oft: step: none
edge: make edge [
color: white
size: 1x1
effect: none
]
scroll?: false
;== See comment about FEEL object binding in ARROW style.
feel: make feel [
engage: func [f a e /local w doft][
switch a [
down [f/oft: e/offset]
over [f/oft: e/offset]
up [f/rate: none show f]
time [
f/scroll?: true
show f
]
]
if any [a = 'down f/scroll?][
f/scroll?: false
;== Same as: f/rate: if positive? f/repeat [f/repeat]
f/rate: pick reduce [f/repeat none] 0 < f/repeat
w: pick [1 2] f/axis = 'x
doft: either (f/oft/:w + (f/pane/1/size/:w / 2)) > (f/pane/1/offset/:w + (f/pane/1/size/:w
/ 2))[any [f/step f/pane/1/size/:w]][negate any [f/step f/pane/1/size/:w]]
;== Reference it via SVVF to reduce lookup time:
system/view/vid/vid-feel/drag-off f f/pane/1 either negative? doft [max f/oft - (f/pane/1/size
/ 2) f/pane/1/offset + doft][min f/oft - (f/pane/1/size / 2) f/pane/1/offset + doft]
if f/oft/:w = f/pane/1/offset/:w [
f/rate: none
]
show f
]
]
]
words: [
;== change REPEAT to RATE (see ARROW)
repeat [new/repeat: first next args next args]
step [new/step: first next args next args]
]
dragger: make dragger [
;== Color via skin (as previous)
color: 115.140.173
edge: make edge [
color: 143.158.177
effect: none
size: 1x1
]
feel: make feel [
redraw: func [f a o][
if a = 'show [
either f/parent-face/axis = 'y [
f/size/x: f/parent-face/size/x - 2
][
f/size/y: f/parent-face/size/y - 2
]
;== Complex static expression should be computed outside of REDRAW (see ARROW comments):
f/effect: compose/deep [gradient (pick [0x1 1x0] f/parent-face/axis = 'x) 255.255.255
210.210.210 draw [pen 180.188.201 box 0x0 (f/size + 1) pen 108.120.132 box (f/size -
3) -1x-1] colorize (f/parent-face/colors/2)]
;== Is this the correct shading for horizontal slider? Don't you want gradient across
the narrow
; portion of the slider?
f/parent-face/effect: compose/deep [gradient 1x0 230.230.230 255.255.255 draw [pen 185.185.185
box 0x0 (f/parent-face/size) pen 225.225.225 box 1x1 (f/parent-face/size - 3)] (if f/parent-face/colors/1
[compose [colorize (f/parent-face/colors/1)]])]
f/edge/effect: f/parent-face/edge/effect: compose/deep [colorize (f/parent-face/colors/1)]
]
]
engage: func [f a e][
if find [over away] a [
if f/data [
;== SVVF reference:
system/view/vid/vid-feel/drag-off f/parent-face f f/offset + e/offset - f/data
show f
]
]
switch a [
down [f/data: e/offset]
up [f/data: none]
]
]
]
]
init: [
edge: make edge []
if color [colors/1: color]
pane: reduce [make dragger [edge: make edge []]]
axis: pick [y x] size/y >= size/x
redrag 0.1
]
]
]
view layout [text-list compose [(sort first system/words)]]
</Cyphre's code>
HTH!!
Ammon
I don't know if you will be able to execute that or not,
=== Original Message ===
Hi everyone,
Sent this message yesterday but it didnt seem to get through ??
Anyway ....
Is it possible to highlight a line in a text list with a color other than
the one assigned by the text list picked attribute?
I want to in essence have a cursor that I can move up & down a text list but I
want to distinguish it from a picked item
Cheers Phil