download edit-menu.scm
Language: Scheme
LOC: 118
Project Info
Snd
Server: SourceForge
Type: cvs
SourceForge\s\snd\snd\cvs‑snd\
   _new_snd-test.rb
   _sndlib.h
   aclocal.m4
   analog-filter.scm
   audinfo.c
   audio.c
   autosave.scm
   bess.rb
   bess.scm
   bess1.rb
   bess1.scm
   bird.rb
   bird.scm
   clm-ins.rb
   clm-ins.scm
   clm-strings.h
   clm.c
   clm.h
   clm23.scm
   clm2xen.c
   clm2xen.h
   cmn-glyphs.lisp
   config.guess
   config.h.in
   config.rpath
   config.sub
   configure.ac
   debug.scm
   dlocsig.rb
   draw.rb
   draw.scm
   dsp.rb
   dsp.scm
   edit-menu.scm
   edit123.scm
   effects-utils.scm
   effects.rb
   env.rb
   env.scm
   enved.scm
   eval-c.scm
   event.scm
   examp.rb
   examp.scm
   extensions.rb
   extensions.scm
   fade.scm
   fft-menu.scm
   fix-optargs.scm
   fmv.scm
   freeverb.rb
   freeverb.scm
   gettext.h
   gl.c
   grani.scm
   gtk-effects.scm
   gtk-popup.scm
   gui.scm
   headers.c
   help-snd-fm.pd
   help-snd.pd
   HISTORY.Snd
   hooks.rb
   hooks.scm
   index.rb
   index.scm
   inf-snd.el
   io.c
   jcrev.scm
   ladspa-help.scm
   ladspa.scm
   makefile.in
   makefile.no-gettext
   maraca.rb
   maraca.scm
   marks-menu.scm
   marks.rb
   marks.scm
   maxf.rb
   maxf.scm
   midi.c
   misc.scm
   mix-menu.scm
   mix.rb
   mix.scm
   mixer.scm
   moog.scm
   musglyphs.rb
   musglyphs.scm
   nb.rb
   nb.scm
   new-backgrounds.scm
   new-buttons.scm
   new-effects.scm
   new-icons.scm
   noise.rb
   noise.scm
   old-mac-audio.c
   old-snd.spec
   oo.scm
   oscope.scm
   panic.scm
   pd-add.scm
   pd-any.scm
   pd-fm.scm
   pd-global.scm
   pd-inout.scm
   pd-local.scm
   pd-mozilla.scm
   pd-send_receive.scm
   peak-env.scm
   piano.rb
   piano.scm
   play.rb
   play.scm
   poly.rb
   poly.scm
   popup.rb
   popup.scm
   prc95.rb
   prc95.scm
   pvoc.rb
   pvoc.scm
   README.Snd
   rgb.rb
   rgb.scm
   rmsgain.scm
   rt-compiler.scm
   rt-engine.scm
   rt-examples.scm
   rt.tex
   rtio.rb
   rtio.scm
   rubber.rb
   rubber.scm
   saw.c
   singer.rb
   singer.scm
   snd-0.h
   snd-1.h
   snd-axis.c
   snd-chn.c
   snd-completion.c
   snd-dac.c
   snd-data.c
   snd-draw.c
   snd-edits.c
   snd-env.c
   snd-error.c
   snd-fft.c
   snd-file.c
   snd-file.h
   snd-find.c
   snd-g0.h
   snd-g1.h
   snd-gchn.c
   snd-gdraw.c
   snd-gdrop.c
   snd-genv.c
   snd-gfft.c
   snd-gfile.c
   snd-gfind.c
   snd-ghelp.c
   snd-gl.scm
   snd-glistener.c
   snd-gmain.c
   snd-gmenu.c
   snd-gmix.c
   snd-gprefs.c
   snd-gprint.c
   snd-grec.c
   snd-gregion.c
   snd-gsnd.c
   snd-gtk.scm
   snd-gutils.c
   snd-gxbitmaps.c
   snd-gxcolormaps.c
   snd-gxen.c
   snd-gxutils.c
   snd-help.c
   snd-hobbit.scm
   snd-io.c
   snd-kbd.c
   snd-ladspa.c
   snd-listener.c
   snd-main.c
   snd-marks.c
   snd-menu.c
   snd-menu.h
   snd-mix.c
   snd-motif.scm
   snd-nogui.c
   snd-nogui0.h
   snd-nogui1.h
   snd-prefs.c
   snd-print.c
   snd-rec.c
   snd-rec.h
   snd-region.c
   snd-run.c
   snd-select.c
   snd-sig.c
   snd-snd.c
   snd-strings.h
   snd-trans.c
   snd-utils.c
   snd-x0.h
   snd-x1.h
   snd-xchn.c
   snd-xdraw.c
   snd-xdrop.c
   snd-xen.c
   snd-xenv.c
   snd-xfft.c
   snd-xfile.c
   snd-xfind.c
   snd-xhelp.c
   snd-xlistener.c
   snd-xm.rb
   snd-xmain.c
   snd-xmenu.c
   snd-xmix.c
   snd-xprefs.c
   snd-xprint.c
   snd-xrec.c
   snd-xref.c
   snd-xregion.c
   snd-xsnd.c
   snd-xutils.c
   snd-xxen.c
   snd.1
   Snd.ad
   snd.c
   Snd.gtkrc
   snd.h
   snd.spec
   snd_conffile.scm
   snd_pd_external.c
   snd_pd_external.h
   snd4.scm
   snd5.scm
   snd6.scm
   snd7.scm
   sndctrl.c
   sndinfo.c
   sndlib-strings.h
   sndlib.h.in
   sndlib2xen.c
   sndlib2xen.h
   sndplay.c
   sndrecord.c
   sndwarp.scm
   sound.c
   special-menu.scm
   spectr.rb
   spectr.scm
   strad.rb
   strad.scm
   TODO.Snd
   track-colors.scm
   v.rb
   v.scm
   vct.c
   vct.h
   ws.rb
   ws.scm
   xen.c
   xen.h
   xg-x11.h
   xm-enved.rb
   xm-enved.scm
   zip.rb
   zip.scm

