#!/bin/tclsh
# BIG DOG, rendered by fbdraw.
#
# Same game as bigdog.tcl, same physics, same dog. The difference is that
# nothing here touches a pixel: the whole frame is described to the compiled
# renderer as a few dozen command lines, and fbdraw owns /dev/fb0, the back
# buffer, and the writes.
#
# bigdog.tcl spent about 160 ms of a 164 ms frame inside the interpreter,
# building rows as Tcl lists one element at a time. That work does not get
# faster with a better algorithm in Tcl — it is per-pixel work in a language
# that charges per operation. So it moved to C, and what stays here is what
# Tcl is genuinely good at: deciding where things are.
#
# The frame is accumulated into ONE string and written with ONE puts. Sending
# each command separately would trade per-pixel interpreter cost for
# per-command pipe cost, which is a smaller version of the same mistake.
#
# fbdraw replies "ok <rows>" to `f`, and this script waits for it. That is the
# backpressure: the game cannot run ahead of the device, and the pipe cannot
# fill up behind it.
#
#   tclsh bigdog-fbdraw.tcl [W] [H] [frames] [auto] [fbdraw-path]

# W and H default to 0, meaning "whatever the device is" — resolved once the
# renderer has reported its geometry below. A hardcoded default would draw a
# 480x320 game into the corner of a 1024x768 canvas.
set W     [expr {[llength $argv] > 0 ? [lindex $argv 0] : 0}]
set H       [expr {[llength $argv] > 1 ? [lindex $argv 1] : 0}]
set FRAMES  [expr {[llength $argv] > 2 ? [lindex $argv 2] : 1000000}]
set AUTO    [expr {[llength $argv] > 3 ? [lindex $argv 3] : 1}]
set FBDRAW  [expr {[llength $argv] > 4 ? [lindex $argv 4] : "/bin/fbdraw"}]

# Colours are plain hex now — fbdraw packs them for whatever the device
# actually is, read from FBIOGET_VSCREENINFO. The old byte-order juggling
# (write B,G,R,A for XRGB, but do NOT swap again for a host-side read) was a
# standing trap; it is now the renderer's problem and it asks the driver.
set SKY      70c2e0
set SKY_DEEP 53a8c9
set GROUND   c9a96b
set GRASS    6aa84f
set PIPE     4c9e3f
set PIPE_DK  37762d
set FUR      c8924e
set FUR_DK   a27138
set MUZZLE   f0e2cb
set NOSE     2b221e
set EYE      1a1a1a
set EYE_W    ffffff
set COLLAR   c0393b
set STUD     e8c85a
set WING     fafaf2
set WING_DK  d2d6de
set INK      ffffff

# ---- the renderer ---------------------------------------------------------
if {[catch {set fb [open "|$FBDRAW" r+]} err]} {
    puts stderr "BIG DOG: cannot start renderer $FBDRAW: $err"
    exit 1
}
fconfigure $fb -buffering full -translation lf

# Ask the device what it is rather than assuming. A mismatch here is the
# difference between a game and a smear, and it is one line to check.
puts $fb "i" ; flush $fb
set geom [gets $fb]
lassign $geom DEV_W DEV_H DEV_STRIDE DEV_BYPP
if {$DEV_W eq "" } { puts stderr "BIG DOG: renderer gave no geometry" ; exit 1 }

# Say what the display actually is, on the console, every run. When a frame
# comes out wrong the first question is always "what geometry did it get?",
# and on a machine whose screen is the thing that is broken, the console is
# the only place that answer can safely appear.
puts "BIG DOG: display ${DEV_W}x${DEV_H} stride=${DEV_STRIDE} bypp=${DEV_BYPP}\
 (stride/bypp=[expr {$DEV_STRIDE/$DEV_BYPP}] px, stride%32=[expr {$DEV_STRIDE%32}])"
flush stdout
if {$W <= 0 || $W > $DEV_W} { set W $DEV_W }
if {$H <= 0 || $H > $DEV_H} { set H $DEV_H }

# Playfield proportions follow the screen we actually got, so the game reads
# the same on a 480x320 panel and on a full browser canvas.
set GROUND_H [expr {max(10, $H/10)}]
set PIPE_W   [expr {max(14, $W/14)}]
set GAP      [expr {max(46, $H*4/10)}]

set frame ""
proc cmd {s} { append ::frame $s "\n" }
proc rect {x y w h colour} {
    cmd "r [expr {int($x)}] [expr {int($y)}] [expr {int($w)}] [expr {int($h)}] $colour"
}
proc text {s x y scale colour} {
    cmd "t [expr {int($x)}] [expr {int($y)}] $scale $colour $s"
}

# Paint the sky once and tell fbdraw to keep it. From then on a whole-screen
# clear is one memcpy in C instead of H gradient rows in Tcl.
for {set y 0} {$y < $H} {incr y} {
    set t [expr {double($y) / max(1, $H-1)}]
    set r [expr {int(0x70 + (0x53 - 0x70) * $t)}]
    set g [expr {int(0xc2 + (0xa8 - 0xc2) * $t)}]
    set b [expr {int(0xe0 + (0xc9 - 0xe0) * $t)}]
    rect 0 $y $W 1 [format %02x%02x%02x $r $g $b]
}
cmd "bg"
puts -nonewline $fb $frame ; flush $fb
set frame ""

proc draw_dog {cx cy wingup} {
    global FUR FUR_DK MUZZLE NOSE EYE EYE_W COLLAR STUD WING WING_DK
    if {$wingup} {
        rect [expr {$cx-12}] [expr {$cy-16}] 9 5 $WING
        rect [expr {$cx-3}]  [expr {$cy-12}] 9 4 $WING
        rect [expr {$cx-12}] [expr {$cy-11}] 9 2 $WING_DK
    } else {
        rect [expr {$cx-13}] [expr {$cy+2}] 10 5 $WING
        rect [expr {$cx-4}]  [expr {$cy-1}]  9 4 $WING
        rect [expr {$cx-13}] [expr {$cy+7}] 10 2 $WING_DK
    }
    rect [expr {$cx-11}] [expr {$cy-6}] 18 13 $FUR
    rect [expr {$cx-11}] [expr {$cy+4}] 18 3  $FUR_DK
    rect [expr {$cx-13}] [expr {$cy+1}] 3  4  $FUR_DK
    rect [expr {$cx+2}] [expr {$cy-11}] 14 14 $FUR
    rect [expr {$cx+2}] [expr {$cy-11}] 14 2  $FUR_DK
    rect [expr {$cx+1}]  [expr {$cy-12}] 4 7 $FUR_DK
    rect [expr {$cx+13}] [expr {$cy-12}] 4 7 $FUR_DK
    rect [expr {$cx+5}]  [expr {$cy-3}] 11 6 $MUZZLE
    rect [expr {$cx+12}] [expr {$cy-2}] 4  3 $NOSE
    rect [expr {$cx+6}] [expr {$cy-8}] 4 4 $EYE_W
    rect [expr {$cx+7}] [expr {$cy-7}] 2 2 $EYE
    rect [expr {$cx+1}] [expr {$cy-1}] 3 8 $COLLAR
    rect [expr {$cx+1}] [expr {$cy+2}] 3 2 $STUD
}

# Send the frame and wait for it to reach the device. Returns rows written,
# which is also the cheapest possible view of how much actually moved.
proc present {} {
    global fb frame
    cmd "f"
    puts -nonewline $fb $frame ; flush $fb
    set frame ""
    set reply [gets $fb]
    return [lindex $reply 1]
}

# ---- state ----------------------------------------------------------------
set dogx    [expr {$W/4}]
set dogy    [expr {$H/2.0}]
set vel     0.0
set pipes   {}
set spacing [expr {max(60, $W*3/5)}]
set nextp   40
set score   0
set seed    12345
set tick    0
set fps     0.0
set nframes 0
set t0      [clock milliseconds]
set rowsw   0
set FLAPFILE "/home/.flap"
set lastflap ""

# TTY SETUP IS OPT-IN, AND THAT IS NOT A STYLE CHOICE.
#
# Putting the console in raw mode means `exec /bin/stty`, and stty's tcsetattr
# is an ioctl. In a browser machine that ioctl parks, and glibc leaks the
# kernel's -517 restart sentinel out of its errno path instead of re-issuing
# the call:
#
#   glibc-wasm32: RESTART-SENTINEL-LEAK val=517 nr=16 site=error_label
#
# stty then spins there forever and the game never reaches its first frame —
# a black screen with no error, which is the worst way to fail. Headless this
# never fires: stdin is a pipe, `/dev/tty` will not open, and the catch skips
# the whole thing. So the browser is the only place it bites.
#
# Without raw mode the console stays line-buffered, so a flap needs SPACE then
# ENTER. That is a worse control scheme and a working game, in that order.
# Set BIGDOG_TTY=1 to ask for raw mode once the ioctl leaf is fixed.
set STDIN_OK 0
if {[info exists env(BIGDOG_TTY)] && $env(BIGDOG_TTY) eq "1"} {
    catch {exec /bin/stty raw -echo -icanon min 0 time 0 < /dev/tty 2>/dev/null}
}
if {!$AUTO && [info exists env(BIGDOG_TTY)] && $env(BIGDOG_TTY) eq "1"} {
    if {![catch {fconfigure stdin -blocking 0 -translation binary}]} { set STDIN_OK 1 }
}
catch {set fh [open $FLAPFILE r] ; set lastflap [string trim [read $fh]] ; close $fh}

