module STM32.DAC
where
import Data.Word
import Data.Bits
import Device
import STM32.MachineInterface
import STM32.Utils
import qualified STM32.RCC as RCC (peripheralResetToggle)
data Config = Config {
_trigger :: Maybe Trigger
,_waveGeneration :: Maybe Wave
,_LFSRUnmask_TriangleAmplitude :: Either TriangleAmplitude LFSRUnmask
,_outputBuffer :: Bool
} deriving (Show,Eq)
defaultConfig :: Config
defaultConfig = Config {
_trigger = Nothing
,_waveGeneration = Nothing
,_LFSRUnmask_TriangleAmplitude = Right Bit0
,_outputBuffer = True
}
data Trigger
= T6_TRGO | T8_TRGO | T7_TRGO
| T5_TRGO | T2_TRGO | T4_TRGO | Ext_IT9 | Software
deriving (Show,Eq)
instance ToBitField Trigger where
toBitField t = case t of
T6_TRGO -> "000"
T8_TRGO -> "001"
T7_TRGO -> "010"
T5_TRGO -> "011"
T2_TRGO -> "100"
T4_TRGO -> "101"
Ext_IT9 -> "110"
Software -> "111"
data Wave = Noise | Triangle
deriving (Show,Eq)
data TriangleAmplitude
= Amplitude_1 | Amplitude_3 | Amplitude_7 | Amplitude_15
| Amplitude_31 | Amplitude_63
| Amplitude_127 | Amplitude_255 | Amplitude_511 | Amplitude_1023
| Amplitude_2047 | Amplitude_4095
deriving (Show,Eq)
instance ToBitField TriangleAmplitude where
toBitField t = case t of
Amplitude_1 -> "0000"
Amplitude_3 -> "0001"
Amplitude_7 -> "0010"
Amplitude_15 -> "0011"
Amplitude_31 -> "0100"
Amplitude_63 -> "0101"
Amplitude_127 -> "0110"
Amplitude_255 -> "0111"
Amplitude_511 -> "1000"
Amplitude_1023 -> "1001"
Amplitude_2047 -> "1010"
Amplitude_4095 -> "1011"
data LFSRUnmask
= Bit0 | Bits1 | Bits2 | Bits3 | Bits4 | Bits5 | Bits6 | Bits7
| Bits8 | Bits9 | Bits10 | Bits11
deriving (Show,Eq)
instance ToBitField LFSRUnmask where
toBitField t = case t of
Bit0 -> "0000"
Bits1 -> "0001"
Bits2 -> "0010"
Bits3 -> "0011"
Bits4 -> "0100"
Bits5 -> "0101"
Bits6 -> "0110"
Bits7 -> "0111"
Bits8 -> "1000"
Bits9 -> "1001"
Bits10 -> "1010"
Bits11 -> "1011"
data Channel = Channel_1 | Channel_2 deriving (Show,Eq)
data Align = Align_12b_R | Align_12b_L | Align_8b_R deriving (Show,Eq)
deInit :: MI ()
deInit = RCC.peripheralResetToggle DAC
init :: Channel -> Config -> MI ()
init channel config = do
let (tsel,wave,mamp,boff) = case channel of
Channel_1 -> (CR_TSEL1,CR_WAVE1,CR_MAMP1,CR_BOFF1)
Channel_2 -> (CR_TSEL2,CR_WAVE2,CR_MAMP2,CR_BOFF2)
regFieldWrite DAC tsel $ case _trigger config of
Nothing -> "000"
Just t -> toBitField t
regFieldWrite DAC wave $ case _waveGeneration config of
Nothing -> BitField [False,False]
Just Noise -> BitField [False,True]
Just Triangle -> BitField [True,False]
regFieldWrite DAC mamp $ case _LFSRUnmask_TriangleAmplitude config of
Right t -> toBitField t
Left t -> toBitField t
bitWrite DAC boff $ not $ _outputBuffer config
cmd :: Channel -> Bool -> MI ()
cmd Channel_1 rs = bitWrite DAC CR_EN1 rs
cmd Channel_2 rs = bitWrite DAC CR_EN2 rs
enable :: Channel -> MI ()
enable c = cmd c True
disable :: Channel -> MI ()
disable c = cmd c False
dmaCmd :: Channel -> Bool -> MI ()
dmaCmd Channel_1 rs = bitWrite DAC CR_DMAEN1 rs
dmaCmd Channel_2 rs = bitWrite DAC CR_DMAEN2 rs
enableDMA :: Channel -> MI ()
enableDMA c = dmaCmd c True
disableDMA :: Channel -> MI ()
disableDMA c = dmaCmd c False
softwareTriggerCmd :: Channel -> Bool -> MI ()
softwareTriggerCmd Channel_1 rs = bitWrite DAC SWTRIGR_SWTRIG1 rs
softwareTriggerCmd Channel_2 rs = bitWrite DAC SWTRIGR_SWTRIG2 rs
enableSoftwareTrigger :: Channel -> MI ()
enableSoftwareTrigger c = softwareTriggerCmd c True
disableSoftwareTrigger :: Channel -> MI ()
disableSoftwareTrigger c = softwareTriggerCmd c False
dualSoftwareTriggerCmd :: Bool -> MI ()
dualSoftwareTriggerCmd rs = do
softwareTriggerCmd Channel_1 rs
softwareTriggerCmd Channel_2 rs
enableDualSoftwareTrigger :: MI ()
enableDualSoftwareTrigger = dualSoftwareTriggerCmd True
disableDualSoftwareTrigger :: MI ()
disableDualSoftwareTrigger = dualSoftwareTriggerCmd False
waveGenerationCmd :: Channel -> (Maybe Wave) -> MI ()
waveGenerationCmd ch wave = regFieldWrite DAC register bits
where
register = case ch of
Channel_1 -> CR_WAVE1
Channel_2 -> CR_WAVE2
bits :: BitField
bits = case wave of
Nothing -> "00"
(Just Noise) -> "01"
(Just Triangle)-> "10"
disableWaveGeneration :: Channel -> MI ()
disableWaveGeneration ch = waveGenerationCmd ch Nothing
setChannel1Data :: Align -> Word16 -> MI ()
setChannel1Data align w = pokeReg DAC reg $ fromIntegral w
where
reg = case align of
Align_12b_R -> DHR12R1
Align_12b_L -> DHR12L1
Align_8b_R -> DHR8R1
setChannel2Data :: Align -> Word16 -> MI ()
setChannel2Data align w = pokeReg DAC reg $ fromIntegral w
where
reg = case align of
Align_12b_R -> DHR12R2
Align_12b_L -> DHR12L2
Align_8b_R -> DHR8R2
setDualChannelData :: Align -> Word16 -> Word16 -> MI ()
setDualChannelData align w1 w2
= pokeReg DAC reg $ (fromIntegral w1) .|. (byteSwap32 $ fromIntegral w2)
where
reg = case align of
Align_12b_R -> DHR12RD
Align_12b_L -> DHR12LD
Align_8b_R -> DHR8RD
getDataOutputValue :: Channel -> MI (Word16)
getDataOutputValue Channel_1 = fmap fromIntegral $ peekReg DAC DOR1
getDataOutputValue Channel_2 = fmap fromIntegral $ peekReg DAC DOR2
setChannel1 :: Word16 -> MI ()
setChannel1 = setChannel1Data Align_12b_R
setChannel2 :: Word16 -> MI ()
setChannel2 = setChannel2Data Align_12b_R
setDualChannel :: Word16 -> Word16 -> MI ()
setDualChannel = setDualChannelData Align_12b_R