Check-in [d0bf2a8d6c]
Not logged in

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

Overview
Comment:Avatar reload when thumbnails are ditched
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: d0bf2a8d6c957974d1a9b178202b82628afd4ccf
User & Date: bernd 2019-03-26 21:24:19
Context
2019-03-26
21:39
?read-enc-hashed with good stack effect check-in: 0ab6fe4fbd user: bernd tags: trunk
21:24
Avatar reload when thumbnails are ditched check-in: d0bf2a8d6c user: bernd tags: trunk
2019-03-21
18:37
Bump version number check-in: 7a68f3bae4 user: bernd tags: trunk, 0.8.8-20190321
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to gui.fs.

399
400
401
402
403
404
405


406
407
408
409

410
411
412
413






414
415
416
417
418
419
420
...
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
    [: data >o ." clicked on " ke-nick $. cr o> ;] o click[] ;

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>



: show-avatar ( addr u -- o )
    2dup avatar# #@ nip 0= IF
	2dup ?read-enc-hashed
	patch-in$ $@ mem>thumb atlas-region 2swap avatar# #!

    ELSE  2drop  THEN
    glue*avatar last# cell+ $@ drop }}thumb
    >r {{ r> }}v 40%b ;







: ?avatar ( addr u -- o / )
    key# #@ IF
	cell+ .ke-avatar $@ dup IF
	    show-avatar
	ELSE  2drop  THEN
    ELSE  drop  THEN ;

................................................................................
    2dup "file:" string-prefix? IF
	0 to v-box
	5 /string [: ." ~+/" type ;] $tmp markdown-parse
	v-box project-vp .child+
	dpy-w @ 50% fm* p-format
    ELSE  2drop  THEN ;
: display-project ( addr u -- )
    project-vp >o dispose-childs  0 to active-w o>
    project:branch$ $@ { d: branch }
    dvcs:new-project-log >o
    ?msg-log  last# msg-log@ 2dup { log u }
    bounds ?DO
	I $@ msg:display \ this will only set the URLs
    cell +LOOP
    glue*lll }}glue project-vp dup .act 0= IF  vp[]  THEN  .child+







>
>


<
<
>




>
>
>
>
>
>







 







|







399
400
401
402
403
404
405
406
407
408
409


410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
...
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
    [: data >o ." clicked on " ke-nick $. cr o> ;] o click[] ;

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>

: read-avatar ( addr u -- addr' u' )
    ?read-enc-hashed patch-in$ $@ mem>thumb atlas-region ;
: show-avatar ( addr u -- o )
    2dup avatar# #@ nip 0= IF


	2dup read-avatar 2swap avatar# #!
    ELSE  2drop  THEN
    glue*avatar last# cell+ $@ drop }}thumb
    >r {{ r> }}v 40%b ;

: re-avatar ( last# -- )
    >r r@ $@ read-avatar r> cell+ $@ smove ;

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

: ?avatar ( addr u -- o / )
    key# #@ IF
	cell+ .ke-avatar $@ dup IF
	    show-avatar
	ELSE  2drop  THEN
    ELSE  drop  THEN ;

................................................................................
    2dup "file:" string-prefix? IF
	0 to v-box
	5 /string [: ." ~+/" type ;] $tmp markdown-parse
	v-box project-vp .child+
	dpy-w @ 50% fm* p-format
    ELSE  2drop  THEN ;
: display-project ( addr u -- )
    project-vp >o dispose-childs  free-thumbs  0 to active-w o>
    project:branch$ $@ { d: branch }
    dvcs:new-project-log >o
    ?msg-log  last# msg-log@ 2dup { log u }
    bounds ?DO
	I $@ msg:display \ this will only set the URLs
    cell +LOOP
    glue*lll }}glue project-vp dup .act 0= IF  vp[]  THEN  .child+

Changes to tools.fs.

797
798
799
800
801
802
803





804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
    w/o create-file throw close-file throw ;

\ copy files

: throw?exists ( throwcode -- )  dup no-file# <> and throw ;

$1F to tmps# \ need more temporaries






: >backup ( addr u -- )
    2dup 2dup [: type '~' emit ;] $tmp rename-file >r
    2dup [: type '+' emit getpid 0 .r ;] $tmp 2swap rename-file
    r> throw?exists throw?exists ;

: >new ( addr u -- fd )
    [: type '+' emit getpid 0 .r ;] $tmp r/w create-file throw ;

: >copy ( addr u -- fd )
    2dup >new { fd1 }
    r/o open-file dup no-file# = IF
	2drop
    ELSE
	throw 0 { fd0 w^ cpy }







>
>
>
>
>



|



|







797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
    w/o create-file throw close-file throw ;

\ copy files

: throw?exists ( throwcode -- )  dup no-file# <> and throw ;

$1F to tmps# \ need more temporaries

Variable tmp-file$
: $tmp-file ( addr u -- addr' u' )
    [: type '+' emit getpid 0 .r ;] tmp-file$ $set
    tmp-file$ $@ ;

: >backup ( addr u -- )
    2dup 2dup [: type '~' emit ;] $tmp rename-file >r
    tmp-file$ $@ 2swap rename-file
    r> throw?exists throw?exists ;

: >new ( addr u -- fd )
    $tmp-file r/w create-file throw ;

: >copy ( addr u -- fd )
    2dup >new { fd1 }
    r/o open-file dup no-file# = IF
	2drop
    ELSE
	throw 0 { fd0 w^ cpy }