gui.fs 35.3 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
\ net2o GUI

\ Copyright (C) 2018   Bernd Paysan

\ This program is free software: you can redistribute it and/or modify
\ it under the terms of the GNU Affero General Public License as published by
\ the Free Software Foundation, either version 3 of the License, or
\ (at your option) any later version.

\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
\ GNU Affero General Public License for more details.

\ You should have received a copy of the GNU Affero General Public License
\ along with this program.  If not, see <http://www.gnu.org/licenses/>.

require minos2/widgets.fs

Bernd Paysan's avatar
Bernd Paysan committed
20 21 22 23 24 25 26 27
also minos

ctx 0= [IF]  window-init  [THEN]

require minos2/font-style.fs

: slide-frame ( glue color -- o )
    font-size# 70% f* }}frame ;
28 29
: bar-frame ( glue color -- o )
    font-size# 20% f* }}frame dup .button3 ;
30
: update-gsize# ( -- )
Bernd Paysan's avatar
Bernd Paysan committed
31
    screen-pwh max s>f
32 33 34
    default-diag screen-diag f/
    [ 5e fsqrt 1e f+ f2/ 1e f- ] FLiteral f**
    default-scale f* 1/f #64 fm*
Bernd Paysan's avatar
Bernd Paysan committed
35
    f/ fround to font-size#
Bernd Paysan's avatar
Bernd Paysan committed
36
    font-size# 133% f* fround to baseline#
37
    font-size# 32e f/ to pixelsize# ;
Bernd Paysan's avatar
Bernd Paysan committed
38 39

require minos2/text-style.fs
40
require minos2/md-viewer.fs
Bernd Paysan's avatar
Bernd Paysan committed
41

42 43
update-gsize#

Bernd Paysan's avatar
Bernd Paysan committed
44 45
glue new Constant glue-sleft
glue new Constant glue-sright
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
glue ' new static-a with-allocater Constant glue-left
glue ' new static-a with-allocater Constant glue-right

: glue0 ( -- ) 0e fdup
    [ glue-left  .hglue-c ]L df!
    [ glue-right .hglue-c ]L df! ;
glue0

Variable slides[]
Variable slide#

: >slides ( o -- ) slides[] >stack ;

: !slides ( nprev n -- )
    over slide# !
    slides[] $[] @ /flip drop
    slides[] $[] @ /flop drop glue0 ;
: anim!slides ( r0..1 n -- )
    slides[] $[] @ /flop drop
    fdup fnegate dpy-w @ fm* glue-left  .hglue-c df!
    -1e f+       dpy-w @ fm* glue-right .hglue-c df! ;

: prev-anim ( n r0..1 -- )
    dup 0<= IF  drop fdrop  EXIT  THEN
    fdup 1e f>= IF  fdrop
71
	dup 1- swap !slides +sync +resize  EXIT
72
    THEN
73
    1e fswap f- 1- sin-t anim!slides +sync +resize ;
74 75 76 77

: next-anim ( n r0..1 -- )
    dup slides[] $[]# 1- u>= IF  drop fdrop  EXIT  THEN
    fdup 1e f>= IF  fdrop
78
	dup 1+ swap !slides +sync +resize  EXIT
79
    THEN
80
    1+ sin-t anim!slides +sync +resize ;
81

Bernd Paysan's avatar
Bernd Paysan committed
82
0.4e FValue slide-time%
83 84

: prev-slide ( -- )
Bernd Paysan's avatar
Bernd Paysan committed
85
    slide-time% anims[] $@len IF  anim-end 50% f*  THEN
86
    slide# @ ['] prev-anim >animate +textures +lang ;
87
: next-slide ( -- )
Bernd Paysan's avatar
Bernd Paysan committed
88
    slide-time% anims[] $@len IF  anim-end 50% f*  THEN
89
    slide# @ ['] next-anim >animate +textures +lang ;
Bernd Paysan's avatar
Bernd Paysan committed
90

91
\ frames
Bernd Paysan's avatar
Bernd Paysan committed
92

93 94
0 Value pw-frame
0 Value id-frame
Bernd Paysan's avatar
Bernd Paysan committed
95
0 Value chat-frame
96
0 Value post-frame
Bernd Paysan's avatar
Bernd Paysan committed
97 98 99

\ password screen

Bernd Paysan's avatar
Bernd Paysan committed
100 101
0 Value pw-err
0 Value pw-num
102 103
0 Value phrase-unlock
0 Value create-new-id
Bernd Paysan's avatar
Bernd Paysan committed
104
0 Value phrase-first
105
0 Value phrase-again
106 107 108
0 Value plus-login
0 Value minus-login
0 Value nick-edit
Bernd Paysan's avatar
Bernd Paysan committed
109 110 111

: err-fade ( r addr -- )
    1e fover [ pi f2* ] Fliteral f* fcos 1e f+ f2/ f-
112
    2 tries# @ lshift s>f f* fdup 1e f> IF fdrop 1e ELSE +sync +resize THEN
113
    .fade fdrop ;
Bernd Paysan's avatar
Bernd Paysan committed
114 115 116 117

: shake-lr ( r addr -- )
    [ pi 16e f* ] FLiteral f* fsin f2/ 0.5e f+ \ 8 times shake
    font-size# f2/ f* font-size# f2/ fover f-
Bernd Paysan's avatar
Bernd Paysan committed
118
    glue-sleft  >o 0g fdup hglue-c glue! o>
119
    glue-sright >o 0g fdup hglue-c glue! o> +sync +resize drop ;
Bernd Paysan's avatar
Bernd Paysan committed
120

121 122
0e 0 shake-lr

Bernd Paysan's avatar
Bernd Paysan committed
123
: pres-frame ( color -- o1 o2 ) \ drop $FFFFFFFF
124
    glue*wh slide-frame dup .button1 ;
Bernd Paysan's avatar
Bernd Paysan committed
125

