LibreMediaServer/lms-video
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

- Reestructuración de ficheros y directorios general

Browse source 
- merge v0.01 --> Añadido fileselector
- Añadidas fuentes de Gem y Pure Data
- pix2jpg incluído en Gem. Archivos de construcción de Gem modificados.
- Añadido fichero ompiling.txt con instrucciones de compilación
This commit is contained in:
Santi Noreña 2013-02-04 18:00:17 +01:00
parent c9adfd020b
commit e85d191b46
3100 changed files with 775434 additions and 3073 deletions
Download patch file Download diff file Expand all files Collapse all files

17
tcl/AppMain.tcl Normal file
View file

@ -0,0 +1,17 @@
# This file is for the Wish.app on Mac OS X. It is only used when a Wish.app
# is loading embedded pd code on Mac OS X. It is completely unused on any
# other configuration, like when 'pd' launches Wish.app or when 'pd' is using
# an X11 wish on Mac OS X. GNU/Linux and Windows will never use this file.
package require apple_events
# TODO is there anything useful to do with the psn (Process Serial Number)?
if {[string first "-psn" [lindex $argv 0]] == 0} {
set argv [lrange $argv 1 end]
set argc [expr $argc - 1]
}
# launch pd-gui.tcl here
if [catch {source [file join [file dirname [info script]] pd-gui.tcl]}] {
puts stderr $errorInfo
}

547
tcl/Makefile Normal file
View file

@ -0,0 +1,547 @@
# Makefile.in generated by automake 1.11.6 from Makefile.am.
# tcl/Makefile. Generated from Makefile.in by configure.
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
# 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software
# Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
am__make_dryrun = \
{ \
am__dry=no; \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
echo 'am--echo: ; @echo "AM" OK' | $(MAKE) -f - 2>/dev/null \
| grep '^AM OK$$' >/dev/null || am__dry=yes;; \
*) \
for am__flg in $$MAKEFLAGS; do \
case $$am__flg in \
*=*|--*) ;; \
*n*) am__dry=yes; break;; \
esac; \
done;; \
esac; \
test $$am__dry = yes; \
}
pkgdatadir = $(datadir)/pd
pkgincludedir = $(includedir)/pd
pkglibdir = $(libdir)/pd
pkglibexecdir = $(libexecdir)/pd
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = i686-pc-linux-gnu
host_triplet = i686-pc-linux-gnu
subdir = tcl
DIST_COMMON = $(dist_libpdtcl_DATA) $(dist_libpdtcl_SCRIPTS) \
$(srcdir)/Makefile.am $(srcdir)/Makefile.in
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/android.m4 \
$(top_srcdir)/m4/iphone.m4 $(top_srcdir)/m4/universal.m4 \
$(top_srcdir)/m4/generated/libtool.m4 \
$(top_srcdir)/m4/generated/ltoptions.m4 \
$(top_srcdir)/m4/generated/ltsugar.m4 \
$(top_srcdir)/m4/generated/ltversion.m4 \
$(top_srcdir)/m4/generated/lt~obsolete.m4 \
$(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__installdirs = "$(DESTDIR)$(bindir)" "$(DESTDIR)$(libpdtcldir)" \
"$(DESTDIR)$(libpdtcldir)"
SCRIPTS = $(bin_SCRIPTS) $(dist_libpdtcl_SCRIPTS)
SOURCES =
DIST_SOURCES =
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
DATA = $(dist_libpdtcl_DATA)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = ${SHELL} /home/santi/PMS/pd-0.44-2/m4/config/missing --run aclocal-1.11
ALLOCA =
ALSA_LIBS = -lasound
AMTAR = $${TAR-tar}
AR = ar
ARCH_CFLAGS =
ARCH_LDFLAGS =
AS = as
AUTOCONF = ${SHELL} /home/santi/PMS/pd-0.44-2/m4/config/missing --run autoconf
AUTOHEADER = ${SHELL} /home/santi/PMS/pd-0.44-2/m4/config/missing --run autoheader
AUTOMAKE = ${SHELL} /home/santi/PMS/pd-0.44-2/m4/config/missing --run automake-1.11
AWK = gawk
CC = gcc
CCDEPMODE = depmode=gcc3
CFLAGS = -O6 -funroll-loops -fomit-frame-pointer
CPP = gcc -E
CPPFLAGS =
CXX = g++
CXXCPP = g++ -E
CXXDEPMODE = depmode=gcc3
CXXFLAGS = -g -O2
CYGPATH_W = echo
DEFS = -DPACKAGE_NAME=\"pd\" -DPACKAGE_TARNAME=\"pd\" -DPACKAGE_VERSION=\"0.44.0\" -DPACKAGE_STRING=\"pd\ 0.44.0\" -DPACKAGE_BUGREPORT=\"\" -DPACKAGE_URL=\"\" -DPACKAGE=\"pd\" -DVERSION=\"0.44.0\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_DLFCN_H=1 -DLT_OBJDIR=\".libs/\" -DHAVE_LIBDL=1 -DSTDC_HEADERS=1 -DHAVE_ALLOCA_H=1 -DHAVE_ALLOCA=1 -DHAVE_FCNTL_H=1 -DHAVE_LIMITS_H=1 -DHAVE_MALLOC_H=1 -DHAVE_NETDB_H=1 -DHAVE_NETINET_IN_H=1 -DHAVE_STDDEF_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_SYS_IOCTL_H=1 -DHAVE_SYS_PARAM_H=1 -DHAVE_SYS_SOCKET_H=1 -DHAVE_SYS_SOUNDCARD_H=1 -DHAVE_SYS_TIME_H=1 -DHAVE_SYS_TIMEB_H=1 -DHAVE_UNISTD_H=1 -DHAVE_FORK=1 -DHAVE_VFORK=1 -DHAVE_WORKING_VFORK=1 -DHAVE_WORKING_FORK=1 -DHAVE_STDLIB_H=1 -DHAVE_MALLOC=1 -DHAVE_STDLIB_H=1 -DHAVE_REALLOC=1 -DRETSIGTYPE=void -DHAVE_DUP2=1 -DHAVE_GETCWD=1 -DHAVE_GETHOSTBYNAME=1 -DHAVE_GETTIMEOFDAY=1 -DHAVE_MEMMOVE=1 -DHAVE_MEMSET=1 -DHAVE_REGCOMP=1 -DHAVE_SELECT=1 -DHAVE_SOCKET=1 -DHAVE_STRCHR=1 -DHAVE_STRERROR=1 -DHAVE_STRRCHR=1 -DHAVE_STRSTR=1 -DHAVE_STRTOL=1
DEPDIR = .deps
DLLTOOL = dlltool
DSYMUTIL =
DUMPBIN =
ECHO_C =
ECHO_N = -n
ECHO_T =
EGREP = /bin/grep -E
EXEEXT =
EXTERNAL_CFLAGS = -fPIC
EXTERNAL_EXTENSION = pd_linux
EXTERNAL_LDFLAGS = -Wl,--export-dynamic -shared -fPIC
EXTERNTARGET =
FGREP = /bin/grep -F
GREP = /bin/grep
HAVE_MSGFMT = yes
INCLUDES =
INSTALL = /usr/bin/install -c
INSTALL_DATA = ${INSTALL} -m 644
INSTALL_PROGRAM = ${INSTALL}
INSTALL_SCRIPT = ${INSTALL}
INSTALL_STRIP_PROGRAM = $(install_sh) -c -s
JACK_LIBS =
LD = /usr/bin/ld
LDFLAGS =
LIBM = -lm
LIBOBJS =
LIBS = -lpthread -ldl
LIBTOOL = $(SHELL) $(top_builddir)/libtool
LIPO =
LN_S = ln -s
LTLIBOBJS =
MAKEINFO = ${SHELL} /home/santi/PMS/pd-0.44-2/m4/config/missing --run makeinfo
MANIFEST_TOOL = :
MKDIR_P = /bin/mkdir -p
NM = /usr/bin/nm -B
NMEDIT =
OBJDUMP = objdump
OBJEXT = o
OTOOL =
OTOOL64 =
PACKAGE = pd
PACKAGE_BUGREPORT =
PACKAGE_NAME = pd
PACKAGE_STRING = pd 0.44.0
PACKAGE_TARNAME = pd
PACKAGE_URL =
PACKAGE_VERSION = 0.44.0
PATH_SEPARATOR = :
RANLIB = ranlib
SED = /bin/sed
SET_MAKE =
SHELL = /bin/bash
STRIP = strip
VERSION = 0.44.0
abs_builddir = /home/santi/PMS/pd-0.44-2/tcl
abs_srcdir = /home/santi/PMS/pd-0.44-2/tcl
abs_top_builddir = /home/santi/PMS/pd-0.44-2
abs_top_srcdir = /home/santi/PMS/pd-0.44-2
ac_ct_AR = ar
ac_ct_CC = gcc
ac_ct_CXX = g++
ac_ct_DUMPBIN =
am__include = include
am__leading_dot = .
am__quote =
am__tar = $${TAR-tar} chof - "$$tardir"
am__untar = $${TAR-tar} xf -
bindir = ${exec_prefix}/bin
build = i686-pc-linux-gnu
build_alias =
build_cpu = i686
build_os = linux-gnu
build_vendor = pc
builddir = .
datadir = ${datarootdir}
datarootdir = ${prefix}/share
docdir = ${datarootdir}/doc/${PACKAGE_TARNAME}
dvidir = ${docdir}
exec_prefix = ${prefix}
host = i686-pc-linux-gnu
host_alias =
host_cpu = i686
host_os = linux-gnu
host_vendor = pc
htmldir = ${docdir}
includedir = ${prefix}/include
infodir = ${datarootdir}/info
install_sh = ${SHELL} /home/santi/PMS/pd-0.44-2/m4/config/install-sh
libdir = ${exec_prefix}/lib
libexecdir = ${exec_prefix}/libexec
localedir = ${datarootdir}/locale
localstatedir = ${prefix}/var
mandir = ${datarootdir}/man
mkdir_p = /bin/mkdir -p
oldincludedir = /usr/include
pdfdir = ${docdir}
prefix = /usr/local
program_transform_name = s,x,x,
psdir = ${docdir}
sbindir = ${exec_prefix}/sbin
sharedstatedir = ${prefix}/com
srcdir = .
subdirs = portaudio
sysconfdir = ${prefix}/etc
target_alias =
top_build_prefix = ../
top_builddir = ..
top_srcdir = ..
AUTOMAKE_OPTIONS = foreign
SUFFIXES = .tcl
# we want these in the dist tarball
#EXTRA_DIST = CHANGELOG.txt notes.txt makefile.mingw
bin_SCRIPTS = pd-gui.tcl
libpdtcldir = $(pkglibdir)/tcl
dist_libpdtcl_SCRIPTS = pd-gui.tcl
dist_libpdtcl_DATA = apple_events.tcl dialog_canvas.tcl dialog_gatom.tcl dialog_path.tcl pd_bindings.tcl pd_menus.tcl pdwindow.tcl scrollboxwindow.tcl AppMain.tcl dialog_data.tcl dialog_iemgui.tcl dialog_startup.tcl pd_connect.tcl pkgIndex.tcl wheredoesthisgo.tcl dialog_array.tcl dialog_find.tcl dialog_message.tcl helpbrowser.tcl pdtk_canvas.tcl pkg_mkIndex.tcl dialog_audio.tcl dialog_font.tcl dialog_midi.tcl opt_parser.tcl pd_menucommands.tcl pdtk_text.tcl pdtk_textwindow.tcl scrollbox.tcl pd_guiprefs.tcl pd.ico
all: all-am
.SUFFIXES:
.SUFFIXES: .tcl
$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign tcl/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign tcl/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
install-binSCRIPTS: $(bin_SCRIPTS)
@$(NORMAL_INSTALL)
@list='$(bin_SCRIPTS)'; test -n "$(bindir)" || list=; \
if test -n "$$list"; then \
echo " $(MKDIR_P) '$(DESTDIR)$(bindir)'"; \
$(MKDIR_P) "$(DESTDIR)$(bindir)" || exit 1; \
fi; \
for p in $$list; do \
if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
if test -f "$$d$$p"; then echo "$$d$$p"; echo "$$p"; else :; fi; \
done | \
sed -e 'p;s,.*/,,;n' \
-e 'h;s|.*|.|' \
-e 'p;x;s,.*/,,;$(transform)' | sed 'N;N;N;s,\n, ,g' | \
$(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1; } \
{ d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \
if ($$2 == $$4) { files[d] = files[d] " " $$1; \
if (++n[d] == $(am__install_max)) { \
print "f", d, files[d]; n[d] = 0; files[d] = "" } } \
else { print "f", d "/" $$4, $$1 } } \
END { for (d in files) print "f", d, files[d] }' | \
while read type dir files; do \
if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \
test -z "$$files" || { \
echo " $(INSTALL_SCRIPT) $$files '$(DESTDIR)$(bindir)$$dir'"; \
$(INSTALL_SCRIPT) $$files "$(DESTDIR)$(bindir)$$dir" || exit $$?; \
} \
; done
uninstall-binSCRIPTS:
@$(NORMAL_UNINSTALL)
@list='$(bin_SCRIPTS)'; test -n "$(bindir)" || exit 0; \
files=`for p in $$list; do echo "$$p"; done | \
sed -e 's,.*/,,;$(transform)'`; \
dir='$(DESTDIR)$(bindir)'; $(am__uninstall_files_from_dir)
install-dist_libpdtclSCRIPTS: $(dist_libpdtcl_SCRIPTS)
@$(NORMAL_INSTALL)
@list='$(dist_libpdtcl_SCRIPTS)'; test -n "$(libpdtcldir)" || list=; \
if test -n "$$list"; then \
echo " $(MKDIR_P) '$(DESTDIR)$(libpdtcldir)'"; \
$(MKDIR_P) "$(DESTDIR)$(libpdtcldir)" || exit 1; \
fi; \
for p in $$list; do \
if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
if test -f "$$d$$p"; then echo "$$d$$p"; echo "$$p"; else :; fi; \
done | \
sed -e 'p;s,.*/,,;n' \
-e 'h;s|.*|.|' \
-e 'p;x;s,.*/,,;$(transform)' | sed 'N;N;N;s,\n, ,g' | \
$(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1; } \
{ d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \
if ($$2 == $$4) { files[d] = files[d] " " $$1; \
if (++n[d] == $(am__install_max)) { \
print "f", d, files[d]; n[d] = 0; files[d] = "" } } \
else { print "f", d "/" $$4, $$1 } } \
END { for (d in files) print "f", d, files[d] }' | \
while read type dir files; do \
if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \
test -z "$$files" || { \
echo " $(INSTALL_SCRIPT) $$files '$(DESTDIR)$(libpdtcldir)$$dir'"; \
$(INSTALL_SCRIPT) $$files "$(DESTDIR)$(libpdtcldir)$$dir" || exit $$?; \
} \
; done
uninstall-dist_libpdtclSCRIPTS:
@$(NORMAL_UNINSTALL)
@list='$(dist_libpdtcl_SCRIPTS)'; test -n "$(libpdtcldir)" || exit 0; \
files=`for p in $$list; do echo "$$p"; done | \
sed -e 's,.*/,,;$(transform)'`; \
dir='$(DESTDIR)$(libpdtcldir)'; $(am__uninstall_files_from_dir)
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
install-dist_libpdtclDATA: $(dist_libpdtcl_DATA)
@$(NORMAL_INSTALL)
@list='$(dist_libpdtcl_DATA)'; test -n "$(libpdtcldir)" || list=; \
if test -n "$$list"; then \
echo " $(MKDIR_P) '$(DESTDIR)$(libpdtcldir)'"; \
$(MKDIR_P) "$(DESTDIR)$(libpdtcldir)" || exit 1; \
fi; \
for p in $$list; do \
if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
echo "$$d$$p"; \
done | $(am__base_list) | \
while read files; do \
echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(libpdtcldir)'"; \
$(INSTALL_DATA) $$files "$(DESTDIR)$(libpdtcldir)" || exit $$?; \
done
uninstall-dist_libpdtclDATA:
@$(NORMAL_UNINSTALL)
@list='$(dist_libpdtcl_DATA)'; test -n "$(libpdtcldir)" || list=; \
files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \
dir='$(DESTDIR)$(libpdtcldir)'; $(am__uninstall_files_from_dir)
tags: TAGS
TAGS:
ctags: CTAGS
CTAGS:
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-am
all-am: Makefile $(SCRIPTS) $(DATA)
installdirs:
for dir in "$(DESTDIR)$(bindir)" "$(DESTDIR)$(libpdtcldir)" "$(DESTDIR)$(libpdtcldir)"; do \
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
done
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-generic clean-libtool mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-generic
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am: install-dist_libpdtclDATA \
install-dist_libpdtclSCRIPTS
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am: install-binSCRIPTS
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-generic mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am: uninstall-binSCRIPTS uninstall-dist_libpdtclDATA \
uninstall-dist_libpdtclSCRIPTS
.MAKE: install-am install-strip
.PHONY: all all-am check check-am clean clean-generic clean-libtool \
distclean distclean-generic distclean-libtool distdir dvi \
dvi-am html html-am info info-am install install-am \
install-binSCRIPTS install-data install-data-am \
install-dist_libpdtclDATA install-dist_libpdtclSCRIPTS \
install-dvi install-dvi-am install-exec install-exec-am \
install-html install-html-am install-info install-info-am \
install-man install-pdf install-pdf-am install-ps \
install-ps-am install-strip installcheck installcheck-am \
installdirs maintainer-clean maintainer-clean-generic \
mostlyclean mostlyclean-generic mostlyclean-libtool pdf pdf-am \
ps ps-am uninstall uninstall-am uninstall-binSCRIPTS \
uninstall-dist_libpdtclDATA uninstall-dist_libpdtclSCRIPTS
etags: TAGS
etags --append --language=none --regex="/proc[ \t]+\([^ \t]+\)/\1/" *.tcl
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:

16
tcl/Makefile.am Normal file
View file

@ -0,0 +1,16 @@
AUTOMAKE_OPTIONS = foreign
SUFFIXES = .tcl
# we want these in the dist tarball
#EXTRA_DIST = CHANGELOG.txt notes.txt makefile.mingw
bin_SCRIPTS = pd-gui.tcl
libpdtcldir = $(pkglibdir)/tcl
dist_libpdtcl_SCRIPTS = pd-gui.tcl
dist_libpdtcl_DATA = apple_events.tcl dialog_canvas.tcl dialog_gatom.tcl dialog_path.tcl pd_bindings.tcl pd_menus.tcl pdwindow.tcl scrollboxwindow.tcl AppMain.tcl dialog_data.tcl dialog_iemgui.tcl dialog_startup.tcl pd_connect.tcl pkgIndex.tcl wheredoesthisgo.tcl dialog_array.tcl dialog_find.tcl dialog_message.tcl helpbrowser.tcl pdtk_canvas.tcl pkg_mkIndex.tcl dialog_audio.tcl dialog_font.tcl dialog_midi.tcl opt_parser.tcl pd_menucommands.tcl pdtk_text.tcl pdtk_textwindow.tcl scrollbox.tcl pd_guiprefs.tcl pd.ico
etags: TAGS
etags --append --language=none --regex="/proc[ \t]+\([^ \t]+\)/\1/" *.tcl

547
tcl/Makefile.in Normal file
View file

@ -0,0 +1,547 @@
# Makefile.in generated by automake 1.11.6 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
# 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software
# Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__make_dryrun = \
{ \
am__dry=no; \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
echo 'am--echo: ; @echo "AM" OK' | $(MAKE) -f - 2>/dev/null \
| grep '^AM OK$$' >/dev/null || am__dry=yes;; \
*) \
for am__flg in $$MAKEFLAGS; do \
case $$am__flg in \
*=*|--*) ;; \
*n*) am__dry=yes; break;; \
esac; \
done;; \
esac; \
test $$am__dry = yes; \
}
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = tcl
DIST_COMMON = $(dist_libpdtcl_DATA) $(dist_libpdtcl_SCRIPTS) \
$(srcdir)/Makefile.am $(srcdir)/Makefile.in
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/android.m4 \
$(top_srcdir)/m4/iphone.m4 $(top_srcdir)/m4/universal.m4 \
$(top_srcdir)/m4/generated/libtool.m4 \
$(top_srcdir)/m4/generated/ltoptions.m4 \
$(top_srcdir)/m4/generated/ltsugar.m4 \
$(top_srcdir)/m4/generated/ltversion.m4 \
$(top_srcdir)/m4/generated/lt~obsolete.m4 \
$(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__installdirs = "$(DESTDIR)$(bindir)" "$(DESTDIR)$(libpdtcldir)" \
"$(DESTDIR)$(libpdtcldir)"
SCRIPTS = $(bin_SCRIPTS) $(dist_libpdtcl_SCRIPTS)
SOURCES =
DIST_SOURCES =
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
DATA = $(dist_libpdtcl_DATA)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
ALLOCA = @ALLOCA@
ALSA_LIBS = @ALSA_LIBS@
AMTAR = @AMTAR@
AR = @AR@
ARCH_CFLAGS = @ARCH_CFLAGS@
ARCH_LDFLAGS = @ARCH_LDFLAGS@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CXX = @CXX@
CXXCPP = @CXXCPP@
CXXDEPMODE = @CXXDEPMODE@
CXXFLAGS = @CXXFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
EXTERNAL_CFLAGS = @EXTERNAL_CFLAGS@
EXTERNAL_EXTENSION = @EXTERNAL_EXTENSION@
EXTERNAL_LDFLAGS = @EXTERNAL_LDFLAGS@
EXTERNTARGET = @EXTERNTARGET@
FGREP = @FGREP@
GREP = @GREP@
HAVE_MSGFMT = @HAVE_MSGFMT@
INCLUDES = @INCLUDES@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
JACK_LIBS = @JACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBM = @LIBM@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_CXX = @ac_ct_CXX@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
subdirs = @subdirs@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
AUTOMAKE_OPTIONS = foreign
SUFFIXES = .tcl
# we want these in the dist tarball
#EXTRA_DIST = CHANGELOG.txt notes.txt makefile.mingw
bin_SCRIPTS = pd-gui.tcl
libpdtcldir = $(pkglibdir)/tcl
dist_libpdtcl_SCRIPTS = pd-gui.tcl
dist_libpdtcl_DATA = apple_events.tcl dialog_canvas.tcl dialog_gatom.tcl dialog_path.tcl pd_bindings.tcl pd_menus.tcl pdwindow.tcl scrollboxwindow.tcl AppMain.tcl dialog_data.tcl dialog_iemgui.tcl dialog_startup.tcl pd_connect.tcl pkgIndex.tcl wheredoesthisgo.tcl dialog_array.tcl dialog_find.tcl dialog_message.tcl helpbrowser.tcl pdtk_canvas.tcl pkg_mkIndex.tcl dialog_audio.tcl dialog_font.tcl dialog_midi.tcl opt_parser.tcl pd_menucommands.tcl pdtk_text.tcl pdtk_textwindow.tcl scrollbox.tcl pd_guiprefs.tcl pd.ico
all: all-am
.SUFFIXES:
.SUFFIXES: .tcl
$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign tcl/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign tcl/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
install-binSCRIPTS: $(bin_SCRIPTS)
@$(NORMAL_INSTALL)
@list='$(bin_SCRIPTS)'; test -n "$(bindir)" || list=; \
if test -n "$$list"; then \
echo " $(MKDIR_P) '$(DESTDIR)$(bindir)'"; \
$(MKDIR_P) "$(DESTDIR)$(bindir)" || exit 1; \
fi; \
for p in $$list; do \
if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
if test -f "$$d$$p"; then echo "$$d$$p"; echo "$$p"; else :; fi; \
done | \
sed -e 'p;s,.*/,,;n' \
-e 'h;s|.*|.|' \
-e 'p;x;s,.*/,,;$(transform)' | sed 'N;N;N;s,\n, ,g' | \
$(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1; } \
{ d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \
if ($$2 == $$4) { files[d] = files[d] " " $$1; \
if (++n[d] == $(am__install_max)) { \
print "f", d, files[d]; n[d] = 0; files[d] = "" } } \
else { print "f", d "/" $$4, $$1 } } \
END { for (d in files) print "f", d, files[d] }' | \
while read type dir files; do \
if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \
test -z "$$files" || { \
echo " $(INSTALL_SCRIPT) $$files '$(DESTDIR)$(bindir)$$dir'"; \
$(INSTALL_SCRIPT) $$files "$(DESTDIR)$(bindir)$$dir" || exit $$?; \
} \
; done
uninstall-binSCRIPTS:
@$(NORMAL_UNINSTALL)
@list='$(bin_SCRIPTS)'; test -n "$(bindir)" || exit 0; \
files=`for p in $$list; do echo "$$p"; done | \
sed -e 's,.*/,,;$(transform)'`; \
dir='$(DESTDIR)$(bindir)'; $(am__uninstall_files_from_dir)
install-dist_libpdtclSCRIPTS: $(dist_libpdtcl_SCRIPTS)
@$(NORMAL_INSTALL)
@list='$(dist_libpdtcl_SCRIPTS)'; test -n "$(libpdtcldir)" || list=; \
if test -n "$$list"; then \
echo " $(MKDIR_P) '$(DESTDIR)$(libpdtcldir)'"; \
$(MKDIR_P) "$(DESTDIR)$(libpdtcldir)" || exit 1; \
fi; \
for p in $$list; do \
if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
if test -f "$$d$$p"; then echo "$$d$$p"; echo "$$p"; else :; fi; \
done | \
sed -e 'p;s,.*/,,;n' \
-e 'h;s|.*|.|' \
-e 'p;x;s,.*/,,;$(transform)' | sed 'N;N;N;s,\n, ,g' | \
$(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1; } \
{ d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \
if ($$2 == $$4) { files[d] = files[d] " " $$1; \
if (++n[d] == $(am__install_max)) { \
print "f", d, files[d]; n[d] = 0; files[d] = "" } } \
else { print "f", d "/" $$4, $$1 } } \
END { for (d in files) print "f", d, files[d] }' | \
while read type dir files; do \
if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \
test -z "$$files" || { \
echo " $(INSTALL_SCRIPT) $$files '$(DESTDIR)$(libpdtcldir)$$dir'"; \
$(INSTALL_SCRIPT) $$files "$(DESTDIR)$(libpdtcldir)$$dir" || exit $$?; \
} \
; done
uninstall-dist_libpdtclSCRIPTS:
@$(NORMAL_UNINSTALL)
@list='$(dist_libpdtcl_SCRIPTS)'; test -n "$(libpdtcldir)" || exit 0; \
files=`for p in $$list; do echo "$$p"; done | \
sed -e 's,.*/,,;$(transform)'`; \
dir='$(DESTDIR)$(libpdtcldir)'; $(am__uninstall_files_from_dir)
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
install-dist_libpdtclDATA: $(dist_libpdtcl_DATA)
@$(NORMAL_INSTALL)
@list='$(dist_libpdtcl_DATA)'; test -n "$(libpdtcldir)" || list=; \
if test -n "$$list"; then \
echo " $(MKDIR_P) '$(DESTDIR)$(libpdtcldir)'"; \
$(MKDIR_P) "$(DESTDIR)$(libpdtcldir)" || exit 1; \
fi; \
for p in $$list; do \
if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
echo "$$d$$p"; \
done | $(am__base_list) | \
while read files; do \
echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(libpdtcldir)'"; \
$(INSTALL_DATA) $$files "$(DESTDIR)$(libpdtcldir)" || exit $$?; \
done
uninstall-dist_libpdtclDATA:
@$(NORMAL_UNINSTALL)
@list='$(dist_libpdtcl_DATA)'; test -n "$(libpdtcldir)" || list=; \
files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \
dir='$(DESTDIR)$(libpdtcldir)'; $(am__uninstall_files_from_dir)
tags: TAGS
TAGS:
ctags: CTAGS
CTAGS:
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-am
all-am: Makefile $(SCRIPTS) $(DATA)
installdirs:
for dir in "$(DESTDIR)$(bindir)" "$(DESTDIR)$(libpdtcldir)" "$(DESTDIR)$(libpdtcldir)"; do \
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
done
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-generic clean-libtool mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-generic
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am: install-dist_libpdtclDATA \
install-dist_libpdtclSCRIPTS
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am: install-binSCRIPTS
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-generic mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am: uninstall-binSCRIPTS uninstall-dist_libpdtclDATA \
uninstall-dist_libpdtclSCRIPTS
.MAKE: install-am install-strip
.PHONY: all all-am check check-am clean clean-generic clean-libtool \
distclean distclean-generic distclean-libtool distdir dvi \
dvi-am html html-am info info-am install install-am \
install-binSCRIPTS install-data install-data-am \
install-dist_libpdtclDATA install-dist_libpdtclSCRIPTS \
install-dvi install-dvi-am install-exec install-exec-am \
install-html install-html-am install-info install-info-am \
install-man install-pdf install-pdf-am install-ps \
install-ps-am install-strip installcheck installcheck-am \
installdirs maintainer-clean maintainer-clean-generic \
mostlyclean mostlyclean-generic mostlyclean-libtool pdf pdf-am \
ps ps-am uninstall uninstall-am uninstall-binSCRIPTS \
uninstall-dist_libpdtclDATA uninstall-dist_libpdtclSCRIPTS
etags: TAGS
etags --append --language=none --regex="/proc[ \t]+\([^ \t]+\)/\1/" *.tcl
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:

65
tcl/apple_events.tcl Normal file
View file

@ -0,0 +1,65 @@
package provide apple_events 0.1
package require pdwindow
package require wheredoesthisgo
# from http://wiki.tcl.tk/12987
set ::tk::mac::CGAntialiasLimit 0 ;# min line thickness to anti-alias (default: 3)
set ::tk::mac::antialiasedtext 1 ;# enable anti-aliased text
# kAEOpenDocuments
proc ::tk::mac::OpenDocument {args} {
foreach filename $args {
if {$::done_init} {
open_file $filename
} else {
lappend ::filestoopen_list $filename
}
}
set ::pd_menucommands::menu_open_dir [file dirname $filename]
}
# kEventAppHidden
proc ::tk::mac::OnHide {args} {
::pdwindow::verbose 1 "::tk::mac::OnHide $args +++++++++++++++++++++"
}
# kEventAppShown
proc ::tk::mac::OnShow {args} {
::pdwindow::verbose 1 "::tk::mac::OnShow $args +++++++++++++++++++++"
}
# open About Pd... in Tk/Cocoa
proc tkAboutDialog {} {
menu_aboutpd
}
# kAEShowPreferences
proc ::tk::mac::ShowPreferences {args} {
::pdwindow::verbose 1 "::tk::mac::ShowPreferences $args ++++++++++++"
pdsend "pd start-path-dialog"
}
# kAEQuitApplication
proc ::tk::mac::Quit {args} {
pdsend "pd verifyquit"
}
# on Tk/Cocoa, override the Apple Help menu
#proc tk::mac::ShowHelp {args} {
#}
# these I gleaned by reading the source (tkMacOSXHLEvents.c)
proc ::tk::mac::PrintDocument {args} {
menu_print $::focused_window
}
proc ::tk::mac::OpenApplication {args} {
::pdwindow::verbose 1 "::tk::mac::OpenApplication $args ++++++++++++"
}
proc ::tk::mac::ReopenApplication {args} {
::pdwindow::verbose 1 "::tk::mac::ReopenApplication $args ++++++++++"
}

333
tcl/dialog_array.tcl Normal file
View file

@ -0,0 +1,333 @@
package provide dialog_array 0.1
namespace eval ::dialog_array:: {
namespace export pdtk_array_dialog
namespace export pdtk_array_listview_new
namespace export pdtk_array_listview_fillpage
namespace export pdtk_array_listview_setpage
namespace export pdtk_array_listview_closeWindow
}
# global variables for the listview
array set pd_array_listview_entry {}
array set pd_array_listview_id {}
array set pd_array_listview_page {}
set pd_array_listview_pagesize 0
# this stores the state of the "save me" check button
array set saveme_button {}
# this stores the state of the "draw as" radio buttons
array set drawas_button {}
# this stores the state of the "in new graph"/"in last graph" radio buttons
# and the "delete array" checkbutton
array set otherflag_button {}
# TODO figure out how to escape $ args so sharptodollar() isn't needed
############ pdtk_array_dialog -- dialog window for arrays #########
proc ::dialog_array::pdtk_array_listview_setpage {arrayName page} {
set ::pd_array_listview_page($arrayName) $page
}
proc ::dialog_array::listview_changepage {arrayName np} {
pdtk_array_listview_setpage \
$arrayName [expr $::pd_array_listview_page($arrayName) + $np]
pdtk_array_listview_fillpage $arrayName
}
proc ::dialog_array::pdtk_array_listview_fillpage {arrayName} {
set windowName [format ".%sArrayWindow" $arrayName]
set topItem [expr [lindex [$windowName.lb yview] 0] * \
[$windowName.lb size]]
if {[winfo exists $windowName]} {
set cmd "$::pd_array_listview_id($arrayName) \
arrayviewlistfillpage \
$::pd_array_listview_page($arrayName) \
$topItem"
pdsend $cmd
}
}
proc ::dialog_array::pdtk_array_listview_new {id arrayName page} {
set ::pd_array_listview_page($arrayName) $page
set ::pd_array_listview_id($arrayName) $id
set windowName [format ".%sArrayWindow" $arrayName]
if [winfo exists $windowName] then [destroy $windowName]
toplevel $windowName -class DialogWindow
wm group $windowName .
wm protocol $windowName WM_DELETE_WINDOW \
"::dialog_array::listview_close $id $arrayName"
wm title $windowName [concat $arrayName "(list view)"]
# FIXME
set font 12
set $windowName.lb [listbox $windowName.lb -height 20 -width 25\
-selectmode extended \
-relief solid -background white -borderwidth 1 \
-font [format {{%s} %d %s} $::font_family $font $::font_weight]\
-yscrollcommand "$windowName.lb.sb set"]
set $windowName.lb.sb [scrollbar $windowName.lb.sb \
-command "$windowName.lb yview" -orient vertical]
place configure $windowName.lb.sb -relheight 1 -relx 0.9 -relwidth 0.1
pack $windowName.lb -expand 1 -fill both
bind $windowName.lb <Double-ButtonPress-1> \
"::dialog_array::listview_edit $arrayName $page $font"
# handle copy/paste
switch -- $::windowingsystem {
"x11" {selection handle $windowName.lb \
"::dialog_array::listview_lbselection $arrayName"}
"win32" {bind $windowName.lb <ButtonPress-3> \
"::dialog_array::listview_popup $arrayName"}
}
set $windowName.prevBtn [button $windowName.prevBtn -text "<-" \
-command "::dialog_array::listview_changepage $arrayName -1"]
set $windowName.nextBtn [button $windowName.nextBtn -text "->" \
-command "::dialog_array::listview_changepage $arrayName 1"]
pack $windowName.prevBtn -side left -ipadx 20 -pady 10 -anchor s
pack $windowName.nextBtn -side right -ipadx 20 -pady 10 -anchor s
focus $windowName
}
proc ::dialog_array::listview_lbselection {arrayName off size} {
set windowName [format ".%sArrayWindow" $arrayName]
set itemNums [$windowName.lb curselection]
set cbString ""
for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} {
set listItem [$windowName.lb get [lindex $itemNums $i]]
append cbString [string range $listItem \
[expr [string first ") " $listItem] + 2] \
end]
append cbString "\n"
}
set listItem [$windowName.lb get [lindex $itemNums $i]]
append cbString [string range $listItem \
[expr [string first ") " $listItem] + 2] \
end]
set last $cbString
}
# Win32 uses a popup menu for copy/paste
proc ::dialog_array::listview_popup {arrayName} {
set windowName [format ".%sArrayWindow" $arrayName]
if [winfo exists $windowName.popup] then [destroy $windowName.popup]
menu $windowName.popup -tearoff false
$windowName.popup add command -label [_ "Copy"] \
-command "::dialog_array::listview_copy $arrayName; \
destroy $windowName.popup"
$windowName.popup add command -label [_ "Paste"] \
-command "::dialog_array::listview_paste $arrayName; \
destroy $windowName.popup"
tk_popup $windowName.popup [winfo pointerx $windowName] \
[winfo pointery $windowName] 0
}
proc ::dialog_array::listview_copy {arrayName} {
set windowName [format ".%sArrayWindow" $arrayName]
set itemNums [$windowName.lb curselection]
set cbString ""
for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} {
set listItem [$windowName.lb get [lindex $itemNums $i]]
append cbString [string range $listItem \
[expr [string first ") " $listItem] + 2] \
end]
append cbString "\n"
}
set listItem [$windowName.lb get [lindex $itemNums $i]]
append cbString [string range $listItem \
[expr [string first ") " $listItem] + 2] \
end]
clipboard clear
clipboard append $cbString
}
proc ::dialog_array::listview_paste {arrayName} {
set cbString [selection get -selection CLIPBOARD]
set lbName [format ".%sArrayWindow.lb" $arrayName]
set itemNum [lindex [$lbName curselection] 0]
set splitChars ", \n"
set itemString [split $cbString $splitChars]
set flag 1
for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} {
if {[lindex $itemString $i] ne {}} {
pdsend "$arrayName [expr $itemNum + \
[expr $counter + \
[expr $::pd_array_listview_pagesize \
* $::pd_array_listview_page($arrayName)]]] \
[lindex $itemString $i]"
incr counter
set flag 0
}
}
}
proc ::dialog_array::listview_edit {arrayName page font} {
set lbName [format ".%sArrayWindow.lb" $arrayName]
if {[winfo exists $lbName.entry]} {
::dialog_array::listview_update_entry \
$arrayName $::pd_array_listview_entry($arrayName)
unset ::pd_array_listview_entry($arrayName)
}
set itemNum [$lbName index active]
set ::pd_array_listview_entry($arrayName) $itemNum
set bbox [$lbName bbox $itemNum]
set y [expr [lindex $bbox 1] - 4]
set $lbName.entry [entry $lbName.entry \
-font [format {{%s} %d %s} $::font_family $font $::font_weight]]
$lbName.entry insert 0 []
place configure $lbName.entry -relx 0 -y $y -relwidth 1
lower $lbName.entry
focus $lbName.entry
bind $lbName.entry <Return> \
"::dialog_array::listview_update_entry $arrayName $itemNum;"
}
proc ::dialog_array::listview_update_entry {arrayName itemNum} {
set lbName [format ".%sArrayWindow.lb" $arrayName]
set splitChars ", \n"
set itemString [split [$lbName.entry get] $splitChars]
set flag 1
for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} {
if {[lindex $itemString $i] ne {}} {
pdsend "$arrayName [expr $itemNum + \
[expr $counter + \
[expr $::pd_array_listview_pagesize \
* $::pd_array_listview_page($arrayName)]]] \
[lindex $itemString $i]"
incr counter
set flag 0
}
}
pdtk_array_listview_fillpage $arrayName
destroy $lbName.entry
}
proc ::dialog_array::pdtk_array_listview_closeWindow {arrayName} {
set mytoplevel [format ".%sArrayWindow" $arrayName]
destroy $mytoplevel
}
proc ::dialog_array::listview_close {mytoplevel arrayName} {
pdtk_array_listview_closeWindow $arrayName
pdsend "$mytoplevel arrayviewclose"
}
proc ::dialog_array::apply {mytoplevel} {
# TODO figure out how to ditch this escaping mechanism
set mofo [$mytoplevel.name.entry get]
if {[string index $mofo 0] == "$"} {
set mofo [string replace $mofo 0 0 #] }
pdsend "$mytoplevel arraydialog \
$mofo \
[$mytoplevel.size.entry get] \
[expr $::saveme_button($mytoplevel) + (2 * $::drawas_button($mytoplevel))] \
$::otherflag_button($mytoplevel)"
}
proc ::dialog_array::openlistview {mytoplevel} {
pdsend "$mytoplevel arrayviewlistnew"
}
proc ::dialog_array::cancel {mytoplevel} {
pdsend "$mytoplevel cancel"
}
proc ::dialog_array::ok {mytoplevel} {
::dialog_array::apply $mytoplevel
::dialog_array::cancel $mytoplevel
}
proc ::dialog_array::pdtk_array_dialog {mytoplevel name size flags newone} {
if {[winfo exists $mytoplevel]} {
wm deiconify $mytoplevel
raise $mytoplevel
} else {
create_dialog $mytoplevel $newone
}
$mytoplevel.name.entry insert 0 $name
$mytoplevel.size.entry insert 0 $size
set ::saveme_button($mytoplevel) [expr $flags & 1]
set ::drawas_button($mytoplevel) [expr ( $flags & 6 ) >> 1]
set ::otherflag_button($mytoplevel) 0
# pd -> tcl
# 2 * (int)(template_getfloat(template_findbyname(sc->sc_template), gensym("style"), x->x_scalar->sc_vec, 1)));
# tcl->pd
# int style = ((flags & 6) >> 1);
}
proc ::dialog_array::create_dialog {mytoplevel newone} {
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [_ "Array Properties"]
wm group $mytoplevel .
wm resizable $mytoplevel 0 0
wm transient $mytoplevel $::focused_window
$mytoplevel configure -menu $::dialog_menubar
$mytoplevel configure -padx 0 -pady 0
::pd_bindings::dialog_bindings $mytoplevel "array"
frame $mytoplevel.name
pack $mytoplevel.name -side top
label $mytoplevel.name.label -text [_ "Name:"]
entry $mytoplevel.name.entry
pack $mytoplevel.name.label $mytoplevel.name.entry -anchor w
frame $mytoplevel.size
pack $mytoplevel.size -side top
label $mytoplevel.size.label -text [_ "Size:"]
entry $mytoplevel.size.entry
pack $mytoplevel.size.label $mytoplevel.size.entry -anchor w
checkbutton $mytoplevel.saveme -text [_ "Save contents"] \
-variable ::saveme_button($mytoplevel) -anchor w
pack $mytoplevel.saveme -side top
labelframe $mytoplevel.drawas -text [_ "Draw as:"] -padx 20 -borderwidth 1
pack $mytoplevel.drawas -side top -fill x
radiobutton $mytoplevel.drawas.points -value 0 \
-variable ::drawas_button($mytoplevel) -text [_ "Points"]
radiobutton $mytoplevel.drawas.polygon -value 1 \
-variable ::drawas_button($mytoplevel) -text [_ "Polygon"]
radiobutton $mytoplevel.drawas.bezier -value 2 \
-variable ::drawas_button($mytoplevel) -text [_ "Bezier curve"]
pack $mytoplevel.drawas.points -side top -anchor w
pack $mytoplevel.drawas.polygon -side top -anchor w
pack $mytoplevel.drawas.bezier -side top -anchor w
if {$newone != 0} {
labelframe $mytoplevel.radio -text [_ "Put array into:"] -padx 20 -borderwidth 1
pack $mytoplevel.radio -side top -fill x
radiobutton $mytoplevel.radio.radio0 -value 0 \
-variable ::otherflag_button($mytoplevel) -text [_ "New graph"]
radiobutton $mytoplevel.radio.radio1 -value 1 \
-variable ::otherflag_button($mytoplevel) -text [_ "Last graph"]
pack $mytoplevel.radio.radio0 -side top -anchor w
pack $mytoplevel.radio.radio1 -side top -anchor w
} else {
checkbutton $mytoplevel.deletearray -text [_ "Delete array"] \
-variable ::otherflag_button($mytoplevel) -anchor w
pack $mytoplevel.deletearray -side top
}
# jsarlo
if {$newone == 0} {
button $mytoplevel.listview -text [_ "Open List View..."] \
-command "::dialog_array::openlistview $mytoplevel [$mytoplevel.name.entry get]"
pack $mytoplevel.listview -side top
}
# end jsarlo
frame $mytoplevel.buttonframe
pack $mytoplevel.buttonframe -side bottom -expand 1 -fill x -pady 2m
button $mytoplevel.buttonframe.cancel -text [_ "Cancel"] \
-command "::dialog_array::cancel $mytoplevel"
pack $mytoplevel.buttonframe.cancel -side left -expand 1 -fill x -padx 10
if {$newone == 0 && $::windowingsystem ne "aqua"} {
button $mytoplevel.buttonframe.apply -text [_ "Apply"] \
-command "::dialog_array::apply $mytoplevel"
pack $mytoplevel.buttonframe.apply -side left -expand 1 -fill x -padx 10
}
button $mytoplevel.buttonframe.ok -text [_ "OK"]\
-command "::dialog_array::ok $mytoplevel"
pack $mytoplevel.buttonframe.ok -side left -expand 1 -fill x -padx 10
}

323
tcl/dialog_audio.tcl Normal file
View file

@ -0,0 +1,323 @@
package provide dialog_audio 0.1
namespace eval ::dialog_audio:: {
namespace export pdtk_audio_dialog
}
# TODO this panel really needs some reworking, it works but the code is very
# unreadable. The panel could look a lot better too, like using menubuttons
# instead of regular buttons with tk_popup for pulldown menus.
####################### audio dialog ##################3
proc ::dialog_audio::apply {mytoplevel} {
global audio_indev1 audio_indev2 audio_indev3 audio_indev4
global audio_inchan1 audio_inchan2 audio_inchan3 audio_inchan4
global audio_inenable1 audio_inenable2 audio_inenable3 audio_inenable4
global audio_outdev1 audio_outdev2 audio_outdev3 audio_outdev4
global audio_outchan1 audio_outchan2 audio_outchan3 audio_outchan4
global audio_outenable1 audio_outenable2 audio_outenable3 audio_outenable4
global audio_sr audio_advance audio_callback audio_blocksize
pdsend "pd audio-dialog \
$audio_indev1 \
$audio_indev2 \
$audio_indev3 \
$audio_indev4 \
[expr $audio_inchan1 * ( $audio_inenable1 ? 1 : -1 ) ]\
[expr $audio_inchan2 * ( $audio_inenable2 ? 1 : -1 ) ]\
[expr $audio_inchan3 * ( $audio_inenable3 ? 1 : -1 ) ]\
[expr $audio_inchan4 * ( $audio_inenable4 ? 1 : -1 ) ]\
$audio_outdev1 \
$audio_outdev2 \
$audio_outdev3 \
$audio_outdev4 \
[expr $audio_outchan1 * ( $audio_outenable1 ? 1 : -1 ) ]\
[expr $audio_outchan2 * ( $audio_outenable2 ? 1 : -1 ) ]\
[expr $audio_outchan3 * ( $audio_outenable3 ? 1 : -1 ) ]\
[expr $audio_outchan4 * ( $audio_outenable4 ? 1 : -1 ) ]\
$audio_sr \
$audio_advance \
$audio_callback \
$audio_blocksize"
}
proc ::dialog_audio::cancel {mytoplevel} {
pdsend "$mytoplevel cancel"
}
proc ::dialog_audio::ok {mytoplevel} {
::dialog_audio::apply $mytoplevel
::dialog_audio::cancel $mytoplevel
}
# callback from popup menu
proc audio_popup_action {buttonname varname devlist index} {
global audio_indevlist audio_outdevlist $varname
$buttonname configure -text [lindex $devlist $index]
set $varname $index
}
# create a popup menu
proc audio_popup {name buttonname varname devlist} {
if [winfo exists $name.popup] {destroy $name.popup}
menu $name.popup -tearoff false
if {$::windowingsystem eq "win32"} {
$name.popup configure -font menuFont
}
for {set x 0} {$x<[llength $devlist]} {incr x} {
$name.popup add command -label [lindex $devlist $x] \
-command [list audio_popup_action \
$buttonname $varname $devlist $x]
}
tk_popup $name.popup [winfo pointerx $name] [winfo pointery $name] 0
}
# start a dialog window to select audio devices and settings. "multi"
# is 0 if only one device is allowed; 1 if one apiece may be specified for
# input and output; and 2 if we can select multiple devices. "longform"
# (which only makes sense if "multi" is 2) asks us to make controls for
# opening several devices; if not, we get an extra button to turn longform
# on and restart the dialog.
proc ::dialog_audio::pdtk_audio_dialog {mytoplevel \
indev1 indev2 indev3 indev4 \
inchan1 inchan2 inchan3 inchan4 \
outdev1 outdev2 outdev3 outdev4 \
outchan1 outchan2 outchan3 outchan4 sr advance multi callback \
longform blocksize} {
global audio_indev1 audio_indev2 audio_indev3 audio_indev4
global audio_inchan1 audio_inchan2 audio_inchan3 audio_inchan4
global audio_inenable1 audio_inenable2 audio_inenable3 audio_inenable4
global audio_outdev1 audio_outdev2 audio_outdev3 audio_outdev4
global audio_outchan1 audio_outchan2 audio_outchan3 audio_outchan4
global audio_outenable1 audio_outenable2 audio_outenable3 audio_outenable4
global audio_sr audio_advance audio_callback audio_blocksize
global audio_indevlist audio_outdevlist
global pd_indev pd_outdev
global audio_longform
set audio_indev1 $indev1
set audio_indev2 $indev2
set audio_indev3 $indev3
set audio_indev4 $indev4
set audio_inchan1 [expr ( $inchan1 > 0 ? $inchan1 : -$inchan1 ) ]
set audio_inenable1 [expr $inchan1 > 0 ]
set audio_inchan2 [expr ( $inchan2 > 0 ? $inchan2 : -$inchan2 ) ]
set audio_inenable2 [expr $inchan2 > 0 ]
set audio_inchan3 [expr ( $inchan3 > 0 ? $inchan3 : -$inchan3 ) ]
set audio_inenable3 [expr $inchan3 > 0 ]
set audio_inchan4 [expr ( $inchan4 > 0 ? $inchan4 : -$inchan4 ) ]
set audio_inenable4 [expr $inchan4 > 0 ]
set audio_outdev1 $outdev1
set audio_outdev2 $outdev2
set audio_outdev3 $outdev3
set audio_outdev4 $outdev4
set audio_outchan1 [expr ( $outchan1 > 0 ? $outchan1 : -$outchan1 ) ]
set audio_outenable1 [expr $outchan1 > 0 ]
set audio_outchan2 [expr ( $outchan2 > 0 ? $outchan2 : -$outchan2 ) ]
set audio_outenable2 [expr $outchan2 > 0 ]
set audio_outchan3 [expr ( $outchan3 > 0 ? $outchan3 : -$outchan3 ) ]
set audio_outenable3 [expr $outchan3 > 0 ]
set audio_outchan4 [expr ( $outchan4 > 0 ? $outchan4 : -$outchan4 ) ]
set audio_outenable4 [expr $outchan4 > 0 ]
set audio_sr $sr
set audio_advance $advance
set audio_callback $callback
set audio_blocksize $blocksize
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [_ "Audio Settings"]
wm group $mytoplevel .
wm resizable $mytoplevel 0 0
wm transient $mytoplevel
$mytoplevel configure -menu $::dialog_menubar
$mytoplevel configure -padx 10 -pady 5
::pd_bindings::dialog_bindings $mytoplevel "audio"
# not all Tcl/Tk versions or platforms support -topmost, so catch the error
catch {wm attributes $mytoplevel -topmost 1}
frame $mytoplevel.buttonframe
pack $mytoplevel.buttonframe -side bottom -fill x -pady 2m
button $mytoplevel.buttonframe.cancel -text [_ "Cancel"]\
-command "::dialog_audio::cancel $mytoplevel"
pack $mytoplevel.buttonframe.cancel -side left -expand 1 -fill x -padx 15
button $mytoplevel.buttonframe.apply -text [_ "Apply"]\
-command "::dialog_audio::apply $mytoplevel"
pack $mytoplevel.buttonframe.apply -side left -expand 1 -fill x -padx 15
button $mytoplevel.buttonframe.ok -text [_ "OK"] \
-command "::dialog_audio::ok $mytoplevel"
pack $mytoplevel.buttonframe.ok -side left -expand 1 -fill x -padx 15
button $mytoplevel.saveall -text [_ "Save All Settings"]\
-command "::dialog_audio::apply $mytoplevel; pdsend {pd save-preferences}"
pack $mytoplevel.saveall -side bottom -expand 1 -pady 5
# sample rate and advance
frame $mytoplevel.srf
pack $mytoplevel.srf -side top
label $mytoplevel.srf.l1 -text [_ "Sample rate:"]
entry $mytoplevel.srf.x1 -textvariable audio_sr -width 7
label $mytoplevel.srf.l2 -text [_ "Delay (msec):"]
entry $mytoplevel.srf.x2 -textvariable audio_advance -width 4
label $mytoplevel.srf.l3 -text [_ "Block size:"]
tk_optionMenu $mytoplevel.srf.x3 audio_blocksize 64 128 256 512 1024 2048
pack $mytoplevel.srf.l1 $mytoplevel.srf.x1 $mytoplevel.srf.l2 \
$mytoplevel.srf.x2 $mytoplevel.srf.l3 $mytoplevel.srf.x3 -side left
if {$audio_callback >= 0} {
checkbutton $mytoplevel.srf.x4 -variable audio_callback \
-text [_ "Use callbacks"] -anchor e
pack $mytoplevel.srf.x4 -side left
}
# input device 1
frame $mytoplevel.in1f
pack $mytoplevel.in1f -side top
checkbutton $mytoplevel.in1f.x0 -variable audio_inenable1 \
-text [_ "Input device 1:"] -anchor e
button $mytoplevel.in1f.x1 -text [lindex $audio_indevlist $audio_indev1] \
-command [list audio_popup $mytoplevel $mytoplevel.in1f.x1 audio_indev1 $audio_indevlist]
label $mytoplevel.in1f.l2 -text [_ "Channels:"]
entry $mytoplevel.in1f.x2 -textvariable audio_inchan1 -width 3
pack $mytoplevel.in1f.x0 $mytoplevel.in1f.x1 $mytoplevel.in1f.l2 \
$mytoplevel.in1f.x2 -side left -fill x
# input device 2
if {$longform && $multi > 1 && [llength $audio_indevlist] > 1} {
frame $mytoplevel.in2f
pack $mytoplevel.in2f -side top
checkbutton $mytoplevel.in2f.x0 -variable audio_inenable2 \
-text [_ "Input device 2:"] -anchor e
button $mytoplevel.in2f.x1 -text [lindex $audio_indevlist $audio_indev2] \
-command [list audio_popup $mytoplevel $mytoplevel.in2f.x1 audio_indev2 \
$audio_indevlist]
label $mytoplevel.in2f.l2 -text [_ "Channels:"]
entry $mytoplevel.in2f.x2 -textvariable audio_inchan2 -width 3
pack $mytoplevel.in2f.x0 $mytoplevel.in2f.x1 $mytoplevel.in2f.l2 \
$mytoplevel.in2f.x2 -side left -fill x
}
# input device 3
if {$longform && $multi > 1 && [llength $audio_indevlist] > 2} {
frame $mytoplevel.in3f
pack $mytoplevel.in3f -side top
checkbutton $mytoplevel.in3f.x0 -variable audio_inenable3 \
-text [_ "Input device 3:"] -anchor e
button $mytoplevel.in3f.x1 -text [lindex $audio_indevlist $audio_indev3] \
-command [list audio_popup $mytoplevel $mytoplevel.in3f.x1 audio_indev3 \
$audio_indevlist]
label $mytoplevel.in3f.l2 -text [_ "Channels:"]
entry $mytoplevel.in3f.x2 -textvariable audio_inchan3 -width 3
pack $mytoplevel.in3f.x0 $mytoplevel.in3f.x1 $mytoplevel.in3f.l2 $mytoplevel.in3f.x2 -side left
}
# input device 4
if {$longform && $multi > 1 && [llength $audio_indevlist] > 3} {
frame $mytoplevel.in4f
pack $mytoplevel.in4f -side top
checkbutton $mytoplevel.in4f.x0 -variable audio_inenable4 \
-text [_ "Input device 4:"] -anchor e
button $mytoplevel.in4f.x1 -text [lindex $audio_indevlist $audio_indev4] \
-command [list audio_popup $mytoplevel $mytoplevel.in4f.x1 audio_indev4 \
$audio_indevlist]
label $mytoplevel.in4f.l2 -text [_ "Channels:"]
entry $mytoplevel.in4f.x2 -textvariable audio_inchan4 -width 3
pack $mytoplevel.in4f.x0 $mytoplevel.in4f.x1 $mytoplevel.in4f.l2 \
$mytoplevel.in4f.x2 -side left
}
# output device 1
frame $mytoplevel.out1f
pack $mytoplevel.out1f -side top
checkbutton $mytoplevel.out1f.x0 -variable audio_outenable1 \
-text [_ "Output device 1:"] -anchor e
if {$multi == 0} {
label $mytoplevel.out1f.l1 \
-text [_ "(same as input device) .............. "]
} else {
button $mytoplevel.out1f.x1 -text [lindex $audio_outdevlist $audio_outdev1] \
-command [list audio_popup $mytoplevel $mytoplevel.out1f.x1 audio_outdev1 \
$audio_outdevlist]
}
label $mytoplevel.out1f.l2 -text [_ "Channels:"]
entry $mytoplevel.out1f.x2 -textvariable audio_outchan1 -width 3
if {$multi == 0} {
pack $mytoplevel.out1f.x0 $mytoplevel.out1f.l1 $mytoplevel.out1f.x2 -side left -fill x
} else {
pack $mytoplevel.out1f.x0 $mytoplevel.out1f.x1 $mytoplevel.out1f.l2\
$mytoplevel.out1f.x2 -side left -fill x
}
# output device 2
if {$longform && $multi > 1 && [llength $audio_outdevlist] > 1} {
frame $mytoplevel.out2f
pack $mytoplevel.out2f -side top
checkbutton $mytoplevel.out2f.x0 -variable audio_outenable2 \
-text [_ "Output device 2:"] -anchor e
button $mytoplevel.out2f.x1 -text [lindex $audio_outdevlist $audio_outdev2] \
-command \
[list audio_popup $mytoplevel $mytoplevel.out2f.x1 audio_outdev2 $audio_outdevlist]
label $mytoplevel.out2f.l2 -text [_ "Channels:"]
entry $mytoplevel.out2f.x2 -textvariable audio_outchan2 -width 3
pack $mytoplevel.out2f.x0 $mytoplevel.out2f.x1 $mytoplevel.out2f.l2\
$mytoplevel.out2f.x2 -side left
}
# output device 3
if {$longform && $multi > 1 && [llength $audio_outdevlist] > 2} {
frame $mytoplevel.out3f
pack $mytoplevel.out3f -side top
checkbutton $mytoplevel.out3f.x0 -variable audio_outenable3 \
-text [_ "Output device 3:"] -anchor e
button $mytoplevel.out3f.x1 -text [lindex $audio_outdevlist $audio_outdev3] \
-command \
[list audio_popup $mytoplevel $mytoplevel.out3f.x1 audio_outdev3 $audio_outdevlist]
label $mytoplevel.out3f.l2 -text [_ "Channels:"]
entry $mytoplevel.out3f.x2 -textvariable audio_outchan3 -width 3
pack $mytoplevel.out3f.x0 $mytoplevel.out3f.x1 $mytoplevel.out3f.l2 \
$mytoplevel.out3f.x2 -side left
}
# output device 4
if {$longform && $multi > 1 && [llength $audio_outdevlist] > 3} {
frame $mytoplevel.out4f
pack $mytoplevel.out4f -side top
checkbutton $mytoplevel.out4f.x0 -variable audio_outenable4 \
-text [_ "Output device 4:"] -anchor e
button $mytoplevel.out4f.x1 -text [lindex $audio_outdevlist $audio_outdev4] \
-command \
[list audio_popup $mytoplevel $mytoplevel.out4f.x1 audio_outdev4 $audio_outdevlist]
label $mytoplevel.out4f.l2 -text [_ "Channels:"]
entry $mytoplevel.out4f.x2 -textvariable audio_outchan4 -width 3
pack $mytoplevel.out4f.x0 $mytoplevel.out4f.x1 $mytoplevel.out4f.l2 \
$mytoplevel.out4f.x2 -side left
}
# if not the "long form" but if "multi" is 2, make a button to
# restart with longform set.
if {$longform == 0 && $multi > 1} {
frame $mytoplevel.longbutton
pack $mytoplevel.longbutton -side top
button $mytoplevel.longbutton.b -text [_ "Use multiple devices"] \
-command {pdsend "pd audio-properties 1"}
pack $mytoplevel.longbutton.b
}
$mytoplevel.srf.x1 select from 0
$mytoplevel.srf.x1 select adjust end
focus $mytoplevel.srf.x1
}

219
tcl/dialog_canvas.tcl Normal file
View file

@ -0,0 +1,219 @@
# TODO offset this panel so it doesn't overlap the pdtk_array panel
package provide dialog_canvas 0.1
namespace eval ::dialog_canvas:: {
namespace export pdtk_canvas_dialog
}
# global variables to store checkbox state on canvas properties window. These
# are only used in the context of getting data from the checkboxes, so they
# aren't really useful elsewhere. It would be nice to have them globally
# useful, but that would mean changing the C code.
array set graphme_button {}
array set hidetext_button {}
############# pdtk_canvas_dialog -- dialog window for canvases #################
proc ::dialog_canvas::apply {mytoplevel} {
pdsend "$mytoplevel donecanvasdialog \
[$mytoplevel.scale.x.entry get] \
[$mytoplevel.scale.y.entry get] \
[expr $::graphme_button($mytoplevel) + 2 * $::hidetext_button($mytoplevel)] \
[$mytoplevel.range.x.from_entry get] \
[$mytoplevel.range.y.from_entry get] \
[$mytoplevel.range.x.to_entry get] \
[$mytoplevel.range.y.to_entry get] \
[$mytoplevel.range.x.size_entry get] \
[$mytoplevel.range.y.size_entry get] \
[$mytoplevel.range.x.margin_entry get] \
[$mytoplevel.range.y.margin_entry get]"
}
proc ::dialog_canvas::cancel {mytoplevel} {
pdsend "$mytoplevel cancel"
}
proc ::dialog_canvas::ok {mytoplevel} {
::dialog_canvas::apply $mytoplevel
::dialog_canvas::cancel $mytoplevel
}
proc ::dialog_canvas::checkcommand {mytoplevel} {
if { $::graphme_button($mytoplevel) != 0 } {
$mytoplevel.scale.x.entry configure -state disabled
$mytoplevel.scale.y.entry configure -state disabled
$mytoplevel.parent.hidetext configure -state normal
$mytoplevel.range.x.from_entry configure -state normal
$mytoplevel.range.x.to_entry configure -state normal
$mytoplevel.range.x.size_entry configure -state normal
$mytoplevel.range.x.margin_entry configure -state normal
$mytoplevel.range.y.from_entry configure -state normal
$mytoplevel.range.y.to_entry configure -state normal
$mytoplevel.range.y.size_entry configure -state normal
$mytoplevel.range.y.margin_entry configure -state normal
if { [$mytoplevel.range.x.from_entry get] == 0 \
&& [$mytoplevel.range.y.from_entry get] == 0 \
&& [$mytoplevel.range.x.to_entry get] == 0 \
&& [$mytoplevel.range.y.to_entry get] == 0 } {
$mytoplevel.range.y.to_entry insert 0 1
$mytoplevel.range.y.to_entry insert 0 1
}
if { [$mytoplevel.range.x.size_entry get] == 0 } {
$mytoplevel.range.x.size_entry delete 0 end
$mytoplevel.range.x.margin_entry delete 0 end
$mytoplevel.range.x.size_entry insert 0 85
$mytoplevel.range.x.margin_entry insert 0 100
}
if { [$mytoplevel.range.y.size_entry get] == 0 } {
$mytoplevel.range.y.size_entry delete 0 end
$mytoplevel.range.y.margin_entry delete 0 end
$mytoplevel.range.y.size_entry insert 0 60
$mytoplevel.range.y.margin_entry insert 0 100
}
} else {
$mytoplevel.scale.x.entry configure -state normal
$mytoplevel.scale.y.entry configure -state normal
$mytoplevel.parent.hidetext configure -state disabled
$mytoplevel.range.x.from_entry configure -state disabled
$mytoplevel.range.x.to_entry configure -state disabled
$mytoplevel.range.x.size_entry configure -state disabled
$mytoplevel.range.x.margin_entry configure -state disabled
$mytoplevel.range.y.from_entry configure -state disabled
$mytoplevel.range.y.to_entry configure -state disabled
$mytoplevel.range.y.size_entry configure -state disabled
$mytoplevel.range.y.margin_entry configure -state disabled
if { [$mytoplevel.scale.x.entry get] == 0 } {
$mytoplevel.scale.x.entry delete 0 end
$mytoplevel.scale.x.entry insert 0 1
}
if { [$mytoplevel.scale.y.entry get] == 0 } {
$mytoplevel.scale.y.entry delete 0 end
$mytoplevel.scale.y.entry insert 0 1
}
}
}
proc ::dialog_canvas::pdtk_canvas_dialog {mytoplevel xscale yscale graphmeflags \
xfrom yfrom xto yto \
xsize ysize xmargin ymargin} {
if {[winfo exists $mytoplevel]} {
wm deiconify $mytoplevel
raise $mytoplevel
} else {
create_dialog $mytoplevel
}
switch -- $graphmeflags {
0 {
$mytoplevel.parent.graphme deselect
$mytoplevel.parent.hidetext deselect
} 1 {
$mytoplevel.parent.graphme select
$mytoplevel.parent.hidetext deselect
} 2 {
$mytoplevel.parent.graphme deselect
$mytoplevel.parent.hidetext select
} 3 {
$mytoplevel.parent.graphme select
$mytoplevel.parent.hidetext select
} default {
::pdwindow::error [_ "WARNING: unknown graphme flags received in pdtk_canvas_dialog"]
}
}
$mytoplevel.scale.x.entry insert 0 $xscale
$mytoplevel.scale.y.entry insert 0 $yscale
$mytoplevel.range.x.from_entry insert 0 $xfrom
$mytoplevel.range.y.from_entry insert 0 $yfrom
$mytoplevel.range.x.to_entry insert 0 $xto
$mytoplevel.range.y.to_entry insert 0 $yto
$mytoplevel.range.x.size_entry insert 0 $xsize
$mytoplevel.range.y.size_entry insert 0 $ysize
$mytoplevel.range.x.margin_entry insert 0 $xmargin
$mytoplevel.range.y.margin_entry insert 0 $ymargin
::dialog_canvas::checkcommand $mytoplevel
}
proc ::dialog_canvas::create_dialog {mytoplevel} {
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [_ "Canvas Properties"]
wm group $mytoplevel .
wm resizable $mytoplevel 0 0
wm transient $mytoplevel $::focused_window
$mytoplevel configure -menu $::dialog_menubar
$mytoplevel configure -padx 0 -pady 0
::pd_bindings::dialog_bindings $mytoplevel "canvas"
labelframe $mytoplevel.scale -text [_ "Scale"] -borderwidth 1
pack $mytoplevel.scale -side top -fill x
frame $mytoplevel.scale.x -pady 2 -borderwidth 1
pack $mytoplevel.scale.x -side top
label $mytoplevel.scale.x.label -text [_ "X units per pixel:"]
entry $mytoplevel.scale.x.entry -width 10
pack $mytoplevel.scale.x.label $mytoplevel.scale.x.entry -side left
frame $mytoplevel.scale.y -pady 2
pack $mytoplevel.scale.y -side top
label $mytoplevel.scale.y.label -text [_ "Y units per pixel:"]
entry $mytoplevel.scale.y.entry -width 10
pack $mytoplevel.scale.y.label $mytoplevel.scale.y.entry -side left
labelframe $mytoplevel.parent -text [_ "Appearance on parent patch"] -borderwidth 1
pack $mytoplevel.parent -side top -fill x
checkbutton $mytoplevel.parent.graphme -text [_ "Graph-On-Parent"] \
-anchor w -variable graphme_button($mytoplevel) \
-command [concat ::dialog_canvas::checkcommand $mytoplevel]
pack $mytoplevel.parent.graphme -side top -fill x -padx 40
checkbutton $mytoplevel.parent.hidetext -text [_ "Hide object name and arguments"] \
-anchor w -variable hidetext_button($mytoplevel) \
-command [concat ::dialog_canvas::checkcommand $mytoplevel]
pack $mytoplevel.parent.hidetext -side top -fill x -padx 40
labelframe $mytoplevel.range -text [_ "Range and size"] -borderwidth 1
pack $mytoplevel.range -side top -fill x
frame $mytoplevel.range.x -padx 2 -pady 2
pack $mytoplevel.range.x -side top
label $mytoplevel.range.x.from_label -text [_ "X range, from"]
entry $mytoplevel.range.x.from_entry -width 6
label $mytoplevel.range.x.to_label -text [_ "to"]
entry $mytoplevel.range.x.to_entry -width 6
label $mytoplevel.range.x.size_label -text [_ "Size:"]
entry $mytoplevel.range.x.size_entry -width 4
label $mytoplevel.range.x.margin_label -text [_ "Margin:"]
entry $mytoplevel.range.x.margin_entry -width 4
pack $mytoplevel.range.x.from_label $mytoplevel.range.x.from_entry \
$mytoplevel.range.x.to_label $mytoplevel.range.x.to_entry \
$mytoplevel.range.x.size_label $mytoplevel.range.x.size_entry \
$mytoplevel.range.x.margin_label $mytoplevel.range.x.margin_entry \
-side left
frame $mytoplevel.range.y -padx 2 -pady 2
pack $mytoplevel.range.y -side top
label $mytoplevel.range.y.from_label -text [_ "Y range, from"]
entry $mytoplevel.range.y.from_entry -width 6
label $mytoplevel.range.y.to_label -text [_ "to"]
entry $mytoplevel.range.y.to_entry -width 6
label $mytoplevel.range.y.size_label -text [_ "Size:"]
entry $mytoplevel.range.y.size_entry -width 4
label $mytoplevel.range.y.margin_label -text [_ "Margin:"]
entry $mytoplevel.range.y.margin_entry -width 4
pack $mytoplevel.range.y.from_label $mytoplevel.range.y.from_entry \
$mytoplevel.range.y.to_label $mytoplevel.range.y.to_entry \
$mytoplevel.range.y.size_label $mytoplevel.range.y.size_entry \
$mytoplevel.range.y.margin_label $mytoplevel.range.y.margin_entry \
-side left
frame $mytoplevel.buttons
pack $mytoplevel.buttons -side bottom -fill x -expand 1 -pady 2m
button $mytoplevel.buttons.cancel -text [_ "Cancel"] \
-command "::dialog_canvas::cancel $mytoplevel"
pack $mytoplevel.buttons.cancel -side left -expand 1 -fill x -padx 10
if {$::windowingsystem ne "aqua"} {
button $mytoplevel.buttons.apply -text [_ "Apply"] \
-command "::dialog_canvas::apply $mytoplevel"
pack $mytoplevel.buttons.apply -side left -expand 1 -fill x -padx 10
}
button $mytoplevel.buttons.ok -text [_ "OK"] \
-command "::dialog_canvas::ok $mytoplevel"
pack $mytoplevel.buttons.ok -side left -expand 1 -fill x -padx 10
}

53
tcl/dialog_data.tcl Normal file
View file

@ -0,0 +1,53 @@
package provide dialog_data 0.1
namespace eval ::dialog_data:: {
namespace export pdtk_data_dialog
}
############ pdtk_data_dialog -- run a data dialog #########
proc ::dialog_data::send {mytoplevel} {
for {set i 1} {[$mytoplevel.text compare [concat $i.0 + 3 chars] < end]} \
{incr i 1} {
pdsend "$mytoplevel data [$mytoplevel.text get $i.0 [expr $i + 1].0]"
}
pdsend "$mytoplevel end"
}
proc ::dialog_data::cancel {mytoplevel} {
pdsend "$mytoplevel cancel"
}
proc ::dialog_data::ok {mytoplevel} {
::dialog_data::send $mytoplevel
::dialog_data::cancel $mytoplevel
}
proc ::dialog_data::pdtk_data_dialog {mytoplevel stuff} {
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [_ "Data Properties"]
wm group $mytoplevel $::focused_window
wm transient $mytoplevel $::focused_window
$mytoplevel configure -menu $::dialog_menubar
$mytoplevel configure -padx 0 -pady 0
frame $mytoplevel.buttonframe
pack $mytoplevel.buttonframe -side bottom -fill x -pady 2m
button $mytoplevel.buttonframe.send -text [_ "Send (Ctrl s)"] \
-command "::dialog_data::send $mytoplevel"
button $mytoplevel.buttonframe.ok -text [_ "OK (Ctrl t)"] \
-command "::dialog_data::ok $mytoplevel"
pack $mytoplevel.buttonframe.send -side left -expand 1
pack $mytoplevel.buttonframe.ok -side left -expand 1
text $mytoplevel.text -relief raised -bd 2 -height 40 -width 60 \
-yscrollcommand "$mytoplevel.scroll set"
scrollbar $mytoplevel.scroll -command "$mytoplevel.text yview"
pack $mytoplevel.scroll -side right -fill y
pack $mytoplevel.text -side left -fill both -expand 1
$mytoplevel.text insert end $stuff
focus $mytoplevel.text
bind $mytoplevel.text <Control-t> "::dialog_data::ok $mytoplevel"
bind $mytoplevel.text <Control-s> "::dialog_data::send $mytoplevel"
}

182
tcl/dialog_find.tcl Normal file
View file

@ -0,0 +1,182 @@
# the find dialog panel is a bit unusual in that it is created directly by the
# Tcl 'pd-gui'. Most dialog panels are created by sending a message to 'pd',
# which then sends a message to 'pd-gui' to create the panel.
package provide dialog_find 0.1
package require pd_bindings
namespace eval ::dialog_find:: {
variable find_in_toplevel ".pdwindow"
# store the state of the "Match whole word only" check box
variable wholeword_button 0
# if the search hasn't changed, then the Find button sends "findagain"
variable previous_wholeword_button 0
variable previous_findstring ""
variable find_history {}
variable history_position 0
namespace export pdtk_couldnotfind
}
proc ::dialog_find::get_history {direction} {
variable find_history
variable history_position
incr history_position $direction
if {$history_position < 0} {set history_position 0}
if {$history_position > [llength $find_history]} {
set history_position [llength $find_history]
}
.find.entry delete 0 end
.find.entry insert 0 [lindex $find_history end-[expr $history_position - 1]]
}
# mytoplevel isn't used here, but is kept for compatibility with other dialog ok procs
proc ::dialog_find::ok {mytoplevel} {
variable find_in_window
variable wholeword_button
variable previous_wholeword_button
variable previous_findstring
variable find_history
set findstring [.find.entry get]
if {$findstring eq ""} {
if {$::windowingsystem eq "aqua"} {bell}
return
}
if {$find_in_window eq ".pdwindow"} {
if {$::tcl_version < 8.5} {
# TODO implement in 8.4 style, without -all
set matches [.pdwindow.text search -nocase -- $findstring 0.0]
} else {
set matches [.pdwindow.text search -all -nocase -- $findstring 0.0]
}
.pdwindow.text tag delete sel
if {[llength $matches] > 0} {
foreach match $matches {
.pdwindow.text tag add sel $match "$match wordend"
}
.pdwindow.text see [lindex $matches 0]
lappend find_history $findstring
}
} else {
if {$findstring eq $previous_findstring \
&& $wholeword_button == $previous_wholeword_button} {
pdsend "$find_in_window findagain"
} else {
pdsend [concat $find_in_window find [pdtk_encodedialog $findstring] \
$wholeword_button]
set previous_findstring $findstring
set previous_wholeword_button $wholeword_button
lappend find_history $findstring
}
}
if {$::windowingsystem eq "aqua"} {
# (Mac OS X) hide panel after success, but keep it if unsuccessful by
# having the couldnotfind proc reopen it
cancel $mytoplevel
} else {
# (GNOME/Windows) find panel should retain focus after a find
# (yes, a bit of a kludge)
after 100 "raise .find; focus .find.entry"
}
}
# mytoplevel isn't used here, but is kept for compatibility with other dialog cancel procs
proc ::dialog_find::cancel {mytoplevel} {
wm withdraw .find
}
proc ::dialog_find::set_window_to_search {mytoplevel} {
variable find_in_window $mytoplevel
if {[winfo exists .find.frame.targetlabel]} {
if {$find_in_window eq ".find"} {
set find_in_window [winfo toplevel [lindex [wm stackorder .] end-1]]
}
# this has funny side effects in tcl 8.4 ???
if {$::tcl_version >= 8.5} {
wm transient .find $find_in_window
}
.find.frame.targetlabel configure -text \
[lookup_windowname $find_in_window]
}
}
proc ::dialog_find::pdtk_couldnotfind {mytoplevel} {
bell
::pdwindow::error [format [_ "Couldn't find '%s' in %s"] \
[.find.entry get] [lookup_windowname $mytoplevel] ]
if {$::windowingsystem eq "aqua"} {open_find_dialog $mytoplevel}
}
# the find panel is opened from the menu and key bindings
proc ::dialog_find::open_find_dialog {mytoplevel} {
if {[winfo exists .find]} {
wm deiconify .find
raise .find
} else {
create_dialog $mytoplevel
}
.find.entry selection range 0 end
}
proc ::dialog_find::create_dialog {mytoplevel} {
toplevel .find -class DialogWindow
wm title .find [_ "Find"]
wm geometry .find =475x125+150+150
wm group .find .
wm resizable .find 0 0
wm transient .find
.find configure -menu $::dialog_menubar
.find configure -padx 10 -pady 5
::pd_bindings::dialog_bindings .find "find"
# sending these commands to the Find Dialog Panel should forward them to
# the currently focused patch
bind .find <$::modifier-Key-s> \
{menu_send $::focused_window menusave; break}
bind .find <$::modifier-Shift-Key-S> \
{menu_send $::focused_window menusaveas; break}
bind .find <$::modifier-Key-p> \
{menu_print $::focused_window; break}
frame .find.frame
pack .find.frame -side top -fill x -pady 1
label .find.frame.searchin -text [_ "Search in"]
label .find.frame.targetlabel -text [_ "Pd window"]
label .find.frame.for -text [_ "for:"]
pack .find.frame.searchin .find.frame.targetlabel .find.frame.for -side left
entry .find.entry -width 54 -font 18 -relief sunken \
-highlightthickness 1 -highlightcolor blue
pack .find.entry -side top -padx 10
bind .find.entry <Up> "::dialog_find::get_history 1"
bind .find.entry <Down> "::dialog_find::get_history -1"
checkbutton .find.wholeword -variable ::dialog_find::wholeword_button \
-text [_ "Match whole word only"] -anchor w
pack .find.wholeword -side top -padx 30 -pady 3 -fill x
frame .find.buttonframe -background yellow
pack .find.buttonframe -side right -pady 3
if {$::windowingsystem eq "win32"} {
button .find.cancel -text [_ "Cancel"] -default normal -width 9 \
-command "::dialog_find::cancel $mytoplevel"
pack .find.cancel -side right -padx 6 -pady 3
}
button .find.button -text [_ "Find"] -default active -width 9 \
-command "::dialog_find::ok $mytoplevel"
pack .find.button -side right -padx 6 -pady 3
if {$::windowingsystem eq "x11"} {
button .find.close -text [_ "Close"] -default normal -width 9 \
-command "::dialog_find::cancel $mytoplevel"
pack .find.close -side right -padx 6 -pady 3
}
# on Mac OS X, the buttons shouldn't get Tab/keyboard focus
if {$::windowingsystem eq "aqua"} {
.find.wholeword configure -takefocus 0
.find.button configure -takefocus 0
}
::dialog_find::set_window_to_search $mytoplevel
focus .find.entry
}

136
tcl/dialog_font.tcl Normal file
View file

@ -0,0 +1,136 @@
package provide dialog_font 0.1
namespace eval ::dialog_font:: {
variable fontsize 10
variable stretchval 100
variable whichstretch 1
variable canvaswindow
variable sizes {8 10 12 16 24 36}
namespace export pdtk_canvas_dofont
}
# TODO this should use the pd_font_$size fonts created in pd-gui.tcl
# TODO change pdtk_canvas_dofont to pdtk_font_dialog here and g_editor.c
# TODO this should really be changed on the C side so that it doesn't have to
# work around gfxstub/x_gui.c. The gfxstub stuff assumes that there are
# multiple panels, for properties panels like this, its much easier to use if
# there is a single properties panel that adjusts based on which PatchWindow
# has focus
proc ::dialog_font::apply {mytoplevel myfontsize} {
if {$mytoplevel eq ".pdwindow"} {
.pdwindow.text configure -font "-size $myfontsize"
} else {
variable stretchval
variable whichstretch
pdsend "$mytoplevel font $myfontsize $stretchval $whichstretch"
}
}
proc ::dialog_font::cancel {gfxstub} {
if {$gfxstub ne ".pdwindow"} {
pdsend "$gfxstub cancel"
}
destroy .font
}
proc ::dialog_font::ok {gfxstub} {
variable fontsize
apply $gfxstub $fontsize
cancel $gfxstub
}
proc ::dialog_font::update_font_dialog {mytoplevel} {
variable canvaswindow $mytoplevel
if {[winfo exists .font]} {
wm title .font [format [_ "%s Font"] [lookup_windowname $mytoplevel]]
}
}
proc ::dialog_font::arrow_fontchange {change} {
variable sizes
variable fontsize
variable canvaswindow
set position [expr [lsearch $sizes $fontsize] + $change]
if {$position < 0} {set position 0}
set max [llength $sizes]
if {$position >= $max} {set position [expr $max-1]}
set fontsize [lindex $sizes $position]
::dialog_font::apply $canvaswindow $fontsize
}
# this should be called pdtk_font_dialog like the rest of the panels, but it
# is called from the C side, so we'll leave it be
proc ::dialog_font::pdtk_canvas_dofont {gfxstub initsize} {
variable fontsize $initsize
variable whichstretch 1
variable stretchval 100
if {[winfo exists .font]} {
wm deiconify .font
raise .font
# the gfxstub stuff expects multiple font windows, we only have one,
# so kill the new gfxstub requests as the come in. We'll save the
# original gfxstub for when the font panel gets closed
pdsend "$gfxstub cancel"
} else {
create_dialog $gfxstub
}
}
proc ::dialog_font::create_dialog {gfxstub} {
toplevel .font -class DialogWindow
.font configure -menu $::dialog_menubar
.font configure -padx 10 -pady 5
wm group .font .
wm resizable .font 0 0
wm transient .font $::focused_window
::pd_bindings::dialog_bindings .font "font"
# replace standard bindings to work around the gfxstub stuff and use
# break to prevent the close window command from going to other bindings.
# .font won't exist anymore, so it'll cause errors down the line...
bind .font <KeyPress-Return> "::dialog_font::ok $gfxstub; break"
bind .font <KeyPress-Escape> "::dialog_font::cancel $gfxstub; break"
bind .font <$::modifier-Key-w> "::dialog_font::cancel $gfxstub; break"
wm protocol .font WM_DELETE_WINDOW "dialog_font::cancel $gfxstub"
bind .font <Up> "::dialog_font::arrow_fontchange -1"
bind .font <Down> "::dialog_font::arrow_fontchange 1"
frame .font.buttonframe
pack .font.buttonframe -side bottom -fill x -pady 2m
button .font.buttonframe.ok -text [_ "OK"] \
-command "::dialog_font::ok $gfxstub"
pack .font.buttonframe.ok -side left -expand 1
labelframe .font.fontsize -text [_ "Font Size"] -padx 5 -pady 4 -borderwidth 1 \
-width [::msgcat::mcmax "Font Size"] -labelanchor n
pack .font.fontsize -side left -padx 5
# this is whacky Tcl at its finest, but I couldn't resist...
foreach size $::dialog_font::sizes {
radiobutton .font.fontsize.radio$size -value $size -text $size \
-variable ::dialog_font::fontsize \
-command [format {::dialog_font::apply $::dialog_font::canvaswindow %s} $size]
pack .font.fontsize.radio$size -side top -anchor w
}
labelframe .font.stretch -text [_ "Stretch"] -padx 5 -pady 5 -borderwidth 1 \
-width [::msgcat::mcmax "Stretch"] -labelanchor n
pack .font.stretch -side left -padx 5 -fill y
entry .font.stretch.entry -textvariable ::dialog_font::stretchval -width 5
pack .font.stretch.entry -side top -pady 5
radiobutton .font.stretch.radio1 -text [_ "X and Y"] \
-value 1 -variable ::dialog_font::whichstretch
radiobutton .font.stretch.radio2 -text [_ "X only"] \
-value 2 -variable ::dialog_font::whichstretch
radiobutton .font.stretch.radio3 -text [_ "Y only"] \
-value 3 -variable ::dialog_font::whichstretch
pack .font.stretch.radio1 -side top -anchor w
pack .font.stretch.radio2 -side top -anchor w
pack .font.stretch.radio3 -side top -anchor w
}

175
tcl/dialog_gatom.tcl Normal file
View file

@ -0,0 +1,175 @@
package provide dialog_gatom 0.1
package require wheredoesthisgo
namespace eval ::dialog_gatom:: {
namespace export pdtk_gatom_dialog
}
# array for communicating the position of the radiobuttons (Tk's
# radiobutton widget requires this to be global)
array set gatomlabel_radio {}
############ pdtk_gatom_dialog -- run a gatom dialog #########
proc ::dialog_gatom::escape {sym} {
if {[string length $sym] == 0} {
set ret "-"
} else {
if {[string equal -length 1 $sym "-"]} {
set ret [string replace $sym 0 0 "--"]
} else {
set ret [string map {"$" "#"} $sym]
}
}
return [unspace_text $ret]
}
proc ::dialog_gatom::unescape {sym} {
if {[string equal -length 1 $sym "-"]} {
set ret [string replace $sym 0 0 ""]
} else {
set ret [string map {"#" "$"} $sym]
}
return $ret
}
proc ::dialog_gatom::apply {mytoplevel} {
global gatomlabel_radio
pdsend "$mytoplevel param \
[$mytoplevel.width.entry get] \
[$mytoplevel.limits.lower.entry get] \
[$mytoplevel.limits.upper.entry get] \
[::dialog_gatom::escape [$mytoplevel.gatomlabel.name.entry get]] \
$gatomlabel_radio($mytoplevel) \
[::dialog_gatom::escape [$mytoplevel.s_r.receive.entry get]] \
[::dialog_gatom::escape [$mytoplevel.s_r.send.entry get]]"
}
proc ::dialog_gatom::cancel {mytoplevel} {
pdsend "$mytoplevel cancel"
}
proc ::dialog_gatom::ok {mytoplevel} {
::dialog_gatom::apply $mytoplevel
::dialog_gatom::cancel $mytoplevel
}
# set up the panel with the info from pd
proc ::dialog_gatom::pdtk_gatom_dialog {mytoplevel initwidth initlower initupper \
initgatomlabel_radio \
initgatomlabel initreceive initsend} {
global gatomlabel_radio
set gatomlabel_radio($mytoplevel) $initgatomlabel_radio
if {[winfo exists $mytoplevel]} {
wm deiconify $mytoplevel
raise $mytoplevel
} else {
create_dialog $mytoplevel
}
$mytoplevel.width.entry insert 0 $initwidth
$mytoplevel.limits.lower.entry insert 0 $initlower
$mytoplevel.limits.upper.entry insert 0 $initupper
if {$initgatomlabel ne "-"} {
$mytoplevel.gatomlabel.name.entry insert 0 \
[::dialog_gatom::unescape $initgatomlabel]
}
set gatomlabel_radio($mytoplevel) $initgatomlabel_radio
if {$initsend ne "-"} {
$mytoplevel.s_r.send.entry insert 0 \
[::dialog_gatom::unescape $initsend]
}
if {$initreceive ne "-"} {
$mytoplevel.s_r.receive.entry insert 0 \
[::dialog_gatom::unescape $initreceive]
}
}
proc ::dialog_gatom::create_dialog {mytoplevel} {
global gatomlabel_radio
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [_ "Atom Box Properties"]
wm group $mytoplevel .
wm resizable $mytoplevel 0 0
wm transient $mytoplevel $::focused_window
$mytoplevel configure -menu $::dialog_menubar
$mytoplevel configure -padx 0 -pady 0
::pd_bindings::dialog_bindings $mytoplevel "gatom"
frame $mytoplevel.width -height 7
pack $mytoplevel.width -side top
label $mytoplevel.width.label -text [_ "Width:"]
entry $mytoplevel.width.entry -width 4
pack $mytoplevel.width.label $mytoplevel.width.entry -side left
labelframe $mytoplevel.limits -text [_ "Limits"] -padx 15 -pady 4 -borderwidth 1
pack $mytoplevel.limits -side top -fill x
frame $mytoplevel.limits.lower
pack $mytoplevel.limits.lower -side left
label $mytoplevel.limits.lower.label -text [_ "Lower:"]
entry $mytoplevel.limits.lower.entry -width 7
pack $mytoplevel.limits.lower.label $mytoplevel.limits.lower.entry -side left
frame $mytoplevel.limits.upper
pack $mytoplevel.limits.upper -side left
label $mytoplevel.limits.upper.label -text [_ "Upper:"]
entry $mytoplevel.limits.upper.entry -width 7
pack $mytoplevel.limits.upper.label $mytoplevel.limits.upper.entry -side left
labelframe $mytoplevel.gatomlabel -text [_ "Label"] -padx 5 -pady 5 -borderwidth 1
pack $mytoplevel.gatomlabel -side top -fill x -pady 5
frame $mytoplevel.gatomlabel.name
pack $mytoplevel.gatomlabel.name -side top
entry $mytoplevel.gatomlabel.name.entry -width 33
pack $mytoplevel.gatomlabel.name.entry -side left
frame $mytoplevel.gatomlabel.radio
pack $mytoplevel.gatomlabel.radio -side top
radiobutton $mytoplevel.gatomlabel.radio.left -value 0 -text [_ "Left "] \
-variable gatomlabel_radio($mytoplevel) -justify left -takefocus 0
radiobutton $mytoplevel.gatomlabel.radio.right -value 1 -text [_ "Right"] \
-variable gatomlabel_radio($mytoplevel) -justify left -takefocus 0
radiobutton $mytoplevel.gatomlabel.radio.top -value 2 -text [_ "Top"] \
-variable gatomlabel_radio($mytoplevel) -justify left -takefocus 0
radiobutton $mytoplevel.gatomlabel.radio.bottom -value 3 -text [_ "Bottom"] \
-variable gatomlabel_radio($mytoplevel) -justify left -takefocus 0
pack $mytoplevel.gatomlabel.radio.left -side left -anchor w
pack $mytoplevel.gatomlabel.radio.right -side right -anchor w
pack $mytoplevel.gatomlabel.radio.top -side top -anchor w
pack $mytoplevel.gatomlabel.radio.bottom -side bottom -anchor w
labelframe $mytoplevel.s_r -text [_ "Messages"] -padx 5 -pady 5 -borderwidth 1
pack $mytoplevel.s_r -side top -fill x
frame $mytoplevel.s_r.send
pack $mytoplevel.s_r.send -side top -anchor e
label $mytoplevel.s_r.send.label -text [_ "Send symbol:"]
entry $mytoplevel.s_r.send.entry -width 21
pack $mytoplevel.s_r.send.entry $mytoplevel.s_r.send.label -side right
frame $mytoplevel.s_r.receive
pack $mytoplevel.s_r.receive -side top -anchor e
label $mytoplevel.s_r.receive.label -text [_ "Receive symbol:"]
entry $mytoplevel.s_r.receive.entry -width 21
pack $mytoplevel.s_r.receive.entry $mytoplevel.s_r.receive.label -side right
frame $mytoplevel.buttonframe -pady 5
pack $mytoplevel.buttonframe -side top -fill x -expand 1 -pady 2m
button $mytoplevel.buttonframe.cancel -text [_ "Cancel"] \
-command "::dialog_gatom::cancel $mytoplevel"
pack $mytoplevel.buttonframe.cancel -side left -expand 1 -fill x -padx 10
if {$::windowingsystem ne "aqua"} {
button $mytoplevel.buttonframe.apply -text [_ "Apply"] \
-command "::dialog_gatom::apply $mytoplevel"
pack $mytoplevel.buttonframe.apply -side left -expand 1 -fill x -padx 10
}
button $mytoplevel.buttonframe.ok -text [_ "OK"] \
-command "::dialog_gatom::ok $mytoplevel"
pack $mytoplevel.buttonframe.ok -side left -expand 1 -fill x -padx 10
$mytoplevel.width.entry select from 0
$mytoplevel.width.entry select adjust end
focus $mytoplevel.width.entry
}

767
tcl/dialog_iemgui.tcl Normal file
View file

@ -0,0 +1,767 @@
# For information on usage and redistribution, and for a DISCLAIMER OF ALL
# WARRANTIES, see the file, "LICENSE.txt," in this distribution.
# Copyright (c) 1997-2009 Miller Puckette.
package provide dialog_iemgui 0.1
namespace eval ::dialog_iemgui:: {
variable define_min_flashhold 50
variable define_min_flashbreak 10
variable define_min_fontsize 4
namespace export pdtk_iemgui_dialog
}
# TODO convert Init/No Init and Steady on click/Jump on click to checkbuttons
proc ::dialog_iemgui::clip_dim {mytoplevel} {
set vid [string trimleft $mytoplevel .]
set var_iemgui_wdt [concat iemgui_wdt_$vid]
global $var_iemgui_wdt
set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid]
global $var_iemgui_min_wdt
set var_iemgui_hgt [concat iemgui_hgt_$vid]
global $var_iemgui_hgt
set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid]
global $var_iemgui_min_hgt
if {[eval concat $$var_iemgui_wdt] < [eval concat $$var_iemgui_min_wdt]} {
set $var_iemgui_wdt [eval concat $$var_iemgui_min_wdt]
$mytoplevel.dim.w_ent configure -textvariable $var_iemgui_wdt
}
if {[eval concat $$var_iemgui_hgt] < [eval concat $$var_iemgui_min_hgt]} {
set $var_iemgui_hgt [eval concat $$var_iemgui_min_hgt]
$mytoplevel.dim.h_ent configure -textvariable $var_iemgui_hgt
}
}
proc ::dialog_iemgui::clip_num {mytoplevel} {
set vid [string trimleft $mytoplevel .]
set var_iemgui_num [concat iemgui_num_$vid]
global $var_iemgui_num
if {[eval concat $$var_iemgui_num] > 2000} {
set $var_iemgui_num 2000
$mytoplevel.para.num_ent configure -textvariable $var_iemgui_num
}
if {[eval concat $$var_iemgui_num] < 1} {
set $var_iemgui_num 1
$mytoplevel.para.num_ent configure -textvariable $var_iemgui_num
}
}
proc ::dialog_iemgui::sched_rng {mytoplevel} {
set vid [string trimleft $mytoplevel .]
set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
global $var_iemgui_min_rng
set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
global $var_iemgui_max_rng
set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid]
global $var_iemgui_rng_sch
variable define_min_flashhold
variable define_min_flashbreak
if {[eval concat $$var_iemgui_rng_sch] == 2} {
if {[eval concat $$var_iemgui_max_rng] < [eval concat $$var_iemgui_min_rng]} {
set hhh [eval concat $$var_iemgui_min_rng]
set $var_iemgui_min_rng [eval concat $$var_iemgui_max_rng]
set $var_iemgui_max_rng $hhh
$mytoplevel.rng.max_ent configure -textvariable $var_iemgui_max_rng
$mytoplevel.rng.min_ent configure -textvariable $var_iemgui_min_rng }
if {[eval concat $$var_iemgui_max_rng] < $define_min_flashhold} {
set $var_iemgui_max_rng $define_min_flashhold
$mytoplevel.rng.max_ent configure -textvariable $var_iemgui_max_rng
}
if {[eval concat $$var_iemgui_min_rng] < $define_min_flashbreak} {
set $var_iemgui_min_rng $define_min_flashbreak
$mytoplevel.rng.min_ent configure -textvariable $var_iemgui_min_rng
}
}
if {[eval concat $$var_iemgui_rng_sch] == 1} {
if {[eval concat $$var_iemgui_min_rng] == 0.0} {
set $var_iemgui_min_rng 1.0
$mytoplevel.rng.min_ent configure -textvariable $var_iemgui_min_rng
}
}
}
proc ::dialog_iemgui::verify_rng {mytoplevel} {
set vid [string trimleft $mytoplevel .]
set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
global $var_iemgui_min_rng
set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
global $var_iemgui_max_rng
set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
global $var_iemgui_lin0_log1
if {[eval concat $$var_iemgui_lin0_log1] == 1} {
if {[eval concat $$var_iemgui_max_rng] == 0.0 && [eval concat $$var_iemgui_min_rng] == 0.0} {
set $var_iemgui_max_rng 1.0
$mytoplevel.rng.max_ent configure -textvariable $var_iemgui_max_rng
}
if {[eval concat $$var_iemgui_max_rng] > 0} {
if {[eval concat $$var_iemgui_min_rng] <= 0} {
set $var_iemgui_min_rng [expr [eval concat $$var_iemgui_max_rng] * 0.01]
$mytoplevel.rng.min_ent configure -textvariable $var_iemgui_min_rng
}
} else {
if {[eval concat $$var_iemgui_min_rng] > 0} {
set $var_iemgui_max_rng [expr [eval concat $$var_iemgui_min_rng] * 0.01]
$mytoplevel.rng.max_ent configure -textvariable $var_iemgui_max_rng
}
}
}
}
proc ::dialog_iemgui::clip_fontsize {mytoplevel} {
set vid [string trimleft $mytoplevel .]
set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid]
global $var_iemgui_gn_fs
variable define_min_fontsize
if {[eval concat $$var_iemgui_gn_fs] < $define_min_fontsize} {
set $var_iemgui_gn_fs $define_min_fontsize
$mytoplevel.label.fs_ent configure -textvariable $var_iemgui_gn_fs
}
}
proc ::dialog_iemgui::set_col_example {mytoplevel} {
set vid [string trimleft $mytoplevel .]
set var_iemgui_bcol [concat iemgui_bcol_$vid]
global $var_iemgui_bcol
set var_iemgui_fcol [concat iemgui_fcol_$vid]
global $var_iemgui_fcol
set var_iemgui_lcol [concat iemgui_lcol_$vid]
global $var_iemgui_lcol
$mytoplevel.colors.sections.lb_bk configure \
-background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \
-activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]]
if { [eval concat $$var_iemgui_fcol] >= 0 } {
$mytoplevel.colors.sections.fr_bk configure \
-background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-foreground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \
-activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]]
} else {
$mytoplevel.colors.sections.fr_bk configure \
-background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-foreground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]]}
}
proc ::dialog_iemgui::preset_col {mytoplevel presetcol} {
set vid [string trimleft $mytoplevel .]
set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid]
global $var_iemgui_l2_f1_b0
set var_iemgui_bcol [concat iemgui_bcol_$vid]
global $var_iemgui_bcol
set var_iemgui_fcol [concat iemgui_fcol_$vid]
global $var_iemgui_fcol
set var_iemgui_lcol [concat iemgui_lcol_$vid]
global $var_iemgui_lcol
if { [eval concat $$var_iemgui_l2_f1_b0] == 0 } { set $var_iemgui_bcol $presetcol }
if { [eval concat $$var_iemgui_l2_f1_b0] == 1 } { set $var_iemgui_fcol $presetcol }
if { [eval concat $$var_iemgui_l2_f1_b0] == 2 } { set $var_iemgui_lcol $presetcol }
::dialog_iemgui::set_col_example $mytoplevel
}
proc ::dialog_iemgui::choose_col_bkfrlb {mytoplevel} {
set vid [string trimleft $mytoplevel .]
set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid]
global $var_iemgui_l2_f1_b0
set var_iemgui_bcol [concat iemgui_bcol_$vid]
global $var_iemgui_bcol
set var_iemgui_fcol [concat iemgui_fcol_$vid]
global $var_iemgui_fcol
set var_iemgui_lcol [concat iemgui_lcol_$vid]
global $var_iemgui_lcol
if {[eval concat $$var_iemgui_l2_f1_b0] == 0} {
set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC]
set helpstring [tk_chooseColor -title [_ "Background color"] -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_bcol]]]
if { $helpstring ne "" } {
set $var_iemgui_bcol [string replace $helpstring 0 0 "0x"]
set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC] }
}
if {[eval concat $$var_iemgui_l2_f1_b0] == 1} {
set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC]
set helpstring [tk_chooseColor -title [_ "Foreground color"] -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_fcol]]]
if { $helpstring ne "" } {
set $var_iemgui_fcol [string replace $helpstring 0 0 "0x"]
set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC] }
}
if {[eval concat $$var_iemgui_l2_f1_b0] == 2} {
set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC]
set helpstring [tk_chooseColor -title [_ "Label color"] -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_lcol]]]
if { $helpstring ne "" } {
set $var_iemgui_lcol [string replace $helpstring 0 0 "0x"]
set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC] }
}
::dialog_iemgui::set_col_example $mytoplevel
}
proc ::dialog_iemgui::lilo {mytoplevel} {
set vid [string trimleft $mytoplevel .]
set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
global $var_iemgui_lin0_log1
set var_iemgui_lilo0 [concat iemgui_lilo0_$vid]
global $var_iemgui_lilo0
set var_iemgui_lilo1 [concat iemgui_lilo1_$vid]
global $var_iemgui_lilo1
::dialog_iemgui::sched_rng $mytoplevel
if {[eval concat $$var_iemgui_lin0_log1] == 0} {
set $var_iemgui_lin0_log1 1
$mytoplevel.para.lilo configure -text [eval concat $$var_iemgui_lilo1]
::dialog_iemgui::verify_rng $mytoplevel
::dialog_iemgui::sched_rng $mytoplevel
} else {
set $var_iemgui_lin0_log1 0
$mytoplevel.para.lilo configure -text [eval concat $$var_iemgui_lilo0]
}
}
proc ::dialog_iemgui::toggle_font {mytoplevel gn_f} {
set vid [string trimleft $mytoplevel .]
set var_iemgui_gn_f [concat iemgui_gn_f_$vid]
global $var_iemgui_gn_f
set $var_iemgui_gn_f $gn_f
switch -- $gn_f {
0 { set current_font $::font_family}
1 { set current_font "Helvetica" }
2 { set current_font "Times" }
}
set current_font_spec "{$current_font} 16 $::font_weight"
$mytoplevel.label.fontpopup_label configure -text $current_font \
-font $current_font_spec
$mytoplevel.label.name_entry configure -font $current_font_spec
$mytoplevel.colors.sections.fr_bk configure -font $current_font_spec
$mytoplevel.colors.sections.lb_bk configure -font $current_font_spec
}
proc ::dialog_iemgui::lb {mytoplevel} {
set vid [string trimleft $mytoplevel .]
set var_iemgui_loadbang [concat iemgui_loadbang_$vid]
global $var_iemgui_loadbang
if {[eval concat $$var_iemgui_loadbang] == 0} {
set $var_iemgui_loadbang 1
$mytoplevel.para.lb configure -text [_ "Init"]
} else {
set $var_iemgui_loadbang 0
$mytoplevel.para.lb configure -text [_ "No init"]
}
}
proc ::dialog_iemgui::stdy_jmp {mytoplevel} {
set vid [string trimleft $mytoplevel .]
set var_iemgui_steady [concat iemgui_steady_$vid]
global $var_iemgui_steady
if {[eval concat $$var_iemgui_steady]} {
set $var_iemgui_steady 0
$mytoplevel.para.stdy_jmp configure -text [_ "Jump on click"]
} else {
set $var_iemgui_steady 1
$mytoplevel.para.stdy_jmp configure -text [_ "Steady on click"]
}
}
proc ::dialog_iemgui::apply {mytoplevel} {
set vid [string trimleft $mytoplevel .]
set var_iemgui_wdt [concat iemgui_wdt_$vid]
global $var_iemgui_wdt
set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid]
global $var_iemgui_min_wdt
set var_iemgui_hgt [concat iemgui_hgt_$vid]
global $var_iemgui_hgt
set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid]
global $var_iemgui_min_hgt
set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
global $var_iemgui_min_rng
set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
global $var_iemgui_max_rng
set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
global $var_iemgui_lin0_log1
set var_iemgui_lilo0 [concat iemgui_lilo0_$vid]
global $var_iemgui_lilo0
set var_iemgui_lilo1 [concat iemgui_lilo1_$vid]
global $var_iemgui_lilo1
set var_iemgui_loadbang [concat iemgui_loadbang_$vid]
global $var_iemgui_loadbang
set var_iemgui_num [concat iemgui_num_$vid]
global $var_iemgui_num
set var_iemgui_steady [concat iemgui_steady_$vid]
global $var_iemgui_steady
set var_iemgui_snd [concat iemgui_snd_$vid]
global $var_iemgui_snd
set var_iemgui_rcv [concat iemgui_rcv_$vid]
global $var_iemgui_rcv
set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid]
global $var_iemgui_gui_nam
set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid]
global $var_iemgui_gn_dx
set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid]
global $var_iemgui_gn_dy
set var_iemgui_gn_f [concat iemgui_gn_f_$vid]
global $var_iemgui_gn_f
set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid]
global $var_iemgui_gn_fs
set var_iemgui_bcol [concat iemgui_bcol_$vid]
global $var_iemgui_bcol
set var_iemgui_fcol [concat iemgui_fcol_$vid]
global $var_iemgui_fcol
set var_iemgui_lcol [concat iemgui_lcol_$vid]
global $var_iemgui_lcol
::dialog_iemgui::clip_dim $mytoplevel
::dialog_iemgui::clip_num $mytoplevel
::dialog_iemgui::sched_rng $mytoplevel
::dialog_iemgui::verify_rng $mytoplevel
::dialog_iemgui::sched_rng $mytoplevel
::dialog_iemgui::clip_fontsize $mytoplevel
if {[eval concat $$var_iemgui_snd] == ""} {set hhhsnd "empty"} else {set hhhsnd [eval concat $$var_iemgui_snd]}
if {[eval concat $$var_iemgui_rcv] == ""} {set hhhrcv "empty"} else {set hhhrcv [eval concat $$var_iemgui_rcv]}
if {[eval concat $$var_iemgui_gui_nam] == ""} {set hhhgui_nam "empty"
} else {
set hhhgui_nam [eval concat $$var_iemgui_gui_nam]}
if {[string index $hhhsnd 0] == "$"} {
set hhhsnd [string replace $hhhsnd 0 0 #] }
if {[string index $hhhrcv 0] == "$"} {
set hhhrcv [string replace $hhhrcv 0 0 #] }
if {[string index $hhhgui_nam 0] == "$"} {
set hhhgui_nam [string replace $hhhgui_nam 0 0 #] }
set hhhsnd [unspace_text $hhhsnd]
set hhhrcv [unspace_text $hhhrcv]
set hhhgui_nam [unspace_text $hhhgui_nam]
# make sure the offset boxes have a value
if {[eval concat $$var_iemgui_gn_dx] eq ""} {set $var_iemgui_gn_dx 0}
if {[eval concat $$var_iemgui_gn_dy] eq ""} {set $var_iemgui_gn_dy 0}
pdsend [concat $mytoplevel dialog \
[eval concat $$var_iemgui_wdt] \
[eval concat $$var_iemgui_hgt] \
[eval concat $$var_iemgui_min_rng] \
[eval concat $$var_iemgui_max_rng] \
[eval concat $$var_iemgui_lin0_log1] \
[eval concat $$var_iemgui_loadbang] \
[eval concat $$var_iemgui_num] \
$hhhsnd \
$hhhrcv \
$hhhgui_nam \
[eval concat $$var_iemgui_gn_dx] \
[eval concat $$var_iemgui_gn_dy] \
[eval concat $$var_iemgui_gn_f] \
[eval concat $$var_iemgui_gn_fs] \
[eval concat $$var_iemgui_bcol] \
[eval concat $$var_iemgui_fcol] \
[eval concat $$var_iemgui_lcol] \
[eval concat $$var_iemgui_steady]]
}
proc ::dialog_iemgui::cancel {mytoplevel} {
pdsend "$mytoplevel cancel"
}
proc ::dialog_iemgui::ok {mytoplevel} {
::dialog_iemgui::apply $mytoplevel
::dialog_iemgui::cancel $mytoplevel
}
proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
wdt min_wdt wdt_label \
hgt min_hgt hgt_label \
rng_header min_rng min_rng_label max_rng \
max_rng_label rng_sched \
lin0_log1 lilo0_label lilo1_label \
loadbang steady num_label num \
snd rcv \
gui_name \
gn_dx gn_dy gn_f gn_fs \
bcol fcol lcol} {
set vid [string trimleft $mytoplevel .]
set var_iemgui_wdt [concat iemgui_wdt_$vid]
global $var_iemgui_wdt
set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid]
global $var_iemgui_min_wdt
set var_iemgui_hgt [concat iemgui_hgt_$vid]
global $var_iemgui_hgt
set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid]
global $var_iemgui_min_hgt
set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
global $var_iemgui_min_rng
set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
global $var_iemgui_max_rng
set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid]
global $var_iemgui_rng_sch
set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
global $var_iemgui_lin0_log1
set var_iemgui_lilo0 [concat iemgui_lilo0_$vid]
global $var_iemgui_lilo0
set var_iemgui_lilo1 [concat iemgui_lilo1_$vid]
global $var_iemgui_lilo1
set var_iemgui_loadbang [concat iemgui_loadbang_$vid]
global $var_iemgui_loadbang
set var_iemgui_num [concat iemgui_num_$vid]
global $var_iemgui_num
set var_iemgui_steady [concat iemgui_steady_$vid]
global $var_iemgui_steady
set var_iemgui_snd [concat iemgui_snd_$vid]
global $var_iemgui_snd
set var_iemgui_rcv [concat iemgui_rcv_$vid]
global $var_iemgui_rcv
set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid]
global $var_iemgui_gui_nam
set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid]
global $var_iemgui_gn_dx
set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid]
global $var_iemgui_gn_dy
set var_iemgui_gn_f [concat iemgui_gn_f_$vid]
global $var_iemgui_gn_f
set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid]
global $var_iemgui_gn_fs
set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid]
global $var_iemgui_l2_f1_b0
set var_iemgui_bcol [concat iemgui_bcol_$vid]
global $var_iemgui_bcol
set var_iemgui_fcol [concat iemgui_fcol_$vid]
global $var_iemgui_fcol
set var_iemgui_lcol [concat iemgui_lcol_$vid]
global $var_iemgui_lcol
set $var_iemgui_wdt $wdt
set $var_iemgui_min_wdt $min_wdt
set $var_iemgui_hgt $hgt
set $var_iemgui_min_hgt $min_hgt
set $var_iemgui_min_rng $min_rng
set $var_iemgui_max_rng $max_rng
set $var_iemgui_rng_sch $rng_sched
set $var_iemgui_lin0_log1 $lin0_log1
set $var_iemgui_lilo0 $lilo0_label
set $var_iemgui_lilo1 $lilo1_label
set $var_iemgui_loadbang $loadbang
set $var_iemgui_num $num
set $var_iemgui_steady $steady
if {$snd == "empty"} {set $var_iemgui_snd [format ""]
} else {set $var_iemgui_snd [format "%s" $snd]}
if {$rcv == "empty"} {set $var_iemgui_rcv [format ""]
} else {set $var_iemgui_rcv [format "%s" $rcv]}
if {$gui_name == "empty"} {set $var_iemgui_gui_nam [format ""]
} else {set $var_iemgui_gui_nam [format "%s" $gui_name]}
if {[string index [eval concat $$var_iemgui_snd] 0] == "#"} {
set $var_iemgui_snd [string replace [eval concat $$var_iemgui_snd] 0 0 $] }
if {[string index [eval concat $$var_iemgui_rcv] 0] == "#"} {
set $var_iemgui_rcv [string replace [eval concat $$var_iemgui_rcv] 0 0 $] }
if {[string index [eval concat $$var_iemgui_gui_nam] 0] == "#"} {
set $var_iemgui_gui_nam [string replace [eval concat $$var_iemgui_gui_nam] 0 0 $] }
set $var_iemgui_gn_dx $gn_dx
set $var_iemgui_gn_dy $gn_dy
set $var_iemgui_gn_f $gn_f
set $var_iemgui_gn_fs $gn_fs
set $var_iemgui_bcol $bcol
set $var_iemgui_fcol $fcol
set $var_iemgui_lcol $lcol
set $var_iemgui_l2_f1_b0 0
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [format [_ "%s Properties"] $mainheader]
wm group $mytoplevel .
wm resizable $mytoplevel 0 0
wm transient $mytoplevel $::focused_window
$mytoplevel configure -menu $::dialog_menubar
$mytoplevel configure -padx 0 -pady 0
::pd_bindings::dialog_bindings $mytoplevel "iemgui"
frame $mytoplevel.dim
pack $mytoplevel.dim -side top
label $mytoplevel.dim.head -text [_ $dim_header]
label $mytoplevel.dim.w_lab -text [_ $wdt_label] -width 6
entry $mytoplevel.dim.w_ent -textvariable $var_iemgui_wdt -width 5
label $mytoplevel.dim.dummy1 -text " " -width 10
label $mytoplevel.dim.h_lab -text [_ $hgt_label] -width 6
entry $mytoplevel.dim.h_ent -textvariable $var_iemgui_hgt -width 5
pack $mytoplevel.dim.head -side top
pack $mytoplevel.dim.w_lab $mytoplevel.dim.w_ent $mytoplevel.dim.dummy1 -side left
if { $hgt_label ne "empty" } {
pack $mytoplevel.dim.h_lab $mytoplevel.dim.h_ent -side left}
frame $mytoplevel.rng
pack $mytoplevel.rng -side top
label $mytoplevel.rng.head -text [_ $rng_header]
label $mytoplevel.rng.min_lab -text [_ $min_rng_label] -width 6
entry $mytoplevel.rng.min_ent -textvariable $var_iemgui_min_rng -width 9
label $mytoplevel.rng.dummy1 -text " " -width 1
label $mytoplevel.rng.max_lab -text [_ $max_rng_label] -width 8
entry $mytoplevel.rng.max_ent -textvariable $var_iemgui_max_rng -width 9
if { $rng_header ne "empty" } {
pack $mytoplevel.rng.head -side top
if { $min_rng_label ne "empty" } {
pack $mytoplevel.rng.min_lab $mytoplevel.rng.min_ent -side left}
if { $max_rng_label ne "empty" } {
pack $mytoplevel.rng.dummy1 \
$mytoplevel.rng.max_lab $mytoplevel.rng.max_ent -side left} }
if { [eval concat $$var_iemgui_lin0_log1] >= 0 || [eval concat $$var_iemgui_loadbang] >= 0 || [eval concat $$var_iemgui_num] > 0 || [eval concat $$var_iemgui_steady] >= 0 } {
label $mytoplevel.space1 -text ""
pack $mytoplevel.space1 -side top }
frame $mytoplevel.para
pack $mytoplevel.para -side top
label $mytoplevel.para.dummy2 -text "" -width 1
label $mytoplevel.para.dummy3 -text "" -width 1
if {[eval concat $$var_iemgui_lin0_log1] == 0} {
button $mytoplevel.para.lilo -text [_ [eval concat $$var_iemgui_lilo0]] -width 5 \
-command "::dialog_iemgui::lilo $mytoplevel" }
if {[eval concat $$var_iemgui_lin0_log1] == 1} {
button $mytoplevel.para.lilo -text [_ [eval concat $$var_iemgui_lilo1]] -width 5 \
-command "::dialog_iemgui::lilo $mytoplevel" }
if {[eval concat $$var_iemgui_loadbang] == 0} {
button $mytoplevel.para.lb -text [_ "No init"] \
-command "::dialog_iemgui::lb $mytoplevel" }
if {[eval concat $$var_iemgui_loadbang] == 1} {
button $mytoplevel.para.lb -text [_ "Save"] \
-command "::dialog_iemgui::lb $mytoplevel" }
label $mytoplevel.para.num_lab -text [_ $num_label] -width 9
entry $mytoplevel.para.num_ent -textvariable $var_iemgui_num -width 4
if {[eval concat $$var_iemgui_steady] == 0} {
button $mytoplevel.para.stdy_jmp -command "::dialog_iemgui::stdy_jmp $mytoplevel" \
-text [_ "Jump on click"] }
if {[eval concat $$var_iemgui_steady] == 1} {
button $mytoplevel.para.stdy_jmp -command "::dialog_iemgui::stdy_jmp $mytoplevel" \
-text [_ "Steady on click"] }
if {[eval concat $$var_iemgui_lin0_log1] >= 0} {
pack $mytoplevel.para.lilo -side left -expand 1}
if {[eval concat $$var_iemgui_loadbang] >= 0} {
pack $mytoplevel.para.dummy2 $mytoplevel.para.lb -side left -expand 1}
if {[eval concat $$var_iemgui_num] > 0} {
pack $mytoplevel.para.dummy3 $mytoplevel.para.num_lab $mytoplevel.para.num_ent -side left -expand 1}
if {[eval concat $$var_iemgui_steady] >= 0} {
pack $mytoplevel.para.dummy3 $mytoplevel.para.stdy_jmp -side left -expand 1}
frame $mytoplevel.spacer0 -height 4
pack $mytoplevel.spacer0 -side top
labelframe $mytoplevel.s_r -borderwidth 1 -pady 4 -text [_ "Messages"]
pack $mytoplevel.s_r -side top -fill x -ipadx 5
frame $mytoplevel.s_r.send
pack $mytoplevel.s_r.send -side top -padx 4 -fill x -expand 1
label $mytoplevel.s_r.send.lab -text [_ "Send symbol:"] -justify left
entry $mytoplevel.s_r.send.ent -textvariable $var_iemgui_snd -width 22
if { $snd ne "nosndno" } {
pack $mytoplevel.s_r.send.lab $mytoplevel.s_r.send.ent -side left \
-fill x -expand 1
}
frame $mytoplevel.s_r.receive
pack $mytoplevel.s_r.receive -side top -padx 4 -fill x -expand 1
label $mytoplevel.s_r.receive.lab -text [_ "Receive symbol:"] -justify left
entry $mytoplevel.s_r.receive.ent -textvariable $var_iemgui_rcv -width 22
if { $rcv ne "norcvno" } {
pack $mytoplevel.s_r.receive.lab $mytoplevel.s_r.receive.ent -side left \
-fill x -expand 1
}
# get the current font name from the int given from C-space (gn_f)
set current_font $::font_family
if {[eval concat $$var_iemgui_gn_f] == 1} \
{ set current_font "Helvetica" }
if {[eval concat $$var_iemgui_gn_f] == 2} \
{ set current_font "Times" }
frame $mytoplevel.spacer1 -height 7
pack $mytoplevel.spacer1 -side top
labelframe $mytoplevel.label -borderwidth 1 -text [_ "Label"] -pady 4
pack $mytoplevel.label -side top -fill x
entry $mytoplevel.label.name_entry -textvariable $var_iemgui_gui_nam \
-width 30 -font [list $current_font 12 $::font_weight]
pack $mytoplevel.label.name_entry -side top -expand yes -fill both -padx 5
frame $mytoplevel.label.xy -padx 27 -pady 1
pack $mytoplevel.label.xy -side top
label $mytoplevel.label.xy.x_lab -text [_ "X offset"]
entry $mytoplevel.label.xy.x_entry -textvariable $var_iemgui_gn_dx -width 5
label $mytoplevel.label.xy.dummy1 -text " " -width 2
label $mytoplevel.label.xy.y_lab -text [_ "Y offset"]
entry $mytoplevel.label.xy.y_entry -textvariable $var_iemgui_gn_dy -width 5
pack $mytoplevel.label.xy.x_lab $mytoplevel.label.xy.x_entry $mytoplevel.label.xy.dummy1 \
$mytoplevel.label.xy.y_lab $mytoplevel.label.xy.y_entry -side left -anchor e
button $mytoplevel.label.fontpopup_label -text $current_font \
-font [list $current_font 16 $::font_weight]
pack $mytoplevel.label.fontpopup_label -side left -anchor w \
-expand 1 -fill x -padx 5
label $mytoplevel.label.fontsize_label -text [_ "Size:"]
entry $mytoplevel.label.fontsize_entry -textvariable $var_iemgui_gn_fs -width 5
pack $mytoplevel.label.fontsize_entry $mytoplevel.label.fontsize_label \
-side right -anchor e -padx 5 -pady 5
menu $mytoplevel.popup
$mytoplevel.popup add command \
-label $::font_family \
-font [format {{%s} 16 %s} $::font_family $::font_weight] \
-command "::dialog_iemgui::toggle_font $mytoplevel 0"
$mytoplevel.popup add command \
-label "Helvetica" \
-font [format {Helvetica 16 %s} $::font_weight] \
-command "::dialog_iemgui::toggle_font $mytoplevel 1"
$mytoplevel.popup add command \
-label "Times" \
-font [format {Times 16 %s} $::font_weight] \
-command "::dialog_iemgui::toggle_font $mytoplevel 2"
bind $mytoplevel.label.fontpopup_label <Button> \
[list tk_popup $mytoplevel.popup %X %Y]
frame $mytoplevel.spacer2 -height 7
pack $mytoplevel.spacer2 -side top
labelframe $mytoplevel.colors -borderwidth 1 -text [_ "Colors"]
pack $mytoplevel.colors -fill x -ipadx 5 -ipady 4
frame $mytoplevel.colors.select
pack $mytoplevel.colors.select -side top
radiobutton $mytoplevel.colors.select.radio0 -value 0 -variable \
$var_iemgui_l2_f1_b0 -text [_ "Background"] -justify left
radiobutton $mytoplevel.colors.select.radio1 -value 1 -variable \
$var_iemgui_l2_f1_b0 -text [_ "Front"] -justify left
radiobutton $mytoplevel.colors.select.radio2 -value 2 -variable \
$var_iemgui_l2_f1_b0 -text [_ "Label"] -justify left
if { [eval concat $$var_iemgui_fcol] >= 0 } {
pack $mytoplevel.colors.select.radio0 $mytoplevel.colors.select.radio1 \
$mytoplevel.colors.select.radio2 -side left
} else {
pack $mytoplevel.colors.select.radio0 $mytoplevel.colors.select.radio2 -side left
}
frame $mytoplevel.colors.sections
pack $mytoplevel.colors.sections -side top
button $mytoplevel.colors.sections.but -text [_ "Compose color"] \
-command "::dialog_iemgui::choose_col_bkfrlb $mytoplevel"
pack $mytoplevel.colors.sections.but -side left -anchor w -padx 10 -pady 5 \
-expand yes -fill x
if { [eval concat $$var_iemgui_fcol] >= 0 } {
label $mytoplevel.colors.sections.fr_bk -text "o=||=o" -width 6 \
-background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-foreground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \
-activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \
-font [list $current_font 12 $::font_weight] -padx 2 -pady 2 -relief ridge
} else {
label $mytoplevel.colors.sections.fr_bk -text "o=||=o" -width 6 \
-background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-foreground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-font [list $current_font 12 $::font_weight] -padx 2 -pady 2 -relief ridge
}
label $mytoplevel.colors.sections.lb_bk -text [_ "Test label"] \
-background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \
-activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \
-font [list $current_font 12 $::font_weight] -padx 2 -pady 2 -relief ridge
pack $mytoplevel.colors.sections.lb_bk $mytoplevel.colors.sections.fr_bk \
-side right -anchor e -expand yes -fill both -pady 7
# color scheme by Mary Ann Benedetto http://piR2.org
frame $mytoplevel.colors.r1
pack $mytoplevel.colors.r1 -side top
foreach i { 0 1 2 3 4 5 6 7 8 9} \
hexcol { 0xFFFFFF 0xDFDFDF 0xBBBBBB 0xFFC7C6 0xFFE3C6 \
0xFEFFC6 0xC6FFC7 0xc6FEFF 0xC7C6FF 0xE3C6FF } \
{
label $mytoplevel.colors.r1.c$i -background [format "#%6.6x" $hexcol] \
-activebackground [format "#%6.6x" $hexcol] -relief ridge \
-padx 7 -pady 0
bind $mytoplevel.colors.r1.c$i <Button> [format "::dialog_iemgui::preset_col %s %d" $mytoplevel $hexcol]
}
pack $mytoplevel.colors.r1.c0 $mytoplevel.colors.r1.c1 $mytoplevel.colors.r1.c2 $mytoplevel.colors.r1.c3 \
$mytoplevel.colors.r1.c4 $mytoplevel.colors.r1.c5 $mytoplevel.colors.r1.c6 $mytoplevel.colors.r1.c7 \
$mytoplevel.colors.r1.c8 $mytoplevel.colors.r1.c9 -side left
frame $mytoplevel.colors.r2
pack $mytoplevel.colors.r2 -side top
foreach i { 0 1 2 3 4 5 6 7 8 9 } \
hexcol { 0x9F9F9F 0x7C7C7C 0x606060 0xFF0400 0xFF8300 \
0xFAFF00 0x00FF04 0x00FAFF 0x0400FF 0x9C00FF } \
{
label $mytoplevel.colors.r2.c$i -background [format "#%6.6x" $hexcol] \
-activebackground [format "#%6.6x" $hexcol] -relief ridge \
-padx 7 -pady 0
bind $mytoplevel.colors.r2.c$i <Button> \
[format "::dialog_iemgui::preset_col %s %d" $mytoplevel $hexcol]
}
pack $mytoplevel.colors.r2.c0 $mytoplevel.colors.r2.c1 $mytoplevel.colors.r2.c2 $mytoplevel.colors.r2.c3 \
$mytoplevel.colors.r2.c4 $mytoplevel.colors.r2.c5 $mytoplevel.colors.r2.c6 $mytoplevel.colors.r2.c7 \
$mytoplevel.colors.r2.c8 $mytoplevel.colors.r2.c9 -side left
frame $mytoplevel.colors.r3
pack $mytoplevel.colors.r3 -side top
foreach i { 0 1 2 3 4 5 6 7 8 9 } \
hexcol { 0x404040 0x202020 0x000000 0x551312 0x553512 \
0x535512 0x0F4710 0x0E4345 0x131255 0x2F004D } \
{
label $mytoplevel.colors.r3.c$i -background [format "#%6.6x" $hexcol] \
-activebackground [format "#%6.6x" $hexcol] -relief ridge \
-padx 7 -pady 0
bind $mytoplevel.colors.r3.c$i <Button> \
[format "::dialog_iemgui::preset_col %s %d" $mytoplevel $hexcol]
}
pack $mytoplevel.colors.r3.c0 $mytoplevel.colors.r3.c1 $mytoplevel.colors.r3.c2 $mytoplevel.colors.r3.c3 \
$mytoplevel.colors.r3.c4 $mytoplevel.colors.r3.c5 $mytoplevel.colors.r3.c6 $mytoplevel.colors.r3.c7 \
$mytoplevel.colors.r3.c8 $mytoplevel.colors.r3.c9 -side left
frame $mytoplevel.cao -pady 10
pack $mytoplevel.cao -side top -expand 1 -fill x
button $mytoplevel.cao.cancel -text [_ "Cancel"] \
-command "::dialog_iemgui::cancel $mytoplevel"
pack $mytoplevel.cao.cancel -side left -padx 10 -expand 1 -fill x
if {$::windowingsystem ne "aqua"} {
button $mytoplevel.cao.apply -text [_ "Apply"] \
-command "::dialog_iemgui::apply $mytoplevel"
pack $mytoplevel.cao.apply -side left -padx 10 -expand 1 -fill x
}
button $mytoplevel.cao.ok -text [_ "OK"] \
-command "::dialog_iemgui::ok $mytoplevel"
pack $mytoplevel.cao.ok -side left -padx 10 -expand 1 -fill x
$mytoplevel.dim.w_ent select from 0
$mytoplevel.dim.w_ent select adjust end
focus $mytoplevel.dim.w_ent
}

