| 1 | chat: make rebface [
|
|---|
| 2 | tip: {
|
|---|
| 3 | USAGE:
|
|---|
| 4 | chat 140x50
|
|---|
| 5 | chat data ["Bob" blue "My comment." yello 14-Apr-2007/10:58]
|
|---|
| 6 |
|
|---|
| 7 | DESCRIPTION:
|
|---|
| 8 | Three column chat display as found in IM apps such as AltME.
|
|---|
| 9 | Messages are appended, with those exceeding 'limit not shown.
|
|---|
| 10 |
|
|---|
| 11 | OPTIONS:
|
|---|
| 12 | [limit n] where n specifies number of messages to show (default 100)
|
|---|
| 13 | [id n] where n specifies id column width (default 10)
|
|---|
| 14 | [user n] where n specifies user column width (default 15)
|
|---|
| 15 | [date n] where n specifies date column width (default 25)
|
|---|
| 16 | }
|
|---|
| 17 | size: 200x100
|
|---|
| 18 | pane: []
|
|---|
| 19 | data: []
|
|---|
| 20 | edge: outline-edge
|
|---|
| 21 | action: make default-action [
|
|---|
| 22 | on-resize: make function! [face] [
|
|---|
| 23 | poke face/pane/2/para/tabs 3 face/pane/1/size/x - (sizes/cell * any [select face/options 'date 25])
|
|---|
| 24 | face/redraw/no-show
|
|---|
| 25 | ]
|
|---|
| 26 | ]
|
|---|
| 27 |
|
|---|
| 28 | height: 0 ; actual pixel height of all messages (-1 ensures first message is offset to hide it's edge
|
|---|
| 29 | rows: 0 ; number of messages
|
|---|
| 30 | limit: none ; last n messages to display
|
|---|
| 31 |
|
|---|
| 32 | append-message: make function! [
|
|---|
| 33 | user [string!]
|
|---|
| 34 | user-color [tuple! word! none!]
|
|---|
| 35 | msg [string!]
|
|---|
| 36 | msg-color [tuple! word! none!]
|
|---|
| 37 | date [date!]
|
|---|
| 38 | /no-show row
|
|---|
| 39 | /local p y t1 t2 t3
|
|---|
| 40 | ][
|
|---|
| 41 | ; cache current tab stops
|
|---|
| 42 | t1: pick pane/2/para/tabs 1
|
|---|
| 43 | t2: pick pane/2/para/tabs 2
|
|---|
| 44 | t3: pick pane/2/para/tabs 3
|
|---|
| 45 | ; get height of message
|
|---|
| 46 | y: max sizes/line 4 + second size-text make subface [
|
|---|
| 47 | size: as-pair t3 - t2 10000
|
|---|
| 48 | text: msg
|
|---|
| 49 | font: default-font
|
|---|
| 50 | para: default-para-wrap
|
|---|
| 51 | ]
|
|---|
| 52 | p: self
|
|---|
| 53 | insert tail pane/1/pane reduce [
|
|---|
| 54 | make subface [
|
|---|
| 55 | offset: as-pair 0 height
|
|---|
| 56 | size: as-pair t1 y
|
|---|
| 57 | text: form any [row rows: rows + 1]
|
|---|
| 58 | color: colors/theme-dark
|
|---|
| 59 | edge: make outline-edge [size: 0x1]
|
|---|
| 60 | font: default-font-heading
|
|---|
| 61 | ]
|
|---|
| 62 | make subface [
|
|---|
| 63 | offset: as-pair t1 height
|
|---|
| 64 | size: as-pair t2 - t1 y
|
|---|
| 65 | text: user
|
|---|
| 66 | edge: make outline-edge [size: 0x1]
|
|---|
| 67 | font: make default-font-top [color: either word? user-color [get user-color] [user-color] style: 'bold]
|
|---|
| 68 | ]
|
|---|
| 69 | make subface [
|
|---|
| 70 | offset: as-pair t2 height
|
|---|
| 71 | size: as-pair t3 - t2 y
|
|---|
| 72 | span: all [p/span find p/span #W #W]
|
|---|
| 73 | text: form msg
|
|---|
| 74 | color: either word? msg-color [get msg-color] [msg-color]
|
|---|
| 75 | edge: make outline-edge [size: 0x1]
|
|---|
| 76 | font: default-font
|
|---|
| 77 | para: default-para-wrap
|
|---|
| 78 | ]
|
|---|
| 79 | make subface [
|
|---|
| 80 | offset: as-pair t3 height
|
|---|
| 81 | size: as-pair p/size/x - t3 - sizes/slider y
|
|---|
| 82 | span: all [p/span find p/span #W #X]
|
|---|
| 83 | text: form either now/date = date/date [date/time] [date/date]
|
|---|
| 84 | edge: make outline-edge [size: 0x1]
|
|---|
| 85 | font: default-font-top
|
|---|
| 86 | ]
|
|---|
| 87 | ]
|
|---|
| 88 | height: height + y - 1
|
|---|
| 89 | if ((length? pane/1/pane) / 4) > limit [
|
|---|
| 90 | y: pane/1/pane/1/size/y - 1
|
|---|
| 91 | remove/part pane/1/pane 4
|
|---|
| 92 | foreach [i u m d] pane/1/pane [
|
|---|
| 93 | i/offset/y: u/offset/y: m/offset/y: d/offset/y: i/offset/y - y
|
|---|
| 94 | ]
|
|---|
| 95 | height: height - y
|
|---|
| 96 | ]
|
|---|
| 97 | unless no-show [
|
|---|
| 98 | insert tail data reduce [user user-color msg msg-color date]
|
|---|
| 99 | pane/1/size/y: height
|
|---|
| 100 | pane/3/ratio: pane/3/size/y / height
|
|---|
| 101 | show p
|
|---|
| 102 | ]
|
|---|
| 103 | show pane/1 ; !!! this cleans up artifacts but "eats" other widgets redraw events !!!
|
|---|
| 104 | ]
|
|---|
| 105 |
|
|---|
| 106 | set-user-color: make function! [id [integer!] color [tuple! word! none!] /local idx] [
|
|---|
| 107 | if any [zero? id id > rows] [exit]
|
|---|
| 108 | poke data id * 5 - 3 color
|
|---|
| 109 | if limit > (rows - id) [
|
|---|
| 110 | idx: either rows > limit [(id + limit - rows) * 4 - 2] [id * 4 - 2]
|
|---|
| 111 | pane/1/pane/:idx/font/color: either word? color [get color] [color]
|
|---|
| 112 | show pane/1/pane/:idx
|
|---|
| 113 | ]
|
|---|
| 114 | ]
|
|---|
| 115 |
|
|---|
| 116 | set-message-text: make function! [id [integer!] string [string!] /local idx] [
|
|---|
| 117 | if any [zero? id id > rows] [exit]
|
|---|
| 118 | poke data id * 5 - 2 string
|
|---|
| 119 | if limit > (rows - id) [
|
|---|
| 120 | idx: either rows > limit [(id + limit - rows) * 4 - 1] [id * 4 - 1]
|
|---|
| 121 | insert clear pane/1/pane/:idx/text string
|
|---|
| 122 | redraw
|
|---|
| 123 | ]
|
|---|
| 124 | ]
|
|---|
| 125 |
|
|---|
| 126 | set-message-color: make function! [id [integer!] color [tuple! word! none!] /local idx] [
|
|---|
| 127 | if any [zero? id id > rows] [exit]
|
|---|
| 128 | poke data id * 5 - 1 color
|
|---|
| 129 | if limit > (rows - id) [
|
|---|
| 130 | idx: either rows > limit [(id + limit - rows) * 4 - 1] [id * 4 - 1]
|
|---|
| 131 | pane/1/pane/:idx/color: either word? color [get color] [color]
|
|---|
| 132 | show pane/1/pane/:idx
|
|---|
| 133 | ]
|
|---|
| 134 | ]
|
|---|
| 135 |
|
|---|
| 136 | redraw: make function! [/no-show /local row] [
|
|---|
| 137 | clear pane/1/pane
|
|---|
| 138 | height: 0
|
|---|
| 139 | rows: (length? data) / 5
|
|---|
| 140 | row: max 0 rows - limit: any [select options 'limit 100]
|
|---|
| 141 | foreach [user user-color msg msg-color date] skip data row * 5 [
|
|---|
| 142 | append-message/no-show user user-color msg msg-color date row: row + 1
|
|---|
| 143 | ]
|
|---|
| 144 | pane/1/size/y: height
|
|---|
| 145 | pane/3/ratio: either zero? height [1] [pane/3/size/y / height]
|
|---|
| 146 | unless no-show [show self]
|
|---|
| 147 | ]
|
|---|
| 148 |
|
|---|
| 149 | init: make function! [/local p] [
|
|---|
| 150 | p: self
|
|---|
| 151 | limit: any [select options 'limit 100]
|
|---|
| 152 | insert pane make subface [
|
|---|
| 153 | offset: as-pair 0 sizes/line
|
|---|
| 154 | size: p/size - as-pair sizes/slider sizes/line
|
|---|
| 155 | span: all [p/span find p/span #W #W]
|
|---|
| 156 | pane: []
|
|---|
| 157 | ]
|
|---|
| 158 | ; heading
|
|---|
| 159 | insert tail pane make subface [
|
|---|
| 160 | size: as-pair p/size/x sizes/line
|
|---|
| 161 | text: "ID^-User^-Message^-Sent"
|
|---|
| 162 | span: all [p/span find p/span #W #W]
|
|---|
| 163 | color: colors/theme-dark
|
|---|
| 164 | font: make default-font [color: colors/page]
|
|---|
| 165 | para: make default-para [tabs: [0 0 0]]
|
|---|
| 166 | ]
|
|---|
| 167 | ; set header tabs
|
|---|
| 168 | poke pane/2/para/tabs 1 sizes/cell * any [select options 'id 10]
|
|---|
| 169 | poke pane/2/para/tabs 2 sizes/cell * (any [select options 'user 15]) + pick pane/2/para/tabs 1
|
|---|
| 170 | poke pane/2/para/tabs 3 size/x - sizes/slider - (sizes/cell * any [select options 'date 25])
|
|---|
| 171 | ; vertical scroller
|
|---|
| 172 | insert tail pane make slider [
|
|---|
| 173 | tip: none
|
|---|
| 174 | offset: as-pair p/size/x - sizes/slider sizes/line
|
|---|
| 175 | size: as-pair sizes/slider p/size/y - sizes/line
|
|---|
| 176 | span: case [
|
|---|
| 177 | none? p/span [none]
|
|---|
| 178 | all [find p/span #H find p/span #W] [#XH]
|
|---|
| 179 | find p/span #H [#H]
|
|---|
| 180 | find p/span #W [#X]
|
|---|
| 181 | ]
|
|---|
| 182 | options:[arrows]
|
|---|
| 183 | action: make default-action [
|
|---|
| 184 | on-click: make function! [face /local p] [
|
|---|
| 185 | p: face/parent-face
|
|---|
| 186 | p/pane/1/offset/y: sizes/line + negate (height - face/size/y) * face/data
|
|---|
| 187 | show p
|
|---|
| 188 | ]
|
|---|
| 189 | ]
|
|---|
| 190 | ]
|
|---|
| 191 | pane/3/init
|
|---|
| 192 | action/on-resize self
|
|---|
| 193 | ]
|
|---|
| 194 | ] |
|---|