Bernd Paysan's avatar
Bernd Paysan committed
126 127 128 129 130 131
: err-fade? ( -- flag ) 0 { flag }
    anims@ 0 ?DO
	>o action-of animate ['] err-fade = flag or to flag
	o anims[] >stack o>
    LOOP  flag ;

132
forward show-nicks
133
forward gui-msgs
Bernd Paysan's avatar
Bernd Paysan committed
134
0 Value title-vp
135
0 Value pw-field
Bernd Paysan's avatar
Bernd Paysan committed
136
0 Value nick-field
137
0 Value nick-pw
138
0 Value pw-back
139

140 141 142
Variable nick$

: nick-done ( max span addr pos -- max span addr pos flag )
143
    over 3 pick nick$ $!
Bernd Paysan's avatar
Bernd Paysan committed
144 145 146 147
    0e pw-field [: data .engage fdrop ;] >animate \ engage delayed
    create-new-id /hflip
    phrase-first /flop +lang
    1 to nick-pw  true ;
148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163

: clear-edit ( max span addr pos -- max 0 addr 0 true )
    drop nip 0 tuck true ;

: do-shake ( max span addr pos -- max span addr pos flag )
    keys sec[]free
    clear-edit invert
    1e o ['] shake-lr >animate
    1 tries# @ lshift s>f f2/ pw-err ['] err-fade >animate ;

: right-phrase ( max span addr pos -- max span addr pos flag )
    \ ." Right passphrase" cr
    0 >o 0 secret-key init-client >raw-key
    read-chatgroups announce-me
    o>
    show-nicks clear-edit ;
164

Bernd Paysan's avatar
Bernd Paysan committed
165
: pw-done ( max span addr pos -- max span addr pos flag )
166 167 168 169
    case nick-pw
	1 of
	    1 +to nick-pw
	    over 3 pick >passphrase +key
170
	    create-new-id /hflip
Bernd Paysan's avatar
Bernd Paysan committed
171
	    phrase-first /hflip
172
	    phrase-again /flop
173
	    clear-edit invert +lang +resize
174 175 176
	endof
	2 of
	    over 3 pick >passphrase lastkey@ str= IF
Bernd Paysan's avatar
Bernd Paysan committed
177 178
		\ ." Create nick " nick$ $. ."  with passphrase (hashed) " lastkey@ 85type cr
		gen-keys-dir nick$ $@ 0 .new-key,
179 180 181
		right-phrase
	    ELSE
		1 to nick-pw
Bernd Paysan's avatar
Bernd Paysan committed
182
		phrase-first /flop
183
		phrase-again /hflip +lang +resize
184 185 186 187
		1 tries# ! do-shake
	    THEN
	endof
	err-fade? IF  false  EXIT  THEN
188
	drop over 3 pick >passphrase +key
189 190 191 192 193 194
	read-keys secret-keys# 0= IF
	    \ ." Wrong passphrase" cr
	    1 tries# +! tries# @ 0 <# #s #> pw-num >o to text$ o>
	    do-shake
	ELSE
	    right-phrase
195
	THEN  0
196
    endcase ;
197

Bernd Paysan's avatar
Bernd Paysan committed
198
: 20%bt ( o -- o ) >o font-size# 20% f* to bordert o o> ;
Bernd Paysan's avatar
Bernd Paysan committed
199
: 25%b ( o -- o ) >o font-size# 25% f* to border o o> ;
200
: 25%bv ( o -- o ) >o font-size# 25% f* fdup to border fnegate to borderv o o> ;
Bernd Paysan's avatar
Bernd Paysan committed
201 202
: 40%b ( o -- o ) >o font-size# 40% f* to border o o> ;

203 204
\ password frame

Bernd Paysan's avatar
Bernd Paysan committed
205 206
tex: net2o-logo

Bernd Paysan's avatar
Bernd Paysan committed
207 208 209 210 211 212 213 214 215 216 217 218 219
$FF0040FF text-color, FValue pw-num-col#
$666666FF text-color, FValue pw-text-col#
$000000FF text-color, FValue show-sign-color#
$FFCCCCFF $44FF44FF fade-color, FValue pw-bg-col#
$0000BFFF new-color, FValue dark-blue#
$0000FF08 new-color, FValue chbs-col#
$FFFFFFFF new-color, FValue login-bg-col#
$FF000000 $FF0000FF fade-color, FValue pw-err-col#
$000000FF dup text-emoji-color: black-emoji
$000000FF new-color, FValue otr-col#
$FFFFFFFF new-color, FValue chat-col#
$80FFFFFF new-color, FValue chat-bg-col#
$FFFFFFFF new-color, FValue posting-bg-col#
220

221 222 223 224
: entropy-colorize ( -- )
    prev-text$ erase  addr prev-text$ $free
    edit-w .text$ passphrase-entropy 1e fmin pw-bg-col# f+
    pw-back >o to w-color o> ;
225 226 227 228
: size-limit ( -- )
    edit-w .text$ nip #800 u> IF
	prev-text$ edit-w >o to text$ o>
    THEN ;
229

230
glue new Constant glue*lll±
Bernd Paysan's avatar
Bernd Paysan committed
231
glue*lll± >o 1Mglue fnip 1000e fswap hglue-c glue! 0glue fnip 1filll fswap dglue-c glue! 1glue vglue-c glue! o>
232

233 234 235
glue new Constant glue*shrink
glue*shrink >o 0e 1filll 0e hglue-c glue! 1glue dglue-c glue! 1glue vglue-c glue! o>

Bernd Paysan's avatar
Bernd Paysan committed
236 237
' dark-blue >body f@

238
{{  login-bg-col# pres-frame
Bernd Paysan's avatar
Bernd Paysan committed
239
    dark-blue# ' dark-blue >body f!
Bernd Paysan's avatar
Bernd Paysan committed
240
    {{
241
	{{ glue*lll± }}glue }}v
Bernd Paysan's avatar
Bernd Paysan committed
242 243 244
	' net2o-logo "doc/net2o.png" 0.666e }}image-file Constant net2o-glue /center
	!i18n l" net2o GUI" /title
	!lit
245
	\footnote cbl dark-blue net2o-version }}text /center
246 247 248
	{{
	    {{
		glue*ll }}glue
Bernd Paysan's avatar
Bernd Paysan committed
249
		blackish \large "👤" }}text \normal
250 251 252 253
		{{
		    glue*l pw-bg-col# font-size# f2/ f2/ }}frame dup .button3
		    {{
			nt
Bernd Paysan's avatar
Bernd Paysan committed
254
			blackish \bold
Bernd Paysan's avatar
Bernd Paysan committed
255
			"nick" }}edit 25%b dup to nick-field
256
			glue*lll }}glue \regular
257 258 259 260 261 262
		    }}h bx-tab nick-field ' nick-done edit[]
		}}z box[] blackish
		{{ \large "👤" }}text \normal }}h /phantom
		glue*ll }}glue
	    }}h box[]
	}}v box[] /vflip dup to nick-edit
Bernd Paysan's avatar
Bernd Paysan committed
263 264
	{{
	    glue*lll }}glue
Bernd Paysan's avatar
Bernd Paysan committed
265
	    glue-sleft }}glue
266 267
	    {{
		\large \sans "🔐" }}text
268
		\large pw-num-col# to x-color s" " }}text
269 270
		25%b dup to pw-num /center
	    }}z
Bernd Paysan's avatar
Bernd Paysan committed
271
	    {{
272
		glue*l pw-bg-col# font-size# f2/ f2/ }}frame dup .button3
273
		dup to pw-back
274
		\mono \normal
275
		{{ chbs-col# to x-color "Correct Horse Battery Staple" }}text 25%b
Bernd Paysan's avatar
Bernd Paysan committed
276 277
		glue*l }}h
		{{
Bernd Paysan's avatar
Bernd Paysan committed
278
		    glue-sright }}glue
279
		    glue*l }}glue \bold
Bernd Paysan's avatar
Bernd Paysan committed
280
		    l" wrong passphrase!" pw-err-col#
281
		    to x-color }}i18n-text \regular
Bernd Paysan's avatar
Bernd Paysan committed
282
		    25%b dup to pw-err
283
		    glue*l }}glue
Bernd Paysan's avatar
Bernd Paysan committed
284
		    glue-sleft }}glue
Bernd Paysan's avatar
Bernd Paysan committed
285 286 287 288
		}}h
		blackish
		{{
		    {{
289
			pw-text-col# to x-color
290
			"" }}pw dup to pw-field
Bernd Paysan's avatar
Bernd Paysan committed
291
			25%b >o config:passmode# @ to pw-mode o o>
292
			glue*lll }}glue
293
		    }}h
294
		    pw-field ' pw-done edit[] ' entropy-colorize filter[]
Bernd Paysan's avatar
Bernd Paysan committed
295
		    \normal \sans white# to x-color
Bernd Paysan's avatar
Bernd Paysan committed
296
		    "" }}text blackish
Bernd Paysan's avatar
Bernd Paysan committed
297 298
		    dup value show-pw-sign
		    \regular
Bernd Paysan's avatar
Bernd Paysan committed
299
		    : pw-show/hide ( flag -- )
Bernd Paysan's avatar
Bernd Paysan committed
300
			dup IF  ""  ELSE  ""  THEN  show-pw-sign >o to text$ o>
Bernd Paysan's avatar
Bernd Paysan committed
301 302 303 304 305
			2 config:passmode# @ 1 min rot select pw-field >o to pw-mode o>
			pw-field engage +sync ;
		    ' pw-show/hide config:passmode# @ 1 > toggle[]
		    \normal
		}}h box[]
306 307 308 309 310 311 312 313 314 315 316
	    }}z box[] bx-tab
	    {{
		\large
		"🔴" }}text \normal  >o font-size# 10% f* to raise o o>
		"➕" }}text /center dup to plus-login
		"➖" }}text /center dup to minus-login /vflip
		\large
		: id-show-hide ( flag -- )
		    IF
			phrase-unlock /hflip
			create-new-id /flop
317 318
			phrase-first /hflip
			phrase-again /hflip
319 320 321 322 323
			plus-login /flip
			minus-login /flop
			nick-edit /flop
			[ x-baseline ] FLiteral nick-edit >o
			fdup gap% f* to gap to baseline o>
Bernd Paysan's avatar
Bernd Paysan committed
324
			"nick" nick-field engage-edit
325
			1 to nick-pw
326 327 328
		    ELSE
			phrase-unlock /flop
			create-new-id /hflip
329 330
			phrase-first /hflip
			phrase-again /hflip
331 332 333 334
			plus-login /flop
			minus-login /flip
			nick-edit /vflip
			0e nick-edit >o to baseline o>
335
			pw-field engage
336
			0 to nick-pw
337 338
		    THEN +resize +lang ;
		\normal
339
	    }}z ' id-show-hide false toggle[] dup Value id-toggler
Bernd Paysan's avatar
Bernd Paysan committed
340
	    glue-sright }}glue
Bernd Paysan's avatar
Bernd Paysan committed
341 342
	    glue*lll }}glue
	}}h box[] \skip >bl
343
	\ Advices, context sensitive
344 345 346
	{{  \small dark-blue !i18n
	    l" Enter passphrase to unlock" }}text' /center dup to phrase-unlock
	    l" Create new ID" }}text' /center dup to create-new-id /hflip
Bernd Paysan's avatar
Bernd Paysan committed
347 348
	    l" Enter new passphrase" }}text' /center dup to phrase-first /hflip
	    l" Enter new passphrase again" }}text' /center dup to phrase-again /hflip
349 350
	    !lit
	}}z box[] /center >bl
351
	{{ glue*lll }}glue }}v
Bernd Paysan's avatar
Bernd Paysan committed
352
    }}v box[]
353 354
}}z box[] to pw-frame

Bernd Paysan's avatar
Bernd Paysan committed
355
' dark-blue >body f!
356

357 358 359
\ id frame

0 Value mykey-box
360
0 Value groups-box
361
0 Value nicks-box
Bernd Paysan's avatar
Bernd Paysan committed
362
0 Value msgs-box
Bernd Paysan's avatar
Bernd Paysan committed
363
0 Value msg-box
364
0 Value msg-par
365
0 Value msg-vbox
366

Bernd Paysan's avatar
Bernd Paysan committed
367
0 Value group-name
Bernd Paysan's avatar
Bernd Paysan committed
368
0 Value group-members
Bernd Paysan's avatar
Bernd Paysan committed
369

Bernd Paysan's avatar
Bernd Paysan committed
370 371 372 373
new-htab tab-glue: name-tab
new-htab tab-glue: pk-tab
new-htab tab-glue: group-tab
new-htab tab-glue: chatname-tab
374

Bernd Paysan's avatar
Bernd Paysan committed
375 376 377 378 379 380 381
[IFUNDEF] child+
    : child+ ( o -- ) o over >o to parent-w o> childs[] >stack ;
[THEN]

Create ke-imports#rgb

Create imports#rgb-bg
Bernd Paysan's avatar
Bernd Paysan committed
382 383 384 385 386 387 388 389
$33EE33FF new-color, sf, \ myself is pretty green
$BBDD66FF new-color, sf, \ manually imported is green, too
$55DD55FF new-color, sf, \ scanned is more green
$CCEE55FF new-color, sf, \ seen in chat is more yellow
$EECC55FF new-color, sf, \ imported from DHT is pretty yellow
$FF8844FF new-color, sf, \ invited is very yellow
$FF6600FF new-color, sf, \ provisional is very orange
$FF0000FF new-color, sf, \ untrusted is last
Bernd Paysan's avatar
Bernd Paysan committed
390
Create imports#rgb-fg
Bernd Paysan's avatar
Bernd Paysan committed
391 392 393 394 395 396 397 398
$003300FF text-color, sf,
$000000FF text-color, sf,
$000000FF text-color, sf,
$000000FF text-color, sf,
$0000FFFF text-color, sf,
$0000FFFF text-color, sf,
$0000FFFF text-color, sf,
$00FFFFFF text-color, sf,
Bernd Paysan's avatar
Bernd Paysan committed
399

Bernd Paysan's avatar
Bernd Paysan committed
400 401
\ more colors

Bernd Paysan's avatar
Bernd Paysan committed
402 403 404 405
$88FF88FF new-color: my-signal
$CCFFCCFF new-color: other-signal
$CC00CCFF new-color: my-signal-otr
$880088FF new-color: other-signal-otr
Bernd Paysan's avatar
Bernd Paysan committed
406 407 408 409 410
$4444CCFF text-color: link-blue
$44CC44FF text-color: re-green
$CC4444FF text-color: obj-red
$00BFFFFF text-color: light-blue
$44FF44FF text-color: greenish
Bernd Paysan's avatar
Bernd Paysan committed
411 412
$33883366 new-color: day-color
$88333366 new-color: hour-color
Bernd Paysan's avatar
Bernd Paysan committed
413
$FFFFFFFF text-color: realwhite
Bernd Paysan's avatar
Bernd Paysan committed
414 415
$FFFFFFFF new-color: edit-bg
$80FF80FF new-color: send-color
Bernd Paysan's avatar
Bernd Paysan committed
416 417
$00FF0020 new-color: pet-color
$FFFF80FF new-color, fvalue users-color#
Bernd Paysan's avatar
Bernd Paysan committed
418 419
$FFCCCCFF new-color, fvalue gps-color#
$000077FF new-color, fvalue chain-color#
420
$FF000000 $FF0000FF fade-color: show-error-color
421 422
$338833FF text-color: lock-color
$883333FF text-color: lockout-color
423
$FFAA44FF text-color, fvalue perm-color#
Bernd Paysan's avatar
Bernd Paysan committed
424

425 426 427
: nick[] ( box o:nick -- box )
    [: data >o ." clicked on " ke-nick $. cr o> ;] o click[] ;

Bernd Paysan's avatar
Bernd Paysan committed
428 429 430 431 432
Hash: avatar#

glue new Constant glue*avatar
glue*avatar >o pixelsize# 64 fm* 0e 0g glue-dup hglue-c glue! vglue-c glue! 0glue dglue-c glue! o>

433
: read-avatar ( addr u -- addr' u' )
434
    ?read-enc-hashed mem>thumb atlas-region ;
Bernd Paysan's avatar
Bernd Paysan committed
435 436
: show-avatar ( addr u -- o )
    2dup avatar# #@ nip 0= IF
437
	2dup read-avatar 2swap avatar# #!
Bernd Paysan's avatar
Bernd Paysan committed
438
    ELSE  2drop  THEN
Bernd Paysan's avatar
Bernd Paysan committed
439
    glue*avatar last# cell+ $@ drop }}thumb
Bernd Paysan's avatar
Bernd Paysan committed
440 441
    >r {{ r> }}v 40%b ;

442 443 444 445 446 447
: re-avatar ( last# -- )
    >r r@ $@ read-avatar r> cell+ $@ smove ;

:noname defers free-thumbs
    avatar# ['] re-avatar #map ; is free-thumbs

Bernd Paysan's avatar
Bernd Paysan committed
448 449 450 451 452 453 454
: ?avatar ( addr u -- o / )
    key# #@ IF
	cell+ .ke-avatar $@ dup IF
	    show-avatar
	ELSE  2drop  THEN
    ELSE  drop  THEN ;

455
: show-nick ( o:key -- )
Bernd Paysan's avatar
Bernd Paysan committed
456
    ke-imports @ [ 1 import#provisional lshift ]L and ?EXIT
457 458
    ke-imports @ >im-color# sfloats { ki }
    {{ glue*l imports#rgb-bg ki + sf@ slide-frame dup .button1
Bernd Paysan's avatar
Bernd Paysan committed
459
	{{
460
	    {{ \large imports#rgb-fg ki + sf@ to x-color
Bernd Paysan's avatar
Bernd Paysan committed
461
		ke-avatar $@ dup IF  show-avatar  ELSE  2drop  THEN
Bernd Paysan's avatar
Bernd Paysan committed
462 463 464
		ke-sk sec@ nip IF  \bold  ELSE  \regular  THEN  \sans
		['] .nick-base $tmp }}text 25%b
		ke-pets[] $[]# IF
Bernd Paysan's avatar
Bernd Paysan committed
465 466
		    {{
			x-color glue*l pet-color x-color slide-frame dup .button3 to x-color
Bernd Paysan's avatar
Bernd Paysan committed
467 468 469 470 471 472 473 474 475 476
			['] .pet-base $tmp }}text 25%b
		    }}z
		THEN
	    glue*l }}glue }}h name-tab
	    {{
		{{ \sans \script ke-selfsig $@ ['] .sigdates $tmp }}text glue*l }}glue }}h
		{{ \mono \script ke-pk $@ key| ['] 85type $tmp }}text 20%bt glue*l }}glue }}h swap
	    }}v pk-tab
	glue*lll }}glue }}h
    }}z nick[]  \regular
Bernd Paysan's avatar
Bernd Paysan committed
477
    mykey-box nicks-box ke-sk sec@ nip select /flop .child+ ;
478 479 480 481 482

: fill-nicks ( -- )
    keys>sort[]
    key-list[] $@ bounds ?DO
	I @ .show-nick
Bernd Paysan's avatar
Bernd Paysan committed
483
    cell +LOOP ;
484

485
: refresh-top ( -- )
Bernd Paysan's avatar
Bernd Paysan committed
486
    +sync +lang
Bernd Paysan's avatar
Bernd Paysan committed
487 488
    top-widget >o htop-resize  <draw-init draw-init draw-init> htop-resize
    false to grab-move? o> ;
489

Bernd Paysan's avatar
Bernd Paysan committed
490
: show-connected ( -- ) main-up@ connection .wait-task ! ;
491

Bernd Paysan's avatar
Bernd Paysan committed
492
: gui-chat-connects ( -- )
493
    [: up@ wait-task ! ;] IS do-connect
494
    [: chat-keys [:
495 496 497 498
	    2dup search-connect ?dup-IF  >o +group greet o> 2drop  EXIT  THEN
	    2dup pk-peek? IF  chat-connect true !!connected!!
	    ELSE  2drop  THEN ;] $[]map ;] catch
    [ ' !!connected!! >body @ ]L = IF  show-connected  THEN ;
Bernd Paysan's avatar
Bernd Paysan committed
499

500 501 502
event: :>!connection    to connection ;
event: :>chat-connects  gui-chat-connects
    <event connection dup elit, :>!connection .wait-task @ event> ;
Bernd Paysan's avatar
Bernd Paysan committed
503

504 505
false Value in-group?

506
: group[] ( box group -- box )
507 508
    [:  in-group? ?EXIT  true to in-group?
	data $@ group-name >o to text$ o>
Bernd Paysan's avatar
Bernd Paysan committed
509
	data cell+ $@ drop cell+ >o groups:id$ groups:member[] o>
510
	[: chat-keys $+[]! ;] $[]map
511 512
	gui-msgs  <event :>chat-connects ?query-task event>
	next-slide
Bernd Paysan's avatar
Bernd Paysan committed
513
    ;] swap click[] ;
514

515
: show-group ( group-o -- )
516
    dup { g -- } cell+ $@ drop cell+ >o
Bernd Paysan's avatar
Bernd Paysan committed
517
    {{ glue*l chat-bg-col# slide-frame dup .button1
Bernd Paysan's avatar
Bernd Paysan committed
518 519 520 521 522 523 524 525 526 527 528 529
	{{
	    {{ \large blackish
		\regular \sans g $@ }}text 25%b
	    glue*l }}glue }}h name-tab
	    {{
		{{
		    \mono \bold \script groups:id$
		    2dup g $@ str= 0= IF  key| ['] 85type $tmp  THEN
		}}text 20%bt glue*l }}glue }}h
		glue*l }}glue
	    }}v pk-tab
	glue*lll }}glue }}h
530
    }}z g group[] o>
Bernd Paysan's avatar
Bernd Paysan committed
531
    groups-box /flop .child+ ;
532

Bernd Paysan's avatar
Bernd Paysan committed
533
: fill-groups ( -- )
534 535 536 537
    groups>sort[]
    group-list[] $@ bounds ?DO
	I @ show-group
    cell +LOOP ;
Bernd Paysan's avatar
Bernd Paysan committed
538

Bernd Paysan's avatar
Bernd Paysan committed
539 540 541 542
also [ifdef] android android [then]

tex: vp-title

Bernd Paysan's avatar
Bernd Paysan committed
543 544
$F110 Constant 'spinner'
$F012 Constant 'signal'
545 546 547
$F234 Constant 'user-plus'
$F503 Constant 'user-minus'
$F235 Constant 'user-times'
Bernd Paysan's avatar
Bernd Paysan committed
548 549 550 551 552 553 554 555 556 557

0 Value online-flag

: online-symbol ( -- addr u )
    'signal' 'spinner' online? select ['] xemit $tmp ;
: !online-symbol ( -- )
    online-symbol online-flag >o to text$ o> +sync ;
:noname  true to online? ['] announce-me catch 0= to online?
    !online-symbol ; is addr-changed

Bernd Paysan's avatar
Bernd Paysan committed
558
: nicks-title ( -- )
Bernd Paysan's avatar
Bernd Paysan committed
559
    {{ glue*l black# slide-frame dup .button1
Bernd Paysan's avatar
Bernd Paysan committed
560 561
	{{
	    {{
Bernd Paysan's avatar
Bernd Paysan committed
562
		{{
Bernd Paysan's avatar
Bernd Paysan committed
563
		    {{ \large \bold \sans realwhite
Bernd Paysan's avatar
Bernd Paysan committed
564 565 566 567 568 569 570 571
		    l" Nick+Pet" }}i18n-text 25%b glue*l }}glue }}h name-tab
		    {{
			{{ \script \mono \bold l" Pubkey"   }}i18n-text 20%bt glue*l }}glue }}h
			{{ \script \sans \bold l" Key date" }}i18n-text glue*l }}glue }}h
		    }}v pk-tab
		    glue*lll± }}glue
		}}h box[]
	    vp-title glue*lll ['] vp-title }}vp vp[] dup to title-vp
572 573
	}}h box[]
    }}z box[] ;
Bernd Paysan's avatar
Bernd Paysan committed
574

Bernd Paysan's avatar
Bernd Paysan committed
575 576
previous

