Curses-Simp
view release on metacpan or search on metacpan
'@63' => 'F5',
'@64' => 'F6',
'@65' => 'F7',
'@66' => 'F8',
'@67' => 'F9',
'@68' => 'F10',
'@133' => 'F11',
'@134' => 'F12',
);
my @KMODNAMZ = ( # in advanced input mode, these KMOD modifier names get set
# within the Simp object's '_kmod' hash after each GetK()
# SDL Modifier Meaning
'KMOD_NONE', # No modifiers applicable
# I don't think I can detect locks or left/right with Curses so commented
# 'KMOD_NUM', # Numlock is down
# 'KMOD_CAPS', # Capslock is down
# 'KMOD_LCTRL', # Left Control is down
# 'KMOD_RCTRL', # Right Control is down
# 'KMOD_RSHIFT', # Right Shift is down
# 'KMOD_LSHIFT', # Left Shift is down
# 'KMOD_RALT', # Right Alt is down
# 'KMOD_LALT', # Left Alt is down
'KMOD_CTRL', # A Control key is down
'KMOD_SHIFT', # A Shift key is down
'KMOD_ALT', # An Alt key is down
); # A_BOLD attribute number
my @kndx = (); my @knam = (); my %knum = (); my $abld = 2097152; my $i = 0;
my %clet = ( 'k' => 0, 'r' => 1, 'g' => 2, 'o' => 3, # color letters map
'u' => 4, 'm' => 5, 't' => 6, 'y' => 3,
'b' => 4, 'p' => 5, 'c' => 6, 'w' => 7,
'K' => 8, 'R' => 9, 'G' => 10, 'O' => 3, # Orange exception
'U' => 12, 'M' => 13, 'T' => 14, 'Y' => 11,
'B' => 12, 'P' => 13, 'C' => 14, 'W' => 15,
'l' => 13, 'L' => 13 ); # lavender exception
my @telc = ( 'k', 'r', 'g', 'y', 'b', 'p', 'c', 'w' ); # core colors indexed
my @tel4 = ( 0 , 4 , 2 , 6 , 1 , 5 , 3 , 7 ); # 4NT colors indexed
# ordered attribute names array, default attribute data hash
my @_attrnamz = (); my %_attrdata = ();
my %_verbose_attrnamz = ();
# field data
push(@_attrnamz, '_wind'); $_attrdata{$_attrnamz[-1]} = 0; # CursesWindowHandle
$_verbose_attrnamz{$_attrnamz[-1]} = 'WindowHandle';
push(@_attrnamz, '_text'); $_attrdata{$_attrnamz[-1]} = []; # text data
$_verbose_attrnamz{$_attrnamz[-1]} = 'TextData';
push(@_attrnamz, '_fclr'); $_attrdata{$_attrnamz[-1]} = []; # fg color data
$_verbose_attrnamz{$_attrnamz[-1]} = 'ForegroundColorData';
push(@_attrnamz, '_bclr'); $_attrdata{$_attrnamz[-1]} = []; # bg color data
$_verbose_attrnamz{$_attrnamz[-1]} = 'BackgroundColorData';
push(@_attrnamz, '_kque'); $_attrdata{$_attrnamz[-1]} = []; # Key Queue
$_verbose_attrnamz{$_attrnamz[-1]} = 'KeyQueue';
push(@_attrnamz, '_mque'); $_attrdata{$_attrnamz[-1]} = []; # Key Mod Queue
$_verbose_attrnamz{$_attrnamz[-1]} = 'KeyModQueue';
push(@_attrnamz, '_hite'); $_attrdata{$_attrnamz[-1]} = 0; # window height
$_verbose_attrnamz{$_attrnamz[-1]} = 'WindowHeight';
push(@_attrnamz, '_widt'); $_attrdata{$_attrnamz[-1]} = 0; # window width
$_verbose_attrnamz{$_attrnamz[-1]} = 'WindowWidth';
push(@_attrnamz, '_yoff'); $_attrdata{$_attrnamz[-1]} = 0; # window y-offset
$_verbose_attrnamz{$_attrnamz[-1]} = 'WindowYOffset';
push(@_attrnamz, '_xoff'); $_attrdata{$_attrnamz[-1]} = 0; # window x-offset
$_verbose_attrnamz{$_attrnamz[-1]} = 'WindowXOffset';
push(@_attrnamz, '_ycrs'); $_attrdata{$_attrnamz[-1]} = 0; # cursor y-offset
$_verbose_attrnamz{$_attrnamz[-1]} = 'CursorYOffset';
push(@_attrnamz, '_xcrs'); $_attrdata{$_attrnamz[-1]} = 0; # cursor x-offset
$_verbose_attrnamz{$_attrnamz[-1]} = 'CursorXOffset';
push(@_attrnamz, '_btyp'); $_attrdata{$_attrnamz[-1]} = 0; # border type
$_verbose_attrnamz{$_attrnamz[-1]} = 'WindowBorderType';
push(@_attrnamz, '_brfc'); $_attrdata{$_attrnamz[-1]} = 'w';# border fore color
$_verbose_attrnamz{$_attrnamz[-1]} = 'WindowBorderForegroundColor';
push(@_attrnamz, '_brbc'); $_attrdata{$_attrnamz[-1]} = 'k';# border back color
$_verbose_attrnamz{$_attrnamz[-1]} = 'WindowBorderBackgroundColor';
push(@_attrnamz, '_titl'); $_attrdata{$_attrnamz[-1]} = ''; # window title
$_verbose_attrnamz{$_attrnamz[-1]} = 'WindowTitle';
push(@_attrnamz, '_ttfc'); $_attrdata{$_attrnamz[-1]} = 'W';# title fore color
$_verbose_attrnamz{$_attrnamz[-1]} = 'WindowTitleForegroundColor';
push(@_attrnamz, '_ttbc'); $_attrdata{$_attrnamz[-1]} = 'W';# title back color
$_verbose_attrnamz{$_attrnamz[-1]} = 'WindowTitleBackgroundColor';
push(@_attrnamz, '_dndx'); $_attrdata{$_attrnamz[-1]} = 0; # DISPSTAK index
$_verbose_attrnamz{$_attrnamz[-1]} = 'DisplayStackIndex';
# Flags, storage Values, && extended attributes
push(@_attrnamz, '_flagaudr'); $_attrdata{$_attrnamz[-1]} = 1; # Auto Draw()
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagAutoDraw';
push(@_attrnamz, '_flagadtf'); $_attrdata{$_attrnamz[-1]} = 1; # AD Tied FG
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagAutoDrawTiedForegroundData';
push(@_attrnamz, '_flagadtb'); $_attrdata{$_attrnamz[-1]} = 1; # AD Tied BG
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagAutoDrawTiedBackgroundData';
push(@_attrnamz, '_flagmaxi'); $_attrdata{$_attrnamz[-1]} = 1; # Maximize
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagMaximize';
push(@_attrnamz, '_flagshrk'); $_attrdata{$_attrnamz[-1]} = 1; # ShrinkToFit
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagShrinkToFit';
push(@_attrnamz, '_flagcntr'); $_attrdata{$_attrnamz[-1]} = 1; # Center
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagCenter';
push(@_attrnamz, '_flagcvis'); $_attrdata{$_attrnamz[-1]} = 0; # CursorVisible
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagCursorVisible';
push(@_attrnamz, '_flagscrl'); $_attrdata{$_attrnamz[-1]} = 0; # Scrollbar
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagScrollbar';
push(@_attrnamz, '_flagsdlk'); $_attrdata{$_attrnamz[-1]} = 0; # SDLK
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagSDLKey';
push(@_attrnamz, '_flagfram'); $_attrdata{$_attrnamz[-1]} = 0; # Time::Frame
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagTimeFrame';
push(@_attrnamz, '_flagmili'); $_attrdata{$_attrnamz[-1]} = 0; # millisecond
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagMillisecond';
push(@_attrnamz, '_flagprin'); $_attrdata{$_attrnamz[-1]} = 1; # Prnt into self
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagPrintInto';
push(@_attrnamz, '_flagclru'); $_attrdata{$_attrnamz[-1]} = 0; # Color Used?
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagColorUsed';
push(@_attrnamz, '_flaginsr'); $_attrdata{$_attrnamz[-1]} = 1; # insert mode
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagInsertMode';
push(@_attrnamz, '_flagdrop'); $_attrdata{$_attrnamz[-1]} = 0; # DropDown
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagDropDown';
push(@_attrnamz, '_flagdown'); $_attrdata{$_attrnamz[-1]} = 0; # DropIsDown
$_verbose_attrnamz{$_attrnamz[-1]} = 'FlagDropIsDown';
push(@_attrnamz, '_valulasp'); $_attrdata{$_attrnamz[-1]} = undef; # last pair
$_verbose_attrnamz{$_attrnamz[-1]} = 'LastPair';
push(@_attrnamz, '_valullsp'); $_attrdata{$_attrnamz[-1]} = undef; # llastpair
$_verbose_attrnamz{$_attrnamz[-1]} = 'LastLastPair';
push(@_attrnamz, '_valulasb'); $_attrdata{$_attrnamz[-1]} = undef; # last bold
$_verbose_attrnamz{$_attrnamz[-1]} = 'LastBold';
push(@_attrnamz, '_valullsb'); $_attrdata{$_attrnamz[-1]} = undef; # llastbold
$_verbose_attrnamz{$_attrnamz[-1]} = 'LastLastBold';
push(@_attrnamz, '_valudol8'); $_attrdata{$_attrnamz[-1]} = undef; # do late
$_verbose_attrnamz{$_attrnamz[-1]} = 'LateEscapedPrint';
# methods
sub DfltValu { my ($self, $attr) = @_; $_attrdata{$attr}; }
sub AttrNamz { @_attrnamz; } # attribute names
sub TIEARRAY {
OScr() unless($GLBL{'FLAGOPEN'}); # need Open main Screen for new Simp obj
my $clas = shift;
my $self = bless({}, $clas);
for my $attr ($self->AttrNamz()){
$self->{$attr} = $self->DfltValu($attr); # init defaults
}
for(@KMODNAMZ){ $self->{'_kmod'}->{$_} = 0; }
while(@_){
my $foun = 0;
my($keey, $valu)=(shift, shift);
for my $attr ($self->AttrNamz()){
if($attr =~ /$keey/i) {
$self->{$attr} = $valu;
$foun = 1;
}
}
unless($foun){
for my $attr ($self->AttrNamz()){
if($_verbose_attrnamz{$attr} eq $keey){ # exact match
$self->{$attr} = $valu;
$foun = 1;
}
}
unless($foun){
croak "!*EROR*! Curses::Simp::new initialization key:$keey was not recognized!\n";
}
}
}
$self->{'_flagshrk'} = 0 if($self->{'_hite'} && $self->{'_widt'});
$self->Updt(1);
if($curs){
$self->{'_wind'} = newwin($self->{'_hite'}, $self->{'_widt'},
$self->{'_yoff'}, $self->{'_xoff'});
unless(exists($self->{'_wind'}) && defined($self->{'_wind'})){
exit();
# croak "!*EROR*! Curses::Simp::new could not create new window with hite:$self->{'_hite'}, widt:$self->{'_widt'}, yoff:$self->{'_yoff'}, xoff:$self->{'_xoff'}!\n";
}
}
# newwin doesn't auto draw so if there's init _text && autodraw is on...
$self->TestDraw();
$self->Move(-1, -1) unless($self->{'_ycrs'} || $self->{'_xcrs'});
curs_set($self->{'_flagcvis'}) if($curs); # set cursor state
# add new Simp object to display order stack
$self->{'_dndx'} = @DISPSTAK;
push(@DISPSTAK, \$self);
return($self);
}
sub FETCH { return( $_[0]->{'_text'}->[$_[1]]); }
sub FETCHSIZE { return(scalar(@{$_[0]->{'_text'}}) ); }
sub STORE {
$_[0]->{'_text'}->[$_[1]] = $_[2];
$_[0]->TestDraw();
}
sub STORESIZE {
splice(@{$_[0]->{'_text'}}, $_[1], @{$_[0]->{'_text'}} - $_[1]);
$_[0]->TestDraw();
}
sub EXISTS { return(0) unless(defined($_[0]->{'_text'}->[$_[1]])); return(1); }
sub CLEAR { @{$_[0]->{'_text'}} = (); $_[0]->TestDraw(); }
sub PUSH { push(@{$_[0]->{'_text'}}, $_[1]); $_[0]->TestDraw(); }
sub POP { $_ = pop(@{$_[0]->{'_text'}}); $_[0]->TestDraw(); return($_); }
sub SHIFT { $_ = shift(@{$_[0]->{'_text'}}); $_[0]->TestDraw(); return($_); }
sub UNSHIFT { unshift(@{$_[0]->{'_text'}}, $_[1]); $_[0]->TestDraw(); }
sub SPLICE {
#open(DBUG, ">dbug"); for(0..$#_) { print DBUG "$_ : $_[$_]\n"; } close(DBUG); $_[0]->GetK(-1);
# $_ = splice(@{$_[0]->{'_text'}}, @_[1..$#_]); $_[0]->TestDraw(); return($_); }
my $self = shift;
my $offs = shift || 0;
my $leng = shift; $leng = $self->FETCHSIZE() - $offs unless(defined($leng));
my $retn = splice(@{$self->{'_text'}}, $offs, $leng, @_);
$self->TestDraw();
return($retn);
}
sub EXTEND { }
# MkMethdz creates Simp object field accessor methods with
# configurable handling && overrideable default operations. Beppu@CPAN.Org
# coded the first version of MkMethdz && taught me a new trick. =)
# Special Parameters:
# NAME => name of the method to be created
# ARAY => if this is true, $self->{$attr} is assumed to be
# an array ref, and default subcommands are installed
# LOOP => like ARAY above but a looping value instead
# ... => other method flags describing what to include in made method
# nmrc => sub reference for handling a numeric subcommand
# The rest of the parameters should be key/value pairs where:
# subcommand => subroutine reference
sub MkMethdz {
my %cmnd = @_;
my $meth = $cmnd{'NAME'} || die('NAME => required!');
my $aray = $cmnd{'ARAY'} || 0;
my $rsiz = $cmnd{'RSIZ'} || 0;
my $mvwn = $cmnd{'MVWN'} || 0;
my $mvcr = $cmnd{'MVCR'} || 0;
my $updt = $cmnd{'UPDT'} || 0;
my $crsr = $cmnd{'CRSR'} || 0;
my $loop = $cmnd{'LOOP'} || 0;
my $dstk = $cmnd{'DSTK'} || 0;
my $attr = '_' . lc($meth);
$cmnd{'asin'} ||= sub { # Dflt assign command
my $self = shift; my $nwvl = shift;
if(!$dstk || (0 <= $nwvl && $nwvl < @DISPSTAK)){
if($dstk && $self->{'_dndx'} != $nwvl) { # exchange displaystack indices
# E_NOT_SELECTABLE E_NOT_CONNECTED E_REQUEST_DENIED
# E_INVALID_FIELD E_CURRENT REQ_LEFT_ITEM
# REQ_RIGHT_ITEM REQ_UP_ITEM REQ_DOWN_ITEM
# REQ_SCR_ULINE REQ_SCR_DLINE REQ_SCR_DPAGE
# REQ_SCR_UPAGE REQ_FIRST_ITEM REQ_LAST_ITEM
# REQ_NEXT_ITEM REQ_PREV_ITEM REQ_TOGGLE_ITEM
# REQ_CLEAR_PATTERN REQ_BACK_PATTERN REQ_NEXT_MATCH
# REQ_PREV_MATCH MIN_MENU_COMMAND MAX_MENU_COMMAND
# O_ONEVALUE O_SHOWDESC O_ROWMAJOR
# O_IGNORECASE O_SHOWMATCH O_NONCYCLIC
# O_SELECTABLE REQ_NEXT_PAGE REQ_PREV_PAGE
# REQ_FIRST_PAGE REQ_LAST_PAGE REQ_NEXT_FIELD
# REQ_PREV_FIELD REQ_FIRST_FIELD REQ_LAST_FIELD
# REQ_SNEXT_FIELD REQ_SPREV_FIELD REQ_SFIRST_FIELD
# REQ_SLAST_FIELD REQ_LEFT_FIELD REQ_RIGHT_FIELD
# REQ_UP_FIELD REQ_DOWN_FIELD REQ_NEXT_CHAR
# REQ_PREV_CHAR REQ_NEXT_LINE REQ_PREV_LINE
# REQ_NEXT_WORD REQ_PREV_WORD REQ_BEG_FIELD
# REQ_END_FIELD REQ_BEG_LINE REQ_END_LINE
# REQ_LEFT_CHAR REQ_RIGHT_CHAR REQ_UP_CHAR
# REQ_DOWN_CHAR REQ_NEW_LINE REQ_INS_CHAR
# REQ_INS_LINE REQ_DEL_CHAR REQ_DEL_PREV
# REQ_DEL_LINE REQ_DEL_WORD REQ_CLR_EOL
# REQ_CLR_EOF REQ_CLR_FIELD REQ_OVL_MODE
# REQ_INS_MODE REQ_SCR_FLINE REQ_SCR_BLINE
# REQ_SCR_FPAGE REQ_SCR_BPAGE REQ_SCR_FHPAGE
# REQ_SCR_BHPAGE REQ_SCR_FCHAR REQ_SCR_BCHAR
# REQ_SCR_HFLINE REQ_SCR_HBLINE REQ_SCR_HFHALF
# REQ_SCR_HBHALF REQ_VALIDATION REQ_NEXT_CHOICE
# REQ_PREV_CHOICE MIN_FORM_COMMAND MAX_FORM_COMMAND
# NO_JUSTIFICATION JUSTIFY_LEFT JUSTIFY_CENTER
# JUSTIFY_RIGHT O_VISIBLE O_ACTIVE
# O_PUBLIC O_EDIT O_WRAP
# O_BLANK O_AUTOSKIP O_NULLOK
# O_PASSOK O_STATIC O_NL_OVERLOAD
# O_BS_OVERLOAD );
# load $knum{CONSTANT_KEY_NUMBER_VALUE} => "CONSTANT_KEY_NAME_STRING" # not mapping -1..9since'0'..'9'are normal chrz&&GetK retnz -1 when $tmot reached
for($i=0;$i<@kndx;$i++){ if(defined($knam[$i]) && $kndx[$i] =~ /../ && $kndx[$i] ne '-1'){ $knum{"$kndx[$i]"} = "$knam[$i]"; } }
for($i=265;$i<=279;$i++){ $knum{"$i"} = "KEY_F" . ($i-264); } # add my own new additional key<->num mappings (i.e., 265..279 => F1..F15)
for($i=0;$i<@kndx;$i++){ if(defined($knam[$i]) && $knam[$i] eq 'A_BOLD'){ # find the right value of the A_BOLD attribute so strict doesn't complain
$abld = $kndx[$i] if($kndx[$i] =~ /^\d+$/); last; #$abld = 2097152;
} } } return; }
sub CScr{ # Close previously OpenedCursesScreen # Following are Curses funcs that might be useful to call in CloseScreen(): termname(),erasechar(),killchar()
if($GLBL{'FLAGOPEN'}){ $GLBL{'FLAGOPEN'} = 0; ${$DISPSTAK[0]}->DelW() while(@DISPSTAK); return(endwin()) if($curs); } } # delete all simp objects before end
sub NumC{ return(COLORS()); }
# Curses::Simp object constructor as class method or copy as object method. First param can be ref to copy. Not including optional ref from copy,
# default is no params to create a new empty Simp object. If params are supplied, they must be hash key => value pairs.
sub new{ OScr() unless($GLBL{'FLAGOPEN'}); my($nvkr, $cork)= @_; my($keey, $valu); my $nobj = ref($nvkr); my $clas = $cork; # need Open Screen for new obj
$clas = $nobj || $nvkr if(!defined($cork) || $cork !~ /::/); my $self = bless({}, $clas); # Class OR Key
for my $attr ($self->AttrNamz()){ $self->{$attr} = $self->DfltValu($attr); # init defaults && copy if supposed to
$self->{$attr} = $nvkr->{$attr} if($nobj); } for(@KMODNAMZ){ $self->{'_kmod'}->{$_} = 0; }
if(defined($cork) && $cork !~ /::/){ $nvkr = shift if($nvkr =~ /::/); while(@_){ my $foun = 0; ($keey, $valu)=(shift, shift); # handle init params with
for my $attr ($self->AttrNamz()){ if($attr =~ /$keey/i){ $self->{$attr} = $valu;$foun = 1; } } # no colons (classname)
unless( $foun){ for my $attr ($self->AttrNamz()){ if($_verbose_attrnamz{$attr} eq $keey){ $self->{$attr} = $valu; $foun = 1; } } # exact match
unless($foun){ croak "!*EROR*! Curses::Simp::new initialization key:$keey was not recognized!\n"; } } } }
$self->{'_flagshrk'} = 0 if($self->{'_hite'} && $self->{'_widt'}); $self->Updt(1);
if($curs){ $self->{'_wind'} = newwin($self->{'_hite'}, $self->{'_widt'}, $self->{'_yoff'}, $self->{'_xoff'});
unless(exists($self->{'_wind'}) && defined($self->{'_wind'})){ exit;
#croak "!*EROR*! Curses::Simp::new could not create window with hite:$self->{'_hite'},widt:$self->{'_widt'},yoff:$self->{'_yoff'},xoff:$self->{'_xoff'}!\n";
} } $self->TestDraw(); $self->Move(-1, -1) unless($self->{'_ycrs'} || $self->{'_xcrs'}); # newwin does!autodraw so if therz init _text && autodraw is on...
curs_set($self->{'_flagcvis'}) if($curs); $self->{'_dndx'} = @DISPSTAK; push(@DISPSTAK, \$self); return($self); } # set cursor state,push obj2stack,&&retn
sub Prnt{ # Simp object PrintString method
my $self = shift; my %parm; my($ycrs, $xcrs); my($keey, $valu);
my($cnum, $delt, $chrz); my($yold, $xold); my($fgcl, $bgcl); my $foun;
$parm{'nore'} = 0; # No Refresh flag init'd to false
$parm{'ycrs'} = $self->{'_ycrs'};
$parm{'xcrs'} = $self->{'_xcrs'};
if($self->{'_btyp'}) { $parm{'ycrs'}++; $parm{'xcrs'}++; }
$parm{'prin'} = $self->{'_flagprin'}; # init prin param
while(@_){ ($keey, $valu)=(shift, shift); $foun = 0; if(defined($valu)){ # load params
for my $attr ($self->AttrNamz()){ if($_verbose_attrnamz{$attr} eq $keey){ $attr =~ s/^_*//; $parm{$attr} = $valu; $foun = 1; } } # exact match
unless($foun){ $keey =~ s/^_*//; $parm{$keey} = $valu; }
}else{ $parm{'text'} = $keey; } }
$chrz = ref($parm{'text'}); # if text, fclr, or bclr are arrays like new or Draw would take, join them
$parm{'text'} = join("\n", @{$parm{'text'}}) if($chrz eq 'ARRAY');
if(exists($parm{'fclr'})){ $self->{'_flagclru'} = 1; $chrz = ref($parm{'fclr'}); $parm{'fclr'} = join("\n", @{$parm{'fclr'}}) if($chrz eq 'ARRAY'); }
if(exists($parm{'fclr'})){ $self->{'_flagclru'} = 1; $chrz = ref($parm{'bclr'}); $parm{'bclr'} = join("\n", @{$parm{'bclr'}}) if($chrz eq 'ARRAY'); }
return() unless(exists($parm{'text'}) && defined($parm{'text'}) && length($parm{'text'}));
($yold, $xold)=($self->{'_ycrs'}, $self->{'_xcrs'});
$parm{'ycrs'} = $parm{'ytmp'} if(exists($parm{'ytmp'}));
$parm{'xcrs'} = $parm{'xtmp'} if(exists($parm{'xtmp'}));
$parm{'text'} =~ s/[�
›œ]/ /g; # Prnt does not support escaped printf chars like Draw
unless($curs){ system("attrib /q /e -rsh C:\\SimpDraw.bat") if(-e 'C:/SimpDraw.bat' && !-w 'C:/SimpDraw.bat');
system("del /q /e C:\\SimpDraw.bat") if(-e 'C:/SimpDraw.bat' && !-w 'C:/SimpDraw.bat'); open(SCRP,'>>','C:\SimpDraw.bat'); }
if($parm{'prin'}){ if($self->{'_btyp'}){ if($parm{'ycrs'}){ $parm{'ycrs'}--; }else{ $parm{'zery'} = 1; }
if($parm{'xcrs'}){ $parm{'xcrs'}--; }else{ $parm{'zerx'} = 1; } }
unless(@{$self->{'_text'}} > $parm{'ycrs'} && defined($self->{'_text'}->[$parm{'ycrs'}])){ $self->{'_text'}->[$parm{'ycrs'}] = ''; }
if(length($self->{'_text'}->[$parm{'ycrs'}]) > $parm{'xcrs'}){substr($self->{'_text'}->[$parm{'ycrs'}],$parm{'xcrs'},length($parm{'text'}),$parm{'text'});}
else{ $self->{'_text'}->[$parm{'ycrs'}] .= ' ' x ($parm{'xcrs'} - length($self->{'_text'}->[$parm{'ycrs'}])) . $parm{'text'};}
if($self->{'_btyp'}){ $parm{'ycrs'}++ unless(exists($parm{'zery'})); $parm{'xcrs'}++ unless(exists($parm{'zerx'})); } }
if(exists($parm{'fclr'}) || exists($parm{'bclr'})){ if($parm{'prin'}){ if($self->{'_btyp'}){ if($parm{'ycrs'}){ $parm{'ycrs'}--; }else{ $parm{'zery'} = 1; }
if($parm{'xcrs'}){ $parm{'xcrs'}--; }else{ $parm{'zerx'} = 1; }}
if($self->{'_btyp'}){ $parm{'ycrs'}++ unless(exists($parm{'zery'}));
$parm{'xcrs'}++ unless(exists($parm{'zerx'})); }}
$parm{'ycrs'} = 0 unless($parm{'ycrs'} =~ /^\d+$/); $parm{'xcrs'} = 0 unless($parm{'xcrs'} =~ /^\d+$/); $cnum = 0;
while(length($parm{'text'})){ $chrz = substr($parm{'text'}, 0, 1, ''); $delt = 0;
if(exists($parm{'fclr'}) && length($parm{'fclr'})){ $fgcl = substr($parm{'fclr'}, 0, 1, ''); }
if(exists($parm{'bclr'}) && length($parm{'bclr'})){ $bgcl = substr($parm{'bclr'}, 0, 1, ''); } $self->InitPair($fgcl, $bgcl);
while((!exists($parm{'fclr'}) || !length($parm{'fclr'}) || substr($parm{'fclr'}, 0, 1) eq $fgcl) &&
(!exists($parm{'bclr'}) || !length($parm{'bclr'}) || substr($parm{'bclr'}, 0, 1) eq $bgcl) && length($parm{'text'})){ $cnum++; $delt++;
substr($parm{'fclr'}, 0, 1, '') if(exists($parm{'fclr'}) && length($parm{'fclr'}));
substr($parm{'bclr'}, 0, 1, '') if(exists($parm{'bclr'}) && length($parm{'bclr'})); $chrz .= substr($parm{'text'}, 0, 1, ''); }
$chrz = '' unless(defined($chrz));
if(exists($parm{'ycrs'}) && exists($parm{'xcrs'})){ if($curs){ $self->{'_wind'}->addstr($parm{'ycrs'}, $parm{'xcrs'} + ($cnum - $delt), $chrz); }
else{ my $scrp = "\@scrput " . $parm{'ycrs'} . ' ' . $parm{'xcrs'} + ($cnum - $delt) . ' ';
my $fgct = $clet{$fgcl} if(exists($clet{$fgcl}));
my $bgct = $clet{$bgcl} if(exists($clet{$bgcl}));
if(defined($fgct) && defined($bgct)){ if($fgct > 7){ $scrp .= $tel4[$fgct - 8] + 8; }
else { $scrp .= $tel4[$fgct]; } $scrp .= ' on ';
if($tel4[$bgct]){ $scrp .= "$tel4[$bgct] "; }else{ $scrp .= "0 "; }
}else{ $scrp = "\@scrput " . $parm{'ycrs'} . ' ' . $parm{'xcrs'} + ($cnum - $delt) . ' '; }
$scrp .= $chrz; print SCRP "$scrp\n"; } } $cnum++; }
}else{ $cnum = length($parm{'text'}); if(exists($parm{'ycrs'}) && exists($parm{'xcrs'})){
if($curs){ $self->{'_wind'}->addstr($parm{'ycrs'}, $parm{'xcrs'}, $parm{'text'}); }
else { print SCRP "\@screen " . $parm{'ycrs'} . ' ' . $parm{'xcrs'} . ' ' . $parm{'text'} . "\n"; } } }
$self->{'_wind'}->getyx($self->{'_ycrs'}, $self->{'_xcrs'}) if($curs);
if($self->{'_btyp'}){ $self->{'_ycrs'}--; $self->{'_xcrs'}--; }
if($curs){ if(exists($parm{'ytmp'}) || exists($parm{'xtmp'})){ $self->Move($yold, $xold); } elsif(!$parm{'nore'}){ $self->{'_wind'}->refresh(); } }
else { close(SCRP); system('call C:\SimpDraw.bat'); } return($cnum); }
sub Draw{ # Simp object self Drawing method
my $self = shift; my($fgcl, $bgcl); my($fgct, $bgct); my($lnum, $cnum);
if($curs && $cnum < $self->{'_widt'}){
$self->{'_wind'}->addstr(' ' x (($self->{'_widt'} - $cnum) - 2));
$self->{'_wind'}->addstr(' ') unless($self->{'_btyp'} ||
!defined($ltxt) ||
length($ltxt) == $self->{'_widt'});
}
}else{ # no color
if($curs){ $self->{'_wind'}->addstr($ltxt); }
else { print SCRP "\@screen $lnum 0 $ltxt\n"; }
if(length($ltxt) < ($self->{'_widt'} - 2)){
if($curs){
$self->{'_wind'}->addstr(' ' x (($self->{'_widt'} - 2) - length($ltxt)));
$self->{'_wind'}->addstr(' ') unless($self->{'_btyp'});
}
}
}
$self->BordChar('vl') if($self->{'_btyp'});
}
# pad blank lines if height not full
if(($lnum < ($self->{'_hite'} - 2)) ||
($lnum < $self->{'_hite'} && !$self->{'_btyp'})){
$ltxt = ' ' x ($self->{'_widt'} - 2);
$ltxt .= ' ' unless($self->{'_btyp'});
while($lnum < $self->{'_hite'}){
if($self->{'_btyp'}){
$self->BordChar('vl', 1);
$self->InitPair('k', 'k') if($self->{'_flagclru'}); # black blanks
}
if($curs){ $self->{'_wind'}->addstr($ltxt); }
if($self->{'_btyp'}){
$self->BordChar('vl');
$lnum+=2 if($lnum >= ($self->{'_hite'} - 3));
}
$lnum++;
}
}
if($self->{'_btyp'}){
$self->BordChar('ll');
$self->BordChar('hl', 1) for(2..$self->{'_widt'});
$self->BordChar('lr', 1);
if ($self->{'_flagdrop'} && !$self->{'_flagdown'}){
$self->{'_wind'}->move(1, ($self->{'_widt'} - 4));
$self->BordChar('vl', 1); $self->{'_wind'}->addstr('\/');
$self->{'_wind'}->move(($self->{'_hite'} - 1), ($self->{'_widt'} - 4));
$self->BordChar('bt', 1);
}elsif($self->{'_flagscrl'}){
$self->{'_wind'}->move(1, ($self->{'_widt'} - 4));
$self->BordChar('vl', 1); $self->{'_wind'}->addstr('/\\');
for(my $lndx = 2; $lndx < ($self->{'_hite'} - 2); $lndx++){
$self->{'_wind'}->move($lndx, ($self->{'_widt'} - 4));
$self->BordChar('vl', 1); $self->{'_wind'}->addstr('..');
}
$self->{'_wind'}->move(($self->{'_hite'} - 2), ($self->{'_widt'} - 4));
$self->BordChar('vl', 1); $self->{'_wind'}->addstr('\/');
$self->{'_wind'}->move(($self->{'_hite'} - 1), ($self->{'_widt'} - 4));
$self->BordChar('bt', 1);
}
}
unless($curs){ close(SCRP); system("call C:\\SimpDraw.bat"); }
$self->{'_valudol8'} = $dol8 if(defined($dol8));
$self->Move(); # replace cursor position && refresh the window
return();
}
sub TestDraw{ # Test whether an auto-Draw() should be called
$_[0]->Draw() if($_[0]->{'_text'} && @{$_[0]->{'_text'}} && $_[0]->{'_flagaudr'});
}
sub Wait{
my $self = shift; my $wait = 0;
my($keey, $valu); my $foun;
while(@_){ # load key/vals like new()
($keey, $valu)=(shift, shift); $foun = 0;
if(defined($valu)){
for my $attr ($self->AttrNamz()){
if ($attr =~ /$keey/i ||
$_verbose_attrnamz{$attr} eq $keey){ # exact match
$self->{$attr} = $valu;
$foun = 1;
}
}
unless($foun){
if($keey =~ /wait/i){
$wait = $valu;
}else{
croak "!*EROR*! Curses::Simp::Wait key:$keey was not recognized!\n";
# $keey =~ s/^_*/_/; # auto-add unfound
# $self->{$keey} = $valu;
}
}
}else{
$wait = $keey;
}
}
if ( $self->{'_flagfram'}){ # cnv from Time::Frame to Curses ms
$wait = Time::Frame->new($wait) unless(ref($wait) eq "Time::Frame");
$wait = int($wait->total_frames() / 60.0 * 1000);
}elsif(!$self->{'_flagmili'}){ # cnv from Dflt float seconds to Curses ms
$wait = int($wait * 1000);
}
return(napms($wait));
}
sub GetK{
my $self = shift; my $tmot = 0; my $tsdl = 0;
my($keey, $valu); my $foun; my $char;
while(@_){ # load key/vals like new()
($keey, $valu)=(shift, shift); $foun = 0;
if(defined($valu)){
for my $attr ($self->AttrNamz()){
if ($attr =~ /$keey/i ||
$_verbose_attrnamz{$attr} eq $keey){ # exact match
$self->{$attr} = $valu;
$foun = 1;
}
}
unless($foun){
if ($keey =~ /tmot/i || $keey eq 'Timeout'){
$tmot = $valu;
}elsif($keey =~ /tsdl/i || $keey eq 'TempSDLKey'){
$tsdl = $valu;
}else{
exit;
# croak "!*EROR*! Curses::Simp::GetK key:$keey was not recognized!\n";
}else {
if($tmot == -1){ `inkey /p /x \%\%SimpKeey & echos '\%SimpKeey''\%\@ASCII[\%SimpKeey]' > C:\\SimpKeey.txt`; }
else { `inkey /p /x /w$tmot \%\%SimpKeey & echos '\%SimpKeey''\%\@ASCII[\%SimpKeey]' > C:\\SimpKeey.txt`; }
open(SKEY, "<C:\\SimpKeey.txt"); $char = <SKEY>; close(SKEY);
if(defined($char)){
my $ordc;
$char =~ s/^'//; $char =~ s/''(\d*)'$//; $ordc = $1;
#print "\nchar:$char ordc:$ordc ord:" . ord($char) . "\n";
if ($ordc ==127 ||
$ordc == 8){ $char = 'KEY_BACKSPACE'; }
elsif($ordc == 9){ $char = 'KEY_TAB'; }
elsif($ordc == 32){ $char = '^s'; }
$char = 'KEY_' . $SDLK4NTM{$char} if(defined($char) && exists($SDLK4NTM{$char}));
}
}
}
unshift(@{$self->{'_kque'}}, $char);
unshift(@{$self->{'_mque'}}, { }); # save %kmod too
for(@KMODNAMZ){ $self->{'_mque'}->[0]->{$_} = $self->{'_kmod'}->{$_}; }
while(@{$self->{'_kque'}} > 63){ # keep up to 64 key presses && kmods
pop(@{$self->{'_kque'}});
pop(@{$self->{'_mque'}});
}
return($char);
}
sub KMod{ # accessor for the %{$self->{'_kmod'}} hash
my $self = shift; my $kmod = 'KMOD_NONE';
my($keey, $valu); my $foun;
while(@_){ # load key/vals like new()
($keey, $valu)=(shift, shift); $foun = 0;
if(defined($valu)){
for my $attr ($self->AttrNamz()){
if ($attr =~ /$keey/i ||
$_verbose_attrnamz{$attr} eq $keey){ # exact match
$self->{$attr} = $valu;
$foun = 1;
}
}
unless($foun){
if($keey =~ /kmod/i){
$kmod = $valu;
}else{
exit;
# croak "!*EROR*! Curses::Simp::KMod key:$keey was not recognized!\n";
# $keey =~ s/^_*/_/; # auto-add unfound
# $self->{$keey} = $valu;
}
}
}else{
$kmod = $keey;
}
}
for(@KMODNAMZ){
if(/$kmod$/i){
$valu = shift;
$self->{'_kmod'}->{$_} = $valu if(defined($valu));
return($self->{'_kmod'}->{$_});
}
}
}
sub GetS{ # Get a string at the cursor or pass temp y, x, and length params
my $self = shift(); # maybe GetS() should update the cursor loc too?
my $ycrs = shift(); $ycrs = $self->YCrs() unless(defined($ycrs));
my $xcrs = shift(); $xcrs = $self->XCrs() unless(defined($xcrs));
my $leng = shift();
my $line = $self->{'_text'}->[$ycrs]; $line = '' unless(defined($line));
if(length($line) >= $xcrs){
if(defined($leng) && $leng <= (length($line) - $xcrs)){
return(substr($line, $xcrs, $leng));
}else{
return(substr($line, $xcrs));
}
}
}
sub Move{ # update cursor position
my $self = shift; my($ycrs, $xcrs)=(shift, shift); my $eflg = 0;
if(defined($ycrs) && defined($xcrs)){ # (-1, -1) is a special Move exception to put cursor in lower right corner of border (if BTyp)
if($ycrs == -1 && $xcrs == -1){ $eflg = 1;
$ycrs = ($self->{'_hite'}-1);
$xcrs = ($self->{'_widt'}-1);
}
}else{
$ycrs = $self->{'_ycrs'} unless(defined($ycrs));
$xcrs = $self->{'_xcrs'} unless(defined($xcrs));
}
$ycrs = 0 if($ycrs < 0);
$xcrs = 0 if($xcrs < 0);
if($self->{'_btyp'}){ # trap cursor inside border
if (($ycrs == $self->{'_hite'}-1 &&
$xcrs == $self->{'_widt'}-2) ||
($ycrs == $self->{'_hite'}-2 &&
$xcrs == $self->{'_widt'}-1)){
$ycrs = $self->{'_hite'}-2;
$xcrs = $self->{'_widt'}-2;
}elsif(!$eflg){ $ycrs++; $xcrs++;
$ycrs = $self->{'_hite'}-2 if($ycrs > $self->{'_hite'}-2);
$xcrs = $self->{'_widt'}-2 if($xcrs > $self->{'_widt'}-2);
}
}else{
$ycrs = $self->{'_hite'}-1 if($ycrs > $self->{'_hite'}-1);
$xcrs = $self->{'_widt'}-1 if($xcrs > $self->{'_widt'}-1);
}
if($curs && $self->{'_valudol8'}){
$self->{'_wind'}->refresh();
$self->{'_wind'}->getyx($self->{'_ycrs'}, $self->{'_xcrs'});
print($self->{'_valudol8'});
printf("\e[%d;%dH", $self->{'_ycrs'} + 1, $self->{'_xcrs'});
}
if($curs){
$self->{'_wind'}->move($ycrs, $xcrs);
$self->{'_wind'}->getyx($self->{'_ycrs'}, $self->{'_xcrs'});
}else{
system("screen $ycrs $xcrs");
}
if($self->{'_btyp'}){ $self->{'_ycrs'}--; $self->{'_xcrs'}--; }
$self->{'_wind'}->refresh() if($curs);
return($self->{'_ycrs'}, $self->{'_xcrs'});
}
sub Rsiz{ # update window dimensions (Resize)
my $self = shift; my $hite = shift; my $widt = shift; my $eflg = 0;
my ($ymax, $xmax);
if(defined($hite) && defined($widt)){
$hite = getmaxy() if($hite == -1);
$widt = getmaxx() if($widt == -1);
}else{
$hite = $self->{'_hite'} unless(defined($hite));
$widt = $self->{'_widt'};
}
$hite = 1 if($hite < 1);
$widt = 1 if($widt < 1);
if($self->{'_btyp'}){ # don't resize text && borders away
$hite = 3 if($hite < 3);
$widt = 3 if($widt < 3);
$ymax = $self->{'_wind'}->getmaxy();
$xmax = $self->{'_wind'}->getmaxx();
if(($self->{'_ycrs'} == ($hite - 2) &&
$self->{'_xcrs'} == ($widt - 3) &&
$self->{'_widt'} != ($xmax )) ||
($self->{'_ycrs'} == ($hite - 3) &&
$self->{'_xcrs'} == ($widt - 2) &&
$self->{'_hite'} != ($ymax )) ||
($self->{'_ycrs'} == ($hite - 1) &&
$self->{'_xcrs'} == ($widt - 2)) ||
($self->{'_ycrs'} == ($hite - 2) &&
$self->{'_xcrs'} == ($widt - 1))){
$eflg = 1;
}
}
if($curs){
$self->{'_hite'} = getmaxy() if($self->{'_hite'} > getmaxy());
}elsif($GLBL{'FLAGU4NT'}){
$self->{'_hite'} = $SDAT{'_ROWS'} if($self->{'_hite'} > $SDAT{'_ROWS'});
}
$self->{'_widt'} = 1;
$self->{'_widt'} += (1 + length($self->{'_titl'})) if(length($self->{'_titl'}));
if($self->{'_text'} && @{$self->{'_text'}}){
for(@{$self->{'_text'}}){
$self->{'_widt'} = length($_) if($self->{'_widt'} < length($_));
}
$self->{'_widt'} += 2 if($self->{'_btyp'});
}
if($curs){
$self->{'_widt'} = getmaxx() if($self->{'_widt'} > getmaxx());
}elsif($GLBL{'FLAGU4NT'}){
$self->{'_widt'} = $SDAT{'_COLUMNS'} if($self->{'_widt'} > $SDAT{'_COLUMNS'});
}
}
if($self->{'_flagcntr'}){ # set yoff,xoff so window is centered
if($curs){
$self->{'_yoff'} = int((getmaxy() - $self->{'_hite'}) / 2);
$self->{'_xoff'} = int((getmaxx() - $self->{'_widt'}) / 2);
}elsif($GLBL{'FLAGU4NT'}){
$self->{'_yoff'} = int(($SDAT{'_ROWS'} - $self->{'_hite'}) / 2);
$self->{'_xoff'} = int(($SDAT{'_COLUMNS'} - $self->{'_widt'}) / 2);
}
}
}
$self->{'_yoff'} = 0 if($self->{'_yoff'} < 0);
$self->{'_xoff'} = 0 if($self->{'_xoff'} < 0);
unless($noch){ # the window has been created so it's ok to change it
$noch = 1; # reappropriate NoChanges flag to designate whether changed
if( $hite != $self->{'_hite'} || $widt != $self->{'_widt'}){
$self->Rsiz();
# $self->{'_wind'}->resize($self->{'_hite'}, $self->{'_widt'});
if($hite > $self->{'_hite'} || $widt > $self->{'_widt'}){
$self->ShokScrn(2); # Clear/Refresh main screen because window shrank
}
$noch = 0;
}
if($yoff != $self->{'_yoff'} || $xoff != $self->{'_xoff'}) {
$self->{'_wind'}->mvwin( $self->{'_yoff'}, $self->{'_xoff'}) if($curs);
$self->ShokScrn(2); # Clear/Refresh main screen because window moved
$noch = 0;
}
}
return(!$noch); # return flag telling whether self resized or moved
}
# Mesg() is a special Curses::Simp object constructor which creates a
# completely temporary Message window.
# If params are supplied, they must be hash key => value pairs.
sub Mesg{
my $main = shift; my($keey, $valu); my $char = -1;
my $self = bless({}, ref($main));
for my $attr ($self->AttrNamz()){
$self->{$attr} = $self->DfltValu($attr); # init defaults
}
# special Mesg window defaults
$self->{'_flagmaxi'} = 0; # not maximized
$self->{'_flagcvis'} = 0; # don't show cursor
$self->{'_flagclru'} = $main->{'_flagclru'}; # inherit ColorUsed flag
$self->{'_mesg'} = '';#EROR!';
$self->{'_text'} = [ ];
if($self->{'_flagclru'}){
$self->{'_fclr'} = [ 'C' ];
$self->{'_bclr'} = [ 'u' ];
}
$self->{'_titl'} = 'Message:';
$self->{'_ttfc'} = 'G';
$self->{'_ttbc'} = 'k';
$self->{'_flagprsk'} = 1;
$self->{'_pres'} = 'Press A Key...';
$self->{'_prfc'} = 'Y';
$self->{'_prbc'} = 'r';
$self->{'_wait'} = 0;
$self->{'_type'} = ''; # type can be set to special message types
# like 'help' or 'info'
$self->{'_stat'} = 0; # checkbox status
$self->{'_elmo'} = ''; # special field to make this Mesg an ELeMent Of
for(@KMODNAMZ){ $self->{'_kmod'}->{$_} = 0; }
# there were init params with no colon (classname)
while(@_){
($keey, $valu)=(shift, shift);
if(defined($valu)){
if($keey =~ /^(mesg|pres|wait|type|stat|elmo|flagprsk)$/){
$self->{"_$keey"} = $valu;
}else{
for my $attr ($self->AttrNamz()){
$self->{$attr} = $valu if($attr =~ /$keey/i);
}
}
}else{
$self->{'_mesg'} = $keey;
}
}
unless(@{$self->{'_text'}}){
@{$self->{'_text'}} = split(/\n/, $self->{'_mesg'});
}
if($self->{'_type'}){
$self->{'_titl'} = '' if($self->{'_titl'} eq 'Message:');
if ($self->{'_type'} =~ /^(help|info)$/ && $self->{'_flagclru'}){
if($self->{'_text'}->[0] =~ /^(\s*)(\w+)(\s*)(v\d+\.)(\d+\.\S{7})(\s*-\s*)((written|hacked|coded|made)?\s*by\s*)(.+)$/i){
my %mtch = ();
$mtch{'1'} = $1 if(defined($1));
$mtch{'2'} = $2 if(defined($2));
$mtch{'3'} = $3 if(defined($3));
$mtch{'4'} = $4 if(defined($4));
$mtch{'5'} = $5 if(defined($5));
$mtch{'6'} = $6 if(defined($6));
$mtch{'7'} = $7 if(defined($7));
$mtch{'9'} = $9 if(defined($9));
$self->{'_fclr'}->[0] = '';
$self->{'_bclr'}->[0] = '';
$self->{'_fclr'}->[0] .= ' ' x length($mtch{'1'}) if(exists($mtch{'1'}));
$self->{'_bclr'}->[0] .= 'u' x length($mtch{'1'}) if(exists($mtch{'1'}));
$self->{'_fclr'}->[0] .= 'G' x length($mtch{'2'});
$self->{'_bclr'}->[0] .= 'u' x length($mtch{'2'});
$self->{'_fclr'}->[0] .= ' ' x length($mtch{'3'}) if(exists($mtch{'3'}));
$self->{'_bclr'}->[0] .= 'u' x length($mtch{'3'}) if(exists($mtch{'3'}));
$self->{'_fclr'}->[0] .= 'W' . 'Y' x (length($mtch{'4'}) - 2) . 'W';
if ($self->{'_type'} eq 'butn'){
my $widt = 3;
if($self->{'_titl'}){
$self->{'_btyp'} = 1 unless($self->{'_btyp'});
}else{
for(@{$self->{'_text'}}){
$widt = (length($_) + 2) if($widt < (length($_) + 2));
}
$self->{'_widt'} = $widt unless($self->{'_widt'});
}
}elsif($self->{'_type'} eq 'ckbx'){
my $ndnt;
$self->{'_onbx'} = '[X] - ' unless(exists($self->{'_onbx'}));
unless(exists($self->{'_ofbx'})){
$self->{'_ofbx'} = $self->{'_onbx'};
$self->{'_ofbx'} =~ s/^(.)./$1 /;
}
$ndnt = ' ' x length($self->{'_ofbx'});
for(@{$self->{'_text'}}){
$_ =~ s/^/$ndnt/;
}
if($self->{'_stat'}){
$self->{'_text'}->[0] =~ s/^$ndnt/$self->{'_onbx'}/;
}else{
$self->{'_text'}->[0] =~ s/^$ndnt/$self->{'_ofbx'}/;
}
if($self->{'_flagclru'}){
$self->{'_fclr'}->[0] = 'c';
$self->{'_bclr'}->[0] = 'k';
}
}
}
}
if($self->{'_flagprsk'}){
if(length($self->{'_pres'})){
if($self->{'_flagclru'}){
$self->{'_fclr'}->[@{$self->{'_text'}}] = $self->{'_prfc'};
$self->{'_bclr'}->[@{$self->{'_text'}}] = $self->{'_prbc'};
}
my $wdst = 0;
$wdst = length($self->{'_titl'}) + 2;
if(@{$self->{'_text'}}){ # center press string
for(@{$self->{'_text'}}){
$wdst = length($_) if($wdst < length($_));
}
}
if($wdst > length($self->{'_pres'})){
$self->{'_pres'} = ' ' x int(($wdst - length($self->{'_pres'})) / 2) . $self->{'_pres'};
}
push(@{$self->{'_text'}}, $self->{'_pres'});
}
}
$self->{'_flagshrk'} = 0 if($self->{'_hite'} && $self->{'_widt'});
$self->Updt(1);
$self->{'_wind'} = newwin($self->{'_hite'}, $self->{'_widt'},
$self->{'_yoff'}, $self->{'_xoff'});
unless(exists($self->{'_wind'}) && defined($self->{'_wind'})){
exit;
# croak "!*EROR*! Curses::Simp::Mesg could not create new window with hite:$self->{'_hite'}, widt:$self->{'_widt'}, yoff:$self->{'_yoff'}, xoff:$self->{'_xoff'}!\n";
}
$self->FlagCVis(); # set cursor visibility to new object state
$self->TestDraw();
if ($self->{'_flagprsk'}){
if($self->{'_wait'}) { $char = $self->GetK($self->{'_wait'}); }
else { $char = $self->GetK(-1); }
$char = '#' . $char if($self->{'_kmod'}->{'KMOD_SHIFT'});
$char = '^' . $char if($self->{'_kmod'}->{'KMOD_CTRL' });
$char = '@' . $char if($self->{'_kmod'}->{'KMOD_ALT' });
}elsif($self->{'_wait'}){
$self->Wait($self->{'_wait'});
}
$self->{'_dndx'} = @DISPSTAK; # add object to display order stack
push(@DISPSTAK, \$self);
if($self->{'_type'} =~ /^(butn|ckbx)$/){
return($self); # special types Button && CheckBox persist
}else{
$self->DelW();
$main->ShokScrn(2);# redraw rest
$main->FlagCVis(); # reset cursor visibility to calling object state
return($char); # return character pressed to dismiss Mesg (if any)
}
}
# Prmt() is a special Curses::Simp object constructor which creates a
# completely temporary Prompt window.
# If params are supplied, they must be hash key => value pairs.
sub Prmt{
my $main = shift; my($keey, $valu); my $char; my $tchr; my $data;
my $self = bless({}, ref($main)); my $twid; my $indx;
for my $attr ($self->AttrNamz()){
$self->{$attr} = $self->DfltValu($attr); # init defaults
}
# special Prmt window defaults
$self->{'_flagsdlk'} = 1; # get SDLKeys
$self->{'_flagmaxi'} = 0; # not maximized
$self->{'_flagcvis'} = 1; # show cursor
$self->{'_flagedit'} = 1; # editable
$self->{'_flagescx'} = 0; # Escape key eXits
$self->{'_flagclru'} = $main->{'_flagclru'}; # inherit ColorUsed flag
$self->{'_widt'} = getmaxx() - 4; # but almost full screen wide
$self->{'_hite'} = 3; # && start 1 text line high
# $self->{'_dref'} = \$data; # default text data ref !exist at start
$self->{'_dtxt'} = '';
$self->{'_text'} = [ ];
$self->{'_dtfc'} = 'G';
$self->{'_dtbc'} = 'u';
if($self->{'_flagclru'}){
$self->{'_fclr'} = [ $self->{'_dtfc'} ];
$self->{'_bclr'} = [ $self->{'_dtbc'} ];
}
$self->{'_titl'} = 'Enter Text:';
$self->{'_ttfc'} = 'C';
$self->{'_ttbc'} = 'k';
$self->{'_hifc'} = 'W';
$self->{'_hibc'} = 'g';
$self->{'_curs'} = 0; # special prompt cursor index
$self->{'_sscr'} = 0; # special prompt side-scrolling index
$self->{'_type'} = 'prmt'; # type can be set to special prompt types
# like 'drop', 'cbls', or 'rdls'
$self->{'_lndx'} = 0; # special line index for drop down types
$self->{'_elmo'} = ''; # special field to make this Prmt an ELeMent Of
for(@KMODNAMZ){ $self->{'_kmod'}->{$_} = 0; }
# there were init params with no colon (classname)
while(@_){
($keey, $valu)=(shift, shift);
if(defined($valu)) {
if($keey =~ /^(dref|dtxt|type|lndx|elmo|flagedit|flagescx)$/){
$self->{"_$keey"} = $valu;
}else{
for my $attr ($self->AttrNamz()){
$self->{$attr} = $valu if($attr =~ /$keey/i);
}
}
}else{
$self->{'_dref'} = $keey;
}
}
if (exists($self->{'_dref'})){
$self->{'_dtxt'} = ${$self->{'_dref'}};
}elsif(exists($self->{'_text'}) && @{$self->{'_text'}}){
$self->{'_dtxt'} = $self->{'_text'}->[0];
if($self->{'_flagclru'}){
for($indx = 1; $indx < @{$self->{'_text'}}; $indx++){
$self->{'_fclr'}->[$indx] = $self->{'_dtfc'} unless($self->{'_fclr'}->[$indx]);
$self->{'_bclr'}->[$indx] = $self->{'_dtbc'} unless($self->{'_bclr'}->[$indx]);
}
}
}
$self->{'_data'} = $self->{'_dtxt'};
if($self->{'_type'} eq 'drop'){
$self->{'_flagdrop'} = 1;
$self->{'_flagdown'} = 0;
$self->{'_flagcntr'} = 0;
$self->{'_lndx'} = 0 unless($self->{'_lndx'});
$self->{'_hite'} = 3;
if($self->{'_widt'} == (getmaxx() - 4) && @{$self->{'_text'}}){
$self->{'_widt'} = 3;
for(@{$self->{'_text'}}){
$self->{'_widt'} = (length($_) + 6) if($self->{'_widt'} < (length($_) + 6));
}
$self->{'_dtxt'} = $self->{'_text'}->[$self->{'_lndx'}];
$self->{'_data'} = $self->{'_dtxt'};
}
unshift(@{$self->{'_text'}}, $self->{'_data'});
}else{
$self->{'_text'}->[0] = $self->{'_data'} unless(@{$self->{'_text'}});
}
$self->{'_curs'} = length($self->{'_data'});
if($self->{'_widt'} < length($self->{'_titl'}) + 4){
$self->{'_widt'} = length($self->{'_titl'}) + 4;
}
$twid = $self->{'_widt'} - 2;
unless($self->{'_curs'} <= $twid){ # scrolling necessary off to the left
substr($self->{'_text'}->[0], 0, $twid, substr($self->{'_data'}, -$twid, $twid));
}
if($self->{'_flagclru'}){
$self->{'_fclr'}->[0] = $self->{'_hifc'} if($self->{'_curs'});
$self->{'_bclr'}->[0] = $self->{'_hibc'} if($self->{'_curs'});
}
$self->{'_ycrs'} = 0;
$self->{'_xcrs'} = $self->{'_curs'};
$self->{'_flagshrk'} = 0 if($self->{'_hite'} && $self->{'_widt'});
$self->Updt(1);
$self->{'_wind'} = newwin($self->{'_hite'}, $self->{'_widt'},
$self->{'_yoff'}, $self->{'_xoff'});
unless(exists($self->{'_wind'}) && defined($self->{'_wind'})){
croak "!*EROR*! Curses::Simp::Prmt could not create new window with hite:$self->{'_hite'}, widt:$self->{'_widt'}, yoff:$self->{'_yoff'}, xoff:$self->{'_xoff'}!\n";
}
$self->FlagCVis(); # set cursor visibility to new object state
$self->TestDraw();
$self->{'_dndx'} = @DISPSTAK; # add object to display order stack
push(@DISPSTAK, \$self);
if($self->{'_type'} =~ /^(drop)$/){
return($self); # $self must be given explicit focus via Focu()
}else{
$self->Focu(); # give Prompt focus (to handle GetK loops)
${$self->{'_dref'}} = $self->{'_data'} if(exists($self->{'_dref'}));
$data = $self->{'_data'};
$self->DelW();
$main->ShokScrn(2);# redraw rest
$main->FlagCVis(); # reset cursor visibility to calling object state
return($data); # return updated text data
}
}
# Focu() is a Curses::Simp method which give focus to special
# typed objects like CheckBoxes or DropDownMenus.
# Maybe later, it will change the border type / color of normal
# Simp object windows as they gain focus.
sub Focu{
my $self = shift; return() unless(exists($self->{'_type'}));
my $updt = shift || 0; my $char = -1; my $tchr;
unless($updt) {
if ($self->{'_type'} eq 'ckbx') {
$self->Draw('fclr' => [ 'C' ]) if($self->{'_flagclru'});
$char = $self->GetK(-1);
$self->Draw('fclr' => [ 'c' ]) if($self->{'_flagclru'});
if($char =~ /^SDLK_(SPACE)$/) { # checkbox toggle keys
$self->{'_stat'} ^= 1; # any other key loses focus
$updt = 1; # leaving ckbx state same
}
} elsif($self->{'_type'} =~ /^(prmt|drop)$/) { # big Prmt (drop)? focus
my $cmov; my $done = 0; # input handler
$self->FlagCVis(1);
while(!$done) {
$char = $self->GetK(-1);
$tchr = $char;
$tchr =~ s/SDLK_//;
$done = 1 if($tchr eq 'RETURN');
if($self->{'_elmo'} eq 'brws' && $self->{'_flagdrop'} &&
(($tchr eq 'F1') ||
($tchr =~ /^[bcfhu]$/ && $self->{'_kmod'}->{'KMOD_CTRL'}) ||
($tchr =~ /^(ESCAPE|SPACE|TILDE|BACKQUOTE)$/ && $self->{'_flagdown'}) ||
($tchr =~ /^(UP|DOWN|LEFT|RIGHT|j|k)$/ && !$self->{'_flagdown'}) ||
$tchr =~ /^(TAB)$/)) {
if($self->{'_flagdrop'} && !$self->{'_flagdown'}) {
$self->{'_dtxt'} = $self->{'_data'};
if($self->{'_flagclru'}) {
$self->{'_fclr'}->[$self->{'_lndx'}] = $self->{'_hifc'};
$self->{'_bclr'}->[$self->{'_lndx'}] = $self->{'_hibc'};
}
}
$self->{'_echg'} = 1;
$done = 1;
}elsif($tchr eq 'TAB'){
$tchr = ' ';
}
$tchr = uc($tchr) if($self->{'_kmod'}->{'KMOD_SHIFT'});
if($self->{'_flagdrop'} && $self->{'_flagdown'}){ # DropIsDown
if($char ne 'SDLK_TAB'){
if ($tchr =~ /^(RETURN|ESCAPE|SPACE|TILDE|BACKQUOTE)$/) {
$self->{'_flagdown'} = 0; # Close Drop down
$self->{'_dtxt'} = $self->{'_text'}->[$self->{'_lndx'}];
$self->{'_data'} = $self->{'_dtxt'};
unshift(@{$self->{'_text'}}, $self->{'_data'});
$self->{'_hite'} = 3;
if($self->{'_flagclru'}){
$self->{'_fclr'}->[$self->{'_lndx'}] = $self->{'_dtfc'};
$self->{'_bclr'}->[$self->{'_lndx'}] = $self->{'_dtbc'};
$self->{'_fclr'}->[0] = $self->{'_hifc'};
$self->{'_bclr'}->[0] = $self->{'_hibc'};
}
$self->{'_ycrs'} = $self->{'_lndx'};
$self->Draw();
}
}elsif( $char ne 'SDLK_RETURN' && (!$self->{'_flagdrop'} ||
( $self->{'_elmo'} eq 'brws' &&
$char ne 'SDLK_TAB' && $self->{'_flagdrop'} &&
($char !~ /^SDLK_[bcfhu]$/ || !$self->{'_kmod'}->{'KMOD_CTRL'})))){
$cmov = 0; # mostly regular Prmt stuff
if ( $self->{'_flagdrop'} && ($tchr =~ /^(TILDE|BACKQUOTE)$/ ||
( $tchr eq 'SPACE' && (!$self->{'_flagclru'} ||
($self->{'_fclr'}->[0] eq $self->{'_hifc'} &&
$self->{'_bclr'}->[0] eq $self->{'_hibc'}))))){
$self->{'_flagdown'} = 1; # drop Down
shift(@{$self->{'_text'}});
$self->{'_hite'} = @{$self->{'_text'}} + 2;
$self->{'_dtxt'} = $self->{'_text'}->[$self->{'_lndx'}];
$self->{'_data'} = $self->{'_dtxt'};
if($self->{'_flagclru'}){
$self->{'_fclr'}->[0] = $self->{'_dtfc'};
$self->{'_bclr'}->[0] = $self->{'_dtbc'};
}
$self->{'_curs'} = length($self->{'_data'});
$self->{'_sscr'} = 0;
}elsif($tchr eq 'UP' ){
if($self->{'_flagdrop'} && !$self->{'_flagdown'}) {
if($self->{'_lndx'}) {
$self->{'_lndx'}--;
$self->{'_dtxt'} = $self->{'_text'}->[$self->{'_lndx'} + 1];
$self->{'_data'} = $self->{'_dtxt'};
$self->{'_text'}->[0] = $self->{'_data'};
if($self->{'_flagclru'}){
$self->{'_fclr'}->[0] = $self->{'_hifc'};
$self->{'_bclr'}->[0] = $self->{'_hibc'};
}
$self->{'_curs'} = length($self->{'_data'});
$self->{'_echg'} = 1 if($self->{'_elmo'} eq 'brws');
}
}elsif($self->{'_flagedit'} && $self->{'_curs'}){ # uppercase
my $temp = substr($self->{'_data'}, $self->{'_curs'}, 1);
substr($self->{'_data'}, $self->{'_curs'}, 1, uc($temp));
}
}elsif($tchr eq 'DOWN'){
if($self->{'_flagdrop'} && !$self->{'_flagdown'}){
if($self->{'_lndx'} < (@{$self->{'_text'}} - 2)){
$self->{'_lndx'}++;
$self->{'_dtxt'} = $self->{'_text'}->[$self->{'_lndx'} + 1];
$self->{'_data'} = $self->{'_dtxt'};
$self->{'_text'}->[0] = $self->{'_data'};
if($self->{'_flagclru'}){
$self->{'_fclr'}->[0] = $self->{'_hifc'};
$self->{'_bclr'}->[0] = $self->{'_hibc'};
}
$self->{'_curs'} = length($self->{'_data'});
$self->{'_echg'} = 1 if($self->{'_elmo'} eq 'brws');
}
}elsif($self->{'_flagedit'} && $self->{'_curs'}){ # lowercase
my $temp = substr($self->{'_data'}, $self->{'_curs'}, 1);
substr($self->{'_data'}, $self->{'_curs'}, 1, lc($temp));
}
}elsif($self->{'_flagedit'}){
if ($tchr eq 'LEFT' ) { # move cursor left
if($self->{'_curs'}) {
$self->{'_curs'}--;
$self->{'_sscr'}-- if($self->{'_sscr'});
}
$cmov = 1;
}elsif($tchr eq 'RIGHT'){ # move cursor right
if($self->{'_curs'} < length($self->{'_data'})){
$self->{'_curs'}++;
}
$cmov = 1;
}elsif($tchr eq 'HOME' ){ # move cursor to beginning
$self->{'_curs'} = 0;
$self->{'_sscr'} = 0 if($self->{'_sscr'});
$cmov = 1;
}elsif($tchr eq 'END' ){ # move cursor to end
$self->{'_curs'} = length($self->{'_data'});
if(length($self->{'_data'}) < $self->{'_widt'} - 2){
$self->{'_sscr'} = (length($self->{'_data'}) - $self->{'_widt'} - 2);
}
$cmov = 1;
}elsif($tchr eq 'INSERT'){
$self->FlagInsr('togl');
if($self->FlagInsr){ $self->{'_titl'} =~ s/\[O\]$//; }
else { $self->{'_titl'} .= '[O]';
unless($self->Widt() > length($self->Titl()) + 4){
$self->Widt(length($self->Titl()) + 4);
$self->Draw(); # was $main
}
}
}elsif($tchr eq 'BACKSPACE' || ord($tchr) == 127){
if($self->{'_curs'}){
substr($self->{'_data'}, --$self->{'_curs'}, 1, '');
$self->{'_sscr'}-- if($self->{'_sscr'});
}
}elsif($tchr eq 'DELETE'){
if($self->{'_curs'} < length($self->{'_data'})) {
substr($self->{'_data'}, $self->{'_curs'}, 1, '');
$self->{'_sscr'}-- if($self->{'_sscr'});
}
}elsif($tchr eq 'ESCAPE'){
if($self->{'_flagescx'}){
$self->{'_data'} = '';
$self->{'_curs'} = 0;
}else{
if($self->{'_flagclru'}){
$self->{'_fclr'}->[0] = $self->{'_hifc'};
$self->{'_bclr'}->[0] = $self->{'_hibc'};
}
$self->{'_data'} = $self->{'_dtxt'};
$self->{'_curs'} = length($self->{'_data'});
$self->{'_sscr'} = 0;
}
}else{
for(keys(%SDLKCHRM)){
$tchr = $_ if($tchr eq $SDLKCHRM{$_});
}
if($tchr ne 'F1'){
if($self->{'_flagclru'} &&
$self->{'_fclr'}->[0] eq $self->{'_hifc'} &&
$self->{'_bclr'}->[0] eq $self->{'_hibc'}){
$self->{'_data'} = $tchr;
$self->{'_curs'} = length($self->{'_data'});
}else{
if ($self->{'_curs'} == length($self->{'_data'})){
$self->{'_data'} .= $tchr;
}elsif($self->FlagInsr()){
substr($self->{'_data'}, $self->{'_curs'}, 0,$tchr);
}else{
substr($self->{'_data'}, $self->{'_curs'},length($tchr),$tchr);
}
$self->{'_curs'} += length($tchr);
}
}
}
while((($self->{'_curs'} - $self->{'_sscr'}) >= ($self->{'_widt'} - 2)) ||
$self->{'_bclr'}->[-1] .= ' w ';
}
}
}
}
$self->{'_text'}->[-1] .= ' ';
if($self->{'_flagclru'}){
$self->{'_fclr'}->[-1] .= ' ';
$self->{'_bclr'}->[-1] .= ' ';
}
}
}
if ($self->{'_hndx'} < 4){
$self->Move( 3, (( $self->{'_hndx'} * 16) + 2));
}elsif($self->{'_hndx'} < 8){
$self->Move( 8, ((($self->{'_hndx'} - 4) * 16) + 2));
}elsif($self->{'_hndx'} < 12){
$self->Move(13, ((($self->{'_hndx'} - 8) * 16) + 2));
}else{
$self->Move(18, ((($self->{'_hndx'} - 12) * 16) + 2));
}
}
if($self->{'_flagprsk'}){
if(length($self->{'_pres'})){
if($self->{'_flagclru'}){
$self->{'_fclr'}->[@{$self->{'_text'}}] = $self->{'_prfc'};
$self->{'_bclr'}->[@{$self->{'_text'}}] = $self->{'_prbc'};
}
my $wdst = 0;
$wdst = length($self->{'_titl'}) + 4;
if(@{$self->{'_text'}}){ # center press string
for(@{$self->{'_text'}}){
$wdst = length($_) if($wdst < length($_));
}
}
if($wdst > length($self->{'_pres'})){
$self->{'_pres'} = ' ' x int(($wdst - length($self->{'_pres'}) + 1) / 2) . $self->{'_pres'} . ' ' x int(($wdst - length($self->{'_pres'}) + 1) / 2);
}
push(@{$self->{'_text'}}, $self->{'_pres'});
}
}
$self->Draw();
return();
}
# CPik() is a special Curses::Simp object constructor which creates a
# Color Pick window.
# If params are supplied, they must be hash key => value pairs.
sub CPik{
my $main = shift;my($keey,$valu);my $char;my $tchr;my $text = '';
my $self = bless({}, ref($main));
my $cmov;my $pick;my $done = 0;
# ' ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿','ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß',
my @bchz = ( 'X', '@', '#', '$', 'Û', '²', '±', '°'); # block chars
my @styz = ( 'barz', 'blox', 'squr' ); # color display styles
for my $attr($self->AttrNamz()){
$self->{$attr} = $self->DfltValu($attr); # init defaults
}
# special CPik window defaults
$self->{'_flagsdlk'} = 1; # get SDLKeys
$self->{'_flagmaxi'} = 0; # not maximized
$self->{'_flagcvis'} = 1; # show cursor
$self->{'_flagbakg'} = 1; # pick background colors
$self->{'_flagforg'} = 1; # pick foreground colors
$self->{'_flagclru'} = $main->{'_flagclru'}; # inherit ColorUsed flag
# $self->{'_widt'} = getmaxx() - 4; # but almost full screen wide
# $self->{'_hite'} = getmaxy() - 4; # && high
$self->{'_text'} = [ ' ' ];
$self->{'_dtfc'} = 'G';
$self->{'_dtbc'} = 'u';
if($self->{'_flagclru'}){
$self->{'_fclr'} = [ $self->{'_dtfc'} ];
$self->{'_bclr'} = [ $self->{'_dtbc'} ];
}
$self->{'_titl'} = 'Color Picker:';
$self->{'_ttfc'} = 'ROYGUbG';
$self->{'_ttbc'} = 'pgcupbu';
$self->{'_flagprsk'} = 1;
$self->{'_pres'} = 'Pick A Color... (Arrows+Enter, Letter, or Number)';
$self->{'_prfc'} = 'Y'; # Pick message foreground Color
$self->{'_prbc'} = 'k'; # Pick message background Color
$self->{'_hifc'} = 'W'; # highlight foreground color
$self->{'_hibc'} = 'g'; # highlight background color
$self->{'_hndx'} = 7; # highlight index
$self->{'_sndx'} = 0; # style index
$self->{'_styl'} = 'barz';# style name
$self->{'_bndx'} = 0; # block index
$self->{'_bchr'} = 'X'; # block char
for(@KMODNAMZ){ $self->{'_kmod'}->{$_} = 0; }
# there were init params with no colon (classname)
while(@_){
($keey, $valu)=(shift, shift);
if(defined($valu)){
if ($keey =~ /^_*....$/){
$keey =~ s/^_*//;
$self->{"_$keey"} = $valu;
}else{
for my $attr($self->AttrNamz()){
$self->{$attr} = $valu if($attr =~ /$keey/i);
}
}
}else{
$self->{'_styl'} = $keey;
}
}
$self->{'_sndx'} = $self->{'_styl'} if($self->{'_styl'} =~ /^\d+$/);
$self->{'_styl'} = $styz[$self->{'_sndx'}];
$self->{'_bndx'} = $self->{'_bchr'} if($self->{'_bchr'} =~ /^\d+$/);
$self->{'_bchr'} = $bchz[$self->{'_bndx'}];
if($self->{'_widt'} < length($self->{'_titl'}) + 4){
$self->{ '_widt'} = length($self->{'_titl'}) + 4;
}
$self->{'_ycrs'} = $self->{'_hndx'};
$self->{'_xcrs'} = 0;
$self->{'_flagshrk'} = 0 if($self->{'_hite'} && $self->{'_widt'});
$self->Updt(1);
$self->{'_wind'} = newwin($self->{'_hite'}, $self->{'_widt'},
$self->{'_yoff'}, $self->{'_xoff'});
unless(exists($self->{'_wind'}) && defined($self->{'_wind'})){
croak "!*EROR*! Curses::Simp::CPik could not create new window with hite:$self->{'_hite'}, widt:$self->{'_widt'}, yoff:$self->{'_yoff'}, xoff:$self->{'_xoff'}!\n";
}
$self->FlagCVis(); # set cursor visibility to new object state
$self->BildBlox(); # build color block data into @text,@fclr,@bclr && Draw()
$self->Move($self->{'_hndx'}, 0);
while(!defined($char) || !$done){
$char = $self->GetK(-1);
if($char =~ /^SDLK_(RETURN|[0-9A-FRGYUPW])$/i){ # gonna be done
$char =~ s/^SDLK_//;
if ($char =~ /^[BRGYUPCW]$/i){
$pick = $char;
$pick = uc($pick) if($self->{'_kmod'}->{'KMOD_SHIFT'});
}else{
$self->{'_hndx'} = dec(uc($char)) unless($char =~ /^RETURN$/);
$pick = $telc[ ($self->{'_hndx'} % 8)];
$pick = uc($pick) if($self->{'_hndx'} >= 8);
}
$done = 1;
}else{
$tchr = $char;
$tchr =~ s/^SDLK_//;
$cmov = 0;
if ($tchr eq 'PAGEUP' ){ # Page keys cycle Block Char
$self->{'_bndx'}++;
$self->{'_bndx'} = 0 if($self->{'_bndx'} == @bchz);
}elsif($tchr eq 'PAGEDOWN'){
$self->{'_bndx'} = @bchz unless($self->{'_bndx'});
$self->{'_bndx'}--;
}elsif($tchr eq 'END' ){ # Home/End cycles layout Style
$self->{'_sndx'}++;
$self->{'_sndx'} = 0 if($self->{'_sndx'} == @styz);
}elsif($tchr eq 'HOME' ){
$self->{'_sndx'} = @styz unless($self->{'_sndx'});
$self->{'_sndx'}--;
}
$self->{'_bchr'} = $bchz[$self->{'_bndx'}];
$self->{'_styl'} = $styz[$self->{'_sndx'}];
if ($self->{'_styl'} eq 'barz'){
if ($tchr eq 'LEFT' or $tchr eq 'UP' ){
$self->{'_hndx'} = 16 unless($self->{'_hndx'});
$self->{'_hndx'}--;
}elsif($tchr eq 'RIGHT' or $tchr eq 'DOWN'){
$self->{'_hndx'}++;
$self->{'_hndx'} = 0 if($self->{'_hndx'} == 16);
}
}elsif($self->{'_styl'} eq 'blox'){
if ($tchr eq 'DOWN' or $tchr eq 'UP'){
$self->{'_hndx'} += 8;
$self->{'_hndx'} -= 16 if($self->{'_hndx'} >= 16);
}elsif($tchr eq 'LEFT' ){
$self->{'_hndx'} = 16 unless($self->{'_hndx'});
$self->{'_hndx'}--;
}elsif($tchr eq 'RIGHT'){
$self->{'_hndx'}++;
$self->{'_hndx'} = 0 if($self->{'_hndx'} == 16);
}
}elsif($self->{'_styl'} eq 'squr'){
if ($tchr eq 'UP' ){
$self->{'_hndx'} -= 4;
$self->{'_hndx'} += 16 if($self->{'_hndx'} < 0);
}elsif($tchr eq 'DOWN' ){
$self->{'_hndx'} += 4;
$self->{'_hndx'} -= 16 if($self->{'_hndx'} >= 16);
}elsif($tchr eq 'LEFT' ){
$self->{'_hndx'} = 16 unless($self->{'_hndx'});
$self->{'_hndx'}--;
}elsif($tchr eq 'RIGHT'){
$self->{'_hndx'}++;
$self->{'_hndx'} = 0 if($self->{'_hndx'} == 16);
}
} $self->BildBlox();
}
} delwin($self->{'_wind'}); # delete the CPik window, redraw rest
$main->ShokScrn(2);
$main->FlagCVis(); # reset cursor visibility to calling object state
return($pick); # return picked color code
}
sub BrwsHelp{ # BrwsHelp() just prints a help text message for Brws()
my $self = shift;
$self->Mesg('type' => 'help',
'titl' => 'File / Directory Browser Help: (F1)',
"This Browser dialog exists to make it easy to choose a file (or directory).
You can <TAB> between elements. Ctrl-I and TAB are interpreted as the same
key by Curses so either one can be pressed to cycle forward through Browse
elements. Ctrl-U cycles backwards. Ctrl-H toggles hidden files.
Ctrl-F toggles file highlighting. Ctrl-C shows the configuration screen.
All drop downs can be navigated with the arrow keys, typed directly into,
or have their drop state toggled with the tilde '~' or backtick '`' keys.
The '=C' button is supposed to look like a wrench for configuration.
Pressing enter on it will bring up the Browse configuration screen.
The 'md' button allows you to make a new directory in the current path.
The 'Path:' drop down lets you specify which directory to apply 'Filter:'
to when populating the main view box in the center.
The '..' button moves path up one directory.
The '??' button brings up this help text.
The main view box can be navigated with the arrow keys and a file can be
chosen with Enter.
The 'Filename:' drop down lets you type the filename specificially or
pick from recent choices.
The button following 'Filename:' will likely be labeled 'Open' or
'Save As' for the purpose of the Browsing. This button accepts
whatever name is in the 'Filename:' drop down.
The 'Filter:' drop down lets you specify what globbing should happen in
'Path:' to populate the main view.
The 'Cancel' button quits without making a selection.
");
}
# The '=C' button is supposed to look like a wrench for configuration.
# Pressing enter on it will bring up the Browse configuration screen.
# The 'md' button allows you to make a new directory in the current path.
# The 'Path:' drop down lets you specify which directory to apply 'Filter:'
# to when populating the main view box in the center.
# The '..' button moves path up one directory.
# The '??' button brings up this help text.
# The main view box can be navigated with the arrow keys and a file can be
# chosen with Enter.
# The 'Filename:' drop down lets you type the filename specificially or
# pick from recent choices.
# The button following 'Filename:' will likely be labeled 'Open' or
# 'Save As' for the purpose of the Browsing. This button accepts
# whatever name is in the 'Filename:' drop down.
# The 'Filter:' drop down lets you specify what globbing should happen in
# 'Path:' to populate the main view.
# The 'Cancel' button quits without making a selection.
sub BrwsCnfg{ # BrwsCnfg() brings up a dialog of checkboxes for elements
my $self = shift; my $char; my $cndx = 0;
my %cdsc = ('_cnfg' => '=C - Configuration Button',
'_mkdr' => 'md - Make Directory Button',
'_path' => 'Path: Drop Down',
'_cdup' => '.. - Change Directory Up Button',
'_help' => '?? - Help Button',
'_view' => 'Main View Area ',
}
sub BrwsCdUp{ # BrwsCdUp() just moves the browse path up one directory
my $self = shift;
if($self->{'_path'} =~ s/^(.*\/).+\/?$/$1/){
$self->{'_bobj'}->{'_path'}->{'_text'}->[
($self->{'_bobj'}->{'_path'}->{'_lndx'} + 1) ] = $self->{'_path'};
$self->{'_bobj'}->{'_path'}->{'_dtxt'} = $self->{'_path'};
$self->{'_bobj'}->{'_path'}->{'_data'} = $self->{'_path'};
$self->{'_bobj'}->{'_path'}->{'_text'}->[0] = $self->{'_path'};
$self->{'_bobj'}->{'_path'}->{'_curs'} = length($self->{'_path'});
$self->{'_bobj'}->{'_path'}->{'_xcrs'} = length($self->{'_path'});
$self->{'_bobj'}->{'_path'}->{'_echg'} = 1;
}
}
# BildBrws() is a utility of Brws() which creates or updates all the
# elements of a Browse Window.
# Brws() bare-bones dialog should look something like:
# +------------------------{Open File:}-------------------------------+
# |+--------------------{cwd: /home/pip }----------------------------+|
# ||../ ||
# ||.LS_COLORS ||
# ||.ssh/ ||
# ||.zshrc *Highlighted line* ||
# ||dvl/ ||
# |+-----------------------------------------------------------------+|
# |+-----------------{Filename:}--------------+--++========++--------+|
# ||.zshrc |\/|| Open || Cancel ||
# |+------------------------------------------+--++========++--------+|
# +-------------------------------------------------------------------+
# or Brws() with frills
# +---------------------------{Open File:}----------------------------+
# |+--++--++-----------------------{Path:}----------------+--++--++--+|
# ||=C||md||/home/pip |\/||..||??||
# |+--++--++----------------------------------------------+--++--++--+|
# |+-----------------------------------------------------------------+|
# ||../ ||
# ||.LS_COLORS ||
# ||.ssh/ ||
# ||.zshrc *Highlighted line* ||
# ||dvl/ ||
# |+-----------------------------------------------------------------+|
# |+----------------------{Filename:}-------------------+--++========+|
# ||.zshrc |\/|| Open ||
# |+----------------------------------------------------+--++========+|
# |+-----------------------{Filter:}--------------------+--++--------+|
# ||* (All Files) |\/|| Cancel ||
# |+----------------------------------------------------+--++--------+|
# +-------------------------------------------------------------------+
# heh... this one is complicated enough that it should probably be
# Curses::Simp::Brws.pm instead ... too bad =)
# =C is configure wrench for new dialog of all toggles (&& hotkeys)
# md is mkdir dialog
# \/ drop down bar to show recent or common options
# .. is `cd ..`
# ?? is help / F1
# ==== box is highlighted (Enter selects)
# Ultimately, Brws() should be able to handle easy Browsing for
# Files or Directories for any Open/SaveAs/etc. purposes
sub BildBrws{
my $self = shift; my $updt = shift || 0; my $indx;
$self->FlagCVis(); # set cursor visibility to main Brws object state
$self->Draw();
for($indx=0;$indx<@{$self->{'_elem'}};$indx++){
if(!$self->{'_eflz'}->{$self->{'_elem'}->[$self->{'_endx'}]}){
$self->{'_endx'}++;
$self->{'_endx'} = 0 if($self->{'_endx'} == @{$self->{'_elem'}});
}
} # this for && below if make sure a visible element is indexed
if(!$self->{'_eflz'}->{$self->{'_elem'}->[$self->{'_endx'}]}){
$self->{'_eflz'}->{$self->{'_elem'}->[$self->{'_endx'}]} = 1;
}
for($indx = 0; $indx < @{$self->{'_elem'}}; $indx++){
my $elem = $self->{'_elem'}->[$indx];
if(!$updt || $self->{'_eflz'}->{$elem}){
my($yoff, $xoff)=($self->{'_yoff'} + 1, $self->{'_xoff'} + 1);
my($widt, $hite)=($self->{'_widt'} - 2, $self->{'_hite'} - 2);
my $type = 'butn';my $titl = '';my $btyp = 1;
my $brfc = 'w';my $brbc = 'k';my $scrl = 0;
my $mesg;my @text;my @fclr;my @bclr;
if($self->{'_flagclru'}){ @fclr = ( 'w' ); @bclr = ( 'k' ); }
if ($elem eq '_cnfg'){ # do specific settings
$hite = 3; $widt = 4;
$mesg = '=C';
}elsif($elem eq '_mkdr'){
$hite = 3; $widt = 4;
$xoff += 4 if($self->{'_eflz'}->{'_cnfg'});
$mesg = 'md';
}elsif($elem eq '_path'){
$hite = 3;
if($self->{'_eflz'}->{'_cnfg'}) { $xoff += 4; $widt -= 4; }
if($self->{'_eflz'}->{'_mkdr'}) { $xoff += 4; $widt -= 4; }
if($self->{'_eflz'}->{'_cdup'}) { $widt -= 4; }
if($self->{'_eflz'}->{'_help'}) { $widt -= 4; }
$type = 'drop';
$titl = 'Path:';
if(exists( $self->{'_bobj'}->{'_path'})){
@text = @{$self->{'_bobj'}->{'_path'}->{'_text'}};
if($self->{'_flagclru'}){
@fclr = @{$self->{'_bobj'}->{'_path'}->{'_fclr'}};
@bclr = @{$self->{'_bobj'}->{'_path'}->{'_bclr'}};
}
}else{
@text = ( $self->{'_path'}, '/home/', '/tmp/' );
}
}elsif($elem eq '_cdup'){
$hite = 3;$widt = 4;
$xoff = $self->{'_widt'} - 3;
$xoff -= 4 if($self->{'_eflz'}->{'_help'});
$mesg = '..';
}elsif($elem eq '_help'){
$hite = 3;$widt = 4;
$xoff = $self->{'_widt'} - 3;
$mesg = '??';
}elsif($elem eq '_view'){
my $dtdt = 0;
if($self->{'_eflz'}->{'_cnfg'} ||
$self->{'_eflz'}->{'_mkdr'} ||
$self->{'_eflz'}->{'_path'} ||
$self->{'_eflz'}->{'_cdup'} ||
$self->{'_eflz'}->{'_help'}){ $yoff += 3;$hite -= 3; }
if($self->{'_eflz'}->{'_file'} ||
);
}
}else{
if ($type eq 'butn'){ # create respective elements
if($self->{'_flagclru'}){
$self->{'_bobj'}->{$elem} = $self->Mesg(
'hite' => $hite, 'widt' => $widt,
'yoff' => $yoff, 'xoff' => $xoff,
'type' => $type, 'titl' => $titl,
'btyp' => $btyp, 'brfc' => $brfc, 'brbc' => $brbc,
'text' => [ @text ], 'fclr' => [ @fclr ], 'bclr' => [ @bclr ],
'elmo' => 'brws', 'flagscrl' => $scrl,
);
}else{
$self->{'_bobj'}->{$elem} = $self->Mesg(
'hite' => $hite, 'widt' => $widt,
'yoff' => $yoff, 'xoff' => $xoff,
'type' => $type, 'titl' => $titl, 'btyp' => $btyp,
'text' => [ @text ], 'elmo' => 'brws', 'flagscrl' => $scrl,
);
}
}elsif($type eq 'drop'){
if($self->{'_flagclru'}){
$self->{'_bobj'}->{$elem} = $self->Prmt(
'hite' => $hite, 'widt' => $widt,
'yoff' => $yoff, 'xoff' => $xoff,
'type' => $type, 'titl' => $titl,
'btyp' => $btyp, 'brfc' => $brfc, 'brbc' => $brbc,
'text' => [ @text ], 'fclr' => [ @fclr ], 'bclr' => [ @bclr ],
'elmo' => 'brws', 'flagscrl' => $scrl,
);
}else{
$self->{'_bobj'}->{$elem} = $self->Prmt(
'hite' => $hite, 'widt' => $widt,
'yoff' => $yoff, 'xoff' => $xoff,
'type' => $type, 'titl' => $titl, 'btyp' => $btyp,
'text' => [ @text ], 'elmo' => 'brws', 'flagscrl' => $scrl,
);
}
}
}
}else{
$self->{'_eflz'}->{$elem} = undef;
}
}
# reset object changed flags
$self->{'_bobj'}->{$_}->{'_echg'} = 0 for(@{$self->{'_elem'}});
}
# Brws() is a special Curses::Simp object constructor which creates a
# file or directory Browse Window.
# If params are supplied, they must be hash key => value pairs.
sub Brws{
my $main = shift; my($keey, $valu); my $char; my $tchr; my $choi = '';
my $self = bless({}, ref($main)); my $indx; my $done = 0;
for my $attr($main->AttrNamz()){
$self->{$attr} = $main->DfltValu($attr); # init defaults
}
# special Brws window defaults
$self->{'_flagsdlk'} = 1; # get SDLKeys
$self->{'_flagmaxi'} = 0; # not maximized
$self->{'_flagcvis'} = 0; # don't show cursor
$self->{'_flagview'} = 0; # show 0=short (1=detailed) view
$self->{'_flaghide'} = 0; # don't hide .files by default
$self->{'_flagquik'} = 0; # don't show quick access panel
$self->{'_flagsepd'} = 0; # don't show separate directory pane
$self->{'_flagflhi'} = 1; # HIghlight FiLes in browser view
$self->{'_flagbgho'} = 1; # BackGround Highlight Only in view
$self->{'_flagclru'} = $main->{'_flagclru'}; # inherit ColorUsed flag
$self->{'_widt'} = getmaxx() - 4; # but almost full screen wide
$self->{'_hite'} = getmaxy() - 4; # && high
$self->{'_text'} = [ ' ' ];
$self->{'_dtfc'} = 'G';
$self->{'_dtbc'} = 'u';
if($self->{'_flagclru'}){
$self->{'_fclr'} = [ $self->{'_dtfc'} ];
$self->{'_bclr'} = [ $self->{'_dtbc'} ];
}
$self->{'_elem'} = [ '_cnfg', '_mkdr', '_path', '_cdup', '_help', # elements
'_view', '_file', '_open', '_filt', '_cncl' ];
$self->{'_eflz'} = { }; $self->{'_eflz'}->{$_} = 1 for(@{$self->{'_elem'}}); # initialize element visibility flags
# BareBones settings below
#$self->{'_eflz'}->{$_} = 0 for('_cnfg','_mkdr','_cdup','_help','_filt');
$self->{'_bobj'} = { }; # Browse Objects (elements)
$self->{'_brwt'} = 'File'; # Browse type ('File' or 'Dir')
$self->{'_acpt'} = 'Open'; # acceptance button text like 'Open' or 'SaveAs'
$self->{'_path'} = `pwd`; # default path is the current working dir
chomp($self->{'_path'});
$self->{'_path'} =~ s/\/*$/\//;
$self->{'_btyp'} = 1; # border type
$self->{'_titl'} = ''; # gets set from Browse type below
$self->{'_ttfc'} = 'G';
$self->{'_ttbc'} = 'u';
$self->{'_hifc'} = 'W'; # HIghlight Foreground Color
$self->{'_hibc'} = 'g'; # HIghlight Background Color
$self->{'_hndx'} = 0; # Highlight iNDeX
$self->{'_endx'} = 6; # Element iNDeX
$self->{'_vndx'} = 0; # View iNDeX (choice line)
$self->{'_vscr'} = 0; # View SCRolling (to get choice line in view)
$self->{'_choi'} = ''; # choice (the chosen file or dir name)
$self->{'_filt'} = '*'; # glob filter
for(@KMODNAMZ){ $self->{'_kmod'}->{$_} = 0; }
# there were init params with no colon (classname)
while(@_){
($keey, $valu)=(shift, shift);
if(defined($valu)){
if ($keey =~ /^_*(....)?....$/){
$keey =~ s/^_*//;
$self->{"_$keey"} = $valu;
}else{
for my $attr($self->AttrNamz()){
$self->{$attr} = $valu if($attr =~ /$keey/i);
}
}
}else{
$self->{'_brwt'} = $keey;
}
}
$self->{'_titl'} = "Open $self->{'_brwt'}:" unless($self->{'_titl'});
if($self->{'_widt'} < length($self->{'_titl'}) + 4) {
$self->{ '_widt'} = length($self->{'_titl'}) + 4;
}
if($self->{'_vndx'} < (@{$self->{'_bobj'}->{'_view'}->{'_text'}} - 1)){
$self->{'_vndx'}++;
$self->{'_choi'} = $self->{'_bobj'}->{'_view'}->{'_text'}->[ $self->{'_vndx'} ];
$self->{'_bobj'}->{'_view'}->{'_echg'} = 1;
$self->BildBrws(1);
}
}elsif($char eq 'SDLK_PAGEUP'){
$self->{'_vndx'} -= ($self->{'_bobj'}->{'_view'}->{'_hite'} - 3);
$self->{'_vndx'} = 0 if($self->{'_vndx'} < 0);
$self->{'_choi'} = $self->{'_bobj'}->{'_view'}->{'_text'}->[ $self->{'_vndx'} ];
$self->{'_bobj'}->{'_view'}->{'_echg'} = 1;
$self->BildBrws(1);
}elsif($char eq 'SDLK_PAGEDOWN'){
$self->{'_vndx'} += ($self->{'_bobj'}->{'_view'}->{'_hite'} - 3);
$self->{'_vndx'} = (@{$self->{'_bobj'}->{'_view'}->{'_text'}} - 1)
if($self->{'_vndx'} >= @{$self->{'_bobj'}->{'_view'}->{'_text'}});
$self->{'_choi'} = $self->{'_bobj'}->{'_view'}->{'_text'}->[ $self->{'_vndx'} ];
$self->{'_bobj'}->{'_view'}->{'_echg'} = 1;
$self->BildBrws(1);
}elsif($char eq 'SDLK_LEFT'){
$self->BrwsCdUp();
$self->BildBrws(1);
}elsif($char eq 'SDLK_RIGHT'){
$choi = $self->{'_path'} . $self->{'_choi'};
if(-d $choi){
$choi =~ s/^(.*\/)([^\/]+\/)\.\.\/$/$1/; # handle cd..
$self->{'_path'} = $choi;
$self->{'_bobj'}->{'_path'}->{'_text'}->[
($self->{'_bobj'}->{'_path'}->{'_lndx'} + 1) ] = $self->{'_path'};
$self->{'_bobj'}->{'_path'}->{'_dtxt'} = $self->{'_path'};
$self->{'_bobj'}->{'_path'}->{'_data'} = $self->{'_path'};
$self->{'_bobj'}->{'_path'}->{'_text'}->[0] = $self->{'_path'};
$self->{'_bobj'}->{'_path'}->{'_curs'} = length($self->{'_path'});
$self->{'_bobj'}->{'_path'}->{'_xcrs'} = length($self->{'_path'});
$self->{'_bobj'}->{'_path'}->{'_echg'} = 1;
$self->BildBrws(1);
}
}
}
if($done){ # clean up && save local choice so all objects can be destroyed
if ($elem eq '_cncl'){ $choi = '-1'; }
else { $choi = $self->{'_path'} . $self->{'_choi'};}
if($self->{'_brwt'} eq 'File' && -d $choi){
$choi =~ s/^(.*\/)([^\/]+\/)\.\.\/$/$1/; # handle cd..
$self->{'_path'} = $choi;
$self->{'_bobj'}->{'_path'}->{'_text'}->[
($self->{'_bobj'}->{'_path'}->{'_lndx'} + 1) ] = $self->{'_path'};
$self->{'_bobj'}->{'_path'}->{'_dtxt'} = $self->{'_path'};
$self->{'_bobj'}->{'_path'}->{'_data'} = $self->{'_path'};
$self->{'_bobj'}->{'_path'}->{'_text'}->[0] = $self->{'_path'};
$self->{'_bobj'}->{'_path'}->{'_curs'} = length($self->{'_path'});
$self->{'_bobj'}->{'_path'}->{'_xcrs'} = length($self->{'_path'});
$self->{'_bobj'}->{'_path'}->{'_echg'} = 1;
$self->BildBrws(1);
$done = 0; # don't accept directory when choosing file
}
}
}
$self->DelW(); # Delete Brws Window && all element windows
$main->ShokScrn(2); # redraw all old stuff
$main->FlagCVis(); # reset cursor visibility to calling object state
return($choi); # return choice (file or dir name)
}
sub DESTROY{
my $self = shift || return(); my $dndx = $self->{'_dndx'};
my $shok = 1;
$shok = 0 if(exists($self->{'_type'}) && length($self->{'_type'}));
if($self->{'_wind'}){
delwin($self->{'_wind'});
for(++$dndx;$dndx<@DISPSTAK;$dndx++){
if($DISPSTAK[$dndx] && exists(${$DISPSTAK[$dndx]}->{'_dndx'})){
${$DISPSTAK[$dndx]}->{'_dndx'}--;
}
}
#remove deleted from displaystack
splice(@DISPSTAK, $self->{'_dndx'}, 1) if($self->{'_dndx'} < @DISPSTAK);
$self->ShokScrn(2) if($shok);
}
}
# VERBOSE METHOD NAME ALIASES
*AttributeNames = \&AttrNamz;
*DefaultValues = \&DfltValu;
*MakeMethods = \&MkMethdz;
*InitializeColorPair = \&InitPair;
*PrintBorderCharacter = \&BordChar;
*ConvertAnsiColorCode = \&CnvAnsCC;
*ShockScreen = \&ShokScrn;
*KeyNumbers = \&KNum;
*ColorLetters = \&CLet;
*NumColors = \&NumC;
*Height = \&Hite;
*Width = \&Widt;
*PrintString = \&Prnt;
*DrawWindow = \&Draw;
*WaitTime = \&Wait;
*GetKey = \&GetK;
*GetString = \&GetS;
*MoveCursor = \&Move;
*ResizeWindow = \&Rsiz;
*UpdateWindow = \&Updt;
*MessageWindow = \&Mesg;
*PromptWindow = \&Prmt;
*FocusWindow = \&Focu;
*ColorPickWindow = \&CPik;
*BrowseWindow = \&Brws;
*DeleteWindow = \&DelW;
*DelW = \&DESTROY;
# allow color arrays to be tied too
package Curses::Simp::FClr;
sub TIEARRAY { # bless an anon array with just parent in case more to store
my $clas = shift;my $prnt = shift;
# carp("!*EROR*! Need additional Parent object reference parameter to tie $clas to!\n") unless(defined($prnt) && ref($prnt) eq 'Curses::Simp');
exit unless(defined($prnt) && ref($prnt) eq 'Curses::Simp');
my $self = bless([$prnt], $clas);
$prnt->{'_flagclru'} = 1;
return($self);
}
sub FETCH { return( $_[0]->[0]->{'_fclr'}->[$_[1]]); }
sub FETCHSIZE{ return(scalar(@{$_[0]->[0]->{'_fclr'}}) ); }
sub STORE {
$_[0]->[0]->{'_fclr'}->[$_[1]] = $_[2];
use Curses::Simp;
my @text; my $keey = '';
my $simp = tie(@text, 'Curses::Simp');
@text =('1337', 'nachoz', 'w/', 'cheese' x 7);
while($keey ne 'x'){ # wait for 'x' to eXit
$keey = $simp->GetKey(-1); # get a blocking keypress
push(@text, $keey);
}
=head1 DESCRIPTION
Curses::Simp provides a curt mechanism for updating a console screen
with any Perl array (or multiple arrays to include color codes).
Most key events can be obtained and tested directly. The goal
was ease-of-use for the common cases first and efficient
rendering second.
=head1 2DU
=over 2
=item - mk proper scrollbars for all objects && use in Brws: view
=item - Brws: mk togl to pack files left && right in view
=item - mk ~/.simprc to save CPik && Brws cfg, OVERMAPP, etc.
=item - CPik: rewrite BildBlox to scale style to window dims if !flagshrk
&& mk sure no forg or bakg works for all styles... also add
options for only name or number options or common grid size defaults
=item - CPik: add styles to pick fgcl,bgcl color code at once
=item - 4NT: work on recognizing more keys the same as Curses (&& then SDL)
=item - 4NT: write custom window support? mk Mesg at least wrap MSGBOX
=item - describe Simp objects sharing apps (ptok above pmix)
mk OScr read Simp apps @_ param list && auto-handle --geom wxh+x+y
=item - Prmt: mk new 'cbls' type: as a ckbx list && use in BrwsCnfg
=item - Prmt: mk new 'rdls' type: as a radio list w/ auto (*) -
=item - Mesg: mk new 'slid' type: params for all overlay text, chars, ticks,
flags, etc. && updt pmix to use... maybe register sub fields,dims...
=item - Prnt: add multi-line option where text can split on /\n/ but each new
line prints relative to starting xcrs
=item - Prmt: add multi-line option where dtxt can split on /\n/ && ^d
accepts entry instead of RETURN
=item - Prnt: handle ASCII chars under 32 with escapes like Draw
=item - Draw: optimize rendering
=item - Prnt&&Draw: handle ASCII chars under 32 better than current escapes
=item - mk 'ceol' && 'ceos' params to clear text[n] from cursor on
=item - consider breaking sub (CPik|Brws|.+?) into own Curses::Simp::$1.pm
instead of letting Simp.pm remain so cluttered
=back
if detectable:
=over 4
=item - handle xterm resize events
=item - handle mouse input (study any existent Curses apps that use mouse
input you can find ... probably in C), read man for gpm(1),
sysmouse(4), && sb(4) && study aumix mouse source
=item - Learn how to read a Shift-Tab key press if in any way
distinguishable from Tab/Ctrl-I
=item - What else does Simp need?
=back
=head1 WHY?
Curses::Simp was created because I could hardly find documentation or
examples of L<Curses> usage so I fiddled until I could wrap the
most important behaviors in names and enhanced functions.
=head1 USAGE
B<new()> - Curses::Simp object constructor
new() opens a new Curses screen if one does not exist already and
initializes useful default screen, color, and keys settings. The
created Curses screen is automatically closed on program exit.
Available object methods are described in detail below. Each of
the following four letter abbreviated or verbose method names
can be used as initialization parameters to new():
Key or VerboseName => Default Value
----- ------------- ---------------
'text' or 'TextData' => [ ]
'fclr' or 'ForegroundColorData' => [ ]
'bclr' or 'BackgroundColorData' => [ ]
'kque' or 'KeyQueue' => [ ]
'mque' or 'KeyModQueue' => [ ]
'hite' or 'WindowHeight' => 0
'widt' or 'WindowWidth' => 0
'yoff' or 'WindowYOffset' => 0
'xoff' or 'WindowXOffset' => 0
'ycrs' or 'CursorYOffset' => 0
'xcrs' or 'CursorXOffset' => 0
'btyp' or 'WindowBorderType' => 0
'brfc' or 'WindowBorderForegroundColor'=> 'w'
'brbc' or 'WindowBorderBackgroundColor'=> 'k'
'titl' or 'WindowTitle' => ''
'ttfc' or 'WindowTitleForegroundColor' => 'W'
'ttbc' or 'WindowTitleBackgroundColor' => 'k'
provide the third parameter of the object which they also want to tie
to. If this is not provided, the program will exit.
The result of all this is an extremely simple way to immediately
manipulate any of the text or colors displayed on the console screen.
=head2 CnvAnsCC or ConvertAnsiColorCode( $AnsiColorCode )
Returns the Simp form of the ANSI color code
$AnsiColorCode.
$AnsiColorCode may contain any of the typical ANSI attribute or
color codes:
Attribute codes:
00=none 01=bold 04=underscore 05=blink 07=reverse 08=concealed
Foreground color codes:
30=black 31=red 32=green 33=yellow 34=blue 35=magenta 36=cyan 37=white
Background color codes:
40=black 41=red 42=green 43=yellow 44=blue 45=magenta 46=cyan 47=white
ConvertAnsiColorCode() is primarily useful as an internal function
to the Curses::Simp package but I have exposed it because it could
be useful elsewhere.
=head2 ShokScrn or ShockScreen( [$FlagClear] )
ShockScreen() forces the screen and all created Simp objects
to be refreshed in order.
The $FlagClear (default is false) can be provided to specify that
the entire screen is to be cleared before everything refreshes.
Clearing the entire screen usually isn't necessary and it slows drawing
down.
=head2 KNum or KeyNumbers()
Returns a hash with key numbers => "names".
=head2 CLet or ColorLetters()
Returns a hash with color "letters" => numbers.
=head2 NumC or NumColors()
Returns the number of available colors
(last index: NumC() - 1)
=head2 Hite or Height
Returns the current Simp object's window height
(last index: Height() - 1)
=head2 Widt or Width
Returns the current Simp object's window width
(last index: Width() - 1)
=head2 Prnt or PrintString( $String )
Prints $String at current cursor position. PrintString() can also accept
a hash of parameters (e.g., PrintString('text' => $String)) where:
'text' => [ "String to Print" ], # or can just be string without arrayref
'fclr' => [ "ForegroundColorCodes corresponding to text" ],
'bclr' => [ "BackgroundColorCodes corresponding to text" ],
'ycrs' => 3, # Number to move the cursor's y to before printing
'xcrs' => 7, # Number to move the cursor's x to before printing
'yoff' => 15, # same as ycrs except original ycrs is restored afterwards
'xoff' => 31, # same as xcrs except original xcrs is restored afterwards
'prin' => 1, # flag to specify whether printed text should update the
# main Text(), FClr(), and BClr() data or just print to the
# screen temporarily. Default is true (i.e., Print Into all)
The hash keys can also be the corresponding VerboseNames described in the
new() section instead of these 4-letter abbreviated key names.
PrintString() returns the number of characters printed.
=head2 Draw or DrawWindow()
Draws the current Simp object with the established TextData() and
ColorData() functions.
DrawWindow() accepts a hash of parameters like new() which will update
as many attributes of the Simp object as are specified by key => value
pairs.
DrawWindow() returns the number of lines printed (which is normally the
same as Height()).
=head2 Wait or WaitTime( $Time )
WaitTime() does nothing for $Time seconds.
$Time can be an integer or floating point number of seconds.
(e.g., WaitTime(1.27) does nothing for just over one second).
WaitTime() (like GetKey()) can also use alternate waiting methods.
The default $Time format is integer or floating seconds. It can
also be a Time::Frame object or an integer of milliseconds.
These modes can be set with the FlagTimeFrame(1) and
FlagMillisecond(1) methods respectively.
=head2 GetK or GetKey( [$Timeout [,$FlagSDLKey]] )
Returns a keypress if one is made or -1 after waiting $Timeout seconds.
$Timeout can be an integer or floating point number of seconds.
(e.g., GetKey(2.55) waits for two and one-half seconds before returning -1
if no key was pressed).
Default behavior is to not block (i.e., GetKey(0)). Use GetKey(-1) for a
blocking keypress (i.e., to wait indefinitely).
GetKey() can use alternate waiting methods. The default is integer or
floating seconds. It can also utilize L<Time::Frame> objects
or integer milliseconds if preferred. These modes can be set with
the FlagTimeFrame(1) and FlagMillisecond(1) methods respectively.
Under normal mode (i.e., when $FlagSDLKey is absent or false), GetKey()
returns a string describing the key pressed. This will either be a
single character or the Curses name for the key if a special key was
pressed. The list of special key names that can be returned from
normal mode are described in the L<"CURSES KEY NOTES"> section. This
means that the return value should be easy to test directly like:
use Curses::Simp;
my $simp = Curses::Simp->new();
my $key = $simp->GetKey(-1); # get a blocking keypress
if ( $key eq 'a' ) { # do 'a' stuff
} elsif( $key eq 'b' ) { # do 'b' stuff
} elsif( $key eq 'A' ) { # do 'A' stuff
} elsif( $key eq 'B' ) { # do 'B' stuff
} elsif( $key eq 'KEY_LEFT' ) { # do Left-Arrow-Key stuff
} elsif( $key eq 'KEY_NPAGE') { # do PageDown stuff
} elsif( $key eq 'KEY_F1' ) { # do F1 (Help) stuff
} elsif(ord($key) == 9 ) { # do Tab stuff
} elsif(ord($key) == 13 ) { # do Return stuff
} elsif(ord($key) == 27 ) { # do Escape stuff
}
$FlagSDLKey is a flag (default is false) which tells GetKey() to return
a verbose key string name from the list of SDLKeys in the L<"SDLKEY NOTES">
section instead of the normal Curses key value or name. In SDLKey mode,
GetKey() also sets flags for Shift, Control, and Alt keys which are
testable through KeyMode().
The $FlagSDLKey parameter sets SDLKey mode temporarily (i.e., only for a
single execution of GetKey()). This mode can be turned on permanently
via the FlagSDLKey(1) function.
If the $Timeout for GetKey() is reached and no keypress has
occurred (in either normal mode or SDLKey mode), -1 is returned.
=head2 KMod or KeyMode( [$KeyName [,$NewValue]] )
Returns the key mode (state) of the key mode name $KeyName. $KeyName
should be one of the KMOD_ names from the bottom of the L<"SDLKEY NOTES">
section.
If no parameters are provided, the state of KMOD_NONE is returned.
If $NewValue is provided, the state of $KeyName is set to $NewValue.
=head2 GetS or GetString( [$YCursor, $XCursor[, $ResultLength]] )
GetString() returns the string found from the cursor (or the specified
coordinates) on to the end-of-line or to $ResultLength if provided.
=head2 Move or MoveCursor( [$YCursor, $XCursor] )
MoveCursor() updates the current Simp object's cursor position
to the newly specified $YCursor, $XCursor.
By default, the cursor is not visible but this can be changed through
the FlagCursorVisible(1) function.
Returns ($YCursor, $XCursor) as the coordinates of the cursor.
=head2 Rsiz or ResizeWindow( $Height, $Width )
ResizeWindow() updates the current Simp object's window dimensions
to the newly specified $Height, $Width.
Think of ResizeWindow() as an easy way to call both Height() and
Width() at once.
Returns ($Height, $Width) as the dimensions of the window.
=head2 Mesg or MessageWindow( $Message )
MessageWindow() draws a Message Window in the center of the screen to
display $Message. MessageWindow() can also accept a hash of parameters
(e.g., MessageWindow('mesg' => $Message)) where:
'mesg' => "Message to Print",
'text' => [ "same as new \@text" ],
'fclr' => [ "ForegroundColorCodes corresponding to mesg or text" ],
'bclr' => [ "BackgroundColorCodes corresponding to mesg or text" ],
'titl' => "MessageWindow Title string",
'ttfc' => "ColorCodes corresponding to titl foreground color",
'ttbc' => "ColorCodes corresponding to titl background color",
'flagprsk' => 1, # a flag specifying whether to "Press A Key"
'pres' => "Press A Key...", # string to append if flagprsk is true
'prfc' => "ColorCodes corresponding to pres foreground color",
'prbc' => "ColorCodes corresponding to pres background color",
'wait' => 1.0, # floating number of seconds to wait
# if flagprsk is true, MessageWindow() waits this
# long for a keypress before quitting
# if flagprsk is false, MessageWindow() waits this
# long regardless of whether keys are pressed
The hash keys can also be the corresponding VerboseNames described in the
new() section instead of these 4-letter abbreviated key names.
Returns the value of the pressed key (if the "Press A Key" flag was true).
This can be used to make simple one-character prompt windows. For example:
use Curses::Simp;
my $simp = Curses::Simp->new();
my $answer = $simp->MessageWindow('titl' => 'Is Simp useful?',
'pres' => '(Yes/No)');
$simp->MessageWindow('titl' => 'Answer:', $answer);
=head2 Prmt or PromptWindow( \$DefaultRef )
PromptWindow() draws a Prompt Window in the center of the screen to
display and update the value of $DefaultRef. \$DefaultRef should be
a reference to a variable containing a string you want edited or
replaced. PromptWindow() can also accept a hash of parameters
(e.g., PromptWindow('dref' => \$DefaultRef)) where:
'dref' => \$dref, # Default Reference to variable to be read && edited
'dtxt' => "Default Text string in place of dref",
'dtfc' => "ColorCodes corresponding to dref/dtxt foreground color",
'dtbc' => "ColorCodes corresponding to dref/dtxt background color",
'hifc' => "ColorCodes for highlighted (unedited) dref/dtxt foreground color",
'hibc' => "ColorCodes for highlighted (unedited) dref/dtxt background color",
'text' => [ "same as new \@text" ],
'fclr' => [ "ForegroundColorCodes corresponding to text" ],
'bclr' => [ "BackgroundColorCodes corresponding to text" ],
'hite' => 3, # height of the prompt window (including borders)
'widt' => 63, # width of the prompt window (including borders)
'titl' => "PromptWindow Title string",
'ttfc' => "ColorCodes corresponding to titl foreground color",
'ttbc' => "ColorCodes corresponding to titl background color",
'flagcvis' => 1, # a flag specifying whether the cursor should be displayed
The hash keys can also be the corresponding VerboseNames described in the
new() section instead of these 4-letter abbreviated key names.
=head2 CPik or ColorPickWindow()
ColorPickWindow() is a simple Color Picker window.
It accepts arrow keys to highlight a particular color and enter to select.
The letter corresponding to the color or the number of the index can also
be pressed instead.
Returns the letter (i.e., Color Code) of the picked color.
=head2 Brws or BrowseWindow()
BrowseWindow() is a simple file browser.
It contains typical file browse dialog components which can be tabbed
between. The tilde (~) character opens and closes drop down boxes.
Enter presses highlighted buttons or selects a highlighted file.
F1 brings up the BrowseWindow() help text.
Returns the full filename chosen or -1 if dialog was canceled.
=head2 DESTROY or DelW or DeleteWindow()
DeleteWindow() deletes all the components of the created Simp object
and calls ShockScreen() to cause the screen and all other created
objects to be redrawn.
=head1 ACCESSOR AND FLAG METHODS
Simp accessor and flag object methods have related interfaces as they
each access and update a single component field of Curses::Simp objects. Each
one always returns the value of the field they access. Thus if you want
to obtain a certain value from a Simp object, just call the accessor
method with no parameters. If you provide parameters, the field will
be updated and will return its new value.
All of these methods accept a default parameter of their own type or
a hash of operations to perform on their field.
Some operations are only applicable to a subset of the methods as
dictated by the field type. The available operations are:
Key => Value Type
NormalName (if different) ... # Purpose
----- ------------
'asin' => $scalar (number|string|arrayref)
'assign' # asin is context-sensitive assignment to load the field
'blnk' => $ignored # blanks a string value
'blank'
'togl' => $ignored # toggles a flag value
'toggle'
'true' => $ignored # trues a flag value
'fals' => $ignored # falsifies a flag value
'false'
'incr' => $numeric_amount
'increase' # increments if no $num is provided or increases by $num
'decr' => $numeric_amount
'decrease' # decrements if no $num is provided or decreases by $num
'nmrc' => $string
'numeric'
# instead of an explicit 'nmrc' hash key, this means the
# key is an entirely numeric string like '1023'
# so the value gets assigned to that indexed element when
# the field is an array. The key is assigned directly if
# the field is numeric or a string.
# Array-Specific operations:
'size' => $ignored # return the array size
'push' => $scalar (number|string) # push new value
'popp' => $ignored # pop last value
'pop'
'apnd' => $scalar (number|string) # append to last element
'append'
'dupl' => $number # duplicate last line or
'duplicate' # $num line if provided
'data' => $arrayref # assigns the array if
# $arrayref provided &&
# returns ALL array data
# Loop-Specific operations:
'next' => $ignored # assign to next in loop
'prev' => $ignored # assign to previous in loop
'previous'
=head2 Array Accessors
Text or TextData # update the text array
FClr or ForegroundColorData # update the color array for foregrounds
BClr or BackgroundColorData # update the color array for backgrounds
Instead of using the above Array Accessors and Array-Specific
operations, it is recommended that you employ the L<"Tied Array Interfaces">
since they accomplish the goal of screen manipulation in a more
Perl-friendly manner.
=head3 Text or TextData
=head3 FClr or ForegroundColorData
=head3 BClr or BackgroundColorData
=head2 Loop Accessors
BTyp or WindowBorderType # loop through border types
=head3 BTyp or WindowBorderType
=head2 Normal Accessors
Name or VerboseName # Description
---- ----------- -------------
Hite or WindowHeight # window height
Widt or WindowWidth # window width
YOff or WindowYOffset # window y-offset position
XOff or WindowXOffset # window x-offset position
YCrs or CursorYOffset # window y-cursor position
XCrs or CursorXOffset # window x-cursor position
BrFC or WindowBorderForegroundColor # border fg color code string
BrBC or WindowBorderBackgroundColor # border bg color code string
Titl or WindowTitle # title string
TtFC or WindowTitleForegroundColor # title fg color code string
TtBC or WindowTitleBackgroundColor # title bg color code string
DNdx or DisplayStackIndex # global display index
=head3 Hite or WindowHeight
=head3 Widt or WindowWidth
=head3 YOff or WindowYOffset
=head3 XOff or WindowXOffset
=head3 YCrs or CursorYOffset
=head3 XCrs or CursorXOffset
=head3 BrFC or WindowBorderForegroundColor
=head3 BrBC or WindowBorderBackgroundColor
=head3 Titl or WindowTitle
=head3 TtFC or WindowTitleForegroundColor
=head3 TtBC or WindowTitleBackgroundColor
=head3 DNdx or DisplayStackIndex
=head2 Flag Accessors
FlagName or VerboseFlagName Default # Description
-------- --------------- ------- -------------
FlagAuDr or FlagAutoDraw 1 # Automatic DrawWindow() call whenever
# TextData or Color*Data is updated
FlagADTF or FlagAutoDrawTiedForegroundData 1 # Automatic DrawWindow() call
# for arrays tied to Curses::Simp::FClr objects when FlagAuDr is already set
FlagADTB or FlagAutoDrawTiedBackgroundData 1 # Automatic DrawWindow() call
# for arrays tied to Curses::Simp::BClr objects when FlagAuDr is already set
FlagMaxi or FlagMaximize 1 # Maximize window
FlagShrk or FlagShrinkToFit 1 # Shrink window to fit TextData
FlagCntr or FlagCenter 1 # Center window within entire screen
FlagCVis or FlagCursorVisible 0 # Cursor Visible
FlagScrl or FlagScrollbar 0 # use Scrollbars
FlagSDLK or FlagSDLKey 0 # use advanced SDLKey mode in GetKey()
FlagFram or FlagTimeFrame 0 # use Time::Frame objects instead of
# float seconds for timing
FlagMili or FlagMillisecond 0 # use integer milliseconds instead of
# float seconds for timing
FlagPrin or FlagPrintInto 1 # PrintString() prints Into TextData
# array. If FlagPrintInto is false, then each call to PrintString()
# only writes to the screen temporarily and will be wiped the next time
# the window behind it is updated.
FlagClrU or FlagColorUsed 0 # ColorUsed gets set automatically
# when color codes are used and determines if internal dialogs have color
=head3 AuDr or FlagAuDr or FlagAutoDraw
( run in 1.354 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )