Please point me to some step by step basics to code the PICAXE using Blockly.

lbenson

Senior Member
Are you suggesting something like this: for the matrix, 4 pins on the cathode side (B.4-B.7) each having a 680 ohm resistor, one pin for the 3 A4s having a 220 ohm resistor (approximately 680 / 3) on the cathode side of the 3 LEDs, and 8 pins for the doubled notes with, say, all cathodes tied together going through a 330 ohm resistor (approximately 680/2) to ground? Alternatively, the resistors could be on the anode side.

6 resistors total?

(No 2 notes ever to be struck at the same time. Although the hammered dulcimer does allow for 2-note cords, this scheme does not allow for that.)
 

AllyCat

Senior Member
Hi,

Alan, please make a drawing!!!!!
Something like this:

LEDsDriver.jpg

This version uses Active Low output pins, and half of the multiplex pins have to be Active Low anyway. Or reverse the LEDs and take the 3 resistors to Earth if you prefer Active High outputs.

However, my "minimalistic" solution would be a 14M2 with 8 pins driving a 7-wire Charlieplex; Two port pins linked to give more current for the triplet of LEDs, so all the LEDs could run at up to 12 mA each. Two 25 (?) byte lookup tables, one mapped to the Active High pin(s) and the other to the Active Low pin(s). It might be even be possible to "pair up" two more output pins (one being SerOut) and run all the LEDs at up to 25 mA if necessary. ;)

Cheers, Alan.
 
Last edited:

Gramps

Senior Member
Ibenson, that's a good point. We do play 2 note chords and we would want to make provision for that.
I was wondering if we could matrix the other nine dual diodes and control them with 3 pins.
Alan, that is a very cool way of grounding cathode rails with 3 resistors!
 

AllyCat

Senior Member
Hi,

We do play 2 note chords and we would want to make provision for that.
it has two G4's, C5's, D4's, D5's, etc.. . The correct note needs to light in both place. .... There are three A4's!
So if 2 (or 3, or more) LEDs light at the same time, how does the player know whether it's a chord or a choice of strings to play one note (or a combination of both)? :confused:

But personally, I had already come to the conclusion that my preferred solution would be a single matrix with individual control of all 35 LEDs (6 x 6 or 7 x 5 , conventional or Charlieplex) and then control the alternatives within the software (chords are likely to need either Time Division Multiplexing or 35 individual output pins).

Cheers, Alan.
 

Gramps

Senior Member
Good point. Probably be best to leave the chords out of the equation.
On second thought, I suppose we could blink the LEDs representing a 2 note chord.
 
Last edited:

AllyCat

Senior Member
Hi,

On second thought, I suppose we could blink the LEDs representing a 2 note chord.
Yes, that might be possible and is basically how the multiplex probably needs to work anyway to show two separate (chord) notes at the same time. Probably quite a high blink/flicker rate (typically 5 - 10 Hz) to be usable in this musical application, but that's easily within the capability of a PICaxe.

I was wondering if we could matrix the other nine dual diodes and control them with 3 pins.
No, multiplexes are only useful with fairly large numbers of LEDs/pins* because they multiply the number of rows by the number of columns: 3 pins can control only a 1 x 2 matrix (i.e. 2 LEDs) which is actually less than using direct drive to individual LEDs! 9 LEDs would need a 3 x 3 matrix which requires 3 + 3 = 6 pins (or 4 for a Charlieplex).

* That's why I would use one large matrix, with 6 x 6 being quite convenient. That gives independent control (and brightness) for every one of the 35 LEDs/strings, using 6 + 6 = 12 pins for a normal array, or just 7 pins for a Charlieplex.

Cheers, Alan.
 

Gramps

Senior Member
If we have enough pins, let's just put one of the A notes on its own pin. Question, how many pins do we actually need for inputs?
If we ran the nine diode pairs in a matrix we would still save three pins.
 
Last edited:

ZanderPIC

New Member
Interesting where this thread has come in the past month! I've never experimented with LED matrixes so it been a good read.

Anyway, as per my original post I suggested using the APA102 LEDs and I guess you disregard the idea. But as I was reading through the thread I was think how easy it would be to use the APA102's in this situation! Especially with the multi LED's "on" with chords as the APA102 are full RGB you could change to colour of the chords to distinguish between them and the alternative notes. Also no need for soldering large matrixes as you can buy the APA102's on 60 LED strips.

GoodLuck, Zander
 

lbenson

Senior Member
Zander--you had a good idea, I thought--easy (relatively) to turn on any specific LED--or more than one. The problem that I foresaw was more mechanical--how do you space the LEDs to align with the string configuration?
 

lbenson

Senior Member
A Hammered Dulcimer "Lighting" Proof of Concept

Here is an implementation of LED lighting on a hammered dulcimer for the notes of a tune. The breadboard design includes a PICAXE 20M2, an 24LC64 8K byte external I2C eeprom, an MCP23017 I2C 16-bit I/O expander, a 4-line by 20-character I2C LCD, two pushbuttons, and a piezo buzzer, in addition to the 25 red indicator LEDs plus a blue one for "note not available".

25 unique notes are indicated (8 have two sets of strings for the same note, and one has 3).

Six tunes have been loaded into the I2C eeprom. Pressing the button on C.6 cycles through the names of these tunes, with the current tune and the next one shown on lines 1 and 2 of the LCD. Pressing the button on C.3 plays the tune on a piezo buzzer on C.7. The pin corresponding to the note lights up for the duration of the time the note is to be played.

Here is the layout of the breadboard shown using westaust55's pebble program.
hammer breadboard.jpg
Here is a youtube video of the breadboard and program in action, playing a couple of tunes. No one is going to listen to the sound from the piezo because of its aesthetic appeal--its main use is to provide a reality check--that the tune is what you expect it to be.
https://youtu.be/N6Ftf_bDug0
(However bad the piezo is in real life, it is significantly worse as recorded by my phone and rendered by Youtube.)

(Perhaps this video is tl;dr, or maybe dv for "Didn't View".)

The 24LC64 I2C eeprom is not on the breadboard as shown in the pebble image. After initial success, I was never able to get it to work again. I moved it off-board, like the LCD, and it is fine. I suspect some problem with the breadboard, but after 4+ hours couldn't figure it out.

Code too long; part in next post.
Code:
' 20hammer -- plays tunes one note at a time & lights LED corresponding to note
'  tunes are stored in eeprom: NextDataAdr=$1C, NTunesAdr=$1E; 32-byte names @ $100; tunes @ 1792

#picaxe 20M2
#terminal 4800
' uses duration, octave, note coding from "tune" command

symbol FALSE = 0
symbol TRUE  = 1

symbol pButtonPin=pinC.6
symbol pButtonPin2=pinC.3
'symbol pLCD=A.3 ' i2c 4-bit LCD
symbol pPiezo=C.7

symbol EEPROMAdr = %10100000 ' $A0
symbol LCDAdr    = $4E
symbol stringAdrBase = $20 ' location of up to 16 offsets for strings
symbol stringBase    = $30 ' location of strings
symbol NextDataAdr=$1C     ' location in eeprom
symbol NTunesAdr=$1E       ' location in eeprom
symbol TuneNameBlockBase=$100 ' 32-byte names per 64-byte block; 2-byte note address, up to 29-byte name
symbol TuneNoteBlockBase=1792 ' 32*48 + 256  ' room for 48 tune names
symbol nameBlockSize=32
symbol noteNdxAdr = 56 ' start of upper ram (X2); 1-byte note text index into table memory; 35 entries
symbol playingAdr = $80
symbol buff32Adr=$E0 ' ram address 32 byte buffer; retrieve from eeprom, write to LCD
symbol ACTIVE=0 ' active state for pushbuttons with weak pullups

' symbols for mcp23017 16-bit I/O extender
SYMBOL mcp23017 = %01000000 ; $0100 A2, A1, A0, R/W all connected to 0V
SYMBOL IODIRA = $00 ; Port A IO Direction register DEFAULT = I/P
SYMBOL IODIRB = $01 ; Port B IO Direction register DEFAULT = I/P
SYMBOL IOCON = $0A ; IO Expander config register - address $0B accesses the same register
SYMBOL GPIOA = $12 ; Port A General purpose register
SYMBOL GPIOB = $13 ; Port B General Purpose register
SYMBOL OLATA = $14 ; Port A latch register
SYMBOL OLATB = $15 ; Port B latch register
'HI2CSETUP i2cmaster, mcp23017, i2cfast, i2cbyte

' hippy's I2C LCD with PCF8574 code, post 28: 
' http://www.picaxeforum.co.uk/showthread.php?21872
' symbols b2,b3,secondNybble reserved for LCD 

symbol xb0             = b0 ' general use bits
  symbol xbit0    = bit0    ' transient flag
  symbol bPiezo   = bit1    ' play tune on piezo
symbol xb2             = b2 ' reserved for LCD--bits 16-23 used
symbol xb3             = b3 ' reserved for LCD--bits 24-31 used
' b3 bits defined below
  Symbol bitRS = bit24
  Symbol bitWR = bit25
  Symbol bitE  = bit26
  Symbol bitBKL = bit27
  Symbol bitD4 = bit28
  Symbol bitD5 = bit29
  Symbol bitD6 = bit30
  Symbol bitD7 = bit31
symbol secondNybble    = b4 ' for LCD
symbol stringAdrOffset = b5 ' location of nth string address

symbol codedNote=b6
symbol pinNo=b7
symbol oldPinNo=b8
symbol octave=b9
symbol checkTime=b10
symbol tunePtr=b11
symbol LEDcoding=b12
symbol note=b13
symbol noteCh=b14
symbol lastCh=b15
symbol eePtr=b16

symbol tuneNo  = b21

symbol wDataAdr= w11 ' b22,b23
symbol NTunes  = b24
symbol ch      = b25
symbol i       = b26
symbol k       = b27
symbol wNoteAdr= s_w0
symbol wNameAdr= s_w1

' BELOW: 1st row, # duplicate if > 1; 2nd row, notes ("-" if not available); 3rd row, note coding
'                            2        2          2        3      2   2        2       2           2 
' G3,-G#3,A3,-Bb3,B3,C4, C#4,D4,-Eb4, E4,F4, F#4,G4, G#4, A4,Bb4,B4, C5, C#5, D5,-Eb5,E5, F5,F#5, G5,-G#5,A5,-Bb5,B5, C6,-C#6,D6
'$00,$FF,$01,$FF,$02,$03,$10,$C0,$FF,$C1,$11,$12,$C2,$13,$C3,$20,$C4,$C5,$21,$C6,$FF,$C7,$22,$23,$C8,$FF,$30,$FF,$31,$32,$FF,$33
' Note coding: $FF=not available; $C?--pin C.0-C.7,A.0; other: 1st nybble is B-port string B0-B3; 2nd is B4-7
table 0,("G3,-G#3,A3,-Bb3,B3,C4,C#4,D4,-Eb4,E4,F4,F#4,G4,G#4,A4,Bb4,B4,C5,C#5,D5,-Eb5,E5,F5,F#5,G5,-G#5,A5,-Bb5,B5,C6,-C#6,D6,",0,0,0)

Initialisation:

  pause 2000
  pullup %0100100000000000 ' pullup on C.6 and C.3

  HI2CSETUP i2cmaster, mcp23017, i2cfast, i2cbyte
  PAUSE 400
  HI2COUT IODIRA, ($00) ;set all port A pins as outputs (0)
  HI2COUT IODIRB, ($00) ;set all port B pins as outputs (0)
  HI2COUT GPIOA, (%00000000) ; all OFF
  HI2COUT GPIOB, (%00000000) ; all OFF

  gosub InitializeLCD
  gosub initializeNoteNames
  bptr=playingAdr ' user $08-$8F
  @bptrinc="P":@bptrinc="l":@bptrinc="a":@bptrinc="y":@bptrinc="i":@bptrinc="n":@bptrinc="g":@bptrinc=0
  @bptrinc=" ":@bptrinc=" ":@bptrinc=" ":@bptrinc=" ":@bptrinc=" ":@bptrinc=" ":@bptrinc=" ":@bptrinc=0
  HI2cSetup I2CMASTER, EEPROMAdr, i2cfast, i2cword ' set up eeprom
  HI2cIn NTunesAdr,(NTunes)
  tuneNo = 1        ' start at beginning
  sertxd("# tunes=",#NTunes,": write2Tunes",cr,lf)
  gosub write2Tunes
  pause 2000
  bPiezo = TRUE ' must be on to get timing right
  
main:
  do
    if pButtonPin = ACTIVE then 
      do while pButtonPin = ACTIVE : loop ' wait until released
      inc tuneNo
      if tuneNo > NTunes then : tuneNo = 1 : endif
      sertxd("move to tune # ",#tuneNo,cr,lf)
      gosub write2Tunes
    endif
    if pButtonPin2 = ACTIVE then 
      do while pButtonPin2 = ACTIVE : loop ' wait until released
      HI2cSetup I2CMASTER, LCDAdr, I2CSLOW, I2CBYTE
      pause 100
      b2 = $D4 ' 4th LCD line
      Gosub SendB2AsCommandByte
      bptr=playingAdr ' user $08-$8F
      gosub sendString
      HI2cSetup I2CMASTER, EEPROMAdr, i2cfast, i2cword
      gosub playTune
      HI2cSetup I2CMASTER, LCDAdr, I2CSLOW, I2CBYTE
      pause 100
      b2 = $D4 ' 4th LCD line
      Gosub SendB2AsCommandByte
      bptr=playingAdr + 8 ' user $08-$8F blank 8 characters
      gosub sendString
      HI2cSetup I2CMASTER, EEPROMAdr, i2cfast, i2cword ' set up eeprom
      pause 100
    endif
  loop

playTune:
  wNameAdr=tuneNo - 1  * 32 + TuneNameBlockBase ' 2-byte note address
  HI2CIN wNameAdr, (b23,b22) '(wDataAdr)
  bptr = $F0 ' 256 bytes from $F0-$1EF (for 14M2, 18M2, 20M2)
  do while bptr < $1F0 ' get max # tune bytes--256
    HI2CIN wDataAdr,(@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc)
    wDataAdr = wDataAdr + 16
  loop
  @bptr = $FF ' terminate
  bptr = $F0 ' 256 bytes from $F0-$1EF 
  do while bptr < $1F0
    codedNote = @bptrinc
    if codedNote <> $FF then 
      if tuneNo <> 5 then ' drop an octave
        octave = codedNote & %00110000
        codedNote = codedNote & %11001111 ' strip out octave
        if octave = %00000000 then : codedNote = codedNote | %00100000 : endif ' low octave
        if octave = %00010000 then : codedNote = codedNote & %11001111 : endif ' middle octave
      endif
    endif
    ch = codedNote / 16 + "0" ' upper nybble
    if ch > "9" then : ch = ch + 7 : endif ' convert to "A"-"F"
    sertxd(ch)
    ch = codedNote & %00001111 + "0" ' lower nybble
    if ch > "9" then : ch = ch + 7 : endif
    sertxd(ch,",")
    gosub playNote
    if codedNote = $FF then exit
  loop
  low C.5    ' note not available
  sertxd(cr,lf)
  return
Possible additions to the program are setting a repeat flag, so the tune recycles until a button is pressed, making the TUNE command "speed" option variable, and printing the name of the note which is being played (e.g., "F#4"--F# in the 4th octave).
 
Last edited:

lbenson

Senior Member
Remainder of code:
Code:
playNote: ' codedNote has "TUNE" note encoding: %ddoonnnn: duration, octave, note (12-tone)
  if codedNote = $FF then ' end of tune
    pinNo = $FF
  else
    octave = codedNote & %00110000 / 16 ' %00=middle; %01=high; %10=low
    note = codedNote & %00001111
    if octave = 0 then : note = note + 12 : endif ' middle octave
    if octave = 1 then : note = note + 24 : endif ' high octave
'    if tuneNo = 5 then : note = note - 12 : endif ' drop an octave
'    table 0,($00,$FF,$01,$FF,$02,$03,$10,$C0,$FF,$C1,$11,$12,$C2,$13,$C3,$20,$C4,$C5,$21,$C6,$FF,$C7,$22,$23,$C8,$FF,$30,$FF,$31,$32,$FF,$33)
    lookup note,(0,$FF,1,$FF,2,3,4,5,$FF,6,7,8,9,10,11,12,13,14,15,16,$FF,17,18,19,20,$FF,21,$FF,22,23,$FF,24),pinNo
'    pinNo = note ' 0-35: mcpA.0-7, mcpB.0-7, B.0-B.4, B.6, C.0-C.2
  endif
  HI2CSETUP i2cmaster, mcp23017, i2cfast, i2cbyte
  PAUSE 100
  HI2COUT GPIOA, (%00000000) ; all OFF
  PAUSE 20
  HI2COUT GPIOB, (%00000000) ; all OFF
  PAUSE 20
  low C.5    ' note not available
  if oldPinNo > 15 and oldPinNo <> $FF  then ' not mcp port 
    oldPinNo = oldPinNo - 16 ' convert down into B.0-C.2 range
    if oldPinNo > 4  then : inc oldPinNo : endif ' skip B.5, SDA
    if oldPinNo > 6  then : inc oldPinNo : endif ' skip B.7, SCL; move to C.0-C.2
    low oldPinNo ' turn off previous note
  endif
  
  if pinNo <> $FF then
    if pinNo < 8 then ' mcpA port
      lookup pinNo,(1,2,4,8,16,32,64,128), oldPinNo
      HI2COUT GPIOA, (oldPinNo)
    else if pinNo < 16 then ' mcpB port
      oldPinNo = pinNo - 8
      lookup oldPinNo,(1,2,4,8,16,32,64,128), oldPinNo
      HI2COUT GPIOB, (oldPinNo)
    else
      oldPinNo = PinNo - 16 ' convert down into B.0-C.2 range
      if oldPinNo > 4  then : inc oldPinNo : endif ' skip B.5, SDA; promote to B.6
      if oldPinNo > 6  then : inc oldPinNo : endif ' skip B.7, SCL; move to C.0-C.2
      high oldPinNo ' turn on note
    endif
    if bPiezo = TRUE then : TUNE pPiezo,8,(codedNote) : endif
  else
    high C.5  ' note not available
  endif
  oldPinNo = pinNo

  return

write2Tunes:
'    lookup i,($80,$80,$C0,$94,$D4),b2 ' address of line on LCD
  i = tuneNo
  b2 = $80 ' first LCD line
  gosub write1Tune
  i = tuneNo + 1
  if i > nTunes then : i = 1 : endif
  b2 = $C0 ' second LDC line
  gosub write1Tune
  return

write1Tune: ' uses i (tune to write); b2 (LCD location to write)
    HI2cSetup I2CMASTER, EEPROMAdr, i2cfast, i2cword
    pause 100
    wNameAdr=i - 1  * 32 + TuneNameBlockBase + 2 ' offset past 2-byte note address
    sertxd(#i," ",#wNameAdr,": ")
    bptr = buff32Adr ' where to put tune name
    k = 0
    do 
      Hi2cIn wNameAdr,(ch)
      if k < 20 then: @bptrinc=ch: endif: inc wNameAdr: if ch <> 0 then: sertxd(ch): endif
      inc k
    loop until ch = 0
    sertxd(cr,lf)
    @bptr=0
    bptr = buff32Adr ' tune name location
    for k = 1 to 20 ' space-fill end of tune name line
      if @bptr = 0 then : ch = " " : endif
      if ch = " " then : @bptr = " " : endif
      inc bptr
    next k
    @bptr=0 ' terminate string after 20 characters
    bptr = buff32Adr ' tune name location
'    lookup i,($80,$80,$C0,$94,$D4),b2 ' address of line on LCD
    HI2cSetup I2CMASTER, LCDAdr, I2CSLOW, I2CBYTE
    Gosub SendB2AsCommandByte
    gosub sendString
    HI2cSetup I2CMASTER, EEPROMAdr, i2cfast, i2cword
    pause 500
    return

initializeNoteNames:
  bptr = noteNdxAdr ' array of 35 byte pointers to note text
  i = 0 ' beginning of note-name data in table
  readtable i,ch
  do while ch <> 0
    @bptrinc = i
    readtable i,ch
    do while ch <> "," ' comma separated text
      inc i
      readtable i,ch
    loop
    inc i
    readtable i,ch
  loop
  i = 0
  return

outputNoteName:
'      serout pLCD,N2400,(254,200) : pause 30 ' set cursor at row 2, position 8
  bptr = pinNo + noteNdxAdr ' address of address in table of note text
  bptr = @bptr ' get address in table of text
  readtable bptr,ch
  do while ch <> ","
'        serout pLCD,N2400,(ch)
    inc bptr
    readtable bptr,ch
  loop
  return

'============= LCD Routines =======================

InitializeLCD:
  HI2cSetup I2CMASTER, LCDAdr, I2CSLOW, I2CBYTE

  b2 = $33 : Gosub Sendb2AsInitByte
  b2 = $33 : Gosub Sendb2AsInitByte
  b2 = $32 : Gosub Sendb2AsInitByte
  b2 = $28 : Gosub Sendb2AsCommandByte
  b2 = $0C : Gosub Sendb2AsCommandByte
  b2 = $06 : Gosub Sendb2AsCommandByte
  b2 = $01 : Gosub Sendb2AsCommandByte 

  Pause 2
  return

Sendb2AsInitByte:

  Pause 15

  bitWR = 0         ; Keep WR signal low
  bitBKL = 1        ; keep backlight on
'  bitBKL = 0        ; keep backlight off
 
Sendb2AsCommandByte:

  bitRS = 0         ; Send byte as a command

Sendb2AsDataByte:

  bitD4 = bit20      ; Send msb first
  bitD5 = bit21
  bitD6 = bit22
  bitD7 = bit23

  bitE  = 1
  secondNybble = b3        ; secondNybble holds msb with E set
  bitE  = 0         ; b1 holds msb with E clear

  HI2cOut b3, ( secondNybble, b3 )

  bitD4 = bit16      ; Send lsb second
  bitD5 = bit17
  bitD6 = bit18
  bitD7 = bit19

  bitE  = 1
  secondNybble = b3        ; secondNybble holds lsb with E set
  bitE  = 0         ; b1 holds lsb with E clear

  HI2cOut b3, ( secondNybble, b3 )

  bitRS = 1         ; Send data byte next time
  
  Return

sendString:
  do : b2 = @bptrinc: if b2 <> 0 then: Gosub Sendb2AsDataByte: endif: loop until b2 = 0
  return
 

lbenson

Senior Member
A major part of why I was interested in this project was that I wanted to see if you could get real tunes likely to be played on the hammered dulcimer into the picaxe. After some poking around, I decided that the best way would be to convert tunes in the text-based "abc" notation (widely used by fiddlers and others) into the coding of the picaxe TUNE command. There are thousands of abc tunes available.

Here is the basic program I used to transcode from abc to picaxe:
Code:
' abc2rtttl.bas

DIM i AS INTEGER, j AS INTEGER, k AS INTEGER, l AS INTEGER, m AS INTEGER, n AS INTEGER
DIM iOctave AS INTEGER
DIM sStr AS STRING, sOut AS STRING, sRTTTL AS STRING, sPX AS STRING, sFN AS STRING
DIM quote AS STRING, hinybble AS STRING, lonybble AS STRING, sNoSharp AS STRING
DIM sSharp AS STRING, sOctave AS STRING, sKey AS STRING, ch AS STRING, nextch AS STRING

i = 0
quote = CHR$(34)
sFN = "Ashokan Farewell"
sFN = "The Irish Washerwoman"
sFN = "The Boys of Blue Hill"
sFN = "Miss McLeods Reel"
sFN = "Temperance Reel2"
OPEN "/music/tabs/abc/" + sFN + ".abc" FOR INPUT AS #1

sOut = ""
sRTTTL = ""
sPX = "(" + quote + sFN + quote + ",$00," ' string for picaxe TUNE command
DO UNTIL EOF(1)
    LINE INPUT #1, sStr
    i = INSTR(sStr, quote)
    DO WHILE i > 0 ' remove any cord designation
        k = INSTR(i + 1, sStr, quote)
        IF k > 0 THEN
            sStr = MID$(sStr, 1, i - 1) + MID$(sStr, k + 1)
        END IF
        i = INSTR(sStr, quote)
    LOOP
    PRINT sStr
    k = LEN(sStr)
    ch = MID$(sStr, 1, 1)
    nextch = MID$(sStr, 2, 1)
    IF nextch = ":" THEN
        IF ch = "K" THEN
            sKey = MID$(sStr, 3, 1)
            IF sKey = " " THEN
                sKey = MID$(sStr, 4, 1)
            END IF
            IF sKey <> "D" AND sKey <> "G" AND sKey <> "C" THEN
                PRINT "Only D Major, G Major and C Major Keys Allowed"
                END
            END IF
            PRINT "Key of " + sKey
            PRINT ""
        ELSEIF ch = ":" THEN ' repeat marker
            PRINT CHR$(7) + "Repeat found: " + quote + ch + quote + "; edit .abc file to unroll repeats"
            END
        END IF
    ELSE ' not a header line
        i = 1
        DO WHILE i <= k
            ch = MID$(sStr, i, 1)
            i = i + 1
            nextch = MID$(sStr, i, 1)
            j = INSTR("ABCDEFG", ch) ' lower octave
            IF j > 0 THEN ' lower octave
                ch = MID$("abcdefg", j, 1)
                sOctave = "6"
                iOctave = 0
                IF nextch = "," THEN
                    sOctave = "5"
                    iOctave = 2
                    nextch = MID$(sStr, i + 1, 1)
                END IF
                '                sOut = sOut + MID$("abcdefg", j, 1) + ","
            ELSEIF INSTR("abcdefg", ch) > 0 THEN ' upper octave
                sOctave = "7"
                iOctave = 1
                IF nextch = "'" THEN
                    '         sOctave = "8"
                    nextch = MID$(sStr, i + 1, 1)
                END IF
            ELSE
                IF ch = "|" THEN
                    IF nextch = "1" OR nextch = "2" THEN
                        PRINT CHR$(7) + "Repeat found: " + quote + ch + quote + "; edit .abc file to unroll repeats"
                        END
                    END IF
                END IF
                sNoSharp = ch
                ch = ""
            END IF
            IF ch <> "" THEN ' standard duration is 16th note (no number)
                IF nextch = "2" THEN
                    sOut = sOut + "4" ' quarter note
                    hinybble = CHR$(iOctave + ASC("0"))
                ELSEIF nextch = "3" THEN ' 3/8ths--8th+quarter
                    hinybble = CHR$(4 + iOctave + ASC("0"))
                    GOSUB outputNote
                    sOut = sOut + "4" ' quarter note
                    hinybble = CHR$(iOctave + ASC("0"))
                ELSEIF nextch = "4" THEN
                    sOut = sOut + "2" ' half note
                    hinybble = CHR$(12 + iOctave + ASC("0"))
                ELSEIF nextch = "6" THEN '3/4ths
                    sOut = sOut + "4" ' quarter note
                    hinybble = CHR$(iOctave + ASC("0"))
                    GOSUB outputNote
                    sOut = sOut + "2" ' half note
                    hinybble = CHR$(12 + iOctave + ASC("0"))
                ELSE
                    hinybble = CHR$(4 + iOctave + ASC("0"))
                END IF
                GOSUB outputNote
            END IF
        LOOP
    END IF
LOOP
CLOSE #1
OPEN "/music/tabs/abc/" + sFN + ".rtttl" FOR OUTPUT AS #2
PRINT #2, sOut
CLOSE #2
OPEN "/music/tabs/abc/" + sFN + ".inc" FOR OUTPUT AS #2
PRINT #2, sPX + ")"
CLOSE #2
PRINT ""
PRINT "DONE: /music/tabs/abc/" + sFN + ".inc" + " written"
END

outputNote:
sOut = sOut + ch
sSharp = ""
IF sNoSharp <> "=" THEN
    IF sKey <> "C" THEN
        IF ch = "f" THEN ' in key of D or G, f#
            sSharp = "#"
        ELSEIF ch = "c" THEN ' in key of D, c#
            IF sKey = "D" THEN
                sSharp = "#"
            END IF
        END IF
    END IF
END IF
sOut = sOut + sSharp + sOctave + ","
m = INSTR("c d ef g a b", ch) - 1
IF sSharp = "#" THEN
    m = m + 1
END IF
lonybble = CHR$(ASC("0") + m) ' note of "0"-"9","A","B"s
IF lonybble > "9" THEN
    lonybble = CHR$(ASC(lonybble) - ASC("9") - 1 + ASC("A")) ' convert to hex
END IF
IF hinybble > "9" THEN
    hinybble = CHR$(ASC(hinybble) - ASC("9") - 1 + ASC("A")) ' convert to hex
END IF
sPX = sPX + "$" + hinybble + lonybble + ","
RETURN
I ran the code in QB64--a QB (Quick Basic) DOS program which runs under Windows on 64-bit PCs. VB, VBA, Freebasic, and other Windows Basics would also work.

The program does not process repeats, which are very common in abc files--you must use a text processor to unroll them before running them through this program. Only tunes in the key of D, G, and C are processed.
 

lbenson

Senior Member
The output is pasted into a picaxe program, and flashed to an external I2C eeprom. Here is sample code:
Code:
' 20initEEPROM: 20M2 eeprom loader:
' $00-$1B, label; $1C, pointer to next available eeprom memory; $1E, #tunes; 
' $100-$6FF, 32-byte blocks of tune name pointers with 1st 2 bytes a word pointer to the notes;
' $700 up, tune note data--one byte per note in PICAXE TUNE command format
' notes are in 16-byte "blocks" (eeprom blocks); notes occupy up to 16 16-byte blocks (max 256 bytes per tune)
' 24LC64 eeprom (8K) has 512 blocks; 100 tunes with 4 blocks of notes each (256 notes) is 450 blocks
'
#picaxe 20M2
#terminal 4800

'#define READONLY
'#define RESTART

symbol EEPROMAdr = %10100000 ' $A0
symbol NextDataAdr=$1C
symbol NTunesAdr=$1E
symbol TuneNameBlockBase=$100 ' 32-byte names per 64-byte block; 2-byte note address, up to 29-byte name
symbol TuneNoteBlockBase=1792 ' 32*48 + 256  ' room for 48 tune names
symbol nameBlockSize=32

symbol NTunes  = b18
symbol ch      = b19
symbol i       = b20
symbol k       = b21
symbol wDataAdr= w11 ' b22,b23
symbol wNoteAdr= w12
symbol wNameAdr= w13
  pause 3000
'  HI2cSetup I2CMASTER, EEPROMAdr, i2cfast, i2cword
  HI2cSetup I2CMASTER, EEPROMAdr, i2cslow, i2cword
  pause 2000
#ifdef RESTART
  HI2cOut 0,("Hammer Dulcimer Tunes") ' label this eeprom
  pause 30  ' wait for write to happen
  NTunes = 0 ' start over--comment out after first run
  Hi2cOut NTunesAdr,(NTunes) 
  pause 30  ' wait for write to happen
  wDataAdr = TuneNoteBlockBase ' start over--comment out after first run
  Hi2cOut NextDataAdr, (b23,b22) '(wDataAdr)
  pause 30
  Hi2cOut TuneNameBlockBase, (b23,b22,0) ' null-terminate 1st name
  pause 30
#endif
#ifdef READONLY
  Hi2cIn 0,(b0,b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12,b13,b14,b15) ' read back what we just wrote
  sertxd("Eeprom label: ",b0,b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12,b13,b14,b15,cr,lf)
  gosub printTunes
#else
  wNameAdr=NTunes * nameBlockSize + TuneNameBlockBase
  Hi2cIn NextDataAdr, (b23,b22) '(wDataAdr)
  HI2cOut wNameAdr,(b23,b22,"Miss McLeods Reel",$00)
  pause 20  ' wait for write to happen
  inc NTunes
  HI2cOut NTunesAdr,(NTunes)
  pause 20  ' wait for write to happen
  sertxd(#NTunes," ",#wNameAdr,cr,lf)

'#rem
  write 0,$07,$4B,$47,$52,$47,$4B,$47,$49,$4B,$4B,$49,$4B,$50,$4B,$49,$07,$4B,$47,$52,$47,$4B,$47,$09,$49,$47,$49,$50,$4B,$49,$07,$4B,$47,$52,$47,$4B,$47,$49,$4B,$4B,$49,$4B,$0B,$52,$54,$56,$54,$52,$4B,$52,$54,$56,$57,$54,$52,$4B,$49,$50,$4B,$49,$07,$4B,$47,$52,$47,$4B,$47,$49,$4B,$4B,$49,$4B,$50,$4B,$49,$07,$4B,$47,$52,$47,$4B,$47,$09,$49,$47,$49,$50,$4B,$49,$07,$4B,$47,$52,$47,$4B,$47,$49,$4B,$4B,$49,$4B,$0B,$52,$54,$56,$54,$52,$4B,$52,$54,$56,$57,$54,$52,$4B,$49,$50,$4B,$49,$07,$57,$56,$54,$56,$57,$54,$52,$4B,$4B,$49,$4B,$50,$4B,$49,$07,$57,$56,$54,$56,$57,$54,$19,$59,$5B,$59,$57,$54,$56,$57,$17,$56,$54,$56,$57,$54,$52,$4B,$4B,$49,$4B,$0B,$52,$54,$14,$52,$4B,$52,$54,$56,$57,$54,$52,$4B,$49,$50,$4B,$49,$07,$57,$56,$54,$56,$57,$54,$52,$4B,$4B,$49,$4B,$50,$4B,$49,$07,$57,$56,$54,$56,$57,$54,$19,$59,$5B,$59,$57,$54,$56,$57,$17,$56,$54,$56,$57,$54,$52,$4B,$4B,$49,$4B,$0B,$52,$54,$14,$52,$4B,$52,$54,$56,$57,$54,$52,$4B,$49,$50,$4B,$49,$FF
  pause 20  ' wait for write to happen
  sertxd("MMR")
  gosub writeToEEPROM
'#endrem

  wNameAdr=NTunes * nameBlockSize + TuneNameBlockBase
  Hi2cIn NextDataAdr, (b23,b22) '(wDataAdr)
  HI2cOut wNameAdr,(b23,b22,"The Boys of Blue Hill",$00)
  pause 20  ' wait for write to happen
  inc NTunes
  HI2cOut NTunesAdr,(NTunes)
  pause 20  ' wait for write to happen
  sertxd(#NTunes," ",#wNameAdr,cr,lf)

'#rem
  write 0,$52,$4B,$4B,$49,$46,$49,$42,$49,$46,$49,$4B,$49,$4B,$52,$14,$52,$54,$56,$59,$57,$56,$54,$57,$56,$54,$52,$56,$54,$52,$0B,$52,$4B,$4B,$49,$46,$49,$42,$49,$46,$49,$4B,$49,$4B,$52,$14,$52,$54,$56,$59,$59,$56,$54,$57,$56,$54,$12,$12,$12,$52,$4B,$4B,$49,$46,$49,$42,$49,$46,$49,$4B,$49,$4B,$52,$14,$52,$54,$56,$59,$57,$56,$54,$57,$56,$54,$52,$56,$54,$52,$0B,$52,$4B,$4B,$49,$46,$49,$42,$49,$46,$49,$4B,$49,$4B,$52,$14,$52,$54,$56,$59,$59,$56,$54,$57,$56,$54,$12,$12,$12,$56,$57,$59,$56,$52,$56,$19,$57,$56,$54,$56,$57,$59,$1B,$59,$57,$56,$59,$57,$56,$54,$57,$56,$54,$52,$56,$54,$52,$0B,$52,$4B,$4B,$49,$46,$49,$42,$49,$46,$49,$4B,$49,$4B,$52,$14,$52,$54,$56,$59,$59,$56,$54,$57,$56,$54,$12,$12,$12,$56,$57,$59,$56,$52,$56,$19,$57,$56,$54,$56,$57,$59,$1B,$59,$57,$56,$59,$57,$56,$54,$57,$56,$54,$52,$56,$54,$52,$0B,$52,$4B,$4B,$49,$46,$49,$42,$49,$46,$49,$4B,$49,$4B,$52,$14,$52,$54,$56,$59,$59,$56,$54,$57,$56,$54,$12,$12,$12,$FF
  pause 20  ' wait for write to happen
  sertxd("BBH")
  gosub writeToEEPROM
  gosub printTunes

#endif
'  sertxd("nTunes = ",#NTunes,cr,lf)
  end

writeToEEPROM:
  i = 0 ' eeprom address
  do
'    sertxd("^")
    bptr = $60
    read i,b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12,b13,b14,b15,b16
'    read i,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc
    @bptr = $FF ' terminate
'    sertxd("-")
    bptr = $60
    hi2cout wDataAdr,(b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12,b13,b14,b15,b16)
'    hi2cout wDataAdr,(@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc,@bptrinc)
    pause 20  ' wait for write to happen
    bptr = 1 : bit0=0 : do while bptr < 17 : if @bptrinc = $FF then : bit0=1 : endif : loop
'    bptr = $60 : bit0=0 : do while bptr < $70 : if @bptrinc = 0 then : bit0=1 : endif : loop
    wDataAdr = wDataAdr + 16
    sertxd(".")
    if bit0 = 1 then exit
    i = i + 16
  loop
  Hi2cOut NextDataAdr, (b23,b22) '(wDataAdr)
  pause 20  ' wait for write to happen
  sertxd(cr,lf)
  return
 
 printTunes:
  Hi2cIn NTunesAdr,(NTunes) 
  if NTunes > 6 then : NTunes = 2 : endif
  sertxd("# tunes: ",#NTunes,cr,lf)
  for i = 1 to NTunes
    wNameAdr=i - 1  * 32 + TuneNameBlockBase + 2 ' offset past 2-byte note address
    k = 1
    sertxd(#i," ",#wNameAdr,": ")
    do
      Hi2cIn wNameAdr,(ch) : inc wNameAdr : if ch <> 0 then : sertxd(ch) : endif : inc k
    loop until ch = 0 or k > 30
    sertxd(cr,lf)
  next i
  return
Because the program writes the notes to local eeprom before writing to external eeprom, there is a limit of 256 notes per tune.

Most fiddle tunes in the abc notation are an octave higher than is suitable for the hammered dulcimer, so I have lowered them an octive in the program in the previous post (except for "Ode to Joy").

This may well be a one-off project, but I had fun working on it.

Apologies to "gramps" if I have hijacked his project.
 
Last edited:

Gramps

Senior Member
Absolutely no apologies necessary! I'm delighted that my question has generated so much interest.
 

techElder

Well-known member
Geez, now I know what you've been spending your time on, Lance. I've been asked several times to sequence songs for this or that "thing", but was always stymied by the difference between notes and tunes (PICAXE tunes. ) Sure does look like you've solved that.

I'm curious how the "hammer" will turn out with this program driving it.

Gramps, how will you complete the project?
 

Gramps

Senior Member
Still waiting 4 the picaxe development board to arrive in the mail which was ordered a month ago still not here sigh
 

AllyCat

Senior Member
Hi,

Still waiting 4 the picaxe development board to arrive in the mail which was ordered a month ago
I hope that's not from the PICaxe Store (Revolution Education Ltd UK) who are normally very efficient. I would only expect to wait that long (sometimes) for a shipment from China. :(

Not much has been said about the physical construction, but I assumed that the dulcimer has a sounding board/box so the LEDs would be mounted on a fairly "minimal" structure, with an "umbilical" cable/bus off to an external "battery box" enclosure? As previously indicated, my preference would be for a fairly "General Purpose" configuration, in case you revise your ideas about LEDs for multiple-strings / chords, etc.. Thus the APA102 (intelligent LEDs) is an interesting solution, but perhaps a little restrictive, expensive and potentially slow (the data has to ripple through all 35 LEDs).

An extension of the basic multiplexing idea could use bi-colour LEDs (Google quickly found these) to indicate both multiple strings and two notes in a Chord. The two coloured LEDs are connected in reversed directions in a single package, which is exactly how LEDs are (or can be) connected in a Charlieplex.

70 LEDs in a Charlieplex require 9 wires/pins (9 x 8 = 72 LEDs maximum) and should be quite easy to connect in a bi-colour format. For example "Wire/pin 1" connects to the "+" pins (e.g. Red Anodes) of the first 8 LEDs, with their "-" pins to "Wire/pins 2 - 9". Then "Wire/pin 2" to the next 7 LEDs, with their negatives to "Wire/pins 3 - 9", etc.. But to simplify the programming, any LEDs which are required to light at the same time should be connected to the same data wire/pin. The only "inconvenience" is that 9 pins can no longer be easily driven from a single byte value (and of course lighting Red and Green together does need time-division multiplexing), but not insurmountable problems ;)

Cheers, Alan.
 

Gramps

Senior Member
The picaxe package from the UK is lost in the US and the US Post Office is searching for it diligently. it was tracking well until May 11th when it went off the radar.
Oldbitcollector and I experimented with some LED arrays but we found the same difficulty in aligning the lamps with the strings on the instrument.
 

premelec

Senior Member
@gramps, www.phanderson.com has very fast and inexpensive shipping if they have what you want - I've also used some other USA dealers with generally good results... hope you get it going soon... good project...
 

lbenson

Senior Member
I don't have a schematic, but the mockup pebble breadboard image shows all the connections. Note that the indicator LEDs are "resistorized"--either with internal resistors, or, as I did it on the breadboard in the video, with soldered-on resistors. I used 3K3 for these indicator LEDs so that the pins can still drive LEDs on the hammered dulcimer with their separate 680 Ohm resistors.
hammer breadboard.jpg
I am working on an Eagle cad schematic and board, but it may be some time before I have that done. I will be following Allycat's suggestion of 'the "resistive source" method' (as I understand it), with 3 680 Ohm resistors from power with the picaxe turning the LEDs on by setting the appropriate pin to 0V.
 

lbenson

Senior Member
A more general question: what speaker type will give the best quality sound when using the picaxe TUNE command? The piezo I have is quite distorted sounding--I don't know if that is a characteristic of the specific piezo I have, or of the piezo speaker in general. I'm not looking for instrument quality, of course, just the best I am likely to get from the TUNE command at a reasonable price.

I realize that better quality sound could be achieved by hacking at an mp3 module, but the TUNE command gives control over note duration (and overall speed), so I want to use that.
 

Gramps

Senior Member
[/QUOTE]I am working on an Eagle cad schematic and board, but it may be some time before I have that done.
That's okay my picaxe board is still lost in the mail:(
Did I miss a table that indicates which notes go to which pins?
 

lbenson

Senior Member
The picaxe TUNE command encodes for 3 12-note octaves. At the beginning of "PlayNote" the note is decoded:
Code:
    octave = codedNote & %00110000 / 16 ' %00=middle; %01=high; %10=low
    note = codedNote & %00001111
    if octave = 0 then : note = note + 12 : endif ' middle octave
    if octave = 1 then : note = note + 24 : endif ' high octave
'    if tuneNo = 5 then : note = note - 12 : endif ' drop an octave
'    table 0,($00,$FF,$01,$FF,$02,$03,$10,$C0,$FF,$C1,$11,$12,$C2,$13,$C3,$20,$C4,$C5,$21,$C6,$FF,$C7,$22,$23,$C8,$FF,$30,$FF,$31,$32,$FF,$33)
    lookup note,(0,$FF,1,$FF,2,3,4,5,$FF,6,7,8,9,10,11,12,13,14,15,16,$FF,17,18,19,20,$FF,21,$FF,22,23,$FF,24),pinNo
The note in the octave is given by the hex values $0 through $B in the lower 4 bits of the coded note. The octave is given by bits 4 and 5, but the coding is not intuitive. For reasons that I assume relate to some internal efficiencies, bit value %00 is the middle octave, %01 is the high octave, and %10 is the low (%11 is unused). The code comes up with a value of 0-35 for the 36 possible TUNE notes. The LOOKUP command specifies which pin that note corresponds to. $FF in the LOOKUP command indicates that the note is not available on the hammered dulcimer (and so the blue LED on pin C.4 is lit).

PinNo 0-7 are portA on the MCP23017; 8-15 are portB; 16-20 are B.0-B.4 on the 20M2; B.5 and B.7 are I2C pins SDA and SCL respectively, and so are skipped; pinNo 21 is B.6, and pinNos 22-24 are C.0, C.1, and C.2. Thus 25 pins are accounted for, corresponding to the 25 unique notes on the hammered dulcimer.
 

lbenson

Senior Member
I was hoping to connect the LEDs directly to a picaxe. That is not possible?
Only the 40X2 has enough pins to directly control 25 LEDs with individual pins. Using Allycat's suggested charlieplexing method, you could get by with a 14M2, but both the wiring and the code would be complex. With the matrix that you have, 8 pins controlling 16 LEDs, you can control the remaining 9 LEDs with the 28X2 and still have 4 left over for piezo output and control (e.g., LCD and pushbutton(s)).

You are limited in how many tunes you can play if you don't have external eeprom, although with multiple 4K "slots" on a 28X2 you could probably code for at least a dozen using the picaxe TUNE encoding scheme that I have employed.
 

Gramps

Senior Member
The picaxe originally ordered was a 28X2. So the program and layout that you constructed using the 16 LED matrix and the nine extra LED pins will work.
My primary objective is to learn how to code a pickaxe.
I never imagined this idea would grow this complex but according to Old bit collector this is the way these projects always morph (grin)
Keeping everything simple and limiting the functions will make it easier for me to understand what's going on.
BTW, picaxe code is still a total mystery.
 

lbenson

Senior Member
Sorry about the introduced complexity. If you were willing to code each tune by hand with a designation of the LED to be lit, and weren't concerned about note duration, the picaxe code would be simpler, but the prep work would be a lot harder (to my mind).

I thought that the duration of the note was an important piece of information, and the picaxe TUNE command provides for that (eighth, quarter, half, whole notes), so one way of simplifying one aspect of the code seemed to me to be to make use of that. If, after confirming that the tune sounds right by playing it on the piezo, the note sound is a distraction, you can simply unplug the piezo, and the TUNE command will still make the timing right.

The other hard aspect of this, to me, was getting tunes you might want to play on the hammered dulcimer into the picaxe in a (relatively) easy way. The external program which converts abc files into picaxe note format handles that. It's still a somewhat clunky process which takes some hand-holding, but I could probably add a new tune available in abc notation in about 15 minutes.

This is not your typical beginner's "light an LED" code--bit manipulation, indexing (indirection) and use of upper ram is required, compounded by the fact that some of the notes in the 3-octave, 12-tone scale which the picaxe uses are not available on the hammered dulcimer, and some notes are available on more than one set of strings.
 

Gramps

Senior Member
Indeed, my original thought was to code each tune individually. that's why I was anticipating working with the first eight notes mentioned back in an earlier post. The average tune has between 30 and 40 notes.
 

AllyCat

Senior Member
Hi,

what speaker type will give the best quality sound when using the picaxe TUNE command?
I believe the TUNE command outputs only a square wave so is always likely to sound "harsh" (lots of harmonics), more like a bowed or reed instrument. A low-pass (top cut) filter might help, but not greatly over a span of three octaves, unless some more pins are used to adjust the "turnover" (-3dB) frequency.

Personally, I would use a "real" (moving-coil) loudspeaker, even if only an inch or two in diameter, mounted in a proper "enclosure" (closed box), acting as an "infinite baffle" to give a reasonable low-frequency response. Ideally the box material should be as acoustically "dead", perhaps wood rather than plastics and lined with felt or a "foamed" rubber/plastics material.

Of course moving coil speakers normally have a rather low impedance (4-8 ohms or maybe up to 35 ohms) so you may need some type of "amplifier". There are plenty of possibilities, but a rather "fun" device is the PAM8403, which could cost less than a couple of dollars sourced locally, and five or ten (PCB modules) at that price from China. Several watts from a 5 volt rail without any output coupling capacitor, and stereo if required. I've not actually used them for their intended (audio) application but they do make nice stepper motor drivers. ;)

Yes, the Charlieplex probably is somewhat more complicated, but you've then only got 7 wires (for 35 LEDs) to worry about and the (required) LOOKUP table can hide a multitude of sins. ;)

Cheers, Alan.
 

lbenson

Senior Member
Thanks. Are you saying that a "moving coil speaker" would work with the TUNE command? I think I have small ones somewhere.

Is Manual 3, page 11 (in my version) apt? The code illustration with it is with the SOUND command.

Off to dig around.
 

lbenson

Senior Member
Here's a 28X2 version which will run in the simulator and play the tunes at a pace which, if slow, makes them recognizable. Encoded tunes are "Ode To Joy", "The Boys of Blue Hill", "Ashokan Farewell", "The Irish Washerwoman", "Amazing Grace", "Wildwood Flower", and "Temperance Reel".

As with the previous 28X2 version, clicking A.2 and then again after about a second will cycle to the next tune. Clicking A.2 and counting to 3 before clicking it off will play the current tune. The simulated LCD is 4 lines by 20 characters on A.3. Two tunes at a time are listed--the "current" tune on line one, and the "next" on on line 2. At the end, the list cycles around again.

In order to get the tunes to play faster, I used a "#define simulate" command. When it is on, the lighting of the LEDs and the printing of the note name to the LCD is turned off. If that DEFINE is commented out, the tune will play very slowly, and the appropriate LEDs will light. Same coding as with the prior 28X2 program, including the 4x4 matrix.

The tune should play at a reasonable speed on a real 28X2.

I had wished to encode additional tunes in slot 1, and have the code there write the tunes to the scratchpad, but it turns out that the simulator does not retain in scratchpad or eeprom memory what a different slot program has written there. Another half-dozen tunes or more could be written to each 28X2 slot on a real chip.
Code:
' 28hammer -- plays tunes one note at a time & lights LED corresponding to note
#picaxe 28X2
' uses duration, octave, note coding from "tune" command
#define simulate ' in simulation, don't light LEDs

' BELOW: 1st row, # duplicate if > 1; 2nd row, notes ("-" if not available); 3rd row, note coding
'                            2        2          2        3      2   2        2       2           2 
' G3,-G#3,A3,-Bb3,B3,C4, C#4,D4,-Eb4, E4,F4, F#4,G4, G#4, A4,Bb4,B4, C5, C#5, D5,-Eb5,E5, F5,F#5, G5,-G#5,A5,-Bb5,B5, C6,-C#6,D6
'$00,$FF,$01,$FF,$02,$03,$10,$C0,$FF,$C1,$11,$12,$C2,$13,$C3,$20,$C4,$C5,$21,$C6,$FF,$C7,$22,$23,$C8,$FF,$30,$FF,$31,$32,$FF,$33
' Note coding: $FF=not available; $C?--pin C.0-C.7,A.0; other: 1st nybble is B-port string B0-B3; 2nd is B4-7
table 0,($00,$FF,$01,$FF,$02,$03,$10,$C0,$FF,$C1,$11,$12,$C2,$13,$C3,$20,$C4,$C5,$21,$C6,$FF,$C7,$22,$23,$C8,$FF,$30,$FF,$31,$32,$FF,$33)
table 40,("G3,-G#3,A3,-Bb3,B3,C4,C#4,D4,-Eb4,E4,F4,F#4,G4,G#4,A4,Bb4,B4,C5,C#5,D5,-Eb5,E5,F5,F#5,G5,-G#5,A5,-Bb5,B5,C6,-C#6,D6,",0,0,0)

symbol pButtonPin=pinA.2
symbol pLCD=A.3          ' for 4x20: line 1=128, 2=192, 3=148, 4=212
symbol pPiezo=A.4

symbol newTune=bit0

symbol notech=b2
symbol lastch=b3
symbol eePtr=b4
symbol note=b5
symbol codedNote=b6
symbol pinNo=b7
symbol oldPinNo=b8
symbol octave=b9
symbol checkTime=b10
symbol tunePtr=b11
symbol LEDcoding=b12
symbol ch=b13
symbol i = b14
symbol k = b15
symbol nextEE  = b16
symbol tuneNo  = b17

' b32-b55 ' 32 bytes reserved for ram

symbol noteNdxAdr = 56 ' start of upper ram; note text index
symbol MAXTUNE = 7

'eeprom 0,("Ode To Joy",0,"The Boys of Blue Hill",0,"Ashokan Farewell",0,"The Irish Washerwoman",0,"Amazing Grace",0,"Wildwood Flower",0,$FF)

settimer t1s_8 ' set timer to 1 second ticks at 8MHz (default speed)
newTune = 1
dirsB=%11111111 ' all outputs
pinsB=%00000000 ' all low
dirsB=%00000000 ' all inputs
dirsC=%11111111 ' all outputs
tuneNo = 1

gosub getNoteNames
nextEE = 0

do
  eePtr = nextEE
  if newTune = 1 then
    serout pLCD,N2400,(254,1) : pause 30 ' clear screen; see http://www.picaxe.com/docs/axe033.pdf
    i = tuneNo
    gosub showTuneName
    serout pLCD,N2400,(254,192)  ' 254,192 for 2 line
    inc i : if i > MAXTUNE then : i = 1 : endif
    gosub showTuneName
    newTune = 0
  endif
  do : loop while pButtonPin = 0 ' wait until button is pressed
  timer = 0 ' one-second timer
  checkTime=1
  do : loop while pButtonPin = 1 ' wait until button is released
  if timer <= checkTime then ' next tune
    inc tuneNo
    if tuneNo > MAXTUNE then : tuneNo = 1 : endif
'    do : read eePtr, codedNote : inc eePtr : loop until codedNote = $FF ' read past this tune
    read eePtr,ch
    if ch = $FF then : eePtr = 0 : endif ' end of tunes; start over
    newTune = 1
  else ' we've selected this tune
    on tuneNo GOSUB tune1, tune1, tune2, tune3,tune4,tune5,tune6,tune7 ' ,tune8 ' no tune 0
    
    serout pLCD,N2400,(254,212,"Playing")  ' 254,192 for 2 line
    ptr = 0
'    read eePtr,codedNote
    codedNote = @ptrinc
    do while codedNote <> $ff
      if tuneNo = 2 or tuneNo = 3 or tuneNo = 4 then ' drop an octave
        octave = codedNote & %00110000
        codedNote = codedNote & %11001111 ' strip out octave
        if octave = %00000000 then : codedNote = codedNote | %00100000 : endif ' low octave
        if octave = %00010000 then : codedNote = codedNote & %11001111 : endif ' middle octave
      endif
#ifndef simulate
      octave = codedNote & %00110000 >> 4 ' %00=middle; %01=high; %10=low
      note = codedNote & %00001111
      if octave = 0 then : note = note + 12 : endif ' middle octave
      if octave = 1 then : note = note + 24 : endif ' high octave
      pinNo = note ' 0-35: b.0-b.7, c.0-c.7, a.0-a.7, d.0-d.6 (D.7 plays tune)
'      if pinNo > 17 then : pinNo = 17 : endif ' reserved pins: A.4=piezo; A.3=LCD; A.2=button
'      low oldPinNo
'      high pinNo
'      oldPinNo = pinNo
      readtable pinNo, LEDcoding
      serout pLCD,N2400,(254,220) : pause 30 ' set cursor at row 4, position 8
      bptr = pinNo + noteNdxAdr ' address of address in table of note text
      bptr = @bptr ' get address in table of text
      readtable bptr,ch
      do while ch <> ","
        serout pLCD,N2400,(ch)
        inc bptr
        readtable bptr,ch
      loop
      serout pLCD,N2400,("  ")
      sertxd(#codedNote,"/",#pinNo,"/")
      pinsB = %00000000 ' set all portB pins to low
      dirsB = %00000000 ' set all portB pins inputs
      pinsC = %00000000 ' set all portC pins to low
      low D.0 '
      if LEDcoding = $FF then ' invalid
      elseif LEDcoding => $C0 then
        pinNo = LEDcoding & %00000111 + 8 ' 8-16: C.0-C.7, A.0
        high pinNo
        pinNo = pinNo - 8
        sertxd("C.",#pinNo," ")
      else ' portB LED matrix control--
        pinNo = LEDcoding / 16 & %00001111 ' 0-3: B.0-B.3: high pin for matrix
        high pinNo
        sertxd("B.",#pinNo,"-")
        pinNo = LEDcoding & %00001111 + 4 ' 4-7: B.4-B.7: low pin for matrix
        low pinNo
        sertxd("B.",#pinNo," ")
    endif
#endif
      tune pPiezo,8,(codedNote)
      codedNote = @ptrinc
      if pButtonPin = 1 then  ' terminate playing
        serout pLCD,N2400,(254,212,"           ") 
'        do while codedNote <> $FF : codedNote = @ptrinc : loop
         codedNote = $ff
         do while pButtonPin = 1 : loop ' wait until released
      endif
    loop
    serout pLCD,N2400,(254,212,"Done      ") 
  endif
loop

showTuneName:
  select case i
    case 1: serout pLCD,N2400,("Ode To Joy          ")
    case 2: serout pLCD,N2400,("The Boys of Blue Hil")
    case 3: serout pLCD,N2400,("Ashokan Farewell    ")
    case 4: serout pLCD,N2400,("Irish Washerwoman   ")
    case 5: serout pLCD,N2400,("Amazing Grace       ")
    case 6: serout pLCD,N2400,("Wildwood Flower     ")
    case 7: serout pLCD,N2400,("Temperance Reel     ")
    else: serout pLCD,N2400,("Unknown           ")
  end select
  return
  
getNoteNames:
#ifndef simulate
  bptr = noteNdxAdr ' array of 35 byte pointers to note text
  eePtr = 30 ' beginning of note-name data in table
  readtable eePtr,ch
  do while ch <> 0
    @bptrinc = eePtr
    readtable eePtr,ch
    do while ch <> "," ' comma separated text
      inc eePtr
      readtable eePtr,ch
    loop
    inc eePtr
    readtable eePtr,ch
  loop
#endif
  return
(Again too long--remaining code in next post.)
 

lbenson

Senior Member
Remaining code:
Code:
tune1: ' "Ode To Joy"
  put 0,$29,$29,$2A,$00,$00,$2A,$29,$27,$25,$25,$27,$29,$29,$67,$E7,$29,$29,$2A,$00,$00,$2A,$29,$27,$25,$25,$27,$29,$27,$65,$E5,$27,$27,$29,$25,$27,$69,$6A,$29,$25,$27,$69,$6A,$29,$27,$25,$27,$25,$E9,$29,$2A,$00,$00,$2A,$29,$27,$25,$25,$27,$29,$27,$65,$E5,$FF
  return

tune2: ' "The Boys of Blue Hill"
  put 0,$52,$4B,$4B,$49,$46,$49,$42,$49,$46,$49,$4B,$49,$4B,$52,$14,$52,$54,$56,$59,$57,$56,$54,$57,$56,$54,$52,$56,$54,$52,$0B,$52,$4B,$4B,$49,$46,$49,$42,$49,$46,$49,$4B,$49,$4B,$52,$14,$52,$54,$56,$59,$59,$56,$54,$57,$56,$54,$12,$12,$12,$52,$4B,$4B,$49,$46,$49,$42,$49,$46,$49,$4B,$49,$4B,$52,$14,$52,$54,$56,$59,$57,$56,$54,$57,$56,$54,$52,$56,$54,$52,$0B,$52,$4B,$4B,$49,$46,$49,$42,$49,$46,$49,$4B,$49,$4B,$52,$14,$52,$54,$56,$59,$59,$56,$54,$57,$56,$54,$12,$12,$12,$56,$57,$59,$56,$52,$56,$19,$57,$56,$54,$56,$57,$59,$1B,$59,$57,$56,$59,$57,$56,$54,$57,$56,$54,$52,$56,$54,$52,$0B,$52,$4B,$4B,$49,$46,$49,$42,$49,$46,$49,$4B,$49,$4B,$52,$14,$52,$54,$56,$59,$59,$56,$54,$57,$56,$54,$12,$12,$12,$56,$57,$59,$56,$52,$56,$19,$57,$56,$54,$56,$57,$59,$1B,$59,$57,$56,$59,$57,$56,$54,$57,$56,$54,$52,$56,$54,$52,$0B,$52,$4B,$4B,$49,$46,$49,$42,$49,$46,$49,$4B,$49,$4B,$52,$14,$52,$54,$56,$59,$59,$56,$54,$57,$56,$54,$12,$12,$12,$FF
  return

tune3: ' "Ashokan Farewell"
  put 0,$49,$51,$52,$12,$51,$4B,$49,$C6,$44,$46,$47,$07,$46,$44,$42,$2B,$42,$02,$6B,$29,$02,$06,$09,$12,$16,$56,$16,$57,$16,$D4,$49,$51,$52,$12,$51,$4B,$49,$C6,$44,$46,$47,$07,$46,$44,$42,$2B,$42,$02,$6B,$29,$02,$06,$09,$12,$16,$09,$11,$14,$D2,$46,$47,$49,$09,$46,$02,$D2,$09,$4B,$0B,$51,$12,$49,$46,$06,$04,$46,$06,$44,$02,$EB,$27,$29,$E9,$C9,$46,$44,$02,$06,$09,$10,$D0,$4B,$0B,$51,$12,$09,$46,$06,$42,$29,$02,$06,$49,$52,$12,$06,$44,$04,$42,$01,$C2,$49,$51,$52,$12,$51,$4B,$49,$C6,$44,$46,$47,$07,$46,$44,$42,$2B,$42,$02,$6B,$29,$02,$06,$09,$12,$16,$56,$16,$57,$16,$D4,$49,$51,$52,$12,$51,$4B,$49,$C6,$44,$46,$47,$07,$46,$44,$42,$2B,$42,$02,$6B,$29,$02,$06,$09,$12,$16,$09,$11,$14,$D2,$FF
  return

tune4: ' "The Irish Washerwoman"
  put 0,$4B,$47,$47,$42,$47,$47,$4B,$47,$4B,$52,$50,$4B,$50,$49,$49,$44,$49,$49,$50,$49,$50,$54,$52,$50,$4B,$47,$47,$42,$47,$47,$4B,$47,$4B,$52,$50,$4B,$50,$4B,$50,$49,$52,$50,$4B,$47,$47,$47,$07,$4B,$47,$47,$42,$47,$47,$4B,$47,$4B,$52,$50,$4B,$50,$49,$49,$44,$49,$49,$50,$49,$50,$54,$52,$50,$4B,$47,$47,$42,$47,$47,$4B,$47,$4B,$52,$50,$4B,$50,$4B,$50,$49,$52,$50,$4B,$47,$47,$47,$07,$4B,$47,$47,$42,$47,$47,$4B,$47,$4B,$4B,$49,$47,$49,$46,$46,$42,$46,$46,$49,$46,$49,$49,$47,$46,$44,$47,$47,$42,$47,$47,$40,$47,$47,$6B,$47,$47,$50,$4B,$50,$49,$52,$50,$4B,$47,$47,$47,$07,$4B,$47,$47,$42,$47,$47,$4B,$47,$4B,$4B,$49,$47,$49,$46,$46,$42,$46,$46,$49,$46,$49,$49,$47,$46,$44,$47,$47,$42,$47,$47,$40,$47,$47,$6B,$47,$47,$50,$4B,$50,$49,$52,$50,$4B,$47,$47,$47,$07,$FF
  return

tune5: ' "Amazing Grace"
  put 0,$64,$69,$29,$41,$6B,$69,$01,$6B,$29,$66,$24,$64,$66,$29,$41,$6B,$69,$01,$6B,$41,$04,$41,$44,$04,$41,$6B,$69,$01,$6B,$29,$66,$24,$64,$66,$29,$41,$6B,$69,$01,$6B,$29,$FF
  return

tune6: ' "Wildwood Flower"
  put 0,$66,$67,$29,$6B,$42,$26,$67,$66,$24,$67,$61,$22,$66,$67,$29,$6B,$42,$26,$67,$66,$24,$67,$61,$22,$29,$06,$46,$44,$02,$69,$69,$2B,$41,$6B,$29,$26,$26,$66,$64,$26,$69,$66,$24,$67,$21,$22,$FF
  return

tune7: ' "Temperance Reel     "
#ifdef simulate    ' not enough room if not simulating
  put 0,$42,$44,$46,$07,$47,$46,$47,$49,$4B,$50,$12,$57,$54,$52,$4B,$49,$50,$4B,$44,$44,$42,$44,$46,$47,$49,$4B,$47,$49,$46,$47,$46,$44,$42,$07,$47,$46,$47,$49,$4B,$50,$12,$57,$54,$52,$4B,$49,$50,$4B,$44,$44,$42,$44,$46,$47,$49,$4B,$52,$49,$46, $07,$4B,$54,$54,$52,$14,$54,$56,$57,$54,$59,$56,$57,$56,$54,$52,$49,$52,$52,$54,$12,$52,$54,$56,$52,$59,$56,$57,$56,$54,$52,$4B,$54,$54,$52,$14,$54,$56,$57,$54,$59,$56,$57,$56,$54,$52,$4B,$49,$47,$46,$44,$46,$47,$49,$4B,$52,$49,$46,$C7,$FF
#endif
  return
For the longer tunes, it may take up to 15 seconds for the tune to start to play.

An ADC ladder with, say, 4 buttons on A.2 would allow for a more sophisticated menu, with, say, adjustments for tune speed and "repeat mode" possible.
 

AllyCat

Senior Member
Hi,

Are you saying that a "moving coil speaker" would work with the TUNE command?
AFAIK, the TUNE and SOUND commands drive the pin with exactly the same "Square Wave" signal. You could try driving the speaker "directly" from a PICaxe pin, via about 100 ohms and a capacitor of at least 100uF (e.g. negative terminal to ground and +ve terminal to the second loudspeaker terminal) but it won't be very loud. A "baffle" prevents the sound from the back cancelling out that from the front of the cone; an "infinite baffle" (closed box) can be more compact/convenient but tends to give an even lower sound level. Hence the use of an amplifier which will almost certainly need an attenuator (potential divider) on its input to avoid overload/clipping. For the PAM8403 I mentioned above, probably about 470k ohms (give or take) between its input pin and the PICaxe output.

Don't forget that most PICaxe's have both EEPROM (Read) and TABLE (Readtable) memories and the TABLE memory can contain different data in each "Slot". Personally, I've never used slots (yet) but I believe you could write the same program to each slot, but with different TABLE data. Also, I thought that at least the RAM contents are retained between slot switching?

Cheers, Alan.
 

stevesmythe

Senior Member
I have used small moving coil speakers very effectively direct from a Picaxe pin. The loudness does depend on the particular loudspeaker, even if they are rated as the same impedence as some are move efficient than others.
 

lbenson

Senior Member
Thanks, Alan and Steve-- still haven't located my speaker.

The issue with retaining eeprom and scratchpad data between slots was just with regard to simulation. No problem on a real chip.
 

Gramps

Senior Member
Alan, we wired the LED's as you suggested.
The three resistors should be 680 ohms each, correct?
 

AllyCat

Senior Member
Hi,

Yes, that's a good safe value. A typical supply rail of 5 volts and 1,5 volts LED forward drop would give 5 mA per LED (i.e. (5.0 - 1.5) / 0.68) , or around 15 mA for all three driven by one pin.

If you need higher brightness and the supply rail is lower (e.g 3 x AA cells) and/or the LED drop is higher (e.g. for White, Blue or Green) then the resistor values could probably be halved and still stay within the PICaxe's 25 mA maximum pin rating.

Cheers, Alan.
 
Top