# @dapp-format 1
# @id dappchat
# @name DappChat
# @version 1.1.4
# @boards fnk0104
# @runtime >=1.4.2 <2.0.0
# @echo off
# @summary Chat with other DOLL-OS/DS units over the Sad Girls Club backend
# /apps/dappchat.dapp
# Live network chat: log in (first use of a username creates the account), pick
# a room, then the window refreshes itself on a timer while you type.
#
# The chat screen cannot use INPUT. INPUT blocks until Enter, so the room would
# freeze for exactly as long as you sat composing -- which is most of the time a
# chat is open, and is why this app used to need a blank line to show anything
# new. So the screen is a CANVAS and the input line is edited by hand out of
# KEY, which returns 0 instead of waiting when nobody has typed. That leaves the
# loop free to poll on a clock.
#
# The feed is stored as fixed-width records, $cols characters each, packed into
# one string. That is what makes both operations trivial: rendering row N is a
# SUBSTR at N*$cols, and scrolling is a SUBSTR that drops the first record. A
# separator character would have been simpler to write and impossible to get
# right, since any byte used to join lines is a byte someone can type.
#
# See sgc-chat-server/README.md for the backend this talks to.

SETSTR endpoint "https://sadgirlsclub.wtf/dappchat"
SETSTR room "lobby"
SET since 0
CHR q 34

# A padding space has to come from CHR, never from a " " literal. The shell
# splitter removes an argument's quotes as it splits, and the runtime's expander
# then trims what it is handed -- so on hardware a quoted whitespace-only literal
# arrives as the empty string and APPEND adds nothing, silently. (The browser
# runtime strips quotes later, so the same line works there, which is exactly how
# this shipped.) A $-reference is read straight out of the variable and never
# trimmed, so it survives both.
CHR sp 32

# Canvas geometry: header, feed, status, prompt. The panel scales its glyphs to
# fit whatever grid it is handed, so these numbers are the font size -- fewer
# columns means bigger text. 40x15 reads comfortably; raise $cols and $rows
# together for more history at a smaller size.
SET cols 40
SET rows 15
SET feedrows 11
SET statusrow 12
SET promptrow 14

# how long the room may go unrefreshed, in milliseconds
SET pollms 2000

COLOR pink
PRINT "DAPPCHAT"
PRINT "letters/numbers/-/_ only for username and room"
COLOR white

HTTPCLEAR
HTTPHEADER "Content-Type" "application/json"

:login
INPUT username "username> "
IFEQ $username "" GOTO login
INPUTSECRET password "password> "

JSONESC safeuser $username
JSONESC safepass $password
SETSTR password ""

SETSTR sbody "{"
APPEND sbody $q
APPEND sbody "username$q:"
APPEND sbody $q
APPEND sbody "$safeuser$q,"
APPEND sbody $q
APPEND sbody "password$q:"
APPEND sbody $q
APPEND sbody "$safepass$q}"
SETSTR safepass ""

SETSTR url "$endpoint/auth"
PRINT "signing in..."
HTTPPOST raw $url $sbody 512
SETSTR sbody ""
IF $httpok = 0 GOTO auth_http_error

JSONGET text $raw "ok"
IFEQ $text "true" GOTO auth_ok
JSONGET text $raw "error"
COLOR red
IFEQ $text "bad_password" GOTO bad_password
PRINT "sign-in failed: HTTP $httpcode ($httplen bytes)"
PRINT "$raw"
COLOR white
GOTO login

:bad_password
PRINT "wrong password for $username"
COLOR white
GOTO login

:auth_http_error
COLOR red
PRINT "could not reach dappchat: HTTP $httpcode"
COLOR white
WAIT 1500
GOTO login

:auth_ok
JSONGET authtoken $raw "token"
JSONGET text $raw "created"
COLOR green
IFEQ $text "true" GOTO welcome_new
PRINT "welcome back, $username"
GOTO room_prompt
:welcome_new
PRINT "account created - welcome, $username"

:room_prompt
COLOR white
INPUT line "room [$room]> "
IFEQ $line "" GOTO room_default
SETSTR room $line
:room_default
SET since 0

HTTPHEADER "Authorization" "Bearer $authtoken"

SETSTR feed ""
SET feedlines 0
SETSTR line ""
SETSTR status "joining $room..."
SET dirty 1
SET nextpoll 0

CANVAS $cols $rows

# ------------------------------------------------------------- the chat loop

