App-Cheats

 view release on metacpan or  search on metacpan

cheats.txt  view on Meta::CPAN


# MenuButton Example (Ptk,Appendix B)

# Message Example (Ptk,Appendix B)

# NoteBook Example (Ptk,Appendix B)

# Optionmenu Example (Ptk,Appendix B)

# Pane Example (Ptk,Appendix B)

# Photo Example (Ptk,Appendix B)

# ProgressBar Example (Ptk,Appendix B)

# Radiobutton Example (Ptk,Appendix B)

# ROText Example (Ptk,Appendix B)

# Scale Example (Ptk,Appendix B)

# Table Example (Ptk,Appendix B)

# Text Example (Ptk,Appendix B)

# TextUndo Example (Ptk,Appendix B)

# Tiler Example (Ptk,Appendix B)

# TList Example (Ptk,Appendix B)

# TopLevel Example (Ptk,Appendix B)

# Tree Example (Ptk,Appendix B)


#############################################################
## Perl Modules - Tk::TextString, Tk::TextStrings
#############################################################

# Tie Text widget to store input as an entry or label would in "-variable" (PTk)
perl -MTk -le '{package P; sub TIESCALAR{my($c,$o)=@_; bless \$o,$c} sub FETCH{my($s)=@_; $$s->get("1.0", "end")} sub STORE{my($s,$v)=@_; $$s->delete("1.0", "end"); $$s->insert("end", $v)} } $mw=MainWindow->new; $t=$mw->Text->pack; tie $v, "P", $t; $...

# Tie Text widget to -variable. Set value with button or entry (PTk)
perl -MTk -le '{package P; sub TIESCALAR{my($c,$o)=@_; bless \$o,$c} sub FETCH{my($s)=@_; $$s->get("1.0", "end")} sub STORE{my($s,$v)=@_; $$s->delete("1.0", "end"); $$s->insert("end", $v)} } $mw=MainWindow->new; $t=$mw->Text->pack; tie $v, "P", $t; $...

# Example of new TextString Mega-Widget (PTk,tie,user module)
perl -MTk -MTk::TextString -w -le '$mw=MainWindow->new; $mw->TextString(-variable => \$v)->pack; $mw->Entry(-textvariable => \$v)->pack(-side => "left"); $mw->Button(-command => sub{print "[$v]"})->pack(-side => "left"); MainLoop'

# Scolled multiple text boxes through multiple -variables (PTk,tie,user module)
perl -MTk -MTk::TextString -w -le '%d=qw(-side left); $mw=MainWindow->new; @f=map{$mw->Frame->pack} 1..3; @t=map{my $v; $f[0]->TextString(-height => 2, -variable => \$v)->pack(%d); \$v} @f; $f[1]->Entry(-textvariable => $_)->pack(%d) for @t; $f[2]->B...

# Scolled multiple text boxes through single -variable (PTk,tie,user module)
perl -MTk -MTk::TextStrings -w -le '%d=qw(-side left); $mw=MainWindow->new; @f=map{$mw->Frame->pack} 1..3; @t=map{$f[0]->TextStrings(-height => 2, -variable => \$v)->pack(%d); \$v} @f; $f[1]->Entry(-textvariable => $_)->pack(%d) for @t; $f[2]->Button...

# Can text widget and entry widget are synced (PTk, tie,user module)
perl -MTk -MTk::TextStrings -le '$mw=MainWindow->new; $mw->TextStrings(-height => 2, -variable => \$v)->pack; $mw->Entry(-textvariable => \$v)->pack; MainLoop'


#############################################################
## Perl Modules - Try::Tiny
#############################################################

# Simple approach to catching errors
# Try Catch return are subroutine based. Below return unexpectedly (at first) "BBB"
# WARNING: It has issues. Unpredictable syntax
perl -MTry::Tiny -lE 'sub try_me{ try{1/0}catch{say "Caught [$@]"; return "AAA"}; return "BBB" } $v=try_me; say $v'

# A better try/catch approach (only on lnxbr42)
# WARNING: It has issues. Highly dependent upon Perl changes
perl -MTryCatch -lE 'sub try_me{ try{1/0}catch{say "Caught [$@]"; return "AAA"}; return "BBB" } $v=try_me; say $v'


#############################################################
## Perl Modules - Unicode::Normalize
#############################################################

# Compose or decompose unicode strings.
perl -Mcharnames=:full -CO -MUnicode::Normalize -E 'say charnames::viacode ord for split //, NFD "\N{LATIN CAPITAL LETTER A WITH ACUTE}"'
# LATIN CAPITAL LETTER A
# COMBINING ACUTE ACCENT

# Get grapheme clusters.
perl -MEncode -MUnicode::Normalize -E 'use open qw(:std :utf8); say for map{ /(\X)/g } NFD "\x{61}\x{301}"'
á
perl -MEncode -MUnicode::Normalize -E 'use open qw(:std :utf8); say for map{ /(.)/g } NFD "\x{61}\x{301}"'
a

# Get individual decomposed characters.
perl -MEncode -MUnicode::Normalize -E 'use open qw(:std :utf8); say ord for map{ /(.)/g } NFD "\x{61}\x{301}"x2'
97
769
97
769
# LATIN SMALL LETTER A   U+61  0x61   97
# COMBINING ACUTE ACCENT U+301 0x301 769

# Use unpack to get unicode codepoints.
perl -MEncode -MUnicode::Normalize -E 'use open qw(:std :utf8); say for unpack "W*",NFD "\x{61}\x{301}"x2'
97
769
97
769
perl -MEncode -MUnicode::Normalize -E 'use open qw(:std :utf8); say for unpack "W*",NFC "\x{61}\x{301}"x2'
225
225


#############################################################
## Perl Modules - utf8
#############################################################

# decode then encode.
perl -MDevel::Peek -E 'my $v = "äöë"; sub c { say "#################"; say "is_utf8: " . utf8::is_utf8($v); say "valid:   " . utf8::valid($v); Dump $v } c; utf8::decode($v); c; utf8::encode($v); c'
#################
is_utf8:
valid:   1
SV = PV(0xb400007634f7a0b0) at 0xb400007634f89f98
  REFCNT = 2
  FLAGS = (POK,IsCOW,pPOK)
  PV = 0xb4000074f4f80650 "\xC3\xA4\xC3\xB6\xC3\xAB"\0
  CUR = 6
  LEN = 10
  COW_REFCNT = 1
#################
is_utf8: 1
valid:   1



( run in 1.452 second using v1.01-cache-2.11-cpan-5511b514fd6 )