#!/usr/bin/env perl
# PODNAME: cubepipe
# ABSTRACT: control the hypnocube via commands coming in over a named pipe

# this will be a daemon process
# sample commands:-
# clear black
# clear 0,0,0
# pixel 2,2,2 blue
# pixel 2,2,1 255,255,255
# update
# xplane 0 green
# zplane 1 255,255,255
# sphere red
# update
# frame [64 sets of rgb values] in correct order
# update
# ### not this ### getframe [gets current displayed frame]]
# ### not this ### info

use 5.16.0 ;
use strict ;
use warnings ;
use Fcntl ;
use Device::Hypnocube ;
use Time::HiRes qw( sleep) ;
use Try::Tiny ;
use App::Basis ;
use Data::Printer ;

# ----------------------------------------------------------------------------

use constant FLASH_SLEEP => 0.5 ;
use constant PULSE_SLEEP => 0.2 ;

# 30 times/second is the highest frequency we can write to the cube
use constant FREQUENCY => 30 ;

# derive a clock tick, make sure its fractional and not an int!
use constant TICK => 1.0 / FREQUENCY ;

# ----------------------------------------------------------------------------

# set hypnocube defaults
#my $DEVICE = '/dev/ttyUSB0' ;
my $DEVICE       = '/dev/ttyS0' ;
my $DEFAULT_FIFO = '/tmp/hypnocube' ;

my $remove_pipe  = 0 ;
my %pulse_colors = (
    red    => [ 1, 0, 0 ],
    blue   => [ 0, 0, 1 ],
    green  => [ 0, 1, 0 ],
    yellow => [ 1, 1, 0 ],
    white  => [ 1, 1, 1 ],
    lilac  => [ 1, 0, 1 ],
    cyan   => [ 0, 1, 1 ],
) ;

# ----------------------------------------------------------------------------

my %valid_commands = (

    # repeat is a special command handled in process_line
    # I did consider having an alias thing for the aliases
    # but TBH repetition is much easier!
    update   => \&_update,
    all      => \&_clear,
    cls      => \&_clear,
    clear    => \&_clear,
    pix      => \&_pixel,
    pixel    => \&_pixel,
    xyz      => \&_pixel,
    i        => \&_position,
    index    => \&_position,
    pos      => \&_position,
    position => \&_position,
    x        => \&_xplane,
    xp       => \&_xplane,
    xplane   => \&_xplane,
    y        => \&_yplane,
    yp       => \&_yplane,
    yplane   => \&_yplane,
    z        => \&_zplane,
    zp       => \&_zplane,
    zplane   => \&_zplane,
    sphere   => \&_sphere,
    sleep    => \&_sleep,
    pulse    => \&_pulse,
    flash    => \&_background_flash,
    matrix   => \&_background_matrix,
    colors   => \&_colors,
    yline    => \&_yline,
    xline    => \&_xline,
    zline    => \&_zline,
) ;

# ----------------------------------------------------------------------------
my $background_process ;
my $background_name ;
my $background_must_wait ;

# ----------------------------------------------------------------------------
sub set_background_name
{
    $background_name = shift ;
}

# ----------------------------------------------------------------------------
sub set_background_process
{
    $background_process = shift ;
    $background_must_wait = shift || 1 ;
}

# ----------------------------------------------------------------------------
# remove the background process
sub stop_background
{
    set_background_name(undef) ;
    set_background_process(undef) ;
}

# ----------------------------------------------------------------------------
# run through the background process once
sub tick_background
{
    $background_process->() ;
}

# ----------------------------------------------------------------------------
# wait for the background_process to finish
# unless its interuptable, in which case stop it now!
sub wait_background
{
    if ($background_must_wait) {
        while ($background_process) {
            tick_background() ;
            sleep(TICK) ;
        }
    }
}

# ----------------------------------------------------------------------------
# clean up when we are finished
sub cleanup_func
{
    if ($remove_pipe) {
        unlink($DEFAULT_FIFO) ;
    }
}

