App-Cheats
view release on metacpan or search on metacpan
# 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}"'
aÌ
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 )