Skip to content

Commit 04df38b

Browse files
WilliamClementsWilliamClements
committed
reinstate minimum size of SoundFont instrument sample
1 parent 21d9b2d commit 04df38b

File tree

4 files changed

+35
-24
lines changed

4 files changed

+35
-24
lines changed

‎PCommand/app/Rosters.lhs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@
2323
> , ("+cjingles", cjingles)
2424
> , ("+djingles", djingles)
2525
> , ("+njingles", njingles)
26+
> , ("+xjingles", xjingles)
2627
> , ("+zjingles", zjingles)
2728
> , ("+all", ajingles ++ bjingles ++ cjingles ++ djingles ++ ejingles ++ njingles ++ zjingles)]
2829
>
@@ -62,6 +63,8 @@
6263
> [ Song "iboogie" (iboogie dives) Map.empty
6364
> , Song "opus131" (opus131 dives) Map.empty
6465
> , Song "bake" (bakedJingle dives 93) Map.empty]
66+
> xjingles =
67+
> [ Song "whelpNarp" whelpNarp Map.empty]
6568
> zjingles =
6669
> [ Song "deathlessHorsie" (deathlessHorsie dives) Map.empty
6770
> , Song "basicLick" (basicLick dives) Map.empty

‎Parthenopea/Repro/Synthesizer.lhs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -187,7 +187,7 @@ Euterpea provides call back mechanism for rendering. Each Midi note, fully speci
187187
> ampL = fromIntegral noon.noteOnVel / 100 / cAttenL
188188
> ampR = fromIntegral noon.noteOnVel / 100 / cAttenR
189189

190-
Account for custom frequency intervals -- SoundFont scale tuning : 0 < x < 100 < 1200
190+
Account for custom frequency intervals = SoundFont scale tuning : 0 < x < 100 < 1200
191191
Clearly multiple root pitches are mutually incompatible, in general, for calculating frequency ratios
192192

193193
For example, input of 3 = key interval, 50 = scale tuning, yields ratio of: 1.09

‎Parthenopea/SoundFont/Boot.lhs‎

Lines changed: 17 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -100,8 +100,8 @@ FileWork =======================================================================
100100
> IntMap.empty
101101
> IntMap.empty
102102
> IntMap.empty
103-
>
104103
> makeLenses ''Pairing
104+
>
105105
> data FileWork =
106106
> FileWork {
107107
> fwDirectives :: Directives
@@ -174,13 +174,13 @@ Task preSample caches file's Sample Headers
174174
Task smell creates sample-level Partner map, based on preSampleCache
175175
Task instrument creates the zrec collection (IntMap) based on file's Instrument data
176176
Task capture creates pzdb, based on file's Zone data, and generates zone owners collection (also IntMap)
177-
Task clean
178-
deletes empty zrecs based on Owners map
177+
Task clean deletes empty zrecs based on Owners map
179178
Task adopt (adds dispos only, based on Owners map)
180179
Task smash creates smashups based on Owners map and PreZone data
181180
Task reorg invalidates Owners Map by what it does
182181
deletes Instruments, in effect
183182
modifies thereby orphaned PreZones to belong to absorbing member Instrument
183+
repairs owners map afterward
184184
Task match (modifies fuzzy data only)
185185
Task pair
186186
develops Pairing
@@ -262,12 +262,12 @@ Boot executive function ========================================================
262262
> = fiIn{ fiFw = (snd . head) fiTaskIfs fiFw
263263
> , fiTaskIfs = tail fiTaskIfs}
264264
> vFiles' = vFiles `VB.snoc` sffile{zPreZones = sy.sPreZones}
265-
> survey' =
265+
> sy' =
266266
> sy{sPerInstruments = Map.union cacheIn sy.sPerInstruments
267267
> , sMatches = combineMatches matchesIn sy.sMatches
268268
> , sDispositions = combinerd rdIn sy.sDispositions}
269269
> in
270-
> (vFiles', survey')
270+
> (vFiles', sy')
271271

272272
support sample and instance ===========================================================================================
273273

@@ -547,6 +547,7 @@ capture task ===================================================================
547547
>
548548
> ok =
549549
> 0 <= stA && stA <= enA && 0 <= stL && stL <= enL
550+
> && enA - stA > 200
550551
> && enA - stA < 2 ^ (22::Word)
551552
> && (digest.zdSampleMode == Just A.NoLoop || enL - stL < 2 ^ (22::Word))
552553

@@ -579,7 +580,9 @@ produce and process capture results ============================================
579580
> hasRom pz = stype pz >= 0x8000
580581
> romClue pz = showHex (stype pz) []
581582
> rangeClue pz = show (pz.pzDigest.zdKeyRange, pz.pzDigest.zdVelRange)
582-
>
583+
584+
consume zone ==========================================================================================================
585+
583586
> buildZone :: SFZone → Maybe PreZone → Word → SFZone
584587
> buildZone fromZone mpz bix
585588
> | traceIf trace_BZ False = undefined
@@ -695,8 +698,8 @@ pair task ======================================================================
695698
> , psTasks :: [(String, PairsSurvey → IntMap Int)]}
696699
>
697700
> pairTaskIf _ _ fWork =
698-
> ( (fwPairing . fwZonePairings .~ survey.psPaired)
699-
> . (fwDispositions .~ survey.psDispos)) fWork
701+
> ( (fwPairing . fwZonePairings .~ sy.psPaired)
702+
> . (fwDispositions .~ sy.psDispos)) fWork
700703
> where
701704
> fName__ = "pairTaskIf"
702705
>
@@ -711,8 +714,8 @@ pairing approach ===============================================================
711714

712715
And remember: peg 'em and pin 'em! I.E. collate (peg) candidates to push (pin) matchers to pairs list.
713716

714-
> survey :: PairsSurvey
715-
> survey = head $ dropWhile unfinished $ iterate' nextGen sinit
717+
> sy :: PairsSurvey
718+
> sy = head $ dropWhile unfinished $ iterate' nextGen sinit
716719
> where
717720
> sinit =
718721
> PairsSurvey
@@ -742,8 +745,7 @@ pairing approach ===============================================================
742745
> (tail sy.psTasks)
743746

744747
Pairing algorithm phases ==============================================================================================
745-
Each of these three functions operates on unpaired set. They are invoked, in following sequence,
746-
during iterate'.
748+
Each of these three functions operates on unpaired set. They are invoked, in equence, during iterate'.
747749

748750
> nominal sy =
749751
> IntMap.foldlWithKey (conducePartners False sy.psUnpaired) IntMap.empty _fwSamplePairings
@@ -861,7 +863,9 @@ pairing convenience functions ==================================================
861863
> where pz = accessPreZone "makeActions" fWork._fwPreZones bix
862864
> in
863865
> IntSet.foldl' make IntMap.empty
864-
>
866+
867+
husband owners ========================================================================================================
868+
865869
> makeOwners :: IntMap PreZone {- [BagIndex → pz] -}
866870
> → IntMap IntSet {- [InstIndex → [BagIndex]] -}
867871
> makeOwners = IntMap.foldl' build IntMap.empty

‎Parthenopea/SoundFont/Utility.lhs‎

Lines changed: 14 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -225,7 +225,7 @@ Returns the elapsed time in seconds
225225
> toTimecents secs = round $ logBase 2 secs * 1_200
226226
>
227227
> minDeltaT, minUseful :: Double
228-
> minDeltaT = fromTimecents Nothing
228+
> minDeltaT = fromTimecents Nothing -- 9.765625e-4
229229
> minUseful = 1/82
230230

231231
Returns the amplitude ratio
@@ -245,7 +245,19 @@ Returns the amplitude ratio (based on input 10ths of a percent)
245245
> else (1000 - jS) / 1000
246246
> where
247247
> jS :: Double = maybe 0 fromIntegral iS
248-
>
248+
249+
Raises 'a' to the power 'b' using logarithms
250+
251+
> pow :: Floating a ⇒ a → a → a
252+
> pow x y = exp (log x * y)
253+
254+
Need this definition
255+
256+
> constA :: Arrow a ⇒ c → a b c
257+
> constA = arr . const
258+
259+
Constants
260+
249261
> theE, epsilon, upsilon :: Double
250262
> theE = 2.718_281_828_459_045_235_360_287_471_352_7
251263
> epsilon = 1e-8 -- a generous little epsilon
@@ -256,13 +268,5 @@ Returns the amplitude ratio (based on input 10ths of a percent)
256268
>
257269
> theJ :: Complex Double
258270
> theJ = 0 :+ 1
259-
>
260-
> constA :: Arrow a ⇒ c → a b c
261-
> constA = arr . const
262-
263-
Raises 'a' to the power 'b' using logarithms.
264-
265-
> pow :: Floating a ⇒ a → a → a
266-
> pow x y = exp (log x * y)
267271

268272
The End

0 commit comments

Comments
 (0)