scratchpad
ambrus
<c>
#include <cstdlib>
#include <iostream>
#include <algorithm>
#include "opencv2/core/core.hpp"
using std::cerr; using std::abort;
using std::min; using std::max;
/*! Find a point set in a mask that is nearest (in l^\infty metric) to a given point. */
/*!
\arg `image` is a boolean mask, must be of type `CV_8C` and 2 dimensional,
nonzero value means true.
\arg `center` is the point.
\arg `output` becomes the nearest point found.
\returns true iff a point is found, false if `image` is all false.
*/
bool
FindNearestPoint(cv::Mat image, cv::Point center, cv::Point &output) {
if (CV_8U != image.type() || 2 != image.dims) {
cerr << "error: wrong type of matrix passed to FindNearestPoints (type=" << image.type() << ", dims=" << image.dims << ").\n";
abort();
}
int sy = image.rows, sx = image.cols;
int cy = center.y, cx = center.x;
int ldx = cx < 0 ? -cx : sx <= cx ? cx - sx : 0;
int ldy = cy < 0 ? -cy : sy <= cy ? cy - sy : 0;
int ld = max(ldx, ldy);
int hdx = cx < 0 ? sx - cx : sx <= cx ? cx : max(cx, sx - cx);
int hdy = cy < 0 ? sy - cy : sy <= cy ? cy : max(cy, sy - cy);
int hd = max(hdx, hdy);
for (int d = ld; d <= hd; d++) {
int ay = cy - d;
int ly = max(0, ay);
int by = cy + d;
int hy = min(sy - 1, by);
int ax = cx - d;
int lx = max(0, ax);
int bx = cx + d;
int hx = min(sx - 1, bx);
if (0 <= ax && ax < sx)
for (int y = ly; y <= hy; y++)
if (0 != image.at<unsigned char>(y, ax))
{ output = cv::Point(ax, y); return true; }
if (0 <= bx && bx < sx)
for (int y = ly; y <= hy; y++)
if (0 != image.at<unsigned char>(y, bx))
{ output = cv::Point(bx, y); return true; }
if (0 <= ay && ay < sy)
for (int x = lx; x <= hx; x++)
if (0 != image.at<unsigned char>(ay, x))
{ output = cv::Point(x, ay); return true; }
if (0 <= by && by < sy)
for (int x = lx; x <= hx; x++)
if (0 != image.at<unsigned char>(by, x))
{ output = cv::Point(x, by); return true; }
}
output = cv::Point(0, 0);
return false;
}
</c>
<hr>
<p>
For obfu. The following magic variables intify automatically: <c>$- $= $% $? $! $^E $^F $^T $^D $^H $^P</c>. The following stringify: <c>$0 $^I $^O $\ $^A $:</c>. This boolify: <c>$| $^W $^C</c>.
<hr>
<p>
To Monk_perl:
<code>
203527 <+termbot> +bcc vowel.c
203529 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland
International
203529 <+termbot> -vowel.c:
203529 <+termbot> -Error vowel.c 9: Type mismatch in parameter '__s' in call to
'fgets' in function main
203529 <+termbot> -Error vowel.c 9: Too few parameters in call to 'fgets' in
function main
203529 <+termbot> -Error vowel.c 9: Nonportable pointer conversion in function
main
203529 <+termbot> -Warning vowel.c 18: Unreachable code in function main
203529 <+termbot> -Error vowel.c 20: Compound statement missing } in function
main
203531 <+termbot> -Warning vowel.c 20: Function should return a value in
function main
203534 <+termbot> -*** 4 errors in Compile ***
203534 <+termbot> -*** 4 errors in Compile ***
203534 <+termbot> -
203535 <+termbot> - Available memory 4081880
203536 <+termbot> -
203537 <+termbot> -C:\MONKPERL>
203542 <@b_jonas> `type vowel.c
203542 <+termbot> +type vowel.c
203542 <+termbot> - #include<stdio.h>
203542 <+termbot> -#include<conio.h>
203542 <+termbot> - main()
203542 <+termbot> - {
203543 <+termbot> - char c;
203545 <+termbot> - int i,n=0; /* n stands for no. of vowel*/
203547 <+termbot> - clrscr();
203548 <+termbot> - c=fgets(a[i]);
203549 <+termbot> - for(i=0;i<=a[i];i++)
203550 <+termbot> - {
203551 <+termbot> - switch(c)
203552 <+termbot> - {
203554 <+termbot> - case 'a': case 'e': case 'i': case 'o': case 'u':
203555 <+termbot> - n++;
203556 <+termbot> - break;
203557 <+termbot> -
203558 <+termbot> - getch();
203559 <+termbot> - }
203600 <+termbot> - }
203600 <+termbot> -
203601 <+termbot> -C:\MONKPERL>
</c>
<p>
Let's fix the call to fgets.
<c>
203945 <@b_jonas> `edlin vowel.c
203945 <+termbot> +edlin vowel.c
203946 <+termbot> -End of input file
203946 <+termbot> -*
204002 <@b_jonas> 9
204005 <@b_jonas> `9
204005 <+termbot> +9
204006 <+termbot> - 9:* c=fgets(a[i]);
204006 <+termbot> - 9:*
204017 <@b_jonas> ` fgets(a, 9, stdin);
204017 <+termbot> + fgets(a, 9, stdin);
204017 <+termbot> -*
204023 <@b_jonas> `8,10p
204023 <+termbot> +8,10p
204023 <+termbot> - 8: clrscr();
204023 <+termbot> - 9: fgets(a, 9, stdin);
204023 <+termbot> - 10:* for(i=0;i<=a[i];i++)
204023 <+termbot> -*
204030 <@b_jonas> `e
204031 <+termbot> +e
204031 <+termbot> -
204031 <+termbot> -C:\MONKPERL>
204039 <@b_jonas> `bcc vowel.c
204039 <+termbot> +bcc vowel.c
204041 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland
International
204041 <+termbot> -vowel.c:
204042 <+termbot> -Warning vowel.c 18: Unreachable code in function main
204042 <+termbot> -Error vowel.c 20: Compound statement missing } in function
main
204042 <+termbot> -Warning vowel.c 20: Function should return a value in
function main
204042 <+termbot> -*** 1 errors in Compile ***
204042 <+termbot> -
204042 <+termbot> - Available memory 4081880
204044 <+termbot> -
204044 <+termbot> -C:\MONKPERL>
204406 <@cbstream> [ambrus] ah, that one error I got seems to be a mistake when
I copied the program. I skipped a line. So what did you get?
What does the program do for you?
204132 <@b_jonas> `edlin vowel.c
204132 <+termbot> +edlin vowel.c
204132 <+termbot> -End of input file
204132 <+termbot> -*
204405 <@b_jonas> `17
204406 <+termbot> +17
204406 <+termbot> - 17:*
204406 <+termbot> - 17:*
204407 <@b_jonas> ` }
204407 <+termbot> + }
204407 <+termbot> -*
204409 <@b_jonas> `e
204410 <+termbot> +e
204410 <+termbot> -
204410 <+termbot> -C:\MONKPERL>
204412 <@b_jonas> `bcc vowel.c
204412 <+termbot> +bcc vowel.c
204415 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland
International
204415 <+termbot> -vowel.c:
204415 <+termbot> -Warning vowel.c 20: Function should return a value in
function main
204415 <+termbot> -Turbo Link Version 5.1 Copyright (c) 1992 Borland
International
204415 <+termbot> -
204415 <+termbot> - Available memory 4075304
204418 <+termbot> -
204418 <+termbot> -C:\MONKPERL>
204640 <@cbstream> [ambrus] Monk_perl: apart from the wrong condition in the
for loop, I think there are at least two smaller problems:
first, you never output anything, secondly, you call getch()
too many times (once for each iteration in the for loop)
204645 <+termbot> -C:\MONKPERL>
204656 <@b_jonas> `edlin vowel.c
204657 <+termbot> +edlin vowel.c
204657 <+termbot> -End of input file
204657 <+termbot> -*
204704 <@b_jonas> `18d
204704 <+termbot> +18d
204704 <+termbot> -*
204724 <+termbot> -*
204815 <@b_jonas> `19i
204815 <+termbot> +19i
204815 <+termbot> - 19:*
204841 <@b_jonas> `printf("%d",n);
204841 <+termbot> +printf("%d",n);
204841 <+termbot> - 20:*
204844 <@b_jonas> ``o
204844 <+termbot> +^Z
204845 <+termbot> -*
204849 <@b_jonas> `17p
204849 <+termbot> +17p
204849 <+termbot> - 17: }
204849 <+termbot> - 18: }
204849 <+termbot> - 19: printf("%d",n);
204849 <+termbot> - 20:* }
204850 <+termbot> -*
204853 <@b_jonas> `10
204854 <+termbot> +10
204854 <+termbot> - 10:* for(i=0;i<=a[i];i++)
204854 <+termbot> - 10:*
204926 <@b_jonas> ` for (i = 0; 0 != a[i]; i++)
204926 <+termbot> + for (i = 0; 0 != a[i]; i++)
204926 <+termbot> -*
204933 <@b_jonas> `1p
204934 <+termbot> +1p
204934 <+termbot> - 1: #include<stdio.h>
204934 <+termbot> - 2: #include<conio.h>
204934 <+termbot> - 3: main()
204934 <+termbot> - 4: {
204934 <+termbot> - 5: char c;
204934 <+termbot> - 6: char a[9];
204935 <+termbot> - 7: int i,n=0; /* n stands for no. of vowel*/
204935 <+termbot> - 8: clrscr();
204936 <+termbot> - 9: fgets(a, 9, stdin);
204936 <+termbot> - 10: for (i = 0; 0 != a[i]; i++)
204937 <+termbot> - 11: {
204937 <+termbot> - 12: switch(c)
204938 <+termbot> - 13: {
204938 <+termbot> - 14: case 'a': case 'e': case 'i': case 'o':
case 'u':
204939 <+termbot> - 15: n++;
204939 <+termbot> - 16: break;
204940 <+termbot> - 17: }
204940 <+termbot> - 18: }
204942 <+termbot> - 19: printf("%d",n);
204943 <+termbot> - 20:* }
204943 <+termbot> -*
205017 <@b_jonas> `e
205017 <+termbot> +e
205017 <+termbot> -
205018 <+termbot> -C:\MONKPERL>
205025 <@b_jonas> `bcc vowel.c
205025 <+termbot> +bcc vowel.c
205028 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland
International
205028 <+termbot> -vowel.c:
205028 <+termbot> -Warning vowel.c 20: Function should return a value in
function main
205028 <+termbot> -Turbo Link Version 5.1 Copyright (c) 1992 Borland
International
205028 <+termbot> -
205028 <+termbot> - Available memory 4074540
205031 <+termbot> -
205031 <+termbot> -C:\MONKPERL>
205320 <@cbstream> [ambrus] right, the problem is, <c>switch(c)</c> doesn't
make sense, since you only assign <c>c</c> once and in a
wrong way at that time. you need to switch on something
that's set to the next character each time.
205319 <@b_jonas> `edlin vowel.c
205320 <+termbot> +edlin vowel.c
205320 <+termbot> -End of input file
205320 <+termbot> -*
205352 <@b_jonas> `12
205352 <+termbot> +12
205352 <+termbot> - 12:* switch(c)
205352 <+termbot> - 12:*
205401 <@b_jonas> ` switch(a[i])
205401 <+termbot> + switch(a[i])
205401 <+termbot> -*
205403 <@b_jonas> `e
205403 <+termbot> +e
205403 <+termbot> -
205403 <+termbot> -C:\MONKPERL>
205406 <@b_jonas> `bcc vowel.c
205406 <+termbot> +bcc vowel.c
205408 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland
International
205408 <+termbot> -vowel.c:
205408 <+termbot> -Warning vowel.c 20: Function should return a value in
function main
205408 <+termbot> -Turbo Link Version 5.1 Copyright (c) 1992 Borland
International
205409 <+termbot> -
205409 <+termbot> - Available memory 4074540
205411 <+termbot> -
205411 <+termbot> -C:\MONKPERL>
205417 <@b_jonas> `vowel
205418 <+termbot> +vowel
205420 <@b_jonas> `semi
205420 <+termbot> -semi
205420 <+termbot> -2
205420 <+termbot> -C:\MONKPERL>
205422 <@b_jonas> `vowel
205422 <+termbot> +vowel
205427 <@b_jonas> eieio
205431 <@b_jonas> `eieio
205432 <+termbot> -eieio
205432 <+termbot> -5
205432 <+termbot> -C:\MONKPERL>
205433 <@b_jonas> `vowel
205433 <+termbot> +vowel
205447 <@b_jonas> strmpf
205453 <@b_jonas> `strmpf
205454 <+termbot> -strmpf
205454 <+termbot> -0
205454 <+termbot> -C:\MONKPERL>
205523 <@cbstream> [ambrus] ah, after all the modifications, my version seems
to work now.
205646 <@b_jonas> `type vowel.c
205646 <+termbot> +type vowel.c
205646 <+termbot> - #include<stdio.h>
205646 <+termbot> -#include<conio.h>
205646 <+termbot> - main()
205646 <+termbot> - {
205647 <+termbot> - char c;
205647 <+termbot> - char a[9];
205648 <+termbot> - int i,n=0; /* n stands for no. of vowel*/
205648 <+termbot> - clrscr();
205649 <+termbot> - fgets(a, 9, stdin);
205649 <+termbot> - for (i = 0; 0 != a[i]; i++)
205650 <+termbot> - {
205650 <+termbot> - switch(a[i])
205651 <+termbot> - {
205651 <+termbot> - case 'a': case 'e': case 'i': case 'o': case 'u':
205652 <+termbot> - n++;
205652 <+termbot> - break;
205653 <+termbot> - }
205653 <+termbot> - }
205654 <+termbot> -printf("%d",n);
205654 <+termbot> - }
205655 <+termbot> -
205655 <+termbot> -C:\MONKPERL>
</code>
<hr>
<p>
To [Xiong]:
<c>
use warnings;
use Scalar::Util "blessed";
{
package Error::Base;
sub new {
my($class, $str, @rest) = @_;
my %o = (str => $str, @rest); # you may store backtrace info too
bless \%o, $class;
}
use overload q/""/ => "strify";
sub strify {
my($self) = @_;
$$self{str} . "\n"; # you may append a user-readable form of the backtrace
}
sub crash {
my($self, @rest) = @_;
die $self->new(@rest);
}
}
my $wt = -140;
if ($wt < 0) {
Error::Base->crash("creature weight negative",
negative_creature_weight => 1,
creature_name => "dragon",
creature_weight => -140,
);
}
__END__
</c>
Output:
<c>
creature weight negative
</c>
<hr>
To Monk_perl:
<ol>
<li>
Solve [id://927735].
<li>
Write a C program that inputs a list of fourteen integers separated by whitespace, then prints their alternating sign sum.
<p>Example input: <c>44 57 31 29 51 29 59 48 82 18 95 11 45 64</c>. Output for this input: <c>151</c>
<li>
Without running it on a computer, determine what this program would print if ran.
<c>
#include <stdio.h>
int main(void) {
int n = 0;
while (n < 10) {
if (n < 5) {
n = n + 3;
} else {
n = n + 2;
printf("%d\n", n);
}
}
return 0;
}
</c>
</ol>
<hr>
List of perl modules I have, for [Xiong]. This is inclusive like your list, there are some modules in here that I haven't really tried.
<p>
Some dependencies are not listed, even if I've used them directly. Also, assume that I mean the latest stable versions of each of these modules and of the perl core.
<ul>
<li>
Mark Lehmann's modules: AnyEvent, EV, AnyEvent::HTTP, Coro, Compress::LZF, EV::Loop::Async, JSON::XS, EV::ADNS, IO::Socket::SSL, AnyEvent::HTTP. (If you want to be inclusive, just install all his modules :)
<li>
Email parsing and creation: Mime::Tools, Email::Mime.
<li>
Internationalization stuff: Unicode::Collate.
<li>
modules whose functions have been integrated to core lately but you can still use them if you want your code to run on older perls unchanged: Socket::GetAddrInfo, MRO::Compat, Hash::Util::FieldHash::Compat, WWW::Curl.
<li>
OS interface: BSD::Resource, Socket::MsgHdr.
<li>
Date module: Date::Manip.
<li>
Toolkit stuff: Glib, Gtk2, Wx, Tk.
<Li>
web and XML and related stuff: CGI, HTML::Tree, XML::Twig, XML::LibXML, XML::XSH2, XML::XPath, LWP, URI, Net::Curl::Simple, Mozilla::CA.
<li>
Perl data structures stuff: Data::Diver, Data::Dump::Streamer.
<li>
Perl internals magic stuff: Sub::Name.
<li>
Regexp::Common.
<li>
Numeric: Math::BigInt::GMP, Math::Int64, Math::Libm, PDL.
<li>
Serialization: YAML (I don't recommend this one, but it's popular), YAML::Syck, JSON.
<li>
Various other modules I have downloaded to look at their docs but have never used them and possibly never even installed them (this is true to some of the previous modules too): Astro::MoonPhase, B::Keywords, File::HomeDir, File::ShareDir, Sane.
<li>
Paul Evan's modules (I haven't really tried any of these): Async-MergePoint, IO::Async, AnyEvent::IRC, Term::TermKey.
<li>
(Update:) This one I install only because I'm the maintainer: Object::Import.
</ul>
<hr>
<p>
Code in pre tags around code tags
<pre>
<c>
first line
second
third
fourth
</c>
</pre>
<hr>
Poll idea draft
<p>
I can't imagine how I could live all my childhood without: mobile phone, electric toothbrush, el. pencil sharpener, notebook computer, Euro, smartphone, wireless mouse, dishwasher,
.
<p>
<hr>
To [cythin], based on [id://885390] and [id://827649]:
<c>
use warnings; use strict;
my $regex1 = qr/([a-zA-Z]+(\d*)+)|((\d*)+[a-zA-Z]+)/; #default words, and words with numbers
my $regex2 = qr/(\w|\d|\.)+@(\w|\d|\.)+/; #email addresses
my $regex3 = qr/(\w+)\s?(\d)+/; #word and number combinations: Number 1, Assignment 2, Vol
my $regex4 = qr/(\w+)'(\w){0,2}/; #contractions in English
my $regex5 = qr/(\w)(\/|&)(\w)/; #abbreviations with slash: c/o, i/o, etc.
my $regex6 = qr/(M).{1,2}\.(\s([A-Z]{1}[a-z]+))?/; #formal titles: Dr., Mr., Mrs. Agenstein, etc.
my $regex7 = qr/(\w+)-(\w+)(-\w+)?/; #hyphenated words: cat-like, face-to-face, etc.
my $regex8 = qr/([A-Z]\.?){3}/; #3-letter abbreviations, using uppercase only, no space,
my $regex9 = qr/[a-zA-Z]{3}\.\s?(\d+)/; #3-letter abbreviations containing numbers, mixed case,
my $regex10 = qr/\$\d+/; #money expressions $xxxx format
my $regex11 = qr/\$\d+(.\d{2})?/; #money expressions $xxxx.xx format
my $regex12 = qr/(http:\/\/.*)|(w{3}\.(.)*)/; #websites beginning with www. or http://
my $regex13 = qr/(\(\d{3}\)\s(\d{3})-(\d{4}))/; #phone numbers, no country code (xxx) xxx-xxxx
my @regarray = ($regex13, $regex12, $regex11, $regex10, $regex9, $regex8, $regex7, $regex6, $regex5, $regex4, $regex3, $regex2, $regex1);
$/ = undef;
my $text = <DATA>;
TOK: while(1) {
for my $i (0 .. @regarray-1) {
my $re = $regarray[$i];
if ($text =~ /\G($re)/gc) {
my $word = $1;
if (12 != $i) {
printf "%02d (%s)\n", $i, $word;
}
next TOK;
}
}
if ($text =~ /\G./gcs) {
1;
} elsif ($text =~ /\G\z/gc) {
print "end of text\n";
last;
} else {
die;
}
}
__DATA__
Some text here
</c>
<hr>
<p>
Custom CSS I use with the Dark theme. This is grey on black text. One problem with it is that I can't change the colors of the checkboxes and option buttons, so they look ugly. (I'm using various versions of Firefox mostly.)
<c>
/* css for ambrus in perlmonks.com */
/* color, supplementing the Dark theme */
input, textarea, select { background-color: #000000; color: #cccccc }
input[type="submit"] { background-color: #000000; color: #ffffff }
a:link { color: #8080ff }
a:visited { color: #a060d0 }
/* posts */
div.notetext { font-size: 100% }
tr.reply-body ul.indent font[size="2"] { font-size: 100% }
div.readmore { background-color: transparent; padding-left: 2px; border-left-width: 2px; border-left-color: #080; border-left-style: solid }
/* nodelets */
tbody.nodelet td { font-size: 100%; background-color: #000000 }
#XP_Nodelet sup { vertical-align: text-top }
tbody.nodelet .inline-list > li:before { content: " "; }
tbody.nodelet#Find_Nodes .inline-list > li { display: block; }
.nodelet#Leftovers ul#external { display: none; }
/* cb messages */
tbody.nodelet td.highlight { /* background-color: transparent */ }
tr.cb_msg td, tr.cb_me td { padding: 0px; text-indent: -0.6em; padding-left: 0.6em; }
/* cb speakers: */
span.chat span.cb_author *:link, span.chat span.cb_author *:visited { font-size: 111% }
span.chat i > span.cb_author *:link , span.chat i > span.cb_author *:visited { font-size: 111%; font-style: italic }
/* cb separators
span.chat span.cb_author:before { content: "\3d" }
span.chat i > span.cb_author:before { content: "\3d" }
span.chat span.cb_author:after { content: "\3d" }
span.chat i > span.cb_author:after { content: "" }
*/
span.chat span.cb_sq_br:first-child , span.chat span.cb_sq_br , span.chat span.cb_me_bullet { display: none }
/* span.chat span.cb_sep { } */
/* cb sidebar */
body#id-481185 input[name="message"] { width: 100%; }
body#id-481181 table.cb_table td { font-size: 17px }
/* increase some text areas */
*.user-settings textarea[name="setstyle"] { width: 80ex; height: 20em }
/* show levels next to attributions */
/*.attribution-title { display: inline; }*/
/* misc */
div.ss-criteria-summary { display: none }
/* TEMP */
/*"http://cruft.de/lr.css"*/
/*tbody[id="XP_Nodelet"] { display: none; color: lime }*/
/*.nnt-line-incidental .nnt-link { background-color: orange; }*/
/*ul ul ul { padding-left: 0px }*/
/* body#id-11911 .nodelets { display: none } */
</c>
Rat gradient is <c>80ff80;8080ff</c>.
<hr>
<p>
Testing: ea ια ou őű low control ␁␅␟␋␌ space control
del cp1252
invalid byte ‘€ end.
<hr>
<p>
Languages in order of portability on unix systems, for when I want to write a cross-language obfu. (These are off the top of my head, check package lists of distros if you want to be sure.)
<ul>
<li>
Almost all unixen: bash or ksh, sed or awk, gcc.
<li>
Almost all linuxen: bash, gsed, gawk, perl.
<li>
Linuxen where you build: g++, gmake.
<li>
Linuxen where you develop: m4 (autotools uses it), lex, yacc, makeinfo, some C libraries.
<li>
Traditional unices (but not some modern linux desktops): make, dc, bc, ex.
<li>
Many unices where you typeset: metafont, tex, latex, gs (ghostscript).
<li>
Many linuxes: python2, ruby1.8, firefox or konqueror.
</ul>
<hr>
<h3>
Possible rumours about the unohly opwer.
</h3>
<p>
<b>
I've removed the actual list, because [jdporter] started the service..</b>
<p>
We may want to cycle these so a new random rumour appears every day on the group page.
<p>
Special thanks to [ww] for some of the ideas.
<p>
Guidelines for inclusion: (yes, I know, these contradict each other and the list of quips I gave)
<ul>
<li>
No Chuck Norris facts
<li>
Plausible ones, so that if someone casually visits the node only on one day, he probably doesn't get too suspicious.
<li>
Ones that won't make a casual onlooker outraged because of violation of their privacy or other pertained rights if they take the quip seriously, eg. no "can read your private messages".
<li>
No powers that specific Cabal groups (other than gods) have.
<li>
Be vague
<li>
Some unholy tone
<li>
Funny
</ul>
<p>
Template and list removed
<p>
The following are to consider whether they can be added.
<ul>
<li>
edit the lists of top of page quips and xp quips and silence messages and borgisms and unholy power rumours
<li>
to edit theme CSS
<li>
Fermat joke
<li>
[id://506825|Microbrewery]
</ul>
<hr>
Funny warning syntax that inlines to nothing:
<c>
use warnings; use strict;
no warnings qw"void";
sub DEBUG () {}
{ package Dbglt; use overload "<", sub {}; }
*< = sub { bless {}, Dbglt::; };
# for not debugging, uncomment:
sub dbg () { "" }
# for debugging, uncomment:
#sub dbg { "" }
dbg & <<'DEBUG;';
warn "debugging message";
DEBUG;
warn "normal message";
__END__
</c>
<hr>
<c>
# bash functions for manipulating the path
shopt -s extglob
# addpath appends a directory to the path unless it is already there
# eg: addpath ~/bin
addpath(){
local a p=":$PATH:"; for a;
do case "$p" in (*:"${a%/}"?(/):*);; (*) p="$p$a:";; esac;
done; p="${p#:}"; PATH="${p%:}";
}
# delpath deletes a dir from the path
delpath(){
local a p=":$PATH:"; for a;
do a="${a%/}"; p=${p/:"${a}"?(\/):/:};
done; p="${p#:}"; PATH="${p%:}";
}
#END
</c>
<hr>
<p>
To Xiong: removing filter by calling unimport works as expected:
<c>
[am]king ~/a/tmp$ cat a.pl
{
package Filter::Transcript;
use Filter::Util::Call;
sub filter {
my $s = filter_read;
warn "TRANSCRIPT: $_";
$s;
}
sub import {
filter_add(\&filter);
}
sub unimport {
filter_del()
}
BEGIN { $INC{"Filter/Transcript.pm"}++; }
}
print "hello, world\n";
use Filter::Transcript;
for (0, 1) {
print "this part of the code is transscribed\n";
}
no Filter::Transcript;
print "good bye\n";
__END__
[am]king ~/a/tmp$ perl a.pl
TRANSCRIPT:
TRANSCRIPT: for (0, 1) {
TRANSCRIPT: print "this part of the code is transscribed\n";
TRANSCRIPT: }
TRANSCRIPT:
TRANSCRIPT: no Filter::Transcript;
hello, world
this part of the code is transscribed
this part of the code is transscribed
good bye
[am]king ~/a/tmp$ perl -v
This is perl 5, version 12, subversion 1 (v5.12.1) built for x86_64-linux
Copyright 1987-2010, Larry Wall
Perl may be copied only under the terms of either the Artistic License or the
GNU General Public License, which may be found in the Perl 5 source kit.
Complete documentation for Perl, including FAQ lists, should be found on
this system using "man perl" or "perldoc perl". If you have access to the
Internet, point your browser at http://www.perl.org/, the Perl Home Page.
[am]king ~/a/tmp$
</c>
<hr>
<p>
The link from the internationalized About Google page
[http://www.google.hu/intl/hu/about.html] to the [http://googleblog.blogspot.com/|Google Blog] is
broken. It says "Google Blog" but actually points to the google
search main page [http://www.google.com/].
<p>
I can't figure out where to send a report about this.
I looked at the Google Help Center at first,
but in [http://www.google.com/support/bin/static.py?page=portal_more.cs]
I couldn't find a category that matched the about page. Then I tried
the "Contacting Us" page, but it seems there's no general contact
page, only ones tied to each google product like Web search
([http://www.google.com/support/websearch/bin/request.py?contact_type=contact_policy]),
which sent me to the Help forum. However, the Help forum
[http://www.google.com/support/forum?hl=en] is also separated to pages
for each google product, and it seems there's no generic forum about
topics that don't fit elsewhere, nor a forum about the Help Center or
the Help forum itself (nor a Help Center category about the forum
etc), so now I completely don't have any idea on who to ask.
<p>
On the
[http://googleblog.blogspot.com/|Google Blog] page itself they say "We Love Feedback" with an email addres, and they're probably interested in the link pointing to them (so readers can find the blog), so finally I sent a mail to that address in case they can help, but I still don't think that's the right place.
<p>
So, dear monks, help me figure out who I should ask about this thing.
<hr>
<p>
Why am I getting this warning?
<c>
$ perl -we 'my %rule = ("suffix1", "foo", "succ1", "bar"); warn join("/", @rule{qw"suffix1 succ1"})'
Scalar value @rule{qw"suffix1 succ1"} better written as $rule{qw"suffix1 succ1"} at -e line 1.
foo/bar at -e line 1.
$ perl -v
This is perl, v5.10.1 (*) built for x86_64-linux
...
</c>
<hr>
<p>
Word ladder, [http://perl.plover.com/qotw/|perl quiz of the week] expert edition week 22. See
[http://perl.plover.com/~alias/list.cgi?mss:99:dlfkjbmmdljnajmfagki|report of solutions and task specification], [http://perl.plover.com/~alias/list.cgi?1:mss:2055:nakbjdbklffolpbgdoac|my submission],
and other mails in these two mailing lists.
<hr>
<p>
<b>RE [id://796576]</b>
<p>
There's
[id://510925] which links to an older node [id://52469].
<p>
Then there's the amazing [http://sed.sourceforge.net/grabbag/scripts/dc_overview.htm|dc.sed] script which implements arbitrary precision numeric calculations in decimal base in sed – you can find [http://sed.sourceforge.net/grabbag/scripts/dc.sed|its source here] or inside the tarball of [http://www.gnu.org/software/sed//sed.html|gnu sed] as a test. I don't really understand how it does the multiplication and division, but I could do the addittion on my own in a slightly more complicated way in [id://388399] (it's a loop of four substitutions, dc.sed has two and the teasing comment "could be done in one s/// if we could have >9 back-refs..." which I don't really believe).
<p>
How about fibonacci numbers? Some snipets like [id://715421] use regex substitutions but then they're not really using the power of the regex engine. There must be some way to actually use the regular expression engine to generate fibonacci numbers though. Searching yields [id://424865] and [id://98691]. These test for fibonacci numbers rather than generating them but there's probably some way to convert them. Another idea is to use something like this but probably there's some nicer way to phrase it:
<c>
perl -le'$==1,(1x$_)=~/(^)(1|11\1)*(?{$=++})^/,print$=for 0..20'
</c>
<hr>
<p>
good <a name="glt" href="javascript: (function(g) { g.parentNode.replaceChild( document.createTextNode( ['morning','afternoon','evening'][Math.floor(3*Math.random())] ), g ); }( document.getElementsByName('glt')[0] )) ">localtime</a>
<hr>
<p>
Here's some code to show that IO::Socket inherits the creation methods (new, new_from_fd, fdopen) from IO::Handle.
<c>
perl -we 'use warnings; use strict; use 5.010; use IO "Socket"; use Socket; use Fcntl; my($L, $R) = IO::Socket->socketpair(PF_UNIX, SOCK_STREAM, 0) or die; $L->fcntl(F_SETFD, $L->fcntl(F_GETFD, 0) &~ FD_CLOEXEC); defined(my $p = fork) or die "fork"; if (!$p) { exec @ARGV, $L->fileno; die "exec"; } $L->close; print "reading... "; my $x = $R->getline; say "got: $x"; 0 < waitpid $p,0 or die "wait";' perl -we 'use warnings; use strict; use 5.010; use IO::Socket; sleep 1; my $h = shift; say "fileno: $h"; my $O = IO::Socket->new_from_fd($h, ">") or die "fdopen $!"; $O->printflush("hello"); $O->shutdown(SHUT_WR); say "written"; sleep 1; say "done";'
</c>
<hr>
<p>
To Tanktalus, who is lazy to read the irc RFCs.
<c>
perl -we 'use Socket; use IO::Handle; socket $C, PF_INET(), SOCK_STREAM(), 0 or die; connect $C, sockaddr_in(6667, inet_aton("irc.freenode.net")) or die; printf $C "user 0 0 0 x\nnick cbu%04x\njoin #cbstream\n", rand(2**16) or die; flush $C; while (<$C>) { y/\r//; /\A(?::\S+)?\s+(?:4|ERROR)/ and die $_; /\A:cbstream!\S+\s+PRIVMSG\s+#cbstream\s+:?(.*)/si and print $1; }'
</c>
New, corrected version:
<c>
perl -we 'use Socket; use IO::Handle; socket $C, PF_INET(), SOCK_STREAM(), 0 or die; connect $C, sockaddr_in(6667, inet_aton("irc.freenode.net")) or die; printf $C "user 0 0 0 x\nnick cbu%04x\njoin #cbstream\n", rand(2**16) or die; flush $C; while (<$C>) { y/\r//; /\A(?::\S+)?\s+(?:4(?!77)|ERROR)/ and die $_; /\A:cbstream!\S+\s+PRIVMSG\s+#cbstream\s+:?(.*)/si and print $1; }'
</c>
<hr>
<p>
Numerology. If you don't cheat by using random operations and only add the letters of each verse then 442 is the most frequent sum in the [http://www.lolcatbible.com/index.php?title=Main_Page|bible].
<c>
442 thorns(19+7+14+17+13+18) also(0+11+18+14) An(0+13) thistlez(19+7+8+18+19+11+4+25) gun(6+20+13) it(8+19) brin(1+17+8+13) forth(5+14+17+19+7) 2 u(20); -- Genesis 3:18
442 Ceiling(2+4+8+11+8+13+6) Cat(2+0+19) sed(18+4+3), "yr(24+17) her(7+4+17) bukkit(1+20+10+10+8+19) holder(7+14+11+3+4+17), go(6+14) hold(7+14+11+3) her(7+4+17) bukkit(1+20+10+10+8+19)." -- Genesis 16:9
442 An(0+13) he(7+4) sed(18+4+3) "Abraham(0+1+17+0+7+0+12) ur(20+17) gud(6+20+3) kitteh(10+8+19+19+4+7). U(20) wud(22+20+3) givd(6+8+21+3) me(12+4) ur(20+17) kitteh(10+8+19+19+4+7). -- Genesis 22:16
442 Dad(3+0+3) may(12+0+24) feels(5+4+4+11+18) my(12+24) no(13+14) furz(5+20+17+25), then(19+7+4+13) he(7+4) would(22+14+20+11+3) cockmongle(2+14+2+10+12+14+13+6+11+4) me(12+4)." -- Genesis 27:12
442 Da(3+0) maidz(12+0+8+3+25) n(13) dere(3+4+17+4) kittehs(10+8+19+19+4+7+18) come(2+14+12+4) up(20+15) and(0+13+3) smelled(18+12+4+11+11+4+3) Esau's(4+18+0+20+18) butt(1+20+19+19), -- Genesis 33:6
442 newai(13+4+22+0+8) u(20) can(2+0+13) lookz(11+14+14+10+25) at(0+19) me(12+4) An(0+13) seez(18+4+4+25) taht(19+0+7+19) i(8) iz(8+25) ur(20+17) bro(1+17+14). 4 rael(17+0+4+11). -- Genesis 45:12
442 See(18+4+4)? U(20) has(7+0+18) stopped(18+19+14+15+15+4+3) all(0+11+11) teh(19+4+7) Israelite(8+18+17+0+4+11+8+19+4) d(3)00dz(3+25) from(5+17+14+12) work(22+14+17+10)." -- Exodus 5:5
442 Eech(4+4+2+7) yr(24+17), U(20) eet(4+4+19) bred(1+17+4+3) wid(22+8+3) no(13+14) yeest(24+4+4+18+19), or(14+17) I(8) pwn(15+22+13) U(20). Big(1+8+6) tyme(19+24+12+4). -- Exodus 12:15
442 pwn(15+22+13) teh(19+4+7) Midianites(12+8+3+8+0+13+8+19+4+18) for(5+14+17) teh(19+4+7) j(9)00s(18) so(18+14) tehy(19+4+7+24) wil(22+8+11) laik(11+0+8+10) u(20). -- Numbers 31:2
442 Ruth(17+20+19+7) goes(6+14+4+18) home(7+14+12+4) at(0+19) 5. She(18+7+4) has(7+0+18) got(6+14+19) good(6+14+14+3) amount(0+12+14+20+13+19) of(14+5) foods(5+14+14+3+18). -- Ruth 2:17
442 "when(22+7+4+13) tehy(19+4+7+24) iz(8+25) liek(11+8+4+10) 'we(22+4) can(2+0+13) haz(7+0+25) cheezburgr(2+7+4+4+25+1+20+17+6+17) naow(13+0+14+22) plz(15+11+25)?'() -- Job 38:40
442 Oh(14+7) hai(7+0+8). Dude(3+20+3+4) called(2+0+11+11+4+3) Job(9+14+1) replied(17+4+15+11+8+4+3) on(14+13) chat(2+7+0+19) and(0+13+3) sed(18+4+3) back(1+0+2+10) to(19+14) Invisible(8+13+21+8+18+8+1+11+4) Man(12+0+13): -- Job 42:1
442 u(20) is(8+18) on(14+13) teh(19+4+7) thrones(19+7+17+14+13+4+18), gettin(6+4+19+19+8+13) praised(15+17+0+8+18+4+3) by(1+24) teh(19+4+7) Israel(8+18+17+0+4+11). -- Psalm 22:3
442 Ceiling(2+4+8+11+8+13+6) cat(2+0+19) are(0+17+4) serious(18+4+17+8+14+20+18) cat(2+0+19). This(19+7+8+18) are(0+17+4) serious(18+4+17+8+14+20+18) psalm(15+18+0+11+12). -- Psalm 24:8
</c>
<p>
The numerology guys are: [id://701899] [id://714469] [id://629053].
<hr>
<hr>
<p>
New fav pentomino pattern testing here.
<TABLE border="5" cellspacing="0">
<COLGROUP span="10" width="25"></COLGROUP>
<TR height="25"><TD bgcolor="#8000c0" colspan="2"><TD bgcolor="#ffff81" colspan="5"><TD bgcolor="#40ff40" colspan="3">
<TR height="25"><TD bgcolor="#8000c0" colspan="1"><TD bgcolor="#80c000" colspan="3"><TD bgcolor="#4040ff" colspan="4"><TD bgcolor="#0080c0" colspan="1"><TD bgcolor="#40ff40" colspan="1">
<TR height="25"><TD bgcolor="#8000c0" colspan="1"><TD bgcolor="#00c080" colspan="2"><TD bgcolor="#80c000" colspan="2"><TD bgcolor="#4040ff" colspan="1"><TD bgcolor="#0080c0" colspan="3"><TD bgcolor="#40ff40" colspan="1">
<TR height="25"><TD bgcolor="#8000c0" colspan="1"><TD bgcolor="#81ffff" colspan="1"><TD bgcolor="#00c080" colspan="2"><TD bgcolor="#c00080" colspan="1"><TD bgcolor="#ff4040" colspan="1"><TD bgcolor="#0080c0" colspan="1"><TD bgcolor="#ff81ff" colspan="1"><TD bgcolor="#c08000" colspan="2">
<TR height="25"><TD bgcolor="#81ffff" colspan="2"><TD bgcolor="#00c080" colspan="1"><TD bgcolor="#c00080" colspan="2"><TD bgcolor="#ff4040" colspan="1"><TD bgcolor="#ff81ff" colspan="3"><TD bgcolor="#c08000" colspan="1">
<TR height="25"><TD bgcolor="#81ffff" colspan="2"><TD bgcolor="#c00080" colspan="2"><TD bgcolor="#ff4040" colspan="3"><TD bgcolor="#ff81ff" colspan="1"><TD bgcolor="#c08000" colspan="2">
</TABLE>
<hr>
<p>
This is a test to see if we can still make a homenode button with html filtering, using javascript.
<P>
<a name=O href="javascript:d=document;m=d.getElementById('talkbox'); m.value='\x3ca name=O href=\x22'+d.getElementsByName('O')[0].href.replace(/Go(\d+)/,function(x,y){return'Go'+ ++y})+'\x22\x3eGo1';m.parentNode.hubmit();">Go0
</a></a></a>
<p>
<a href="javascript:alert(1)">Alert1</a>
<a href="javascript:d=document;d.write('\x3cform method=postImessage name=opI\'ho hum\' name=message '.replace(/I/g,' \x3cinput value='));d.close();d.forms[0].submit();">Golf
</a></a>
<a href="javascript:d=document;d.body.innerHTML=('\x3cform method=postImessage name=opI\'ho hum\' name=message '.replace(/I/g,' \x3cinput value='));d.forms[0].submit();">More
</a>
<a name=O href="javascript:d=document;m=d.getElementById('talkbox'); m.value='\x3ca name=O href=\x22'+d.getElementsByName('O')[0].href+'\x22\x3eO';m.parentNode.hubmit();">Ofill
</a>
<a name=O1 href="javascript:void(document.getElementsByName('O1')[0].innerHTML='\x3cimg src=http://tinyurl.com/52jsn3\x3e')" >Smile</a>
<p>
<a href="r=javascript:r='replace';eval(s='\';d=document;d.write(\'\\x3cform method=postImessage name=opI\\\'H\\\' name=message \'.replace(/I/g,\' \\x3cinput value=\'));d.close();d.forms[0].stubmit();'[r](/^/,'r=\''+r))">X
</a>
<p>
<table border=0 cellspacing=0 cellpadding=0>
<COLGROUP span=2 width=2></COLGROUP>
<COLGROUP span=1></COLGROUP>
<COLGROUP span=1 width=2></COLGROUP>
<tr height=1>
<td bgcolor="#f3f3f3" colspan=5>
<tr height=1>
<td bgcolor="#f3f3f3" colspan=4><td bgcolor="#787878" rowspan=4>
<tr>
<td bgcolor="#f3f3f3" colspan=2><td bgcolor="#dadada"
><a href="javascript:d=document;d.write('z \x3cform method=post I129 name=node_id Imessage name=op Iwassup name=message '.replace(/I/g,' \x3cinput type=hidden value=')); d.close(); d.forms[0].submit(); " ><font color="#000000"> do not press </font></a><
td bgcolor="#787878">
<tr height=1>
<td bgcolor="#f3f3f3" colspan=1><td bgcolor="#787878" colspan=4>
<tr height=1>
<td bgcolor="#787878" colspan=5>
</table>
<hr>
<p>
My perlmonks user CSS (I use the default theme, updated 2008 August 1st):
<c>
/* css for ambrus in perlmonks.com */
/* general */
/* posts */
div.notetext { font-size: 100% }
tr.reply-body ul.indent font[size="2"] { font-size: 100% }
div.readmore { background-color: transparent; padding-left: 2px; border-left-width: 2px; border-left-color: #080; border-left-style: solid }
/* nodelets */
#nodelet_body_row_XP_Nodelet sup { vertical-align: text-top }
tbody.nodelet td { font-size: 100% }
/* cb messages */
tbody.nodelet td.highlight { /* background-color: transparent */ }
tr.cb_msg td, tr.cb_me td { padding: 0px; text-indent: -0.6em; padding-left: 0.6em; }
/* cb speakers: */
span.chat span.cb_author *:link, span.chat span.cb_author *:visited { font-size: 111% }
span.chat i > span.cb_author *:link , span.chat i > span.cb_author *:visited { font-size: 111%; font-style: italic }
/* cb separators
span.chat span.cb_author:before { content: "\3d" }
span.chat i > span.cb_author:before { content: "\3d" }
span.chat span.cb_author:after { content: "\3d" }
span.chat i > span.cb_author:after { content: "" }
*/
span.chat span.cb_sq_br:first-child , span.chat span.cb_sq_br , span.chat span.cb_me_bullet { display: none }
/* span.chat span.cb_sep { } */
/* cb sidebar */
body#id-481185 input[name="message"] { width: 100%; }
body#id-481181 table.cb_table td { font-size: 17px }
/* increase some text areas */
*.user-settings textarea[name="setstyle"] { width: 80ex; height: 20em }
/* hide levels next to attributions */
span.attribution-title { display: none }
/* misc */
div.ss-criteria-summary { background-color: lime }
/* hide some links from the nodelets */
.nodelet#leftovers a[href="http://www.cafepress.com/perlmonks,perlmonks_too,pm_more"], .nodelet#leftovers a[href="http://www.cafepress.com/perlmonks,perlmonks_too,pm_more"] + br, a[href="http://perlbuzz.com/"], .nodelet#leftovers a[href="http://perlbuzz.com/"] + br, a[href="http://perl.com/"], .nodelet#leftovers a[href="http://perl.com/"] + br, a[href="http://www.perlfoundation.org/perl5/index.cgi"], .nodelet#leftovers a[href="http://www.perlfoundation.org/perl5/index.cgi"] + br, a[href="http://jobs.perl.org/"], .nodelet#leftovers a[href="http://jobs.perl.org/"] + br, a[href="http://www.pm.org/"], .nodelet#leftovers a[href="http://www.pm.org/"] + br, a[href="http://planet.perl.org/"], .nodelet#leftovers a[href="http://planet.perl.org/"] + br, a[href="http://use.perl.org/"], .nodelet#leftovers a[href="http://use.perl.org/"] + br, a[href="http://www.perl.org/"], .nodelet#leftovers a[href="http://www.perl.org/"] + br { display: none }
/* TEMP */
/*"http://cruft.de/lr.css"*/
/*tbody[id="XP_Nodelet"] { display: none; color: lime }*/
</c>
<hr>
<p>
Variant of [patchy patterns]
<c>
perl -we '($H,$W)=`stty size`=~/^(\d+) (\d+)/?($1-1,$2):(24,80);$w=$W+20; @a = map { rand() < 1/5 } 0 .. ($H+20)*$w; print "\e[H\e[J"; while() { print "\e[H"; for (1..5) { rand(40)<1 and @a[rand(@a)] = 1; @a = map { $c = $_; $s = 0; $s += $a[($c + $_) % @a] for -$w-1, -$w, -$w+1, -1, 1, $w-1, $w, $w+1; $p = $a[$_]; ($p?2:4) <= $s && $s < ($p?6:9) } 0 .. @a - 1; } for $y (10 .. $H + 9) { for $x (10 .. $W + 9) { print $a[$y*$w + $x] ? "#" : " "; } print "\n"; } }'
</c>
<hr>
<p>
List of candidates for irc/pm questions that could be auto-replied to.
<ul>
<li>duping filehandles
<li>system versus qx, especially `mkdir` and `cp`
<li>replace between
<li>fork, esp 0==$pid
<li>\Q
<li>dereferencing deep datastructures (hard)
<li>symbolic references
<li>status gauge in a CGI
<li>anything with xp in pmdiscuss
<li>
</ul>
<hr>
<p>
Proof-of-concept example for array automatically computing the sum of its first few elements. On [Limbic~Region]'s question. Warning: splicing, shifting etc the element will mess this up.
<c>
[am]king ~$ perl -we 'use strict; { package S; use Tie::Scalar; @{*ISA} = "Tie::StdScalar"; sub STORE { $::sum -= ${$_[0]}||0; $::sum += ${$_[0]} = $_[1] } } my @x; tie $x[$_], "S" for 0..2; $::sum = 0; $x[rand(10)] = int(rand(10)) for 0..99; $"="+"; warn "$::sum = @x[0..2]";'
13 = 2+8+3 at -e line 1.
[am]king ~$
</c>
<hr>
<p>
Here's a simple vector paint program.
<p>
It requires a terminal that can do xterm-like mouse reporting. It allows to draw colored polygons.
<p>
Left button adds a new node after the last one, right button removes the last node, middle button moves last node. The dot and comma keys cycle the nodes of the polygon, so you can change the nodes at any place. Backspace scrapes the whole polygon. The digits 0-7 set the color of the polygon. The lc letters a-z select another polygon: you have 26 of these, you can edit and color each of them independently, at startup the "a" polygon is selected, and the polygons with later letters are above the earlier ones.
<p>
The program can now save drawings. If you give a filename as a command-line argument, the drawing from that file will be loaded (if the file exists) and control-D will quit from the program saving to that file.
<p>
You figure out the rest from the code.
<c>
#!ruby -w
# simple vector-based paint program -- by ambrus
#
def mainloop;
at_exit do
print "\e[?9l\e[m";
system(*%w"stty sane");
end;
system(*%w"stty -icanon -echo -echonl");
puts "\e[?9h";
render;
while c = STDIN.getc;
if ?\e != c;
gotkey c;
elsif ?[ != STDIN.getc || ?M != STDIN.getc;
else
b = STDIN.getc - ?\ ;
x = STDIN.getc - ?!;
y = STDIN.getc - ?!;
gotmouse b, x, y;
end;
end;
end;
def render;
print "\e[H";
@SCRHEI.times do |y|
b = [[1e6]];
(0 ... @x.size).each do |obj|
px = @x[obj];
py = @y[obj];
b.concat((0 ... px.size).map do |k|
m = if py[k-1] <= y && y < py[k]; 1;
elsif py[k] <= y && y < py[k-1]; -1; end;
if m;
if xdet = py[k] - py[k - 1];
x = (px[k-1] * (py[k] - y) - px[k] * (py[k - 1] - y)) / xdet;
[x, m, obj];
end;
end;
end.compact);
end;
b.sort!;
c = @x.map { 0 };
@SCRWID.times do |x|
while b[0][0] < x;
c[b[0][2]] += b[0][1];
b.shift;
end;
fobj = (0 ... c.size).map.reverse!.find {|o| 0 != c[o] };
colr = if fobj; @colr[fobj] else "7" end;
print "\e[4#{colr}m ";
end;
y < @SCRHEI - 1 and print "\e[K\n";
end;
print "\e[J";
STDOUT.flush;
end;
def fsave fname;
File.open(fname, "w") do |file|
file.puts "DRAWIMAGE 0 1";
(0 ... 26).each do |n|
@x[n].empty? and next;
file.print "OBJECT ", n, " ", @colr[n];
(0 ... @x[n].size).each do |k|
file.print " ", @x[n][k], " ", @y[n][k];
end;
file.print "\n";
end;
end;
end;
def fload fname;
file = ();
begin
file = File.open(fname);
rescue Errno::ENOENT, Errno::ENAMETOOLONG, Errno::EISDIR, Errno::ELOOP, Errno::ENOTDIR,
Errno::EACCES, Errno::EROFS;
return;
end;
version = false;
file.each do |l|
l =~ /\A\s*(?:#|\z)/ and next;
f = l.scan(/\S+/);
case f[0].upcase;
when "DRAWIMAGE";
"0" == f[1] or fail "wrong major verson loading image file";
version = true;
when "OBJECT";
(0 ... 26) === (n = Integer(f[1])) or fail "wrong file format: invalid obj nr";
(0 ... 7) === (colr = Integer(f[2])) or fail "wrong file format: invalid colr";
@colr[n] = colr.to_s;
s = (f.size - 3)/2;
(0 ... s).each do |k|
(-32768 .. 32767) === (@x[n][k] = Integer(f[3 + k * 2])) or fail "wrong file format: invalid coordinate";
(-32768 .. 32767) === (@y[n][k] = Integer(f[3 + k * 2 + 1])) or fail "wrong file format: invalid coordinate";
end;
when "QC";
# noop
else
fail "wrong file format: invalid decl";
end;
end;
version or fail "wrong draw file format: no header";
file.close;
true;
end;
TIOCGWINSZ = 0x00005413;
def getwinsz;
#@SCRHEI, @SCRWID = 24, 80;
STDOUT.ioctl(TIOCGWINSZ, (buf = [].pack("x99")));
@SCRHEI, @SCRWID = buf.unpack("s!s!");
end;
getwinsz;
@x = (0 ... 26).map { [] };
@y = @x.map { [] };
@colr = @x.map { "0" };
def selobj n;
@s = n;
@xs = @x[n];
@ys = @y[n];
end;
selobj 0;
$*.empty? or fload($*[0]);
def gotmouse b, x, y;
if 0 == b; # left button appends point
@xs.push x;
@ys.push y;
elsif 2 === b; # right button removes point
@xs.pop;
@ys.pop;
elsif 1 === b; # middle button moves last point
@xs.empty? and return;
@xs[@xs.size - 1] = x;
@ys[@xs.size - 1] = y;
end;
render;
end;
def gotkey c;
case c;
when ?a .. ?z;
selobj c - ?a;
when ?0 .. ?7;
@colr[@s] = c.chr;
when ?\b, ?\x7f;
@xs.replace [];
@ys.replace [];
when ?,;
@xs.empty? and return;
@xs.unshift @xs.pop;
@ys.unshift @ys.pop;
when ?.;
@xs.empty? and return;
@xs.push @xs.shift;
@ys.push @ys.shift;
when ?/;
@xs.pop;
@ys.pop;
when ?\cd;
$*.empty? or fsave($*[0]);
exit;
end;
render;
end;
mainloop();
__END__
</c>
Here's an elephant I've made with a previous version.
<c>
+
+++++++++++++++++++
+++++++++++++++++++++
++++++++++++++++++++++
++++++++++++++++++++++++
+++++++++ ++++++++++++++++++++++++++++++++++++++++
++++++++++ +++++++++++++++++++++++++++++++++++++++
++++++++++++++++++++++++++++++++++++++++++++++++++++++
+++++++++++++++++++++++++++++++++++++++++++++++++++++++
+++++++ +++++++++++++++++++++++++++++++++++++++++++++
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++ +++++++++++++++++++++++++++++++++++++++++++
+++++ +++++++++++++++++++++++++++++++++++++++++++++
++++ ++++++++++++++++++++++++++++++++++++++++++++++
++++ +++++++++++++++++++++++++++++++++++++++++++++ ++
++++++ ++++++++++++++++++++++++++++++++++++++++++++++ ++
++++++++++ +++++++++++ ++++++++++ +
+++++++ +++++++++++ ++++++++++ +
++++++++++++ ++++++++++
++++++++++++ ++++++++++
+++++++++++++ ++++++++++
</c>
<hr>
<p>
[http://www.math.bme.hu/~ambrus/pu/cbstream/|cbstream FAQ]
<hr>
<p>
To [Corion].
<c>
sub mask {
my($s, $m) = @_;
[map { $$s[$_] } grep { 0 != ($m & (1<<$_)) } 0 .. @$s - 1];
}
</c>
<hr>
<p>
A lua japh.
<c>
a="for b=2,26 do c=0;for d,e in ipairs({a:byte(1,-1)})do c=(b*c+e)%127\
end;io.write(string.char(c))end--$S`U$-}OPX41,@aYH\3\26Q2\23*|>";
loadstring(a) {ambrus}
</c>
<hr>
<p>
Question about the regexp engine.
<p>
Suppose I want to do this: <c>"aaaaaaaaab" =~ /(a(?:|(?1)|a(?1 )))/</c>
<p>
Which one of the below two behaiviours would it do:
<c>
#!perl
# simulate the regexp /(a(?:|(?1)|a(?1)))/
use warnings;
use strict;
for my $MEM (0, 1) {
print $MEM ? "with" : "without", " memoization\n";
my $u;
my %c = ();
my $f; $f = sub {
$u++;
my $a = join(",", @_);
$MEM and exists($c{$a}) and
return $c{$a};
$c{$a} = (
1 <= @_ and
$_[0] eq "a" and (
1 == @_ or
&$f(@_[1 .. @_ - 1]) or
$_[1] eq "a" and
&$f(@_[1 .. @_ - 1])
)
);
};
for my $s ("aaaaaaaa", "aaaaaaaab") {
$u = 0;
print " ", $s, ": ",
&$f($s =~ /(.)/g) ? "hit" : "miss", ", sub called ", $u,
" times\n";
}
}
__END__
</c>
Output:
<c>
without memoization
aaaaaaaa: hit, sub called 8 times
aaaaaaaab: miss, sub called 383 times
with memoization
aaaaaaaa: hit, sub called 8 times
aaaaaaaab: miss, sub called 16 times
</c>
<p><a name="node_358307_t833837">
Here's a somewhat similar re that would blow up but perl optimizes it.
<c>
[am]king ~/a$ perl -we 'do { $u = 0; print "$_: ", /^((?{$u++})(?:a|aa))+$/ ? "hit" : "miss", ", parens called $u times\n" } for qw"aaaaaaaaa aaaaaaaaab";'
aaaaaaaaa: hit, parens called 10 times
aaaaaaaaab: miss, parens called 20 times
</c>
However, you can force it to blow up if you make the optimization impossible with a <c>(??{</c> -- which incidentally shows that "have I recursed" conditionals are not the only thing why these kinds of optimizations are difficult.
<c>
[am]king ~/a$ perl -we 'do { $u = 0; print "$_: ", /^((??{$u++;""})(?:a|aa))+$/ ? "hit" : "miss", ", parens called $u times\n" } for qw"aaaaaaaaa aaaaaaaaab";'
aaaaaaaaa: hit, parens called 10 times
aaaaaaaaab: miss, parens called 143 times
</c>
Backreferences can also inhibit this optimization:
<c>
[am]king ~/a$ perl -we 'do { $u = 0; print "$_: ", /j(.)rd((?{$u++})(?:\1|\1\1))+j/ ? "hit" : "miss", ", parens called $u times\n" } for qw"jard"."a"x16 ."bjord"."o"x16 ."j";'
jardaaaaaaaaaaaaaaaabjordooooooooooooooooj: hit, parens called 4197 times
[am]king ~/a$ perl -we 'do { $u = 0; print "$_: ", /j(.)rd((?{$u++})(?:[ao]|[ao][ao]))+j/ ? "hit" : "miss", ", parens called $u times\n" } for qw"jard"."a"x16 ."bjord"."o"x16 ."j";'
jardaaaaaaaaaaaaaaaabjordooooooooooooooooj: hit, parens called 76 times
</c>
This means that if you want to implement this memoization thing in the perl RE engine, you'll have to work with finding out when you can correctly apply it and when you can't.
I'm starting to really admire the engine (and those who wrote it) that it can work all this out.
<p>
I guess might make all this a meditation. As a reference to myself: [id://577368].
<p>
<hr>
<p>
<c>
print {;log=>} "hi";
</c>
<hr>
<p>
For [tye].
A command to rename some files, answer for a question on irc. Note how I avoid elseifs with [next].
<c>
perl -we 'use File::Find; finddepth sub {{ /\A(\d{5}-p)(\d+)(\.tif)\z/ or next; my $n = sprintf("%s%04d%s", $1, $2, $3); -e $n and next; warn "$_ => $n\n"; rename $_, $n or die "error rename $_ $n: $!"; }}, ".";'
</c>
<hr>
<p><!-- Sun Aug 27 21:19:52 CEST 2006 -->
For [creamygoodness], on embedding C snippets into C as data, here's a quine I wrote ages ago.
<c>
// 323 - Self reproducing program by Ambrus ZSBAN
//
// This program writes its source code to stdout.
// RVLVQRVLVQ
#include <stdio.h>
#include <string.h>
char s1[]=
"// 323 - Self reproducing program by Ambrus ZSBAN\n"
"//\n"
"// This program writes its source code to stdout.\n"
"// RVLVQRVLVQ\n"
"\n"
"#include <stdio.h>\n"
"#include <string.h>\n"
"char s1[]=\n"
"\"";
char s2[]=
"\";\n"
"\n"
"int main (void) {\n"
" char *p;\n"
" int x;\n"
" printf (\"%s\", s1);\n"
" p= s1;\n"
" while (*p) {\n"
" switch (*p) {\n"
" case '\\n':\n"
" printf (\"\\\\n\\\"\\n\\\"\");\n"
" break;\n"
" case '\\\\':\n"
" printf (\"\\\\\\\\\");\n"
" break;\n"
" case '\\\"':\n"
" printf (\"\\\\\\\"\");\n"
" break;\n"
" default:\n"
" x= strcspn (p, \"\\n\\\\\\\"\");\n"
" printf (\"%.*s\", x, p);\n"
" p+= x -1;\n"
" }\n"
" p++;\n"
" }\n"
" printf (\"\\\";\\nchar s2[]=\\n\\\"\");\n"
" p= s2;\n"
" while (*p) {\n"
" switch (*p) {\n"
" case '\\n':\n"
" printf (\"\\\\n\\\"\\n\\\"\");\n"
" break;\n"
" case '\\\\':\n"
" printf (\"\\\\\\\\\");\n"
" break;\n"
" case '\\\"':\n"
" printf (\"\\\\\\\"\");\n"
" break;\n"
" default:\n"
" x= strcspn (p, \"\\n\\\\\\\"\");\n"
" printf (\"%.*s\", x, p);\n"
" p+= x -1;\n"
" }\n"
" p++;\n"
" }\n"
" printf (\"%s\", s2);\n"
" return;\n"
" }\n"
"\n"
"\n"
"";
int main (void) {
char *p;
int x;
printf ("%s", s1);
p= s1;
while (*p) {
switch (*p) {
case '\n':
printf ("\\n\"\n\"");
break;
case '\\':
printf ("\\\\");
break;
case '\"':
printf ("\\\"");
break;
default:
x= strcspn (p, "\n\\\"");
printf ("%.*s", x, p);
p+= x -1;
}
p++;
}
printf ("\";\nchar s2[]=\n\"");
p= s2;
while (*p) {
switch (*p) {
case '\n':
printf ("\\n\"\n\"");
break;
case '\\':
printf ("\\\\");
break;
case '\"':
printf ("\\\"");
break;
default:
x= strcspn (p, "\n\\\"");
printf ("%.*s", x, p);
p+= x -1;
}
p++;
}
printf ("%s", s2);
return;
}
</c>
<hr>
<p>
Here's the ruby version of the CGI script I tried to make work below. This one seems to work, but I can't make a demonstration that can be viewed from outside because the firewalls on webservers block that.
<c>
#!/usr/local/bin/ruby -w
IMAGE_NAME = "/home/ambrus/a/flycgi/leer.jpg";
require "socket";
require "timeout";
print "Content-Type: text/html; charset=ISO-8859-2\n\n";
print %{<html>
<head>
<title>On-the-fly server experiment</title>
</head><body>
<h1>On-the-fly server experiment with ruby</h1>
<p>This CGI script experiments with starting a TCP server connection
on the fly to serve an image embedded in the page.
I do not recommend this technique for production.
<p>
So, here's an image:
};
lsock = Socket.new(Socket::PF_INET, Socket::SOCK_STREAM, 0);
lsock.listen 1;
port = Socket.unpack_sockaddr_in(lsock.getsockname)[0];
imgthread = Thread.new {
begin
asock = ();
timeout(60) {
asock, * = lsock.accept;
};
imgfile = File.open IMAGE_NAME;
imgsize = imgfile.stat.size;
asock.print "HTTP/1.1 200 Ok\nContent-type: image/jpeg\n" +
"Content-length: " + imgsize.to_s + "\n\n";
while b = imgfile.read(16*1024);
asock.print b;
end;
asock.close;
rescue Timeout::Error;
end;
};
server_name = ENV["SERVER_NAME"] || "localhost";
print %{<img src="http://} + server_name + ":" + port.to_s + %{/" alt="some dynamic image">};
print %{<p>Goodbye for now.
</body></html>
};
$>.flush;
imgthread.join;
__END__
</c>
<p>
This is the CGI script I'm trying to write as an experiment to serve an image in a strange way. It segfaults on the webserver at the point when it first wants to start the coroutine. I'm trying though on another machine that doesn't have a webserver it seems to work fine. You may have to change some pathnames in it, like the path to the error log (take care, it's overwritten every time) and the path to the image to be served.
<c>
#!/usr/bin/perl -T
use warnings; use strict;
BEGIN {
use IO::Handle;
open our $LOG, ">", "/home/student/ambrus/a/html/.fly.log" or die "cannot write error log";
sub tolog {
chomp(my $s = join("", @_));
warn "logged: " . $s;
print $LOG "fly " . localtime() . ": " . $s . "\n" or die "cannot write error log";
flush $LOG;
}
tolog "starting";
$SIG{__WARN__} = \&tolog;
our $OLDSIGDIE = $SIG{__DIE__}; $SIG{__DIE__} = \&tolog;
} CHECK {
#$SIG{__DIE__} = our $OLDSIGDIE;
tolog "checking";
} END {
tolog "ending";
}
eval {
use lib "/home/student/ambrus/local/perl/lib/perl/5.8.4";
use Coro; use Coro::Handle; use Coro::Timer; use Coro::Socket;
use Socket;
print qq{Content-Type: text/html; charset=ISO-8859-2\n\n};
my @jobs;
push @jobs, async {
tolog "[D10]";
select unblock *STDOUT;
print qq{<html>
<head>
<title>On-the-fly server experiment</title>
</head><body>
<h1>On-the-fly server experiment</h1>
<p>This CGI script experiments with starting a TCP server connection
on the fly to serve an image embedded in the page.
I do not recommend this technique for production.
<p>
So, here's an image:
};
socket my $S, PF_INET(), SOCK_STREAM(), 0 or die "socket $!";
listen $S, 1 or die "listen $!";
my($p, undef) = sockaddr_in(getsockname $S);
push @jobs, async {
eval {
my $Su = Coro::Socket->new_from_fh($S);
my $A = $Su->accept or die "accept: $!";
open my $I, "<", "/home/student/ambrus/a/html/pu/egyetem.jpg" or die "open image: $!";
print $A "HTTP/1.1 200 Ok\nContent-type: image/jpeg\n" .
"Content-length: " . (-s $I) . "\n\n" or
die "print image header: $!";
while (read $I, my $b, 4*1024) {
print $A $b;
#Coro::Timer::sleep 0.1;
}
close $A;
};
$@ and warn($@), die($@);
};
my $sn = $ENV{"SERVER_NAME"} || "localhost";
print q{<img src="http://} . $sn . ":" . $p . q{/">
<p>
Now I'll print some lines just to see if the image data and
the webpage can be loaded async.
};
for my $i (1 .. 10) {
Coro::Timer::sleep 2;
print q{<P>Just a line } . $i . qq{, nothing more.\n};
}
print q{<p>Goodbye for now.
</body></html>
};
};
tolog "[D20]";
$_->join for @jobs;
}; $@ and do {
tolog $@;
};
__END__
</c>
<hr>
<p>
Documentation format conversion graph
<c>
docbook -> texinfo => dvi => postscript -> pdf;
dvi => pdf -> postscript;
texinfo => info => text;
docbook -> manroff => text;
texinfo -> html -> text;
pod => manroff;
pod -> html;
pod -> text;
pod -> latex => dvi;
latex -> html;
docbook => html;
docbook -> pdf;
</c>
<p>
The block of edit keys on my new keyboard is vertical:
<table border="1">
<tr><td>Home<td>End
<tr><td>Ins<td>PgUp
<tr><td>Del<td>PgDn
</table>
<p>
When you redo in a while loop, it doesn't just goto back to the loop body. It gotos out of the scope of the loop and then gotos back in after the starting brace. Thus, the variable you declare as lexical in the loop condition behaives as a <c>my if 0</c> variable in this case. Here's an example:
<c>
[am]king ~$ perl -we 'while (!eof(STDIN)) { my $line = <STDIN> if 0 == @x % 3; push @x, \$line; print \$line, ": ", ($line || 0), "\n"; }; ' <<<$'a\nb\n'
SCALAR(0x812c9c0): a
SCALAR(0x812c048): 0
SCALAR(0x812c048): 0
SCALAR(0x812c048): b
SCALAR(0x812c9a8): 0
SCALAR(0x812c9a8): 0
SCALAR(0x812c9a8):
[am]king ~$ perl -we 'while (my $line = <STDIN>) { push @x, \$line; print \$line, ": ", ($line || 0), "\n"; redo if 0 != @x % 3; }; ' <<<$'a\nb'
SCALAR(0x812c9c0): a
SCALAR(0x812c048): 0
SCALAR(0x812c048): 0
SCALAR(0x812c048): b
SCALAR(0x812c9a8): 0
SCALAR(0x812c9a8): 0
[am]king ~$ </c>
<hr>
<p>
For [tye]:
<c>
UTF-8
ENCODING
The following byte sequences are used to represent a character. The
sequence to be used depends on the UCS code number of the character:
0x00000000 - 0x0000007F:
0xxxxxxx
0x00000080 - 0x000007FF:
110xxxxx 10xxxxxx
0x00000800 - 0x0000FFFF:
1110xxxx 10xxxxxx 10xxxxxx
0x00010000 - 0x001FFFFF:
11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
0x00200000 - 0x03FFFFFF:
111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
0x04000000 - 0x7FFFFFFF:
1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
more bits (non-standard extension):
11111110 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
11111111 100xxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
11111111 1010xxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
11111110 10110xxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
11111110 101110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
11111110 1011110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
11111110 10111110 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
11111110 10111111 100xxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
....
The xxx bit positions are filled with the bits of the character code
number in binary representation. Only the shortest possible multi-byte
sequence which can represent the code number of the character can be
used.
The UCS code values 0xd800-0xdfff (UTF-16 surrogates) as well as 0xfffe
and 0xffff (UCS non-characters) should not appear in conforming UTF-8
streams.
</c>
<hr>
<p>
This is for the compressed bootfloppy I wrote.
<p>
config.sys:
<c>
switches=/f
device=himem.sys /testmem:off
device=ramdrive.sys 16384 512 /e
</c>
<p>
autoexec.bat:
<c>
@echo off
echo,
echo,Ambrus bootfloppy
echo,Loading files from floppy, please wait...
set dircmd=/p/a/ogn
set prompt=$P$G
c:
ctty nul
for %%a in (d e f g h i j k l m n o p q) do %%a:
ctty con
md main
cd main
copy a:\se*.bat
if errorlevel 1 goto error
cd >> setpath.bat
call setpath.bat
set temp=%path%
copy a:\pk*.*
copy a:\s.*
copy a:\co*.com
if not exist %path%\command.com goto error
set comspec=%path%\command.com
pkunzjr s
pkunzjr f
del f.zip
echo,Ready
goto end
:error
echo,An error occurred. Make sure you have the floppy in drive a:,
echo,and that you have at least 6M of memory.
:end
</c>
<P>
setpath.bat contains "<c>set path=</c>", without newline.
<hr>
<p>
Just a collection of languages. Some of it might be worthwile to look at. Google.
<ol>
<li>
Perl-related: Perl, Perl6, Parrot,
<li>
Scheme implementations: PLT Scheme, Bigloo, Guile, MIT Scheme, Elk Scheme,
<li>
Other high-level languages, dynamically typed: GCL (common lisp), Python, Ruby, Lua, Pike, J (from JSoftware), JavaScript, Forth,
<li>
Statically typed languages: Haskell, Dylan, Sather, SML, Eiffel, OCaml,
<li>
Low level languages: C, C++, Delphi, D (from Digitalmars),
<li>
Popular languages: Java, DotNet,