85
tcl/dialog_message.tcl Normal file
View file

@ -0,0 +1,85 @@
# the message dialog panel is a bit unusual in that it is created directly by
# the Tcl 'pd-gui'. Most dialog panels are created by sending a message to
# 'pd', which then sends a message to 'pd-gui' to create the panel. This is
# similar to the Find dialog panel.
package provide dialog_message 0.1
package require pd_bindings
namespace eval ::dialog_message:: {
variable message_history {"pd dsp 1"}
variable history_position 0
namespace export open_message_dialog
}
proc ::dialog_message::get_history {direction} {
variable message_history
variable history_position
incr history_position $direction
if {$history_position < 0} {set history_position 0}
if {$history_position > [llength $message_history]} {
set history_position [llength $message_history]
}
.message.f.entry delete 0 end
.message.f.entry insert 0 \
[lindex $message_history end-[expr $history_position - 1]]
}
# mytoplevel isn't used here, but is kept for compatibility with other dialog ok procs
proc ::dialog_message::ok {mytoplevel} {
variable message_history
set message [.message.f.entry get]
if {$message ne ""} {
pdsend $message
lappend message_history $message
.message.f.entry delete 0 end
}
}
# mytoplevel isn't used here, but is kept for compatibility with other dialog cancel procs
proc ::dialog_message::cancel {mytoplevel} {
wm withdraw .message
}
# the message panel is opened from the menu and key bindings
proc ::dialog_message::open_message_dialog {mytoplevel} {
if {[winfo exists .message]} {
wm deiconify .message
raise .message
} else {
create_dialog $mytoplevel
}
}
proc ::dialog_message::create_dialog {mytoplevel} {
toplevel .message -class DialogWindow
wm group .message .
wm transient .message
wm title .message [_ "Send a Pd message"]
wm geometry .message =400x80+150+150
wm resizable .message 1 0
wm minsize .message 250 80
.message configure -menu $::dialog_menubar
.message configure -padx 10 -pady 5
::pd_bindings::dialog_bindings .message "message"
# not all Tcl/Tk versions or platforms support -topmost, so catch the error
catch {wm attributes $id -topmost 1}
# TODO this should use something like 'dialogfont' for the font
frame .message.f
pack .message.f -side top -fill x -expand 1
entry .message.f.entry -width 54 -font {Helvetica 18} -relief sunken \
-highlightthickness 1 -highlightcolor blue
label .message.f.semicolon -text ";" -font {Helvetica 24}
pack .message.f.semicolon -side left
pack .message.f.entry -side left -padx 10 -fill x -expand 1
focus .message.f.entry
label .message.label -text [_ "(use arrow keys for history)"]
pack .message.label -side bottom
bind .message.f.entry <Up> "::dialog_message::get_history 1"
bind .message.f.entry <Down> "::dialog_message::get_history -1"
}

