Skip to content

Instantly share code, notes, and snippets.

@gtrak

gtrak/gist:5733287

Created June 8, 2013 00:16
Show Gist options
  • Save gtrak/5733287 to your computer and use it in GitHub Desktop.
Save gtrak/5733287 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
gistfile1.clj
(ns com.gtrak.emu.chips.ym2612)
(defmacro defs
[& def-specs]
(let [def-specs (partition 2 def-specs)
forms (for [[var val] def-specs]
`(def ~var ~val))]
`(do ~@forms)))
;; envelope generator
(defs
ENV_BITS 10
ENV_LEN (bit-shift-left 1 ENV_BITS)
ENV_STEP (/ 128.0 ENV_LEN)
MAX_ATT_INDEX (dec ENV_LEN) ;; 1023
MIN_ATT_INDEX 0 ;; 0
EG_ATT 4
EG_DEC 3
EG_SUS 2
EG_REL 1
EG_OFF 0
;; phase generator (detune mask)
DT_BITS 17
DT_LEN (bit-shift-left 1 DT_BITS)
DT_MASK (dec DT_LEN)
;; operator unit
SIN_BITS 10
SIN_LEN (bit-shift-left 1 SIN_BITS)
SIN_MASK (dec SIN_LEN)
TL_RES_LEN 256 ;; 8 bits addressing (real chip)
TL_BITS 14 ;; channel output
;; TL_TAB_LEN is calculated as:
;; 13 - sinus amplitude bits (Y axis)
;; 2 - sinus sign bit (Y axis)
;; TL_RES_LEN - sinus resolution (X axis)
TL_TAB_LEN (* 13 2 TL_RES_LEN)
tl_tab [] ;;static signed int tl_tab[TL_TAB_LEN];
ENV_QUIET (bit-shift-right TL_TAB_LEN 3)
;; sin waveform table in 'decibel' scale
;; static unsigned int sin_tab[SIN_LEN];
sin_tab [])
;; sustain level table (3dB per step)
;; bit0 bit1 bit2 bit3 bit4 bit5 bit6
;; 1 2 4 8 16 32 64 (value)
;; 0.75 1.5 3 6 12 24 48 (dB)
;; 0 - 15: 0 3 6 9 12 15 18 21 24 27 30 33 36 39 42 93 (dB)
;; attenuation value (10 bits) = (SL << 2) << 3
;;static const UINT32 sl_table[16]=
;; {{
;; SC( 0) SC( 1) SC( 2) SC(3 ) SC(4 ) SC(5 ) SC(6 ) SC( 7)
;; SC( 8) SC( 9) SC(10) SC(11) SC(12) SC(13) SC(14) SC(31)
;; } ;
(let [SC (fn [db] (* db (/ 4.0 ENV_STEP)))]
(def sl_table (mapv SC (concat (range 15) [31]))))
(def RATE_STEPS 8)
(def eg_inc
;; dimension: 19*RATE_STEPS
;; cycle:0 1 2 3 4 5 6 7
[0 1 0 1 0 1 0 1 ;; rates 00..11 0 (increment by 0 or 1)
0 1 0 1 1 1 0 1 ;; rates 00..11 1
0 1 1 1 0 1 1 1 ;; rates 00..11 2
0 1 1 1 1 1 1 1 ;; rates 00..11 3
1 1 1 1 1 1 1 1 ;; rate 12 0 (increment by 1)
1 1 1 2 1 1 1 2 ;; rate 12 1
1 2 1 2 1 2 1 2 ;; rate 12 2
1 2 2 2 1 2 2 2 ;; rate 12 3
2 2 2 2 2 2 2 2 ;; rate 13 0 (increment by 2)
2 2 2 4 2 2 2 4 ;; rate 13 1
2 4 2 4 2 4 2 4 ;; rate 13 2
2 4 4 4 2 4 4 4 ;; rate 13 3
4 4 4 4 4 4 4 4 ;; rate 14 0 (increment by 4)
4 4 4 8 4 4 4 8 ;; rate 14 1
4 8 4 8 4 8 4 8 ;; rate 14 2
4 8 8 8 4 8 8 8 ;; rate 14 3
8 8 8 8 8 8 8 8 ;; rates 15 0 15 1 15 2 15 3 (increment by 8)
16 16 16 16 16 16 16 16 ;; rates 15 2 15 3 for attack
0 0 0 0 0 0 0 0 ] ;; infinity rates for attack and decay(s)
)
(let [O (fn [a] (* a RATE_STEPS))]
;;note that there is no 17) in this table - it's directly in the code
(def eg_rate_select
;; dimension: [32+64+32] Envelope Generator rates (32 + 64 rates + 32 RKS)
(mapv
O
[;; 32 infinite time rates (same as Rate 0)
18 18 18 18 18 18 18 18
18 18 18 18 18 18 18 18
18 18 18 18 18 18 18 18
18 18 18 18 18 18 18 18
18 18 0 0
0 0 2 2 ;; Nemesis's tests
0 1 2 3
0 1 2 3
0 1 2 3
0 1 2 3
0 1 2 3
0 1 2 3
0 1 2 3
0 1 2 3
0 1 2 3
0 1 2 3
;; rate 12
4 5 6 7
;; rate 13
8 9 10 11
;; rate 14
12 13 14 15
;; rate 15
16 16 16 16
;; 32 dummy rates (same as 15 3)
16 16 16 16 16 16 16 16
16 16 16 16 16 16 16 16
16 16 16 16 16 16 16 16
16 16 16 16 16 16 16 16])))
;;rate 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;shift 11 10 9 8 7 6 5 4 3 2 1 0 0 0 0 0
;;mask 2047 1023 511 255 127 63 31 15 7 3 1 0 0 0 0 0
;; dimension [32+64+32]
(def eg_rate_shift
[;; Envelope Generator counter shifts (32 + 64 rates + 32 RKS)
;; fixed (should be the same as rate 0 even if it makes no difference since increment value is 0 for these rates)
11 11 11 11 11 11 11 11
11 11 11 11 11 11 11 11
11 11 11 11 11 11 11 11
11 11 11 11 11 11 11 11
;; rates 00-11
11 11 11 11
10 10 10 10
9 9 9 9
8 8 8 8
7 7 7 7
6 6 6 6
5 5 5 5
4 4 4 4
3 3 3 3
2 2 2 2
1 1 1 1
0 0 0 0
;; rate 12
0 0 0 0
;; rate 13
0 0 0 0
;; rate 14
0 0 0 0
;; rate 15
0 0 0 0
;; 32 dummy rates (same as 15 3)
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0])
;; dimension: [4 * 32]=
(def dt_tab
[;; this is YM2151 and YM2612 phase increment data (in 10.10 fixed point format)
;; FD=0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
;; FD=1
0 0 0 0 1 1 1 1 1 1 1 1 2 2 2 2
2 3 3 3 4 4 4 5 5 6 6 7 8 8 8 8
;; FD=2
1 1 1 1 2 2 2 2 2 3 3 3 4 4 4 5
5 6 6 7 8 8 9 10 11 12 13 14 16 16 16 16
;; FD=3
2 2 2 2 2 3 3 3 4 4 4 5 5 6 6 7
8 8 9 10 11 12 13 14 16 17 19 20 22 22 22 22
])
;; OPN key frequency number -> key code follow table
;; fnum higher 4bit -> keycode lower 2bit
(def opn_fktable [0 0 0 0 0 0 0 1 2 3 3 3 3 3 3 3])
;; 8 LFO speed parameters
;; each value represents number of samples that one LFO level will last for
(def lfo_samples_per_step [108 77 71 67 62 44 8 5])
(def lfo_ams_depth_shift = [8 3 1 0])
;; register number to channel number , slot offset
(defn OPN_CHAN [N] (bit-and N 3))
(defn OPN_SLOT [N] (bit-and (bit-shift-right N 2) 3))
;; slot number
(defs
SLOT1 0
SLOT2 2
SLOT3 1
SLOT4 3)
;; struct describing a single operator (SLOT)
(defrecord FM_SLOT
[DT; ;; detune :dt_tab[DT]
KSR; ;; key scale rate :3-KSR
ar; ;; attack rate
d1r; ;; decay rate
d2r; ;; sustain rate
rr; ;; release rate
ksr; ;; key scale rate :kcode>>(3-KSR)
mul; ;; multiple :ML_TABLE[ML]
;; Phase Generator
phase; ;; phase counter
Incr; ;; phase step
;; Envelope Generator
state; ;; phase type
tl; ;; total level: TL << 3
volume; ;; envelope counter
sl; ;; sustain level:sl_table[SL]
vol_out; ;; current output from EG circuit (without AM from LFO)
eg_sh_ar; ;; (attack state)
eg_sel_ar; ;; (attack state)
eg_sh_d1r; ;; (decay state)
eg_sel_d1r; ;; (decay state)
eg_sh_d2r; ;; (sustain state)
eg_sel_d2r; ;; (sustain state)
eg_sh_rr; ;; (release state)
eg_sel_rr; ;; (release state)
ssg; ;; SSG-EG waveform
ssgn; ;; SSG-EG negated output
key; ;; 0=last key was KEY OFF, 1=KEY ON
;; LFO
AMmask; ;; AM enable flag
])
(defrecord FM_CH
[^FM_SLOT SLOT; ;; four SLOTs (operators)
ALGO; ;; algorithm
FB; ;; feedback shift
op1_out; ;; length 2, op1 output for feedback
connect1; ;; SLOT1 output pointer
connect3; ;; SLOT3 output pointer
connect2; ;; SLOT2 output pointer
connect4; ;; SLOT4 output pointer
mem_connect; ;; where to put the delayed sample (MEM)
mem_value; ;; delayed sample (MEM) value
pms; ;; channel PMS
ams; ;; channel AMS
fc; ;; fnum,blk
kcode; ;; key code
block_fnum; ;; blk/fnum value (for LFO PM calculations)
])
(defrecord FM_ST
[address; ;; address register
status; ;; status flag
mode; ;; mode CSM / 3SLOT
fn_h; ;; freq latch
TA; ;; timer a value
TAL; ;; timer a base
TAC; ;; timer a counter
TB; ;; timer b value
TBL; ;; timer b base
TBC; ;; timer b counter
dt_tab; [8][32]; ;; DeTune table
])
;;*********************************************************
;; OPN unit
;;*********************************************************
;; OPN 3slot struct
(defrecord FM_3SLOT
[fc;[3]; ;; fnum3,blk3: calculated
fn_h; ;; freq3 latch
kcode; [3]; ;; key code
block_fnum; [3]; ;; current fnum value for this slot (can be different betweeen slots of one channel in 3slot mode)
key_csm; ;; CSM mode Key-ON flag
])
;; OPN/A/B common state
(defrecord FM_OPN
[^FM_ST ST; ;; general state
^FM_3SLOT SL3; ;; 3 slot mode state
pan; [6*2]; ;; fm channels output masks (0xffffffff = enable)
;; EG
eg_cnt; ;; global envelope generator counter
eg_timer; ;; global envelope generator counter works at frequency = chipclock/144/3
;; LFO
lfo_cnt; ;; current LFO phase (out of 128)
lfo_timer; ;; current LFO phase runs at LFO frequency
lfo_timer_overflow; ;; LFO timer overflows every N samples (depends on LFO frequency)
LFO_AM; ;; current LFO AM step
LFO_PM; ;; current LFO PM step
])
;;*********************************************************
;; YM2612 chip
;;*********************************************************
(defrecord YM2612
[^FM_CH CH; [6]; ;; channel state
dacen; ;; DAC mode
dacout; ;; DAC output
^FM_OPN OPN; ;; OPN state
])
(defrecord State
[tl_tab sin_tab lfo_pm_table ^YM2612 ym2612
m2 c1 c2 ;; Phase Modulation input for operators 2,3,4
mem ;; one sample delay memory
out_fm ;; [8] ;; outputs of working channels
])
(defn update-volumes
[slot]
(let [{:keys [ar ksr volume s1]} slot
sus-or-dec (if (= s1 MIN_ATT_INDEX) EG_SUS EG_DEC)]
(if (< (+ ar ksr) 94)
(assoc slot :state (if (< volume MIN_ATT_INDEX)
sus-or-dec
EG_ATT))
(-> (assoc slot :volume MIN_ATT_INDEX)
(assoc :state sus-or-dec)))))
(defn update-eg
[slot]
(let [{:keys [ssg ssgn volume t1]} slot]
(assoc slot :vol_out (+ t1 (if (and (bit-and ssg 0x08) (bit-or ssgn (bit-and ssg 0x04)))
(bit-and (- 0x200 volume) MAX_ATT_INDEX)
volume)))))
(defn FM_KEYON
[state ^FM_CH ch s]
(let [slot (ch :SLOT s)]
(if (and (not (:key slot)) (not (-> state :ym2612 :OPN :SL3 :key_csm)))
(let [slot (-> slot
(assoc :phase 0)
(assoc :ssgn 0)
update-volumes
update-eg
(assoc :key y1))]
(assoc-in ch [:SLOT s] slot)))))
(defn FM_KEYOFF
[state ^FM_CH ch s]
(let [slot (ch :SLOT s)]
(if (and (:key slot) (not (-> state :ym2612 :OPN :SL3 :key_csm)))
(if (> (:state slot) EG_REL)
(assoc slot :state EG_REL))
(let [slot (-> slot
(assoc :phase 0)
(assoc :ssgn 0)
update-volumes
update-eg
(assoc :key y1))]
(assoc-in ch [:SLOT s] slot)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment