pkg://Xforms4Perl-0.8.4-2.src.rpm:140916/Xforms4Perl-0.8.4-2.tgz
info downloads
Xforms4Perl-0.8.4/ 40775 0 0 0 6506160004 11671 5 ustar root root Xforms4Perl-0.8.4/DEMOS/ 40775 0 0 0 6443252517 12553 5 ustar root root Xforms4Perl-0.8.4/DEMOS/ProcCntl.pl 100775 0 0 44030 6373564123 14756 0 ustar root root #!/usr/bin/perl
use X11::Xforms;
#-*-perl-*-
# Autogenerated by fd2pl from fdesign file ProcCntl.fd
#
#
# This builds a browser that contains the system process tree. It relies
# upon the Linux 'ps -f' command for the heirarchical view. However, in
# the demos directory is another script named psf that, with a bit of
# tweaking, should be able to emulate that command on other systems.
# Therefore, you can replace the 'ps -xafw' command used here with 'psf -xaw'
# and get the same results.
#
# Unless you have a /proc file system, the details menu will not work
#
fl_initialize('ProcCntl');
$ProcCntl = undef;
@Processes = undef;
$SelectedProcs = undef;
$Browser = undef;
$Menu = undef;
$details_showing = 0;
$details_proc = 0;
$autoupdate = 1;
$menuautoupdate = 1;
$ProcDtls = undef;
$stackBase = undef;
$stackPtr = undef;
$codeStart = undef;
$codeEnd = undef;
$instPtr = undef;
$mappedMemory = undef;
$sigPnMask = undef;
$sigBlMask = undef;
$sigIgMask = undef;
$sigCtMask = undef;
$minFaultsSelf = undef;
$VMsize = undef;
$residentSet = undef;
$minFaultsTree = undef;
$majFaultsTree = undef;
$majFaultsSelf = undef;
$kernCPUSelf = undef;
$kernCPUTree = undef;
$userCPUTree = undef;
$userCPUSelf = undef;
$procGrp = undef;
$pid = undef;
$ppid = undef;
$tty = undef;
$state = undef;
$session = undef;
$priority = undef;
$ttyProcGrp = undef;
$executable = undef;
%state_string = (
R => "Running",
S => "Suspended",
D => "Sleep/Swap",
Z => "Zombie",
T => "Traced/Stopped"
);
create_the_forms();
PopulateBrowser();
($icon_pixmap, $w, $h, $mask, $hx, $hy) = fl_read_pixmapfile(fl_default_window(),"crab45.xpm",0);
fl_set_form_icon($ProcCntl,$icon_pixmap,1);
fl_show_form($ProcCntl, FL_PLACE_FREE, FL_FULLBORDER, "Processes");
fl_add_timeout(10000, "AutoUpdate", 0);
fl_do_forms();
exit 0;
sub PopulateBrowser {
$top = fl_get_browser_topline($Browser);
$newtop = -1;
if (!defined($topproc = $Processes[$top-1])) {
$topproc = 0;
}
@Processes = ();
@SelectedProcs = ();
fl_freeze_form($ProcCntl);
fl_clear_browser($Browser);
open (PROCS, 'ps -xafw |');
$linenum = 0;
while ($procline = <PROCS>) {
if ($procline =~ /\s*(\d\d*).*:\d\d (.*)/) {
$linenum++;
$procnum = $1;
$proctext = $2;
push (@Processes,$procnum);
$newtop = $linenum if ($procnum == $topproc);
fl_add_browser_line($Browser,$proctext);
}
}
if ($newtop == -1) {
if ($top <= $linenum) {
$newtop = $top;
} else {
$newtop = $linenum;
}
}
fl_set_browser_topline($Browser, $newtop);
fl_set_menu_item_mode($Menu, 2, FL_PUP_GRAY);
fl_unfreeze_form($ProcCntl);
close PROCS;
}
sub SelectBrows {
my $selline = fl_get_browser($Browser);
my $process = $Processes[abs($selline)-1];
if ($selline > 0) {
push (@SelectedProcs, $process);
show_details($process) if ($details_showing);
} else {
for ($i = 0; $i <= $#SelectedProcs && $SelectedProcs[$i] != $process; $i++) {}
splice (@SelectedProcs, $i, 1) if ($i <= $#SelectedProcs);
}
if (@SelectedProcs) {
fl_set_menu_item_mode($Menu, 1, FL_PUP_NONE);
fl_set_menu_item_mode($Menu, 2, FL_PUP_NONE);
$autoupdate = 0;
} else {
fl_set_menu_item_mode($Menu, 1, FL_PUP_GRAY);
fl_set_menu_item_mode($Menu, 2, FL_PUP_GRAY);
$autoupdate = $menuautoupdate;
}
}
sub AutoUpdate {
my($num, $obj) = @_;
if ($autoupdate) {
PopulateBrowser();
show_details($details_proc) if ($details_showing);
}
fl_add_timeout(10000, "AutoUpdate", 0);
}
sub HideDetails {
fl_hide_form($ProcDtls);
$details_showing = 0;
}
sub ProcMenu {
$menuitem = fl_get_menu($Menu);
if ($menuitem == 5) {
fl_finish();
exit;
} elsif ($menuitem == 4) {
$menuautoupdate = $autoupdate = !$menuautoupdate;
} elsif ($menuitem == 3) {
PopulateBrowser();
show_details($details_proc) if ($details_showing);
$autoupdate = $menuautoupdate;
} elsif ($menuitem == 1 && @SelectedProcs) {
show_details($SelectedProcs[0]);
} elsif ($menuitem == 2 && @SelectedProcs) {
kill (9, @SelectedProcs);
PopulateBrowser();
$autoupdate = $menuautoupdate;
}
}
sub show_details {
my($proc) = @_;
open(PROCDTLS,"/proc/$proc/stat");
$procdtls = <PROCDTLS>;
close PROCDTLS;
open(PROCMAPS,"/proc/$proc/maps");
@mapdtls = <PROCMAPS>;
close PROCMAPS;
open(PROCMEM,"/proc/$proc/statm");
$memdtls = <PROCMEM>;
close PROCMEM;
#
# This array is derived from the output of the get_stat function
# in the Linux kernel source 'fs/proc/array.c'
#
($pid_val,
$executable_val,
$state_i,
$ppid_val,
$procGrp_val,
$session_val,
$tty_val,
$ttyProcGrp_val,
$flags_val,
$minFaultsSelf_val,
$minFaultsTree_val,
$majFaultsSelf_val,
$majFaultsTree_val,
$userCPUSelf_val,
$kernCPUSelf_val,
$userCPUTree_val,
$kernCPUTree_val,
$priority_val,
$nice_val,
$time_to_time_out_val,
$time_to_sigalrm_val,
$start_time_val,
$VMsize_val,
$residentSet_val,
$max_res_set_size_val,
$codeStart_val,
$codeEnd_val,
$stackBase_val,
$stackPtr_val,
$instPtr_val,
$sigPnMask_val,
$sigBlMask_val,
$sigIgMask_val,
$sigCtMask_val,
$channel,
$swapSelf,
$swapTree) = split(' ',$procdtls);
$state_val = $state_string{"$state_i"};
($mem_size_val,
$mem_res_val,
$mem_share_val,
$mem_text_val,
$mem_lib_val,
$mem_data_val,
$mem_dirty_val) = split(' ',$memdtls);
fl_set_object_label($stackBase,sprintf('%#010X', $stackBase_val));
fl_set_object_label($stackPtr,sprintf('%#010X',$stackPtr_val));
fl_set_object_label($codeStart,sprintf('%#010X',$codeStart_val));
fl_set_object_label($codeEnd,sprintf('%#010X',$codeEnd_val));
fl_set_object_label($instPtr,sprintf('%#010X',$instPtr_val));
fl_set_object_label($sigPnMask,sprintf('%#010X',$sigPnMask_val));
fl_set_object_label($sigBlMask,sprintf('%#010X',$sigBlMask_val));
fl_set_object_label($sigIgMask,sprintf('%#010X',$sigIgMask_val));
fl_set_object_label($sigCtMask,sprintf('%#010X',$sigCtMask_val));
fl_set_object_label($minFaultsSelf,$minFaultsSelf_val);
fl_set_object_label($VMsize,$VMsize_val/1024);
fl_set_object_label($residentSet,$mem_res_val*4);
fl_set_object_label($minFaultsTree,$minFaultsTree_val);
fl_set_object_label($majFaultsTree,$majFaultsTree_val);
fl_set_object_label($majFaultsSelf,$majFaultsSelf_val);
fl_set_object_label($kernCPUSelf,$kernCPUSelf_val);
fl_set_object_label($kernCPUTree,$kernCPUTree_val);
fl_set_object_label($userCPUTree,$userCPUTree_val);
fl_set_object_label($userCPUSelf,$userCPUSelf_val);
fl_set_object_label($procGrp,$procGrp_val);
fl_set_object_label($pid,$pid_val);
fl_set_object_label($ppid,$ppid_val);
fl_set_object_label($tty,$tty_val);
fl_set_object_label($state,$state_val);
fl_set_object_label($session,$session_val);
fl_set_object_label($priority,$priority_val);
fl_set_object_label($ttyProcGrp,$ttyProcGrp_val);
fl_set_object_label($executable,$executable_val);
fl_freeze_form($ProcDtls) if ($details_showing);
fl_clear_browser($mappedMemory);
fl_addto_browser($mappedMemory,"\@baddress perm offset dev inode");
for ($i = 0; $i <= $#mapdtls; ++$i){
fl_addto_browser($mappedMemory,$mapdtls[$i]);
}
fl_set_browser_topline($mappedMemory, 1);
fl_show_form($ProcDtls, FL_PLACE_SIZE, FL_FULLBORDER, "Process Details");
fl_unfreeze_form($ProcDtls) if ($details_showing);
$details_showing = 1;
$details_proc = $proc;
}
sub create_form_ProcCntl {
$obj = undef;
$ProcCntl = fl_bgn_form(FL_NO_BOX, 300, 260);
$obj = fl_add_box(FL_FLAT_BOX, 0, 0, 300, 260, "");
$obj = $Browser = fl_add_browser(FL_MULTI_BROWSER, 0, 22, 300, 237, "");
fl_set_object_gravity($obj, FL_NorthWest, FL_SouthEast);
fl_set_object_lstyle($obj, FL_BOLD_STYLE);
fl_set_object_callback($obj, "SelectBrows", 0);
fl_set_browser_fontsize($obj, FL_NORMAL_SIZE);
fl_set_browser_fontstyle($obj, FL_FIXED_STYLE);
fl_set_object_resize($obj, FL_RESIZE_X);
$obj = $Menu = fl_add_menu(FL_PULLDOWN_MENU, 2, 5, 60, 15, "Process");
fl_set_object_resize($obj,FL_RESIZE_NONE);
fl_set_object_gravity($obj, FL_NorthWest, FL_NorthWest);
fl_set_object_shortcut($obj, "P", 1);
fl_set_object_boxtype($obj, FL_FLAT_BOX);
fl_set_object_lsize($obj, FL_NORMAL_SIZE);
fl_set_object_lstyle($obj, FL_BOLD_STYLE);
fl_setpup_fontstyle(FL_BOLD_STYLE);
fl_set_menu($obj, "Details|Kill%l|Refresh Now|Auto Refresh%l|Exit");
fl_set_menu_item_mode($obj, 1, FL_PUP_GRAY);
fl_set_menu_item_mode($obj, 2, FL_PUP_GRAY);
fl_set_menu_item_mode($obj, 4, FL_PUP_CHECK | FL_PUP_TOGGLE);
fl_set_object_callback($obj, "ProcMenu", 0);
fl_end_form();
}
sub create_form_ProcDtls {
$obj = undef;
$ProcDtls = fl_bgn_form(FL_NO_BOX, 310, 390);
$obj = fl_add_box(FL_UP_BOX, 0, 0, 310, 390, "");
$obj = fl_add_button(FL_NORMAL_BUTTON, 5, 368,300,19,"Hide Process Details");
fl_set_object_callback($obj, "HideDetails", 0);
$obj = fl_add_labelframe(FL_ENGRAVED_FRAME, 5, 190, 300, 175, "Memory Details");
fl_set_object_lsize($obj, FL_NORMAL_SIZE);
fl_set_object_lstyle($obj, FL_BOLD_STYLE);
$obj = fl_add_text(FL_NORMAL_TEXT, 145, 210, 64, 15, "Minor Faults");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_labelframe(FL_ENGRAVED_FRAME, 254, 205, 45, 40, "Tree");
fl_set_object_lalign($obj, FL_ALIGN_TOP_RIGHT);
fl_set_object_lstyle($obj, FL_BOLD_STYLE);
$obj = fl_add_labelframe(FL_ENGRAVED_FRAME, 209, 205, 45, 40, "Self");
fl_set_object_lalign($obj, FL_ALIGN_TOP_RIGHT);
fl_set_object_lstyle($obj, FL_BOLD_STYLE);
$obj = fl_add_text(FL_NORMAL_TEXT, 145, 228, 64, 15, "Major Faults");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_labelframe(FL_ENGRAVED_FRAME, 10, 255, 130, 40, "Stack");
fl_set_object_lstyle($obj, FL_BOLD_STYLE);
$obj = fl_add_text(FL_NORMAL_TEXT, 15, 260, 45, 15, "Base");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 15, 275, 45, 15, "Current");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 65, 260, 70, 15, "0x00000000");
$stackBase = $obj;
fl_set_object_lstyle($obj, FL_FIXED_STYLE);
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 65, 275, 70, 15, "0x00000000");
$stackPtr = $obj;
fl_set_object_lstyle($obj, FL_FIXED_STYLE);
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_labelframe(FL_ENGRAVED_FRAME, 10, 305, 130, 55, "Code");
fl_set_object_lstyle($obj, FL_BOLD_STYLE);
$obj = fl_add_text(FL_NORMAL_TEXT, 15, 310, 45, 15, "Start");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 65, 308, 70, 15, "0x00000000");
$codeStart = $obj;
fl_set_object_lstyle($obj, FL_FIXED_STYLE);
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 65, 325, 70, 15, "0x00000000");
$codeEnd = $obj;
fl_set_object_lstyle($obj, FL_FIXED_STYLE);
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 15, 325, 45, 15, "End");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 14, 340, 50, 15, "Instr Ptr");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 65, 340, 70, 15, "0x00000000");
$instPtr = $obj;
fl_set_object_lstyle($obj, FL_FIXED_STYLE);
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_browser(FL_NORMAL_BROWSER, 150, 265, 150, 95, "Mapped Regions");
$mappedMemory = $obj;
fl_set_object_lalign($obj, FL_ALIGN_TOP);
fl_set_object_lstyle($obj, FL_BOLD_STYLE);
fl_set_browser_fontsize($obj, 11);
fl_set_browser_fontstyle($obj, FL_FIXED_STYLE);
$obj = fl_add_labelframe(FL_ENGRAVED_FRAME, 5, 105, 135, 75, "Signal Masks");
fl_set_object_lsize($obj, FL_NORMAL_SIZE);
fl_set_object_lstyle($obj, FL_BOLD_STYLE);
$obj = fl_add_text(FL_NORMAL_TEXT, 6, 115, 75, 15, "Pending");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 6, 130, 75, 15, "Blocked");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 6, 160, 75, 15, "Caught");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 6, 145, 75, 15, "Ignored");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 65, 115, 70, 15, "0x00000000");
$sigPnMask = $obj;
fl_set_object_lstyle($obj, FL_FIXED_STYLE);
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 65, 130, 70, 15, "0x00000000");
$sigBlMask = $obj;
fl_set_object_lstyle($obj, FL_FIXED_STYLE);
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 65, 145, 70, 15, "0x00000000");
$sigIgMask = $obj;
fl_set_object_lstyle($obj, FL_FIXED_STYLE);
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 65, 160, 70, 15, "0x00000000");
$sigCtMask = $obj;
fl_set_object_lstyle($obj, FL_FIXED_STYLE);
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 210, 210, 42, 15, "000");
$minFaultsSelf = $obj;
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_labelframe(FL_ENGRAVED_FRAME, 10, 205, 130, 40, "Sizes (Kb)");
fl_set_object_lstyle($obj, FL_BOLD_STYLE);
$obj = fl_add_text(FL_NORMAL_TEXT, 15, 210, 45, 15, "VM");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 15, 225, 48, 15, "Res Set");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 67, 210, 68, 15, "0x00000000");
$VMsize = $obj;
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 67, 225, 68, 15, "0x00000000");
$residentSet = $obj;
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_frame(FL_ENGRAVED_FRAME, 209, 226, 90, 19, "");
$obj = fl_add_text(FL_NORMAL_TEXT, 255, 210, 42, 15, "000");
$minFaultsTree = $obj;
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 255, 228, 42, 15, "000");
$majFaultsTree = $obj;
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 210, 228, 42, 15, "000");
$majFaultsSelf = $obj;
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_labelframe(FL_ENGRAVED_FRAME, 150, 105, 155, 74, "CPU");
fl_set_object_lsize($obj, FL_NORMAL_SIZE);
fl_set_object_lstyle($obj, FL_BOLD_STYLE);
$obj = fl_add_text(FL_NORMAL_TEXT, 155, 128, 42, 15, "Kernel");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_labelframe(FL_ENGRAVED_FRAME, 244, 122, 50, 48, "Tree");
fl_set_object_lalign($obj, FL_ALIGN_TOP_RIGHT);
fl_set_object_lstyle($obj, FL_BOLD_STYLE);
$obj = fl_add_labelframe(FL_ENGRAVED_FRAME, 194, 122, 50, 48, "Self");
fl_set_object_lalign($obj, FL_ALIGN_TOP_RIGHT);
fl_set_object_lstyle($obj, FL_BOLD_STYLE);
$obj = fl_add_text(FL_NORMAL_TEXT, 155, 152, 37, 15, "User");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 196, 128, 47, 15, "000");
$kernCPUSelf = $obj;
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_frame(FL_ENGRAVED_FRAME, 194, 147, 100, 23, "");
$obj = fl_add_text(FL_NORMAL_TEXT, 246, 128, 47, 15, "000");
$kernCPUTree = $obj;
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 246, 151, 47, 15, "000");
$userCPUTree = $obj;
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 196, 151, 47, 15, "000");
$userCPUSelf = $obj;
fl_set_object_lalign($obj, FL_ALIGN_RIGHT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 176, 46, 78, 15, "Process Group");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 262, 46, 41, 15, "00000");
$procGrp = $obj;
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 6, 31, 78, 15, "Process ID");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 90, 31, 45, 15, "00000");
$pid = $obj;
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 6, 61, 89, 15, "Parent Proc ID");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 90, 61, 45, 15, "00000");
$ppid = $obj;
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 6, 76, 89, 15, "TTY");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 90, 76, 45, 15, "00000");
$tty = $obj;
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 5, 46, 43, 15, "State");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 90, 46, 88, 15, "Traced/Stopped");
$state = $obj;
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 176, 61, 78, 15, "Session ID");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 262, 61, 41, 15, "00000");
$session = $obj;
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 176, 31, 78, 15, "Priority");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 262, 31, 41, 15, "00000");
$priority = $obj;
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 176, 76, 78, 15, "TTY Proc Grp");
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 262, 76, 41, 15, "00000");
$ttyProcGrp = $obj;
fl_set_object_lalign($obj, FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_text(FL_NORMAL_TEXT, 50, 3, 210, 23, "Command Name");
$executable = $obj;
fl_set_object_lsize($obj, FL_MEDIUM_SIZE);
fl_set_object_lalign($obj, FL_ALIGN_CENTER|FL_ALIGN_INSIDE);
fl_set_object_lstyle($obj, FL_BOLD_STYLE);
fl_end_form();
}
sub create_the_forms {
create_form_ProcCntl();
create_form_ProcDtls();
}
1;
Xforms4Perl-0.8.4/DEMOS/XFbat.pl 100775 0 0 4245 6373564043 14223 0 ustar root root #!/usr/bin/perl
#
# Battery level from /proc
#
$XFbat = undef;
$pos = undef;
$tim = undef;
$batlevel = undef;
$last_stat = 0;
use X11::Xforms;
fl_initialize("Battery");
create_form_XFbat();
fl_show_form($XFbat,FL_PLACE_FREE,FL_FULLBORDER,"Battery");
set_positioner();
fl_do_forms();
exit 0;
sub set_positioner
{
open(APM, "/proc/apm");
$apm = <APM>;
close APM;
($drv_ver,
$apm_ver,
$apm_flag,
$ac_stat,
$batstat,
$batflag,
$percent,
$time,
$units) = split(' ',$apm);
$percent =~ /(.*)%/;
$batlevel = $1;
$batflag = eval($batflag);
$ac_stat = eval($ac_stat);
if ($batflag & 0x08) {
$timeleft = "Charging";
} elsif ($time == -1) {
if ($ac_stat & 0x01) {
$timeleft = "AC adapter";
} else {
$timeleft = "Time left: ...";
}
} else {
$timeleft = "Time left: $time $units";
}
if ($batflag & 0x01) {
$last_stat = 0;
$col2 = FL_PALEGREEN;
$col1 = FL_SLIDER_COL1;
} elsif ($batflag & 0x02) {
if ($last_stat < 1) {
fl_ringbell(100);
$last_stat = 1;
}
$col2 = FL_DARKORANGE;
$col1 = FL_SLIDER_COL1;
} else {
if ($last_stat < 4) {
fl_ringbell(100);
$last_stat += 1;
}
fl_ringbell(100);
$col2 = FL_RED;
$col1 = FL_RED;
}
fl_set_slider_value($pos, $batlevel);
fl_set_object_color($pos, $col1, $col2);
fl_set_object_label($tim, $timeleft);
fl_add_timeout(10000, "set_positioner", 0);
return;
}
sub slider_filter {
my($obj, $value, $int) = @_;
$str = "$batlevel";
return $str;
}
sub create_form_XFbat
{
$XFbat = fl_bgn_form(FL_NO_BOX, 125, 37);
$obj = fl_add_box(FL_FLAT_BOX,0,0,125,37,"");
$tim = $obj = fl_add_text(FL_NORMAL_TEXT,2,0,108,19,"");
fl_set_object_lsize($obj,FL_NORMAL_SIZE);
fl_set_object_lalign($obj,FL_ALIGN_CENTER);
fl_set_object_lstyle($obj,FL_TIMESBOLD_STYLE);
$pos = $obj = fl_add_valslider(FL_HOR_FILL_SLIDER,2,19,108,16,"");
fl_set_object_lsize($obj,FL_SMALL_SIZE);
fl_set_object_lstyle($obj,FL_NORMAL_STYLE);
fl_set_slider_bounds($obj, 0, 100);
fl_set_slider_filter($obj, "slider_filter");
fl_set_slider_step($obj, 1);
fl_deactivate_object($obj);
$obj = fl_add_button(FL_NORMAL_BUTTON,111,1,12,34,"X");
fl_end_form();
return;
}
Xforms4Perl-0.8.4/DEMOS/arrowbutton.pl 100711 0 0 2446 6427213740 15567 0 ustar root root #!/usr/bin/perl -w
# /* This demo shows the use of special symbol labels */
use X11::Xforms;
$border = FL_NOBORDER;
fl_initialize("FormDemo");
$form = fl_bgn_form(FL_UP_BOX,400,400);
$obj = fl_add_button(FL_NORMAL_BUTTON, 50, 250,100,100,"\@1");
fl_set_object_lcol($obj,FL_BLUE);
$obj = fl_add_button(FL_NORMAL_BUTTON,150, 250,100,100,"\@2");
fl_set_object_lcol($obj,FL_BLUE);
$obj = fl_add_button(FL_NORMAL_BUTTON,250, 250,100,100,"\@3");
fl_set_object_lcol($obj,FL_BLUE);
$obj = fl_add_button(FL_NORMAL_BUTTON, 50,150,100,100,"\@4");
fl_set_object_lcol($obj,FL_BLUE);
$but = fl_add_button(FL_NORMAL_BUTTON,150,150,100,100,"\@square");
fl_set_object_lcol($but,FL_GREEN);
fl_set_object_color($but,FL_MAGENTA,FL_RED);
$obj = fl_add_button(FL_NORMAL_BUTTON,250,150,100,100,"\@6");
fl_set_object_lcol($obj,FL_BLUE);
$obj = fl_add_button(FL_NORMAL_BUTTON, 50, 50,100,100,"\@7");
fl_set_object_lcol($obj,FL_BLUE);
$obj = fl_add_button(FL_NORMAL_BUTTON,150, 50,100,100,"\@8");
fl_set_object_lcol($obj,FL_BLUE);
$obj = fl_add_button(FL_NORMAL_BUTTON,250, 50,100,100,"\@9");
fl_set_object_lcol($obj,FL_BLUE);
fl_end_form();
fl_show_form($form,FL_PLACE_ASPECT,$border,"Buttons");
while (fl_do_forms() != $but) {}
fl_hide_form($form);
Xforms4Perl-0.8.4/DEMOS/bm1.xbm 100600 0 0 425 6130457075 14005 0 ustar root root #define bm1_width 16
#define bm1_height 16
static char bm1_bits[] =
{
0x00, 0x00, 0x00, 0x57, 0x7c, 0x72, 0xc4, 0x52, 0xc4, 0x00, 0x44, 0x01,
0x44, 0x1f, 0xfc, 0x22, 0x40, 0x42, 0x40, 0x44, 0x40, 0x43, 0xc0, 0x40,
0x70, 0x40, 0x8c, 0x20, 0x00, 0x1f, 0x00, 0x00
};
Xforms4Perl-0.8.4/DEMOS/bm2.xbm 100600 0 0 420 6130457075 14001 0 ustar root root #define bm2_width 16
#define bm2_height 16
static char bm2_bits[] = {
0x00, 0x00, 0x00, 0x57, 0x7c, 0x72, 0xfc, 0x52, 0xfc, 0x00, 0x7c, 0x01,
0x7c, 0x1f, 0xfc, 0x22, 0x40, 0x42, 0x40, 0x44, 0x40, 0x43, 0xc0, 0x40,
0x70, 0x40, 0x8c, 0x20, 0x00, 0x1f, 0x00, 0x00};
Xforms4Perl-0.8.4/DEMOS/browserall.pl 100711 0 0 7571 6437602423 15362 0 ustar root root #!/usr/bin/perl
#/* This is a demo that shows the different types of browsers. */
use X11::Xforms;
$form = "";
@br[4] = ("", "", "", "");
@bnames = ( "NORMAL_BROWSER",
"SELECT_BROWSER",
"HOLD_BROWSER",
"MULTI_BROWSER" );
$exitobj = "";
$readout = "";
fl_initialize("FormDemo");
create_form();
fill_browsers();
fl_show_form($form,FL_PLACE_CENTER,FL_NOBORDER,NULL);
fl_do_forms();
fl_hide_form($form);
sub deselect {
my($obj, $arg) = @_;
for ($i=0; $i<4; $i++) {
fl_deselect_browser($br[$i]);
}
}
sub set_size {
my($obj, $arg) = @_;
for ($i=0; $i<4; $i++) {
fl_set_browser_fontsize($br[$i],$arg);
}
}
sub set_style {
my($obj, $arg) = @_;
for ($i=0; $i<4; $i++) {
fl_set_browser_fontstyle($br[$i], $arg);
}
}
sub br_callback {
my($obj, $arg) = @_;
$i = fl_get_browser($obj);
$buf = "In $bnames[$arg]";
$buf1 = fl_get_browser_line($obj, ($i >0 ? $i :-$i));
$buf2 = ($i > 0 ? " was selected":" was deselected.");
fl_set_object_label($readout,"$buf $buf1 $buf2");
}
sub create_form {
$form = fl_bgn_form(FL_UP_BOX,700,570);
$readout = fl_add_box(FL_UP_BOX,50,30,600,50,"");
fl_set_object_lsize($readout,FL_LARGE_SIZE);
fl_set_object_lstyle($readout,FL_BOLD_STYLE);
fl_set_object_color($readout,FL_MAGENTA,FL_MAGENTA);
$br[0] = $obj = fl_add_browser(FL_NORMAL_BROWSER,20,120,150,290,$bnames[0]);
fl_set_object_callback($obj, "br_callback", 0);
$br[1] = $obj = fl_add_browser(FL_SELECT_BROWSER,190,120,150,290,$bnames[1]);
fl_set_object_callback($obj, "br_callback", 1);
$br[2] = $obj = fl_add_browser(FL_HOLD_BROWSER,360,120,150,290,$bnames[2]);
fl_set_object_color($obj,$obj->col1,FL_GREEN);
fl_set_object_callback($obj, "br_callback", 2);
$br[3] = $obj = fl_add_browser(FL_MULTI_BROWSER,530,120,150,290,$bnames[3]);
fl_set_object_color($br[3],$obj->col1,FL_CYAN);
fl_set_object_callback($obj, "br_callback", 3);
$exitobj = $obj = fl_add_button(FL_NORMAL_BUTTON,560,510,120,30,"Exit");
$obj = fl_add_button(FL_NORMAL_BUTTON,560,460,120,30,"Deselect");
fl_set_object_callback($obj,"deselect",0);
fl_bgn_group();
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,20,500,100,30,"Tiny");
fl_set_object_lsize($obj,FL_TINY_SIZE);
fl_set_object_callback($obj,"set_size",FL_TINY_SIZE);
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,130,500,100,30,"Small");
fl_set_object_lsize($obj,FL_SMALL_SIZE);
fl_set_object_callback($obj,"set_size",FL_SMALL_SIZE);
fl_set_button($obj,1);
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,240,500,100,30,"Normal");
fl_set_object_lsize($obj,FL_NORMAL_SIZE);
fl_set_object_callback($obj,"set_size",FL_NORMAL_SIZE);
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,350,500,100,30,"Large");
fl_set_object_lsize($obj,FL_LARGE_SIZE);
fl_set_object_callback($obj,"set_size",FL_LARGE_SIZE);
fl_end_group();
fl_bgn_group();
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,20,450,100,30,"Normal");
fl_set_object_callback($obj,"set_style",FL_NORMAL_STYLE);
fl_set_button($obj,1);
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,120,450,100,30,"Bold");
fl_set_object_callback($obj,"set_style",FL_BOLD_STYLE);
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,220,450,100,30,"Italic");
fl_set_object_callback($obj,"set_style",FL_ITALIC_STYLE);
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,320,450,100,30,"BoldItalic");
fl_set_object_callback($obj,"set_style",FL_BOLDITALIC_STYLE);
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,420,450,100,30,"Fixed");
fl_set_object_callback($obj,"set_style",FL_FIXED_STYLE);
fl_end_group();
fl_end_form();
}
sub fill_browsers {
for ($i=0; $i<4; $i++) {
for ($j=1; $j<=100; $j++) {
if ( $j == 5) {
$buf = "\@NLine with qb $j";
} elsif ( $j == 10) {
$buf = "\@-";
} else {
$buf = "Line with qb $j";
}
fl_add_browser_line($br[$i],$buf);
}
}
}
Xforms4Perl-0.8.4/DEMOS/browserop.pl 100711 0 0 3500 6316164353 15215 0 ustar root root #!/usr/bin/perl
#/* This demo shows the different routines on browsers */
use X11::Xforms;
$form = "";
$browserobj = "";
$inputobj = "";
$exitobj = "";
fl_initialize("FormDemo");
create_form();
fl_show_form($form,FL_PLACE_CENTER,FL_NOBORDER,"Browser Op");
do {
$obj = fl_do_forms();
} while ($obj != $exitobj);
fl_hide_form($form);
sub addit
{
fl_addto_browser($browserobj,fl_get_input($inputobj));
}
sub insertit
{
return if (! fl_get_browser($browserobj));
fl_insert_browser_line($browserobj,
fl_get_browser($browserobj),
fl_get_input($inputobj));
}
sub replaceit
{
return if (! fl_get_browser($browserobj));
fl_replace_browser_line($browserobj,
fl_get_browser($browserobj),
fl_get_input($inputobj));
}
sub deleteit
{
return if (! fl_get_browser($browserobj));
fl_delete_browser_line($browserobj,
fl_get_browser($browserobj));
}
sub clearit
{
fl_clear_browser($browserobj);
}
sub create_form
{
$form = fl_bgn_form(FL_UP_BOX,390,420);
$browserobj = fl_add_browser(FL_HOLD_BROWSER,20,20,210,330,"");
fl_set_object_dblbuffer($browserobj, 1);
$inputobj = $obj = fl_add_input(FL_NORMAL_INPUT,20,370,210,30,"");
fl_set_object_callback($obj,"addit",0);
$obj = fl_add_button(FL_NORMAL_BUTTON,250,20,120,30,"Add");
fl_set_object_callback($obj,"addit",0);
$obj = fl_add_button(FL_NORMAL_BUTTON,250,60,120,30,"Insert");
fl_set_object_callback($obj,"insertit",0);
$obj = fl_add_button(FL_NORMAL_BUTTON,250,100,120,30,"Replace");
fl_set_object_callback($obj,"replaceit",0);
$obj = fl_add_button(FL_NORMAL_BUTTON,250,160,120,30,"Delete");
fl_set_object_callback($obj,"deleteit",0);
$obj = fl_add_button(FL_NORMAL_BUTTON,250,200,120,30,"Clear");
fl_set_object_callback($obj,"clearit",0);
$exitobj = fl_add_button(FL_NORMAL_BUTTON,250,370,120,30,"Exit");
fl_end_form();
}
Xforms4Perl-0.8.4/DEMOS/buttonall.pl 100711 0 0 6650 6437577142 15220 0 ustar root root #!/usr/bin/perl
#
# Demo all types of buttons
#
use X11::Xforms;
$buttform = undef;
$backface = undef;
$done = undef;
$objsgroup = undef;
$bbutt = undef;
$pbutt = undef;
$bw_obj = undef;
$ret_obj = undef;
fl_initialize("Buttform");
create_form_buttform();
# fill-in form initialization code */
fl_set_pixmapbutton_file($pbutt,"crab45.xpm");
fl_set_bitmapbutton_file($bbutt,"bm1.xbm");
fl_addto_choice($bw_obj," -4 | -3 | -2 | -1 | 1| 2| 3| 4");
fl_set_choice($bw_obj,7);
# show the first form */
fl_show_form($buttform,FL_PLACE_CENTER,FL_FULLBORDER,"buttform");
while ($done != fl_do_forms()){}
# callbacks for form buttform */
sub done_cb
{
exit(0);
}
sub bw_cb
{
my($ob, $data) = @_;
@bws = (-4,-3,-2,-1,1,2,3,4);
$n = fl_get_choice($ob)-1;
fl_set_object_bw($backface, $bws[$n]);
fl_set_object_bw($objsgroup, $bws[$n]);
# redrawing the backface wipes out the done button. Redraw it*/
fl_redraw_object($done);
}
sub create_form_buttform
{
$buttform = fl_bgn_form(FL_NO_BOX, 290, 260);
$backface = $obj = fl_add_box(FL_UP_BOX,0,0,290,260,"");
$done = $obj = fl_add_button(FL_NORMAL_BUTTON,185,215,90,30,"Done");
fl_set_object_callback($obj,"done_cb",0);
$objsgroup = fl_bgn_group();
$obj = fl_add_box(FL_FRAME_BOX,190,27,90,98,"");
$obj = fl_add_box(FL_FRAME_BOX,90,25,90,100,"");
$obj = fl_add_frame(FL_ENGRAVED_FRAME,175,170,100,30,"");
fl_set_object_color($obj,FL_COL1,FL_GREEN);
$obj = fl_add_round3dbutton(FL_PUSH_BUTTON,210,170,30,30,"");
fl_set_object_color($obj,FL_COL1,FL_GREEN);
$bbutt = $obj = fl_add_bitmapbutton(FL_NORMAL_BUTTON,25,85,40,40,"bitmapbutton");
fl_set_object_color($obj,FL_COL1,FL_BLACK);
$pbutt = $obj = fl_add_pixmapbutton(FL_NORMAL_BUTTON,25,25,40,40,"pixmapbutton");
$obj = fl_add_text(FL_NORMAL_TEXT,100,15,70,20,"CheckButton");
fl_set_object_lalign($obj,FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_checkbutton(FL_RADIO_BUTTON,100,37,70,32,"Red");
fl_set_object_color($obj,FL_COL1,FL_RED);
$obj = fl_add_checkbutton(FL_RADIO_BUTTON,100,63,70,32,"Green");
fl_set_object_color($obj,FL_COL1,FL_GREEN);
$obj = fl_add_checkbutton(FL_RADIO_BUTTON,100,90,70,32,"Blue");
fl_set_object_color($obj,FL_COL1,FL_BLUE);
$obj = fl_add_lightbutton(FL_PUSH_BUTTON,20,170,92,30,"LightButton");
fl_set_button($obj, 1);
$obj = fl_add_text(FL_NORMAL_TEXT,200,15,70,24,"RoundButton");
fl_set_object_lalign($obj,FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
$obj = fl_add_roundbutton(FL_PUSH_BUTTON,200,35,75,25,"Red");
fl_set_object_color($obj,FL_COL1,FL_RED);
$obj = fl_add_roundbutton(FL_PUSH_BUTTON,200,65,75,25,"Green");
fl_set_object_color($obj,FL_COL1,FL_GREEN);
$obj = fl_add_roundbutton(FL_PUSH_BUTTON,200,90,75,25,"Blue");
fl_set_object_color($obj,FL_COL1,FL_BLUE);
$obj = fl_add_round3dbutton(FL_PUSH_BUTTON,180,170,30,30,"");
fl_set_object_color($obj,FL_COL1,FL_RED);
$obj = fl_add_round3dbutton(FL_PUSH_BUTTON,240,170,30,30,"");
fl_set_object_color($obj,FL_COL1,FL_BLUE);
$obj = fl_add_button(FL_PUSH_BUTTON,130,210,30,30,"go");
fl_set_object_boxtype($obj,FL_OVAL3D_UPBOX);
fl_set_object_lstyle($obj,FL_BOLD_STYLE);
$obj = fl_add_button(FL_NORMAL_BUTTON,20,210,90,30,"Button");
fl_set_object_boxtype($obj,FL_ROUNDED3D_UPBOX);
$bw_obj = $obj = fl_add_choice(FL_NORMAL_CHOICE2,105,135,80,30,"BW");
fl_set_object_callback($obj,"bw_cb",0);
fl_end_group();
fl_end_form();
fl_adjust_form_size($buttform);
}
Xforms4Perl-0.8.4/DEMOS/buttonsome.pl 100711 0 0 6553 6316164371 15405 0 ustar root root #!/usr/bin/perl
#/*
# * All buttons
# */
use X11::Xforms;
#use Forms;
$buttonform = "";
$readyobj = "";
fl_initialize("FormDemo");
create_form_buttons();
fl_show_form($buttonform, FL_PLACE_CENTER, FL_TRANSIENT, "Some Buttons");
fl_set_cursor_color(60, FL_RED, FL_WHITE);
$win = $buttonform->window;
fl_set_cursor($win, 60);
while (fl_do_forms() != $readyobj){}
sub bitmapbutton
{
my($ob, $q) = @_;
if (fl_get_button($ob)) {
$file = "nomail.xbm";
}
else {
$file = "newmail.xbm";
}
fl_set_bitmapbutton_file($ob, $file);
}
sub pixmapbutton
{
my($ob, $q) = @_;
if (fl_get_button($ob)) {
$file = "crab45.xpm";
}
else {
$file = "crab.xpm";
}
fl_set_pixmapbutton_file($ob, $file);
}
sub create_form_buttons
{
return if ($buttonform);
$buttonform = fl_bgn_form(FL_NO_BOX,320,380);
$obj = fl_add_box(FL_UP_BOX,0,0,320,380,"");
$readyobj = $obj = fl_add_button(FL_NORMAL_BUTTON,190,335,110,30,"READY");
$obj = fl_add_button(FL_NORMAL_BUTTON,125,30,150,35,"Button");
fl_set_object_boxtype($obj,FL_SHADOW_BOX);
fl_set_object_color($obj,FL_GREEN,FL_RED);
$obj = fl_add_bitmapbutton(FL_PUSH_BUTTON,180,210,80,70,"");
fl_set_object_boxtype($obj,FL_NO_BOX);
fl_set_object_callback($obj, "bitmapbutton",0);
fl_set_bitmapbutton_file($obj,"newmail.xbm");
$obj = fl_add_pixmapbutton(FL_PUSH_BUTTON,200,280,45,40,"");
fl_set_object_callback($obj, "pixmapbutton",0);
fl_set_pixmapbutton_file($obj,"crab.xpm");
fl_bgn_group();
$obj = fl_add_roundbutton(FL_RADIO_BUTTON,25,30,45,50,"");
fl_set_object_boxtype($obj,FL_BORDER_BOX);
fl_set_object_color($obj,FL_MCOL,FL_RED);
$obj = fl_add_roundbutton(FL_RADIO_BUTTON,25,75,45,50,"");
fl_set_object_boxtype($obj,FL_BORDER_BOX);
fl_set_object_color($obj,FL_MCOL,FL_GREEN);
$obj = fl_add_roundbutton(FL_RADIO_BUTTON,25,125,45,50,"");
fl_set_object_boxtype($obj,FL_BORDER_BOX);
fl_set_object_color($obj,FL_MCOL,FL_BLUE);
fl_end_group();
fl_bgn_group();
$obj = fl_add_frame(FL_ENGRAVED_FRAME,115,80,75,95,"");
$obj = fl_add_box(FL_FLAT_BOX,125,75,50,10,"CheckB");
$obj = fl_add_checkbutton(FL_RADIO_BUTTON,120,85,55,30,"Red");
fl_set_object_color($obj,FL_MCOL,FL_RED);
$obj = fl_add_checkbutton(FL_RADIO_BUTTON,120,115,55,30,"Green");
fl_set_object_color($obj,FL_MCOL,FL_GREEN);
$obj = fl_add_checkbutton(FL_RADIO_BUTTON,120,145,55,30,"Blue");
fl_set_object_color($obj,FL_MCOL,FL_BLUE);
fl_end_group();
fl_bgn_group();
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,20,215,125,35," Red");
fl_set_object_color($obj,FL_COL1,FL_RED);
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,20,250,125,35," Green");
fl_set_object_color($obj,FL_COL1,FL_GREEN);
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,20,285,125,35," Blue");
fl_set_object_color($obj,FL_COL1,FL_BLUE);
fl_end_group();
fl_bgn_group();
$obj = fl_add_roundbutton(FL_RADIO_BUTTON,230,85,55,30,"Red");
fl_set_object_color($obj,FL_MCOL,FL_RED);
$obj = fl_add_frame(FL_SHADOW_FRAME,225,80,75,95,"");
$obj = fl_add_roundbutton(FL_RADIO_BUTTON,230,145,55,30,"Blue");
fl_set_object_color($obj,FL_MCOL,FL_BLUE);
$obj = fl_add_roundbutton(FL_RADIO_BUTTON,230,115,55,30,"Green");
fl_set_object_color($obj,FL_MCOL,FL_GREEN);
$obj = fl_add_roundbutton(FL_RADIO_BUTTON,230,85,55,30,"Red");
fl_set_object_color($obj,FL_MCOL,FL_RED);
fl_end_group();
fl_end_form();
}
Xforms4Perl-0.8.4/DEMOS/canvas.pl 100711 0 0 11016 6437337506 14475 0 ustar root root #!/usr/bin/perl
#/* Demo showing the use of canvas object. V0.75
#
# It also shows the use of XEvent objects and XEvent callbacks
#
# */
#use Forms;
use X11::Xforms;
#use Forms_DRAW;
#use Forms_CANVAS;
#use Forms_CHOICE_OBJS;
#use Forms_WIN;
#use Forms_XEVENT;
use X11::XEvent;
$canvasform = "";
$canvas = "";
$br = "";
$keyboard = "";
$mouse = "";
$done = "";
$misc = "";
$menu = "";
$vdata = "";
$ldata = "";
$canvasGC = "";
fl_initialize("FormDemo");
create_form_canvasform();
fl_set_object_dblbuffer($br, 1);
init_canvas();
fl_addto_menu($menu,"Item1|Item2|Item3|Item4");
fl_show_form($canvasform,
FL_PLACE_FREE,FL_FULLBORDER,"canvasform");
while (($o =fl_do_forms()) != $done){}
sub canvas_expose
{
my($ob, $win, $w, $h, $ev, $d) = @_;
fl_rectf($ob->x, $ob->y, $w, $h, FL_BLACK);
fl_addto_browser($br, "Expose");
return 0;
}
sub canvas_key
{
my($ob, $win, $w, $h, $ev, $d) = @_;
$code = XKeycodeToKeysym(fl_get_display,$ev->keycode, 0);
$buf = "KeyPress: keysym=$code";
fl_addto_browser($br, $buf);
return 0;
}
sub canvas_but
{
my($ob, $win, $w, $h, $ev, $d) = @_;
$buf = "ButtonPress: " . $ev->button;
fl_addto_browser($br, $buf);
return 0;
}
sub canvas_misc
{
my($ob, $win, $w, $h, $ev, $d) = @_;
if ($ev->type == EnterNotify) {
$str = "Enter canvas";
} else {
$str = "Leave canvas";
}
fl_addto_browser($br, $str);
return 0;
}
sub init_canvas
{
fl_add_canvas_handler($canvas, 12, "canvas_expose", 0);
fl_add_canvas_handler($canvas, 2, "canvas_key", 0);
fl_add_canvas_handler($canvas, 4, "canvas_but", 0);
fl_set_button($mouse, 1);
fl_set_button($keyboard, 1);
$canvasGC = fl_create_GC();
fl_set_foreground($canvasGC, FL_BLACK);
}
sub sensitive_setting
{
my($ob, $event) = @_;
if ($event == KeyPress) {
$hc = "canvas_key";
} else {
$hc = "canvas_but";
}
if(fl_get_button($ob)) {
fl_add_canvas_handler($canvas, $event, $hc, 0);
} else {
fl_remove_canvas_handler($canvas, $event);
}
}
sub hide_it
{
my($ob, $all) = @_;
if($all)
{
fl_hide_form($canvasform);
fl_show_form($canvasform,
FL_PLACE_CENTER, FL_TRANSIENT, "canvas");
}
else
{
if($canvas->visible)
{
fl_hide_object($canvas);
fl_set_object_label($ob,"ShowCanvas");
}
else
{
fl_show_object($canvas);
fl_set_object_label($ob,"HideCanvas");
}
}
}
sub misc_cb
{
my($ob, $parm) = @_;
if(fl_get_button($ob))
{
fl_add_canvas_handler($canvas, EnterNotify,
"canvas_misc", 0);
fl_add_canvas_handler($canvas, LeaveNotify,
"canvas_misc", 0);
}
else
{
fl_remove_canvas_handler($canvas,
EnterNotify);
fl_remove_canvas_handler($canvas,
LeaveNotify);
}
}
sub create_form_canvasform
{
$old_bw = fl_get_border_width();
fl_set_border_width(-2);
$canvasform = fl_bgn_form(FL_NO_BOX, 450, 280);
$obj = fl_add_box(FL_UP_BOX,0,0,450,280,"");
$canvas = $obj = fl_add_canvas(FL_NORMAL_CANVAS,20,40,155,187,"");
$br = $obj = fl_add_browser(FL_NORMAL_BROWSER,188,40,152,187,"");
$obj = fl_add_button(FL_NORMAL_BUTTON,80,236,90,27,"HideCanvas");
fl_set_object_callback($obj, "hide_it", 0);
$obj = fl_add_button(FL_NORMAL_BUTTON,170,236,90,27,"HideForm");
fl_set_object_callback($obj, "hide_it", 1);
$done = $obj = fl_add_button(FL_NORMAL_BUTTON,260,236,90,27,"Done");
$obj = fl_add_text(FL_NORMAL_TEXT,130,10,120,20,"Canvas");
fl_set_object_lsize( $obj,FL_MEDIUM_SIZE);
fl_set_object_lalign($obj,FL_ALIGN_CENTER);
fl_set_object_lstyle($obj,FL_BOLD_STYLE);
$menu = $obj = fl_add_menu(FL_PULLDOWN_MENU, 20,10, 40,20,"Menu");
fl_set_object_shortcut($obj,"#m", 1);
$keyboard = $obj = fl_add_checkbutton(FL_PUSH_BUTTON,345,40,76,26,"Keyboard");
fl_set_object_color($obj,FL_COL1,FL_BLUE);
fl_set_object_callback($obj,"sensitive_setting",2);
$mouse = $obj = fl_add_checkbutton(FL_PUSH_BUTTON,345,70,76,26,"Mouse");
fl_set_object_color($obj,FL_COL1,FL_BLUE);
fl_set_object_callback($obj,"sensitive_setting",4);
$misc = $obj = fl_add_checkbutton(FL_PUSH_BUTTON,345,100,74,26,"Enter/Leave");
fl_set_object_color($obj,FL_COL1,FL_BLUE);
fl_set_object_callback($obj,"misc_cb",4);
fl_end_form();
fl_set_border_width($old_bw);
}
Xforms4Perl-0.8.4/DEMOS/chartall.pl 100711 0 0 3400 6316164413 14761 0 ustar root root #!/usr/bin/perl
#/* Showing all different charts */
use X11::Xforms;
#use Forms_PLOT_OBJS;
fl_initialize("FormDemo");
$form = fl_bgn_form(FL_NO_BOX,940,360);
$obj = fl_add_box(FL_UP_BOX,0,0,940,360,"");
$barchart = $obj = fl_add_chart(FL_BAR_CHART,20,20,210,140,"BAR_CHART");
fl_set_object_boxtype($obj,FL_RSHADOW_BOX);
$linechart = $obj = fl_add_chart(FL_LINE_CHART,250,20,210,140,"LINE_CHART");
fl_set_object_boxtype($obj,FL_RSHADOW_BOX);
$filledchart = $obj = fl_add_chart(FL_FILLED_CHART,250,190,210,140,"FILLED_CHART");
fl_set_object_boxtype($obj,FL_RSHADOW_BOX);
$piechart = $obj = fl_add_chart(FL_PIE_CHART,480,190,210,140,"PIE_CHART");
fl_set_object_boxtype($obj,FL_RSHADOW_BOX);
$specialpiechart = $obj = fl_add_chart(FL_SPECIALPIE_CHART,710,20,210,140,"SPECIALPIE_CHART");
fl_set_object_boxtype($obj,FL_RSHADOW_BOX);
$exitbut = $obj = fl_add_button(FL_NORMAL_BUTTON,750,260,140,30,"Exit");
$horbarchart = $obj = fl_add_chart(FL_HORBAR_CHART,20,190,210,140,"HORBAR_CHART");
fl_set_object_boxtype($obj,FL_RSHADOW_BOX);
$spikechart = $obj = fl_add_chart(FL_SPIKE_CHART,480,20,210,140,"SPIKE_CHART");
fl_set_object_boxtype($obj,FL_RSHADOW_BOX);
fl_end_form();
fill_in($barchart);
fill_in($horbarchart);
fill_in($linechart);
fill_in($filledchart);
fill_in($spikechart);
fill_in($piechart);
fill_in($specialpiechart);
fl_show_form($form,FL_PLACE_CENTER,FL_FULLBORDER,NULL);
fl_do_forms();
sub fill_in
{
my($ob) = @_;
$c = FL_BLACK;
fl_add_chart_value($ob,15.0,"item 1",++$c);
fl_add_chart_value($ob,5.0,"item 2",++$c);
fl_add_chart_value($ob,0.0,"item 3",++$c);
fl_add_chart_value($ob,-10.,"item 4",++$c);
fl_add_chart_value($ob,25.0,"item 5",++$c);
fl_add_chart_value($ob,12.0,"item 6",++$c);
}
Xforms4Perl-0.8.4/DEMOS/choice.pl 100711 0 0 2524 6316164421 14426 0 ustar root root #!/usr/bin/perl
#/* This demo shows the use of choice objects. */
use X11::Xforms;
#use Forms_CHOICE_OBJS;
$form = "";
$sexobj = "";
$childobj = "";
$licenceobj = "";
$marriedobj = "";
$readyobj = "";
fl_initialize("FormDemo");
create_form();
fl_addto_choice($sexobj,"Male");
fl_addto_choice($sexobj,"Female");
fl_addto_choice($childobj,"Zero|One|Two|Three|Many");
fl_addto_choice($licenceobj,"Yes");
fl_addto_choice($licenceobj,"No");
fl_addto_choice($marriedobj,"Yes");
fl_addto_choice($marriedobj,"No");
fl_show_form($form,FL_PLACE_CENTER,FL_NOBORDER,NULL);
do {$obj = fl_do_forms();} while ($obj != $readyobj);
fl_hide_form($form);
sub create_form
{
$form = fl_bgn_form(FL_NO_BOX,420,360);
fl_add_box(FL_UP_BOX,0,0,420,360,"");
fl_add_input(FL_NORMAL_INPUT,70,300,320,30,"Name");
fl_add_input(FL_NORMAL_INPUT,70,260,320,30,"Address");
fl_add_input(FL_NORMAL_INPUT,70,220,320,30,"City");
fl_add_input(FL_NORMAL_INPUT,70,180,320,30,"Country");
$sexobj = fl_add_choice(FL_NORMAL_CHOICE,70,130,110,30,"Sex");
$childobj = fl_add_choice(FL_NORMAL_CHOICE,280,130,110,30,"Children");
$licenceobj = fl_add_choice(FL_NORMAL_CHOICE,280,80,110,30,"Licence");
$marriedobj = fl_add_choice(FL_DROPLIST_CHOICE,70,80,110,30,"Married");
$readyobj = fl_add_button(FL_NORMAL_BUTTON,150,20,140,30,"Ready");
fl_end_form();
}
Xforms4Perl-0.8.4/DEMOS/crab.xpm 100600 0 0 4000 6130457075 14264 0 ustar root root /* XPM */
static char * crab[] = {
/* crab pixmap
* width height ncolors chars_per_pixel */
"28 28 6 2 ",
". c None m white s s_SkyBlue ",
"x c orange m black s s_orange ",
"* c #ff72c2 m black s s_#ff72c2 ",
"+ c SteelBlue m white s s_SteelBlue ",
"G c black m black s s_black ",
"a c LightGrey m white s s_LightGrey ",
/* pixels */
". . . . . . * * * * . . . . . . . . . * * * * . . . . . ",
". . . . + * x x * . . . . . . . . . . + * x x * . . . . ",
". . . + * x x * . . . . . . . . . . . . + * x x * . . . ",
". . + * x * . . . * . . . . . . . . . * . . + * x * . . ",
". . + * x * . . + * . . . . . . . . + * . . + * x * . . ",
". . + * x * . + * * . . . . . . . . + * * . + * x * . . ",
". . + * x * + * * . . . . . . . . . . + * * + * x * . . ",
". . + * x * * * . . . . . . . . . . . . + * * x x * . . ",
". . . + * x * . . + * . . . . . . + * . . + * x * . . . ",
". . . + * x . . + * . + * * . * * . + * . . + x * . . . ",
". . . . + x . . + * . + * * . * * . + * . . + x . . . . ",
". . . . + x . . . + * + * * * * * + * . . . + x . . . . ",
". . . . + * x . . + * * * * * * * * * . . + x * . . . . ",
". . . . . + * x * * * * x x x x x * * * * x * . . . . . ",
". . . . + + + * * x x x x x x x x x x x x * . . . . . . ",
". . + + * x x x x x x x x x x x x x x x x x x * x . . . ",
". + * x x a + * * x x x x x x x x x x x * * a G * x * . ",
"+ * x . . . + * * x x x x x x x x x x x * * G . . . x * ",
". . . . . . + * * x x x x x x x x x x x * * . . . . . . ",
". . . . . + * * x x x x x x x x x x x x x * * . . . . . ",
". . . + * x x x * x x x x x x x x x x x * x x x * . . . ",
". . + * x a a + * * x x x x x x x x x * * a a a x * . . ",
". + * x G G G + * * x x x x x x x x x * * a G G G x * . ",
". + * G . . . + * x * x x x x x x x * x * a G . . . * . ",
". . . . . . + * x a * * * x x x * * * a x * G . . . . . ",
". . . . . + * x a G a a * * * * * a a G a x * G . . . . ",
". . . . . + x a G . G G a a a a a G G . G G x a G . . . ",
". . . . . + x a G . . . G G G G G . . . . . x a G . . . "
} ;
Xforms4Perl-0.8.4/DEMOS/crab45.xpm 100600 0 0 3710 6130457075 14444 0 ustar root root /* XPM */
static char * crab45[] = {
/* crab45 pixmap
* width height ncolors chars_per_pixel */
"28 28 6 2 ",
". c None s s_SkyBlue ",
"x c orange s s_orange ",
"* c #ff72c2 s s_#ff72c2 ",
"+ c SteelBlue s s_SteelBlue ",
"G c black s s_black ",
"a c LightGrey s s_LightGrey ",
/* pixels */
". . . . . . . . . . * * * * * * * . . . . . . . . . . . ",
". . . . . . . . * x x x x x x x * . . . . . . . . . . . ",
". . . . . . . * * * * * * * x x * . . . . . . . . . . . ",
". . . . . . . . . . . . . * x x x * . . . . . . . . . . ",
". . . . . . . . . . * x x x x * x x . . . . . . . . . . ",
". . . . . . . . + + * * * * * * * x x . . . . . . . . . ",
". . . . . . . . . . . . . . . . . * x x . . . . . * . . ",
". . * . . . . . . . . . . . . . . . * x . . * * x x . . ",
". * * . . + . . . . . . + + x x + * * x * * x x x + . . ",
". x * . . + . . . . . . . . + x + * x x x x x + + . . . ",
"* x * . * * . . . . . . + . + x * * x x x * * . . . . . ",
"* x * . x * . . . . . + x + + x x x x x x * * . . * * * ",
"* x * . x * . . + . + x x x x x x x x x x * * * * x x x ",
"* x * * x * . . + . . + x x x x x x x x x * * x x x G G ",
"* x x x x * . . x + + + x x x x x x x x x x x * * G G . ",
"* x x x * * . . x x x x x x x x x x x x x x x * * G G . ",
"* * * x . * . . + + * x x x x x x x x x x x x * * G G . ",
". . . * . x * . * * * x x x x x x x x x x x x x * * * * ",
". . . . . x x * * x x x x x x x x x x x x x x * x x x x ",
". . . . . . x x x x x x x x x x x x x x x x * * G G G x ",
". . . . . . . . * x x x x x x x x x x x x x * * G G + . ",
". . . . . . . . * x * * * * x x x x x x x * * * G G . . ",
". . . . . . . * x x * * * * x x x x x * * * * * * G G . ",
". . . . . . . * x + . . * x * * * x * * * * * G G G G . ",
". . . . . . . x x + . . * x * * * * x G G G * G G G . . ",
". . . . . . * x + . . * x x G G G * x G G G G G . . . . ",
". . . . . . . . . . . * x G G G G * x G + . G G . . . . ",
". . . . . . . . . . . * x G . . . * x x . . . . . . . . "
} ;
Xforms4Perl-0.8.4/DEMOS/crab_tran.xpm 100600 0 0 3765 6130457075 15331 0 ustar root root /* XPM */
static char * crab[] = {
/* crab pixmap
* width height ncolors chars_per_pixel */
"28 28 6 2 ",
". c None m white s None ",
"x c orange m black s s_orange ",
"* c #ff72c2 m black s s_#ff72c2 ",
"+ c red m white s s_SteelBlue ",
"G c black m black s s_black ",
"a c LightGrey m white s s_LightGrey ",
/* pixels */
". . . . . . * * * * . . . . . . . . . * * * * . . . . . ",
". . . . + * x x * . . . . . . . . . . + * x x * . . . . ",
". . . + * x x * . . . . . . . . . . . . + * x x * . . . ",
". . + * x * . . . * . . . . . . . . . * . . + * x * . . ",
". . + * x * . . + * . . . . . . . . + * . . + * x * . . ",
". . + * x * . + * * . . . . . . . . + * * . + * x * . . ",
". . + * x * + * * . . . . . . . . . . + * * + * x * . . ",
". . + * x * * * . . . . . . . . . . . . + * * x x * . . ",
". . . + * x * . . + * . . . . . . + * . . + * x * . . . ",
". . . + * x . . + * . + * * . * * . + * . . + x * . . . ",
". . . . + x . . + * . + * * . * * . + * . . + x . . . . ",
". . . . + x . . . + * + * * * * * + * . . . + x . . . . ",
". . . . + * x . . + * * * * * * * * * . . + x * . . . . ",
". . . . . + * x * * * * x x x x x * * * * x * . . . . . ",
". . . . + + + * * x x x x x x x x x x x x * . . . . . . ",
". . + + * x x x x x x x x x x x x x x x x x x * x . . . ",
". + * x x a + * * x x x x x x x x x x x * * a G * x * . ",
"+ * x . . . + * * x x x x x x x x x x x * * G . . . x * ",
". . . . . . + * * x x x x x x x x x x x * * . . . . . . ",
". . . . . + * * x x x x x x x x x x x x x * * . . . . . ",
". . . + * x x x * x x x x x x x x x x x * x x x * . . . ",
". . + * x a a + * * x x x x x x x x x * * a a a x * . . ",
". + * x G G G + * * x x x x x x x x x * * a G G G x * . ",
". + * G . . . + * x * x x x x x x x * x * a G . . . * . ",
". . . . . . + * x a * * * x x x * * * a x * G . . . . . ",
". . . . . + * x a G a a * * * * * a a G a x * G . . . . ",
". . . . . + x a G . G G a a a a a G G . G G x a G . . . ",
". . . . . + x a G . . . G G G G G . . . . . x a G . . . "
} ;
Xforms4Perl-0.8.4/DEMOS/cursor.pl 100711 0 0 5003 6367647366 14530 0 ustar root root #!/usr/bin/perl
use X11::Xforms;
#
# Switching cursors demo
#
$cursor = undef;
$animated = undef;
$bitmapcur = undef;
#
# The bitstring deatils were derived from bm1.xbm and bm2.xbm in the
# DEMOS directory
#
$bm1_width = 16;
$bm1_height = 16;
$bm1_bits = "\x00\x00\x00\x57\x7c\x72\xc4\x52\xc4\x00\x44\x01\x44\x1f\xfc\x22\x40\x42\x40\x44\x40\x43\xc0\x40\x70\x40\x8c\x20\x00\x1f\x00\x00";
$bm2_bits = "\x00\x00\x00\x57\x7c\x72\xfc\x52\xfc\x00\x7c\x01\x7c\x1f\xfc\x22\x40\x42\x40\x44\x40\x43\xc0\x40\x70\x40\x8c\x20\x00\x1f\x00\x00";
#@curs = (14,16,12,70,134,138,136,96);
for ($i=0; $i < 25; ++$i)
{
$curs[$i] = $i*2;
}
fl_set_border_width(-2);
fl_initialize("FormDemo");
create_form_cursor();
fl_set_cursor_color(150,FL_BLACK,FL_RED);
fl_show_form($cursor,FL_PLACE_CENTER,FL_FULLBORDER,"cursor");
fl_do_forms();
exit 0;
# callbacks for form cursor */
sub setcursor_cb
{
my($ob, $data) = @_;
fl_set_cursor($ob->window, $data);
}
sub setbitmapcursor_cb
{
my($ob, $data) = @_;
if (!defined($bitmapcur))
{
$bitmapcur = fl_create_bitmap_cursor($bm1_bits, $bm2_bits,
$bm1_width, $bm1_height,
$bm1_width/2, $bm1_height/2);
}
fl_set_cursor($ob->window, $bitmapcur);
}
sub setanimatedcursor_cb
{
my($ob, $data) = @_;
$animated = fl_create_animated_cursor(@curs, 100) if (!defined($animated));
fl_set_cursor(FL_ObjWin($ob), $animated);
}
sub done_cb
{
exit(0);
}
sub create_form_cursor
{
$cursor = fl_bgn_form(FL_NO_BOX, 325, 175);
$obj = fl_add_box(FL_UP_BOX,0,0,325,175,"");
$obj = fl_add_frame(FL_EMBOSSED_FRAME,10,10,305,120,"");
$obj = fl_add_button(FL_NORMAL_BUTTON,20,20,50,25,"Hand");
fl_set_object_callback($obj,"setcursor_cb",60);
$obj = fl_add_button(FL_NORMAL_BUTTON,70,20,50,25,"Watch");
fl_set_object_callback($obj,"setcursor_cb",150);
$obj = fl_add_button(FL_NORMAL_BUTTON,120,20,60,25,"Invisible");
fl_set_object_callback($obj,"setcursor_cb",FL_INVISIBLE_CURSOR);
$obj = fl_add_button(FL_NORMAL_BUTTON,180,20,62,25,"Animated");
fl_set_object_callback($obj,"setanimatedcursor_cb",0);
$obj = fl_add_button(FL_NORMAL_BUTTON,242,20,62,25,"BitmapCur");
fl_set_object_callback($obj,"setbitmapcursor_cb",0);
$obj = fl_add_button(FL_NORMAL_BUTTON,90,70,140,50,"DefaultCursor");
fl_set_button_shortcut($obj,"Dd#d",1);
fl_set_object_callback($obj,"setcursor_cb",FL_DEFAULT_CURSOR);
$obj = fl_add_button(FL_NORMAL_BUTTON,250,140,60,25,"Done");
fl_set_object_callback($obj,"done_cb",0);
fl_end_form();
}
Xforms4Perl-0.8.4/DEMOS/fbrowse.pl 100711 0 0 3571 6316164435 14653 0 ustar root root #!/usr/bin/perl
#/* This demo shows the use of a browser and a file selector.
#*/
use X11::Xforms;
#use Forms_GOODIES;
$form = 0;
$br = 0;
fl_initialize("FormDemo");
create_form();
fl_clear_browser($br);
fl_add_browser_line($br,"LOAD A FILE.");
fl_set_browser_fontstyle($br,FL_FIXED_STYLE);
fl_show_form($form,FL_PLACE_FREE,FL_FULLBORDER,"Browser");
fl_do_forms();
fl_hide_form($form);
fl_free_form($form);
sub load_file
{
my($ob, $arg) = @_;
$fname = fl_show_file_selector("File To Load","","*","");
return if ($fname eq "");
fl_add_browser_line($br,"NO SUCH FILE!")
unless (fl_load_browser($br,$fname));
}
sub set_size
{
my($ob, $arg) = @_;
fl_set_browser_fontsize($br,$arg);
}
sub exit_program
{
exit(0);
}
sub create_form
{
$x = 20;
$dx = 85;
$form = fl_bgn_form(FL_NO_BOX,590,610);
$obj = fl_add_box(FL_UP_BOX,0,0,590,610,"");
$br = $obj = fl_add_browser(FL_NORMAL_BROWSER,20,20,550,530,"");
$obj = fl_add_button(FL_NORMAL_BUTTON,$x,560,$dx,30,"Load");
fl_set_object_callback($obj,\&load_file,0);
$x += $dx + 10;
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,$x,560,$dx,30,"Tiny");
fl_set_object_callback($obj,\&set_size,FL_TINY_SIZE);
$x += $dx;
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,$x ,560,$dx,30,"Small");
fl_set_object_callback($obj,\&set_size,FL_SMALL_SIZE);
fl_set_button($obj, FL_SMALL_SIZE == FL_BROWSER_FONTSIZE);
$x += $dx;
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,$x ,560,$dx,30,"Normal");
fl_set_object_callback($obj,\&set_size,FL_NORMAL_SIZE);
fl_set_button($obj, FL_NORMAL_SIZE == FL_BROWSER_FONTSIZE);
$x += $dx;
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,$x ,560,$dx,30,"Large");
fl_set_object_callback($obj,\&set_size,FL_LARGE_SIZE);
$obj = fl_add_button(FL_NORMAL_BUTTON,470,560,100,30,"Exit");
fl_set_object_callback($obj, \&exit_program, 0);
fl_end_form();
}
Xforms4Perl-0.8.4/DEMOS/flclock.pl 100775 0 0 2010 6316164442 14614 0 ustar root root #!/usr/bin/perl
#/* Form definition file generated with fdesign. */
use X11::Xforms;
$fclock = "";
fl_initialize("FormDemo");
create_form_clock();
fl_set_form_dblbuffer($fclock, 1);
fl_show_form($fclock, FL_PLACE_CENTER,FL_NOBORDER,"clocks");
fl_do_forms();
exit 0;
sub exit_cb
{
exit(0);
}
sub create_form_clock
{
if (!$fclock) {
$fclock = fl_bgn_form(FL_NO_BOX,500,350);
$obj = fl_add_box(FL_UP_BOX,0,0,500,350,"");
$obj = fl_add_clock(FL_DIGITAL_CLOCK,190,20,140,30,"");
fl_set_object_boxtype($obj,FL_ROUNDED_BOX);
fl_set_object_color($obj,FL_COL1,FL_BLACK);
fl_set_object_lsize($obj,FL_MEDIUM_SIZE);
fl_set_object_lstyle($obj,FL_BOLD_STYLE);
$obj = fl_add_clock(FL_ANALOG_CLOCK,30,70,220,200,"");
fl_set_object_boxtype($obj,FL_UP_BOX);
$obj = fl_add_clock(FL_ANALOG_CLOCK,260,70,220,200,"");
fl_set_object_boxtype($obj,FL_OVAL_BOX);
$obj = fl_add_button(FL_NORMAL_BUTTON,380,300,100,30,"Exit");
fl_set_object_callback($obj, "exit_cb", 0);
fl_end_form();
}
}
Xforms4Perl-0.8.4/DEMOS/free1.pl 100711 0 0 3071 6316164447 14204 0 ustar root root #!/usr/bin/perl
#/* This demo is meant to demonstrate the use of a free
# object in a form. It also demonstrates the use of the
# u_ldata field in the FL_OBJECT structure (and, thus, the
# u_vdata fields in the FL_FORM and FL_OBJECT structures)
#*/
use X11::Xforms;
#use Forms_DRAW;
$dcol = $on = 1;
fl_initialize("FormDemo");
$form = fl_bgn_form(FL_UP_BOX,400.0,400.0);
$obj = fl_add_button(FL_NORMAL_BUTTON,320.0,20.0,40.0,30.0,"Exit");
fl_set_object_callback($obj, "done", 0);
$obj = fl_add_free(FL_CONTINUOUS_FREE,40.0,80.0,320.0,280.0,"","handle_it");
fl_end_form();
$depth = fl_get_visual_depth();
# /* can't do it if less than 4 bit deep */
die("This Demo requires a depth of at least 4 bits\n") if($depth < 4);
$cole = ((1 << $depth)-1);
$cole = 64 if ($cole > 64);
$obj->u_ldata($col = FL_FREE_COL1);
$cole += $col;
for ( $i = $col; $i <= $cole; $i++)
{
$j = 255.0 * ($i - $col) / ($cole - $col);
fl_mapcolor($i, $j, $j, $j);
}
fl_show_form($form,FL_PLACE_CENTER,FL_NOBORDER,"Free Object");
fl_do_forms();
#/* The call back routine */
sub handle_it {
my($obj, $event, $mx, $my, $key, $ev) = @_;
if ($event == FL_DRAW) {
fl_roundrectf($obj->x,$obj->y,$obj->w,$obj->h, $obj->u_ldata);
} elsif ($event == FL_RELEASE) {
$on = !$on;
} elsif ($event == FL_STEP) {
if ($on)
{
$u_ldata = $obj->u_ldata;
$dcol = -1 if ($u_ldata == $cole);
$dcol = 1 if ($u_ldata == FL_FREE_COL1);
$u_ldata += $dcol;
$obj->u_ldata($u_ldata);
fl_redraw_object($obj);
}
}
return 0;
}
sub done { exit(0);}
Xforms4Perl-0.8.4/DEMOS/freedraw.pl 100711 0 0 17260 6316164454 15024 0 ustar root root #!/usr/bin/perl
#/* Demo showing the use of a free obejct */
use X11::Xforms;
#use Forms_DRAW;
#use Forms_VAL_OBJS;
$drawfree = "";
$freeobj = "";
$figgrp = "";
$colgrp = "";
$colorobj = "";
$rsli = "";
$gsli = "";
$bsli = "";
$miscgrp = "";
$sizegrp = "";
$hsli = "";
$wsli = "";
@drobj = ("", "", "");
$cur_fig = $saved_figure[0] = alloc_figure(0);
$cur_fign = 0;
@drawfunc = (\&fl_oval, \&fl_rectangle, \&draw_triangle);
$max_w = $max_h = 150;
$dpy = fl_initialize("FormDemo");
create_form_drawfree();
fl_set_object_color($colorobj,FL_FREE_COL1, FL_FREE_COL1);
draw_initialize();
fl_show_form($drawfree, FL_PLACE_CENTER|FL_FREE_SIZE,
FL_FULLBORDER, "FreeObject");
fl_do_forms();
sub draw_triangle
{
my($fill, $x, $y, $w, $h, $col) = @_;
if($fill) {
fl_polyf($x, $y+$h-1, $x+$w/2, $y, $x+$w-1, $y+$h-1, $col);
} else {
fl_polyl($x, $y+$h-1,
$x+$w/2, $y, $x+$w-1,
$y+$h-1, $x, $y+$h-1, $col);
}
}
sub draw_initialize
{
fl_set_form_minsize($drawfree, 530, 490);
fl_set_object_gravity($colgrp, WestGravity, WestGravity);
fl_set_object_gravity($sizegrp, SouthWestGravity, SouthWestGravity);
fl_set_object_gravity($figgrp, NorthWestGravity, NorthWestGravity);
fl_set_object_gravity($miscgrp, SouthGravity, SouthGravity);
fl_set_object_resize($miscgrp, FL_RESIZE_NONE);
$cur_fig = $saved_figure[0];
@{$cur_fig->{"c"}} = (127, 127, 127);
$cur_fig->{"w"} = $cur_fig->{"h"} = 30;
$cur_fig->{"drawit"} = \&fl_oval;
$cur_fig->{"fill"} = 1;
$cur_fig->{"col"} = FL_FREE_COL1 + 1;
fl_mapcolor(FL_FREE_COL1, @{$cur_fig->{"c"}});
fl_mapcolor($cur_fig->{"col"}, @{$cur_fig->{"c"}});
fl_set_slider_bounds($wsli, 1, $max_w);
fl_set_slider_bounds($hsli, 1, $max_h);
fl_set_slider_precision($wsli, 0);
fl_set_slider_precision($hsli, 0);
fl_set_slider_value($wsli, $cur_fig->{"w"});
fl_set_slider_value($hsli, $cur_fig->{"h"});
# /* color sliders */
fl_set_slider_bounds($rsli, 1.0, 0);
fl_set_slider_bounds($gsli, 1.0, 0);
fl_set_slider_bounds($bsli, 1.0, 0);
# /* intial drawing function */
fl_set_button($drobj[0], 1);
}
sub switch_object
{
my($ob, $which) = @_;
$cur_fig->{"drawit"} = $drawfunc[$which];
}
sub change_color
{
my($ob, $which) = @_;
${$cur_fig->{"c"}}[$which] = fl_get_slider_value($ob) * 255;
fl_mapcolor($cur_fig->{"col"}, @{$cur_fig->{"c"}});
fl_mapcolor(FL_FREE_COL1, @{$cur_fig->{"c"}});
fl_redraw_object($colorobj);
}
sub fill_cb
{
my($ob, $notused) = @_;
$cur_fig->{"fill"} = !fl_get_button($ob);
}
sub change_size
{
my($ob, $which) = @_;
if ($which == 0) {
$cur_fig->{"w"} = fl_get_slider_value($ob);
} else {
$cur_fig->{"h"} = fl_get_slider_value($ob);
}
}
sub refresh_cb
{
fl_redraw_object($freeobj);
}
sub clear_cb
{
my($ob, $notused) = @_;
@saved_figure = (alloc_figure($cur_fig));
$cur_fig = $saved_figure[0];
$cur_fign = 0;
fl_redraw_object($freeobj);
}
#/* The routine that does drawing */
sub freeobject_handler
{
my($ob, $event, $mx, $my, $key, $xev) = @_;
if ($event == FL_DRAW) {
if ($cur_fig->{"newfig"} == 1)
{
&{$cur_fig->{"drawit"}}($cur_fig->{"fill"},
$cur_fig->{"x"} + $ob->x,
$cur_fig->{"y"} + $ob->y,
$cur_fig->{"w"}, $cur_fig->{"h"},
$cur_fig->{"col"});
}
else
{
fl_drw_box($ob->boxtype, $ob->x, $ob->y, $ob->w,
$ob->h, $ob->col1, $ob->bw);
for ($dr = 0; $dr < $cur_fign; $dr++)
{
$ptr = $saved_figure[$dr];
&{$ptr->{"drawit"}}($ptr->{"fill"}, $ptr->{"x"} + $ob->x,
$ptr->{"y"} + $ob->y,
$ptr->{"w"}, $ptr->{"h"}, $ptr->{"col"});
}
}
$cur_fig->{"newfig"} = 0;
} elsif ($event == FL_PUSH) {
if ($key != 2)
{
$cur_fig->{"x"} = $mx - $cur_fig->{"w"}/2;
$cur_fig->{"y"} = $my - $cur_fig->{"h"}/2;
# /* convert position to relative to the free object */
$cur_fig->{"x"} -= $ob->x;
$cur_fig->{"y"} -= $ob->y;
$cur_fig->{"newfig"} = 1;
fl_redraw_object($ob);
$saved_figure[$cur_fign+1] = alloc_figure($cur_fig);
fl_mapcolor($cur_fig->{"col"}+1, @{$cur_fig->{"c"}});
$cur_fig = $saved_figure[++$cur_fign];
$cur_fig->{"col"} = $cur_fig->{"col"}+1;
}
}
return 0;
}
sub create_form_drawfree
{
$drawfree = fl_bgn_form(FL_NO_BOX, 530, 490);
fl_add_box(FL_UP_BOX,0,0,530,490,"");
$obj = fl_add_frame(FL_DOWN_FRAME,145,30,370,405,"");
fl_set_object_gravity($obj, FL_NorthWest, FL_SouthEast);
$freeobj = $obj = fl_add_free(FL_NORMAL_FREE,145,30,370,405,"",
"freeobject_handler");
fl_set_object_gravity($obj, FL_NorthWest, FL_SouthEast);
$obj = fl_add_checkbutton(FL_PUSH_BUTTON,15,25,100,35,"Outline");
fl_set_object_color($obj,FL_MCOL,FL_BLUE);
fl_set_object_gravity($obj, FL_NorthWest, FL_NorthWest);
fl_set_object_callback($obj,"fill_cb",0);
$figgrp = fl_bgn_group();
$drobj[0] = $obj = fl_add_button(FL_RADIO_BUTTON,10,60,40,40,"@#circle");
fl_set_object_lcol($obj,FL_YELLOW);
fl_set_object_callback($obj,"switch_object",0);
$drobj[1] = $obj = fl_add_button(FL_RADIO_BUTTON,50,60,40,40,"@#square");
fl_set_object_lcol($obj,FL_YELLOW);
fl_set_object_callback($obj,"switch_object",1);
$drobj[2] = $obj = fl_add_button(FL_RADIO_BUTTON,90,60,40,40,"@#8>");
fl_set_object_lcol($obj,FL_YELLOW);
fl_set_object_callback($obj,"switch_object",2);
fl_end_group();
$colgrp = fl_bgn_group();
$colorobj = $obj = fl_add_box(FL_BORDER_BOX,25,140,90,25,"");
$rsli = $obj = fl_add_slider(FL_VERT_FILL_SLIDER,25,170,30,125,"");
fl_set_object_color($obj,FL_COL1,FL_RED);
fl_set_object_callback($obj,"change_color",0);
fl_set_slider_return($obj, FL_RETURN_CHANGED);
$gsli = $obj = fl_add_slider(FL_VERT_FILL_SLIDER,55,170,30,125,"");
fl_set_object_color($obj,FL_COL1,FL_GREEN);
fl_set_object_callback($obj,"change_color",1);
fl_set_slider_return($obj, FL_RETURN_CHANGED);
$bsli = $obj = fl_add_slider(FL_VERT_FILL_SLIDER,85,170,30,125,"");
fl_set_object_color($obj,FL_COL1,FL_BLUE);
fl_set_object_callback($obj,"change_color",2);
fl_set_slider_return($obj, FL_RETURN_CHANGED);
fl_end_group();
$miscgrp = fl_bgn_group();
$obj = fl_add_button(FL_NORMAL_BUTTON,395,445,105,30,"Quit");
fl_set_button_shortcut($obj,"Qq#q",1);
$obj = fl_add_button(FL_NORMAL_BUTTON,280,445,105,30,"Refresh");
fl_set_object_callback($obj,"refresh_cb",0);
$obj = fl_add_button(FL_NORMAL_BUTTON,165,445,105,30,"Clear");
fl_set_object_callback($obj,"clear_cb",0);
fl_end_group();
$sizegrp = fl_bgn_group();
$hsli = $obj = fl_add_valslider(FL_HOR_SLIDER,15,410,120,25,"Height");
fl_set_object_lalign($obj,FL_ALIGN_TOP);
fl_set_object_callback($obj,"change_size",1);
fl_set_slider_return($obj, FL_RETURN_CHANGED);
$wsli = $obj = fl_add_valslider(FL_HOR_SLIDER,15,370,120,25,"Width");
fl_set_object_lalign($obj,FL_ALIGN_TOP);
fl_set_object_callback($obj,"change_size",0);
fl_set_slider_return($obj, FL_RETURN_CHANGED);
fl_end_group();
fl_end_form();
}
sub alloc_figure {
my($copy) = @_;
if ($copy) {
return {
drawit => $copy->{"drawit"},
x => $copy->{"x"},
y => $copy->{"y"},
w => $copy->{"w"},
h => $copy->{"h"},
fill => $copy->{"fill"},
c => $copy->{"c"},
col => $copy->{"col"},
newfig => $copy->{"newfig"},
};
} else {
return {
drawit => 0,
x => 0,
y => 0,
w => 0,
h => 0,
fill => 0,
c => [0, 0, 0],
col => 0,
newfig => 0,
};
}
}
Xforms4Perl-0.8.4/DEMOS/goodies.pl 100711 0 0 2436 6316164461 14633 0 ustar root root #!/usr/bin/perl
#/* This demo program uses the routines in the
# goodies section, that help you create easy
# forms in an even easier way.
#*/
use X11::Xforms;
#use Forms_GOODIES;
fl_initialize("FormDemo");
($ver_rev, $ver, $rev) = fl_library_version();
if( fl_show_question("Do you want bold font ?",1)) {
fl_set_goodies_font(FL_BOLD_STYLE,FL_DEFAULT_SIZE);
}
fl_show_messages("This is a test program\nfor the goodies of the \nforms library");
fl_show_alert("Alert", "Alert form can be used to inform",
"recoverable errors", 0);
exit(0) if (fl_show_question("Do you want to quit?",0));
$str1 = fl_show_input("Give a string:","");
fl_show_message("You typed:","",$str1);
if ($ver_rev == 84) {
$choice = fl_show_choice("Pick a choice",3,"One","Two","Three",2);
} else {
$choice = fl_show_choices("Pick a choice",3,"One","Two","Three",2);
}
if ($choice == 1) {
fl_show_message("You typed: One","","");
} elsif ($choice == 2) {
fl_show_message("You typed: Two","","");
} elsif ($choice == 3) {
fl_show_message("You typed: Three","","");
} else {
fl_show_message("An error occured!","","");
}
$str2 = fl_show_input("Give another string:",$str1);
fl_show_message("You typed:","",$str2);
fl_show_messages("Good Bye");
Xforms4Perl-0.8.4/DEMOS/ldial.pl 100711 0 0 3575 6437526672 14306 0 ustar root root #!/usr/bin/perl
#/* This is an example of the use of dials.
#*/
use X11::Xforms;
#use Forms_VAL_OBJS;
$form = "";
$button = $red = $green = $blue = $redtext = $greentext = $bluetext = $result = "";
$ret = "";
fl_initialize("FormDemo");
makeform();
fl_show_form($form,FL_PLACE_MOUSE,FL_TRANSIENT,"A Form");
while ($ret != $button) {
$r = fl_get_dial_value($red);
$g = fl_get_dial_value($green);
$b = fl_get_dial_value($blue);
fl_mapcolor(FL_FREE_COL1,$r,$g,$b);
fl_redraw_object($result);
fl_set_object_label($redtext,sprintf("%X", int($r)));
fl_set_object_label($greentext,sprintf("%X", int($g)));
fl_set_object_label($bluetext,sprintf("%X", int($b)));
$ret = fl_do_forms();
}
fl_hide_form($form);
exit 0;
sub makeform
{
$form = fl_bgn_form(FL_UP_BOX,300,330);
$button = fl_add_button(FL_NORMAL_BUTTON,45,15,210,45,"A Color Editor");
fl_set_object_lsize($button,FL_LARGE_SIZE);
$red = fl_add_dial(FL_LINE_DIAL,30,240,60,60,"Red");
fl_set_dial_bounds($red,0.0,255.0);
fl_set_dial_value($red,128.0);
fl_set_object_color($red,FL_RED,FL_DIAL_COL2);
$redtext = fl_add_box(FL_DOWN_BOX,105,255,50,25,"");
$green = fl_add_dial(FL_LINE_DIAL,30,155,60,60,"Green");
fl_set_dial_bounds($green,0.0,255.0);
fl_set_dial_value($green,128.0);
fl_set_dial_angles($green, 270-45., 270+45.);
fl_set_object_color($green,FL_GREEN,FL_DIAL_COL2);
$greentext = fl_add_box(FL_DOWN_BOX,105,170,50,25,"");
$blue = fl_add_dial(FL_LINE_DIAL,30,70,60,60,"Blue");
fl_set_dial_bounds($blue,0.0,255.0);
fl_set_dial_value($blue,128.0);
fl_set_object_color($blue,FL_BLUE,FL_DIAL_COL2);
$bluetext = fl_add_box(FL_DOWN_BOX,105,90,50,25,"");
$result = fl_add_box(FL_DOWN_BOX,180,70,90,245,"");
fl_set_object_color($result,FL_FREE_COL1,FL_FREE_COL1);
fl_set_object_dblbuffer($result,1);
fl_end_form();
}
Xforms4Perl-0.8.4/DEMOS/newmail.xbm 100600 0 0 6412 6130457075 15004 0 ustar root root #define newmail_width 64
#define newmail_height 64
static unsigned char newmail_bits[] =
{
0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80,
0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,
0x07, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x70, 0x38, 0x00, 0x00, 0x80,
0x01, 0x00, 0x00, 0x0e, 0xc0, 0x00, 0x00, 0x80, 0x01, 0x00, 0xc0, 0x01,
0x00, 0x01, 0x00, 0x80, 0x01, 0x00, 0x38, 0x00, 0x20, 0x02, 0x00, 0x80,
0x01, 0x00, 0x06, 0x00, 0x38, 0x04, 0x00, 0x80, 0x01, 0xc0, 0x1f, 0x00,
0x3e, 0x04, 0x00, 0x80, 0x01, 0x30, 0x60, 0x80, 0x3f, 0x08, 0x00, 0x80,
0x01, 0x08, 0x80, 0x80, 0x3f, 0x08, 0x00, 0x80, 0x01, 0x04, 0x07, 0x81,
0x3f, 0x10, 0x00, 0x80, 0x01, 0x82, 0x0f, 0x82, 0x3f, 0x10, 0x00, 0x80,
0x01, 0x82, 0x0f, 0x82, 0x1f, 0x10, 0x00, 0x80, 0x01, 0x01, 0x07, 0x84,
0x07, 0x20, 0x00, 0x80, 0x01, 0x01, 0x00, 0x84, 0x01, 0x20, 0x00, 0x80,
0x81, 0x00, 0x00, 0x88, 0x00, 0x20, 0x00, 0x80, 0x81, 0x40, 0x00, 0x88,
0x00, 0x20, 0x00, 0x80, 0x81, 0xa0, 0x00, 0x88, 0x00, 0x20, 0x00, 0x80,
0x81, 0x12, 0xa3, 0x88, 0x00, 0x20, 0x00, 0x80, 0x41, 0x4e, 0xa6, 0x90,
0x00, 0x20, 0x00, 0x80, 0x41, 0xa6, 0xac, 0x90, 0x01, 0x20, 0x00, 0x80,
0x41, 0x42, 0xa9, 0x90, 0x01, 0x20, 0x00, 0x80, 0x41, 0x81, 0xb0, 0x10,
0x00, 0x20, 0x00, 0x80, 0xc1, 0x00, 0xa0, 0x17, 0x00, 0x20, 0x00, 0x80,
0x41, 0x01, 0x40, 0x10, 0x00, 0x20, 0x00, 0x80, 0x41, 0x02, 0x82, 0x10,
0x00, 0x20, 0x00, 0x80, 0x41, 0x06, 0x05, 0x17, 0x00, 0x20, 0x00, 0x80,
0x41, 0x88, 0x0a, 0x12, 0x00, 0x30, 0x00, 0x80, 0x41, 0xfe, 0xff, 0x17,
0x00, 0x3c, 0x0e, 0x80, 0x41, 0x00, 0x00, 0x10, 0x00, 0x0f, 0x11, 0x80,
0x41, 0x00, 0x00, 0x10, 0xc0, 0x1b, 0x11, 0x80, 0x41, 0x00, 0x00, 0x10,
0xf0, 0xe4, 0x10, 0x80, 0x41, 0x00, 0x00, 0x10, 0x3c, 0x84, 0x08, 0x80,
0x41, 0x00, 0x00, 0x10, 0x0f, 0x88, 0x3c, 0x80, 0x41, 0x00, 0x00, 0xd0,
0x03, 0xf0, 0x43, 0x80, 0x41, 0x00, 0x00, 0xf0, 0x01, 0x8c, 0x43, 0x80,
0xc1, 0xff, 0xff, 0x3f, 0x01, 0x82, 0x24, 0x80, 0xc1, 0xff, 0xff, 0x1f,
0x01, 0x82, 0x18, 0x80, 0x01, 0x00, 0x02, 0x02, 0x01, 0xfc, 0x08, 0x80,
0x01, 0x00, 0x02, 0x02, 0x01, 0x20, 0x09, 0x80, 0x01, 0x00, 0x02, 0x02,
0x01, 0x10, 0x06, 0x80, 0x01, 0x00, 0x02, 0x02, 0x01, 0x10, 0x00, 0x80,
0x01, 0x00, 0x02, 0x02, 0x01, 0x08, 0x00, 0x80, 0x01, 0x00, 0x02, 0x02,
0x01, 0x08, 0x00, 0x80, 0x01, 0x00, 0x02, 0x02, 0x01, 0xb4, 0x3f, 0x80,
0x01, 0x00, 0x02, 0x02, 0x01, 0x0e, 0x28, 0x80, 0x01, 0x00, 0x02, 0x02,
0x01, 0x03, 0x16, 0x80, 0x01, 0x00, 0x02, 0x02, 0x81, 0xc0, 0x11, 0x80,
0x01, 0x00, 0x02, 0x02, 0x41, 0x38, 0x08, 0x80, 0x01, 0x00, 0x02, 0x02,
0x21, 0x04, 0x04, 0x80, 0x01, 0x00, 0x02, 0x02, 0x11, 0x03, 0x02, 0x80,
0x01, 0x00, 0x02, 0x02, 0xc9, 0x80, 0x01, 0x80, 0x01, 0x00, 0x02, 0x02,
0x25, 0x60, 0x00, 0x80, 0x01, 0x00, 0x02, 0x02, 0x13, 0x18, 0x00, 0x80,
0x01, 0x00, 0x02, 0x02, 0x01, 0x07, 0x00, 0x80, 0x01, 0x00, 0x02, 0xc2,
0xfe, 0x00, 0x00, 0x80, 0x01, 0x00, 0x02, 0x32, 0x00, 0x00, 0x00, 0x80,
0x01, 0x00, 0x02, 0x0e, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0xfe, 0x03,
0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80,
0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff};
Xforms4Perl-0.8.4/DEMOS/nomail.xbm 100600 0 0 6407 6130457075 14633 0 ustar root root #define nomail_width 64
#define nomail_height 64
static unsigned char nomail_bits[] =
{
0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80,
0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,
0x07, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x70, 0x38, 0x00, 0x00, 0x80,
0x01, 0x00, 0x00, 0x0e, 0xc0, 0x00, 0x00, 0x80, 0x01, 0x00, 0xc0, 0x01,
0x00, 0x01, 0x00, 0x80, 0x01, 0x00, 0x38, 0x00, 0x00, 0x02, 0x00, 0x80,
0x01, 0x00, 0x06, 0x00, 0x00, 0x04, 0x00, 0x80, 0x01, 0xc0, 0x1f, 0x00,
0x00, 0x04, 0x00, 0x80, 0x01, 0x30, 0x60, 0x00, 0x00, 0x08, 0x00, 0x80,
0x01, 0x08, 0x80, 0x00, 0x00, 0x08, 0x00, 0x80, 0x01, 0x04, 0x07, 0x01,
0x00, 0x10, 0x00, 0x80, 0x01, 0x82, 0x0f, 0x02, 0x00, 0x10, 0x00, 0x80,
0x01, 0x82, 0x0f, 0x02, 0x00, 0x10, 0x00, 0x80, 0x01, 0x01, 0x07, 0x04,
0x00, 0x20, 0x00, 0x80, 0x01, 0x01, 0x00, 0x04, 0x00, 0x20, 0x00, 0x80,
0x81, 0x00, 0x00, 0x08, 0x00, 0x26, 0x00, 0x80, 0x81, 0x00, 0x00, 0x08,
0x80, 0x27, 0x00, 0x80, 0x81, 0x00, 0x00, 0x08, 0xe0, 0x27, 0x00, 0x80,
0x81, 0x22, 0xa2, 0x08, 0xd8, 0x27, 0x00, 0x80, 0x41, 0x36, 0xa5, 0x10,
0xc6, 0x27, 0x00, 0x80, 0x41, 0xaa, 0xa8, 0x90, 0xc1, 0x27, 0x00, 0x80,
0x41, 0xaa, 0xaf, 0x90, 0xc1, 0x27, 0x00, 0x80, 0x41, 0xa2, 0xa8, 0x10,
0xc0, 0x27, 0x00, 0x80, 0x41, 0xa2, 0xa8, 0x17, 0xc0, 0x21, 0x00, 0x80,
0x41, 0x00, 0x00, 0x10, 0x40, 0x20, 0x00, 0x80, 0x41, 0x00, 0x00, 0x10,
0x00, 0x20, 0x00, 0x80, 0x41, 0xfe, 0xff, 0x17, 0x00, 0x20, 0x00, 0x80,
0x41, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x80, 0x41, 0xfe, 0xff, 0x17,
0x00, 0x3c, 0x0e, 0x80, 0x41, 0x00, 0x00, 0x10, 0x00, 0x0f, 0x11, 0x80,
0x41, 0x00, 0x00, 0x10, 0xc0, 0x1b, 0x11, 0x80, 0x41, 0x00, 0x00, 0x10,
0xf0, 0xe4, 0x10, 0x80, 0x41, 0x00, 0x00, 0x10, 0x3c, 0x84, 0x08, 0x80,
0x41, 0x00, 0x00, 0x10, 0x0f, 0x88, 0x3c, 0x80, 0x41, 0x00, 0x00, 0xd0,
0x03, 0xf0, 0x43, 0x80, 0x41, 0x00, 0x00, 0xf0, 0x01, 0x8c, 0x43, 0x80,
0xc1, 0xff, 0xff, 0x3f, 0x01, 0x82, 0x24, 0x80, 0xc1, 0xff, 0xff, 0x1f,
0x01, 0x82, 0x18, 0x80, 0x01, 0x00, 0x02, 0x02, 0x01, 0xfc, 0x08, 0x80,
0x01, 0x00, 0x02, 0x02, 0x01, 0x20, 0x09, 0x80, 0x01, 0x00, 0x02, 0x02,
0x01, 0x10, 0x06, 0x80, 0x01, 0x00, 0x02, 0x02, 0x01, 0x10, 0x00, 0x80,
0x01, 0x00, 0x02, 0x02, 0x01, 0x08, 0x00, 0x80, 0x01, 0x00, 0x02, 0x02,
0x01, 0x08, 0x00, 0x80, 0x01, 0x00, 0x02, 0x02, 0x01, 0xb4, 0x3f, 0x80,
0x01, 0x00, 0x02, 0x02, 0x01, 0x0e, 0x28, 0x80, 0x01, 0x00, 0x02, 0x02,
0x01, 0x03, 0x16, 0x80, 0x01, 0x00, 0x02, 0x02, 0x81, 0xc0, 0x11, 0x80,
0x01, 0x00, 0x02, 0x02, 0x41, 0x38, 0x08, 0x80, 0x01, 0x00, 0x02, 0x02,
0x21, 0x04, 0x04, 0x80, 0x01, 0x00, 0x02, 0x02, 0x11, 0x03, 0x02, 0x80,
0x01, 0x00, 0x02, 0x02, 0xc9, 0x80, 0x01, 0x80, 0x01, 0x00, 0x02, 0x02,
0x25, 0x60, 0x00, 0x80, 0x01, 0x00, 0x02, 0x02, 0x13, 0x18, 0x00, 0x80,
0x01, 0x00, 0x02, 0x02, 0x01, 0x07, 0x00, 0x80, 0x01, 0x00, 0x02, 0xc2,
0xfe, 0x00, 0x00, 0x80, 0x01, 0x00, 0x02, 0x32, 0x00, 0x00, 0x00, 0x80,
0x01, 0x00, 0x02, 0x0e, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0xfe, 0x03,
0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80,
0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff};
Xforms4Perl-0.8.4/DEMOS/pmbrowse.pl 100711 0 0 3264 6316164476 15046 0 ustar root root #!/usr/bin/perl
#/* Form definition file generated with fdesign. */
use X11::Xforms;
#use Forms_GOODIES;
$ttt = 0;
$bm = $pm = 0;
fl_initialize("FormDemo");
create_form_ttt();
fl_show_form($ttt, FL_PLACE_CENTER, FL_TRANSIENT, "PixmapBrowser");
fl_set_fselector_placement(FL_PLACE_FREE);
fl_set_fselector_callback(\&load_file, 0);
fl_show_fselector("Load a Pixmap file", 0, "*.x?m",0);
fl_do_forms();
sub load_file
{
my($fname, $data) = @_;
$ispix = 0;
if ($fname =~ /\.(\w+)$/) {
$ispix = ($1 eq "xpm");
}
if($ispix)
{
fl_hide_object($bm);
fl_show_object($pm);
fl_free_pixmap_pixmap($pm);
fl_set_pixmap_file($pm, $fname);
}
else
{
fl_hide_object($pm);
fl_show_object($bm);
fl_set_bitmap_file($bm, $fname);
}
return 1;
}
sub done
{
exit(0);
}
sub reload
{
my($ob, $q) = @_;
fl_set_fselector_placement(FL_PLACE_MOUSE);
fl_set_fselector_callback("load_file", 0);
fl_show_fselector("Load a Pixmap file", 0, "*.x?m",0);
}
sub create_form_ttt
{
return if ($ttt);
$ttt = fl_bgn_form(FL_NO_BOX,330,320);
$obj = fl_add_box(FL_UP_BOX,0,0,330,320,"");
$bm = $obj = fl_add_bitmap(FL_NORMAL_BITMAP,30,20,270,240,"");
fl_set_object_boxtype($obj, FL_FLAT_BOX);
$pm = $obj = fl_add_pixmap(FL_NORMAL_PIXMAP,30,20,270,240,"");
fl_set_object_boxtype($obj, FL_FLAT_BOX);
$obj = fl_add_button(FL_NORMAL_BUTTON,220,280,90,30,"Done");
fl_set_object_callback($obj, \&done, 0);
$obj = fl_add_button(FL_NORMAL_BUTTON,20,280,90,30,"Load");
fl_set_object_callback($obj, \&reload, 0);
fl_set_object_shortcut($obj,"L",1);
fl_end_form();
}
Xforms4Perl-0.8.4/DEMOS/sliderall.pl 100775 0 0 5327 6367666006 15201 0 ustar root root #!/usr/bin/perl
use X11::Xforms;
# /* This demo shows the different types of sliders */
#use Forms_VAL_OBJS;
$form = "";
$exitobj = "";
fl_initialize("FormDemo");
create_the_forms();
fl_show_form($form,FL_PLACE_CENTER,FL_NOBORDER,"All Sliders");
while (fl_do_forms() != $exitobj){}
fl_hide_form($form);
exit 0;
sub create_form_form
{
$form = fl_bgn_form(FL_NO_BOX,780,320);
$obj = fl_add_box(FL_UP_BOX,0,0,780,320,"");
fl_set_object_color($obj,FL_PALEGREEN,FL_COL1);
$obj = fl_add_box(FL_SHADOW_BOX,20,30,360,270,"SLIDER");
fl_set_object_color($obj,FL_SLATEBLUE,47);
fl_set_object_lalign($obj,FL_ALIGN_TOP);
fl_set_object_lstyle($obj,FL_BOLD_STYLE);
$obj = fl_add_box(FL_SHADOW_BOX,390,30,370,270,"VALSLIDER");
fl_set_object_color($obj,FL_SLATEBLUE,FL_COL1);
fl_set_object_lalign($obj,FL_ALIGN_TOP);
fl_set_object_lstyle($obj,FL_BOLD_STYLE);
$obj = fl_add_slider(FL_VERT_SLIDER,30,50,40,220,"vert");
fl_set_object_color($obj,FL_INDIANRED,FL_PALEGREEN);
$obj = fl_add_slider(FL_VERT_FILL_SLIDER,80,50,40,220,"vert_fill");
fl_set_object_color($obj,FL_INDIANRED,FL_PALEGREEN);
$obj = fl_add_slider(FL_HOR_SLIDER,180,50,190,40,"hor");
fl_set_object_color($obj,FL_INDIANRED,FL_PALEGREEN);
$obj = fl_add_slider(FL_HOR_FILL_SLIDER,180,110,190,40,"hor_fill");
fl_set_object_color($obj,FL_INDIANRED,FL_PALEGREEN);
$obj = fl_add_valslider(FL_VERT_NICE_SLIDER,610,50,30,220,"vert_nice");
fl_set_object_boxtype($obj,FL_FLAT_BOX);
fl_set_object_color($obj,FL_SLATEBLUE,FL_INDIANRED);
$obj = fl_add_valslider(FL_VERT_FILL_SLIDER,660,50,40,220,"vert_fill");
fl_set_object_color($obj,FL_INDIANRED,FL_PALEGREEN);
$obj = fl_add_valslider(FL_HOR_SLIDER,400,50,190,40,"hor");
fl_set_object_color($obj,FL_INDIANRED,FL_PALEGREEN);
$obj = fl_add_valslider(FL_HOR_FILL_SLIDER,400,110,190,40,"hor_fill");
fl_set_object_color($obj,FL_INDIANRED,FL_PALEGREEN);
$exitobj = $obj = fl_add_button(FL_NORMAL_BUTTON,450,240,100,30,"Exit");
fl_set_object_color($obj,FL_INDIANRED,FL_RED);
$obj = fl_add_slider(FL_VERT_NICE_SLIDER,130,50,30,220,"vert_nice");
fl_set_object_boxtype($obj,FL_FLAT_BOX);
fl_set_object_color($obj,FL_SLATEBLUE,FL_INDIANRED);
$obj = fl_add_slider(FL_HOR_NICE_SLIDER,180,170,190,30,"hor_nice");
fl_set_object_boxtype($obj,FL_FLAT_BOX);
fl_set_object_color($obj,FL_SLATEBLUE,FL_INDIANRED);
$obj = fl_add_valslider(FL_HOR_NICE_SLIDER,400,170,190,30,"hor_nice");
fl_set_object_boxtype($obj,FL_FLAT_BOX);
fl_set_object_color($obj,FL_SLATEBLUE,FL_INDIANRED);
$obj = fl_add_valslider(FL_VERT_SLIDER,710,50,40,220,"vert");
fl_set_object_color($obj,FL_INDIANRED,FL_PALEGREEN);
fl_end_form();
}
sub create_the_forms
{
create_form_form();
}
Xforms4Perl-0.8.4/DEMOS/srs.xbm 100600 0 0 11164 6130457075 14177 0 ustar root root #define sorceress_width 75
#define sorceress_height 75
static unsigned char sorceress_bits[] =
{
0xfc, 0x7e, 0x40, 0x20, 0x90, 0x00, 0x07, 0x80, 0x23, 0x00, 0x00, 0xc6,
0xc1, 0x41, 0x98, 0xb8, 0x01, 0x07, 0x66, 0x00, 0x15, 0x9f, 0x03, 0x47,
0x8c, 0xc6, 0xdc, 0x7b, 0xcc, 0x00, 0xb0, 0x71, 0x0e, 0x4d, 0x06, 0x66,
0x73, 0x8e, 0x8f, 0x01, 0x18, 0xc4, 0x39, 0x4b, 0x02, 0x23, 0x0c, 0x04,
0x1e, 0x03, 0x0c, 0x08, 0xc7, 0xef, 0x08, 0x30, 0x06, 0x07, 0x1c, 0x02,
0x06, 0x30, 0x18, 0xae, 0xc8, 0x98, 0x3f, 0x78, 0x20, 0x06, 0x02, 0x20,
0x60, 0xa0, 0xc4, 0x1d, 0xc0, 0xff, 0x41, 0x04, 0xfa, 0x63, 0x80, 0xa1,
0xa4, 0x3d, 0x00, 0x84, 0xbf, 0x04, 0x0f, 0x06, 0xfc, 0xa1, 0x34, 0x6b,
0x01, 0x1c, 0xc9, 0x05, 0x06, 0xc7, 0x06, 0xbe, 0x11, 0x1e, 0x43, 0x30,
0x91, 0x05, 0xc3, 0x61, 0x02, 0x30, 0x1b, 0x30, 0xcc, 0x20, 0x11, 0x00,
0xc1, 0x3c, 0x03, 0x20, 0x0a, 0x00, 0xe8, 0x60, 0x21, 0x00, 0x61, 0x1b,
0xc1, 0x63, 0x08, 0xf0, 0xc6, 0xc7, 0x21, 0x03, 0xf8, 0x08, 0xe1, 0xcf,
0x0a, 0xfc, 0x4d, 0x99, 0x43, 0x07, 0x3c, 0x0c, 0xf1, 0x9f, 0x0b, 0xfc,
0x5b, 0x81, 0x47, 0x02, 0x16, 0x04, 0x31, 0x1c, 0x0b, 0x1f, 0x17, 0x89,
0x4d, 0x06, 0x1a, 0x04, 0x31, 0x38, 0x02, 0x07, 0x56, 0x89, 0x49, 0x04,
0x0b, 0x04, 0xb1, 0x72, 0x82, 0xa1, 0x54, 0x9a, 0x49, 0x04, 0x1d, 0x66,
0x50, 0xe7, 0xc2, 0xf0, 0x54, 0x9a, 0x58, 0x04, 0x0d, 0x62, 0xc1, 0x1f,
0x44, 0xfc, 0x51, 0x90, 0x90, 0x04, 0x86, 0x63, 0xe0, 0x74, 0x04, 0xef,
0x31, 0x1a, 0x91, 0x00, 0x02, 0xe2, 0xc1, 0xfd, 0x84, 0xf9, 0x30, 0x0a,
0x91, 0x00, 0x82, 0xa9, 0xc0, 0xb9, 0x84, 0xf9, 0x31, 0x16, 0x81, 0x00,
0x42, 0xa9, 0xdb, 0x7f, 0x0c, 0xff, 0x1c, 0x16, 0x11, 0x00, 0x02, 0x28,
0x0b, 0x07, 0x08, 0x60, 0x1c, 0x02, 0x91, 0x00, 0x46, 0x29, 0x0e, 0x00,
0x00, 0x00, 0x10, 0x16, 0x11, 0x02, 0x06, 0x29, 0x04, 0x00, 0x00, 0x00,
0x10, 0x16, 0x91, 0x06, 0xa6, 0x2a, 0x04, 0x00, 0x00, 0x00, 0x18, 0x24,
0x91, 0x04, 0x86, 0x2a, 0x04, 0x00, 0x00, 0x00, 0x18, 0x27, 0x93, 0x04,
0x96, 0x4a, 0x04, 0x00, 0x00, 0x00, 0x04, 0x02, 0x91, 0x04, 0x86, 0x4a,
0x0c, 0x00, 0x00, 0x00, 0x1e, 0x23, 0x93, 0x04, 0x56, 0x88, 0x08, 0x00,
0x00, 0x00, 0x90, 0x21, 0x93, 0x04, 0x52, 0x0a, 0x09, 0x80, 0x01, 0x00,
0xd0, 0x21, 0x95, 0x04, 0x57, 0x0a, 0x0f, 0x80, 0x27, 0x00, 0xd8, 0x20,
0x9d, 0x04, 0x5d, 0x08, 0x1c, 0x80, 0x67, 0x00, 0xe4, 0x01, 0x85, 0x04,
0x79, 0x8a, 0x3f, 0x00, 0x00, 0x00, 0xf4, 0x11, 0x85, 0x06, 0x39, 0x08,
0x7d, 0x00, 0x00, 0x18, 0xb7, 0x10, 0x81, 0x03, 0x29, 0x12, 0xcb, 0x00,
0x7e, 0x30, 0x28, 0x00, 0x85, 0x03, 0x29, 0x10, 0xbe, 0x81, 0xff, 0x27,
0x0c, 0x10, 0x85, 0x03, 0x29, 0x32, 0xfa, 0xc1, 0xff, 0x27, 0x94, 0x11,
0x85, 0x03, 0x28, 0x20, 0x6c, 0xe1, 0xff, 0x07, 0x0c, 0x01, 0x85, 0x01,
0x28, 0x62, 0x5c, 0xe3, 0x8f, 0x03, 0x4e, 0x91, 0x80, 0x05, 0x39, 0x40,
0xf4, 0xc2, 0xff, 0x00, 0x9f, 0x91, 0x84, 0x05, 0x31, 0xc6, 0xe8, 0x07,
0x7f, 0x80, 0xcd, 0x00, 0xc4, 0x04, 0x31, 0x06, 0xc9, 0x0e, 0x00, 0xc0,
0x48, 0x88, 0xe0, 0x04, 0x79, 0x04, 0xdb, 0x12, 0x00, 0x30, 0x0c, 0xc8,
0xe4, 0x04, 0x6d, 0x06, 0xb6, 0x23, 0x00, 0x18, 0x1c, 0xc0, 0x84, 0x04,
0x25, 0x0c, 0xff, 0xc2, 0x00, 0x4e, 0x06, 0xb0, 0x80, 0x04, 0x3f, 0x8a,
0xb3, 0x83, 0xff, 0xc3, 0x03, 0x91, 0x84, 0x04, 0x2e, 0xd8, 0x0f, 0x3f,
0x00, 0x00, 0x5f, 0x83, 0x84, 0x04, 0x2a, 0x70, 0xfd, 0x7f, 0x00, 0x00,
0xc8, 0xc0, 0x84, 0x04, 0x4b, 0xe2, 0x2f, 0x01, 0x00, 0x08, 0x58, 0x60,
0x80, 0x04, 0x5b, 0x82, 0xff, 0x01, 0x00, 0x08, 0xd0, 0xa0, 0x84, 0x04,
0x72, 0x80, 0xe5, 0x00, 0x00, 0x08, 0xd2, 0x20, 0x44, 0x04, 0xca, 0x02,
0xff, 0x00, 0x00, 0x08, 0xde, 0xa0, 0x44, 0x04, 0x82, 0x02, 0x6d, 0x00,
0x00, 0x08, 0xf6, 0xb0, 0x40, 0x02, 0x82, 0x07, 0x3f, 0x00, 0x00, 0x08,
0x44, 0x58, 0x44, 0x02, 0x93, 0x3f, 0x1f, 0x00, 0x00, 0x30, 0x88, 0x4f,
0x44, 0x03, 0x83, 0x23, 0x3e, 0x00, 0x00, 0x00, 0x18, 0x60, 0xe0, 0x07,
0xe3, 0x0f, 0xfe, 0x00, 0x00, 0x00, 0x70, 0x70, 0xe4, 0x07, 0xc7, 0x1b,
0xfe, 0x01, 0x00, 0x00, 0xe0, 0x3c, 0xe4, 0x07, 0xc7, 0xe3, 0xfe, 0x1f,
0x00, 0x00, 0xff, 0x1f, 0xfc, 0x07, 0xc7, 0x03, 0xf8, 0x33, 0x00, 0xc0,
0xf0, 0x07, 0xff, 0x07, 0x87, 0x02, 0xfc, 0x43, 0x00, 0x60, 0xf0, 0xff,
0xff, 0x07, 0x8f, 0x06, 0xbe, 0x87, 0x00, 0x30, 0xf8, 0xff, 0xff, 0x07,
0x8f, 0x14, 0x9c, 0x8f, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x07, 0x9f, 0x8d,
0x8a, 0x0f, 0x00, 0x00, 0xfe, 0xff, 0xff, 0x07, 0xbf, 0x0b, 0x80, 0x1f,
0x00, 0x00, 0xff, 0xff, 0xff, 0x07, 0x7f, 0x3a, 0x80, 0x3f, 0x00, 0x80,
0xff, 0xff, 0xff, 0x07, 0xff, 0x20, 0xc0, 0x3f, 0x00, 0x80, 0xff, 0xff,
0xff, 0x07, 0xff, 0x01, 0xe0, 0x7f, 0x00, 0xc0, 0xff, 0xff, 0xff, 0x07,
0xff, 0x0f, 0xf8, 0xff, 0x40, 0xe0, 0xff, 0xff, 0xff, 0x07, 0xff, 0xff,
0xff, 0xff, 0x40, 0xf0, 0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0xff,
0x41, 0xf0, 0xff, 0xff, 0xff, 0x07};
Xforms4Perl-0.8.4/DEMOS/timer.pl 100711 0 0 2544 6316164507 14323 0 ustar root root #!/usr/bin/perl
#/* A demo showing the use of timer objects.
# * note there is only one fl_do_form().
# */
use X11::Xforms;
$form1 = "";
$form2 = "";
$tim = "";
$tim2 = "";
$TIME=5;
fl_initialize("FormDemo");
makeforms();
fl_show_form($form1,FL_PLACE_CENTER,FL_NOBORDER,"Timer");
fl_set_timer($tim,$TIME);
fl_do_forms();
exit 0;
sub timer1_expired
{
fl_deactivate_form($form1);
fl_set_timer($tim2,10);
fl_show_form($form2,FL_PLACE_MOUSE,0,"Q");
}
sub nothing
{
}
sub continue_cb
{
fl_hide_form($form2);
fl_activate_form($form1);
fl_set_timer($tim,$TIME);
fl_set_object_callback($tim,"nothing",0);
}
sub done_cb
{
exit 0;
}
sub makeforms
{
$form1 = fl_bgn_form(FL_UP_BOX,400,400);
$obj = fl_add_button(FL_NORMAL_BUTTON,140,160,120,80,"Push Me");
fl_set_object_callback($obj, "done_cb", 0);
$tim = fl_add_timer(FL_VALUE_TIMER,200,40,90,50,"Time Left");
fl_set_object_callback($tim, "timer1_expired",0);
fl_set_object_lcol($tim, FL_BLACK);
fl_end_form();
$form2 = fl_bgn_form(FL_UP_BOX,320,120);
fl_add_box(FL_NO_BOX,160,40,0,0,"You were too late");
$obj = fl_add_button(FL_NORMAL_BUTTON,100,70,120,30,"Try Again");
fl_set_object_callback($obj, "continue_cb", 0);
$tim2 = fl_add_timer(FL_HIDDEN_TIMER,0,0,1,2,"");
fl_set_object_callback($tim2, "continue_cb", 0);
fl_end_form();
}
Xforms4Perl-0.8.4/DEMOS/xyplotall.pl 100711 0 0 6221 6317564446 15236 0 ustar root root #!/usr/bin/perl
#/* test screen/world conversion in addition to showing the xyplot styles */
use X11::Xforms;
#use Forms_PLOT_OBJS;
#use Forms_GOODIES;
$| = 1;
@xytype = (
{ type => FL_NORMAL_XYPLOT,
name => "FL_NORMAL_XYPLOT",
color => FL_BLACK,
x => 20,
y => 40
}, {
type => FL_SQUARE_XYPLOT,
name => "FL_SQUARE_XYPLOT",
color => FL_RED,
x => 200,
y => 40
}, {
type => FL_CIRCLE_XYPLOT,
name => "FL_CIRCLE_XYPLOT",
color => FL_GREEN,
x => 380,
y => 40
}, {
type => FL_POINTS_XYPLOT,
name => "FL_POINTS_XYPLOT",
color => FL_BLUE,
x => 20,
y => 210
}, {
type => FL_DASHED_XYPLOT,
name => "FL_DASHED_XYPLOT",
color => FL_INDIANRED,
x => 200,
y => 210
}, {
type => FL_FILL_XYPLOT,
name => "FL_FILL_XYPLOT",
color => FL_SLATEBLUE,
x => 380,
y => 210
}, {
type => -1,
name => "End",
color => 0,
x => 0,
y => 0
}
);
@xyplot = ();
fl_initialize("FormDemo");
create_form_xyplot();
for ( $i = 0; $i < 6 ; $i++)
{
for($j = 0; $j < 21; $j++)
{
$val = $j * 3.1415 / 10 ;
push(@{$xy[$i]}, $val, sin(2*$val) + cos($val));
}
fl_set_xyplot_data($xyplot[$i], @{$xy[$i]}, "TestTitle",
"X-axis", "Y-axis");
fl_add_xyplot_text($xyplot[$i], $xy[$i][14], 1.4,
"Text Inset", FL_ALIGN_CENTER, FL_BLUE);
fl_set_object_posthandler($xyplot[$i], "post");
}
fl_show_form($fxyplot, FL_PLACE_ASPECT, FL_TRANSIENT, "XYplot");
while ($retobj = fl_do_forms()){}
sub done_xyplot
{
my($ob, $q) = @_;
fl_hide_form($ob->form);
exit(0);
}
sub post
{
my($ob, $ev, $mx, $my, $key, $xev) = @_;
if($ev == FL_PUSH || $ev == FL_MOUSE)
{
($wx, $wy) = fl_xyplot_s2w($ob, $mx, $my);
$buf = "x=$mx y=$my wx=$wx wy=$wy";
$form = $ob->form;
#print "Uncomment below to get object returns tested\n";
fl_show_oneliner($buf, $ob->x + $form->x + 5,
$ob->y + $form->y);
# fl_show_oneliner($buf, $mx + $form->x,
# $my + $form->y);
$ob->wantkey(FL_KEY_ALL);
$ob->input(1);
}
elsif($ev == FL_RELEASE){
fl_hide_oneliner();
}
elsif($ev == FL_KEYBOARD) {
print "key=$key\n";
}
return 0;
}
sub create_form_xyplot
{
$xyi = 0;
$xy = $xytype[$xyi];
$dx = 180;
$dy = 160;
$fxyplot = fl_bgn_form(FL_NO_BOX,570,430);
$obj = fl_add_box(FL_UP_BOX,0,0,570,430,"");
until ($xy->{"type"} == -1)
{
$xyplot[$xyi] = $obj = fl_add_xyplot($xy->{"type"},
$xy->{"x"},
$xy->{"y"},
$dx,$dy,$xy->{"name"});
fl_set_object_lsize($obj, FL_TINY_SIZE);
fl_set_object_color($obj, FL_COL1, $xy->{"color"});
$xyi++;
$xy = $xytype[$xyi];
}
$obj = fl_add_button(FL_NORMAL_BUTTON,230,390,100,30,"Exit");
fl_set_object_callback($obj, "done_xyplot", 0);
$obj = fl_add_text(FL_NORMAL_TEXT,180,20,240,30,"FL_XYPLOT");
fl_set_object_lcol($obj, FL_SLATEBLUE);
fl_set_object_lsize($obj, FL_HUGE_SIZE);
fl_set_object_lstyle($obj, FL_BOLD_STYLE|FL_EMBOSSED_STYLE);
fl_set_object_boxtype($obj, FL_FLAT_BOX);
fl_end_form();
}
Xforms4Perl-0.8.4/DEMOS/psf.pl 100644 0 0 4766 6333671006 14004 0 ustar root root #!/usr/bin/perl
# List a hierarchical display of processes
#
$PID = 2;
$PPID = 1;
%dtl_pref=undef;
#
# First build the child/parent relationships
#
open(PROCESSES, "ps -xj |");
<PROCESSES>;
for ($i = 0; $process = <PROCESSES>; ++$i) {
chop $process;
@items = split(/\s+/, " $process");
$parent{$items[$PID]} = $items[$PPID];
}
#
# Now get what the user really wants
#
open(PROCESSES, "ps @ARGV |");
@result = <PROCESSES>;
chop @result;
#
# Parse out the PID
#
@headings = split(/\s+/, " $result[0]");
for ($i = 0; $i <= $#headings && ($PID1 == 0); ++$i) {
$PID1 = $i if ($headings[$i] eq "PID");
}
#
# Build parent/child list for requested processes (ignoring the ps processes
# themselves - a slightly ugly byproduct!)
#
for ($i = 1; $i <= $#result; ++$i) {
@temp = split(/\s+/, " $result[$i]");
$temp_child = $temp[$PID1];
next if (! defined($parent{$temp_child}));
$temp_parent = $parent{$temp_child};
$childlist{$temp_parent} = "$temp_child $childlist{$temp_parent}" unless ($temp_child == $temp_parent);
($dtl_pref{$temp_child}, $dtl_time{$temp_child}, $dtl_cmd{$temp_child}) = split(/(\s\d*\:\d\d\s)/, $result[$i]);
$temp_l = length($dtl_pref{$temp_child});
$dtl_pref_l = $temp_l if ($dtl_pref_l < $temp_l);
}
#
# Print a heirarchical list of processes as per the users request
#
@headings = split(/( TIME )/, " $result[0]");
print "$headings[0] $headings[1]" . "$headings[2]\n";
foreach $parent (sort numsort (keys(%childlist))) {
heirprint ($parent) if (defined($childlist{$parent}));
}
exit;
sub heirprint {
#
# print the heirarchy associated with &_[0] and its immediate children
#
my($old_tab_pref) = $tab_pref;
my($old_child_pref) = $child_pref;
my($old_tab_suff) = $tab_suff;
my($process) = @_;
if ($dtl_pref{$process}) {
printf("%-" . $dtl_pref_l . "s%8s%s%s%s\n",
$dtl_pref{$process},
$dtl_time{$process},
$tab_pref,
$tab_suff,
$dtl_cmd{$process});
}
$tab_pref .= $child_pref;
my(@child) = split (/\s+/, $childlist{$process});
my($i) = undef;
for ($i = 0; defined($child[$i]); $i++) {
my($nextchild) = $child[$i];
if ($dtl_pref{$process}) {
$tab_suff = "\\_ ";
$child_pref = ($i == $#child ? " " : "| ");
}
heirprint($nextchild);
}
$tab_pref = $old_tab_pref;
$child_pref = $old_child_pref;
$tab_suff = $old_tab_suff;
delete $childlist{$process};
}
sub numsort {
return (1) if ($a > $b);
return (0) if ($a == $b);
return -1;
}
Xforms4Perl-0.8.4/DEMOS/popup.pl 100711 0 0 7771 6372734176 14364 0 ustar root root #!/usr/bin/perl
use X11::Xforms;
$pupform = undef;
$menu = undef;
$button = undef;
$choice = undef;
$status = undef;
$done_cb = undef;
$pupID = -1;
@pup_entries =
(
"Popup Item1", "pupitem_cb", "1", FL_PUP_RADIO,
"Popup Item2", "pupitem_cb", "2", FL_PUP_RADIO,
"Popup Item3", "pupitem_cb", "3", FL_PUP_RADIO,
"/Popup Item 4", "pupitem_cb", "", 0,
"Popup Item 5", pupitem_cb, "", 0,
"Popup Item 6", pupitem_cb, "", 0,
"Popup Item 7", pupitem_cb, "", 0,
"Popup Item 8", pupitem_cb, "", 0,
0,
"Popup Item10", pupitem_cb, "", FL_PUP_GRAY,
"Popup Item11", pupitem_cb, "", 0,
0
);
@menu_entries =
(
"Menu Item1", undef, "", 0,
"Menu Item2", undef, "", 0,
"_Menu Item3", undef, "", 0,
"/_Menu Item 4", undef, "", 0,
"Menu Item 5", undef, "", 0,
"Menu Item 6", undef, "", 0,
"Menu Item 7", undef, "", 0,
"Menu Item 8", undef, "", 0,
0,
"Menu Item10", undef, "", 0,
"menu Item11", undef, "", 0,
0
);
fl_initialize("Popup Demo");
create_form_pupform();
init_menu($menu);
init_choice($choice);
fl_show_form($pupform,FL_PLACE_CENTER,FL_FULLBORDER,"pupform");
fl_do_forms();
exit 0;
#/********* MENU ***********************************************/
sub menu_callback
{
my($ob, $data) = @_;
$buf = sprintf("item %d (%s) selected",
fl_get_menu($ob), fl_get_menu_text($ob));
fl_set_object_label($status, $buf);
}
#/** menu initialization entries. No callbacks for the item */
sub menuitem_entercb
{
my($item, $menuid) = @_;
$buf = sprintf("Entered %d (%s)", $item, fl_get_menu_item_text($menuid, $item));
fl_set_object_label($status, $buf);
}
sub init_menu
{
my($menu) = @_;
$n = fl_newpup(0);
fl_setpup_entries($n, @menu_entries);
fl_setpup_entercb($n, "menuitem_entercb", $menu);
fl_setpup_bw($n, -2);
fl_set_menu_popup($menu, $n);
}
#/*********** End of menu *************************/
#/******* PopUP ***********************************/
sub pupitem_cb(int selected)
{
my($selected) = @_;
$buf = sprintf("Item %d (%s) selected",
$selected, fl_getpup_text($pupID, $selected));
fl_set_object_label($status, $buf);
return $selected;
}
sub pup_entercb
{
my($item, $null) = @_;
$buf = sprintf("Entered %d (%s)", $item, fl_getpup_text($pupID, $item));
fl_set_object_label($status, $buf);
}
sub dopup_callback
{
my($ob, $data) = @_;
if($pupID < 0)
{
$pupID = fl_newpup(0);
fl_setpup_entries($pupID, @pup_entries);
fl_setpup_entercb($pupID, "pup_entercb", 0);
}
fl_dopup($pupID);
}
#/********* End of pup *****************/
sub init_choice
{
my($ob) = @_;
fl_addto_choice($ob,"Choice1|Choice2|Choice3");
fl_addto_choice($ob,"Choice4|Choice5|Choice6");
fl_addto_choice($ob,"Choice7|Choice8|Choice9");
}
sub choice_callback
{
my($ob, $data) = @_;
$buf = sprintf("%d (%s) selected",
fl_get_choice($ob), fl_get_choice_text($ob));
fl_set_object_label($status, $buf);
}
#/* Form definition file generated with fdesign. */
sub create_form_pupform
{
$pupform = fl_bgn_form(FL_NO_BOX, 320, 250);
$obj = fl_add_box(FL_UP_BOX,0,0,320,250,"");
$menu = $obj = fl_add_menu(FL_PULLDOWN_MENU,20,95,60,20,"Menu");
fl_set_object_boxtype($obj,FL_FLAT_BOX);
fl_set_object_callback($obj, "menu_callback",0);
$button = $obj = fl_add_button(FL_MENU_BUTTON,100,90,75,30,"Button");
fl_set_object_callback($obj, "dopup_callback", 0);
fl_set_object_shortcut($obj, "#BB", 1);
$choice = $obj = fl_add_choice(FL_NORMAL_CHOICE2,195,90,105,30,"");
fl_set_object_callback($obj,"choice_callback", 0);
$status = $obj = fl_add_text(FL_NORMAL_TEXT,25,30,265,30,"");
fl_set_object_boxtype($obj,FL_FRAME_BOX);
fl_set_object_lalign($obj,FL_ALIGN_CENTER);
fl_set_object_dblbuffer($obj, 1);
$done_cb = $obj = fl_add_button(FL_NORMAL_BUTTON,210,200,85,30,"Done");
fl_end_form();
fl_adjust_form_size($pupform);
}
Xforms4Perl-0.8.4/DEMOS/xyplotactive.pl 100775 0 0 5545 6373210172 15745 0 ustar root root #!/usr/bin/perl
use X11::Xforms;
$test_interp = 0; # Set to 1 to test fl_get_xyplot_data and fl_interpolate
$axypform = undef;
$xyplot = undef;
$status = undef;
fl_initialize("FormDemo");
create_form_axypform();
fl_set_object_dblbuffer($status, 1);
for ($i = 0, $j = 0; $i <= 10; $i++, $j+=2)
{
$xy[$j] = $xy[$j+1] = $i;
}
fl_set_xyplot_data($xyplot, @xy, "","","");
fl_set_xyplot_linewidth($xyplot, 0, 2);
fl_set_xyplot_xgrid($xyplot,FL_GRID_MINOR);
fl_show_form($axypform,FL_PLACE_MOUSE,FL_TRANSIENT,"axypform");
fl_do_forms();
exit 0;
#/* callbacks for form axypform */
sub xyplot_cb
{
my($ob, $data) = @_;
($x, $y, $i) = fl_get_xyplot($ob);
return if(i < 0);
$buf = sprintf("X=%f Y=%f",$x,$y);
fl_set_object_label($status, $buf);
}
sub alwaysreturn_cb
{
my($ob, $data) = @_;
fl_set_xyplot_return($xyplot, fl_get_button($ob));
}
sub interpolate_cb
{
my($ob, $data) = @_;
my($degree) = fl_get_button($ob) ? 3:0;
if ($test_interp)
{
@nowxy = fl_get_xyplot_data($xyplot);
print "xyplot has @nowxy\n";
@interp = fl_interpolate(@nowxy, 0.2, $degree);
print "interpolated xyplot has @interp\n";
}
fl_set_xyplot_interpolate($xyplot, 0, fl_get_button($ob) ? 3:0, 0.2);
}
sub inspect_cb
{
my($ob, $data) = @_;
fl_set_xyplot_inspect($xyplot, fl_get_button($ob));
}
sub notic_cb
{
my($ob, $data) = @_;
$notic = fl_get_button($ob);
if($notic)
{
fl_set_xyplot_xtics($xyplot, -1, -1);
fl_set_xyplot_ytics($xyplot, -1, -1);
}
else
{
fl_set_xyplot_xtics($xyplot, 0, 0);
fl_set_xyplot_ytics($xyplot, 0, 0);
}
}
sub create_form_axypform
{
$axypform = fl_bgn_form(FL_NO_BOX, 431, 301);
$obj = fl_add_box(FL_UP_BOX,0,0,431,301,"");
$xyplot = $obj = fl_add_xyplot(FL_ACTIVE_XYPLOT,20,50,285,235,"");
fl_set_object_boxtype($obj,FL_DOWN_BOX);
fl_set_object_color($obj,FL_BLACK,FL_GREEN);
fl_set_object_lalign($obj,FL_ALIGN_BOTTOM|FL_ALIGN_INSIDE);
fl_set_object_callback($obj,"xyplot_cb",0);
$obj = fl_add_checkbutton(FL_PUSH_BUTTON,315,40,80,25,"AlwaysReturn");
fl_set_object_color($obj,FL_COL1,FL_BLUE);
fl_set_object_callback($obj,"alwaysreturn_cb",0);
$obj = fl_add_checkbutton(FL_PUSH_BUTTON,315,65,80,25,"Interpolate");
fl_set_object_color($obj,FL_COL1,FL_BLUE);
fl_set_object_callback($obj,"interpolate_cb",0);
$obj = fl_add_checkbutton(FL_PUSH_BUTTON,315,90,85,25,"InspectOnly");
fl_set_object_color($obj,FL_COL1,FL_BLUE);
fl_set_object_callback($obj,"inspect_cb",0);
$status = $obj = fl_add_box(FL_BORDER_BOX,45,15,170,25,"");
fl_set_object_boxtype($obj,FL_DOWN_BOX);
$obj = fl_add_button(FL_NORMAL_BUTTON,325,250,90,30,"Done");
$obj = fl_add_checkbutton(FL_PUSH_BUTTON,315,120,85,25,"NoTics");
fl_set_object_color($obj,FL_COL1,FL_BLUE);
fl_set_object_callback($obj,"notic_cb",0);
fl_end_form();
}
Xforms4Perl-0.8.4/DEMOS/xyplotover.pl 100711 0 0 2726 6367152102 15432 0 ustar root root #!/usr/bin/perl
use X11::Xforms;
#/* Demo showing the use of xyplot overlay. */
$fff = undef;
$xyplot = undef;
fl_initialize("Overlay Demo");
create_form_fff();
init_xyplot($fff);
fl_show_form($fff, FL_PLACE_MOUSE, FL_TRANSIENT, "XYPlot Overlay");
fl_do_forms();
exit 0;
sub init_xyplot
{
for ($i = 0, $j = 0; $i <= 10; $i++, $j+=2)
{
$xy[$j] = $i;
$xy[$j+1] = exp(-($xy[$j] - 5) * ($xy[$j] - 5) / 8);
}
fl_set_xyplot_data($xyplot, @xy, "", "", "");
fl_set_xyplot_ybounds($xyplot, 0, 1.1);
fl_set_xyplot_xbounds($xyplot, 0, 10);
fl_add_xyplot_overlay($xyplot, 1, @xy, FL_BLUE);
fl_set_xyplot_overlay_type($xyplot, 1, FL_DOTTED_XYPLOT);
fl_set_xyplot_interpolate($xyplot, 1, 2, 0.1);
fl_add_xyplot_text($xyplot, 0.5, 1.0, "Gaussian\nDistribution",
FL_ALIGN_RIGHT, FL_BLUE);
fl_set_xyplot_key($xyplot, 0, "Original");
fl_set_xyplot_key($xyplot, 1, "Overlay");
fl_set_xyplot_key_position($xyplot, 9.8, 1.08, FL_ALIGN_BOTTOM_LEFT);
}
sub create_form_fff
{
$fff = fl_bgn_form(FL_NO_BOX, 370, 310);
$obj = fl_add_box(FL_UP_BOX, 0, 0, 370, 310, "");
$xyplot = $obj = fl_add_xyplot(FL_IMPULSE_XYPLOT, 10, 20, 350, 260, "");
fl_set_object_lalign($obj, FL_ALIGN_BOTTOM | FL_ALIGN_INSIDE);
fl_set_object_lsize($obj, FL_NORMAL_SIZE);
$obj = fl_add_button(FL_HIDDEN_BUTTON, 10, 10, 350, 290, "");
fl_set_button_shortcut($obj,"qQ", 0);
fl_end_form();
}
Xforms4Perl-0.8.4/DEMOS/folder.pl 100711 0 0 21166 6416172034 14472 0 ustar root root #!/usr/bin/perl
use X11::Xforms;
#
# This demonstartes the building and use of folders. It also demonstrates how
# to use the fdui field of the form structure in order to build an
# application on the same lines as done by fdesign.
#
fl_initialize("Folder example");
$fd_mainform = create_form_mainform();
make_folder($fd_mainform->{"folder"});
fl_show_form($fd_mainform->{"mainform"},FL_PLACE_CENTER,FL_FULLBORDER,"buttonform");
fl_do_forms() while(1);
exit 0;
sub done_cb
{
exit(0);
}
sub hide_show_cb
{
($ob, $data) = @_;
$fdui = $ob->form->fdui;
$data ? fl_show_object($fdui->{"folder"}) : fl_hide_object($fdui->{"folder"});
}
sub reshow_cb
{
($ob, $data) = @_;
fl_hide_form($ob->form);
fl_show_form($ob->form,FL_PLACE_CENTER,FL_FULLBORDER,"buttonform");
}
sub set_cb
{
($ob, $data) = @_;
$fdui = $ob->form->fdui;
$n = fl_get_active_folder_number($fdui->{"folder"});
fl_set_folder_bynumber($fdui->{"folder"}, ($n%5)+1);
}
sub deactivate_cb
{
($ob, $data) = @_;
$fdui = $ob->form->fdui;
if($fdui->{"folder"}->active > 0)
{
fl_set_object_label($ob,"Activate");
fl_deactivate_object($fdui->{"folder"});
}
else
{
fl_set_object_label($ob,"Deactivate");
fl_activate_object($fdui->{"folder"});
}
}
sub make_folder
{
my($folder) = @_;
$fd_buttonform = create_form_buttonform();
$fd_staticform = create_form_staticform();
$fd_valuatorform = create_form_valuatorform();
$fd_choiceform = create_form_choiceform();
$fd_inputform = create_form_inputform();
fl_addto_menu($fd_choiceform->{"pulldown"},"MenuEntry1|MenuEntry2|MenuEntry3|MenuEntry4");
fl_addto_menu($fd_choiceform->{"pushmenu"},"MuEntry1|MenuEntry2|MenuEntry3");
fl_addto_choice($fd_choiceform->{"choice"},"Choice1|Choice2|Choice3|Choice4|Choice5|Choice6");
fl_load_browser($fd_choiceform->{"browser"},"folder.pl");
fl_addto_tabfolder($folder,"ButtonObj", $fd_buttonform->{"buttonform"});
fl_addto_tabfolder($folder,"StaticObj", $fd_staticform->{"staticform"});
fl_addto_tabfolder($folder,"ValuatorObj", $fd_valuatorform->{"valuatorform"});
fl_addto_tabfolder($folder,"ChoiceObj", $fd_choiceform->{"choiceform"});
fl_addto_tabfolder($folder,"InputObj", $fd_inputform->{"inputform"});
}
sub create_form_buttonform
{
# %fdui = {
# buttonform => undef
# };
$fdui->{"buttonform"} = fl_bgn_form(FL_NO_BOX, 430, 210);
$obj = fl_add_box(FL_FLAT_BOX,0,0,430,210,"");
$obj = fl_add_button(FL_NORMAL_BUTTON,30,151,80,30,"Button");
$obj = fl_add_roundbutton(FL_PUSH_BUTTON,40,91,100,30,"RoundButton");
$obj = fl_add_round3dbutton(FL_PUSH_BUTTON,135,151,110,30,"Round3DButton");
fl_set_object_color($obj,FL_COL1,FL_BLUE);
$obj = fl_add_checkbutton(FL_PUSH_BUTTON,170,111,110,30,"CheckButton");
$obj = fl_add_lightbutton(FL_PUSH_BUTTON,30,31,100,30,"LightButton");
$obj = fl_add_pixmapbutton(FL_NORMAL_BUTTON,320,36,80,80,"PixmapButton");
fl_set_pixmapbutton_file($obj, "porsche.xpm");
$obj = fl_add_button(FL_NORMAL_BUTTON,185,26,100,30,"Button");
fl_set_object_boxtype($obj,FL_ROUNDED3D_UPBOX);
$obj = fl_add_lightbutton(FL_PUSH_BUTTON,290,146,100,30,"Button");
fl_set_object_boxtype($obj,FL_EMBOSSED_BOX);
$obj = fl_add_button(FL_NORMAL_BUTTON,175,71,60,25,"Button");
fl_set_object_boxtype($obj,FL_SHADOW_BOX);
fl_set_object_color($obj,FL_COL1,FL_SLATEBLUE);
fl_end_form();
$fdui->{"buttonform"}->fdui($fdui);
return $fdui;
}
sub create_form_staticform
{
# %fdui = {
# staticform => undef
# };
$fdui->{"staticform"} = fl_bgn_form(FL_NO_BOX, 431, 211);
$obj = fl_add_box(FL_FLAT_BOX,0,0,431,211,"");
fl_set_object_color($obj,FL_INDIANRED,FL_INDIANRED);
fl_set_object_lcolor($obj,FL_INDIANRED);
$obj = fl_add_box(FL_UP_BOX,40,40,60,45,"A Box");
$obj = fl_add_labelframe(FL_ENGRAVED_FRAME,130,30,120,55,"LabelFrame");
fl_set_object_color($obj,FL_BLACK,FL_INDIANRED);
fl_set_object_lstyle($obj,FL_BOLD_STYLE);
$obj = fl_add_chart(FL_BAR_CHART,270,20,130,105,"Chart");
$c = FL_BLACK;
fl_add_chart_value($obj,15.0,"item 1",++$c);
fl_add_chart_value($obj,5.0,"item 2",++$c);
fl_add_chart_value($obj,0.0,"item 3",++$c);
fl_add_chart_value($obj,-10.,"item 4",++$c);
fl_add_chart_value($obj,25.0,"item 5",++$c);
fl_add_chart_value($obj,12.0,"item 6",++$c);
$obj = fl_add_clock(FL_ANALOG_CLOCK,30,100,85,85,"Clock");
fl_set_object_color($obj,FL_COL1,FL_RIGHT_BCOL);
$obj = fl_add_bitmap(FL_NORMAL_BITMAP,150,140,30,25,"Bitmap");
fl_set_bitmap_file($obj, "srs.xbm");
$obj = fl_add_pixmap(FL_NORMAL_PIXMAP,230,120,40,40,"Pixmap");
fl_set_pixmap_file($obj, "crab.xpm");
$obj = fl_add_text(FL_NORMAL_TEXT,310,150,70,25,"Text");
fl_set_object_boxtype($obj,FL_BORDER_BOX);
fl_set_object_lalign($obj,FL_ALIGN_LEFT|FL_ALIGN_INSIDE);
fl_end_form();
$fdui->{"staticform"}->fdui($fdui);
return $fdui;
}
sub create_form_mainform
{
# %fdui = {
# mainform => undef,
# done => undef,
# hide => undef,
# show => undef,
# reshow => undef,
# folder => undef,
# set => undef,
# deactivate => undef
# };
$fdui->{"mainform"} = fl_bgn_form(FL_NO_BOX, 461, 311);
$obj = fl_add_box(FL_UP_BOX,0,0,461,311,"");
$fdui->{"done"} = $obj = fl_add_button(FL_NORMAL_BUTTON,381,270,64,25,"Done");
fl_set_object_callback($obj,"done_cb",0);
$fdui->{"hide"} = $obj = fl_add_button(FL_NORMAL_BUTTON,15,269,64,27,"Hide");
fl_set_button_shortcut($obj,"#H",1);
fl_set_object_callback($obj,"hide_show_cb",0);
$fdui->{"show"} = $obj = fl_add_button(FL_NORMAL_BUTTON,79,269,64,27,"Show");
fl_set_button_shortcut($obj,"#S",1);
fl_set_object_callback($obj,"hide_show_cb",1);
$fdui->{"reshow"} = $obj = fl_add_button(FL_NORMAL_BUTTON,155,269,64,27,"ReShow");
fl_set_button_shortcut($obj,"#R",1);
fl_set_object_callback($obj,"reshow_cb",0);
$fdui->{"folder"} = $obj = fl_add_tabfolder(FL_TOP_TABFOLDER,15,21,435,230,"");
$fdui->{"set"} = $obj = fl_add_button(FL_NORMAL_BUTTON,232,269,64,27,"Set");
fl_set_object_callback($obj,"set_cb",0);
$fdui->{"deactivate"} = $obj = fl_add_button(FL_NORMAL_BUTTON,296,269,69,27,"Deactivate");
fl_set_object_callback($obj,"deactivate_cb",0);
fl_end_form();
$fdui->{"mainform"}->fdui($fdui);
return $fdui;
}
sub create_form_valuatorform
{
# %fdui = {
# valuatorform => undef
# };
$fdui->{"valuatorform"} = fl_bgn_form(FL_NO_BOX, 431, 211);
$obj = fl_add_box(FL_FLAT_BOX,0,0,431,211,"");
$obj = fl_add_positioner(FL_NORMAL_POSITIONER,300,102,90,80,"");
fl_set_positioner_xvalue($obj, 0.679012);
fl_set_positioner_yvalue($obj, 0.71831);
$obj = fl_add_valslider(FL_HOR_NICE_SLIDER,70,20,240,20,"");
fl_set_object_boxtype($obj,FL_FLAT_BOX);
fl_set_object_color($obj,FL_COL1,FL_RIGHT_BCOL);
fl_set_slider_value($obj, 0.87);
$obj = fl_add_counter(FL_NORMAL_COUNTER,285,54,110,20,"");
fl_set_counter_value($obj, -1.0);
$obj = fl_add_slider(FL_VERT_NICE_SLIDER,20,30,20,160,"");
fl_set_object_boxtype($obj,FL_FLAT_BOX);
fl_set_object_color($obj,FL_COL1,FL_RED);
fl_set_slider_value($obj, 0.49);
$obj = fl_add_valslider(FL_HOR_BROWSER_SLIDER,70,170,150,23,"");
fl_set_slider_size($obj, 0.10);
$obj = fl_add_slider(FL_HOR_FILL_SLIDER,69,57,159,27,"");
fl_set_object_color($obj,FL_COL1,FL_SLATEBLUE);
fl_set_slider_value($obj, 0.25);
$obj = fl_add_dial(FL_LINE_DIAL,147,93,72,60,"");
fl_set_object_boxtype($obj,FL_UP_BOX);
fl_set_object_color($obj,FL_COL1,FL_BLUE);
fl_end_form();
$fdui->{"valuatorform"}->fdui($fdui);
return $fdui;
}
sub create_form_choiceform
{
# %fdui = {
# choiceform => undef,
# pulldown => undef,
# choice => undef,
# browser => undef,
# pushmenu => undef
# };
$fdui->{"choiceform"} = fl_bgn_form(FL_NO_BOX, 431, 211);
$obj = fl_add_box(FL_FLAT_BOX,0,0,431,211,"");
$fdui->{"pulldown"} = $obj = fl_add_menu(FL_PULLDOWN_MENU,45,36,45,21,"Menu");
fl_set_object_boxtype($obj,FL_FLAT_BOX);
fl_set_object_color($obj,FL_COL1,FL_LEFT_BCOL);
$fdui->{"choice"} = $obj = fl_add_choice(FL_NORMAL_CHOICE2,24,93,111,27,"");
$fdui->{"browser"} = $obj = fl_add_browser(FL_HOLD_BROWSER,257,14,154,179,"");
$fdui->{"pushmenu"} = $obj = fl_add_menu(FL_PUSH_MENU,152,51,75,26,"Menu");
fl_set_object_boxtype($obj,FL_UP_BOX);
fl_end_form();
$fdui->{"choiceform"}->fdui($fdui);
return $fdui;
}
sub create_form_inputform
{
# %fdui = {
# inputform => undef
# };
$fdui->{"inputform"} = fl_bgn_form(FL_NO_BOX, 430, 210);
$obj = fl_add_box(FL_FLAT_BOX,0,0,430,210,"");
$obj = fl_add_input(FL_MULTILINE_INPUT,70,20,280,90,"MultiLine\nInput");
$obj = fl_add_input(FL_NORMAL_INPUT,80,132,250,34,"Input");
fl_end_form();
$fdui->{"inputform"}->fdui($fdui);
return $fdui;
}
Xforms4Perl-0.8.4/DEMOS/porsche.xpm 100600 0 0 11015 6367356033 15050 0 ustar root root /* XPM */
static char * porsche[] = {
/* porsche pixmap
* width height ncolors chars_per_pixel */
"64 64 4 1 ",
" c None m None s s_slateblue ",
". c yellow m white s s_yellow ",
"r c red m white s s_red ",
"b c black m black s s_black ",
/* pixels */
" ",
" ",
" bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ",
" bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ",
" bb............................................bb ",
" bb..bbbb..bbbb..bbbb..bbbb..bbbb..b..b..bbbb..bb ",
" bb..b..b..b..b..b..b..b..b..b..b..b..b..b.....bb ",
" bb..b..b..b..b..b..b..b.....b.....b..b..b.....bb ",
" bb..bbbb..b..b..bbb...bbbb..b.....bbbb..bbbb..bb ",
" bb..b.....b..b..b..b.....b..b.....b..b..b.....bb ",
" bb..b.....b..b..b..b..b..b..b..b..b..b..b.....bb ",
" bb..b.....bbbb..b..b..bbbb..bbbb..b..b..bbbb..bb ",
" bb............................................bb ",
" bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ",
" bb.....................bbbbbbbbbbbbbbbbbbbbbbbbb ",
" bb......b...b...bb.....bbbbbbbbbbbbbbbbbbbbbbbbb ",
" bb.....b...b...b....b..bbbbbbbbbbbbbbbbbbbbbbbbb ",
" bb....bb..bb.bbbbbbb...bbbbbbbbbbbbbbbbbbbbbbbbb ",
" bb...bbbbbbbb......bb..bbrrrrrrrrrrrrrrrrrrrrrbb ",
" bb..bbbb...............bbrrrrrrrrrrrrrrrrrrrrrbb ",
" bb.bbb.................bbrrrrrrrrrrrrrrrrrrrrrbb ",
" bb..........b..b.......bbrrrrrrrrrrrrrrrrrrrrrbb ",
" bb.....b...b..b........bbrrrrrrrrrrrrrrrrrrrrrbb ",
" bb....b...b..b..bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ",
" bb....b.bbbbbbbbb..............bbbbbbbbbbbbbbbbb ",
" bb...bbbb.......bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ",
" bb..bbb.........b..............bbbbbbbbbbbbbbbbb ",
" bb.bbb..........b...bbb........bbbbbbbbbbbbbbbbb ",
" bb.........b..b.b..bbbbb.......bbbbbbbbbbbbbbbbb ",
" bb.....b..b..b..b..b.bbb.....b.brrrrrrrrrrrrrrbb ",
" bb....b..b..b..bb....bbb....bb.brrrrrrrrrrrrrrbb ",
" bb...bb.bbbbbbb.b....bbb....bb.brrrrrrrrrrrrrrbb ",
" bb..bbbbb......bb...bbbbb...b..brrrrrrrrrrrrrrbb ",
" bb.bbb..........b.bbbbbbbbbbb..brrrrrrrrrrrrrrbb ",
" bb..............b.b.bbbbbbbbb..brrrrrrrrrrrrrrbb ",
" bbbbbbbbbbbbbbbbb.b.b....bbbb..bbbbbbbbbbbbbbbbb ",
" bbbbbbbbbbbbbbbbb...b.....b.b..b..............bb ",
" bbbbbbbbbbbbbbbbb........bb.bb.b...b..b.......bb ",
" bbbbbbbbbbbbbbbb........b..b..b..b..b...b...bb ",
" bbbbbbbbbbbbbbbb.......b..b...b.b..b...b....bb ",
" bbbbbbbbbbbbbbbbb............b.bbbbbbbbbb...bb ",
" bbrrrrrrrrrrrrrrb..........bbbb........bb.bb ",
" bbrrrrrrrrrrrrrrrb........bbbb............bb ",
" bbrrrrrrrrrrrrrrrbbbbbbbb.......b..b....bb ",
" bbrrrrrrrrrrrrrrrrrrbb.....b...b..b..b..bb ",
" bbrrrrrrrrrrrrrrrrrbb....b...b..b..b..bb ",
" bbrrrrrrrrrrrrrrrrrbb...bb.bbbbbbbb...bb ",
" bbbbbbbbbbbbbbbbbbbb...bbbb......bb.bb ",
" bbbbbbbbbbbbbbbbbbb..bbb...........b ",
" bbbbbbbbbbbbbbbbbbb.bbb...........bb ",
" bbbbbbbbbbbbbbbbbb..............bb ",
" bbbbbbbbbbbbbbbbb...b.b.b.....bb ",
" bbbbbbbbbbbbbbbb..b.b.b..b..bb ",
" bbrrrrrrrrrrrbb..bbbbbbb..bb ",
" bbrrrrrrrrrrbb.bbb....b.bb ",
" bbrrrrrrrrrbb.bb......bb ",
" bbbrrrrrrrbb.......bbb ",
" bbbbrrrrrbb.....bbbb ",
" bbbbrrrbb...bbbb ",
" bbbbrbb.bbbb ",
" bbbbbbbb ",
" bbbb ",
" bb ",
" "
} ;
Xforms4Perl-0.8.4/DEMOS/pup.pl 100711 0 0 12317 6373175554 14035 0 ustar root root #!/usr/bin/perl
use X11::Xforms;
#/* Demo: complete pop-ups.
# * test font/cursor change
# * test attaching pup to menu
# */
$subm = -1;
$m = -1;
$ssm = undef;
$n = undef;
$n1 = -1;
$n2 = -1;
$pup = undef;
$done = $pret = $b1 = $b2 = $b3 = $menu = undef;
$aa = X11::Xforms::FLOpt::new;
$mask = FL_PDVisual;
$aa->vclass(FL_DefaultVisual);
fl_set_defaults($mask, $aa);
fl_initialize("FormDemo");
create_form_pup();
fl_set_object_posthandler($b1, "post");
fl_set_object_posthandler($b2, "post");
fl_set_object_posthandler($b3, "post");
fl_show_form($pup, FL_PLACE_MOUSE, FL_TRANSIENT,"PupDemo");
init_menu();
fl_do_forms();
exit 0;
#/* post-handler */
sub post
{
my($ob, $ev, $mx, $y, $key, $xev) = @_;
if($n1 == -1)
{
$n1 = fl_defpup(FL_ObjWin($ob),"line1|line2");
fl_setpup_shadow($n1,0);
fl_setpup_bw($n1,0);
fl_setpup_pad($n1,3,0);
$n2 = fl_defpup(FL_ObjWin($ob),"button1|button2");
fl_setpup_shadow($n2,0);
fl_setpup_bw($n2,-1);
fl_setpup_pad($n2,3,0);
}
if($ev == FL_ENTER)
{
if($ob==$b3)
{
fl_show_oneliner("button3",$ob->form->x+$ob->x,
$ob->form->y+$ob->y + $ob->h + 5);
}
else
{
fl_setpup_position($ob->form->x+$ob->x, $ob->form->y+$ob->y+$ob->h+5);
fl_showpup(($ob==$b1) ? $n1:$n2);
}
}
elsif($ev != FL_MOTION)
{
if($ob==$b3)
{
fl_hide_oneliner();
}
else
{
fl_hidepup(($ob==$b1) ? $n1:$n2);
}
}
return 0;
}
sub show_return_val
{
my($i) = @_;
if($i >= 0)
{
$buf = sprintf("Returned %d(%s)",$i, fl_getpup_text($m,$i));
}
else
{
$buf = sprintf($buf,"Returned %d",$i);
}
fl_set_object_label($pret, $buf);
}
sub ssm_cb
{
my($a) = @_;
show_return_val($a);
return $a;
}
sub do_pup
{
my($ob, $q) = @_;
if($subm == -1)
{
$ssm = fl_newpup(FL_ObjWin($ob));
$subm = fl_newpup(FL_ObjWin($ob));
$m = fl_newpup(FL_ObjWin($ob));
#/* fl_addtopup(ssm,"SubSubM%F%t",ssm_cb);*/
fl_addtopup($ssm,"SSMItem20%x20%R1");
fl_addtopup($ssm,"SSMItem21%x21%r1");
fl_addtopup($ssm,"SSMItem22%x22%r1%l");
fl_addtopup($ssm,"SSMitem30%x30%R2");
fl_addtopup($ssm,"SSMItem31%x31%r2");
fl_addtopup($ssm,"SSMItem32%x32%r2");
#/* fl_addtopup(subm,"SubMenu%t");*/
fl_addtopup($subm,"SMItemA\tAlt-A%x10");
fl_setpup_shortcut($subm, 10, "#a");
fl_addtopup($subm,"SMItemB\tAlt-B%x11");
fl_setpup_shortcut($subm, 11, "#b");
fl_addtopup($subm,"SMItemC\tAlt-C%x12");
fl_setpup_shortcut($subm, 12, "#c");
fl_addtopup($subm,"SMItemD\tAlt-F5%x13");
fl_setpup_submenu($subm, 13, $ssm);
fl_setpup_shortcut($subm, 13, "#&5");
fl_addtopup($subm,"SMItemE\tAlt-E%x14");
fl_setpup_shortcut($subm, 14, "#E");
fl_setpup_mode($subm, 14, FL_PUP_GREY);
$i = 0;
fl_addtopup($m,"PopUP%t"); $i++;
fl_addtopup($m,"MenuItem1");
fl_setpup_shortcut($subm, $i++, "1#1");
fl_addtopup($m,"MenuItem2");
fl_setpup_shortcut($subm, $i, "2#2");
fl_setpup_submenu($m, $i++, $subm);
fl_addtopup($m,"MenuItem3");
fl_setpup_shortcut($subm, $i, "3#3");
fl_addtopup($m,"MenuItem4");
fl_setpup_shortcut($subm, $i, "4#4");
}
if(fl_get_button_numb($ob) >= FL_SHORTCUT)
{
fl_setpup_position($ob->form->x + $ob->x,
$ob->form->y + $ob->y + $ob->h);
}
show_return_val(fl_dopup($m));
# /* test if changing size/style ok */
$n = !$n;
fl_setpup_fontsize($n ? 14:12);
fl_setpup_fontstyle($n ? FL_TIMES_STYLE:FL_BOLDITALIC_STYLE);
fl_setpup_cursor($m, $n ? XC_hand2:XC_sb_right_arrow);
}
sub init_menu
{
$mm = fl_newpup(fl_default_win());
fl_setpup_bw($mm, -2);
fl_setpup_shadow($mm, 0);
$smm = fl_newpup(0);
fl_setpup_shadow($smm, 0);
fl_addtopup($mm,"MenuItem1|MenuItem2|MenuItem3");
fl_addtopup($smm,"SubItem1%x11|SubItem2%x12|SubItem3%x13");
fl_setpup_submenu($mm, 2, $smm);
# /* attach pup to menu */
fl_set_menu_popup($menu, $mm);
}
sub do_menu(FL_OBJECT *ob, long data)
{
my($ob, $data) = @_;
if(fl_get_menu($ob) >= 0)
{
$buf = sprintf("%d (%s)", fl_get_menu($ob), fl_get_menu_text($ob));
}
else
{
$buf = sprintf($buf,"%d", fl_get_menu($ob));
}
fl_set_object_label($pret, $buf);
}
sub done_cb
{
exit(0);
}
sub create_form_pup
{
return if ($pup);
$pup = fl_bgn_form(FL_UP_BOX,260,210);
$done = $obj = fl_add_button(FL_NORMAL_BUTTON,150,150,90,35,"Done");
fl_set_object_callback($obj,"done_cb", 0);
$obj = fl_add_button(FL_MENU_BUTTON,30,90,100,30,"PopUp");
fl_set_button_shortcut($obj,"Pp#p",1);
fl_set_object_callback($obj, "do_pup", 0);
$menu = $obj = fl_add_menu(FL_PULLDOWN_MENU,160,95,60,25,"Menu");
fl_set_object_callback($obj, "do_menu", 0);
$pret = $obj = fl_add_text(FL_NORMAL_TEXT,20,60,220,30,"");
fl_set_object_lalign($obj,FL_ALIGN_CENTER);
$b1 = fl_add_button(FL_NORMAL_BUTTON, 20, 10, 60, 30,"Button1");
$b2 = fl_add_button(FL_NORMAL_BUTTON, 90, 10, 60, 30,"Button2");
$b3 = fl_add_button(FL_NORMAL_BUTTON, 160, 10, 60, 30,"Button3");
fl_end_form();
}
Xforms4Perl-0.8.4/DEMOS/XFtool.pl 100755 0 0 32047 6440527724 14451 0 ustar root root #!/usr/bin/perl
use X11::Xforms;
#
# Example (and test) of the use of Xforms from PERL!!
#
# This PERL script is deliberately incomplete (well thats my excuse anyway!!).
#
# It is also rather messy - it SHOULD use PERL OO style programming, but
# doesn't.
#
# So what does it do? Well, it manages a toolbar in a similar fashion to
# MS Office. You can add tools, move them around, and delete them.
#
# Enhancements since the first version:
# Tooltips courtesy of fl_show_oneliner
# Command Line and Pixmap file browsing when editting tools
# along with extra buttons on the pixmap browser to
# allow you to create your own pixmaps or edit existing
# ones (via xpaint)
#
# And what is left to do? Well, firstly it puts itself at the top of the
# screen without Window Manager adornment - this is either desirable
# (in which case leave it) or not - in which case either change the
# fl_show_forms for $toolform - or be a bit more clever and add an option
# to the Control panel). And there is NO help whatsoever. That should be a
# simple browser loaded with a file.
#
# You might also want to make it save the options you change. I have added
# the PERL code necessary to recognize resources in the name xftoolxxxxx.
# this is an example of how to do the option/resource processing available
# in XForms when you code an application in perl. Add/remove what you will
# to customize as you see fit.
#
# By and large, however, the basics are there.
#
# So why leave it incomplete? Three reasons:
#
# 1) I promised some people this wonder-package by a certain date
# and its going to be late already!
# 2) The bits that need adding are definately up to user taste
# 3) It gives you an exercise in using Xforms with PERL.
#
#
# THE PROGRAM USES WHICH TO LOCATE TOOL EXECUTABLES. IF YOUR SYSTEM DOES NOT
# HAVE WHICH, SUBSTITUTE WHAT EVER PROGRAM SEARCHES FOR A BINARY IN YOUR
# PATH STATEMENT - OR BUILD ONE!!
#
$which = "which";
#
# Good luck.
#
#
use X11::Xforms;
$BUTTONSIZE=38;
$PIXEDITOR="xpaint -size '30x30' ";
$executor="Exec:Execute a program:$ENV{'X11HOME'}/include/X11/pixmaps/XFexec.xpm:1";
$controler="Cntl:Configure the Toolbar:$ENV{'X11HOME'}/include/X11/pixmaps/XFcntl.xpm:2";
@inttools = ($executor, $controler);
@internal = (\&run_executor, \&run_controller);
$controlform = 0;
$editform = 0;
$tbrws = 0;
$sel = 0;
$exec_fsel = 1;
$pix_fsel = 0;
@edit_tool_text = (0,0,0);
$SIG{"CHLD"} = "IGNORE";
open(TOOLS, "$ENV{HOME}/.XFtools");
@toolbar = <TOOLS>;
close TOOLS;
@buttons = ();
while($toolbar[0] =~ /^OPTS:/) {
($dummy, $opt) = split(/:/, shift(@toolbar));
eval ($opt) if (!$a);
push (@options, "OPTS:$opt");
}
chop(@toolbar);
fl_initialize('Toolbar');
$scrw = fl_scrw();
$toolform = "FIRST";
build_toolbar();
fl_do_forms();
sub button_callback {
my($obj, $parm) = @_;
my(@exectools) = (@toolbar, @inttools);
my($name, $longname, $pixpath, $cmdpath) =
split(/:/, $exectools[$parm]);
$button = fl_get_button_numb($obj);
if ($cmdpath > 0) {
fl_deactivate_form($toolform);
&{$internal[$cmdpath-1]}();
fl_activate_form($toolform);
} else {
if (system("$which $cmdpath > /dev/null") != 0 &&
! -f "$cmdpath") {
fl_show_alert("Program not found", "$cmdpath cannot be found","", 0);
} else {
exec ($cmdpath) if (!fork());
}
}
}
sub group_callback {
my($obj, $group) = @_;
print "in $group\n";
}
sub post
{
my($ob, $ev, $mx, $my, $key, $xev) = @_;
if($ev == FL_ENTER)
{
my(@exectools) = (@toolbar, @inttools);
my($name, $longname, $pixpath, $cmdpath) =
split(/:/, $exectools[$ob->u_ldata]);
my($ox, $oy, $ow, $oh, $form) =
(fl_get_object_geometry($ob), $ob->form);
$strs = fl_get_string_width(FL_DEFAULT_SIZE,
FL_NORMAL_STYLE,
$longname,
length($longname));
$olx = $ox + $form->x + 2;
fl_show_oneliner($longname, $olx,
$oy + $form->y + 1 + $oh);
}
elsif($ev == FL_LEAVE){
fl_hide_oneliner();
}
return 0;
}
sub run_controller {
if (!$controlform) {
$controlform = fl_bgn_form(FL_NO_BOX, 320, 265);
fl_add_box(FL_UP_BOX,0,0,320,265,"");
$tbrws = fl_add_browser(FL_HOLD_BROWSER,10,15,150,240,"");
fl_set_object_callback($tbrws, "set_selected", 1);
$cntlok = fl_add_button(FL_NORMAL_BUTTON,220,15,90,30,"OK");
$cntlcan = fl_add_button(FL_NORMAL_BUTTON,220,50,90,30,"Cancel");
$obj = fl_add_button(FL_NORMAL_BUTTON,220,85,90,30,"Add tool");
fl_set_object_callback($obj, "edit_tool", 1);
$obj = fl_add_button(FL_NORMAL_BUTTON,170,65,40,60,'@8->');
fl_set_object_lcol($obj,FL_BLUE);
fl_set_call_back($obj, "move_tool_up", 1);
$obj = fl_add_button(FL_NORMAL_BUTTON,170,145,40,60,'@8<-');
fl_set_object_lcol($obj,FL_BLUE);
fl_set_call_back($obj, "move_tool_down", 1);
$obj = fl_add_button(FL_NORMAL_BUTTON,220,155,90,30,"Delete Tool");
fl_set_call_back($obj, "delete_tool", 1);
$obj = fl_add_button(FL_NORMAL_BUTTON,220,120,90,30,"Edit tool");
fl_set_call_back($obj, "edit_tool", 0);
$obj = fl_add_button(FL_NORMAL_BUTTON,220,190,90,30,"Help");
$obj = fl_add_button(FL_NORMAL_BUTTON,220,225,90,30,"Quit XFtool");
fl_set_call_back($obj, "exit_xftool", 0);
fl_end_form();
}
fl_clear_browser($tbrws);
$browser_lines = 0;
foreach $tool (@toolbar) {
($name, $longname, $pixpath, $cmdpath) = split(/:/, $tool);
fl_add_browser_line($tbrws, $longname);
$browser_lines++;
}
$changes = 0;
@worktoolbar = @toolbar;
fl_show_form($controlform,
FL_PLACE_POSITION,
FL_FULLBORDER,
"Tool Control");
if ($cntlok == fl_do_forms() && $changes) {
@toolbar = @worktoolbar;
open(TOOLS, ">$ENV{HOME}/.XFtools");
$" = "\n";
print TOOLS "$options" if ($options);
print TOOLS "@toolbar\n";
close TOOLS;
build_toolbar();
}
fl_hide_form($controlform);
}
sub move_tool_up {
if ($sel > 1) {
$oldline = fl_get_browser_line($tbrws, $sel-1);
$selline = fl_get_browser_line($tbrws, $sel);
fl_replace_browser_line($tbrws, $sel-1, $selline);
fl_replace_browser_line($tbrws, $sel, $oldline);
fl_select_browser_line($tbrws, $sel-1);
$temp = $worktoolbar[$sel-1];
$worktoolbar[$sel-1] = $worktoolbar[$sel-2];
$worktoolbar[$sel-2] = $temp;
$changes = 1;
--$sel;
}
}
sub move_tool_down {
if ($sel < $browser_lines) {
$oldline = fl_get_browser_line($tbrws, $sel+1);
$selline = fl_get_browser_line($tbrws, $sel);
fl_replace_browser_line($tbrws, $sel+1, $selline);
fl_replace_browser_line($tbrws, $sel, $oldline);
fl_select_browser_line($tbrws, $sel+1);
$temp = $worktoolbar[$sel-1];
$worktoolbar[$sel-1] = $worktoolbar[$sel];
$worktoolbar[$sel] = $temp;
$changes = 1;
++$sel;
}
}
sub delete_tool {
if ($sel) {
fl_delete_browser_line($tbrws, $sel);
fl_deselect_browser_line($tbrws, $sel);
splice(@worktoolbar, $sel-1, 1);
$changes = 1;
$browser_lines--;
$sel = 0;
}
}
sub set_selected {
$sel = fl_get_browser($tbrws);
}
sub run_executor {
fl_use_fselector($exec_fsel);
my($fsel) = fl_get_fselector_fdstruct();
my($readybut, $fselform) =
($fsel->ready(), $fsel->fselect());
print "$fsel, $readybut, $fselform\n";
fl_set_form_title($fselform, "Execute a Command");
fl_set_object_label($readybut, "Execute");
$cmdpath = fl_show_fselector("Enter the command you want to execute",
"$ENV{X11HOME}/bin",
"",
"");
if (-f $cmdpath) {
exec ($cmdpath) if (!fork());
}
}
sub edit_tool {
my($obj, $editadd) = @_;
if (!$editform) {
@errstring = (
"Tool name must be non-blank",
"Short name must be non-blank",
"Command line is invalid",
"Pixmap path is invalid");
$editform = fl_bgn_form(FL_NO_BOX, 320, 215);
fl_add_box(FL_UP_BOX,0,0,320,215,"");
$edittln = fl_add_input(FL_NORMAL_INPUT,10,25,110,25,"Tool Name");
fl_set_input_scroll($edittln, 0);
fl_set_object_callback($edittln, "edit_callback", 0);
fl_set_object_lalign($edittln,FL_ALIGN_RIGHT);
$edittls = fl_add_input(FL_NORMAL_INPUT,190,25,40,25,"Short Name");
fl_set_input_scroll($edittls, 0);
fl_set_object_callback($edittls, "edit_callback", 0);
fl_set_object_lalign($edittls,FL_ALIGN_RIGHT);
fl_add_text(FL_NORMAL_TEXT,5,55,125,15,"Command Line:");
$editcmd = fl_add_input(FL_NORMAL_INPUT,10,70,220,25,"");
fl_set_object_callback($editcmd, "edit_callback", 0);
fl_set_object_lalign($editcmd,FL_ALIGN_RIGHT);
$edit_tool_text[1] = $editcmd;
my($ob) = fl_add_button(FL_NORMAL_BUTTON,235,70,75,25,"Browse");
fl_set_object_callback($ob, "edit_callback", 1);
fl_add_text(FL_NORMAL_TEXT,5,100,125,15,"Pixmap Path:");
$editpix = fl_add_input(FL_NORMAL_INPUT,10,115,220,25,"");
fl_set_object_callback($editpix, "edit_callback", 0);
fl_set_object_lalign($editpix,FL_ALIGN_TOP_LEFT);
$edit_tool_text[2] = $editpix;
$ob = fl_add_button(FL_NORMAL_BUTTON,235,115,75,25,"Browse");
fl_set_object_callback($ob, "edit_callback", 2);
$editok = fl_add_button(FL_NORMAL_BUTTON,10,175,80,30,"OK");
$editcan = fl_add_button(FL_NORMAL_BUTTON,120,175,80,30,"Cancel");
$edithlp = fl_add_button(FL_NORMAL_BUTTON,230,175,80,30,"Help");
fl_add_text(FL_NORMAL_TEXT,5,145,125,25,"Enter tool button details");
$errtext = fl_add_text(FL_NORMAL_TEXT,140,145,175,25,"");
fl_set_object_lcol($errtext,FL_RED);
fl_set_object_lalign($errtext,FL_ALIGN_RIGHT);
fl_end_form();
}
if ($editadd) {
fl_set_input($edittln, "");
fl_set_input($edittls, "");
fl_set_input($editcmd, "");
fl_set_input($editpix, "");
$edittitle = "Define new Tool";
} elsif ($sel) {
my($short,$long,$pix,$cmd) =
@edititem = split(/:/,$worktoolbar[$sel-1]);
fl_set_input($edittln, "$long");
fl_set_input($edittls, "$short");
fl_set_input($editcmd, "$cmd");
fl_set_input($editpix, "$pix");
$edittitle = "Edit Tool";
} else {
return;
}
fl_deactivate_form($controlform);
fl_show_form($editform,
FL_PLACE_MOUSE,
FL_FULLBORDER,
"$edittitle");
until (($tempbutton = fl_do_forms()) == $editcan) {
$editerror = 0;
if ($tempbutton == $editok) {
@edititem = (fl_get_input($edittls),
fl_get_input($edittln),
fl_get_input($editpix),
fl_get_input($editcmd));
$editerror == 4 if ($edititem[3] =~ /^\s*$/);
$editerror == 3 if ($edititem[2] =~ /^\s*$/);
$editerror == 2 if ($edititem[1] =~ /^\s*$/);
$editerror == 1 if ($edititem[0] =~ /^\s*$/);
if (!$editerror) {
$newtool = join(':', @edititem);
$changes = 1;
if($editadd) {
$placement = $sel ? $sel : 1;
splice(@worktoolbar,$placement-1,0,$newtool);
fl_insert_browser_line($tbrws, $placement, $edititem[1]);
$browser_lines++;
} else {
splice(@worktoolbar,$sel-1,1,$newtool);
fl_replace_browser_line($tbrws, $sel, $edititem[1]);
}
last;
}
}
fl_set_object_label($errtext, $errstring[$editerror]);
}
fl_hide_form($editform);
fl_activate_form($controlform);
}
sub edit_callback {
my($obj, $parm) = @_;
if($parm) {
fl_deactivate_form($editform);
fl_use_fselector($parm);
if ($parm == 1) {
$path = fl_show_fselector("Enter the path of the new tool",
"$ENV{X11HOME}/bin",
"",
"");
} else {
if (!$pix_fsel) {
fl_add_fselector_appbutton("Create", "create_pixmap", 0);
fl_add_fselector_appbutton("Edit", "edit_pixmap", 1);
$pix_fsel = 2;
}
$path = fl_show_fselector("Enter the path of the tool's pixmap",
"$ENV{X11HOME}/include/X11/pixmaps",
"",
"");
}
fl_set_input($edit_tool_text[$parm], $path) if ($path);
fl_activate_form($editform);
}
}
sub create_pixmap {
fl_deactivate_form(fl_get_fselector_form());
`$PIXEDITOR`;
fl_activate_form(fl_get_fselector_form());
fl_refresh_fselector();
}
sub edit_pixmap {
fl_deactivate_form(fl_get_fselector_form());
my($dir, $file) = (fl_get_directory(), fl_get_filename());
if($file && -f "$dir/$file"){
`$PIXEDITOR $dir/$file`;
}
fl_activate_form(fl_get_fselector_form());
fl_refresh_fselector();
}
sub build_toolbar {
while(defined($button = pop(@buttons))) {
fl_delete_object($button);
fl_free_object($button);
}
if ($toolform ne "FIRST") {
fl_hide_form($toolform);
fl_free_form($toolform);
}
$toolbarl = (@toolbar+@inttools)*$BUTTONSIZE;
$toolform =
fl_bgn_form(FL_UP_BOX, $toolbarl, $BUTTONSIZE);
fl_set_form_position($toolform, $scrw-$toolbarl, 0);
$index = $pos = 0;
foreach $tool (@toolbar, @inttools) {
($name, $longname, $pixpath, $cmdpath) = split(/:/, $tool);
if (-f $pixpath) {
$obj = fl_add_pixmapbutton(FL_NORMAL_BUTTON,
$pos, 0,
$BUTTONSIZE, $BUTTONSIZE,
$name);
fl_set_pixmapbutton_file($obj, $pixpath);
} else {
$obj = fl_add_button(FL_NORMAL_BUTTON,
$pos, 0,
$BUTTONSIZE, $BUTTONSIZE,
$name);
}
fl_set_object_callback($obj, "button_callback", $index);
fl_set_object_posthandler($obj, "post");
$obj->u_ldata($index);
$buttons[$index++] = $obj;
$pos += $BUTTONSIZE;
}
fl_end_form();
fl_show_form($toolform,
FL_PLACE_GEOMETRY,
FL_NOBORDER,
"Toolbar");
}
sub exit_xftool {
fl_finish();
exit(0);
}
Xforms4Perl-0.8.4/DEMOS/cursorsel.pl 100775 0 0 2231 6440527517 15231 0 ustar root root #!/usr/bin/perl
use X11::Xforms;
# Display a popup with all cursors - return the selected one
fl_initialize("CursorChooser");
open(XC, "/usr/X11/include/X11/cursorfont.h");
@lines = <XC>;
close XC;
while ($line = shift(@lines))
{
if ($line =~ /#define\s*(XC_\w*)\s*(\d*)\s*$/)
{
if ($1 ne "XC_num_glyphs")
{
$cname[$i] = $1;
$wdth = $cname[$i] if ($wdth < length($cname[$i]));
$cnmbr[$i++] = $2;
}
}
}
exit(-1) if ($#cname < 1);
$form = fl_bgn_form(FL_NO_BOX, 200, 400);
$browser = fl_add_browser(FL_HOLD_BROWSER,0,0,200,400,"");
fl_set_object_dblbuffer($browser, 1);
fl_set_object_callback($browser, "set_cursor", 0);
fl_set_browser_dblclick_callback($browser, "rtrn_cursor", 0);
fl_end_form;
while ($line = shift(@cname))
{
fl_add_browser_line($browser,$line)
}
fl_show_form($form,FL_PLACE_MOUSE,FL_FULLBORDER,"Select a Cursor");
fl_do_forms();
exit -1;
sub set_cursor
{
my($obj, $data) = @_;
fl_set_cursor($obj->window, $cnmbr[$item-1])
if (($item = fl_get_browser($obj)) > 0);
}
sub rtrn_cursor
{
my($obj, $data) = @_;
$item = fl_get_browser($obj);
if ($item > 0)
{
exit($cnmbr[$item-1]);
}
else
{
exit(-1);
}
}
Xforms4Perl-0.8.4/DEMOS/XFgrep.pl 100775 0 0 5741 6437527626 14423 0 ustar root root #!/usr/bin/perl
use X11::Xforms;
#-*-perl-*-
# Autogenerated by fd2pl from fdesign file /root/xgrep.c
#
#
$editskel="vi -geometry 80x42 +%s %s";
$xgrep = undef;
$ResultBrowser = undef;
$SearchButton = undef;
$SearchMessage = undef;
$pattern = "";
sub create_form_xgrep {
$obj = undef;
$xgrep = fl_bgn_form(FL_NO_BOX, 535, 220);
$obj = fl_add_box(FL_FLAT_BOX, 0, 0, 535, 220, "");
fl_set_object_lsize($obj, FL_NORMAL_SIZE);
$obj = fl_add_browser(FL_HOLD_BROWSER, 6, 6, 522, 177, "");
fl_set_object_gravity($obj, FL_NorthWest, FL_SouthEast);
$ResultBrowser = $obj;
fl_set_object_lsize($obj, FL_NORMAL_SIZE);
fl_set_object_callback($obj, "dummy", 0);
fl_set_browser_dblclick_callback($obj, "execute_result", 0);
fl_set_browser_fontsize($obj, FL_NORMAL_SIZE);
fl_set_browser_fontstyle($obj, FL_FIXED_STYLE);
fl_set_object_color($obj, FL_WHITE, FL_RED);
$obj = fl_add_button(FL_NORMAL_BUTTON, 5, 186, 125, 30, "Search");
$SearchButton = $obj;
fl_set_object_resize($obj, FL_RESIZE_NONE);
fl_set_object_gravity($obj, FL_SouthWest,FL_ForgetGravity );
fl_set_object_lsize($obj, FL_NORMAL_SIZE);
fl_set_object_callback($obj, "execute_search", 0);
$obj = fl_add_button(FL_NORMAL_BUTTON, 135, 186, 125, 30, "Exit");
fl_set_object_resize($obj, FL_RESIZE_NONE);
fl_set_object_gravity($obj, FL_SouthWest, FL_ForgetGravity);
$obj = fl_add_text(FL_NORMAL_TEXT, 265, 186, 265, 30, " ");
fl_set_object_lsize($obj, FL_NORMAL_SIZE);
$SearchMessage = $obj;
fl_end_form();
}
sub create_the_forms {
create_form_xgrep();
}
sub execute_search {
fl_deactivate_form($xgrep);
my($args) = fl_show_input("Enter the grep arguments", $pattern);
if ($args ne "")
{
$pattern = $args;
populate_browser($args);
}
fl_activate_form($xgrep);
}
sub populate_browser {
my($args) = @_;
if ($args ne "")
{
fl_set_object_label($SearchMessage, "Status: Searching ...");
fl_clear_browser($ResultBrowser);
fl_freeze_form($xgrep);
open(GREP, "cat /dev/null | grep -n $args |");
$results = 0;
while(<GREP>) {
chop;
fl_add_browser_line($ResultBrowser, $_);
$results++;
}
close GREP;
fl_unfreeze_form($xgrep);
fl_set_object_label($SearchMessage, "Status: $results occurences found");
}
}
sub dummy {
}
sub execute_result {
my($obj, $parm) = @_;
($file, $line, $text) = split(/:/,fl_get_browser_line($obj, fl_get_browser($obj)));
if (-f $file) {
$command = sprintf("$editskel", $line, $file);
exec("$command\n") if(!fork());
}
}
$SIG{CHLD} = 'IGNORE';
close(STDIN);
$pattern = "@ARGV";
@ARGV=undef;
fl_initialize('ProcCntl');
#
# How to use edit key maps to make Delete and Backspace work!!
#
$keymap = X11::Xforms::FLEditKeymap::new;
$keymap->del_prev_char(8);
$keymap->del_next_char(127);
fl_set_input_editkeymap($keymap);
create_the_forms();
populate_browser($pattern);
fl_show_form($xgrep, FL_PLACE_FREE, FL_FULLBORDER, "XGrep");
fl_do_forms();
exit 0;
Xforms4Perl-0.8.4/DEMOS/clipboard.pl 100775 0 0 4323 6416160637 15152 0 ustar root root #!/usr/bin/perl -w
#-*-perl-*-
# Autogenerated by fd2pl from fdesign file /root/clipboard.c
#
use X11::Xforms;
#
$clipboard = undef;
$TextBox = undef;
$SelectButton = undef;
$PasteButton = undef;
$DoneButton = undef;
$form_frozen = 0;
fl_initialize("ClipBoard");
create_the_forms();
fl_show_form($clipboard, FL_PLACE_FREE, FL_FULLBORDER, "Clipboard");
fl_do_forms();
exit(0);
sub create_form_clipboard {
$obj = undef;
$clipboard = fl_bgn_form(FL_NO_BOX, 280, 140);
$obj = fl_add_box(FL_UP_BOX, 0, 0, 280, 140, "");
$obj = fl_add_text(FL_NORMAL_TEXT, 10, 10, 260, 80, "This Text can be selected using the 'Select' button,\nor overwritten with the primary X selection\nusing the 'Paste' button");
$TextBox = $obj;
fl_set_object_boxtype($obj, FL_DOWN_BOX);
fl_set_object_lalign($obj, FL_ALIGN_CENTER|FL_ALIGN_INSIDE);
$obj = fl_add_button(FL_NORMAL_BUTTON, 10, 100, 80, 30, "Select");
$SelectButton = $obj;
fl_set_object_callback($obj, "process_select", 0);
$obj = fl_add_button(FL_NORMAL_BUTTON, 100, 100, 80, 30, "Paste");
$PasteButton = $obj;
fl_set_object_callback($obj, "process_paste", 0);
$obj = fl_add_button(FL_NORMAL_BUTTON, 190, 100, 80, 30, "Done");
$DoneButton = $obj;
fl_set_object_callback($obj, "process_done", 0);
fl_end_form();
}
sub create_the_forms {
create_form_clipboard();
}
sub process_select {
my($obj, $val) = @_;
fl_set_object_color($TextBox, FL_BLACK, FL_WHITE);
fl_set_object_lcolor($TextBox, FL_WHITE);
fl_stuff_clipboard($obj, $TextBox->label, "selection_lost");
}
sub process_paste {
my($obj, $val) = @_;
if (fl_request_clipboard($obj, "selection_obtained") == 0)
{
$form_frozen = 1;
fl_freeze_form($clipboard);
}
}
sub process_done {
exit(0);
}
sub selection_lost {
my($obj, $type) = @_;
fl_set_object_color($TextBox, FL_TEXT_COL1, FL_TEXT_COL2);
fl_set_object_lcolor($TextBox, FL_TEXT_LCOL);
return 0;
}
sub selection_obtained {
my($obj, $type, $data, $size) = @_;
$data = "There is no selection" if ($size == 0);
fl_set_object_color($TextBox, FL_TEXT_COL1, FL_TEXT_COL2);
fl_set_object_lcolor($TextBox, FL_TEXT_LCOL);
fl_set_object_label($TextBox, $data);
if ($form_frozen)
{
fl_unfreeze_form($clipboard);
$form_frozen = 0;
}
return 0;
}
Xforms4Perl-0.8.4/DEMOS/chartstrip.pl 100775 0 0 5654 6376324610 15404 0 ustar root root #!/usr/bin/perl
use X11::Xforms;
$func = 1;
$x = 0.0;
$step = 0.15;
$form = undef;
$chartobj= undef;
$sinobj = undef;
$exitbut = undef;
$stepobj = undef;
sub set_function
{
my($obj, $arg) = @_;
$func = $arg;
fl_clear_chart($chartobj);
$x = 0.0;
}
sub set_step
{
my($obj, $arg) = @_;
$step = fl_get_slider_value($stepobj);
}
#/*************************************************/
sub create_form_form
{
$form = fl_bgn_form(FL_NO_BOX,490,320);
$obj = fl_add_box(FL_BORDER_BOX,0,0,490,320,"");
$chartobj = $obj = fl_add_chart(FL_LINE_CHART,20,160,390,140,"");
fl_set_object_dblbuffer($obj,1);
fl_bgn_group();
$sinobj = $obj = fl_add_lightbutton(FL_RADIO_BUTTON,30,120,170,30,"sin(x)");
fl_set_object_boxtype($obj,FL_BORDER_BOX);
fl_set_object_callback($obj,"set_function",1);
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,30,90,170,30,"sin(2x)*cos(x)");
fl_set_object_boxtype($obj,FL_BORDER_BOX);
fl_set_object_callback($obj,"set_function",2);
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,30,60,170,30,"sin(2x)+cos(x)");
fl_set_object_boxtype($obj,FL_BORDER_BOX);
fl_set_object_callback($obj,"set_function",3);
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,240,120,160,30,"sin(3x)+cos(x)");
fl_set_object_boxtype($obj,FL_BORDER_BOX);
fl_set_object_callback($obj,"set_function",4);
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,240,90,160,30,"sin(x)^2 + cos(x)");
fl_set_object_boxtype($obj,FL_BORDER_BOX);
fl_set_object_callback($obj,"set_function",5);
$obj = fl_add_lightbutton(FL_RADIO_BUTTON,240,60,160,30,"sin(x)^3");
fl_set_object_boxtype($obj,FL_BORDER_BOX);
fl_set_object_callback($obj,"set_function",6);
fl_end_group();
$exitbut = $obj = fl_add_button(FL_NORMAL_BUTTON,150,20,140,30,"Exit");
fl_set_object_boxtype($obj,FL_BORDER_BOX);
$stepobj = $obj = fl_add_valslider(FL_VERT_SLIDER,430,20,40,280,"");
fl_set_object_boxtype($obj,FL_BORDER_BOX);
fl_set_object_callback($obj,"set_step",0);
fl_end_form();
}
sub next_step
{
$res = 0.0;
$res = sin($x) if($func == 1);
$res = sin(2*$x)*cos($x) if($func == 2);
$res = sin(2*$x)+cos($x) if($func == 3);
$res = sin(3*$x)+cos($x) if($func == 4);
$res = sin($x)*sin($x) + cos($x) if($func == 5);
$res = sin($x)*sin($x)*sin($x) if($func == 6);
$x += $step;
return $res;
}
sub idle_cb
{
my($xev, $d) = @_;
fl_insert_chart_value($chartobj,1,next_step(),"",1);
return 0;
}
fl_initialize("FormDemo");
create_form_form();
fl_set_chart_bounds($chartobj,-1.5,1.5);
fl_set_chart_maxnumb($chartobj,80);
fl_set_chart_autosize($chartobj,0);
fl_set_button($sinobj,1);
fl_set_slider_value($stepobj,0.15);
fl_set_slider_bounds($stepobj,0.0,0.4);
fl_show_form($form,FL_PLACE_CENTER,FL_NOBORDER,"StripChart");
do
{
fl_insert_chart_value($chartobj,1,next_step(),"",1);
$obj = fl_check_forms();
}
while ($obj != $exitbut);
exit(0);
Xforms4Perl-0.8.4/DEMOS/scrollbar.pl 100711 0 0 4776 6431437277 15204 0 ustar root root #!/usr/bin/perl
use X11::Xforms;
#
# scrollbar functionality checkout
#
fl_initialize("Scrollbar");
$fd_scb = create_form_scb();
fl_show_form($fd_scb->{"scb"},FL_PLACE_CENTERFREE,FL_FULLBORDER,"form0");
fl_do_forms();
return 0;
sub hide_cb
{
my($ob, $data) = @_;
$fdui = $ob->form->fdui;
if($fdui->{"hor_thin"}->visible)
{
fl_set_object_label($fdui->{"hide"},"Show");
fl_hide_object($fdui->{"hor_thin"});
}
else
{
fl_set_object_label($fdui->{"hide"},"Hide");
fl_show_object($fdui->{"hor_thin"});
}
}
sub deactivate_cb
{
my($ob, $data) = @_;
$fdui = $ob->form->fdui;
if($fdui->{"hor_thin"}->active == 1)
{
fl_set_object_label($fdui->{"deactivate"},"Activate");
fl_deactivate_object($fdui->{"hor_thin"});
}
else
{
fl_set_object_label($fdui->{"deactivate"},"Deactivate");
fl_activate_object($fdui->{"hor_thin"});
}
}
sub done_cb
{
my($ob, $data) = @_;
exit(0);
}
sub create_form_scb
{
%fdui = {
scb => undef,
hor => undef,
hor_thin => undef,
hor_nice => undef,
vert => undef,
vert_thin => undef,
hide => undef,
deactivate => undef,
vert_nice => undef
};
$fdui->{"scb"} = fl_bgn_form(FL_NO_BOX, 420, 210);
$obj = fl_add_box(FL_UP_BOX,0,0,420,210,"");
$fdui->{"hor"} = $obj = fl_add_scrollbar(FL_HOR_BASIC_SCROLLBAR,30,20,230,17,"");
$fdui->{"hor_thin"} = $obj = fl_add_scrollbar(FL_HOR_THIN_SCROLLBAR,30,60,230,18,"");
fl_set_object_boxtype($obj,FL_DOWN_BOX);
fl_set_scrollbar_value($obj, 0.11);
$fdui->{"hor_nice"} = $obj = fl_add_scrollbar(FL_HOR_NICE_SCROLLBAR,30,100,230,18,"");
fl_set_object_boxtype($obj,FL_FRAME_BOX);
$fdui->{"vert"} = $obj = fl_add_scrollbar(FL_VERT_BASIC_SCROLLBAR,300,10,17,185,"");
$fdui->{"vert_thin"} = $obj = fl_add_scrollbar(FL_VERT_THIN_SCROLLBAR,338,10,17,185,"");
fl_set_object_boxtype($obj,FL_DOWN_BOX);
$fdui->{"hide"} = $obj = fl_add_button(FL_NORMAL_BUTTON,20,160,80,25,"Hide");
fl_set_object_callback($obj,"hide_cb",0);
$fdui->{"deactivate"} = $obj = fl_add_button(FL_NORMAL_BUTTON,100,160,80,25,"Deactivate");
fl_set_object_callback($obj,"deactivate_cb",0);
$obj = fl_add_button(FL_NORMAL_BUTTON,200,160,80,25,"Done");
fl_set_object_callback($obj,"done_cb",0);
$fdui->{"vert_nice"} = $obj = fl_add_scrollbar(FL_VERT_NICE_SCROLLBAR,370,10,17,185,"");
fl_set_object_boxtype($obj,FL_FRAME_BOX);
fl_set_scrollbar_value($obj, 1.00);
fl_end_form();
$fdui->{"scb"}->fdui($fdui);
return $fdui;
}
Xforms4Perl-0.8.4/DEMOS/xyplotsymb.pl 100711 0 0 3536 6435065410 15432 0 ustar root root #!/usr/bin/perl
use X11::Xforms;
#/* Demo showing the use of xyplot symbol drawing routines. */
$fff = undef;
$xyplot = undef;
fl_initialize("Overlay Demo");
create_form_fff();
init_xyplot($fff);
fl_show_form($fff, FL_PLACE_MOUSE, FL_TRANSIENT, "XYPlot Overlay");
fl_do_forms();
exit 0;
sub init_xyplot
{
for ($i = 0, $j = 0; $i <= 10; $i++, $j+=2)
{
$xy[$j] = $i;
$xy[$j+1] = exp(-($xy[$j] - 5) * ($xy[$j] - 5) / 8);
}
fl_set_xyplot_data($xyplot, @xy, "", "", "");
fl_set_xyplot_ybounds($xyplot, 0, 1.1);
fl_set_xyplot_xbounds($xyplot, 0, 10);
fl_add_xyplot_overlay($xyplot, 1, @xy, FL_BLUE);
fl_set_xyplot_symbol($xyplot, 1, "drawsymbol");
fl_set_xyplot_overlay_type($xyplot, 1, FL_LINEPOINTS_XYPLOT);
fl_set_xyplot_interpolate($xyplot, 1, 2, 0.1);
fl_add_xyplot_text($xyplot, 0.5, 1.0, "Gaussian\nDistribution",
FL_ALIGN_RIGHT, FL_BLUE);
fl_set_xyplot_key($xyplot, 0, "Original");
fl_set_xyplot_key($xyplot, 1, "Overlay");
fl_set_xyplot_key_position($xyplot, 9.8, 1.08, FL_ALIGN_BOTTOM_LEFT);
}
sub create_form_fff
{
$fff = fl_bgn_form(FL_NO_BOX, 370, 310);
$obj = fl_add_box(FL_UP_BOX, 0, 0, 370, 310, "");
$xyplot = $obj = fl_add_xyplot(FL_POINTS_XYPLOT, 10, 20, 350, 260, "");
fl_set_object_lalign($obj, FL_ALIGN_BOTTOM | FL_ALIGN_INSIDE);
fl_set_object_lsize($obj, FL_NORMAL_SIZE);
fl_set_xyplot_symbol($obj, 0, "drawsymbol");
$obj = fl_add_button(FL_HIDDEN_BUTTON, 10, 10, 350, 290, "");
fl_set_button_shortcut($obj,"qQ", 0);
fl_end_form();
}
sub drawsymbol {
my($obj, $id, $w, $h, @points) = @_;
my($r) = ($w + $h) / 4;
while ($#points > 0)
{
my($x) = shift @points;
my($y) = shift @points;
if ($id == 0 )
{
fl_circf($x, $y, $r, FL_BLACK);
}
else
{
fl_circ($x, $y, $r, FL_GREEN);
}
}
}
Xforms4Perl-0.8.4/DEMOS/X4Pinit.pl 100664 0 0 17655 6443252502 14534 0 ustar root root # This script allows for automatic initialization and cutomization
# of Xforms and Xforms objects!
#
# It MUST contain two subroutines named fl_pre_init and fl_post_init.
#
# Additionally, any callback routine registered MUST be in the namespace
# of the package of the function that causes their invocation. Usually
# this is main::.
#
# This sample performs some pre-initialization of defaults, and then some
# post initialization of the keymap, pups and certain goodies. It also
# registers a callback for all avaialbe object classes. Most do nothing
# in particular, but some, such as the browser one, show just how useful
# this facility is.
#
# To use this script, place it in your home directory.
#
#
# Set up the colors
#
@SelectColor = ( 85, 128, 151); # Gets mapped to FL_FREE_COL1
@BackgroundColor = (152, 184, 200); # Gets mapped to FL_COL1
@WorkingBackGround = (255, 255, 255); # This is also FL_WHITE
#
# Ratios based on KDEs calculations at contrast = 5
#
@TopLeftShadow = (int(($BackgroundColor[0] * 1.2)+0.5),
int(($BackgroundColor[1] * 1.2)+0.5),
int(($BackgroundColor[2] * 1.2)+0.5));
@BottomRightShadow =(int(($BackgroundColor[0] / 3)+0.5),
int(($BackgroundColor[1] / 3)+0.5),
int(($BackgroundColor[2] / 3)+0.5));
@ScrollBackGround =(int(($BackgroundColor[0] * 0.84)+0.5),
int(($BackgroundColor[1] * 0.82)+0.5),
int(($BackgroundColor[2] * 0.80)+0.5));
$SelectColor=FL_FREE_COL1;
$BackgroundColor=FL_COL1;
$ScrollBackGround=FL_MCOL;
$Working_bgrnd=FL_WHITE;
#
# An array of initializer callbacks IN CLASS NUMBER ORDER!
#
@init_cbs = (
0,
\&main::fl_button_cl,
\&main::fl_lightbutton_cl,
\&main::fl_roundbutton_cl,
\&main::fl_round3dbutton_cl,
\&main::fl_checkbutton_cl,
\&main::fl_bitmapbutton_cl,
\&main::fl_pixmapbutton_cl,
\&main::fl_bitmap_cl,
\&main::fl_pixmap_cl,
\&main::fl_box_cl,
\&main::fl_text_cl,
\&main::fl_menu_cl,
\&main::fl_chart_cl,
\&main::fl_choice_cl,
\&main::fl_counter_cl,
\&main::fl_slider_cl,
\&main::fl_valslider_cl,
\&main::fl_input_cl,
\&main::fl_browser_cl,
\&main::fl_dial_cl,
\&main::fl_timer_cl,
\&main::fl_clock_cl,
\&main::fl_positioner_cl,
\&main::fl_free_cl,
\&main::fl_xyplot_cl,
\&main::fl_frame_cl,
\&main::fl_labelframe_cl,
\&main::fl_canvas_cl,
\&main::fl_glcanvas_cl,
\&main::fl_tabfolder_cl,
\&main::fl_scrollbar_cl,
\&main::fl_scrollbutton_cl,
\&main::fl_menubar_cl
);
sub fl_pre_init {
#
# THIS IS A REQUIRED SUBROUTINE EVEN IF IT IS EMPTY
#
# This routine is called immediately prior to fl_initialize
#
# CAUTION: Only certain things work before fl_initialize. See
# Xforms documentation for details
#
my($iopt) = X11::Xforms::FLOpt->new();
$iopt->scrollbarType(FL_PLAIN_SCROLLBAR);
fl_set_defaults(FL_PDScrollbarType, $iopt);
#
# Now overwrite the default colors with what we want.
#
fl_set_icm_color(FL_COL1, @BackgroundColor );
fl_set_icm_color(FL_MCOL, @ScrollBackGround );
fl_set_icm_color(FL_TOP_BCOL, @TopLeftShadow );
fl_set_icm_color(FL_LEFT_BCOL, @TopLeftShadow );
fl_set_icm_color(FL_BOTTOM_BCOL, @BottomRightShadow );
fl_set_icm_color(FL_RIGHT_BCOL, @BottomRightShadow );
}
sub fl_post_init {
#
# THIS IS A REQUIRED SUBROUTINE EVEN IF IT IS EMPTY
#
# This routine is called immediately after fl_initialize
#
# This is the ideal place to do most global customization and to register
# class callback routines.
#
my($iopt) = fl_get_defaults();
if ($iopt->scrollbarType == FL_PLAIN_SCROLLBAR)
{
$hscroll = FL_HOR_PLAIN_SCROLLBAR;
$vscroll = FL_VERT_PLAIN_SCROLLBAR;
}
elsif ($iopt->scrollbarType == FL_THIN_SCROLLBAR)
{
$hscroll = FL_HOR_THIN_SCROLLBAR;
$vscroll = FL_VERT_THIN_SCROLLBAR;
}
elsif ($iopt->scrollbarType == FL_NORMAL_SCROLLBAR)
{
$hscroll = FL_HOR_NORMAL_SCROLLBAR;
$vscroll = FL_VERT_NORMAL_SCROLLBAR;
}
elsif ($iopt->scrollbarType == FL_NICE_SCROLLBAR)
{
$hscroll = FL_HOR_NICE_SCROLLBAR;
$vscroll = FL_VERT_NICE_SCROLLBAR;
}
$keymap = X11::Xforms::FLEditKeymap->new();
$keymap->del_prev_char(8);
$keymap->del_next_char(127);
fl_set_input_editkeymap($keymap);
fl_mapcolor($SelectColor, @SelectColor);
# fl_mapcolor($Working_bgrnd, @Working_bgrnd); # FL_WHITE
# fl_mapcolor($BackgroundColor, @BackgroundColor); # FL_COL1
# fl_mapcolor($ScrollBackGround, @ScrollBackGround);# FL_MCOL
#
# Set the pup defaults
#
fl_setpup_fontstyle(FL_NORMAL_STYLE);
fl_setpup_color($BackgroundColor, FL_BLACK);
fl_setpup_checkcolor($SelectColor);
@libver = fl_library_version();
$maxcbs = 33 if ($libver[1] > 86);
$maxcbs = 29 if ($libver[1] > 86);
#
# Register the callbacks for each object class
#
for ($i = 1; $i <= $maxcbs; $i++)
{
fl_set_class_callback($i,$init_cbs[$i]);
}
#
# Now initialize the command log and fselector goodies
#
$strct = fl_get_command_log_fdstruct();
init_form($strct->form);
$strct = fl_get_fselector_fdstruct();
init_form($strct->fselect);
}
sub init_form
{
#
# This useful little subroutine initializes ALL objects in a form
# using the registered initializer routines. This is useful for
# initializing goodies such as the Command Log and File Selector
#
my($form) = @_;
my($nxt) = my($obj) = $form->first;
my($lst) = $form->last;
do
{
$obj = $nxt;
&{$init_cbs[$obj->objclass]}($obj) if ($obj->objclass <= $#init_cbs);
$nxt = $obj->next;
} while ($obj ne $lst);
}
#
# The callbacks
#
sub main::fl_button_cl {
my($obj) = @_;
}
sub main::fl_lightbutton_cl {
my($obj) = @_;
fl_set_object_color($obj, $ScrollBackGround, FL_YELLOW);
}
sub main::fl_roundbutton_cl {
my($obj) = @_;
}
sub main::fl_round3dbutton_cl {
my($obj) = @_;
}
sub main::fl_checkbutton_cl {
my($obj) = @_;
}
sub main::fl_bitmapbutton_cl {
my($obj) = @_;
}
sub main::fl_pixmapbutton_cl {
my($obj) = @_;
}
sub main::fl_bitmap_cl {
my($obj) = @_;
}
sub main::fl_pixmap_cl {
my($obj) = @_;
}
sub main::fl_box_cl {
my($obj) = @_;
fl_set_object_bw($obj, -1) if ($obj->type == FL_UP_BOX);
}
sub main::fl_text_cl {
my($obj) = @_;
}
sub main::fl_menu_cl {
my($obj) = @_;
fl_set_object_boxtype($obj, FL_FLAT_BOX);
fl_set_object_lsize($obj, FL_NORMAL_SIZE);
fl_set_object_lstyle($obj, FL_NORMAL_STYLE);
}
sub main::fl_chart_cl {
my($obj) = @_;
}
sub main::fl_choice_cl {
my($obj) = @_;
}
sub main::fl_counter_cl {
my($obj) = @_;
}
sub main::fl_slider_cl {
my($obj) = @_;
}
sub main::fl_valslider_cl {
my($obj) = @_;
}
sub main::fl_input_cl {
my($obj) = @_;
fl_set_object_color($obj, $SelectColor, $Working_bgrnd);
}
sub main::fl_browser_cl {
#
# Browsers are composite objects. To change colors, therefore, we must
# get the various sub-objects and change those colors too.
#
my($obj) = @_;
fl_set_object_color($obj, $Working_bgrnd, $SelectColor);
#
# If you want other than default coloros for browsers, this is how
# you can get at the scroll bars and change those too! 0.88 ONLY!
#
if ($libver[1] > 86)
{
my($scr) = fl_get_object_component($obj, FL_SCROLLBAR, $hscroll, 0);
fl_set_object_color($scr, $ScrollBackGround, $BackgroundColor) if (defined($scr));
$scr = fl_get_object_component($obj, FL_SCROLLBAR, $vscroll, 0);
fl_set_object_color($scr, $ScrollBackGround, $BackgroundColor) if (defined($scr));
}
}
sub main::fl_dial_cl {
my($obj) = @_;
}
sub main::fl_timer_cl {
my($obj) = @_;
}
sub main::fl_clock_cl {
my($obj) = @_;
}
sub main::fl_positioner_cl {
my($obj) = @_;
}
sub main::fl_free_cl {
my($obj) = @_;
}
sub main::fl_xyplot_cl {
my($obj) = @_;
}
sub main::fl_frame_cl {
my($obj) = @_;
}
sub main::fl_labelframe_cl {
my($obj) = @_;
}
sub main::fl_canvas_cl {
my($obj) = @_;
}
sub main::fl_glcanvas_cl {
my($obj) = @_;
}
sub main::fl_tabfolder_cl {
my($obj) = @_;
}
sub main::fl_scrollbar_cl {
my($obj) = @_;
}
sub main::fl_scrollbutton_cl {
my($obj) = @_;
}
sub main::fl_menubar_cl {
my($obj) = @_;
}
#
# Since we are 'required' return 1
#
1;
Xforms4Perl-0.8.4/DEMOS/testiocb.pl 100711 0 0 1465 6437562525 15026 0 ustar root root #!/usr/bin/perl
#/* This demo shows the use of io callbacks. */
use X11::Xforms;
$form = undef;
pipe(PREAD, PWRITE);
if ($kid = fork() == 0)
{
sub_proc();
}
else
{
fl_initialize("FormDemo");
create_form();
fl_show_form($form,FL_PLACE_CENTER,FL_FULLBORDER,NULL);
fl_add_io_callback(*PREAD, FL_READ, io_cb, 0);
fl_do_forms();
kill(9, $kid);
fl_hide_form($form);
}
sub create_form
{
$form = fl_bgn_form(FL_NO_BOX,30,30);
fl_add_box(FL_UP_BOX,0,0,30,30,"");
fl_add_button(FL_NORMAL_BUTTON,0,0,30,30,"Quit");
fl_end_form();
}
sub io_cb {
my($file, $data) = @_;
$line = <$file>;
print "Line: $line\n";
}
sub sub_proc {
select(PWRITE); $| = 1;
while(1) {
sleep(5);
print PWRITE "from child: I'm still here!!!\n";
}
}
Xforms4Perl-0.8.4/DEMOS/ProcExp.pl 100755 765 0 20016 6443234632 15340 0 ustar william root #!/usr/bin/perl
$|=1;
use X11::Xforms;
use X11::XEvent;
use Getopt::Long;
#
# A /proc system explorer - complete with tree-view and splitter bar!!!
# To make it a filesystem explorer run with the -fs switch.
#
$opt_fs = 0;
$result=GetOptions('fs');
die("Option Error\n") unless($result);
$procdir = "/proc" if (!$opt_fs);
$procdir = "/" if ($opt_fs);
$procbrws = undef;
$$dtlsbrws = undef;
@procs = undef;
@proctree = undef;
@procind = undef;
$resizing = 0;
fl_initialize('Explorer');
create_form_main();
populate_proc();
fl_show_form($mainform,FL_PLACE_FREE,FL_FULLBORDER,
$opt_fs ? "Filesystem Explorer" : "Proc Filesystem Explorer");
while ($quit==0) {
fl_do_forms();
}
sub populate_proc()
{
@procs = undef;
@proctree = undef;
@procind = undef;
opendir(PROC, $procdir) || die "Can't open $procdir\n";
@procs = sort {
return ($a <=> $b) if ($a > 0 && $b > 0);
return ($a cmp $b) if ($a == 0 && $b == 0);
return -1 if ($a == 0);
return 1;
} (grep { !/^\./ } readdir(PROC));
closedir PROC;
my($sub) = 0;
my(@tprocs) = @procs;
foreach $proc (@procs) {
if (-d "$procdir/$proc")
{
fl_add_browser_line($procbrws,"\@b+$proc");
$proctree[$sub] = 0;
$procind[$sub] = 0;
++$sub;
}
elsif ($opt_fs)
{
splice(@tprocs, $sub, 1);
fl_add_browser_line($dtlsbrws,"$proc");
}
else
{
fl_add_browser_line($procbrws," $proc");
$proctree[$sub] = 0;
$procind[$sub] = 0;
++$sub;
}
}
@procs = @tprocs;
}
sub ProcMenu {
$menuitem = fl_get_menu($Menu);
$selected = fl_get_browser($procbrws);
if ($menuitem == $MENU_EXIT) {
fl_finish();
exit;
} elsif ($menuitem == $MENU_REFR) {
fl_freeze_form($mainform);
fl_clear_browser($procbrws);
fl_clear_browser($dtlsbrws);
populate_proc();
fl_unfreeze_form($mainform);
} elsif ($menuitem == $MENU_DTLS && $selected > 0) {
DblClickProc($procbrws, 0);
} elsif ($menuitem == $MENU_KILL && $selected > 0) {
$kill = $procs[$selected - 1];
kill (9, $kill)
if fl_show_question("Are you sure you want to kill process number $kill?", 0);
}
}
sub SelectProc
{
fl_freeze_form($mainform);
my($obj, $parm) = @_;
my($line) = fl_get_browser($obj);
my($procfile) = $procs[$line-1];
my($procsubdir) = "$procdir/$procfile";
if ($opt_fs)
{
fl_clear_browser($dtlsbrws);
if (opendir(SUBD, $procsubdir))
{
my(@files) = sort (grep {!(-d "$procsubdir/$_") } readdir(SUBD));
close SUBD;
foreach $file (@files)
{
fl_add_browser_line($dtlsbrws," $file");
}
}
}
elsif (-d "$procsubdir")
{
fl_clear_browser($dtlsbrws);
fl_set_menu_item_mode($Menu, $MENU_DTLS, FL_PUP_NONE);
if ($procfile =~ /^\d\d*$/)
{
fl_set_menu_item_mode($Menu, $MENU_KILL, FL_PUP_NONE);
}
else
{
fl_set_menu_item_mode($Menu, $MENU_KILL, FL_PUP_GREY);
}
}
else
{
fl_set_menu_item_mode($Menu, $MENU_KILL, FL_PUP_GREY);
fl_set_menu_item_mode($Menu, $MENU_DTLS, FL_PUP_GREY);
return if ($procfile eq "kcore" || $procfile eq "kmsg");
fl_load_browser($dtlsbrws, $procsubdir)
if (-f $procsubdir);
}
fl_unfreeze_form($mainform);
}
sub DblClickProc
{
fl_freeze_form($mainform);
my($obj, $parm) = @_;
my($line) = fl_get_browser($obj);
my($ix) = $line-1;
my($linetext) = fl_get_browser_line($obj, $line);
my($subdir) = $procs[$ix];
my($tree) = $proctree[$ix];
my($ind) = $procind[$ix];
my($procsubdir) = "$procdir/$subdir";
if ($tree)
{
for ($i =$ix+1 , $len = 0;
$i <= $#procind && $procind[$i] > $ind;
$i++, $len++)
{
fl_delete_browser_line($procbrws, $line+1);
}
if ($len)
{
splice(@proctree, $line, $len);
splice(@procind, $line, $len);
splice(@procs, $line, $len);
$proctree[$ix] = 0;
$linetext =~ s/((\@b)?\s*)\-/\1+/;
fl_replace_browser_line($procbrws, $line, $linetext);
}
}
elsif (-d $procsubdir && opendir(SUBD, $procsubdir))
{
my(@subs) = undef;
if ($opt_fs)
{
@subs = sort (grep {(-d "$procsubdir/$_") && !/^\./} readdir(SUBD));
}
else
{
@subs = sort (grep { !/^\./ } readdir(SUBD));
}
closedir SUBD;
my($adj) = 0;
foreach $sub (@subs)
{
my($file) = "$procsubdir/$sub";
splice(@procs, $line+$adj, 0, "$subdir/$sub");
splice(@proctree, $line+$adj, 0, 0);
splice(@procind, $line+$adj, 0, $ind+1);
my($text) = " " x ($ind+1);
if (-d $file)
{$text = "\@b" . $text . "+$sub";}
else
{$text = $text . " $sub";}
fl_insert_browser_line($procbrws, $line+$adj+1, $text);
$adj++;
}
$proctree[$ix] = 1;
$linetext =~ s/((\@b)?\s*)\+/\1-/;
fl_replace_browser_line($procbrws, $line, $linetext);
fl_set_browser_topline($procbrws, $line);
}
fl_unfreeze_form($mainform);
}
sub create_form_main {
$mainform = fl_bgn_form(FL_NO_BOX, 480, 290);
$obj = fl_add_box(FL_UP_BOX,0,0,480,286,"");
$procbrws= $obj = fl_add_browser(FL_HOLD_BROWSER,0,30,238,260,"");
fl_set_browser_fontstyle($obj,FL_FIXED_STYLE);
fl_set_browser_fontsize($obj, FL_NORMAL_SIZE);
fl_set_browser_fontstyle($obj, FL_FIXED_STYLE);
fl_set_object_callback($obj, "SelectProc", 0);
fl_set_object_gravity($obj, FL_NorthWest, FL_South);
fl_set_browser_dblclick_callback($obj, "DblClickProc", 0);
$dtlsbrws= $obj = fl_add_browser(FL_NORMAL_BROWSER,242,30,238,260,"");
fl_set_browser_fontstyle($obj,FL_FIXED_STYLE);
fl_set_browser_fontsize($obj, FL_NORMAL_SIZE);
fl_set_object_gravity($obj, FL_NorthWest, FL_SouthEast);
fl_set_browser_fontstyle($obj, FL_FIXED_STYLE);
fl_set_object_gravity($obj, FL_North, FL_SouthEast);
$splitter= $obj = fl_add_box(FL_FLAT_BOX, 238, 30, 4, 260, "");
fl_set_object_resize($obj, FL_RESIZE_Y);
fl_set_object_gravity($obj, FL_North, FL_South);
$obj = fl_add_box(FL_UP_BOX, 0, 0, 480, 30, "");
fl_set_object_resize($obj,FL_RESIZE_X);
fl_set_object_gravity($obj, FL_NorthWest, FL_NorthEast);
$obj = $Menu = fl_add_menu(FL_PULLDOWN_MENU, 4, 4, 40, 22, $opt_fs ? "File" : "Proc");
fl_set_object_resize($obj,FL_RESIZE_NONE);
fl_set_object_gravity($obj, FL_NorthWest, FL_NorthWest);
fl_set_object_shortcut($obj, "P", 1);
if ($opt_fs)
{
fl_set_menu($obj, "Details%l|Refresh%l|Exit");
$MENU_EXIT = 3;
$MENU_REFR = 2;
$MENU_DTLS = 1;
}
else
{
fl_set_menu($obj, "Details|Kill%l|Refresh%l|Exit");
$MENU_EXIT = 4;
$MENU_REFR = 3;
$MENU_KILL = 2;
$MENU_DTLS = 1;
fl_set_menu_item_mode($obj, 2, FL_PUP_GRAY);
}
fl_set_object_callback($obj, "ProcMenu", 0);
fl_end_form();
fl_register_raw_callback($mainform, ((1<<2) | (1<<3) | (1<<13) | (1<<6)),
"raw_callback");
}
sub raw_callback
{
my($form, $event) = @_;
my($window, $mx, $my, $keymask) = fl_get_form_mouse($form);
my($type) = $event->type;
if ($resizing && $type == 5)
{
$resizing = 0;
fl_set_object_boxtype($splitter, FL_FLAT_BOX);
fl_set_cursor($mainform->window, FL_DEFAULT_CURSOR);
($sx, $sy, $sw, $sh) = fl_get_object_geometry($splitter);
return FL_PREEMPT if ($sx == $old_sgeom[0]);
fl_freeze_form($mainform);
my($dx) = $sx + $sw;
fl_set_object_size($procbrws, $sx, $procbrws->h);
fl_set_object_geometry($dtlsbrws, $dx,
$dtlsbrws->y,
$dtlsbrws->w - ($dx - $dtlsbrws->x),
$dtlsbrws->h);
fl_unfreeze_form($mainform);
return FL_PREEMPT;
}
elsif ($resizing)
{
$newx = $mx - $delta;
fl_set_object_position($splitter, $newx, $splitter->y)
if ($newx >= $procbrws->x + 10 && $newx <= ($dtlsbrws->x + $dtlsbrws->w) - 10);
return FL_PREEMPT;
}
elsif ($type == 4 && $mx >= $splitter->x &&
$mx <= $splitter->x + $splitter->w &&
$my >= $splitter->y &&
$my <= $splitter->y + $splitter->h)
{
fl_set_cursor($mainform->window, 108);
fl_set_object_boxtype($splitter, FL_DOWN_BOX);
@old_sgeom = fl_get_object_geometry($splitter);
$delta = $mx - $old_sgeom[0];
$resizing = 1;
return FL_PREEMPT;
}
return 0;
}
Xforms4Perl-0.8.4/README 100644 0 0 34635 6443253146 12711 0 ustar root root # README - An extension to Perl to access Xforms functions.
# Copyright (C) 1996-1997 Martin Bartlett
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*** INTRODUCTION
This is an extension to Perl that allows you to call the Xforms GUI api
from a standard Perl script. The implications are quite impressive - you
can now develop complex X applications in Perl. The package includes a
number of examples in the DEMOS directory, many of which are unashamedly
plagerised from the Xforms DEMOS directory. See, especially, the ProcExp.pl
DEMO for an example of how to really get under the covers of Xforms and
produce a neat little application - its a filesystem explorer complete with
splitter bar, tree view and list view. Run it with 'ProcExp.pl -fs' for its
general filesystem mode, or with no switch if you have a Linux system and
a /proc filesystem, for its special proc filesystem mode.
This is the 0.8.4 release of the extension and operates with both the 0.88
public release, and the previous 0.86 public release of the Xforms
library. It requires at least Perl 5.002 and has been successfully compiled
and run on all major versions of Perl up to and including 5.004. Perl 5.004
with Xforms 0.88 is the recommended platform.
Please consider this an Alpha release - that is, it's a release that may cause
you to 'alf-beat your head on a hard spiky object! I have not tested EVERY
function. As releases pile up on each other this becomes less and less of a
'good-thing' since now most of the functions are definitely NOT implemented
with bog-standard XSUB code.
*** WHAT'S IMPLEMENTED
Almost everything in Xforms 0.86 and 0.88! From basic forms to XEvent
processing, from GL canvases to XY plots. The man page X11::Xforms details
what's NOT here - and why.
There are also two major 'Value Added Features' that give you additional
facilities not provided with the Xforms library itself:
. The Class Initialization Callback
. The Global Initialization Script
Those familiar with Xforms programming will know the pains they have to go
through in order to customize objects to get a common system look-and-feel
other than the Xforms default. These two facilities provide a very effective
solution for Perl programmers! The X11::Xforms man page has full usage details
for these facilities.
If you want to see what effect these have, after installation run the demos,
then copy the X4Pinit.pl script from the DEMO directory to your home directory
and rename it to .X4Pinit.pl, and then re-run the demos!!!! You will not have
changed a line of code, but the entire look and feel of the demos will have
changed!!
For the most part, the Xforms functions have the same protocols from Perl
as they do from C. This proves mighty useful, since you can very easily
convert the nnnnnnn.c output from Fdesign into equivalent Perl statements.
To this end, the master directory contains a program named fd2Perl which is
an fdesign filter program. By invoking fdesign in the following way:
fdesign -Perl
a file, by the name of your .fd file but with a .pl suffix, will be generated.
This will contain the Perl code to build your fdesign-ed forms. The program is
also callable from the command line. If you are installing from an rpm, then
this program gets copied to your /usr/local/bin directory.
The Xforms library documentation for C (available from the Xforms ftp site)
pertains to a large extent to the Perl interface. So I rely upon that to give
you the low-down on general Xforms programming.
The new X11::Xforms man page, and the ubiquitous Xforms.functions file in
the doc directory, complete the picture by telling you how to interpret the
Xforms doc for use with Perl, and by providing programming notes and call
protocols when these cannot be easily derived from the Xforms doc.
Before using the extension, please read the man page X11::Xforms and then
the comments at the top of the Xforms.functions file in the doc directory.
*** HOW'S IT IMPLEMENTED
Its a Perl Xsub that does quite a lot of magic things under the covers
in order to make Perl scripts believe they are calling Perl subroutines
and to make Xforms believe that it is being called by a C application.
Actually the magic only really gets involved when dealing with callbacks.
The callback mechanism is complex and convoluted and you don't really want
to know its guts!!!
*** WHAT'S CHANGED SINCE VERSION 0.7
. Xforms 0.88 support is added.
. Xforms 0.81 - 0.85 and 0.87 support removed.
. Class Initialization Callback facility added, allowing a callback
subroutine to be invoked every time an object of a particular type
is created.
. Global Initialization Script facility added, allowing a single script
to be written to provide initialization for all X11::Xforms
applications - customize look-and-feel once and it applies to all
scripts!!
. Full pup callback support enabled (by virtue of 0.88 changes).
. proc-dtls.pl demo replaced with ProcExp.pl filesystem explorer.
. Bug fixes to fl_set_defaults, fl_interpolate and others.
. all textbox support removed since 0.88 removed it and it always
was an internal thing anyway.
. menubar api's removed since 0.88 was delivered without them. No
doubt they will come back when support is completed.
. Man page created for X11::Xforms (was already there for XEvent and
XFontStruct). Contains enhanced detailed programming information,
details on the Value Added Features, the contents from the old
Xforms.not_implemented doc file, and pointers to where to get more
detailed information.
. Consequently Xforms.not_implemented is deleted
. All previous version change information moved to a new CHANGES file
in the doc directory.
*** WHAT YOU NEED
You need a couple of things:
. T.C.Zhao's and Mark Overmars' Forms Library for X, version 0.86 or 0.88
You can get that from
ftp://einstein.phys.uwm.edu/pub/Xforms
. Perl version 5.003 or 5.004. You need to have installed the full
distribution (though you don't need the source tree itself). You
need the Perl extensions that get distributed with Perl but no others.
The package may compile successfully on 5.002 as well.
*** HOW TO INSTALL IT
If you installed from a binary RPM, this section is an elephant .. er ...
sorry, irrelevant.
If you installed from a SOURCE rpm, then use rpm -ba from the RedHat SPECS
directory in order to build and install the binaries - then skip the remainder
of the section.
Otherwise If you are reading this then you know how to gunzip/untar the
distribution! From there you SHOULD be able to just do the following IF you
want to use the extension as a dynamically loaded extension. If you want it
statically bound then you need to read the comments that are found in the
Makefile generated by the first step:
In the Xforms, XEvent and XFontStruct subdirectories of the X11
directory:
1) edit Makefile.PL # Read the comments in Makefile.PL that pertain
# to Include paths, Library paths, OpenGL, and
# object file 'stripping' and make any
# necessary changes.
Then, in the X11 directory, do
2) Perl Makefile.PL # to make the makefile using the Perl
# MakeMaker.pm extension
3) make # To make a dynamic extension.
4) make install # To install the extension.
Then,
5) cp fd2Perl ... # Where ... is a directory that is in your
# PATH when you run fdesign
6) Convert previous Xforms4Perl scripts to 0.8 (see below)
*** HOW TO CONVERT Xforms4Perl 0.4, 0.5, 0.6 or 0.7 SCRIPTS TO Xforms4Perl 0.8
YOU DON'T NEED TO CONVERT 0.7 SCRIPTS. Thankfully the interface seems to
have stabilized!!
For others, the only changes are in the format and quantity of 'use'
statements.
There is a Perl script named cnvtto8.pl, found in the doc directory, which
will do the work for you. Invoke it like this:
cnvtto8.pl <script.1> ...
It will back up the old script with a suffix of '.x4p.old'.
Note that the 0.4, 0.5 or 0.6 packages are NOT removed by 0.8. They are
not even disabled. On the other hand, 0.7 will probably be completely wiped
out by installing 0.8 - back it up if you need to!
To remove the 0.4-0.6 versions of Xforms4Perl you must look in the site_Perl
directory of your base Perl directory (mine is /usr/lib/Perl5) and remove all
files and directories with names matching 'Forms_*', 'Xforms', 'XEvent' or
'XFontStruct' EXCEPT those found under the X11 directory trees trees (sorry
it's so confusing). If you do accidentally remove any under the X11 trees,
just re-install 0.8
*** HOW TO USE IT
Basically just add
use X11::Xforms;
to your Perl script, then follow the instructions given in the Xforms
documentation, making any necessary semantic transformations between the
C presented therein and the Perl you are using.
To access XFontStruct or XEvent structure fields, you will also have to
add:
use X11:XFontStruct;
and/or
use X11:XEvent;
All three packages now have detailed man pages named X11::<package name>.
Read X11::Xforms before doing anything - it tells you just about everything
you need to know to get started - or, at least, where to go for more info
*** THE DEMOS
There is a directory, named DEMOS, that, funnily enough, contains
demonstration scripts! Many of these are converted native Xforms demos and, as
such, should work on any OS platform that has successfully installed
Xforms4Perl. The scripts X4Pinit.pl and psf.pl are not intended to be run
stand-alone. The former is a sample Global Initialization Script, the latter
is a Perl implementation of a tree-formatted 'ps' command that you might
want to try with the ProcCntl.pl script on non-Linux platforms.
Note that some of the DEMOS rely on Xforms version 0.88 being installed. If you
try to run these against 0.86 you will get an error message on stdout that
explains the problem, and the script will die.
The original inspiration for this project is also included. Its a toolbar (yawn
yawn - another toolbar). But the fact that it is written in Perl is what's
impressive. It has full GUI configuration, pixmap button support, tool tips
etc etc. Acts a bit like the M* Of*ice toolbar of Win*ows 3.*! This should also
work on all platforms.
There is an interactive grepper, XFgrep.pl, that allows you to double click on
a grep result line to edit the file in which the RE was found, even positioning
the editor at that line (depending on editor capabilities).
There are also three 'useful' demos that are designed specifically for
Linux - ProcCntl.pl, XFbat.pl and ProcExp.pl. They all use the Linux /proc
file system, ProcCntl also relies on the GNU ps 'tree' display for its pretty
look. These are, therefore, unlikely to work on non-Linux systems, though
ProcExp.pl, a filesystem explorer complete with a splitter bar, can be made
more general by changing a program switch. However, I would be very interested
to see someone else's workings of these in order to include more generic
versions in future releases.
And if someone wants to re-work the XFtool.pl demo to look like Of*ice 95/97
then that might be quite cool too.
TRY THIS:
After installation, run the demos. Then copy X4Pinit.pl from the DEMOS
directory to your home directory, renaming it .X4Pinit.pl. Then run
the demos again.
THATS what the Value Added Features do!
*** OPENGL NOTES
The OpenGL related functions are now part of the X11::Xforms package.
To use them you MUST change the Makefile.PL file in the Xforms directory.
See the comments in Makefile.PL for details. If you attempt to use an OpenGL
function WITHOUT compiling them into the package then your Perl script will
die with a message:
Xforms4Perl OpenGL functions are not installed.
To rectify, make the changes necessary in the Makefile.PL and re-build the
package.
*** DEVELOPMENT DETAILS
This version was developed on an IBM Thinkpad 760ED running Linux 2.0.30
from RedHat, X11R6, the Xforms Library 0.86-to-88 and Perl 5.002-5.004. It
should work on any version of Linux that runs other Xforms applications and
Perl 5.002 and above. It should also run on any Unix system that can run
Xforms and Perl 5.002 and above, or at least be reasonably easy to port.
Your implementation stories, along with comments/questions/bug-reports and ecstatic testimonials are welcome, to
martin@nitram.demon.co.uk
or on the Xforms mailing list, which I read (but to make sure I do, put the
phrase 'Xforms4Perl' in the heading!!)
*** THANKS
My main 'other party' thanks goes to Zoran Popovic <zoran@cs.cmu.edu> for
his extensive testing efforts on the original versions (especially around the
OpenGL area) and suggestions, and also for the convert fd file script upon
which the fdesign filter is based (fd2Perl, found in the master directory).
Thanks to the CPAN people for their packaging comments - it only took me six
months to implement their ideas!!
Thanks to Reza Naima <reza@reza.extern.ucsd.edu>, who tested and championed
previous versions of this otherwise personal project.
Thanks to Dr Zhao (Dr. Xforms) for his patience with my nagging about API
protocol strategies that aren't suitable for Perl, for thanking ME in HIS
doc, and, or course, for Xforms itself (along with Mark Overmars).
Thanks to Michael Fulbright of RedHat for help with building the RPM.
Thanks to the following for platform problem reports (in no particular order):
Randy J. Ray (HP-UX)
Michael J. Salay (HP-UX)
Arthur Blair (SunOS 4.1.3)
Thomas Eickermann (AIX and others)
Phillips Nguyen (SGI)
Joshua S. Pincus (SunOS)
Further thanks to Randy for other suggestions that make this more portable,
more standard, and much cleaner. Incidentally, Randy has a Perl extension of
his own, named X11::Fvwm that assists in the creation of FVWM modules written
in Perl. An Xforms extension to that package is being developed using
Xforms4Perl. See any CPAN mirror site for details.
Martin Bartlett
Xforms4Perl-0.8.4/X11/ 40775 0 0 0 6506157713 12257 5 ustar root root Xforms4Perl-0.8.4/X11/XEvent/ 40755 0 0 0 6506157702 13464 5 ustar root root Xforms4Perl-0.8.4/X11/XEvent/MANIFEST 100644 0 0 51 6130500317 14631 0 ustar root root MANIFEST
Makefile.PL
XEvent.pm
XEvent.xs
Xforms4Perl-0.8.4/X11/XEvent/Makefile.PL 100644 0 0 3245 6443245417 15540 0 ustar root root # XEvent.pm - An extension to PERL to access XEvent structures.
# Copyright (C) 1996-1997 Martin Bartlett
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
#
# IF YOUR SYSTEM DOES NOT HAVE A 'STRIP' UTILITY TO DISCARD SYMBOLS FROM
# OBJECT FILES, THEN DELETE THE
#
# sub MY::dynamic_lib
#
# SUBROUTINE BELOW, OTHERWISE THIS MODULE WILL NOT COMPILE CORRECTLY
#
WriteMakefile(
'NAME' => 'X11::XEvent',
'VERSION_FROM' => 'XEvent.pm',
'LIBS' => ['-L/usr/X11R6/lib -lX11'], # e.g., '-lm'
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
'INC' => '' # e.g., '-I/usr/include/other'
);
sub MY::dynamic_lib {
my $self = shift;
local *dynamic_lib;
my $lk=$self->MM::dynamic_lib;
my $strip = "strip";
$strip = "strip -f" if ($Config::Config{osname} =~ /irix/);
$strip = "true" if ($Config::Config{osname} =~ /sunos/);
$lk . "\t$strip \$@\n";
}
Xforms4Perl-0.8.4/X11/XEvent/XEvent.pm 100644 0 0 11615 6322156311 15343 0 ustar root root # XEvent.pm - An extension to PERL to access XEvent structures.
# Copyright (C) 1996-1997 Martin Bartlett
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
package X11::XEvent;
require Exporter;
require DynaLoader;
require AutoLoader;
=head1 NAME
XEvent - package to access XEvent structure fields
=head1 SYNOPSIS
use <a package that returns XEvents>;
use X11::XEvent;
$xevent = function_that_returns_xevent(its, parms);
$type = $xevent->type;
# Any XEvent field can be read like this.
=head1 DESCRIPTION
This class/package provides an extension to perl that allows
Perl programs read-only access to the XEvent structure. So.
how do they get hold of an XEvent to read? Well, they use ANOTHER
Perl extension that blesses pointers to XEvents into the XEvent
class. Such an extension would do that by supplying a TYPEMAP as
follows:
XEvent * T_PTROBJ
and then returning XEvent pointers from appropriate function calls.
An extension that does this is the X11::Xforms extension. So, using these
two extensions the perl programmer can do some pretty powerful
XWindows application programming.
So whats in this package. Well, quite simply, every method in this
package is named after a field in the XEvent structure. Now, anyone
who has seen that structure knows that it is, in fact, a union of
a bunch of other structures, the only common field of which is the
first field, the type field.
However, this package is written so that you don't have to know the
REAL structure of the event you are interested in, you just have to
know the name of the field you are after. ALL XEvent fields are
catered for, even the wierd vector ones. ALL are returned as perl
scalars of various intuitively obvious types.
There is one special function that might interest some of you. The
all_fields function returns the values of all fields in the XEvent
as a perl list.
=cut
@ISA = qw(Exporter DynaLoader);
$X11::XEvent::VERSION = '0.7';
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
AnyModifier
Button1
Button1Mask
Button1MotionMask
Button2
Button2Mask
Button2MotionMask
Button3
Button3Mask
Button3MotionMask
Button4
Button4Mask
Button4MotionMask
Button5
Button5Mask
Button5MotionMask
ButtonMotionMask
ButtonPress
ButtonPressMask
ButtonRelease
ButtonReleaseMask
CirculateNotify
CirculateRequest
ClientMessage
ColormapChangeMask
ColormapNotify
ConfigureNotify
ConfigureRequest
ControlMapIndex
ControlMask
CreateNotify
DestroyNotify
EnterNotify
EnterWindowMask
Expose
ExposureMask
FocusChangeMask
FocusIn
FocusOut
GraphicsExpose
GravityNotify
KeyPress
KeyPressMask
KeyRelease
KeyReleaseMask
KeymapNotify
KeymapStateMask
LASTEvent
LeaveNotify
LeaveWindowMask
LockMapIndex
LockMask
MapNotify
MapRequest
MappingNotify
Mod1MapIndex
Mod1Mask
Mod2MapIndex
Mod2Mask
Mod3MapIndex
Mod3Mask
Mod4MapIndex
Mod4Mask
Mod5MapIndex
Mod5Mask
MotionNotify
NoEventMask
NoExpose
OwnerGrabButtonMask
PointerMotionHintMask
PointerMotionMask
PropertyChangeMask
PropertyNotify
ReparentNotify
ResizeRedirectMask
ResizeRequest
SelectionClear
SelectionNotify
SelectionRequest
ShiftMapIndex
ShiftMask
StructureNotifyMask
SubstructureNotifyMask
SubstructureRedirectMask
UnmapNotify
VisibilityChangeMask
VisibilityNotify
XKeycodeToKeysym
);
sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function. If a constant is not found then control is passed
# to the AUTOLOAD in AutoLoader.
local($constname);
($constname = $AUTOLOAD) =~ s/.*:://;
$val = constant($constname, @_ ? $_[0] : 0);
if ($! != 0) {
if ($! =~ /Invalid/) {
$AutoLoader::AUTOLOAD = $AUTOLOAD;
goto &AutoLoader::AUTOLOAD;
}
else {
($pack,$file,$line) = caller;
die "Your vendor has not defined XEventPtr macro $constname, used at $file on $line.";
}
}
eval "sub $AUTOLOAD { $val }";
goto &$AUTOLOAD;
}
bootstrap X11::XEvent;
# Preloaded methods go here.
# Autoload methods go after __END__, and are processed by the autosplit program.
1;
__END__
Xforms4Perl-0.8.4/X11/XEvent/XEvent.xs 100644 0 0 53307 6317572537 15405 0 ustar root root /*
# XEvent.pm - An extension to PERL to access XEvent structures.
# Copyright (C) 1996-1997 Martin Bartlett
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <X11/X.h>
#include <X11/Xlib.h>
/*
* This is a very simple Xsub!! It provides an extension to perl that
* allows Perl programs read-only access to the XEvent structure. So.
* how do they get hold of an XEvent to read? Well, they use ANOTHER
* Perl extension that blesses pointers to XEvents into the XEventPtr
* class. Such an extension would do that by supplying a TYPEMAP as
* follows:
*
* XEvent * T_PTROBJ
*
* and then returning XEvent pointers as appropriate to the perl program.
*
* An extension that does this is the XForms extension. So, using these
* two extensions the perl programmer can do some pretty reasonable
* XWindows application programming.
*
* So whats in this package. Well, quite simply, every method in this
* package is named after a field in the XEvent structure. Now, anyone
* who has seen that structure knows that it is, in fact, a union of
* a bunch of other structures, the only common field of which is the
* first field, the type field.
*
* However, this package is written so that you don't have to know the
* REAL structure of the event you are interested in, you just have to
* know the name of the field you are after. ALL XEVent fields are
* catered for, even the wierd vector ones. ALL are returned as perl
* scalars of various intuitively obvious types.
*
* For info on how to use the XEventPtr extension, see XEventPtr.pm
*
*/
/*
* Structure defining the layout of the contants list
*/
#define NUMCONS 87
typedef struct _const_value {
const char * constr;
const double conval;
} const_value;
/*
* The constants list
*/
static const_value constants[NUMCONS] = {
{ "AnyModifier", AnyModifier },
{ "Button1", Button1 },
{ "Button1Mask", Button1Mask },
{ "Button1MotionMask", Button1MotionMask },
{ "Button2", Button2 },
{ "Button2Mask", Button2Mask },
{ "Button2MotionMask", Button2MotionMask },
{ "Button3", Button3 },
{ "Button3Mask", Button3Mask },
{ "Button3MotionMask", Button3MotionMask },
{ "Button4", Button4 },
{ "Button4Mask", Button4Mask },
{ "Button4MotionMask", Button4MotionMask },
{ "Button5", Button5 },
{ "Button5Mask", Button5Mask },
{ "Button5MotionMask", Button5MotionMask },
{ "ButtonMotionMask", ButtonMotionMask },
{ "ButtonPress", ButtonPress },
{ "ButtonPressMask", ButtonPressMask },
{ "ButtonRelease", ButtonRelease },
{ "ButtonReleaseMask", ButtonReleaseMask },
{ "CirculateNotify", CirculateNotify },
{ "CirculateRequest", CirculateRequest },
{ "ClientMessage", ClientMessage },
{ "ColormapChangeMask", ColormapChangeMask },
{ "ColormapNotify", ColormapNotify },
{ "ConfigureNotify", ConfigureNotify },
{ "ConfigureRequest", ConfigureRequest },
{ "ControlMapIndex", ControlMapIndex },
{ "ControlMask", ControlMask },
{ "CreateNotify", CreateNotify },
{ "DestroyNotify", DestroyNotify },
{ "EnterNotify", EnterNotify },
{ "EnterWindowMask", EnterWindowMask },
{ "Expose", Expose },
{ "ExposureMask", ExposureMask },
{ "FocusChangeMask", FocusChangeMask },
{ "FocusIn", FocusIn },
{ "FocusOut", FocusOut },
{ "GraphicsExpose", GraphicsExpose },
{ "GravityNotify", GravityNotify },
{ "KeyPress", KeyPress },
{ "KeyPressMask", KeyPressMask },
{ "KeyRelease", KeyRelease },
{ "KeyReleaseMask", KeyReleaseMask },
{ "KeymapNotify", KeymapNotify },
{ "KeymapStateMask", KeymapStateMask },
{ "LASTEvent", LASTEvent },
{ "LeaveNotify", LeaveNotify },
{ "LeaveWindowMask", LeaveWindowMask },
{ "LockMapIndex", LockMapIndex },
{ "LockMask", LockMask },
{ "MapNotify", MapNotify },
{ "MapRequest", MapRequest },
{ "MappingNotify", MappingNotify },
{ "Mod1MapIndex", Mod1MapIndex },
{ "Mod1Mask", Mod1Mask },
{ "Mod2MapIndex", Mod2MapIndex },
{ "Mod2Mask", Mod2Mask },
{ "Mod3MapIndex", Mod3MapIndex },
{ "Mod3Mask", Mod3Mask },
{ "Mod4MapIndex", Mod4MapIndex },
{ "Mod4Mask", Mod4Mask },
{ "Mod5MapIndex", Mod5MapIndex },
{ "Mod5Mask", Mod5Mask },
{ "MotionNotify", MotionNotify },
{ "NoEventMask", NoEventMask },
{ "NoExpose", NoExpose },
{ "OwnerGrabButtonMask", OwnerGrabButtonMask },
{ "PointerMotionHintMask", PointerMotionHintMask },
{ "PointerMotionMask", PointerMotionMask },
{ "PropertyChangeMask", PropertyChangeMask },
{ "PropertyNotify", PropertyNotify },
{ "ReparentNotify", ReparentNotify },
{ "ResizeRedirectMask", ResizeRedirectMask },
{ "ResizeRequest", ResizeRequest },
{ "SelectionClear", SelectionClear },
{ "SelectionNotify", SelectionNotify },
{ "SelectionRequest", SelectionRequest },
{ "ShiftMapIndex", ShiftMapIndex },
{ "ShiftMask", ShiftMask },
{ "StructureNotifyMask", StructureNotifyMask },
{ "SubstructureNotifyMask", SubstructureNotifyMask },
{ "SubstructureRedirectMask", SubstructureRedirectMask },
{ "UnmapNotify", UnmapNotify },
{ "VisibilityChangeMask", VisibilityChangeMask },
{ "VisibilityNotify", VisibilityNotify }
};
static double
constant(name, arg)
char *name;
int arg;
{
int wrktop, wrkbot, wrkmid, i;
errno = 0;
wrktop = 0;
wrkbot = NUMCONS-1;
wrkmid = (NUMCONS/2)-1;
while (wrktop < wrkmid && wrkbot > wrkmid) {
i = strcmp(constants[wrkmid].constr, name);
if (i == 0)
return constants[wrkmid].conval;
else if (i < 0)
wrktop = wrkmid;
else
wrkbot = wrkmid;
wrkmid = wrktop + ((wrkbot - wrktop) / 2);
}
/*
* If we get here then we check the rest sequentially
*/
while (wrktop <= wrkbot) {
if (strEQ(constants[wrktop].constr, name))
return constants[wrktop].conval;
wrktop++;
}
errno = EINVAL;
return 0;
}
/*
* The obligitary not_here
*/
static int
not_here(s)
char *s;
{
croak("%s not implemented on this architecture", s);
return -1;
}
MODULE = X11::XEvent PACKAGE = X11::XEvent
PROTOTYPES: DISABLE
double
constant(name,arg)
char * name
int arg
KeySym
XKeycodeToKeysym(display,keycode,index)
Display * display
KeyCode keycode
int index
XEvent *
new(class)
char * class
CODE:
{
/*
* This is a test method that is NOT exported by the .pm
*/
XEvent * newevent;
printf("Creating a new event in %s!!\n", class);
newevent = (XEvent *)malloc(sizeof(XEvent));
newevent->xconfigure.type = ConfigureNotify;
newevent->xconfigure.serial = 2;
newevent->xconfigure.send_event = 3;
newevent->xconfigure.display = (Display *)4;
newevent->xconfigure.event = 5;
newevent->xconfigure.window = 6;
newevent->xconfigure.x = 7;
newevent->xconfigure.y = 8;
newevent->xconfigure.width = 9;
newevent->xconfigure.height = 10;
newevent->xconfigure.border_width = 11;
newevent->xconfigure.above = 12;
newevent->xconfigure.override_redirect = 13;
RETVAL = newevent;
}
OUTPUT:
RETVAL
Display *
display(event)
XEvent * event
CODE:
{
switch(event->type) {
case 0:
RETVAL = event->xerror.display;
break;
default:
RETVAL = event->xany.display;
break;
}
}
OUTPUT:
RETVAL
void
type(event)
XEvent * event
ALIAS:
serial = 1
send_event = 2
window = 3
root = 4
subwindow = 5
time = 6
x = 7
y = 8
x_root = 9
y_root = 1