351
tcl/dialog_midi.tcl Normal file
View file

@ -0,0 +1,351 @@
package provide dialog_midi 0.1
namespace eval ::dialog_midi:: {
namespace export pdtk_midi_dialog
namespace export pdtk_alsa_midi_dialog
}
# TODO this panel really needs some reworking, it works but the code is
# very unreadable
####################### midi dialog ##################
proc ::dialog_midi::apply {mytoplevel} {
global midi_indev1 midi_indev2 midi_indev3 midi_indev4
global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4
global midi_alsain midi_alsaout
pdsend "pd midi-dialog \
$midi_indev1 \
$midi_indev2 \
$midi_indev3 \
$midi_indev4 \
$midi_outdev1 \
$midi_outdev2 \
$midi_outdev3 \
$midi_outdev4 \
$midi_alsain \
$midi_alsaout"
}
proc ::dialog_midi::cancel {mytoplevel} {
pdsend "$mytoplevel cancel"
}
proc ::dialog_midi::ok {mytoplevel} {
::dialog_midi::apply $mytoplevel
::dialog_midi::cancel $mytoplevel
}
# callback from popup menu
proc midi_popup_action {buttonname varname devlist index} {
global midi_indevlist midi_outdevlist $varname
$buttonname configure -text [lindex $devlist $index]
set $varname $index
}
# create a popup menu
proc midi_popup {name buttonname varname devlist} {
if [winfo exists $name.popup] {destroy $name.popup}
menu $name.popup -tearoff false
if {$::windowingsystem eq "win32"} {
$name.popup configure -font menuFont
}
# puts stderr [concat $devlist ]
for {set x 0} {$x<[llength $devlist]} {incr x} {
$name.popup add command -label [lindex $devlist $x] \
-command [list midi_popup_action \
$buttonname $varname $devlist $x]
}
tk_popup $name.popup [winfo pointerx $name] [winfo pointery $name] 0
}
# start a dialog window to select midi devices. "longform" asks us to make
# controls for opening several devices; if not, we get an extra button to
# turn longform on and restart the dialog.
proc ::dialog_midi::pdtk_midi_dialog {id indev1 indev2 indev3 indev4 \
outdev1 outdev2 outdev3 outdev4 longform} {
global midi_indev1 midi_indev2 midi_indev3 midi_indev4
global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4
global midi_indevlist midi_outdevlist
global midi_alsain midi_alsaout
set midi_indev1 $indev1
set midi_indev2 $indev2
set midi_indev3 $indev3
set midi_indev4 $indev4
set midi_outdev1 $outdev1
set midi_outdev2 $outdev2
set midi_outdev3 $outdev3
set midi_outdev4 $outdev4
set midi_alsain [llength $midi_indevlist]
set midi_alsaout [llength $midi_outdevlist]
toplevel $id -class DialogWindow
wm title $id [_ "MIDI Settings"]
wm group $id .
wm resizable $id 0 0
wm transient $id
$id configure -menu $::dialog_menubar
$id configure -padx 10 -pady 5
::pd_bindings::dialog_bindings $id "midi"
# not all Tcl/Tk versions or platforms support -topmost, so catch the error
catch {wm attributes $id -topmost 1}
frame $id.buttonframe
pack $id.buttonframe -side bottom -fill x -pady 2m
button $id.buttonframe.cancel -text [_ "Cancel"]\
-command "::dialog_midi::cancel $id"
button $id.buttonframe.apply -text [_ "Apply"]\
-command "::dialog_midi::apply $id"
button $id.buttonframe.ok -text [_ "OK"]\
-command "::dialog_midi::ok $id"
pack $id.buttonframe.cancel -side left -expand 1
pack $id.buttonframe.apply -side left -expand 1
pack $id.buttonframe.ok -side left -expand 1
# input device 1
frame $id.in1f
pack $id.in1f -side top
label $id.in1f.l1 -text [_ "Input device 1:"]
button $id.in1f.x1 -text [lindex $midi_indevlist $midi_indev1] \
-command [list midi_popup $id $id.in1f.x1 midi_indev1 $midi_indevlist]
pack $id.in1f.l1 $id.in1f.x1 -side left
# input device 2
if {$longform && [llength $midi_indevlist] > 2} {
frame $id.in2f
pack $id.in2f -side top
label $id.in2f.l1 -text [_ "Input device 2:"]
button $id.in2f.x1 -text [lindex $midi_indevlist $midi_indev2] \
-command [list midi_popup $id $id.in2f.x1 midi_indev2 \
$midi_indevlist]
pack $id.in2f.l1 $id.in2f.x1 -side left
}
# input device 3
if {$longform && [llength $midi_indevlist] > 3} {
frame $id.in3f
pack $id.in3f -side top
label $id.in3f.l1 -text [_ "Input device 3:"]
button $id.in3f.x1 -text [lindex $midi_indevlist $midi_indev3] \
-command [list midi_popup $id $id.in3f.x1 midi_indev3 \
$midi_indevlist]
pack $id.in3f.l1 $id.in3f.x1 -side left
}
# input device 4
if {$longform && [llength $midi_indevlist] > 4} {
frame $id.in4f
pack $id.in4f -side top
label $id.in4f.l1 -text [_ "Input device 4:"]
button $id.in4f.x1 -text [lindex $midi_indevlist $midi_indev4] \
-command [list midi_popup $id $id.in4f.x1 midi_indev4 \
$midi_indevlist]
pack $id.in4f.l1 $id.in4f.x1 -side left
}
# output device 1
frame $id.out1f
pack $id.out1f -side top
label $id.out1f.l1 -text [_ "Output device 1:"]
button $id.out1f.x1 -text [lindex $midi_outdevlist $midi_outdev1] \
-command [list midi_popup $id $id.out1f.x1 midi_outdev1 \
$midi_outdevlist]
pack $id.out1f.l1 $id.out1f.x1 -side left
# output device 2
if {$longform && [llength $midi_outdevlist] > 2} {
frame $id.out2f
pack $id.out2f -side top
label $id.out2f.l1 -text [_ "Output device 2:"]
button $id.out2f.x1 -text [lindex $midi_outdevlist $midi_outdev2] \
-command \
[list midi_popup $id $id.out2f.x1 midi_outdev2 $midi_outdevlist]
pack $id.out2f.l1 $id.out2f.x1 -side left
}
# output device 3
if {$longform && [llength $midi_outdevlist] > 3} {
frame $id.out3f
pack $id.out3f -side top
label $id.out3f.l1 -text [_ "Output device 3:"]
button $id.out3f.x1 -text [lindex $midi_outdevlist $midi_outdev3] \
-command \
[list midi_popup $id $id.out3f.x1 midi_outdev3 $midi_outdevlist]
pack $id.out3f.l1 $id.out3f.x1 -side left
}
# output device 4
if {$longform && [llength $midi_outdevlist] > 4} {
frame $id.out4f
pack $id.out4f -side top
label $id.out4f.l1 -text [_ "Output device 4:"]
button $id.out4f.x1 -text [lindex $midi_outdevlist $midi_outdev4] \
-command \
[list midi_popup $id $id.out4f.x1 midi_outdev4 $midi_outdevlist]
pack $id.out4f.l1 $id.out4f.x1 -side left
}
# if not the "long form" make a button to
# restart with longform set.
if {$longform == 0} {
frame $id.longbutton
pack $id.longbutton -side top
button $id.longbutton.b -text [_ "Use multiple devices"] \
-command {pdsend "pd midi-properties 1"}
pack $id.longbutton.b
}
}
proc ::dialog_midi::pdtk_alsa_midi_dialog {id indev1 indev2 indev3 indev4 \
outdev1 outdev2 outdev3 outdev4 longform alsa} {
global midi_indev1 midi_indev2 midi_indev3 midi_indev4
global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4
global midi_indevlist midi_outdevlist
global midi_alsain midi_alsaout
set midi_indev1 $indev1
set midi_indev2 $indev2
set midi_indev3 $indev3
set midi_indev4 $indev4
set midi_outdev1 $outdev1
set midi_outdev2 $outdev2
set midi_outdev3 $outdev3
set midi_outdev4 $outdev4
set midi_alsain [llength $midi_indevlist]
set midi_alsaout [llength $midi_outdevlist]
toplevel $id
wm title $id [_ "ALSA MIDI Settings"]
if {$::windowingsystem eq "aqua"} {$id configure -menu .menubar}
::pd_bindings::dialog_bindings $id "midi"
frame $id.buttonframe
pack $id.buttonframe -side bottom -fill x -pady 2m
button $id.buttonframe.cancel -text [_ "Cancel"]\
-command "::dialog_midi::cancel $id"
button $id.buttonframe.apply -text [_ "Apply"]\
-command "::dialog_midi::apply $id"
button $id.buttonframe.ok -text [_ "OK"]\
-command "::dialog_midi::ok $id"
pack $id.buttonframe.cancel -side left -expand 1
pack $id.buttonframe.apply -side left -expand 1
pack $id.buttonframe.ok -side left -expand 1
frame $id.in1f
pack $id.in1f -side top
if {$alsa == 0} {
# input device 1
label $id.in1f.l1 -text [_ "Input device 1:"]
button $id.in1f.x1 -text [lindex $midi_indevlist $midi_indev1] \
-command [list midi_popup $id $id.in1f.x1 midi_indev1 $midi_indevlist]
pack $id.in1f.l1 $id.in1f.x1 -side left
# input device 2
if {$longform && [llength $midi_indevlist] > 2} {
frame $id.in2f
pack $id.in2f -side top
label $id.in2f.l1 -text [_ "Input device 2:"]
button $id.in2f.x1 -text [lindex $midi_indevlist $midi_indev2] \
-command [list midi_popup $id $id.in2f.x1 midi_indev2 \
$midi_indevlist]
pack $id.in2f.l1 $id.in2f.x1 -side left
}
# input device 3
if {$longform && [llength $midi_indevlist] > 3} {
frame $id.in3f
pack $id.in3f -side top
label $id.in3f.l1 -text [_ "Input device 3:"]
button $id.in3f.x1 -text [lindex $midi_indevlist $midi_indev3] \
-command [list midi_popup $id $id.in3f.x1 midi_indev3 \
$midi_indevlist]
pack $id.in3f.l1 $id.in3f.x1 -side left
}
# input device 4
if {$longform && [llength $midi_indevlist] > 4} {
frame $id.in4f
pack $id.in4f -side top
label $id.in4f.l1 -text [_ "Input device 4:"]
button $id.in4f.x1 -text [lindex $midi_indevlist $midi_indev4] \
-command [list midi_popup $id $id.in4f.x1 midi_indev4 \
$midi_indevlist]
pack $id.in4f.l1 $id.in4f.x1 -side left
}
# output device 1
frame $id.out1f
pack $id.out1f -side top
label $id.out1f.l1 -text [_ "Output device 1:"]
button $id.out1f.x1 -text [lindex $midi_outdevlist $midi_outdev1] \
-command [list midi_popup $id $id.out1f.x1 midi_outdev1 \
$midi_outdevlist]
pack $id.out1f.l1 $id.out1f.x1 -side left
# output device 2
if {$longform && [llength $midi_outdevlist] > 2} {
frame $id.out2f
pack $id.out2f -side top
label $id.out2f.l1 -text [_ "Output device 2:"]
button $id.out2f.x1 -text [lindex $midi_outdevlist $midi_outdev2] \
-command \
[list midi_popup $id $id.out2f.x1 midi_outdev2 $midi_outdevlist]
pack $id.out2f.l1 $id.out2f.x1 -side left
}
# output device 3
if {$longform && [llength $midi_outdevlist] > 3} {
frame $id.out3f
pack $id.out3f -side top
label $id.out3f.l1 -text [_ "Output device 3:"]
button $id.out3f.x1 -text [lindex $midi_outdevlist $midi_outdev3] \
-command \
[list midi_popup $id $id.out3f.x1 midi_outdev3 $midi_outdevlist]
pack $id.out3f.l1 $id.out3f.x1 -side left
}
# output device 4
if {$longform && [llength $midi_outdevlist] > 4} {
frame $id.out4f
pack $id.out4f -side top
label $id.out4f.l1 -text [_ "Output device 4:"]
button $id.out4f.x1 -text [lindex $midi_outdevlist $midi_outdev4] \
-command \
[list midi_popup $id $id.out4f.x1 midi_outdev4 $midi_outdevlist]
pack $id.out4f.l1 $id.out4f.x1 -side left
}
# if not the "long form" make a button to
# restart with longform set.
if {$longform == 0} {
frame $id.longbutton
pack $id.longbutton -side top
button $id.longbutton.b -text [_ "Use multiple ALSA devices"] \
-command {pdsend "pd midi-properties 1"}
pack $id.longbutton.b
}
}
if {$alsa} {
label $id.in1f.l1 -text [_ "In Ports:"]
entry $id.in1f.x1 -textvariable midi_alsain -width 4
pack $id.in1f.l1 $id.in1f.x1 -side left
label $id.in1f.l2 -text [_ "Out Ports:"]
entry $id.in1f.x2 -textvariable midi_alsaout -width 4
pack $id.in1f.l2 $id.in1f.x2 -side left
}
}

70
tcl/dialog_path.tcl Normal file
View file

@ -0,0 +1,70 @@
package provide dialog_path 0.1
namespace eval ::dialog_path:: {
variable use_standard_extensions_button 1
variable verbose_button 0
namespace export pdtk_path_dialog
}
############ pdtk_path_dialog -- run a path dialog #########
# set up the panel with the info from pd
proc ::dialog_path::pdtk_path_dialog {mytoplevel extrapath verbose} {
global use_standard_extensions_button
global verbose_button
set use_standard_extensions_button $extrapath
set verbose_button $verbose
if {[winfo exists $mytoplevel]} {
wm deiconify $mytoplevel
raise $mytoplevel
} else {
create_dialog $mytoplevel
}
}
proc ::dialog_path::create_dialog {mytoplevel} {
scrollboxwindow::make $mytoplevel $::sys_searchpath \
dialog_path::add dialog_path::edit dialog_path::commit \
[_ "Pd search path for objects, help, fonts, and other files"] \
400 300
frame $mytoplevel.extraframe
pack $mytoplevel.extraframe -side bottom -pady 2m
checkbutton $mytoplevel.extraframe.extra -text [_ "Use standard extensions"] \
-variable use_standard_extensions_button -anchor w
checkbutton $mytoplevel.extraframe.verbose -text [_ "Verbose"] \
-variable verbose_button -anchor w
pack $mytoplevel.extraframe.extra $mytoplevel.extraframe.verbose \
-side left -expand 1
}
############ pdtk_path_dialog -- dialog window for search path #########
proc ::dialog_path::choosePath { currentpath title } {
if {$currentpath == ""} {
set currentpath "~"
}
return [tk_chooseDirectory -initialdir $currentpath -title $title]
}
proc ::dialog_path::add {} {
return [::dialog_path::choosePath "" {Add a new path}]
}
proc ::dialog_path::edit { currentpath } {
return [::dialog_path::choosePath $currentpath "Edit existing path \[$currentpath\]"]
}
proc ::dialog_path::commit { new_path } {
global use_standard_extensions_button
global verbose_button
set ::sys_searchpath $new_path
pdsend "pd path-dialog $use_standard_extensions_button $verbose_button $::sys_searchpath"
}

96
tcl/dialog_startup.tcl Normal file
View file

@ -0,0 +1,96 @@
package provide dialog_startup 0.1
package require scrollboxwindow
namespace eval dialog_startup {
variable defeatrt_flag 0
namespace export pdtk_startup_dialog
}
########## pdtk_startup_dialog -- dialog window for startup options #########
# Create a simple modal window with an entry widget
# for editing/adding a startup command
# (the next-best-thing to in-place editing)
proc ::dialog_startup::chooseCommand { prompt initialValue } {
global cmd
set cmd $initialValue
toplevel .inputbox
wm title .inputbox $prompt
wm group .inputbox .
wm minsize .inputbox 450 30
wm resizable .inputbox 0 0
wm geom .inputbox "450x30"
# not all Tcl/Tk versions or platforms support -topmost, so catch the error
catch {wm attributes $mytoplevel -topmost 1}
button .inputbox.button -text [_ "OK"] -command { destroy .inputbox } \
-width [::msgcat::mcmax [_ "OK"]]
entry .inputbox.entry -width 50 -textvariable cmd
pack .inputbox.button -side right
bind .inputbox.entry <KeyPress-Return> { destroy .inputbox }
bind .inputbox.entry <KeyPress-Escape> { destroy .inputbox }
pack .inputbox.entry -side right -expand 1 -fill x -padx 2m
focus .inputbox.entry
raise .inputbox
wm transient .inputbox
grab .inputbox
tkwait window .inputbox
return $cmd
}
proc ::dialog_startup::add {} {
return [chooseCommand [_ "Add new library"] ""]
}
proc ::dialog_startup::edit { current_library } {
return [chooseCommand [_ "Edit library"] $current_library]
}
proc ::dialog_startup::commit { new_startup } {
variable defeatrt_button
set ::startup_libraries $new_startup
pdsend "pd startup-dialog $defeatrt_button [pdtk_encodedialog $::startup_flags] $::startup_libraries"
}
# set up the panel with the info from pd
proc ::dialog_startup::pdtk_startup_dialog {mytoplevel defeatrt flags} {
variable defeatrt_button $defeatrt
if {$flags ne ""} {variable ::startup_flags $flags}
if {[winfo exists $mytoplevel]} {
wm deiconify $mytoplevel
raise $mytoplevel
} else {
create_dialog $mytoplevel
}
}
proc ::dialog_startup::create_dialog {mytoplevel} {
::scrollboxwindow::make $mytoplevel $::startup_libraries \
dialog_startup::add dialog_startup::edit dialog_startup::commit \
[_ "Pd libraries to load on startup"] \
400 300
label $mytoplevel.entryname -text [_ "Startup flags:"]
entry $mytoplevel.entry -textvariable ::startup_flags -width 60
pack $mytoplevel.entryname $mytoplevel.entry -side left
pack $mytoplevel.entry -side right -padx 2m -fill x -expand 1
frame $mytoplevel.defeatrtframe
pack $mytoplevel.defeatrtframe -side bottom -fill x -pady 2m
if {$::windowingsystem ne "win32"} {
checkbutton $mytoplevel.defeatrtframe.defeatrt -anchor w \
-text [_ "Defeat real-time scheduling"] \
-variable ::dialog_startup::defeatrt_button
pack $mytoplevel.defeatrtframe.defeatrt -side left
}
}

272
tcl/helpbrowser.tcl Normal file
View file

@ -0,0 +1,272 @@
package provide helpbrowser 0.1
namespace eval ::helpbrowser:: {
variable libdirlist
variable helplist
variable reference_count
variable reference_paths
variable doctypes "*.{pd,pat,mxb,mxt,help,txt,htm,html,pdf}"
namespace export open_helpbrowser
}
# TODO remove the doc_ prefix on procs where its not needed
# TODO rename .help_browser to .helpbrowser
# TODO enter and up/down/left/right arrow key bindings for nav
################## help browser and support functions #########################
proc ::helpbrowser::open_helpbrowser {} {
if { [winfo exists .help_browser.frame] } {
wm deiconify .help_browser
raise .help_browser
} else {
toplevel .help_browser -class HelpBrowser
wm group .help_browser .
wm transient .help_browser
wm title .help_browser [_ "Help Browser"]
bind .help_browser <$::modifier-Key-w> "wm withdraw .help_browser"
if {$::windowingsystem eq "aqua"} {
.help_browser configure -menu $::dialog_menubar
}
wm resizable .help_browser 0 0
frame .help_browser.frame
pack .help_browser.frame -side top -fill both
build_references
make_rootlistbox .help_browser.frame
}
}
# make the root listbox of the help browser using the pre-built lists
proc ::helpbrowser::make_rootlistbox {base} {
variable libdirlist
variable helplist
# exportselection 0 looks good, but selection gets easily out-of-sync
set current_listbox [listbox "[set b $base.root]" -yscrollcommand "$b-scroll set" \
-highlightbackground white -highlightthickness 5 \
-highlightcolor "#D6E5FC" -selectborderwidth 0 \
-height 20 -width 23 -exportselection 0 -bd 0]
pack $current_listbox [scrollbar "$b-scroll" -command [list $current_listbox yview]] \
-side left -fill both -expand 1
foreach item [concat [lsort [concat $libdirlist $helplist]]] {
$current_listbox insert end $item
}
bind $current_listbox <Button-1> \
[list ::helpbrowser::root_navigate %W %x %y]
bind $current_listbox <Key-Return> \
[list ::helpbrowser::root_navigate %W %x %y]
bind $current_listbox <Double-ButtonRelease-1> \
[list ::helpbrowser::root_doubleclick %W %x %y]
bind $current_listbox <$::modifier-Key-o> \
[list ::helpbrowser::root_doubleclick %W %x %y]
}
# navigate into a library/directory from the root
proc ::helpbrowser::root_navigate {window x y} {
variable reference_paths
if {[set item [$window get [$window index "@$x,$y"]]] eq {}} {
return
}
set filename $reference_paths($item)
if {[file isdirectory $filename]} {
make_liblistbox [winfo parent $window] $filename
}
}
# double-click action to open the folder
proc ::helpbrowser::root_doubleclick {window x y} {
variable reference_paths
if {[set listname [$window get [$window index "@$x,$y"]]] eq {}} {
return
}
set dir [file dirname $reference_paths($listname)]
set filename [file tail $reference_paths($listname)]
::pdwindow::verbose 0 "menu_doc_open $dir $filename"
if { [catch {menu_doc_open $dir $filename} fid] } {
::pdwindow::error "Could not open $dir/$filename\n"
}
}
# make the listbox to show the first level contents of a libdir
proc ::helpbrowser::make_liblistbox {base dir} {
variable doctypes
catch { eval destroy [lrange [winfo children $base] 2 end] } errorMessage
# exportselection 0 looks good, but selection gets easily out-of-sync
set current_listbox [listbox "[set b $base.listbox0]" -yscrollcommand "$b-scroll set" \
-highlightbackground white -highlightthickness 5 \
-highlightcolor "#D6E5FC" -selectborderwidth 0 \
-height 20 -width 23 -exportselection 0 -bd 0]
pack $current_listbox [scrollbar "$b-scroll" -command [list $current_listbox yview]] \
-side left -fill both -expand 1
foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {d} -- *]] {
if {[glob -directory $item -nocomplain -types {f} -- $doctypes] ne "" ||
[glob -directory $item -nocomplain -types {d} -- *] ne ""} {
$current_listbox insert end "[file tail $item]/"
}
}
foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- \
*-{help,meta}.pd]] {
$current_listbox insert end [file tail $item]
}
$current_listbox insert end "___________________________"
foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- \
*.txt]] {
$current_listbox insert end [file tail $item]
}
bind $current_listbox <Button-1> \
[list ::helpbrowser::dir_navigate $dir 1 %W %x %y]
bind $current_listbox <Double-ButtonRelease-1> \
[list ::helpbrowser::dir_doubleclick $dir 1 %W %x %y]
bind $current_listbox <Key-Return> \
[list ::helpbrowser::dir_doubleclick $dir 1 %W %x %y]
}
proc ::helpbrowser::doc_make_listbox {base dir count} {
variable doctypes
# check for [file readable]?
# requires Tcl 8.5 but probably deals with special chars better:
# destroy {*}[lrange [winfo children $base] [expr {2 * $count}] end]
if { [catch { eval destroy [lrange [winfo children $base] \
[expr { 2 * $count }] end] } errorMessage] } {
::pdwindow::error "doc_make_listbox: error listing $dir\n"
}
# exportselection 0 looks good, but selection gets easily out-of-sync
set current_listbox [listbox "[set b "$base.listbox$count"]-list" \
-yscrollcommand "$b-scroll set" \
-highlightbackground white -highlightthickness 5 \
-highlightcolor "#D6E5FC" -selectborderwidth 0 \
-height 20 -width 23 -exportselection 0 -bd 0]
pack $current_listbox [scrollbar "$b-scroll" -command "$current_listbox yview"] \
-side left -fill both -expand 1
foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {d} -- *]] {
$current_listbox insert end "[file tail $item]/"
}
foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- \
$doctypes]] {
$current_listbox insert end [file tail $item]
}
bind $current_listbox <Button-1> \
"::helpbrowser::dir_navigate {$dir} $count %W %x %y"
bind $current_listbox <Key-Right> \
"::helpbrowser::dir_navigate {$dir} $count %W %x %y"
bind $current_listbox <Double-ButtonRelease-1> \
"::helpbrowser::dir_doubleclick {$dir} $count %W %x %y"
bind $current_listbox <Key-Return> \
"::helpbrowser::dir_doubleclick {$dir} $count %W %x %y"
}
# navigate into an actual directory
proc ::helpbrowser::dir_navigate {dir count window x y} {
if {[set newdir [$window get [$window index "@$x,$y"]]] eq {}} {
return
}
set dir_to_open [file join $dir $newdir]
if {[file isdirectory $dir_to_open]} {
doc_make_listbox [winfo parent $window] $dir_to_open [incr count]
}
}
proc ::helpbrowser::dir_doubleclick {dir count window x y} {
if {[set filename [$window get [$window index "@$x,$y"]]] eq {}} {
return
}
if { [catch {menu_doc_open $dir $filename} fid] } {
::pdwindow::error "Could not open $dir/$filename\n"
}
}
proc ::helpbrowser::rightclickmenu {dir count window x y} {
if {[set filename [$window get [$window index "@$x,$y"]]] eq {}} {
return
}
if { [catch {menu_doc_open $dir $filename} fid] } {
::pdwindow::error "Could not open $dir/$filename\n"
}
}
#------------------------------------------------------------------------------#
# build help browser trees
# TODO check file timestamp against timestamp of when tree was built
proc ::helpbrowser::findfiles {basedir pattern} {
set basedir [string trimright [file join [file normalize $basedir] { }]]
set filelist {}
# Look in the current directory for matching files, -type {f r}
# means ony readable normal files are looked at, -nocomplain stops
# an error being thrown if the returned list is empty
foreach filename [glob -nocomplain -type {f r} -path $basedir $pattern] {
lappend filelist $filename
}
foreach dirName [glob -nocomplain -type {d r} -path $basedir *] {
set subdirlist [findfiles $dirName $pattern]
if { [llength $subdirlist] > 0 } {
foreach subdirfile $subdirlist {
lappend filelist $subdirfile
}
}
}
return $filelist
}
proc ::helpbrowser::add_entry {reflist entry} {
variable libdirlist
variable helplist
variable reference_paths
variable reference_count
set entryname [file tail $entry]
# if we are checking libdirs, then check to see if there is already a
# libdir with that name that has been discovered in the path. If so, dump
# a warning. The trailing slash on $entryname is added below when
# $entryname is a dir
if {$reflist eq "libdirlist" && [lsearch -exact $libdirlist $entryname/] > -1} {
::pdwindow::error "WARNING: duplicate '$entryname' library found!\n"
::pdwindow::error " '$reference_paths($entryname/)' is active\n"
::pdwindow::error " '$entry' is duplicate\n"
incr reference_count($entryname)
append entryname "/ ($reference_count($entryname))"
} else {
set reference_count($entryname) 1
if {[file isdirectory $entry]} {
append entryname "/"
}
}
lappend $reflist $entryname
set reference_paths($entryname) $entry
}
proc ::helpbrowser::build_references {} {
variable libdirlist {" Pure Data/" "-----------------------"}
variable helplist {}
variable reference_count
variable reference_paths
array set reference_count {}
array set reference_paths [list \
" Pure Data/" $::sys_libdir/doc \
"-----------------------" "" \
]
foreach pathdir [concat $::sys_searchpath $::sys_staticpath] {
if { ! [file isdirectory $pathdir]} {continue}
# Fix the directory name, this ensures the directory name is in the
# native format for the platform and contains a final directory seperator
set dir [string trimright [file join [file normalize $pathdir] { }]]
## find the libdirs
foreach filename [glob -nocomplain -type d -path $dir "*"] {
add_entry libdirlist $filename
}
## find the stray help patches
foreach filename [glob -nocomplain -type f -path $dir "*-help.pd"] {
add_entry helplist $filename
}
}
}

86
tcl/opt_parser.tcl Normal file
View file

@ -0,0 +1,86 @@
package provide opt_parser 0.1
namespace eval opt_parser {
# list of option vars (keys are long option names)
variable optlist
# option behavior <set|lappend>
variable optbehavior
variable optprefix {-}
}
proc opt_parser::init {optdata} {
variable optlist
variable optbehavior
array unset optlist ; array set optlist {}
array unset optbehavior ; array set optbehavior {}
foreach item $optdata {
foreach {optName behavior varlist} $item {
if {[llength $varlist] < 1 || [lsearch -exact {set lappend} $behavior] == -1} {
return -code error "usage: init { {optname <set|lappend> {var1 var2 ...}} ... }"
}
set optlist($optName) $varlist
set optbehavior($optName) $behavior
}
}
}
proc opt_parser::get_options {argv {opts {}}} {
# second argument are internal options
# (like 'ignore_unknown_flags <0|1>')
foreach {k v} $opts {set $k $v}
set ignore_unknown_flags 0
variable optlist
variable optbehavior
variable optprefix
# zero all the options 1st var
foreach optName [array names optlist] {
uplevel [list set [lindex $optlist($optName) 0] 0]
if {$optbehavior($optName) == {lappend}} {
for {set i 1} {$i < [llength $optlist($optName)]} {incr i} {
uplevel [list set [lindex $optlist($optName) $i] [list]]
}
}
}
# here will be appended non-options arguments
set residualArgs {}
set argc [llength $argv]
for {set i 0} {$i < $argc} {} {
# get i-th arg
set optName [lindex $argv $i]
incr i
# if it's not an option, stop here, and add to residualArgs
if {![regexp ^$optprefix $optName]} {
lappend residualArgs $optName
continue
}
if {[info exists optlist($optName)]} {
set varlist $optlist($optName)
uplevel [list set [lindex $optlist($optName) 0] 1]
set n_required_opt_args [expr {-1+[llength $varlist]}]
set j 1
while {$n_required_opt_args > 0} {
incr n_required_opt_args -1
if {$i >= $argc} {
return -code error "not enough arguments for option $optName"
}
uplevel [list $optbehavior($optName) [lindex $varlist $j] [lindex $argv $i]]
incr j
incr i
}
} else {
if {$ignore_unknown_flags} {
lappend residualArgs $argv_i
continue
} else {
return -code error "unknown option: $optName"
}
}
}
return $residualArgs
}

732
tcl/pd-gui.tcl Executable file
View file

@ -0,0 +1,732 @@
#!/bin/sh
# This line continues for Tcl, but is a single line for 'sh' \
exec wish "$0" -- ${1+"$@"}
# For information on usage and redistribution, and for a DISCLAIMER OF ALL
# WARRANTIES, see the file, "LICENSE.txt," in this distribution.
# Copyright (c) 1997-2009 Miller Puckette.
# "." automatically gets a window, we don't want it. Withdraw it before doing
# anything else, so that we don't get the automatic window flashing for a
# second while pd loads.
if { [catch {wm withdraw .} fid] } { exit 2 }
package require Tcl 8.3
package require Tk
#package require tile
## replace Tk widgets with Ttk widgets on 8.5
#namespace import -force ttk::*
package require msgcat
# TODO create a constructor in each package to create things at startup, that
# way they can be easily be modified by startup scripts
# TODO create alt-Enter/Cmd-I binding to bring up Properties panels
# Pd's packages are stored in the same directory as the main script (pd-gui.tcl)
set auto_path [linsert $auto_path 0 [file dirname [info script]]]
package require pd_connect
package require pd_menus
package require pd_bindings
package require pdwindow
package require dialog_array
package require dialog_audio
package require dialog_canvas
package require dialog_data
package require dialog_font
package require dialog_gatom
package require dialog_iemgui
package require dialog_message
package require dialog_midi
package require dialog_path
package require dialog_startup
package require helpbrowser
package require pd_menucommands
package require opt_parser
package require pdtk_canvas
package require pdtk_text
package require pdtk_textwindow
# TODO eliminate this kludge:
package require wheredoesthisgo
package require pd_guiprefs
#------------------------------------------------------------------------------#
# import functions into the global namespace
# gui preferences
namespace import ::pd_guiprefs::init
namespace import ::pd_guiprefs::update_recentfiles
namespace import ::pd_guiprefs::write_recentfiles
# make global since they are used throughout
namespace import ::pd_menucommands::*
# import into the global namespace for backwards compatibility
namespace import ::pd_connect::pdsend
namespace import ::pdwindow::pdtk_post
namespace import ::pdwindow::pdtk_pd_dio
namespace import ::pdwindow::pdtk_pd_dsp
namespace import ::pdwindow::pdtk_pd_meters
namespace import ::pdtk_canvas::pdtk_canvas_popup
namespace import ::pdtk_canvas::pdtk_canvas_editmode
namespace import ::pdtk_canvas::pdtk_canvas_getscroll
namespace import ::pdtk_canvas::pdtk_canvas_setparents
namespace import ::pdtk_canvas::pdtk_canvas_reflecttitle
namespace import ::pdtk_canvas::pdtk_canvas_menuclose
namespace import ::dialog_array::pdtk_array_dialog
namespace import ::dialog_audio::pdtk_audio_dialog
namespace import ::dialog_canvas::pdtk_canvas_dialog
namespace import ::dialog_data::pdtk_data_dialog
namespace import ::dialog_find::pdtk_couldnotfind
namespace import ::dialog_font::pdtk_canvas_dofont
namespace import ::dialog_gatom::pdtk_gatom_dialog
namespace import ::dialog_iemgui::pdtk_iemgui_dialog
namespace import ::dialog_midi::pdtk_midi_dialog
namespace import ::dialog_midi::pdtk_alsa_midi_dialog
namespace import ::dialog_path::pdtk_path_dialog
namespace import ::dialog_startup::pdtk_startup_dialog
# hack - these should be better handled in the C code
namespace import ::dialog_array::pdtk_array_listview_new
namespace import ::dialog_array::pdtk_array_listview_fillpage
namespace import ::dialog_array::pdtk_array_listview_setpage
namespace import ::dialog_array::pdtk_array_listview_closeWindow
#------------------------------------------------------------------------------#
# global variables
# this is a wide array of global variables that are used throughout the GUI.
# they can be used in plugins to check the status of various things since they
# should all have been properly initialized by the time startup plugins are
# loaded.
set PD_MAJOR_VERSION 0
set PD_MINOR_VERSION 0
set PD_BUGFIX_VERSION 0
set PD_TEST_VERSION ""
set done_init 0
set TCL_MAJOR_VERSION 0
set TCL_MINOR_VERSION 0
set TCL_BUGFIX_VERSION 0
# for testing which platform we are running on ("aqua", "win32", or "x11")
set windowingsystem ""
# args about how much and where to log
set loglevel 2
set stderr 0
# connection between 'pd' and 'pd-gui'
set host ""
set port 0
# canvas font, received from pd in pdtk_pd_startup, set in s_main.c
set font_family "courier"
set font_weight "normal"
# sizes of chars for each of the Pd fixed font sizes:
# fontsize width(pixels) height(pixels)
set font_fixed_metrics {
8 6 11
9 6 12
10 7 13
12 9 16
14 8 17
16 10 20
18 11 22
24 15 25
30 18 37
36 25 45
}
set font_measured_metrics {}
# root path to lib of Pd's files, see s_main.c for more info
set sys_libdir {}
# root path where the pd-gui.tcl GUI script is located
set sys_guidir {}
# user-specified search path for objects, help, fonts, etc.
set sys_searchpath {}
# hard-coded search patch for objects, help, plugins, etc.
set sys_staticpath {}
# the path to the folder where the current plugin is being loaded from
set current_plugin_loadpath {}
# a list of plugins that were loaded
set loaded_plugins {}
# list of command line flags set at startup
set startup_flags {}
# list of libraries loaded on startup
set startup_libraries {}
# start dirs for new files and open panels
set filenewdir [pwd]
set fileopendir [pwd]
# lists of audio/midi devices and APIs for prefs dialogs
set audio_apilist {}
set audio_indevlist {}
set audio_outdevlist {}
set midi_apilist {}
set midi_indevlist {}
set midi_outdevlist {}
set pd_whichapi 0
set pd_whichmidiapi 0
# current state of the DSP
set dsp 0
# state of the peak meters in the Pd window
set meters 0
# the toplevel window that currently is on top and has focus
set focused_window .
# store that last 5 files that were opened
set recentfiles_list {}
set total_recentfiles 5
# keep track of the location of popup menu for PatchWindows, in canvas coords
set popup_xcanvas 0
set popup_ycanvas 0
# modifier for key commands (Ctrl/Control on most platforms, Cmd/Mod1 on MacOSX)
set modifier ""
# current state of the Edit Mode menu item
set editmode_button 0
## per toplevel/patch data
# window location modifiers
set menubarsize 0 ;# Mac OS X and other platforms have a menubar on top
set windowframex 0 ;# different platforms have different window frames
set windowframey 0 ;# different platforms have different window frames
# patch properties
array set editmode {} ;# store editmode for each open patch canvas
array set editingtext {};# if an obj, msg, or comment is being edited, per patch
array set loaded {} ;# store whether a patch has completed loading
array set xscrollable {};# keep track of whether the scrollbars are present
array set yscrollable {}
# patch window tree, these might contain patch IDs without a mapped toplevel
array set windowname {} ;# window names based on mytoplevel IDs
array set childwindows {} ;# all child windows based on mytoplevel IDs
array set parentwindows {} ;# topmost parent window ID based on mytoplevel IDs
# variables for holding the menubar to allow for configuration by plugins
set ::pdwindow_menubar ".menubar"
set ::patch_menubar ".menubar"
set ::dialog_menubar ""
# minimum size of the canvas window of a patch
set canvas_minwidth 50
set canvas_minheight 20
# undo states
set ::undo_action "no"
set ::redo_action "no"
set ::undo_toplevel "."
namespace eval ::pdgui:: {
variable scriptname [ file normalize [ info script ] ]
}
#------------------------------------------------------------------------------#
# coding style
#
# these are preliminary ideas, we'll change them as we work things out:
# - when possible use "" doublequotes to delimit messages
# - use '$::myvar' instead of 'global myvar'
# - for the sake of clarity, there should not be any inline code, everything
# should be in a proc that is ultimately triggered from main()
# - if a menu_* proc opens a dialog panel, that proc is called menu_*_dialog
# - use "eq/ne" for string comparison, NOT "==/!=" (http://wiki.tcl.tk/15323)
#
#
## Names for Common Variables
#----------------------------
# variables named after the Tk widgets they represent
# $window = any kind of Tk widget that can be a Tk 'window'
# $mytoplevel = a window id made by a 'toplevel' command
# $gfxstub = a 'toplevel' window id for dialogs made in gfxstub/x_gui.c
# $menubar = the 'menu' attached to each 'toplevel'
# $mymenu = 'menu' attached to the menubar, like the File menu
# $tkcanvas = a Tk 'canvas', which is the root of each patch
#
#
## Dialog Panel Types
#----------------------------
# global (only one): find, sendmessage, prefs, helpbrowser
# per-canvas: font, canvas properties (created with a message from pd)
# per object: gatom, iemgui, array, data structures (created with a message from pd)
#
#
## Prefix Names for procs
#----------------------------
# pdtk_ pd -> pd-gui API (i.e. called from 'pd')
# pdsend pd-gui -> pd API (sends a message to 'pd' using pdsend)
# ------------------------------------------------------------------------------
# init functions
# root paths to find Pd's files where they are installed
proc set_pd_paths {} {
set ::sys_guidir [file normalize [file dirname [info script]]]
set ::sys_libdir [file normalize [file join $::sys_guidir ".."]]
}
proc init_for_platform {} {
# we are not using Tk scaling, so fix it to 1 on all platforms. This
# guarantees that patches will be pixel-exact on every platform
tk scaling 1
switch -- $::windowingsystem {
"x11" {
set ::modifier "Control"
option add *PatchWindow*Canvas.background "white" startupFile
# add control to show/hide hidden files in the open panel (load
# the tk_getOpenFile dialog once, otherwise it will not work)
catch {tk_getOpenFile -with-invalid-argument}
set ::tk::dialog::file::showHiddenBtn 1
set ::tk::dialog::file::showHiddenVar 0
# set file types that open/save recognize
set ::filetypes \
[list \
[list [_ "Associated Files"] {.pd .pat .mxt} ] \
[list [_ "Pd Files"] {.pd} ] \
[list [_ "Max Patch Files"] {.pat} ] \
[list [_ "Max Text Files"] {.mxt} ] \
]
# some platforms have a menubar on the top, so place below them
set ::menubarsize 0
# Tk handles the window placement differently on each
# platform. With X11, the x,y placement refers to the window
# frame's upper left corner. http://wiki.tcl.tk/11502
set ::windowframex 3
set ::windowframey 53
# TODO add wm iconphoto/iconbitmap here if it makes sense
# mouse cursors for all the different modes
set ::cursor_runmode_nothing "left_ptr"
set ::cursor_runmode_clickme "arrow"
set ::cursor_runmode_thicken "sb_v_double_arrow"
set ::cursor_runmode_addpoint "plus"
set ::cursor_editmode_nothing "hand2"
set ::cursor_editmode_connect "circle"
set ::cursor_editmode_disconnect "X_cursor"
}
"aqua" {
set ::modifier "Mod1"
option add *DialogWindow*background "#E8E8E8" startupFile
option add *DialogWindow*Entry.highlightBackground "#E8E8E8" startupFile
option add *DialogWindow*Button.highlightBackground "#E8E8E8" startupFile
option add *DialogWindow*Entry.background "white" startupFile
# Mac OS X needs a menubar all the time
set ::dialog_menubar ".menubar"
# set file types that open/save recognize
set ::filetypes \
[list \
[list [_ "Associated Files"] {.pd .pat .mxt} ] \
[list [_ "Pd Files"] {.pd} ] \
[list [_ "Max Patch Files (.pat)"] {.pat} ] \
[list [_ "Max Text Files (.mxt)"] {.mxt} ] \
]
# some platforms have a menubar on the top, so place below them
set ::menubarsize 22
# Tk handles the window placement differently on each platform, on
# Mac OS X, the x,y placement refers to the content window's upper
# left corner (not of the window frame) http://wiki.tcl.tk/11502
set ::windowframex 0
set ::windowframey 0
# mouse cursors for all the different modes
set ::cursor_runmode_nothing "arrow"
set ::cursor_runmode_clickme "center_ptr"
set ::cursor_runmode_thicken "sb_v_double_arrow"
set ::cursor_runmode_addpoint "plus"
set ::cursor_editmode_nothing "hand2"
set ::cursor_editmode_connect "circle"
set ::cursor_editmode_disconnect "X_cursor"
}
"win32" {
set ::modifier "Control"
option add *PatchWindow*Canvas.background "white" startupFile
# fix menu font size on Windows with tk scaling = 1
font create menufont -family Tahoma -size -11
option add *Menu.font menufont startupFile
option add *HelpBrowser*font menufont startupFile
option add *DialogWindow*font menufont startupFile
option add *PdWindow*font menufont startupFile
option add *ErrorDialog*font menufont startupFile
# set file types that open/save recognize
set ::filetypes \
[list \
[list [_ "Associated Files"] {.pd .pat .mxt} ] \
[list [_ "Pd Files"] {.pd} ] \
[list [_ "Max Patch Files"] {.pat} ] \
[list [_ "Max Text Files"] {.mxt} ] \
]
# some platforms have a menubar on the top, so place below them
set ::menubarsize 0
# Tk handles the window placement differently on each platform, on
# Mac OS X, the x,y placement refers to the content window's upper
# left corner. http://wiki.tcl.tk/11502
# TODO this probably needs a script layer: http://wiki.tcl.tk/11291
set ::windowframex 0
set ::windowframey 0
# TODO use 'winico' package for full, hicolor icon support
wm iconbitmap . -default [file join $::sys_guidir pd.ico]
# mouse cursors for all the different modes
set ::cursor_runmode_nothing "right_ptr"
set ::cursor_runmode_clickme "arrow"
set ::cursor_runmode_thicken "sb_v_double_arrow"
set ::cursor_runmode_addpoint "plus"
set ::cursor_editmode_nothing "hand2"
set ::cursor_editmode_connect "circle"
set ::cursor_editmode_disconnect "X_cursor"
}
}
}
# ------------------------------------------------------------------------------
# locale handling
# official GNU gettext msgcat shortcut
proc _ {s} {return [::msgcat::mc $s]}
proc load_locale {} {
# on any UNIX-like environment, Tcl should automatically use LANG, LC_ALL,
# etc. otherwise we need to dig it up. Mac OS X only uses LANG, etc. from
# the Terminal, and Windows doesn't have LANG, etc unless you manually set
# it up yourself. Windows apps don't use the locale env vars usually.
if {$::tcl_platform(os) eq "Darwin" && ! [info exists ::env(LANG)]} {
# http://thread.gmane.org/gmane.comp.lang.tcl.mac/5215
# http://thread.gmane.org/gmane.comp.lang.tcl.mac/6433
if {![catch "exec defaults read com.apple.dock loc" lang]} {
::msgcat::mclocale $lang
} elseif {![catch "exec defaults read NSGlobalDomain AppleLocale" lang]} {
::msgcat::mclocale $lang
}
} elseif {$::tcl_platform(platform) eq "windows"} {
# using LANG on Windows is useful for easy debugging
if {[info exists ::env(LANG)] && $::env(LANG) ne "C" && $::env(LANG) ne ""} {
::msgcat::mclocale $::env(LANG)
} elseif {![catch {package require registry}]} {
::msgcat::mclocale [string tolower \
[string range \
[registry get {HKEY_CURRENT_USER\Control Panel\International} sLanguage] 0 1] ]
}
}
::msgcat::mcload [file join [file dirname [info script]] .. po]
##--moo: force default system and stdio encoding to UTF-8
encoding system utf-8
fconfigure stderr -encoding utf-8
fconfigure stdout -encoding utf-8
##--/moo
}
# ------------------------------------------------------------------------------
# font handling
# this proc gets the internal font name associated with each size
proc get_font_for_size {size} {
return "::pd_font_${size}"
}
# searches for a font to use as the default. Tk automatically assigns a
# monospace font to the name "Courier" (see Tk 'font' docs), but it doesn't
# always do a good job of choosing in respect to Pd's needs. So this chooses
# from a list of fonts that are known to work well with Pd.
proc find_default_font {} {
set testfonts {"DejaVu Sans Mono" "Bitstream Vera Sans Mono" \
"Inconsolata" "Courier 10 Pitch" "Andale Mono" "Droid Sans Mono"}
foreach family $testfonts {
if {[lsearch -exact -nocase [font families] $family] > -1} {
set ::font_family $family
break
}
}
::pdwindow::verbose 0 "Default font: $::font_family\n"
}
proc set_base_font {family weight} {
if {[lsearch -exact [font families] $family] > -1} {
set ::font_family $family
} else {
::pdwindow::post [format \
[_ "WARNING: Font family '%s' not found, using default (%s)\n"] \
$family $::font_family]
}
if {[lsearch -exact {bold normal} $weight] > -1} {
set ::font_weight $weight
set using_defaults 0
} else {
::pdwindow::post [format \
[_ "WARNING: Font weight '%s' not found, using default (%s)\n"] \
$weight $::font_weight]
}
}
# creates all the base fonts (i.e. pd_font_8 thru pd_font_36) so that they fit
# into the metrics given by $::font_fixed_metrics for any given font/weight
proc fit_font_into_metrics {} {
# TODO the fonts picked seem too small, probably on fixed width
foreach {size width height} $::font_fixed_metrics {
set myfont [get_font_for_size $size]
font create $myfont -family $::font_family -weight $::font_weight \
-size [expr {-$height}]
set height2 $height
set giveup 0
while {[font measure $myfont M] > $width || \
[font metrics $myfont -linespace] > $height} {
incr height2 -1
font configure $myfont -size [expr {-$height2}]
if {$height2 * 2 <= $height} {
set giveup 1
set ::font_measured_metrics $::font_fixed_metrics
break
}
}
set ::font_measured_metrics \
"$::font_measured_metrics $size\
[font measure $myfont M] [font metrics $myfont -linespace]"
if {$giveup} {
::pdwindow::post [format \
[_ "WARNING: %s failed to find font size (%s) that fits into %sx%s!\n"]\
[lindex [info level 0] 0] $size $width $height]
continue
}
}
}
# ------------------------------------------------------------------------------
# procs called directly by pd
proc pdtk_pd_startup {major minor bugfix test
audio_apis midi_apis sys_font sys_fontweight} {
set ::PD_MAJOR_VERSION $major
set ::PD_MINOR_VERSION $minor
set ::PD_BUGFIX_VERSION $bugfix
set ::PD_TEST_VERSION $test
set oldtclversion 0
set ::audio_apilist $audio_apis
set ::midi_apilist $midi_apis
if {$::tcl_version >= 8.5} {find_default_font}
set_base_font $sys_font $sys_fontweight
fit_font_into_metrics
::pd_guiprefs::init
pdsend "pd init [enquote_path [pwd]] $oldtclversion $::font_measured_metrics"
::pd_bindings::class_bindings
::pd_bindings::global_bindings
::pd_menus::create_menubar
::pdtk_canvas::create_popup
::pdwindow::create_window
::pd_menus::configure_for_pdwindow
load_startup_plugins
open_filestoopen
set ::done_init 1
}
##### routine to ask user if OK and, if so, send a message on to Pd ######
proc pdtk_check {mytoplevel message reply_to_pd default} {
wm deiconify $mytoplevel
raise $mytoplevel
if {$::windowingsystem eq "win32"} {
set answer [tk_messageBox -message [_ $message] -type yesno -default $default \
-icon question -title [wm title $mytoplevel]]
} else {
set answer [tk_messageBox -message [_ $message] -type yesno \
-default $default -parent $mytoplevel -icon question]
}
if {$answer eq "yes"} {
pdsend $reply_to_pd
}
}
# ------------------------------------------------------------------------------
# parse command line args when Wish/pd-gui.tcl is started first
proc parse_args {argc argv} {
opt_parser::init {
{-stderr set {::stderr}}
{-open lappend {- ::filestoopen_list}}
}
set unflagged_files [opt_parser::get_options $argv]
# if we have a single arg that is not a file, its a port or host:port combo
if {$argc == 1 && ! [file exists $argv]} {
if { [string is int $argv] && $argv > 0} {
# 'pd-gui' got the port number from 'pd'
set ::host "localhost"
set ::port $argv
} else {
set hostport [split $argv ":"]
set ::port [lindex $hostport 1]
if { [string is int $::port] && $::port > 0} {
set ::host [lindex $hostport 0]
} else {
set ::port 0
}
}
} elseif {$unflagged_files ne ""} {
foreach filename $unflagged_files {
lappend ::filestoopen_list $filename
}
}
}
proc open_filestoopen {} {
foreach filename $::filestoopen_list {
open_file $filename
}
}
# ------------------------------------------------------------------------------
# X11 procs for handling singleton state and getting args from other instances
# first instance
proc singleton {key} {
if {![catch { selection get -selection $key }]} {
return 0
}
selection handle -selection $key . "singleton_request"
selection own -command first_lost -selection $key .
return 1
}
proc singleton_request {offset maxbytes} {
## the next 2 lines raise the focus to the given window (and change desktop)
# wm deiconify .pdwindow
# raise .pdwindow
return [tk appname]
}
proc first_lost {} {
receive_args [selection get -selection ${::pdgui::scriptname} ]
selection own -command first_lost -selection ${::pdgui::scriptname} .
}
proc others_lost {} {
set ::singleton_state "exit"
destroy .
exit
}
# all other instances
proc send_args {offset maxChars} {
set sendargs {}
foreach filename $::filestoopen_list {
lappend sendargs [file normalize $filename]
}
return [string range $sendargs $offset [expr {$offset+$maxChars}]]
}
# this command will open files received from a 2nd instance of Pd
proc receive_args {filelist} {
raise .
wm deiconify .pdwindow
raise .pdwindow
foreach filename $filelist {
open_file $filename
}
}
proc dde_open_handler {cmd} {
open_file [file normalize $cmd]
}
proc check_for_running_instances { } {
switch -- $::windowingsystem {
"aqua" {
# handled by ::tk::mac::OpenDocument in apple_events.tcl
} "x11" {
# http://wiki.tcl.tk/1558
# TODO replace PUREDATA name with path so this code is a singleton
# based on install location rather than this hard-coded name
if {![singleton ${::pdgui::scriptname}_MANAGER ]} {
# if pd-gui gets called from pd ('pd-gui 5400') or is told otherwise
# to connect to a running instance of Pd (by providing [<host>:]<port>)
# then we don't want to connect to a running instance
if { $::port > 0 && $::host ne "" } { return }
selection handle -selection ${::pdgui::scriptname} . "send_args"
selection own -command others_lost -selection ${::pdgui::scriptname} .
after 5000 set ::singleton_state "timeout"
vwait ::singleton_state
exit
} else {
# first instance
selection own -command first_lost -selection ${::pdgui::scriptname} .
}
} "win32" {
## http://wiki.tcl.tk/8940
package require dde ;# 1.4 or later needed for full unicode support
set topic "Pure_Data_DDE_Open"
# if no DDE service is running, start one and claim the name
if { [dde services TclEval $topic] == {} } {
dde servername -handler dde_open_handler $topic
}
}
}
}
# ------------------------------------------------------------------------------
# load plugins on startup
proc load_plugin_script {filename} {
global errorInfo
set basename [file tail $filename]
if {[lsearch $::loaded_plugins $basename] > -1} {
::pdwindow::post [_ "'$basename' already loaded, ignoring: '$filename'\n"]
return
}
::pdwindow::debug [_ "Loading plugin: $filename\n"]
set tclfile [open $filename]
set tclcode [read $tclfile]
close $tclfile
if {[catch {uplevel #0 $tclcode} errorname]} {
::pdwindow::error "-----------\n"
::pdwindow::error [_ "UNHANDLED ERROR: $errorInfo\n"]
::pdwindow::error [_ "FAILED TO LOAD $filename\n"]
::pdwindow::error "-----------\n"
} else {
lappend ::loaded_plugins $basename
}
}
proc load_startup_plugins {} {
foreach pathdir [concat $::sys_searchpath $::sys_staticpath] {
set dir [file normalize $pathdir]
if { ! [file isdirectory $dir]} {continue}
foreach filename [glob -directory $dir -nocomplain -types {f} -- \
*-plugin/*-plugin.tcl *-plugin.tcl] {
set ::current_plugin_loadpath [file dirname $filename]
load_plugin_script $filename
}
}
}
# ------------------------------------------------------------------------------
# main
proc main {argc argv} {
# TODO Tcl/Tk 8.3 doesn't have [tk windowingsystem]
set ::windowingsystem [tk windowingsystem]
tk appname pd-gui
load_locale
parse_args $argc $argv
check_for_running_instances
set_pd_paths
init_for_platform
# ::host and ::port are parsed from argv by parse_args
if { $::port > 0 && $::host ne "" } {
# 'pd' started first and launched us, so get the port to connect to
::pd_connect::to_pd $::port $::host
} else {
# the GUI is starting first, so create socket and exec 'pd'
set ::port [::pd_connect::create_socket]
set pd_exec [file join [file dirname [info script]] ../bin/pd]
exec -- $pd_exec -guiport $::port &
if {$::windowingsystem eq "aqua"} {
# on Aqua, if 'pd-gui' first, then initial dir is home
set ::filenewdir $::env(HOME)
set ::fileopendir $::env(HOME)
}
}
::pdwindow::verbose 0 "------------------ done with main ----------------------\n"
}
main $::argc $::argv

BIN
tcl/pd.ico Executable file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 25 KiB

270
tcl/pd_bindings.tcl Normal file
View file

@ -0,0 +1,270 @@
package provide pd_bindings 0.1
package require pd_menucommands
package require dialog_find
namespace eval ::pd_bindings:: {
namespace export global_bindings
namespace export dialog_bindings
namespace export patch_bindings
}
# TODO rename pd_bindings to window_bindings after merge is done
# Some commands are bound using "" quotations so that the $mytoplevel is
# interpreted immediately. Since the command is being bound to $mytoplevel,
# it makes sense to have value of $mytoplevel already in the command. This is
# the opposite of most menu/bind commands here and in pd_menus.tcl, which use
# {} to force execution of any variables (i.e. $::focused_window) until later
# binding by class is not recursive, so its useful for window events
proc ::pd_bindings::class_bindings {} {
# and the Pd window is in a class to itself
bind PdWindow <FocusIn> "::pd_bindings::window_focusin %W"
# bind to all the windows dedicated to patch canvases
bind PatchWindow <FocusIn> "::pd_bindings::window_focusin %W"
bind PatchWindow <Map> "::pd_bindings::map %W"
bind PatchWindow <Unmap> "::pd_bindings::unmap %W"
bind PatchWindow <Configure> "::pd_bindings::patch_configure %W %w %h %x %y"
# dialog panel windows bindings, which behave differently than PatchWindows
bind DialogWindow <Configure> "::pd_bindings::dialog_configure %W"
bind DialogWindow <FocusIn> "::pd_bindings::dialog_focusin %W"
}
proc ::pd_bindings::global_bindings {} {
# we use 'bind all' everywhere to get as much of Tk's automatic binding
# behaviors as possible, things like not sending an event for 'O' when
# 'Control-O' is pressed.
bind all <$::modifier-Key-a> {menu_send %W selectall}
bind all <$::modifier-Key-b> {menu_helpbrowser}
bind all <$::modifier-Key-c> {menu_send %W copy}
bind all <$::modifier-Key-d> {menu_send %W duplicate}
bind all <$::modifier-Key-e> {menu_toggle_editmode}
bind all <$::modifier-Key-f> {menu_find_dialog}
bind all <$::modifier-Key-g> {menu_send %W findagain}
bind all <$::modifier-Key-n> {menu_new}
bind all <$::modifier-Key-o> {menu_open}
bind all <$::modifier-Key-p> {menu_print $::focused_window}
bind all <$::modifier-Key-q> {pdsend "pd verifyquit"}
bind all <$::modifier-Key-r> {menu_raise_pdwindow}
bind all <$::modifier-Key-s> {menu_send %W menusave}
bind all <$::modifier-Key-v> {menu_send %W paste}
bind all <$::modifier-Key-w> {menu_send_float %W menuclose 0}
bind all <$::modifier-Key-x> {menu_send %W cut}
bind all <$::modifier-Key-z> {menu_undo}
bind all <$::modifier-Key-1> {menu_send_float %W obj 0}
bind all <$::modifier-Key-2> {menu_send_float %W msg 0}
bind all <$::modifier-Key-3> {menu_send_float %W floatatom 0}
bind all <$::modifier-Key-4> {menu_send_float %W symbolatom 0}
bind all <$::modifier-Key-5> {menu_send_float %W text 0}
bind all <$::modifier-Key-slash> {pdsend "pd dsp 1"}
bind all <$::modifier-Key-period> {pdsend "pd dsp 0"}
bind all <$::modifier-greater> {menu_raisenextwindow}
bind all <$::modifier-less> {menu_raisepreviouswindow}
# annoying, but Tk's bind needs uppercase letter to get the Shift
bind all <$::modifier-Shift-Key-B> {menu_send %W bng}
bind all <$::modifier-Shift-Key-C> {menu_send %W mycnv}
bind all <$::modifier-Shift-Key-D> {menu_send %W vradio}
bind all <$::modifier-Shift-Key-H> {menu_send %W hslider}
bind all <$::modifier-Shift-Key-I> {menu_send %W hradio}
bind all <$::modifier-Shift-Key-L> {menu_clear_console}
bind all <$::modifier-Shift-Key-N> {menu_send %W numbox}
bind all <$::modifier-Shift-Key-Q> {pdsend "pd quit"}
bind all <$::modifier-Shift-Key-S> {menu_send %W menusaveas}
bind all <$::modifier-Shift-Key-T> {menu_send %W toggle}
bind all <$::modifier-Shift-Key-U> {menu_send %W vumeter}
bind all <$::modifier-Shift-Key-V> {menu_send %W vslider}
bind all <$::modifier-Shift-Key-W> {menu_send_float %W menuclose 1}
bind all <$::modifier-Shift-Key-Z> {menu_redo}
# OS-specific bindings
if {$::windowingsystem eq "aqua"} {
# Cmd-m = Minimize and Cmd-t = Font on Mac OS X for all apps
bind all <$::modifier-Key-m> {menu_minimize %W}
bind all <$::modifier-Key-t> {menu_font_dialog}
bind all <$::modifier-quoteleft> {menu_raisenextwindow}
bind all <$::modifier-Shift-Key-M> {menu_message_dialog}
} else {
bind all <$::modifier-Key-m> {menu_message_dialog}
#bind all <$::modifier-Key-t> {menu_texteditor}
bind all <$::modifier-Next> {menu_raisenextwindow} ;# PgUp
bind all <$::modifier-Prior> {menu_raisepreviouswindow};# PageDown
}
bind all <KeyPress> {::pd_bindings::sendkey %W 1 %K %A 0}
bind all <KeyRelease> {::pd_bindings::sendkey %W 0 %K %A 0}
bind all <Shift-KeyPress> {::pd_bindings::sendkey %W 1 %K %A 1}
bind all <Shift-KeyRelease> {::pd_bindings::sendkey %W 0 %K %A 1}
}
# this is for the dialogs: find, font, sendmessage, gatom properties, array
# properties, iemgui properties, canvas properties, data structures
# properties, Audio setup, and MIDI setup
proc ::pd_bindings::dialog_bindings {mytoplevel dialogname} {
variable modifier
bind $mytoplevel <KeyPress-Escape> "dialog_${dialogname}::cancel $mytoplevel"
bind $mytoplevel <KeyPress-Return> "dialog_${dialogname}::ok $mytoplevel"
bind $mytoplevel <$::modifier-Key-w> "dialog_${dialogname}::cancel $mytoplevel"
# these aren't supported in the dialog, so alert the user, then break so
# that no other key bindings are run
bind $mytoplevel <$::modifier-Key-s> {bell; break}
bind $mytoplevel <$::modifier-Shift-Key-S> {bell; break}
bind $mytoplevel <$::modifier-Key-p> {bell; break}
wm protocol $mytoplevel WM_DELETE_WINDOW "dialog_${dialogname}::cancel $mytoplevel"
}
proc ::pd_bindings::patch_bindings {mytoplevel} {
variable modifier
set tkcanvas [tkcanvas_name $mytoplevel]
# TODO move mouse bindings to global and bind to 'all'
# mouse bindings -----------------------------------------------------------
# these need to be bound to $tkcanvas because %W will return $mytoplevel for
# events over the window frame and $tkcanvas for events over the canvas
bind $tkcanvas <Motion> "pdtk_canvas_motion %W %x %y 0"
bind $tkcanvas <$::modifier-Motion> "pdtk_canvas_motion %W %x %y 2"
bind $tkcanvas <ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 0"
bind $tkcanvas <ButtonRelease-1> "pdtk_canvas_mouseup %W %x %y %b"
bind $tkcanvas <$::modifier-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 2"
bind $tkcanvas <Shift-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 1"
if {$::windowingsystem eq "x11"} {
# from http://wiki.tcl.tk/3893
bind all <Button-4> \
{event generate [focus -displayof %W] <MouseWheel> -delta 1}
bind all <Button-5> \
{event generate [focus -displayof %W] <MouseWheel> -delta -1}
bind all <Shift-Button-4> \
{event generate [focus -displayof %W] <Shift-MouseWheel> -delta 1}
bind all <Shift-Button-5> \
{event generate [focus -displayof %W] <Shift-MouseWheel> -delta -1}
}
bind $tkcanvas <MouseWheel> {::pdtk_canvas::scroll %W y %D}
bind $tkcanvas <Shift-MouseWheel> {::pdtk_canvas::scroll %W x %D}
# "right clicks" are defined differently on each platform
switch -- $::windowingsystem {
"aqua" {
bind $tkcanvas <ButtonPress-2> "pdtk_canvas_rightclick %W %x %y %b"
# on Mac OS X, make a rightclick with Ctrl-click for 1 button mice
bind $tkcanvas <Control-Button-1> "pdtk_canvas_rightclick %W %x %y %b"
bind $tkcanvas <Option-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 3"
} "x11" {
bind $tkcanvas <ButtonPress-3> "pdtk_canvas_rightclick %W %x %y %b"
# on X11, button 2 "pastes" from the X windows clipboard
bind $tkcanvas <ButtonPress-2> "pdtk_canvas_clickpaste %W %x %y %b"
bind $tkcanvas <Alt-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 3"
} "win32" {
bind $tkcanvas <ButtonPress-3> "pdtk_canvas_rightclick %W %x %y %b"
bind $tkcanvas <Alt-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 3"
}
}
# window protocol bindings
wm protocol $mytoplevel WM_DELETE_WINDOW "pdsend \"$mytoplevel menuclose 0\""
bind $tkcanvas <Destroy> "::pd_bindings::window_destroy %W"
}
#------------------------------------------------------------------------------#
# event handlers
proc ::pd_bindings::patch_configure {mytoplevel width height x y} {
# for some reason, when we create a window, we get an event with a
# widthXheight of 1x1 first, then we get the right values, so filter it out
if {$width == 1 && $height == 1} {return}
pdtk_canvas_getscroll [tkcanvas_name $mytoplevel]
# send the size/location of the window and canvas to 'pd' in the form of:
# left top right bottom
pdsend "$mytoplevel setbounds $x $y [expr $x + $width] [expr $y + $height]"
}
proc ::pd_bindings::window_destroy {window} {
set mytoplevel [winfo toplevel $window]
unset ::editmode($mytoplevel)
unset ::editingtext($mytoplevel)
unset ::loaded($mytoplevel)
# unset my entries all of the window data tracking arrays
array unset ::windowname $mytoplevel
array unset ::parentwindows $mytoplevel
array unset ::childwindows $mytoplevel
}
# do tasks when changing focus (Window menu, scrollbars, etc.)
proc ::pd_bindings::window_focusin {mytoplevel} {
# focused_window is used throughout for sending bindings, menu commands,
# etc. to the correct patch receiver symbol.
set ::focused_window $mytoplevel
::dialog_find::set_window_to_search $mytoplevel
::pd_menucommands::set_filenewdir $mytoplevel
::dialog_font::update_font_dialog $mytoplevel
if {$mytoplevel eq ".pdwindow"} {
::pd_menus::configure_for_pdwindow
} else {
::pd_menus::configure_for_canvas $mytoplevel
}
if {[winfo exists .font]} {wm transient .font $::focused_window}
# if we regain focus from another app, make sure to editmode cursor is right
if {$::editmode($mytoplevel)} {
$mytoplevel configure -cursor hand2
}
# TODO handle enabling/disabling the Cut/Copy/Paste menu items in Edit
}
proc ::pd_bindings::dialog_configure {mytoplevel} {
}
proc ::pd_bindings::dialog_focusin {mytoplevel} {
# TODO disable things on the menus that don't work for dialogs
::pd_menus::configure_for_dialog $mytoplevel
}
# "map" event tells us when the canvas becomes visible, and "unmap",
# invisible. Invisibility means the Window Manager has minimized us. We
# don't get a final "unmap" event when we destroy the window.
proc ::pd_bindings::map {mytoplevel} {
pdsend "$mytoplevel map 1"
::pdtk_canvas::finished_loading_file $mytoplevel
}
proc ::pd_bindings::unmap {mytoplevel} {
pdsend "$mytoplevel map 0"
}
#------------------------------------------------------------------------------#
# key usage
# canvas_key() expects to receive the patch's mytoplevel because key messages
# are local to each patch. Therefore, key messages are not send for the
# dialog panels, the Pd window, help browser, etc. so we need to filter those
# events out.
proc ::pd_bindings::sendkey {window state key iso shift} {
# TODO canvas_key on the C side should be refactored with this proc as well
switch -- $key {
"BackSpace" { set iso ""; set key 8 }
"Tab" { set iso ""; set key 9 }
"Return" { set iso ""; set key 10 }
"Escape" { set iso ""; set key 27 }
"Space" { set iso ""; set key 32 }
"Delete" { set iso ""; set key 127 }
"KP_Delete" { set iso ""; set key 127 }
}
if {$iso ne ""} {
scan $iso %c key
}
# some pop-up panels also bind to keys like the enter, but then disappear,
# so ignore their events. The inputbox in the Startup dialog does this.
if {! [winfo exists $window]} {return}
#$window might be a toplevel or canvas, [winfo toplevel] does the right thing
set mytoplevel [winfo toplevel $window]
if {[winfo class $mytoplevel] eq "PatchWindow"} {
pdsend "$mytoplevel key $state $key $shift"
}
# TODO send to 'pd key' for global key events in Pd?
}

96
tcl/pd_connect.tcl Normal file
View file

@ -0,0 +1,96 @@
package provide pd_connect 0.1
namespace eval ::pd_connect:: {
variable pd_socket
variable cmds_from_pd ""
namespace export to_pd
namespace export create_socket
namespace export pdsend
}
# TODO figure out how to escape { } properly
proc ::pd_connect::configure_socket {sock} {
fconfigure $sock -blocking 0 -buffering none -encoding utf-8;
fileevent $sock readable {::pd_connect::pd_readsocket}
}
# if pd opens first, it starts pd-gui, then pd-gui connects to the port pd sent
proc ::pd_connect::to_pd {port {host localhost}} {
variable pd_socket
::pdwindow::debug "'pd-gui' connecting to 'pd' on localhost $port ...\n"
if {[catch {set pd_socket [socket $host $port]}]} {
puts stderr "WARNING: connect to pd failed, retrying port $host:$port."
after 1000 ::pd_connect::to_pd $port $host
return
}
::pd_connect::configure_socket $pd_socket
}
# if pd-gui opens first, it creates socket and requests a port. The function
# then returns the portnumber it receives. pd then connects to that port.
proc ::pd_connect::create_socket {} {
if {[catch {set sock [socket -server ::pd_connect::from_pd -myaddr localhost 0]}]} {
puts stderr "ERROR: failed to allocate port, exiting!"
exit 3
}
return [lindex [fconfigure $sock -sockname] 2]
}
proc ::pd_connect::from_pd {channel clientaddr clientport} {
variable pd_socket $channel
::pdwindow::debug "Connection from 'pd' to 'pd-gui' on $clientaddr:$clientport\n"
::pd_connect::configure_socket $pd_socket
}
# send a pd/FUDI message from Tcl to Pd. This function aims to behave like a
# [; message( in Pd or pdsend on the command line. Basically, whatever is in
# quotes after the proc name will be sent as if it was sent from a message box
# with a leading semi-colon.
proc ::pd_connect::pdsend {message} {
variable pd_socket
append message \;
if {[catch {puts $pd_socket $message} errorname]} {
puts stderr "pdsend errorname: >>$errorname<<"
error "Not connected to 'pd' process"
}
}
proc ::pd_connect::pd_readsocket {} {
variable pd_socket
variable cmds_from_pd
if {[eof $pd_socket]} {
# if we lose the socket connection, that means pd quit, so we quit
close $pd_socket
exit
}
append cmds_from_pd [read $pd_socket]
if {[string index $cmds_from_pd end] ne "\n" || \
![info complete $cmds_from_pd]} {
# the block is incomplete, wait for the next block of data
return
} else {
set docmds $cmds_from_pd
set cmds_from_pd ""
if {![catch {uplevel #0 $docmds} errorname]} {
# we ran the command block without error, reset the buffer
} else {
# oops, error, alert the user:
global errorInfo
switch -regexp -- $errorname {
"missing close-brace" {
::pdwindow::fatal \
[concat [_ "(Tcl) MISSING CLOSE-BRACE '\}': "] $errorInfo "\n"]
} "^invalid command name" {
::pdwindow::fatal \
[concat [_ "(Tcl) INVALID COMMAND NAME: "] $errorInfo "\n"]
} default {
::pdwindow::fatal \
[concat [_ "(Tcl) UNHANDLED ERROR: "] $errorInfo "\n"]
}
}
}
}
}

249
tcl/pd_guiprefs.tcl Normal file
View file

@ -0,0 +1,249 @@
#
# Copyright (c) 1997-2009 Miller Puckette.
# Copyright (c) 2011 Yvan Volochine.
#(c) 2008 WordTech Communications LLC. License: standard Tcl license, http://www.tcl.tk/software/tcltk/license.html
package provide pd_guiprefs 0.1
namespace eval ::pd_guiprefs:: {
namespace export init
namespace export write_recentfiles
namespace export update_recentfiles
}
# FIXME should these be globals ?
set ::recentfiles_key ""
set ::recentfiles_domain ""
#################################################################
# global procedures
#################################################################
# ------------------------------------------------------------------------------
# init preferences
#
proc ::pd_guiprefs::init {} {
switch -- $::windowingsystem {
"aqua" { init_aqua }
"win32" { init_win }
"x11" { init_x11 }
}
# assign gui preferences
# osx special case for arrays
set arr [expr { $::windowingsystem eq "aqua" }]
set ::recentfiles_list ""
catch {set ::recentfiles_list [get_config $::recentfiles_domain \
$::recentfiles_key $arr]}
}
proc ::pd_guiprefs::init_aqua {} {
# osx has a "Open Recent" menu with 10 recent files (others have 5 inlined)
set ::recentfiles_domain org.puredata
set ::recentfiles_key "NSRecentDocuments"
set ::total_recentfiles 10
}
proc ::pd_guiprefs::init_win {} {
# windows uses registry
set ::recentfiles_domain "HKEY_CURRENT_USER\\Software\\Pure-Data"
set ::recentfiles_key "RecentDocs"
}
proc ::pd_guiprefs::init_x11 {} {
# linux uses ~/.config/pure-data dir
set ::recentfiles_domain "~/.config/pure-data"
set ::recentfiles_key "recentfiles.conf"
prepare_configdir
}
# ------------------------------------------------------------------------------
# write recent files
#
proc ::pd_guiprefs::write_recentfiles {} {
write_config $::recentfiles_list $::recentfiles_domain $::recentfiles_key true
}
# ------------------------------------------------------------------------------
# this is called when opening a document (wheredoesthisshouldgo.tcl)
#
proc ::pd_guiprefs::update_recentfiles {afile} {
# remove duplicates first
set index [lsearch -exact $::recentfiles_list $afile]
set ::recentfiles_list [lreplace $::recentfiles_list $index $index]
# insert new one in the beginning and crop the list
set ::recentfiles_list [linsert $::recentfiles_list 0 $afile]
set ::recentfiles_list [lrange $::recentfiles_list 0 $::total_recentfiles]
::pd_menus::update_recentfiles_menu
}
#################################################################
# main read/write procedures
#################################################################
# ------------------------------------------------------------------------------
# get configs from a file or the registry
#
proc ::pd_guiprefs::get_config {adomain {akey} {arr}} {
switch -- $::windowingsystem {
"aqua" { set conf [get_config_aqua $adomain $akey $arr] }
"win32" { set conf [get_config_win $adomain $akey $arr] }
"x11" { set conf [get_config_x11 $adomain $akey $arr] }
}
return $conf
}
# ------------------------------------------------------------------------------
# write configs to a file or to the registry
# $arr is true if the data needs to be written in an array
#
proc ::pd_guiprefs::write_config {data {adomain} {akey} {arr false}} {
switch -- $::windowingsystem {
"aqua" { write_config_aqua $data $adomain $akey $arr }
"win32" { write_config_win $data $adomain $akey $arr }
"x11" { write_config_x11 $data $adomain $akey }
}
}
#################################################################
# os specific procedures
#################################################################
# ------------------------------------------------------------------------------
# osx: read a plist file
#
proc ::pd_guiprefs::get_config_aqua {adomain {akey} {arr false}} {
if {![catch {exec defaults read $adomain $akey} conf]} {
if {$arr} {
set conf [plist_array_to_tcl_list $conf]
}
} else {
# initialize NSRecentDocuments with an empty array
exec defaults write $adomain $akey -array
set conf {}
}
return $conf
}
# ------------------------------------------------------------------------------
# win: read in the registry
#
proc ::pd_guiprefs::get_config_win {adomain {akey} {arr false}} {
package require registry
if {![catch {registry get $adomain $akey} conf]} {
return [expr {$conf}]
} else {
return {}
}
}
# ------------------------------------------------------------------------------
# linux: read a config file and return its lines splitted.
#
proc ::pd_guiprefs::get_config_x11 {adomain {akey} {arr false}} {
set filename [file join $adomain $akey]
set conf {}
if {
[file exists $filename] == 1
&& [file readable $filename]
} else {
set fl [open $filename r]
while {[gets $fl line] >= 0} {
lappend conf $line
}
close $fl
}
return $conf
}
# ------------------------------------------------------------------------------
# osx: write configs to plist file
# if $arr is true, we write an array
#
proc ::pd_guiprefs::write_config_aqua {data {adomain} {akey} {arr false}} {
# FIXME empty and write again so we don't loose the order
if {[catch {exec defaults write $adomain $akey -array} errorMsg]} {
::pdwindow::error "write_config_aqua $akey: $errorMsg"
}
if {$arr} {
foreach filepath $data {
set escaped [escape_for_plist $filepath]
exec defaults write $adomain $akey -array-add "$escaped"
}
} else {
set escaped [escape_for_plist $data]
exec defaults write $adomain $akey '$escaped'
}
}
# ------------------------------------------------------------------------------
# win: write configs to registry
# if $arr is true, we write an array
#
proc ::pd_guiprefs::write_config_win {data {adomain} {akey} {arr false}} {
package require registry
# FIXME: ugly
if {$arr} {
if {[catch {registry set $adomain $akey $data multi_sz} errorMsg]} {
::pdwindow::error "write_config_win $data $akey: $errorMsg"
}
} else {
if {[catch {registry set $adomain $akey $data sz} errorMsg]} {
::pdwindow::error "write_config_win $data $akey: $errorMsg"
}
}
}
# ------------------------------------------------------------------------------
# linux: write configs to USER_APP_CONFIG_DIR
#
proc ::pd_guiprefs::write_config_x11 {data {adomain} {akey}} {
# right now I (yvan) assume that data are just \n separated, i.e. no keys
set data [join $data "\n"]
set filename [file join $adomain $akey]
if {[catch {set fl [open $filename w]} errorMsg]} {
::pdwindow::error "write_config_x11 $data $akey: $errorMsg"
} else {
puts -nonewline $fl $data
close $fl
}
}
#################################################################
# utils
#################################################################
# ------------------------------------------------------------------------------
# linux only! : look for pd config directory and create it if needed
#
proc ::pd_guiprefs::prepare_configdir {} {
if {[file isdirectory $::recentfiles_domain] != 1} {
file mkdir $::recentfiles_domain
::pdwindow::debug "$::recentfiles_domain was created.\n"
}
}
# ------------------------------------------------------------------------------
# osx: handles arrays in plist files (thanks hc)
#
proc ::pd_guiprefs::plist_array_to_tcl_list {arr} {
set result {}
set filelist $arr
regsub -all -- {("?),\s+("?)} $filelist {\1 \2} filelist
regsub -all -- {\n} $filelist {} filelist
regsub -all -- {^\(} $filelist {} filelist
regsub -all -- {\)$} $filelist {} filelist
regsub -line -- {^'(.*)'$} $filelist {\1} filelist
foreach file $filelist {
set filename [regsub -- {,$} $file {}]
lappend result $filename
}
return $result
}
# the Mac OS X 'defaults' command uses single quotes to quote things,
# so they need to be escaped
proc ::pd_guiprefs::escape_for_plist {str} {
return [regsub -all -- {'} $str {\\'}]
}

278
tcl/pd_menucommands.tcl Normal file
View file

@ -0,0 +1,278 @@
package provide pd_menucommands 0.1
namespace eval ::pd_menucommands:: {
variable untitled_number "1"
namespace export menu_*
}
# ------------------------------------------------------------------------------
# functions called from File menu
proc ::pd_menucommands::menu_new {} {
variable untitled_number
if { ! [file isdirectory $::filenewdir]} {set ::filenewdir $::env(HOME)}
# to localize "Untitled" there will need to be changes in g_canvas.c and
# g_readwrite.c, where it tests for the string "Untitled"
set untitled_name "Untitled"
pdsend "pd menunew $untitled_name-$untitled_number [enquote_path $::filenewdir]"
incr untitled_number
}
proc ::pd_menucommands::menu_open {} {
if { ! [file isdirectory $::fileopendir]} {set ::fileopendir $::env(HOME)}
set files [tk_getOpenFile -defaultextension .pd \
-multiple true \
-filetypes $::filetypes \
-initialdir $::fileopendir]
if {$files ne ""} {
foreach filename $files {
open_file $filename
}
set ::fileopendir [file dirname $filename]
}
}
proc ::pd_menucommands::menu_print {mytoplevel} {
set filename [tk_getSaveFile -initialfile pd.ps \
-defaultextension .ps \
-filetypes { {{postscript} {.ps}} }]
if {$filename ne ""} {
set tkcanvas [tkcanvas_name $mytoplevel]
$tkcanvas postscript -file $filename
}
}
# ------------------------------------------------------------------------------
# functions called from Edit menu
proc ::pd_menucommands::menu_undo {} {
if {$::focused_window eq $::undo_toplevel && $::undo_action ne "no"} {
pdsend "$::focused_window undo"
}
}
proc ::pd_menucommands::menu_redo {} {
if {$::focused_window eq $::undo_toplevel && $::redo_action ne "no"} {
pdsend "$::focused_window redo"
}
}
proc ::pd_menucommands::menu_editmode {state} {
if {[winfo class $::focused_window] ne "PatchWindow"} {return}
set ::editmode_button $state
# this shouldn't be necessary because 'pd' will reply with pdtk_canvas_editmode
# set ::editmode($::focused_window) $state
pdsend "$::focused_window editmode $state"
}
proc ::pd_menucommands::menu_toggle_editmode {} {
menu_editmode [expr {! $::editmode_button}]
}
# ------------------------------------------------------------------------------
# generic procs for sending menu events
# send a message to a pd canvas receiver
proc ::pd_menucommands::menu_send {window message} {
set mytoplevel [winfo toplevel $window]
if {[winfo class $mytoplevel] eq "PatchWindow"} {
pdsend "$mytoplevel $message"
} elseif {$mytoplevel eq ".pdwindow"} {
if {$message eq "copy"} {
tk_textCopy .pdwindow.text
} elseif {$message eq "selectall"} {
.pdwindow.text tag add sel 1.0 end
} elseif {$message eq "menusaveas"} {
::pdwindow::save_logbuffer_to_file
}
}
}
# send a message to a pd canvas receiver with a float arg
proc ::pd_menucommands::menu_send_float {window message float} {
set mytoplevel [winfo toplevel $window]
if {[winfo class $mytoplevel] eq "PatchWindow"} {
pdsend "$mytoplevel $message $float"
}
}
# ------------------------------------------------------------------------------
# open the dialog panels
proc ::pd_menucommands::menu_message_dialog {} {
::dialog_message::open_message_dialog $::focused_window
}
proc ::pd_menucommands::menu_find_dialog {} {
::dialog_find::open_find_dialog $::focused_window
}
proc ::pd_menucommands::menu_font_dialog {} {
if {[winfo exists .font]} {
raise .font
} elseif {$::focused_window eq ".pdwindow"} {
pdtk_canvas_dofont .pdwindow [lindex [.pdwindow.text cget -font] 1]
} else {
pdsend "$::focused_window menufont"
}
}
proc ::pd_menucommands::menu_path_dialog {} {
if {[winfo exists .path]} {
raise .path
} else {
pdsend "pd start-path-dialog"
}
}
proc ::pd_menucommands::menu_startup_dialog {} {
if {[winfo exists .startup]} {
raise .startup
} else {
pdsend "pd start-startup-dialog"
}
}
proc ::pd_menucommands::menu_helpbrowser {} {
::helpbrowser::open_helpbrowser
}
proc ::pd_menucommands::menu_texteditor {} {
::pdwindow::error "the text editor is not implemented"
}
# ------------------------------------------------------------------------------
# window management functions
proc ::pd_menucommands::menu_minimize {window} {
wm iconify [winfo toplevel $window]
}
proc ::pd_menucommands::menu_maximize {window} {
wm state [winfo toplevel $window] zoomed
}
proc ::pd_menucommands::menu_raise_pdwindow {} {
if {$::focused_window eq ".pdwindow" && [winfo viewable .pdwindow]} {
lower .pdwindow
} else {
wm deiconify .pdwindow
raise .pdwindow
}
}
# used for cycling thru windows of an app
proc ::pd_menucommands::menu_raisepreviouswindow {} {
lower [lindex [wm stackorder .] end] [lindex [wm stackorder .] 0]
focus [lindex [wm stackorder .] end]
}
# used for cycling thru windows of an app the other direction
proc ::pd_menucommands::menu_raisenextwindow {} {
set mytoplevel [lindex [wm stackorder .] 0]
raise $mytoplevel
focus $mytoplevel
}
# ------------------------------------------------------------------------------
# Pd window functions
proc menu_clear_console {} {
::pdwindow::clear_console
}
# ------------------------------------------------------------------------------
# manage the saving of the directories for the new commands
# this gets the dir from the path of a window's title
proc ::pd_menucommands::set_filenewdir {mytoplevel} {
# TODO add Aqua specifics once g_canvas.c has [wm attributes -titlepath]
if {$mytoplevel eq ".pdwindow"} {
set ::filenewdir $::fileopendir
} else {
regexp -- ".+ - (.+)" [wm title $mytoplevel] ignored ::filenewdir
}
}
# parse the textfile for the About Pd page
proc ::pd_menucommands::menu_aboutpd {} {
set versionstring "Pd $::PD_MAJOR_VERSION.$::PD_MINOR_VERSION.$::PD_BUGFIX_VERSION$::PD_TEST_VERSION"
set filename "$::sys_libdir/doc/1.manual/1.introduction.txt"
if {[winfo exists .aboutpd]} {
wm deiconify .aboutpd
raise .aboutpd
} else {
toplevel .aboutpd -class TextWindow
wm title .aboutpd [_ "About Pd"]
wm group .aboutpd .
.aboutpd configure -menu $::dialog_menubar
text .aboutpd.text -relief flat -borderwidth 0 \
-yscrollcommand ".aboutpd.scroll set" -background white
scrollbar .aboutpd.scroll -command ".aboutpd.text yview"
pack .aboutpd.scroll -side right -fill y
pack .aboutpd.text -side left -fill both -expand 1
bind .aboutpd <$::modifier-Key-w> "wm withdraw .aboutpd"
set textfile [open $filename]
while {![eof $textfile]} {
set bigstring [read $textfile 1000]
regsub -all PD_BASEDIR $bigstring $::sys_guidir bigstring2
regsub -all PD_VERSION $bigstring2 $versionstring bigstring3
.aboutpd.text insert end $bigstring3
}
close $textfile
}
}
# ------------------------------------------------------------------------------
# opening docs as menu items (like the Test Audio and MIDI patch and the manual)
proc ::pd_menucommands::menu_doc_open {dir basename} {
if {[file pathtype $dir] eq "relative"} {
set dirname "$::sys_libdir/$dir"
} else {
set dirname $dir
}
set textextension "[string tolower [file extension $basename]]"
if {[lsearch -exact [lindex $::filetypes 0 1] $textextension] > -1} {
set fullpath [file normalize [file join $dirname $basename]]
set dirname [file dirname $fullpath]
set basename [file tail $fullpath]
pdsend "pd open [enquote_path $basename] [enquote_path $dirname]"
} else {
::pd_menucommands::menu_openfile "$dirname/$basename"
}
}
# open HTML docs from the menu using the OS-default HTML viewer
proc ::pd_menucommands::menu_openfile {filename} {
if {$::tcl_platform(os) eq "Darwin"} {
exec sh -c [format "open '%s'" $filename]
} elseif {$::tcl_platform(platform) eq "windows"} {
exec rundll32 url.dll,FileProtocolHandler [format "%s" $filename] &
} else {
foreach candidate { gnome-open xdg-open sensible-browser iceweasel firefox \
mozilla galeon konqueror netscape lynx } {
set browser [lindex [auto_execok $candidate] 0]
if {[string length $browser] != 0} {
exec -- sh -c [format "%s '%s'" $browser $filename] &
break
}
}
}
}
# ------------------------------------------------------------------------------
# Mac OS X specific functions
proc ::pd_menucommands::menu_bringalltofront {} {
# use [winfo children .] here to include windows that are minimized
foreach item [winfo children .] {
# get all toplevel windows, exclude menubar windows
if { [string equal [winfo toplevel $item] $item] && \
[catch {$item cget -tearoff}]} {
wm deiconify $item
}
}
wm deiconify .
}

607
tcl/pd_menus.tcl Normal file
View file

@ -0,0 +1,607 @@
# Copyright (c) 1997-2009 Miller Puckette.
#(c) 2008 WordTech Communications LLC. License: standard Tcl license, http://www.tcl.tk/software/tcltk/license.html
package provide pd_menus 0.1
package require pd_menucommands
# TODO figure out Undo/Redo/Cut/Copy/Paste state changes for menus
# since there is one menubar that is used for all windows, the menu -commands
# use {} quotes so that $::focused_window is interpreted when the menu item
# is called, not when the command is mapped to the menu item. This is the
# opposite of the 'bind' commands in pd_bindings.tcl
namespace eval ::pd_menus:: {
variable accelerator
variable menubar ".menubar"
namespace export create_menubar
namespace export configure_for_pdwindow
namespace export configure_for_canvas
namespace export configure_for_dialog
# turn off tearoff menus globally
option add *tearOff 0
}
# ------------------------------------------------------------------------------
#
proc ::pd_menus::create_menubar {} {
variable accelerator
variable menubar
if {$::windowingsystem eq "aqua"} {
set accelerator "Cmd"
} else {
set accelerator "Ctrl"
}
menu $menubar
set menulist "file edit put find media window help"
foreach mymenu $menulist {
menu $menubar.$mymenu
$menubar add cascade -label [_ [string totitle $mymenu]] \
-menu $menubar.$mymenu
[format build_%s_menu $mymenu] $menubar.$mymenu
}
if {$::windowingsystem eq "aqua"} {create_apple_menu $menubar}
if {$::windowingsystem eq "win32"} {create_system_menu $menubar}
. configure -menu $menubar
}
proc ::pd_menus::configure_for_pdwindow {} {
variable menubar
# these are meaningless for the Pd window, so disable them
# File menu
$menubar.file entryconfigure [_ "Save"] -state disabled
$menubar.file entryconfigure [_ "Save As..."] -state normal
$menubar.file entryconfigure [_ "Print..."] -state disabled
$menubar.file entryconfigure [_ "Close"] -state disabled
# Edit menu
$menubar.edit entryconfigure [_ "Duplicate"] -state disabled
$menubar.edit entryconfigure [_ "Tidy Up"] -state disabled
$menubar.edit entryconfigure [_ "Edit Mode"] -state disabled
pdtk_canvas_editmode .pdwindow 0
# Undo/Redo change names, they need to have the asterisk (*) after
$menubar.edit entryconfigure 0 -state disabled -label [_ "Undo"]
$menubar.edit entryconfigure 1 -state disabled -label [_ "Redo"]
# disable everything on the Put menu
for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
# catch errors that happen when trying to disable separators
catch {$menubar.put entryconfigure $i -state disabled }
}
}
proc ::pd_menus::configure_for_canvas {mytoplevel} {
variable menubar
# File menu
$menubar.file entryconfigure [_ "Save"] -state normal
$menubar.file entryconfigure [_ "Save As..."] -state normal
$menubar.file entryconfigure [_ "Print..."] -state normal
$menubar.file entryconfigure [_ "Close"] -state normal
# Edit menu
$menubar.edit entryconfigure [_ "Duplicate"] -state normal
$menubar.edit entryconfigure [_ "Tidy Up"] -state normal
$menubar.edit entryconfigure [_ "Edit Mode"] -state normal
pdtk_canvas_editmode $mytoplevel $::editmode($mytoplevel)
# Put menu
for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
# catch errors that happen when trying to disable separators
if {[$menubar.put type $i] ne "separator"} {
$menubar.put entryconfigure $i -state normal
}
}
update_undo_on_menu $mytoplevel
}
proc ::pd_menus::configure_for_dialog {mytoplevel} {
variable menubar
# these are meaningless for the dialog panels, so disable them except for
# the ones that make senes in the Find dialog panel
# File menu
if {$mytoplevel ne ".find"} {
$menubar.file entryconfigure [_ "Save"] -state disabled
$menubar.file entryconfigure [_ "Save As..."] -state disabled
$menubar.file entryconfigure [_ "Print..."] -state disabled
}
$menubar.file entryconfigure [_ "Close"] -state disabled
# Edit menu
$menubar.edit entryconfigure [_ "Duplicate"] -state disabled
$menubar.edit entryconfigure [_ "Tidy Up"] -state disabled
$menubar.edit entryconfigure [_ "Edit Mode"] -state disabled
pdtk_canvas_editmode $mytoplevel 0
# Undo/Redo change names, they need to have the asterisk (*) after
$menubar.edit entryconfigure 0 -state disabled -label [_ "Undo"]
$menubar.edit entryconfigure 1 -state disabled -label [_ "Redo"]
# disable everything on the Put menu
for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
# catch errors that happen when trying to disable separators
catch {$menubar.put entryconfigure $i -state disabled }
}
}
# ------------------------------------------------------------------------------
# menu building functions
proc ::pd_menus::build_file_menu {mymenu} {
# run the platform-specific build_file_menu_* procs first, and config them
[format build_file_menu_%s $::windowingsystem] $mymenu
$mymenu entryconfigure [_ "New"] -command {menu_new}
$mymenu entryconfigure [_ "Open"] -command {menu_open}
$mymenu entryconfigure [_ "Save"] -command {menu_send $::focused_window menusave}
$mymenu entryconfigure [_ "Save As..."] -command {menu_send $::focused_window menusaveas}
#$mymenu entryconfigure [_ "Revert*"] -command {menu_revert $::focused_window}
$mymenu entryconfigure [_ "Close"] -command {menu_send_float $::focused_window menuclose 0}
$mymenu entryconfigure [_ "Message..."] -command {menu_message_dialog}
$mymenu entryconfigure [_ "Print..."] -command {menu_print $::focused_window}
# update recent files
if {[llength $::recentfiles_list] > 0} {
::pd_menus::update_recentfiles_menu false
}
}
proc ::pd_menus::build_edit_menu {mymenu} {
variable accelerator
$mymenu add command -label [_ "Undo"] -accelerator "$accelerator+Z" \
-command {menu_undo $::focused_window}
$mymenu add command -label [_ "Redo"] -accelerator "Shift+$accelerator+Z" \
-command {menu_redo $::focused_window}
$mymenu add separator
$mymenu add command -label [_ "Cut"] -accelerator "$accelerator+X" \
-command {menu_send $::focused_window cut}
$mymenu add command -label [_ "Copy"] -accelerator "$accelerator+C" \
-command {menu_send $::focused_window copy}
$mymenu add command -label [_ "Paste"] -accelerator "$accelerator+V" \
-command {menu_send $::focused_window paste}
$mymenu add command -label [_ "Duplicate"] -accelerator "$accelerator+D" \
-command {menu_send $::focused_window duplicate}
$mymenu add command -label [_ "Select All"] -accelerator "$accelerator+A" \
-command {menu_send $::focused_window selectall}
$mymenu add separator
if {$::windowingsystem eq "aqua"} {
# $mymenu add command -label [_ "Text Editor"] \
# -command {menu_texteditor}
$mymenu add command -label [_ "Font"] -accelerator "$accelerator+T" \
-command {menu_font_dialog}
} else {
# $mymenu add command -label [_ "Text Editor"] -accelerator "$accelerator+T"\
# -command {menu_texteditor}
$mymenu add command -label [_ "Font"] \
-command {menu_font_dialog}
}
$mymenu add command -label [_ "Tidy Up"] \
-command {menu_send $::focused_window tidy}
$mymenu add command -label [_ "Clear Console"] \
-accelerator "Shift+$accelerator+L" -command {menu_clear_console}
$mymenu add separator
#TODO madness! how to set the state of the check box without invoking the menu!
$mymenu add check -label [_ "Edit Mode"] -accelerator "$accelerator+E" \
-variable ::editmode_button \
-command {menu_editmode $::editmode_button}
}
proc ::pd_menus::build_put_menu {mymenu} {
variable accelerator
# The trailing 0 in menu_send_float basically means leave the object box
# sticking to the mouse cursor. The iemguis alway do that when created
# from the menu, as defined in canvas_iemguis()
$mymenu add command -label [_ "Object"] -accelerator "$accelerator+1" \
-command {menu_send_float $::focused_window obj 0}
$mymenu add command -label [_ "Message"] -accelerator "$accelerator+2" \
-command {menu_send_float $::focused_window msg 0}
$mymenu add command -label [_ "Number"] -accelerator "$accelerator+3" \
-command {menu_send_float $::focused_window floatatom 0}
$mymenu add command -label [_ "Symbol"] -accelerator "$accelerator+4" \
-command {menu_send_float $::focused_window symbolatom 0}
$mymenu add command -label [_ "Comment"] -accelerator "$accelerator+5" \
-command {menu_send_float $::focused_window text 0}
$mymenu add separator
$mymenu add command -label [_ "Bang"] -accelerator "Shift+$accelerator+B" \
-command {menu_send $::focused_window bng}
$mymenu add command -label [_ "Toggle"] -accelerator "Shift+$accelerator+T" \
-command {menu_send $::focused_window toggle}
$mymenu add command -label [_ "Number2"] -accelerator "Shift+$accelerator+N" \
-command {menu_send $::focused_window numbox}
$mymenu add command -label [_ "Vslider"] -accelerator "Shift+$accelerator+V" \
-command {menu_send $::focused_window vslider}
$mymenu add command -label [_ "Hslider"] -accelerator "Shift+$accelerator+H" \
-command {menu_send $::focused_window hslider}
$mymenu add command -label [_ "Vradio"] -accelerator "Shift+$accelerator+D" \
-command {menu_send $::focused_window vradio}
$mymenu add command -label [_ "Hradio"] -accelerator "Shift+$accelerator+I" \
-command {menu_send $::focused_window hradio}
$mymenu add command -label [_ "VU Meter"] -accelerator "Shift+$accelerator+U"\
-command {menu_send $::focused_window vumeter}
$mymenu add command -label [_ "Canvas"] -accelerator "Shift+$accelerator+C" \
-command {menu_send $::focused_window mycnv}
$mymenu add separator
$mymenu add command -label [_ "Graph"] -command {menu_send $::focused_window graph}
$mymenu add command -label [_ "Array"] -command {menu_send $::focused_window menuarray}
}
proc ::pd_menus::build_find_menu {mymenu} {
variable accelerator
$mymenu add command -label [_ "Find..."] -accelerator "$accelerator+F" \
-command {menu_find_dialog}
$mymenu add command -label [_ "Find Again"] -accelerator "$accelerator+G" \
-command {menu_send $::focused_window findagain}
$mymenu add command -label [_ "Find Last Error"] \
-command {pdsend {pd finderror}}
}
proc ::pd_menus::build_media_menu {mymenu} {
variable accelerator
$mymenu add radiobutton -label [_ "DSP On"] -accelerator "$accelerator+/" \
-variable ::dsp -value 1 -command {pdsend "pd dsp 1"}
$mymenu add radiobutton -label [_ "DSP Off"] -accelerator "$accelerator+." \
-variable ::dsp -value 0 -command {pdsend "pd dsp 0"}
$mymenu add separator
$mymenu add command -label [_ "Test Audio and MIDI..."] \
-command {menu_doc_open doc/7.stuff/tools testtone.pd}
$mymenu add command -label [_ "Load Meter"] \
-command {menu_doc_open doc/7.stuff/tools load-meter.pd}
set audio_apilist_length [llength $::audio_apilist]
if {$audio_apilist_length > 0} {$mymenu add separator}
for {set x 0} {$x<$audio_apilist_length} {incr x} {
$mymenu add radiobutton -label [lindex [lindex $::audio_apilist $x] 0] \
-command {menu_audio 0} -variable ::pd_whichapi \
-value [lindex [lindex $::audio_apilist $x] 1]\
-command {pdsend "pd audio-setapi $::pd_whichapi"}
}
set midi_apilist_length [llength $::midi_apilist]
if {$midi_apilist_length > 0} {$mymenu add separator}
for {set x 0} {$x<$midi_apilist_length} {incr x} {
$mymenu add radiobutton -label [lindex [lindex $::midi_apilist $x] 0] \
-command {menu_midi 0} -variable ::pd_whichmidiapi \
-value [lindex [lindex $::midi_apilist $x] 1]\
-command {pdsend "pd midi-setapi $::pd_whichmidiapi"}
}
if {$::windowingsystem ne "aqua"} {
$mymenu add separator
create_preferences_menu $mymenu.preferences
$mymenu add cascade -label [_ "Preferences"] -menu $mymenu.preferences
}
}
proc ::pd_menus::build_window_menu {mymenu} {
variable accelerator
if {$::windowingsystem eq "aqua"} {
$mymenu add command -label [_ "Minimize"] -accelerator "$accelerator+M"\
-command {menu_minimize $::focused_window}
$mymenu add command -label [_ "Zoom"] \
-command {menu_maximize $::focused_window}
$mymenu add separator
$mymenu add command -label [_ "Bring All to Front"] \
-command {menu_bringalltofront}
} else {
$mymenu add command -label [_ "Next Window"] \
-command {menu_raisenextwindow} \
-accelerator [_ "$accelerator+Page Down"]
$mymenu add command -label [_ "Previous Window"] \
-command {menu_raisepreviouswindow} \
-accelerator [_ "$accelerator+Page Up"]
}
$mymenu add separator
$mymenu add command -label [_ "Pd window"] -command {menu_raise_pdwindow} \
-accelerator "$accelerator+R"
$mymenu add command -label [_ "Parent Window"] \
-command {menu_send $::focused_window findparent}
$mymenu add separator
}
proc ::pd_menus::build_help_menu {mymenu} {
if {$::windowingsystem ne "aqua"} {
$mymenu add command -label [_ "About Pd"] -command {menu_aboutpd}
}
$mymenu add command -label [_ "HTML Manual..."] \
-command {menu_doc_open doc/1.manual index.htm}
$mymenu add command -label [_ "Browser..."] \
-command {menu_helpbrowser}
$mymenu add separator
$mymenu add command -label [_ "puredata.info"] \
-command {menu_openfile {http://puredata.info}}
$mymenu add command -label [_ "Report a bug"] -command {menu_openfile \
{http://sourceforge.net/tracker/?func=add&group_id=55736&atid=478070}}
$mymenu add separator
$mymenu add command -label [_ "Tcl prompt"] -command \
{::pdwindow::create_tcl_entry}
}
#------------------------------------------------------------------------------#
# undo/redo menu items
proc ::pd_menus::update_undo_on_menu {mytoplevel} {
variable menubar
if {$mytoplevel eq $::undo_toplevel && $::undo_action ne "no"} {
$menubar.edit entryconfigure 0 -state normal \
-label [_ "Undo $::undo_action"]
} else {
$menubar.edit entryconfigure 0 -state disabled -label [_ "Undo"]
}
if {$mytoplevel eq $::undo_toplevel && $::redo_action ne "no"} {
$menubar.edit entryconfigure 1 -state normal \
-label [_ "Redo $::redo_action"]
} else {
$menubar.edit entryconfigure 1 -state disabled -label [_ "Redo"]
}
}
# ------------------------------------------------------------------------------
# update the menu entries for opening recent files (write arg should always be true except the first time when pd is opened)
proc ::pd_menus::update_recentfiles_menu {{write true}} {
variable menubar
switch -- $::windowingsystem {
"aqua" {::pd_menus::update_openrecent_menu_aqua .openrecent $write}
"win32" {::pd_menus::update_recentfiles_on_menu $menubar.file $write}
"x11" {::pd_menus::update_recentfiles_on_menu $menubar.file $write}
}
}
proc ::pd_menus::clear_recentfiles_menu {} {
set ::recentfiles_list {}
::pd_menus::update_recentfiles_menu
# empty recentfiles in preferences (write empty array)
::pd_guiprefs::write_recentfiles
}
proc ::pd_menus::update_openrecent_menu_aqua {mymenu {write}} {
if {! [winfo exists $mymenu]} {menu $mymenu}
$mymenu delete 0 end
# now the list is last first so we just add
foreach filename $::recentfiles_list {
$mymenu add command -label [file tail $filename] \
-command "open_file {$filename}"
}
# clear button
$mymenu add separator
$mymenu add command -label [_ "Clear Menu"] \
-command "::pd_menus::clear_recentfiles_menu"
# write to config file
if {$write == true} { ::pd_guiprefs::write_recentfiles }
}
# ------------------------------------------------------------------------------
# this expects to be run on the File menu, and to insert above the last separator
proc ::pd_menus::update_recentfiles_on_menu {mymenu {write}} {
set lastitem [$mymenu index end]
set i 1
while {[$mymenu type [expr $lastitem-$i]] ne "separator"} {incr i}
set bottom_separator [expr $lastitem-$i]
incr i
while {[$mymenu type [expr $lastitem-$i]] ne "separator"} {incr i}
set top_separator [expr $lastitem-$i]
if {$top_separator < [expr $bottom_separator-1]} {
$mymenu delete [expr $top_separator+1] [expr $bottom_separator-1]
}
# insert the list from the end because we insert each element on the top
set i [llength $::recentfiles_list]
while {[incr i -1] > 0} {
set filename [lindex $::recentfiles_list $i]
$mymenu insert [expr $top_separator+1] command \
-label [file tail $filename] -command "open_file {$filename}"
}
set filename [lindex $::recentfiles_list 0]
$mymenu insert [expr $top_separator+1] command \
-label [file tail $filename] -command "open_file {$filename}"
# write to config file
if {$write == true} { ::pd_guiprefs::write_recentfiles }
}
# ------------------------------------------------------------------------------
# lots of crazy recursion to update the Window menu
# find the first parent patch that has a mapped window
proc ::pd_menus::find_mapped_parent {parentlist} {
if {[llength $parentlist] == 0} {return "none"}
set firstparent [lindex $parentlist 0]
if {[winfo exists $firstparent]} {
return $firstparent
} elseif {[llength $parentlist] > 1} {
return [find_mapped_parent [lrange $parentlist 1 end]]
} else {
# we must be the first menu item to be inserted
return "none"
}
}
# find the first parent patch that has a mapped window
proc ::pd_menus::insert_into_menu {mymenu entry parent} {
set insertat [$mymenu index end]
for {set i 0} {$i <= [$mymenu index end]} {incr i} {
if {[$mymenu type $i] ne "command"} {continue}
set currentcommand [$mymenu entrycget $i -command]
if {$currentcommand eq "raise $entry"} {return} ;# it exists already
if {$currentcommand eq "raise $parent"} {
set insertat $i
}
}
incr insertat
set label ""
for {set i 0} {$i < [llength $::parentwindows($entry)]} {incr i} {
append label " "
}
append label $::windowname($entry)
$mymenu insert $insertat command -label $label -command "raise $entry"
}
# recurse through a list of parent windows and add to the menu
proc ::pd_menus::add_list_to_menu {mymenu window parentlist} {
if {[llength $parentlist] == 0} {
insert_into_menu $mymenu $window {}
} else {
set entry [lindex $parentlist end]
if {[winfo exists $entry]} {
insert_into_menu $mymenu $entry \
[find_mapped_parent $::parentwindows($entry)]
}
}
if {[llength $parentlist] > 1} {
add_list_to_menu $mymenu $window [lrange $parentlist 0 end-1]
}
}
# update the list of windows on the Window menu. This expects run on the
# Window menu, and to insert below the last separator
proc ::pd_menus::update_window_menu {} {
set mymenu $::patch_menubar.window
# find the last separator and delete everything after that
for {set i 0} {$i <= [$mymenu index end]} {incr i} {
if {[$mymenu type $i] eq "separator"} {
set deleteat $i
}
}
$mymenu delete $deleteat end
$mymenu add separator
foreach window [array names ::parentwindows] {
set parentlist $::parentwindows($window)
add_list_to_menu $mymenu $window $parentlist
insert_into_menu $mymenu $window [find_mapped_parent $parentlist]
}
}
# ------------------------------------------------------------------------------
# submenu for Preferences, now used on all platforms
proc ::pd_menus::create_preferences_menu {mymenu} {
menu $mymenu
$mymenu add command -label [_ "Path..."] \
-command {pdsend "pd start-path-dialog"}
$mymenu add command -label [_ "Startup..."] \
-command {pdsend "pd start-startup-dialog"}
$mymenu add command -label [_ "Audio Settings..."] \
-command {pdsend "pd audio-properties"}
$mymenu add command -label [_ "MIDI Settings..."] \
-command {pdsend "pd midi-properties"}
}
# ------------------------------------------------------------------------------
# menu building functions for Mac OS X/aqua
# for Mac OS X only
proc ::pd_menus::create_apple_menu {mymenu} {
# TODO this should open a Pd patch called about.pd
menu $mymenu.apple
$mymenu.apple add command -label [_ "About Pd"] -command {menu_aboutpd}
$mymenu.apple add separator
create_preferences_menu $mymenu.apple.preferences
$mymenu.apple add cascade -label [_ "Preferences"] \
-menu $mymenu.apple.preferences
# this needs to be last for things to function properly
$mymenu add cascade -label "Apple" -menu $mymenu.apple
}
proc ::pd_menus::build_file_menu_aqua {mymenu} {
variable accelerator
$mymenu add command -label [_ "New"] -accelerator "$accelerator+N"
$mymenu add command -label [_ "Open"] -accelerator "$accelerator+O"
# this is now done in main ::pd_menus::build_file_menu
#::pd_menus::update_openrecent_menu_aqua .openrecent
$mymenu add cascade -label [_ "Open Recent"] -menu .openrecent
$mymenu add separator
$mymenu add command -label [_ "Close"] -accelerator "$accelerator+W"
$mymenu add command -label [_ "Save"] -accelerator "$accelerator+S"
$mymenu add command -label [_ "Save As..."] -accelerator "$accelerator+Shift+S"
#$mymenu add command -label [_ "Save All"]
#$mymenu add command -label [_ "Revert to Saved"]
$mymenu add separator
$mymenu add command -label [_ "Message..."]
$mymenu add separator
$mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
}
# the "Edit", "Put", and "Find" menus do not have cross-platform differences
proc ::pd_menus::build_media_menu_aqua {mymenu} {
}
proc ::pd_menus::build_window_menu_aqua {mymenu} {
}
# the "Help" does not have cross-platform differences
# ------------------------------------------------------------------------------
# menu building functions for UNIX/X11
proc ::pd_menus::build_file_menu_x11 {mymenu} {
variable accelerator
$mymenu add command -label [_ "New"] -accelerator "$accelerator+N"
$mymenu add command -label [_ "Open"] -accelerator "$accelerator+O"
$mymenu add separator
$mymenu add command -label [_ "Save"] -accelerator "$accelerator+S"
$mymenu add command -label [_ "Save As..."] -accelerator "Shift+$accelerator+S"
# $mymenu add command -label "Revert"
$mymenu add separator
$mymenu add command -label [_ "Message..."] -accelerator "$accelerator+M"
$mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
$mymenu add separator
# the recent files get inserted in here by update_recentfiles_on_menu
$mymenu add separator
$mymenu add command -label [_ "Close"] -accelerator "$accelerator+W"
$mymenu add command -label [_ "Quit"] -accelerator "$accelerator+Q" \
-command {pdsend "pd verifyquit"}
}
# the "Edit", "Put", and "Find" menus do not have cross-platform differences
proc ::pd_menus::build_media_menu_x11 {mymenu} {
}
proc ::pd_menus::build_window_menu_x11 {mymenu} {
}
# the "Help" does not have cross-platform differences
# ------------------------------------------------------------------------------
# menu building functions for Windows/Win32
# for Windows only
proc ::pd_menus::create_system_menu {mymenubar} {
set mymenu $mymenubar.system
$mymenubar add cascade -label System -menu $mymenu
menu $mymenu -tearoff 0
# placeholders
$mymenu add command -label [_ "Edit Mode"] -command "::pdwindow::verbose 0 systemmenu"
# TODO add Close, Minimize, etc and whatever else is on the little menu
# that is on the top left corner of the window frame
# http://wiki.tcl.tk/1006
# TODO add Edit Mode here
}
proc ::pd_menus::build_file_menu_win32 {mymenu} {
variable accelerator
$mymenu add command -label [_ "New"] -accelerator "$accelerator+N"
$mymenu add command -label [_ "Open"] -accelerator "$accelerator+O"
$mymenu add separator
$mymenu add command -label [_ "Save"] -accelerator "$accelerator+S"
$mymenu add command -label [_ "Save As..."] -accelerator "Shift+$accelerator+S"
# $mymenu add command -label "Revert"
$mymenu add separator
$mymenu add command -label [_ "Message..."] -accelerator "$accelerator+M"
create_preferences_menu $mymenu.preferences
$mymenu add cascade -label [_ "Preferences"] -menu $mymenu.preferences
$mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
$mymenu add separator
# the recent files get inserted in here by update_recentfiles_on_menu
$mymenu add separator
$mymenu add command -label [_ "Close"] -accelerator "$accelerator+W"
$mymenu add command -label [_ "Quit"] -accelerator "$accelerator+Q"\
-command {pdsend "pd verifyquit"}
}
# the "Edit", "Put", and "Find" menus do not have cross-platform differences
proc ::pd_menus::build_media_menu_win32 {mymenu} {
}
proc ::pd_menus::build_window_menu_win32 {mymenu} {
}
# the "Help" does not have cross-platform differences

384
tcl/pdtk_canvas.tcl Normal file
View file

@ -0,0 +1,384 @@
package provide pdtk_canvas 0.1
package require pd_bindings
namespace eval ::pdtk_canvas:: {
namespace export pdtk_canvas_popup
namespace export pdtk_canvas_editmode
namespace export pdtk_canvas_getscroll
namespace export pdtk_canvas_setparents
namespace export pdtk_canvas_reflecttitle
namespace export pdtk_canvas_menuclose
}
# One thing that is tricky to understand is the difference between a Tk
# 'canvas' and a 'canvas' in terms of Pd's implementation. They are similar,
# but not the same thing. In Pd code, a 'canvas' is basically a patch, while
# the Tk 'canvas' is the backdrop for drawing everything that is in a patch.
# The Tk 'canvas' is contained in a 'toplevel' window. That window has a Tk
# class of 'PatchWindow'.
# TODO figure out weird frameless window when you open a graph
#TODO: http://wiki.tcl.tk/11502
# MS Windows
#wm geometry . returns contentswidthxcontentsheight+decorationTop+decorationLeftEdge.
#and
#winfo rooty . returns contentsTop
#winfo rootx . returns contentsLeftEdge
# this proc is split out on its own to make it easy to override. This makes it
# easy for people to customize these calculations based on their Window
# Manager, desires, etc.
proc pdtk_canvas_place_window {width height geometry} {
set screenwidth [lindex [wm maxsize .] 0]
set screenheight [lindex [wm maxsize .] 1]
# read back the current geometry +posx+posy into variables
scan $geometry {%[+]%d%[+]%d} - x - y
# fit the geometry onto screen
set x [ expr $x % $screenwidth - $::windowframex]
set y [ expr $y % $screenheight - $::windowframey]
if {$width > $screenwidth} {
set width $screenwidth
set x 0
}
if {$height > $screenheight} {
set height [expr $screenheight - $::menubarsize - 30] ;# 30 for window framing
set y $::menubarsize
}
return [list $width $height ${width}x$height+$x+$y]
}
#------------------------------------------------------------------------------#
# canvas new/saveas
proc pdtk_canvas_new {mytoplevel width height geometry editable} {
set l [pdtk_canvas_place_window $width $height $geometry]
set width [lindex $l 0]
set height [lindex $l 1]
set geometry [lindex $l 2]
# release the window grab here so that the new window will
# properly get the Map and FocusIn events when its created
::pdwindow::busyrelease
# set the loaded array for this new window so things can track state
set ::loaded($mytoplevel) 0
toplevel $mytoplevel -width $width -height $height -class PatchWindow
wm group $mytoplevel .
$mytoplevel configure -menu $::patch_menubar
# we have to wait until $mytoplevel exists before we can generate
# a <<Loading>> event for it, that's why this is here and not in the
# started_loading_file proc. Perhaps this doesn't make sense tho
event generate $mytoplevel <<Loading>>
wm geometry $mytoplevel $geometry
wm minsize $mytoplevel $::canvas_minwidth $::canvas_minheight
set tkcanvas [tkcanvas_name $mytoplevel]
canvas $tkcanvas -width $width -height $height \
-highlightthickness 0 -scrollregion [list 0 0 $width $height] \
-xscrollcommand "$mytoplevel.xscroll set" \
-yscrollcommand "$mytoplevel.yscroll set"
scrollbar $mytoplevel.xscroll -orient horizontal -command "$tkcanvas xview"
scrollbar $mytoplevel.yscroll -orient vertical -command "$tkcanvas yview"
pack $tkcanvas -side left -expand 1 -fill both
# for some crazy reason, win32 mousewheel scrolling is in units of
# 120, and this forces Tk to interpret 120 to mean 1 scroll unit
if {$::windowingsystem eq "win32"} {
$tkcanvas configure -xscrollincrement 1 -yscrollincrement 1
}
::pd_bindings::patch_bindings $mytoplevel
# give focus to the canvas so it gets the events rather than the window
focus $tkcanvas
# let the scrollbar logic determine if it should make things scrollable
set ::xscrollable($tkcanvas) 0
set ::yscrollable($tkcanvas) 0
# init patch properties arrays
set ::editingtext($mytoplevel) 0
set ::childwindows($mytoplevel) {}
# this should be at the end so that the window and canvas are all ready
# before this variable changes.
set ::editmode($mytoplevel) $editable
}
# if the patch canvas window already exists, then make it come to the front
proc pdtk_canvas_raise {mytoplevel} {
wm deiconify $mytoplevel
raise $mytoplevel
set mycanvas $mytoplevel.c
focus $mycanvas
}
proc pdtk_canvas_saveas {name initialfile initialdir} {
if { ! [file isdirectory $initialdir]} {set initialdir $::env(HOME)}
set filename [tk_getSaveFile -initialfile $initialfile -initialdir $initialdir \
-defaultextension .pd -filetypes $::filetypes]
if {$filename eq ""} return; # they clicked cancel
set extension [file extension $filename]
set oldfilename $filename
set filename [regsub -- "$extension$" $filename [string tolower $extension]]
if { ! [regexp -- "\.(pd|pat|mxt)$" $filename]} {
# we need the file extention even on Mac OS X
set filename $filename.pd
}
# test again after downcasing and maybe adding a ".pd" on the end
if {$filename ne $oldfilename && [file exists $filename]} {
set answer [tk_messageBox -type okcancel -icon question -default cancel\
-message [_ "\"$filename\" already exists. Do you want to replace it?"]]
if {$answer eq "cancel"} return; # they clicked cancel
}
set dirname [file dirname $filename]
set basename [file tail $filename]
pdsend "$name savetofile [enquote_path $basename] [enquote_path $dirname]"
set ::filenewdir $dirname
# add to recentfiles
::pd_guiprefs::update_recentfiles $filename
}
##### ask user Save? Discard? Cancel?, and if so, send a message on to Pd ######
proc ::pdtk_canvas::pdtk_canvas_menuclose {mytoplevel reply_to_pd} {
raise $mytoplevel
set filename [wm title $mytoplevel]
set message [format {Do you want to save the changes you made in "%s"?} $filename]
set answer [tk_messageBox -message $message -type yesnocancel -default "yes" \
-parent $mytoplevel -icon question]
switch -- $answer {
yes {
pdsend "$mytoplevel menusave"
if {[regexp {Untitled-[0-9]+} $filename]} {
# wait until pdtk_canvas_saveas finishes and writes to
# this var, otherwise the close command will be sent
# immediately and the file won't get saved
vwait ::filenewdir
}
pdsend $reply_to_pd
}
no {pdsend $reply_to_pd}
cancel {}
}
}
#------------------------------------------------------------------------------#
# mouse usage
# TODO put these procs into the pdtk_canvas namespace
proc pdtk_canvas_motion {tkcanvas x y mods} {
set mytoplevel [winfo toplevel $tkcanvas]
pdsend "$mytoplevel motion [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $mods"
}
proc pdtk_canvas_mouse {tkcanvas x y b f} {
set mytoplevel [winfo toplevel $tkcanvas]
pdsend "$mytoplevel mouse [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b $f"
}
proc pdtk_canvas_mouseup {tkcanvas x y b} {
set mytoplevel [winfo toplevel $tkcanvas]
pdsend "$mytoplevel mouseup [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b"
}
proc pdtk_canvas_rightclick {tkcanvas x y b} {
set mytoplevel [winfo toplevel $tkcanvas]
pdsend "$mytoplevel mouse [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b 8"
}
# on X11, button 2 pastes from X11 clipboard, so simulate normal paste actions
proc pdtk_canvas_clickpaste {tkcanvas x y b} {
pdtk_canvas_mouse $tkcanvas $x $y $b 0
pdtk_canvas_mouseup $tkcanvas $x $y $b
if { [catch {set pdtk_pastebuffer [selection get]}] } {
# no selection... do nothing
} else {
for {set i 0} {$i < [string length $pdtk_pastebuffer]} {incr i 1} {
set cha [string index $pdtk_pastebuffer $i]
scan $cha %c keynum
pdsend "pd key 1 $keynum 0"
}
}
}
#------------------------------------------------------------------------------#
# canvas popup menu
# since there is one popup that is used for all canvas windows, the menu
# -commands use {} quotes so that $::focused_window is interpreted when the
# menu item is called, not when the command is mapped to the menu item. This
# is the same as the menubar in pd_menus.tcl but the opposite of the 'bind'
# commands in pd_bindings.tcl
proc ::pdtk_canvas::create_popup {} {
if { ! [winfo exists .popup]} {
# the popup menu for the canvas
menu .popup -tearoff false
.popup add command -label [_ "Properties"] \
-command {::pdtk_canvas::done_popup $::focused_window 0}
.popup add command -label [_ "Open"] \
-command {::pdtk_canvas::done_popup $::focused_window 1}
.popup add command -label [_ "Help"] \
-command {::pdtk_canvas::done_popup $::focused_window 2}
}
}
proc ::pdtk_canvas::done_popup {mytoplevel action} {
pdsend "$mytoplevel done-popup $action $::popup_xcanvas $::popup_ycanvas"
}
proc ::pdtk_canvas::pdtk_canvas_popup {mytoplevel xcanvas ycanvas hasproperties hasopen} {
set ::popup_xcanvas $xcanvas
set ::popup_ycanvas $ycanvas
if {$hasproperties} {
.popup entryconfigure [_ "Properties"] -state normal
} else {
.popup entryconfigure [_ "Properties"] -state disabled
}
if {$hasopen} {
.popup entryconfigure [_ "Open"] -state normal
} else {
.popup entryconfigure [_ "Open"] -state disabled
}
set tkcanvas [tkcanvas_name $mytoplevel]
set scrollregion [$tkcanvas cget -scrollregion]
# get the canvas location that is currently the top left corner in the window
set left_xview_pix [expr [lindex [$tkcanvas xview] 0] * [lindex $scrollregion 2]]
set top_yview_pix [expr [lindex [$tkcanvas yview] 0] * [lindex $scrollregion 3]]
# take the mouse clicks in canvas coords, add the root of the canvas
# window, and subtract the area that is obscured by scrolling
set xpopup [expr int($xcanvas + [winfo rootx $tkcanvas] - $left_xview_pix)]
set ypopup [expr int($ycanvas + [winfo rooty $tkcanvas] - $top_yview_pix)]
tk_popup .popup $xpopup $ypopup 0
}
#------------------------------------------------------------------------------#
# procs for when file loading starts/finishes
proc ::pdtk_canvas::started_loading_file {patchname} {
::pdwindow::busygrab
}
# things to run when a patch is finished loading. This is called when
# the OS sends the "Map" event for this window.
proc ::pdtk_canvas::finished_loading_file {mytoplevel} {
# ::pdwindow::busyrelease is in pdtk_canvas_new so that the grab
# is released before the new toplevel window gets created.
# Otherwise the grab blocks the new window from getting the
# FocusIn event on creation.
# set editmode to make sure the menu item is in the right state
pdtk_canvas_editmode $mytoplevel $::editmode($mytoplevel)
set ::loaded($mytoplevel) 1
# send the virtual events now that everything is loaded
event generate $mytoplevel <<Loaded>>
}
#------------------------------------------------------------------------------#
# procs for canvas events
# check or uncheck the "edit" menu item
proc ::pdtk_canvas::pdtk_canvas_editmode {mytoplevel state} {
set ::editmode_button $state
set ::editmode($mytoplevel) $state
event generate $mytoplevel <<EditMode>>
}
# message from Pd to update the currently available undo/redo action
proc pdtk_undomenu {mytoplevel undoaction redoaction} {
set ::undo_toplevel $mytoplevel
set ::undo_action $undoaction
set ::redo_action $redoaction
if {$mytoplevel ne "nobody"} {
::pd_menus::update_undo_on_menu $mytoplevel
}
}
# This proc configures the scrollbars whenever anything relevant has
# been updated. It should always receive a tkcanvas, which is then
# used to generate the mytoplevel, needed to address the scrollbars.
proc ::pdtk_canvas::pdtk_canvas_getscroll {tkcanvas} {
set mytoplevel [winfo toplevel $tkcanvas]
set bbox [$tkcanvas bbox all]
if {$bbox eq "" || [llength $bbox] != 4} {return}
set xupperleft [lindex $bbox 0]
set yupperleft [lindex $bbox 1]
if {$xupperleft > 0} {set xupperleft 0}
if {$yupperleft > 0} {set yupperleft 0}
set scrollregion [concat $xupperleft $yupperleft [lindex $bbox 2] [lindex $bbox 3]]
$tkcanvas configure -scrollregion $scrollregion
# X scrollbar
if {[lindex [$tkcanvas xview] 0] == 0.0 && [lindex [$tkcanvas xview] 1] == 1.0} {
set ::xscrollable($tkcanvas) 0
pack forget $mytoplevel.xscroll
} else {
set ::xscrollable($tkcanvas) 1
pack $mytoplevel.xscroll -side bottom -fill x -before $tkcanvas
}
# Y scrollbar, it gets touchy at the limit, so say > 0.995
if {[lindex [$tkcanvas yview] 0] == 0.0 && [lindex [$tkcanvas yview] 1] > 0.995} {
set ::yscrollable($tkcanvas) 0
pack forget $mytoplevel.yscroll
} else {
set ::yscrollable($tkcanvas) 1
pack $mytoplevel.yscroll -side right -fill y -before $tkcanvas
}
}
proc ::pdtk_canvas::scroll {tkcanvas axis amount} {
if {$axis eq "x" && $::xscrollable($tkcanvas) == 1} {
$tkcanvas xview scroll [expr {- ($amount)}] units
}
if {$axis eq "y" && $::yscrollable($tkcanvas) == 1} {
$tkcanvas yview scroll [expr {- ($amount)}] units
}
}
#------------------------------------------------------------------------------#
# get patch window child/parent relationships
# add a child window ID to the list of children, if it isn't already there
proc ::pdtk_canvas::addchild {mytoplevel child} {
# if either ::childwindows($mytoplevel) does not exist, or $child does not
# exist inside of the ::childwindows($mytoplevel list
if { [lsearch -exact [array names ::childwindows $mytoplevel]] == -1 \
|| [lsearch -exact $::childwindows($mytoplevel) $child] == -1} {
set ::childwindows($mytoplevel) [lappend ::childwindows($mytoplevel) $child]
}
}
# receive a list of all my parent windows from 'pd'
proc ::pdtk_canvas::pdtk_canvas_setparents {mytoplevel args} {
set ::parentwindows($mytoplevel) $args
foreach parent $args {
addchild $parent $mytoplevel
}
}
# receive information for setting the info the the title bar of the window
proc ::pdtk_canvas::pdtk_canvas_reflecttitle {mytoplevel \
path name arguments dirty} {
set ::windowname($mytoplevel) $name ;# TODO add path to this
if {$::windowingsystem eq "aqua"} {
wm attributes $mytoplevel -modified $dirty
if {[file exists "$path/$name"]} {
# for some reason -titlepath can still fail so just catch it
if [catch {wm attributes $mytoplevel -titlepath "$path/$name"}] {
wm title $mytoplevel "$path/$name"
}
}
wm title $mytoplevel "$name$arguments"
} else {
if {$dirty} {set dirtychar "*"} else {set dirtychar " "}
wm title $mytoplevel "$name$dirtychar$arguments - $path"
}
}

56
tcl/pdtk_text.tcl Normal file
View file

@ -0,0 +1,56 @@
package provide pdtk_text 0.1
# these procs are currently all in the global namespace because all of them
# are used by 'pd' and therefore need to be in the global namespace.
# create a new text object (ie. obj, msg, comment)
proc pdtk_text_new {tkcanvas tags x y text font_size color} {
$tkcanvas create text $x $y -tags $tags -text $text -fill $color \
-anchor nw -font [get_font_for_size $font_size]
set mytag [lindex $tags 0]
$tkcanvas bind $mytag <Home> "$tkcanvas icursor $mytag 0"
$tkcanvas bind $mytag <End> "$tkcanvas icursor $mytag end"
# select all
$tkcanvas bind $mytag <Triple-ButtonRelease-1> \
"pdtk_text_selectall $tkcanvas $mytag"
if {$::windowingsystem eq "aqua"} { # emacs bindings for Mac OS X
$tkcanvas bind $mytag <Control-a> "$tkcanvas icursor $mytag 0"
$tkcanvas bind $mytag <Control-e> "$tkcanvas icursor $mytag end"
}
}
# change the text in an existing text box
proc pdtk_text_set {tkcanvas tag text} {
$tkcanvas itemconfig $tag -text $text
}
# paste into an existing text box by literally "typing" the contents of the
# clipboard, i.e. send the contents one character at a time via 'pd key'
proc pdtk_pastetext {args} {
if { [catch {set pdtk_pastebuffer [clipboard get]}] } {
# no selection... do nothing
} else {
for {set i 0} {$i < [string length $pdtk_pastebuffer]} {incr i 1} {
set cha [string index $pdtk_pastebuffer $i]
scan $cha %c keynum
pdsend "pd key 1 $keynum 0"
}
}
}
# select all of the text in an existing text box
proc pdtk_text_selectall {tkcanvas mytag} {
if {$::editmode([winfo toplevel $tkcanvas])} {
$tkcanvas select from $mytag 0
$tkcanvas select to $mytag end
}
}
# de/activate a text box for editing based on $editing flag
proc pdtk_text_editing {mytoplevel tag editing} {
set tkcanvas [tkcanvas_name $mytoplevel]
if {$editing == 0} {selection clear $tkcanvas}
$tkcanvas focus $tag
set ::editingtext($mytoplevel) $editing
}

95
tcl/pdtk_textwindow.tcl Normal file
View file

@ -0,0 +1,95 @@
# Copyright (c) 2002-2012 krzYszcz and others.
# For information on usage and redistribution, and for a DISCLAIMER OF ALL
# WARRANTIES, see the file, "LICENSE.txt," in this distribution. */
# pdtk_textwindow - a window containing scrollable text for "qlist" and
# "textfile" objects - later the latter might get renamed just "text"
# this is adapted from krzYszcz's code for coll in cyclone
package provide pdtk_textwindow 0.1
# these procs are currently all in the global namespace because they're
# called from pd.
proc pdtk_textwindow_open {name geometry title font} {
if {[winfo exists $name]} {
$name.text delete 1.0 end
} else {
toplevel $name
wm title $name $title
wm geometry $name $geometry
wm protocol $name WM_DELETE_WINDOW \
[concat pdtk_textwindow_close $name 1]
bind $name <<Modified>> "pdtk_textwindow_dodirty $name"
text $name.text -relief raised -bd 2 \
-font [get_font_for_size $font] \
-yscrollcommand "$name.scroll set" -background white
scrollbar $name.scroll -command "$name.text yview"
pack $name.scroll -side right -fill y
pack $name.text -side left -fill both -expand 1
bind $name.text <$::modifier-Key-s> "pdtk_textwindow_send $name"
}
}
proc pdtk_textwindow_dodirty {name} {
if {[catch {$name.text edit modified} dirty]} {set dirty 1}
set title [wm title $name]
set dt [string equal -length 1 $title "*"]
if {$dirty} {
if {$dt == 0} {wm title $name *$title}
} else {
if {$dt} {wm title $name [string range $title 1 end]}
}
}
proc pdtk_textwindow_setdirty {name flag} {
if {[winfo exists $name]} {
catch {$name.text edit modified $flag}
}
}
proc pdtk_textwindow_doclose {name} {
destroy $name
pdsend [concat $name signoff]
}
proc pdtk_textwindow_append {name contents} {
if {[winfo exists $name]} {
$name.text insert end $contents
}
}
proc pdtk_textwindow_send {name} {
if {[winfo exists $name]} {
pdsend [concat $name clear]
for {set i 1} \
{[$name.text compare $i.end < end]} \
{incr i 1} {
set lin [$name.text get $i.0 $i.end]
if {$lin != ""} {
regsub -all \; $lin " \\; " tmplin
regsub -all \, $tmplin " \\, " lin
pdsend [concat $name addline $lin]
}
}
}
pdtk_textwindow_setdirty $name 0
}
proc pdtk_textwindow_close {name ask} {
if {[winfo exists $name]} {
if {[catch {$name.text edit modified} dirty]} {set dirty 1}
if {$ask && $dirty} {
set title [wm title $name]
if {[string equal -length 1 $title "*"]} {
set title [string range $title 1 end]
}
set answer [tk_messageBox \-type yesnocancel \
\-icon question \
\-message [concat Save changes to \"$title\"?]]
if {$answer == "yes"} {pdtk_textwindow_send $name}
if {$answer != "cancel"} {pdsend [concat $name close]}
} else {pdsend [concat $name close]}
}
}

400
tcl/pdwindow.tcl Normal file
View file

@ -0,0 +1,400 @@
package provide pdwindow 0.1
namespace eval ::pdwindow:: {
variable logbuffer {}
variable tclentry {}
variable tclentry_history {"console show"}
variable history_position 0
variable linecolor 0 ;# is toggled to alternate text line colors
variable logmenuitems
variable maxloglevel 4
variable lastlevel 0
namespace export create_window
namespace export pdtk_post
namespace export pdtk_pd_dsp
namespace export pdtk_pd_dio
}
# TODO make the Pd window save its size and location between running
proc ::pdwindow::set_layout {} {
variable maxloglevel
.pdwindow.text.internal tag configure log0 -foreground "#d00" -background "#ffe0e8"
.pdwindow.text.internal tag configure log1 -foreground "#d00"
# log2 messages are normal black on white
.pdwindow.text.internal tag configure log3 -foreground "#484848"
# 0-20(4-24) is a rough useful range of 'verbose' levels for impl debugging
set start 4
set end 25
for {set i $start} {$i < $end} {incr i} {
set B [expr int(($i - $start) * (40 / ($end - $start))) + 50]
.pdwindow.text.internal tag configure log${i} -foreground grey${B}
}
}
# grab focus on part of the Pd window when Pd is busy
proc ::pdwindow::busygrab {} {
# set the mouse cursor to look busy and grab focus so it stays that way
.pdwindow.text configure -cursor watch
grab set .pdwindow.text
}
# release focus on part of the Pd window when Pd is finished
proc ::pdwindow::busyrelease {} {
.pdwindow.text configure -cursor xterm
grab release .pdwindow.text
}
# ------------------------------------------------------------------------------
# pdtk functions for 'pd' to send data to the Pd window
proc ::pdwindow::buffer_message {object_id level message} {
variable logbuffer
lappend logbuffer $object_id $level $message
}
proc ::pdwindow::insert_log_line {object_id level message} {
if {$object_id eq ""} {
.pdwindow.text.internal insert end $message log$level
} else {
.pdwindow.text.internal insert end $message [list log$level obj$object_id]
.pdwindow.text.internal tag bind obj$object_id <$::modifier-ButtonRelease-1> \
"::pdwindow::select_by_id $object_id; break"
.pdwindow.text.internal tag bind obj$object_id <Key-Return> \
"::pdwindow::select_by_id $object_id; break"
.pdwindow.text.internal tag bind obj$object_id <Key-KP_Enter> \
"::pdwindow::select_by_id $object_id; break"
}
}
# this has 'args' to satisfy trace, but its not used
proc ::pdwindow::filter_buffer_to_text {args} {
variable logbuffer
variable maxloglevel
.pdwindow.text.internal delete 0.0 end
set i 0
foreach {object_id level message} $logbuffer {
if { $level <= $::loglevel || $maxloglevel == $::loglevel} {
insert_log_line $object_id $level $message
}
# this could take a while, so update the GUI every 10000 lines
if { [expr $i % 10000] == 0} {update idletasks}
incr i
}
.pdwindow.text.internal yview end
::pdwindow::verbose 10 "The Pd window filtered $i lines\n"
}
proc ::pdwindow::select_by_id {args} {
if [llength $args] { # Is $args empty?
pdsend "pd findinstance $args"
}
}
# logpost posts to Pd window with an object to trace back to and a
# 'log level'. The logpost and related procs are for generating
# messages that are useful for debugging patches. They are messages
# that are meant for the Pd programmer to see so that they can get
# information about the patches they are building
proc ::pdwindow::logpost {object_id level message} {
variable maxloglevel
variable lastlevel $level
buffer_message $object_id $level $message
if {[llength [info commands .pdwindow.text.internal]] &&
($level <= $::loglevel || $maxloglevel == $::loglevel)} {
# cancel any pending move of the scrollbar, and schedule it
# after writing a line. This way the scrollbar is only moved once
# when the inserting has finished, greatly speeding things up
after cancel .pdwindow.text.internal yview end
insert_log_line $object_id $level $message
after idle .pdwindow.text.internal yview end
}
# -stderr only sets $::stderr if 'pd-gui' is started before 'pd'
if {$::stderr} {puts stderr $message}
}
# shortcuts for posting to the Pd window
proc ::pdwindow::fatal {message} {logpost {} 0 $message}
proc ::pdwindow::error {message} {logpost {} 1 $message}
proc ::pdwindow::post {message} {logpost {} 2 $message}
proc ::pdwindow::debug {message} {logpost {} 3 $message}
# for backwards compatibility
proc ::pdwindow::bug {message} {logpost {} 3 $message}
proc ::pdwindow::pdtk_post {message} {post $message}
proc ::pdwindow::endpost {} {
variable linecolor
variable lastlevel
logpost {} $lastlevel "\n"
set linecolor [expr ! $linecolor]
}
# this verbose proc has a separate numbering scheme since its for
# debugging implementations, and therefore falls outside of the 0-3
# numbering on the Pd window. They should only be shown in ALL mode.
proc ::pdwindow::verbose {level message} {
incr level 4
logpost {} $level $message
}
# clear the log and the buffer
proc ::pdwindow::clear_console {} {
variable logbuffer {}
.pdwindow.text.internal delete 0.0 end
}
# save the contents of the pdwindow::logbuffer to a file
proc ::pdwindow::save_logbuffer_to_file {} {
variable logbuffer
set filename [tk_getSaveFile -initialfile "pdwindow.txt" -defaultextension .txt]
if {$filename eq ""} return; # they clicked cancel
set f [open $filename w]
puts $f "Pd $::PD_MAJOR_VERSION.$::PD_MINOR_VERSION.$::PD_BUGFIX_VERSION.$::PD_TEST_VERSION on $::windowingsystem"
puts $f "Tcl/Tk [info patchlevel]"
puts $f "------------------------------------------------------------------------------"
puts $f $logbuffer
close $f
}
#--compute audio/DSP checkbutton-----------------------------------------------#
# set the checkbox on the "Compute Audio" menuitem and checkbox
proc ::pdwindow::pdtk_pd_dsp {value} {
# TODO canvas_startdsp/stopdsp should really send 1 or 0, not "ON" or "OFF"
if {$value eq "ON"} {
set ::dsp 1
} else {
set ::dsp 0
}
}
proc ::pdwindow::pdtk_pd_dio {red} {
if {$red == 1} {
.pdwindow.header.dio configure -foreground red
} else {
.pdwindow.header.dio configure -foreground lightgray
}
}
#--bindings specific to the Pd window------------------------------------------#
proc ::pdwindow::pdwindow_bindings {} {
# these bindings are for the whole Pd window, minus the Tcl entry
foreach window {.pdwindow.text .pdwindow.header} {
bind $window <$::modifier-Key-x> "tk_textCut .pdwindow.text"
bind $window <$::modifier-Key-c> "tk_textCopy .pdwindow.text"
bind $window <$::modifier-Key-v> "tk_textPaste .pdwindow.text"
}
# Select All doesn't seem to work unless its applied to the whole window
bind .pdwindow <$::modifier-Key-a> ".pdwindow.text tag add sel 1.0 end"
# the "; break" part stops executing another binds, like from the Text class
# these don't do anything in the Pd window, so alert the user, then break
# so no more bindings run
bind .pdwindow <$::modifier-Key-s> "bell; break"
bind .pdwindow <$::modifier-Key-p> "bell; break"
# ways of hiding/closing the Pd window
if {$::windowingsystem eq "aqua"} {
# on Mac OS X, you can close the Pd window, since the menubar is there
bind .pdwindow <$::modifier-Key-w> "wm withdraw .pdwindow"
wm protocol .pdwindow WM_DELETE_WINDOW "wm withdraw .pdwindow"
} else {
# TODO should it possible to close the Pd window and keep Pd open?
bind .pdwindow <$::modifier-Key-w> "wm iconify .pdwindow"
wm protocol .pdwindow WM_DELETE_WINDOW "pdsend \"pd verifyquit\""
}
}
#--Tcl entry procs-------------------------------------------------------------#
proc ::pdwindow::eval_tclentry {} {
variable tclentry
variable tclentry_history
variable history_position 0
if {$tclentry eq ""} {return} ;# no need to do anything if empty
if {[catch {uplevel #0 $tclentry} errorname]} {
global errorInfo
switch -regexp -- $errorname {
"missing close-brace" {
::pdwindow::error [concat [_ "(Tcl) MISSING CLOSE-BRACE '\}': "] $errorInfo]\n
} "missing close-bracket" {
::pdwindow::error [concat [_ "(Tcl) MISSING CLOSE-BRACKET '\]': "] $errorInfo]\n
} "^invalid command name" {
::pdwindow::error [concat [_ "(Tcl) INVALID COMMAND NAME: "] $errorInfo]\n
} default {
::pdwindow::error [concat [_ "(Tcl) UNHANDLED ERROR: "] $errorInfo]\n
}
}
}
lappend tclentry_history $tclentry
set tclentry {}
}
proc ::pdwindow::get_history {direction} {
variable tclentry_history
variable history_position
incr history_position $direction
if {$history_position < 0} {set history_position 0}
if {$history_position > [llength $tclentry_history]} {
set history_position [llength $tclentry_history]
}
.pdwindow.tcl.entry delete 0 end
.pdwindow.tcl.entry insert 0 \
[lindex $tclentry_history end-[expr $history_position - 1]]
}
proc ::pdwindow::validate_tcl {} {
variable tclentry
if {[info complete $tclentry]} {
.pdwindow.tcl.entry configure -background "white"
} else {
.pdwindow.tcl.entry configure -background "#FFF0F0"
}
}
#--create tcl entry-----------------------------------------------------------#
proc ::pdwindow::create_tcl_entry {} {
# Tcl entry box frame
label .pdwindow.tcl.label -text [_ "Tcl:"] -anchor e
pack .pdwindow.tcl.label -side left
entry .pdwindow.tcl.entry -width 200 \
-exportselection 1 -insertwidth 2 -insertbackground blue \
-textvariable ::pdwindow::tclentry -font {$::font_family 12}
pack .pdwindow.tcl.entry -side left -fill x
# bindings for the Tcl entry widget
bind .pdwindow.tcl.entry <$::modifier-Key-a> "%W selection range 0 end; break"
bind .pdwindow.tcl.entry <Return> "::pdwindow::eval_tclentry"
bind .pdwindow.tcl.entry <Up> "::pdwindow::get_history 1"
bind .pdwindow.tcl.entry <Down> "::pdwindow::get_history -1"
bind .pdwindow.tcl.entry <KeyRelease> +"::pdwindow::validate_tcl"
bind .pdwindow.text <Key-Tab> "focus .pdwindow.tcl.entry; break"
}
proc ::pdwindow::set_findinstance_cursor {widget key state} {
set triggerkeys [list Control_L Control_R Meta_L Meta_R]
if {[lsearch -exact $triggerkeys $key] > -1} {
if {$state == 0} {
$widget configure -cursor xterm
} else {
$widget configure -cursor based_arrow_up
}
}
}
#--create the window-----------------------------------------------------------#
proc ::pdwindow::create_window {} {
variable logmenuitems
set ::loaded(.pdwindow) 0
# colorize by class before creating anything
option add *PdWindow*Entry.highlightBackground "grey" startupFile
option add *PdWindow*Frame.background "grey" startupFile
option add *PdWindow*Label.background "grey" startupFile
option add *PdWindow*Checkbutton.background "grey" startupFile
option add *PdWindow*Menubutton.background "grey" startupFile
option add *PdWindow*Text.background "white" startupFile
option add *PdWindow*Entry.background "white" startupFile
toplevel .pdwindow -class PdWindow
wm title .pdwindow [_ "Pd"]
set ::windowname(.pdwindow) [_ "Pd"]
if {$::windowingsystem eq "x11"} {
wm minsize .pdwindow 400 75
} else {
wm minsize .pdwindow 400 51
}
wm geometry .pdwindow =500x400+20+50
.pdwindow configure -menu .menubar
frame .pdwindow.header -borderwidth 1 -relief flat -background lightgray
pack .pdwindow.header -side top -fill x -ipady 5
frame .pdwindow.header.pad1
pack .pdwindow.header.pad1 -side left -padx 12
checkbutton .pdwindow.header.dsp -text [_ "DSP"] -variable ::dsp \
-font {$::font_family 18 bold} -takefocus 1 -background lightgray \
-borderwidth 0 -command {pdsend "pd dsp $::dsp"}
pack .pdwindow.header.dsp -side right -fill y -anchor e -padx 5 -pady 0
# DIO button
label .pdwindow.header.dio -text [_ "audio I/O error"] -borderwidth 0 \
-background lightgray -foreground lightgray \
-takefocus 0 \
-font {$::font_family 14}
pack .pdwindow.header.dio -side right -fill y -padx 30 -pady 0
label .pdwindow.header.loglabel -text [_ "Log:"] -anchor e \
-background lightgray
pack .pdwindow.header.loglabel -side left
set loglevels {0 1 2 3 4}
lappend logmenuitems "0 [_ fatal]"
lappend logmenuitems "1 [_ error]"
lappend logmenuitems "2 [_ normal]"
lappend logmenuitems "3 [_ debug]"
lappend logmenuitems "4 [_ all]"
set logmenu \
[eval tk_optionMenu .pdwindow.header.logmenu ::loglevel $loglevels]
.pdwindow.header.logmenu configure -background lightgray
foreach i $loglevels {
$logmenu entryconfigure $i -label [lindex $logmenuitems $i]
}
trace add variable ::loglevel write ::pdwindow::filter_buffer_to_text
# TODO figure out how to make the menu traversable with the keyboard
#.pdwindow.header.logmenu configure -takefocus 1
pack .pdwindow.header.logmenu -side left
frame .pdwindow.tcl -borderwidth 0
pack .pdwindow.tcl -side bottom -fill x
# TODO this should use the pd_font_$size created in pd-gui.tcl
text .pdwindow.text -relief raised -bd 2 -font {-size 10} \
-highlightthickness 0 -borderwidth 1 -relief flat \
-yscrollcommand ".pdwindow.scroll set" -width 60 \
-undo false -autoseparators false -maxundo 1 -takefocus 0
scrollbar .pdwindow.scroll -command ".pdwindow.text.internal yview"
pack .pdwindow.scroll -side right -fill y
pack .pdwindow.text -side right -fill both -expand 1
raise .pdwindow
focus .pdwindow.text
# run bindings last so that .pdwindow.tcl.entry exists
pdwindow_bindings
# set cursor to show when clicking in 'findinstance' mode
bind .pdwindow <KeyPress> "+::pdwindow::set_findinstance_cursor %W %K %s"
bind .pdwindow <KeyRelease> "+::pdwindow::set_findinstance_cursor %W %K %s"
# hack to make a good read-only text widget from http://wiki.tcl.tk/1152
rename ::.pdwindow.text ::.pdwindow.text.internal
proc ::.pdwindow.text {args} {
switch -exact -- [lindex $args 0] {
"insert" {}
"delete" {}
"default" { return [eval ::.pdwindow.text.internal $args] }
}
}
# print whatever is in the queue after the event loop finishes
after idle [list after 0 ::pdwindow::filter_buffer_to_text]
set ::loaded(.pdwindow) 1
# set some layout variables
::pdwindow::set_layout
# wait until .pdwindow.tcl.entry is visible before opening files so that
# the loading logic can grab it and put up the busy cursor
tkwait visibility .pdwindow.text
# create_tcl_entry
}

37
tcl/pkgIndex.tcl Normal file
View file

@ -0,0 +1,37 @@
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script. It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands. When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.
package ifneeded apple_events 0.1 [list source [file join $dir apple_events.tcl]]
package ifneeded pd_bindings 0.1 [list source [file join $dir pd_bindings.tcl]]
package ifneeded pd_connect 0.1 [list source [file join $dir pd_connect.tcl]]
package ifneeded dialog_array 0.1 [list source [file join $dir dialog_array.tcl]]
package ifneeded dialog_audio 0.1 [list source [file join $dir dialog_audio.tcl]]
package ifneeded dialog_canvas 0.1 [list source [file join $dir dialog_canvas.tcl]]
package ifneeded dialog_data 0.1 [list source [file join $dir dialog_data.tcl]]
package ifneeded dialog_find 0.1 [list source [file join $dir dialog_find.tcl]]
package ifneeded dialog_font 0.1 [list source [file join $dir dialog_font.tcl]]
package ifneeded dialog_gatom 0.1 [list source [file join $dir dialog_gatom.tcl]]
package ifneeded dialog_iemgui 0.1 [list source [file join $dir dialog_iemgui.tcl]]
package ifneeded dialog_message 0.1 [list source [file join $dir dialog_message.tcl]]
package ifneeded dialog_midi 0.1 [list source [file join $dir dialog_midi.tcl]]
package ifneeded dialog_path 0.1 [list source [file join $dir dialog_path.tcl]]
package ifneeded dialog_startup 0.1 [list source [file join $dir dialog_startup.tcl]]
package ifneeded helpbrowser 0.1 [list source [file join $dir helpbrowser.tcl]]
package ifneeded opt_parser 0.1 [list source [file join $dir opt_parser.tcl]]
package ifneeded pd_guiprefs 0.1 [list source [file join $dir pd_guiprefs.tcl]]
package ifneeded pdwindow 0.1 [list source [file join $dir pdwindow.tcl]]
package ifneeded pd_menucommands 0.1 [list source [file join $dir pd_menucommands.tcl]]
package ifneeded pd_menus 0.1 [list source [file join $dir pd_menus.tcl]]
package ifneeded pdtk_canvas 0.1 [list source [file join $dir pdtk_canvas.tcl]]
package ifneeded pdtk_text 0.1 [list source [file join $dir pdtk_text.tcl]]
package ifneeded pdtk_textwindow 0.1 [list source [file join $dir pdtk_textwindow.tcl]]
package ifneeded scrollbox 0.1 [list source [file join $dir scrollbox.tcl]]
package ifneeded scrollboxwindow 0.1 [list source [file join $dir scrollboxwindow.tcl]]
package ifneeded wheredoesthisgo 0.1 [list source [file join $dir wheredoesthisgo.tcl]]

9
tcl/pkg_mkIndex.tcl Executable file
View file

@ -0,0 +1,9 @@
#!/usr/bin/tclsh
puts stdout "Watch out, this doesn't work on packages with namespace import"
pkg_mkIndex -verbose -- [pwd] *.tcl *.[info sharedlibextension]
## this currently needs to be added to pkg_mkIndex manually, ug
#package ifneeded pd_menus 0.1 [list source [file join $dir pd_menus.tcl]]

191
tcl/scrollbox.tcl Normal file
View file

@ -0,0 +1,191 @@
######### scrollbox -- utility scrollbar with default bindings #######
# scrollbox is used in the Path and Startup dialogs to edit lists of options
package provide scrollbox 0.1
namespace eval scrollbox {
# This variable keeps track of the last list element we clicked on,
# used to implement drag-drop reordering of list items
variable lastIdx 0
}
proc ::scrollbox::get_curidx { mytoplevel } {
set idx [$mytoplevel.listbox.box index active]
if {$idx < 0 || \
$idx == [$mytoplevel.listbox.box index end]} {
return [expr {[$mytoplevel.listbox.box index end] + 1}]
}
return [expr $idx]
}
proc ::scrollbox::insert_item { mytoplevel idx name } {
if {$name != ""} {
$mytoplevel.listbox.box insert $idx $name
set activeIdx [expr {[$mytoplevel.listbox.box index active] + 1}]
$mytoplevel.listbox.box see $activeIdx
$mytoplevel.listbox.box activate $activeIdx
$mytoplevel.listbox.box selection clear 0 end
$mytoplevel.listbox.box selection set active
focus $mytoplevel.listbox.box
}
}
proc ::scrollbox::add_item { mytoplevel add_method } {
set dir [$add_method]
insert_item $mytoplevel [expr {[get_curidx $mytoplevel] + 1}] $dir
}
proc ::scrollbox::edit_item { mytoplevel edit_method } {
set idx [expr {[get_curidx $mytoplevel]}]
set initialValue [$mytoplevel.listbox.box get $idx]
if {$initialValue != ""} {
set dir [$edit_method $initialValue]
if {$dir != ""} {
$mytoplevel.listbox.box delete $idx
insert_item $mytoplevel $idx $dir
}
$mytoplevel.listbox.box activate $idx
$mytoplevel.listbox.box selection clear 0 end
$mytoplevel.listbox.box selection set active
focus $mytoplevel.listbox.box
}
}
proc ::scrollbox::delete_item { mytoplevel } {
set cursel [$mytoplevel.listbox.box curselection]
foreach idx $cursel {
$mytoplevel.listbox.box delete $idx
}
}
# Double-clicking on the listbox should edit the current item,
# or add a new one if there is no current
proc ::scrollbox::dbl_click { mytoplevel edit_method add_method x y } {
if { $x == "" || $y == "" } {
return
}
set curBB [$mytoplevel.listbox.box bbox @$x,$y]
# listbox bbox returns an array of 4 items in the order:
# left, top, width, height
set height [lindex $curBB 3]
set top [lindex $curBB 1]
if { $height == "" || $top == "" } {
# If for some reason we didn't get valid bbox info,
# we want to default to adding a new item
set height 0
set top 0
set y 1
}
set bottom [expr {$height + $top}]
if {$y > $bottom} {
add_item $mytoplevel $add_method
} else {
edit_item $mytoplevel $edit_method
}
}
proc ::scrollbox::click { mytoplevel x y } {
# record the index of the current element being
# clicked on
variable ::lastIdx [$mytoplevel.listbox.box index @$x,$y]
focus $mytoplevel.listbox.box
}
# For drag-and-drop reordering, recall the last-clicked index
# and move it to the position of the item currently under the mouse
proc ::scrollbox::release { mytoplevel x y } {
variable lastIdx
set curIdx [$mytoplevel.listbox.box index @$x,$y]
if { $curIdx != $::lastIdx } {
# clear any current selection
$mytoplevel.listbox.box selection clear 0 end
set oldIdx $::lastIdx
set newIdx [expr {$curIdx+1}]
set selIdx $curIdx
if { $curIdx < $::lastIdx } {
set oldIdx [expr {$::lastIdx + 1}]
set newIdx $curIdx
set selIdx $newIdx
}
$mytoplevel.listbox.box insert $newIdx [$mytoplevel.listbox.box get $::lastIdx]
$mytoplevel.listbox.box delete $oldIdx
$mytoplevel.listbox.box activate $newIdx
$mytoplevel.listbox.box selection set $selIdx
}
}
# Make a scrollbox widget in a given window and set of data.
#
# id - the parent window for the scrollbox
# listdata - array of data to populate the scrollbox
# add_method - method to be called when we add a new item
# edit_method - method to be called when we edit an existing item
proc ::scrollbox::make { mytoplevel listdata add_method edit_method } {
frame $mytoplevel.listbox
listbox $mytoplevel.listbox.box \
-selectmode browse -activestyle dotbox \
-yscrollcommand [list "$mytoplevel.listbox.scrollbar" set]
# Create a scrollbar and keep it in sync with the current
# listbox view
pack $mytoplevel.listbox.box [scrollbar "$mytoplevel.listbox.scrollbar" \
-command [list $mytoplevel.listbox.box yview]] \
-side left -fill y -anchor w
# Populate the listbox widget
foreach item $listdata {
$mytoplevel.listbox.box insert end $item
}
# Standard listbox key/mouse bindings
event add <<Delete>> <Delete>
if { $::windowingsystem eq "aqua" } { event add <<Delete>> <BackSpace> }
bind $mytoplevel.listbox.box <ButtonPress> "::scrollbox::click $mytoplevel %x %y"
bind $mytoplevel.listbox.box <Double-1> "::scrollbox::dbl_click $mytoplevel $edit_method $add_method %x %y"
bind $mytoplevel.listbox.box <ButtonRelease> "::scrollbox::release $mytoplevel %x %y"
bind $mytoplevel.listbox.box <Return> "::scrollbox::edit_item $mytoplevel $edit_method"
bind $mytoplevel.listbox.box <<Delete>> "::scrollbox::delete_item $mytoplevel"
# <Configure> is called when the user modifies the window
# We use it to capture resize events, to make sure the
# currently selected item in the listbox is always visible
bind $mytoplevel <Configure> "$mytoplevel.listbox.box see active"
# The listbox should expand to fill its containing window
# the "-fill" option specifies which direction (x, y or both) to fill, while
# the "-expand" option (false by default) specifies whether the widget
# should fill
pack $mytoplevel.listbox.box -side left -fill both -expand 1
pack $mytoplevel.listbox -side top -pady 2m -padx 2m -fill both -expand 1
# All widget interactions can be performed without buttons, but
# we still need a "New..." button since the currently visible window
# might be full (even though the user can still expand it)
frame $mytoplevel.actions
pack $mytoplevel.actions -side top -padx 2m -fill x
button $mytoplevel.actions.add_path -text {New...} \
-command "::scrollbox::add_item $mytoplevel $add_method"
button $mytoplevel.actions.edit_path -text {Edit...} \
-command "::scrollbox::edit_item $mytoplevel $edit_method"
button $mytoplevel.actions.delete_path -text {Delete} \
-command "::scrollbox::delete_item $mytoplevel"
pack $mytoplevel.actions.delete_path -side right -pady 2m
pack $mytoplevel.actions.edit_path -side right -pady 2m
pack $mytoplevel.actions.add_path -side right -pady 2m
$mytoplevel.listbox.box activate end
$mytoplevel.listbox.box selection set end
focus $mytoplevel.listbox.box
}

94
tcl/scrollboxwindow.tcl Normal file
View file

@ -0,0 +1,94 @@
####### scrollboxwindow -- scrollbox window with default bindings #########
## This is the base dialog behind the Path and Startup dialogs
## This namespace specifies everything the two dialogs have in common,
## with arguments specifying the differences
##
## By default, this creates a dialog centered on the viewing area of the screen
## with cancel, apply, and OK buttons
## which contains a scrollbox widget populated with the given data
package provide scrollboxwindow 0.1
package require scrollbox
namespace eval scrollboxwindow {
}
proc ::scrollboxwindow::get_listdata {mytoplevel} {
return [$mytoplevel.listbox.box get 0 end]
}
proc ::scrollboxwindow::do_apply {mytoplevel commit_method listdata} {
$commit_method [pdtk_encode $listdata]
pdsend "pd save-preferences"
}
# Cancel button action
proc ::scrollboxwindow::cancel {mytoplevel} {
pdsend "$mytoplevel cancel"
}
# Apply button action
proc ::scrollboxwindow::apply {mytoplevel commit_method } {
do_apply $mytoplevel $commit_method [get_listdata $mytoplevel]
}
# OK button action
# The "commit" action can take a second or more,
# long enough to be noticeable, so we only write
# the changes after closing the dialog
proc ::scrollboxwindow::ok {mytoplevel commit_method } {
set listdata [get_listdata $mytoplevel]
cancel $mytoplevel
do_apply $mytoplevel $commit_method $listdata
}
# "Constructor" function for building the window
# id -- the window id to use
# listdata -- the data used to populate the scrollbox
# add_method -- a reference to a proc to be called when the user adds a new item
# edit_method -- same as above, for editing and existing item
# commit_method -- same as above, to commit during the "apply" action
# title -- top-level title for the dialog
# width, height -- initial width and height dimensions for the window, also minimum size
proc ::scrollboxwindow::make {mytoplevel listdata add_method edit_method commit_method title width height } {
wm deiconify .pdwindow
raise .pdwindow
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel $title
wm group $mytoplevel .
wm transient $mytoplevel .pdwindow
wm protocol $mytoplevel WM_DELETE_WINDOW "::scrollboxwindow::cancel $mytoplevel"
# Enforce a minimum size for the window
wm minsize $mytoplevel $width $height
# Set the current dimensions of the window
wm geometry $mytoplevel "${width}x${height}"
# Add the scrollbox widget
::scrollbox::make $mytoplevel $listdata $add_method $edit_method
# Use two frames for the buttons, since we want them both
# bottom and right
frame $mytoplevel.nb
pack $mytoplevel.nb -side bottom -fill x -pady 2m
frame $mytoplevel.nb.buttonframe
pack $mytoplevel.nb.buttonframe -side right -padx 2m
button $mytoplevel.nb.buttonframe.cancel -text [_ "Cancel"]\
-command "::scrollboxwindow::cancel $mytoplevel"
button $mytoplevel.nb.buttonframe.apply -text [_ "Apply"]\
-command "::scrollboxwindow::apply $mytoplevel $commit_method"
button $mytoplevel.nb.buttonframe.ok -text [_ "OK"]\
-command "::scrollboxwindow::ok $mytoplevel $commit_method"
pack $mytoplevel.nb.buttonframe.cancel -side left -expand 1 -padx 2m
pack $mytoplevel.nb.buttonframe.apply -side left -expand 1 -padx 2m
pack $mytoplevel.nb.buttonframe.ok -side left -expand 1 -padx 2m
}

111
tcl/wheredoesthisgo.tcl Normal file
View file

@ -0,0 +1,111 @@
package provide wheredoesthisgo 0.1
# a place to temporarily store things until they find a home or go away
proc open_file {filename} {
set directory [file normalize [file dirname $filename]]
set basename [file tail $filename]
if {
[file exists $filename]
&& [regexp -nocase -- "\.(pd|pat|mxt)$" $filename]
} then {
::pdtk_canvas::started_loading_file [format "%s/%s" $basename $filename]
pdsend "pd open [enquote_path $basename] [enquote_path $directory]"
# now this is done in pd_guiprefs
::pd_guiprefs::update_recentfiles $filename
} {
::pdwindow::post [format [_ "Ignoring '%s': doesn't look like a Pd-file"] $filename]
}
}
# ------------------------------------------------------------------------------
# procs for panels (openpanel, savepanel)
proc pdtk_openpanel {target localdir} {
if {! [file isdirectory $localdir]} {
if { ! [file isdirectory $::fileopendir]} {
set ::fileopendir $::env(HOME)
}
set localdir $::fileopendir
}
set filename [tk_getOpenFile -initialdir $localdir]
if {$filename ne ""} {
set ::fileopendir [file dirname $filename]
pdsend "$target callback [enquote_path $filename]"
}
}
proc pdtk_savepanel {target localdir} {
if {! [file isdirectory $localdir]} {
if { ! [file isdirectory $::filenewdir]} {
set ::filenewdir $::env(HOME)
}
set localdir $::filenewdir
}
set filename [tk_getSaveFile -initialdir $localdir]
if {$filename ne ""} {
pdsend "$target callback [enquote_path $filename]"
}
}
# ------------------------------------------------------------------------------
# window info (name, path, parents, children, etc.)
proc lookup_windowname {mytoplevel} {
set window [array get ::windowname $mytoplevel]
if { $window ne ""} {
return [lindex $window 1]
} else {
return ERROR
}
}
proc tkcanvas_name {mytoplevel} {
return "$mytoplevel.c"
}
# ------------------------------------------------------------------------------
# quoting functions
# enquote a string for find, path, and startup dialog panels, to be decoded by
# sys_decodedialog()
proc pdtk_encodedialog {x} {
concat +[string map {" " "+_" "$" "+d" ";" "+s" "," "+c" "+" "++"} $x]
}
# encode a list with pdtk_encodedialog
proc pdtk_encode { listdata } {
set outlist {}
foreach this_path $listdata {
if {0==[string match "" $this_path]} {
lappend outlist [pdtk_encodedialog $this_path]
}
}
return $outlist
}
# TODO enquote a filename to send it to pd, " isn't handled properly tho...
proc enquote_path {message} {
string map {"," "\\," ";" "\\;" " " "\\ "} $message
}
#enquote a string to send it to Pd. Blow off semi and comma; alias spaces
#we also blow off "{", "}", "\" because they'll just cause bad trouble later.
proc unspace_text {x} {
set y [string map {" " "_" ";" "" "," "" "{" "" "}" "" "\\" ""} $x]
if {$y eq ""} {set y "empty"}
concat $y
}
# ------------------------------------------------------------------------------
# watchdog functions
proc pdtk_watchdog {} {
pdsend "pd watchdog"
after 2000 {pdtk_watchdog}
}
proc pdtk_ping {} {
pdsend "pd ping"
}