# One pass: refresh if the clock says so, drain whatever was typed, redraw if
# anything changed, then hand the CPU back. WAIT is also what clears the
# runaway-loop step counter, so it has to stay on this path.
:loop
IF $millis < $nextpoll GOTO loop_keys
GOSUB poll
SET nextpoll $millis
ADD nextpoll $pollms

# Drain the whole key queue each pass rather than one key per frame, so fast
# typing cannot fall behind the redraw.
:loop_keys
KEY k
IF $k = 0 GOTO loop_draw
IF $k = $kesc GOTO done
IF $k = $kenter GOTO loop_enter
# The runtime folds CR and LF into $kenter before a script sees them, but a
# keyboard bridge that ever hands one through raw should still send the line
# rather than silently swallowing the keystroke.
IF $k = 13 GOTO loop_enter
IF $k = 10 GOTO loop_enter
IF $k = $kback GOTO loop_back
IF $k = 127 GOTO loop_back
IF $k < 32 GOTO loop_unused
IF $k > 126 GOTO loop_unused
LEN llen $line
IF $llen >= 200 GOTO loop_keys
CHR kc $k
APPEND line $kc
SET dirty 1
GOTO loop_keys

# Naming the code makes a keyboard that disagrees with the runtime diagnosable
# from the screen instead of by guesswork: if Enter arrives as something this
# app does not act on, the status row says which number it was.
:loop_unused
SETSTR status "unused key ($k)"
SET dirty 1
GOTO loop_keys

:loop_back
LEN llen $line
IF $llen = 0 GOTO loop_keys
SUB llen 1
SUBSTR line $line 0 $llen
SET dirty 1
GOTO loop_keys

:loop_enter
IFEQ $line "" GOTO loop_now
IFEQ $line "/quit" GOTO done
GOSUB send
SETSTR line ""
SET dirty 1
GOTO loop_keys

# Enter on an empty line still means "refresh right now" -- the timer is the
# normal path, but there is no reason to make someone wait it out.
:loop_now
SET nextpoll 0
GOTO loop_keys

:loop_draw
IF $dirty = 1 GOSUB render
WAIT 20
GOTO loop

# ---------------------------------------------------------------- the screen

:render
SET dirty 0
CLS
COLOR cyan
SETSTR padtext "$room - enter sends, esc quits"
GOSUB padline
PUT 0 0 $padtext
COLOR white

SET rrow 1
SET roff 0
SET rleft $feedlines
:render_row
IF $rleft = 0 GOTO render_status
SUBSTR padtext $feed $roff $cols
PUT 0 $rrow $padtext
ADD roff $cols
ADD rrow 1
SUB rleft 1
GOTO render_row

:render_status
IFEQ $status "" GOTO render_prompt
COLOR yellow
SETSTR padtext $status
GOSUB padline
PUT 0 $statusrow $padtext
COLOR white

:render_prompt
SETSTR padtext "$username> $line"
LEN plen $padtext
IF $plen <= $cols GOTO render_prompt_pad
# A narrow grid runs out of room long before the 200 characters the server will
# take, so keep the end of what is being typed on screen rather than the start.
SET ptail $plen
SUB ptail $cols
SET plen $cols
SUBSTR padtext $padtext $ptail $plen
:render_prompt_pad
GOSUB padline
PUT 0 $promptrow $padtext
FLIP
RETURN

# in/out: padtext -- exactly $cols wide, so every PUT overwrites the whole row
# and no stale text survives a redraw
:padline
LEN plen $padtext
IF $plen > $cols GOTO pad_cut
:pad_grow
IF $plen >= $cols GOTO pad_done
APPEND padtext $sp
ADD plen 1
GOTO pad_grow
:pad_cut
SUBSTR padtext $padtext 0 $cols
:pad_done
RETURN

# in: padtext (raw line) -- appends it to the feed, wrapping anything wider than
# the grid across as many records as it needs. The server takes 200 characters
# and a readable grid is 40 wide, so clipping would routinely eat most of a
# message rather than the odd long one.
:feed_add
SETSTR faline $padtext
LEN falen $faline
IF $falen = 0 GOTO feed_done
SET faoff 0
:feed_chunk
SET facount $falen
SUB facount $faoff
IF $facount <= $cols GOTO feed_chunk_take
SET facount $cols
:feed_chunk_take
SUBSTR padtext $faline $faoff $facount
GOSUB padline
APPEND feed $padtext
ADD feedlines 1
ADD faoff $facount
GOSUB feed_scroll
IF $faoff < $falen GOTO feed_chunk
:feed_done
RETURN

