Commit 5c207d88 authored by Bernd Paysan's avatar Bernd Paysan

Click on images that don't have thumbnails

parent 3cf439e6
......@@ -144,10 +144,11 @@ cmd-class class{ msg
field: peers[]
field: keys[]
field: log[]
field: hashs[]
field: perms# \ pk -> permission map
field: mode
\ mode bits:
1 4 bits: otr# redate# lock# visible#
1 3 bits: otr# lock# visible#
: bit-ops: ( bit -- )
parse-name [{: d: name :}l name rot [: emit type ;] $tmp nextname ;]
{: xt: gen-name :}
......@@ -155,7 +156,6 @@ cmd-class class{ msg
'-' 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
......
......@@ -27,11 +27,11 @@ require minos2/font-style.fs
font-size# 70% f* }}frame ;
: bar-frame ( glue color -- o )
font-size# 20% f* }}frame dup .button3 ;
#64 Value lines/diag
: update-gsize# ( -- )
screen-pwh max s>f
default-diag screen-diag f/ .8e f**
default-scale f* 1/f #56 fm*
f/ fround to font-size#
screen-pwh dup * swap dup * + s>f fsqrt
screen-diag default-diag f/ .5e f** lines/diag fm* f/
m2c:scale% f@ f* fround to font-size#
font-size# 133% f* fround to baseline#
font-size# 32e f/ to pixelsize# ;
......@@ -412,10 +412,11 @@ Variable thumb.png$
read-user.png user.png$ $@ mem>thumb atlas-region
user-avatar# $!
THEN user-avatar# $@ drop ;
: read-dummy ( -- addr u )
read-thumb.png thumb.png$ $@ mem>thumb atlas-region ;
: dummy-thumb ( -- addr )
dummy-thumb# @ 0= IF
read-thumb.png thumb.png$ $@ mem>thumb atlas-region
dummy-thumb# $!
read-dummy dummy-thumb# $!
THEN dummy-thumb# $@ drop ;
: avatar-thumb ( avatar -- )
glue*avatar swap }}thumb >r {{ r> }}v 40%b ;
......@@ -428,9 +429,12 @@ Variable thumb.png$
: re-avatar ( last# -- )
>r r@ $@ read-avatar r> cell+ $@ smove ;
: re-dummy ( -- )
dummy-thumb# @ 0= ?EXIT \ nobody has a dummy thumb
read-dummy dummy-thumb# $@ smove ;
:noname defers free-thumbs
avatar# ['] re-avatar #map ; is free-thumbs
re-dummy avatar# ['] re-avatar #map ; is free-thumbs
event: :>update-avatar ( thumb hash u1 -- )
avatar-frame swap .childs[] $@ drop @ >o to frame# o>
......@@ -610,6 +614,7 @@ previous
}}z box[] to id-frame
: show-nicks ( -- )
dummy-thumb drop
fill-nicks fill-groups !online-symbol
next-slide +lang +resize peers-box engage
peers-box 0.01e [: .vp-top fdrop title-vp .vp-top +sync +resize ;] >animate ;
......@@ -795,7 +800,7 @@ Variable emojis$ "👍👎🤣😍😘😛🤔😭😡😱🔃" emojis$ $! \
p-format
ELSE 2drop THEN ;
: display-posting ( addr u -- )
posting-vp >o dispose-childs free-thumbs 0 to active-w o>
posting-vp >o dispose-childs ( free-thumbs ) 0 to active-w o>
project:branch$ $@ { d: branch }
dvcs:new-posting-log >o
>group msg-log@ 2dup { log u }
......@@ -1074,12 +1079,8 @@ hash: imgs# \ hash of images
: +imgs ( addr$ -- )
[: { w^ string | ts[ 1 64s ] }
msg:timestamp ts[ be-64!
ts[ 1 64s type string $. ;] $tmp $make { w^ string }
msg-group$ $@ imgs# #@ d0= IF
string cell msg-group$ $@ imgs# #!
ELSE
string $@ last# cell+ $ins[] drop string $free
THEN ;
ts[ 1 64s type string $. ;] $tmp
msg-group$ $@ imgs# #!ins[] ;
: img>group# ( img u -- n )
msg-group$ $@ imgs# #@ bounds ?DO
......@@ -1098,18 +1099,21 @@ hash: imgs# \ hash of images
album-viewer md-frame .childs[] >stack
+sync +resize ;
: album-view[] ( addr u o -- o xt data )
[: addr data $@ >msg-album-viewer ;]
2swap $make dup +imgs 64#1 +to msg:timestamp ;
:noname ( addr u type -- )
obj-red
case 0 >r
case #0. 2>r
msg:image# of
2dup key| ?fetch
msg-box .childs[] $[]# ?dup-IF
rdrop 1- msg-box .childs[] $[] @
dup .name$ "thumbnail" str= IF
[: addr data $@ >msg-album-viewer ;]
2swap $make dup +imgs 64#1 +to msg:timestamp
click[] drop EXIT THEN drop THEN
[: ." img[" 85type ']' emit ;] $tmp }}text "image" name!
album-view[] click[] drop EXIT THEN drop THEN
[: ." img[" 2dup 85type ']' emit ;] $tmp }}text "image" name!
2rdrop album-view[] 2>r
endof
msg:thumbnail# of ?thumb "thumbnail" name! endof
msg:patch# of [: ." patch[" 85type ']' emit
......@@ -1119,10 +1123,10 @@ hash: imgs# \ hash of images
msg:message# of [: ." message[" 85type ']' emit
;] $tmp }}text "message" name! endof
msg:posting# of ." posting"
rdrop 2dup [d:h open-posting ;] >r
rdrop 2dup [d:h open-posting ;] 0 2>r
['] .posting $tmp }}text "posting" name!
endof
endcase r> ?dup-IF 0 click[] THEN
endcase 2r> 2dup d0<> IF click[] ELSE 2drop THEN
msg-box .child+
text-color!
; wmsg-class is msg:object
......@@ -1277,7 +1281,7 @@ Variable gui-log[]
\normal \mono blackish
{{
gui-log[] [: }}text /left ;] $[]map
}}v box[] 25%b
}}v box[] 25%b \regular
{{
s" " $444444FF new-color, }}text 25%b /right dup { closer }
glue*ll }}glue
......
......@@ -285,7 +285,7 @@ User hostc$ \ check for this hostname
: myhost= ( o -- flag )
.host:id $@ host$ $@ str= ?myself and ;
: host= ( o -- flag )
>o hostc$ $@ dup IF host:id $@ str= ELSE 2drop true THEN o> ;
......
......@@ -470,7 +470,7 @@ Variable comment#
: write-out-article ( o:comment -- )
\ <info> ." write out: " comments:url$ type cr <default>
>dir redate-mode on comment# off
>dir comment# off
dvcs:new-dvcs { dvcs-o }
comments-base
2dup [: ." posts/" type ." /.n2o" ;] $tmp ~net2o-cache/..
......@@ -495,7 +495,7 @@ Variable comment#
create>never
dvcs-o ['] add-collection mkey wrap-key
dvcs-o .dvcs:dispose-dvcs
dir> redate-mode off
dir>
dvcs-objects #frees ;
: write-articles ( -- ) { | nn }
......
......@@ -45,7 +45,6 @@ Variable otr-mode \ global otr mode
cell +LOOP ;
Variable msg-group$
Variable redate-mode
User replay-mode
User skip-sig?
......@@ -295,6 +294,12 @@ event: :>msg-nestsig ( $addr o group -- )
Forward msg:last?
Forward msg:last
Forward msg:want
hash: ihave#
: msg:ihave ( id u1 hash u2 -- )
bounds U+DO 2dup I keysize ihave# #!ins[] keysize +LOOP 2drop ;
: push-msg ( addr u o:parent -- )
up@ receiver-task <> IF
......@@ -794,6 +799,8 @@ $21 net2o: msg-group ( $:group -- ) \g set group
parent .wait-task @ ?query-task over select event> ;
+net2o: msg-last? ( start end n -- ) 64>n msg:last? ;
+net2o: msg-last ( $:[tick0,msgs,..tickn] n -- ) 64>n msg:last ;
+net2o: msg-ihave ( $:[hash0,...,hashn] $:[id] -- ) $> $> msg:ihave ;
+net2o: msg-want ( $:[hash0,...,hashn] -- ) $> msg:want ;
net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest
$> nest-sig ?dup-0=-IF
......@@ -891,6 +898,23 @@ in net2o : copy-msg ( filename u -- )
$20 Value max-last#
$20 Value ask-last#
$8 Value max-want#
: have>want ( hashs u want# -- ) { want# }
\ transform have into wants
bounds U+DO
I keysize ihave# #@ bounds U+DO
J keysize I $@ want# #+!
cell +LOOP
keysize +LOOP ;
: want, ( index -- )
\ compile a single want
over $@len over cell+ $@len + 8 + maxstring u< IF
dup cell+ $@ $, $@ $, msg-ihave
ELSE drop THEN ;
: msg:want ( hashs u -- )
{ | w^ want# } want# have>want
want# [: want, ;] #map want# #free ;
Variable ask-msg-files[]
: msg:last? ( start end n -- )
......@@ -1494,8 +1518,7 @@ text-chat-cmd-o to chat-cmd-o
:noname ( addr u -- )
dup 0= IF 2drop
away? IF "I'm back" ELSE "Away from keyboard" THEN
away? 0= to away?
THEN
THEN away? 0= to away?
[: $, msg-action ;] send-avalanche ; is /away
:noname ( flag -- )
......
......@@ -774,8 +774,9 @@ warnings !
\G gui: start net2o's graphical user interface
?.net2o-config
reset-net2o-cmds
[ "gui.fs" ]path required run-gui
save-net2o-cmds set-net2o-cmds ;
[ "gui.fs" ]path required
save-net2o-cmds set-net2o-cmds
run-gui ;
: ... ( -- )
... ;
......
......@@ -40,7 +40,6 @@ require threefish.fs
keccak-o crypto-o !
require rng.fs
require ed25519-donna.fs
require hash-table.fs
require bdelta.fs
require minos2/jpeg-exif.fs
......
......@@ -24,6 +24,7 @@ require date.fs
require mini-oof2.fs
require forward.fs
require set-compsem.fs
require hash-table.fs
\ enum
......@@ -508,13 +509,16 @@ Variable configured?
forward default-host
: !wrapper ( val addr xt -- .. ) { a xt -- .. }
a !@ >r xt catch r> a ! throw ;
: ?old-config ( addr u wid -- )
\G check if we have an old config; then keep it.
"~/.net2o/config" file-status nip no-file# <> IF
"~/.net2o" 2dup .net2o$ $! .net2o-config$ $!
subdir-config
nip nip "~/.net2o/config" rot
read-config default-host
0 addr config-throw ['] read-config !wrapper default-host
ELSE
?.net2o default-host write-config
THEN ;
......@@ -522,8 +526,9 @@ forward default-host
: ?.net2o-config ( -- ) true configured? !@ ?EXIT
"NET2O_CONF" getenv ?dup-IF config-file$ $! ELSE drop THEN
config-file$ $@ 2dup file-status nip ['] config >body swap
no-file# = IF ?old-config ELSE read-config default-host THEN
rootdirs>path ;
no-file# = IF ?old-config ELSE
0 addr config-throw ['] read-config !wrapper default-host
THEN rootdirs>path ;
: init-dirs ( -- ) ?.net2o-config fsane-init ;
......@@ -671,6 +676,16 @@ $40 Constant #splitminute
: $del[] ( addr u $array -- ) 0 $del[]# ;
\G delete O(log(n)) from pre-sorted array
\ hash with array of unique strings
: #!ins[] ( addr1 u1 addr-key u-key hash -- )
third third third >r 2>r
#@ d0= IF
$make { w^ s } s cell 2r> r> #!
ELSE
last# cell+ $ins[] drop rdrop 2rdrop
THEN ;
\ same with signatures; newest signature replaces older
$41 Constant sigonlysize#
......@@ -1019,25 +1034,8 @@ edit-terminal edit-out !
\ !wrapper: generic wrapper to store a value in a variable
\ and restore it after catching the xt
: !wrapper ( val addr xt -- .. ) { addr xt -- .. }
addr !@ >r xt catch r> addr ! throw ;
\ evaluate in
: evaluate-in ( addr u voc-addr -- )
get-order n>r >body 1 set-order ['] evaluate catch
nr> set-order throw ;
\ blocking event, also available in most recent Gforth
[IFUNDEF] event|
event: :>restart ( task -- ) restart ;
: event| ( task -- )
\G send an event and block
dup up@ = IF \ don't block, just eval if we send to ourselves
event> ?events
ELSE
up@ elit, :>restart event> stop
THEN ;
[THEN]
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment