' code for etude 4 REM $DYNAMIC '$INCLUDE: 'KONSTANT.BI' :' shared constants '$INCLUDE: 'COM_TYPE.BI' ' midi-support module CONST Madr% = &H330 ' procedure declaration for library: '$INCLUDE: 'HARMONY.BI' '$INCLUDE: 'HARM_ANA.BI' '$INCLUDE: 'HARM_FUZ.BI' COMMON SHARED P%() COMMON SHARED Stem() AS St DECLARE SUB MpuUart () DECLARE SUB ResetMpu () DECLARE SUB Uit (byte%) DECLARE SUB RdFil (Q$) DECLARE SUB WrFil (Q$) DECLARE SUB ReadAndConvertFile () REDIM SHARED P%(0 TO 4000, 0 TO 8): ' voorlopige dim. REDIM SHARED Stem(0 TO 4) AS St SCREEN 12 WIDTH 80, 60 MpuUart ' force initialisation of values from fuzzy data file HAR_FUZ.DAT: d! = Dishar!(60, 61) d! = Dismel!(60, 61) SUB FuzHarStudy4 norm! = .05 FOR i% = 48 TO 72 FOR j% = 48 TO i% FOR k% = 48 TO j% IF i% MOD 12 <> j% MOD 12 AND j% MOD 12 <> k% MOD 12 AND i% MOD 12 <> k% MOD 12 THEN norm! = norm! + .05 IF norm! >= .9 THEN norm! = .05 dh! = Dishar3!(i%, j%, k%) IF dh! <= norm! THEN PRINT i%, j%, k%, norm!, dh! IF i% <> oldi% AND j% <> oldj% AND k% <> oldk% THEN DO cnt& = cnt& + 1 IF cnt& MOD 16 = 0 THEN EXIT DO LOOP Uit 144: Uit i%: Uit 94 oldi% = i% P%(cnt&, 1) = i%: P%(cnt&, 2) = 94 Uit 145: Uit j%: Uit 94 oldj% = j% P%(cnt&, 3) = j%: P%(cnt&, 4) = 94 Uit 146: Uit k%: Uit 94 oldk% = k% P%(cnt&, 5) = k%: P%(cnt&, 6) = 94 ELSE IF i% <> oldi% THEN Uit 144: Uit i%: Uit 64 oldi% = i% P%(cnt&, 1) = i%: P%(cnt&, 2) = 64 END IF IF j% <> oldj% THEN Uit 145: Uit j%: Uit 64 oldj% = j% P%(cnt&, 3) = j%: P%(cnt&, 4) = 64 END IF IF k% <> oldk% THEN Uit 146: Uit k%: Uit 64 oldk% = k% P%(cnt&, 5) = k%: P%(cnt&, 6) = 64 END IF END IF Skip% = 0 SELECT CASE dh! CASE IS <= .1 DO IF cnt& MOD 16 = 0 THEN Skip% = -1 EXIT DO ELSE cnt& = cnt& + 1 END IF LOOP CASE IS <= .2 t% = 12 CASE IS <= .3 t% = 9 CASE IS <= .4 t% = 6 CASE IS <= .8 t% = 3 CASE ELSE t% = 2 END SELECT SOUND 20000, t% IF Skip% = 0 THEN cnt& = cnt& + (t% / 3) ELSE 'cnt& = cnt& + 1 'SOUND 20000, 1 END IF END IF NEXT k% NEXT j% NEXT i% P%(cnt& + 12, 1) = oldi% P%(cnt& + 12, 3) = oldj% P%(cnt& + 12, 5) = oldk% WrFil "FuzHar4.bin" END SUB