# drops whole records off the top until the window fits again
:feed_scroll
IF $feedlines <= $feedrows GOTO feed_scroll_done
LEN flen $feed
SUB flen $cols
SUBSTR feed $feed $cols $flen
SUB feedlines 1
GOTO feed_scroll
:feed_scroll_done
RETURN

# ---------------------------------------------------------------- networking

# Appends anything newer than $since to the feed and advances $since. The server
# answers at most 10 messages per request and since=0 means "the 10 most recent",
# so a response that comes back full means more is waiting; $pround caps the
# catch-up at 50 rather than replaying a whole room.
:poll
SET pround 0
:poll_round
SETSTR url "$endpoint/poll?room=$room&since=$since"
HTTPGET praw $url 4096
IF $httpok = 1 GOTO poll_body
# The refresh after a pause is the request most likely to land on a keep-alive
# socket the server has already closed. That attempt is lost; the retry gets a
# fresh connection.
HTTPGET praw $url 4096
IF $httpok = 0 GOTO poll_failed
:poll_body
SET pi 0
:poll_next
JSONGET ptext $praw "messages[$pi].text"
IF $jsonok = 0 GOTO poll_done
JSONGET puser $praw "messages[$pi].user"
SETSTR padtext "$puser: $ptext"
GOSUB feed_add
SET dirty 1
ADD pi 1
GOTO poll_next
:poll_done
SETSTR status ""
JSONGET text $praw "last_id"
IF $jsonok = 0 GOTO poll_return
GOSUB str2num
SET since $num
IF $pi < 10 GOTO poll_return
ADD pround 1
IF $pround < 5 GOTO poll_round
:poll_return
RETURN

:poll_failed
SETSTR status "refresh failed (HTTP $httpcode) - still trying"
SET dirty 1
RETURN

# in: line
:send
JSONESC safemsg $line
IF $jsonok = 0 GOTO send_too_long

SETSTR sbody "{"
APPEND sbody $q
APPEND sbody "room$q:"
APPEND sbody $q
APPEND sbody "$room$q,"
APPEND sbody $q
APPEND sbody "text$q:"
APPEND sbody $q
APPEND sbody $safemsg
APPEND sbody $q
APPEND sbody "}"

SETSTR url "$endpoint/send"
HTTPPOST sraw $url $sbody 512
IF $httpok = 0 GOTO send_http_error

# Every endpoint answers HTTP 200 and reports success inside the body, so $httpok
# is 1 for a refusal too. A send the server rejected has to be read out of "ok"
# or the message simply evaporates: nothing on screen, nothing in the room, and
# nothing for the next poll to return because the text was never stored.
JSONGET sendok $sraw "ok"
IFEQ $sendok "true" GOTO send_ok
JSONGET senderr $sraw "error"
IFEQ $senderr "unauthorized" GOTO send_unauthorized
SETSTR status "not sent ($senderr)"
SET dirty 1
RETURN

:send_ok
# show it now rather than at the end of the poll interval
SET nextpoll 0
SETSTR status ""
RETURN

# The server keeps one token per account and overwrites it on every sign-in, so
# signing the same username in on a second unit silently retires this one's.
# Reading a room needs no token at all, which is what makes this look like a
# chat that receives fine and drops everything you type.
:send_unauthorized
SETSTR status "signed out - is $username signed in on another unit?"
SET dirty 1
RETURN

:send_http_error
SETSTR status "send failed (HTTP $httpcode)"
SET dirty 1
RETURN

:send_too_long
SETSTR status "message too long after JSON escaping"
SET dirty 1
RETURN

# in: text (string)   out: num -- digits off the front of a string, since a
# JSON number comes back through JSONGET as text (the tetris/snake routine)
:str2num
SET num 0
SET s2i 0
LEN s2len $text
:s2n_loop
IF $s2i >= $s2len GOTO s2n_done
CHARAT s2d $text $s2i
IF $s2d < 48 GOTO s2n_done
IF $s2d > 57 GOTO s2n_done
SUB s2d 48
MUL num 10
ADD num $s2d
ADD s2i 1
GOTO s2n_loop
:s2n_done
RETURN

:done
ENDCANVAS
HTTPCLEAR
SETSTR authtoken ""
COLOR pink
PRINT "bye"
EXIT