Verified Commit 40be85cc authored by Bernd Paysan's avatar Bernd Paysan
Browse files

Start calendar navigation

parent 16331169

gui.fs

+48 −4
Original line number Diff line number Diff line
@@ -401,10 +401,12 @@ Variable dummy-thumb# 
Variable user.png$

Variable thumb.png$

: read-user ( -- region )

    [ "doc/user.png" ]path user.png$ $slurp-file

    user.png$ $@len 0= IF

	[ "doc/user.png" ]path user.png$ $slurp-file  THEN

    user.png$ $@ mem>thumb atlas-region ;

: read-thumb ( -- )

    [ "minos2/thumb.png" ]path thumb.png$ $slurp-file

    thumb.png$ $@len 0= IF

	[ "minos2/thumb.png" ]path thumb.png$ $slurp-file  THEN

    thumb.png$ $@ mem>thumb atlas-region ;

: user-avatar ( -- addr )

    user-avatar# @ 0= IF
@@ -1159,14 +1161,56 @@ wmsg-o >o msg-table @ token-table ! o> 
0 Value chat-edit    \ chat edit field

0 Value chat-edit-bg \ chat edit background



: >ymd ( ticks -- year month day )

    64>f 1n f* >day fdrop unix-day0 + day2ymd ;

: year>i ( year -- index )

    1 1 ymd2day unix-day0 - #86400 * #1000000000 um* d>64 date>i ;



: +years ( end start -- o maxyear ) { | maxyear }

    >r 1+ >r

    {{

	glue*ll }}glue

	r> r> DO

	    I 1+ year>i I year>i - dup maxyear umax to maxyear

	    IF  I 0 <# #s #> day-color x-color blackish }}button-lit  THEN

	LOOP

	glue*ll }}glue

    }}h box[] maxyear ;

: +months ( end start -- )

    >r 1+ >r

    {{

	glue*ll }}glue

	r> r> DO

	    I 0 <# #s #> day-color x-color blackish }}button-lit

	LOOP

	glue*ll }}glue

    }}h box[] ;



: gen-calendar { log u -- o/0 }

    u gui-msgs# cells u<= IF  0  EXIT  THEN

    log u cell- 0 max + $@ startdate@ { 64: endd }

    log $@ startdate@ { 64: std }

    {{  \Large

	endd >ymd 2drop

	std >ymd 2drop 2dup <> IF

	    +years gui-msgs# u> IF

		12 1 +months

	    THEN

	ELSE  2drop

	    endd >ymd drop nip

	    std >ymd drop nip +months

	THEN

    }}v box[] ;



: (gui-msgs) ( gaddr u -- )

    reset-time

    64#0 to last-tick  last-bubble-pk $free

    0 to msg-par  0 to msg-box

    msgs-box .dispose-childs

    load-msg msg-log@ { log u }

    log u gen-calendar ?dup-IF  msgs-box .child+  THEN

    glue*lll }}glue msgs-box .child+

    load-msg msg-log@

    { log u } u gui-msgs# cells - 0 max { u' }  log u' wmsg-o .?search-lock

    u gui-msgs# cells - 0 max { u' }  log u' wmsg-o .?search-lock

    log u u' /string bounds ?DO

	I log - cell/ to log#

	I $@ { d: msgt }

tools.fs

+2 −2
Original line number Diff line number Diff line
@@ -596,7 +596,7 @@ $40 Constant #splitminute 
    10 6 0 f.rdp 's' emit ;



: >day ( seconds -- fraction day )

    86400 fm/ fsplit ;

    #86400 fm/ fsplit ;

: .day ( day -- )

    unix-day0 + day2ymd

    rot 0 .r '-' emit swap .## '-' emit .## 'T' emit ;
@@ -626,7 +626,7 @@ $40 Constant #splitminute 
    datehms? 1 > IF ." forever" ELSE 'f' emit THEN ;



: f.ticks ( rticks -- )

    1e-9 f* >day

    1n f* >day

    dup today? date? #today and 0= and

    IF

	drop .timeofday