view release on metacpan or  search on metacpan

lib/Antsy.pm  view on Meta::CPAN

sub bg_256   ( $n         ) { _256( _bg(), $n ) }
sub bg_rgb   ( $r, $g, $b ) { _rgb( _bg(), $r, $g, $b ) }

sub cursor_row_column ( $n = 1, $m = 1 ) { _seq( 'H', $n, $m ) }

sub text_256 ( $n         ) { _256( _text(), $n ) }
sub text_rgb ( $r, $g, $b ) { _rgb( _text(), $r, $g, $b ) }


# This section takes the subroutines that we've already defined to
# adds them to the export lists.
BEGIN {
	my @subs = qw( bg_256 bg_rgb text_256 text_rgb
		erase_in_display erase_in_line cursor_row_column
		);

	push @EXPORT_OK, @subs;
	push $EXPORT_TAGS{all   }->@*,                      @subs;
	push $EXPORT_TAGS{bg    }->@*, grep { /\Abg_/     } @subs;
	push $EXPORT_TAGS{text  }->@*, grep { /\Atext_/   } @subs;
	push $EXPORT_TAGS{erase }->@*, grep { /\Aerase_/  } @subs;
	push $EXPORT_TAGS{cursor}->@*, grep { /\Acursor_/ } @subs;
	}

BEGIN {
	my @groups = (
		[ qw( J screen) ],
		[ qw( K line  ) ],
		);

	my @templates = ( 'clear_to_%s_end', 'clear_to_%s_start', 'clear_%s' );

	foreach my $group ( @groups ) {
		no strict 'refs';
		foreach my $i ( 0 .. 2 ) {
			my $name = sprintf $templates[$i], $group->[1];
			my $value = _seq( $group->[0], $i );
			*{$name} = sub () { $value };
			_export( $name, 'clear' );
			}
		}
	}

BEGIN {
	my @groups = (
		[ qw( cursor back           D ) ],
		[ qw( cursor column         G ) ],
		[ qw( cursor down           B ) ],
		[ qw( cursor forward        C ) ],
		[ qw( cursor next_line      E ) ],
		[ qw( cursor previous_line  F ) ],
		[ qw( cursor up             A ) ],
		[ qw( scroll down           T ) ],
		[ qw( scroll up             S ) ],
		);

	foreach my $group ( @groups ) {
		no strict 'refs';

		my( $export_tag, $fragment, $command ) = @$group;
		my $name = join '_', $export_tag, $fragment;

		*{$name} = sub ( $n ) {
			$n = $n =~ /\A([0-9]+)\z/ ? $1 : 0;
			_seq( $command, $n );
			};

		_export( $name, $export_tag );
		}
	}

BEGIN {
	my @groups = (
		# EXPORT_TAG  SUB_NAME  COMMAND ARGS
		[ qw( control reset          m    0 ) ],
		[ qw( text    bold           m    1 ) ],
		[ qw( text    dark           m    2 ) ],
		[ qw( text    italic         m    3 ) ],
		[ qw( text    underline      m    4 ) ],
		[ qw( text    blink          m    5 ) ],
		[ qw( text    reverse        m    7 ) ],
		[ qw( text    conceal        m    8 ) ],
		[ qw( cursor  save_cursor    s      ) ],
		[ qw( cursor  restore_cursor u      ) ],
		[ qw( cursor  hide_cursor    h  ?25 ) ],
		[ qw( cursor  show_cursor    l  ?25 ) ],
		);

	foreach my $group ( @groups ) {
		no strict 'refs';

		my( $export_tag, $name, $command, $n ) =  @$group;
		$n //= '';
		my $value = _seq( $command, $n );

		*{$name} = sub () { $value };

		_export( $name, $export_tag );
		}
	}

BEGIN {
	my @colors = qw( black red green yellow blue magenta cyan white );
	my %colors = map { state $n = 0; $_ => $n++ } @colors;

	my @groups = (
		[   (   0, '',       '%s' ) ],
		[ qw(  30 text        %s  ) ],
		[ qw(  90 text bright %s  ) ],
		[ qw(  40 bg          %s  ) ],
		[ qw( 100 bg   bright %s  ) ],
		);

	foreach my $group ( @groups ) {
		my $offset  = shift @$group;
		my $template = join "_", @$group;

		foreach my $i ( 0 .. $#colors ) {
			no strict 'refs';
			my $name = sprintf $template, $colors[$i];
			my $value = _seq( 'm', $offset + $i );