BBC BASIC for Windows
« My Latest Hit ..... »

Welcome Guest. Please Login or Register.
Feb 21st, 2018, 1:52pm


BBC BASIC for Windows Resources
Online BBC BASIC for Windows documentation
BBC BASIC for Windows Beginners' Tutorial
BBC BASIC Home Page
BBC BASIC on Rosetta Code
BBC BASIC discussion group
BBC BASIC for Windows Programmers' Reference

« Previous Topic | Next Topic »
Pages: 1 2  Notify Send Topic Print
 hotthread  Author  Topic: My Latest Hit .....  (Read 2722 times)
hitsware
Junior Member
ImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 70
xx My Latest Hit .....
« Thread started on: Jun 6th, 2015, 01:33am »

ON CLOSE PROC_cleanup : QUIT
ON ERROR SYS "MessageBox", @hwnd%, REPORT$, 0, 0 : PROC_cleanup : QUIT
SYS "midiOutOpen", ^hMidiOut%, -1, 0, 0, 0 TO ret%
IF ret% ERROR 100, "Failed to open MIDI output device"

SYS"midiOutShortMsg",hMidiOut%,(192)+(34<<8)
SYS"midiOutShortMsg",hMidiOut%,(193)+(89<<8)

DIM root(11), drum(15), perc(15): a=0

FOR x=0 TO 11: READ root(x): NEXT x
FOR x=0 TO 15: READ perc(x): NEXT x
FOR x=0 TO 15: READ drum(x): NEXT x

FOR x=0 TO 3
SYS"midiOutShortMsg",hMidiOut%,(153)+(33<<8)+(127<<16)
WAIT 44: NEXT x

REPEAT
FOR x=0 TO 11: IF root(x)=a THEN 10
SYS"midiOutShortMsg",hMidiOut%,(177)+(123<<8)+(0<<16)
SYS"midiOutShortMsg",hMidiOut%,(145)+(root(x)+69<<8)+(50<<16)
SYS"midiOutShortMsg",hMidiOut%,(145)+(root(x)+64<<8)+(50<<16)
10 FOR y=0 TO 7: z=((8*x)+y) MOD 16
SYS"midiOutShortMsg",hMidiOut%,(153)+(perc(z)<<8)+(80<<16)
SYS"midiOutShortMsg",hMidiOut%,(153)+(drum(z)<<8)+(127<<16)
SYS"midiOutShortMsg",hMidiOut%,(144)+(root(x)+33<<8)+(90<<16)
WAIT 22
SYS"midiOutShortMsg",hMidiOut%,(176)+(123<<8)+(0<<16)
a=root(x): NEXT y: NEXT x
UNTIL FALSE: END

DEF PROC_cleanup
hMidiOut% += 0 : IF hMidiOut% SYS "midiOutClose", hMidiOut%
ENDPROC

DATA 7,5,0,7, 0,0,0,0, 5,5,0,0
DATA 0,0,0,0, 0,0,64,64, 0,0,0,0, 0,0,63,63
DATA 35,0,76,35, 35,0,0,0, 35,0,76,35, 35,0,0,0
User IP Logged

rtr2
Guest
xx Re: My Latest Hit .....
« Reply #1 on: Jun 8th, 2015, 10:47am »

on Jun 6th, 2015, 01:33am, hitsware wrote:
Code:
      IF root(x)=a THEN 10
      SYS"midiOutShortMsg",hMidiOut%,(177)+(123<<8)+(0<<16)
      SYS"midiOutShortMsg",hMidiOut%,(145)+(root(x)+69<<8)+(50<<16)
      SYS"midiOutShortMsg",hMidiOut%,(145)+(root(x)+64<<8)+(50<<16)
   10 

I think you should win a prize for the most unnecessary use of an (implied) GOTO! To eliminate it just reverse the test:

Code:
      IF root(x)<>a THEN
        SYS"midiOutShortMsg",hMidiOut%,(177)+(123<<8)+(0<<16)
        SYS"midiOutShortMsg",hMidiOut%,(145)+(root(x)+69<<8)+(50<<16)
        SYS"midiOutShortMsg",hMidiOut%,(145)+(root(x)+64<<8)+(50<<16)
      ENDIF 

Remember, GOTO (with a line number destination) is by design incredibly slow in BBC BASIC. It works by searching the program line-by-line, from the start, until the specified line is found - even if the program is tens of thousands of lines long! For the same reason, GOTO does not work at all in a library or CALLed module. Just don't do it. Ever. :)

Richard.
« Last Edit: Jun 8th, 2015, 2:54pm by rtr2 » User IP Logged

hitsware
Junior Member
ImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 70
xx Re: My Latest Hit .....
« Reply #2 on: Jun 9th, 2015, 10:49pm »

>I think you should win a prize
>for the most unnecessary use
>of an (implied) GOTO!

Duh ...........

And the prize is ? ! ?
User IP Logged

hitsware
Junior Member
ImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 70
xx Re: My Latest Hit .....
« Reply #3 on: Jun 12th, 2015, 10:47pm »

Code:
      CALL @lib$+"HQSOUND"

      *TEMPO 133

      ENVELOPE 1,0,0,0,0,0,0,0,63,0,0,0,40,0
      ENVELOPE 2,0,0,0,0,0,0,0,127,0,0,-2,100,0
      ENVELOPE 3,0,0,0,0,0,0,0,127,-127,0,0,126,0
      ENVELOPE 4,0,0,0,0,0,0,0,0,0,0,0,0,0
      ENVELOPE 5,0,0,0,0,0,0,0,127,-1,0,0,60,0

      DIM orgn(11), bass(7), drum(7)

      FOR x=0 TO 11: READ orgn(x): NEXT x
      FOR x=0 TO 7: READ bass(x): NEXT x
      FOR x=0 TO 7: READ drum(x): NEXT x

      FOR v=0 TO 3: SOUND v,4,0,30: NEXT v
      FOR x=0 TO 3: FOR y= 0 TO 3
          SOUND y,5,148,8: NEXT y: NEXT x

      REPEAT
        FOR x=0 TO 11: FOR y=0 TO 7
            SOUND 3,1,orgn(x)+48,4
            SOUND 1,1,orgn(x)+76,4
            SOUND (4098-(bass(y)*4096)),2,orgn(x),1:SOUND 4098,2,0,3
            SOUND 0,drum(y),140,4
          NEXT y: NEXT x
      UNTIL FALSE: END

      DATA 32,24,4,32, 4,4,4,4, 24,24,4,4
      DATA 1,0,0,1, 1,0,0,0
      DATA 4,4,3,4, 4,4,3,4


 
« Last Edit: Jun 13th, 2015, 12:59am by hitsware » User IP Logged

hitsware
Junior Member
ImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 70
xx Re: My Latest Hit .....
« Reply #4 on: Jun 14th, 2015, 10:07pm »

Code:
      ON CLOSE PROC_Cleanup: QUIT
      ON ERROR PROC_Cleanup: REPORT : END
      SYS "midiOutOpen",^hMidiOut%,-1,0,0,0 TO ret%
      IF ret% ERROR 100,"Failed to open MIDI output device"

      DIM c(19),n(3),d(7)
      FOR x=0 TO 19: READ c(x): NEXT x
      FOR x=0 TO 3: READ n(x): NEXT x
      FOR x=0 TO 7: READ d(x): NEXT x

      DIM p(3),v(3)
      p(0)=034: v(0)=120
      p(1)=107: v(1)=080
      p(2)=108: v(2)=080
      p(3)=050: v(3)=050
      dv=127
      REPEAT
        FOR x=0 TO 19
          n2=45+INT(LOG(c(x)*4/20)*(12/LOG(2)))-5
          n3=45+INT(LOG(c(x)*6/20)*(12/LOG(2)))-5
          SYS"midiOutShortMsg",hMidiOut%,(193)+(p(3)<<8)
          SYS"midiOutShortMsg",hMidiOut%,(145)+(n2<<8)+(v(3)<<16)
          SYS"midiOutShortMsg",hMidiOut%,(194)+(p(3)<<8)
          SYS"midiOutShortMsg",hMidiOut%,(146)+(n3<<8)+(v(3)<<16)
          FOR y=0 TO 3: dc=((4*x)+y)MOD 8
            r=RND(3)-1:o=2^r: jn=o*c(x)*n(y)
            n1=45+INT(LOG(jn/40)*(12/LOG(2)))-5
            SYS"midiOutShortMsg",hMidiOut%,(153)+(d(dc)<<8)+(dv<<16)
            SYS"midiOutShortMsg",hMidiOut%,(192)+(p(r)<<8)
            SYS"midiOutShortMsg",hMidiOut%,(144)+(n1<<8)+(v(r)<<16)
            WAIT 22
            SYS"midiOutShortMsg",hMidiOut%,(153)+(d(dc)<<8)+(00<<16)
            SYS"midiOutShortMsg",hMidiOut%,(144)+(n1<<8)+(00<<16)
          NEXT y
          SYS"midiOutShortMsg",hMidiOut%,(145)+(n2<<8)+(00<<16)
          SYS"midiOutShortMsg",hMidiOut%,(146)+(n3<<8)+(00<<16)
        NEXT x: UNTIL FALSE

      DEF PROC_Cleanup
      IF hMidiOut% SYS "midiOutClose", hMidiOut%
      ENDPROC

      DATA 16,12,09,12, 12,12,09,12, 16,12,09,09, 12,12,16,12
      DATA 16,12,18,12
      DATA 2,3,4,5
      DATA 35,00,76,00, 00,35,76,00

 
User IP Logged

hitsware
Junior Member
ImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 70
xx Re: My Latest Hit .....
« Reply #5 on: Jun 16th, 2015, 1:12pm »

Code:
      CALL @lib$+"HQSOUND"

      *TEMPO 133

      ENVELOPE 1,0,0,0,0,0,0,0,63,0,0,0,40,0
      ENVELOPE 2,0,0,0,0,0,0,0,127,0,0,-2,100,0
      ENVELOPE 3,0,0,0,0,0,0,0,127,-127,0,0,126,0
      ENVELOPE 4,0,0,0,0,0,0,0,0,0,0,0,0,0
      ENVELOPE 5,0,0,0,0,0,0,0,127,-127,0,0,70,0

      DIM orgn(29), bass(7), drum(7), octv(7)

      FOR x=0 TO 29: READ orgn(x): NEXT x
      FOR x=0 TO 7: READ bass(x): NEXT x
      FOR x=0 TO 7: READ drum(x): NEXT x
      FOR x=0 TO 7: READ octv(x): NEXT x

      SOUND 0,4,0,40
      SOUND 1,4,0,40
      SOUND 2,4,0,40
      SOUND 3,4,0,40

      FOR x=0 TO 3: FOR y=0 TO 3
          SOUND y,5,1056,10: NEXT y: NEXT x

      REPEAT
        FOR z=0 TO 119: x=z DIV(4): y=z MOD(8): v=z MOD(4)
          SOUND 3,1,FNfreqout(orgn(x)*22*octv(y)/2),5
          SOUND 1,1,FNfreqout(orgn(x)*33*octv(y)/2),5
          SOUND (4096-(bass(y)*4096)),2,FNfreqout(orgn(x)*11/2),1:SOUND 4096,2,0,4
          IF v=2 THEN SOUND 2,3,FNfreqout(1056),5 ELSE SOUND 2,5,FNfreqout(RND(2)*180),5
        NEXT z: UNTIL FALSE: END

      DATA 10,12,9,10, 10,12,9,9, 10,12,9,10, 8,9,10,10
      DATA 8,10,9,9, 8,10,9,9, 8,10,9,9, 8,9
      DATA 1,0,0,1, 1,0,0,0
      DATA 4,4,3,4, 4,4,3,4
      DATA 1,1,2,2, 1,2,2,1

      DEF FNfreqout(f)
      LOCAL I% : PRIVATE ftab%, indx&
      IF ftab% = 0 THEN
        LOCAL base%
        SYS "GetModuleHandle", 0 TO base%
        FOR I% = base% TO base% + 65534 STEP 2
          IF !I% = &03550354 IF I%!4 = &06060606 EXIT FOR
        NEXT
        IF I% > base% + 65534 ERROR 100, "Cannot locate frequency table"
        ftab% = I% + 8
        SYS "VirtualProtect", ftab% AND -&1000, &2000, &40, ^I% TO I%
        IF I% = 0 ERROR 100, "Cannot make memory image writable"
      ENDIF
      indx& += 1 : IF indx& = 0 indx& = 1
      I% = 2 * indx&
      ftab%!I% = ftab%!I% AND &FFFF0000 OR INT(f * &10000 / 22050 + 0.5)
      = indx&

 
User IP Logged

dfeugey
Guest
xx Re: My Latest Hit .....
« Reply #6 on: Jun 16th, 2015, 5:56pm »

Really very good smiley
User IP Logged

hitsware
Junior Member
ImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 70
xx Re: My Latest Hit .....
« Reply #7 on: Jun 16th, 2015, 9:26pm »

on Jun 16th, 2015, 5:56pm, dfeugey wrote:
Really very good smiley


Thank You ! grin

You are obviously a person of rare taste and refinement laugh

Tweaked some here :

https://home.comcast.net/~mnjmiller/bbcgyp.bbc
« Last Edit: Jun 16th, 2015, 9:36pm by hitsware » User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 451
xx Re: My Latest Hit .....
« Reply #8 on: Jun 16th, 2015, 9:44pm »

on Jun 16th, 2015, 5:56pm, dfeugey wrote:
Really very good smiley


I used two of hitsware's algorithmically-generated tunes in one of my games, SubZap II:

http://www.jeroengroenendaal.com/repository/bb4w/progs/zip/subzap2.zip

I'd say the music makes the game worth playing! smiley

hitsware: I haven't listened to your latest hit yet (since I haven't downloaded the library HQSOUND), but I did listen to the previous MIDI-based one, and I thought it was excellent.


David.
--

http://www.proggies.uk
« Last Edit: Jun 16th, 2015, 9:53pm by David Williams » User IP Logged

hitsware
Junior Member
ImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 70
xx Re: My Latest Hit .....
« Reply #9 on: Jun 16th, 2015, 10:21pm »

WOW !
Thank You Dave. I had forgotten about that. That piece was done with ZEL .....:

http://zelsoftware.org/

A main difference between BBCmidi and ZELmidi is that ZEL produces midi files. I.E. songname.mid, while BBC addresses the synth directly. I hadn't yet discovered BBCbasic at that time. I prefer the BBC approach because the tunes can go on forever as opposed to the finite length of a midi file ...........
ZEL is worth a look though ..........
User IP Logged

rtr2
Guest
xx Re: My Latest Hit .....
« Reply #10 on: Jun 17th, 2015, 1:49pm »

on Jun 16th, 2015, 9:44pm, David Williams wrote:
I haven't listened to your latest hit yet (since I haven't downloaded the library HQSOUND)

HQSOUND is not a requirement, it is simply a way of improving the quality.

Incidentally over at the Yahoo! group (but not at the direct link I gave) HQSOUND has been updated to v1.2 which supports 127 amplitude steps, rather than 16, to reduce the problem of being able to hear the steps in a slow amplitude envelope.

Richard.
User IP Logged

hitsware
Junior Member
ImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 70
xx Re: My Latest Hit .....
« Reply #11 on: Jun 17th, 2015, 6:47pm »

If I rename the 2 versions, put them both in LIB, call 1 from a routine, run the routine, then call 2 and run the routine .......... Will the second version over-write the first ?
......In order to test the effectiveness.........
User IP Logged

hitsware
Junior Member
ImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 70
xx Re: My Latest Hit .....
« Reply #12 on: Jun 17th, 2015, 10:47pm »

1) No matter the order entered I get an error on second iteration

2) Must listen some more. At first I was hearing clearly the noise I speak of, but when I simplified the routine as much as possible it seemed to go away (both HQ versions) Seems perhaps other things can aggravate the problem.

