Hi, George and all,
This time, f-get-4play-data prints the counted number while writing
the data to file, in order to memorize the place when you find the sound,
phrase or rhythm you like.
On the other hand, f-get-4play-data, f-assign-4play-data added an argument
for printing on-off.
And 2 tiny tools.
Some changes on the others, too .....
;; This function sets two file port variables and a file,
;; these file port variables are defined as gloval variables,
;; and put the path-file name in a property list of this file port variable.
;; Old version used a property list of value of this file port variable,
;; a token, like as #<PORT0x1153a7240>, but now not value but gloval variable name,
;; like as '*fport-in1* etc .... (put '*fport-in1* 'fname "/any..path/fname")
;;
;; usage: (fl-set *fport-out1* *fport-in1* "/any..path/fname" )
;;
(define-macro (fl-set f-out-port f-in-port f-path-name)
`(begin
(define ,f-out-port 'closed) ; file port var as gloval variable
(put (quote ,f-out-port) 'fname ,f-path-name)
(define ,f-in-port 'closed)
(put (quote ,f-in-port) 'fname ,f-path-name)
(fl-init (quote ,f-in-port))
))
;; initialize f-count, end-n, called by some functions
;;
(define fl-init
(lambda (f-port-var)
(put f-port-var 'f-count 0)
(put f-port-var 'end-n 0)))
;; file open function
;; arguments are <out> or <in>、<file port var name defined in fl-set>
;; usage: (fl-open out *fport-out1*)
;; or
;; (fl-open in *fport-in1*)
;;
(define-macro (fl-open out-or-in f-port-var)
`(begin
(fl-close ,out-or-in ,f-port-var)
(set! ,f-port-var (,(if (eq? out-or-in 'out) 'open-output-file 'open-input-file)
(get (quote ,f-port-var) 'fname)))
(println ,(if (eq? out-or-in 'out) ''open-out ''open-in))
(fl-init (quote ,f-port-var))))
;; file close function
;; arguments are <out> or <in>、<file port var name defined in fl-set>
;; usage: (fl-close out *fport-out1*)
;; or
;; (fl-close in *fport-in1*)
;;
(define-macro (fl-close out-or-in f-port-var)
`(begin
(if (eq? ,f-port-var 'closed)
'already-closed-!
(begin
(,(if (eq? out-or-in 'out) 'close-output-port 'close-input-port) ,f-port-var)
(set! ,f-port-var 'closed)
(println ,(if (eq? out-or-in 'out) ''close-out ''close-in))
(fl-init (quote ,f-port-var))))))
;; This function gets data in a function that including this function,
;; then writes it to the file while the target file is open,
;; not closed, thas is, after (fl-open out .....)
;; if closed by (fl-close out ...), this does nothing.
;; And this prints out the count number of writing data in shell window while working.
;;
;; 2nd argument is boolean, #t or #f for printing on/off
;;
;; usage:
;; (f-get-4play-data *fport-out1* #t p v d p2 v2...) 2nd arg #t to print the counting number,
;; or
;; (f-get-4play-data *fport-out1* #f p v d p2 v2...) 2nd arg #f, no print
;;
(define-macro (f-get-4play-data f-port-var prt-bool . args)
(let ((a (gensym)))
`(if (not (eq? ,f-port-var 'closed))
(let ((n (+ 1 (get (quote ,f-port-var) 'f-count)))
(got-data (map (lambda (,a)
(eval ,a))
(quote ,args))))
(if ,prt-bool
(begin (print n) (print ", ")))
(put (quote ,f-port-var) 'f-count n)
(write got-data ,f-port-var)))))
;; This function reads data from a file and assigns them to the variables
;; in a function involving this funtion, printing the count number and it's
;; data in the shell window while the target file is open, not closed.
;; When this gets a end of file, close the file and stop to read,
;; then do nothing while the data file is closed.
;; This function begins to read the file again whenever the file
;; is opened by (fl-open .....) or (fl-opne-ff ......)
;;
;; 2nd argument is boolean, #t or #f for printing on/off.
;;
;; usage:
;; (f-assign-4play-data *fport-in1* #t p v d p2 v2 ...) prints the data in the shell window.
;; or
;; (f-assign-4play-data *fport-in1* #f p v d p2 v2 ...) no print, because of 2nd arg.
;;
(define-macro (f-assign-4play-data f-port-var prt-bool . args)
(let ((a (gensym)))
`(if (not (eq? ,f-port-var 'closed))
(let ((n (+ 1 (get (quote ,f-port-var) 'f-count)))
(end-num (get (quote ,f-port-var) 'end-n))
(s-exp-data (read ,f-port-var)))
(cond ((or (and (> end-num 0)
(> n end-num))
(eof-object? s-exp-data))
(fl-close in ,f-port-var)
(if (eof-object? s-exp-data)
(println 'file 'end)
(println 'file 'data 'exceed end-num)))
(else
(if ,prt-bool
(begin (print n) (print ":") (print s-exp-data)(print ", ")))
(put (quote ,f-port-var) 'f-count n)
(map (lambda (,a)
(eval (list 'set! ,a '(car s-exp-data))) ; corrected, 2020-04-02 by minoru
(set! s-exp-data (cdr s-exp-data)))
(quote ,args))))))))
;; This fast forwards the file reading,
;; and optional argument sets the end position at any place, too.
;;
;; usage:
;; (fl-open-ff *fport-in1* 2) reads 2 list, so you get the data from 3rd to the last.
;; (fl-open-ff *fport-in1* 1 4) read 1 list, and sets the 4th data as the last one,
;; so you get the data from 2nd to 4th.
;; (fl-open-ff *fport-in1* 0 4) you get the data from 1st to 4th.
;;
;; It's possible to run this again befor the setting condition is over, that is,
;; while using the data on the condition that preceding another this function set,
;; or without closing the file, (fl-close in *fport-in2*),
;; you can run this again and again at any time you like.
;;
(define-macro (fl-open-ff f-port-var ffn . end-targ-n)
`(begin
(fl-close in ,f-port-var)
(set! ,f-port-var (open-input-file (get (quote ,f-port-var) 'fname)))
(if (null? (quote ,end-targ-n))
(put (quote ,f-port-var) 'end-n 0)
(put (quote ,f-port-var) 'end-n (car (quote ,end-targ-n))))
(if (not (= 0 ,ffn))
(let loop ((n 1) (s-exp-data (read ,f-port-var)))
(if (or (>= n ,ffn) (eof-object? s-exp-data))
(cond ((eof-object? s-exp-data)
(fl-close in ,f-port-var)
(println "FF over, file end ..."))
(else
(put (quote ,f-port-var) 'f-count n)))
(loop (+ n 1) (read ,f-port-var)))))))
;;;;; example of playing music, recoding and playing(back) the file data ;;;;;
(begin
(sys:load "libs/core/instruments.xtm")
(sys:load "libs/core/pc_ivl.xtm")
(sys:load "libs/core/audio_dsp.xtm" )
)
(make-instrument fmsynth fmsynth)
(bind-func dsp:DSP
(lambda (in time chan dat)
(fmsynth in time chan dat)))
(dsp:set! dsp)
;; just simple playing function with random data
(define play1
(lambda (beat-n)
(let ((p (+ 0 (random '(60 64 67)))) ; change 0 -> 12 or 24 after recording data
(v 70)
(d (random '(1 1/2 1/2 1/4))))
;; just add these 2 lines in your ordinary playing function,
;; and add variables as many as you need, p2 v2 d2 etc ...
(f-get-4play-data *fport-out2* #t p d) ; to file, print on
(f-assign-4play-data *fport-in2* #t p d) ; from file, print on
(play-note (*metro* beat-n) fmsynth p v (*metro* 'dur d) .24 .5)
(callback (*metro* (+ beat-n (* .5 d))) 'play1 (+ beat-n d)))))
;; You have to evaluate this before play1 involving (f-get- ....) and (f-assign- ....) runs.
(fl-set *fport-out2* *fport-in2* "/.../save-file2.txt");<-Use a real file path/name !!!
;; start playing now !
(play1 (*metro* 'get-beat))
;; it's just playing ......
;; evaluate this to begin recording when you like
(fl-open out *fport-out2*)
;; it begins to print the counted number in the shell window,
;; so you can memorize the place when you find nice phrase/rhythm etc,
;; then you can re-play that place by fl-open-ff .
;; you can change f-get-4play-data's 2nd arg's value #t to #f when
;; printing info bothers you.
;; evaluate this to stop recording at anytime
(fl-close out *fport-out2*)
;; don't stop the music !
;; chnage the above (p (+ 0 .....)) to (p (+ 12)), then re-evaluate it.
;; you hear the higher sounds after this change.
;; then you can hear the lower sounds when evaluate the below line ..
;; because play1 uses p,d value from the file now,
;; and you see the number and data from the file in the shell window.
;; no printing them when f-assign-4play-data's 2nd arg is #f
(fl-open in *fport-in2*)
;; when you evaluate this, reading data from the file stops with printing "close-in",
;; then you hear the higher sounds because of (p (+ 12 ...)), that is, playing
;; random data starts again, not data from the file.
(fl-close in *fport-in2*)
;; when it gets end of file before you do above (fl-close in ....)
;; the same results as above comes with printing "file end and closed ..."
;; and anytime you do above (fl-open in *fport-in2*),
;; you hear the lower sounds because of the file data ...
;; and you can rewind it whenever you do this (fl-open in *fport-in2*).
;; then you evaluate this, play1 begins to play the data from 11th to the last
;; on the file, you can do this at any time. It's possible to do this again
;; without waiting the end of file.
(fl-open-ff *fport-in2* 10)
;; and by next code, play1 plays from 11th to 20th, then stops to reading,
;; then play1 plays random data again as (define play1 ....)
;; and you can re-evaluate this code while the preceding this code is running,
;; so you can do this again while paying data is between 11th - 20th,
;; then play1 plays from 11th again, or with different argument values that
;; makes play1 play the data of another place on the same file,
;; at anytime you like, as many as you like.
;; if you have some notes that show the place you like, the number of data place,
;; printed number while recording by f-get-4play-data,
;; it's this function that uses those number.
(fl-open-ff *fport-in2* 10 20)
;; While the file is closed, e.g., (fl-close in ...) or "file end and closed",
;; (fl-open out *fport-out2*) makes it's new recording start again,
;; You can do this as many times as you want.
;; Don't forget (fl-close out *fport-out2*) to close the file.
;; end
(define play1 (lambda ()))
;; You can write or edit the file directly, too, of course !!
;; this data file is (value1 value2 ..) (value1 value2 .....) .... just simple!
;; It reads one list at every time.
;; p.s.
;; I tried above functions on a file consists of 7980 lists, sum of duration is 4480 beat,
;; it meant the data to play for 37.3 min by 120bpm. It's enough long.
;; This code (fl-open-ff *fport* 7970) was evaluated many times befor it's over,
;; and it did that FF without any delay or stagnation.
;; These are tiny tools for the recorded list data file.
;; 1.
;; This returns number of list, beat, time from the data like
;; (val1 val2 val3 ....) (...) .. on the file.
;; usage: (count-time "/.../fname.txt/ (*metro* 'get-tempo) n)
;; or
;; (count-time "/.../fname.txt/ 90 n) ; 90 is your bpm
;; n is position of duration value in list,
;; 2 for (pitch dur), 3 for (pitch vol dur) etc ...
;;
(define count-time
(lambda (fname bpm place-dur) ; 3rd var: place of duration in a list, 1 or 2 or ....
(let ((fp (open-input-file fname)))
(let loop((n 0)
(ans 0)
(lis (read fp)))
(if (eof-object? lis)
(begin
(close-input-port fp)
(println n 'list, ans 'beat, (exact->inexact (/ ans bpm)) 'min,
'by (real->integer bpm) 'bpm))
(loop (+ n 1)(+ ans (list-ref lis (- place-dur 1))) (read fp)))))))
;; when playing the data with the current bpm
(count-time (get '*fport-out2* 'fname) (*metro* 'get-tempo) 2)
; --> 501 list, 1131/4 beat, 2.356250 min, by 120 bpm
;; when playing the same data with a different bpm.
(count-time (get '*fport-out2* 'fname) 90 2)
; --> 501 list, 1131/4 beat, 3.141667 min, by 90 bpm
;; 2.
;; This writes the list data you want on the file to another file.
;; usage:
;; (f-clip "/../file1" "/../file2" 0) -> write 1st to the last list on file1 to file2
;; (f-clip "/../file1" "/../file2" 3) -> write 4th to the last list on file1 to file2
;; (f-clip "/../file1" "/../file2" 0 5) -> write 1st to 5th list on file1 to file2
;; (f-clip "/../file1" "/../file2" 2 5) -> 3rd to 5th, .... like fl-open-ff .
(define f-clip
(lambda (targ-f new-f n1 . n2)
(let ((f-port-in (open-input-file targ-f))
(f-port-out (open-output-file new-f))
(end-n (if (null? n2) 0 (car n2))))
(let loop ((n 1)
(lis (read f-port-in)))
(cond ((or (eof-object? lis)
(and (not (= end-n 0))
(> n end-n)))
(close-input-port f-port-in)
(close-output-port f-port-out))
(else
(if (> n n1) ;-> write n+1 to n2, (>= n n1) --> write n1 to n2
(write lis f-port-out))
(loop (+ n 1) (read f-port-in))))))))
(f-clip (get '*fport-out2* 'fname) "/.. your-file-path../newfile.txt" 1 5)
2021年5月30日日曜日 15:59:29 UTC+9 Minoru: