#!/usr/bin/env raku

use Termbox :ALL;

my $current-color = 0;
my $current-brush = 0;

my @BRUSHES = ' ', '░', '▒', '▓', '█';
my @COLORS  = (
    TB_BLACK,
    TB_RED,
    TB_GREEN,
    TB_YELLOW,
    TB_BLUE,
    TB_MAGENTA,
    TB_CYAN,
    TB_WHITE,
);

sub update-and-draw-buttons (
    Int $current is rw,
    Int $x,
    Int $y,
    Int $mouse-x,
    Int $mouse-y,
    Int $n,
    &callback,
) {
    my ( $lx, $ly ) = ( $x, $y );

    for ^$n -> $i {
        $current = $i
            if $lx <= $mouse-x <= $lx + 3 && $ly <= $mouse-y <= $ly + 1;

        my Int ( $r, $fg, $bg );

        callback( $i, $r, $fg, $bg );

        for ^4 {
            tb-change-cell( $lx + $^a, $ly + 0, $r, $fg, $bg );
            tb-change-cell( $lx + $^a, $ly + 1, $r, $fg, $bg );
        }

        $lx += 4;
    }

    ( $lx, $ly ) = ( $x, $y );

    for ^$n -> $i {
        my ( $r, $fg, $bg );

        if ( $current == $i ) {
            $fg = TB_RED +| TB_BOLD;
            $bg = TB_DEFAULT;
            $r  = tb-encode-string( '^' );
        }
        else {
            ( $r, $fg, $bg ) = ( tb-encode-string( ' ' ), 0, 0 );
        }

        tb-change-cell( $lx + $_, $ly + 2, $r, $fg, $bg ) for ^4;
        $lx += 4;
    }
}

sub rune-attr-callback (
    Int $i,
    Int $r  is rw,
    Int $fg is rw,
    Int $bg is rw,
) {
    $r  = tb-encode-string( @BRUSHES[$i] );
    $fg = TB_DEFAULT;
    $bg = TB_DEFAULT;
}

sub color-attr-callback (
    Int $i,
    Int $r  is rw,
    Int $fg is rw,
    Int $bg is rw,
) {
    $r  = tb-encode-string( ' ' );
    $fg = TB_DEFAULT;
    $bg = @COLORS[$i];
}

sub update-and-redraw-all ( @buffer, Int $x, Int $y ) {
    my $w = tb-width();

    if $x != -1 && $y != -1 {
        given @buffer[ $x; $y ] -> $cell {
            $cell.fg = @COLORS[ $current-color ];
            $cell.ch = tb-encode-string( @BRUSHES[ $current-brush ] );

            tb-put-cell( $x, $y, $cell );
        }
    }
    else {
        for @buffer.pairs -> ( :key($x), :value(@row) ) {
            for @row.pairs -> ( :key($y), :value($cell) ) {
                tb-put-cell( $x, $y, $cell );
            }
        }
    }

    my $h = tb-height();

    update-and-draw-buttons(
        $current-brush,
        0, 0,
        $x, $y,
        @BRUSHES.elems,
        &rune-attr-callback,
    );

    update-and-draw-buttons(
        $current-color,
        0, $h - 3,
        $x, $y,
        @COLORS.elems,
        &color-attr-callback,
    );

    tb-present();
}

sub realloc-back-buffer ( Int $w, Int $h, @buffer = () ) {
    for ^$w -> $x {
        for ^$h -> $y {
            @buffer[ $x; $y ] //= Termbox::Cell.new
        }
    }
}

sub MAIN () {
    if my $ret = tb-init() {
        note "tb-init() failed with error code $ret";
        return -1;
    }

    LEAVE tb-shutdown();

    tb-select-input-mode( TB_INPUT_ESC +| TB_INPUT_MOUSE );

    realloc-back-buffer( tb-width(), tb-height(), my @buffer );
    update-and-redraw-all( @buffer, -1, -1 );

    my $events = Supplier.new;
    start {
        while tb-poll-event( my $ev = Termbox::Event.new ) {
            $events.emit: $ev;
        }
    }

    react whenever $events.Supply -> $ev {
        my ( $x, $y ) = ( -1, -1 );

        given $ev.type {
            when $_ <= 0 {
                note 'termbox poll event error';
                done;
            }
            when TB_EVENT_KEY {
                # FIXME: The original demo existed on ESC. But somehow,
                # this program seems to sometimes fire spureous ESC
                # keypresses.
                done if $ev.ch && tb-decode-string( $ev.ch ) ~~ 'q';
            }
            when TB_EVENT_RESIZE {
                realloc-back-buffer( $ev.w, $ev.h, @buffer );
            }
            when TB_EVENT_MOUSE {
                given $ev.key {
                    when TB_KEY_MOUSE_LEFT {
                        ( $x, $y ) = ( $ev.x, $ev.y );
                    }
                }
            }
        }

        update-and-redraw-all( @buffer, $x, $y );
    }
}
