luv

Workshop wiki

telegram.lisp

mcclim/telegram.lisp

system luvcraft/telegram · 109 definitions · on GitHub

A Telegram terminal bolted to a luvcraft wall.

The wall is the device. Build a rectangle of terminal blocks, look at it, press TAB to focus, and switch it to Telegram: the same surface that runs a shell or plays a film now shows a conversation, drawn by McCLIM into the texture the block world samples.

Two threads meet here and only one thing crosses between them. A console owns a Telegram connection and a roster on its own thread, and the roster is never touched from outside it; the game thread posts requests to a mailbox and reads one slot, which the console fills with a finished, immutable view. That is the whole concurrency story: a mailbox one way, a published snapshot the other, and no lock anywhere. It is also why the text is wrapped and the timestamps are formatted on the console's thread -- by the time a frame repaints, there is nothing left to compute.

in-package#:mcluv

The panel

Sizes are in texture pixels. The surface's own rectangle decides how big the thing is in the world; this decides how much of it is bezel.

Two surfaces carry the panel and they are not the same shape: a wall is wide, the phone in the hand is tall. What differs between them is a handful of edges -- the panel's extent, where the well ends and the composer begins, how many characters fit on a line -- and those are specials, bound from the frame's geometry around every paint and every hit-test. Everything that does not depend on the shape stays a constant.

defstruct
communicator-geometry
:constructormake-communicator-geometry
width720:typefixnum
height560:typefixnum
screen-bottom470:typefixnum
composer-top480:typefixnum
composer-bottom540:typefixnum
text-columns52:typefixnum
defparameter*wall-communicator-geometry*
make-communicator-geometry
"The wall's panel: wide, with room for a long line."
defparameter*phone-communicator-geometry*
make-communicator-geometry:width440:height545:screen-bottom455:composer-top465:composer-bottom525:text-columns40

The phone's panel: the proportions of the slab in the hand, so the texture is not squeezed sideways onto it.

defmacrowith-communicator-geometry
geometry
&bodybody
`
let*
%geometry,geometry
*communicator-width*
communicator-geometry-width%geometry
*communicator-height*
communicator-geometry-height%geometry
*communicator-screen-bottom*
communicator-geometry-screen-bottom%geometry
*communicator-composer-top*
communicator-geometry-composer-top%geometry
*communicator-composer-bottom*
communicator-geometry-composer-bottom%geometry
*communicator-text-columns*
communicator-geometry-text-columns%geometry
,@body
defparameter*communicator-bezel-ink*
make-rgb-color0.550.510.43
defparameter*communicator-bezel-light*
make-rgb-color0.730.690.59
defparameter*communicator-bezel-dark*
make-rgb-color0.260.240.20
defparameter*communicator-screen-ink*
make-rgb-color0.0750.0750.075
defparameter*communicator-row-ink*
make-rgb-color0.1250.1250.125
defparameter*communicator-text-ink*
make-rgb-color0.930.910.84
defparameter*communicator-muted-ink*
make-rgb-color0.540.540.51
defparameter*communicator-accent-ink*
make-rgb-color0.450.720.42
defparameter*communicator-sender-inks*
vector
make-rgb-color0.420.680.93
make-rgb-color0.480.800.45
make-rgb-color0.920.500.44
make-rgb-color0.900.760.36
make-rgb-color0.720.580.92
make-rgb-color0.380.820.78
make-rgb-color0.940.620.34
make-rgb-color0.920.560.76

Telegram gives every participant a colour and so does this. The choice is a hash of the name, so a person keeps their colour between sessions without anything having to be stored.

defuncommunicator-name-hash
name
let
hash5381
loopforcharacteracrossnamedo
setfhash
logand
+
*hash33
char-codecharacter
most-positive-fixnum
hash

What a frame paints

One immutable value, built on the console's thread and read on the game's. Publishing it is a single SETF of a slot, which is why no lock is needed: a repaint either sees the whole previous view or the whole next one.

defstruct
console-view
:constructormake-console-view
generation0:typeinteger
status"":typestring
failurenil
title"":typestring
subtitle"":typestring
dialogs'
:typelist
lines'
:typelist

While logging in: which answer the console is waiting for, and the words to put above the field. NIL once there is a conversation to show.

loginnil
prompt'
:typelist
secret-pnil

At the :QR stage, the code to draw: a square bit array, dark where 1.

qrnil
defstructdialog-row
keynil
label"":typestring
preview"":typestring
unread0:typeinteger

Pictures

FFmpeg opens a still exactly the way it opens a film -- one packet, one frame -- so the decode path luv already has for video is also the one for a photograph, and no JPEG reader has to exist here. The word order turns around on the way through: libav packs red in the low byte, and a CLIM pattern wants it in the third.

defuncommunicator-thumbnail-extent
photo

The size photo should be drawn at, fitted into the transcript's box.

let*
width
max1
telegram.chat:chat-photo-widthphoto
height
max1
telegram.chat:chat-photo-heightphoto
defunrgba-words-pattern-array
words
let*
dimensions
array-dimensionswords
result
make-arraydimensions:element-type'
unsigned-byte32
dotimes
y
firstdimensions
result
dotimes
x
seconddimensions
let
word
arefwordsyx
setf
arefresultyx
logior
ash
ldb
byte824
word
24
ash
ldb
byte80
word
16
ash
ldb
byte88
word
8
ldb
byte816
word
defunwrite-temporary-octets
bytestype
let
path
merge-pathnames
formatnil"luvcraft-~36R.~A"
random
expt248
type
uiop:temporary-directory
with-open-file
streampath:direction:output:element-type'
unsigned-byte8
:if-exists:supersede:if-does-not-exist:create
write-sequencebytesstream
path
defunvideo-file-type

An extension FFmpeg will recognize from the name alone.

The demuxer probes the content anyway, but a plausible suffix costs nothing and makes a leftover temporary file identifiable.

let*
name
telegram.chat:chat-document-file-namedocument
dot
andname
position#\.name:from-endt
if
subseqname
1+dot
"mp4"
defundecode-photo-pattern

Decode JPEG bytes into a width by height CLIM pattern, or NIL.

defstructtranscript-line

:HEAD carries the avatar, the name, and the time; :BODY is a wrapped continuation; :PHOTO is a picture this client can locate but not yet draw.

kind:body
sender"":typestring
inknil
time"":typestring
text"":typestring
out-pnil
width0:typeinteger
height0:typeinteger
patternnil
defuncommunicator-clock-string
unix-seconds

unix-seconds as a local HH:MM.

multiple-value-bind
decode-universal-time
+unix-seconds2208988800
declare
ignoresecond
formatnil"~2,'0D:~2,'0D"hourminute
defunwrap-communicator-text
textcolumns

text broken into lines of at most columns characters, on spaces when it can and mid-word when a word is longer than the whole line.

let
lines'
current
make-string-output-stream
flet
flush
let
line
get-output-stream-stringcurrent
when
plusp
lengthline
pushlinelines
setflength0
dolist
paragraph
uiop:split-stringtext:separator'
#\Newline
dolist
word
remove""
uiop:split-stringparagraph:separator'
#\Space
:test#'string=
loopwhile
>
lengthword
columns
do
flush
push
subseqword0columns
lines
setfword
subseqwordcolumns
when
and
plusplength
>columns
flush
when
plusplength
write-char#\Spacecurrent
incflength
write-stringwordcurrent
incflength
lengthword
flush
or
nreverselines
list""

The console

A thread, a mailbox, and a slot. The thread holds the only reference to the roster that anything dereferences, and its Telegram connection is bound thread-locally so that a console never disturbs whatever the listener is doing with TELEGRAM.CLIENT:*connection*.

defclasstelegram-console
roster:initform
telegram.chat:make-roster
:readerconsole-roster
requests:initform
sb-concurrency:make-mailbox:name"telegram console"
:readerconsole-requests
thread:initformnil:accessorconsole-thread
running-p:initformt:accessorconsole-running-p
view:initform
make-console-view:status"starting"
:accessorconsole-view
selected:initformnil:accessorconsole-selected
generation:initform0:accessorconsole-generation

Photo id to a decoded pattern, or :UNAVAILABLE for one that will not decode -- which has to be remembered too, or a broken picture is refetched on every pass forever.

photos:initform
make-hash-table:test#'eql
:readerconsole-photos
wanted-photos:initform'
:accessorconsole-wanted-photos

A film the console has fetched and the render thread has not started yet. Opening it makes GPU resources, so the console only downloads.

pending-film:initformnil:accessorconsole-pending-film

The last thing that went wrong, kept until something goes right. A failure passed to one publish-console-view would otherwise be erased by the very next publish, which is a good way never to see an error.

failure:initformnil:accessorconsole-failure
transcript-limit:initarg:transcript-limit:initform40:readerconsole-transcript-limit
text-columns:initarg:text-columns:initform52:readerconsole-text-columns
poll-interval:initarg:poll-interval:initform2.0:readerconsole-poll-interval

The login, when there is one to do: which answer is wanted next, and what has been gathered so far. NIL means logged in, or trying to be.

login-stage:initformnil:accessorconsole-login-stage
login-note:initformnil:accessorconsole-login-note
pending-api-id:initformnil:accessorconsole-pending-api-id

The code login in progress, when there is one. It holds a live connection and lives only as long as this process, which is the whole point: a code is good for about a minute, so a login that outlived a restart is not one to resume.

login:initformnil:accessorconsole-login

The QR code as a bit array, rebuilt whenever the token changes. The console thread encodes it so the render thread only ever draws squares.

qr:initformnil:accessorconsole-qr
:documentation

One Telegram connection and roster, driven on its own thread, publishing a finished view for a McCLIM frame to paint.

defunconsole-request
consolename&optionalargument

Post a request to console's thread. Never blocks and never answers.

sb-concurrency:send-message
console-requestsconsole
consnameargument
console
defunconsole-selected-peer
console
let
key
console-selectedconsole
andkey
telegram.chat:roster-peer
console-rosterconsole
key
defunconsole-peer-subtitle
peer
cond
nullpeer
""
typeppeer'telegram.chat:channel-peer
if
telegram.chat:channel-peer-broadcast-ppeer
"channel""group"
typeppeer'telegram.chat:chat-peer
"group"
telegram.chat:user-peer-bot-ppeer
"bot"
telegram.chat:peer-usernamepeer
formatnil"@~A"
telegram.chat:peer-usernamepeer
t"private chat"
defunconsole-transcript-lines
consolepeer

peer's recent history as finished, wrapped transcript lines.

let*
roster
console-rosterconsole
history
telegram.chat:peer-historyrosterpeer
count
fill-pointerhistory
start
max0
-count
console-transcript-limitconsole
lines'
loopforindexfromstartbelowcountformessage=
arefhistoryindex
forsender=
telegram.chat:message-sender-labelrostermessage
forink=forphoto=
telegram.chat:chat-message-photomessage
do
push
make-transcript-line:kind:head:sendersender:inkink:time
communicator-clock-string
telegram.chat:chat-message-datemessage
:out-p
telegram.chat:chat-message-out-pmessage
lines
whenphoto
multiple-value-bind
thumb-widththumb-height
let
cached
gethash
telegram.chat:chat-photo-idphoto
console-photosconsole
unlesscached
pushnewphoto
console-wanted-photosconsole
:key#'telegram.chat:chat-photo-id
push
make-transcript-line:kind:photo:inkink:widththumb-width:heightthumb-height:pattern
and
typepcached'pattern
cached
lines
let
document
telegram.chat:chat-message-documentmessage
when
anddocument
telegram.chat:chat-document-video-pdocument
push
make-transcript-line:kind:video:inkink:documentdocument:text
telegram.chat:chat-document-labeldocument
lines
dolist
text
wrap-communicator-text
telegram.chat:chat-message-textmessage
console-text-columnsconsole
unless
and
orphoto
let
d
telegram.chat:chat-message-documentmessage
andd
telegram.chat:chat-document-video-pd
zerop
lengthtext
push
make-transcript-line:kind:body:texttext
lines
nreverselines
defunconsole-dialog-rows
console
let
roster
console-rosterconsole
loopforpeerin
telegram.chat:roster-orderroster
repeat24collect
make-dialog-row:key
telegram.chat:peer-keypeer
:label
telegram.chat:peer-labelpeer
:preview:unread
telegram.chat:peer-unread-countpeer
defunpublish-console-view
console&keystatusfailure

Build the next view and hand it to whoever repaints.

What is wanted is whatever this view turns out to reference; a picture scrolled out of the transcript stops being worth a round trip.

setf
console-wanted-photosconsole
'
whenfailure
setf
console-failureconsole
failure
let
stage
console-login-stageconsole
setf
console-viewconsole
make-console-view:generation
incf
console-generationconsole
:status
orstatus
ifstage"not logged in"
let
usertelegram.client:*user*
ifuser
formatnil"~A"
telegram.client:user-labeluser
"connected"
:failure
console-failureconsole
:title
cond
stage"Telegram"
peer
telegram.chat:peer-labelpeer
t"Conversations"
:subtitle:dialogs
unlessstage
:lines
andpeer
notstage
:loginstage:prompt:secret-p
eqstage:password
:qr
and
eqstage:qr
console-qrconsole
console

Logging in

BEGIN-LOGIN returns a CODE-LOGIN holding an open connection, and COMPLETE-LOGIN and COMPLETE-PASSWORD are handed it back. The console keeps it in a slot, so the panel's state is which question it is asking and which login is asking it, and a player who quits between the code being sent and typed comes back to a clean phone rather than to a prompt for a code Telegram forgot about an hour ago. Only the finished authorization key reaches the disk. Credentials go their own way: the api_id and hash typed here are written to ~/.telegram.env, where the library already looks.

defparameter*communicator-credential-file*

~/.telegram.env

defunconsole-login-prompt
console

The lines shown above the field for the login stage the console is at.

let
note
console-login-noteconsole
append
ecase
console-login-stageconsole
:api-id'
"This game needs a Telegram application""identity before it can log anyone in.""""Get one at my.telegram.org/apps, then""type its api_id here. Both values are""written to ~/.telegram.env.""""api_id:"
:api-hash'
"Now the api_hash:"
:qr'
"Open Telegram on your phone, go to""Settings, Devices, Link Desktop Device,""and point it at this code.""""Or type anything to use a phone number""and an SMS code instead."
:phone'
"Your phone number, with the country""code, as +46701234567.""""Phone:"
:code'
"Telegram has sent a code to another""device, or by SMS. Type it here.""""Code:"
:password'
"This account has a password.""""Password:"
andnote
list""note
defunforget-console-login
console

Drop any login in progress, closing the connection it was holding.

telegram.client:abandon-login
console-loginconsole
setf
console-loginconsole
nil
console-qrconsole
nil
defunenter-login-stage
consolestage&keynotefailure

Anything before :CODE means the login in hand is not the one being finished, so let go of its connection rather than leaking it.

unless
memberstage'
:code:password:qr
setf
console-login-stageconsole
stage
console-login-noteconsole
note
publish-console-viewconsole:failurefailure
defunwrite-communicator-credentials
api-idapi-hash
with-open-file
stream:direction:output:if-exists:supersede:external-format:utf-8
formatstream"TELEGRAM_API_ID=~D~%TELEGRAM_API_HASH=~A~%"api-idapi-hash
defunfinish-console-login
console

The connection is current and authorized: load and show conversations.

setf
console-login-stageconsole
nil
console-login-noteconsole
nil
console-loginconsole
nil
console-qrconsole
nil
console-failureconsole
nil

RESUME and COMPLETE-LOGIN bind the application identity only for their own extent; INVOKE needs it for every call after, so give this thread its own.

setftelegram.client:*application*
telegram.client:application-from-environment
publish-console-viewconsole:status"loading…"
telegram.chat:refresh-roster-dialogs
console-rosterconsole
:limit40
telegram.chat:synchronize-chat-updates
console-rosterconsole
defunshow-console-qr
console

Encode the login's current token and publish it.

let
login
console-loginconsole
setf
console-qrconsole
telegram.client:qr-login-moduleslogin
enter-login-stageconsole:qr:failure
unless
console-qrconsole
"no qrencode: type anything to log in by phone instead"
defunbegin-console-qr-login
console

Start a QR login and show its code, or fall back to asking for a number.

publish-console-viewconsole:status"asking for a code…"
handler-case
let
login
telegram.client:begin-qr-login
setf
console-loginconsole
login
error
condition
enter-login-stageconsole:phone:failure
princ-to-stringcondition
defunadvance-console-qr-login
console

One short wait for the phone to accept the code, then show whatever the login has now: the conversations, the password question, or a fresh code.

let*
login
console-loginconsole
token
telegram.client:qr-login-tokenlogin
telegram.client:poll-qr-loginlogin
cond
telegram.client:qr-login-userlogin
telegram.client:qr-login-password-hintlogin

The phone said yes and the account has a password: same question as a code login's, answered over this connection.

setf
console-qrconsole
nil
enter-login-stageconsole:password:note
let
hint
telegram.client:qr-login-password-hintlogin
when
plusp
lengthhint
formatnil"hint: ~A"hint
not
equalptoken
telegram.client:qr-login-tokenlogin
defgenericanswer-console-login
consolestageanswer
:documentation

Take answer, the player's reply at login stage, on the console's thread. Each stage either moves to the next or, on failure, stays and says why.

defmethodanswer-console-login
console
stage
eql:api-id
answer
let
id
ignore-errors
parse-integeranswer
ifid
progn
setf
console-pending-api-idconsole
id
enter-login-stageconsole:api-hash
enter-login-stageconsole:api-id:failure"an api_id is a number"
defmethodanswer-console-login
console
stage
eql:api-hash
answer
write-communicator-credentials
console-pending-api-idconsole
answer

A fresh identity from the file, replacing whatever the missing one left behind, so BEGIN-LOGIN sees the credentials just written.

setftelegram.client:*application*nil
enter-login-stageconsole:phone
defmethodanswer-console-login
console
stage
eql:qr
answer
declare
ignoreanswer
enter-login-stageconsole:phone
defmethodanswer-console-login
console
stage
eql:phone
answer
publish-console-viewconsole:status"sending code…"
handler-case
let
login
telegram.client:begin-loginanswer:stream
make-broadcast-stream
setf
console-loginconsole
login
enter-login-stageconsole:code:note
formatnil"sent by ~(~A~) to ~A"
telegram.client:code-login-deliverylogin
answer
error
condition
let
text
princ-to-stringcondition

A rejected identity is not the phone's fault: go back and ask for the credentials again rather than leaving the player stuck.

enter-login-stageconsole
if
search"API_ID_INVALID"text
:api-id:phone
:failuretext
defmethodanswer-console-login
console
stage
eql:code
answer
publish-console-viewconsole:status"signing in…"
handler-case
progn
telegram.client:complete-login
console-loginconsole
answer:password-readernil:stream
make-broadcast-stream
telegram.client:password-required
condition
enter-login-stageconsole:password:note
alexandria:when-let
hint
telegram.client:password-required-hintcondition
formatnil"hint: ~A"hint
error
condition
let
text
princ-to-stringcondition

An expired or already-spent code cannot be retyped: this login is over, so let it go and ask for the number again rather than keeping the player at a question with no right answer.

enter-login-stageconsole
if
or
search"PHONE_CODE_EXPIRED"text
search"was abandoned"text
:phone:code
:failuretext
defmethodanswer-console-login
console
stage
eql:password
answer
publish-console-viewconsole:status"checking…"
handler-case
progn
telegram.client:complete-password
console-loginconsole
answer:stream
make-broadcast-stream
error
condition
enter-login-stageconsole:password:note
console-login-noteconsole
:failure
princ-to-stringcondition
defgenericapply-console-request
consolenameargument
:documentation

Carry out one request on the console's own thread. Returns true when the published view should be rebuilt.

Adding a command the panel can ask for is a method here.

:method
consolenameargument
declare
ignoreconsolenameargument
nil
:method
console
name
eql:select
argument
setf
console-selectedconsole
argument
let
whenpeer
telegram.chat:refresh-peer-history
console-rosterconsole
peer:limit
console-transcript-limitconsole
telegram.chat:mark-peer-readpeer
t
:method
console
name
eql:send
argument
let
when
andpeer
plusp
lengthargument
telegram.chat:send-chat-message
console-rosterconsole
peerargument
t
:method
console
name
eql:play
argument

Fetch the whole film and leave it where the render thread will find it. Opening it here would make GPU resources on the wrong thread.

handler-case
setf
console-pending-filmconsole
write-temporary-octets
telegram.chat:download-chat-documentargument
error
condition
publish-console-viewconsole:failure
princ-to-stringcondition
t
:method
console
name
eql:login
argument
alexandria:when-let
stage
console-login-stageconsole
setf
console-failureconsole
nil
answer-console-loginconsolestageargument

answer-console-login publishes as it goes.

nil
:method
console
name
eql:refresh
argument
declare
ignoreargument
telegram.chat:refresh-roster-dialogs
console-rosterconsole
:limit40
let
whenpeer
telegram.chat:refresh-peer-history
console-rosterconsole
peer:limit
console-transcript-limitconsole
t
defundrain-console-requests
console
let
dirtynil
dolist
request
sb-concurrency:receive-pending-messages
console-requestsconsole
dirty
when
apply-console-requestconsole
carrequest
cdrrequest
setfdirtyt
defunopen-console-connection
console

Resume the stored session and load enough to show something -- or, when there is nothing to resume, start asking for what a login needs.

The connection is this thread's: TELEGRAM.CLIENT:*connection* is rebound around the whole loop, so RESUME makes it current here and nowhere else.

publish-console-viewconsole:status"connecting…"
let
stored
telegram.client:load-session
cond
null
ignore-errors
telegram.client:application-from-environment
enter-login-stageconsole:api-id
nullstored
t
handler-case
progn
telegram.client:resume
telegram.client:login-failed
condition

The key is stale or was logged out elsewhere: start over.

setf
console-failureconsole
princ-to-stringcondition
defunadopt-late-console-credentials
console

Leave the manual API-ID prompt when credentials appeared asynchronously. The next console pass opens normally, using a stored session or QR login.

when
and
eq:api-id
console-login-stageconsole
ignore-errors
telegram.client:application-from-environment
setf
console-login-stageconsole
nil
console-login-noteconsole
nil
console-failureconsole
nil
t
defunfetch-console-photos
console&key
limit2

Download and decode a few of the pictures the last view asked for.

A handful per pass rather than all of them: a transcript full of photographs would otherwise stall the update poll behind a queue of downloads, and the pictures appearing over a second or two is the better failure.

let
wanted
console-wanted-photosconsole
fetched0
dolist
photowanted
pluspfetched
when
>=fetchedlimit
return
pluspfetched
let
id
telegram.chat:chat-photo-idphoto
unless
gethashid
console-photosconsole
setf
gethashid
console-photosconsole
or
handler-case
multiple-value-bind
decode-photo-pattern
telegram.chat:download-chat-photophoto
widthheight
error
nil
:unavailable
incffetched
defunadvance-telegram-console
console
unless
ortelegram.client:*connection*
console-login-stageconsole
when
console-login-stageconsole

Nothing to poll while logging in -- except a QR code, which is waiting on the phone rather than on the player.

if
eq:qr
console-login-stageconsole
progn
when
eq:qr
console-login-stageconsole
alexandria:when-let
request
sb-concurrency:receive-message
console-requestsconsole
:timeout0.25
apply-console-requestconsole
carrequest
cdrrequest
let
when
telegram.chat:pull-chat-updates
console-rosterconsole
setfdirtyt
whendirty

Pictures are fetched after the view that named them, so the text is on the wall before the photographs land on it.

sleep
console-poll-intervalconsole
defunrun-telegram-console
console

console's thread. Nothing in here touches McCLIM.

let
telegram.client:*connection*nil
telegram.client:*user*nil
telegram.client:*application*nil
unwind-protect
loopwhile
console-running-pconsole
do
handler-case
error
condition

A dropped socket is ordinary: Telegram closes an idle connection and the next call notices. Forget it and the next pass resumes. Any login in progress owned that connection, so it is over too: let it go and clear its stage, or the loop would keep polling a dead socket at a question no answer can advance -- the panel stuck saying "reconnecting" forever.

publish-console-viewconsole:status"reconnecting…":failure
princ-to-stringcondition
ignore-errors
setf
console-login-stageconsole
nil
console-login-noteconsole
nil
ignore-errors
telegram.client:disconnect
sleep3
ignore-errors
ignore-errors
telegram.client:disconnect
defunstart-telegram-console
&restinitargs
let
console
apply#'make-instance'telegram-consoleinitargs
setf
console-threadconsole
sb-thread:make-thread:name"luvcraft telegram console"
console
defunstop-telegram-console
console
setf
console-running-pconsole
nil
alexandria:when-let
thread
console-threadconsole
when
sb-thread:thread-alive-pthread
ignore-errors
sb-thread:join-threadthread:timeout5
setf
console-threadconsole
nil
console

Painting

defclasscommunicator-pane
application-pane
define-application-frameluvcraft-communicator
console:initarg:console:readercommunicator-console
display:initarg:display:initformnil:readercommunicator-display
geometry:initarg:geometry:initform*wall-communicator-geometry*:readercommunicator-geometry

Which of the two screens is showing, and what is half-typed. Both are the panel's own business and never leave the game thread.

screen:initform:dialogs:accessorcommunicator-screen
draft:initform"":accessorcommunicator-draft

How far back the transcript is pushed, in pixels above the bottom. Zero means pinned to the newest message, which is where a chat starts.

scroll:initform0:accessorcommunicator-scroll
content-height:initformnil:accessorcommunicator-content-height-cache
painted:initformnil:accessorcommunicator-painted
:menu-barnil
:panes
communicator
make-pane'communicator-pane:default-text-style
make-text-style:fixnil:normal
:layouts
default
horizontallycommunicator
defundraw-communicator-plate
streamlefttoprightbottom&keyrecessed-p
relief0.0
radius4

One bevelled panel, raised or recessed, optionally standing off the wall.

if
plusprelief
draw-analytic-rounded-rectangle*streamlefttoprightbottom:radiusradius:ink
draw-rectangle*streamlefttoprightbottom:inkink
let
draw-line*streamlefttoprighttop:inknear:line-thickness2
draw-line*streamlefttopleftbottom:inknear:line-thickness2
draw-line*streamleftbottomrightbottom:inkfar:line-thickness2
draw-line*streamrighttoprightbottom:inkfar:line-thickness2
defundraw-communicator-button
streamlefttoprightbottomglyph
draw-communicator-platestreamlefttoprightbottom:relief1.6:radius5
draw-text*streamglyph
/
+leftright
2.0
/
+topbottom
2.0
:align-x:center:align-y:center:text-size20:ink
make-rgb-color0.160.150.13
defundraw-communicator-avatar
streamnamelefttopsize

A little generated head. Telegram's own avatars are files this client cannot fetch yet; a hash of the name at least gives every speaker a stable face rather than a blank square.

let*
draw-rectangle*streamlefttop
+leftsize
+topsize
:ink
make-rgb-color0.160.160.16
dotimes
rowcells
dotimes
column
ceilingcells2
when
logbitp
mod
+
*row3
column
30
hash
dolist
mirrored
listcolumn
-cells1column
draw-rectangle*stream
+left
*mirroredstep
+top
+left
*
1+mirrored
step
+top
*
1+row
step
:inkink
draw-rectangle*streamlefttop
+leftsize
+topsize
:fillednil:line-thickness1:ink*communicator-bezel-dark*
luv:zdefun
draw-communicator-header:zone:telegram/paint/header
framepaneview
let

The header is part of the screen, not part of the bezel: cream text on a lit stone frame has no contrast, and the device reads as one dark pane behind one raised surround.

let*
chat-p
and
eq:chat
communicator-screenframe
not
console-view-loginview
text-left
+left
ifchat-p6014
whenchat-p
draw-communicator-buttonpane
+left6
22
+left48
70"‹"
draw-text*pane
console-view-titleview
text-left34:align-y:center:text-size19:ink*communicator-text-ink*
draw-text*pane
ifchat-p
console-view-subtitleview
console-view-statusview
text-left60:align-y:center:text-size12:ink*communicator-muted-ink*
draw-communicator-buttonpane
-right96
22
-right54
70"⌕"
draw-communicator-buttonpane
-right48
22
-right6
70"≡"
luv:zdefun
draw-communicator-dialogs:zone:telegram/paint/dialogs:value
length
console-view-dialogsview
paneview
let*
loopforrowin
console-view-dialogsview
forindexfrom0forrow-top=whiledo
when
oddpindex
draw-rectangle*paneleftrow-topright:ink*communicator-row-ink*
draw-communicator-avatarpane
dialog-row-labelrow
+left6
+row-top4
30
draw-text*pane
dialog-row-labelrow
+left46
+row-top15
:align-y:center:text-size15:ink
communicator-sender-ink
dialog-row-labelrow
draw-text*pane
dialog-row-previewrow
+left46
+row-top30
:align-y:center:text-size11:ink*communicator-muted-ink*
when
plusp
dialog-row-unreadrow
draw-analytic-rounded-rectangle*pane
-right46
+row-top8
-right10
+row-top30
:radius10:ink*communicator-accent-ink*
draw-text*pane
formatnil"~D"
dialog-row-unreadrow
-right28
+row-top19
:align-x:center:align-y:center:text-size12:ink
make-rgb-color0.050.10.05
defuntranscript-line-extent
line
case
transcript-line-kindline
:head24
:photo
+8
transcript-line-heightline
:video46
t18
defuncommunicator-content-height
view
reduce#'+
console-view-linesview
:key#'transcript-line-extent:initial-value0
defuncommunicator-scroll-limit
view

How far back the transcript can be pushed before it runs out of history.

defuncommunicator-transcript-layout
view&optional
scroll0

view's transcript as (LINE TOP height) triples, scroll pixels back.

Bottom-anchored like every chat: at scroll zero the newest line sits against the composer, and scrolling moves the whole column down to uncover older ones. Drawing and hit-testing both read this, which is the only way a click can land on the picture the player is actually looking at.

Lines that fall entirely outside the well are dropped; ones that straddle its edge are kept and clipped when drawn, so scrolling moves smoothly instead of a line at a time.

let*
lines
console-view-linesview
heights
total
reduce#'+heights:initial-value0
y
++communicator-screen-top+
min0
-availabletotal
max0scroll
loopforlineinlinesforheightinheightsfortop=ydo
incfyheight
whencollect
listlinetopheight
defundraw-communicator-scrollbar
paneviewscroll

A slim mark on the right of the well showing where the transcript is.

let
when
plusplimit
let*
track
-track-bottomtrack-top
thumb

Scroll counts backwards from the bottom, so a scroll of zero puts the thumb at the end of the track.

offset
round
*
-trackthumb
-1.0
/
minscrolllimit
limit
draw-rectangle*panextrack-top
+x4
track-bottom:ink
make-rgb-color0.140.140.14
draw-rectangle*panex
+track-topoffset
+x4
+track-topoffsetthumb
:ink
make-rgb-color0.420.420.40
defunadjust-communicator-scroll
frameview

Keep a scrolled-back transcript over the same messages as new ones arrive.

Pinned to the bottom it stays pinned, which is what a chat should do; pushed back, it holds its place instead of being dragged along by every arrival.

let
previous
communicator-content-height-cacheframe
when
andprevious
>totalprevious
plusp
communicator-scrollframe
incf
communicator-scrollframe
-totalprevious
setf
communicator-content-height-cacheframe
total
setf
communicator-scrollframe
max0
min
communicator-scrollframe
luv:zdefun
draw-communicator-transcript:zone:telegram/paint/transcript:value
length
console-view-linesview
paneframeview
"Paint the visible part of the transcript, clipped to the well."
draw-communicator-scrollbarpaneview
communicator-scrollframe
let
with-drawing-options
loopfor
lineyheight
indo
ecase
transcript-line-kindline
:head
draw-communicator-avatarpane
transcript-line-senderline
left
-y2
+communicator-avatar-size+
draw-text*pane
transcript-line-senderline
+left42
+y10
:align-y:center:text-size15:ink
transcript-line-inkline
draw-text*pane
transcript-line-timeline
right
+y10
:align-x:right:align-y:center:text-size11:ink*communicator-muted-ink*
:photo
let
width
transcript-line-widthline
height
transcript-line-heightline
pattern
transcript-line-patternline
ifpattern
draw-pattern*panepattern
+left42
y

Still downloading, or a picture that would not decode: keep its exact footprint so the transcript does not jump when it arrives.

draw-rectangle*pane
+left42
y
+left42width
:ink
make-rgb-color0.160.160.16
draw-rectangle*pane
+left42
y
+left42width
:fillednil:line-thickness1:ink*communicator-bezel-dark*
:video
let
document
transcript-line-documentline
draw-communicator-platepane
+left42
y
+left42260
+y38
:ink
make-rgb-color0.170.170.19
:recessed-pt
draw-communicator-buttonpane
+left48
+y4
+left80
+y34
"▶"
draw-text*pane
transcript-line-textline
+left90
+y13
:align-y:center:text-size12:ink*communicator-text-ink*
draw-text*pane
formatnil"~,1Fs ~,1FMB"
telegram.chat:chat-document-durationdocument
/
telegram.chat:chat-document-sizedocument
1048576.0
+left90
+y28
:align-y:center:text-size10:ink*communicator-muted-ink*
:body
draw-text*pane
transcript-line-textline
+left42
+y9
:align-y:center:text-size14:ink*communicator-text-ink*
defundraw-communicator-qr
panemodulestop

modules drawn under top, centred in the well. Returns the bottom edge.

One draw-lattice* primitive: the whole code -- paper, quiet zone, and modules together -- is a single analytic shape whose fragment integrates the module grid exactly over each pixel's footprint, so no module edge can composite against another and nothing shimmers as the phone moves. Whole pixels per module stopped mattering when the filtering became exact, so the code simply fills the well.

luv:zdefun
draw-communicator-login:zone:telegram/paint/login:value
list
length
console-view-promptview
and
console-view-qrview
t
paneview
"The login screen: what is being asked, in the well, above the field."
let
dolist
line
console-view-promptview
draw-text*panelinelefty:align-y:center:text-size13:ink
alexandria:when-let
modules
console-view-qrview
defuncommunicator-field-text
frameview

What the composer shows: the draft, or one dot per character of a secret.

let
draft
communicator-draftframe
if
console-view-secret-pview
make-string
lengthdraft
:initial-element#\•
draft
luv:zdefun
draw-communicator-composer:zone:telegram/paint/composer:value
length
communicator-draftframe
framepaneview
let
draw-communicator-platepane
+left52
-right60
:ink
make-rgb-color0.110.110.11
:recessed-pt
if
plusp
lengthdraft
draw-text*panedraft
+left64
:align-y:center:text-size15:ink*communicator-text-ink*
draw-text*pane
if
console-view-loginview
"""Message…"
+left64
:align-y:center:text-size15:ink*communicator-muted-ink*

The caret sits after the text rather than inside it, which is all a single-line composer with no selection needs.

let
caret-x
+left66
*8.4
lengthdraft
luv:zdefmethod
handle-repaint:zone:telegram/paint
declare
ignoreregion
let*
frame
pane-framepane
view
console-view
communicator-consoleframe
with-communicator-geometry
communicator-geometryframe
with-bounding-rectangle*
lefttoprightbottom
pane
with-sheet-medium
mediumpane

The bezel is the body of the device; everything else is inside it.

draw-rectangle*mediumlefttoprightbottom:ink*communicator-bezel-ink*
draw-rectangle*pane
+left3
+top3
-right3
-bottom3
:fillednil:line-thickness3:ink*communicator-bezel-light*
draw-rectangle*pane
+left6
+top6
-right6
-bottom6
:fillednil:line-thickness2:ink*communicator-bezel-dark*
cond
console-view-loginview
eq:chat
communicator-screenframe
alexandria:when-let
failure
console-view-failureview
draw-text*pane
subseqfailure0
min70
lengthfailure
+communicator-inset+:align-y:center:text-size10:ink
make-rgb-color0.850.420.36
setf
communicator-paintedframe
list
console-view-generationview
communicator-screenframe
communicator-draftframe
communicator-scrollframe
luv:zdefun
repaint-communicator:zone:telegram/repaint:value
length
communicator-draftframe
let
mirror
sheet-direct-mirror
frame-top-level-sheetframe
check-typemirrorluv-gpu-mirror
frame
defuncommunicator-paint-state
list
console-view-generation
console-view
communicator-consoleframe
communicator-screenframe
communicator-draftframe
communicator-scrollframe

The overlay on the wall

defclassluvcraft-communicator-overlay
display:initarg:display:readercommunicator-overlay-display
luv:zdefmethod
sessionpasssurface-texture
"Draw the panel flat on its wall, in the scene, with the world's depth."
declare
ignorepass
place-widget-overlay-on-surfaceoverlay
communicator-overlay-displayoverlay
session
let
viewport-size
luv:canvas-extent
luvcraft::luvcraft-session-contextsession
prepare-direct-widget-overlayoverlaysessionsurface-texture
world-device-clip-stateoverlaysession
firstviewport-size
secondviewport-size
overlay
luv:zdefmethod
luvcraft:refresh-luvcraft-overlay:zone:telegram/refresh:value
length
communicator-draft
widget-overlay-frameoverlay

Repaint only when the console has published something new, or the player has typed. This runs every frame, so it has to be cheap to say no.

declare
ignoresession
let*
frame
widget-overlay-frameoverlay
console
communicator-consoleframe

A film the console finished fetching is started here, on the thread that owns the device. The wall stays in :TELEGRAM mode: the film suppresses the panel while it runs and gives it back when it stops.

alexandria:when-let
path
console-pending-filmconsole
setf
console-pending-filmconsole
nil
let
display
communicator-overlay-displayoverlay
handler-case
progn
luvcraft:play-terminal-display-filmdisplaypath:hardware:auto
setf
luvcraft:terminal-display-modedisplay
:telegram
error
condition

Say so on the panel rather than dropping it: a film that will not open is the one thing the player is waiting on.

publish-console-viewconsole:failure
princ-to-stringcondition
overlay
defuncommunicator-texture-point
overlayevent

Where in the panel's own pixels a pointer event landed, or NIL.

alexandria:when-let
uv
luvcraft-widget-texture-coordinateoverlay
luv:canvas-pointer-event-xevent
luv:canvas-pointer-event-yevent
with-communicator-geometry
communicator-geometry
widget-overlay-frameoverlay
defunsubmit-communicator-draft

Enter, or the send button: an answer while logging in, else a message.

let*
console
communicator-consoleframe
view
console-viewconsole
draft
communicator-draftframe
cond
console-view-loginview
when
plusp
lengthdraft
console-requestconsole:logindraft
setf
communicator-draftframe
""
eq:chat
communicator-screenframe
console-requestconsole:senddraft
setf
communicator-draftframe
""
defunscroll-communicator

Move the transcript for one of the scrolling keys.

Clamping happens at paint time against the view that will actually be drawn, so this only has to say which way and how far.

with-communicator-geometry
communicator-geometryframe
let
view
console-view
communicator-consoleframe
setf
communicator-scrollframe
max0
min
casekey
:up
+
communicator-scrollframe
22
:down
-
communicator-scrollframe
22
:page-up
+
communicator-scrollframe
page
:page-down
-
communicator-scrollframe
page
:end0
t
communicator-scrollframe
defuncommunicator-video-line-at
viewyscroll

The playable video line at texture Y, if the click landed on one.

loopfor
linetopheight
inwhen
and
eq:video
transcript-line-kindline
<=topy
returnline
defmethodluvcraft:handle-luvcraft-overlay-event

Scroll the transcript under the pointer.

Only when the pointer is actually on the panel: a wheel turn aimed at the world should not quietly move a screen on a wall somewhere behind it.

declare
ignoresessioncanvas
when
and
eq:chat
communicator-screen
widget-overlay-frameoverlay
let
frame
widget-overlay-frameoverlay
view
console-view
communicator-console
widget-overlay-frameoverlay
with-communicator-geometry
communicator-geometryframe
setf
communicator-scrollframe
max0
min
round
+
communicator-scrollframe
*48
luv:canvas-pointer-event-scroll-yevent
t
defmethodluvcraft:handle-luvcraft-overlay-event
declare
ignoresessioncanvas
alexandria:when-let
when
and
eq:left
luv:canvas-pointer-event-buttonevent
destructuring-bind
xy
point
let*
frame
widget-overlay-frameoverlay
console
communicator-consoleframe
view
console-viewconsole
with-communicator-geometry
communicator-geometryframe
cond

Nothing else on the login screen is a control.

console-view-loginview
nil

The back button, which only exists on the conversation screen.

setf
communicator-screenframe
:dialogs
eq:dialogs
communicator-screenframe
alexandria:when-let
console-requestconsole:select
dialog-row-keyrow

A conversation opens at its newest message, not wherever the last one happened to be scrolled to.

setf
communicator-screenframe
:chat
communicator-scrollframe
0
communicator-content-height-cacheframe
nil
t

A click inside a video's plate plays it on the wall.

alexandria:when-let
line
communicator-video-line-atviewy
communicator-scrollframe
console-requestconsole:play
transcript-line-documentline
t
luv:zdefmethod
luvcraft:handle-luvcraft-focus-event:zone:telegram/key-input:value
length
communicator-draft
widget-overlay-frameoverlay
let*
frame
widget-overlay-frameoverlay
key
luv:canvas-key-event-key-nameevent
character
luv:canvas-key-event-characterevent
casekey

TAB belongs to the session: it is how the player leaves the wall, and a composer that ate it would trap them at the screen.

:tabnil
:up:down:page-up:page-down:home:end
t
:escape

One Escape leaves the conversation, the next leaves the wall.

if
eq:chat
communicator-screenframe
setf
communicator-screenframe
:dialogs
t
:v

Cmd-V or Ctrl-V pastes -- a two-factor password is not something anyone should have to type into a phone in a game -- taking the first line only, since the field is one line.

if
intersection'
:super:control
luv:canvas-key-event-modifiersevent
alexandria:when-let
setf
communicator-draftframe
concatenate'string
communicator-draftframe
string-trim'
#\Space#\Tab#\Return#\Newline
subseqtext0
position#\Newlinetext
when
andcharacter
graphic-char-pcharacter
setf
communicator-draftframe
concatenate'string
communicator-draftframe
stringcharacter
t
:backspace
let
draft
communicator-draftframe
when
plusp
lengthdraft
setf
communicator-draftframe
subseqdraft0
1-
lengthdraft
t
t
when
andcharacter
graphic-char-pcharacter
setf
communicator-draftframe
concatenate'string
communicator-draftframe
stringcharacter
t

The wall mode

defgenericcommunicator-geometry-for
display
:documentation

The panel shape that fits display's surface. A wall gets the wide panel; the phone gets the tall one. A new kind of surface adds a method.

defunopen-luvcraft-communicator
display&keyconsole

Mount a Telegram panel on display's surface -- a wall, or the phone.

let*
session
luvcraft::terminal-display-sessiondisplay
port
find-port:server-path'
:luv-gpu
manager
or
first
climi::frame-managersport
make-instance'luv-frame-manager:portport
console
orconsole
start-telegram-console:text-columns
communicator-geometry-text-columnsgeometry
frame
let
*embedded-mirror-target*
luvcraft:luvcraft-session-canvassession
*embedded-mirror-context*
luvcraft::luvcraft-session-contextsession
*embedded-mirror-device*
luvcraft::luvcraft-session-devicesession
with-communicator-geometry
geometry
make-application-frame'luvcraft-communicator:frame-managermanager:enablet:consoleconsole:displaydisplay:geometrygeometry
setf
frame-pretty-nameframe
"telegram"
let*
mirror
sheet-direct-mirror
frame-top-level-sheetframe
overlay
make-instance'luvcraft-communicator-overlay:sessionsession:frameframe:mirrormirror:displaydisplay

A little relief, so the buttons and the bezel actually stand off the surface instead of being painted on it.

:height-scale0.35
place-widget-overlay-on-surfaceoverlaydisplaysession
setf
mirror-compositormirror
overlay
luvcraft:terminal-display-mode-overlaydisplay
overlay
overlay
defmethodluvcraft:release-luvcraft-overlay

Stop the console thread and close its Telegram connection.

This is what makes a mode switch safe: the overlay is dropped by whoever is mounting the next one, and its thread has to go with it.

stop-telegram-console
communicator-console
widget-overlay-frameoverlay
call-next-method
defunclose-luvcraft-communicator
overlay
let
display
communicator-overlay-displayoverlay
when
eqoverlay
luvcraft:terminal-display-mode-overlaydisplay
setf
luvcraft:terminal-display-mode-overlaydisplay
nil
nil

Loading this system is what makes the wall offer a third mode, and what makes the phone come out of the pocket as a messenger rather than a shell.

pushnew:telegram*terminal-display-modes*
setf*terminal-display-modes*
sort#'<:key
lambda
mode
positionmode'
:shell:film:telegram