home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / misc / volume37 / xdrum / part01 < prev    next >
Encoding:
Text File  |  1993-05-15  |  59.6 KB  |  2,147 lines
  1. Newsgroups: comp.sources.misc
  2. From: durian@advtech.uswest.com (Mike Durian)
  3. Subject: v37i048:  xdrum - create and edit drum patterns, Part01/02
  4. Message-ID: <csm-v37i048=xdrum.123859@sparky.IMD.Sterling.COM>
  5. X-Md4-Signature: 7849343278f93bd20863b159e7f3798e
  6. Date: Tue, 11 May 1993 17:39:11 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: durian@advtech.uswest.com (Mike Durian)
  10. Posting-number: Volume 37, Issue 48
  11. Archive-name: xdrum/part01
  12. Environment: X11, tcl, tk, tclm, BSD/386, Esix SysV, SunOS
  13.  
  14. Xdrum is a wishm script that allows you to create and edit drum
  15. patterns under X11.  These patterns can then be saved as Standard
  16. MIDI Files for use by other programs, or as ASCII files for text
  17. editing and re-loading.  Xdrum is requires tcl, tk and tclm.
  18.  
  19. mike
  20. ---------------
  21. #! /bin/sh
  22. # This is a shell archive.  Remove anything before this line, then unpack
  23. # it by saving it into a file and typing "sh file".  To overwrite existing
  24. # files, type "sh file -c".  You can also feed this as standard input via
  25. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  26. # will see the following message at the end:
  27. #        "End of archive 1 (of 2)."
  28. # Contents:  xdrum-1.0 xdrum-1.0/Blurb xdrum-1.0/INSTALL
  29. #   xdrum-1.0/Makefile xdrum-1.0/README xdrum-1.0/XDrum.ad
  30. #   xdrum-1.0/drumgrid.3 xdrum-1.0/main.c xdrum-1.0/patchlevel.h
  31. #   xdrum-1.0/tkm.h xdrum-1.0/wishm.tcl xdrum-1.0/wishmversion.3
  32. #   xdrum-1.0/xdrum xdrum-1.0/xdrum.1
  33. # Wrapped by durian@angeleys on Fri May  7 13:06:25 1993
  34. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  35. if test ! -d 'xdrum-1.0' ; then
  36.     echo shar: Creating directory \"'xdrum-1.0'\"
  37.     mkdir 'xdrum-1.0'
  38. fi
  39. if test -f 'xdrum-1.0/Blurb' -a "${1}" != "-c" ; then 
  40.   echo shar: Will not clobber existing file \"'xdrum-1.0/Blurb'\"
  41. else
  42. echo shar: Extracting \"'xdrum-1.0/Blurb'\" \(259 characters\)
  43. sed "s/^X//" >'xdrum-1.0/Blurb' <<'END_OF_FILE'
  44. X  Xdrum is a wishm script that allows you to create and edit drum
  45. patterns under X11.  These patterns can then be saved as Standard
  46. MIDI Files for use by other programs, or as ASCII files for text
  47. editing and re-loading.
  48. X  Xdrum is requires tcl, tk and tclm.
  49. END_OF_FILE
  50. if test 259 -ne `wc -c <'xdrum-1.0/Blurb'`; then
  51.     echo shar: \"'xdrum-1.0/Blurb'\" unpacked with wrong size!
  52. fi
  53. # end of 'xdrum-1.0/Blurb'
  54. fi
  55. if test -f 'xdrum-1.0/INSTALL' -a "${1}" != "-c" ; then 
  56.   echo shar: Will not clobber existing file \"'xdrum-1.0/INSTALL'\"
  57. else
  58. echo shar: Extracting \"'xdrum-1.0/INSTALL'\" \(1302 characters\)
  59. sed "s/^X//" >'xdrum-1.0/INSTALL' <<'END_OF_FILE'
  60. X  Installation for xdrum-1.0     May 5, 1993
  61. X
  62. X  1) Get tcl, tk and tclm.  Tk comes with tcl, so if you
  63. get tk, you don't have to get tcl separately.  As of today,
  64. the latest version of tk is tk3.2 and the latest version
  65. of tcl is tcl6.7.  They are both available at sprite.berkeley.edu
  66. in the tcl directory.
  67. X     The latest release of tclm is tclm-1.0.  It can be found
  68. at comp.sources.misc archive sites and harbor.ecn.purdue.edu.
  69. Most likely it is available where you picked this up.
  70. X
  71. X  2) Build and install the aforementioned packages.  See
  72. their documentation on how to do this.
  73. X
  74. X  3) Edit the Makefile.  Check out the stuff near the top
  75. and change the paths as necessary.  If you change the install
  76. directory, you'll also have to change the first line of
  77. the xdrum script to point to the correct location of wishm.
  78. X
  79. X  4) make
  80. X
  81. X  5) make install
  82. X
  83. X  6) If you want to install you man pages, either
  84. make install-man-cooked (the default) or make install-man-raw.
  85. install-man-cooked formats the man pages and copies the
  86. formatted document to the man dir.  install-man-raw installs
  87. the unformatted document.
  88. X     You probably want to use the cooked option, as the man pages
  89. use the mdoc macros and not the older man macros.  I don't think
  90. man(1) knows to process the files with mdoc.
  91. X
  92. X  7) You're done.
  93. END_OF_FILE
  94. if test 1302 -ne `wc -c <'xdrum-1.0/INSTALL'`; then
  95.     echo shar: \"'xdrum-1.0/INSTALL'\" unpacked with wrong size!
  96. fi
  97. # end of 'xdrum-1.0/INSTALL'
  98. fi
  99. if test -f 'xdrum-1.0/Makefile' -a "${1}" != "-c" ; then 
  100.   echo shar: Will not clobber existing file \"'xdrum-1.0/Makefile'\"
  101. else
  102. echo shar: Extracting \"'xdrum-1.0/Makefile'\" \(3232 characters\)
  103. sed "s/^X//" >'xdrum-1.0/Makefile' <<'END_OF_FILE'
  104. X#
  105. X# XINCDIR is the directory for the X11 include files.
  106. X#
  107. XXINCDIR = /usr/X11/include
  108. X
  109. X#
  110. X# XLIBDIR is the directory for the X11 library files.
  111. X#
  112. XXLIBDIR = /usr/X11/lib
  113. X
  114. X#
  115. X# XTRALIBS are any extra libraries your system might want
  116. X# for instance a SVR4 system might want -lns -lnsl -lsocket
  117. X#
  118. X# XTRALIBS = -lns -lnsl -lsocket
  119. XXTRALIBS =
  120. X
  121. X#
  122. X# INSTALL is the install program
  123. X#
  124. X# INSTALL = cp
  125. INSTALL = install
  126. X
  127. X#
  128. X# INSTALLEXECFLAG are the flags used when installing executables
  129. X#
  130. X# INSTALLEXECFLAG =
  131. INSTALLEXECFLAG = -c -m 755
  132. X
  133. X#
  134. X# INSTALLTEXTFLAG are the flags used when installing text files
  135. X#
  136. X# INSTALLTEXTFLAG =
  137. INSTALLTEXTFLAG = -c -m 644
  138. X
  139. X#
  140. X# INSTALLMANFLAG are the flags used when installing the man pages
  141. X#
  142. X# INSTALLMANFLAG =
  143. INSTALLMANFLAG = -c -m 444 -o bin -g bin
  144. X
  145. X#
  146. X# INSTALLDIR is the directory where wishm and xdrum should go.
  147. X# If you change this, be sure to change the 1st line of
  148. X# xdrum script so the path to wishm is correct.
  149. X#
  150. INSTALLDIR = /usr/local/bin
  151. X
  152. X#
  153. X# TKLIBDIR is the directory where the wishm.tcl startup
  154. X# script should go.  wishm.tcl contains the default bindings
  155. X# for the drumgrid widget
  156. X#
  157. TKLIBDIR = /usr/local/lib/tk
  158. X
  159. X#
  160. X# LIBDIR is the directory where libraries like libtcl.a, libtk.a,
  161. X# and libtclm.a can be found.
  162. X#
  163. LIBDIR = /usr/local/lib
  164. X
  165. X#
  166. X# INCDIR is the directory where include files like tk.h, tclm.h
  167. X# mutil.h can be found
  168. X#
  169. INCDIR = /usr/local/include
  170. X
  171. X#
  172. X# If you don't have or don't need ranlib, set this to true
  173. X#
  174. X# RANLIB = true
  175. RANLIB = ranlib
  176. X
  177. X#
  178. X# NROFF is the command to format the man pages
  179. X#
  180. NROFF = groff -mdoc -Tascii
  181. X
  182. X#
  183. X# MANDIR is the directory when the man pages go
  184. X#
  185. MANDIR = /usr/local/man
  186. X
  187. X#
  188. X# MANSUB is the subdirectory for man pages
  189. X#
  190. X# MANSUB = man
  191. MANSUB = cat
  192. X
  193. X#
  194. X# MANEXT1 is the extension for man section 1 pages
  195. X#
  196. MANEXT1 = 1
  197. X
  198. X#
  199. X# MANEXT3 is the extension for man section 3 pages
  200. X#
  201. MANEXT3 = 3
  202. X
  203. TKMSRCS = tkmGrid.c
  204. TKMOBJS = tkmGrid.o
  205. TKMLIB = libtkm.a
  206. X
  207. WISHMSRCS = main.c
  208. WISHMOBJS = main.o
  209. WISHMEXEC = wishm
  210. X
  211. SCRIPTS = xdrum
  212. X
  213. MAN1 = xdrum.1
  214. MAN3 = drumgrid.3 wishmversion.3
  215. X
  216. MAN10 = xdrum.0
  217. MAN30 = drumgrid.0 wishmversion.0
  218. X
  219. LIBPATH = -L. -L$(LIBDIR) -L$(XLIBDIR)
  220. LIBS = -ltkm -ltclm -lmutil -ltk -ltcl -lX11 -lm $(XTRALIBS)
  221. LFLAGS = $(LIBPATH) $(LIBS)
  222. X
  223. CFLAGS = -O -I$(INCDIR) -I$(XINCDIR)
  224. X
  225. CC = cc
  226. X
  227. X.SUFFIXES: $(.SUFFIXES) .0 .1 .3
  228. X
  229. X$(WISHMEXEC): $(WISHMOBJS) $(TKMLIB)
  230. X    $(CC) -o $(WISHMEXEC) $(WISHMOBJS) $(LFLAGS)
  231. X
  232. X$(TKMLIB): $(TKMOBJS)
  233. X    ar cr $(TKMLIB) $(TKMOBJS)
  234. X    $(RANLIB) $(TKMLIB)
  235. X
  236. install: $(WISHMEXEC)
  237. X    $(INSTALL) $(INSTALLEXECFLAG) $(WISHMEXEC) $(SCRIPTS) $(INSTALLDIR)
  238. X    $(INSTALL) $(INSTALLTEXTFLAG) wishm.tcl $(TKLIBDIR)
  239. X    $(INSTALL) $(INSTALLTEXTFLAG) $(TKMLIB) $(LIBDIR)
  240. X    $(RANLIB) $(LIBDIR)/$(TKMLIB)
  241. X    $(INSTALL) $(INSTALLTEXTFLAG) tkm.h $(INCDIR)
  242. X
  243. X
  244. install-man-cooked: $(MAN10) $(MAN30)
  245. X    $(INSTALL) $(INSTALLMANFLAG) $(MAN10) $(MANDIR)/$(MANSUB)$(MANEXT1)
  246. X    $(INSTALL) $(INSTALLMANFLAG) $(MAN30) $(MANDIR)/$(MANSUB)$(MANEXT3)
  247. X
  248. install-man-raw:
  249. X    $(INSTALL) $(INSTALLMANFLAG) $(MAN1) $(MANDIR)/$(MANSUB)$(MANEXT1)
  250. X    $(INSTALL) $(INSTALLMANFLAG) $(MAN3) $(MANDIR)/$(MANSUB)$(MANEXT3)
  251. X
  252. X.1.0:
  253. X    $(NROFF) $< > $@
  254. X
  255. X.3.0:
  256. X    $(NROFF) $< > $@
  257. X
  258. clean:
  259. X    rm -f $(WISHMOBJS) $(TKMOBJS) $(TKMLIB) $(WISHMEXEC) errlist core* \
  260. X        $(MAN10) $(MAN30)
  261. X
  262. tkmGrid.o: tkm.h
  263. END_OF_FILE
  264. if test 3232 -ne `wc -c <'xdrum-1.0/Makefile'`; then
  265.     echo shar: \"'xdrum-1.0/Makefile'\" unpacked with wrong size!
  266. fi
  267. # end of 'xdrum-1.0/Makefile'
  268. fi
  269. if test -f 'xdrum-1.0/README' -a "${1}" != "-c" ; then 
  270.   echo shar: Will not clobber existing file \"'xdrum-1.0/README'\"
  271. else
  272. echo shar: Extracting \"'xdrum-1.0/README'\" \(1148 characters\)
  273. sed "s/^X//" >'xdrum-1.0/README' <<'END_OF_FILE'
  274. X  This is release 1.0 of xdrum.
  275. X
  276. X  xdrum is wishm based script that allows you to create and
  277. edit drum patterns under X11.  These patterns can then be saved
  278. in a re-loadable and editable ASCII format or in a non-loadable
  279. MIDI format.  Though the MIDI format can't be re-loaded,
  280. it conforms to the Standard MIDI Format and can be used with
  281. other tools such as the tclm scripts mplay and minfo.
  282. X  Wishm is John Ousterhout's wish interpreter with tclm
  283. extensions.  Wish in turn is based on his interpreted
  284. language tcl.  Tcl is a simple and easy to use scripting
  285. language designed for applications such as this.
  286. X  The tclm extensions are extensions to tcl that allow one
  287. to easily read/write and modify MIDI files.
  288. X  To use xdrum, you must have tcl, tk and tclm.  Tcl and
  289. tk are available at sprite.berkeley.edu.  Tclm is probably
  290. available where you found xdrum.  If not check comp.sources.misc
  291. archive sites and harbor.ecn.purdue.edu.
  292. X
  293. X  See the INSTALL file for information on how to build and
  294. install xdrum.
  295. X
  296. X  Special thanks go to Michael Caro (acps7221@ryevm.ryerson.ca)
  297. for invaluable input and feedback.
  298. X
  299. mike durian
  300. durian@advtech.uswest.com
  301. END_OF_FILE
  302. if test 1148 -ne `wc -c <'xdrum-1.0/README'`; then
  303.     echo shar: \"'xdrum-1.0/README'\" unpacked with wrong size!
  304. fi
  305. # end of 'xdrum-1.0/README'
  306. fi
  307. if test -f 'xdrum-1.0/XDrum.ad' -a "${1}" != "-c" ; then 
  308.   echo shar: Will not clobber existing file \"'xdrum-1.0/XDrum.ad'\"
  309. else
  310. echo shar: Extracting \"'xdrum-1.0/XDrum.ad'\" \(175 characters\)
  311. sed "s/^X//" >'xdrum-1.0/XDrum.ad' <<'END_OF_FILE'
  312. xdrum*Labels:    Kick Snare {High Hat Open} {High Hat Closed} Ride Crash
  313. xdrum*Pitches:    35 38 46 42 51 49
  314. xdrum*Levels:    8
  315. xdrum*Beats:    4
  316. xdrum*Measures:    2
  317. xdrum*Quantization:    16
  318. END_OF_FILE
  319. if test 175 -ne `wc -c <'xdrum-1.0/XDrum.ad'`; then
  320.     echo shar: \"'xdrum-1.0/XDrum.ad'\" unpacked with wrong size!
  321. fi
  322. # end of 'xdrum-1.0/XDrum.ad'
  323. fi
  324. if test -f 'xdrum-1.0/drumgrid.3' -a "${1}" != "-c" ; then 
  325.   echo shar: Will not clobber existing file \"'xdrum-1.0/drumgrid.3'\"
  326. else
  327. echo shar: Extracting \"'xdrum-1.0/drumgrid.3'\" \(8434 characters\)
  328. sed "s/^X//" >'xdrum-1.0/drumgrid.3' <<'END_OF_FILE'
  329. X.Dd March 30, 1993
  330. X.Os WISHM
  331. X.Dt DRUMGRID 3
  332. X.Sh NAME
  333. X.Nm drumgrid
  334. X.Nd "a wishm widget to display and edit drum patterns"
  335. X.Sh SYNOPSIS
  336. X.Nm
  337. X.Ar pathName
  338. X.Op Ar options
  339. X.Ss STANDARD OPTIONS
  340. X.Bl -item -compact
  341. X.It
  342. X.Fl background Ar color
  343. X.It
  344. X.Fl borderwidth Ar width
  345. X.It
  346. X.Fl cursor Ar cursor
  347. X.It
  348. X.Fl font Ar font
  349. X.It
  350. X.Fl foreground Ar color
  351. X.It
  352. X.Fl relief Ar relief
  353. X.It
  354. X.Fl xscrollcommand Ar command
  355. X.It
  356. X.Fl yscrollcommand Ar command
  357. X.El
  358. X.Ss WIDGET SPECIFIC OPTIONS
  359. X.Bl -tag -width Fl
  360. X.It Fl beatcolor Ar color
  361. This option specifies the color of the lines dividing
  362. beats.
  363. If not specified the color blue is used.
  364. It's class in BeatColor.
  365. X.It Fl beats Ar beats
  366. This option specifies how many beats are in a measure.
  367. If not specified the value 4 is used.
  368. It's class is Beats.
  369. X.It Fl boxheight Ar height
  370. This option specifies the height of the boxes.
  371. If not specified the value 20 is used.
  372. It's class is BoxHeight.
  373. X.It Fl boxwidth Ar width
  374. This option specifies the width of the boxes.
  375. If not specified the value 20 is used.
  376. It's class is BoxWidth.
  377. X.It Fl height Ar height
  378. This option specifies how many rows should be displayed.
  379. The remainder can be viewed by scrolling.
  380. If not specified the number of labels is used.
  381. It's class is Height.
  382. X.It Fl labels Ar labelList
  383. This option specifies the labels for each row.
  384. It is a list and each element in the list corresponds
  385. to one row.
  386. If not specified the list {Kick Snare {High Hat Open} {High Hat Closed}
  387. Crash Ride {High Tom} {Middle Tom} {Low Tom}} is assumed.
  388. It's class is Labels.
  389. X.It Fl levels Ar levels
  390. This option specifies how many different dynamic
  391. levels exist.
  392. If not specified the value 8 is assumed.
  393. It's class is Levels.
  394. X.It Fl linecolor Ar color
  395. This option specifies the colors of lines that
  396. are neither dividing beats nor dividing measures.
  397. If not specified the value bisque3 is assumed.
  398. It's class is LineColor.
  399. X.It Fl linethickness Ar thickness
  400. This option specifies the thickness of the lines.
  401. If not specified the value 2 is assumed.
  402. It's class is LineThickness.
  403. X.It Fl measurecolor Ar color
  404. This option specifies the color to use when
  405. drawing lines that divide measures.
  406. If not specified the color red is assumed.
  407. It's class is MeasureColor.
  408. X.It Fl measures Ar measures
  409. This option specifies how many measures are
  410. in the pattern.
  411. If not specified a value of 2 is assumed.
  412. It's class is Measures.
  413. X.It Fl padx Ar pad
  414. This option specifies how many pixels to insert
  415. in front of the labels.
  416. If not specified a value of 2 is assumed.
  417. It's class if PadX.
  418. X.It Fl pitches Ar pitchList
  419. This option specifies the pitches associated with
  420. each row.
  421. It is a list and each element corresponds to one
  422. row.
  423. If not specified a pitchlist of {35 38 56 42 49 51 48 45 41}
  424. is assumed.
  425. This corresponds to pitches on an Alesis HR-16 appropriate
  426. for the default labels.
  427. It's class is Pitches.
  428. X.It Fl quantization Ar quantization
  429. This option specifies the quantization of the grid.
  430. It should be a multiple of 4 and corresponds to
  431. the number of boxes per measure.
  432. If not specified a quantization of 16 is assumed.
  433. It's class is Quantization.
  434. X.It Fl width Ar width
  435. This option specifies the number of boxes to display.
  436. The remainder can be viewed by scrolling.
  437. If a value is not specified, one measure's worth of
  438. boxes will be displayed.
  439. It's class is Width.
  440. X.El
  441. X.Sh DESCRIPTION
  442. X.Nm
  443. is a
  444. X.Tn TCL/TK
  445. compatible widget designed for use as an aid in
  446. creating and editing drum rhythms, though it could be
  447. used for other purposes as well.
  448. These rhythms are represented in a grid with each row
  449. corresponding to one voice of the drum kit and each column
  450. a time period when a voice can be struck.
  451. The time is shown as increasing on the x-axis.
  452. The columns are grouped by beats and measures.
  453. There are
  454. X.Ar quantization
  455. divided by 4 columns per beat,
  456. X.Ar beats
  457. beats per measure, and
  458. X.Ar measures
  459. measures per pattern.
  460. Varying dynamics are represented by different
  461. shadings in each box.
  462. There are
  463. X.Ar levels
  464. distinct levels of dynamics available.
  465. X.Pp
  466. The default bindings for
  467. X.Nm
  468. are loaded automatically by
  469. X.Xr wishm 1
  470. when it is started.
  471. Pressing mouse button 1 in a box will
  472. increase the velocity of the box by 1.
  473. Pressing mouse button 3 decrease the
  474. velocity by 1, and pressing mouse button 2 sets
  475. the velocity to zero.
  476. The velocity of a box can be set directly to a
  477. specific value by first moving the mouse to the
  478. box and then pressing a key in the range 0 - 9,
  479. where the key value is the desired velocity.
  480. The '+' key can be used to increment the velocity
  481. of a box by 10 and the '-' decrements the velocity
  482. by 10.
  483. Thus, you can set the value to velocities greater
  484. than 9.
  485. If you specify a velocity greater than the maximum
  486. level, the maximum level will be used.
  487. X.Sh WIDGET COMMAND
  488. The
  489. X.Nm
  490. command creates a new Tcl command whose
  491. name is
  492. X.Ar pathName.
  493. This command may be used to invoke various
  494. operations on the widget.
  495. It has the following general form:
  496. X.Dl Nm pathName Ar option Op Ar "arg arg ..."
  497. The following options are possible for the
  498. X.Nm
  499. widgets:
  500. X.Bl -tag -width configure
  501. X.It Nm configure Oo option
  502. X.Op value
  503. X.Oc
  504. The configure command allows you to change to configuration
  505. parameters of the widget.
  506. These parameters are listed in the
  507. X.Tn STANDARD OPTIONS
  508. and
  509. X.Tn WIDGET SPECIFIC OPTIONS
  510. sections.
  511. If no option and value are specified, then this
  512. command returns all of the options and their settings.
  513. If an option is specified without a value, then
  514. the setting for that option only is returned.
  515. If both an option and a value are specified, then
  516. that parameter will be set to the given value.
  517. The grid will be cleared whenever a configure parameter
  518. is changed.
  519. This is due to difficulties in placing existing patterns
  520. into new beat/measure/quantization combinations.
  521. X.It Nm down Ar x y
  522. This command will change the relief the the box specified
  523. by the x and y coordinates to sunken.
  524. X.It Nm label add Ar label
  525. This command adds another row to the grid.
  526. The row will initially be empty and the label will be
  527. X.Em label.
  528. X.It Nm label remove Ar {label | index} value
  529. This command will remove a row from the grid.
  530. This row can be specified by either its label or
  531. its index.
  532. X.It Nm label list
  533. This command returns a list of all the current labels.
  534. X.It Nm pitch get Ar index
  535. This command returns the pitch value associated with
  536. a row.
  537. The row is specified in by the index value.
  538. X.It Nm pitch set Ar index value
  539. This command set the pitch associated with a row.
  540. The row is specified by the index parameter and the new
  541. pitch by the value parameter.
  542. X.It Nm pitch list
  543. This command returns a list of all the current pitch values.
  544. This first element is for row 0, the second for row 1, etc.
  545. X.It Nm up Ar x y
  546. This command changes the relief of the box specified
  547. by the x and y coordinates to raised.
  548. X.It Nm volume get Ar {all | x y}
  549. This command returns the volume setting for either one box
  550. or the entire grid.
  551. If the string all is the argument instead of a x and y positions,
  552. then a list will be returned.
  553. The list will have sublists for each column.
  554. XEach sublist will contain the volume settings for each row
  555. in that time slice.
  556. If x and y positions are specified in stead of the string all,
  557. then the volume setting for that one box is returned.
  558. X.It Nm volume set Ar x y value
  559. This command sets the volume at a given x and y coordinate to
  560. the value specified.
  561. X.It Nm xview Op index
  562. This command adjusts the display so that the column specified by
  563. index is in the far left position unless there will not be
  564. enough boxes to the right of index to span the display area.
  565. In this case the last box will be placed in the far right
  566. position and the preceding boxes filled to the left.
  567. If an index is not specified then the current index of the
  568. left most box in the display is returned.
  569. X.It Nm yview Op index
  570. This command adjusts the display so that the row specified by
  571. index is in the top position unless there will not be enough
  572. rows below index to fill the display area.
  573. In this case the last row will be placed in the bottom positions
  574. and preceding rows placed above it.
  575. If an index is not specified then the current index of the
  576. top label in the display is returned.
  577. X.El
  578. X.Sh RETURN VALUES
  579. The
  580. X.Nm
  581. command returns the specified
  582. X.Ar pathName .
  583. X.Sh SEE ALSO
  584. X.Xr tclm 1 ,
  585. X.Xr wish 1
  586. X.Sh AUTHORS
  587. X.Tn TCL
  588. and
  589. X.Tn TK
  590. X.D1 John Ousterhout - ouster@cs.berkeley.edu
  591. X.Tn TCLM
  592. and
  593. X.Tn XDRUM
  594. X.D1 Mike Durian - durian@advtech.uswest.com
  595. X.Sh BUGS
  596. Just because I don't currently know of any doesn't mean they
  597. aren't there.
  598. END_OF_FILE
  599. if test 8434 -ne `wc -c <'xdrum-1.0/drumgrid.3'`; then
  600.     echo shar: \"'xdrum-1.0/drumgrid.3'\" unpacked with wrong size!
  601. fi
  602. # end of 'xdrum-1.0/drumgrid.3'
  603. fi
  604. if test -f 'xdrum-1.0/main.c' -a "${1}" != "-c" ; then 
  605.   echo shar: Will not clobber existing file \"'xdrum-1.0/main.c'\"
  606. else
  607. echo shar: Extracting \"'xdrum-1.0/main.c'\" \(8848 characters\)
  608. sed "s/^X//" >'xdrum-1.0/main.c' <<'END_OF_FILE'
  609. X/*-
  610. X * main.c --
  611. X *
  612. X *    A simple program to test the toolkit facilities.
  613. X *
  614. X * Copyright 1990-1992 Regents of the University of California.
  615. X * Permission to use, copy, modify, and distribute this
  616. X * software and its documentation for any purpose and without
  617. X * fee is hereby granted, provided that the above copyright
  618. X * notice appear in all copies.  The University of California
  619. X * makes no representations about the suitability of this
  620. X * software for any purpose.  It is provided "as is" without
  621. X * express or implied warranty.
  622. X */
  623. X/*-
  624. X * Copyright (c) 1993 Michael B. Durian.  All rights reserved.
  625. X */
  626. X/*-
  627. X * I made it conform to BSD's KNF (Kernel Normal Form) - or at
  628. X * least mostly.  Also changed a few minor things and extended
  629. X * it to work with TCLM and TKM.
  630. X * Mike
  631. X */
  632. X
  633. X#ifndef lint
  634. static char rcsid[] = "main.c,v 1.8 1993/05/07 17:51:17 durian Exp";
  635. X#endif
  636. X
  637. X#include <stdio.h>
  638. X#include <stdlib.h>
  639. X#include <unistd.h>
  640. X#include <string.h>
  641. X#include "tk.h"
  642. X#include "tkm.h"
  643. X#include "mutil.h"
  644. X#include "tclm.h"
  645. X#include "patchlevel.h"
  646. X
  647. X/*
  648. X * Declarations for library procedures:
  649. X */
  650. X
  651. extern int isatty();
  652. X
  653. X/*
  654. X * Command used to initialize wish:
  655. X */
  656. X
  657. char initCmd[] = "source $tk_library/wish.tcl";
  658. char initTkmCmd[] = "source $tk_library/wishm.tcl";
  659. X
  660. Tk_Window w;            /* NULL means window has been deleted. */
  661. Tk_TimerToken timeToken = 0;
  662. Tcl_CmdBuf buffer;
  663. Tcl_Interp *interp;
  664. int idleHandler = 0;
  665. int x, y;
  666. int tty;
  667. int Tk_SquareCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
  668. X    int argc, char **argv));
  669. int Tk_WishmVersionCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
  670. X    int argc, char **argv));
  671. X
  672. X/*
  673. X * Information for testing out command-line options:
  674. X */
  675. X
  676. int synchronize = 0;
  677. char *fileName = NULL;
  678. char *name = NULL;
  679. char *display = NULL;
  680. char *geometry = NULL;
  681. X
  682. Tk_ArgvInfo argTable[] = {
  683. X    {"-file", TK_ARGV_STRING, (char *)NULL, (char *)&fileName,
  684. X        "File from which to read commands"},
  685. X    {"-geometry", TK_ARGV_STRING, (char *)NULL, (char *)&geometry,
  686. X        "Initial geometry for window"},
  687. X    {"-display", TK_ARGV_STRING, (char *)NULL, (char *)&display,
  688. X        "Display to use"},
  689. X    {"-name", TK_ARGV_STRING, (char *)NULL, (char *)&name,
  690. X        "Name to use for application"},
  691. X    {"-sync", TK_ARGV_CONSTANT, (char *)1, (char *)&synchronize,
  692. X        "Use synchronous mode for display server"},
  693. X    {(char *)NULL, TK_ARGV_END, (char *)NULL, (char *)NULL,
  694. X        (char *)NULL}
  695. X};
  696. X
  697. X/* ARGSUSED */
  698. void
  699. StdinProc(clientData, mask)
  700. X    ClientData clientData;        /* Not used. */
  701. X    int mask;
  702. X{
  703. X    char line[200];
  704. X    static int gotPartial = 0;
  705. X    char *cmd;
  706. X    int result;
  707. X
  708. X    if (mask & TK_READABLE) {
  709. X        if (fgets(line, 200, stdin) == NULL) {
  710. X            if (gotPartial)
  711. X                line[0] = 0;
  712. X            else {
  713. X                if (!tty)
  714. X                    Tk_DeleteFileHandler(0);
  715. X                else {
  716. X                    Tcl_Eval(interp, "destroy .", 0,
  717. X                        (char **)NULL);
  718. X                    exit(0);
  719. X                }
  720. X                return;
  721. X            }
  722. X        }
  723. X        cmd = Tcl_AssembleCmd(buffer, line);
  724. X        if (cmd == NULL) {
  725. X            gotPartial = 1;
  726. X            return;
  727. X        }
  728. X        gotPartial = 0;
  729. X        result = Tcl_RecordAndEval(interp, cmd, 0);
  730. X        if (*interp->result != 0)
  731. X            if ((result != TCL_OK) || (tty))
  732. X                printf("%s\n", interp->result);
  733. X        if (tty) {
  734. X            printf("wishm: ");
  735. X            fflush(stdout);
  736. X        }
  737. X    }
  738. X}
  739. X
  740. X/* ARGSUSED */
  741. static void
  742. StructureProc(clientData, eventPtr)
  743. X    ClientData clientData;    /* Information about window. */
  744. X    XEvent *eventPtr;    /* Information about event. */
  745. X{
  746. X    if (eventPtr->type == DestroyNotify)
  747. X        w = NULL;
  748. X}
  749. X
  750. X/*
  751. X * Procedure to map initial window.  This is invoked as a do-when-idle
  752. X * handler.  Wait for all other when-idle handlers to be processed
  753. X * before mapping the window, so that the window's correct geometry
  754. X * has been determined.
  755. X */
  756. X
  757. X/* ARGSUSED */
  758. static void
  759. DelayedMap(clientData)
  760. X    ClientData clientData;    /* Not used. */
  761. X{
  762. X
  763. X    /* Empty loop body. */
  764. X    while (Tk_DoOneEvent(TK_IDLE_EVENTS) != 0);
  765. X    if (w == NULL)
  766. X        return;
  767. X    Tk_MapWindow(w);
  768. X}
  769. X
  770. X/* ARGSUSED */
  771. int
  772. DotCmd(dummy, interp, argc, argv)
  773. X    ClientData dummy;    /* Not used. */
  774. X    Tcl_Interp *interp;    /* Current interpreter. */
  775. X    int argc;        /* Number of arguments. */
  776. X    char **argv;        /* Argument strings. */
  777. X{
  778. X    int x, y;
  779. X
  780. X    if (argc != 3) {
  781. X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  782. X            " x y\"", (char *)NULL);
  783. X        return (TCL_ERROR);
  784. X    }
  785. X    x = strtol(argv[1], (char **)NULL, 0);
  786. X    y = strtol(argv[2], (char **)NULL, 0);
  787. X    Tk_MakeWindowExist(w);
  788. X    XDrawPoint(Tk_Display(w), Tk_WindowId(w),
  789. X        DefaultGCOfScreen(Tk_Screen(w)), x, y);
  790. X    return (TCL_OK);
  791. X}
  792. X
  793. X/* ARGSUSED */
  794. int
  795. MovetoCmd(dummy, interp, argc, argv)
  796. X    ClientData dummy;    /* Not used. */
  797. X    Tcl_Interp *interp;    /* Current interpreter. */
  798. X    int argc;        /* Number of arguments. */
  799. X    char **argv;        /* Argument strings. */
  800. X{
  801. X    if (argc != 3) {
  802. X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  803. X            " x y\"", (char *)NULL);
  804. X        return (TCL_ERROR);
  805. X    }
  806. X    x = strtol(argv[1], (char **)NULL, 0);
  807. X    y = strtol(argv[2], (char **)NULL, 0);
  808. X    return (TCL_OK);
  809. X}
  810. X
  811. X/* ARGSUSED */
  812. int
  813. LinetoCmd(dummy, interp, argc, argv)
  814. X    ClientData dummy;    /* Not used. */
  815. X    Tcl_Interp *interp;    /* Current interpreter. */
  816. X    int argc;        /* Number of arguments. */
  817. X    char **argv;        /* Argument strings. */
  818. X{
  819. X    int newX, newY;
  820. X
  821. X    if (argc != 3) {
  822. X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  823. X            " x y\"", (char *)NULL);
  824. X        return (TCL_ERROR);
  825. X    }
  826. X    newX = strtol(argv[1], (char **)NULL, 0);
  827. X    newY = strtol(argv[2], (char **)NULL, 0);
  828. X    Tk_MakeWindowExist(w);
  829. X    XDrawLine(Tk_Display(w), Tk_WindowId(w),
  830. X        DefaultGCOfScreen(Tk_Screen(w)), x, y, newX, newY);
  831. X    x = newX;
  832. X    y = newY;
  833. X    return (TCL_OK);
  834. X}
  835. X
  836. int
  837. main(argc, argv)
  838. X    int argc;
  839. X    char **argv;
  840. X{
  841. X    char *args, *p, *msg;
  842. X    char buf[20];
  843. X    int result;
  844. X    Tk_3DBorder border;
  845. X
  846. X    interp = Tcl_CreateInterp();
  847. X#ifdef TCL_MEM_DEBUG
  848. X    Tcl_InitMemory(interp);
  849. X#endif
  850. X    if (Tk_ParseArgv(interp, (Tk_Window)NULL, &argc, argv, argTable, 0)
  851. X        != TCL_OK) {
  852. X        fprintf(stderr, "%s\n", interp->result);
  853. X        exit(1);
  854. X    }
  855. X    if (name == NULL) {
  856. X        if (fileName != NULL)
  857. X            p = fileName;
  858. X        else
  859. X            p = argv[0];
  860. X        name = strrchr(p, '/');
  861. X        if (name != NULL)
  862. X            name++;
  863. X        else
  864. X            name = p;
  865. X    }
  866. X    w = Tk_CreateMainWindow(interp, display, name);
  867. X    if (w == NULL) {
  868. X        fprintf(stderr, "%s\n", interp->result);
  869. X        exit(1);
  870. X    }
  871. X    Tk_SetClass(w, "Tk");
  872. X    Tk_CreateEventHandler(w, StructureNotifyMask, StructureProc,
  873. X        (ClientData)NULL);
  874. X    Tk_DoWhenIdle(DelayedMap, (ClientData)NULL);
  875. X    tty = isatty(0);
  876. X
  877. X    args = Tcl_Merge(argc-1, argv+1);
  878. X    Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
  879. X    ckfree(args);
  880. X    sprintf(buf, "%d", argc-1);
  881. X    Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
  882. X
  883. X    if (synchronize)
  884. X        XSynchronize(Tk_Display(w), True);
  885. X    Tk_GeometryRequest(w, 200, 200);
  886. X    border = Tk_Get3DBorder(interp, w, None, "#4eee94");
  887. X    if (border != NULL)
  888. X        Tk_SetBackgroundFromBorder(w, border);
  889. X    else {
  890. X        Tcl_SetResult(interp, (char *)NULL, TCL_STATIC);
  891. X        Tk_SetWindowBackground(w, WhitePixelOfScreen(Tk_Screen(w)));
  892. X        }
  893. X    XSetForeground(Tk_Display(w), DefaultGCOfScreen(Tk_Screen(w)),
  894. X        BlackPixelOfScreen(Tk_Screen(w)));
  895. X    Tcl_CreateCommand(interp, "dot", DotCmd, (ClientData)w,
  896. X        (void (*)())NULL);
  897. X    Tcl_CreateCommand(interp, "lineto", LinetoCmd, (ClientData)w,
  898. X        (void (*)())NULL);
  899. X    Tcl_CreateCommand(interp, "moveto", MovetoCmd, (ClientData)w,
  900. X        (void (*)())NULL);
  901. X#ifdef SQUARE_DEMO
  902. X    Tcl_CreateCommand(interp, "square", Tk_SquareCmd, (ClientData)w,
  903. X        (void (*)())NULL);
  904. X#endif
  905. X    Tcl_CreateCommand(interp, "drumgrid", Tk_DrumGridCmd, (ClientData)w,
  906. X        (void(*)())NULL);
  907. X    Tcl_CreateCommand(interp, "wishmversion", Tk_WishmVersionCmd,
  908. X        (ClientData)w, (void(*)())NULL);
  909. X
  910. X    /* the MIDI stuff */
  911. X    Tclm_InitMidi(interp);
  912. X
  913. X    if (geometry != NULL)
  914. X        Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
  915. X    result = Tcl_Eval(interp, initCmd, 0, (char **)NULL);
  916. X    if (result != TCL_OK)
  917. X        goto error;
  918. X    result = Tcl_Eval(interp, initTkmCmd, 0, (char **)NULL);
  919. X    if (result != TCL_OK)
  920. X        goto error;
  921. X    if (fileName != NULL) {
  922. X        result = Tcl_VarEval(interp, "source ", fileName,
  923. X            (char *)NULL);
  924. X        if (result != TCL_OK)
  925. X            goto error;
  926. X        tty = 0;
  927. X    } else {
  928. X        tty = isatty(0);
  929. X        Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData)0);
  930. X        if (tty)
  931. X            printf("wishm: ");
  932. X    }
  933. X    fflush(stdout);
  934. X    buffer = Tcl_CreateCmdBuf();
  935. X    (void)Tcl_Eval(interp, "update", 0, (char **)NULL);
  936. X
  937. X    Tk_MainLoop();
  938. X    Tcl_DeleteInterp(interp);
  939. X    Tcl_DeleteCmdBuf(buffer);
  940. X    exit(0);
  941. X
  942. error:
  943. X    msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  944. X    if (msg == NULL)
  945. X        msg = interp->result;
  946. X    fprintf(stderr, "%s\n", msg);
  947. X    Tcl_Eval(interp, "destroy .", 0, (char **)NULL);
  948. X    exit(1);
  949. X    return (0);
  950. X}
  951. X
  952. int
  953. Tk_WishmVersionCmd(clientData, interp, argc, argv)
  954. X    ClientData clientData;
  955. X    Tcl_Interp *interp;
  956. X    int argc;
  957. X    char **argv;
  958. X{
  959. X
  960. X    if (argc != 1) {
  961. X        Tcl_AppendResult(interp, "wrong # args: should be \"",
  962. X            argv[0], "\"", (char *)NULL);
  963. X        return (TCL_ERROR);
  964. X    }
  965. X    Tcl_AppendResult(interp, WISHM_PATCHLEVEL, (char *)NULL);
  966. X    return (TCL_OK);
  967. X}
  968. END_OF_FILE
  969. if test 8848 -ne `wc -c <'xdrum-1.0/main.c'`; then
  970.     echo shar: \"'xdrum-1.0/main.c'\" unpacked with wrong size!
  971. fi
  972. # end of 'xdrum-1.0/main.c'
  973. fi
  974. if test -f 'xdrum-1.0/patchlevel.h' -a "${1}" != "-c" ; then 
  975.   echo shar: Will not clobber existing file \"'xdrum-1.0/patchlevel.h'\"
  976. else
  977. echo shar: Extracting \"'xdrum-1.0/patchlevel.h'\" \(144 characters\)
  978. sed "s/^X//" >'xdrum-1.0/patchlevel.h' <<'END_OF_FILE'
  979. X/*
  980. X * patchlevel.h,v 1.1 1993/05/06 02:49:44 durian Exp
  981. X */
  982. X
  983. X#ifndef PATCHLEVEL_H
  984. X#define PATCHLEVEL_H
  985. X
  986. X#define WISHM_PATCHLEVEL "0.9.5"
  987. X#endif
  988. END_OF_FILE
  989. if test 144 -ne `wc -c <'xdrum-1.0/patchlevel.h'`; then
  990.     echo shar: \"'xdrum-1.0/patchlevel.h'\" unpacked with wrong size!
  991. fi
  992. # end of 'xdrum-1.0/patchlevel.h'
  993. fi
  994. if test -f 'xdrum-1.0/tkm.h' -a "${1}" != "-c" ; then 
  995.   echo shar: Will not clobber existing file \"'xdrum-1.0/tkm.h'\"
  996. else
  997. echo shar: Extracting \"'xdrum-1.0/tkm.h'\" \(3039 characters\)
  998. sed "s/^X//" >'xdrum-1.0/tkm.h' <<'END_OF_FILE'
  999. X/*-
  1000. X * Copyright (c) 1993 Michael B. Durian.  All rights reserved.
  1001. X *
  1002. X * Redistribution and use in source and binary forms, with or without
  1003. X * modification, are permitted provided that the following conditions
  1004. X * are met:
  1005. X * 1. Redistributions of source code must retain the above copyright
  1006. X *    notice, this list of conditions and the following disclaimer.
  1007. X * 2. Redistributions in binary form must reproduce the above copyright
  1008. X *    notice, this list of conditions and the following disclaimer in the
  1009. X *    documentation and/or other materials provided with the distribution.
  1010. X * 3. All advertising materials mentioning features or use of this software
  1011. X *    must display the following acknowledgement:
  1012. X *    This product includes software developed by Michael B. Durian.
  1013. X * 4. The name of the the Author may be used to endorse or promote 
  1014. X *    products derived from this software without specific prior written 
  1015. X *    permission.
  1016. X *
  1017. X * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 
  1018. X * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  1019. X * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  
  1020. X * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
  1021. X * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  1022. X * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  1023. X * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  1024. X * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  1025. X * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  1026. X * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  1027. X * SUCH DAMAGE.
  1028. X */
  1029. X/*
  1030. X * tkm.h,v 1.2 1993/04/04 22:02:27 durian Exp
  1031. X */
  1032. X#ifndef TKM_H
  1033. X#define TKM_H
  1034. extern int Tk_DrumGridCmd _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **));
  1035. X
  1036. X#define BLACK        "Black"
  1037. X#define WHITE        "White"
  1038. X#define GRAY        "#b0b0b0"
  1039. X
  1040. X#define BISQUE1        "#ffe4c4"
  1041. X#define BISQUE2        "#eed5b7"
  1042. X#define BISQUE3        "#cdb79e"
  1043. X
  1044. X#define LIGHTBLUE2    "#b2dfee"
  1045. X
  1046. X#define LIGHTPINK1    "#ffaeb9"
  1047. X
  1048. X#define MAROON        "#b03060"
  1049. X
  1050. X#define DEF_GRID_FG_COLOR        BLACK
  1051. X#define DEF_GRID_FG_MONO        WHITE
  1052. X#define DEF_GRID_NORMAL_BG_COLOR    BISQUE1
  1053. X#define DEF_GRID_NORMAL_BG_MONO        BLACK
  1054. X#define DEF_GRID_LINE_COLOR        BISQUE3
  1055. X#define DEF_GRID_MEASURE_COLOR        "red"
  1056. X#define DEF_GRID_BEAT_COLOR        "blue"
  1057. X#define DEF_GRID_BORDER_WIDTH        "2"
  1058. X#define DEF_GRID_CURSOR            ((char *)NULL)
  1059. X#define DEF_GRID_FONT            "*-Helvetica-Bold-R-Normal-*-120-*"
  1060. X#define DEF_GRID_HEIGHT            "0"
  1061. X#define DEF_GRID_WIDTH            "0"
  1062. X#define DEF_GRID_RELIEF            "flat"
  1063. X#define DEF_GRID_LABELS            "Kick Snare {High Hat Open} {High Hat \
  1064. Closed} Crash Ride {High Tom} {Middle Tom} {Low Tom}"
  1065. X#define DEF_GRID_PITCHES        "35 38 46 42 49 51 48 45 41"
  1066. X#define DEF_GRID_LEVELS            "8"
  1067. X#define DEF_GRID_BEATS            "4"
  1068. X#define DEF_GRID_MEASURES        "2"
  1069. X#define DEF_GRID_QUANTIZATION        "16"
  1070. X#define DEF_GRID_LINETHICKNESS        "2"
  1071. X#define DEF_GRID_PADX            "2"
  1072. X#define DEF_GRID_BOXWIDTH        "20"
  1073. X#define DEF_GRID_BOXHEIGHT        "20"
  1074. X#define DEF_GRID_SCROLL_COMMAND        ((char *)NULL)
  1075. X
  1076. X#endif
  1077. END_OF_FILE
  1078. if test 3039 -ne `wc -c <'xdrum-1.0/tkm.h'`; then
  1079.     echo shar: \"'xdrum-1.0/tkm.h'\" unpacked with wrong size!
  1080. fi
  1081. # end of 'xdrum-1.0/tkm.h'
  1082. fi
  1083. if test -f 'xdrum-1.0/wishm.tcl' -a "${1}" != "-c" ; then 
  1084.   echo shar: Will not clobber existing file \"'xdrum-1.0/wishm.tcl'\"
  1085. else
  1086. echo shar: Extracting \"'xdrum-1.0/wishm.tcl'\" \(4630 characters\)
  1087. sed "s/^X//" >'xdrum-1.0/wishm.tcl' <<'END_OF_FILE'
  1088. X# Copyright (c) 1993 Michael B. Durian.  All rights reserved.
  1089. X#
  1090. X# Redistribution and use in source and binary forms, with or without
  1091. X# modification, are permitted provided that the following conditions
  1092. X# are met:
  1093. X# 1. Redistributions of source code must retain the above copyright
  1094. X#    notice, this list of conditions and the following disclaimer.
  1095. X# 2. Redistributions in binary form must reproduce the above copyright
  1096. X#    notice, this list of conditions and the following disclaimer in the
  1097. X#    documentation and/or other materials provided with the distribution.
  1098. X# 3. All advertising materials mentioning features or use of this software
  1099. X#    must display the following acknowledgement:
  1100. X#    This product includes software developed by Michael B. Durian.
  1101. X# 4. The name of the the Author may be used to endorse or promote 
  1102. X#    products derived from this software without specific prior written 
  1103. X#    permission.
  1104. X#
  1105. X# THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 
  1106. X# WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  1107. X# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  
  1108. X# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
  1109. X# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  1110. X# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  1111. X# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  1112. X# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  1113. X# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  1114. X# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  1115. X# SUCH DAMAGE.
  1116. X
  1117. X# wishm.tcl,v 1.3 1993/04/05 21:35:12 durian Exp
  1118. X
  1119. X# default bindings for drumgrid widget
  1120. X# briefly:
  1121. X# mouse 1 - incrs. level
  1122. X# mouse 3 - decrs. level
  1123. X# mouse 2 - clears
  1124. X# keys 0-9 set level to value
  1125. X# key + incrs. level by 10
  1126. X# key - decrs. level by 10
  1127. X#
  1128. X# also handles moving in and out of boxes, in and out of grid, changing
  1129. X# relief etc.
  1130. X
  1131. set DrumGridSomethingPressed 0
  1132. X
  1133. proc DrumGridPress {W x y} {
  1134. X    global DrumGridLastX
  1135. X    global DrumGridLastY
  1136. X    global DrumGridSomethingPressed
  1137. X
  1138. X    incr DrumGridSomethingPressed
  1139. X    set DrumGridLastX [$W xnearest $x]
  1140. X    set DrumGridLastY [$W ynearest $y]
  1141. X    if {$DrumGridLastX != -1 && $DrumGridLastY != -1} {
  1142. X        $W down $DrumGridLastX $DrumGridLastY
  1143. X    }
  1144. X}
  1145. X
  1146. proc DrumGridMotion {W x y} {
  1147. X    global DrumGridLastX
  1148. X    global DrumGridLastY
  1149. X
  1150. X    set DrumGridNewX [$W xnearest $x]
  1151. X    set DrumGridNewY [$W ynearest $y]
  1152. X    if {$DrumGridNewX != $DrumGridLastX || \
  1153. X        $DrumGridNewY != $DrumGridLastY} {
  1154. X        if {$DrumGridLastX != -1 && $DrumGridLastY != -1} {
  1155. X            $W up $DrumGridLastX $DrumGridLastY
  1156. X        }
  1157. X        if {$DrumGridNewX != -1 && $DrumGridNewY != -1} {
  1158. X            $W down $DrumGridNewX $DrumGridNewY
  1159. X        }
  1160. X        set DrumGridLastX $DrumGridNewX
  1161. X        set DrumGridLastY $DrumGridNewY
  1162. X    }
  1163. X}
  1164. X
  1165. bind DrumGrid <ButtonPress> {
  1166. X
  1167. X    DrumGridPress %W %x %y
  1168. X}
  1169. X
  1170. bind DrumGrid <Any-Motion> {
  1171. X    global DrumGridSomethingPressed
  1172. X
  1173. X    if {$DrumGridSomethingPressed} {
  1174. X        DrumGridMotion %W %x %y
  1175. X    }
  1176. X}
  1177. X
  1178. bind DrumGrid <ButtonRelease-1> {
  1179. X    global DrumGridLastX
  1180. X    global DrumGridLastY
  1181. X    global DrumGridSomethingPressed
  1182. X
  1183. X    if {$DrumGridLastX != -1 && $DrumGridLastY != -1} {
  1184. X        %W volume set $DrumGridLastX $DrumGridLastY \
  1185. X            [expr {[%W volume get $DrumGridLastX $DrumGridLastY] + 1}]
  1186. X    }
  1187. X    incr DrumGridSomethingPressed -1
  1188. X}
  1189. X
  1190. bind DrumGrid <ButtonRelease-2> {
  1191. X    global DrumGridLastX
  1192. X    global DrumGridLastY
  1193. X    global DrumGridSomethingPressed
  1194. X
  1195. X    if {$DrumGridLastX != -1 && $DrumGridLastY != -1} {
  1196. X        %W volume set $DrumGridLastX $DrumGridLastY 0
  1197. X    }
  1198. X    incr DrumGridSomethingPressed -1
  1199. X}
  1200. X
  1201. bind DrumGrid <ButtonRelease-3> {
  1202. X    global DrumGridLastX
  1203. X    global DrumGridLastY
  1204. X    global DrumGridSomethingPressed
  1205. X
  1206. X    if {$DrumGridLastX != -1 && $DrumGridLastY != -1} {
  1207. X        %W volume set $DrumGridLastX $DrumGridLastY \
  1208. X            [expr {[%W volume get $DrumGridLastX $DrumGridLastY] - 1}]
  1209. X    }
  1210. X    incr DrumGridSomethingPressed -1
  1211. X}
  1212. X
  1213. bind DrumGrid <Enter> {
  1214. X
  1215. X    focus %W
  1216. X}
  1217. X
  1218. bind DrumGrid <Leave> {
  1219. X
  1220. X    focus none
  1221. X}
  1222. X
  1223. bind DrumGrid <Any-KeyPress> {
  1224. X
  1225. X    case %A in {
  1226. X    {1 2 3 4 5 6 7 8 9 0 + -} {
  1227. X        DrumGridPress %W %x %y
  1228. X    }
  1229. X    }
  1230. X}
  1231. X
  1232. bind DrumGrid <Any-KeyRelease> {
  1233. X    global DrumGridLastX
  1234. X    global DrumGridLastY
  1235. X    global DrumGridSomethingPressed
  1236. X
  1237. X    case %A in {
  1238. X    {1 2 3 4 5 6 7 8 9 0} {
  1239. X        %W volume set $DrumGridLastX $DrumGridLastY %A
  1240. X        incr DrumGridSomethingPressed -1
  1241. X    }
  1242. X    {+} {
  1243. X        %W volume set $DrumGridLastX $DrumGridLastY \
  1244. X            [expr {[%W volume get $DrumGridLastX $DrumGridLastY] + 10}]
  1245. X        incr DrumGridSomethingPressed -1
  1246. X    }
  1247. X    {-} {
  1248. X        %W volume set $DrumGridLastX $DrumGridLastY \
  1249. X            [expr {[%W volume get $DrumGridLastX $DrumGridLastY] - 10}]
  1250. X        incr DrumGridSomethingPressed -1
  1251. X    }
  1252. X    }
  1253. X}
  1254. END_OF_FILE
  1255. if test 4630 -ne `wc -c <'xdrum-1.0/wishm.tcl'`; then
  1256.     echo shar: \"'xdrum-1.0/wishm.tcl'\" unpacked with wrong size!
  1257. fi
  1258. # end of 'xdrum-1.0/wishm.tcl'
  1259. fi
  1260. if test -f 'xdrum-1.0/wishmversion.3' -a "${1}" != "-c" ; then 
  1261.   echo shar: Will not clobber existing file \"'xdrum-1.0/wishmversion.3'\"
  1262. else
  1263. echo shar: Extracting \"'xdrum-1.0/wishmversion.3'\" \(369 characters\)
  1264. sed "s/^X//" >'xdrum-1.0/wishmversion.3' <<'END_OF_FILE'
  1265. X.Dt WISHMVERSION 3
  1266. X.Os WISHM
  1267. X.Dd May 5, 1993
  1268. X.Sh NAME
  1269. X.Nm wishmversion
  1270. X.Nd "wishm command that returns the version of wishm being used"
  1271. X.Sh SYNOPSIS
  1272. X.Nm
  1273. X.Sh DESCRIPTION
  1274. X.Nm
  1275. is a simple command that returns
  1276. the version of
  1277. X.Xr wishm 1
  1278. being used.
  1279. X.Sh RETURN VALUES
  1280. The version of
  1281. X.Xr wishm 1 .
  1282. X.Sh SEE ALSO
  1283. X.Xr wishm 1
  1284. X.Sh AUTHORS
  1285. Mike Durian - durian@advtech.uswest.com
  1286. END_OF_FILE
  1287. if test 369 -ne `wc -c <'xdrum-1.0/wishmversion.3'`; then
  1288.     echo shar: \"'xdrum-1.0/wishmversion.3'\" unpacked with wrong size!
  1289. fi
  1290. # end of 'xdrum-1.0/wishmversion.3'
  1291. fi
  1292. if test -f 'xdrum-1.0/xdrum' -a "${1}" != "-c" ; then 
  1293.   echo shar: Will not clobber existing file \"'xdrum-1.0/xdrum'\"
  1294. else
  1295. echo shar: Extracting \"'xdrum-1.0/xdrum'\" \(16554 characters\)
  1296. sed "s/^X//" >'xdrum-1.0/xdrum' <<'END_OF_FILE'
  1297. X#!/usr/local/bin/wishm -f
  1298. X# Copyright (c) 1993 Michael B. Durian.  All rights reserved.
  1299. X#
  1300. X# Redistribution and use in source and binary forms, with or without
  1301. X# modification, are permitted provided that the following conditions
  1302. X# are met:
  1303. X# 1. Redistributions of source code must retain the above copyright
  1304. X#    notice, this list of conditions and the following disclaimer.
  1305. X# 2. Redistributions in binary form must reproduce the above copyright
  1306. X#    notice, this list of conditions and the following disclaimer in the
  1307. X#    documentation and/or other materials provided with the distribution.
  1308. X# 3. All advertising materials mentioning features or use of this software
  1309. X#    must display the following acknowledgement:
  1310. X#    This product includes software developed by Michael B. Durian.
  1311. X# 4. The name of the the Author may be used to endorse or promote 
  1312. X#    products derived from this software without specific prior written 
  1313. X#    permission.
  1314. X#
  1315. X# THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 
  1316. X# WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  1317. X# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  
  1318. X# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
  1319. X# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  1320. X# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  1321. X# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  1322. X# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  1323. X# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  1324. X# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  1325. X# SUCH DAMAGE.
  1326. X
  1327. X# xdrum,v 1.8 1993/05/05 01:35:25 durian Exp
  1328. X
  1329. set InputValue {}
  1330. set InputValid {}
  1331. set InputIndex {}
  1332. X
  1333. set Division 120
  1334. set Tempo 120
  1335. set Channel 0
  1336. set BaseFileName xdrum
  1337. X
  1338. set PlayPID -1
  1339. set PlayMFile {}
  1340. X
  1341. wm maxsize . 1024 1024
  1342. drumgrid .dg -xscrollcommand {.xscroll set} -yscrollcommand {.yscroll set}
  1343. scrollbar .xscroll -command {ChangePosition} -orient horizontal
  1344. scrollbar .yscroll -command {.dg yview} -orient vertical
  1345. frame .buttons
  1346. menubutton .buttons.config -text "Adjust Grid" -menu .buttons.config.menu \
  1347. X    -relief raised
  1348. menu .buttons.config.menu
  1349. X.buttons.config.menu add command -label "Add Voice" -command AddVoice
  1350. X.buttons.config.menu add command -label "Remove Voice" -command RemoveVoice
  1351. X.buttons.config.menu add command -label "Change Pitch" -command ChangePitch
  1352. X.buttons.config.menu add command -label "Change Tempo" -command ChangeTempo
  1353. X.buttons.config.menu add command -label "Change Division" \
  1354. X    -command ChangeDivision
  1355. X.buttons.config.menu add command -label "Change Channel" -command ChangeChannel
  1356. X.buttons.config.menu add separator
  1357. X.buttons.config.menu add command -label "Change Beats" -command ChangeBeats
  1358. X.buttons.config.menu add command -label "Change Measures" \
  1359. X    -command ChangeMeasures
  1360. X.buttons.config.menu add command -label "Change Quantization" \
  1361. X    -command ChangeQuant
  1362. X.buttons.config.menu add command -label "Change Levels" -command ChangeLevels
  1363. menubutton .buttons.file -text "File I/O" -menu .buttons.file.menu \
  1364. X    -relief raised
  1365. menu .buttons.file.menu
  1366. X.buttons.file.menu add command -label "Save ASCII" -command SaveASCII
  1367. X.buttons.file.menu add command -label "Load ASCII" -command LoadASCII
  1368. X.buttons.file.menu add command -label "Save MIDI" -command SaveMIDI
  1369. if {[midiplayable]} {
  1370. X    menubutton .buttons.play -text "Play" -menu .buttons.play.menu \
  1371. X        -relief raised
  1372. X    menu .buttons.play.menu
  1373. X    .buttons.play.menu add command -label "Play Pattern" \
  1374. X        -command PlayPattern
  1375. X    .buttons.play.menu add command -label "Stop Playing" \
  1376. X        -command StopPlaying
  1377. X}
  1378. button .buttons.quit -text "Quit" -command {StopPlaying; destroy .}
  1379. label .position
  1380. pack append .buttons \
  1381. X    .buttons.config {left expand} \
  1382. X    .buttons.file {left expand} \
  1383. X    .buttons.quit {left expand}
  1384. pack append . \
  1385. X    .buttons {bottom fillx} \
  1386. X    .position {top fillx} \
  1387. X    .yscroll {right filly} \
  1388. X    .xscroll {bottom fillx} \
  1389. X    .dg {top fill expand}
  1390. X
  1391. if {[midiplayable]} {
  1392. X    pack before .buttons.quit .buttons.play {left expand}
  1393. X}
  1394. X
  1395. proc AddVoice {} {
  1396. X    global InputValue
  1397. X    global InputValid
  1398. X
  1399. X    set pos [split [wm geometry .] +]
  1400. X    set x [expr {[lindex $pos 1] + 20}]
  1401. X    set y [expr {[lindex $pos 2] + 20}]
  1402. X    
  1403. X    tkwait window [GetText $x $y "New Voice:" ""]
  1404. X    if {$InputValid} {
  1405. X        .dg label add $InputValue
  1406. X    }
  1407. X}
  1408. X
  1409. proc RemoveVoice {} {
  1410. X    global InputValue
  1411. X    global InputValid
  1412. X
  1413. X    set pos [split [wm geometry .] +]
  1414. X    set x [expr {[lindex $pos 1] + 20}]
  1415. X    set y [expr {[lindex $pos 2] + 20}]
  1416. X    
  1417. X    tkwait window [GetSelection $x $y "Which Voice:" [.dg label list]]
  1418. X    if {$InputValid} {
  1419. X        .dg label remove label [lindex $InputValue 0]
  1420. X    }
  1421. X}
  1422. X
  1423. proc ChangePitch {} {
  1424. X    global InputValue
  1425. X    global InputValid
  1426. X    global InputIndex
  1427. X
  1428. X    set pos [split [wm geometry .] +]
  1429. X    set x [expr {[lindex $pos 1] + 20}]
  1430. X    set y [expr {[lindex $pos 2] + 20}]
  1431. X
  1432. X    tkwait window [GetSelection $x $y "Which Voice:" [.dg label list]]
  1433. X    if {!$InputValid} {
  1434. X        return
  1435. X    }
  1436. X    set pitch [.dg pitch get $InputIndex]
  1437. X
  1438. X    tkwait window [GetText $x $y "Pitch:" $pitch]
  1439. X    if {$InputValid} {
  1440. X        .dg pitch set $InputIndex $InputValue
  1441. X    }
  1442. X}
  1443. X
  1444. proc ChangeTempo {} {
  1445. X    global InputValue
  1446. X    global InputValid
  1447. X    global Tempo
  1448. X
  1449. X    set pos [split [wm geometry .] +]
  1450. X    set x [expr {[lindex $pos 1] + 20}]
  1451. X    set y [expr {[lindex $pos 2] + 20}]
  1452. X    
  1453. X    tkwait window [GetText $x $y "New Tempo:" $Tempo]
  1454. X    if {$InputValid} {
  1455. X        set Tempo $InputValue
  1456. X    }
  1457. X}
  1458. X
  1459. proc ChangeDivision {} {
  1460. X    global InputValue
  1461. X    global InputValid
  1462. X    global Division
  1463. X
  1464. X    set pos [split [wm geometry .] +]
  1465. X    set x [expr {[lindex $pos 1] + 20}]
  1466. X    set y [expr {[lindex $pos 2] + 20}]
  1467. X    
  1468. X    tkwait window [GetText $x $y "New Division:" $Division]
  1469. X    if {$InputValid} {
  1470. X        set Division $InputValue
  1471. X    }
  1472. X}
  1473. X
  1474. proc ChangeChannel {} {
  1475. X    global InputValue
  1476. X    global InputValid
  1477. X    global Channel
  1478. X
  1479. X    set pos [split [wm geometry .] +]
  1480. X    set x [expr {[lindex $pos 1] + 20}]
  1481. X    set y [expr {[lindex $pos 2] + 20}]
  1482. X    
  1483. X    tkwait window [GetText $x $y "New Channel:" $Channel]
  1484. X    if {$InputValid} {
  1485. X        set Channel $InputValue
  1486. X    }
  1487. X}
  1488. X
  1489. proc ChangeBeats {} {
  1490. X    global InputValue
  1491. X    global InputValid
  1492. X    global InputIndex
  1493. X
  1494. X    set pos [split [wm geometry .] +]
  1495. X    set x [expr {[lindex $pos 1] + 20}]
  1496. X    set y [expr {[lindex $pos 2] + 20}]
  1497. X
  1498. X    tkwait window [GetText $x $y "Beats Per Measure:" \
  1499. X        [lindex [.dg configure -beats] 4]]
  1500. X    if {$InputValid} {
  1501. X        .dg configure -beats $InputValue
  1502. X        ChangePositionLabel [.dg xview]
  1503. X    }
  1504. X}
  1505. X
  1506. proc ChangeMeasures {} {
  1507. X    global InputValue
  1508. X    global InputValid
  1509. X    global InputIndex
  1510. X
  1511. X    set pos [split [wm geometry .] +]
  1512. X    set x [expr {[lindex $pos 1] + 20}]
  1513. X    set y [expr {[lindex $pos 2] + 20}]
  1514. X
  1515. X    tkwait window [GetText $x $y "Number of Measures:" \
  1516. X        [lindex [.dg configure -measures] 4]]
  1517. X    if {$InputValid} {
  1518. X        .dg configure -measures $InputValue
  1519. X        ChangePositionLabel [.dg xview]
  1520. X    }
  1521. X}
  1522. X
  1523. proc ChangeQuant {} {
  1524. X    global InputValue
  1525. X    global InputValid
  1526. X    global InputIndex
  1527. X
  1528. X    set pos [split [wm geometry .] +]
  1529. X    set x [expr {[lindex $pos 1] + 20}]
  1530. X    set y [expr {[lindex $pos 2] + 20}]
  1531. X
  1532. X    tkwait window [GetText $x $y "New Quantization (mult. of 4):" \
  1533. X        [lindex [.dg configure -quantization] 4]]
  1534. X    if {$InputValid} {
  1535. X        .dg configure -quantization $InputValue
  1536. X        ChangePositionLabel [.dg xview]
  1537. X    }
  1538. X}
  1539. X
  1540. proc ChangeLevels {} {
  1541. X    global InputValue
  1542. X    global InputValid
  1543. X    global InputIndex
  1544. X
  1545. X    set pos [split [wm geometry .] +]
  1546. X    set x [expr {[lindex $pos 1] + 20}]
  1547. X    set y [expr {[lindex $pos 2] + 20}]
  1548. X
  1549. X    tkwait window [GetText $x $y "New Levels of Dynamics:" \
  1550. X        [lindex [.dg configure -levels] 4]]
  1551. X    if {$InputValid} {
  1552. X        .dg configure -levels $InputValue
  1553. X        ChangePositionLabel [.dg xview]
  1554. X    }
  1555. X}
  1556. X
  1557. proc SaveASCII {} {
  1558. X    global InputValue
  1559. X    global InputValid
  1560. X    global InputIndex
  1561. X    global BaseFileName
  1562. X    global Tempo
  1563. X    global Division
  1564. X    global Channel
  1565. X
  1566. X    set pos [split [wm geometry .] +]
  1567. X    set x [expr {[lindex $pos 1] + 20}]
  1568. X    set y [expr {[lindex $pos 2] + 20}]
  1569. X
  1570. X    tkwait window [GetText $x $y "File Name:" ${BaseFileName}.ptrn]
  1571. X    if {!$InputValid} {
  1572. X        return
  1573. X    }
  1574. X
  1575. X    set BaseFileName [join [lrange [split $InputValue .] \
  1576. X        0 [expr {[llength $InputValue] - 1}]] .]
  1577. X
  1578. X    ChangePositionLabel [.dg xview]
  1579. X
  1580. X    if {[file exists $InputValue] && ! [file writable $InputValue]} {
  1581. X        tkwait window [PutMessage $x $y \
  1582. X            "$InputValue exists and is not writable."]
  1583. X        return
  1584. X    }
  1585. X
  1586. X    set file [open $InputValue "w"]
  1587. X    puts $file "xdrum pattern $InputValue"
  1588. X    puts $file "Measures:"
  1589. X    puts $file "[lindex [.dg configure -measures] 4]"
  1590. X    puts $file "Beats:"
  1591. X    puts $file "[lindex [.dg configure -beats] 4]"
  1592. X    puts $file "Quantization:"
  1593. X    puts $file "[lindex [.dg configure -quantization] 4]"
  1594. X    puts $file "Levels:"
  1595. X    puts $file "[lindex [.dg configure -levels] 4]"
  1596. X    puts $file "Tempo:"
  1597. X    puts $file "$Tempo"
  1598. X    puts $file "Division:"
  1599. X    puts $file "$Division"
  1600. X    puts $file "Channel:"
  1601. X    puts $file "$Channel"
  1602. X    set labels [.dg label list]
  1603. X    set num_labels [llength $labels]
  1604. X    puts $file "Number Labels:"
  1605. X    puts $file "$num_labels"
  1606. X    puts $file "Labels:"
  1607. X    foreach label $labels {
  1608. X        puts $file $label
  1609. X    }
  1610. X    puts $file "Pitches:"
  1611. X    for {set i 0} {$i < $num_labels} {incr i} {
  1612. X        puts $file [.dg pitch get $i]
  1613. X    }
  1614. X    puts $file "Volumes:"
  1615. X    foreach column [.dg volume get all] {
  1616. X        puts $file $column
  1617. X    }
  1618. X    close $file
  1619. X}
  1620. X
  1621. proc LoadASCII {} {
  1622. X    global InputValue
  1623. X    global InputValid
  1624. X    global InputIndex
  1625. X    global BaseFileName
  1626. X    global Tempo
  1627. X    global Division
  1628. X    global Channel
  1629. X
  1630. X    set pos [split [wm geometry .] +]
  1631. X    set x [expr {[lindex $pos 1] + 20}]
  1632. X    set y [expr {[lindex $pos 2] + 20}]
  1633. X
  1634. X    tkwait window [GetText $x $y "File Name:" ${BaseFileName}.ptrn]
  1635. X    if {!$InputValid} {
  1636. X        return
  1637. X    }
  1638. X
  1639. X    set BaseFileName [join [lrange [split $InputValue .] \
  1640. X        0 [expr {[llength $InputValue] - 1}]] .]
  1641. X
  1642. X    ChangePositionLabel [.dg xview]
  1643. X    
  1644. X    if {! ([file exists $InputValue] && [file readable $InputValue])} {
  1645. X        tkwait window [PutMessage $x $y \
  1646. X            "$InputValue does not exist or is not readable."]
  1647. X        return
  1648. X    }
  1649. X    set file [open $InputValue "r"]
  1650. X    if { ! [string match "xdrum pattern*" [gets $file]] } {
  1651. X        tkwait window [PutMessage $x $y \
  1652. X            "$InputValue is not a valid xdrum ASCII pattern file."]
  1653. X        return
  1654. X    }
  1655. X    # Measures:
  1656. X    gets $file
  1657. X    set measures [gets $file]
  1658. X    # Beats:
  1659. X    gets $file
  1660. X    set beats [gets $file]
  1661. X    # Quantization:
  1662. X    gets $file
  1663. X    set quant [gets $file]
  1664. X    # Levels:
  1665. X    gets $file
  1666. X    set levels [gets $file]
  1667. X    # Tempo:
  1668. X    gets $file
  1669. X    set Tempo [gets $file]
  1670. X    # Division
  1671. X    gets $file
  1672. X    set Division [gets $file]
  1673. X    # Channel
  1674. X    gets $file
  1675. X    set Channel [gets $file]
  1676. X    # Number labels:
  1677. X    gets $file
  1678. X    set num_labels [gets $file]
  1679. X    # Labels:
  1680. X    gets $file
  1681. X    for {set i 0} {$i < $num_labels} {incr i} {
  1682. X        lappend labels [gets $file]
  1683. X    }
  1684. X    # Pitches:
  1685. X    gets $file
  1686. X    for {set i 0} {$i < $num_labels} {incr i} {
  1687. X        lappend pitches [gets $file]
  1688. X    }
  1689. X    # Volumes:
  1690. X    gets $file
  1691. X    set num_hits [expr {$measures * $beats * $quant / 4}]
  1692. X    for {set i 0} {$i < $num_hits} {incr i} {
  1693. X        lappend volumes [gets $file]
  1694. X    }
  1695. X    close $file
  1696. X
  1697. X    .dg configure -measures $measures
  1698. X    .dg configure -beats $beats
  1699. X    .dg configure -quantization $quant
  1700. X    .dg configure -levels $levels
  1701. X    .dg configure -labels $labels
  1702. X    .dg configure -pitches $pitches
  1703. X    set x 0
  1704. X    foreach column $volumes {
  1705. X        set y 0
  1706. X        foreach voice $column {
  1707. X            .dg volume set $x $y $voice
  1708. X            incr y
  1709. X        }
  1710. X        incr x
  1711. X    }
  1712. X}
  1713. X
  1714. proc GenerateSMF {pattern_name} {
  1715. X    global Tempo
  1716. X    global Division
  1717. X    global Channel
  1718. X
  1719. X    # some values we'll need
  1720. X    set beats [lindex [.dg configure -beats] 4]
  1721. X    set measures [lindex [.dg configure -measures] 4]
  1722. X    set quant [lindex [.dg configure -quantization] 4]
  1723. X    set levels [lindex [.dg configure -levels] 4]
  1724. X
  1725. X    set mfile [midimake]
  1726. X    midiconfig $mfile format 1
  1727. X    midiconfig $mfile division $Division
  1728. X    midiconfig $mfile tracks 2
  1729. X
  1730. X    # give a seqence name
  1731. X    midiput $mfile 0 0 metaseqname $pattern_name
  1732. X
  1733. X    # set the tempo
  1734. X    midiput $mfile 0 0 metatempo $Tempo
  1735. X
  1736. X    # time signature
  1737. X    midiput $mfile 0 0 metatime 4 4 24 8
  1738. X
  1739. X    # now put an EOT at the end - with proper delta
  1740. X    set elapsed [expr {$Division * $beats * $measures}]
  1741. X    midiput $mfile 0 $elapsed metaeot
  1742. X
  1743. X    # now the real events
  1744. X    set events [.dg volume get all]
  1745. X    set pitches [.dg pitch list]
  1746. X    set num_voices [llength $pitches]
  1747. X
  1748. X    set time_delta [expr {$Division * 4 / $quant}]
  1749. X
  1750. X    set delta 0
  1751. X    set no_status 1
  1752. X    foreach time_slice $events {
  1753. X        set notes_on ""
  1754. X        # do notes on
  1755. X        for {set i 0} {$i < $num_voices} {incr i} {
  1756. X            set voice [lindex $time_slice $i]
  1757. X            if {$voice != 0} {
  1758. X                set p [lindex $pitches $i]
  1759. X                midiput $mfile 1 $delta noteon $Channel $p \
  1760. X                    [expr {127 * $voice / ($levels - 1)}]
  1761. X                # keep track off pitches that need to go
  1762. X                # off
  1763. X                lappend notes_on $p
  1764. X                # clear delta
  1765. X                set delta 0
  1766. X            }
  1767. X        }
  1768. X        incr delta $time_delta
  1769. X
  1770. X        # do notes off if needed
  1771. X        if {[llength $notes_on] > 0} {
  1772. X            foreach p $notes_on {
  1773. X                midiput $mfile 1 $delta noteoff $Channel $p
  1774. X                # clear delta
  1775. X                set delta 0
  1776. X            }
  1777. X        }
  1778. X    }
  1779. X    # EOT for track 1
  1780. X    midiput $mfile 1 $delta metaeot
  1781. X
  1782. X    return $mfile
  1783. X}
  1784. X
  1785. proc SaveMIDI {} {
  1786. X    global InputValue
  1787. X    global InputValid
  1788. X    global InputIndex
  1789. X    global BaseFileName
  1790. X
  1791. X    set pos [split [wm geometry .] +]
  1792. X    set x [expr {[lindex $pos 1] + 20}]
  1793. X    set y [expr {[lindex $pos 2] + 20}]
  1794. X
  1795. X    tkwait window [GetText $x $y "File Name:" ${BaseFileName}.mid]
  1796. X    if {!$InputValid} {
  1797. X        return
  1798. X    }
  1799. X
  1800. X    set BaseFileName [join [lrange [split $InputValue .] \
  1801. X        0 [expr {[llength $InputValue] - 1}]] .]
  1802. X
  1803. X    ChangePositionLabel [.dg xview]
  1804. X
  1805. X    if {[file exists $InputValue] && ! [file writable $InputValue]} {
  1806. X        tkwait window [PutMessage $x $y \
  1807. X            "$InputValue exists and is not writable."]
  1808. X        return
  1809. X    }
  1810. X
  1811. X    # now let's write this puppy
  1812. X    set file [open $InputValue "w"]
  1813. X    set mfile [GenerateSMF $InputValue]
  1814. X    midiwrite $mfile $file
  1815. X    close $file
  1816. X    midifree $mfile
  1817. X}
  1818. X
  1819. proc PlayPattern {} {
  1820. X    global PlayPID
  1821. X    global PlayMFile
  1822. X
  1823. X    set mfile [GenerateSMF internal]
  1824. X    set PlayPID [midiplay background repeat $mfile]
  1825. X    set PlayMFile $mfile
  1826. X}
  1827. X
  1828. proc StopPlaying {} {
  1829. X    global PlayPID
  1830. X    global PlayMFile
  1831. X
  1832. X    if {$PlayPID != -1} {
  1833. X        midistop $PlayPID
  1834. X        midifree $PlayMFile
  1835. X        set PlayPID -1
  1836. X    }
  1837. X}
  1838. X
  1839. X
  1840. proc ChangePositionLabel {hit} {
  1841. X    global BaseFileName
  1842. X
  1843. X    set quant [lindex [.dg configure -quantization] 4]
  1844. X    set measure [expr {$hit / $quant}]
  1845. X    set remain [expr {$hit % $quant}]
  1846. X    set hit_per_beat [expr {$quant / 4}]
  1847. X    set beat [expr {$remain / $hit_per_beat}]
  1848. X    set q [expr {$remain % $hit_per_beat}]
  1849. X
  1850. X    .position configure -text \
  1851. X        "$BaseFileName - Measure:$measure Beat:$beat Quant:$q/$hit_per_beat"
  1852. X}
  1853. X
  1854. proc ChangePosition {hit} {
  1855. X
  1856. X    .dg xview $hit
  1857. X    ChangePositionLabel [.dg xview]
  1858. X}
  1859. X
  1860. X
  1861. proc GetText {x y prompt default} {
  1862. X    global InputValue
  1863. X    global InputValid
  1864. X
  1865. X    toplevel .get_text
  1866. X    wm transient .get_text .
  1867. X    wm geometry .get_text "+$x+$y"
  1868. X    grab .get_text
  1869. X
  1870. X    set InputValid 0
  1871. X
  1872. X    label .get_text.label -text "$prompt"
  1873. X    entry .get_text.entry
  1874. X    .get_text.entry insert 0 "$default"
  1875. X    bind .get_text.entry <Return> {set InputValue [.get_text.entry get]; \
  1876. X        set InputValid 1; destroy .get_text}
  1877. X    button .get_text.ok -text "OK" -command {set InputValue \
  1878. X        [.get_text.entry get]; set InputValid 1; destroy .get_text}
  1879. X    button .get_text.cancel -text "Cancel" -command {destroy .get_text}
  1880. X
  1881. X    focus .get_text.entry
  1882. X
  1883. X    pack append .get_text \
  1884. X        .get_text.label {top fill} \
  1885. X        .get_text.entry {top fill} \
  1886. X        .get_text.ok {left fill expand} \
  1887. X        .get_text.cancel {left fill expand}
  1888. X    return ".get_text"
  1889. X}
  1890. X
  1891. proc GetSelection {x y prompt list} {
  1892. X    global InputValue
  1893. X    global InputValid
  1894. X
  1895. X    toplevel .get_sel
  1896. X    wm transient .get_sel .
  1897. X    wm geometry .get_sel "+$x+$y"
  1898. X    grab .get_sel
  1899. X
  1900. X    set InputValid 0
  1901. X    set InputIndex 0
  1902. X
  1903. X    label .get_sel.label -text "$prompt"
  1904. X    listbox .get_sel.list -yscrollcommand {.get_sel.scrolly set}
  1905. X    foreach elem $list {
  1906. X        .get_sel.list insert end $elem
  1907. X    }
  1908. X    tk_listboxSingleSelect .get_sel.list
  1909. X    button .get_sel.cancel -text "Cancel" -command {destroy .get_sel}
  1910. X    scrollbar .get_sel.scrolly -command {.get_sel.list yview}
  1911. X
  1912. X    bind .get_sel.list <ButtonRelease-1> {set InputValue [selection get]; \
  1913. X        set InputValid 1; \
  1914. X        set InputIndex [.get_sel.list curselection]; \
  1915. X        destroy .get_sel}
  1916. X
  1917. X    pack append .get_sel \
  1918. X        .get_sel.label {top fill} \
  1919. X        .get_sel.cancel {bottom fill} \
  1920. X        .get_sel.scrolly {right filly} \
  1921. X        .get_sel.list {top fill expand}
  1922. X
  1923. X    return .get_sel
  1924. X}
  1925. X
  1926. proc PutMessage {x y message} {
  1927. X
  1928. X    toplevel .put_message
  1929. X    wm transient .put_message .
  1930. X    wm geometry .put_message "+$x+$y"
  1931. X    grab .put_message
  1932. X
  1933. X    label .put_message.message -text "$message"
  1934. X    button .put_message.ok -text "OK" -command {destroy .put_message}
  1935. X
  1936. X    pack append .put_message \
  1937. X        .put_message.message {top fill expand} \
  1938. X        .put_message.ok {bottom fill}
  1939. X    return ".put_message"
  1940. X}
  1941. X
  1942. proc StrToHex {str} {
  1943. X
  1944. X    foreach char [split $str {}] {
  1945. X        scan $char %c dec
  1946. X        lappend hex_str [format 0x%x $dec]
  1947. X    }
  1948. X
  1949. X    return $hex_str
  1950. X}
  1951. X
  1952. ChangePositionLabel 0
  1953. END_OF_FILE
  1954. if test 16554 -ne `wc -c <'xdrum-1.0/xdrum'`; then
  1955.     echo shar: \"'xdrum-1.0/xdrum'\" unpacked with wrong size!
  1956. fi
  1957. chmod +x 'xdrum-1.0/xdrum'
  1958. # end of 'xdrum-1.0/xdrum'
  1959. fi
  1960. if test -f 'xdrum-1.0/xdrum.1' -a "${1}" != "-c" ; then 
  1961.   echo shar: Will not clobber existing file \"'xdrum-1.0/xdrum.1'\"
  1962. else
  1963. echo shar: Extracting \"'xdrum-1.0/xdrum.1'\" \(3912 characters\)
  1964. sed "s/^X//" >'xdrum-1.0/xdrum.1' <<'END_OF_FILE'
  1965. X.Dd March 31, 1993
  1966. X.Os WISHM
  1967. X.Dt XDRUM 1
  1968. X.Sh NAME
  1969. X.Nm xdrum
  1970. X.Nd "a program for graphically creating and editing drum patterns"
  1971. X.Sh SYNOPSIS
  1972. X.Nm
  1973. X.Sh DESCRIPTION
  1974. X.Nm
  1975. is a program that runs under X.
  1976. It is designed to facilitate constructing and editing
  1977. rhythms for drum machines, and
  1978. is based on 
  1979. X.Xr TCL 1,
  1980. X.Xr TK  1
  1981. and
  1982. X.Xr TCLM 1 .
  1983. X.Nm
  1984. supports reading and saving the patterns in an
  1985. X.Tn ASCII
  1986. format as well as saving
  1987. patterns in the Standard
  1988. X.Tn MIDI
  1989. format for playing back with other utilities,
  1990. such as
  1991. X.Xr mplay 1 .
  1992. XEssentially,
  1993. X.Nm
  1994. is just a fancy wrapper around the
  1995. X.Xr drumgrid 3
  1996. widget.
  1997. See
  1998. X.Xr drumgrid 3
  1999. for further information.
  2000. X.Pp
  2001. X.Nm
  2002. uses the default
  2003. X.Xr drumgrid 3
  2004. bindings.
  2005. Pressing mouse button 1 in a box will
  2006. increase the velocity of the box by 1.
  2007. Pressing mouse button 3 decrease the
  2008. velocity by 1, and pressing mouse button 2 sets
  2009. the velocity to zero.
  2010. Since it is a pain to constantly click the mouse
  2011. button to set velocities to higher values,
  2012. keyboard accelerators have also been incorporated
  2013. into
  2014. X.Nm Ns . 
  2015. The velocity of a box can be set directly to a
  2016. specific value by first moving the mouse to the
  2017. box and then pressing a key in the range 0 - 9,
  2018. where the key value is the desired velocity.
  2019. The '+' key can be used to increment the velocity
  2020. of a box by 10 and the '-' decrements the velocity
  2021. by 10.
  2022. Thus, you can set the value to velocities greater
  2023. than 9.
  2024. If you specify a velocity greater than the maximum
  2025. level, the maximum level will be used.
  2026. X.Pp
  2027. X.Nm
  2028. also has 2, or 3, pull down menus that allow you
  2029. to adjust the parameters in the grid and save or load
  2030. files.
  2031. The optional third menu will only appear if the
  2032. X.Xr tclm 1
  2033. library was compiled with play support.
  2034. The ``Adjust Grid'' menu allows you to add voices and
  2035. remove them, change the pitch of voices, which is a voice's
  2036. associated
  2037. X.Tn MIDI
  2038. value, change the tempo
  2039. of the pattern, change the
  2040. X.Tn MIDI
  2041. channel on which
  2042. the pattern is played and change the division value to
  2043. use when generating a
  2044. X.Tn MIDI
  2045. file.
  2046. This menu also allows you to change the configuration of
  2047. the grid.
  2048. You can change the number of measures in the pattern, the
  2049. number of beats per measure, the quantization value and
  2050. the number velocity levels (remember a velocity of zero
  2051. counts as a level).
  2052. These options are displayed below a line in the menu because
  2053. changing these values will erase anything that is currently
  2054. in the grid.
  2055. X.Pp
  2056. The ``File I/O'' menu allows you to save a pattern in
  2057. an
  2058. X.Tn ASCII
  2059. format, load a pattern that was previously
  2060. saved in the
  2061. X.Tn ASCII
  2062. format and save a pattern as
  2063. a Standard
  2064. X.Tn MIDI
  2065. file.
  2066. X.Nm
  2067. cannot load files in the Standard
  2068. X.Tn MIDI
  2069. format.
  2070. XFiles that have been saved in the
  2071. X.tn ASCII
  2072. format
  2073. may also be edited by hand with your favorite editor.
  2074. X.Pp
  2075. The optional third menu allows you to start playing the
  2076. pattern and stop playing the pattern.
  2077. This menu will only appear if your version of the
  2078. X.Xr tclm 1
  2079. library was compiled with support for playing Standard
  2080. X.Tn MIDI
  2081. files.
  2082. X.Pp
  2083. There is also a ``Quit'' button for exiting the application.
  2084. X.Pp
  2085. Since
  2086. X.Nm
  2087. may only display a portion of the pattern at one time,
  2088. a message is displayed above the grid showing
  2089. where in the pattern
  2090. the display begins.
  2091. This value is shown in measures, beats and fractions of a beat.
  2092. The name of the pattern is also displayed.
  2093. The scrollbars allow you to move around in the pattern.
  2094. X.Sh APPLICATION RESOURCES
  2095. The application resources which are part of the
  2096. X.Xr drumgrid 3
  2097. widget are
  2098. available to customize the
  2099. X.Nm
  2100. setup.
  2101. It is recommended that the voices and related pitches be
  2102. stored in your .Xdefaults file so they need not be set
  2103. by hand each time
  2104. X.Nm
  2105. is run.
  2106. X.Sh SEE ALSO
  2107. X.Xr tclm 1 ,
  2108. X.Xr wish 1 ,
  2109. X.Xr drumgrid 3
  2110. X.Sh AUTHORS
  2111. X.Tn TCL
  2112. and
  2113. X.Tn TK
  2114. X.D1 John Ousterhout - ouster@cs.berkeley.edu
  2115. X.Tn TCLM
  2116. and
  2117. X.Tn XDRUM
  2118. X.D1 Mike Durian - durian@advtech.uswest.com
  2119. X.Sh BUGS
  2120. Just because I don't currently know of any doesn't mean they
  2121. aren't there.
  2122. END_OF_FILE
  2123. if test 3912 -ne `wc -c <'xdrum-1.0/xdrum.1'`; then
  2124.     echo shar: \"'xdrum-1.0/xdrum.1'\" unpacked with wrong size!
  2125. fi
  2126. # end of 'xdrum-1.0/xdrum.1'
  2127. fi
  2128. echo shar: End of archive 1 \(of 2\).
  2129. cp /dev/null ark1isdone
  2130. MISSING=""
  2131. for I in 1 2 ; do
  2132.     if test ! -f ark${I}isdone ; then
  2133.     MISSING="${MISSING} ${I}"
  2134.     fi
  2135. done
  2136. if test "${MISSING}" = "" ; then
  2137.     echo You have unpacked both archives.
  2138.     rm -f ark[1-9]isdone
  2139. else
  2140.     echo You still need to unpack the following archives:
  2141.     echo "        " ${MISSING}
  2142. fi
  2143. ##  End of shell archive.
  2144. exit 0
  2145.  
  2146. exit 0 # Just in case...
  2147.