Check-in [985b47981c]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add better chain support
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 985b47981cab9b74a7ec11a02079317ebab6b517
User & Date: bernd 2019-07-05 14:51:28.521
Context
2019-07-05
15:01
Add better chain support check-in: 8afee7be22 user: bernd tags: trunk
14:51
Add better chain support check-in: 985b47981c user: bernd tags: trunk
2019-07-04
21:50
Start implementing commands in GUI mode check-in: 581eb4c544 user: bernd tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to classes.fs.
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
    $value: name$ \ group name
    $value: id$
    field: peers[]
    field: keys[]
    field: log[]
    field: mode
    \ mode bits:
    1 5 bits: otr# chain# redate# lock# visible#
    : bit-ops: ( bit -- )
        parse-name [{: d: name :}l name rot [: emit type ;] $tmp nextname ;]
	{: xt: gen-name :}
	'+' gen-name create dup , [: @        mode or!  ;] set-does>
	'-' gen-name create dup , [: @ invert mode and! ;] set-does>
	'?' gen-name create     , [: @ mode @ and 0<>   ;] set-does> ;
    otr#     bit-ops: otr
    chain#   bit-ops: chain
    redate#  bit-ops: redate
    lock#    bit-ops: lock
    visible# bit-ops: visible

    method start
    method tag
    method chain







|







<







138
139
140
141
142
143
144
145
146
147
148
149
150
151
152

153
154
155
156
157
158
159
    $value: name$ \ group name
    $value: id$
    field: peers[]
    field: keys[]
    field: log[]
    field: mode
    \ mode bits:
    1 4 bits: otr# redate# lock# visible#
    : bit-ops: ( bit -- )
        parse-name [{: d: name :}l name rot [: emit type ;] $tmp nextname ;]
	{: xt: gen-name :}
	'+' gen-name create dup , [: @        mode or!  ;] set-does>
	'-' gen-name create dup , [: @ invert mode and! ;] set-does>
	'?' gen-name create     , [: @ mode @ and 0<>   ;] set-does> ;
    otr#     bit-ops: otr

    redate#  bit-ops: redate
    lock#    bit-ops: lock
    visible# bit-ops: visible

    method start
    method tag
    method chain
Changes to gui.fs.
406
407
408
409
410
411
412


413
414
415
416
417
418
419
$33883366 new-color: day-color
$88333366 new-color: hour-color
$FFFFFFFF text-color: realwhite
$FFFFFFFF new-color: edit-bg
$80FF80FF new-color: send-color
$00FF0020 new-color: pet-color
$FFFF80FF new-color, fvalue users-color#



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

Hash: avatar#

glue new Constant glue*avatar







>
>







406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
$33883366 new-color: day-color
$88333366 new-color: hour-color
$FFFFFFFF text-color: realwhite
$FFFFFFFF new-color: edit-bg
$80FF80FF new-color: send-color
$00FF0020 new-color: pet-color
$FFFF80FF new-color, fvalue users-color#
$FFCCCCFF new-color, fvalue gps-color#
$000077FF new-color, fvalue chain-color#

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

Hash: avatar#

glue new Constant glue*avatar
886
887
888
889
890
891
892
893
894
895
896







897
898
899
900
901
902
903
    [: data >o text$ o> open-url ;]
    over click[]
    click( ." url: " dup ..parents cr )
    "url" name! msg-box .child+
; wmsg-class to msg:url
:noname { d: string -- o }
    {{
	glue*l $FFCCCCFF new-color, slide-frame dup .button1
	string [: ."  GPS: " .coords ;] $tmp }}text 25%b
    }}z "gps" name! msg-box .child+
; wmsg-class to msg:coord







:noname { d: pk -- o }
    {{
	x-color { f: xc }
	pk key|
	2dup 0 .pk@ key| str=
	last-otr? IF  IF  my-signal-otr  ELSE  other-signal-otr  THEN
	ELSE  IF  my-signal  ELSE  other-signal  THEN  THEN







|



>
>
>
>
>
>
>







888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
    [: data >o text$ o> open-url ;]
    over click[]
    click( ." url: " dup ..parents cr )
    "url" name! msg-box .child+
; wmsg-class to msg:url
:noname { d: string -- o }
    {{
	glue*l gps-color# slide-frame dup .button1
	string [: ."  GPS: " .coords ;] $tmp }}text 25%b
    }}z "gps" name! msg-box .child+
; wmsg-class to msg:coord
: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+
; wmsg-class to msg:chain
:noname { d: pk -- o }
    {{
	x-color { f: xc }
	pk key|
	2dup 0 .pk@ key| str=
	last-otr? IF  IF  my-signal-otr  ELSE  other-signal-otr  THEN
	ELSE  IF  my-signal  ELSE  other-signal  THEN  THEN
Changes to msg.fs.
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
$20 net2o: msg-start ( $:pksig -- ) \g start message
    1 !!>order? $> msg:start ;
+net2o: msg-tag ( $:tag -- ) \g tagging (can be anywhere)
    $> msg:tag ;
+net2o: msg-id ( $:id -- ) \g a hash id
    2 !!>=order? $> msg:id ;
+net2o: msg-chain ( $:dates,sighash -- ) \g chained to message[s]
    $10 !!>=order? $> msg:chain ;
+net2o: msg-signal ( $:pubkey -- ) \g signal message to one person
    $> msg:signal ;
+net2o: msg-re ( $:hash ) \g relate to some object
    4 !!>=order? $> msg:re ;
+net2o: msg-text ( $:msg -- ) \g specify message string
    8 !!>=order? $> msg:text ;
+net2o: msg-object ( $:object type -- ) \g specify an object, e.g. an image







|







343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
$20 net2o: msg-start ( $:pksig -- ) \g start message
    1 !!>order? $> msg:start ;
+net2o: msg-tag ( $:tag -- ) \g tagging (can be anywhere)
    $> msg:tag ;
+net2o: msg-id ( $:id -- ) \g a hash id
    2 !!>=order? $> msg:id ;
+net2o: msg-chain ( $:dates,sighash -- ) \g chained to message[s]
    ( $10 !!>=order? ) $> msg:chain ;
+net2o: msg-signal ( $:pubkey -- ) \g signal message to one person
    $> msg:signal ;
+net2o: msg-re ( $:hash ) \g relate to some object
    4 !!>=order? $> msg:re ;
+net2o: msg-text ( $:msg -- ) \g specify message string
    8 !!>=order? $> msg:text ;
+net2o: msg-object ( $:object type -- ) \g specify an object, e.g. an image
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185

also net2o-base
\ chain messages to one previous message
: chain, ( msgaddr u -- )
    [: 2dup startdate@ 64#0 { 64^ sd } sd le-64!  sd 1 64s forth:type
	c:0key sigonly@ >hash hashtmp hash#128 forth:type ;] $tmp $, msg-chain ;

: ?chain, ( -- )  msg-group-o .msg:?chain 0= ?EXIT
    msg-group-o .msg:log[] $[]# 1- dup 0< IF  drop
    ELSE  msg-group-o .msg:log[] $[]@ chain,
    THEN ;

: (send-avalanche) ( xt -- addr u flag )
    [: 0 >o [: sign[ msg-start execute ?chain, msg> ;] gen-cmd$ o>
      +last-signed msg-log, ;] [group] ;
previous
: send-avalanche ( xt -- )
    msg-group-o .msg:?otr IF  now>otr  ELSE  now>never  THEN
    (send-avalanche)
    >r .chat r> 0= IF  .nobody  THEN ;








<
<
<
<
<

|







1165
1166
1167
1168
1169
1170
1171





1172
1173
1174
1175
1176
1177
1178
1179
1180

also net2o-base
\ chain messages to one previous message
: chain, ( msgaddr u -- )
    [: 2dup startdate@ 64#0 { 64^ sd } sd le-64!  sd 1 64s forth:type
	c:0key sigonly@ >hash hashtmp hash#128 forth:type ;] $tmp $, msg-chain ;






: (send-avalanche) ( xt -- addr u flag )
    [: 0 >o [: sign[ msg-start execute msg> ;] gen-cmd$ o>
      +last-signed msg-log, ;] [group] ;
previous
: send-avalanche ( xt -- )
    msg-group-o .msg:?otr IF  now>otr  ELSE  now>never  THEN
    (send-avalanche)
    >r .chat r> 0= IF  .nobody  THEN ;

1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
    \G me: send remaining string as action
umethod /away ( addr u -- )
    \U away [<action>]      send string or "away from keyboard" as action
    \G away: send string or "away from keyboard" as action
synonym /back /away
umethod /otr ( addr u -- )
    \U otr on|off|message   turn otr mode on/off (or one-shot)
umethod /chain ( addr u -- )
    \U chain on|off         turn chain mode on/off
umethod /peers ( addr u -- )
    \U peers                list peers
    \G peers: list peers in all groups
umethod /gps ( addr u -- )
    \U gps                  send coordinates
    \G gps: send your coordinates
synonym /here /gps







<
<







1305
1306
1307
1308
1309
1310
1311


1312
1313
1314
1315
1316
1317
1318
    \G me: send remaining string as action
umethod /away ( addr u -- )
    \U away [<action>]      send string or "away from keyboard" as action
    \G away: send string or "away from keyboard" as action
synonym /back /away
umethod /otr ( addr u -- )
    \U otr on|off|message   turn otr mode on/off (or one-shot)


umethod /peers ( addr u -- )
    \U peers                list peers
    \G peers: list peers in all groups
umethod /gps ( addr u -- )
    \U gps                  send coordinates
    \G gps: send your coordinates
synonym /here /gps
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
	."  otr mode ===" <default> forth:cr
    ELSE  rdrop
	msg-group-o .msg:mode @ >r
	msg-group-o .msg:+otr avalanche-text
	r> msg-group-o .msg:mode !
    THEN ; is /otr

:noname ( addr u -- )
    2dup s" on" str= >r
    s" off" str= r@ or IF
	msg-group-o r@ IF  .msg:+chain  ELSE  .msg:-chain  THEN
	<info> ." === " r> IF  ." enter"  ELSE  ." leave"  THEN
	."  chain mode ==="
    ELSE  <err> ." only 'chain on|off' are allowed" rdrop  THEN
    <default> forth:cr ; is /chain

:noname ( addr u -- )  2drop
    [: msg:name$ .group ." : "
	msg:peers[] $@ bounds ?DO
	    space I @ >o .con-id space
	    ack@ .rtdelay 64@ 64>f 1n f* (.time) o>
	cell +LOOP  forth:cr ;] group#map ; is /peers








<
<
<
<
<
<
<
<
<







1404
1405
1406
1407
1408
1409
1410









1411
1412
1413
1414
1415
1416
1417
	."  otr mode ===" <default> forth:cr
    ELSE  rdrop
	msg-group-o .msg:mode @ >r
	msg-group-o .msg:+otr avalanche-text
	r> msg-group-o .msg:mode !
    THEN ; is /otr










:noname ( addr u -- )  2drop
    [: msg:name$ .group ." : "
	msg:peers[] $@ bounds ?DO
	    space I @ >o .con-id space
	    ack@ .rtdelay 64@ 64>f 1n f* (.time) o>
	cell +LOOP  forth:cr ;] group#map ; is /peers

1556
1557
1558
1559
1560
1561
1562
















1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
	    2>r over ?flush-text + to last->in  2r>
	    [:
		\ ." signal: '" 85type ''' forth:emit forth:cr
		$, msg-signal
	    ;] rectype-name
	THEN
    ELSE  2drop rectype-null  THEN ;
















: http-rec ( addr u -- )
    2dup "https://" string-prefix? >r
    2dup "http://" string-prefix? r> or IF
	over ?flush-text 2dup + to last->in
	[: $, msg-url ;] rectype-name
    ELSE  2drop rectype-null  THEN ;

$Variable msg-recognizer
' text-rec ' http-rec ' tag-rec ' pk-rec 4 msg-recognizer set-stack

: parse-text ( addr u -- ) last# >r  forth-recognizer >r
    0 to last->in
    msg-recognizer to forth-recognizer 2dup evaluate
    last->in IF  + last->in tuck -  THEN  dup IF
	\ ." text: '" forth:type ''' forth:emit forth:cr
	$, msg-text







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








|







1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
	    2>r over ?flush-text + to last->in  2r>
	    [:
		\ ." signal: '" 85type ''' forth:emit forth:cr
		$, msg-signal
	    ;] rectype-name
	THEN
    ELSE  2drop rectype-null  THEN ;
: chain-rec ( addr u -- )
    over c@ '!' = IF
	2dup 1 /string dup 0= IF  2drop rectype-null  EXIT  THEN
	snumber?
	case
	    0 of  endof
	    -1 of
		msg-group-o .msg:log[] $[]#
		over abs over u< IF  over 0< IF  +  ELSE  drop  THEN
		    >r over ?flush-text + to last->in  r>
		    [: msg-group-o .msg:log[] $[]@ chain, ;]
		    rectype-name  EXIT  THEN
	    endof
	    2drop
	endcase
    THEN  2drop  rectype-null  ;
: http-rec ( addr u -- )
    2dup "https://" string-prefix? >r
    2dup "http://" string-prefix? r> or IF
	over ?flush-text 2dup + to last->in
	[: $, msg-url ;] rectype-name
    ELSE  2drop rectype-null  THEN ;

$Variable msg-recognizer
' text-rec ' http-rec ' chain-rec ' tag-rec ' pk-rec 5 msg-recognizer set-stack

: parse-text ( addr u -- ) last# >r  forth-recognizer >r
    0 to last->in
    msg-recognizer to forth-recognizer 2dup evaluate
    last->in IF  + last->in tuck -  THEN  dup IF
	\ ." text: '" forth:type ''' forth:emit forth:cr
	$, msg-text