;;; add some useful options to the Edit menu
;;;
;;; these used to be in the effects menu

(use-modules (ice-9 format))
(provide 'snd-edit-menu.scm)

(if (and (not (provided? 'snd-gtk))
	 (provided? 'xm)
	 (not (provided? 'snd-effects-utils.scm)))
    (load-from-path "effects-utils.scm"))

(define edit-menu 1)

;(add-to-menu edit-menu #f #f)


;;; -------- selection -> new file

(define (selection->new)
  "(selection-<new) saves the selection in a new file, then opens that file"
  (if (selection?)
      (let ((new-file-name (snd-tempnam)))
	(save-selection new-file-name)
	(open-sound new-file-name))
      #f))

(add-to-menu edit-menu "Selection->new" selection->new 8) ;pos=8 puts this in the selection section in the Edit menu


;;; -------- cut selection -> new file

(define (cut-selection->new)
  "(cut-selection->new) saves the selection, deletes it, then opens the saved file"
  (if (selection?)
      (let ((new-file-name (snd-tempnam)))
	(save-selection new-file-name)
	(delete-selection)
	(open-sound new-file-name))
      #f))

(add-to-menu edit-menu "Cut selection->new" cut-selection->new 9)


;;; -------- append selection

(define (append-selection)
  "(append-selection) appends the current selection"
  (if (selection?)
      (insert-selection (frames))))

(add-to-menu edit-menu "Append selection" append-selection 10)


;;; -------- make-stereofile
(define (make-stereofile)
  (let* ((ofile-name (file-name))
	 (old-sound (selected-sound))
	 (nsnd (new-sound (string-append ofile-name ".stereo") (header-type) (data-format) (srate) 2)))
    (if (not nsnd)
	(begin
	  (display "Could not make new sound.")(newline))
	(begin
	  (insert-sound ofile-name 0 0 nsnd 0)
	  (insert-sound ofile-name 0 (if (> 0 (channels old-sound)) 1 0) nsnd 1)))))

(add-to-menu edit-menu "Make Stereofile" make-stereofile)

;;; --------


(add-to-menu edit-menu #f #f)

;;; -------- trim front and back (goes by first or last mark)

(define (trim-front)
  "(trim-front) finds the first mark in each of the syncd channels and removes all samples before it"
  (let ((snc (sync)))
    (define (trim-front-one-channel snd chn)
      (if (< (length (marks snd chn)) 1)
	  (report-in-minibuffer "trim-front needs a mark" snd)
	  (delete-samples 0 (mark-sample (car (marks snd chn))) snd chn)))
    (if (> snc 0)
	(apply map
	       (lambda (snd chn)
		 (if (= (sync snd) snc)
		     (trim-front-one-channel snd chn)))
	       (all-chans))
	(trim-front-one-channel 
	 (or (selected-sound) (car (sounds))) 
	 (or (selected-channel) 0)))))

(add-to-menu edit-menu "Trim front" trim-front)

(define (trim-back)
  "(trim-back) finds the last mark in each of the syncd channels and removes all samples after it"
  (let ((snc (sync)))
    (define (trim-back-one-channel snd chn)
      (if (< (length (marks snd chn)) 1)
	  (report-in-minibuffer "trim-back needs a mark" snd)
	  (let ((endpt (mark-sample (car (reverse (marks snd chn))))))
	    (delete-samples (+ endpt 1) (- (frames snd chn) endpt)))))
    (if (> snc 0)
	(apply map
	       (lambda (snd chn)
		 (if (= (sync snd) snc)
		     (trim-back-one-channel snd chn)))
	       (all-chans))
	(trim-back-one-channel 
	 (or (selected-sound) (car (sounds))) 
	 (or (selected-channel) 0)))))

(add-to-menu edit-menu "Trim back" trim-back)


;;; -------- crop (trims front and back)

(define* (crop-one-channel #:optional snd chn)
  (if (< (length (marks snd chn)) 2)
      (report-in-minibuffer "crop needs start and end marks" snd)
      (as-one-edit
       (lambda ()
	 (delete-samples 0 (mark-sample (car (marks snd chn))) snd chn)
	 (let ((endpt (mark-sample (car (reverse (marks snd chn))))))
	   (delete-samples (+ endpt 1) (- (frames snd chn) endpt))))
       "crop-one-channel")))

(define (crop)
  "(crop) finds the first and last marks in each of the syncd channels and removes all samples outside them"
  (let ((snc (sync)))
    (if (> snc 0)
	(apply map
	       (lambda (snd chn)
		 (if (= (sync snd) snc)
		     (crop-one-channel snd chn)))
	       (all-chans))
	(crop-one-channel 
	 (or (selected-sound) (car (sounds)))
	 (or (selected-channel) 0)))))

(add-to-menu edit-menu "Crop" crop)


;;; -------- add these to the Edit menu, if possible

(if (and (not (provided? 'snd-gtk))
	 (provided? 'xm))
    (let* ((edit-cascade (list-ref (menu-widgets) 2))
	   (edit-menu (cadr (XtGetValues edit-cascade (list XmNsubMenuId 0)))))

      (XtAddCallback edit-cascade XmNcascadingCallback 
	(lambda (w c i)
	  (for-each-child 
	   edit-menu
	   (lambda (child)
	     (if (or (string=? (XtName child) "Selection->new")
		     (string=? (XtName child) "Cut selection->new")
		     (string=? (XtName child) "Append selection"))
		 (XtSetSensitive child (selection?))
		 (if (string=? (XtName child) "Crop")
		     (XtSetSensitive child (and (selected-sound)
						(> (length (marks (selected-sound) (selected-channel))) 1)))
		     (if (or (string=? (XtName child) "Trim front")
			     (string=? (XtName child) "Trim back"))
			 (XtSetSensitive child (and (selected-sound)
						    (>= (length (marks (selected-sound) (selected-channel))) 1))))))))))))


About Koders | Resources | Downloads | Support | Black Duck | Submit Project | Terms of Service | DMCA | Privacy Policy | Site Map| Contact Us