Code:
      *TEMPO 133

      ENVELOPE 1,0,0,0,0,0,0,0,127,0,0,-1,127,0

      CALL @lib$+"HQS_1"

      FOR x=0 TO 7
        READ n
        SOUND 0,1,n,1: SOUND 4096,1,0,10
      NEXT x

      RESTORE

      CALL @lib$+"HQS_2"

      FOR x=0 TO 7
        READ n
        SOUND 0,1,n,1: SOUND 4096,1,0,10
      NEXT x

      END

      DATA 52,60,68,72,80,88,96,100


 
User IP Logged

rtr2
Guest
xx Re: My Latest Hit .....
« Reply #13 on: Jun 18th, 2015, 05:40am »

on Jun 17th, 2015, 6:47pm, hitsware wrote:
In order to test the effectiveness

So long as you run them in separate sessions of BB4W (i.e. separate processes) they will of course be entirely independent. That's how I have been comparing different versions; commonly I have three or more copies of BB4W running simultaneously.

The alternative is to compile your programs and run the EXEs, which of course also ensures that they are independent.

Here's a good test of the difference (also worth trying without the HQSOUND library at all); it is very important that you listen with headphones:

Code:
      ENVELOPE 1,5,0,0,0,0,0,0,1,-1,-1,-1,126,0
      SOUND 1,1,148,252 

Richard.
« Last Edit: Jun 18th, 2015, 05:52am by rtr2 » User IP Logged

hitsware
Junior Member
ImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 70
xx Re: My Latest Hit .....
« Reply #14 on: Aug 8th, 2016, 12:58am »

REM:m = 12*log2(fm/440 Hz) + 69
REM: key(),D(144), C(160), A(96), E(128), G(108)
key=144: DIM mn(700)

FOR jn=1 TO 700
mn(jn)=69+INT(12*LOG((jn)/key)/LOG(2)+0.5)
NEXT jn: PROC_midistart

FOR ch=0 TO 4:READ pa,le,pn
PROC_env(ch,pa,le,pn): NEXT ch

DATA 034,127,064, 107,060,127, 11,100,0
DATA 127,064,000, 127,127,064

DIM cm(29),cn(3),cr(3),da(7),db(7),d1(7),d2(7)
FOR x=0 TO 29:READ cm(x):NEXT x
FOR x=0 TO 03:READ cn(x):NEXT x
FOR x=0 TO 07:READ da(x):NEXT x
FOR x=0 TO 07:READ db(x):NEXT x
DATA 5,6,9,5, 5,6,9,9, 5,6,9,5, 8,9,5,5
DATA 8,9,5,5, 8,9,5,5, 8,9,5,5, 8,9
DATA 2,4,3,4
DATA 035,000,076,000, 035,035,076,000
DATA 042,000,042,042, 042,000,042,042

REPEAT
FOR x=0 TO 29:FOR y=0 TO 3
rr=INT(RND(3)-1): oc=2^rr
nn= mn(cm(x)*cn(y)*oc)
PROC_playnote(rr,nn)

NEXT y: NEXT x: UNTIL FALSE: END

DEF PROC_playnote(rr,nn)
SYS"midiOutShortMsg",hMidiOut%,(144+rr)+(nn<<8)+(127<<16)
WAIT 22
SYS"midiOutShortMsg",hMidiOut%,(144+rr)+(nn<<8)+(000<<16)
ENDPROC

DEF PROC_env(ch,pa,le,pn)
SYS"midiOutShortMsg",hMidiOut%,(192+ch)+(pa<<8)
SYS"midiOutShortMsg",hMidiOut%,(176+ch)+(07<<8)+(le<<16)
SYS"midiOutShortMsg",hMidiOut%,(176+ch)+(10<<8)+(pn<<16)
ENDPROC

DEF PROC_midistart
ON CLOSE PROC_Cleanup: QUIT
ON ERROR PROC_Cleanup: REPORT : END
SYS "midiOutOpen",^hMidiOut%,-1,0,0,0 TO ret%
IF ret% ERROR 100,"Failed to open MIDI output device"
ENDPROC

DEF PROC_Cleanup
hMidiOut% +=0 :IF hMidiOut% SYS "midiOutClose", hMidiOut%
ENDPROC
User IP Logged

Pages: 1 2  Notify Send Topic Print
« Previous Topic | Next Topic »

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls