gui.fs 33.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 ;
Bernd Paysan's avatar
Bernd Paysan committed
30
: update-size# ( -- )
Bernd Paysan's avatar
Bernd Paysan committed
31
    screen-pwh max s>f
Bernd Paysan's avatar
Bernd Paysan committed
32
    default-diag screen-diag f/ fsqrt default-scale f* 1/f #64 fm*
Bernd Paysan's avatar
Bernd Paysan committed
33
    f/ fround to font-size#
Bernd Paysan's avatar
Bernd Paysan committed
34
    font-size# 133% f* fround to baseline#
35
    font-size# 32e f/ to pixelsize# ;
Bernd Paysan's avatar
Bernd Paysan committed
36 37 38 39

update-size#

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

Bernd Paysan's avatar
Bernd Paysan committed
42 43
glue new Constant glue-sleft
glue new Constant glue-sright
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
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
69
	dup 1- swap !slides +sync +resize  EXIT
70
    THEN
71
    1e fswap f- 1- sin-t anim!slides +sync +resize ;
72 73 74 75

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

Bernd Paysan's avatar
Bernd Paysan committed
80
0.4e FValue slide-time%
81 82

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

89
\ frames
Bernd Paysan's avatar
Bernd Paysan committed
90

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

\ password screen

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

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

: 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
116
    glue-sleft  >o 0g fdup hglue-c glue! o>
117
    glue-sright >o 0g fdup hglue-c glue! o> +sync +resize drop ;
Bernd Paysan's avatar
Bernd Paysan committed
118

119 120
0e 0 shake-lr

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

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

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

138 139 140
Variable nick$

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

: 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 ;
162

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

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

200 201
\ password frame

Bernd Paysan's avatar
Bernd Paysan committed
202 203
tex: net2o-logo

Bernd Paysan's avatar
Bernd Paysan committed
204 205 206 207 208 209 210 211 212 213 214 215 216
$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#
217

218 219 220 221
: 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> ;
222 223 224 225
: size-limit ( -- )
    edit-w .text$ nip #800 u> IF
	prev-text$ edit-w >o to text$ o>
    THEN ;
226

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

230 231 232
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
233 234 235 236
' dark-blue >body f@

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

Bernd Paysan's avatar
Bernd Paysan committed
350
' dark-blue >body f!
351

352 353 354
\ id frame

0 Value mykey-box
355
0 Value groups-box
356
0 Value nicks-box
Bernd Paysan's avatar
Bernd Paysan committed
357
0 Value msgs-box
Bernd Paysan's avatar
Bernd Paysan committed
358
0 Value msg-box
359
0 Value msg-par
360
0 Value msg-vbox
361

Bernd Paysan's avatar
Bernd Paysan committed
362
0 Value group-name
Bernd Paysan's avatar
Bernd Paysan committed
363
0 Value group-members
Bernd Paysan's avatar
Bernd Paysan committed
364

Bernd Paysan's avatar
Bernd Paysan committed
365 366 367 368
new-htab tab-glue: name-tab
new-htab tab-glue: pk-tab
new-htab tab-glue: group-tab
new-htab tab-glue: chatname-tab
369

Bernd Paysan's avatar
Bernd Paysan committed
370 371 372 373 374 375 376
[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
377 378 379 380 381 382 383 384
$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
385
Create imports#rgb-fg
Bernd Paysan's avatar
Bernd Paysan committed
386 387 388 389 390 391 392 393
$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
394

Bernd Paysan's avatar
Bernd Paysan committed
395 396
\ more colors

Bernd Paysan's avatar
Bernd Paysan committed
397 398 399 400
$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
401 402 403 404 405
$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
406 407
$33883366 new-color: day-color
$88333366 new-color: hour-color
Bernd Paysan's avatar
Bernd Paysan committed
408
$FFFFFFFF text-color: realwhite
Bernd Paysan's avatar
Bernd Paysan committed
409 410
$FFFFFFFF new-color: edit-bg
$80FF80FF new-color: send-color
Bernd Paysan's avatar
Bernd Paysan committed
411 412
$00FF0020 new-color: pet-color
$FFFF80FF new-color, fvalue users-color#
Bernd Paysan's avatar
Bernd Paysan committed
413

414 415 416
: nick[] ( box o:nick -- box )
    [: data >o ." clicked on " ke-nick $. cr o> ;] o click[] ;

Bernd Paysan's avatar
Bernd Paysan committed
417 418 419 420 421
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>

422
: read-avatar ( addr u -- addr' u' )
423
    ?read-enc-hashed mem>thumb atlas-region ;
Bernd Paysan's avatar
Bernd Paysan committed
424 425
: show-avatar ( addr u -- o )
    2dup avatar# #@ nip 0= IF
426
	2dup read-avatar 2swap avatar# #!
Bernd Paysan's avatar
Bernd Paysan committed
427
    ELSE  2drop  THEN
Bernd Paysan's avatar
Bernd Paysan committed
428
    glue*avatar last# cell+ $@ drop }}thumb
Bernd Paysan's avatar
Bernd Paysan committed
429 430
    >r {{ r> }}v 40%b ;

431 432 433 434 435 436
: 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
437 438 439 440 441 442 443
: ?avatar ( addr u -- o / )
    key# #@ IF
	cell+ .ke-avatar $@ dup IF
	    show-avatar
	ELSE  2drop  THEN
    ELSE  drop  THEN ;

444
: show-nick ( o:key -- )
Bernd Paysan's avatar
Bernd Paysan committed
445
    ke-imports @ [ 1 import#provisional lshift ]L and ?EXIT
446 447
    ke-imports @ >im-color# sfloats { ki }
    {{ glue*l imports#rgb-bg ki + sf@ slide-frame dup .button1
Bernd Paysan's avatar
Bernd Paysan committed
448
	{{
449
	    {{ \large imports#rgb-fg ki + sf@ to x-color
Bernd Paysan's avatar
Bernd Paysan committed
450
		ke-avatar $@ dup IF  show-avatar  ELSE  2drop  THEN
Bernd Paysan's avatar
Bernd Paysan committed
451 452 453
		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
454 455
		    {{
			x-color glue*l pet-color x-color slide-frame dup .button3 to x-color
Bernd Paysan's avatar
Bernd Paysan committed
456 457 458 459 460 461 462 463 464 465
			['] .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
466
    mykey-box nicks-box ke-sk sec@ nip select /flop .child+ ;
467 468 469 470 471

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

474
: refresh-top ( -- )
Bernd Paysan's avatar
Bernd Paysan committed
475
    +sync +lang
Bernd Paysan's avatar
Bernd Paysan committed
476 477
    top-widget >o htop-resize  <draw-init draw-init draw-init> htop-resize
    false to grab-move? o> ;
478

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

Bernd Paysan's avatar
Bernd Paysan committed
481
: gui-chat-connects ( -- )
482
    [: up@ wait-task ! ;] IS do-connect
483
    [: chat-keys [:
484 485 486 487
	    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
488

489 490 491
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
492

493 494
false Value in-group?

495
: group[] ( box group -- box )
496 497
    [:  in-group? ?EXIT  true to in-group?
	data $@ group-name >o to text$ o>
Bernd Paysan's avatar
Bernd Paysan committed
498
	data cell+ $@ drop cell+ >o groups:id$ groups:member[] o>
499
	[: chat-keys $+[]! ;] $[]map
500 501
	gui-msgs  <event :>chat-connects ?query-task event>
	next-slide
Bernd Paysan's avatar
Bernd Paysan committed
502
    ;] swap click[] ;
503

504
: show-group ( last# -- )
505
    dup { g -- } cell+ $@ drop cell+ >o
Bernd Paysan's avatar
Bernd Paysan committed
506
    {{ glue*l chat-bg-col# slide-frame dup .button1
Bernd Paysan's avatar
Bernd Paysan committed
507 508 509 510 511 512 513 514 515 516 517 518
	{{
	    {{ \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
519
    }}z g group[] o>
Bernd Paysan's avatar
Bernd Paysan committed
520
    groups-box /flop .child+ ;
521

Bernd Paysan's avatar
Bernd Paysan committed
522
: fill-groups ( -- )
523 524 525 526
    groups>sort[]
    group-list[] $@ bounds ?DO
	I @ show-group
    cell +LOOP ;
Bernd Paysan's avatar
Bernd Paysan committed
527

Bernd Paysan's avatar
Bernd Paysan committed
528 529 530 531
also [ifdef] android android [then]

tex: vp-title

Bernd Paysan's avatar
Bernd Paysan committed
532 533
$F110 Constant 'spinner'
$F012 Constant 'signal'
534 535 536
$F234 Constant 'user-plus'
$F503 Constant 'user-minus'
$F235 Constant 'user-times'
Bernd Paysan's avatar
Bernd Paysan committed
537 538 539 540 541 542 543 544 545 546

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
547
: nicks-title ( -- )
Bernd Paysan's avatar
Bernd Paysan committed
548
    {{ glue*l black# slide-frame dup .button1
Bernd Paysan's avatar
Bernd Paysan committed
549 550
	{{
	    {{
Bernd Paysan's avatar
Bernd Paysan committed
551
		{{
Bernd Paysan's avatar
Bernd Paysan committed
552
		    {{ \large \bold \sans realwhite
Bernd Paysan's avatar
Bernd Paysan committed
553 554 555 556 557 558 559 560
		    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
561 562
	}}h box[]
    }}z box[] ;
Bernd Paysan's avatar
Bernd Paysan committed
563

Bernd Paysan's avatar
Bernd Paysan committed
564 565
previous

Bernd Paysan's avatar
Bernd Paysan committed
566
{{ users-color# pres-frame
Bernd Paysan's avatar
Bernd Paysan committed
567
    {{
568 569 570
	{{
	    nicks-title
	    glue*shrink }}glue
Bernd Paysan's avatar
Bernd Paysan committed
571 572 573
	    \Large
	    s" ❌" $444444FF new-color, }}button-lit /hfix [: -1 data +! ;]
	    [IFDEF] android android:level# [ELSE] level# [THEN] click[]
574
	}}h box[] /vfix
Bernd Paysan's avatar
Bernd Paysan committed
575 576
	{{
	    {{
Bernd Paysan's avatar
Bernd Paysan committed
577
		{{ glue*l $303000FF new-color, bar-frame
Bernd Paysan's avatar
Bernd Paysan committed
578 579
		{{ \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
580
		{{ glue*l $300030FF new-color, bar-frame
Bernd Paysan's avatar
Bernd Paysan committed
581
		{{ \script l" My groups" }}i18n-text 25%b glue*l }}glue }}h }}z
582
		{{ }}v box[] dup to groups-box /vflip
Bernd Paysan's avatar
Bernd Paysan committed
583
		{{ glue*l $003030FF new-color, bar-frame
Bernd Paysan's avatar
Bernd Paysan committed
584
		{{ \script l" My peers" }}i18n-text 25%b glue*l }}glue }}h }}z
585
		{{ }}v box[] dup to nicks-box /vflip
Bernd Paysan's avatar
Bernd Paysan committed
586
		glue*lll }}glue
587
	    tex: vp-nicks vp-nicks glue*lll ' vp-nicks }}vp vp[] dup value peers-box
Bernd Paysan's avatar
Bernd Paysan committed
588 589
	    $444444FF new-color, to slider-color
	    $CCCCCCFF new-color, to slider-fgcolor
Bernd Paysan's avatar
Bernd Paysan committed
590 591 592
	    font-size# 33% f* to slider-border
	dup font-size# 66% f* fdup vslider }}h box[]
    }}v box[]
593
}}z box[] to id-frame
594 595

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

Bernd Paysan's avatar
Bernd Paysan committed
600 601 602 603 604
\ messages

msg-class class
end-class wmsg-class

605
Variable last-bubble-pk
606
0 Value last-otr?
607
0 Value last-bubble
608 609
64#0 64Value last-tick
#300 #1000000000 um* d>64 64Constant delta-bubble
610

611 612 613
: >bubble-border ( o me? -- )
    swap >o font-size# 25% f*
    IF
614 615 616 617 618 619
	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> ;
620
: add-dtms ( ticks -- )
Bernd Paysan's avatar
Bernd Paysan committed
621
    \small blackish
622 623
    1n fm* >day { day } day last-day <> IF
	{{
624 625 626
	    x-color { f: xc }
	    glue*l day-color x-color slide-frame dup .button1
	    xc to x-color
627 628 629 630 631 632 633
	    \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
	{{
634 635 636
	    x-color { f: xc }
	    glue*l hour-color x-color slide-frame dup .button1
	    xc to x-color
637 638 639 640 641
	    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 ;
642

643 644 645 646
: otr? ( tick -- flag )
    64dup 64#-1 64<> ;
: text-color! ( -- ) last-otr? IF  greenish  ELSE  blackish  THEN ;

647 648 649 650 651 652 653 654 655 656 657 658 659
[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
660
: .posting ( addr u -- )
661 662 663 664
    2dup keysize /string
    2dup printable? IF  '[' emit type '@' emit
    ELSE  ." #["  85type ." /@"  THEN
    key| .key-id? ;
665

Bernd Paysan's avatar
Bernd Paysan committed
666 667
hash: chain-tags#

668 669
scope{ dvcs
dvcs-log-class class
Bernd Paysan's avatar
Bernd Paysan committed
670
end-class posting-log-class
671

Bernd Paysan's avatar
Bernd Paysan committed
672 673
Variable like-char

674 675
:noname ( addr u -- )
    + sigpksize# - [ keysize $10 + ]L dvcs-log:id$ $!
Bernd Paysan's avatar
Bernd Paysan committed
676
    like-char off
Bernd Paysan's avatar
Bernd Paysan committed
677 678 679 680 681 682
; 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
683 684 685 686 687 688 689 690 691 692
: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
693
; posting-log-class is msg:chain
694 695
:noname ( addr u -- )
    [: dvcs-log:id$ $. forth:type ;] dvcs-log:urls[] dup $[]# swap $[] $exec
Bernd Paysan's avatar
Bernd Paysan committed
696
; posting-log-class is msg:url
697

Bernd Paysan's avatar
Bernd Paysan committed
698 699
: new-posting-log ( -- o )
    posting-log-class new >o msg-table @ token-table ! o o> ;
700 701
}scope

Bernd Paysan's avatar
Bernd Paysan committed
702
0 Value posting-vp
703 704

{{
Bernd Paysan's avatar
Bernd Paysan committed
705
    posting-bg-col# pres-frame
706
    {{
707
	{{
Bernd Paysan's avatar
Bernd Paysan committed
708
	    glue*l $000000FF new-color, slide-frame dup .button1
709
	    {{
Bernd Paysan's avatar
Bernd Paysan committed
710
		\large realwhite
711 712 713 714 715 716 717 718 719
		"⬅" }}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
720 721
	    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>
722
	dup font-size# 66% f* fdup vslider }}h box[]
Bernd Paysan's avatar
Bernd Paysan committed
723
	>o "posting-slider" to name$ o o>
724
    }}v box[]
Bernd Paysan's avatar
Bernd Paysan committed
725
    >o "posting-vbox" to name$ o o>
726
}}z box[]
Bernd Paysan's avatar
Bernd Paysan committed
727
>o "posting-zbox" to name$ o o>
728
to post-frame
729

Bernd Paysan's avatar
Bernd Paysan committed
730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751
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 ;
752 753
: display-title { d: prj | ki -- }
    prj key>o ?dup-IF  .ke-imports @ >im-color# sfloats to ki  THEN
754
    {{
755
	glue*l imports#rgb-bg ki + sf@ slide-frame dup .button1
756
	{{
Bernd Paysan's avatar
Bernd Paysan committed
757
	    prj key| ?avatar
758
	    \large imports#rgb-fg ki + sf@ to x-color
Bernd Paysan's avatar
Bernd Paysan committed
759
	    prj key| ['] .key-id? $tmp }}text 25%b
760
	    glue*ll }}glue
Bernd Paysan's avatar
Bernd Paysan committed
761
	    \small prj drop keysize + le-64@ [: .ticks space ;] $tmp }}text 25%b
Bernd Paysan's avatar
Bernd Paysan committed
762
	    \normal
Bernd Paysan's avatar
Bernd Paysan committed
763
	    prj drop keysize + 8 chain-tags# #@
Bernd Paysan's avatar
Bernd Paysan committed
764
	    ['] chain-string $tmp }}text 25%b blackish
765
	}}h box[]
Bernd Paysan's avatar
Bernd Paysan committed
766
    }}z box[] posting-vp .child+ ;
767 768 769

: display-file { d: prj -- }
    prj display-title
770
    prj [ keysize $10 + ]L safe/string
771
    2dup "file:" string-prefix? IF
772
	0 to v-box
773
	5 /string [: ." ~+/" type ;] $tmp markdown-parse
Bernd Paysan's avatar
Bernd Paysan committed
774
	v-box posting-vp .child+
Bernd Paysan's avatar
Bernd Paysan committed
775 776
	dpy-w @ dpy-h @ > IF  dpy-w @ 50% fm*
	ELSE  dpy-w @ s>f font-size# f2* f-  THEN
777
	p-format
778
    ELSE  2drop  THEN ;
Bernd Paysan's avatar
Bernd Paysan committed
779 780
: display-posting ( addr u -- )
    posting-vp >o dispose-childs  free-thumbs  0 to active-w o>
781
    project:branch$ $@ { d: branch }
Bernd Paysan's avatar
Bernd Paysan committed
782
    dvcs:new-posting-log >o
783 784 785 786
    ?msg-log  last# msg-log@ 2dup { log u }
    bounds ?DO
	I $@ msg:display \ this will only set the URLs
    cell +LOOP
Bernd Paysan's avatar
Bernd Paysan committed
787
    glue*lll }}glue posting-vp dup .act 0= IF  vp[]  THEN  .child+
788 789
    log free
    dvcs-log:urls[] ['] display-file $[]map
Bernd Paysan's avatar
Bernd Paysan committed
790
    dvcs:dispose-dvcs-log o> ;
Bernd Paysan's avatar
Bernd Paysan committed
791
: .posting-log ( -- )
792 793
    dvcs:new-dvcs >o  config>dvcs
    project:project$ $@ @/ 2drop 2dup load-msg
Bernd Paysan's avatar
Bernd Paysan committed
794
    display-posting
795
    dvcs:dispose-dvcs o> ;
Bernd Paysan's avatar
Bernd Paysan committed
796 797 798
: open-posting { d: prj -- }
    >dir "posts" ~net2o-cache/
    ." open " prj .posting cr
Bernd Paysan's avatar
Bernd Paysan committed
799 800 801
    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
802 803
    .posting-log next-slide
    posting-vp 0.01e [: >o vp-top box-flags box-touched# invert and to box-flags o>
804
	fdrop +sync +resize ;] >animate
Bernd Paysan's avatar
Bernd Paysan committed
805
    dir> ;
806

807 808
:noname ( -- )
    glue*ll }}glue msg-box .child+
809
    dpy-w @ 90% fm* msg-par .par-split
Bernd Paysan's avatar
Bernd Paysan committed
810 811 812
    {{ msg-par unbox }}
    dup >r 0 ?DO  I pick box[] "unboxed" name! drop  LOOP  r>
    msg-vbox .+childs
813
; wmsg-class to msg:end
Bernd Paysan's avatar
Bernd Paysan committed
814 815 816 817 818
: 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
819
:noname { d: pk -- o }
820
    pk [: .simple-id ." : " ;] $tmp notify-nick!
821
    pk key| pkc over str= { me? }
822
    pk enddate@ otr? { otr }
823 824 825 826
    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
827
	new-msg-par
828
    ELSE
829
	pk startdate@ add-dtms
830
	pk key| last-bubble-pk $!  otr to last-otr?  text-color!
Bernd Paysan's avatar
Bernd Paysan committed
831
	{{
832 833 834 835
	    {{ glue*l }}glue
		{{ \sans \normal
		    {{
			glue*l }}glue
Bernd Paysan's avatar
Bernd Paysan committed
836 837 838 839 840 841 842 843
			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
844 845
			\regular
		    }}h
846 847
		    glue*l imports#rgb-bg last-ki >im-color# sfloats + sf@
		    slide-frame dup .button2
848 849 850 851
		    swap
		}}z me? 0= IF  chatname-tab  THEN
	    }}v
	    {{
Bernd Paysan's avatar
Bernd Paysan committed
852 853
		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
854
		"bubble" name!
855
		{{
Bernd Paysan's avatar
Bernd Paysan committed
856 857 858 859
		    new-msg-par
		}}v box[] dup to msg-vbox "msg-vbox" name!
		me? >bubble-border
	    }}z box[] "msg-zbox" name!
860 861
	    glue*ll }}glue
	    me? IF  swap rot  THEN
Bernd Paysan's avatar
Bernd Paysan committed
862
	}}h box[] "msgs-box" name! msgs-box .child+
Bernd Paysan's avatar
Bernd Paysan committed
863
	blackish
864
    THEN
Bernd Paysan's avatar
Bernd Paysan committed
865 866
; wmsg-class to msg:start
:noname { d: string -- o }
867 868
    link-blue \mono string [: '#' emit type ;] $tmp
    ['] utf8-sanitize $tmp }}text text-color! \sans
Bernd Paysan's avatar
Bernd Paysan committed
869
    msg-box .child+
Bernd Paysan's avatar
Bernd Paysan committed
870
; wmsg-class to msg:tag
Bernd Paysan's avatar
Bernd Paysan committed
871
:noname { d: string -- o }
872 873
    text-color!
    string ['] utf8-sanitize $tmp }}text 25%bv
Bernd Paysan's avatar
Bernd Paysan committed
874
    "text" name! msg-box .child+
Bernd Paysan's avatar
Bernd Paysan committed
875
; wmsg-class to msg:text
Bernd Paysan's avatar
Bernd Paysan committed
876
:noname { d: string -- o }
877 878 879
    \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
880
    "action" name! msg-box .child+
Bernd Paysan's avatar
Bernd Paysan committed
881
; wmsg-class to msg:action
Bernd Paysan's avatar
Bernd Paysan committed
882 883
:noname { d: string -- o }
    last-otr? IF light-blue ELSE dark-blue THEN
Bernd Paysan's avatar
Bernd Paysan committed
884
    string ['] utf8-sanitize $tmp }}text _underline_ 25%bv
Bernd Paysan's avatar
Bernd Paysan committed
885
    text-color!
886
    [: data >o text$ o> open-url ;]
Bernd Paysan's avatar
Bernd Paysan committed
887 888 889 890
    over click[]
    click( ." url: " dup ..parents cr )
    "url" name! msg-box .child+
; wmsg-class to msg:url
Bernd Paysan's avatar
Bernd Paysan committed
891
:noname { d: string -- o }
Bernd Paysan's avatar
Bernd Paysan committed
892
    {{
Bernd Paysan's avatar
Bernd Paysan committed
893
	glue*l $FFCCCCFF new-color, slide-frame dup .button1
Bernd Paysan's avatar
Bernd Paysan committed
894
	string [: ."  GPS: " .coords ;] $tmp }}text 25%b
Bernd Paysan's avatar
Bernd Paysan committed
895
    }}z "gps" name! msg-box .child+
Bernd Paysan's avatar
Bernd Paysan committed
896 897
; wmsg-class to msg:coord
:noname { d: pk -- o }
Bernd Paysan's avatar
Bernd Paysan committed
898
    {{
899
	x-color { f: xc }
900 901
	pk key|
	2dup 0 .pk@ key| str=
902 903 904
	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
905
	black# to x-color
906
	[: '@' emit .key-id ;] $tmp ['] utf8-sanitize $tmp }}text 25%b r> swap
Bernd Paysan's avatar
Bernd Paysan committed
907
	xc to x-color
Bernd Paysan's avatar
Bernd Paysan committed
908
    }}z msg-box .child+
Bernd Paysan's avatar
Bernd Paysan committed
909 910
; wmsg-class to msg:signal
:noname ( addr u -- )
Bernd Paysan's avatar
Bernd Paysan committed
911
    re-green [: ." [" 85type ." ]→" ;] $tmp }}text msg-box .child+
912
    text-color!
913
; wmsg-class to msg:re
Bernd Paysan's avatar
Bernd Paysan committed
914
:noname ( addr u -- )
Bernd Paysan's avatar
Bernd Paysan committed
915
    obj-red [: ." [" 85type ." ]:" ;] $tmp }}text msg-box .child+
916
    text-color!
917
; wmsg-class to msg:id
918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941
:noname { sig u' addr u -- }
    u' 64'+ u =  u sigsize# = and IF
	last# >r last# $@ ?msg-log
	addr u startdate@ 64dup date>i >r 64#1 64+ date>i' r>
	\ 2dup = IF  ."  [otrified] "  addr u startdate@ .ticks  THEN
	U+DO
	    I last# cell+ $[]@
	    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+
		    sig u' I last# cell+ $[]@ replace-sig
		    \ !!Schedule message saving!!
		ELSE
		    I [: ."  [OTRified] #" u. forth:cr ;] do-debug
		THEN
	    ELSE
		I [: ."  [OTRifignore] #" u. forth:cr ;] do-debug
		2drop
	    THEN
	LOOP
	r> to last#
942 943 944
    THEN ; wmsg-class is msg:otrify
:noname ( addr u type -- )
    obj-red
945
    [: case 0 >r
946 947 948 949 950
	    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
951
	    msg:posting#   of  ." posting"
Bernd Paysan's avatar
Bernd Paysan committed
952
		rdrop 2dup [d:h open-posting ;] >r
Bernd Paysan's avatar
Bernd Paysan committed
953
		.posting
954
	    endof
955
	endcase ." ]" r> ;] $tmp }}text
Bernd Paysan's avatar
Bernd Paysan committed
956 957
    swap ?dup-IF  0 click[]  THEN
    "object" name! msg-box .child+
958 959
    text-color!
; wmsg-class is msg:object
Bernd Paysan's avatar
Bernd Paysan committed
960

Bernd Paysan's avatar
Bernd Paysan committed
961 962 963 964
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
965 966 967
wmsg-class ' new static-a with-allocater Constant wmsg-o
wmsg-o >o msg-table @ token-table ! o>

968 969 970 971 972 973
: 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
974
: wmsg-display ( addr u -- )
Bernd Paysan's avatar
Bernd Paysan committed
975
    msg-tdisplay
976 977
    msgs-box >o [: +sync +resize ;] vp-needed vp-bottom
    +sync +resize o> ;
Bernd Paysan's avatar
Bernd Paysan committed
978
' wmsg-display wmsg-class to msg:display
Bernd Paysan's avatar
Bernd Paysan committed
979

Bernd Paysan's avatar
Bernd Paysan committed
980
#128 Value gui-msgs# \ display last 128 messages
Bernd Paysan's avatar
Bernd Paysan committed
981
0 Value chat-edit    \ chat edit field
Bernd Paysan's avatar
Bernd Paysan committed
982

983
: (gui-msgs) ( gaddr u -- )
Bernd Paysan's avatar
Bernd Paysan committed
984
    reset-time
985 986
    64#0 to last-tick  last-bubble-pk $free
    0 to msg-par  0 to msg-box
Bernd Paysan's avatar
Bernd Paysan committed
987
    msgs-box .dispose-childs
988
    glue*lll }}glue msgs-box .child+
989
    2dup load-msg ?msg-log
990
    last# msg-log@ 2dup { log u }
Bernd Paysan's avatar
Bernd Paysan committed
991
    dup gui-msgs# cells - 0 max /string bounds ?DO
992 993 994
	I $@ { d: msgt }
	msgt ['] wmsg-display wmsg-o .catch IF
	    <err> ." invalid entry" <default> 2drop
Bernd Paysan's avatar
Bernd Paysan committed
995 996
	THEN
    cell +LOOP
Bernd Paysan's avatar
Bernd Paysan committed
997 998
    log free throw  msgs-box >o resized vp-bottom o>
    chat-edit engage ;
Bernd Paysan's avatar
Bernd Paysan committed
999

1000 1001 1002
: gui-msgs ( gaddr u -- )
    2dup msg-group$ $! (gui-msgs) ;

Bernd Paysan's avatar
Bernd Paysan committed
1003 1004
: msg-wredisplay ( n -- )
    drop 0 otr-mode
1005
    [: msg-group$ $@ (gui-msgs) ;] !wrapper
1006 1007
    msgs-box >o [: +sync +resize ;] vp-needed vp-bottom
    +sync +resize o>  ;
Bernd Paysan's avatar
Bernd Paysan committed
1008 1009
' msg-wredisplay wmsg-class is msg:redisplay

Bernd Paysan's avatar
Bernd Paysan committed
1010 1011
[IFDEF] android also android [THEN]

Bernd Paysan's avatar
Bernd Paysan committed
1012
: chat-edit-enter ( o:edit-w -- )
Bernd Paysan's avatar
Bernd Paysan committed
1013 1014 1015
    text$ dup IF  do-chat-cmd? 0= IF  avalanche-text  THEN
    ELSE  2drop  THEN
    64#-1 line-date 64!  $lastline $free ;
Bernd Paysan's avatar
Bernd Paysan committed
1016

Bernd Paysan's avatar
Bernd Paysan committed
1017
\ +db click( \ )
Bernd Paysan's avatar
Bernd Paysan committed
1018
\ +db click-o( \ )
1019
\ +db gui( \ )
Bernd Paysan's avatar
Bernd Paysan committed
1020

Bernd Paysan's avatar
Bernd Paysan committed
1021
{{ chat-bg-col# pres-frame
Bernd Paysan's avatar
Bernd Paysan committed
1022
    {{
1023
	{{
Bernd Paysan's avatar
Bernd Paysan committed
1024
	    glue*l black# slide-frame dup .button1
Bernd Paysan's avatar
Bernd Paysan committed
1025
	    {{
Bernd Paysan's avatar
Bernd Paysan committed
1026
		\large realwhite
1027 1028
		"" }}text 40%b [: in-group? 0= ?EXIT  false to in-group?
		    leave-chats prev-slide ;] over click[]
Bernd Paysan's avatar
Bernd Paysan committed
1029
		!i18n l" " }}text' !lit 40%b
Bernd Paysan's avatar
Bernd Paysan committed
1030
		"" }}text 40%b dup to group-name
Bernd Paysan's avatar
Bernd Paysan committed
1031 1032
		{{
		}}h box[] dup to group-members
Bernd Paysan's avatar
Bernd Paysan committed
1033
		glue*l }}glue
Bernd Paysan's avatar
Bernd Paysan committed
1034 1035
	    }}h box[]
	}}z box[]
Bernd Paysan's avatar
Bernd Paysan committed
1036 1037 1038
	{{
	    {{
		{{
1039
		tex: vp-chats vp-chats glue*lll ' vp-chats }}vp vp[]
1040
		dup to msgs-box
1041
		dup font-size# 66% f* fdup vslider
Bernd Paysan's avatar
Bernd Paysan committed
1042
	    over >r }}h box[] r>
1043
	    font-size# 66% f* fdup hslider
1044
	}}v box[]
Bernd Paysan's avatar
Bernd Paysan committed
1045
	{{
Bernd Paysan's avatar
Bernd Paysan committed
1046
	    {{ glue*lll edit-bg x-color font-size# 40% f* }}frame dup .button3
Bernd Paysan's avatar
Bernd Paysan committed
1047
		{{ \normal \regular blackish "" }}edit 40%b dup to chat-edit glue*l }}glue
Bernd Paysan's avatar
Bernd Paysan committed
1048 1049
		    glue*lll }}glue
		}}h box[]
1050
	    }}z chat-edit [: edit-w .chat-edit-enter drop nip 0 tuck false ;] edit[] ' size-limit filter[]
Bernd Paysan's avatar
Bernd Paysan committed
1051 1052
	    >o act >o [: connection .chat-next-line ;] is edit-next-line o> o o>
	    >o act >o [: connection .chat-prev-line ;] is edit-prev-line o> o o>
Bernd Paysan's avatar
Bernd Paysan committed
1053
	    {{
Bernd Paysan's avatar
Bernd Paysan committed
1054 1055
		glue*l send-color x-color font-size# 40% f* }}frame dup .button2
		blackish !i18n l" Send" }}text' !lit 40%b
Bernd Paysan's avatar
Bernd Paysan committed
1056 1057
		[: data >o chat-edit-enter "" to text$ o>
		    chat-edit engage ;] chat-edit click[]
Bernd Paysan's avatar
Bernd Paysan committed
1058 1059 1060
	    }}z box[]
	}}h box[]
    }}v box[]
Bernd Paysan's avatar
Bernd Paysan committed
1061 1062
}}z box[] to chat-frame

Bernd Paysan's avatar
Bernd Paysan committed
1063 1064
[IFDEF] android previous [THEN]

1065 1066
\ top box

Bernd Paysan's avatar
Bernd Paysan committed
1067 1068 1069 1070 1071
box-actor class
end-class net2o-actor

:noname ( ekey -- )
    case
1072
	k-f5 of  color-theme 0=  IF  anim-end 0.25e o
Bernd Paysan's avatar
Bernd Paysan committed
1073
		[:             fdup f>s to color-theme 0.5e f+ ColorMode! +sync +vpsync ;]
1074 1075 1076
		>animate  THEN   endof
	k-f6 of  color-theme 0<> IF  anim-end 0.25e o
		[: 1e fswap f- fdup f>s to color-theme 0.5e f+ ColorMode! +sync +vpsync ;]
Bernd Paysan's avatar
Bernd Paysan committed
1077 1078 1079 1080 1081 1082 1083
		>animate  THEN   endof
	[ box-actor :: ekeyed ]  EXIT
    endcase ; net2o-actor to ekeyed

: net2o[] ( o -- o )
    >o net2o-actor new !act o o> ;

1084 1085 1086 1087 1088 1089 1090 1091 1092
0 Value invitations
0 Value invitations-list
0 Value invitations-notify
Variable invitation-stack

