10REM Software volume control program
   20REM (C) John Robinson 1988
   30:
   40DIM code &400
   50osbyte    =  &FFF4
   60osword    =  &FFF1
   70wordv     =  osword!1 AND &FFFF
   80eventv    =  &0220
   90envelopes =  &08C0
  100:
  110FOR pass=0 TO 3 STEP 3
  120P%=code
  130[OPT pass
  140
  150.initialise
  160STA volumelevel
  170PHP
  180SEI
  190LDY wordv+1
  200LDX wordv
  210CPY #newword DIV 256
  220BNE normal_stuff_eh
  230LDX #0
  240.restore_envelopes
  250LDA oldenvelopes,X
  260STA envelopes,X
  270INX
  280BNE restore_envelopes
  290BEQ multiply_envelopes
  300.normal_stuff_eh
  310STY oldwordv+1
  320STX oldwordv
  330LDY #newword DIV 256
  340LDX #newword MOD 256
  350STY wordv+1
  360STX wordv
  370LDY eventv+1
  380LDX eventv
  390STY oldeventv+1
  400STX oldeventv
  410LDY #newevent DIV 256
  420LDX #newevent MOD 256
  430STY eventv+1
  440STX eventv
  450LDA #14
  460LDX #2
  470JSR osbyte
  480.multiply_envelopes
  490LDX #0
  500.save_envelopes_first
  510LDA envelopes,X
  520STA oldenvelopes,X
  530INX
  540BNE save_envelopes_first
  550\ X is now 0
  560.mult_env_loop
  570LDY #3
  580.second_loop
  590INX
  600LDA envelopes,X
  610JSR multiply
  620STA envelopes,X
  630DEY
  640BNE second_loop
  650INX
  660INX
  670INX
  680LDY #9
  690.third_loop
  700INX
  710LDA envelopes,X
  720JSR multiply
  730STA envelopes,X
  740DEY
  750BNE third_loop
  760INX
  770BNE mult_env_loop
  780PLP
  790RTS
  800
  810.oldwordv
  820EQUW 0
  830.oldeventv
  840EQUW 0
  850.volumelevel
  860EQUB 0
  870
  880.multiply
  890ORA #0
  900BMI special
  910.xply
  920STA number
  930LDA volumelevel
  940STA multiplier
  950TYA
  960PHA
  970LDA #0
  980STA resultlo
  990STA resulthi
 1000LDY #8
 1010.multiplyloop
 1020LSR number
 1030BCC no_add
 1040LDA multiplier
 1050CLC
 1060ADC resulthi
 1070STA resulthi
 1080.no_add
 1090ROR resulthi
 1100ROR resultlo
 1110DEY
 1120BNE multiplyloop
 1130LDY #4
 1140.div16
 1150LSR resulthi
 1160ROR resultlo
 1170DEY
 1180BNE div16
 1190PLA
 1200TAY
 1210LDA resultlo
 1220RTS
 1230.special
 1240SEC
 1250SBC #1
 1260EOR #&FF
 1270JSR xply
 1280EOR #&FF
 1290CLC
 1300ADC #1
 1310RTS
 1320
 1330.multiplier
 1340EQUB 0
 1350.number
 1360EQUB 0
 1370.resultlo
 1380EQUB 0
 1390.resulthi
 1400EQUB 0
 1410
 1420.newword
 1430CMP #7
 1440BNE goto_old
 1450STY &F1
 1460STX &F0
 1470STA &EF
 1480LDY #3
 1490LDA (&F0),Y
 1500CMP #&FF
 1510BNE not_straight_sound
 1520DEY
 1530LDA (&F0),Y
 1540CMP #&F0
 1550BCC not_straight_sound
 1560JSR multiply
 1570LDY #2
 1580STA (&F0),Y
 1590.not_straight_sound
 1600LDY &F1
 1610LDX &F0
 1620LDA &EF
 1630.goto_old
 1640JMP (oldwordv)
 1650
 1660.newevent
 1670PHP
 1680PHA
 1690TYA
 1700PHA
 1710TXA
 1720PHA
 1730TSX
 1740LDA &103,X
 1750CMP #2
 1760BNE notus
 1770CPY #ASC "P" AND &1F
 1780BEQ piano__quieter
 1790CPY #ASC "F" AND &1F
 1800BEQ forte__louder
 1810.notus
 1820PLA
 1830TAX
 1840PLA
 1850TAY
 1860PLA
 1870PLP
 1880JMP (oldeventv)
 1890.piano__quieter
 1900LDA volumelevel
 1910BEQ notus
 1920SEC
 1930SBC #1
 1940STA volumelevel
 1950.newvolumeset
 1960JSR initialise
 1970JMP notus
 1980.forte__louder
 1990LDA volumelevel
 2000CMP #&10
 2010BEQ notus
 2020ADC #1
 2030STA volumelevel
 2040BCC newvolumeset
 2050
 2060.oldenvelopes
 2070\ 256 byte buffer
 2080
 2090]
 2100NEXT pass
 2110:
 2120A%=&10              :REM Full volume
 2130CALL initialise
 2140PRINT "Keys: <CTRL><P> = piano = quieter"'"      <CTRL><F> = forte = louder"