URL: https://linuxfr.org/users/guillaum/journaux/taptempo-en-brainfuck
Title: TapTempo en brainfuck
Authors: Guillaum
Date: 2018年03月03日T16:01:59+01:00
License: CC By-SA
Tags: brainfuck, taptempo et haskell
Score: 48
TapTempo est disponible en [version BrainFuck](https://github.com/guibou/TapTempo/tree/master/BrainFuck)
C'est un portage partiel (faut pas pousser ;), donc :
- Pas d'options
- Pas de localisation
- Pas de remise à zéro des samples
- Que deux samples
- N'importe quelle touche fonctionne (Pas seulement `<return>`)
Mais c'est tout de même une version Brainfuck qui fait son boulot :
```
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-] ++++++++++++++++++++++++++++++++.[-] [-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-] ++++++++++++++++++++++++++++++++.[-] [-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-] ++++++++++++++++++++++++++++++++.[-] [-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-] ++++++++++++++++++++++++++++++++.[-] [-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-] ++++++++++++++++++++++++++++++++.[-] [-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-] ++++++++++++++++++++++++++++++++.[-] [-]
++++++++++++++++++++++++++++++++++++++++.[-] [-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-] ++++++++++++++++++++++++++++++++.[-] [-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-] ++++++++++++++++++++++++++++++++.[-] [-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-] +++++++++++++++++++++++++++++++++++++++++.[-] [-]
++++++++++++++++++++++++++++++++++++++++++++++.[-] [-] ++++++++++.[-]
[-]
,-----------------------------------------------------------------------------------------------------------------[>[-]
++++++++.[-] [-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-] ++++++++++++++++++++++++++++++++.[-] [-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-] [-]
++++++++++++++++++++++++++++++++.[-] <<+>>[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>[-]
<<[>>+<<-]>>>[-]>[-]>[-]>[-] <<<<<[>>+<<-]>>[<[>>+>+<<<-]>>>[<<<+>>>-] <[>+ <<-[>>[-]>+<<<-]>>>[<<<+>>>-] <[<- [<<<->>>[-] ]+>-] <-] <<<+>>][-]>[-]>[-]>[-] <<<<[-] <[>>+>+<<<-]>>>[<<<+>>>-]<<+>[<->[>++++++++++<[->-[>+>>]>[+[-<+>]>+>>]<<<<<]>[-]
++++++++[<++++++>-]>[<<+>>-]>[<<+>>-]<<]>]<[->>++++++++[<++++++>-]]<[.[-] <]<[-] <strong>[-] ++++++++++++++++++++++++++++++++.[-] [-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-]
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]
[-] ++++++++++++++++++++++++++++++++++++++++++++++.[-] [-]
++++++++++.[-]
<,-----------------------------------------------------------------------------------------------------------------][-] +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-] [-] +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-] [-] ++++++++++++++++++++++++++++++++.[-] [-] ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-] [-] +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-] [-] ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-] [-] +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-] [-] +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-] [-] ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-] [-] ++++++++++++++++++++++++++++++++.[-] [-] +++++++++++++++++++++++++++++++++.[-] [-] ++++++++++.[-] ``` (Ce n'est pas du beau brainfuck, pas mal de duplication de code, pas vraiment réutilisable et non testé... J'ai honte) # Subtilités de la machine brainfuck Pour faire tourne ce code il faut une machine virtuelle brainfuck un peu particulière pour intégrer la gestion d'un compteur hardware de temps. Ma machine est équipée d'une mémoire infinie à droite et à gauche, cellules de 16 bits. Le registre `-1` est particulier, en effet, toute écriture sur celui-ci va provoque l'écriture sur le registre `0` d'un timer qui représente `5` fois le temps passé depuis la dernière écriture sur `-1` avec un minimum de `1`. Le facteur cinq étant pour avoir un peu de précision, mais pas trop, car le temps d'exécution est proportionnelle à la précision du compteur ;) Le minimum de 1 sert à éviter des divisions par 0 dans le code brainfuck. # Implémentation de la VM La machine virtuelle est écrite en Haskell dans le fichier [Bf.hs](https://github.com/guibou/TapTempo/blob/master/BrainFuck/Bf.hs) que nous allons détailler maintenant. ## Parsing du brainfuck Création d'un AST représentant les instructions brainfuck. J'ai juste ajouté une instruction `Debug` qui permet d'afficher l'état de la VM quand le code contient le caractère `!` : ```haskell data BrainFuck = Add &#124; Sub &#124; MemoryLeft &#124; MemoryRight &#124; Put &#124; Read &#124; Loop [BrainFuck] &#124; Comment Char &#124; Debug deriving (Show) ``` Le parseur est le suivant : ```haskell parseBf :: Parser BrainFuck parseBf = choice [ Add <$ char '+' , Sub <$ char '-' , MemoryLeft <$ char '<' , MemoryRight <$ char '>'
 , Put <$ char '.' , Read <$ char ',' , Loop <$> (char '[' *> many parseBf <* char ']') , Debug <$ char '!' , Comment <$> noneOf "+-<strong>.,[]"
 ]
parseProgram :: Parser Program
parseProgram = Program <$> many parseBf
```
Si une opération de parsing, comme `char '+'` réussie, le parseur renvoie `Add`. Je ne vous détaille pas trop, mais sachez que `<$` et `<$>` sont tellement habituels en Haskell que cela ne fait peur à personne, il s'agit "simplement" d'opérateurs représentant la fonction `map`.
## Bandeau de mémoire infinie
La mémoire est représentée par deux listes chaînées de `Word16` (int sur 16 bits), l'état actuelle des listes chaînées représentant la position actuelle sur le bandeau :
```haskell
data Memory = Memory [Word16] [Word16]
 deriving (Show)
```
S'en suit un ensemble de fonction servant à aller à droite, à gauche,
à écrire et lire la mémoire, rien de bien intéressant, c'est de
l'analyse de cas. Pour aller à droite :
```haskell
memoryToRight :: Memory -> Memory
memoryToRight (Memory l r) = case r of
 (x:xs) -> Memory (x:l) xs
 [] -> Memory (0:l) []
```
On prend un élément de la liste de droite pour le mettre dans la liste de gauche, mais si la liste de droite est vide, on met un 0 à la place. On aurait pu s'affranchir de ce cas en générant initialement une liste infinie de 0. C'est amusant ;)
## La Machine
Celle-ci contient une mémoire, un indice pour représenter la position et le compteur de temps :
```haskell
data Machine = Machine Memory Int (Maybe TimeSpec)
 deriving (Show)
```
Suivit de quelques fonctions pour aller à gauche / droite / modifier la mémoire. La fonction de modification contient un cas particulier pour le registre `-1` :
```haskell
modify :: (Word16 -> Word16) -> Machine -> IO (Machine)
modify f (Machine mem (-1) tM) = do
 t' <- getTime Monotonic let reg0Val = case tM of Nothing -> 0
 Just t -> fromIntegral ((fromIntegral precision * toNanoSecs (diffTimeSpec t t')) `div` (10 ^ (9 :: Integer)))
 -- value is bounded to 1 to avoid divid by zero
 pure (Machine (memoryModify f (memoryToLeft (memoryModify (const (max 1 reg0Val)) (memoryToRight mem)))) (-1) (Just t'))
modify f (Machine mem idx tM) = pure (Machine (memoryModify f mem) idx 
```
(Ce code est vraiment degeux, je n'ai fais aucun effort). Mais en gros, dans le cas `-1`, on calcul le delta de temps, on va un coup à droite pour le stocker, puis on revient à gauche.
## Exécution du programme
Cette partie est jolie car il s'agit simplement d'appeler la bonne fonction en fonction de l'instruction à exécuter :
```haskell
evalInstr :: Machine -> BrainFuck -> IO Machine
evalInstr m Add = modify (+1) m
evalInstr m Sub = modify (subtract 1) m
evalInstr m MemoryRight = pure (toRight m)
evalInstr m MemoryLeft = pure (toLeft m)
evalInstr m Read = do
 c <- getChar modify (const (fromIntegral (ord c))) m evalInstr m Put = do putChar (chr (fromIntegral (get m))) pure m evalInstr m loop@(Loop subInstrs) &#124; get m == 0 = pure m &#124; otherwise = do m' <- evalInstrs subInstrs m evalInstr m' loop evalInstr m (Comment _) = pure m evalInstr m Debug = print m>> pure m
```
Et voila. Ouf.
# Le programme brainfuck
Comment je l'ai écris, et bien à la main, mais avec quelques fonctions utilitaires contenues dans [TapTempoBf.hs](https://github.com/guibou/TapTempo/blob/master/BrainFuck/TapTempoBF.hs). D'ailleurs ce programme Haskell écrit le programme brainfuck sur sa sortie standard.
# Un exemple d'exécution ?
```
Appuyer sur une touche en cadence (q pour quitter).
Tempo : 300 bpm.
Tempo : 100 bpm.
Tempo : 100 bpm.
Tempo : 150 bpm.
Tempo : 50 bpm.
Tempo : 37 bpm.
Tempo : 25 bpm.
Tempo : 60 bpm.
Tempo : 300 bpm.
Tempo : 300 bpm.
Tempo : 300 bpm.
Tempo : 300 bpm.
Tempo : 300 bpm.
Tempo : 18 bpm.
qAu revoir
```
# Conclusion
C'était un défi, je l'ai fais, c'était amusant. Bon, je commence à avoir quelques notions de brainfuck (mon premier journal linuxfr datant d'il y a quelques centaines d'année parlait déja de brainfuck), donc voila, c'était marrant ;)
Ce qui serait bien c'est de faire une VM brainfuck un peu plus intelligente, car là c'est vraiment trop lent. En remplaçant les séries de "------" pour une unique opération, en détectant des motifs connus (comme l'affichage d'un caractère ou la division). C'est un travail que j'ai commencé il y a quelques temps et sur lequel je compte me remettre quand j'aurais du temps puisque mon but ultime c'est de réaliser un lancer de rayon en brainfuck ;)
</div><div class="naked_ctrl">
<form action="/index.cgi/contrast" method="get" name="gate">
<p><a href="http://altstyle.alfasado.net">AltStyle</a> によって変換されたページ <a href="httpS://linuxfr.org/users/guillaum/journaux/taptempo-en-brainfuck.md">(-&gt;オリジナル)</a>
/ <label>アドレス: <input type="text" name="naked_post_url" value="httpS://linuxfr.org/users/guillaum/journaux/taptempo-en-brainfuck.md" size="22" /></label> <label>モード: <select name="naked_post_mode">
<option value="default">デフォルト</option>
<option value="speech">音声ブラウザ</option>
<option value="ruby">ルビ付き</option>
<option value="contrast" selected="selected">配色反転</option>
<option value="larger-text">文字拡大</option>
<option value="mobile">モバイル</option>
</select>
<input type="submit" value="表示" />
</p>
</form>
</div>