├── .github └── workflows │ └── build.yml ├── .gitignore ├── .gitmodules ├── .ocamlformat ├── README.md ├── dune ├── dune-project ├── nes-ml.opam ├── nes-ml.opam.template ├── roms ├── games │ ├── arkanoid.nes │ ├── asterix.nes │ ├── bal.nes │ ├── castlevania.nes │ ├── challenger.nes │ ├── contra.nes │ ├── donk.nes │ ├── doughboy.nes │ ├── dragonslair.nes │ ├── ducktales.nes │ ├── ducktales2.nes │ ├── excite.nes │ ├── ghostngoblins.nes │ ├── ice.nes │ ├── indiana.nes │ ├── loderunner.nes │ ├── mario.nes │ ├── megaman.nes │ ├── meta_gear.nes │ ├── ninja.nes │ ├── popeye.nes │ ├── prince_of_persia.nes │ └── smurfs.nes └── tests │ ├── allpads.nes │ ├── blargg_ppu │ ├── palette_ram.nes │ ├── power_up_palette.nes │ ├── readme.txt │ ├── sprite_ram.nes │ └── vram_access.nes │ ├── color_test.nes │ ├── full_palette.nes │ ├── nestest.nes │ ├── oam_read.nes │ ├── oc.nes │ ├── palette.nes │ ├── rstrdemo.nes │ └── vbl_nmi_timing │ ├── 1.frame_basics.nes │ ├── 2.vbl_timing.nes │ └── 3.even_odd_frames.nes ├── screens ├── mario_bros.png ├── metal_gear.png └── prince_of_persia.png ├── src ├── apu.ml ├── apu.mli ├── common.ml ├── display.ml ├── display.mli ├── dune ├── gui.ml ├── gui.mli ├── infix_int.ml ├── input.ml ├── input.mli ├── input_movie.ml ├── input_sdl.ml ├── mapper.ml ├── mapper.mli ├── movie_format.ml ├── nes.ml ├── ppu.ml ├── ppu.mli ├── ppu_display.ml ├── rom.ml └── rom.mli └── tests ├── dune ├── inputs ├── mario.rec └── nestest.rec ├── roms ├── mario.nes └── nestest.nes ├── video_diffs.ml └── videos ├── mario.mp4 └── nestest.mp4 /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | # This is a basic workflow to help you get started with Actions 2 | 3 | name: build 4 | 5 | # Controls when the workflow will run 6 | on: 7 | # Triggers the workflow on push or pull request events but only for the main branch 8 | push: 9 | branches: [ main ] 10 | pull_request: 11 | branches: [ main ] 12 | 13 | # Allows you to run this workflow manually from the Actions tab 14 | workflow_dispatch: 15 | 16 | # A workflow run is made up of one or more jobs that can run sequentially or in parallel 17 | jobs: 18 | # This workflow contains a single job called "build" 19 | build: 20 | # The type of runner that the job will run on 21 | runs-on: ubuntu-latest 22 | 23 | # Steps represent a sequence of tasks that will be executed as part of the job 24 | steps: 25 | # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it 26 | - uses: actions/checkout@v3 27 | 28 | - name: Install packages 29 | run: | 30 | sudo apt-get update 31 | sudo apt-get install -y libsdl2-dev libsdl2-image-dev libsdl2-ttf-dev ffmpeg 32 | sudo apt-get install -y rsync bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools 33 | 34 | # Runs a single command using the runners shell 35 | - name: Setup OCaml switch 36 | uses: ocaml/setup-ocaml@v2 37 | with: 38 | ocaml-compiler: 4.14.0 39 | 40 | # Runs a set of commands using the runners shell 41 | - name: Pin and build package 42 | run: opam install -y . 43 | 44 | - name: Test ROMs 45 | run: opam exec -- dune test 46 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.sav 2 | _build 3 | *.sav* 4 | *.nes 5 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "roms/nes-test-roms"] 2 | path = roms/nes-test-roms 3 | url = https://github.com/christopherpow/nes-test-roms 4 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/.ocamlformat -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # nes-ml 2 | 3 |

4 | Mario Bros 5 | Metal Gear 6 | Prince of Persia 7 |

8 | 9 | A NES emulator from scratch in OCaml (and with sound). Still in development (see [development status](#development-status)). 10 | 11 | ![CI](https://github.com/Firobe/nes-ml/actions/workflows/build.yml/badge.svg) 12 | 13 | ## Build & Install 14 | 15 | Assuming you have `opam` installed with an existing switch, either: 16 | - add a pin to this repo: 17 | > `opam pin add nes-ml https://github.com/Firobe/nes-ml.git` 18 | 19 | - or clone and run 20 | > `opam install .` 21 | 22 | This will fetch the libraries (two of them are unreleased and will need pins), build and install the emulator. 23 | The executable name is `nes-ml`. 24 | 25 | Note: I recommend using a build with `flambda` activated for more performance. 26 | 27 | ## Usage 28 | 29 | Use : `nes-ml PATH_TO_ROM` 30 | 31 | See `nes-ml --help` for a list of useful options 32 | 33 | ### Controls (hard-coded) 34 | 35 | | Function | Keyboard key | 36 | | --- | --- | 37 | | A button | S | 38 | | B button | D | 39 | | Left arrow | ← | 40 | | Right arrow | → | 41 | | Up arrow | ↑ | 42 | | Down arrow | ↓ | 43 | | Start | ⏎ (return) | 44 | | Select | ⌫ (backspace) | 45 | | Toggle GUI | Escape | 46 | | Save state in slot `N` | `N` | 47 | | Load state from slot `N` | Shift+`N` | 48 | | Toggle debugging windows | Home | 49 | 50 | Note that the `N` for save states must be 1, 2 or 3. 51 | 52 | ## Development status 53 | 54 | - **Cycle-accurate CPU** (see [`6502-ml`](https://github.com/Firobe/6502-ml)) 55 | - **Cycle-accurate PPU** (graphics) (with rough edges) 56 | - Partially implemented cycle-accurate **APU** (sound) (with rough edges) 57 | - Multiple **save states** 58 | - Implemented mappers: 0, 2 59 | - Barebones GUI (with debugging windows showing the internal PPU state) 60 | - Movie (input log) recording and replaying (in custom format with subframe precision) 61 | - Ability to record video (lossless `mp4`) of runs with ffmpeg 62 | - Headless mode for automatic tests 63 | 64 | ## Next steps 65 | 66 | - Implement mappers 1, 4 67 | 68 | ## Based on 69 | 70 | - separate CPU library: [`6502-ml`](https://github.com/Firobe/6502-ml) 71 | - fixed-size int literals: [`stdint-literals`](https://github.com/Firobe/ocaml-stdint-literals) 72 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (target dune-linker) 3 | (enabled_if %{bin-available:lld}) 4 | (action 5 | (with-stdout-to 6 | dune-linker 7 | (echo "lld")))) 8 | 9 | (rule 10 | (target dune-linker) 11 | (enabled_if 12 | (= %{bin-available:lld} false)) 13 | (action 14 | (with-stdout-to 15 | dune-linker 16 | (echo "bfd")))) 17 | 18 | (env 19 | (dev 20 | (flags 21 | (:standard -ccopt=-fuse-ld=%{read:dune-linker}))) 22 | (dev 23 | (ocamlopt_flags 24 | (:standard -O3)))) 25 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.0) 2 | (name nes-ml) 3 | 4 | ; (version 1.0.0) 5 | 6 | (generate_opam_files true) 7 | 8 | (source (github Firobe/NES-ml)) 9 | (license MIT) 10 | (authors "Virgile Robles") 11 | (maintainers "virgile.robles@pm.me") 12 | 13 | (package 14 | (name nes-ml) 15 | (synopsis "Experimental NES emulator") 16 | (description "Experimental NES emulator") 17 | (depends 18 | 6502-ml 19 | tsdl 20 | stdint 21 | stdint-literals 22 | fpath 23 | bos 24 | digestif 25 | cmdliner 26 | bogue 27 | (dune :build))) 28 | -------------------------------------------------------------------------------- /nes-ml.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Experimental NES emulator" 4 | description: "Experimental NES emulator" 5 | maintainer: ["virgile.robles@pm.me"] 6 | authors: ["Virgile Robles"] 7 | license: "MIT" 8 | homepage: "https://github.com/Firobe/NES-ml" 9 | bug-reports: "https://github.com/Firobe/NES-ml/issues" 10 | depends: [ 11 | "6502-ml" 12 | "tsdl" 13 | "stdint" 14 | "stdint-literals" 15 | "fpath" 16 | "bos" 17 | "digestif" 18 | "cmdliner" 19 | "bogue" 20 | "dune" {>= "3.0" & build} 21 | "odoc" {with-doc} 22 | ] 23 | build: [ 24 | ["dune" "subst"] {dev} 25 | [ 26 | "dune" 27 | "build" 28 | "-p" 29 | name 30 | "-j" 31 | jobs 32 | "@install" 33 | "@runtest" {with-test} 34 | "@doc" {with-doc} 35 | ] 36 | ] 37 | dev-repo: "git+https://github.com/Firobe/NES-ml.git" 38 | pin-depends: [ 39 | ["6502-ml.dev" "git+https://github.com/Firobe/6502-ml.git"] 40 | ] 41 | -------------------------------------------------------------------------------- /nes-ml.opam.template: -------------------------------------------------------------------------------- 1 | pin-depends: [ 2 | ["6502-ml.dev" "git+https://github.com/Firobe/6502-ml.git"] 3 | ] 4 | -------------------------------------------------------------------------------- /roms/games/arkanoid.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/arkanoid.nes -------------------------------------------------------------------------------- /roms/games/asterix.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/asterix.nes -------------------------------------------------------------------------------- /roms/games/bal.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/bal.nes -------------------------------------------------------------------------------- /roms/games/castlevania.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/castlevania.nes -------------------------------------------------------------------------------- /roms/games/challenger.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/challenger.nes -------------------------------------------------------------------------------- /roms/games/contra.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/contra.nes -------------------------------------------------------------------------------- /roms/games/donk.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/donk.nes -------------------------------------------------------------------------------- /roms/games/doughboy.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/doughboy.nes -------------------------------------------------------------------------------- /roms/games/dragonslair.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/dragonslair.nes -------------------------------------------------------------------------------- /roms/games/ducktales.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/ducktales.nes -------------------------------------------------------------------------------- /roms/games/ducktales2.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/ducktales2.nes -------------------------------------------------------------------------------- /roms/games/excite.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/excite.nes -------------------------------------------------------------------------------- /roms/games/ghostngoblins.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/ghostngoblins.nes -------------------------------------------------------------------------------- /roms/games/ice.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/ice.nes -------------------------------------------------------------------------------- /roms/games/indiana.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/indiana.nes -------------------------------------------------------------------------------- /roms/games/loderunner.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/loderunner.nes -------------------------------------------------------------------------------- /roms/games/mario.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/mario.nes -------------------------------------------------------------------------------- /roms/games/megaman.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/megaman.nes -------------------------------------------------------------------------------- /roms/games/meta_gear.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/meta_gear.nes -------------------------------------------------------------------------------- /roms/games/ninja.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/ninja.nes -------------------------------------------------------------------------------- /roms/games/popeye.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/popeye.nes -------------------------------------------------------------------------------- /roms/games/prince_of_persia.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/prince_of_persia.nes -------------------------------------------------------------------------------- /roms/games/smurfs.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/games/smurfs.nes -------------------------------------------------------------------------------- /roms/tests/allpads.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/allpads.nes -------------------------------------------------------------------------------- /roms/tests/blargg_ppu/palette_ram.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/blargg_ppu/palette_ram.nes -------------------------------------------------------------------------------- /roms/tests/blargg_ppu/power_up_palette.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/blargg_ppu/power_up_palette.nes -------------------------------------------------------------------------------- /roms/tests/blargg_ppu/readme.txt: -------------------------------------------------------------------------------- 1 | NTSC NES PPU Tests 2 | ------------------ 3 | These ROMs test a few aspects of the NTSC NES PPU operation. They have been 4 | tested on an actual NES and all give a passing result. I wrote them to verify 5 | that my NES emulator's PPU was working properly. 6 | 7 | Each ROM runs several tests and reports a result code on screen and by beeping 8 | a number of times. A result code of 1 always indicates that all tests were 9 | passed; see below for the meaning of other codes for each test. 10 | 11 | The main source code for each test is included, and most tests are clearly 12 | divided into sections. Some of the common support code is included, but not 13 | all, since it runs on a custom setup. Contact me if you want to assemble the 14 | tests yourself. 15 | 16 | Shay Green (swap to e-mail) 17 | 18 | 19 | palette_ram 20 | ----------- 21 | PPU palette RAM read/write and mirroring test 22 | 23 | 1) Tests passed 24 | 2) Palette read shouldn't be buffered like other VRAM 25 | 3) Palette write/read doesn't work 26 | 4) Palette should be mirrored within $3f00-$3fff 27 | 5) Write to $10 should be mirrored at $00 28 | 6) Write to $00 should be mirrored at $10 29 | 30 | 31 | power_up_palette 32 | ---------------- 33 | Reports whether initial values in palette at power-up match those 34 | that my NES has. These values are probably unique to my NES. 35 | 36 | 1) Palette matches 37 | 2) Palette differs from table 38 | 39 | 40 | sprite_ram 41 | ---------- 42 | Tests sprite RAM access via $2003, $2004, and $4014 43 | 44 | 1) Tests passed 45 | 2) Basic read/write doesn't work 46 | 3) Address should increment on $2004 write 47 | 4) Address should not increment on $2004 read 48 | 5) Third sprite bytes should be masked with $e3 on read 49 | 6) $4014 DMA copy doesn't work at all 50 | 7) $4014 DMA copy should start at value in $2003 and wrap 51 | 8) $4014 DMA copy should leave value in $2003 intact 52 | 53 | 54 | vbl_clear_time 55 | -------------- 56 | The VBL flag ($2002.7) is cleared by the PPU around 2270 CPU clocks 57 | after NMI occurs. 58 | 59 | 1) Tests passed 60 | 2) VBL flag cleared too soon 61 | 3) VBL flag cleared too late 62 | 63 | 64 | vram_access 65 | ----------- 66 | Tests PPU VRAM read/write and internal read buffer operation 67 | 68 | 1) Tests passed 69 | 2) VRAM reads should be delayed in a buffer 70 | 3) Basic Write/read doesn't work 71 | 4) Read buffer shouldn't be affected by VRAM write 72 | 5) Read buffer shouldn't be affected by palette write 73 | 6) Palette read should also read VRAM into read buffer 74 | 7) "Shadow" VRAM read unaffected by palette transparent color mirroring 75 | -------------------------------------------------------------------------------- /roms/tests/blargg_ppu/sprite_ram.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/blargg_ppu/sprite_ram.nes -------------------------------------------------------------------------------- /roms/tests/blargg_ppu/vram_access.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/blargg_ppu/vram_access.nes -------------------------------------------------------------------------------- /roms/tests/color_test.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/color_test.nes -------------------------------------------------------------------------------- /roms/tests/full_palette.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/full_palette.nes -------------------------------------------------------------------------------- /roms/tests/nestest.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/nestest.nes -------------------------------------------------------------------------------- /roms/tests/oam_read.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/oam_read.nes -------------------------------------------------------------------------------- /roms/tests/oc.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/oc.nes -------------------------------------------------------------------------------- /roms/tests/palette.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/palette.nes -------------------------------------------------------------------------------- /roms/tests/rstrdemo.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/rstrdemo.nes -------------------------------------------------------------------------------- /roms/tests/vbl_nmi_timing/1.frame_basics.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/vbl_nmi_timing/1.frame_basics.nes -------------------------------------------------------------------------------- /roms/tests/vbl_nmi_timing/2.vbl_timing.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/vbl_nmi_timing/2.vbl_timing.nes -------------------------------------------------------------------------------- /roms/tests/vbl_nmi_timing/3.even_odd_frames.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/roms/tests/vbl_nmi_timing/3.even_odd_frames.nes -------------------------------------------------------------------------------- /screens/mario_bros.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/screens/mario_bros.png -------------------------------------------------------------------------------- /screens/metal_gear.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/screens/metal_gear.png -------------------------------------------------------------------------------- /screens/prince_of_persia.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/screens/prince_of_persia.png -------------------------------------------------------------------------------- /src/apu.ml: -------------------------------------------------------------------------------- 1 | open Infix_int.Common 2 | open Tsdl 3 | 4 | let dynamic_rate_control = true 5 | 6 | (* in Hz *) 7 | let master_freq = 21477272 8 | let cpu_freq = 1789773 9 | let main_divider = 89490 (* to obtain frame counter *) 10 | let cpu_divider = main_divider / (master_freq / cpu_freq) 11 | 12 | (* Adjust overall output volume *) 13 | let volume_modifier = 0.1 14 | 15 | module Divider = struct 16 | type t = { mutable length : int; mutable counter : int } 17 | 18 | let create length = { length; counter = length } 19 | let reload t = t.counter <- t.length 20 | let set_length t length = t.length <- length 21 | 22 | (* Returns if the divider clocks *) 23 | let clock t = 24 | if t.counter = 0 then ( 25 | reload t; 26 | true) 27 | else ( 28 | t.counter <- t.counter - 1; 29 | false) 30 | end 31 | 32 | module Sequencer = struct 33 | type t = { mutable length : int; mutable step : int } 34 | 35 | let create length = { length; step = 0 } 36 | let set_length t length = t.length <- length 37 | let clock t = t.step <- (t.step + 1) mod t.length 38 | let reset t = t.step <- 0 39 | let get t = t.step 40 | end 41 | 42 | module Counter = struct 43 | type t = { mutable counter : int; mutable halt : bool } 44 | 45 | let active t = t.counter > 0 46 | let load t v = t.counter <- v 47 | let update t halt = t.halt <- halt 48 | let reset t = t.counter <- 0 49 | let clock t = if (not t.halt) && t.counter > 0 then t.counter <- t.counter - 1 50 | let create () = { counter = 0; halt = true } 51 | end 52 | 53 | module Length_counter = struct 54 | include Counter 55 | 56 | let lengths = 57 | [| 58 | 10; 59 | 254; 60 | 20; 61 | 2; 62 | 40; 63 | 4; 64 | 80; 65 | 6; 66 | 160; 67 | 8; 68 | 60; 69 | 10; 70 | 14; 71 | 12; 72 | 26; 73 | 14; 74 | 12; 75 | 16; 76 | 24; 77 | 18; 78 | 48; 79 | 20; 80 | 96; 81 | 22; 82 | 192; 83 | 24; 84 | 72; 85 | 26; 86 | 16; 87 | 28; 88 | 32; 89 | 30; 90 | |] 91 | 92 | let load t v = load t lengths.(v) 93 | end 94 | 95 | module Envelope = struct 96 | type t = { 97 | mutable start : bool; 98 | mutable volume : int; 99 | mutable constant : bool; 100 | mutable decay : int; 101 | mutable loop : bool; 102 | divider : Divider.t; 103 | } 104 | 105 | let create () = 106 | { 107 | start = false; 108 | volume = 0; 109 | loop = false; 110 | constant = false; 111 | decay = 0; 112 | divider = Divider.create 0; 113 | } 114 | 115 | let set_constant t b = t.constant <- b 116 | let set_start t = t.start <- true 117 | let set_loop t b = t.loop <- b 118 | let set_volume t v = t.volume <- v 119 | 120 | let clock t = 121 | if t.start then ( 122 | t.start <- false; 123 | t.decay <- 15; 124 | Divider.set_length t.divider t.volume) 125 | else if Divider.clock t.divider then 126 | if t.decay = 0 && t.loop then t.decay <- 15 127 | else if t.decay > 0 then t.decay <- t.decay - 1 128 | 129 | let output t = if t.constant then t.volume else t.decay 130 | end 131 | 132 | module Sweep = struct 133 | type pulse_kind = Pulse1 | Pulse2 134 | 135 | type t = { 136 | divider : Divider.t; 137 | kind : pulse_kind; 138 | mutable shift_count : int; 139 | mutable target_period : int; 140 | mutable enabled : bool; 141 | mutable reload : bool; 142 | mutable negate_flag : bool; 143 | mutable current_period : int; 144 | } 145 | 146 | let muted t = t.target_period > 0x7FF 147 | 148 | let create kind = 149 | { 150 | divider = Divider.create 0; 151 | target_period = 0; 152 | current_period = 0; 153 | kind; 154 | shift_count = 0; 155 | enabled = false; 156 | negate_flag = false; 157 | reload = false; 158 | } 159 | 160 | let new_target t period = 161 | t.current_period <- period; 162 | let change_amount = period lsr t.shift_count in 163 | let change_amount = 164 | if t.negate_flag then 165 | match t.kind with 166 | | Pulse1 -> -change_amount - 1 167 | | Pulse2 -> -change_amount 168 | else change_amount 169 | in 170 | let target = period + change_amount in 171 | t.target_period <- target 172 | 173 | let write t v = 174 | t.enabled <- v land 0x80 <> 0; 175 | let period = (v lsr 4) land 0x7 in 176 | Divider.set_length t.divider period; 177 | t.negate_flag <- v land 0x8 <> 0; 178 | t.shift_count <- v land 0x7; 179 | t.reload <- true 180 | 181 | let clock t = 182 | if t.enabled && (not @@ muted t) && Divider.clock t.divider then ( 183 | t.reload <- false; 184 | new_target t t.target_period); 185 | if t.reload then ( 186 | Divider.reload t.divider; 187 | t.reload <- false) 188 | end 189 | 190 | module Pulse = struct 191 | let duties = 192 | [| 193 | [| 0; 1; 0; 0; 0; 0; 0; 0 |]; 194 | [| 0; 1; 1; 0; 0; 0; 0; 0 |]; 195 | [| 0; 1; 1; 1; 1; 0; 0; 0 |]; 196 | [| 1; 0; 0; 1; 1; 1; 1; 1 |]; 197 | |] 198 | 199 | type t = { 200 | timer : Divider.t; 201 | sequencer : Sequencer.t; 202 | length : Length_counter.t; 203 | sweep : Sweep.t; 204 | mutable duty_type : int; 205 | mutable enabled : bool; 206 | envelope : Envelope.t; 207 | } 208 | 209 | let create kind = 210 | { 211 | timer = Divider.create 0; 212 | sequencer = Sequencer.create 8; 213 | length = Length_counter.create (); 214 | duty_type = 0; 215 | sweep = Sweep.create kind; 216 | enabled = false; 217 | envelope = Envelope.create (); 218 | } 219 | 220 | let active t = Length_counter.active t.length 221 | 222 | let write0 t v = 223 | t.duty_type <- v lsr 6; 224 | let halt_loop = v land 0x20 <> 0 in 225 | let constant = v land 0x10 <> 0 in 226 | Envelope.set_constant t.envelope constant; 227 | Envelope.set_volume t.envelope (v land 0xF); 228 | Envelope.set_loop t.envelope halt_loop; 229 | Length_counter.update t.length halt_loop 230 | 231 | let update t v = 232 | t.enabled <- v; 233 | if not t.enabled then Length_counter.reset t.length 234 | 235 | let write1 t = Sweep.write t.sweep 236 | 237 | let write2 t v = 238 | let new_length = t.timer.length land 0x700 lor v in 239 | Divider.set_length t.timer new_length; 240 | Sweep.new_target t.sweep new_length 241 | 242 | let write3 t v = 243 | let new_length = t.timer.length land 0xFF lor ((v land 0x7) lsl 8) in 244 | Divider.set_length t.timer new_length; 245 | Sweep.new_target t.sweep new_length; 246 | Length_counter.load t.length (v lsr 3); 247 | Sequencer.reset t.sequencer; 248 | Envelope.set_start t.envelope 249 | 250 | let clock t = if Divider.clock t.timer then Sequencer.clock t.sequencer 251 | 252 | let frame_clock t = 253 | if t.enabled then Length_counter.clock t.length; 254 | Sweep.clock t.sweep; 255 | Divider.set_length t.timer t.sweep.current_period 256 | 257 | let output t = 258 | if 259 | t.timer.length >= 8 260 | && (not @@ Sweep.muted t.sweep) 261 | && Length_counter.active t.length 262 | then 263 | Envelope.output t.envelope 264 | * duties.(t.duty_type).(Sequencer.get t.sequencer) 265 | else 0 266 | end 267 | 268 | module Triangle = struct 269 | let sequence = 270 | [| 271 | 15; 272 | 14; 273 | 13; 274 | 12; 275 | 11; 276 | 10; 277 | 9; 278 | 8; 279 | 7; 280 | 6; 281 | 5; 282 | 4; 283 | 3; 284 | 2; 285 | 1; 286 | 0; 287 | 0; 288 | 1; 289 | 2; 290 | 3; 291 | 4; 292 | 5; 293 | 6; 294 | 7; 295 | 8; 296 | 9; 297 | 10; 298 | 11; 299 | 12; 300 | 13; 301 | 14; 302 | 15; 303 | |] 304 | 305 | type t = { 306 | mutable enabled : bool; 307 | timer : Divider.t; 308 | sequencer : Sequencer.t; 309 | length : Length_counter.t; 310 | linear_counter : Counter.t; 311 | mutable linear_reload : int; 312 | mutable control : bool; 313 | } 314 | 315 | let create () = 316 | { 317 | enabled = false; 318 | timer = Divider.create 0; 319 | sequencer = Sequencer.create 32; 320 | linear_counter = Counter.create (); 321 | length = Length_counter.create (); 322 | linear_reload = 0; 323 | control = false; 324 | } 325 | 326 | let active t = Length_counter.active t.length 327 | 328 | let update t v = 329 | t.enabled <- v; 330 | if not t.enabled then Length_counter.reset t.length 331 | 332 | let write_linear t v = 333 | let value = v land 0x7F in 334 | let control = v land 0x80 <> 0 in 335 | t.linear_reload <- value; 336 | Counter.load t.linear_counter value; 337 | Length_counter.update t.length control; 338 | t.control <- control 339 | 340 | let write_a t v = 341 | let new_length = t.timer.length land 0x700 lor v in 342 | Divider.set_length t.timer new_length 343 | 344 | let write_b t v = 345 | let new_length = t.timer.length land 0xFF lor ((v land 0x7) lsl 8) in 346 | Divider.set_length t.timer new_length; 347 | Length_counter.load t.length (v lsr 3); 348 | Sequencer.reset t.sequencer; 349 | t.linear_counter.halt <- false 350 | 351 | let clock t = 352 | if 353 | Divider.clock t.timer 354 | && Counter.active t.linear_counter 355 | && Length_counter.active t.length 356 | then Sequencer.clock t.sequencer 357 | 358 | let linear_frame_clock t = 359 | if t.linear_counter.halt then t.linear_counter.counter <- t.linear_reload 360 | else Counter.clock t.linear_counter; 361 | if not t.control then Counter.update t.linear_counter false 362 | 363 | let frame_clock t = if t.enabled then Length_counter.clock t.length 364 | let output t = sequence.(Sequencer.get t.sequencer) 365 | end 366 | 367 | (* Linear Feedback Shift Register *) 368 | module LFSR = struct 369 | type t = { mutable register : U16.t; mutable mode : bool } 370 | 371 | let create () = { register = U16.one; mode = false } 372 | let set_mode t b = t.mode <- b 373 | 374 | let active t = 375 | let open U16 in 376 | t.register $& 1U = 0U 377 | 378 | let feedback t = 379 | let open U16 in 380 | let b0 = t.register $& 1U in 381 | let n = if t.mode then 6 else 1 in 382 | let bn = t.register $>> n $& 1U in 383 | b0 $^ bn = 1U 384 | 385 | let clock t = 386 | let open U16 in 387 | let feedback = feedback t in 388 | t.register <- t.register $>> 1; 389 | if feedback then t.register <- t.register $| 0x4000U 390 | end 391 | 392 | module Noise = struct 393 | type t = { 394 | length : Length_counter.t; 395 | timer : Divider.t; 396 | lfsr : LFSR.t; 397 | mutable enabled : bool; 398 | envelope : Envelope.t; 399 | } 400 | 401 | let create () = 402 | { 403 | length = Length_counter.create (); 404 | timer = Divider.create 0; 405 | lfsr = LFSR.create (); 406 | enabled = false; 407 | envelope = Envelope.create (); 408 | } 409 | 410 | let update t v = 411 | t.enabled <- v; 412 | if not t.enabled then Length_counter.reset t.length 413 | 414 | let active t = Length_counter.active t.length 415 | 416 | let periods = 417 | [| 418 | 4; 8; 16; 32; 64; 96; 128; 160; 202; 254; 380; 508; 762; 1016; 2034; 4068; 419 | |] 420 | 421 | let write_c t v = 422 | let halt_loop = v land 0x20 <> 0 in 423 | let constant = v land 0x10 <> 0 in 424 | Envelope.set_constant t.envelope constant; 425 | Envelope.set_loop t.envelope halt_loop; 426 | Envelope.set_volume t.envelope (v land 0xF); 427 | Length_counter.update t.length halt_loop 428 | 429 | let write_e t v = 430 | Divider.set_length t.timer periods.(0xF land v); 431 | LFSR.set_mode t.lfsr (v land 0x80 <> 0) 432 | 433 | let write_f t v = 434 | Length_counter.load t.length (v lsr 3); 435 | Envelope.set_start t.envelope 436 | 437 | let frame_clock t = if t.enabled then Length_counter.clock t.length 438 | 439 | let output t = 440 | if LFSR.active t.lfsr && Length_counter.active t.length then 441 | Envelope.output t.envelope 442 | else 0 443 | 444 | let clock t = if Divider.clock t.timer then LFSR.clock t.lfsr 445 | end 446 | 447 | module DMC = struct 448 | type t = { mutable enabled : bool; mutable output_level : int } 449 | 450 | let create () = { enabled = false; output_level = 0 } 451 | let write0 _ _ = () 452 | let write1 t v = t.output_level <- v land 0x7F 453 | let write2 _ _ = () 454 | let write3 _ _ = () 455 | let output t = t.output_level 456 | end 457 | 458 | module Frame_counter = struct 459 | module Event = struct 460 | type t = O | E | EL | ELF 461 | 462 | let is_e t = t <> O 463 | let is_l = function EL | ELF -> true | _ -> false 464 | let is_f t = t = ELF 465 | end 466 | 467 | let mode1 = Event.[| E; EL; E; ELF |] 468 | let mode2 = Event.[| EL; E; EL; E; O |] 469 | 470 | type t = { 471 | divider : Divider.t; 472 | sequencer : Sequencer.t; 473 | mutable mode : bool; 474 | mutable frame_interrupt : bool; 475 | } 476 | 477 | let create () = 478 | { 479 | divider = Divider.create cpu_divider; 480 | sequencer = Sequencer.create 4; 481 | mode = false; 482 | frame_interrupt = false; 483 | } 484 | 485 | let collector_id = "apu_frame_counter" 486 | 487 | let clear_interrupt t collector = 488 | t.frame_interrupt <- false; 489 | C6502.IRQ_collector.set_pulled collector collector_id false 490 | 491 | let write t collector v = 492 | Divider.reload t.divider; 493 | Sequencer.reset t.sequencer; 494 | let mode = v lsr 7 <> 0 in 495 | t.mode <- mode; 496 | if v lsr 6 <> 0 then clear_interrupt t collector; 497 | Sequencer.set_length t.sequencer (if mode then 5 else 4); 498 | Sequencer.clock t.sequencer 499 | 500 | let action t (pulse1, pulse2, triangle, noise) collector = 501 | let mode_array = if t.mode then mode2 else mode1 in 502 | let event = mode_array.(Sequencer.get t.sequencer) in 503 | if Event.is_e event then ( 504 | Triangle.linear_frame_clock triangle; 505 | Envelope.clock Pulse.(pulse1.envelope); 506 | Envelope.clock Pulse.(pulse2.envelope); 507 | Envelope.clock Noise.(noise.envelope)); 508 | if Event.is_l event then ( 509 | Pulse.frame_clock pulse1; 510 | Pulse.frame_clock pulse2; 511 | Triangle.frame_clock triangle; 512 | Noise.frame_clock noise); 513 | t.frame_interrupt <- Event.is_f event; 514 | C6502.IRQ_collector.set_pulled collector collector_id t.frame_interrupt 515 | 516 | let clock t units collector = 517 | if Divider.clock t.divider then ( 518 | Sequencer.clock t.sequencer; 519 | action t units collector) 520 | end 521 | 522 | module type Backend = sig 523 | type t 524 | 525 | val create : unit -> t 526 | val delete : t -> unit 527 | val get_queued : t -> int 528 | val queue_audio : t -> ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t -> unit 529 | val sampling_freq : t -> int 530 | end 531 | 532 | module Make_Resampler (A : Backend) = struct 533 | type t = { 534 | backend : A.t; 535 | sampling_freq : float; 536 | mutable fb : 537 | (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t; 538 | (* frame buffer *) 539 | mutable fb_length : int; 540 | mutable history : float array; (* 4 last values *) 541 | mutable mu : float; 542 | mutable ratio : float; 543 | max_delta : float; 544 | } 545 | 546 | (* enough to store samples for two frames at 44100 Hz *) 547 | let fb_capacity = 2048 548 | 549 | let create backend cli_flags = 550 | { 551 | backend; 552 | sampling_freq = float_of_int (A.sampling_freq backend); 553 | fb = Bigarray.Array1.create Bigarray.Float32 Bigarray.c_layout fb_capacity; 554 | fb_length = 0; 555 | history = Array.make 4 0.; 556 | mu = 0.; 557 | ratio = float_of_int cpu_freq /. float_of_int (A.sampling_freq backend); 558 | max_delta = (if cli_flags.Common.uncap_speed then 0.5 else 0.005); 559 | } 560 | 561 | (* Return 0. if queue empty 1. if >= max_queue_size *) 562 | let fill_level t = 563 | let max_queue_size = 8192 in 564 | let current = min (A.get_queued t.backend) max_queue_size in 565 | float_of_int current /. float_of_int max_queue_size 566 | 567 | let update_frequency t = 568 | let fill_level = fill_level t in 569 | let cpu_freq = float_of_int cpu_freq in 570 | let base_ratio = cpu_freq /. t.sampling_freq in 571 | let coef = 1. -. t.max_delta +. (2. *. fill_level *. t.max_delta) in 572 | let target_ratio = base_ratio *. coef in 573 | t.ratio <- target_ratio 574 | 575 | let append t value = 576 | if t.fb_length < fb_capacity then ( 577 | t.fb.{t.fb_length} <- value; 578 | t.fb_length <- t.fb_length + 1) 579 | 580 | (* Cubic interpolation *) 581 | let buffer_next t value = 582 | t.history.(0) <- t.history.(1); 583 | t.history.(1) <- t.history.(2); 584 | t.history.(2) <- t.history.(3); 585 | t.history.(3) <- value; 586 | while t.mu <= 1.0 do 587 | let a = 588 | t.history.(3) -. t.history.(2) -. t.history.(0) +. t.history.(1) 589 | in 590 | let b = t.history.(0) -. t.history.(1) -. a in 591 | let c = t.history.(2) -. t.history.(0) in 592 | let d = t.history.(1) in 593 | append t 594 | ((a *. t.mu *. t.mu *. t.mu) +. (b *. t.mu *. t.mu) +. (c *. t.mu) +. d); 595 | t.mu <- t.mu +. t.ratio 596 | done; 597 | t.mu <- t.mu -. 1.0 598 | 599 | let resample t = 600 | let res = Bigarray.Array1.sub t.fb 0 t.fb_length in 601 | t.fb_length <- 0; 602 | if dynamic_rate_control then update_frequency t; 603 | res 604 | end 605 | 606 | module type S = sig 607 | type t 608 | 609 | val create : C6502.IRQ_collector.t -> Common.cli_flags -> t 610 | val next_cycle : t -> unit 611 | val output_frame : t -> unit 612 | val write_register : t -> Stdint.uint8 -> Stdint.uint16 -> unit 613 | val read_register : t -> Stdint.uint16 -> Stdint.uint8 614 | val exit : t -> unit 615 | end 616 | 617 | module Make (A : Backend) : S = struct 618 | module Resampler = Make_Resampler (A) 619 | 620 | type t = { 621 | frame_counter : Frame_counter.t; 622 | pulse1 : Pulse.t; 623 | pulse2 : Pulse.t; 624 | triangle : Triangle.t; 625 | resampler : Resampler.t; 626 | half_clock : Divider.t; 627 | noise : Noise.t; 628 | dmc : DMC.t; 629 | backend : A.t; 630 | collector : C6502.IRQ_collector.t; 631 | } 632 | 633 | let create collector cli_flags = 634 | let backend = A.create () in 635 | { 636 | frame_counter = Frame_counter.create (); 637 | pulse1 = Pulse.create Sweep.Pulse1; 638 | pulse2 = Pulse.create Sweep.Pulse2; 639 | triangle = Triangle.create (); 640 | resampler = Resampler.create backend cli_flags; 641 | half_clock = Divider.create 1; 642 | noise = Noise.create (); 643 | dmc = DMC.create (); 644 | collector; 645 | backend; 646 | } 647 | 648 | let write_register t v r = 649 | let open Stdint in 650 | let v = Uint8.to_int v in 651 | let r = Uint16.to_int r in 652 | match r with 653 | | 0x4000 -> Pulse.write0 t.pulse1 v 654 | | 0x4001 -> Pulse.write1 t.pulse1 v 655 | | 0x4002 -> Pulse.write2 t.pulse1 v 656 | | 0x4003 -> Pulse.write3 t.pulse1 v 657 | | 0x4004 -> Pulse.write0 t.pulse2 v 658 | | 0x4005 -> Pulse.write1 t.pulse2 v 659 | | 0x4006 -> Pulse.write2 t.pulse2 v 660 | | 0x4007 -> Pulse.write3 t.pulse2 v 661 | | 0x4008 -> Triangle.write_linear t.triangle v 662 | | 0x400A -> Triangle.write_a t.triangle v 663 | | 0x400B -> Triangle.write_b t.triangle v 664 | | 0x400C -> Noise.write_c t.noise v 665 | | 0x400E -> Noise.write_e t.noise v 666 | | 0x400F -> Noise.write_f t.noise v 667 | | 0x4010 -> DMC.write0 t.dmc v 668 | | 0x4011 -> DMC.write1 t.dmc v 669 | | 0x4012 -> DMC.write2 t.dmc v 670 | | 0x4013 -> DMC.write3 t.dmc v 671 | | 0x4015 -> 672 | (* status *) 673 | let e_pulse1 = v land 0x1 <> 0 in 674 | let e_pulse2 = v land 0x2 <> 0 in 675 | let e_triangle = v land 0x4 <> 0 in 676 | let e_noise = v land 0x8 <> 0 in 677 | let _e_dmc = v land 0x10 <> 0 in 678 | Pulse.update t.pulse1 e_pulse1; 679 | Pulse.update t.pulse2 e_pulse2; 680 | Triangle.update t.triangle e_triangle; 681 | Noise.update t.noise e_noise 682 | (* TODO update other stuff *) 683 | | 0x4017 -> Frame_counter.write t.frame_counter t.collector v 684 | | _ -> () 685 | 686 | let read_register t r = 687 | if Stdint.Uint16.to_int r = 0x4015 then ( 688 | let iob n b = if b then 1 lsl n else 0 in 689 | let a_pulse1 = Pulse.active t.pulse1 |> iob 0 in 690 | let a_pulse2 = Pulse.active t.pulse1 |> iob 1 in 691 | let a_triangle = Triangle.active t.triangle |> iob 2 in 692 | let a_noise = Noise.active t.noise |> iob 3 in 693 | let interrupt = t.frame_counter.frame_interrupt |> iob 6 in 694 | Frame_counter.clear_interrupt t.frame_counter t.collector; 695 | a_pulse1 lor a_pulse2 lor interrupt lor a_triangle lor a_noise 696 | |> Stdint.Uint8.of_int 697 | (* TODO other bits *)) 698 | else failwith "Read invalid APU register" 699 | 700 | let mixer t = 701 | let pulse1 = float_of_int @@ Pulse.output t.pulse1 in 702 | let pulse2 = float_of_int @@ Pulse.output t.pulse2 in 703 | let triangle = float_of_int @@ Triangle.output t.triangle in 704 | let noise = float_of_int @@ Noise.output t.noise in 705 | let dmc = float_of_int @@ DMC.output t.dmc in 706 | let pulse_out = 95.88 /. ((8128. /. (pulse1 +. pulse2)) +. 100.) in 707 | let tnd_factor = 708 | (triangle /. 8227.) +. (noise /. 12241.) +. (dmc /. 22638.) 709 | in 710 | let tnd_out = 159.79 /. ((1. /. tnd_factor) +. 100.) in 711 | let out_raw = pulse_out +. tnd_out in 712 | (* [0. - 1.] *) 713 | out_raw *. volume_modifier 714 | 715 | let next_cycle t = 716 | (* Clock pulse timers *) 717 | if Divider.clock t.half_clock then ( 718 | Frame_counter.clock t.frame_counter 719 | (t.pulse1, t.pulse2, t.triangle, t.noise) 720 | t.collector; 721 | Pulse.clock t.pulse1; 722 | Pulse.clock t.pulse2; 723 | Noise.clock t.noise); 724 | Triangle.clock t.triangle; 725 | Resampler.buffer_next t.resampler (mixer t) 726 | 727 | let output_frame t = 728 | let buffer = Resampler.resample t.resampler in 729 | A.queue_audio t.backend buffer 730 | 731 | let exit t = A.delete t.backend 732 | end 733 | 734 | module Normal_backend : Backend = struct 735 | type t = { device : int32; sampling_freq : int } 736 | 737 | let create () = 738 | match Sdl.init Sdl.Init.audio with 739 | | Error (`Msg e) -> 740 | Printf.printf "Error while initializing audio device %s" e; 741 | assert false 742 | | Ok () -> 743 | (); 744 | let audio_spec = 745 | { 746 | Sdl.as_freq = 44100; 747 | as_format = Sdl.Audio.f32; 748 | as_channels = 1; 749 | as_silence = 0; 750 | as_samples = 1024; 751 | as_size = Int32.zero; 752 | as_callback = None; 753 | } 754 | in 755 | let dev, have = 756 | match 757 | Sdl.open_audio_device None false audio_spec 758 | Sdl.Audio.allow_frequency_change 759 | with 760 | | Error (`Msg e) -> 761 | Printf.printf "Error while opening audio device: %s\n" e; 762 | assert false 763 | | Ok h -> h 764 | in 765 | Sdl.pause_audio_device dev false; 766 | { sampling_freq = have.as_freq; device = dev } 767 | 768 | let delete t = Sdl.close_audio_device t.device 769 | let get_queued t = Sdl.get_queued_audio_size t.device 770 | let sampling_freq t = t.sampling_freq 771 | 772 | let queue_audio t data = 773 | match Sdl.queue_audio t.device data with 774 | | Ok () -> () 775 | | Error (`Msg e) -> 776 | Printf.printf "Error when pushing samples: %s\n" e; 777 | assert false 778 | end 779 | 780 | module Dummy_backend : Backend = struct 781 | type t = unit 782 | 783 | let create () = () 784 | let delete () = () 785 | let get_queued () = 4000 786 | let sampling_freq () = 44100 787 | let queue_audio () _ = () 788 | end 789 | 790 | include Make (Normal_backend) 791 | -------------------------------------------------------------------------------- /src/apu.mli: -------------------------------------------------------------------------------- 1 | (** Emulate and interface with an APU chip. 2 | 3 | The emulated APU will output sound automatically when cycled through. The sound 4 | will be fine only if the chip is cycled through at the appropriate frequency. 5 | *) 6 | 7 | module type Backend 8 | 9 | module Normal_backend : Backend 10 | module Dummy_backend : Backend 11 | 12 | module type S = sig 13 | type t 14 | 15 | val create : C6502.IRQ_collector.t -> Common.cli_flags -> t 16 | (** Create the emulated chip, given a collector to communicate IRQs with the 17 | * CPU. Also initialize the sound backend. *) 18 | 19 | val next_cycle : t -> unit 20 | (** Emulate next cycle of the chip *) 21 | 22 | val output_frame : t -> unit 23 | (** Output actual audio to the backend for the last frame *) 24 | 25 | val write_register : t -> Stdint.uint8 -> Stdint.uint16 -> unit 26 | (** Emulate writing a value at an address of the APU *) 27 | 28 | val read_register : t -> Stdint.uint16 -> Stdint.uint8 29 | (** Similar, for reading *) 30 | 31 | val exit : t -> unit 32 | (** Release the sound backend *) 33 | end 34 | 35 | module Make (_ : Backend) : S 36 | -------------------------------------------------------------------------------- /src/common.ml: -------------------------------------------------------------------------------- 1 | type cli_flags = { uncap_speed : bool; save_mp4 : string option } 2 | type set_pixel = x:int -> y:int -> color:Stdint.uint8 -> unit 3 | 4 | exception End_of_movie 5 | -------------------------------------------------------------------------------- /src/display.ml: -------------------------------------------------------------------------------- 1 | module type S = sig 2 | type t 3 | 4 | val init : unit -> unit 5 | val exit : unit -> unit 6 | 7 | val create : 8 | width:int -> 9 | height:int -> 10 | scale:int -> 11 | palette:int list -> 12 | ?vsync:bool -> 13 | ?save:string -> 14 | string -> 15 | t 16 | 17 | val delete : t -> unit 18 | val clear : t -> Stdint.uint8 -> unit 19 | val get_window : t -> Tsdl.Sdl.window 20 | val set_pixel : t -> x:int -> y:int -> color:Stdint.uint8 -> unit 21 | val render : ?after:(unit -> unit) -> t -> unit 22 | end 23 | 24 | let sdl_get = function 25 | | Error (`Msg m) -> failwith m 26 | | Error _ -> failwith "Unknown SDL error encountered" 27 | | Ok obj -> obj 28 | 29 | let prepare_record_dir save = 30 | match save with 31 | | None -> None 32 | | Some out_path -> ( 33 | match Bos.OS.Dir.tmp "nes-ml-recording%s" with 34 | | Ok path -> 35 | Printf.printf "Recording frames in %s\n%!" (Fpath.to_string path); 36 | Some (path, out_path) 37 | | Error _ -> 38 | Printf.printf "Couldn't create a temp dir\n%!"; 39 | None) 40 | 41 | let save_mp4 dir out = 42 | let in_pat = Fpath.(dir / "%d.bmp" |> to_string) in 43 | let cmd = 44 | Bos.Cmd.( 45 | v "ffmpeg" % "-loglevel" % "error" % "-f" % "image2" % "-framerate" % "60" 46 | % "-i" % in_pat % "-c:v" % "libx264" % "-crf" % "0" % "-y" % "-vf" 47 | % "scale=1024:-1:flags=neighbor" % out) 48 | in 49 | match Bos.OS.Cmd.run cmd with 50 | | Ok () -> Printf.printf "Saved movie to %s\n" out 51 | | Error _ -> Printf.printf "Couldn't save the movie!\n" 52 | 53 | let save_texture pixels filename = 54 | let open Tsdl in 55 | let surface = 56 | sdl_get 57 | @@ Sdl.create_rgb_surface_from ~w:256 ~h:240 ~depth:32 ~pitch:256 pixels 0l 58 | 0l 0l 0l 59 | in 60 | let filename = Fpath.to_string filename in 61 | sdl_get @@ Sdl.save_bmp surface filename 62 | 63 | module Headless_backend = struct 64 | open Bigarray 65 | open Stdint 66 | 67 | type t = { 68 | screen : (int32, int32_elt, c_layout) Array1.t; 69 | record : (Fpath.t * string) option; 70 | (* name of directory where to save frames, and 71 | output file *) 72 | palette : int32 array; 73 | width : int; 74 | mutable frame : int; 75 | } 76 | 77 | let render ?after t = 78 | ignore after; 79 | (match t.record with 80 | | None -> () 81 | | Some (path, _) -> 82 | let frame_name = Printf.sprintf "%d.bmp" t.frame in 83 | let frame_path = Fpath.(path / frame_name) in 84 | save_texture t.screen frame_path); 85 | t.frame <- t.frame + 1 86 | 87 | let get_window _ = failwith "No window in headless mode" 88 | 89 | let create ~width ~height ~scale ~palette ?(vsync = true) ?save _ = 90 | ignore (scale, palette, vsync); 91 | let screen = Array1.create Int32 c_layout (width * height) in 92 | let record = prepare_record_dir save in 93 | let palette = Array.of_list (List.map Int32.of_int palette) in 94 | { screen; record; palette; width; frame = 0 } 95 | 96 | let init () = () 97 | let exit () = () 98 | 99 | let delete t = 100 | match t.record with Some (path, out) -> save_mp4 path out | None -> () 101 | 102 | let set_pixel t ~x ~y ~(color : uint8) = 103 | let ind = Uint8.to_int color mod 64 in 104 | let color = t.palette.(ind) in 105 | t.screen.{(y * t.width) + x} <- color 106 | 107 | let clear t back_color = 108 | let rgb_color = t.palette.(Uint8.to_int back_color mod 64) in 109 | Array1.fill t.screen rgb_color 110 | end 111 | 112 | module Sdl_backend = struct 113 | module H = Headless_backend 114 | open Tsdl 115 | open Bigarray 116 | open Stdint 117 | 118 | type t = { 119 | core : H.t; 120 | renderer : Sdl.renderer; 121 | window : Sdl.window; 122 | texture : Sdl.texture; 123 | width : int; 124 | height : int; 125 | scale : int; 126 | vsync : bool; 127 | } 128 | 129 | let get_window t = t.window 130 | 131 | let create ~width ~height ~scale ~palette ?(vsync = true) ?save title = 132 | let core = H.create ~width ~height ~scale ~palette ~vsync ?save title in 133 | let s_width = scale * width in 134 | let s_height = scale * height in 135 | let window = 136 | sdl_get 137 | @@ Sdl.create_window ~w:s_width ~h:s_height title Sdl.Window.opengl 138 | in 139 | let flags = Sdl.Renderer.accelerated in 140 | let renderer = sdl_get @@ Sdl.create_renderer ~flags window in 141 | let () = 142 | sdl_get @@ Sdl.set_render_draw_blend_mode renderer Sdl.Blend.mode_blend 143 | in 144 | let texture = 145 | sdl_get 146 | @@ Sdl.create_texture renderer Sdl.Pixel.format_rgb888 147 | Sdl.Texture.access_streaming ~w:width ~h:height 148 | in 149 | { renderer; window; texture; width; height; scale; vsync; core } 150 | 151 | let delete t = 152 | H.delete t.core; 153 | Sdl.destroy_texture t.texture; 154 | Sdl.destroy_renderer t.renderer; 155 | Sdl.destroy_window t.window 156 | 157 | let set_pixel t = H.set_pixel t.core 158 | let clear t = H.clear t.core 159 | 160 | module FPS = struct 161 | let target = 60.0988 (* NTSC *) 162 | let cps = Sdl.get_performance_frequency () 163 | let delta = 1. /. target *. Int64.to_float cps |> Int64.of_float 164 | let next_time = ref Int64.zero 165 | 166 | let wait_next_frame () = 167 | let now = Sdl.get_performance_counter () in 168 | if !next_time = Int64.zero then next_time := now; 169 | if now < !next_time then 170 | let to_wait = 171 | Int64.((!next_time - now) * 1000L / cps) |> Int32.of_int64 172 | in 173 | Sdl.delay to_wait 174 | else next_time := now; 175 | next_time := Int64.(!next_time + delta) 176 | end 177 | 178 | let render ?(after = fun () -> ()) t = 179 | let pixels, _ = sdl_get @@ Sdl.lock_texture t.texture None Int32 in 180 | Array1.blit t.core.screen pixels; 181 | Sdl.unlock_texture t.texture; 182 | sdl_get @@ Sdl.render_copy t.renderer t.texture; 183 | after (); 184 | H.render t.core; 185 | if t.vsync then FPS.wait_next_frame (); 186 | Sdl.render_present t.renderer 187 | 188 | let init () = sdl_get @@ Sdl.init Sdl.Init.video 189 | let exit () = Sdl.quit () 190 | end 191 | -------------------------------------------------------------------------------- /src/display.mli: -------------------------------------------------------------------------------- 1 | (** SDL backend for displaying the emulator buffer and updating pixels *) 2 | 3 | module type S = sig 4 | type t 5 | 6 | val init : unit -> unit 7 | (** Initialize the backend (must be called once) *) 8 | 9 | val exit : unit -> unit 10 | (** Release the backend *) 11 | 12 | val create : 13 | width:int -> 14 | height:int -> 15 | scale:int -> 16 | palette:int list -> 17 | ?vsync:bool -> 18 | ?save:string -> 19 | string -> 20 | t 21 | (** Create the emulation window with given attributes *) 22 | 23 | val delete : t -> unit 24 | 25 | val clear : t -> Stdint.uint8 -> unit 26 | (** Fill the buffer with the given color *) 27 | 28 | val get_window : t -> Tsdl.Sdl.window 29 | (** Retrieve SDL window *) 30 | 31 | val set_pixel : t -> x:int -> y:int -> color:Stdint.uint8 -> unit 32 | 33 | val render : ?after:(unit -> unit) -> t -> unit 34 | (** Refresh the displayed buffer *) 35 | end 36 | 37 | module Sdl_backend : S 38 | module Headless_backend : S 39 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name nes) 3 | (public_name nes-ml) 4 | (package nes-ml) 5 | (modes native) 6 | (ocamlopt_flags -g) 7 | (preprocess 8 | (pps stdint-literals)) 9 | (libraries 6502-ml tsdl bos stdint fpath digestif str cmdliner bogue)) 10 | -------------------------------------------------------------------------------- /src/gui.ml: -------------------------------------------------------------------------------- 1 | module type S = sig 2 | type t 3 | 4 | val create : Common.cli_flags -> t 5 | val render : t -> unit 6 | val toggle_gui : t -> unit -> unit 7 | val set_pixel : t -> Common.set_pixel 8 | val render_raw : t -> unit 9 | val clear : t -> Stdint.uint8 -> unit 10 | val continue : t -> bool 11 | val shown : t -> bool 12 | val set_exit : t -> (unit -> unit) -> unit 13 | val set_save_state : t -> (Rom.Save_file.slot -> unit) -> unit 14 | val set_load_state : t -> (Rom.Save_file.slot -> unit) -> unit 15 | val exit : t -> unit 16 | end 17 | 18 | module type SF = functor (D : Display.S) -> S 19 | 20 | module Disabled (D : Display.S) : S = struct 21 | type t = D.t 22 | 23 | let create cli_flags = Ppu_display.create D.create cli_flags 24 | let render_raw t = D.render t 25 | let clear = D.clear 26 | let set_pixel = D.set_pixel 27 | let render t = D.render t 28 | let toggle_gui _ _ = () 29 | let continue _ = true 30 | let shown _ = false 31 | let set_exit _ _ = () 32 | let set_save_state _ _ = () 33 | let set_load_state _ _ = () 34 | 35 | let exit t = 36 | D.delete t; 37 | D.exit () 38 | end 39 | 40 | module Enabled (D : Display.S) : S = struct 41 | open Bogue 42 | module W = Widget 43 | module L = Layout 44 | 45 | type state = { 46 | mutable anim : bool; 47 | mutable continue : bool; 48 | mutable gui_shown : bool; 49 | } 50 | 51 | type gui = Main.board 52 | 53 | type callbacks = { 54 | mutable exit : unit -> unit; 55 | mutable save_state : Rom.Save_file.slot -> unit; 56 | mutable load_state : Rom.Save_file.slot -> unit; 57 | } 58 | 59 | type t = { 60 | board : gui; 61 | display : D.t; 62 | start : unit -> unit; 63 | fps : unit -> unit; 64 | state : state; 65 | callbacks : callbacks; 66 | } 67 | 68 | let set_pixel t = D.set_pixel t.display 69 | let render_raw t = D.render t.display 70 | let clear t = D.clear t.display 71 | let continue t = t.state.continue 72 | let shown t = t.state.gui_shown 73 | let set_exit t f = t.callbacks.exit <- f 74 | let set_save_state t f = t.callbacks.save_state <- f 75 | let set_load_state t f = t.callbacks.load_state <- f 76 | 77 | let create_board window callbacks = 78 | let dummy () = Printf.printf "GUI action not implemented yet!\n%!" in 79 | let exit () = raise Bogue.Exit in 80 | let save_call slot () = 81 | callbacks.save_state slot; 82 | exit () 83 | in 84 | let load_call slot () = 85 | callbacks.load_state slot; 86 | exit () 87 | in 88 | let state_entries f = 89 | Menu.Flat 90 | Rom.Save_file. 91 | [ 92 | { label = Text "Slot 1"; content = Action (f S1) }; 93 | { label = Text "Slot 2"; content = Action (f S2) }; 94 | { label = Text "Slot 3"; content = Action (f S3) }; 95 | ] 96 | in 97 | let entries = 98 | Menu. 99 | [ 100 | { 101 | label = Text "Emulation"; 102 | content = 103 | Tower 104 | [ 105 | { label = Text "Reset"; content = Action dummy }; 106 | { label = Text "Quit"; content = Action callbacks.exit }; 107 | ]; 108 | }; 109 | { 110 | label = Text "State"; 111 | content = 112 | Tower 113 | [ 114 | { 115 | label = Text "Save state"; 116 | content = state_entries save_call; 117 | }; 118 | { 119 | label = Text "Load state"; 120 | content = state_entries load_call; 121 | }; 122 | ]; 123 | }; 124 | { 125 | label = Text "Settings"; 126 | content = 127 | Tower 128 | [ 129 | { label = Text "Control mapping"; content = Action dummy }; 130 | { 131 | label = Text "Toggle debug windows"; 132 | content = Action dummy; 133 | }; 134 | ]; 135 | }; 136 | { label = Text "About"; content = Action dummy }; 137 | ] 138 | in 139 | let layout = Layout.empty ~w:800 ~h:100 () in 140 | Menu.add_bar ~dst:layout entries; 141 | let board = 142 | Bogue.of_layout 143 | ~shortcuts:Bogue.(shortcuts_of_list [ exit_on_escape ]) 144 | layout 145 | in 146 | Bogue.make_sdl_windows ~windows:[ window ] board; 147 | let start, fps = Time.adaptive_fps 60 in 148 | start (); 149 | (board, start, fps) 150 | 151 | let create cli_flags = 152 | Theme.set_scale 0.8; 153 | let display = Ppu_display.create D.create cli_flags in 154 | let state = { anim = false; gui_shown = false; continue = true } in 155 | let window = D.get_window display in 156 | let callbacks = 157 | { 158 | exit = (fun () -> state.continue <- false); 159 | save_state = (fun _ -> Printf.printf "Dummy save\n"); 160 | load_state = (fun _ -> Printf.printf "Dummy load\n"); 161 | } 162 | in 163 | let board, start, fps = create_board window callbacks in 164 | { board; start; fps; state; display; callbacks } 165 | 166 | let render_gui t = 167 | try 168 | Bogue.refresh_custom_windows t.board; 169 | t.state.anim <- Bogue.one_step t.state.anim (t.start, t.fps) t.board; 170 | if not t.state.anim then t.fps (); 171 | `Continue 172 | with Bogue.Exit -> `Exited 173 | 174 | let toggle_gui t () = t.state.gui_shown <- not t.state.gui_shown 175 | 176 | let render t = 177 | let after () = 178 | if t.state.gui_shown then 179 | match render_gui t with `Continue -> () | `Exited -> toggle_gui t () 180 | in 181 | D.render ~after t.display 182 | 183 | let exit t = 184 | D.delete t.display; 185 | D.exit () 186 | end 187 | -------------------------------------------------------------------------------- /src/gui.mli: -------------------------------------------------------------------------------- 1 | (** Full definition of the emulator's GUI and rendering window *) 2 | 3 | module type S = sig 4 | type t 5 | 6 | val create : Common.cli_flags -> t 7 | (** Create the emulator GUI attached to a window, and callbacks to call *) 8 | 9 | val render : t -> unit 10 | (** Refresh and render the GUI to the attached window. Return if the GUI has 11 | exited *) 12 | 13 | val toggle_gui : t -> unit -> unit 14 | (** Toggle if GUI should be shown or not *) 15 | 16 | val set_pixel : t -> Common.set_pixel 17 | val render_raw : t -> unit 18 | val clear : t -> Stdint.uint8 -> unit 19 | val continue : t -> bool 20 | val shown : t -> bool 21 | val set_exit : t -> (unit -> unit) -> unit 22 | val set_save_state : t -> (Rom.Save_file.slot -> unit) -> unit 23 | val set_load_state : t -> (Rom.Save_file.slot -> unit) -> unit 24 | 25 | val exit : t -> unit 26 | (** Exit and destroy the main window *) 27 | end 28 | 29 | module type SF = functor (D : Display.S) -> S 30 | 31 | module Enabled : SF 32 | module Disabled : SF 33 | -------------------------------------------------------------------------------- /src/infix_int.ml: -------------------------------------------------------------------------------- 1 | module Make (M : Stdint.Int) = struct 2 | include M 3 | 4 | let ( $& ) = M.logand 5 | let ( $| ) = M.logor 6 | let ( $^ ) = M.logxor 7 | let ( $>> ) = M.shift_right_logical 8 | let ( $>>! ) = M.shift_right 9 | let ( $<< ) = M.shift_left 10 | let ( ?~ ) = M.lognot 11 | let ( ?$ ) = M.of_uint8 12 | let ( ?$$ ) = M.of_uint16 13 | let ( ?% ) = M.to_int 14 | let ( ?@ ) = M.of_int 15 | end 16 | 17 | (* for some reason, functions from these modules cannot be inlined while 18 | functions from Stdint.Uint8 and Uint16 can... *) 19 | module Common = struct 20 | module U8 = Make (Stdint.Uint8) 21 | module U16 = Make (Stdint.Uint16) 22 | end 23 | -------------------------------------------------------------------------------- /src/input.ml: -------------------------------------------------------------------------------- 1 | module Keys = struct 2 | type t = 3 | | A 4 | | B 5 | | Right 6 | | Left 7 | | Down 8 | | Up 9 | | Start 10 | | Select 11 | | Toggle_debug 12 | | Toggle_gui 13 | | Save_state of Rom.Save_file.slot 14 | | Load_state of Rom.Save_file.slot 15 | 16 | let compare = Stdlib.compare 17 | 18 | let to_string = function 19 | | A -> "A" 20 | | B -> "B" 21 | | Right -> "Right" 22 | | Left -> "Left" 23 | | Down -> "Down" 24 | | Up -> "Up" 25 | | Start -> "Start" 26 | | Select -> "Select" 27 | | _ -> "unknown" 28 | end 29 | 30 | type callbacks = { 31 | toggle_debug : unit -> unit; 32 | toggle_gui : unit -> unit; 33 | save_state : Rom.Save_file.slot -> unit; 34 | load_state : Rom.Save_file.slot -> unit; 35 | } 36 | 37 | module type Backend = sig 38 | type t 39 | 40 | val create : unit -> t 41 | val key_pressed : t -> Keys.t -> bool 42 | val get_inputs : t -> callbacks -> unit 43 | val next_frame : t -> unit 44 | end 45 | 46 | module type S = sig 47 | type t 48 | (** State of the input state machine *) 49 | 50 | type backend 51 | 52 | val create : unit -> t 53 | 54 | val next_register : t -> Stdint.uint8 55 | (** Value of the next input register for the NES *) 56 | 57 | val next_frame : t -> unit 58 | 59 | val get_inputs : t -> callbacks -> unit 60 | (** Call back the functions if the related input is triggered *) 61 | end 62 | 63 | module Make (B : Backend) : S with type backend = B.t = struct 64 | type t = { mutable next_key : int; backend_state : B.t } 65 | type backend = B.t 66 | 67 | let create () = { next_key = 0; backend_state = B.create () } 68 | 69 | let nes_key_order = 70 | Array.of_list Keys.[ A; B; Select; Start; Up; Down; Left; Right ] 71 | 72 | let next_nes_key t = 73 | let to_check = nes_key_order.(t.next_key) in 74 | t.next_key <- (t.next_key + 1) mod 8; 75 | B.key_pressed t.backend_state to_check 76 | 77 | let next_register t = if next_nes_key t then 1u else 0u 78 | let next_frame t = B.next_frame t.backend_state 79 | let get_inputs t callbacks = B.get_inputs t.backend_state callbacks 80 | end 81 | -------------------------------------------------------------------------------- /src/input.mli: -------------------------------------------------------------------------------- 1 | (** Manage keyboard IO for the NES and the emulator itself *) 2 | 3 | module Keys : sig 4 | type t = 5 | | A 6 | | B 7 | | Right 8 | | Left 9 | | Down 10 | | Up 11 | | Start 12 | | Select 13 | | Toggle_debug 14 | | Toggle_gui 15 | | Save_state of Rom.Save_file.slot 16 | | Load_state of Rom.Save_file.slot 17 | 18 | val compare : t -> t -> int 19 | val to_string : t -> string 20 | end 21 | 22 | type callbacks = { 23 | toggle_debug : unit -> unit; 24 | toggle_gui : unit -> unit; 25 | save_state : Rom.Save_file.slot -> unit; 26 | load_state : Rom.Save_file.slot -> unit; 27 | } 28 | 29 | module type Backend = sig 30 | type t 31 | 32 | val create : unit -> t 33 | val key_pressed : t -> Keys.t -> bool 34 | val get_inputs : t -> callbacks -> unit 35 | val next_frame : t -> unit 36 | end 37 | 38 | module type S = sig 39 | type t 40 | (** State of the input state machine *) 41 | 42 | type backend 43 | 44 | val create : unit -> t 45 | 46 | val next_register : t -> Stdint.uint8 47 | (** Value of the next input register for the NES *) 48 | 49 | val next_frame : t -> unit 50 | 51 | val get_inputs : t -> callbacks -> unit 52 | (** Call back the functions if the related input is triggered *) 53 | end 54 | 55 | module Make : functor (B : Backend) -> S with type backend = B.t 56 | -------------------------------------------------------------------------------- /src/input_movie.ml: -------------------------------------------------------------------------------- 1 | module type Movie = sig 2 | val file : string 3 | end 4 | 5 | module KSet = Set.Make (Input.Keys) 6 | module ISet = Set.Make (Int) 7 | 8 | let debug = false 9 | 10 | let string_of_kset t = 11 | KSet.fold (fun e s -> Printf.sprintf "%s %s" s (Input.Keys.to_string e)) t "" 12 | 13 | module Make_FM2 (M : Movie) : Input.Backend = struct 14 | type t = { mutable frame : int; inputs : KSet.t array } 15 | 16 | let create () = { frame = 0; inputs = Movie_format.FM2.Read.read M.file } 17 | 18 | let key_pressed t k = 19 | if t.frame >= Array.length t.inputs then failwith "End of movie"; 20 | let set = t.inputs.(t.frame) in 21 | KSet.mem k set 22 | 23 | let get_inputs _ _ = () 24 | 25 | let next_frame t = 26 | if debug then 27 | Printf.printf "%d: %s\n%!" t.frame (string_of_kset t.inputs.(t.frame)); 28 | t.frame <- t.frame + 1 29 | end 30 | 31 | module Make_deter (M : Movie) : Input.Backend = struct 32 | type t = { mutable counter : int; inputs : ISet.t; last : int } 33 | 34 | let read_deter file = 35 | let chan = open_in file in 36 | let rec aux () = 37 | try 38 | let line = input_line chan in 39 | let i = int_of_string line in 40 | ISet.add i (aux ()) 41 | with End_of_file -> ISet.empty 42 | in 43 | aux () 44 | 45 | let create () = 46 | let inputs = read_deter M.file in 47 | { counter = 0; inputs; last = ISet.max_elt inputs } 48 | 49 | let key_pressed t _ = 50 | if t.counter > t.last then raise Common.End_of_movie; 51 | let r = ISet.mem t.counter t.inputs in 52 | t.counter <- t.counter + 1; 53 | r 54 | 55 | let get_inputs _ _ = () 56 | let next_frame _ = () 57 | end 58 | -------------------------------------------------------------------------------- /src/input_sdl.ml: -------------------------------------------------------------------------------- 1 | open Tsdl 2 | 3 | module M = struct 4 | type t = unit 5 | 6 | module Keymap = Map.Make (Input.Keys) 7 | 8 | type binding = { key : Sdl.keycode; kmod : Sdl.keymod } 9 | 10 | let create () = () 11 | 12 | (* Hardcoded, for now *) 13 | let bindings = 14 | let open Sdl.K in 15 | (* Bare key *) 16 | let b k = { key = k; kmod = Sdl.Kmod.none } in 17 | (* Key with shift modifier *) 18 | let shift k = { key = k; kmod = Sdl.Kmod.lshift } in 19 | let open Input.Keys in 20 | [ 21 | (A, b s); 22 | (B, b d); 23 | (Right, b right); 24 | (Left, b left); 25 | (Down, b down); 26 | (Up, b up); 27 | (Start, b return); 28 | (Select, b backspace); 29 | (Toggle_debug, b home); 30 | (Save_state S1, b k1); 31 | (Save_state S2, b k2); 32 | (Save_state S3, b k3); 33 | (Load_state S1, shift k1); 34 | (Load_state S2, shift k2); 35 | (Load_state S3, shift k3); 36 | (Toggle_gui, b escape); 37 | ] 38 | |> List.to_seq |> Keymap.of_seq 39 | 40 | let reverse_binding b = 41 | let f key b' found = 42 | match found with 43 | | None -> if b = b' then Some key else None 44 | | Some _ -> found 45 | in 46 | Keymap.fold f bindings None 47 | 48 | let state = Sdl.get_keyboard_state () 49 | 50 | let key_pressed () key = 51 | let { key; _ } = Keymap.find key bindings in 52 | let scancode = Sdl.get_scancode_from_key key in 53 | state.{scancode} != 0 54 | 55 | let gen_get_inputs key_callback (c : Input.callbacks) = 56 | let open Sdl in 57 | let event = Event.create () in 58 | let rec aux () = 59 | if poll_event (Some event) then ( 60 | let typ = Event.get event Event.typ in 61 | (match Event.enum typ with 62 | | `Key_down -> ( 63 | let key = Event.get event Event.keyboard_keycode in 64 | let kmod = Event.get event Event.keyboard_keymod in 65 | let binding = { key; kmod } in 66 | match reverse_binding binding with 67 | | Some Toggle_debug -> c.toggle_debug () 68 | | Some Toggle_gui -> c.toggle_gui () 69 | | Some (Save_state slot) -> c.save_state slot 70 | | Some (Load_state slot) -> c.load_state slot 71 | | Some k -> key_callback k 72 | | None -> ()) 73 | | _ -> ()); 74 | aux ()) 75 | in 76 | aux () 77 | 78 | let get_inputs () (c : Input.callbacks) = gen_get_inputs (fun _ -> ()) c 79 | let next_frame () = () 80 | end 81 | 82 | module type Out = sig 83 | val file : string 84 | end 85 | 86 | module KSet = Set.Make (Input.Keys) 87 | 88 | module Make_record_FM2 (O : Out) = struct 89 | type t = { mutable this_frame : KSet.t; channel : out_channel } 90 | 91 | let create () = 92 | let channel = open_out O.file in 93 | { this_frame = KSet.empty; channel } 94 | 95 | let add_key_to_frame t k = t.this_frame <- KSet.add k t.this_frame 96 | 97 | let key_pressed t k = 98 | let pressed = M.key_pressed () k in 99 | Movie_format.FM2.Write.write_header t.channel; 100 | if pressed then add_key_to_frame t k; 101 | pressed 102 | 103 | let get_inputs t c = M.gen_get_inputs (add_key_to_frame t) c 104 | 105 | let next_frame t = 106 | Movie_format.FM2.Write.write_line t.channel t.this_frame; 107 | t.this_frame <- KSet.empty 108 | end 109 | 110 | module Make_record_deter (O : Out) = struct 111 | type t = { mutable counter : int; channel : out_channel } 112 | 113 | let create () = 114 | let channel = open_out O.file in 115 | { counter = 0; channel } 116 | 117 | let key_pressed t k = 118 | let pressed = M.key_pressed () k in 119 | if pressed then Printf.fprintf t.channel "%d\n" t.counter; 120 | t.counter <- t.counter + 1; 121 | pressed 122 | 123 | let get_inputs _ = M.get_inputs () 124 | let next_frame _ = () 125 | end 126 | 127 | include M 128 | -------------------------------------------------------------------------------- /src/mapper.ml: -------------------------------------------------------------------------------- 1 | open Infix_int.Common 2 | 3 | module type S' = sig 4 | type t 5 | 6 | val read : t -> U16.t -> U8.t 7 | val write : t -> U16.t -> U8.t -> unit 8 | end 9 | 10 | module type S = sig 11 | type t 12 | 13 | val create : Rom.t -> t 14 | 15 | module CPU : S' with type t := t 16 | module PPU : S' with type t := t 17 | end 18 | 19 | module PPU_Basic = struct 20 | type mirroring = Horizontal | Vertical 21 | type t = { m : U8.t array; mirroring : mirroring } 22 | 23 | module Make (A : sig 24 | type outer 25 | 26 | val get : outer -> t 27 | end) = 28 | struct 29 | let create rom = 30 | let open Rom in 31 | let mirroring = if rom.config.mirroring then Vertical else Horizontal in 32 | let m = Array.make 0x4000 0u in 33 | Array.blit 34 | (Array.map C6502.Utils.u8 rom.chr_rom) 35 | 0 m 0x0 rom.config.chr_rom_size; 36 | { m; mirroring } 37 | 38 | let nametable_mirroring t v = 39 | match t.mirroring with 40 | | Horizontal -> U16.(v $& ?~0x400U) 41 | | Vertical -> U16.(v $& ?~0x800U) 42 | 43 | let mirroring t v = 44 | if v <= 0x1FFFU then v 45 | else if v <= 0x2FFFU then nametable_mirroring t v 46 | else v 47 | 48 | open U16 49 | 50 | let read t a = (A.get t).m.(?%(mirroring (A.get t) a)) 51 | let write t a v = (A.get t).m.(?%(mirroring (A.get t) a)) <- v 52 | end 53 | end 54 | 55 | module NROM : S = struct 56 | type t = { prg : U8.t array; chr : PPU_Basic.t } 57 | 58 | module CPU = struct 59 | let create rom = 60 | let open Rom in 61 | let bank_nb = rom.config.prg_rom_size / 0x4000 in 62 | if bank_nb = 2 then Array.map C6502.Utils.u8 rom.prg_rom 63 | else 64 | let m = Array.make 0x8000 0x00 in 65 | (* 32K *) 66 | Array.blit rom.prg_rom 0 m 0 0x4000; 67 | Array.blit rom.prg_rom 0 m 0x4000 0x4000; 68 | Array.map C6502.Utils.u8 m 69 | 70 | open U16 71 | 72 | let read t a = t.prg.(?%(a $& 0x7FFFU)) 73 | let write t a v = t.prg.(?%(a $& 0x7FFFU)) <- v 74 | end 75 | 76 | module PPU = PPU_Basic.Make (struct 77 | type outer = t 78 | 79 | let get { chr; _ } = chr 80 | end) 81 | 82 | let create rom = { prg = CPU.create rom; chr = PPU.create rom } 83 | end 84 | 85 | let banks_of_raw data total_size bank_size = 86 | let bank_nb = total_size / bank_size in 87 | let create_bank _ = Array.make bank_size 0x00 in 88 | let banks = Array.init bank_nb create_bank in 89 | for i = 0 to bank_nb - 1 do 90 | Array.blit data (bank_size * i) banks.(i) 0 bank_size 91 | done; 92 | Array.map (Array.map C6502.Utils.u8) banks 93 | 94 | module UxROM : S = struct 95 | type prg = { banks : U8.t array array; mutable selected : int } 96 | type t = { prg : prg; chr : PPU_Basic.t } 97 | 98 | module CPU = struct 99 | let create rom = 100 | let open Rom in 101 | let banks = banks_of_raw rom.prg_rom rom.config.prg_rom_size 0x4000 in 102 | { banks; selected = 0 } 103 | 104 | let last_bank t = t.prg.banks.(Array.length t.prg.banks - 1) 105 | 106 | open U16 107 | 108 | let read t a = 109 | if a >= 0xC000U then (last_bank t).(?%(a $& 0x3FFFU)) 110 | else t.prg.banks.(t.prg.selected).(?%(a $& 0x3FFFU)) 111 | 112 | let write t _ v = t.prg.selected <- U8.to_int v 113 | end 114 | 115 | module PPU = PPU_Basic.Make (struct 116 | type outer = t 117 | 118 | let get { chr; _ } = chr 119 | end) 120 | 121 | let create rom = { prg = CPU.create rom; chr = PPU.create rom } 122 | end 123 | 124 | module MMC1 : S = struct 125 | type prg = { 126 | banks : U8.t array array; 127 | mutable mode : int; 128 | mutable selected : int; 129 | prg_ram : U8.t array; 130 | } 131 | 132 | type chr = { 133 | banks : U8.t array array; 134 | mutable mode_4k : bool; 135 | mutable selected_0 : int; 136 | mutable selected_1 : int; 137 | ram : U8.t array; 138 | } 139 | 140 | type mirroring = Horizontal | Vertical | Single_lower | Single_upper 141 | 142 | type t = { 143 | prg : prg; 144 | chr : chr; 145 | mutable mirroring : mirroring; 146 | mutable shift_register : U8.t; 147 | mutable sr_writes : int; 148 | } 149 | 150 | let create rom = 151 | Rom. 152 | { 153 | prg = 154 | { 155 | banks = banks_of_raw rom.prg_rom rom.config.prg_rom_size 0x4000; 156 | mode = 3; 157 | selected = 0; 158 | prg_ram = Array.make 0x2000 0u; 159 | }; 160 | chr = 161 | { 162 | banks = 163 | (if rom.config.chr_rom_size = 0 then 164 | (* CHR RAM *) 165 | [| Array.make 0x1000 0u; Array.make 0x1000 0u |] 166 | else banks_of_raw rom.chr_rom rom.config.chr_rom_size 0x1000); 167 | mode_4k = false; 168 | selected_0 = 0; 169 | selected_1 = 0; 170 | ram = Array.make 0x4000 0u; 171 | }; 172 | mirroring = Single_lower; 173 | shift_register = 0u; 174 | sr_writes = 0; 175 | } 176 | 177 | module CPU = struct 178 | let write_control t v = 179 | let mirroring = 180 | match U8.(v $& 0x3u |> to_int) with 181 | | 0 -> Single_lower 182 | | 1 -> Single_upper 183 | | 2 -> Vertical 184 | | 3 -> Horizontal 185 | | _ -> assert false 186 | in 187 | (* Copy active table when switching mirroring 188 | * there's probably a better solution ...*) 189 | (match (t.mirroring, mirroring) with 190 | | Vertical, Horizontal -> 191 | Array.blit t.chr.ram 0x2400 t.chr.ram 0x2800 0x400 192 | | Horizontal, Vertical -> 193 | Array.blit t.chr.ram 0x2800 t.chr.ram 0x2400 0x400 194 | | _ -> ()); 195 | t.mirroring <- mirroring; 196 | t.chr.mode_4k <- U8.(v $& 0x10u <> 0u); 197 | t.prg.mode <- U8.(v $& 0xCu $>> 2 |> to_int) 198 | 199 | let write_register t a v = 200 | let open U8 in 201 | match U16.(a $& 0xE000U |> to_int) with 202 | | 0x8000 -> write_control t v 203 | | 0xA000 -> 204 | if t.chr.mode_4k then 205 | t.chr.selected_0 <- ?%v mod Array.length t.chr.banks 206 | else t.chr.selected_0 <- ?%(v $& 0x1Eu) mod Array.length t.chr.banks 207 | | 0xC000 -> 208 | if t.chr.mode_4k then 209 | t.chr.selected_1 <- ?%v mod Array.length t.chr.banks 210 | | 0xE000 -> 211 | if t.prg.mode < 2 (* 32 Kb mode *) then 212 | t.prg.selected <- ?%(v $& 0xEu) mod Array.length t.prg.banks 213 | else t.prg.selected <- ?%v mod Array.length t.prg.banks 214 | | _ -> assert false 215 | 216 | let write t a v = 217 | if a < 0x8000U then U16.(t.prg.prg_ram.(?%a) <- v) 218 | else 219 | let b7 = U8.(v $>> 7) in 220 | if b7 = 1u then ( 221 | t.shift_register <- 0u; 222 | t.sr_writes <- 0; 223 | t.prg.mode <- 3) 224 | else ( 225 | t.shift_register <- U8.(t.shift_register $| (v $<< 7)); 226 | t.shift_register <- U8.(t.shift_register $>> 1); 227 | t.sr_writes <- t.sr_writes + 1; 228 | if t.sr_writes = 5 then ( 229 | t.sr_writes <- 0; 230 | let v = U8.(t.shift_register $>> 2) in 231 | t.shift_register <- 0u; 232 | write_register t a v)) 233 | 234 | let read t a = 235 | let a = U16.(?%a) in 236 | if a < 0x8000 then t.prg.prg_ram.(a) 237 | else if a < 0xC000 then 238 | let selected = match t.prg.mode with 2 -> 0 | _ -> t.prg.selected in 239 | t.prg.banks.(selected).(a land 0x3FFF) 240 | else 241 | let selected = 242 | match t.prg.mode with 243 | | 0 | 1 -> (t.prg.selected + 1) mod Array.length t.prg.banks 244 | | 3 -> Array.length t.prg.banks - 1 245 | | 2 -> t.prg.selected 246 | | _ -> assert false 247 | in 248 | t.prg.banks.(selected).(a land 0x3FFF) 249 | end 250 | 251 | module PPU = struct 252 | let nametable_mirroring t v = 253 | match t.mirroring with 254 | | Horizontal -> U16.(v $& ?~0x400U) 255 | | Vertical -> U16.(v $& ?~0x800U) 256 | | Single_lower | Single_upper -> U16.(v $& ?~0xC00U) 257 | 258 | let indirection t v = 259 | if v <= 0x1FFFU then v 260 | else if v <= 0x2FFFU then nametable_mirroring t v 261 | else v 262 | 263 | let read t a = 264 | let a = indirection t a in 265 | let open U16 in 266 | if a <= 0x0FFFU then 267 | t.chr.banks.(t.chr.selected_0).(a $& 0x0FFFU |> to_int) 268 | else if a <= 0x1FFFU then 269 | if t.chr.mode_4k then 270 | t.chr.banks.(t.chr.selected_1).(a $& 0x0FFFU |> to_int) 271 | else 272 | t.chr.banks.(Stdlib.succ t.chr.selected_0 mod Array.length t.chr.banks).( 273 | a $& 0x0FFFU |> to_int) 274 | else t.chr.ram.(?%a) 275 | 276 | let write t a v = 277 | let a = indirection t a in 278 | let open U16 in 279 | if a <= 0x0FFFU then 280 | t.chr.banks.(t.chr.selected_0).(a $& 0x0FFFU |> to_int) <- v 281 | else if a <= 0x1FFFU then 282 | if t.chr.mode_4k then 283 | t.chr.banks.(t.chr.selected_1).(a $& 0x0FFFU |> to_int) <- v 284 | else 285 | t.chr.banks.(Stdlib.succ t.chr.selected_0 mod Array.length t.chr.banks).( 286 | a $& 0x0FFFU |> to_int) <- v 287 | else t.chr.ram.(?%a) <- v 288 | end 289 | end 290 | 291 | module MMC3 = struct 292 | type t = { 293 | (* (0: $8000-$9FFF swappable, 294 | $C000-$DFFF fixed to second-last bank; 295 | 1: $C000-$DFFF swappable, 296 | $8000-$9FFF fixed to second-last bank) 297 | *) 298 | mutable prg_rom_mode : bool; 299 | (* (0: two 2 KB banks at $0000-$0FFF, 300 | four 1 KB banks at $1000-$1FFF; 301 | 1: two 2 KB banks at $1000-$1FFF, 302 | four 1 KB banks at $0000-$0FFF) 303 | *) 304 | mutable chr_a12_inversion : bool; 305 | mutable next_register : int; 306 | } 307 | 308 | module CPU = struct end 309 | module PPU = struct end 310 | end 311 | [@@warning "-34"] 312 | 313 | let mappers = 314 | [ (0, (module NROM : S)); (1, (module MMC1)); (2, (module UxROM)) ] 315 | 316 | let find rom = 317 | let open Rom in 318 | match List.assoc_opt rom.config.mapper_nb mappers with 319 | | None -> raise (Invalid_ROM "Unsupported mapper") 320 | | Some x -> x 321 | -------------------------------------------------------------------------------- /src/mapper.mli: -------------------------------------------------------------------------------- 1 | (** NES cartridge mappers, as first-class modules *) 2 | 3 | open Stdint 4 | 5 | module type S' = sig 6 | type t 7 | 8 | val read : t -> uint16 -> uint8 9 | val write : t -> uint16 -> uint8 -> unit 10 | end 11 | 12 | module type S = sig 13 | type t 14 | 15 | val create : Rom.t -> t 16 | 17 | module CPU : S' with type t := t 18 | module PPU : S' with type t := t 19 | end 20 | 21 | val find : Rom.t -> (module S) 22 | (** Try to find the implementation of the appropriate mapper for the given ROM, 23 | if it exists. Raises [Invalid_ROM] if the mapper is not implemented. *) 24 | -------------------------------------------------------------------------------- /src/movie_format.ml: -------------------------------------------------------------------------------- 1 | module KSet = Set.Make (Input.Keys) 2 | 3 | (** FM2 is a really bad file format: non determinist *) 4 | module FM2 = struct 5 | module Read = struct 6 | let rec get_input_log chan = 7 | try 8 | let line = input_line chan in 9 | if line.[0] = '|' then line :: get_input_log chan 10 | else get_input_log chan 11 | with End_of_file -> [] 12 | 13 | let parse_log_line line = 14 | let second_pipe = String.index_from line 1 '|' in 15 | let inputs = String.sub line (second_pipe + 1) 8 in 16 | let mapping = 17 | Input.Keys.[| Right; Left; Down; Up; Start; Select; B; A |] 18 | in 19 | let keys = ref KSet.empty in 20 | String.iteri 21 | (fun i c -> 22 | if c <> '.' && c <> ' ' then keys := KSet.add mapping.(i) !keys) 23 | inputs; 24 | !keys 25 | 26 | let read file = 27 | let chan = open_in file in 28 | let log = get_input_log chan in 29 | let log_parsed = List.map parse_log_line log in 30 | Array.of_list log_parsed 31 | end 32 | 33 | module Write = struct 34 | let write_header channel = 35 | Printf.fprintf channel 36 | {|version 3 37 | emuVersion 20604 38 | palFlag 0 39 | romFilename ??? 40 | romChecksum ??? 41 | guid ??? 42 | fourscore 0 43 | microphone 0 44 | port0 1 45 | port1 0 46 | port2 0 47 | FDS 0 48 | NewPPU 0 49 | |} 50 | 51 | let write_line channel ks = 52 | let p = Printf.fprintf channel in 53 | let pk k c = 54 | if KSet.mem k ks then Printf.fprintf channel "%c" c 55 | else Printf.fprintf channel "." 56 | in 57 | p "|0|"; 58 | pk Right 'R'; 59 | pk Left 'L'; 60 | pk Down 'D'; 61 | pk Up 'U'; 62 | pk Start 'T'; 63 | pk Select 'S'; 64 | pk B 'B'; 65 | pk A 'A'; 66 | p "|||\n" 67 | end 68 | end 69 | -------------------------------------------------------------------------------- /src/nes.ml: -------------------------------------------------------------------------------- 1 | open Common 2 | 3 | type ('ppu, 'apu, 'input, 'mapper) devices = { 4 | rom : Rom.t; 5 | mapper : 'mapper; 6 | apu : 'apu; 7 | ppu : 'ppu; 8 | input : 'input; 9 | } 10 | 11 | module Build_NES (P : Ppu.S) (A : Apu.S) (M : Mapper.S) (I : Input.S) : 12 | C6502.MemoryMap with type input = (P.t, A.t, I.t, M.t) devices = struct 13 | open Infix_int.Common 14 | 15 | type input = (P.t, A.t, I.t, M.t) devices 16 | 17 | type t = { 18 | main : U8.t array; 19 | mapper : M.t; 20 | apu : A.t; 21 | ppu : P.t; 22 | input : I.t; 23 | } 24 | 25 | let create ({ mapper; apu; ppu; input; _ } : input) = 26 | { main = Array.make 0x8000 0u; mapper; input; apu; ppu } 27 | 28 | (* Utils *) 29 | let is_in_ppu_range addr = addr >= 0x2000U && addr <= 0x2007U 30 | 31 | let is_in_apu_range addr = 32 | addr >= 0x4000U && addr <= 0x4017U && addr <> 0x4014U 33 | 34 | let is_in_cartridge_range addr = addr >= 0x8000U 35 | 36 | let address_mirroring a = 37 | let open U16 in 38 | if a < 0x2000U then (* RAM mirroring *) 39 | a $& 0x07FFU 40 | else if a $>> 13 = 1U then 41 | (* PPU mirroring *) 42 | (* TODO also mask ?*) 43 | a $& 0x2007U 44 | else a 45 | 46 | let read t (a : U16.t) : U8.t = 47 | let open U16 in 48 | let a = address_mirroring a in 49 | if is_in_ppu_range a then P.get_register t.ppu (to_int (logand a 7U)) 50 | else if a = 0x4015U then A.read_register t.apu a 51 | else if a = 0x4016U then I.next_register t.input 52 | else if is_in_cartridge_range a then M.CPU.read t.mapper a 53 | else t.main.(?%a) 54 | 55 | let write t (a : U16.t) (v : U8.t) = 56 | let open U16 in 57 | let a = address_mirroring a in 58 | if is_in_ppu_range a then P.set_register t.ppu (to_int (logand a 7U)) v 59 | else if is_in_apu_range a then A.write_register t.apu v a 60 | else if a = 0x4014U then P.dma t.ppu (read t) (?$v $<< 8) 61 | else if is_in_cartridge_range a then M.CPU.write t.mapper a v 62 | else t.main.(?%a) <- v 63 | end 64 | 65 | module Main 66 | (P : Ppu.S) 67 | (G : Gui.S) 68 | (A : Apu.S) 69 | (M : Mapper.S) 70 | (I : Input.S) 71 | (NES : C6502.CPU with type input := (P.t, A.t, I.t, M.t) devices) = 72 | struct 73 | type state = { 74 | cpu : NES.t; 75 | apu : A.t; 76 | ppu : P.t; 77 | rom : Rom.t; 78 | collector : C6502.IRQ_collector.t; 79 | input : I.t; 80 | cli_flags : cli_flags; 81 | } 82 | 83 | type io = { mutable debug : P.Debug.t option; main_window : G.t } 84 | type t = { mutable state : state; io : io } 85 | 86 | module Save_state = struct 87 | let save t slot = 88 | try 89 | let save_name = Rom.Save_file.make_name t.state.rom slot in 90 | let chan = open_out_bin save_name in 91 | Marshal.(to_channel chan t.state []); 92 | close_out chan 93 | with Sys_error err -> Printf.printf "Cannot save state: %s\n%!" err 94 | 95 | let load t slot = 96 | let err msg = Printf.printf "Cannot load state: %s\n%!" msg in 97 | try 98 | match Rom.Save_file.find_matching_name t.state.rom slot with 99 | | Some path -> 100 | let chan = open_in_bin path in 101 | let state' = Marshal.from_channel chan in 102 | t.state <- state'; 103 | close_in chan 104 | | None -> err "no save file existing." 105 | with 106 | | Sys_error msg -> err msg 107 | | Failure msg -> 108 | Printf.printf 109 | "Cannot parse save state (%s). It was probably saved with a \ 110 | different version of the emulator.\n\ 111 | %!" 112 | msg 113 | end 114 | 115 | let create ({ apu; ppu; input; rom; _ } as d : (P.t, A.t, I.t, M.t) devices) 116 | collector nmi cli_flags = 117 | let cpu = NES.create ~collector ~nmi d in 118 | NES.Register.set (NES.registers cpu) `S 0xFDu; 119 | NES.Register.set (NES.registers cpu) `P 0x34u; 120 | NES.PC.init (NES.pc cpu) (NES.memory cpu); 121 | NES.enable_decimal cpu false; 122 | let state = { cpu; apu; ppu; collector; input; cli_flags; rom } in 123 | let io = { debug = None; main_window = G.create cli_flags } in 124 | { state; io } 125 | 126 | let debug_callback t () = 127 | match t.io.debug with 128 | | None -> t.io.debug <- Some (P.Debug.create ()) 129 | | Some d -> 130 | P.Debug.delete d; 131 | t.io.debug <- None 132 | 133 | let run t = 134 | (* When the GUI is enabled, wait until the current NES frame is drawn before 135 | pausing, to avoid having a partial image *) 136 | let enable_gui_at_next_frame = ref false in 137 | let callbacks = 138 | Input. 139 | { 140 | toggle_debug = debug_callback t; 141 | save_state = Save_state.save t; 142 | load_state = Save_state.load t; 143 | toggle_gui = (fun () -> enable_gui_at_next_frame := true); 144 | } 145 | in 146 | G.set_save_state t.io.main_window (Save_state.save t); 147 | G.set_load_state t.io.main_window (Save_state.load t); 148 | let set_pixel = G.set_pixel t.io.main_window in 149 | let rec aux frame = 150 | if G.continue t.io.main_window then 151 | if G.shown t.io.main_window then ( 152 | (* Stop emulation when GUI is displayed, and don't collect inputs *) 153 | G.render t.io.main_window; 154 | aux (frame + 1)) 155 | else ( 156 | (* Normal emulation *) 157 | if frame mod 100 = 0 then I.get_inputs t.state.input callbacks; 158 | NES.next_cycle t.state.cpu; 159 | A.next_cycle t.state.apu; 160 | P.next_cycle t.state.ppu set_pixel; 161 | P.next_cycle t.state.ppu set_pixel; 162 | P.next_cycle t.state.ppu set_pixel; 163 | (match P.should_render t.state.ppu with 164 | | None -> () 165 | | Some bg_color -> 166 | A.output_frame t.state.apu; 167 | I.next_frame t.state.input; 168 | G.render_raw t.io.main_window; 169 | if !enable_gui_at_next_frame then ( 170 | G.toggle_gui t.io.main_window (); 171 | enable_gui_at_next_frame := false) 172 | else G.clear t.io.main_window bg_color); 173 | P.Debug.render t.state.ppu t.io.debug; 174 | aux (frame + 1)) 175 | in 176 | try aux 0 177 | with Common.End_of_movie -> Printf.printf "End of movie\n" (* end loop *) 178 | 179 | let close_io { io; state; _ } = 180 | A.exit state.apu; 181 | G.exit io.main_window 182 | end 183 | 184 | let input_backend movie record = 185 | match (movie, record) with 186 | | Some _, Some _ -> failwith "Cannot record while replaying movie" 187 | | Some path, None -> 188 | let module Movie = struct 189 | let file = path 190 | end in 191 | let module Movie_applied = Input_movie.Make_deter (Movie) in 192 | (module Movie_applied : Input.Backend) 193 | | None, Some path -> 194 | let module Out = struct 195 | let file = path 196 | end in 197 | let module Record_applied = Input_sdl.Make_record_deter (Out) in 198 | (module Record_applied) 199 | | None, None -> (module Input_sdl) 200 | 201 | let make_apu headless = 202 | let backend = 203 | if headless then (module Apu.Dummy_backend : Apu.Backend) 204 | else (module Apu.Normal_backend) 205 | in 206 | let module Backend = (val backend) in 207 | let module Applied = Apu.Make (Backend) in 208 | (module Applied : Apu.S) 209 | 210 | let make_gui headless disabled = 211 | let gui_func = 212 | if disabled then (module Gui.Disabled : Gui.SF) else (module Gui.Enabled) 213 | in 214 | let display = 215 | if headless then (module Display.Headless_backend : Display.S) 216 | else (module Display.Sdl_backend) 217 | in 218 | let module Gui_func = (val gui_func) in 219 | let module Display = (val display) in 220 | let module Applied = Gui_func (Display) in 221 | (module Applied : Gui.S) 222 | 223 | let run filename movie record uncap_speed save_mp4 headless gui_disabled = 224 | let gui_disabled = if headless then true else gui_disabled in 225 | let cli_flags = { uncap_speed; save_mp4 } in 226 | let collector = C6502.IRQ_collector.create () in 227 | let nmi = C6502.NMI.create () in 228 | let rom = Rom.load filename in 229 | let apu_m = make_apu headless in 230 | let module Apu = (val apu_m : Apu.S) in 231 | let apu = Apu.create collector cli_flags in 232 | let input_backend = input_backend movie record in 233 | let module Input_backend = (val input_backend : Input.Backend) in 234 | let module Input = Input.Make (Input_backend) in 235 | let input = Input.create () in 236 | let mapper = Mapper.find rom in 237 | (* Create the CPU from the Mapper and ROM *) 238 | let module Mapper = (val mapper : Mapper.S) in 239 | let mapper = Mapper.create rom in 240 | let module Ppu = Ppu.Make (Mapper) in 241 | let ppu = Ppu.create mapper nmi in 242 | let module Memory_Map = Build_NES (Ppu) (Apu) (Mapper) (Input) in 243 | let module NES = C6502.Make (Memory_Map) in 244 | let gui_m = make_gui headless gui_disabled in 245 | let module Gui = (val gui_m : Gui.S) in 246 | let module System = Main (Ppu) (Gui) (Apu) (Mapper) (Input) (NES) in 247 | let state = 248 | System.create { mapper; rom; apu; ppu; input } collector nmi cli_flags 249 | in 250 | (try System.run state 251 | with C6502.Invalid_instruction (addr, opcode) -> 252 | Format.printf 253 | "The CPU encountered an invalid instruction %a at address %a.\n" 254 | C6502.Utils.pp_u8 opcode C6502.Utils.pp_u16 addr); 255 | System.close_io state 256 | 257 | module Command_line = struct 258 | open Cmdliner 259 | 260 | let rom_arg = 261 | let doc = "Path to the ROM to run." in 262 | Arg.(required & pos 0 (some file) None & info [] ~docv:"ROM_PATH" ~doc) 263 | 264 | let movie_arg = 265 | let doc = "Optional input file as outputed by --record to be replayed" in 266 | let i = Arg.info [ "m"; "movie" ] ~docv:"MOVIE_PATH" ~doc in 267 | Arg.(value & opt (some file) None & i) 268 | 269 | let record_arg = 270 | let doc = "Record input log to given file in a custom format" in 271 | let i = Arg.info [ "r"; "record" ] ~docv:"OUTPUT_PATH" ~doc in 272 | Arg.(value & opt (some string) None & i) 273 | 274 | let save_arg = 275 | let doc = 276 | "Save a (lossless) mp4 movie of the run to the given path (need ffmpeg \ 277 | installed)" 278 | in 279 | let i = Arg.info [ "s"; "save" ] ~docv:"OUTPUT_PATH" ~doc in 280 | Arg.(value & opt (some string) None & i) 281 | 282 | let headless_arg = 283 | let doc = "Run in headless mode: no audio or video output" in 284 | let i = Arg.info [ "t"; "headless" ] ~doc in 285 | Arg.(value & flag i) 286 | 287 | let gui_arg = 288 | let doc = "Disable GUI" in 289 | let i = Arg.info [ "g"; "disable-gui" ] ~doc in 290 | Arg.(value & flag i) 291 | 292 | let speed_arg = 293 | let doc = "Uncap emulation speed" in 294 | let i = Arg.info [ "u"; "uncap" ] ~doc in 295 | Arg.(value & flag i) 296 | 297 | let run_term = 298 | Term.( 299 | const run $ rom_arg $ movie_arg $ record_arg $ speed_arg $ save_arg 300 | $ headless_arg $ gui_arg) 301 | 302 | let cmd = 303 | let doc = "experimental NES emulator written in OCaml" in 304 | let man = 305 | [ 306 | `S Manpage.s_bugs; 307 | `P "File bug reports at https://github.com/Firobe/nes-ml"; 308 | ] 309 | in 310 | let info = Cmd.info "nes-ml" ~doc ~man in 311 | Cmd.v info run_term 312 | 313 | let go () = exit (Cmd.eval cmd) 314 | end 315 | 316 | let () = Command_line.go () 317 | -------------------------------------------------------------------------------- /src/ppu.ml: -------------------------------------------------------------------------------- 1 | open Infix_int.Common 2 | 3 | (* Important links 4 | * - Memory map : https://wiki.nesdev.com/w/index.php/PPU_memory_map 5 | * - Rendering : https://wiki.nesdev.com/w/index.php/PPU_rendering 6 | * - Scrolling : https://wiki.nesdev.com/w/index.php/PPU_scrolling 7 | * - Pattern tables : https://wiki.nesdev.com/w/index.php/PPU_pattern_tables 8 | * - Name tables : https://wiki.nesdev.com/w/index.php/PPU_nametables 9 | * - Attribute tables : https://wiki.nesdev.com/w/index.php/PPU_attribute_tables 10 | * - Shift registers topic : https://forums.nesdev.com/viewtopic.php?t=10348 11 | * - Some more details on rendering : https://fceux.com/web/help/PPU.html 12 | *) 13 | 14 | let int_of_bool b = if b then 1 else 0 15 | let nth_bit b n = U8.(b $& (1u $<< n) <> 0u) 16 | 17 | let reverse_byte b = 18 | let cur = ref b in 19 | let res = ref 0u in 20 | let open U8 in 21 | for _ = 1 to 8 do 22 | res := !res $<< 1; 23 | res := !res + (!cur $& 1u); 24 | cur := !cur $>> 1 25 | done; 26 | !res 27 | 28 | module type S = sig 29 | open Stdint 30 | 31 | type t 32 | type mapper 33 | 34 | val create : mapper -> C6502.NMI.t -> t 35 | val frame : t -> int 36 | val get_register : t -> int -> uint8 37 | val set_register : t -> int -> uint8 -> unit 38 | val dma : t -> (uint16 -> uint8) -> uint16 -> unit 39 | val next_cycle : t -> Common.set_pixel -> unit 40 | val should_render : t -> uint8 option 41 | 42 | module Debug : sig 43 | type ppu := t 44 | type t 45 | 46 | val create : unit -> t 47 | val delete : t -> unit 48 | val render : ppu -> t option -> unit 49 | end 50 | end 51 | 52 | module Make (M : Mapper.S) = struct 53 | type mapper = M.t 54 | 55 | (** Main memory *) 56 | module Mem = struct 57 | type t = { 58 | mutable mem : M.t; 59 | mutable address : U16.t; 60 | mutable temp_address : U16.t; 61 | mutable latch : bool; 62 | mutable bus_latch : U8.t; 63 | } 64 | 65 | let create mapper = 66 | { 67 | mem = mapper; 68 | address = 0U; 69 | temp_address = 0U; 70 | (* 15-bit *) 71 | latch = true; 72 | (* True : first set *) 73 | bus_latch = 0x00u; 74 | } 75 | 76 | let read_latch t = 77 | let r = t.latch in 78 | t.latch <- not t.latch; 79 | r 80 | 81 | (* PPU memory address with redirections *) 82 | let address_indirection v = 83 | let open U16 in 84 | if v <= 0x2FFFU then v 85 | else if v <= 0x3EFFU then v $& 0x2FFFU 86 | else 87 | let v = v $& 0x3F1FU in 88 | if v $& 0x7U = 0U then v $& ?~0x10U else v 89 | 90 | module M = M.PPU 91 | 92 | let set t x = M.write t.mem (address_indirection t.address) x 93 | let get t v = M.read t.mem (address_indirection v) 94 | let get_raw t v = M.read t.mem v 95 | end 96 | 97 | module OAM = struct 98 | (* Fetching state machine *) 99 | module SM = struct 100 | type state = 101 | | Sleep of state (* rest 1 cycle, remember next state *) 102 | | CopyY 103 | (* read a sprite's Y-coordinate (OAM[n][0], copying it to the 104 | next open slot in secondary OAM *) 105 | | CopyRest of int (* copy remaining bytes OAM[n[1] thru OAM[n][3] *) 106 | | OverflowDetection of int (* buggy overflow detection loop *) 107 | | Full (* do not copy anything, increment n *) 108 | 109 | type t = { mutable state : state; mutable n : int } 110 | 111 | let create () = { state = CopyY; n = 0 } 112 | end 113 | 114 | type t = { 115 | primary : U8.t array; 116 | secondary : U8.t array; 117 | mutable address : U8.t; 118 | sm : SM.t; 119 | mutable next_open_slot : int; 120 | (* Contain pattern table data *) 121 | render_shifters : (U8.t ref * U8.t ref) array; 122 | (* Contain attribute bytes *) 123 | latches : U8.t array; 124 | (* Contain X positions *) 125 | counters : U8.t array; 126 | (* For optimisation *) 127 | (* True if on the current scanline, shifter 0 contains sprite 0 data *) 128 | mutable sprite_0_here : bool; 129 | (* Number of spries to display this scanline, for optimization purposes *) 130 | mutable last_sprite_this_scanline : int; 131 | } 132 | 133 | let create () = 134 | { 135 | address = 0u; 136 | primary = Array.make 0x100 0u; 137 | secondary = Array.make 0x20 0u; 138 | next_open_slot = 0; 139 | sm = SM.create (); 140 | render_shifters = Array.init 8 (fun _ -> (ref 0u, ref 0u)); 141 | latches = Array.make 8 0u; 142 | counters = Array.make 8 0u; 143 | sprite_0_here = false; 144 | last_sprite_this_scanline = 0; 145 | } 146 | 147 | let get_byte t n m = t.primary.((4 * n) + m) 148 | 149 | let decrease_sprite_counters t = 150 | (* Opti *) 151 | for i = 0 to t.last_sprite_this_scanline do 152 | let v = t.counters.(i) in 153 | if v <> 0u then t.counters.(i) <- U8.(pred v) 154 | done 155 | 156 | let pixel t = 157 | let found = ref false in 158 | let color = ref (0u, 0u, false, false) in 159 | for i = 0 to t.last_sprite_this_scanline do 160 | (* sprite is active *) 161 | if (not !found) && t.counters.(i) = 0u then 162 | let low, high = t.render_shifters.(i) in 163 | let scroll = 7 in 164 | let pat = 165 | U8.(!high $>> scroll $<< 1 $| (!low $>> scroll $& 1u) $& 3u) 166 | in 167 | (* opaque pixel *) 168 | if pat <> 0u then ( 169 | found := true; 170 | let pal = U8.(t.latches.(i) $& 0x3u) in 171 | let priority = nth_bit t.latches.(i) 5 in 172 | color := (pat, pal, priority, i = 0 && t.sprite_0_here)) 173 | done; 174 | !color 175 | end 176 | 177 | (* Control register *) 178 | module Control = struct 179 | type t = { 180 | mutable increment : U16.t; 181 | mutable sprite_pattern_address : U16.t; 182 | mutable background_pattern_address : U16.t; 183 | mutable sprite_size : bool; 184 | mutable master_slave_mode : bool; 185 | mutable nmi_enabled : bool; 186 | } 187 | 188 | let create () = 189 | { 190 | increment = 1U; 191 | sprite_pattern_address = 0x0000U; 192 | background_pattern_address = 0x0000U; 193 | sprite_size = false; 194 | master_slave_mode = false; 195 | nmi_enabled = false; 196 | } 197 | end 198 | 199 | (* Mask register *) 200 | module Graphics = struct 201 | type t = { 202 | mutable greyscale : bool; 203 | mutable background_leftmost : bool; 204 | mutable sprites_leftmost : bool; 205 | mutable background : bool; 206 | mutable sprites : bool; 207 | mutable emph_red : bool; 208 | mutable emph_green : bool; 209 | mutable emph_blue : bool; 210 | } 211 | 212 | let create () = 213 | { 214 | greyscale = false; 215 | background_leftmost = false; 216 | sprites_leftmost = false; 217 | background = false; 218 | sprites = false; 219 | emph_red = false; 220 | emph_green = false; 221 | emph_blue = false; 222 | } 223 | 224 | let is_rendering t = t.background || t.sprites 225 | end 226 | 227 | (* Status register *) 228 | module Status = struct 229 | type t = { 230 | mutable sprite_0_hit : bool; 231 | mutable vblank_enabled : bool; 232 | mutable vbl_read : bool; 233 | } 234 | 235 | let create () = 236 | { sprite_0_hit = false; vblank_enabled = true; vbl_read = false } 237 | end 238 | 239 | module Rendering = struct 240 | module BG = struct 241 | (* For storing pattern table data for two tiles *) 242 | type t = { 243 | mutable low : U16.t; 244 | mutable high : U16.t; 245 | mutable next_low : U8.t; 246 | mutable next_high : U8.t; 247 | } 248 | 249 | let create () = { low = 0U; high = 0U; next_low = 0u; next_high = 0u } 250 | end 251 | 252 | module AT = struct 253 | type t = { 254 | (* For storing palette attributes *) 255 | mutable low : U8.t; 256 | mutable high : U8.t; 257 | mutable low_next : bool; 258 | mutable high_next : bool; 259 | mutable next : U8.t; 260 | } 261 | 262 | let create () = 263 | { low = 0u; high = 0u; low_next = false; high_next = false; next = 0u } 264 | end 265 | 266 | module NT = struct 267 | type t = { mutable next : U8.t } 268 | 269 | let create () = { next = 0u } 270 | end 271 | 272 | type t = { 273 | mutable frame : int; 274 | mutable scanline : int; 275 | mutable cycle : int; 276 | bg : BG.t; 277 | at : AT.t; 278 | nt : NT.t; 279 | } 280 | 281 | let create () = 282 | { 283 | frame = 0; 284 | scanline = 261; 285 | cycle = 0; 286 | bg = BG.create (); 287 | at = AT.create (); 288 | nt = NT.create (); 289 | } 290 | end 291 | 292 | type t = { 293 | memory : Mem.t; 294 | oam : OAM.t; 295 | control : Control.t; 296 | graphics : Graphics.t; 297 | status : Status.t; 298 | rendering : Rendering.t; 299 | nmi : C6502.NMI.t; 300 | mutable fine_x_scroll : U8.t; 301 | mutable vram_buffer : U8.t; 302 | mutable should_render : Stdint.uint8 option; 303 | } 304 | 305 | let create mapper nmi = 306 | { 307 | memory = Mem.create mapper; 308 | oam = OAM.create (); 309 | control = Control.create (); 310 | graphics = Graphics.create (); 311 | status = Status.create (); 312 | rendering = Rendering.create (); 313 | nmi; 314 | (* Scrolling *) 315 | fine_x_scroll = 0u; 316 | (* Latch for PPUSCROLL and PPUADDR *) 317 | vram_buffer = 0u; 318 | should_render = None; 319 | } 320 | 321 | let frame t = t.rendering.frame 322 | 323 | let increment_ppu_address t = 324 | t.memory.address <- U16.(t.memory.address + t.control.increment $& 0x3FFFU) 325 | 326 | open C6502.Utils 327 | 328 | let set_register t register (v : U8.t) = 329 | let open U16 in 330 | t.memory.bus_latch <- v; 331 | match register with 332 | | 0 -> 333 | (* Control register *) 334 | (* t: ...GH.. ........ <- d: ......GH *) 335 | let to_set = ?$U8.(v $& 3u) $<< 10 in 336 | let with_hole = t.memory.temp_address $& 0x73FFU in 337 | t.memory.temp_address <- to_set $| with_hole; 338 | t.control.increment <- (if nth_bit v 2 then 32U else 1U); 339 | t.control.sprite_pattern_address <- 340 | (if nth_bit v 3 then 0x1000U else 0U); 341 | t.control.background_pattern_address <- 342 | (if nth_bit v 4 then 0x1000U else 0U); 343 | t.control.sprite_size <- nth_bit v 5; 344 | t.control.master_slave_mode <- nth_bit v 6; 345 | let old_nmi = t.control.nmi_enabled in 346 | t.control.nmi_enabled <- nth_bit v 7; 347 | (* If NMI enabled during VBLANK, interrupt now *) 348 | if 349 | t.control.nmi_enabled && (not old_nmi) && t.status.vblank_enabled 350 | && not t.status.vbl_read 351 | then C6502.NMI.pull t.nmi 352 | | 1 -> 353 | (* Mask register *) 354 | t.graphics.greyscale <- nth_bit v 0; 355 | t.graphics.background_leftmost <- nth_bit v 1; 356 | t.graphics.sprites_leftmost <- nth_bit v 2; 357 | t.graphics.background <- nth_bit v 3; 358 | t.graphics.sprites <- nth_bit v 4; 359 | t.graphics.emph_red <- nth_bit v 5; 360 | t.graphics.emph_green <- nth_bit v 6; 361 | t.graphics.emph_blue <- nth_bit v 7 362 | | 3 -> 363 | (* OAM address *) 364 | t.oam.address <- v 365 | | 4 -> 366 | (* OAM data *) 367 | t.oam.primary.(U8.to_int t.oam.address) <- v; 368 | t.oam.address <- U8.(succ t.oam.address) 369 | | 5 -> 370 | (* Scroll register *) 371 | if Mem.read_latch t.memory then ( 372 | (* t: ....... ...ABCDE <- d: ABCDE... *) 373 | let to_set = ?$v $>> 3 in 374 | let with_hole = t.memory.temp_address $& 0xFFFE0U in 375 | t.memory.temp_address <- to_set $| with_hole; 376 | (* x: FGH <- d: .....FGH *) 377 | t.fine_x_scroll <- U8.(v $& 7u)) 378 | else 379 | (* t: FGH..AB CDE..... <- d: ABCDEFGH *) 380 | let fgh = ?$U8.(v $& 7u) $<< 12 in 381 | let abcde = ?$U8.(v $& 0xF8u) $<< 2 in 382 | let with_hole = t.memory.temp_address $& 0xC1FU in 383 | let with_fgh = with_hole $| fgh in 384 | t.memory.temp_address <- with_fgh $| abcde 385 | | 6 -> 386 | (* PPU address *) 387 | if Mem.read_latch t.memory then 388 | (* t: .CDEFGH ........ <- d: ..CDEFGH 389 | <- d: AB...... 390 | t: Z...... ........ <- 0 (bit Z is cleared) *) 391 | t.memory.temp_address <- 392 | mk_addr ~lo:(get_lo t.memory.temp_address) ~hi:v $& 0x3FFFU 393 | else ( 394 | (* t: ....... ABCDEFGH <- d: ABCDEFGH 395 | v: <...all bits...> <- t: <...all bits...> *) 396 | t.memory.temp_address <- 397 | mk_addr ~hi:(get_hi t.memory.temp_address) ~lo:v; 398 | t.memory.address <- t.memory.temp_address) 399 | | 7 -> 400 | (* PPU data *) 401 | Mem.set t.memory v; 402 | increment_ppu_address t 403 | | _ -> Printf.printf "Warning: trying to set PPU register %d\n" register 404 | 405 | let get_register t reg = 406 | let open U16 in 407 | let res = 408 | match reg with 409 | | 2 -> 410 | (* Status register *) 411 | t.memory.latch <- true; 412 | let r = 413 | (int_of_bool t.status.vblank_enabled lsl 7) 414 | lor (int_of_bool t.status.sprite_0_hit lsl 6) 415 | in 416 | t.status.vbl_read <- true; 417 | t.status.vblank_enabled <- false; 418 | u8 r 419 | | 4 -> 420 | (* OAM data *) 421 | t.oam.primary.(U8.to_int t.oam.address) 422 | | 7 -> 423 | (* PPU data *) 424 | (* Palette mirroring *) 425 | let addr = Mem.address_indirection t.memory.address in 426 | increment_ppu_address t; 427 | (* Correct buffer *) 428 | if addr >= 0x3F00U then ( 429 | (* TODO what is this ? why are we doing this ? *) 430 | t.vram_buffer <- Mem.get t.memory (addr $& 0x2F1FU); 431 | Mem.get t.memory addr) 432 | else 433 | let old = t.vram_buffer in 434 | t.vram_buffer <- Mem.get t.memory addr; 435 | old 436 | | _ -> t.memory.bus_latch 437 | in 438 | t.memory.bus_latch <- res; 439 | res 440 | 441 | let dma t read cpu_begin = 442 | let t = t.oam in 443 | let rec aux cpu_addr oam_addr length = 444 | if length > 0 then ( 445 | t.primary.(U8.to_int oam_addr) <- read cpu_addr; 446 | aux U16.(succ cpu_addr) U8.(succ oam_addr) (length - 1)) 447 | in 448 | aux cpu_begin t.address 0x100 449 | 450 | module R = struct 451 | let draw_pixel t disp x y pal_start ~pal:palette_nb ~pat:color_nb = 452 | if color_nb <> 0u then 453 | (* Get a palette address, a palette number and a color number, give the 454 | * corresponding color *) 455 | let address = 456 | U16.(pal_start + (u16of8 palette_nb * 4U) + u16of8 color_nb) 457 | in 458 | let color = Mem.get t.memory address in 459 | disp ~x:(U8.to_int x) ~y:(U8.to_int y) ~color 460 | 461 | let copy_bits_16 ~src ~dst mask = 462 | let open U16 in 463 | let to_set = src $& mask in 464 | let with_hole = dst $& ?~mask in 465 | to_set $| with_hole 466 | 467 | let inc_hori old = 468 | let v = ref old in 469 | let open U16 in 470 | let coarse = !v $& 0x001FU in 471 | if coarse = 0x1FU then ( 472 | v := !v $& ?~0x1FU; 473 | v := !v $^ 0x0400U) 474 | else v := !v + 1U; 475 | !v 476 | 477 | let inc_vert old = 478 | let v = ref old in 479 | let open U16 in 480 | if !v $& 0x7000U <> 0x7000U then v := !v + 0x1000U 481 | else ( 482 | v := !v $& ?~0x7000U; 483 | let y = ref (!v $& 0x03E0U $>> 5) in 484 | if !y = 29U then ( 485 | y := 0U; 486 | v := !v $^ 0x0800U) 487 | else if !y = 31U then y := 0U 488 | else y := !y + 1U; 489 | v := !v $& ?~0x03E0U $| (!y $<< 5)); 490 | !v 491 | 492 | let pat_address t ~bank ~offset = 493 | let open U16 in 494 | let v = t.memory.address in 495 | let offset = offset * 16U in 496 | let finey = v $& 0x7000U $>> 12 in 497 | bank + offset + finey 498 | 499 | let fetch_next_data t = 500 | let module U8 = Stdint.Uint8 in 501 | let module U16 = Stdint.Uint16 in 502 | let r = t.rendering in 503 | (* Step number in the fetching process *) 504 | let local_step = r.cycle mod 8 in 505 | let open U16 in 506 | (* Every 8 cycles (9, 17, 25, ..., 257 *) 507 | (* Actual memory fetching *) 508 | (* Only 12 first bits of address should be used *) 509 | match local_step with 510 | | 0 -> 511 | t.memory.address <- inc_hori t.memory.address; 512 | if r.cycle = 256 then t.memory.address <- inc_vert t.memory.address 513 | | 1 -> 514 | if r.cycle <> 0 then ( 515 | (* Reload shifters *) 516 | r.bg.low <- mk_addr ~lo:r.bg.next_low ~hi:(get_hi r.bg.low); 517 | r.bg.high <- mk_addr ~lo:r.bg.next_high ~hi:(get_hi r.bg.high); 518 | r.at.low_next <- U8.(logand 0x1u r.at.next <> 0u); 519 | r.at.high_next <- U8.(logand 0x2u r.at.next <> 0u)); 520 | (* load r.nt byte to shift8_r.nt_next *) 521 | let v = t.memory.address in 522 | let tile_address = logor 0x2000U (logand v 0xFFFU) in 523 | r.nt.next <- Mem.get t.memory tile_address 524 | | 3 -> 525 | (* load r.at byte to shift8_r.at_next *) 526 | (* stolen from mesen *) 527 | let v = t.memory.address in 528 | let addr = 529 | logor 0x23C0U 530 | (logor 531 | (logor (logand v 0x0C00U) 532 | (logand (shift_right_logical v 4) 0x38U)) 533 | (logand (shift_right_logical v 2) 0x7U)) 534 | in 535 | let data = of_uint8 (Mem.get t.memory addr) in 536 | let shift = 537 | to_int 538 | (logor (logand 0x04U (shift_right_logical v 4)) (logand v 0x02U)) 539 | in 540 | r.at.next <- to_uint8 (logand 0x3U (shift_right_logical data shift)) 541 | | 5 -> 542 | (* load low r.bg tile byte to next_r.bg_low (pr.attern table) *) 543 | let offset = of_uint8 r.nt.next in 544 | let bank = t.control.background_pattern_address in 545 | let addr = pat_address t ~bank ~offset in 546 | r.bg.next_low <- Mem.get t.memory addr 547 | | 7 -> 548 | (* load high r.bg tile byte to next_r.bg_high *) 549 | let offset = of_uint8 r.nt.next in 550 | let bank = t.control.background_pattern_address in 551 | let addr = pat_address t ~bank ~offset in 552 | r.bg.next_high <- Mem.get t.memory (addr + 8U) 553 | | _ -> () 554 | 555 | let render_pixel t disp = 556 | let module U8 = Stdint.Uint8 in 557 | let module U16 = Stdint.Uint16 in 558 | let r = t.rendering in 559 | let x = U8.of_int (r.cycle - 1) in 560 | let y = U8.of_int r.scanline in 561 | let pat, pal = 562 | if t.graphics.background then 563 | let scroll1 = 15 - U8.to_int t.fine_x_scroll in 564 | let scroll2 = 7 - U8.to_int t.fine_x_scroll in 565 | let rbglow = U16.to_int r.bg.low in 566 | let rbghigh = U16.to_int r.bg.high in 567 | let patl = (rbglow lsr scroll1) land 1 in 568 | let path = (rbghigh lsr scroll1) land 1 in 569 | let pat = patl lor (path lsl 1) land 0xFF in 570 | let rathigh = U8.to_int r.at.high in 571 | let ratlow = U8.to_int r.at.low in 572 | let pal = 573 | ((rathigh lsr scroll2) lsl 1) 574 | lor ((ratlow lsr scroll2) land 1) 575 | land 3 576 | in 577 | let pat = U8.of_int pat in 578 | let pal = U8.of_int pal in 579 | (pat, pal) 580 | else (0u, 0u) 581 | in 582 | let spat, spal, priority, sprite_0 = 583 | if t.graphics.sprites then OAM.pixel t.oam else (0u, 0u, false, false) 584 | in 585 | match U8.(to_int pat, to_int spat, priority) with 586 | | _, 0, _ -> draw_pixel t disp x y 0x3F00U ~pal ~pat 587 | | 0, _, _ -> draw_pixel t disp x y 0x3F10U ~pal:spal ~pat:spat 588 | | _, _, false -> 589 | if sprite_0 then t.status.sprite_0_hit <- true; 590 | draw_pixel t disp x y 0x3F10U ~pal:spal ~pat:spat 591 | | _, _, true -> 592 | if sprite_0 then t.status.sprite_0_hit <- true; 593 | draw_pixel t disp x y 0x3F00U ~pal ~pat 594 | 595 | let shift_registers t = 596 | let module U8 = Stdint.Uint8 in 597 | let module U16 = Stdint.Uint16 in 598 | let r = t.rendering in 599 | r.bg.low <- U16.(shift_left r.bg.low 1); 600 | r.bg.high <- U16.(shift_left r.bg.high 1); 601 | r.at.low <- U8.(shift_left r.at.low 1); 602 | r.at.high <- U8.(shift_left r.at.high 1); 603 | r.at.low <- (if r.at.low_next then U8.(logor r.at.low 1u) else r.at.low); 604 | r.at.high <- 605 | (if r.at.high_next then U8.(logor r.at.high 1u) else r.at.high); 606 | for i = 0 to t.oam.last_sprite_this_scanline do 607 | (* sprite is active *) 608 | if t.oam.counters.(i) = 0u then ( 609 | let low, high = t.oam.render_shifters.(i) in 610 | (low := U8.(shift_left !low 1)); 611 | high := U8.(shift_left !high 1)) 612 | done 613 | 614 | let data_fetching t disp render = 615 | let r = t.rendering in 616 | (* Cycle 0 : IDLE *) 617 | if r.cycle = 0 then () (* Cycles 1 - 256 : BACKGROUND FETCHING *) 618 | else if r.cycle <= 256 && Graphics.is_rendering t.graphics then ( 619 | fetch_next_data t; 620 | (* Pixel rendering *) 621 | if render && (r.cycle > 8 || t.graphics.background_leftmost) then 622 | render_pixel t disp; 623 | shift_registers t; 624 | OAM.decrease_sprite_counters t.oam 625 | (* Cycles 257 - 320 : NEXT SPRITES FETCHING in another function *)) 626 | else if r.cycle <= 320 then ( 627 | if 628 | (* If rendering is enabled, the PPU copies all bits related to 629 | * horizontal position from t to v *) 630 | (* v: ....A.. ...BCDEF <- t: ....A.. ...BCDEF *) 631 | r.cycle = 257 && Graphics.is_rendering t.graphics 632 | then 633 | t.memory.address <- 634 | copy_bits_16 ~src:t.memory.temp_address ~dst:t.memory.address 0x41FU 635 | (* Cycles 321 - 336 : NEXT TWO TILES FETCHING *)) 636 | else if r.cycle <= 336 && Graphics.is_rendering t.graphics then ( 637 | fetch_next_data t; 638 | shift_registers t (* Cycles 337-340 : USELESS *)) 639 | else () 640 | 641 | let y_in_range t y_pos = 642 | let offset = if t.control.sprite_size then 16 else 8 in 643 | let y_pos = U8.to_int y_pos in 644 | let scanline = t.rendering.scanline in 645 | y_pos <= scanline && scanline < y_pos + offset 646 | 647 | let sprite_evaluation t = 648 | let open OAM in 649 | let o = t.oam in 650 | let set_next s = o.sm.state <- Sleep s in 651 | let decide_next () = 652 | if o.sm.n = 0 then SM.Full 653 | else if o.next_open_slot < 32 then SM.CopyY 654 | else SM.OverflowDetection 0 655 | in 656 | match o.sm.state with 657 | | Sleep next -> o.sm.state <- next 658 | | CopyY -> 659 | let y_pos = OAM.get_byte o o.sm.n 0 in 660 | o.secondary.(o.next_open_slot) <- y_pos; 661 | if y_in_range t y_pos then ( 662 | if o.sm.n = 0 then o.sprite_0_here <- true; 663 | o.next_open_slot <- o.next_open_slot + 1; 664 | set_next (CopyRest 1)) 665 | else ( 666 | o.sm.n <- (o.sm.n + 1) land 0x3f; 667 | set_next (decide_next ())) 668 | | CopyRest m -> 669 | o.secondary.(o.next_open_slot) <- OAM.get_byte o o.sm.n m; 670 | o.next_open_slot <- o.next_open_slot + 1; 671 | if m = 3 then ( 672 | o.sm.n <- (o.sm.n + 1) land 0x3f; 673 | set_next (decide_next ())) 674 | else set_next (CopyRest (m + 1)) 675 | | OverflowDetection _ -> () (* TODO *) 676 | | Full -> () 677 | 678 | let fetch_sprite t = 679 | let o = t.oam in 680 | let r = t.rendering in 681 | let get_oam'_byte n m = o.secondary.((4 * n) + m) in 682 | let sn = (r.cycle - 257) / 8 in 683 | let step = (r.cycle - 257) mod 8 in 684 | let enabled = sn < o.next_open_slot / 4 in 685 | let fetch_tile_8 ~high = 686 | let y_pos = get_oam'_byte sn 0 in 687 | let fine_offset = U16.(?@(r.scanline) - ?$y_pos) in 688 | (* Flip vertically *) 689 | let fine_offset = 690 | if nth_bit o.latches.(sn) 7 then U16.(7U - fine_offset) 691 | else fine_offset 692 | in 693 | let index = get_oam'_byte sn 1 in 694 | let bank = t.control.sprite_pattern_address in 695 | let open U16 in 696 | let offset = of_uint8 index in 697 | let offset = offset * 16U in 698 | let addr = bank + offset + fine_offset in 699 | let addr = if high then U16.(addr + 8U) else addr in 700 | let data = Mem.get t.memory addr in 701 | (* Flip horizontally *) 702 | if nth_bit o.latches.(sn) 6 then reverse_byte data else data 703 | in 704 | let fetch_tile_16 ~high = 705 | let y_pos = get_oam'_byte sn 0 in 706 | let row = r.scanline - U8.(?%y_pos) in 707 | let vert_flip = nth_bit o.latches.(sn) 7 in 708 | let tile_nb = if row < 8 <> vert_flip then 0U else 1U in 709 | let y_offset = U16.(?@(row mod 8)) in 710 | let y_offset = if vert_flip then U16.(7U - y_offset) else y_offset in 711 | let index = get_oam'_byte sn 1 in 712 | let bank = if nth_bit index 0 then 0x1000U else 0x0U in 713 | let index' = U16.((U8.(index $& ?~1u) |> U16.of_uint8) + tile_nb) in 714 | let offset = U16.(index' * 16U) in 715 | let open U16 in 716 | let addr = bank + offset + y_offset in 717 | let addr = if high then U16.(addr + 8U) else addr in 718 | let data = Mem.get t.memory addr in 719 | (* Flip horizontally *) 720 | if nth_bit o.latches.(sn) 6 then reverse_byte data else data 721 | in 722 | let fetch = 723 | if t.control.sprite_size then fetch_tile_16 else fetch_tile_8 724 | in 725 | match step with 726 | | 2 -> o.latches.(sn) <- get_oam'_byte sn 2 727 | | 3 -> o.counters.(sn) <- get_oam'_byte sn 3 728 | | 4 when enabled -> fst o.render_shifters.(sn) := fetch ~high:false 729 | | 6 when enabled -> snd o.render_shifters.(sn) := fetch ~high:true 730 | | 4 -> fst o.render_shifters.(sn) := 0u 731 | | 6 -> fst o.render_shifters.(sn) := 0u 732 | | _ -> () 733 | 734 | let sprite_fetching t = 735 | let r = t.rendering in 736 | let o = t.oam in 737 | (* Cycle 0: IDLE *) 738 | if r.cycle = 0 then () (* Cycles 1-64: clear OAM' *) 739 | else if r.cycle <= 64 && r.cycle mod 2 = 0 then 740 | o.secondary.((r.cycle - 1) / 2) <- 0xFFu 741 | (* Cycles 65-256: sprite evaluation *) 742 | else if r.cycle <= 256 then ( 743 | if r.cycle = 65 then ( 744 | o.sm.state <- CopyY; 745 | o.next_open_slot <- 0; 746 | o.sm.n <- 0; 747 | o.sprite_0_here <- false); 748 | sprite_evaluation t (* Cycles 257-320: sprite tile fetching *)) 749 | else if r.cycle <= 320 then ( 750 | o.last_sprite_this_scanline <- (o.next_open_slot / 4) - 1; 751 | fetch_sprite t (* Cycles 321-340: IDLE *)) 752 | else () 753 | 754 | let pre_rendering t disp = 755 | let r = t.rendering in 756 | (* Clear VBLANK *) 757 | if r.cycle = 1 then t.status.vblank_enabled <- false; 758 | (* Fetch data for next frame *) 759 | sprite_fetching t; 760 | data_fetching t disp false; 761 | (* If rendering is enabled, at the end of vblank, shortly after 762 | * the horizontal bits are copied from t to v at dot 257, the PPU 763 | * will repeatedly copy the vertical bits from t to v from dots 764 | * 280 to 304, completing the full initialization of v from t: *) 765 | if r.cycle >= 280 && r.cycle <= 304 && Graphics.is_rendering t.graphics 766 | then 767 | t.memory.address <- 768 | copy_bits_16 ~src:t.memory.temp_address ~dst:t.memory.address 0x7BE0U 769 | (* Final dot : change everything *) 770 | else if r.cycle = 340 then ( 771 | t.status.sprite_0_hit <- false; 772 | r.frame <- r.frame + 1; 773 | t.should_render <- Some (Mem.get_raw t.memory 0x3F00U); 774 | (* this should be at cycle 1 *) 775 | (* Odd frame : jump to (0, 0) directly *) 776 | if r.frame mod 2 = 1 && Graphics.is_rendering t.graphics then ( 777 | r.scanline <- 0; 778 | r.cycle <- 0)) 779 | 780 | let increment_cycle t = 781 | let r = t.rendering in 782 | (* Next cycle *) 783 | r.cycle <- r.cycle + 1; 784 | if r.cycle = 341 then ( 785 | r.cycle <- 0; 786 | (* Next scanline *) 787 | r.scanline <- r.scanline + 1; 788 | if r.scanline = 262 then (* End of frame *) 789 | r.scanline <- 0); 790 | t.status.vbl_read <- false 791 | 792 | let next_cycle t disp = 793 | let r = t.rendering in 794 | (* Process *) 795 | (* Visible scanlines : 0 - 239 *) 796 | if r.scanline <= 239 then ( 797 | sprite_fetching t; 798 | data_fetching t disp true (* Post-render scanline : 240 (IDLE) *)) 799 | else if r.scanline = 240 then () (* Vertical blanking *) 800 | else if r.scanline = 241 && r.cycle = 1 then ( 801 | if not t.status.vbl_read then t.status.vblank_enabled <- true; 802 | if t.control.nmi_enabled && not t.status.vbl_read then 803 | C6502.NMI.pull t.nmi (* Last vertical blanking lines : IDLE *)) 804 | else if r.scanline <= 260 then () (* Pre-rendering scanline *) 805 | else pre_rendering t disp; 806 | increment_cycle t 807 | end 808 | 809 | let should_render t = 810 | let old = t.should_render in 811 | t.should_render <- None; 812 | old 813 | 814 | let next_cycle = R.next_cycle 815 | 816 | module Debug = struct 817 | module Display = Display.Sdl_backend 818 | 819 | type t = { 820 | names : Display.t; 821 | attributes : Display.t; 822 | patterns : Display.t; 823 | mutable counter : int; 824 | } 825 | 826 | let palette = Ppu_display.palette 827 | let pal_4 = [ 0x000000; 0xFF0000; 0x00FF00; 0x0000FF ] 828 | 829 | let create () = 830 | { 831 | names = 832 | Display.create ~width:64 ~height:62 ~scale:8 ~palette 833 | "Name tables + palettes"; 834 | attributes = 835 | Display.create ~width:32 ~height:32 ~scale:16 ~palette:pal_4 836 | "Attribute tables"; 837 | patterns = 838 | Display.create ~width:256 ~height:128 ~scale:4 ~palette:pal_4 839 | "Pattern tables"; 840 | counter = 0; 841 | } 842 | 843 | let delete t = 844 | Display.delete t.names; 845 | Display.delete t.attributes; 846 | Display.delete t.patterns 847 | 848 | let render_nametables t disp = 849 | let set_nametable addr x_orig y_orig = 850 | for y = 0 to 29 do 851 | for x = 0 to 31 do 852 | let addr = addr + (y * 32) + x in 853 | let v = Mem.get t.memory (U16.of_int addr) in 854 | Display.set_pixel disp ~x:(x + x_orig) ~y:(y + y_orig) ~color:v 855 | done 856 | done 857 | in 858 | set_nametable 0x2000 0 0; 859 | set_nametable 0x2400 32 0; 860 | set_nametable 0x2800 0 30; 861 | set_nametable 0x2C00 32 30; 862 | for x = 0 to 63 do 863 | Display.set_pixel disp ~x ~y:60 ~color:(U8.of_int x) 864 | done; 865 | for x = 0 to 31 do 866 | let color = Mem.get_raw t.memory U16.(0x3F00U + ?@x) in 867 | Display.set_pixel disp ~x:(x * 2) ~y:61 ~color; 868 | Display.set_pixel disp ~x:((x * 2) + 1) ~y:61 ~color 869 | done 870 | 871 | let render_attributes t disp = 872 | let set_attr addr x_orig y_orig = 873 | for y = 0 to 7 do 874 | for x = 0 to 7 do 875 | let addr = addr + (y * 8) + x in 876 | let v = Mem.get_raw t.memory U16.(?@addr) in 877 | let x' = (x * 2) + x_orig in 878 | let y' = (y * 2) + y_orig in 879 | let open U8 in 880 | let top_left = v $& 0x3u in 881 | let top_right = v $>> 2 $& 0x3u in 882 | let bot_left = v $>> 4 $& 0x3u in 883 | let bot_right = v $>> 6 $& 0x3u in 884 | let open Stdlib in 885 | Display.set_pixel disp ~x:x' ~y:y' ~color:top_left; 886 | Display.set_pixel disp ~x:(x' + 1) ~y:y' ~color:top_right; 887 | Display.set_pixel disp ~x:x' ~y:(y' + 1) ~color:bot_left; 888 | Display.set_pixel disp ~x:(x' + 1) ~y:(y' + 1) ~color:bot_right 889 | done 890 | done 891 | in 892 | set_attr 0x23C0 0 0; 893 | set_attr 0x27C0 16 0; 894 | set_attr 0x2BC0 0 16; 895 | set_attr 0x2FC0 16 16 896 | 897 | let render_patterns t disp = 898 | let set_pattern addr x_orig y_orig = 899 | for tile_y = 0 to 15 do 900 | for tile_x = 0 to 15 do 901 | let addr = addr + (((tile_y * 16) + tile_x) * 16) in 902 | for y = 0 to 7 do 903 | for x = 0 to 7 do 904 | let low = Mem.get_raw t.memory U16.(?@addr + ?@y) in 905 | let high = Mem.get_raw t.memory U16.(?@addr + ?@y + 8U) in 906 | let shift = 7 - x in 907 | let open U8 in 908 | let low = low $>> shift $& 1u in 909 | let high = high $>> shift $& 1u in 910 | let color = low $| high * 2u in 911 | let open Stdlib in 912 | Display.set_pixel disp 913 | ~x:((tile_x * 8) + x + x_orig) 914 | ~y:((tile_y * 8) + y + y_orig) 915 | ~color 916 | done 917 | done 918 | done 919 | done 920 | in 921 | set_pattern 0x0000 0 0; 922 | set_pattern 0x1000 128 0 923 | 924 | let cooldown = 1000000 925 | 926 | let render t = function 927 | | None -> () 928 | | Some ({ names; attributes; patterns; _ } as s) -> 929 | if s.counter = 0 then ( 930 | render_nametables t names; 931 | render_attributes t attributes; 932 | render_patterns t patterns; 933 | Display.render names; 934 | Display.render attributes; 935 | Display.render patterns; 936 | s.counter <- cooldown); 937 | s.counter <- s.counter - 1 938 | end 939 | end 940 | -------------------------------------------------------------------------------- /src/ppu.mli: -------------------------------------------------------------------------------- 1 | (** Emulate and interface with a PPU chip *) 2 | 3 | open Stdint 4 | 5 | module type S = sig 6 | type t 7 | type mapper 8 | 9 | val create : mapper -> C6502.NMI.t -> t 10 | (** Create the chip from a fixed mirroring kind and a NMI channel to the CPU *) 11 | 12 | val frame : t -> int 13 | (** Current frame number *) 14 | 15 | val get_register : t -> int -> uint8 16 | (** Emulate reading from an address of the PPU *) 17 | 18 | val set_register : t -> int -> uint8 -> unit 19 | (** Same, for writing *) 20 | 21 | val dma : t -> (uint16 -> uint8) -> uint16 -> unit 22 | (** Direct Memory Access: given the PPU, a function to read from CPU addresses 23 | and a starting PPU address, blit the memory *) 24 | 25 | val next_cycle : t -> Common.set_pixel -> unit 26 | (** Emulate next cycle of the PPU *) 27 | 28 | val should_render : t -> uint8 option 29 | 30 | (** Create and destroy the windows dedicated to the PPU debugging *) 31 | module Debug : sig 32 | type ppu := t 33 | type t 34 | 35 | val create : unit -> t 36 | val delete : t -> unit 37 | val render : ppu -> t option -> unit 38 | end 39 | end 40 | 41 | module Make (M : Mapper.S) : S with type mapper = M.t 42 | -------------------------------------------------------------------------------- /src/ppu_display.ml: -------------------------------------------------------------------------------- 1 | let palette = 2 | [ 3 | 0x7C7C7C; 4 | 0x0000FC; 5 | 0x0000BC; 6 | 0x4428BC; 7 | 0x940084; 8 | 0xA80020; 9 | 0xA81000; 10 | 0x881400; 11 | 0x503000; 12 | 0x007800; 13 | 0x006800; 14 | 0x005800; 15 | 0x004058; 16 | 0x000000; 17 | 0x000000; 18 | 0x000000; 19 | 0xBCBCBC; 20 | 0x0078F8; 21 | 0x0058F8; 22 | 0x6844FC; 23 | 0xD800CC; 24 | 0xE40058; 25 | 0xF83800; 26 | 0xE45C10; 27 | 0xAC7C00; 28 | 0x00B800; 29 | 0x00A800; 30 | 0x00A844; 31 | 0x008888; 32 | 0x000000; 33 | 0x000000; 34 | 0x000000; 35 | 0xF8F8F8; 36 | 0x3CBCFC; 37 | 0x6888FC; 38 | 0x9878F8; 39 | 0xF878F8; 40 | 0xF85898; 41 | 0xF87858; 42 | 0xFCA044; 43 | 0xF8B800; 44 | 0xB8F818; 45 | 0x58D854; 46 | 0x58F898; 47 | 0x00E8D8; 48 | 0x787878; 49 | 0x000000; 50 | 0x000000; 51 | 0xFCFCFC; 52 | 0xA4E4FC; 53 | 0xB8B8F8; 54 | 0xD8B8F8; 55 | 0xF8B8F8; 56 | 0xF8A4C0; 57 | 0xF0D0B0; 58 | 0xFCE0A8; 59 | 0xF8D878; 60 | 0xD8F878; 61 | 0xB8F8B8; 62 | 0xB8F8D8; 63 | 0x00FCFC; 64 | 0xF8D8F8; 65 | 0x000000; 66 | 0x000000; 67 | ] 68 | 69 | type 'a display_create = 70 | width:int -> 71 | height:int -> 72 | scale:int -> 73 | palette:int list -> 74 | ?vsync:bool -> 75 | ?save:string -> 76 | string -> 77 | 'a 78 | 79 | let create (f : 'a display_create) cli_flags = 80 | let vsync = not cli_flags.Common.uncap_speed in 81 | let save = cli_flags.save_mp4 in 82 | f ~width:256 ~height:240 ~scale:4 ~palette ~vsync ?save "NES" 83 | -------------------------------------------------------------------------------- /src/rom.ml: -------------------------------------------------------------------------------- 1 | exception Invalid_ROM of string 2 | 3 | type rom_config = { 4 | prg_rom_size : int; 5 | chr_rom_size : int; 6 | mirroring : bool; 7 | prg_ram_present : bool; 8 | trainer : bool; 9 | four_screen_vram : bool; 10 | vs_unisystem : bool; 11 | playchoice_10 : bool; 12 | prg_ram_size : int; 13 | mapper_nb : int; 14 | tv_system : [ `NTSC | `PAL ]; 15 | } 16 | 17 | type t = { 18 | file_name : string; 19 | hash : string; 20 | config : rom_config; 21 | prg_rom : int array; 22 | chr_rom : int array; 23 | trainer : int array option; 24 | } 25 | 26 | let truncated_hash b = 27 | let trunc_size = 6 in 28 | let open Digestif.MD5 in 29 | let hash = digest_bytes b in 30 | let hex = to_hex hash in 31 | String.sub hex 0 trunc_size 32 | 33 | let read_file path = 34 | let file = open_in_bin path in 35 | let size = in_channel_length file in 36 | let store = Bytes.create size in 37 | really_input file store 0 size; 38 | let res = Array.make size 0 in 39 | for i = 0 to size - 1 do 40 | res.(i) <- int_of_char @@ Bytes.get store i 41 | done; 42 | let hash = truncated_hash store in 43 | Printf.printf "Loaded %d bytes of memory (%s)\n" size hash; 44 | (res, hash) 45 | 46 | module Save_file = struct 47 | type slot = S1 | S2 | S3 48 | 49 | let suffix = ".sav" 50 | let separator = "_" 51 | let num_of_slot = function S1 -> 1 | S2 -> 2 | S3 -> 3 52 | 53 | let make_name t slot = 54 | t.hash ^ separator ^ t.file_name ^ suffix ^ Int.to_string (num_of_slot slot) 55 | 56 | let find_matching_name t slot = 57 | let cwd = Sys.getcwd () in 58 | let files = Sys.readdir cwd in 59 | let sn = num_of_slot slot in 60 | let regex = 61 | Printf.sprintf "%s%s.*\\%s%d$" t.hash separator suffix sn |> Str.regexp 62 | in 63 | let pred candidate = Str.string_match regex candidate 0 in 64 | Array.find_opt pred files 65 | end 66 | 67 | let nth_bit b n = b land (1 lsl n) != 0 68 | 69 | let read_header rom = 70 | if rom.(0) != 0x4E || rom.(1) != 0x45 || rom.(2) != 0x53 || rom.(3) != 0x1A 71 | then raise (Invalid_ROM "Wrong NES header"); 72 | let nes2 = rom.(7) land 0b1100 = 0b1000 in 73 | if nes2 then raise (Invalid_ROM "NES 2.0 ROM format not supported") 74 | else 75 | { 76 | prg_rom_size = rom.(4) * 0x4000; 77 | chr_rom_size = rom.(5) * 0x2000; 78 | mirroring = nth_bit rom.(6) 0; 79 | prg_ram_present = nth_bit rom.(6) 1; 80 | trainer = nth_bit rom.(6) 2; 81 | four_screen_vram = nth_bit rom.(6) 3; 82 | vs_unisystem = nth_bit rom.(7) 0; 83 | playchoice_10 = nth_bit rom.(7) 1; 84 | prg_ram_size = rom.(8); 85 | mapper_nb = (rom.(6) lsr 4) lor (rom.(7) land 0xF0); 86 | tv_system = (if nth_bit rom.(9) 0 then `PAL else `NTSC); 87 | } 88 | 89 | let load path = 90 | let file_name = 91 | match Fpath.of_string path with 92 | | Ok p -> Fpath.(normalize p |> rem_ext |> basename) 93 | | Error _ -> failwith "Invalid ROM path" 94 | in 95 | Printf.printf "Opening ROM: '%s'\n" file_name; 96 | let rom, hash = read_file path in 97 | let config = read_header rom in 98 | Printf.printf "Mapper %d\n" config.mapper_nb; 99 | Printf.printf "PRG ROM is %d bytes\n" config.prg_rom_size; 100 | Printf.printf "CHR ROM is %d bytes\n" config.chr_rom_size; 101 | Printf.printf "PRG RAM : %B\n" config.prg_ram_present; 102 | if config.tv_system = `PAL then raise (Invalid_ROM "PAL is not supported"); 103 | let cur_address = ref 0x10 in 104 | let trainer = 105 | if not config.trainer then None 106 | else ( 107 | cur_address := !cur_address + 0x200; 108 | Some (Array.sub rom 0x10 512)) 109 | in 110 | let prg_rom = Array.sub rom !cur_address config.prg_rom_size in 111 | cur_address := !cur_address + config.prg_rom_size; 112 | let chr_rom = Array.sub rom !cur_address config.chr_rom_size in 113 | cur_address := !cur_address + config.chr_rom_size; 114 | (* ignored PRG_RAM, Playchoices data, title *) 115 | { file_name; hash; config; prg_rom; chr_rom; trainer } 116 | -------------------------------------------------------------------------------- /src/rom.mli: -------------------------------------------------------------------------------- 1 | (** Read binary iNES ROMS from files *) 2 | 3 | exception Invalid_ROM of string 4 | (** Thrown if the given ROM is either ill-formed or unsupported. *) 5 | 6 | type rom_config = { 7 | prg_rom_size : int; 8 | chr_rom_size : int; 9 | mirroring : bool; 10 | prg_ram_present : bool; 11 | trainer : bool; 12 | four_screen_vram : bool; 13 | vs_unisystem : bool; 14 | playchoice_10 : bool; 15 | prg_ram_size : int; 16 | mapper_nb : int; 17 | tv_system : [ `NTSC | `PAL ]; 18 | } 19 | (** The various iNES header attributes *) 20 | 21 | type t = { 22 | file_name : string; 23 | hash : string; (** Truncated MD5 hash of the ROM payload *) 24 | config : rom_config; 25 | prg_rom : int array; 26 | chr_rom : int array; 27 | trainer : int array option; 28 | } 29 | 30 | val load : string -> t 31 | (** Load a ROM from a file path *) 32 | 33 | (** Save states filename generation, with three slots *) 34 | module Save_file : sig 35 | type slot = S1 | S2 | S3 36 | 37 | val make_name : t -> slot -> string 38 | val find_matching_name : t -> slot -> string option 39 | end 40 | -------------------------------------------------------------------------------- /tests/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name video_diffs) 3 | (deps 4 | (source_tree roms/) 5 | (source_tree inputs/) 6 | (source_tree videos/) 7 | %{bin:nes-ml}) 8 | (libraries bos fpath)) 9 | -------------------------------------------------------------------------------- /tests/inputs/mario.rec: -------------------------------------------------------------------------------- 1 | 467 2 | 475 3 | 483 4 | 491 5 | 959 6 | 967 7 | 975 8 | 983 9 | 991 10 | 993 11 | 999 12 | 1001 13 | 1007 14 | 1009 15 | 1015 16 | 1017 17 | 1023 18 | 1025 19 | 1031 20 | 1033 21 | 1039 22 | 1041 23 | 1047 24 | 1049 25 | 1055 26 | 1057 27 | 1063 28 | 1065 29 | 1071 30 | 1073 31 | 1079 32 | 1081 33 | 1087 34 | 1089 35 | 1095 36 | 1097 37 | 1103 38 | 1105 39 | 1111 40 | 1113 41 | 1119 42 | 1121 43 | 1127 44 | 1129 45 | 1135 46 | 1137 47 | 1143 48 | 1145 49 | 1151 50 | 1153 51 | 1159 52 | 1161 53 | 1167 54 | 1169 55 | 1175 56 | 1177 57 | 1183 58 | 1185 59 | 1191 60 | 1193 61 | 1199 62 | 1201 63 | 1207 64 | 1209 65 | 1215 66 | 1217 67 | 1223 68 | 1225 69 | 1231 70 | 1233 71 | 1239 72 | 1241 73 | 1247 74 | 1249 75 | 1255 76 | 1257 77 | 1263 78 | 1265 79 | 1271 80 | 1273 81 | 1279 82 | 1281 83 | 1287 84 | 1289 85 | 1295 86 | 1297 87 | 1303 88 | 1305 89 | 1311 90 | 1313 91 | 1319 92 | 1321 93 | 1327 94 | 1329 95 | 1335 96 | 1337 97 | 1343 98 | 1345 99 | 1351 100 | 1353 101 | 1359 102 | 1361 103 | 1367 104 | 1369 105 | 1375 106 | 1377 107 | 1383 108 | 1385 109 | 1391 110 | 1393 111 | 1399 112 | 1401 113 | 1407 114 | 1409 115 | 1415 116 | 1417 117 | 1423 118 | 1425 119 | 1431 120 | 1433 121 | 1439 122 | 1441 123 | 1447 124 | 1449 125 | 1455 126 | 1457 127 | 1463 128 | 1465 129 | 1471 130 | 1473 131 | 1479 132 | 1481 133 | 1487 134 | 1489 135 | 1495 136 | 1497 137 | 1503 138 | 1505 139 | 1511 140 | 1513 141 | 1519 142 | 1521 143 | 1527 144 | 1529 145 | 1535 146 | 1537 147 | 1543 148 | 1545 149 | 1551 150 | 1553 151 | 1559 152 | 1561 153 | 1567 154 | 1569 155 | 1575 156 | 1577 157 | 1583 158 | 1585 159 | 1591 160 | 1593 161 | 1599 162 | 1601 163 | 1607 164 | 1609 165 | 1615 166 | 1617 167 | 1623 168 | 1625 169 | 1631 170 | 1633 171 | 1639 172 | 1641 173 | 1647 174 | 1649 175 | 1655 176 | 1657 177 | 1663 178 | 1665 179 | 1671 180 | 1673 181 | 1679 182 | 1681 183 | 1687 184 | 1689 185 | 1695 186 | 1697 187 | 1703 188 | 1705 189 | 1711 190 | 1713 191 | 1719 192 | 1721 193 | 1727 194 | 1729 195 | 1735 196 | 1737 197 | 1743 198 | 1745 199 | 1751 200 | 1753 201 | 1759 202 | 1761 203 | 1767 204 | 1769 205 | 1775 206 | 1777 207 | 1783 208 | 1785 209 | 1791 210 | 1793 211 | 1799 212 | 1801 213 | 1807 214 | 1809 215 | 1815 216 | 1817 217 | 1823 218 | 1825 219 | 1831 220 | 1833 221 | 1839 222 | 1841 223 | 1847 224 | 1849 225 | 1855 226 | 1857 227 | 1863 228 | 1865 229 | 1871 230 | 1873 231 | 1879 232 | 1881 233 | 1887 234 | 1889 235 | 1895 236 | 1897 237 | 1903 238 | 1905 239 | 1911 240 | 1913 241 | 1919 242 | 1921 243 | 1927 244 | 1929 245 | 1935 246 | 1937 247 | 1943 248 | 1945 249 | 1951 250 | 1953 251 | 1959 252 | 1961 253 | 1967 254 | 1969 255 | 1975 256 | 1977 257 | 1983 258 | 1985 259 | 1991 260 | 1993 261 | 1999 262 | 2001 263 | 2007 264 | 2009 265 | 2015 266 | 2017 267 | 2023 268 | 2025 269 | 2031 270 | 2033 271 | 2039 272 | 2041 273 | 2047 274 | 2049 275 | 2055 276 | 2057 277 | 2063 278 | 2065 279 | 2071 280 | 2073 281 | 2079 282 | 2081 283 | 2087 284 | 2089 285 | 2095 286 | 2097 287 | 2103 288 | 2105 289 | 2111 290 | 2113 291 | 2119 292 | 2121 293 | 2127 294 | 2129 295 | 2135 296 | 2137 297 | 2143 298 | 2145 299 | 2151 300 | 2153 301 | 2159 302 | 2161 303 | 2167 304 | 2169 305 | 2175 306 | 2177 307 | 2183 308 | 2185 309 | 2191 310 | 2193 311 | 2199 312 | 2201 313 | 2207 314 | 2209 315 | 2215 316 | 2217 317 | 2223 318 | 2225 319 | 2231 320 | 2233 321 | 2239 322 | 2241 323 | 2247 324 | 2249 325 | 2255 326 | 2257 327 | 2263 328 | 2265 329 | 2271 330 | 2273 331 | 2279 332 | 2281 333 | 2287 334 | 2289 335 | 2295 336 | 2297 337 | 2303 338 | 2305 339 | 2311 340 | 2313 341 | 2319 342 | 2321 343 | 2327 344 | 2329 345 | 2335 346 | 2337 347 | 2343 348 | 2345 349 | 2351 350 | 2353 351 | 2359 352 | 2361 353 | 2367 354 | 2369 355 | 2375 356 | 2377 357 | 2383 358 | 2385 359 | 2391 360 | 2392 361 | 2393 362 | 2399 363 | 2400 364 | 2401 365 | 2407 366 | 2408 367 | 2409 368 | 2415 369 | 2416 370 | 2417 371 | 2423 372 | 2424 373 | 2425 374 | 2431 375 | 2432 376 | 2433 377 | 2439 378 | 2440 379 | 2441 380 | 2447 381 | 2449 382 | 2455 383 | 2457 384 | 2463 385 | 2465 386 | 2471 387 | 2473 388 | 2479 389 | 2481 390 | 2487 391 | 2489 392 | 2495 393 | 2497 394 | 2503 395 | 2505 396 | 2511 397 | 2513 398 | 2519 399 | 2521 400 | 2527 401 | 2529 402 | 2535 403 | 2537 404 | 2543 405 | 2545 406 | 2553 407 | 2558 408 | 2561 409 | 2566 410 | 2569 411 | 2574 412 | 2577 413 | 2582 414 | 2590 415 | 2598 416 | 2606 417 | 2614 418 | 2622 419 | 2630 420 | 2638 421 | 2646 422 | 2654 423 | 2662 424 | 2670 425 | 2678 426 | 2686 427 | 2694 428 | 2702 429 | 2710 430 | 2718 431 | 2726 432 | 2734 433 | 2742 434 | 2750 435 | 2758 436 | 2766 437 | 2774 438 | 2782 439 | 2790 440 | 2798 441 | 2806 442 | 2814 443 | 2822 444 | 2830 445 | 2838 446 | 2846 447 | 2854 448 | 2862 449 | 2870 450 | 2872 451 | 2878 452 | 2880 453 | 2887 454 | 2888 455 | 2895 456 | 2896 457 | 2903 458 | 2904 459 | 2911 460 | 2912 461 | 2919 462 | 2920 463 | 2927 464 | 2928 465 | 2935 466 | 2936 467 | 2943 468 | 2944 469 | 2951 470 | 2952 471 | 2959 472 | 2960 473 | 2967 474 | 2968 475 | 2975 476 | 2976 477 | 2983 478 | 2991 479 | 2999 480 | 3062 481 | 3070 482 | 3078 483 | 3086 484 | 3094 485 | 3102 486 | 3110 487 | 3118 488 | 3126 489 | 3134 490 | 3142 491 | 3150 492 | 3158 493 | 3166 494 | 3174 495 | 3182 496 | 3190 497 | 3217 498 | 3225 499 | 3233 500 | 3239 501 | 3241 502 | 3247 503 | 3249 504 | 3255 505 | 3257 506 | 3263 507 | 3265 508 | 3271 509 | 3273 510 | 3279 511 | 3281 512 | 3287 513 | 3288 514 | 3289 515 | 3295 516 | 3296 517 | 3297 518 | 3303 519 | 3304 520 | 3305 521 | 3311 522 | 3312 523 | 3313 524 | 3319 525 | 3320 526 | 3321 527 | 3327 528 | 3328 529 | 3329 530 | 3335 531 | 3336 532 | 3337 533 | 3343 534 | 3344 535 | 3345 536 | 3351 537 | 3352 538 | 3353 539 | 3359 540 | 3360 541 | 3361 542 | 3367 543 | 3368 544 | 3369 545 | 3375 546 | 3376 547 | 3377 548 | 3383 549 | 3384 550 | 3385 551 | 3391 552 | 3392 553 | 3393 554 | 3399 555 | 3400 556 | 3401 557 | 3407 558 | 3408 559 | 3409 560 | 3415 561 | 3416 562 | 3417 563 | 3423 564 | 3424 565 | 3425 566 | 3431 567 | 3432 568 | 3433 569 | 3439 570 | 3440 571 | 3441 572 | 3447 573 | 3448 574 | 3449 575 | 3455 576 | 3456 577 | 3457 578 | 3463 579 | 3464 580 | 3465 581 | 3471 582 | 3472 583 | 3473 584 | 3479 585 | 3480 586 | 3481 587 | 3487 588 | 3488 589 | 3489 590 | 3495 591 | 3496 592 | 3497 593 | 3503 594 | 3504 595 | 3505 596 | 3511 597 | 3512 598 | 3513 599 | 3519 600 | 3520 601 | 3521 602 | 3527 603 | 3528 604 | 3529 605 | 3535 606 | 3536 607 | 3537 608 | 3543 609 | 3544 610 | 3545 611 | 3551 612 | 3553 613 | 3559 614 | 3561 615 | 3567 616 | 3569 617 | 3575 618 | 3577 619 | 3583 620 | 3585 621 | 3591 622 | 3593 623 | 3599 624 | 3601 625 | 3607 626 | 3609 627 | 3615 628 | 3617 629 | 3623 630 | 3625 631 | 3631 632 | 3633 633 | 3639 634 | 3641 635 | 3647 636 | 3649 637 | 3655 638 | 3657 639 | 3663 640 | 3665 641 | 3671 642 | 3673 643 | 3679 644 | 3681 645 | 3687 646 | 3689 647 | 3695 648 | 3697 649 | 3703 650 | 3705 651 | 3711 652 | 3713 653 | 3719 654 | 3721 655 | 3727 656 | 3729 657 | 3735 658 | 3737 659 | 3743 660 | 3745 661 | 3751 662 | 3753 663 | 3759 664 | 3761 665 | 3767 666 | 3769 667 | 3775 668 | 3777 669 | 3783 670 | 3785 671 | 3791 672 | 3793 673 | 3799 674 | 3801 675 | 3807 676 | 3809 677 | 3815 678 | 3817 679 | 3823 680 | 3825 681 | 3831 682 | 3833 683 | 3839 684 | 3841 685 | 3847 686 | 3849 687 | 3855 688 | 3857 689 | 3863 690 | 3865 691 | 3871 692 | 3873 693 | 3879 694 | 3881 695 | 3887 696 | 3889 697 | 3895 698 | 3897 699 | 3903 700 | 3905 701 | 3911 702 | 3913 703 | 3919 704 | 3921 705 | 3927 706 | 3929 707 | 3935 708 | 3937 709 | 3943 710 | 3945 711 | 3951 712 | 3953 713 | 3959 714 | 3961 715 | 3967 716 | 3969 717 | 3975 718 | 3977 719 | 3983 720 | 3985 721 | 3991 722 | 3993 723 | 3999 724 | 4001 725 | 4007 726 | 4009 727 | 4015 728 | 4017 729 | 4023 730 | 4025 731 | 4031 732 | 4033 733 | 4039 734 | 4041 735 | 4047 736 | 4049 737 | 4055 738 | 4057 739 | 4063 740 | 4065 741 | 4071 742 | 4073 743 | 4079 744 | 4081 745 | 4087 746 | 4089 747 | 4095 748 | 4097 749 | 4103 750 | 4105 751 | 4111 752 | 4113 753 | 4119 754 | 4121 755 | 4127 756 | 4129 757 | 4135 758 | 4137 759 | 4143 760 | 4145 761 | 4151 762 | 4153 763 | 4159 764 | 4161 765 | 4167 766 | 4169 767 | 4175 768 | 4177 769 | 4183 770 | 4185 771 | 4191 772 | 4193 773 | 4199 774 | 4200 775 | 4201 776 | 4207 777 | 4208 778 | 4209 779 | 4215 780 | 4216 781 | 4217 782 | 4223 783 | 4224 784 | 4225 785 | 4231 786 | 4232 787 | 4233 788 | 4239 789 | 4240 790 | 4241 791 | 4247 792 | 4249 793 | 4255 794 | 4257 795 | 4263 796 | 4265 797 | 4271 798 | 4273 799 | 4279 800 | 4281 801 | 4287 802 | 4289 803 | 4295 804 | 4297 805 | 4303 806 | 4305 807 | 4311 808 | 4313 809 | 4319 810 | 4321 811 | 4327 812 | 4329 813 | 4335 814 | 4337 815 | 4343 816 | 4345 817 | 4351 818 | 4353 819 | 4359 820 | 4361 821 | 4367 822 | 4369 823 | 4375 824 | 4377 825 | 4383 826 | 4385 827 | 4391 828 | 4393 829 | 4399 830 | 4401 831 | 4407 832 | 4409 833 | 4415 834 | 4417 835 | 4423 836 | 4425 837 | 4431 838 | 4433 839 | 4439 840 | 4441 841 | 4447 842 | 4449 843 | 4455 844 | 4457 845 | 4463 846 | 4465 847 | 4471 848 | 4473 849 | 4479 850 | 4481 851 | 4487 852 | 4489 853 | 4495 854 | 4497 855 | 4503 856 | 4505 857 | 4511 858 | 4513 859 | 4519 860 | 4521 861 | 4527 862 | 4529 863 | 4535 864 | 4537 865 | 4543 866 | 4545 867 | 4551 868 | 4553 869 | 4559 870 | 4561 871 | 4567 872 | 4569 873 | 4575 874 | 4577 875 | 4583 876 | 4584 877 | 4585 878 | 4591 879 | 4592 880 | 4593 881 | 4599 882 | 4600 883 | 4601 884 | 4607 885 | 4608 886 | 4609 887 | 4615 888 | 4616 889 | 4617 890 | 4623 891 | 4624 892 | 4625 893 | 4631 894 | 4632 895 | 4633 896 | 4639 897 | 4640 898 | 4641 899 | 4647 900 | 4648 901 | 4649 902 | 4655 903 | 4656 904 | 4657 905 | 4663 906 | 4665 907 | 4671 908 | 4673 909 | 4679 910 | 4681 911 | 4687 912 | 4689 913 | 4695 914 | 4697 915 | 4703 916 | 4705 917 | 4711 918 | 4713 919 | 4719 920 | 4721 921 | 4727 922 | 4729 923 | 4735 924 | 4737 925 | 4743 926 | 4745 927 | 4751 928 | 4753 929 | 4759 930 | 4761 931 | 4767 932 | 4769 933 | 4775 934 | 4777 935 | 4783 936 | 4785 937 | 4791 938 | 4793 939 | 4799 940 | 4800 941 | 4801 942 | 4807 943 | 4808 944 | 4809 945 | 4815 946 | 4816 947 | 4817 948 | 4823 949 | 4824 950 | 4825 951 | 4831 952 | 4832 953 | 4833 954 | 4839 955 | 4840 956 | 4841 957 | 4847 958 | 4848 959 | 4849 960 | 4855 961 | 4856 962 | 4857 963 | 4863 964 | 4864 965 | 4865 966 | 4871 967 | 4872 968 | 4873 969 | 4879 970 | 4880 971 | 4881 972 | 4887 973 | 4888 974 | 4889 975 | 4895 976 | 4896 977 | 4897 978 | 4903 979 | 4904 980 | 4905 981 | 4911 982 | 4912 983 | 4913 984 | 4919 985 | 4920 986 | 4921 987 | 4927 988 | 4928 989 | 4929 990 | 4935 991 | 4936 992 | 4937 993 | 4943 994 | 4944 995 | 4945 996 | 4951 997 | 4952 998 | 4953 999 | 4959 1000 | 4960 1001 | 4961 1002 | 4967 1003 | 4968 1004 | 4969 1005 | 4975 1006 | 4976 1007 | 4977 1008 | 4983 1009 | 4984 1010 | 4985 1011 | 4991 1012 | 4992 1013 | 4993 1014 | 4999 1015 | 5000 1016 | 5001 1017 | 5007 1018 | 5008 1019 | 5009 1020 | 5015 1021 | 5017 1022 | 5023 1023 | 5025 1024 | 5031 1025 | 5033 1026 | 5039 1027 | 5041 1028 | 5047 1029 | 5049 1030 | 5055 1031 | 5057 1032 | 5063 1033 | 5065 1034 | 5071 1035 | 5073 1036 | 5079 1037 | 5081 1038 | 5087 1039 | 5089 1040 | 5095 1041 | 5097 1042 | 5103 1043 | 5105 1044 | 5111 1045 | 5113 1046 | 5119 1047 | 5121 1048 | 5127 1049 | 5129 1050 | 5135 1051 | 5137 1052 | 5143 1053 | 5145 1054 | 5151 1055 | 5153 1056 | 5159 1057 | 5161 1058 | 5167 1059 | 5169 1060 | 5175 1061 | 5177 1062 | 5183 1063 | 5184 1064 | 5185 1065 | 5191 1066 | 5192 1067 | 5193 1068 | 5199 1069 | 5200 1070 | 5201 1071 | 5207 1072 | 5208 1073 | 5209 1074 | 5215 1075 | 5216 1076 | 5217 1077 | 5223 1078 | 5224 1079 | 5225 1080 | 5231 1081 | 5233 1082 | 5239 1083 | 5241 1084 | 5247 1085 | 5249 1086 | 5255 1087 | 5257 1088 | 5263 1089 | 5265 1090 | 5271 1091 | 5273 1092 | 5279 1093 | 5281 1094 | 5287 1095 | 5289 1096 | 5295 1097 | 5297 1098 | 5303 1099 | 5305 1100 | 5311 1101 | 5313 1102 | 5319 1103 | 5321 1104 | 5327 1105 | 5329 1106 | 5335 1107 | 5337 1108 | 5343 1109 | 5345 1110 | 5351 1111 | 5353 1112 | 5359 1113 | 5361 1114 | 5367 1115 | 5369 1116 | 5375 1117 | 5377 1118 | 5383 1119 | 5385 1120 | 5391 1121 | 5393 1122 | 5399 1123 | 5401 1124 | 5407 1125 | 5409 1126 | 5415 1127 | 5417 1128 | 5423 1129 | 5425 1130 | 5431 1131 | 5433 1132 | 5439 1133 | 5441 1134 | 5447 1135 | 5449 1136 | 5455 1137 | 5457 1138 | 5463 1139 | 5465 1140 | 5471 1141 | 5473 1142 | 5479 1143 | 5481 1144 | 5487 1145 | 5489 1146 | 5495 1147 | 5497 1148 | 5503 1149 | 5505 1150 | 5511 1151 | 5513 1152 | 5519 1153 | 5521 1154 | 5527 1155 | 5529 1156 | 5535 1157 | 5537 1158 | 5543 1159 | 5544 1160 | 5545 1161 | 5551 1162 | 5552 1163 | 5553 1164 | 5559 1165 | 5560 1166 | 5561 1167 | 5567 1168 | 5568 1169 | 5569 1170 | 5575 1171 | 5576 1172 | 5577 1173 | 5583 1174 | 5584 1175 | 5585 1176 | 5591 1177 | 5592 1178 | 5593 1179 | 5599 1180 | 5600 1181 | 5601 1182 | 5607 1183 | 5608 1184 | 5609 1185 | 5615 1186 | 5616 1187 | 5617 1188 | 5623 1189 | 5624 1190 | 5625 1191 | 5631 1192 | 5632 1193 | 5633 1194 | 5639 1195 | 5640 1196 | 5641 1197 | 5647 1198 | 5648 1199 | 5649 1200 | 5655 1201 | 5656 1202 | 5657 1203 | 5663 1204 | 5664 1205 | 5665 1206 | 5671 1207 | 5672 1208 | 5673 1209 | 5679 1210 | 5680 1211 | 5681 1212 | 5687 1213 | 5688 1214 | 5689 1215 | 5695 1216 | 5696 1217 | 5697 1218 | 5703 1219 | 5704 1220 | 5705 1221 | 5711 1222 | 5712 1223 | 5713 1224 | 5719 1225 | 5720 1226 | 5721 1227 | 5727 1228 | 5729 1229 | 5735 1230 | 5737 1231 | 5743 1232 | 5745 1233 | 5751 1234 | 5753 1235 | 5759 1236 | 5761 1237 | 5767 1238 | 5769 1239 | 5775 1240 | 5777 1241 | 5783 1242 | 5785 1243 | 5791 1244 | 5793 1245 | 5799 1246 | 5801 1247 | 5807 1248 | 5809 1249 | 5815 1250 | 5817 1251 | 5823 1252 | 5825 1253 | 5831 1254 | 5833 1255 | 5839 1256 | 5841 1257 | 5847 1258 | 5849 1259 | 5855 1260 | 5857 1261 | 5863 1262 | 5865 1263 | 5871 1264 | 5873 1265 | 5879 1266 | 5881 1267 | 5887 1268 | 5889 1269 | 5895 1270 | 5897 1271 | 5903 1272 | 5905 1273 | 5911 1274 | 5913 1275 | 5919 1276 | 5921 1277 | 5927 1278 | 5929 1279 | 5935 1280 | 5937 1281 | 5943 1282 | 5945 1283 | 5951 1284 | 5953 1285 | 5959 1286 | 5961 1287 | 5967 1288 | 5969 1289 | 5975 1290 | 5977 1291 | 5983 1292 | 5985 1293 | 5991 1294 | 5993 1295 | 5999 1296 | 6001 1297 | 6007 1298 | 6009 1299 | 6015 1300 | 6017 1301 | 6023 1302 | 6025 1303 | 6031 1304 | 6033 1305 | 6039 1306 | 6041 1307 | 6047 1308 | 6049 1309 | 6055 1310 | 6057 1311 | 6063 1312 | 6065 1313 | 6071 1314 | 6073 1315 | 6079 1316 | 6081 1317 | 6087 1318 | 6089 1319 | 6095 1320 | 6097 1321 | 6103 1322 | 6105 1323 | 6111 1324 | 6113 1325 | 6119 1326 | 6121 1327 | 6127 1328 | 6129 1329 | 6135 1330 | 6137 1331 | 6143 1332 | 6145 1333 | 6151 1334 | 6153 1335 | 6159 1336 | 6161 1337 | 6167 1338 | 6169 1339 | 6175 1340 | 6177 1341 | 6183 1342 | 6185 1343 | 6191 1344 | 6193 1345 | 6199 1346 | 6201 1347 | 6207 1348 | 6209 1349 | 6215 1350 | 6217 1351 | 6223 1352 | 6225 1353 | 6231 1354 | 6233 1355 | 6239 1356 | 6240 1357 | 6241 1358 | 6247 1359 | 6248 1360 | 6249 1361 | 6255 1362 | 6256 1363 | 6257 1364 | 6263 1365 | 6264 1366 | 6265 1367 | 6271 1368 | 6272 1369 | 6273 1370 | 6279 1371 | 6281 1372 | 6287 1373 | 6289 1374 | 6295 1375 | 6297 1376 | 6303 1377 | 6305 1378 | 6311 1379 | 6313 1380 | 6319 1381 | 6321 1382 | 6327 1383 | 6329 1384 | 6335 1385 | 6337 1386 | 6343 1387 | 6345 1388 | 6351 1389 | 6353 1390 | 6359 1391 | 6361 1392 | 6367 1393 | 6369 1394 | 6375 1395 | 6377 1396 | 6383 1397 | 6385 1398 | 6391 1399 | 6393 1400 | 6399 1401 | 6401 1402 | 6407 1403 | 6409 1404 | 6415 1405 | 6417 1406 | 6423 1407 | 6425 1408 | 6431 1409 | 6433 1410 | 6439 1411 | 6441 1412 | 6447 1413 | 6449 1414 | 6455 1415 | 6457 1416 | 6463 1417 | 6465 1418 | 6471 1419 | 6473 1420 | 6479 1421 | 6481 1422 | 6487 1423 | 6489 1424 | 6495 1425 | 6497 1426 | 6503 1427 | 6505 1428 | 6511 1429 | 6513 1430 | 6519 1431 | 6521 1432 | 6527 1433 | 6529 1434 | 6535 1435 | 6537 1436 | 6543 1437 | 6545 1438 | 6551 1439 | 6553 1440 | 6559 1441 | 6561 1442 | 6567 1443 | 6569 1444 | 6575 1445 | 6577 1446 | 6583 1447 | 6585 1448 | 6591 1449 | 6593 1450 | 6599 1451 | 6601 1452 | 6607 1453 | 6609 1454 | 6615 1455 | 6617 1456 | 6623 1457 | 6625 1458 | 6631 1459 | 6633 1460 | 6639 1461 | 6641 1462 | 6647 1463 | 6648 1464 | 6649 1465 | 6655 1466 | 6656 1467 | 6657 1468 | 6663 1469 | 6664 1470 | 6665 1471 | 6671 1472 | 6672 1473 | 6673 1474 | 6679 1475 | 6680 1476 | 6681 1477 | 6687 1478 | 6689 1479 | 6695 1480 | 6697 1481 | 6703 1482 | 6705 1483 | 6711 1484 | 6713 1485 | 6719 1486 | 6721 1487 | 6727 1488 | 6729 1489 | 6735 1490 | 6737 1491 | 6743 1492 | 6745 1493 | 6751 1494 | 6753 1495 | 6759 1496 | 6761 1497 | 6767 1498 | 6769 1499 | 6775 1500 | 6777 1501 | 6783 1502 | 6785 1503 | 6791 1504 | 6793 1505 | 6799 1506 | 6801 1507 | 6809 1508 | 6814 1509 | 6817 1510 | 6822 1511 | 6825 1512 | 6830 1513 | 6833 1514 | 6838 1515 | 6841 1516 | 6846 1517 | 6849 1518 | 6854 1519 | 6857 1520 | 6865 1521 | 6873 1522 | 6881 1523 | 6889 1524 | 6897 1525 | 6905 1526 | 6950 1527 | 6958 1528 | 6966 1529 | 6974 1530 | 6982 1531 | 6990 1532 | 6998 1533 | 7006 1534 | 7158 1535 | 7166 1536 | 7174 1537 | 7182 1538 | 7190 1539 | 7193 1540 | 7198 1541 | 7201 1542 | 7206 1543 | 7209 1544 | 7214 1545 | 7217 1546 | 7222 1547 | 7225 1548 | 7230 1549 | 7232 1550 | 7233 1551 | 7238 1552 | 7240 1553 | 7241 1554 | 7246 1555 | 7248 1556 | 7249 1557 | 7254 1558 | 7256 1559 | 7257 1560 | 7262 1561 | 7264 1562 | 7265 1563 | 7270 1564 | 7272 1565 | 7273 1566 | 7278 1567 | 7280 1568 | 7281 1569 | 7286 1570 | 7288 1571 | 7289 1572 | 7294 1573 | 7296 1574 | 7297 1575 | 7302 1576 | 7304 1577 | 7305 1578 | 7310 1579 | 7312 1580 | 7313 1581 | 7318 1582 | 7320 1583 | 7321 1584 | 7326 1585 | 7328 1586 | 7329 1587 | 7334 1588 | 7336 1589 | 7337 1590 | 7342 1591 | 7344 1592 | 7345 1593 | 7350 1594 | 7352 1595 | 7353 1596 | 7358 1597 | 7360 1598 | 7361 1599 | 7366 1600 | 7368 1601 | 7369 1602 | 7374 1603 | 7376 1604 | 7377 1605 | 7382 1606 | 7384 1607 | 7385 1608 | 7390 1609 | 7392 1610 | 7393 1611 | 7398 1612 | 7400 1613 | 7401 1614 | 7406 1615 | 7408 1616 | 7409 1617 | 7414 1618 | 7416 1619 | 7417 1620 | 7422 1621 | 7424 1622 | 7425 1623 | 7430 1624 | 7432 1625 | 7433 1626 | 7839 1627 | 7847 1628 | 7855 1629 | 7863 1630 | 7871 1631 | 7879 1632 | 7887 1633 | 7889 1634 | 7895 1635 | 7897 1636 | 7903 1637 | 7905 1638 | 7911 1639 | 7913 1640 | 7919 1641 | 7921 1642 | 7927 1643 | 7929 1644 | 7935 1645 | 7936 1646 | 7937 1647 | 7943 1648 | 7944 1649 | 7945 1650 | 7951 1651 | 7952 1652 | 7953 1653 | 7959 1654 | 7960 1655 | 7961 1656 | 7967 1657 | 7968 1658 | 7969 1659 | 7975 1660 | 7976 1661 | 7977 1662 | 7983 1663 | 7984 1664 | 7985 1665 | 7991 1666 | 7992 1667 | 7993 1668 | 7999 1669 | 8000 1670 | 8001 1671 | 8007 1672 | 8008 1673 | 8009 1674 | 8015 1675 | 8016 1676 | 8017 1677 | 8023 1678 | 8024 1679 | 8025 1680 | 8031 1681 | 8032 1682 | 8033 1683 | 8039 1684 | 8040 1685 | 8041 1686 | 8047 1687 | 8048 1688 | 8049 1689 | 8055 1690 | 8056 1691 | 8057 1692 | 8063 1693 | 8064 1694 | 8065 1695 | 8071 1696 | 8072 1697 | 8073 1698 | 8079 1699 | 8080 1700 | 8081 1701 | 8087 1702 | 8088 1703 | 8089 1704 | 8095 1705 | 8096 1706 | 8097 1707 | 8103 1708 | 8104 1709 | 8105 1710 | 8111 1711 | 8112 1712 | 8113 1713 | 8119 1714 | 8120 1715 | 8121 1716 | 8127 1717 | 8128 1718 | 8129 1719 | 8135 1720 | 8136 1721 | 8137 1722 | 8143 1723 | 8144 1724 | 8145 1725 | 8151 1726 | 8152 1727 | 8153 1728 | 8159 1729 | 8160 1730 | 8161 1731 | 8167 1732 | 8168 1733 | 8169 1734 | 8175 1735 | 8176 1736 | 8177 1737 | 8183 1738 | 8184 1739 | 8185 1740 | 8191 1741 | 8199 1742 | 8207 1743 | 8215 1744 | 8223 1745 | 8358 1746 | 8366 1747 | 8374 1748 | 8382 1749 | 8390 1750 | 8398 1751 | 8406 1752 | 8414 1753 | 8422 1754 | 8513 1755 | 8519 1756 | 8521 1757 | 8527 1758 | 8529 1759 | 8535 1760 | 8537 1761 | 8543 1762 | 8544 1763 | 8545 1764 | 8551 1765 | 8552 1766 | 8553 1767 | 8559 1768 | 8560 1769 | 8561 1770 | 8567 1771 | 8568 1772 | 8569 1773 | 8575 1774 | 8576 1775 | 8577 1776 | 8583 1777 | 8584 1778 | 8585 1779 | 8591 1780 | 8592 1781 | 8593 1782 | 8599 1783 | 8600 1784 | 8601 1785 | 8607 1786 | 8608 1787 | 8609 1788 | 8615 1789 | 8616 1790 | 8617 1791 | 8623 1792 | 8624 1793 | 8625 1794 | 8631 1795 | 8632 1796 | 8633 1797 | 8639 1798 | 8640 1799 | 8641 1800 | 8647 1801 | 8648 1802 | 8649 1803 | 8655 1804 | 8656 1805 | 8657 1806 | 8663 1807 | 8664 1808 | 8665 1809 | 8671 1810 | 8672 1811 | 8673 1812 | 8679 1813 | 8680 1814 | 8681 1815 | 8687 1816 | 8688 1817 | 8689 1818 | 8695 1819 | 8696 1820 | 8697 1821 | 8703 1822 | 8704 1823 | 8705 1824 | 8711 1825 | 8712 1826 | 8713 1827 | 8719 1828 | 8720 1829 | 8727 1830 | 8728 1831 | 8735 1832 | 8736 1833 | 8743 1834 | 8744 1835 | 8751 1836 | 8759 1837 | 8761 1838 | 8767 1839 | 8769 1840 | 8775 1841 | 8777 1842 | 8783 1843 | 8785 1844 | 8791 1845 | 8793 1846 | 8799 1847 | 8801 1848 | 8807 1849 | 8815 1850 | 8823 1851 | 8831 1852 | 8839 1853 | 8841 1854 | 8847 1855 | 8849 1856 | 8855 1857 | 8857 1858 | 8863 1859 | 8871 1860 | 8879 1861 | 8887 1862 | 8895 1863 | 8897 1864 | 8903 1865 | 8905 1866 | 8911 1867 | 8913 1868 | 8919 1869 | 8921 1870 | 8927 1871 | 8935 1872 | 8943 1873 | 8945 1874 | 8951 1875 | 8953 1876 | 8959 1877 | 8961 1878 | 8967 1879 | 8969 1880 | 8975 1881 | 8977 1882 | 8983 1883 | 8985 1884 | 8991 1885 | 8999 1886 | 9007 1887 | 9015 1888 | 9023 1889 | 9025 1890 | 9031 1891 | 9033 1892 | 9039 1893 | 9041 1894 | 9047 1895 | 9049 1896 | 9055 1897 | 9057 1898 | 9063 1899 | 9071 1900 | 9079 1901 | 9087 1902 | 9095 1903 | 9103 1904 | 9111 1905 | 9119 1906 | 9127 1907 | 9128 1908 | 9135 1909 | 9136 1910 | 9143 1911 | 9144 1912 | 9151 1913 | 9152 1914 | 9159 1915 | 9160 1916 | 9167 1917 | 9168 1918 | 9169 1919 | 9175 1920 | 9176 1921 | 9177 1922 | 9183 1923 | 9184 1924 | 9185 1925 | 9191 1926 | 9192 1927 | 9193 1928 | 9199 1929 | 9200 1930 | 9201 1931 | 9207 1932 | 9208 1933 | 9209 1934 | 9215 1935 | 9216 1936 | 9217 1937 | 9223 1938 | 9224 1939 | 9225 1940 | 9231 1941 | 9232 1942 | 9233 1943 | 9239 1944 | 9240 1945 | 9241 1946 | 9247 1947 | 9255 1948 | 9263 1949 | 9271 1950 | 9279 1951 | 9287 1952 | 9295 1953 | 9303 1954 | 9311 1955 | 9319 1956 | 9327 1957 | 9335 1958 | 9343 1959 | 9351 1960 | 9359 1961 | 9367 1962 | 9375 1963 | 9383 1964 | 9391 1965 | 9399 1966 | 9407 1967 | 9415 1968 | 9423 1969 | 9431 1970 | 9439 1971 | 9447 1972 | 9455 1973 | 9456 1974 | 9463 1975 | 9464 1976 | 9471 1977 | 9472 1978 | 9479 1979 | 9480 1980 | 9487 1981 | 9488 1982 | 9495 1983 | 9496 1984 | 9503 1985 | 9504 1986 | 9511 1987 | 9519 1988 | 9527 1989 | 9535 1990 | 9543 1991 | 9551 1992 | 9559 1993 | 9567 1994 | 9575 1995 | 9583 1996 | 9591 1997 | 9599 1998 | 9607 1999 | 9615 2000 | 9623 2001 | 9631 2002 | 9639 2003 | 9647 2004 | 9655 2005 | 9663 2006 | 9671 2007 | 9679 2008 | 9687 2009 | 9695 2010 | 9703 2011 | 9711 2012 | 9719 2013 | 9727 2014 | 9735 2015 | 9743 2016 | 9751 2017 | 9759 2018 | 9767 2019 | 9775 2020 | 9783 2021 | 9791 2022 | 9799 2023 | 9807 2024 | 9815 2025 | 9823 2026 | 9831 2027 | 9839 2028 | 9847 2029 | 9855 2030 | 9863 2031 | 9865 2032 | 9871 2033 | 9873 2034 | 9879 2035 | 9881 2036 | 9887 2037 | 9889 2038 | 9895 2039 | 9897 2040 | 9903 2041 | 9905 2042 | 9911 2043 | 9913 2044 | 9919 2045 | 9921 2046 | 9927 2047 | 9929 2048 | 9935 2049 | 9937 2050 | 9943 2051 | 9945 2052 | 9951 2053 | 9953 2054 | 9959 2055 | 9961 2056 | 9967 2057 | 9969 2058 | 9975 2059 | 9977 2060 | 9983 2061 | 9985 2062 | 9991 2063 | 9992 2064 | 9993 2065 | 9999 2066 | 10000 2067 | 10001 2068 | 10007 2069 | 10008 2070 | 10009 2071 | 10015 2072 | 10016 2073 | 10017 2074 | 10023 2075 | 10024 2076 | 10025 2077 | 10031 2078 | 10032 2079 | 10033 2080 | 10039 2081 | 10041 2082 | 10047 2083 | 10055 2084 | 10063 2085 | 10071 2086 | 10079 2087 | 10087 2088 | 10095 2089 | 10175 2090 | 10183 2091 | 10191 2092 | 10199 2093 | 10207 2094 | 10215 2095 | 10223 2096 | 10231 2097 | 10233 2098 | 10239 2099 | 10241 2100 | 10247 2101 | 10249 2102 | 10255 2103 | 10257 2104 | 10263 2105 | 10265 2106 | 10271 2107 | 10273 2108 | 10279 2109 | 10281 2110 | 10287 2111 | 10295 2112 | 10303 2113 | 10311 2114 | 10319 2115 | 10327 2116 | 10335 2117 | 10337 2118 | 10343 2119 | 10345 2120 | 10351 2121 | 10353 2122 | 10359 2123 | 10361 2124 | 10367 2125 | 10369 2126 | 10375 2127 | 10383 2128 | 10391 2129 | 10399 2130 | 10407 2131 | 10415 2132 | 10417 2133 | 10423 2134 | 10425 2135 | 10431 2136 | 10433 2137 | 10439 2138 | 10441 2139 | 10447 2140 | 10449 2141 | 10455 2142 | 10463 2143 | 10471 2144 | 10479 2145 | 10487 2146 | 10495 2147 | 10503 2148 | 10505 2149 | 10511 2150 | 10513 2151 | 10519 2152 | 10521 2153 | 10527 2154 | 10529 2155 | 10535 2156 | 10543 2157 | 10551 2158 | 10559 2159 | 10567 2160 | 10575 2161 | 10577 2162 | 10583 2163 | 10585 2164 | 10591 2165 | 10593 2166 | 10599 2167 | 10601 2168 | 10607 2169 | 10609 2170 | 10615 2171 | 10623 2172 | 10631 2173 | 10639 2174 | 10647 2175 | 10649 2176 | 10655 2177 | 10657 2178 | 10663 2179 | 10665 2180 | 10671 2181 | 10673 2182 | 10679 2183 | 10681 2184 | 10687 2185 | 10689 2186 | 10695 2187 | 10703 2188 | 10711 2189 | 10719 2190 | 10727 2191 | 10735 2192 | 10743 2193 | 10751 2194 | 10759 2195 | 10767 2196 | 10775 2197 | 10783 2198 | 10791 2199 | 10799 2200 | 10807 2201 | 10815 2202 | 10816 2203 | 10823 2204 | 10824 2205 | 10831 2206 | 10832 2207 | 10839 2208 | 10840 2209 | 10847 2210 | 10848 2211 | 10855 2212 | 10856 2213 | 10863 2214 | 10864 2215 | 10871 2216 | 10872 2217 | 10879 2218 | 10880 2219 | 10887 2220 | 10888 2221 | 10895 2222 | 10896 2223 | 10903 2224 | 10911 2225 | 10919 2226 | 10927 2227 | 10935 2228 | 10943 2229 | 10951 2230 | 10959 2231 | 10967 2232 | 10975 2233 | 10983 2234 | 10991 2235 | 10999 2236 | 11007 2237 | 11015 2238 | 11023 2239 | 11031 2240 | 11039 2241 | 11047 2242 | 11055 2243 | 11063 2244 | 11071 2245 | 11079 2246 | 11087 2247 | 11095 2248 | 11103 2249 | 11105 2250 | 11111 2251 | 11113 2252 | 11119 2253 | 11121 2254 | 11127 2255 | 11129 2256 | 11135 2257 | 11137 2258 | 11143 2259 | 11145 2260 | 11151 2261 | 11153 2262 | 11159 2263 | 11161 2264 | 11167 2265 | 11169 2266 | 11175 2267 | 11177 2268 | 11183 2269 | 11185 2270 | 11191 2271 | 11193 2272 | 11199 2273 | 11201 2274 | 11207 2275 | 11209 2276 | 11215 2277 | 11217 2278 | 11223 2279 | 11225 2280 | 11231 2281 | 11233 2282 | 11239 2283 | 11241 2284 | 11247 2285 | 11249 2286 | 11255 2287 | 11257 2288 | 11263 2289 | 11265 2290 | 11271 2291 | 11273 2292 | 11279 2293 | 11281 2294 | 11287 2295 | 11289 2296 | 11295 2297 | 11297 2298 | 11303 2299 | 11305 2300 | 11311 2301 | 11313 2302 | 11319 2303 | 11321 2304 | 11327 2305 | 11329 2306 | 11335 2307 | 11337 2308 | 11343 2309 | 11344 2310 | 11345 2311 | 11351 2312 | 11352 2313 | 11353 2314 | 11359 2315 | 11360 2316 | 11361 2317 | 11367 2318 | 11368 2319 | 11369 2320 | 11375 2321 | 11376 2322 | 11377 2323 | 11383 2324 | 11384 2325 | 11385 2326 | 11391 2327 | 11392 2328 | 11393 2329 | 11399 2330 | 11400 2331 | 11401 2332 | 11407 2333 | 11408 2334 | 11409 2335 | 11415 2336 | 11416 2337 | 11417 2338 | 11423 2339 | 11424 2340 | 11425 2341 | 11431 2342 | 11432 2343 | 11433 2344 | 11439 2345 | 11440 2346 | 11441 2347 | 11447 2348 | 11448 2349 | 11449 2350 | 11455 2351 | 11456 2352 | 11457 2353 | 11463 2354 | 11464 2355 | 11465 2356 | 11471 2357 | 11472 2358 | 11473 2359 | 11479 2360 | 11480 2361 | 11481 2362 | 11487 2363 | 11488 2364 | 11489 2365 | 11495 2366 | 11497 2367 | 11503 2368 | 11505 2369 | 11511 2370 | 11513 2371 | 11519 2372 | 11521 2373 | 11527 2374 | 11529 2375 | 11535 2376 | 11537 2377 | 11543 2378 | 11545 2379 | 11551 2380 | 11553 2381 | 11559 2382 | 11561 2383 | 11567 2384 | 11569 2385 | 11575 2386 | 11577 2387 | 11583 2388 | 11585 2389 | 11591 2390 | 11593 2391 | 11599 2392 | 11601 2393 | 11607 2394 | 11609 2395 | 11615 2396 | 11617 2397 | 11623 2398 | 11625 2399 | 11631 2400 | 11633 2401 | 11639 2402 | 11641 2403 | 11647 2404 | 11649 2405 | 11655 2406 | 11657 2407 | 11663 2408 | 11665 2409 | 11671 2410 | 11673 2411 | 11679 2412 | 11681 2413 | 11687 2414 | 11689 2415 | 11695 2416 | 11697 2417 | 11703 2418 | 11705 2419 | 11711 2420 | 11713 2421 | 11719 2422 | 11721 2423 | 11727 2424 | 11729 2425 | 11735 2426 | 11737 2427 | 11743 2428 | 11744 2429 | 11745 2430 | 11751 2431 | 11752 2432 | 11753 2433 | 11759 2434 | 11760 2435 | 11761 2436 | 11767 2437 | 11768 2438 | 11769 2439 | 11775 2440 | 11776 2441 | 11777 2442 | 11783 2443 | 11784 2444 | 11785 2445 | 11791 2446 | 11792 2447 | 11793 2448 | 11799 2449 | 11800 2450 | 11801 2451 | 11807 2452 | 11808 2453 | 11809 2454 | 11815 2455 | 11816 2456 | 11817 2457 | 11823 2458 | 11824 2459 | 11825 2460 | 11831 2461 | 11832 2462 | 11833 2463 | 11839 2464 | 11840 2465 | 11841 2466 | 11847 2467 | 11848 2468 | 11849 2469 | 11855 2470 | 11856 2471 | 11857 2472 | 11863 2473 | 11865 2474 | 11871 2475 | 11873 2476 | 11879 2477 | 11881 2478 | 11887 2479 | 11889 2480 | 11895 2481 | 11897 2482 | 11903 2483 | 11905 2484 | 11911 2485 | 11913 2486 | 11919 2487 | 11921 2488 | 11927 2489 | 11929 2490 | 11935 2491 | 11937 2492 | 11943 2493 | 11945 2494 | 11951 2495 | 11953 2496 | 11959 2497 | 11961 2498 | 11967 2499 | 11969 2500 | 11975 2501 | 11977 2502 | 11983 2503 | 11985 2504 | 11991 2505 | 11993 2506 | 11999 2507 | 12001 2508 | 12007 2509 | 12009 2510 | 12015 2511 | 12017 2512 | 12023 2513 | 12025 2514 | 12031 2515 | 12033 2516 | 12039 2517 | 12041 2518 | 12047 2519 | 12049 2520 | 12055 2521 | 12057 2522 | 12063 2523 | 12065 2524 | 12071 2525 | 12073 2526 | 12079 2527 | 12081 2528 | 12087 2529 | 12089 2530 | 12095 2531 | 12097 2532 | 12103 2533 | 12105 2534 | 12111 2535 | 12113 2536 | 12119 2537 | 12121 2538 | 12127 2539 | 12128 2540 | 12129 2541 | 12135 2542 | 12136 2543 | 12137 2544 | 12143 2545 | 12144 2546 | 12145 2547 | 12151 2548 | 12152 2549 | 12153 2550 | 12159 2551 | 12160 2552 | 12161 2553 | 12167 2554 | 12168 2555 | 12169 2556 | 12175 2557 | 12176 2558 | 12177 2559 | 12183 2560 | 12184 2561 | 12185 2562 | 12191 2563 | 12192 2564 | 12193 2565 | 12199 2566 | 12200 2567 | 12201 2568 | 12207 2569 | 12208 2570 | 12209 2571 | 12215 2572 | 12216 2573 | 12217 2574 | 12223 2575 | 12224 2576 | 12225 2577 | 12231 2578 | 12232 2579 | 12233 2580 | 12239 2581 | 12240 2582 | 12241 2583 | 12247 2584 | 12248 2585 | 12249 2586 | 12255 2587 | 12256 2588 | 12257 2589 | 12263 2590 | 12264 2591 | 12265 2592 | 12271 2593 | 12272 2594 | 12273 2595 | 12279 2596 | 12280 2597 | 12281 2598 | 12287 2599 | 12289 2600 | 12295 2601 | 12297 2602 | 12303 2603 | 12305 2604 | 12311 2605 | 12313 2606 | 12319 2607 | 12321 2608 | 12327 2609 | 12329 2610 | 12335 2611 | 12337 2612 | 12343 2613 | 12345 2614 | 12351 2615 | 12353 2616 | 12359 2617 | 12361 2618 | 12367 2619 | 12369 2620 | 12375 2621 | 12377 2622 | 12383 2623 | 12385 2624 | 12391 2625 | 12393 2626 | 12399 2627 | 12401 2628 | 12407 2629 | 12409 2630 | 12415 2631 | 12417 2632 | 12423 2633 | 12425 2634 | 12431 2635 | 12433 2636 | 12439 2637 | 12441 2638 | 12447 2639 | 12449 2640 | 12455 2641 | 12457 2642 | 12463 2643 | 12465 2644 | 12471 2645 | 12473 2646 | 12479 2647 | 12481 2648 | 12487 2649 | 12489 2650 | 12495 2651 | 12497 2652 | 12503 2653 | 12505 2654 | 12511 2655 | 12513 2656 | 12519 2657 | 12521 2658 | 12527 2659 | 12529 2660 | 12535 2661 | 12537 2662 | 12543 2663 | 12545 2664 | 12551 2665 | 12553 2666 | 12559 2667 | 12561 2668 | 12567 2669 | 12569 2670 | 12575 2671 | 12577 2672 | 12583 2673 | 12585 2674 | 12591 2675 | 12593 2676 | 12599 2677 | 12601 2678 | 12607 2679 | 12609 2680 | 12615 2681 | 12617 2682 | 12623 2683 | 12625 2684 | 12631 2685 | 12633 2686 | 12639 2687 | 12641 2688 | 12647 2689 | 12649 2690 | 12655 2691 | 12657 2692 | 12663 2693 | 12665 2694 | 12671 2695 | 12673 2696 | 12679 2697 | 12681 2698 | 12687 2699 | 12688 2700 | 12689 2701 | 12695 2702 | 12696 2703 | 12697 2704 | 12703 2705 | 12704 2706 | 12705 2707 | 12711 2708 | 12712 2709 | 12713 2710 | 12719 2711 | 12720 2712 | 12721 2713 | 12727 2714 | 12728 2715 | 12729 2716 | 12735 2717 | 12736 2718 | 12737 2719 | 12743 2720 | 12744 2721 | 12745 2722 | 12751 2723 | 12752 2724 | 12753 2725 | 12759 2726 | 12760 2727 | 12761 2728 | 12767 2729 | 12768 2730 | 12769 2731 | 12775 2732 | 12777 2733 | 12783 2734 | 12785 2735 | 12791 2736 | 12793 2737 | 12799 2738 | 12801 2739 | 12807 2740 | 12809 2741 | 12815 2742 | 12817 2743 | 12823 2744 | 12825 2745 | 12831 2746 | 12833 2747 | 12839 2748 | 12841 2749 | 12847 2750 | 12849 2751 | 12855 2752 | 12857 2753 | 12863 2754 | 12865 2755 | 12871 2756 | 12873 2757 | 12879 2758 | 12881 2759 | 12887 2760 | 12889 2761 | 12895 2762 | 12897 2763 | 12903 2764 | 12904 2765 | 12905 2766 | 12911 2767 | 12912 2768 | 12913 2769 | 12919 2770 | 12920 2771 | 12921 2772 | 12927 2773 | 12928 2774 | 12929 2775 | 12935 2776 | 12936 2777 | 12937 2778 | 12943 2779 | 12944 2780 | 12945 2781 | 12951 2782 | 12952 2783 | 12953 2784 | 12959 2785 | 12960 2786 | 12961 2787 | 12967 2788 | 12968 2789 | 12969 2790 | 12975 2791 | 12976 2792 | 12977 2793 | 12983 2794 | 12985 2795 | 12991 2796 | 12993 2797 | 12999 2798 | 13007 2799 | 13015 2800 | 13023 2801 | 13031 2802 | 13039 2803 | 13047 2804 | 13167 2805 | 13175 2806 | 13183 2807 | 13191 2808 | 13193 2809 | 13199 2810 | 13201 2811 | 13207 2812 | 13209 2813 | 13215 2814 | 13216 2815 | 13217 2816 | 13223 2817 | 13224 2818 | 13225 2819 | 13231 2820 | 13232 2821 | 13233 2822 | 13239 2823 | 13240 2824 | 13241 2825 | 13247 2826 | 13248 2827 | 13249 2828 | 13255 2829 | 13256 2830 | 13257 2831 | 13263 2832 | 13264 2833 | 13265 2834 | 13271 2835 | 13272 2836 | 13273 2837 | 13279 2838 | 13280 2839 | 13281 2840 | 13287 2841 | 13288 2842 | 13289 2843 | 13295 2844 | 13296 2845 | 13297 2846 | 13303 2847 | 13304 2848 | 13305 2849 | 13311 2850 | 13313 2851 | 13319 2852 | 13321 2853 | 13327 2854 | 13329 2855 | 13335 2856 | 13337 2857 | 13343 2858 | 13345 2859 | 13351 2860 | 13353 2861 | 13359 2862 | 13361 2863 | 13367 2864 | 13369 2865 | 13375 2866 | 13383 2867 | 13391 2868 | 13399 2869 | 13407 2870 | 13415 2871 | 13423 2872 | 13431 2873 | 13439 2874 | 13447 2875 | 13455 2876 | 13463 2877 | 13471 2878 | 13479 2879 | 13487 2880 | 13495 2881 | 13503 2882 | 13511 2883 | 13519 2884 | 13527 2885 | 13529 2886 | 13535 2887 | 13537 2888 | 13543 2889 | 13545 2890 | 13551 2891 | 13553 2892 | 13559 2893 | 13561 2894 | 13567 2895 | 13569 2896 | 13575 2897 | 13577 2898 | 13583 2899 | 13585 2900 | 13591 2901 | 13593 2902 | 13599 2903 | 13601 2904 | 13607 2905 | 13609 2906 | 13615 2907 | 13617 2908 | 13623 2909 | 13625 2910 | 13631 2911 | 13633 2912 | 13639 2913 | 13641 2914 | 13647 2915 | 13649 2916 | 13655 2917 | 13657 2918 | 13663 2919 | 13665 2920 | 13671 2921 | 13673 2922 | 13679 2923 | 13681 2924 | 13687 2925 | 13689 2926 | 13695 2927 | 13697 2928 | 13703 2929 | 13705 2930 | 13711 2931 | 13713 2932 | 13719 2933 | 13721 2934 | 13727 2935 | 13729 2936 | 13735 2937 | 13737 2938 | 13743 2939 | 13745 2940 | 13751 2941 | 13753 2942 | 13759 2943 | 13760 2944 | 13761 2945 | 13767 2946 | 13768 2947 | 13769 2948 | 13775 2949 | 13776 2950 | 13777 2951 | 13783 2952 | 13784 2953 | 13785 2954 | 13791 2955 | 13792 2956 | 13793 2957 | 13799 2958 | 13800 2959 | 13801 2960 | 13807 2961 | 13808 2962 | 13809 2963 | 13815 2964 | 13816 2965 | 13817 2966 | 13823 2967 | 13824 2968 | 13825 2969 | 13831 2970 | 13832 2971 | 13833 2972 | 13839 2973 | 13840 2974 | 13841 2975 | 13847 2976 | 13849 2977 | 13855 2978 | 13863 2979 | 13871 2980 | 13879 2981 | 13887 2982 | 13895 2983 | 13903 2984 | 13911 2985 | 13919 2986 | 13927 2987 | 13935 2988 | 13943 2989 | 13951 2990 | 13959 2991 | 13967 2992 | 13975 2993 | 13983 2994 | 13991 2995 | 13999 2996 | 14007 2997 | 14015 2998 | 14023 2999 | 14129 3000 | 14137 3001 | 14145 3002 | 14153 3003 | 14161 3004 | 14169 3005 | 14201 3006 | 14209 3007 | 14215 3008 | 14217 3009 | 14223 3010 | 14225 3011 | 14231 3012 | 14233 3013 | 14239 3014 | 14247 3015 | 14255 3016 | 14263 3017 | 14271 3018 | 14279 3019 | 14281 3020 | 14287 3021 | 14289 3022 | 14295 3023 | 14297 3024 | 14303 3025 | 14305 3026 | 14311 3027 | 14313 3028 | 14319 3029 | 14327 3030 | 14335 3031 | 14343 3032 | 14351 3033 | 14359 3034 | 14367 3035 | 14472 3036 | 14480 3037 | 14488 3038 | 14496 3039 | 14504 3040 | 14512 3041 | 14520 3042 | 14528 3043 | 14536 3044 | 14544 3045 | 14552 3046 | 14607 3047 | 14615 3048 | 14623 3049 | 14631 3050 | 14639 3051 | 14647 3052 | 14655 3053 | 14663 3054 | 14671 3055 | 14679 3056 | 14694 3057 | 14702 3058 | 14710 3059 | 14718 3060 | 14726 3061 | 14734 3062 | 14742 3063 | 14750 3064 | 14758 3065 | 14766 3066 | 14774 3067 | 14782 3068 | 14790 3069 | 14798 3070 | 14806 3071 | 14814 3072 | 14822 3073 | 14830 3074 | 14838 3075 | 14846 3076 | 14854 3077 | 14862 3078 | 14870 3079 | 14878 3080 | 14886 3081 | 14894 3082 | 14902 3083 | 14910 3084 | 14918 3085 | 14926 3086 | 14934 3087 | 14942 3088 | 14950 3089 | 14958 3090 | 14976 3091 | 14984 3092 | 14991 3093 | 14992 3094 | 14999 3095 | 15000 3096 | 15007 3097 | 15008 3098 | 15015 3099 | 15016 3100 | 15023 3101 | 15024 3102 | 15031 3103 | 15032 3104 | 15039 3105 | 15047 3106 | 15055 3107 | 15063 3108 | 15071 3109 | 15079 3110 | 15087 3111 | 15095 3112 | 15103 3113 | 15111 3114 | 15119 3115 | 15127 3116 | 15135 3117 | 15143 3118 | 15145 3119 | 15151 3120 | 15153 3121 | 15159 3122 | 15161 3123 | 15167 3124 | 15169 3125 | 15175 3126 | 15177 3127 | 15183 3128 | 15185 3129 | 15191 3130 | 15193 3131 | 15199 3132 | 15201 3133 | 15207 3134 | 15209 3135 | 15215 3136 | 15217 3137 | 15223 3138 | 15225 3139 | 15231 3140 | 15233 3141 | 15239 3142 | 15241 3143 | 15247 3144 | 15249 3145 | 15255 3146 | 15257 3147 | 15263 3148 | 15265 3149 | 15271 3150 | 15273 3151 | 15279 3152 | 15281 3153 | 15287 3154 | 15289 3155 | 15295 3156 | 15297 3157 | 15303 3158 | 15305 3159 | 15311 3160 | 15313 3161 | 15319 3162 | 15321 3163 | 15327 3164 | 15329 3165 | 15335 3166 | 15337 3167 | 15343 3168 | 15345 3169 | 15351 3170 | 15353 3171 | 15359 3172 | 15361 3173 | 15367 3174 | 15369 3175 | 15375 3176 | 15377 3177 | 15383 3178 | 15385 3179 | 15391 3180 | 15393 3181 | 15399 3182 | 15401 3183 | 15407 3184 | 15409 3185 | 15415 3186 | 15417 3187 | 15423 3188 | 15425 3189 | 15431 3190 | 15433 3191 | 15439 3192 | 15441 3193 | 15447 3194 | 15449 3195 | 15455 3196 | 15456 3197 | 15457 3198 | 15463 3199 | 15464 3200 | 15465 3201 | 15471 3202 | 15472 3203 | 15473 3204 | 15479 3205 | 15480 3206 | 15481 3207 | 15487 3208 | 15488 3209 | 15489 3210 | 15495 3211 | 15496 3212 | 15497 3213 | 15503 3214 | 15504 3215 | 15505 3216 | 15511 3217 | 15512 3218 | 15513 3219 | 15519 3220 | 15520 3221 | 15521 3222 | 15527 3223 | 15529 3224 | 15535 3225 | 15537 3226 | 15543 3227 | 15545 3228 | 15551 3229 | 15553 3230 | 15559 3231 | 15561 3232 | 15567 3233 | 15569 3234 | 15575 3235 | 15577 3236 | 15583 3237 | 15585 3238 | 15591 3239 | 15593 3240 | 15599 3241 | 15601 3242 | 15607 3243 | 15609 3244 | 15615 3245 | 15617 3246 | 15623 3247 | 15625 3248 | 15631 3249 | 15633 3250 | 15639 3251 | 15641 3252 | 15647 3253 | 15649 3254 | 15655 3255 | 15657 3256 | 15663 3257 | 15664 3258 | 15665 3259 | 15671 3260 | 15672 3261 | 15673 3262 | 15679 3263 | 15680 3264 | 15681 3265 | 15687 3266 | 15688 3267 | 15689 3268 | 15695 3269 | 15696 3270 | 15697 3271 | 15703 3272 | 15704 3273 | 15705 3274 | 15711 3275 | 15712 3276 | 15713 3277 | 15719 3278 | 15720 3279 | 15721 3280 | 15727 3281 | 15728 3282 | 15729 3283 | 15735 3284 | 15736 3285 | 15737 3286 | 15743 3287 | 15744 3288 | 15745 3289 | 15751 3290 | 15752 3291 | 15753 3292 | 15759 3293 | 15760 3294 | 15761 3295 | 15767 3296 | 15768 3297 | 15769 3298 | 15775 3299 | 15776 3300 | 15777 3301 | 15783 3302 | 15784 3303 | 15785 3304 | 15791 3305 | 15792 3306 | 15793 3307 | 15799 3308 | 15800 3309 | 15801 3310 | 15807 3311 | 15808 3312 | 15809 3313 | 15815 3314 | 15816 3315 | 15817 3316 | 15823 3317 | 15824 3318 | 15825 3319 | 15831 3320 | 15832 3321 | 15833 3322 | 15839 3323 | 15840 3324 | 15841 3325 | 15847 3326 | 15848 3327 | 15849 3328 | 15855 3329 | 15856 3330 | 15857 3331 | 15863 3332 | 15864 3333 | 15865 3334 | 15871 3335 | 15872 3336 | 15873 3337 | 15879 3338 | 15880 3339 | 15881 3340 | 15887 3341 | 15888 3342 | 15889 3343 | 15895 3344 | 15896 3345 | 15897 3346 | 15903 3347 | 15904 3348 | 15905 3349 | 15911 3350 | 15913 3351 | 15919 3352 | 15921 3353 | 15927 3354 | 15929 3355 | 15935 3356 | 15937 3357 | 15943 3358 | 15945 3359 | 15951 3360 | 15953 3361 | 15959 3362 | 15961 3363 | 15967 3364 | 15969 3365 | 15975 3366 | 15976 3367 | 15977 3368 | 15983 3369 | 15984 3370 | 15985 3371 | 15991 3372 | 15992 3373 | 15993 3374 | 15999 3375 | 16000 3376 | 16001 3377 | 16007 3378 | 16008 3379 | 16009 3380 | 16015 3381 | 16016 3382 | 16017 3383 | 16023 3384 | 16024 3385 | 16025 3386 | 16031 3387 | 16032 3388 | 16033 3389 | 16039 3390 | 16040 3391 | 16041 3392 | 16047 3393 | 16048 3394 | 16049 3395 | 16055 3396 | 16056 3397 | 16057 3398 | 16063 3399 | 16065 3400 | 16071 3401 | 16073 3402 | 16079 3403 | 16081 3404 | 16087 3405 | 16089 3406 | 16095 3407 | 16097 3408 | 16103 3409 | 16303 3410 | 16311 3411 | 16319 3412 | 16321 3413 | 16327 3414 | 16329 3415 | 16335 3416 | 16337 3417 | 16343 3418 | 16344 3419 | 16345 3420 | 16351 3421 | 16352 3422 | 16353 3423 | 16359 3424 | 16360 3425 | 16361 3426 | 16367 3427 | 16368 3428 | 16369 3429 | 16375 3430 | 16376 3431 | 16377 3432 | 16383 3433 | 16384 3434 | 16391 3435 | 16392 3436 | 16400 3437 | 16408 3438 | 16519 3439 | 16527 3440 | 16535 3441 | 16543 3442 | 16551 3443 | 16773 3444 | 16781 3445 | 16789 3446 | 16797 3447 | 16805 3448 | 16813 3449 | 16837 3450 | 16845 3451 | 16853 3452 | 16861 3453 | 16869 3454 | 16893 3455 | 16901 3456 | 16909 3457 | 16917 3458 | 16949 3459 | 16957 3460 | 16965 3461 | 17055 3462 | 17063 3463 | 17071 3464 | 17079 3465 | 17087 3466 | 17095 3467 | 17103 3468 | 17111 3469 | 17119 3470 | 17127 3471 | 17135 3472 | 17143 3473 | 17151 3474 | 17159 3475 | 17167 3476 | 17175 3477 | 17303 3478 | 17311 3479 | 17319 3480 | 17327 3481 | 17335 3482 | 17407 3483 | 17415 3484 | 17423 3485 | 17431 3486 | 17503 3487 | 17511 3488 | 17519 3489 | 17527 3490 | 17535 3491 | 17719 3492 | 17727 3493 | 17735 3494 | 17743 3495 | 17751 3496 | 17821 3497 | 17829 3498 | 17837 3499 | 17845 3500 | 17853 3501 | 17877 3502 | 17885 3503 | 17893 3504 | 17901 3505 | 17909 3506 | 17917 3507 | 17966 3508 | 17974 3509 | 17982 3510 | 17990 3511 | 17998 3512 | 18006 3513 | 18014 3514 | 18022 3515 | 18030 3516 | 18038 3517 | 18046 3518 | 18054 3519 | 18062 3520 | 18070 3521 | 18078 3522 | 18086 3523 | 18094 3524 | 18102 3525 | 18110 3526 | 18118 3527 | 18126 3528 | 18134 3529 | 18142 3530 | 18183 3531 | 18191 3532 | 18199 3533 | 18207 3534 | 18209 3535 | 18215 3536 | 18217 3537 | 18223 3538 | 18225 3539 | 18231 3540 | 18233 3541 | 18239 3542 | 18241 3543 | 18247 3544 | 18249 3545 | 18255 3546 | 18257 3547 | 18263 3548 | 18265 3549 | 18271 3550 | 18273 3551 | 18279 3552 | 18281 3553 | 18287 3554 | 18289 3555 | 18295 3556 | 18297 3557 | 18303 3558 | 18305 3559 | 18311 3560 | 18313 3561 | 18319 3562 | 18321 3563 | 18327 3564 | 18329 3565 | 18335 3566 | 18337 3567 | 18343 3568 | 18345 3569 | 18351 3570 | 18353 3571 | 18359 3572 | 18361 3573 | 18367 3574 | 18369 3575 | 18375 3576 | 18377 3577 | 18383 3578 | 18385 3579 | 18391 3580 | 18392 3581 | 18393 3582 | 18399 3583 | 18400 3584 | 18401 3585 | 18407 3586 | 18408 3587 | 18409 3588 | 18415 3589 | 18416 3590 | 18417 3591 | 18423 3592 | 18424 3593 | 18425 3594 | 18431 3595 | 18432 3596 | 18433 3597 | 18439 3598 | 18440 3599 | 18441 3600 | 18447 3601 | 18448 3602 | 18449 3603 | 18455 3604 | 18456 3605 | 18457 3606 | 18463 3607 | 18464 3608 | 18465 3609 | 18471 3610 | 18472 3611 | 18473 3612 | 18479 3613 | 18480 3614 | 18481 3615 | 18487 3616 | 18488 3617 | 18489 3618 | 18495 3619 | 18496 3620 | 18497 3621 | 18503 3622 | 18504 3623 | 18505 3624 | 18511 3625 | 18512 3626 | 18513 3627 | 18519 3628 | 18520 3629 | 18521 3630 | 18527 3631 | 18528 3632 | 18529 3633 | 18535 3634 | 18536 3635 | 18537 3636 | 18543 3637 | 18544 3638 | 18545 3639 | 18551 3640 | 18552 3641 | 18553 3642 | 18559 3643 | 18560 3644 | 18561 3645 | 18567 3646 | 18568 3647 | 18569 3648 | 18575 3649 | 18576 3650 | 18577 3651 | 18583 3652 | 18584 3653 | 18585 3654 | 18591 3655 | 18592 3656 | 18593 3657 | 18599 3658 | 18600 3659 | 18601 3660 | 18607 3661 | 18608 3662 | 18609 3663 | 18615 3664 | 18616 3665 | 18617 3666 | 18623 3667 | 18624 3668 | 18625 3669 | 18631 3670 | 18632 3671 | 18633 3672 | 18639 3673 | 18640 3674 | 18641 3675 | 18647 3676 | 18648 3677 | 18649 3678 | 18655 3679 | 18656 3680 | 18657 3681 | 18663 3682 | 18664 3683 | 18665 3684 | 18671 3685 | 18672 3686 | 18673 3687 | 18679 3688 | 18680 3689 | 18681 3690 | 18687 3691 | 18688 3692 | 18689 3693 | 18695 3694 | 18696 3695 | 18697 3696 | 18703 3697 | 18704 3698 | 18705 3699 | 18711 3700 | 18712 3701 | 18713 3702 | 18719 3703 | 18720 3704 | 18721 3705 | 18727 3706 | 18728 3707 | 18729 3708 | 18735 3709 | 18736 3710 | 18737 3711 | 18743 3712 | 18744 3713 | 18745 3714 | 18751 3715 | 18752 3716 | 18753 3717 | 18759 3718 | 18760 3719 | 18761 3720 | 18767 3721 | 18768 3722 | 18769 3723 | 18775 3724 | 18776 3725 | 18777 3726 | 18783 3727 | 18784 3728 | 18785 3729 | 18791 3730 | 18792 3731 | 18793 3732 | 18799 3733 | 18800 3734 | 18801 3735 | 18807 3736 | 18808 3737 | 18809 3738 | 18815 3739 | 18816 3740 | 18817 3741 | 18823 3742 | 18824 3743 | 18825 3744 | 18831 3745 | 18832 3746 | 18833 3747 | 18839 3748 | 18840 3749 | 18841 3750 | 18847 3751 | 18848 3752 | 18849 3753 | 18855 3754 | 18856 3755 | 18857 3756 | 18863 3757 | 18864 3758 | 18865 3759 | 18871 3760 | 18872 3761 | 18873 3762 | 18879 3763 | 18880 3764 | 18881 3765 | 18887 3766 | 18888 3767 | 18889 3768 | 18895 3769 | 18896 3770 | 18897 3771 | 18903 3772 | 18904 3773 | 18905 3774 | 18911 3775 | 18912 3776 | 18913 3777 | 18919 3778 | 18920 3779 | 18921 3780 | 18927 3781 | 20089 3782 | 20097 3783 | 20105 3784 | 20113 3785 | 20121 3786 | 20129 3787 | 20137 3788 | 20145 3789 | 20153 3790 | 20161 3791 | 20169 3792 | 20177 3793 | 20185 3794 | 20193 3795 | 20201 3796 | 20209 3797 | 20217 3798 | 20225 3799 | 20233 3800 | 20241 3801 | 20249 3802 | 20257 3803 | 20304 3804 | 20312 3805 | 20320 3806 | 20328 3807 | 20336 3808 | 20344 3809 | 20352 3810 | 20360 3811 | 21600 3812 | 21608 3813 | 21615 3814 | 21616 3815 | 21623 3816 | 21624 3817 | 21631 3818 | 21632 3819 | 21639 3820 | 21640 3821 | 21647 3822 | 21648 3823 | 21655 3824 | 21656 3825 | 21663 3826 | 21664 3827 | 21671 3828 | 21672 3829 | 21676 3830 | 21679 3831 | 21680 3832 | 21684 3833 | 21687 3834 | 21688 3835 | 21692 3836 | 21695 3837 | 21696 3838 | 21700 3839 | 21703 3840 | 21704 3841 | 21708 3842 | 21711 3843 | 21712 3844 | 21713 3845 | 21716 3846 | 21719 3847 | 21720 3848 | 21721 3849 | 21724 3850 | 21727 3851 | 21729 3852 | 21732 3853 | 21735 3854 | 21737 3855 | 21740 3856 | 21743 3857 | 21745 3858 | 21748 3859 | 21750 3860 | 21751 3861 | 21753 3862 | 21756 3863 | 21758 3864 | 21759 3865 | 21761 3866 | 21764 3867 | 21766 3868 | 21767 3869 | 21769 3870 | 21772 3871 | 21774 3872 | 21782 3873 | 21790 3874 | 21798 3875 | 23559 3876 | 23560 3877 | 23567 3878 | 23568 3879 | 23575 3880 | 23576 3881 | 23577 3882 | 23583 3883 | 23584 3884 | 23585 3885 | 23591 3886 | 23592 3887 | 23593 3888 | 23597 3889 | 23599 3890 | 23600 3891 | 23601 3892 | 23605 3893 | 23607 3894 | 23608 3895 | 23609 3896 | 23613 3897 | 23615 3898 | 23616 3899 | 23617 3900 | 23621 3901 | 23623 3902 | 23624 3903 | 23625 3904 | 23629 3905 | 23631 3906 | 23632 3907 | 23633 3908 | 23637 3909 | 23639 3910 | 23640 3911 | 23641 3912 | 23645 3913 | 23647 3914 | 23648 3915 | 23649 3916 | 23653 3917 | 23655 3918 | 23656 3919 | 23657 3920 | 23661 3921 | 23662 3922 | 23663 3923 | 23665 3924 | 23669 3925 | 23670 3926 | 23671 3927 | 23673 3928 | 23677 3929 | 23678 3930 | 23681 3931 | 23686 3932 | 23689 3933 | 23694 3934 | 23697 3935 | 23702 3936 | 23705 3937 | 23713 3938 | -------------------------------------------------------------------------------- /tests/inputs/nestest.rec: -------------------------------------------------------------------------------- 1 | 227 2 | 235 3 | 243 4 | 514 5 | 522 6 | 530 7 | 538 8 | 811 9 | 819 10 | 1248 11 | 1256 12 | 1264 13 | 1272 14 | -------------------------------------------------------------------------------- /tests/roms/mario.nes: -------------------------------------------------------------------------------- 1 | ../../roms/games/mario.nes -------------------------------------------------------------------------------- /tests/roms/nestest.nes: -------------------------------------------------------------------------------- 1 | ../../roms/tests/nestest.nes -------------------------------------------------------------------------------- /tests/video_diffs.ml: -------------------------------------------------------------------------------- 1 | open Bos 2 | 3 | let dir name = Fpath.(v name |> to_dir_path) 4 | let roms_dir = dir "roms" 5 | let inputs_dir = dir "inputs" 6 | let videos_dir = dir "videos" 7 | 8 | let launch_emulator args rom = 9 | let cmd = Cmd.(v "nes-ml" %% args % p rom) in 10 | assert (OS.Cmd.run cmd |> Result.is_ok) 11 | 12 | let record_video name = 13 | let input_file = Fpath.(inputs_dir / name |> add_ext "rec") in 14 | let output_file = Fpath.(v name |> add_ext "mp4") in 15 | let rom_file = Fpath.(roms_dir / name |> add_ext "nes") in 16 | let args = Cmd.(v "-m" % p input_file % "-u" % "-t" % "-s" % p output_file) in 17 | launch_emulator args rom_file; 18 | output_file 19 | 20 | let videos_equal name v1 v2 = 21 | let get_md5 n = 22 | let cmd = 23 | Cmd.( 24 | v "ffmpeg" % "-loglevel" % "error" % "-i" % p n % "-map" % "0:v" % "-f" 25 | % "md5" % "-") 26 | in 27 | let out = OS.Cmd.run_out cmd in 28 | match OS.Cmd.to_string out with 29 | | Ok s -> s 30 | | Error _ -> failwith "Couldn't retrieve output" 31 | in 32 | let m1 = get_md5 v1 in 33 | let m2 = get_md5 v2 in 34 | Printf.printf "%s\n=============\nv1: %s\nv2: %s\n%!" name m1 m2; 35 | m1 = m2 36 | 37 | let test_case name = 38 | let test_video = record_video name in 39 | let video_file = Fpath.(videos_dir / name |> add_ext "mp4") in 40 | assert (videos_equal name test_video video_file) 41 | 42 | let list_inputs () = 43 | match OS.Dir.contents inputs_dir with 44 | | Ok files -> List.map Fpath.rem_ext files |> List.map Fpath.basename 45 | | Error _ -> failwith "Failed to retrieve list of recordings" 46 | 47 | let _ = 48 | let names = list_inputs () in 49 | List.iter test_case names 50 | -------------------------------------------------------------------------------- /tests/videos/mario.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/tests/videos/mario.mp4 -------------------------------------------------------------------------------- /tests/videos/nestest.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/nes-ml/36d5743edf67f72d39a8fc1eff1dd00d1284d09e/tests/videos/nestest.mp4 --------------------------------------------------------------------------------