: invitations-s/h ( flag -- )
    invitations swap  IF  /flop  ELSE  /flip  THEN  drop +resize ;

: add-user ( key-o -- )
1093 1094
    data >o perm%default ke-mask !  "peer" >group-id set-group
    o cell- ke-end over - ke-pk $@ key| key# #! o> save-keys ;
1095
: sub-user ( key-o -- )
1096 1097
    data >o perm%blocked ke-mask !  "blocked" >group-id set-group
    o cell- ke-end over - ke-pk $@ key| key# #! o> save-keys ;
1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114

: add-invitation ( addr u -- )
    over >r read-pk2key$ sample-key .clone >o
    o invitation-stack >stack
    {{
	ke-nick $@ }}text
	glue*ll }}glue
	'user-plus' ['] xemit $tmp }}text
	['] add-user o click[]
	'user-minus' ['] xemit $tmp }}text
	['] sub-user o click[]
    }}h box[] 25%b invitations-list .child+
    invitations-notify /flop drop +resize
    o> r> free throw ;

' add-invitation is do-invite

1115
{{
1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126
    {{
	glue-left }}glue
	pw-frame          dup >slides
	id-frame   /flip  dup >slides
	chat-frame /flip  dup >slides
	post-frame /flip  dup >slides
	glue-right }}glue
    }}h box[]
    {{
	{{
	    glue*lll }}glue
1127 1128
	    \large
	    {{
Bernd Paysan's avatar
Bernd Paysan committed
1129
		'user-plus' ' xemit $tmp }}text
1130
	    }}h ' invitations-s/h 0 toggle[] /flip dup to invitations-notify
Bernd Paysan's avatar
Bernd Paysan committed
1131
	    online-symbol }}text dup to online-flag
Bernd Paysan's avatar
Bernd Paysan committed
1132 1133
	    s" " $444444FF new-color, }}button-lit [: -1 data +! ;]
	    [IFDEF] android android:level# [ELSE] level# [THEN] click[]
1134
	}}h box[] /vfix
Bernd Paysan's avatar