# -----------------------------------------------------------------------------
# update the framebuffer into the cube
sub _update
{
    my $self_name = shift ;
    my $cube      = shift ;
    my @args      = @_ ;
    $cube->update() ;
}

# -----------------------------------------------------------------------------
# set entire cube to one color
# ### clear black
# ### clear 0,0,0
sub _clear
{
    my $self_name = shift ;
    my $cube      = shift ;
    my @args      = @_ ;
    $cube->clear(@args) ;
}

# -----------------------------------------------------------------------------
# set a single pixel to one color
# ### pixel 2,2,2 blue
# ### pixel 2,2,1 255,255,255
sub _pixel
{
    my $self_name = shift ;
    my $cube      = shift ;
    my @args      = @_ ;
    $cube->pixel(@args) ;
}

# -----------------------------------------------------------------------------
# set the numbered position (0..63) to a color
# position 10 red
# position 32 red
sub _position
{
    my $self_name = shift ;
    my $cube      = shift ;
    my @args      = @_ ;
    my $pos       = shift @args ;    # get the position

    # limit size, wrap around
    # no finesse here, work on the basis that it is 4x4x4 cube
    my $x = $pos & 3 ;
    $pos >>= 2 ;
    my $y = $pos & 3 ;
    $pos >>= 2 ;
    my $z = $pos & 3 ;

    # pass rest of the colour data through
    $cube->pixel( $x, $y, $z, @args ) ;
}

# -----------------------------------------------------------------------------
# set an entire plane to a single color
# ### xplane 0 green
sub _xplane
{
    my $self_name = shift ;
    my $cube      = shift ;
    my @args      = @_ ;
    $cube->xplane(@args) ;
}

# -----------------------------------------------------------------------------
# ### yplane 2 255,255,255
sub _yplane
{
    my $self_name = shift ;
    my $cube      = shift ;
    my @args      = @_ ;
    $cube->yplane(@args) ;
}

# -----------------------------------------------------------------------------
# ### zplane 1 255,255,255
sub _zplane
{
    my $self_name = shift ;
    my $cube      = shift ;
    my @args      = @_ ;
    $cube->zplane(@args) ;
}

# -----------------------------------------------------------------------------
# draw a sphere into the cuble
# sphere red
sub _sphere
{
    my $self_name = shift ;
    my $cube      = shift ;
    my @args      = @_ ;
    $cube->clear(@args) ;
    for ( my $i = 0; $i < 4; $i++ ) {
        $cube->pixel( 0,  0,  $i, 'black' ) ;
        $cube->pixel( 0,  3,  $i, 'black' ) ;
        $cube->pixel( 3,  0,  $i, 'black' ) ;
        $cube->pixel( 3,  3,  $i, 'black' ) ;
        $cube->pixel( 0,  $i, 0,  'black' ) ;
        $cube->pixel( 0,  $i, 3,  'black' ) ;
        $cube->pixel( 3,  $i, 0,  'black' ) ;
        $cube->pixel( 3,  $i, 3,  'black' ) ;
        $cube->pixel( $i, 0,  0,  'black' ) ;
        $cube->pixel( $i, 0,  3,  'black' ) ;
        $cube->pixel( $i, 3,  0,  'black' ) ;
        $cube->pixel( $i, 3,  3,  'black' ) ;
    }
}

# -----------------------------------------------------------------------------
# sleep for tenths of a second, cannot be interrupted
# ### sleep 0.1
sub _sleep
{
    my $self_name = shift ;
    my $cube      = shift ;
    my ($sleep)   = @_ ;
    $cube->update() ;
    $sleep ||= 1 ;
    $sleep = $sleep < 10 ? $sleep : 10 ;

    sleep($sleep) ;
}

# -----------------------------------------------------------------------------
# pulse the entire cube color up and down
# ### pulse 5 red
sub _pulse
{
    my $self_name = shift ;
    my $cube      = shift ;
    my @args      = @_ ;
    my $counter   = $args[0] || 0 ;
    $counter = 3 if ( $counter > 3 ) ;    # for max pulse as 3
    my $color = $args[1] ;
    $color = 'white' if ( !grep( /$color/, keys %pulse_colors ) ) ;
    for ( my $i = 0; $i < $args[0]; $i++ ) {

        # on
        my @val = qw( 0 31 63 95 127 159 191 223 255) ;
        for ( my $j = 0; $j <= 8; $j++ ) {
            my @a = map { $_ * $val[$j] } @{ $pulse_colors{$color} } ;
            $cube->clear(@a) ;
            $cube->update() ;
            sleep(PULSE_SLEEP) ;
        }

        # pulsing leaves the color on, so skip last off
        last if ( $i >= $counter - 1 ) ;

        # off
        for ( my $j = 0; $j <= 8; $j++ ) {
            my @a = map { $_ * $val[ 8 - $j ] } @{ $pulse_colors{$color} } ;
            $cube->clear(@a) ;
            $cube->update() ;
        }
    }
}

# -----------------------------------------------------------------------------
# display all the colors
sub _colors
{
    my $self_name = shift ;
    my $cube      = shift ;

    # get the buffer just to get the correct sized thing
    $cube->clear() ;
    my $buffer = $cube->get_buffer() ;
    my @colors = $cube->list_colors() ;

    # say STDERR scalar( @colors) . "colors:\n  " . join( "\n  ", @colors) ;
    # add to the start of the buffer and remove from the end
    foreach my $c (@colors) {
        unshift @{$buffer},
            [ $cube->get_color( $c, undef, undef, 'black' ) ] ;
        pop @{$buffer} ;
    }

    $cube->set_buffer($buffer) ;
}

# -----------------------------------------------------------------------------
# draw a vertical line of color
# yline 1 red
# yline 2 3 green

sub _yline
{
    my $self_name = shift ;
    my $cube      = shift ;
    my @args      = @_ ;
    my ( $x, $y, $z, $color ) ;

    $y = 0 ;
    if ( @args == 2 ) {
        $x     = int( $args[0] / 4 ) ;
        $z     = $args[0] % 4 ;
        $color = $args[1] ;
    } else {
        $x     = $args[0] % 4 ;
        $z     = $args[1] % 4 ;
        $color = $args[2] ;
    }

    $cube->pixel( $x, $y,     $z, $color ) ;
    $cube->pixel( $x, $y + 1, $z, $color ) ;
    $cube->pixel( $x, $y + 2, $z, $color ) ;
    $cube->pixel( $x, $y + 3, $z, $color ) ;
}


# -----------------------------------------------------------------------------
# draw a horizontal line of color
# xline 1 red
# xline 2 3 green

sub _xline
{
    my $self_name = shift ;
    my $cube      = shift ;
    my @args      = @_ ;
    my ( $x, $y, $z, $color ) ;

    $x = 0 ;
    if ( @args == 2 ) {
        $y     = int( $args[0] / 4 ) ;
        $z     = $args[0] % 4 ;
        $color = $args[1] ;
    } else {
        $y     = $args[0] % 4 ;
        $z     = $args[1] % 4 ;
        $color = $args[2] ;
    }

    $cube->pixel( $x,     $y, $z, $color ) ;
    $cube->pixel( $x + 1, $y, $z, $color ) ;
    $cube->pixel( $x + 2, $y, $z, $color ) ;
    $cube->pixel( $x + 3, $y, $z, $color ) ;
}

# -----------------------------------------------------------------------------
# draw a z-index line of color
# zline 1 red
# zline 2 3 green

sub _zline
{
    my $self_name = shift ;
    my $cube      = shift ;
    my @args      = @_ ;
    my ( $x, $y, $z, $color ) ;

    $z = 0 ;
    if ( @args == 2 ) {
        $x     = int( $args[0] / 4 ) ;
        $y     = $args[0] % 4 ;
        $color = $args[1] ;
    } else {
        $x     = $args[0] % 4 ;
        $y     = $args[1] % 4 ;
        $color = $args[2] ;
    }

    $cube->pixel( $x, $y, $z,     $color ) ;
    $cube->pixel( $x, $y, $z + 1, $color ) ;
    $cube->pixel( $x, $y, $z + 2, $color ) ;
    $cube->pixel( $x, $y, $z + 3, $color ) ;
}