Bernd Paysan's avatar
Bernd Paysan committed
577
{{ users-color# pres-frame
Bernd Paysan's avatar
Bernd Paysan committed
578
    {{
579 580 581
	{{
	    nicks-title
	    glue*shrink }}glue
Bernd Paysan's avatar
Bernd Paysan committed
582 583 584
	    \Large
	    s" ❌" $444444FF new-color, }}button-lit /hfix [: -1 data +! ;]
	    [IFDEF] android android:level# [ELSE] level# [THEN] click[]
585
	}}h box[] /vfix
Bernd Paysan's avatar
Bernd Paysan committed
586 587
	{{
	    {{
Bernd Paysan's avatar
Bernd Paysan committed
588
		{{ glue*l $303000FF new-color, bar-frame
Bernd Paysan's avatar
Bernd Paysan committed
589 590
		{{ \script l" My key" }}i18n-text 25%b glue*l }}glue }}h }}z
		{{ }}v box[] dup to mykey-box
Bernd Paysan's avatar
Bernd Paysan committed
591
		{{ glue*l $300030FF new-color, bar-frame
Bernd Paysan's avatar
Bernd Paysan committed
592
		{{ \script l" My groups" }}i18n-text 25%b glue*l }}glue }}h }}z
593
		{{ }}v box[] dup to groups-box /vflip
Bernd Paysan's avatar
Bernd Paysan committed
594
		{{ glue*l $003030FF new-color, bar-frame
Bernd Paysan's avatar
Bernd Paysan committed
595
		{{ \script l" My peers" }}i18n-text 25%b glue*l }}glue }}h }}z
596
		{{ }}v box[] dup to nicks-box /vflip
Bernd Paysan's avatar
Bernd Paysan committed
597
		glue*lll }}glue
598
	    tex: vp-nicks vp-nicks glue*lll ' vp-nicks }}vp vp[] dup value peers-box
Bernd Paysan's avatar
Bernd Paysan committed
599 600
	    $444444FF new-color, to slider-color
	    $CCCCCCFF new-color, to slider-fgcolor
Bernd Paysan's avatar
Bernd Paysan committed
601 602 603
	    font-size# 33% f* to slider-border
	dup font-size# 66% f* fdup vslider }}h box[]
    }}v box[]
604
}}z box[] to id-frame
605 606

: show-nicks ( -- )
Bernd Paysan's avatar
Bernd Paysan committed
607 608
    fill-nicks fill-groups !online-symbol
    next-slide
Bernd Paysan's avatar
Bernd Paysan committed
609
    peers-box 0.01e [: .vp-top fdrop title-vp .vp-top +sync +resize ;] >animate ;
Bernd Paysan's avatar
Bernd Paysan committed
610

Bernd Paysan's avatar
Bernd Paysan committed
611 612 613 614 615
\ messages

msg-class class
end-class wmsg-class

616
Variable last-bubble-pk
617
0 Value last-otr?
618
0 Value last-bubble
619 620
64#0 64Value last-tick
#300 #1000000000 um* d>64 64Constant delta-bubble
621

622 623 624
: >bubble-border ( o me? -- )
    swap >o font-size# 25% f*
    IF
625 626 627 628 629 630
	fdup f2* to border
	fnegate fdup to borderl fdup to borderv to bordert
    ELSE
	fdup f2* to border
	0e to borderl fnegate f2* to bordert 0e to borderv
    THEN o o> ;
631
: add-dtms ( ticks -- )
Bernd Paysan's avatar
Bernd Paysan committed
632
    \small blackish
633 634
    1n fm* >day { day } day last-day <> IF
	{{
635 636 637
	    x-color { f: xc }
	    glue*l day-color x-color slide-frame dup .button1
	    xc to x-color
638 639 640 641 642 643 644
	    \bold day ['] .day $tmp }}text 25%b \regular
	}}z /center msgs-box .child+
    THEN  day to last-day
    24 fm* fsplit { hour } hour last-hour <>
    60 fm* fsplit { minute } minute 10 / last-minute 10 / <> or
    IF
	{{
645 646 647
	    x-color { f: xc }
	    glue*l hour-color x-color slide-frame dup .button1
	    xc to x-color
648 649 650 651 652
	    60 fm* fsplit minute hour
	    [: .## ':' emit .## ':' emit .## 'Z' emit ;] $tmp }}text 25%b
	}}z /center msgs-box .child+
    THEN  hour to last-hour  minute to last-minute
    fdrop \normal ;
653

654 655 656 657
: otr? ( tick -- flag )
    64dup 64#-1 64<> ;
: text-color! ( -- ) last-otr? IF  greenish  ELSE  blackish  THEN ;

658 659 660 661 662 663 664 665 666 667 668 669 670
[IFDEF] android
    also jni
    : open-url ( addr u -- )
	clazz >o make-jstring to args0 o>
	['] startbrowser post-it ;
    previous
[ELSE]
    [IFDEF] linux
	: open-url ( addr u -- )
	    [: ." xdg-open " type ;] $tmp system ;
    [THEN]
[THEN]

Bernd Paysan's avatar
Bernd Paysan committed
671
: .posting ( addr u -- )
672 673 674 675
    2dup keysize /string
    2dup printable? IF  '[' emit type '@' emit
    ELSE  ." #["  85type ." /@"  THEN
    key| .key-id? ;
676

Bernd Paysan's avatar
Bernd Paysan committed
677 678
hash: chain-tags#

679 680
scope{ dvcs
dvcs-log-class class
Bernd Paysan's avatar
Bernd Paysan committed
681
end-class posting-log-class
682

Bernd Paysan's avatar
Bernd Paysan committed
683 684
Variable like-char

685 686
:noname ( addr u -- )
    + sigpksize# - [ keysize $10 + ]L dvcs-log:id$ $!
Bernd Paysan's avatar
Bernd Paysan committed
687
    like-char off
Bernd Paysan's avatar
Bernd Paysan committed
688 689 690 691 692 693
; posting-log-class is msg:start
:noname ( xchar -- )  like-char ! ; posting-log-class is msg:like
' 2drop posting-log-class is msg:tag
' 2drop posting-log-class is msg:id
' 2drop posting-log-class is msg:text
' 2drop posting-log-class is msg:action
Bernd Paysan's avatar
Bernd Paysan committed
694 695 696 697 698 699 700 701 702 703
:noname ( addr u -- )
    like-char @ 0= IF  2drop  EXIT  THEN
    8 umin { | w^ id+like }
    like-char @ dvcs-log:id$ $@ [: forth:type forth:xemit ;] id+like $exec
    id+like cell
    2over chain-tags# #@ d0= IF
	2swap chain-tags# #!
    ELSE
	2nip last# cell+ $+!
    THEN
Bernd Paysan's avatar
Bernd Paysan committed
704
; posting-log-class is msg:chain
705 706
:noname ( addr u -- )
    [: dvcs-log:id$ $. forth:type ;] dvcs-log:urls[] dup $[]# swap $[] $exec
Bernd Paysan's avatar
Bernd Paysan committed
707
; posting-log-class is msg:url
708

Bernd Paysan's avatar
Bernd Paysan committed
709 710
: new-posting-log ( -- o )
    posting-log-class new >o msg-table @ token-table ! o o> ;
711 712
}scope

Bernd Paysan's avatar
Bernd Paysan committed
713
0 Value posting-vp
714 715

{{
Bernd Paysan's avatar
Bernd Paysan committed
716
    posting-bg-col# pres-frame
717
    {{
718
	{{
Bernd Paysan's avatar
Bernd Paysan committed
719
	    glue*l $000000FF new-color, slide-frame dup .button1
720
	    {{
Bernd Paysan's avatar
Bernd Paysan committed
721
		\large realwhite
722 723 724 725 726 727 728 729 730
		"⬅" }}text 40%b [: prev-slide ;] over click[]
		!i18n l" Post" }}text' !lit 40%b
		glue*l }}glue
	    }}h box[]
	}}z box[]
	{{
	    {{
		glue*ll }}glue
		tex: vp-md
Bernd Paysan's avatar
Bernd Paysan committed
731 732
	    glue*l ' vp-md }}vp dup to posting-vp
	    >o "posting" to name$ font-size# dpy-w @ dpy-h @ > [IF]  dpy-w @ 25% fm* fover f- [ELSE] 0e [THEN] fdup fnegate to borderv f+ to border o o>
733
	dup font-size# 66% f* fdup vslider }}h box[]
Bernd Paysan's avatar
Bernd Paysan committed
734
	>o "posting-slider" to name$ o o>
735
    }}v box[]
Bernd Paysan's avatar
Bernd Paysan committed
736
    >o "posting-vbox" to name$ o o>
737
}}z box[]
Bernd Paysan's avatar
Bernd Paysan committed
738
>o "posting-zbox" to name$ o o>
739
to post-frame
740

Bernd Paysan's avatar
Bernd Paysan committed
741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762
hash: buckets#

: #!+ ( addr u hash -- ) >r
    2dup r@ #@ IF
	1 swap +!  rdrop 2drop
    ELSE
	drop 1 { w^ one }
	one cell 2swap r> #!
    THEN ;

Variable emojis$ "👍👎🤣😍😘😛🤔😭😡😱🔃" emojis$ $! \ list need to be bigger

: chain-string ( addr u -- addr' u' )
    buckets# #frees
    bounds U+DO
	I $@ [ keysize 2 64s + ]L /string buckets# #!+
    cell +LOOP
    emojis$ $@ bounds DO
	I dup I' over - x-size 2dup buckets# #@
	IF    @ >r tuck type r> .
	ELSE  drop nip  THEN
    +LOOP ;
763 764
: display-title { d: prj | ki -- }
    prj key>o ?dup-IF  .ke-imports @ >im-color# sfloats to ki  THEN
765
    {{
766
	glue*l imports#rgb-bg ki + sf@ slide-frame dup .button1
767
	{{
Bernd Paysan's avatar
Bernd Paysan committed
768
	    prj key| ?avatar
769
	    \large imports#rgb-fg ki + sf@ to x-color
Bernd Paysan's avatar
Bernd Paysan committed
770
	    prj key| ['] .key-id? $tmp }}text 25%b
771
	    glue*ll }}glue
Bernd Paysan's avatar
Bernd Paysan committed
772
	    \small prj drop keysize + le-64@ [: .ticks space ;] $tmp }}text 25%b
Bernd Paysan's avatar
Bernd Paysan committed
773
	    \normal
Bernd Paysan's avatar
Bernd Paysan committed
774
	    prj drop keysize + 8 chain-tags# #@
Bernd Paysan's avatar
Bernd Paysan committed
775
	    ['] chain-string $tmp }}text 25%b blackish
776
	}}h box[]
Bernd Paysan's avatar
Bernd Paysan committed
777
    }}z box[] posting-vp .child+ ;
778 779 780

: display-file { d: prj -- }
    prj display-title
781
    prj [ keysize $10 + ]L safe/string
782
    2dup "file:" string-prefix? IF
783
	0 to v-box
784
	5 /string [: ." ~+/" type ;] $tmp markdown-parse
Bernd Paysan's avatar
Bernd Paysan committed
785
	v-box posting-vp .child+
Bernd Paysan's avatar
Bernd Paysan committed
786 787
	dpy-w @ dpy-h @ > IF  dpy-w @ 50% fm*
	ELSE  dpy-w @ s>f font-size# f2* f-  THEN
788
	p-format
789
    ELSE  2drop  THEN ;
Bernd Paysan's avatar
Bernd Paysan committed
790 791
: display-posting ( addr u -- )
    posting-vp >o dispose-childs  free-thumbs  0 to active-w o>
792
    project:branch$ $@ { d: branch }
Bernd Paysan's avatar
Bernd Paysan committed
793
    dvcs:new-posting-log >o
794
    >group msg-log@ 2dup { log u }
795 796 797
    bounds ?DO
	I $@ msg:display \ this will only set the URLs
    cell +LOOP
Bernd Paysan's avatar
Bernd Paysan committed
798
    glue*lll }}glue posting-vp dup .act 0= IF  vp[]  THEN  .child+
799 800
    log free
    dvcs-log:urls[] ['] display-file $[]map
Bernd Paysan's avatar
Bernd Paysan committed
801
    dvcs:dispose-dvcs-log o> ;
Bernd Paysan's avatar
Bernd Paysan committed
802
: .posting-log ( -- )
803 804
    dvcs:new-dvcs >o  config>dvcs
    project:project$ $@ @/ 2drop 2dup load-msg
Bernd Paysan's avatar
Bernd Paysan committed
805
    display-posting
806
    dvcs:dispose-dvcs o> ;
Bernd Paysan's avatar
Bernd Paysan committed
807
: open-posting { d: prj -- }
808
    >dir "posts" ~net2o-cache/  chat-keys $[]free
Bernd Paysan's avatar
Bernd Paysan committed
809
    ." open " prj .posting cr
Bernd Paysan's avatar
Bernd Paysan committed
810 811 812
    prj 2dup keysize /string [: type '@' emit key| .key-id? ;] $tmp nick>chat
    handle-clone
    prj keysize /string set-dir throw
Bernd Paysan's avatar
Bernd Paysan committed
813 814
    .posting-log next-slide
    posting-vp 0.01e [: >o vp-top box-flags box-touched# invert and to box-flags o>
815
	fdrop +sync +resize ;] >animate
Bernd Paysan's avatar
Bernd Paysan committed
816
    dir> ;
817

818 819
:noname ( -- )
    glue*ll }}glue msg-box .child+
820
    dpy-w @ 90% fm* msg-par .par-split
Bernd Paysan's avatar
Bernd Paysan committed
821 822 823
    {{ msg-par unbox }}
    dup >r 0 ?DO  I pick box[] "unboxed" name! drop  LOOP  r>
    msg-vbox .+childs
824 825 826 827
; wmsg-class is msg:end
0 Value nobody-online-text \ nobody is online warning
:noname 2e nobody-online-text [: f2* sin-t .fade +sync ;] >animate
; wmsg-class is msg:.nobody
Bernd Paysan's avatar
Bernd Paysan committed
828 829 830 831 832
: new-msg-par ( -- )
    {{ }}p "msg-par" name!
    dup .subbox box[] drop box[] cbl >bl
    dup .subbox "msg-box" name!
    to msg-box to msg-par ;
Bernd Paysan's avatar
Bernd Paysan committed
833
:noname { d: pk -- o }
834
    pk [: .simple-id ." : " ;] $tmp notify-nick!
835
    pk key| pkc over str= { me? }
836
    pk enddate@ otr? { otr }
837 838 839 840
    pk key| last-bubble-pk $@ str= otr last-otr? = and
    pk startdate@ last-tick 64over to last-tick
    64- delta-bubble 64< and
    IF
Bernd Paysan's avatar
Bernd Paysan committed
841
	new-msg-par
842
    ELSE
843
	pk startdate@ add-dtms
844
	pk key| last-bubble-pk $!  otr to last-otr?  text-color!
Bernd Paysan's avatar
Bernd Paysan committed
845
	{{
846 847 848 849
	    {{ glue*l }}glue
		{{ \sans \normal
		    {{
			glue*l }}glue
Bernd Paysan's avatar
Bernd Paysan committed
850 851 852 853 854 855 856 857
			0 pk key| ?avatar dup IF  nip
			    pk ['] .key-id $tmp 2drop
			ELSE  drop
			    \bold pk ['] .key-id $tmp }}text 25%b
			    >o imports#rgb-fg last-ki >im-color# sfloats + sf@
			    to text-color  o o>
			THEN
			me? IF  swap  THEN
858 859
			\regular
		    }}h
860 861
		    glue*l imports#rgb-bg last-ki >im-color# sfloats + sf@
		    slide-frame dup .button2
862 863 864 865
		    swap
		}}z me? 0= IF  chatname-tab  THEN
	    }}v
	    {{
Bernd Paysan's avatar
Bernd Paysan committed
866 867
		glue*l last-otr? IF otr-col# ELSE chat-col# THEN
		slide-frame dup me? IF .rbubble ELSE .lbubble THEN
Bernd Paysan's avatar
Bernd Paysan committed
868
		"bubble" name!
869
		{{
Bernd Paysan's avatar
Bernd Paysan committed
870 871 872 873
		    new-msg-par
		}}v box[] dup to msg-vbox "msg-vbox" name!
		me? >bubble-border
	    }}z box[] "msg-zbox" name!
874 875
	    glue*ll }}glue
	    me? IF  swap rot  THEN
Bernd Paysan's avatar
Bernd Paysan committed
876
	}}h box[] "msgs-box" name! msgs-box .child+
Bernd Paysan's avatar
Bernd Paysan committed
877
	blackish
878
    THEN
879
; wmsg-class is msg:start
Bernd Paysan's avatar
Bernd Paysan committed
880
:noname { d: string -- o }
881 882
    link-blue \mono string [: '#' emit type ;] $tmp
    ['] utf8-sanitize $tmp }}text text-color! \sans
Bernd Paysan's avatar
Bernd Paysan committed
883
    msg-box .child+
884
; wmsg-class is msg:tag
Bernd Paysan's avatar
Bernd Paysan committed
885
:noname { d: string -- o }
886 887
    text-color!
    string ['] utf8-sanitize $tmp }}text 25%bv
Bernd Paysan's avatar
Bernd Paysan committed
888
    "text" name! msg-box .child+
889
; wmsg-class is msg:text
Bernd Paysan's avatar
Bernd Paysan committed
890
:noname { d: string -- o }
891 892 893
    \italic last-otr? IF light-blue ELSE dark-blue THEN
    string ['] utf8-sanitize $tmp }}text 25%bv \regular
    text-color!
Bernd Paysan's avatar
Bernd Paysan committed
894
    "action" name! msg-box .child+
895
; wmsg-class is msg:action
Bernd Paysan's avatar
Bernd Paysan committed
896 897
:noname { d: string -- o }
    last-otr? IF light-blue ELSE dark-blue THEN
Bernd Paysan's avatar
Bernd Paysan committed
898
    string ['] utf8-sanitize $tmp }}text _underline_ 25%bv
Bernd Paysan's avatar
Bernd Paysan committed
899
    text-color!
900
    [: data >o text$ o> open-url ;]
Bernd Paysan's avatar
Bernd Paysan committed
901 902 903
    over click[]
    click( ." url: " dup ..parents cr )
    "url" name! msg-box .child+
904
; wmsg-class is msg:url
Bernd Paysan's avatar
Bernd Paysan committed
905
:noname ( d: string -- )
906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921
    0 .v-dec$ dup IF
	msg-key!  msg-group-o .msg:+lock
	{{
	    glue*l lock-color x-color slide-frame dup .button1
	    greenish l" chat is locked" }}text' 25%bv
	}}z
    ELSE  2drop
	{{
	    glue*l lockout-color x-color slide-frame dup .button1
	    show-error-color 1e +to x-color l" locked out of chat" }}text' 25%bv
	}}z
    THEN "lock" name! msg-box .child+ ; wmsg-class is msg:lock
:noname ( -- o )
	{{
	    glue*l lock-color x-color slide-frame dup .button1
	    blackish l" chat is unlocked" }}text' 25%bv
922
	}}z msg-box .child+ ; wmsg-class is msg:unlock
Bernd Paysan's avatar
Bernd Paysan committed
923
:noname { d: string -- o }
Bernd Paysan's avatar
Bernd Paysan committed
924
    {{
Bernd Paysan's avatar
Bernd Paysan committed
925
	glue*l gps-color# slide-frame dup .button1
Bernd Paysan's avatar
Bernd Paysan committed
926
	string [: ."  GPS: " .coords ;] $tmp }}text 25%b
Bernd Paysan's avatar
Bernd Paysan committed
927
    }}z "gps" name! msg-box .child+
928
; wmsg-class is msg:coord
929 930 931 932 933 934 935 936 937 938
:noname { 64^ perm d: pk -- }
    perm [ 1 64s ]L pk msg-group-o .msg:perms# #!
    {{
	glue*l perm-color# slide-frame dup .button1
	{{
	    pk [: '@' emit .key-id ;] $tmp ['] utf8-sanitize $tmp }}text 25%b
	    perm 64@ 64>n ['] .perms $tmp }}text 25%b
	}}h
    }}z msg-box .child+
; wmsg-class is msg:perms
Bernd Paysan's avatar
Bernd Paysan committed
939 940 941 942 943 944
:noname { d: string -- o }
    {{
	glue*l chain-color# slide-frame dup .button1
	string sighash? IF  re-green  ELSE  obj-red  THEN
	string [: ." <" drop le-64@ .ticks ;] $tmp }}text 25%b
    }}z "chain" name! msg-box .child+
945
; wmsg-class is msg:chain
Bernd Paysan's avatar
Bernd Paysan committed
946
:noname { d: pk -- o }
Bernd Paysan's avatar
Bernd Paysan committed
947
    {{
948
	x-color { f: xc }
949 950
	pk key|
	2dup 0 .pk@ key| str=
951 952 953
	last-otr? IF  IF  my-signal-otr  ELSE  other-signal-otr  THEN
	ELSE  IF  my-signal  ELSE  other-signal  THEN  THEN
	x-color glue*l slide-frame dup .button1 40%b >r
Bernd Paysan's avatar
Bernd Paysan committed
954
	black# to x-color
955
	[: '@' emit .key-id ;] $tmp ['] utf8-sanitize $tmp }}text 25%b r> swap
Bernd Paysan's avatar
Bernd Paysan committed
956
	xc to x-color
Bernd Paysan's avatar
Bernd Paysan committed
957
    }}z msg-box .child+
958
; wmsg-class is msg:signal
Bernd Paysan's avatar
Bernd Paysan committed
959
:noname ( addr u -- )
Bernd Paysan's avatar
Bernd Paysan committed
960
    re-green [: ." [" 85type ." ]→" ;] $tmp }}text msg-box .child+
961
    text-color!
962
; wmsg-class is msg:re
Bernd Paysan's avatar
Bernd Paysan committed
963
:noname ( addr u -- )
Bernd Paysan's avatar
Bernd Paysan committed
964
    obj-red [: ." [" 85type ." ]:" ;] $tmp }}text msg-box .child+
965
    text-color!
966
; wmsg-class is msg:id
967 968 969 970 971
:noname { sig u' addr u -- }
    u' 64'+ u =  u sigsize# = and IF
	addr u startdate@ 64dup date>i >r 64#1 64+ date>i' r>
	\ 2dup = IF  ."  [otrified] "  addr u startdate@ .ticks  THEN
	U+DO
972
	    I msg-group-o .msg:log[] $[]@
973 974 975 976 977 978
	    2dup dup sigpksize# - /string key| msg:id$ str= IF
		dup u - /string addr u str= IF
		    I [: ."  [OTRifying] #" u. forth:cr ;] do-debug
		    I [: ."  OTRify #" u. ;] $tmp
		    \italic }}text 25%bv \regular light-blue text-color!
		    "otrify" name! msg-box .child+
979
		    sig u' I msg-group-o .msg:log[] $[]@ replace-sig
980 981 982 983 984 985 986 987 988
		    \ !!Schedule message saving!!
		ELSE
		    I [: ."  [OTRified] #" u. forth:cr ;] do-debug
		THEN
	    ELSE
		I [: ."  [OTRifignore] #" u. forth:cr ;] do-debug
		2drop
	    THEN
	LOOP
989 990 991
    THEN ; wmsg-class is msg:otrify
:noname ( addr u type -- )
    obj-red
992
    [: case 0 >r
993 994 995 996 997
	    msg:image#     of  ." img["      85type  endof
	    msg:thumbnail# of  ." thumb["    85type  endof
	    msg:patch#     of  ." patch["    85type  endof
	    msg:snapshot#  of  ." snapshot[" 85type  endof
	    msg:message#   of  ." message["  85type  endof
Bernd Paysan's avatar
Bernd Paysan committed
998
	    msg:posting#   of  ." posting"
Bernd Paysan's avatar
Bernd Paysan committed
999
		rdrop 2dup [d:h open-posting ;] >r
Bernd Paysan's avatar
Bernd Paysan committed
1000
		.posting
1001
	    endof
1002
	endcase ." ]" r> ;] $tmp }}text
Bernd Paysan's avatar
Bernd Paysan committed
1003 1004
    swap ?dup-IF  0 click[]  THEN
    "object" name! msg-box .child+
1005 1006
    text-color!
; wmsg-class is msg:object
Bernd Paysan's avatar
Bernd Paysan committed
1007

Bernd Paysan's avatar
Bernd Paysan committed
1008 1009 1010 1011
in net2o : new-wmsg ( o:connection -- o )
    o wmsg-class new >o  parent!  msg-table @ token-table ! o o> ;
' net2o:new-wmsg is net2o:new-msg

Bernd Paysan's avatar
Bernd Paysan committed
1012 1013 1014
wmsg-class ' new static-a with-allocater Constant wmsg-o
wmsg-o >o msg-table @ token-table ! o>

1015 1016 1017 1018 1019 1020
: vp-softbottom ( o:viewport -- )
    act >o o anim-del  set-startxy
    0e           to vmotion-dx
    vp-y fnegate to vmotion-dy
    0.333e o ['] vp-scroll >animate o> ;

Bernd Paysan's avatar
Bernd Paysan committed
1021
: wmsg-display ( addr u -- )
Bernd Paysan's avatar
Bernd Paysan committed
1022
    msg-tdisplay
1023 1024
    msgs-box >o [: +sync +resize ;] vp-needed vp-bottom
    +sync +resize o> ;
1025
' wmsg-display wmsg-class is msg:display
Bernd Paysan's avatar
Bernd Paysan committed
1026

Bernd Paysan's avatar
Bernd Paysan committed
1027
#128 Value gui-msgs# \ display last 128 messages
Bernd Paysan's avatar
Bernd Paysan committed
1028
0 Value chat-edit    \ chat edit field
1029
0 Value chat-edit-bg \ chat edit background
Bernd Paysan's avatar
Bernd Paysan committed
1030

1031
: (gui-msgs) ( gaddr u -- )
Bernd Paysan's avatar
Bernd Paysan committed
1032
    reset-time
1033 1034
    64#0 to last-tick  last-bubble-pk $free
    0 to msg-par  0 to msg-box
Bernd Paysan's avatar
Bernd Paysan committed
1035
    msgs-box .dispose-childs
1036
    glue*lll }}glue msgs-box .child+
1037
    2dup load-msg
Bernd Paysan's avatar
Bernd Paysan committed
1038
    msg-log@
Bernd Paysan's avatar
Bernd Paysan committed
1039
    { log u } u gui-msgs# cells - 0 max { u' }  log u' wmsg-o .?search-lock
1040
    log u u' /string bounds ?DO
1041 1042 1043
	I $@ { d: msgt }
	msgt ['] wmsg-display wmsg-o .catch IF
	    <err> ." invalid entry" <default> 2drop
Bernd Paysan's avatar
Bernd Paysan committed
1044 1045
	THEN
    cell +LOOP
Bernd Paysan's avatar
Bernd Paysan committed
1046 1047
    log free throw  msgs-box >o resized vp-bottom o>
    chat-edit engage ;
Bernd Paysan's avatar
Bernd Paysan committed
1048

1049 1050 1051
: gui-msgs ( gaddr u -- )
    2dup msg-group$ $! (gui-msgs) ;

Bernd Paysan's avatar
Bernd Paysan committed
1052
: msg-wredisplay ( n -- )
1053
    drop 0 msg-group-o .msg:mode
1054
    [: msg-group$ $@ (gui-msgs) ;] !wrapper
1055 1056
    msgs-box >o [: +sync +resize ;] vp-needed vp-bottom
    +sync +resize o>  ;
Bernd Paysan's avatar
Bernd Paysan committed
1057 1058
' msg-wredisplay wmsg-class is msg:redisplay

Bernd Paysan's avatar
Bernd Paysan committed
1059 1060
[IFDEF] android also android [THEN]

1061 1062 1063 1064 1065 1066 1067
: ?chat-otr-status ( o:edit-w -- )
    msg-group-o .msg:?otr
    IF   otr-col#  [ greenish x-color ] Fliteral
    ELSE chat-col# [ blackish x-color ] Fliteral  THEN
    chat-edit    >o to w-color o>
    chat-edit-bg >o to w-color o> ;

Bernd Paysan's avatar
Bernd Paysan committed
1068
: chat-edit-enter ( o:edit-w -- )
1069 1070
    text$ dup IF  do-chat-cmd? 0= IF  avalanche-text
	ELSE  ?chat-otr-status  THEN
Bernd Paysan's avatar
Bernd Paysan committed
1071 1072
    ELSE  2drop  THEN
    64#-1 line-date 64!  $lastline $free ;
Bernd Paysan's avatar
Bernd Paysan committed
1073

Bernd Paysan's avatar
Bernd Paysan committed
1074
\ +db click( \ )
Bernd Paysan's avatar
Bernd Paysan committed
1075
\ +db click-o( \ )
1076
\ +db gui( \ )
Bernd Paysan's avatar
Bernd Paysan committed
1077

Bernd Paysan's avatar
Bernd Paysan committed
1078
{{ chat-bg-col# pres-frame
Bernd Paysan's avatar
Bernd Paysan committed
1079
    {{
1080
	{{
Bernd Paysan's avatar
Bernd Paysan committed
1081
	    glue*l black# slide-frame dup .button1
Bernd Paysan's avatar
Bernd Paysan committed
1082
	    {{
Bernd Paysan's avatar
Bernd Paysan committed
1083
		\large realwhite
1084 1085
		"" }}text 40%b [: in-group? 0= ?EXIT  false to in-group?
		    leave-chats prev-slide ;] over click[]
Bernd Paysan's avatar
Bernd Paysan committed
1086
		!i18n l" " }}text' !lit 40%b
Bernd Paysan's avatar
Bernd Paysan committed
1087
		"" }}text 40%b dup to group-name
Bernd Paysan's avatar
Bernd Paysan committed
1088 1089
		{{
		}}h box[] dup to group-members
Bernd Paysan's avatar
Bernd Paysan committed
1090
		glue*l }}glue
Bernd Paysan's avatar
Bernd Paysan committed
1091 1092
	    }}h box[]
	}}z box[]
Bernd Paysan's avatar
Bernd Paysan committed
1093 1094