# ---- the real keyboard: /dev/input/event0, not the tty ---------------------
#
# The console is the wrong place to take keys from here. Reading it means
# putting the channel in non-blocking mode, which is a tty ioctl, and tty
# ioctls leak the kernel's -517 restart sentinel out of glibc on this platform
# — the same fault that hangs `stty`. A game that spins on that never sees a
# keystroke, which is exactly what happened.
#
# The display already has a keyboard attached to it: the kernel registers
# `brintos-virtio-input` as input0, and the Screen pane feeds it. Reading
# /dev/input/event0 is an ordinary read() on a character device, so it never
# touches the leaky leaf.
#
# CLICK THE SCREEN PANE, not the console — the keys follow the focus.
#
# An evdev record on wasm32 is 16 BYTES, not the 24 a 64-bit Linux gives you:
#   u32 tv_sec | u32 tv_usec | u16 type | u16 code | s32 value
# so the scan is `x8ssi` (skip 8, two shorts, one int). `x8susui` fails with
# "not enough arguments for all format specifiers" — that cost a round once.
set EVDEV ""
set evbuf ""
set inputs 0
if {![catch {open /dev/input/event0 r} ev]} {
    if {[catch {fconfigure $ev -blocking 0 -translation binary}]} {
        catch {close $ev}
    } else {
        set EVDEV $ev
    }
}
# Linux keycodes; the device advertises EV=7 (SYN|KEY|REL) and no ABS axes.
set KEY_Q 16 ; set KEY_W 17 ; set KEY_SPACE 57 ; set KEY_UP 103
set BTN_LEFT 272
if {$EVDEV ne ""} {
    puts "BIG DOG: keyboard = /dev/input/event0 - CLICK THE SCREEN PANE, then SPACE or W to flap, Q to quit"
} else {
    puts "BIG DOG: keyboard = NONE (/dev/input/event0 would not open) - demo mode only"
}
flush stdout

# KD_GRAPHICS stops fbcon repainting the console over the playfield, but it is
# another tty ioctl on the same leaky leaf, so it rides the same opt-in. The
# cost of leaving it off is cosmetic (fbcon may repaint over the game); the
# cost of hanging on it is a black screen. Cosmetic loses to visible.
if {[info exists env(BIGDOG_TTY)] && $env(BIGDOG_TTY) eq "1"} { cmd "g" }