# -----------------------------------------------------------------------------
# flash the cube on and off a number of times as a background_process
# ### flash 5
sub _background_flash
{
    my $self_name = shift ;
    my $cube      = shift ;
    my ($counter) = @_ ;
    $counter //= 0 ;
    $counter = $counter <= 10 ? $counter : 10 ;   # restrict to 10 flashes max
    my $buffer = $cube->get_buffer() ;

    # setup anonymous sub to handle the background stuff
    set_background_name($self_name) ;
    set_background_process(
        sub {

            # variables need to persist over repeated calls to this sub
            state $count = 0 ;
            state $loops = 0 ;

            $count++ ;
            if ( $count == int( FREQUENCY / 3 ) ) {    # 1/3 sec
                $cube->clear('black') ;
                $cube->update() ;
            } elsif ( $count == int( ( 2 * FREQUENCY ) / 3 ) )
            {                                          # next 1/3 sec
                $cube->set_buffer($buffer) ;
                $cube->update() ;
                $count = 0 ;
                if ( ++$loops >= $counter ) {

                    # remove ourselves from the background process
                    stop_background() ;
                }
            }
        },
        1    # we want to wait for this to complete
    ) ;
}

# -----------------------------------------------------------------------------
# get a 1 in 'chance' value
sub _chance
{
    my ($chance) = @_ ;

    return ( int( rand($chance) ) % ( $chance - 1 ) ) == 0 ;
}

# -----------------------------------------------------------------------------
# flash the cube on and off a number of times as a background_process
# ### matrix green
sub _background_matrix
{
    my $self_name = shift ;
    my $cube      = shift ;
    my (@args)    = @_ ;

    # default to green matrix
    $args[0] //= 'green' ;

    # and if a primary variant remove it
    $args[0] =~ s/^dark|^mid|^bright// ;

    my @colors = $cube->list_colors() ;
    my $mono   = 0 ;

    # if the color requested has variants lets mostly use a mono scheme
    $mono = 1 if ( grep( "mid$args[0]", @colors ) ) ;

    # setup anonymous sub to handle the background stuff
    set_background_name($self_name) ;
    set_background_process(
        sub {
            # variables need to persist over repeated calls to this sub
            state $count  = 0 ;
            state $planes = [] ;
            $count++ ;

            # we will change the state every 15 ticks
            $count %= ( FREQUENCY / 2 ) ;
            if ( !$count ) {

                # get the buffer just to get the correct sized thing
                my $buffer = $cube->get_buffer() ;

                # copy the contents of planes 0-2 to 1-3
                # and create a new plane 0
                # or add a new plane to the top of the stack and drop
                # the last one off!

                my $max = int( rand(10) ) ;

            # drop the first 16 items (4x4) plane from the buffer
            # and add new empty elements to the end to re-create the top plane
                for ( my $i = 0; $i < 16; $i++ ) {
                    shift @{$buffer} ;
                    push @{$buffer}, [ 0, 0, 0 ] ;
                }

                # add in our random pixels to the top plane (3)
                for ( my $i = 0; $i < $max; $i++ ) {
                    my $offset = $cube->buffer_offset( int( rand(4) ),
                        3, int( rand(4) ) ) ;

                    my ( $r, $g, $b )
                        = $cube->get_color( $args[0], $args[2], $args[2] ) ;

                    # decide if we are going to change the color
                    if ( _chance(10) ) {

                        if ( $mono && _chance(5) ) {

                            # lets pick versions of the main color
                            my @prefix = ( "dark", "mid", "", "bright" ) ;
                            my $p
                                = $prefix[ int( rand( scalar(@prefix) ) ) ] ;
                            ( $r, $g, $b ) = $cube->get_color("$p$args[0]") ;
                        } elsif ( ( $mono && _chance(20) )
                            || ( $args[0] =~ /^[\d|\s]+$/ && _chance(5) ) ) {
                            my $off = int( rand( scalar(@colors) ) ) ;
                            ( $r, $g, $b )
                                = $cube->get_color( $colors[$off] ) ;
                        }
                    } elsif ($mono) {

                        # lets choose the dark version most of the time
                        ( $r, $g, $b ) = $cube->get_color("dark$args[0]") ;
                    }
                    $buffer->[$offset] = [ $r, $g, $b ] ;
                }

                # write the new buffer and update
                $cube->set_buffer($buffer) ;
                $cube->update() ;
            }

        },
        0    # we must stop matix as soon as anything else wants to do stuff
    ) ;
}

# -----------------------------------------------------------------------------
# process the line and send relevant command to the cube
# ### frame [64 sets of rgb values] in correct order
# ### repeat 4
# ### flash 5
# we can have multiple lines split by semi-colons or colons

sub process_section
{
    my ( $cube, $sections, $verbose ) = @_ ;

    foreach my $line (@$sections) {

        # do things with the line
        # trim off lead/trail whitespace
        $line =~ s/^\s*(.*?)\s*$/$1/ ;
        next if ( !$line ) ;
        say "processing [$line] " if ($verbose) ;
        my ( $cmd, @args ) = split( /[\s,]/, $line ) ;
        next if ( !$cmd ) ;
        say "cmd '$cmd', args " . p(@args) if ($verbose) ;

        # lets not do any args error checking for now
        $_ = $cmd ;

        # special command to force wait for any background process to complete
        if ( $cmd eq 'wait' ) {
            wait_background() ;
        } else {
            my $handler = $valid_commands{$cmd} ;

            if ($handler) {

# if we are actioning a command then we must stop any existing background_process
                stop_background() ;

                $handler->( $cmd, $cube, @args ) ;
            } else {
                say "Unknown command $cmd" ;
            }
        }
    }
}

# -----------------------------------------------------------------------------
sub process_line
{
    my ( $cube, $lines, $verbose ) = @_ ;
    my @sections ;

    # colons or semi colons, helps when using cube script without quotes
    my @chunks = split( /[;:]/, $lines ) ;

    foreach my $ele (@chunks) {

        # handle the repeat command
        if ( $ele =~ /repeat\s*(\d+)/ ) {
            my $repeat = abs($1) ;
            $repeat ||= 1 ;
            while ( $repeat-- ) {
                process_section( $cube, \@sections, $verbose ) ;
            }
            @sections = () ;
        } else {
            push @sections, $ele ;
        }

    }

    # process any final sections
    if (@sections) {
        process_section( $cube, \@sections, $verbose ) ;
    }
}

# ----------------------------------------------------------------------------
# non blocking read from file/pipe
# http://davesource.com/Solutions/20080924.Perl-Non-blocking-Read-On-Pipes-Or-Files.html
# Returns:  ($eof,@lines)
sub nb_readlines
{
    state %nonblockGetLines_last
        ;    # hold onto some data for next time if needed
    my ( $fh, $timeout, $buffsize ) = @_ ;

    if ( !$fh ) {
        say "bad filehandle" ;
        return 1 ;
    }

    my $rfd = '' ;
    $nonblockGetLines_last{$fh} //= '' ;    # nothing previous for this fh

    $timeout //= 0 ;                        # timeout is 0 if not defined

    # get a large chunk if nothing is passed, don't allow 0
    $buffsize ||= 1024 * 1024 ;

    vec( $rfd, fileno($fh), 1 ) = 1 ;
    my $nfound = select( $rfd, undef, undef, $timeout ) ;
    return ( 0, 0 ) if ( !$nfound ) ;

    # I'm not sure the following is necessary?
    return ( 0, 0 ) if ( !vec( $rfd, fileno($fh), 1 ) ) ;
    my $buf = '' ;
    my $n = sysread( $fh, $buf, $buffsize ) ;

    # If we're done, make sure to send the last unfinished line
    return ( 1, $nonblockGetLines_last{$fh} ) if ( !$n ) ;

    # Prepend the last unfinished line
    $buf = $nonblockGetLines_last{$fh} . $buf ;

    # And save any newly unfinished lines
    $nonblockGetLines_last{$fh}
        = ( substr( $buf, -1 ) !~ /[\r\n]/ && $buf =~ s/([^\r\n]*)$// )
        ? $1
        : '' ;

    $buf ? ( 0, $buf ) : ( 0, undef ) ;
}

# ----------------------------------------------------------------------------

sub commands
{

    return '

It is easiest to use the cube command to control the cube, alternately send
the command to the pipe /tmp/hypnocube with echo "command" > /tmp/hypnocube

Colors can be either by HTML name (red,blue), by rgb values (255,255,0) or by 
hex triplet (#FF0000 or 0xFF0000). Short versions of these are also possible
#FF0 or 0X0ff.

Additionally "random" picks a random color and "clear"  or "off" is an alias for black.

Cube Commands

update   
    update the sube with the commands that have been entered

all, cls, clear {color}
    set all the LEDS to the named color
    requires update
    a random color will set the entire cube to a random value
    cube all 255,255,255 : update
    cube all 255 0 0 : update

pix, pixel, xyz  {x} {y} {z} {color}
    set a single pixel referenced with coordinates to a color
    requires update
    cube pixel 3 2 1 red : update

pos, position, index, i {index} {color}
    set a single pixel referenced with an index 0..63 to a color
    requires update
    cube index 23 red : update

x, xp, xplane {plane} {color} 
    set all LEDS in an X plane to a color
    requires update
    a random color will set all LEDS in the plane to different values
    cube xp 1 darkslategray : update

y, yp, yplane {plane} {color}
    set all LEDS in an Y plane to a color
    requires update
    a random color will set all LEDS in the plane to different values
    cube yplane 1 pink : update

z, zp, zplane {plane} {color}
    set all LEDS in an Z plane to a color
    requires update
    a random color will set all LEDS in the plane to different values
    cube z 1 goldenrod : update

sphere {color}  
    create a sphere of LEDS in the given color
    requires update
    a random color will set the entire sphere to a random value
    cube sphere random : update

sleep {time}
    pause the activity for a number of seconds

pulse {times} {color}
    clears the cube and the pulses the color for a maximum of 3 times
    requires update
    cube pulse 2 green

flash {times}   
    flash the current cube setting on and off for a number of times
    this happends in the background so can be interrupted by another command
    does not requires update
    cube flash 10

matrix {color}
    run a matrix effect in the background, continues until another command
    is called
    does not require update
    cube matrix random ; sleep 60 ; cube sphere darkblue : update

colors  
    show each LED as a different color 
    requires update
    cube colors : update

vline
    draw vertical line of color
    cube vline 13 blue : update
    cube vline 1 2 red : update

hline
    draw horizontal line of color
    cube hline 13 blue : update
    cube hline 1 2 red : update

zline
    draw z index line of color
    cube zline 13 blue : update
    cube zline 1 2 red : update

' ;


}

# ----------------------------------------------------------------------------
# main

my %opt = init_app(
    help_text => 'Control the hypnocube via a named pipe'

        #     , help_cmdline  => 'filename'
    ,
    options => {
        'device|d=s' => "serial device to use [default: $DEVICE]",
        'pipe|p=s'   => "named pipe to use/create [default: $DEFAULT_FIFO]",
        'remove|r'   => 'remove pipe on program exit',
        'daemon' =>
            'run as a daemon process, otherwise will remain in foreground',
        'restart'  => 'kill any running cubepipe',
        'verbose'  => 'tell us whats going on',
        'commands' => 'describe all the commands that can be sent'

    },
    cleanup => \&cleanup_func    # optional func to call to clean up
) ;

if ( $opt{commands} ) {

    msg_exit( commands(), 1 ) ;
}

if ( $opt{restart} ) {
    if ( $^O ne 'MSWin32' ) {
        # sorry to say I am assuming a standard linux PS here
        my ( $c, $o, $e ) = run_cmd("ps ax") ;
        if ( !$c ) {
            foreach my $l ( split( /\n/, $o ) ) {
                # if we are not there, skip
                next if ( $l !~ /$0/ ) ;
                $l =~ /^(\d+)\s+(.*?)\s+(.*?)\s+(\d+:\d+)\s+(.*)/ ;
                my ( $pid, $process ) = ( $1, $5 ) ;
                next if ( !$pid ) ;
                # kill whatever we find, that is not us
                if ( $pid != $$ ) {
                    say "killing $pid - $process" if ( $opt{verbose} ) ;
                    my $s = kill( 'KILL', $pid ) ;
                    if ( $s != 1 ) {
                        say STDERR "Could not kill $pid ($l)" ;
                    }
                }
            }
        } else {
            say STDERR "Could not find $0, wrong ps command?" ;
        }
    } else {
        say STDERR "Cannot restart on this OS - $^O" ;
    }
}

# set defaults if needed
$opt{device} ||= $DEVICE ;
$DEFAULT_FIFO = $opt{pipe} if ( $opt{pipe} ) ;

show_usage("Device missing or not recognised ($opt{device})")
    if ( !$opt{device} || !-c $opt{device} ) ;

# start the daemon process if needed

if ( $opt{daemon} ) {
    try {
        # parent should exit
        exit(0) if ( !daemonise() ) ;
    }
    catch {
        msg_exit( 'Failed to create daemon process', 1 ) ;
    } ;
} else {
    say 'running in foreground' ;
}

# now connect to the cube and start listening to the pipe
my $cube ;
$cube = Device::Hypnocube->new(
    serial  => $opt{device},
    verbose => $opt{verbose}
) ;
msg_exit( 'Failed to login to hypnocube', 1 ) if ( !$cube->login() ) ;
say 'Logged in to cube' if ( $opt{verbose} ) ;

my $reopen = 1 ;
my $fifo ;
while (1) {

    # exit if signature file manually removed
    # create the pipe if needed each time around
    if ($reopen) {
        if ( !-e $DEFAULT_FIFO ) {
            POSIX::mkfifo( $DEFAULT_FIFO, 0666 )
                or msg_exit( "Cannot create named pipe", 2 ) ;

            # cos mkfifo does not seem to change permissions properly
            system("chmod a+rw '$DEFAULT_FIFO'") ;
        } else {
            msg_exit(
                'Cannot use named pipe, it already exists as something else',
                1
            ) if ( !-p $DEFAULT_FIFO ) ;
        }

        msg_exit( 'Failed to open named pipe', 3 )
            if ( !sysopen( $fifo, $DEFAULT_FIFO, O_RDONLY | O_NONBLOCK ) ) ;

        say 'Opened named pipe for reading' if ( $opt{verbose} ) ;
        $reopen = 0 ;
    }

    my ( $eof, $line ) = nb_readlines( $fifo, 0, 10000 ) ;

    if ($line) {

        chomp($line) ;
        if ($line) {
            say 'received ' . "'$line'" if ( $opt{verbose} ) ;

            # decide how to handle things
            process_line( $cube, $line, $opt{verbose} ) ;
        }
    }

    if ($eof) {
        close($fifo) ;
        say 'Closed named pipe' if ( $opt{verbose} ) ;
        $reopen = 1 ;
    }

    if ($background_process) {
        tick_background() ;
    }

    sleep(TICK) ;
}

__END__

=pod

=encoding UTF-8

=head1 NAME

cubepipe - control the hypnocube via commands coming in over a named pipe

=head1 VERSION

version 1.9.4

=head1 AUTHOR

Kevin Mulholland <moodfarm@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by Kevin Mulholland.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
