1#!/usr/local/bin/perl 2 3eval 'case $# in 0) exec /usr/bin/perl -S "$0";; *) exec /usr/bin/perl -S "$0" "$@";; esac' 4 if 0; 5 6$VERSION = '1.3.4'; 7 8######################################################################## 9# MAIN LOOP 10 11# kludge to make this easier (?) for package maintainers 12# (sorry guys, i wrote this years before i had the remotest clue as to 13# what the hell i was doing) 14use FindBin qw($Bin); 15$HELPFILE = "/usr/local/share/cadubi/help.txt"; 16 17# other stuff 18$DEBUG = 0; 19$CADUBI_VERSION = $VERSION; 20use Term::ReadKey; 21use lib "$Bin/../lib"; 22 23# global variables 24$ESC = "\x1b"; # our most important var 25$AUDIBLE = 1; # beep unless -m, --mute, or configured in 'cadubi' 26@pos = (1,1); # position of cursor (x,y) 27@totalspan = undef; # width & height of console (x,y) 28@workspan = undef; # same as $totalspace, but y-1 29$charmap = undef; # a 3D array: 30 # [col] [row] [(0 => char to paint with 31 # 1 => bg color 32 # 2 => fg color 33 # 3 => bold 34 # 4 => inverse 35 # 5 => blink 36 # 6 => special char command 37 # )] 38@charmode = ('x',0,0,0,0,0,''); 39$status_changed = 1; # used with &status so we don't constantly redraw. 40$current_filename = undef; # name of file we're working with 41$cadubi_done = 0; # main loop var 42 43# runtime statements 44&initKeys(); # setup %controlkeys and %keymap 45&initANSI(); # setup %ansi_mode 46&setspan(); # setup span of terminal (default 24x80) 47&get_args; # read in command line parameters 48&clear; # clear screen 49&debug_open(); # open debug file 50ReadMode raw; # set terminal getchar mode 51 52if ($current_filename) { 53 # file has been specified via command line, open it 54 &user_readfile($current_filename); 55} else { 56 # draw default status bar 57 &status(); 58} 59 60do { 61 &status if &HandleKeystroke(ReadKey(0)); # handle the key 62} until ($cadubi_done); 63 64&clear; # clear screen 65&cleanup; # cleanup code 66 67sub cleanup { 68 ReadMode restore; # restore previous terminal getchar mode 69 &debug_close(); # close debug file 70 print $ESC.'[0m'; # return to normal ansi mode if anything has messed up 71} 72 73######################################################################## 74# ANSI MODES 75sub initANSI { 76 %ansi_mode = ( 'escape' => "\x1b", 77 'normal' => 0, 78 'bold' => 1, 79 'blink' => 5, 80 'inverse ' => 7, 81 'invisible' => 8, 82 'fg_black' => 30, 83 'fg_red' => 31, 84 'fg_green' => 32, 85 'fg_yellow' => 33, 86 'fg_blue' => 34, 87 'fg_magenta' => 35, 88 'fg_cyan' => 36, 89 'fg_white' => 37, 90 'bg_black' => 40, 91 'bg_red' => 41, 92 'bg_green' => 42, 93 'bg_yellow' => 43, 94 'bg_blue' => 44, 95 'bg_magenta' => 45, 96 'bg_cyan' => 46, 97 'bg_white' => 47 ); 98 99 # color codes is used strictly for interface purposes 100 %color_codes = qw( N normal 0 normal 101 W white 1 white 102 R red 2 red 103 G green 3 green 104 Y yellow 4 yellow 105 B blue 5 blue 106 M magenta 6 magenta 107 C cyan 7 cyan 108 K black 8 black 109 ); 110} 111 112 113 114######################################################################## 115# CONSOLE ROUTINES 116 117sub curs_move { 118 # accepts coordinates ((x,y) or (column, row)) 119 if (($_[0] >= 1) && ($_[0] <= $totalspan[0]) && ($_[1] >= 1) && ($_[1] <= $totalspan[1])) { 120 print $ESC.'['.$_[1].';'.$_[0].'H'; 121 @pos = ($_[0], $_[1]); 122 } else { 123 #&debug('&curs_move out of range: ('.$_[0].','.$_[1].')'); 124 #&debug(' >> @totalspan = ('.$totalspan[0].','.$totalspan[1].')'); 125 #&debug(' >> @workspan = ('.$workspan[0].','.$workspan[1].')'); 126 #&debug(' >> @pos = ('.$pos[0].','.$pos[1].')'); 127 return 0; 128 } 129 1; 130} 131 132sub curs_move_up { 133 if ($pos[1] > 1) { 134 print $ESC.'[1A'; 135 $pos[1]--; 136 } else { 137 &beep; 138 return 0; 139 } 140 1; 141} 142sub curs_move_dn { 143 if ($pos[1] < $workspan[1]) { 144 print $ESC.'[1B'; 145 $pos[1]++; 146 } else { 147 &beep; 148 return 0; 149 } 150 1; 151} 152sub curs_move_rt { 153 if ($pos[0] < $workspan[0]) { 154 print $ESC.'[1C'; 155 $pos[0]++; 156 } else { 157 &beep; 158 return 0; 159 } 160 1; 161} 162sub curs_move_lt { 163 if ($pos[0] > 1) { 164 print $ESC.'[1D'; 165 $pos[0]--; 166 } else { 167 &beep; 168 return 0; 169 } 170 1; 171} 172 173sub clear { 174 print $ESC.'[2J'; 175 &curs_move(1,1); 176} 177 178# set the size of our workspace 179sub setspan { 180 if (@_) { 181 @totalspan = ($_[0],$_[1]); 182 @workspan = ($_[0],$_[1]-1); 183 &debug("\&setspan (specified): $_[0], $_[1]"); 184 } elsif (GetTerminalSize) { #Term::ReadKey 185 my ($w, $h, @x) = GetTerminalSize; #Term::ReadKey 186 @totalspan = ($w,$h); 187 @workspan = ($w,$h-1); 188 &debug("\&setspan (using Term::ReadKey): $w, $h"); 189 } else { # we must assume, even though it makes an ass of u and me 190 @totalspan = (80,24); 191 @workspan = (80,23); 192 &debug("\&setspan (assumed): 80, 24"); 193 } 194} 195 196 197# our status bar 198# if no parameters, erases if status has changed 199# if string is first argument, fills entire status bar with string 200# if string begins with '>', only replace 'CADUBI v1.x' in status bar with string 201# if second argument is true, leave the cursor at the end of the status text... 202# (good for prompts, see &user_writefile(). 203sub status { 204 my $msg = shift; 205 my $leave_cursor = shift; 206 my $out = undef; 207 if ($msg && (substr($msg,0,1) ne '>')) { 208 $out = ''.$ESC.'[0m'.$ESC.'[7m '. 209 pack('A'.($totalspan[0]-1), $msg).$ESC.'[0m'; 210 $status_changed = 1; 211 } else { 212 if ($status_changed || $msg) { 213 my $out_vers; 214 if ($msg) { 215 $out_vers = pack('A34',' '.substr($msg,1).' '); 216 $status_changed = 1; 217 } else { 218 $out_vers = pack('A34',' cadubi '.$CADUBI_VERSION.' '); 219 $status_changed = 0; 220 } 221 my $out_help = ' Type ^H for Help '; 222 my $out_char = ' Pen: '.&printchar(@charmode).' '; 223 $out = $ESC.'[0m'.$ESC.'[7m'.$out_vers. 224 $ESC.'[0m'.$out_char.$ESC.'[7m'. 225 (' ' x ($totalspan[0]- 226 length($out_vers)- 227 length($out_help)- 228 8) 229 ). 230 $out_help.$ESC.'[0m'; 231 } 232 } 233 my @oldpos = @pos; 234 &curs_move(1,$totalspan[1]); 235 print $out; 236 &curs_move(@oldpos) unless $leave_cursor; 237} 238 239# this promps the user with the first argument given, and waits for a string. 240# pass it a maximum string length for second argument. if no second argument, 241# user's allowed to fill the width between prompt & right edge with text. 242# a third argument is treated as a default answer, already filled in the field 243sub get_user_string { 244 my $msg = shift; 245 my $max = shift; 246 my $out = shift; 247 my @oldpos = @pos; 248 my $char = undef; 249 &curs_move(1,$totalspan[1]); 250 # notice we don't print a normal mode sequence (\x1b[0m) because we 251 # want to keep writing in inverse. we print a normal mode right before 252 # we do a return. 253 print $ESC.'[7m '.pack('A'.($workspan[0]-2),$msg)." "; 254 $max = $workspan[0]-length($msg)-3 unless $max; 255 &curs_move(length($msg)+3,$totalspan[1]); 256 print $out; 257 while (not $char =~ /[\n\x1b]/) { 258 $char = ReadKey(0); 259 # no chars < space 260 if ($char =~ /[\x00-\x1f]/) { 261 &beep; 262 } 263 # delete, but don't delete past starting x position 264 elsif (ord($char) == $keymap{'del'}) { 265 if ($out) { 266 # print a backspace...the same as move left one char, print 267 # a space (which moves the cursor right one char), then move 268 # back one char again 269 print $ESC.'[1D '.$ESC.'[1D'; 270 $out = substr($out,0,-1); 271 } else { 272 &beep; 273 } 274 } 275 else { 276 if (length($out) >= $max) { 277 &beep; 278 } else { 279 $out .= $char; 280 print $char; 281 } 282 } 283 } 284 &curs_move(@oldpos); 285 print $ESC.'[0m'; 286 # refresh status bar 287 $status_changed = 1; 288 &status(); 289 # user hit enter 290 return $out if ($char eq "\n"); 291 # user hit cancel 292 return undef; 293} 294 295 296######################################################################## 297# SUPPORT SUBROUTINES 298 299sub beep { 300 print "\x07" if $AUDIBLE; 301} 302 303sub refresh { 304 my @oldpos = @pos; 305 &clear(); 306 my ($x, $y); 307 for ($y=1; $y<=$workspan[1]; $y++) { 308 for ($x=1; $x<=$workspan[0]; $x++) { 309 if ($charmap->[$x][$y]) { 310 print &printchar(@{$charmap->[$x][$y]}); 311 } else { 312 print ' '; 313 } 314 } 315 &curs_move($x--,$y); 316 } 317 &curs_move(@oldpos); 318} 319 320sub printchar { # returns a string with the current ANSI mode and the character 321 my $out = undef; 322 my @desc = @_; 323 my $char = shift(@desc); #key to draw 324 pop(@desc); #remove special char command 325 $out.= $ESC.'['; #print properties 326 foreach (@desc) { 327 $out.= $_.';' if ($_); 328 } 329 $out = substr($out,0,-1).'m'; 330 $out = undef if ($out eq $ESC.'m'); 331 if (defined($char)) { #print char or space if there's no char 332 $out.= $char; 333 } else { 334 $out.= ' '; 335 } 336 $out.= $ESC.'[0m'; 337 return $out; 338} 339 340sub paintchar { # prints the char on screen and saves it to $charmap 341 $charmap->[$pos[0]][$pos[1]] = [@charmode]; 342 print &printchar(@charmode); 343 &curs_move(@pos); #print moves to the right on us, without asking. the nerve! 344} 345 346sub erasechar { # saves blank char to $charmap, prints 347 $charmap->[$pos[0]][$pos[1]] = undef; 348 print &printchar({$charmap->[$pos[0]][$pos[1]]}); 349 &curs_move(@pos); #print moves to the right on us, without asking. the nerve! 350} 351 352sub usage { 353 if ($_[0]) { 354 print $_[0]."\n"; 355 } 356print <<END_USAGE; 357 358usage: $0 [OPTIONS] [FILE] 359 360Available options: 361 -h, --help what you're looking at now 362 -m, --mute turn off beeping 363 -s, --size [W] [H] sets the size of the console for use with 364 cadubi, where W is number of columns and H 365 is number of rows. 366 -v, --version show cadubi version 367END_USAGE 368} 369 370sub version { 371print <<END_VERSION; 372cadubi (Creative ASCII Drawing Utility By Ian) $CADUBI_VERSION 373Copyright (c) 2015 Ian Langworth 374END_VERSION 375} 376 377sub get_args { 378 my @ARGS = @ARGV; 379 my ($option, $param1, $param2); 380 my $got_filename = 0; 381 while (@ARGS) { 382 &debug('Processing argument: '.$option); 383 $option = shift(@ARGS); 384 if (($option eq '-h') || ($option eq '--help')) { 385 &debug('>> printed &usage'); 386 &usage(); 387 &cleanup; 388 exit(1); 389 } 390 elsif (($option eq '-v') || ($option eq '--version')) { 391 &debug('>> printed &version'); 392 &version; 393 &cleanup; 394 exit(1); 395 } 396 elsif (($option eq '-m') || ($option eq '--mute')) { 397 &debug('>> disabled audio'); 398 $AUDIBLE = 0; 399 } 400 elsif (($option eq '-s') || ($option eq '--size')) { 401 ($param1, $param2) = (shift(@ARGS), shift(@ARGS)); 402 &debug('>> grabbing setspan variables, raw:'); 403 &debug('>> $param1 = '.$param1); 404 &debug('>> $param2 = '.$param2); 405 $param1 = 80 unless $param1; 406 $param2 = 24 unless $param2; 407 &debug('>> processed setspan vars:'); 408 &debug('>> $param1 = '.$param1); 409 &debug('>> $param2 = '.$param2); 410 &setspan($param1, $param2); 411 } 412 elsif ($option =~ /^-/) { 413 &usage('Unknown option: '.$option); 414 &cleanup; 415 exit(1); 416 } 417 elsif (not $got_filename) { 418 $got_filename = 1; 419 $current_filename = $option; 420 } 421 else { 422 &usage('Unknown argument: '.$option); 423 &cleanup; 424 exit(1); 425 } 426 } 427} 428 429######################################################################## 430# DEBUGGING 431 432sub debug { 433 print DEBUGFH $_[0]."\n" if ($DEBUG && DEBUGFH); 434} 435sub debug_open { 436 open(DEBUGFH, '>cadubi_debug.txt') if $DEBUG; 437 &debug('Debug file opened '.(localtime)); 438} 439sub debug_close { 440 &debug('Debug file closed '.(localtime)); 441 close(DEBUGFH) if DEBUGFH; 442} 443 444 445######################################################################## 446# KEY HANDLING 447sub initKeys { 448 %controlkeys = GetControlChars; #Term::ReadKey 449 # DISCARD 450 # DSUSPEND 451 # EOF 452 # EOL 453 # EOL2 454 # ERASE 455 # ERASEWORD 456 # INTERRUPT 457 # KILL 458 # MIN 459 # QUIT 460 # QUOTENEXT 461 # REPRINT 462 # START 463 # STATUS 464 # STOP 465 # SUSPEND 466 # SWITCH 467 # TIME 468 469 %keymap = ( '^a' => 1, 470 '^b' => 2, 471 '^d' => 4, 472 '^e' => 5, 473 '^f' => 6, 474 '^g' => 7, #bell 475 '^h' => 8, 476 '^i' => 9, 477 '^k' => 11, 478 '^o' => 15, 479 '^p' => 16, 480 '^r' => 18, 481 '^t' => 20, 482 '^u' => 21, 483 '^v' => 22, 484 '^w' => 23, 485 '^x' => 24, 486 '^y' => 25, 487 'esc' => 27, 488 'del' => 127, 489 'up' => 30, 490 'dn' => 31, 491 'lt' => 28, 492 'rt' => 29, 493 'space' => 32, 494 'cr' => 13, 495 'lf' => 10); 496} 497 498 499sub HandleKeystroke { 500 my $key = shift; 501 502 # ansi escape chars, like arrow keys 503 if ($key eq $ESC) { 504 if (ReadKey(0) eq '[') { 505 my $newkey = ReadKey(0); 506 if ($newkey eq 'A') {&curs_move_up; return 1;} 507 elsif ($newkey eq 'B') {&curs_move_dn; return 1;} 508 elsif ($newkey eq 'C') {&curs_move_rt; return 1;} 509 elsif ($newkey eq 'D') {&curs_move_lt; return 1;} 510 else { 511 &status("Unknown escape sequence: '".$newkey."'"); 512 return 0; 513 } 514 } else { 515 &status("Unknown escape sequence."); 516 return 0; 517 } 518 } 519 520 # moving around keys (ijkl, IJKL, arrow keys) 521 if ($key eq 'i') {&curs_move_up; return 1;} 522 if ($key eq 'j') {&curs_move_lt; return 1;} 523 if ($key eq 'k') {&curs_move_dn; return 1;} 524 if ($key eq 'l') {&curs_move_rt; return 1;} 525 if ($key eq 'I') {for (1 .. 5) {&curs_move_up}; return 1;} 526 if ($key eq 'J') {for (1 .. 5) {&curs_move_lt}; return 1;} 527 if ($key eq 'K') {for (1 .. 5) {&curs_move_dn}; return 1;} 528 if ($key eq 'L') {for (1 .. 5) {&curs_move_rt}; return 1;} 529 530 # exit 531 if (ord($key) == $keymap{'^x'}) { 532 $cadubi_done = 1; 533 return 1; 534 } 535 536 # carrage return 537 if ($key eq "\n") { 538 # if we're at the bottom of the workspace, don't return 539 if ($pos[1] >= $workspan[1]) { 540 &curs_move(1, $pos[1]); 541 } else { 542 &curs_move(1, $pos[1]); 543 &curs_move_dn; 544 } 545 return 1; 546 } 547 548 # paint 549 if ($key eq ' ') { 550 &paintchar; 551 &curs_move_rt if ($pos[0] < $workspan[0]); 552 return 1; 553 } 554 555 # erase 556 if ((ord($key) == $keymap{'del'}) || ($key eq '`')) { 557 &curs_move_lt; 558 &erasechar; 559 return 1; 560 } 561 562 # text mode 563 if ($key eq 't') { 564 my $char = undef; 565 my $oldchar = $charmode[0]; 566 my $startingx = $pos[0]; 567 &status('Text mode (escape key exits)'); 568 while ($char ne "\x1b") { 569 $char = ReadKey(0); 570 # if user hit return, move down a line to starting point 571 if ($char eq "\n") { 572 # if we're at the bottom of the workspace, don't return 573 if ($pos[1] >= $workspan[1]) { 574 &beep; 575 } else { 576 &curs_move($startingx, $pos[1]); 577 &curs_move_dn; 578 } 579 } 580 # no chars < space 581 elsif ($char =~ /[\x00-\x1a\x1c-\x1f]/) { 582 &beep; 583 } 584 # delete, but don't delete past starting x position 585 elsif (ord($char) == $keymap{'del'}) { 586 if ($pos[0] > $startingx) { 587 &curs_move_lt; 588 } else { 589 &beep; 590 } 591 &erasechar; 592 } 593 elsif ($char ne $ESC) { 594 $charmode[0] = $char; 595 &paintchar(@charmode); 596 &curs_move_rt; 597 } 598 } 599 $charmode[0] = $oldchar; 600 return 1; 601 } 602 603 # paint modes 604 if ($key eq 'p') { # pen character 605 &status('Set pen character:'); 606 my $newkey = ReadKey(0); 607 if ($newkey =~ /[\x00-\x1f\x7f]/) { 608 &beep; 609 &status('Unusable pen selection'); 610 } else { 611 $charmode[0] = $newkey; 612 &status(">Pen char now: '".$newkey."'"); 613 } 614 return 0; 615 } 616 if ($key eq 'g') { # bold 617 $charmode[3] = ($charmode[3]) ? 0 : 1; 618 &status(">Bold enabled") if $charmode[3]; 619 &status(">Bold disabled") unless $charmode[3]; 620 return 0; 621 } 622 if ($key eq 'v') { # inverse 623 $charmode[4] = ($charmode[4]) ? 0 : 7; 624 &status(">Inverse enabled") if $charmode[4]; 625 &status(">Inverse disabled") unless $charmode[4]; 626 return 0; 627 } 628 if ($key eq 'W') { # blink (that's W for "why?") 629 $charmode[5] = ($charmode[5]) ? 0 : 5; 630 &status(">Blink enabled") if $charmode[5]; 631 &status(">Blink disabled") unless $charmode[5]; 632 return 0; 633 } 634 if ($key eq 'f') { 635 &status('Set pen foreground color:'); 636 my $newkey = ReadKey(0); 637 if ($newkey =~ /[nN0]/) {$charmode[2] = $ansi_mode{'normal'}} 638 elsif ($newkey =~ /[wW1]/) {$charmode[2] = $ansi_mode{'fg_white'}} 639 elsif ($newkey =~ /[rR2]/) {$charmode[2] = $ansi_mode{'fg_red'}} 640 elsif ($newkey =~ /[gG3]/) {$charmode[2] = $ansi_mode{'fg_green'}} 641 elsif ($newkey =~ /[yY4]/) {$charmode[2] = $ansi_mode{'fg_yellow'}} 642 elsif ($newkey =~ /[bB5]/) {$charmode[2] = $ansi_mode{'fg_blue'}} 643 elsif ($newkey =~ /[mM6]/) {$charmode[2] = $ansi_mode{'fg_magenta'}} 644 elsif ($newkey =~ /[cC7]/) {$charmode[2] = $ansi_mode{'fg_cyan'}} 645 elsif ($newkey =~ /[kK8]/) {$charmode[2] = $ansi_mode{'fg_black'}} 646 if ($newkey =~ /[NWRGYBMCK012345678]/i) { 647 &status(">Foreground: ".$color_codes{uc($newkey)}); 648 } else { 649 &beep; 650 &status("Unknown color selection: '".$newkey."'") 651 } 652 return 0; 653 } 654 if ($key eq 'b') { 655 &status('Set pen background color:'); 656 my $newkey = ReadKey(0); 657 if ($newkey =~ /[nN0]/) {$charmode[1] = $ansi_mode{'normal'}} 658 elsif ($newkey =~ /[wW1]/) {$charmode[1] = $ansi_mode{'bg_white'}} 659 elsif ($newkey =~ /[rR2]/) {$charmode[1] = $ansi_mode{'bg_red'}} 660 elsif ($newkey =~ /[gG3]/) {$charmode[1] = $ansi_mode{'bg_green'}} 661 elsif ($newkey =~ /[yY4]/) {$charmode[1] = $ansi_mode{'bg_yellow'}} 662 elsif ($newkey =~ /[bB5]/) {$charmode[1] = $ansi_mode{'bg_blue'}} 663 elsif ($newkey =~ /[mM6]/) {$charmode[1] = $ansi_mode{'bg_magenta'}} 664 elsif ($newkey =~ /[cC7]/) {$charmode[1] = $ansi_mode{'bg_cyan'}} 665 elsif ($newkey =~ /[kK8]/) {$charmode[1] = $ansi_mode{'bg_black'}} 666 if ($newkey =~ /[NWRGYBMCK012345678]/i) { 667 &status(">Background: ".$color_codes{uc($newkey)}); 668 } else { 669 &beep; 670 &status("Unknown color selection: '".$newkey."'") 671 } 672 return 0; 673 } 674 675 # file i/o 676 if (ord($key) == $keymap{'^r'}) { 677 return &user_readfile; 678 } 679 if (ord($key) == $keymap{'^o'}) { 680 return &user_writefile; 681 } 682 683 # refresh 684 if (ord($key) == $keymap{'^w'}) { #refresh 685 &refresh(); 686 &status('Workspace refreshed'); 687 return 1; 688 } 689 690 # help 691 if (ord($key) == $keymap{'^h'}) { #Help 692 if (-e $HELPFILE) { 693 my $oldmap = $charmap; 694 my @oldpos = @pos; 695 &readfile($HELPFILE); 696 &status('Press a key to continue...', 1); 697 my $temp = ReadKey(0); 698 $charmap = $oldmap; 699 $oldmap = undef; 700 &curs_move(@oldpos); 701 &refresh; 702 &status; 703 } else { 704 &beep; 705 &status("$HELPFILE not available"); 706 } 707 return 0; 708 } 709 710 # other 711 if (ord($key) == $keymap{'^t'}) { # TEST 712 &beep; 713 return 0; 714 } 715 716 # no cigar! 717 &beep; 718 return 0; 719} 720 721 722######################################################################## 723# FILE SUBROUTINES 724 725sub readfile { 726 # pass it a filename as first argument, reads a file into 727 # the $charmap array 728 my $filepath = shift; 729 my @oldpos = @pos; 730 my @oldcharmode = @charmode; 731 my ($char, $buf, $command, @nums); 732 my $x = 1; 733 my $y = 1; 734 open(IN, '<'.$filepath); 735 unless (IN) { 736 return 0; 737 } 738 $charmap = undef; 739 &debug('&readfile parsing:'); 740 PARSE: while (not eof(IN)) { 741 # MAGICAL ANSI ESCAPE SEQUENCE PARSER 742 # This parses almost all the escape sequences I could get documentation on. 743 # Even though, other than the mode change sequences, they will hardly ever 744 # appear in an ascii art file, it's good to be prepared. 745 # 746 # I've parsed all EXCEPT this format: 747 # ESC[#;"string";#p 748 # 749 $char = ReadKey(0, IN); 750 &debug('>> "'.$char.'"'); 751 # exit if we've found more lines than max 752 if ($y > $workspan[1]) { 753 &debug('>> '.$y.' is greater than '.$workspan[1]); 754 last PARSE; 755 } 756 # if we've hit a newline in the file 757 if ($char eq "\n") { 758 &debug('>> newline'); 759 $y++; 760 $x = 1; 761 } 762 # if we've found more chars on the line than max 763 elsif ($x > $workspan[0]) { 764 &debug('>> maximum chars hit'); 765 $y++; 766 $x = 1; 767 # read until newline 768 do { 769 $char = ReadKey(0, IN); 770 } until ($char eq "\n"); 771 } 772 elsif ($char eq $ESC) { # escape sequence 773 $char = ReadKey(0, IN); 774 if ($char eq '[') { 775 $char = ReadKey(0, IN); 776 # These escape sequence types don't need support 777 if ($char =~ /[usK]/) { 778 # example: ESC[u 779 } 780 # Double-char unsupported escape sequences 781 elsif ($char =~ /[2]/) { 782 # example: ESC[2J 783 $char = ReadKey(0, IN); 784 } 785 # Multi-numbered wierd with digits 786 elsif ($char =~ /[\=\?]/) { 787 # example: ESC[=21;29h 788 do { 789 $char = ReadKey(0, IN); 790 } until (not ($char =~ /[\d\;]/)); 791 } 792 # Eeek! Keyboard reassignment! 793 elsif ($char eq '"') { 794 # example: ESC["string"p 795 $char = ReadKey(0, IN); # get first " 796 do { 797 $char = ReadKey(0, IN); # get string" 798 } until ($char eq '"'); 799 $char = ReadKey(0, IN); # get final p 800 } 801 # Oh great. We've hit digits. 802 elsif ($char =~ /\d/) { 803 # example: ESC[31;7m 804 $buf = $char; 805 # read until we hit a non-digit or non-; char 806 do { 807 $char = ReadKey(0, IN); 808 $buf .= $char; 809 } until (not ($char =~ /[\d\;]/)); 810 # $command is the letter following the number series 811 $command = substr($buf,-1,1); 812 # $buf ends up being a ; delimeted list of numbers 813 $buf = substr($buf,0,-1); 814 # @nums is a list the numbers 815 @nums = split(/\;/, $buf); 816 &debug(">> Sequence:"); 817 &debug(">> -> \$command = $command"); 818 &debug(">> -> \$buf = $bug"); 819 &debug(">> -> \@nums = "); 820 foreach (@nums) {&debug(">> -> !- $_")} 821 # make sure these numbers are a mode change 822 if ($command eq 'm') { 823 # did we get a set-to-normal mode? (ESC[0m]) 824 if (grep(/0/, @nums)) { 825 @charmode = (' ',0,0,0,0,0,''); 826 # no, we got a regular mode change 827 } else { 828 foreach (@nums) { 829 $charmode[1] = $_ if (($_ >= 40) && ($_ <= 47)); 830 $charmode[2] = $_ if (($_ >= 30) && ($_ <= 37)); 831 $charmode[3] = $_ if ($_ == 1); 832 $charmode[4] = $_ if ($_ == 7); 833 $charmode[5] = $_ if ($_ == 5); 834 } 835 } 836 } 837 } 838 } 839 } 840 else { 841 $charmode[0] = $char; 842 $charmap->[$x][$y] = [@charmode]; 843 $x++; 844 } 845 } 846 close(IN); 847 &refresh; 848 &curs_move(@oldpos); 849 @charmode = @oldcharmode; 850 return 1; 851} 852 853sub writefile { 854 # pass it a filename, writes the entire $charmap to file, readable by 855 # cat, more, less, whatever. 856 my $filepath = shift; 857 my $out = undef; 858 my ($thisline, $thischar); 859 my $inital_space = 1; 860 my ($x, $y, $i, $d, $max, @newmode, @oldmode, @outlines); 861 for ($y=1; $y<=$workspan[1]; $y++) { 862 # fresh new line to work with 863 @oldmode = qw(99 99 99 99 99 99); 864 $thisline = undef; 865 for ($x=1; $x<=$workspan[0]; $x++) { 866 # set @newmode to the mode of the char we're about to write 867 @newmode = @{$charmap->[$x][$y]}; 868 # is our new char mode different from our old one? 869 $d = 0; 870 $max = ($#oldmode > $#newmode) ? $#oldmode : $#newmode; 871 for($i=1; $i<=$max; $i++) { 872 # notice $i starts at one so we skip the character 873 $d++ if ($oldmode[$i] != $newmode[$i]); 874 } 875 # if our new char mode is indeed different, add a normal 876 # mode sequence and our new mode and char. else, just add 877 # the char. 878 if ($d) { 879 $thisline .= $ESC.'[0m'.substr(&printchar(@{$charmap->[$x][$y]}),0,-4); 880 } else { 881 # make sure it's not just a space 882 if ($charmap->[$x][$y]) { 883 $thisline .= $newmode[0]; 884 } else { 885 $thisline .= ' '; 886 } 887 } 888 # now make @newmode our @oldmode 889 @oldmode = @newmode; 890 } 891 # kill trailing whitespace on single lines 892 $thisline =~ s/(\s+)$//; 893 # make sure each line ends with a normal mode sequence 894 push(@outlines, $thisline.$ESC."[0m\n"); 895 } 896 open(OUT, ">$filepath") or return 0; 897 # kill trailing lines 898 $x = 0; 899 for ($i=$#outlines; $i>=0; $i--) { 900 unless (($outlines[$i] eq $ESC.'[0m'.$ESC."[0m\n") && (not $x)) { 901 $out = $outlines[$i].$out; 902 $x++; 903 } 904 } 905 print OUT $out; 906 close(OUT); 907 if ($out) { 908 return length($out); 909 } else { 910 # if no bytes were written, we'll return 'zero' 911 return 'zero'; 912 } 913} 914 915sub user_writefile { 916 my ($filename, $reply, $bytes_written); 917 my $file_exists = 1; 918 my @oldpos = @pos; 919 while ($file_exists) { 920 $filename = &get_user_string('File name to write:', undef, $current_filename); 921 # user canceled 922 return 1 unless defined($filename); 923 # check if file exists 924 if (-e $filename) { 925 &status('File already exists. Overwrite? (y/n)',1); 926 $reply = uc(ReadKey(0)); 927 $file_exists = 0 if ($reply eq 'Y'); 928 return 1 if ($reply eq $ESC); 929 &status(); 930 } else { 931 $file_exists = 0; 932 } 933 } 934 $current_filename = $filename; 935 $bytes_written = &writefile($filename); 936 if ($bytes_written) { 937 &status("Wrote '".$filename."' (".$bytes_written.' bytes)'); 938 } else { 939 &beep; 940 &status("Couldn't write file '".$filename."': ".$!); 941 } 942 &curs_move(@oldpos); 943 return 0; 944} 945 946sub user_readfile { 947 my $filename; 948 if ($_[0]) { 949 $filename = $_[0]; 950 } else { 951 $filename = &get_user_string('File name to read:', undef, $current_filename); 952 } 953 # user canceled 954 return 1 unless defined($filename); 955 if (-e $filename) { 956 if (&readfile($filename)) { 957 &status("Read file '".$filename."'"); 958 } else { 959 &status("Couldn't read file '".$filename."': ".$!); 960 } 961 } else { 962 &status("File '".$filename."' doesn't exist."); 963 } 964 return 0; 965} 966 967######################################################################## 968# EOF 9691; 970 971