while {$tick < $FRAMES} {
    set seed [expr {($seed * 1103515245 + 12345) & 0x7fffffff}]
    if {$nextp <= 0} {
        set span [expr {max(1, $H - $GROUND_H - $GAP - 50)}]
        lappend pipes [list $W [expr {$GROUND_H + 20 + ($seed % $span)}]]
        set nextp $spacing
    }
    incr nextp -3

    # Keyboard and mouse, straight off the input device.
    if {$EVDEV ne ""} {
        if {[catch {append evbuf [read $EVDEV 4096]}]} {
            catch {close $EVDEV} ; set EVDEV ""
        }
        # Buffer and consume whole 16-byte records: a partial read must not
        # desync the stream, or every later record is garbage.
        while {[string length $evbuf] >= 16} {
            set rec   [string range $evbuf 0 15]
            set evbuf [string range $evbuf 16 end]
            binary scan $rec x8ssi etype ecode evalue
            if {$etype == 1 && $evalue == 1} {
                incr inputs
                if {$ecode == $KEY_SPACE || $ecode == $KEY_W ||
                    $ecode == $KEY_UP    || $ecode == $BTN_LEFT} {
                    set vel -5.2
                }
                if {$ecode == $KEY_Q} { set tick $FRAMES ; break }
            }
        }
    }
    if {$STDIN_OK} {
        if {[catch {
            while {[set k [read stdin 1]] ne ""} {
                if {$k eq " " || $k eq "w" || $k eq "\r" || $k eq "\n"} { set vel -5.2 }
                if {$k eq "q"} { set tick $FRAMES ; break }
            }
        }]} { set STDIN_OK 0 }
    }
    if {[catch {set fh [open $FLAPFILE r]} err] == 0} {
        set nowflap [string trim [read $fh]]
        close $fh
        if {$nowflap ne $lastflap} { set lastflap $nowflap ; set vel -5.2 }
    }
    if {$AUTO && ($tick % 14 == 0)} { set vel -5.2 }
    if {$AUTO && $dogy > $H - $GROUND_H - 26} { set vel -5.2 }

    set wingup [expr {$vel < 0}]
    set vel  [expr {$vel + 0.55}]
    set dogy [expr {$dogy + $vel}]
    if {$dogy < 14} { set dogy 14 ; set vel 0.0 }
    set floor [expr {$H - $GROUND_H - 14}]
    if {$dogy > $floor} { set dogy $floor ; set vel 0.0 }

    set moved {}
    foreach p $pipes {
        set nx [expr {[lindex $p 0] - 3}]
        if {$nx + $PIPE_W < 0} { incr score } else { lappend moved [list $nx [lindex $p 1]] }
    }
    set pipes $moved

    set dl [expr {$dogx - 9}]  ; set dr [expr {$dogx + 15}]
    set dt [expr {int($dogy) - 9}] ; set db [expr {int($dogy) + 6}]
    set hit 0
    foreach p $pipes {
        set px [lindex $p 0] ; set gt [lindex $p 1]
        if {$dr > $px && $dl < $px + $PIPE_W} {
            if {$dt < $gt || $db > $gt + $GAP} { set hit 1 ; break }
        }
    }
    if {$db >= $H - $GROUND_H} { set hit 1 }

    # ---- draw ------------------------------------------------------------
    cmd "c"
    foreach p $pipes {
        set px [lindex $p 0] ; set gt [lindex $p 1]
        rect $px 0 $PIPE_W $gt $PIPE
        rect [expr {$px-2}] [expr {$gt-12}] [expr {$PIPE_W+4}] 12 $PIPE_DK
        set low [expr {$gt + $GAP}]
        rect $px $low $PIPE_W [expr {$H - $low - $GROUND_H}] $PIPE
        rect [expr {$px-2}] $low [expr {$PIPE_W+4}] 12 $PIPE_DK
    }
    rect 0 [expr {$H-$GROUND_H}] $W $GROUND_H $GROUND
    rect 0 [expr {$H-$GROUND_H}] $W 4 $GRASS
    draw_dog $dogx [expr {int($dogy)}] [expr {$hit ? 0 : $wingup}]

    set s [expr {max(2, $H/110)}]
    text "BIG DOG" 8 8 $s $INK
    set sc [format %d $score]
    text $sc [expr {$W - 8 - 4*$s*[string length $sc]}] 8 $s $INK
    # IN is the count of key/button presses seen on /dev/input/event0. If it
    # stays 0 while you mash keys, the events are not reaching the guest and
    # the fault is upstream of this game — worth knowing at a glance.
    set fl [format "%.0f FPS %d ROWS IN %d" $fps $rowsw $inputs]
    text $fl [expr {$W - 8 - 4*$s*[string length $fl]}] [expr {8 + 7*$s}] $s $INK

    if {$hit} {
        set gs [expr {max(1, $H/60)}]
        set gw [expr {4*$gs*9}]
        rect [expr {($W-$gw)/2 - 6}] [expr {$H/2 - 12}] [expr {$gw+12}] [expr {5*$gs+16}] $PIPE_DK
        text "GAME OVER" [expr {($W-$gw)/2}] [expr {$H/2 - 4}] $gs $INK
    }

    set rowsw [present]

    if {$hit} {
        after 1500
        set dogy [expr {$H/2.0}] ; set vel 0.0
        set pipes {} ; set nextp 40 ; set score 0
        set t0 [clock milliseconds] ; set nframes 0
    }

    incr tick
    incr nframes
    set dt_ms [expr {[clock milliseconds] - $t0}]
    if {$dt_ms >= 1000} {
        set fps [expr {1000.0 * $nframes / $dt_ms}]
        set nframes 0
        set t0 [clock milliseconds]
    }
}

# Only ask for text mode back if we ever left it (same leaky ioctl leaf).
if {[info exists env(BIGDOG_TTY)] && $env(BIGDOG_TTY) eq "1"} { cmd "x" }
cmd "q"
puts -nonewline $fb $frame ; flush $fb
catch {close $fb}
catch {exec /bin/stty sane < /dev/tty 2>/dev/null}
puts "BIG DOG: $tick frames, score $score, [format %.1f $fps] fps"