├── .gitignore ├── LICENSE ├── README.md ├── elm-package.json ├── index.html ├── index.js ├── package.json ├── src ├── AddressingMode.elm ├── AppCss.elm ├── AppState.elm ├── Breakpoints.elm ├── Byte.elm ├── ByteArray.elm ├── Colors.elm ├── Console.elm ├── ConsoleCommand.elm ├── Continue.elm ├── DebuggerCommand.elm ├── DebuggerState.elm ├── Disassembler.elm ├── HexEditor.elm ├── Instruction.elm ├── Main.elm ├── Memory.elm ├── Native │ ├── ByteArray.js │ └── WebSocket.js ├── Ports.elm ├── Registers.elm ├── Step.elm ├── Styles.elm ├── Stylesheets.elm ├── ToggleBreakpoint.elm ├── ToggleNmiBreakpoint.elm ├── WebSocket.elm └── WebSocket │ └── LowLevel.elm └── webpack.config.js /.gitignore: -------------------------------------------------------------------------------- 1 | .idea/ 2 | elm-stuff/ 3 | node_modules 4 | dist 5 | npm-debug.log 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2016 W. Brian Gourlie 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## rs-nes-debugger-frontend 2 | 3 | This is the front-end for the rs-nes debugger. You can view a demo of it in action [here](https://www.youtube.com/watch?v=YC2FvozglPc) 4 | 5 | ### Running the project 6 | 7 | git clone https://github.com/bgourlie/rs-nes-debugger-frontend.git 8 | cd rs-nes-debugger-frontend 9 | npm install 10 | elm-package install 11 | npm run dev 12 | 13 | Then navigate your browser to `http://localhost:3001`. 14 | -------------------------------------------------------------------------------- /elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.0", 3 | "summary": "A debugger front-end for for rs-nes.", 4 | "repository": "https://github.com/bgourlie/rs-nes-debugger-frontend.git", 5 | "license": "MIT", 6 | "source-directories": [ 7 | "src" 8 | ], 9 | "exposed-modules": [], 10 | "native-modules": true, 11 | "dependencies": { 12 | "elm-community/list-split": "1.0.2 <= v < 2.0.0", 13 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 14 | "elm-lang/dom": "1.1.1 <= v < 2.0.0", 15 | "elm-lang/html": "2.0.0 <= v < 3.0.0", 16 | "elm-lang/http": "1.0.0 <= v < 2.0.0", 17 | "elm-lang/keyboard": "1.0.1 <= v < 2.0.0", 18 | "elm-lang/svg": "2.0.0 <= v < 3.0.0", 19 | "elm-tools/parser": "1.0.2 <= v < 2.0.0", 20 | "fredcy/elm-parseint": "2.0.0 <= v < 3.0.0", 21 | "rtfeldman/elm-css": "8.1.0 <= v < 9.0.0", 22 | "rtfeldman/elm-css-helpers": "2.0.1 <= v < 3.0.0" 23 | }, 24 | "elm-version": "0.18.0 <= v < 0.19.0" 25 | } 26 | -------------------------------------------------------------------------------- /index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | rs-nes debugger 6 | 7 | 8 | 9 | 10 | -------------------------------------------------------------------------------- /index.js: -------------------------------------------------------------------------------- 1 | 'use strict'; 2 | 3 | require('./index.html'); 4 | require('./src/Stylesheets'); 5 | const Elm = require('./src/Main'); 6 | 7 | const app = Elm.Main.fullscreen(); 8 | 9 | app.ports.scrollElementIntoViewCommand.subscribe(function(cls) { 10 | const elem = document.getElementsByClassName(cls)[0]; 11 | if (elem) { 12 | elem.scrollIntoView(); 13 | } 14 | }); 15 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "rsnes-debugger", 3 | "main": "index.js", 4 | "version": "1.0.0", 5 | "private": true, 6 | "scripts": { 7 | "build": "webpack", 8 | "watch": "webpack --watch", 9 | "test": "echo \"Error: no test specified\" && exit 1", 10 | "dev": "webpack-dev-server --port 3001" 11 | }, 12 | "devDependencies": { 13 | "css-loader": "^0.25.0", 14 | "elm-css-webpack-loader": "^2.0.1", 15 | "elm-webpack-loader": "^4.0.0", 16 | "file-loader": "^0.9.0", 17 | "style-loader": "^0.13.1", 18 | "webpack": "^1.12.0", 19 | "webpack-dev-server": "^1.14.0" 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /src/AddressingMode.elm: -------------------------------------------------------------------------------- 1 | module AddressingMode exposing (AddressingMode(..), getTargetOffset, view) 2 | 3 | import Byte 4 | import ByteArray exposing (ByteArray) 5 | import Html exposing (Html, span, text) 6 | import ParseInt exposing (toHex) 7 | import Registers exposing (Registers) 8 | 9 | 10 | type AddressingMode 11 | = IndexedIndirect Int 12 | | IndirectIndexed Int 13 | | ZeroPage Int 14 | | Immediate Int 15 | | Absolute Int 16 | | AbsoluteX Int 17 | | AbsoluteY Int 18 | | ZeroPageX Int 19 | | ZeroPageY Int 20 | | Indirect Int 21 | | Relative Int 22 | | Implied 23 | | Accumulator 24 | 25 | 26 | 27 | -- TODO: This is something that really needs good tests 28 | 29 | 30 | getTargetOffset : ByteArray -> Registers -> AddressingMode -> Maybe ( Int, Int ) 31 | getTargetOffset bytes registers am = 32 | case am of 33 | IndexedIndirect addr -> 34 | Nothing 35 | 36 | IndirectIndexed addr -> 37 | let 38 | -- TODO: for IndirectIndexed, getWord should have zero-page wrapping behavior 39 | targetAddr = 40 | ByteArray.getWord addr bytes + registers.y 41 | 42 | value = 43 | ByteArray.getByte targetAddr bytes 44 | in 45 | Just ( targetAddr, value ) 46 | 47 | ZeroPage addr -> 48 | Just ( addr, ByteArray.getByte addr bytes ) 49 | 50 | Absolute addr -> 51 | Just ( addr, ByteArray.getByte addr bytes ) 52 | 53 | AbsoluteX addr -> 54 | Just ( addr + registers.x, ByteArray.getByte (addr + registers.x) bytes ) 55 | 56 | AbsoluteY addr -> 57 | Just ( addr + registers.y, ByteArray.getByte (addr + registers.y) bytes ) 58 | 59 | ZeroPageX addr -> 60 | Just ( addr + registers.x, ByteArray.getByte (addr + registers.x) bytes ) 61 | 62 | ZeroPageY addr -> 63 | Just ( addr + registers.y, ByteArray.getByte (addr + registers.y) bytes ) 64 | 65 | Indirect addr -> 66 | let 67 | targetAddr = 68 | ByteArray.getWord addr bytes 69 | 70 | value = 71 | ByteArray.getWord targetAddr bytes 72 | in 73 | Just ( targetAddr, value ) 74 | 75 | _ -> 76 | Nothing 77 | 78 | 79 | view : Byte.Format -> AddressingMode -> List (Html msg) 80 | view display am = 81 | case am of 82 | IndexedIndirect addr -> 83 | indexedIndirectView display addr 84 | 85 | IndirectIndexed addr -> 86 | indirectIndexedView display addr 87 | 88 | ZeroPage addr -> 89 | zeroPageView display addr 90 | 91 | Immediate addr -> 92 | immediateView display addr 93 | 94 | Absolute addr -> 95 | absoluteView display addr 96 | 97 | AbsoluteX addr -> 98 | absoluteXView display addr 99 | 100 | AbsoluteY addr -> 101 | absoluteYView display addr 102 | 103 | ZeroPageX addr -> 104 | zeroPageXView display addr 105 | 106 | ZeroPageY addr -> 107 | zeroPageYView display addr 108 | 109 | Indirect addr -> 110 | indirectView display addr 111 | 112 | Relative addr -> 113 | relativeView display addr 114 | 115 | Implied -> 116 | [] 117 | 118 | Accumulator -> 119 | [ text "A" ] 120 | 121 | 122 | indexedIndirectView : Byte.Format -> Int -> List (Html msg) 123 | indexedIndirectView display addr = 124 | [ text "(" 125 | , asmByteView Byte.Hex addr 126 | , text ",X)" 127 | ] 128 | 129 | 130 | indirectIndexedView : Byte.Format -> Int -> List (Html msg) 131 | indirectIndexedView display addr = 132 | [ text "(" 133 | , asmByteView display addr 134 | , text "),Y" 135 | ] 136 | 137 | 138 | indirectView : Byte.Format -> Int -> List (Html msg) 139 | indirectView display addr = 140 | [ text "(" 141 | , asmByteView display addr 142 | , text ")" 143 | ] 144 | 145 | 146 | zeroPageView : Byte.Format -> Int -> List (Html msg) 147 | zeroPageView display addr = 148 | [ asmByteView display addr 149 | ] 150 | 151 | 152 | immediateView : Byte.Format -> Int -> List (Html msg) 153 | immediateView display addr = 154 | [ span [] [ text "#" ] 155 | , asmByteView display addr 156 | ] 157 | 158 | 159 | absoluteView : Byte.Format -> Int -> List (Html msg) 160 | absoluteView display addr = 161 | [ asmByteView display addr 162 | ] 163 | 164 | 165 | zeroPageXView : Byte.Format -> Int -> List (Html msg) 166 | zeroPageXView display addr = 167 | [ asmByteView display addr 168 | , text ",X" 169 | ] 170 | 171 | 172 | zeroPageYView : Byte.Format -> Int -> List (Html msg) 173 | zeroPageYView display addr = 174 | [ asmByteView display addr 175 | , text ",Y" 176 | ] 177 | 178 | 179 | absoluteXView : Byte.Format -> Int -> List (Html msg) 180 | absoluteXView display addr = 181 | [ asmByteView display addr 182 | , text ",X" 183 | ] 184 | 185 | 186 | absoluteYView : Byte.Format -> Int -> List (Html msg) 187 | absoluteYView display addr = 188 | [ asmByteView display addr 189 | , text ",Y" 190 | ] 191 | 192 | 193 | relativeView : Byte.Format -> Int -> List (Html msg) 194 | relativeView display addr = 195 | [ asmByteView display addr 196 | ] 197 | 198 | 199 | 200 | -- We use a special byte for for 6502 assembly, which prefixes hex values with $ instead of 0x 201 | 202 | 203 | asmByteView : Byte.Format -> Int -> Html msg 204 | asmByteView display byte = 205 | let 206 | str = 207 | case display of 208 | Byte.Hex -> 209 | -- Correctly display negative hex values (accommodates relative addressing) 210 | if byte < 0 then 211 | "-$" ++ toHex byte 212 | else 213 | "$" ++ toHex byte 214 | 215 | Byte.Dec -> 216 | toString byte 217 | 218 | Byte.Ascii -> 219 | "'" ++ Byte.asciiValue byte ++ "'" 220 | in 221 | text str 222 | -------------------------------------------------------------------------------- /src/AppCss.elm: -------------------------------------------------------------------------------- 1 | module AppCss exposing (css) 2 | 3 | import Breakpoints 4 | import Byte 5 | import Colors 6 | import Console 7 | import Css exposing (..) 8 | import Css.Elements exposing (body, div, html, li, ul) 9 | import Css.Namespace exposing (namespace) 10 | import HexEditor 11 | import Instruction 12 | import Main 13 | import Registers 14 | import Styles 15 | 16 | 17 | css : Stylesheet 18 | css = 19 | (stylesheet << namespace "") <| 20 | List.concat 21 | [ [ html 22 | [ boxSizing borderBox 23 | ] 24 | , everything 25 | [ boxSizing inherit 26 | , after 27 | [ boxSizing inherit 28 | ] 29 | , before 30 | [ boxSizing inherit 31 | ] 32 | ] 33 | , body 34 | [ padding (px 0) 35 | , margin (px 0) 36 | , backgroundColor Colors.background 37 | , color Colors.foreground 38 | , fontFamily monospace 39 | ] 40 | ] 41 | , Main.styles 42 | , Instruction.styles 43 | , Console.styles 44 | , HexEditor.styles 45 | , Breakpoints.styles 46 | , Registers.styles 47 | ] 48 | -------------------------------------------------------------------------------- /src/AppState.elm: -------------------------------------------------------------------------------- 1 | module AppState exposing (AppState(..), Input(..), transition) 2 | 3 | import Continue 4 | import Step 5 | import Task 6 | 7 | 8 | -- A state machine defining all the debugger states and transitions 9 | 10 | 11 | type alias Model a = 12 | { a 13 | | appState : AppState 14 | } 15 | 16 | 17 | type AppState 18 | = NotConnected 19 | | Paused 20 | | Running 21 | 22 | 23 | type Input 24 | = Connect 25 | | Disconnect 26 | | Pause 27 | | Continue 28 | | Step 29 | 30 | 31 | transition : Input -> AppState -> Result ( Input, AppState ) AppState 32 | transition input oldState = 33 | case oldState of 34 | NotConnected -> 35 | case input of 36 | Connect -> 37 | Ok Paused 38 | 39 | _ -> 40 | Err ( input, oldState ) 41 | 42 | Paused -> 43 | case input of 44 | Pause -> 45 | Ok Paused 46 | 47 | Disconnect -> 48 | Ok NotConnected 49 | 50 | Continue -> 51 | Ok Running 52 | 53 | Step -> 54 | Ok Running 55 | 56 | _ -> 57 | Err ( input, oldState ) 58 | 59 | Running -> 60 | case input of 61 | Disconnect -> 62 | Ok NotConnected 63 | 64 | Pause -> 65 | Ok Paused 66 | 67 | Continue -> 68 | Ok Running 69 | 70 | Step -> 71 | Ok Running 72 | 73 | _ -> 74 | Err ( input, oldState ) 75 | -------------------------------------------------------------------------------- /src/Breakpoints.elm: -------------------------------------------------------------------------------- 1 | module Breakpoints 2 | exposing 3 | ( Breakpoints 4 | , icon 5 | , isSet 6 | , styles 7 | , toggleBreakpoint 8 | ) 9 | 10 | import Colors 11 | import Css 12 | import Html exposing (Html) 13 | import Set exposing (Set) 14 | import Styles 15 | import Svg exposing (circle, path, svg) 16 | import Svg.Attributes exposing (cx, cy, d, fill, height, r, viewBox, width) 17 | 18 | 19 | { id, class, classList } = 20 | Styles.helpers 21 | 22 | 23 | type alias Breakpoints = 24 | Set Int 25 | 26 | 27 | type alias Model a = 28 | { a | breakpoints : Breakpoints } 29 | 30 | 31 | toggleBreakpoint : Model a -> Bool -> Int -> Breakpoints 32 | toggleBreakpoint model isSet offset = 33 | if isSet then 34 | Set.insert offset model.breakpoints 35 | else 36 | Set.remove offset model.breakpoints 37 | 38 | 39 | isSet : Breakpoints -> Int -> Bool 40 | isSet breakpoints offset = 41 | Set.member offset breakpoints 42 | 43 | 44 | icon : Html msg 45 | icon = 46 | svg 47 | [ Svg.Attributes.class <| toString Styles.BreakpointIcon, viewBox "0 0 20 20" ] 48 | [ circle 49 | [ fill Colors.breakpointColor 50 | , cx "10" 51 | , cy "10" 52 | , r "10" 53 | ] 54 | [] 55 | ] 56 | 57 | 58 | styles : List Css.Snippet 59 | styles = 60 | [ Styles.class Styles.BreakpointIcon 61 | [ Css.height (Css.ch 1.6) 62 | , Css.width (Css.ch 1.6) 63 | ] 64 | ] 65 | -------------------------------------------------------------------------------- /src/Byte.elm: -------------------------------------------------------------------------------- 1 | module Byte exposing (Format(..), asciiValue) 2 | 3 | import Char 4 | import Styles 5 | 6 | 7 | { id, class, classList } = 8 | Styles.helpers 9 | 10 | 11 | type Format 12 | = Hex 13 | | Dec 14 | | Ascii 15 | 16 | 17 | asciiValue : Int -> String 18 | asciiValue value = 19 | if value >= 32 && value <= 127 then 20 | String.fromChar (Char.fromCode value) 21 | else 22 | "." 23 | -------------------------------------------------------------------------------- /src/ByteArray.elm: -------------------------------------------------------------------------------- 1 | module ByteArray exposing (..) 2 | 3 | import Bitwise 4 | import Native.ByteArray 5 | 6 | 7 | type ByteArray 8 | = ByteArray 9 | 10 | 11 | empty : ByteArray 12 | empty = 13 | Native.ByteArray.empty 14 | 15 | 16 | get : Int -> ByteArray -> Maybe Int 17 | get i arr = 18 | Native.ByteArray.get i arr 19 | 20 | 21 | get16 : Int -> ByteArray -> Maybe Int 22 | get16 i arr = 23 | Maybe.map2 24 | (\low_byte high_byte -> Bitwise.or low_byte (Bitwise.shiftLeftBy 8 high_byte)) 25 | (get i arr) 26 | (get (i + 1) arr) 27 | 28 | 29 | fromBase64 : String -> Result String ByteArray 30 | fromBase64 base64 = 31 | Native.ByteArray.fromBase64 base64 32 | 33 | 34 | slice : Int -> Int -> ByteArray -> ByteArray 35 | slice start end arr = 36 | Native.ByteArray.slice start end arr 37 | 38 | 39 | toList : ByteArray -> List Int 40 | toList arr = 41 | Native.ByteArray.toList arr 42 | 43 | 44 | getByte : Int -> ByteArray -> Int 45 | getByte addr memory = 46 | Maybe.withDefault 0 (get addr memory) 47 | 48 | 49 | getWord : Int -> ByteArray -> Int 50 | getWord addr memory = 51 | Maybe.withDefault 0 (get16 addr memory) 52 | -------------------------------------------------------------------------------- /src/Colors.elm: -------------------------------------------------------------------------------- 1 | module Colors exposing (..) 2 | 3 | import Css exposing (hex) 4 | 5 | 6 | background : Css.Color 7 | background = 8 | hex "#2b2b2b" 9 | 10 | 11 | foreground : Css.Color 12 | foreground = 13 | hex "#a9b7c6" 14 | 15 | 16 | consoleBackground : Css.Color 17 | consoleBackground = 18 | hex "#111111" 19 | 20 | 21 | consoleInputBackground : Css.Color 22 | consoleInputBackground = 23 | hex "#111111" 24 | 25 | 26 | consoleInputText : Css.Color 27 | consoleInputText = 28 | hex "#dddddd" 29 | 30 | 31 | currentLine : Css.Color 32 | currentLine = 33 | hex "#2d6099" 34 | 35 | 36 | mnemonic : Css.Color 37 | mnemonic = 38 | hex "#a5c25c" 39 | 40 | 41 | undefinedOpcode : Css.Color 42 | undefinedOpcode = 43 | hex "#606366" 44 | 45 | 46 | gutterBackground : Css.Color 47 | gutterBackground = 48 | hex "#313335" 49 | 50 | 51 | gutterBorder : Css.Color 52 | gutterBorder = 53 | hex "#606366" 54 | 55 | 56 | lineNumber : Css.Color 57 | lineNumber = 58 | hex "#606366" 59 | 60 | 61 | headerColor : Css.Color 62 | headerColor = 63 | hex "#313335" 64 | 65 | 66 | headerBorder : Css.Color 67 | headerBorder = 68 | hex "#606366" 69 | 70 | 71 | messageRepeatBackgroundColor : Css.Color 72 | messageRepeatBackgroundColor = 73 | hex "#214283" 74 | 75 | 76 | breakpointColor : String 77 | breakpointColor = 78 | "#FF6666" 79 | 80 | 81 | buttonBorderColor : String 82 | buttonBorderColor = 83 | "#808080" 84 | 85 | 86 | debuggerIconColor : String 87 | debuggerIconColor = 88 | "#9FD6AE" 89 | 90 | 91 | hexEditorOffsetColor : Css.Color 92 | hexEditorOffsetColor = 93 | hex "#606366" 94 | 95 | 96 | hexEditorByte : Css.Color 97 | hexEditorByte = 98 | hex "#6897bb" 99 | 100 | 101 | hexEditorBackground : Css.Color 102 | hexEditorBackground = 103 | hex "#222222" 104 | 105 | 106 | addressModeActiveValue : Css.Color 107 | addressModeActiveValue = 108 | hex "#ffc66d" 109 | 110 | 111 | addressModeInactiveValue : Css.Color 112 | addressModeInactiveValue = 113 | hex "#777777" 114 | 115 | 116 | statusConnected : Css.Color 117 | statusConnected = 118 | hex "00aa00" 119 | 120 | 121 | statusDisconnected : Css.Color 122 | statusDisconnected = 123 | hex "990000" 124 | 125 | 126 | statusStripBackgroundColor : Css.Color 127 | statusStripBackgroundColor = 128 | hex "3c3f41" 129 | -------------------------------------------------------------------------------- /src/Console.elm: -------------------------------------------------------------------------------- 1 | module Console exposing (addMessage, styles, view) 2 | 3 | import Colors 4 | import Css 5 | import Dom.Scroll 6 | import Html exposing (Html) 7 | import Styles 8 | import Task exposing (Task) 9 | 10 | 11 | { id, class, classList } = 12 | Styles.helpers 13 | 14 | 15 | type alias Model a = 16 | { a 17 | | messages : List ( String, Int ) 18 | } 19 | 20 | 21 | 22 | -- TODO: break this up into smaller functions 23 | 24 | 25 | addMessage : msg -> String -> ( Model a, Cmd msg ) -> ( Model a, Cmd msg ) 26 | addMessage handler message appInput = 27 | let 28 | ( inputModel, inputCmd ) = 29 | appInput 30 | 31 | last = 32 | List.head inputModel.messages 33 | 34 | ( messages, cmd ) = 35 | let 36 | newItem = 37 | case last of 38 | Just msgItem -> 39 | let 40 | ( msg, repeats ) = 41 | msgItem 42 | in 43 | if msg == message then 44 | ( msg, repeats + 1 ) 45 | else 46 | ( message, 0 ) 47 | 48 | Nothing -> 49 | ( message, 0 ) 50 | in 51 | case List.tail inputModel.messages of 52 | Just tail -> 53 | let 54 | ( _, newRepeats ) = 55 | newItem 56 | in 57 | if newRepeats > 0 then 58 | ( newItem :: tail, Cmd.none ) 59 | else 60 | let 61 | result = 62 | \r -> 63 | case r of 64 | Ok _ -> 65 | handler 66 | 67 | Err _ -> 68 | handler 69 | in 70 | ( newItem :: inputModel.messages, Task.attempt result (Dom.Scroll.toBottom <| toString Styles.ConsoleLines) ) 71 | 72 | Nothing -> 73 | ( newItem :: inputModel.messages, Cmd.none ) 74 | in 75 | ( { inputModel | messages = messages }, Cmd.batch [ inputCmd, cmd ] ) 76 | 77 | 78 | styles : List Css.Snippet 79 | styles = 80 | [ Styles.id Styles.ConsoleLines 81 | [ Css.width (Css.pct 100) 82 | , Css.padding2 (Css.em 0.3) (Css.em 0.5) 83 | , Css.backgroundColor Colors.consoleBackground 84 | , Css.displayFlex 85 | , Css.flexDirection Css.column 86 | , Css.overflowY Css.auto 87 | , Css.children 88 | [ Styles.class Styles.ConsoleLine 89 | [ Css.paddingBottom (Css.em 0.1) 90 | , Css.children 91 | [ Styles.class Styles.MessageRepeats 92 | [ Css.display Css.inlineBlock 93 | , Css.marginLeft (Css.em 0.5) 94 | , Css.padding2 (Css.em 0.075) (Css.em 0.25) 95 | , Css.backgroundColor Colors.messageRepeatBackgroundColor 96 | , Css.borderRadius (Css.pct 50) 97 | , Css.fontSize (Css.pct 80) 98 | , Css.property "visibility" "hidden" 99 | ] 100 | , Styles.class Styles.MessageRepeatsShow 101 | [ Css.property "visibility" "visible" 102 | ] 103 | ] 104 | ] 105 | ] 106 | ] 107 | ] 108 | 109 | 110 | view : Model a -> Html msg 111 | view { messages } = 112 | Html.div [ id Styles.ConsoleLines ] 113 | (messages 114 | |> List.map 115 | (\( msg, repeats ) -> 116 | Html.div [ class [ Styles.ConsoleLine ] ] 117 | [ Html.span [] [ Html.text msg ] 118 | , Html.span [ messageRepeatsClasses repeats ] [ Html.text <| toString repeats ] 119 | ] 120 | ) 121 | |> List.reverse 122 | ) 123 | 124 | 125 | messageRepeatsClasses : Int -> Html.Attribute msg 126 | messageRepeatsClasses repeats = 127 | if repeats > 0 then 128 | class [ Styles.MessageRepeats, Styles.MessageRepeatsShow ] 129 | else 130 | class [ Styles.MessageRepeats ] 131 | -------------------------------------------------------------------------------- /src/ConsoleCommand.elm: -------------------------------------------------------------------------------- 1 | module ConsoleCommand exposing (BreakpointType(..), ConsoleCommand(..), parse) 2 | 3 | import Byte 4 | import Parser exposing (..) 5 | 6 | 7 | type ConsoleCommand 8 | = ToggleBreakpoint BreakpointType 9 | | JumpToMemory Int 10 | | SetDisassembleOffset Int 11 | | SetMemoryByteView Byte.Format 12 | | SetOffsetByteView Byte.Format 13 | | SetOperandByteView Byte.Format 14 | | SetRegistersByteView Byte.Format 15 | 16 | 17 | type BreakpointType 18 | = Offset Int 19 | | Nmi 20 | 21 | 22 | parse : String -> Result String ConsoleCommand 23 | parse input = 24 | run 25 | (oneOf 26 | [ parseBreakpointCommand 27 | , parseSetDisassembleOffsetCommand 28 | , parseJumpToMemoryCommand 29 | , parseSetMemoryByteView 30 | , parseSetOffsetByteView 31 | , parseSetOperandByteView 32 | , parseSetRegistersByteView 33 | ] 34 | ) 35 | input 36 | |> Result.mapError (\_ -> "An error occurred while parsing the command") 37 | 38 | 39 | parseBreakpointCommand : Parser ConsoleCommand 40 | parseBreakpointCommand = 41 | succeed ToggleBreakpoint 42 | |. keyword "bp" 43 | |. spaces 44 | |= oneOf 45 | [ int |> andThen (\offset -> succeed (Offset offset)) 46 | , keyword "nmi" |> andThen (\_ -> succeed Nmi) 47 | ] 48 | 49 | 50 | parseJumpToMemoryCommand : Parser ConsoleCommand 51 | parseJumpToMemoryCommand = 52 | succeed JumpToMemory 53 | |. keyword "jmpm" 54 | |. spaces 55 | |= oneOf 56 | [ int 57 | , keyword "stack" |> andThen (\_ -> succeed 0x0100) 58 | ] 59 | 60 | 61 | parseSetDisassembleOffsetCommand : Parser ConsoleCommand 62 | parseSetDisassembleOffsetCommand = 63 | succeed SetDisassembleOffset 64 | |. keyword "sdo" 65 | |. spaces 66 | |= int 67 | 68 | 69 | parseSetMemoryByteView : Parser ConsoleCommand 70 | parseSetMemoryByteView = 71 | succeed SetMemoryByteView 72 | |. keyword "memview" 73 | |. spaces 74 | |= parseByteFormat 75 | 76 | 77 | parseSetOffsetByteView : Parser ConsoleCommand 78 | parseSetOffsetByteView = 79 | succeed SetOffsetByteView 80 | |. keyword "offsetview" 81 | |. spaces 82 | |= parseByteFormat 83 | 84 | 85 | parseSetRegistersByteView : Parser ConsoleCommand 86 | parseSetRegistersByteView = 87 | succeed SetRegistersByteView 88 | |. keyword "regview" 89 | |. spaces 90 | |= parseByteFormat 91 | 92 | 93 | parseSetOperandByteView : Parser ConsoleCommand 94 | parseSetOperandByteView = 95 | succeed SetOperandByteView 96 | |. keyword "opview" 97 | |. spaces 98 | |= parseByteFormat 99 | 100 | 101 | parseByteFormat : Parser Byte.Format 102 | parseByteFormat = 103 | oneOf 104 | [ keyword "hex" |> andThen (\_ -> succeed Byte.Hex) 105 | , keyword "dec" |> andThen (\_ -> succeed Byte.Dec) 106 | , keyword "ascii" |> andThen (\_ -> succeed Byte.Ascii) 107 | ] 108 | 109 | 110 | spaces : Parser () 111 | spaces = 112 | ignoreWhile (\char -> char == ' ') 113 | -------------------------------------------------------------------------------- /src/Continue.elm: -------------------------------------------------------------------------------- 1 | module Continue exposing (Result(..), request) 2 | 3 | import Http 4 | import Json.Decode exposing (Decoder, field) 5 | 6 | 7 | type Result 8 | = Success SuccessModel 9 | | Error String 10 | 11 | 12 | type alias SuccessModel = 13 | { continued : Bool 14 | } 15 | 16 | 17 | decoder : Decoder SuccessModel 18 | decoder = 19 | Json.Decode.map SuccessModel 20 | (field "continued" Json.Decode.bool) 21 | 22 | 23 | endpoint : String 24 | endpoint = 25 | "http://localhost:9975/continue" 26 | 27 | 28 | request : (Result -> msg) -> ( a, Cmd msg ) -> ( a, Cmd msg ) 29 | request handler ( inputModel, inputCmd ) = 30 | let 31 | result = 32 | \r -> 33 | case r of 34 | Ok r -> 35 | handler <| Success r 36 | 37 | Err e -> 38 | handler <| Error (toString e) 39 | in 40 | ( inputModel, Cmd.batch [ inputCmd, Http.send result (Http.get endpoint decoder) ] ) 41 | -------------------------------------------------------------------------------- /src/DebuggerCommand.elm: -------------------------------------------------------------------------------- 1 | module DebuggerCommand 2 | exposing 3 | ( BreakReason(..) 4 | , CrashReason(..) 5 | , DebuggerCommand(..) 6 | , ReceiveResult(..) 7 | , crashReasonToString 8 | , decode 9 | ) 10 | 11 | import DebuggerState 12 | import Json.Decode as Json exposing (Decoder, field) 13 | import Memory 14 | import ParseInt exposing (toHex) 15 | 16 | 17 | type ReceiveResult 18 | = Success DebuggerCommand 19 | | Error String 20 | 21 | 22 | type DebuggerCommand 23 | = Break BreakReason DebuggerState.State 24 | | Crash CrashReason DebuggerState.State 25 | 26 | 27 | type BreakReason 28 | = Step 29 | | Breakpoint 30 | | Trap 31 | | Nmi 32 | 33 | 34 | type CrashReason 35 | = InvalidOperation String 36 | | UnexpectedOpcode Int 37 | | InvalidVramAccess String Int 38 | | UnimplementedOperation String 39 | 40 | 41 | decoder : Memory.Memory -> Decoder DebuggerCommand 42 | decoder oldMemory = 43 | field "command" Json.string |> Json.andThen (decodeByCommand oldMemory) 44 | 45 | 46 | decodeByCommand : Memory.Memory -> String -> Decoder DebuggerCommand 47 | decodeByCommand oldMemory cmd = 48 | case cmd of 49 | "break" -> 50 | Json.map2 (,) 51 | (field "reason" breakReasonDecoder) 52 | (field "snapshot" <| DebuggerState.decoder oldMemory) 53 | |> Json.andThen (\( reason, snapshot ) -> Json.succeed (Break reason snapshot)) 54 | 55 | "crash" -> 56 | Json.map2 (,) 57 | (field "reason" crashReasonDecoder) 58 | (field "snapshot" <| DebuggerState.decoder oldMemory) 59 | |> Json.andThen (\( reason, snapshot ) -> Json.succeed (Crash reason snapshot)) 60 | 61 | _ -> 62 | Json.fail <| "Unknown debugger command: " ++ cmd 63 | 64 | 65 | crashReasonDecoder : Decoder CrashReason 66 | crashReasonDecoder = 67 | field "type" Json.string 68 | |> Json.andThen 69 | (\type_ -> 70 | case type_ of 71 | "invalidOperation" -> 72 | field "description" Json.string 73 | |> Json.andThen (\description -> Json.succeed (InvalidOperation description)) 74 | 75 | "invalidVramAccess" -> 76 | Json.map2 (,) 77 | (field "address" Json.int) 78 | (field "description" Json.string) 79 | |> Json.andThen (\( address, desc ) -> Json.succeed (InvalidVramAccess desc address)) 80 | 81 | "unexpectedOpcode" -> 82 | field "opcode" Json.int 83 | |> Json.andThen (\opcode -> Json.succeed (UnexpectedOpcode opcode)) 84 | 85 | "unimplementedOperation" -> 86 | field "description" Json.string 87 | |> Json.andThen (\description -> Json.succeed (UnimplementedOperation description)) 88 | 89 | _ -> 90 | Json.fail <| "Unexpected crash reason: " ++ type_ 91 | ) 92 | 93 | 94 | breakReasonDecoder : Decoder BreakReason 95 | breakReasonDecoder = 96 | Json.string 97 | |> Json.andThen 98 | (\reason -> 99 | case reason of 100 | "step" -> 101 | Json.succeed Step 102 | 103 | "breakpoint" -> 104 | Json.succeed Breakpoint 105 | 106 | "trap" -> 107 | Json.succeed Trap 108 | 109 | "nmi" -> 110 | Json.succeed Nmi 111 | 112 | _ -> 113 | Json.fail <| "Unexpected break reason: " ++ reason 114 | ) 115 | 116 | 117 | decode : Memory.Memory -> (ReceiveResult -> msg) -> String -> msg 118 | decode oldMemory handler json = 119 | case Json.decodeString (decoder oldMemory) json of 120 | Ok cmd -> 121 | handler <| Success cmd 122 | 123 | Err msg -> 124 | handler <| Error msg 125 | 126 | 127 | crashReasonToString : CrashReason -> String 128 | crashReasonToString reason = 129 | case reason of 130 | InvalidOperation description -> 131 | "Invalid Operation (" ++ description ++ ")" 132 | 133 | UnexpectedOpcode opcode -> 134 | "Unexpected Opcode (0x" ++ String.padLeft 2 '0' (toHex opcode) ++ ")" 135 | 136 | InvalidVramAccess description address -> 137 | "Invalid VRAM access [0x" ++ String.padLeft 2 '0' (toHex address) ++ "]: " ++ description 138 | 139 | UnimplementedOperation description -> 140 | "Unimplemented operation (" ++ description ++ ")" 141 | -------------------------------------------------------------------------------- /src/DebuggerState.elm: -------------------------------------------------------------------------------- 1 | module DebuggerState exposing (Screen, State, decoder) 2 | 3 | import Debug 4 | import Json.Decode as Json exposing (Decoder, field) 5 | import Memory 6 | import Registers exposing (Registers) 7 | 8 | 9 | type alias State = 10 | { cycles : Int 11 | , registers : Registers.Registers 12 | , screen : Screen 13 | , memory : Memory.Memory 14 | } 15 | 16 | 17 | type alias Screen = 18 | { width : Int 19 | , height : Int 20 | , imgData : String 21 | } 22 | 23 | 24 | screenDecoder : Decoder Screen 25 | screenDecoder = 26 | Json.map3 Screen 27 | (field "width" Json.int) 28 | (field "height" Json.int) 29 | (field "imgData" Json.string) 30 | 31 | 32 | decoder : Memory.Memory -> Decoder State 33 | decoder oldMemory = 34 | Json.map4 State 35 | (field "cycles" Json.int) 36 | (field "registers" Registers.decoder) 37 | (field "screen" screenDecoder) 38 | (field "memory" Memory.messageDecoder 39 | |> Json.andThen 40 | (\memorySnapshot -> 41 | case memorySnapshot of 42 | Memory.NoChange hash -> 43 | let 44 | ( oldHash, oldMem ) = 45 | oldMemory 46 | in 47 | if hash == oldHash then 48 | Json.succeed oldMemory 49 | else 50 | -- TODO 51 | Json.succeed <| Debug.log "TODO: Stale memory, request latest" oldMemory 52 | 53 | Memory.Updated newMemory -> 54 | Json.succeed newMemory 55 | ) 56 | ) 57 | -------------------------------------------------------------------------------- /src/Disassembler.elm: -------------------------------------------------------------------------------- 1 | module Disassembler exposing (Instruction(..), disassemble) 2 | 3 | import AddressingMode exposing (AddressingMode(..)) 4 | import ByteArray exposing (ByteArray) 5 | 6 | 7 | type Instruction 8 | = Known Int String AddressingMode 9 | | Undefined Int 10 | 11 | 12 | disassemble : Int -> Int -> ByteArray -> List Instruction 13 | disassemble startOffset instructionsToDecode memory = 14 | disassemble_ startOffset instructionsToDecode memory [] 15 | |> List.reverse 16 | 17 | 18 | disassemble_ : Int -> Int -> ByteArray -> List Instruction -> List Instruction 19 | disassemble_ offset remainingInstructions memory inputList = 20 | case remainingInstructions of 21 | 0 -> 22 | inputList 23 | 24 | _ -> 25 | case ByteArray.get offset memory of 26 | Nothing -> 27 | inputList 28 | 29 | Just byte -> 30 | let 31 | decoded = 32 | case byte of 33 | 0x69 -> 34 | immediate "ADC" offset memory 35 | 36 | 0x65 -> 37 | zeroPage "ADC" offset memory 38 | 39 | 0x75 -> 40 | zeroPageX "ADC" offset memory 41 | 42 | 0x6D -> 43 | absolute "ADC" offset memory 44 | 45 | 0x7D -> 46 | absoluteX "ADC" offset memory 47 | 48 | 0x79 -> 49 | absoluteY "ADC" offset memory 50 | 51 | 0x61 -> 52 | indexedIndirect "ADC" offset memory 53 | 54 | 0x71 -> 55 | indirectIndexed "ADC" offset memory 56 | 57 | 0x29 -> 58 | immediate "AND" offset memory 59 | 60 | 0x25 -> 61 | zeroPage "AND" offset memory 62 | 63 | 0x35 -> 64 | zeroPageX "AND" offset memory 65 | 66 | 0x2D -> 67 | absolute "AND" offset memory 68 | 69 | 0x3D -> 70 | absoluteX "AND" offset memory 71 | 72 | 0x39 -> 73 | absoluteY "AND" offset memory 74 | 75 | 0x21 -> 76 | indexedIndirect "AND" offset memory 77 | 78 | 0x31 -> 79 | indirectIndexed "AND" offset memory 80 | 81 | 0x0A -> 82 | accumulator "ASL" offset 83 | 84 | 0x06 -> 85 | zeroPage "ASL" offset memory 86 | 87 | 0x16 -> 88 | zeroPageX "ASL" offset memory 89 | 90 | 0x0E -> 91 | absolute "ASL" offset memory 92 | 93 | 0x1E -> 94 | absoluteX "ASL" offset memory 95 | 96 | 0x24 -> 97 | zeroPage "BIT" offset memory 98 | 99 | 0x2C -> 100 | absolute "BIT" offset memory 101 | 102 | 0x10 -> 103 | relative "BPL" offset memory 104 | 105 | 0x30 -> 106 | relative "BMI" offset memory 107 | 108 | 0x50 -> 109 | relative "BVC" offset memory 110 | 111 | 0x70 -> 112 | relative "BVS" offset memory 113 | 114 | 0x90 -> 115 | relative "BCC" offset memory 116 | 117 | 0xB0 -> 118 | relative "BCS" offset memory 119 | 120 | 0xD0 -> 121 | relative "BNE" offset memory 122 | 123 | 0xF0 -> 124 | relative "BEQ" offset memory 125 | 126 | 0x00 -> 127 | implied "BRK" offset 128 | 129 | 0xC9 -> 130 | immediate "CMP" offset memory 131 | 132 | 0xC5 -> 133 | zeroPage "CMP" offset memory 134 | 135 | 0xD5 -> 136 | zeroPageX "CMP" offset memory 137 | 138 | 0xCD -> 139 | absolute "CMP" offset memory 140 | 141 | 0xDD -> 142 | absoluteX "CMP" offset memory 143 | 144 | 0xD9 -> 145 | absoluteY "CMP" offset memory 146 | 147 | 0xC1 -> 148 | indexedIndirect "CMP" offset memory 149 | 150 | 0xD1 -> 151 | indirectIndexed "CMP" offset memory 152 | 153 | 0xE0 -> 154 | immediate "CPX" offset memory 155 | 156 | 0xE4 -> 157 | zeroPage "CPX" offset memory 158 | 159 | 0xEC -> 160 | absolute "CPX" offset memory 161 | 162 | 0xC0 -> 163 | immediate "CPY" offset memory 164 | 165 | 0xC4 -> 166 | zeroPage "CPY" offset memory 167 | 168 | 0xCC -> 169 | absolute "CPY" offset memory 170 | 171 | 0xC6 -> 172 | zeroPage "DEC" offset memory 173 | 174 | 0xD6 -> 175 | zeroPageX "DEC" offset memory 176 | 177 | 0xCE -> 178 | absolute "DEC" offset memory 179 | 180 | 0xDE -> 181 | absoluteX "DEC" offset memory 182 | 183 | 0x49 -> 184 | immediate "EOR" offset memory 185 | 186 | 0x45 -> 187 | zeroPage "EOR" offset memory 188 | 189 | 0x55 -> 190 | zeroPageX "EOR" offset memory 191 | 192 | 0x4D -> 193 | absolute "EOR" offset memory 194 | 195 | 0x5D -> 196 | absoluteX "EOR" offset memory 197 | 198 | 0x59 -> 199 | absoluteY "EOR" offset memory 200 | 201 | 0x41 -> 202 | indexedIndirect "EOR" offset memory 203 | 204 | 0x51 -> 205 | indirectIndexed "EOR" offset memory 206 | 207 | 0x18 -> 208 | implied "CLC" offset 209 | 210 | 0x38 -> 211 | implied "SEC" offset 212 | 213 | 0x58 -> 214 | implied "CLI" offset 215 | 216 | 0x78 -> 217 | implied "SEI" offset 218 | 219 | 0xB8 -> 220 | implied "CLV" offset 221 | 222 | 0xD8 -> 223 | implied "CLD" offset 224 | 225 | 0xF8 -> 226 | implied "SED" offset 227 | 228 | 0xE6 -> 229 | zeroPage "INC" offset memory 230 | 231 | 0xF6 -> 232 | zeroPageX "INC" offset memory 233 | 234 | 0xEE -> 235 | absolute "INC" offset memory 236 | 237 | 0xFE -> 238 | absoluteX "INC" offset memory 239 | 240 | 0x4C -> 241 | absolute "JMP" offset memory 242 | 243 | 0x6C -> 244 | indirect "JMP" offset memory 245 | 246 | 0x20 -> 247 | absolute "JSR" offset memory 248 | 249 | 0xA9 -> 250 | immediate "LDA" offset memory 251 | 252 | 0xA5 -> 253 | zeroPage "LDA" offset memory 254 | 255 | 0xB5 -> 256 | zeroPageX "LDA" offset memory 257 | 258 | 0xAD -> 259 | absolute "LDA" offset memory 260 | 261 | 0xBD -> 262 | absoluteX "LDA" offset memory 263 | 264 | 0xB9 -> 265 | absoluteY "LDA" offset memory 266 | 267 | 0xA1 -> 268 | indexedIndirect "LDA" offset memory 269 | 270 | 0xB1 -> 271 | indirectIndexed "LDA" offset memory 272 | 273 | 0xA2 -> 274 | immediate "LDX" offset memory 275 | 276 | 0xA6 -> 277 | zeroPage "LDX" offset memory 278 | 279 | 0xB6 -> 280 | zeroPageY "LDX" offset memory 281 | 282 | 0xAE -> 283 | absolute "LDX" offset memory 284 | 285 | 0xBE -> 286 | absoluteY "LDX" offset memory 287 | 288 | 0xA0 -> 289 | immediate "LDY" offset memory 290 | 291 | 0xA4 -> 292 | zeroPage "LDY" offset memory 293 | 294 | 0xB4 -> 295 | zeroPageX "LDY" offset memory 296 | 297 | 0xAC -> 298 | absolute "LDY" offset memory 299 | 300 | 0xBC -> 301 | absoluteX "LDY" offset memory 302 | 303 | 0x4A -> 304 | accumulator "LSR" offset 305 | 306 | 0x46 -> 307 | zeroPage "LSR" offset memory 308 | 309 | 0x56 -> 310 | zeroPageX "LSR" offset memory 311 | 312 | 0x4E -> 313 | absolute "LSR" offset memory 314 | 315 | 0x5E -> 316 | absoluteX "LSR" offset memory 317 | 318 | 0xEA -> 319 | implied "NOP" offset 320 | 321 | 0x09 -> 322 | immediate "ORA" offset memory 323 | 324 | 0x05 -> 325 | zeroPage "ORA" offset memory 326 | 327 | 0x15 -> 328 | zeroPageX "ORA" offset memory 329 | 330 | 0x0D -> 331 | absolute "ORA" offset memory 332 | 333 | 0x1D -> 334 | absoluteX "ORA" offset memory 335 | 336 | 0x19 -> 337 | absoluteY "ORA" offset memory 338 | 339 | 0x01 -> 340 | indexedIndirect "ORA" offset memory 341 | 342 | 0x11 -> 343 | indirectIndexed "ORA" offset memory 344 | 345 | 0xAA -> 346 | implied "TAX" offset 347 | 348 | 0x8A -> 349 | implied "TXA" offset 350 | 351 | 0xCA -> 352 | implied "DEX" offset 353 | 354 | 0xE8 -> 355 | implied "INX" offset 356 | 357 | 0xA8 -> 358 | implied "TAY" offset 359 | 360 | 0x98 -> 361 | implied "TYA" offset 362 | 363 | 0x88 -> 364 | implied "DEY" offset 365 | 366 | 0xC8 -> 367 | implied "INY" offset 368 | 369 | 0x2A -> 370 | accumulator "ROL" offset 371 | 372 | 0x26 -> 373 | zeroPage "ROL" offset memory 374 | 375 | 0x36 -> 376 | zeroPageX "ROL" offset memory 377 | 378 | 0x2E -> 379 | absolute "ROL" offset memory 380 | 381 | 0x3E -> 382 | absoluteX "ROL" offset memory 383 | 384 | 0x6A -> 385 | accumulator "ROR" offset 386 | 387 | 0x66 -> 388 | zeroPage "ROR" offset memory 389 | 390 | 0x76 -> 391 | zeroPageX "ROR" offset memory 392 | 393 | 0x6E -> 394 | absolute "ROR" offset memory 395 | 396 | 0x7E -> 397 | absoluteX "ROR" offset memory 398 | 399 | 0x40 -> 400 | implied "RTI" offset 401 | 402 | 0x60 -> 403 | implied "RTS" offset 404 | 405 | 0xE9 -> 406 | immediate "SBC" offset memory 407 | 408 | 0xE5 -> 409 | zeroPage "SBC" offset memory 410 | 411 | 0xF5 -> 412 | zeroPageX "SBC" offset memory 413 | 414 | 0xED -> 415 | absolute "SBC" offset memory 416 | 417 | 0xFD -> 418 | absoluteX "SBC" offset memory 419 | 420 | 0xF9 -> 421 | absoluteY "SBC" offset memory 422 | 423 | 0xE1 -> 424 | indexedIndirect "SBC" offset memory 425 | 426 | 0xF1 -> 427 | indirectIndexed "SBC" offset memory 428 | 429 | 0x85 -> 430 | zeroPage "STA" offset memory 431 | 432 | 0x95 -> 433 | zeroPageX "STA" offset memory 434 | 435 | 0x8D -> 436 | absolute "STA" offset memory 437 | 438 | 0x9D -> 439 | absoluteX "STA" offset memory 440 | 441 | 0x99 -> 442 | absoluteY "STA" offset memory 443 | 444 | 0x81 -> 445 | indexedIndirect "STA" offset memory 446 | 447 | 0x91 -> 448 | indirectIndexed "STA" offset memory 449 | 450 | 0x9A -> 451 | implied "TXS" offset 452 | 453 | 0xBA -> 454 | implied "TSX" offset 455 | 456 | 0x48 -> 457 | implied "PHA" offset 458 | 459 | 0x68 -> 460 | implied "PLA" offset 461 | 462 | 0x08 -> 463 | implied "PHP" offset 464 | 465 | 0x28 -> 466 | implied "PLP" offset 467 | 468 | 0x86 -> 469 | zeroPage "STX" offset memory 470 | 471 | 0x96 -> 472 | zeroPageY "STX" offset memory 473 | 474 | 0x8E -> 475 | absolute "STX" offset memory 476 | 477 | 0x84 -> 478 | zeroPage "STY" offset memory 479 | 480 | 0x94 -> 481 | zeroPageX "STY" offset memory 482 | 483 | 0x8C -> 484 | absolute "STY" offset memory 485 | 486 | _ -> 487 | Just ( 1, Undefined offset ) 488 | in 489 | case decoded of 490 | Nothing -> 491 | inputList 492 | 493 | Just ( bytesRead, instruction ) -> 494 | let 495 | nextOffset = 496 | offset + bytesRead 497 | 498 | outputList = 499 | instruction :: inputList 500 | in 501 | disassemble_ nextOffset (remainingInstructions - 1) memory outputList 502 | 503 | 504 | implied : String -> Int -> Maybe ( Int, Instruction ) 505 | implied mnemonic offset = 506 | Just ( 1, Known offset mnemonic Implied ) 507 | 508 | 509 | accumulator : String -> Int -> Maybe ( Int, Instruction ) 510 | accumulator mnemonic offset = 511 | Just ( 1, Known offset mnemonic Accumulator ) 512 | 513 | 514 | immediate : String -> Int -> ByteArray -> Maybe ( Int, Instruction ) 515 | immediate mnemonic offset memory = 516 | ByteArray.get (offset + 1) memory 517 | |> Maybe.map (\val -> ( 2, Known offset mnemonic (Immediate val) )) 518 | 519 | 520 | zeroPage : String -> Int -> ByteArray -> Maybe ( Int, Instruction ) 521 | zeroPage mnemonic offset memory = 522 | ByteArray.get (offset + 1) memory 523 | |> Maybe.map (\val -> ( 2, Known offset mnemonic (ZeroPage val) )) 524 | 525 | 526 | zeroPageX : String -> Int -> ByteArray -> Maybe ( Int, Instruction ) 527 | zeroPageX mnemonic offset memory = 528 | ByteArray.get (offset + 1) memory 529 | |> Maybe.map (\val -> ( 2, Known offset mnemonic (ZeroPageX val) )) 530 | 531 | 532 | zeroPageY : String -> Int -> ByteArray -> Maybe ( Int, Instruction ) 533 | zeroPageY mnemonic offset memory = 534 | ByteArray.get (offset + 1) memory 535 | |> Maybe.map (\val -> ( 2, Known offset mnemonic (ZeroPageY val) )) 536 | 537 | 538 | absolute : String -> Int -> ByteArray -> Maybe ( Int, Instruction ) 539 | absolute mnemonic offset memory = 540 | ByteArray.get16 (offset + 1) memory 541 | |> Maybe.map (\val -> ( 3, Known offset mnemonic (Absolute val) )) 542 | 543 | 544 | indirect : String -> Int -> ByteArray -> Maybe ( Int, Instruction ) 545 | indirect mnemonic offset memory = 546 | ByteArray.get16 (offset + 1) memory 547 | |> Maybe.map (\val -> ( 3, Known offset mnemonic (Indirect val) )) 548 | 549 | 550 | relative : String -> Int -> ByteArray -> Maybe ( Int, Instruction ) 551 | relative mnemonic offset memory = 552 | ByteArray.get (offset + 1) memory 553 | |> Maybe.map (\val -> ( 2, Known offset mnemonic (Relative val) )) 554 | 555 | 556 | absoluteX : String -> Int -> ByteArray -> Maybe ( Int, Instruction ) 557 | absoluteX mnemonic offset memory = 558 | ByteArray.get16 (offset + 1) memory 559 | |> Maybe.map (\val -> ( 3, Known offset mnemonic (AbsoluteX val) )) 560 | 561 | 562 | absoluteY : String -> Int -> ByteArray -> Maybe ( Int, Instruction ) 563 | absoluteY mnemonic offset memory = 564 | ByteArray.get16 (offset + 1) memory 565 | |> Maybe.map (\val -> ( 3, Known offset mnemonic (AbsoluteY val) )) 566 | 567 | 568 | indexedIndirect : String -> Int -> ByteArray -> Maybe ( Int, Instruction ) 569 | indexedIndirect mnemonic offset memory = 570 | ByteArray.get (offset + 1) memory 571 | |> Maybe.map (\val -> ( 2, Known offset mnemonic (IndexedIndirect val) )) 572 | 573 | 574 | indirectIndexed : String -> Int -> ByteArray -> Maybe ( Int, Instruction ) 575 | indirectIndexed mnemonic offset memory = 576 | ByteArray.get (offset + 1) memory 577 | |> Maybe.map (\val -> ( 2, Known offset mnemonic (IndirectIndexed val) )) 578 | -------------------------------------------------------------------------------- /src/HexEditor.elm: -------------------------------------------------------------------------------- 1 | module HexEditor exposing (styles, view) 2 | 3 | import Byte 4 | import ByteArray 5 | import Colors 6 | import Css 7 | import Css.Elements 8 | import Html exposing (Html, span, table, tbody, td, text, th, thead, tr) 9 | import List 10 | import List.Split 11 | import Memory 12 | import ParseInt exposing (toHex) 13 | import Styles 14 | 15 | 16 | { id, class, classList } = 17 | Styles.helpers 18 | 19 | 20 | type alias Model a = 21 | { a 22 | | memory : Memory.Memory 23 | , memoryViewOffset : Int 24 | , offsetByteFormat : Byte.Format 25 | , memoryByteFormat : Byte.Format 26 | } 27 | 28 | 29 | bytesPerRow : Int 30 | bytesPerRow = 31 | 32 32 | 33 | 34 | windowSize : Int 35 | windowSize = 36 | 2048 37 | 38 | 39 | view : Model a -> Html msg 40 | view model = 41 | let 42 | offsetHeaderCells = 43 | th [ class [ Styles.OffsetColumn ] ] [ text "Offset" ] 44 | :: ((bytesPerRow - 1) 45 | |> List.range 0 46 | |> List.map (\offset -> th [] [ offsetHeaderDisplay model offset ]) 47 | ) 48 | in 49 | table [ id Styles.HexEditor ] 50 | [ thead [] [ tr [] offsetHeaderCells ] 51 | , tbody [ id Styles.HexEditorBody ] (intoRows model) 52 | ] 53 | 54 | 55 | offsetHeaderDisplay : Model a -> Int -> Html msg 56 | offsetHeaderDisplay model val = 57 | let 58 | padding = 59 | case model.memoryByteFormat of 60 | Byte.Dec -> 61 | 3 62 | 63 | _ -> 64 | 2 65 | in 66 | case model.offsetByteFormat of 67 | Byte.Dec -> 68 | Html.text (String.padLeft padding '0' (toString val)) 69 | 70 | _ -> 71 | -- default to hex 72 | Html.text (String.padLeft padding '0' (toHex val)) 73 | 74 | 75 | intoRows : Model a -> List (Html msg) 76 | intoRows model = 77 | let 78 | ( _, bytes ) = 79 | model.memory 80 | 81 | startOffset = 82 | model.memoryViewOffset 83 | in 84 | bytes 85 | |> ByteArray.slice startOffset (startOffset + windowSize) 86 | |> ByteArray.toList 87 | |> List.Split.chunksOfLeft bytesPerRow 88 | |> List.map2 (,) (List.range 0 (floor (toFloat windowSize / toFloat bytesPerRow))) 89 | |> List.map 90 | (\( rowOffset, row ) -> 91 | let 92 | rowOffset1 = 93 | startOffset + (rowOffset * bytesPerRow) 94 | in 95 | tr [ class [ Styles.BytesRow ] ] 96 | (td [ class [ Styles.OffsetColumn, Styles.RowOffset ] ] [ offsetView model.offsetByteFormat rowOffset1 ] 97 | :: List.map 98 | (\byte -> 99 | td [] [ memoryView model byte ] 100 | ) 101 | row 102 | ) 103 | ) 104 | 105 | 106 | offsetView : Byte.Format -> Int -> Html msg 107 | offsetView display byte = 108 | let 109 | str = 110 | case display of 111 | Byte.Dec -> 112 | String.padLeft 5 '0' (toString byte) 113 | 114 | _ -> 115 | -- Default to hex display 116 | "0x" ++ String.padLeft 4 '0' (toHex byte) 117 | in 118 | text str 119 | 120 | 121 | memoryView : Model a -> Int -> Html msg 122 | memoryView model byte = 123 | let 124 | str = 125 | case model.memoryByteFormat of 126 | Byte.Dec -> 127 | String.padLeft 3 '0' (toString byte) 128 | 129 | Byte.Hex -> 130 | -- Default to hex display 131 | String.padLeft 2 '0' (toHex byte) 132 | 133 | Byte.Ascii -> 134 | "." ++ Byte.asciiValue byte 135 | in 136 | text str 137 | 138 | 139 | styles : List Css.Snippet 140 | styles = 141 | [ Styles.id Styles.HexEditor 142 | [ Css.displayFlex 143 | , Css.flexDirection Css.column 144 | , Css.position Css.absolute 145 | , Css.height (Css.pct 100) 146 | , Css.width (Css.pct 100) 147 | , Css.backgroundColor Colors.hexEditorBackground 148 | , Css.children 149 | [ Css.Elements.thead 150 | [ Css.display Css.block 151 | , Css.property "flex" "0 1 auto" 152 | , Css.overflow Css.hidden 153 | , Css.color Colors.hexEditorOffsetColor 154 | ] 155 | , Css.Elements.tbody 156 | [ Css.display Css.block 157 | , Css.property "flex" "0 1 auto" 158 | , Css.overflow Css.auto 159 | , Css.height (Css.pct 100) 160 | ] 161 | ] 162 | ] 163 | , Styles.class Styles.RowOffset 164 | [ Css.fontWeight Css.bold 165 | , Css.color Colors.hexEditorOffsetColor 166 | , Css.property "user-select" "none" 167 | ] 168 | , Styles.class Styles.OffsetColumn 169 | [ Css.width (Css.ch 9) 170 | , Css.textAlign Css.left 171 | ] 172 | , Styles.class Styles.BytesRow 173 | [ Css.color Colors.hexEditorByte 174 | ] 175 | ] 176 | -------------------------------------------------------------------------------- /src/Instruction.elm: -------------------------------------------------------------------------------- 1 | module Instruction exposing (styles, view) 2 | 3 | import AddressingMode 4 | import Breakpoints 5 | import Byte 6 | import ByteArray exposing (ByteArray) 7 | import Colors 8 | import Css 9 | import Css.Elements 10 | import Disassembler exposing (Instruction(..)) 11 | import Html exposing (Attribute, Html) 12 | import Html.Events exposing (onClick) 13 | import List 14 | import Memory 15 | import ParseInt exposing (toHex) 16 | import Registers 17 | import Styles 18 | 19 | 20 | { id, class, classList } = 21 | Styles.helpers 22 | 23 | 24 | type alias Model a = 25 | { a 26 | | instructionsDisplayed : Int 27 | , disassembleOffset : Int 28 | , registers : Registers.Registers 29 | , memory : Memory.Memory 30 | , breakpoints : Breakpoints.Breakpoints 31 | , offsetByteFormat : Byte.Format 32 | , operandByteFormat : Byte.Format 33 | , memoryByteFormat : Byte.Format 34 | } 35 | 36 | 37 | view : (Int -> msg) -> Model a -> Html msg 38 | view breakpointClickHandler model = 39 | let 40 | ( _, memory ) = 41 | model.memory 42 | in 43 | Html.table [ id Styles.Instructions ] 44 | (memory 45 | |> Disassembler.disassemble model.disassembleOffset model.instructionsDisplayed 46 | |> List.map 47 | (\instruction -> 48 | let 49 | offset = 50 | getOffset instruction 51 | in 52 | Html.tr 53 | [ classList 54 | [ ( Styles.Instruction, True ) 55 | , ( Styles.CurrentInstruction, offset == model.registers.pc ) 56 | ] 57 | ] 58 | [ Html.td [ class [ Styles.InstructionGutter ] ] 59 | [ Html.div [ class [ Styles.MemoryLocation ] ] [ memoryView model.offsetByteFormat offset ] 60 | , Html.div 61 | [ classList 62 | [ ( Styles.BreakpointHitBox, True ) 63 | , ( Styles.BreakpointOn, Breakpoints.isSet model.breakpoints offset ) 64 | ] 65 | , onClick (breakpointClickHandler offset) 66 | ] 67 | [ Breakpoints.icon 68 | ] 69 | ] 70 | , instructionCell model memory instruction 71 | , amMemoryCell model memory instruction 72 | ] 73 | ) 74 | ) 75 | 76 | 77 | getOffset : Instruction -> Int 78 | getOffset instr = 79 | case instr of 80 | Known offset _ _ -> 81 | offset 82 | 83 | Undefined offset -> 84 | offset 85 | 86 | 87 | amMemoryCell : Model a -> ByteArray.ByteArray -> Instruction -> Html msg 88 | amMemoryCell { registers, memoryByteFormat } memory instr = 89 | case instr of 90 | Known _ _ addressingMode -> 91 | let 92 | amMemory = 93 | AddressingMode.getTargetOffset memory registers addressingMode 94 | in 95 | case amMemory of 96 | Just mem -> 97 | let 98 | ( targetAddr, targetValue ) = 99 | mem 100 | in 101 | Html.td [ class [ Styles.AddressModeValues ] ] 102 | [ Html.text "@ " 103 | , Html.span [ class [ Styles.AddressModeMemoryLocation ] ] [ memoryView memoryByteFormat targetAddr ] 104 | , Html.text " = " 105 | , Html.span [ class [ Styles.AddressModeMemoryValue ] ] [ valueView memoryByteFormat targetValue ] 106 | ] 107 | 108 | Nothing -> 109 | Html.td [] [] 110 | 111 | Undefined _ -> 112 | Html.td [] [] 113 | 114 | 115 | instructionCell : Model a -> ByteArray.ByteArray -> Instruction -> Html msg 116 | instructionCell { registers, operandByteFormat } memory instr = 117 | case instr of 118 | Known offset mnemonic addressingMode -> 119 | let 120 | amMemory = 121 | AddressingMode.getTargetOffset memory registers addressingMode 122 | in 123 | Html.td [ class [ Styles.InstructionValue ] ] 124 | [ Html.span [ class [ Styles.Mnemonic ] ] [ Html.text mnemonic ] 125 | , Html.text " " 126 | , Html.span [ class [ Styles.Operand ] ] (AddressingMode.view operandByteFormat addressingMode) 127 | ] 128 | 129 | Undefined offset -> 130 | Html.td [ class [ Styles.InstructionValue ] ] [ Html.span [ class [ Styles.UndefinedOpcode ] ] [ Html.text "---" ] ] 131 | 132 | 133 | memoryView : Byte.Format -> Int -> Html msg 134 | memoryView display byte = 135 | let 136 | str = 137 | case display of 138 | Byte.Dec -> 139 | String.padLeft 5 '0' (toString byte) 140 | 141 | _ -> 142 | -- Default to hex display 143 | "0x" ++ String.padLeft 4 '0' (toHex byte) 144 | in 145 | Html.text str 146 | 147 | 148 | valueView : Byte.Format -> Int -> Html msg 149 | valueView display byte = 150 | let 151 | str = 152 | case display of 153 | Byte.Dec -> 154 | String.padLeft 3 '0' (toString byte) 155 | 156 | _ -> 157 | -- Default to hex 158 | "0x" ++ String.padLeft 2 '0' (toHex byte) 159 | in 160 | Html.span [] [ Html.text str ] 161 | 162 | 163 | styles : List Css.Snippet 164 | styles = 165 | [ Styles.id Styles.Instructions 166 | [ Css.width (Css.pct 100) 167 | , Css.property "border-spacing" "0" 168 | , Css.children 169 | [ Styles.class Styles.Instruction 170 | [ Css.displayFlex 171 | , Styles.withClass Styles.CurrentInstruction 172 | [ Css.backgroundColor Colors.currentLine 173 | , Css.children 174 | [ Styles.class Styles.AddressModeValues 175 | [ Css.color Colors.addressModeActiveValue 176 | ] 177 | ] 178 | ] 179 | , Css.children 180 | [ Styles.class Styles.InstructionGutter 181 | [ Css.color Colors.lineNumber 182 | , Css.backgroundColor Colors.gutterBackground 183 | , Css.borderRight3 (Css.px 1) Css.solid Colors.gutterBorder 184 | , Css.paddingRight (Css.em 0.5) 185 | , Css.whiteSpace Css.noWrap 186 | , Css.property "user-select" "none" 187 | , Css.children 188 | [ Styles.class Styles.MemoryLocation 189 | [ Css.display Css.inlineBlock 190 | ] 191 | , Styles.class Styles.BreakpointHitBox 192 | [ Css.display Css.inlineBlock 193 | , Css.property "transition" "opacity .15s" 194 | , Css.paddingLeft (Css.em 0.6) 195 | , Css.opacity (Css.num 0) 196 | , Css.cursor Css.pointer 197 | , Css.hover 198 | [ Css.opacity (Css.num 0.2) 199 | ] 200 | , Styles.withClass Styles.BreakpointOn 201 | [ Css.opacity (Css.num 1.0) 202 | , Css.hover 203 | [ Css.opacity (Css.num 1.0) 204 | ] 205 | ] 206 | ] 207 | ] 208 | ] 209 | , Styles.class Styles.InstructionValue 210 | [ Css.flexGrow (Css.num 1) 211 | , Css.children 212 | [ Styles.class Styles.Mnemonic 213 | [ Css.color Colors.mnemonic 214 | , Css.paddingLeft (Css.em 0.5) 215 | ] 216 | , Styles.class Styles.UndefinedOpcode 217 | [ Css.color Colors.undefinedOpcode 218 | , Css.paddingLeft (Css.em 0.5) 219 | ] 220 | ] 221 | ] 222 | , Styles.class Styles.AddressModeValues 223 | [ Css.color Colors.addressModeInactiveValue 224 | , Css.paddingRight (Css.em 1) 225 | ] 226 | ] 227 | ] 228 | ] 229 | ] 230 | ] 231 | -------------------------------------------------------------------------------- /src/Main.elm: -------------------------------------------------------------------------------- 1 | module Main exposing (..) 2 | 3 | import AppState 4 | import Breakpoints 5 | import Byte 6 | import ByteArray 7 | import Colors 8 | import Console 9 | import ConsoleCommand 10 | import Continue 11 | import Css 12 | import DebuggerCommand exposing (BreakReason, CrashReason, DebuggerCommand(..), crashReasonToString) 13 | import DebuggerState 14 | import Dom 15 | import HexEditor 16 | import Html exposing (Attribute, Html, button, div, fieldset, header, input, li, text, ul) 17 | import Html.Attributes exposing (checked, disabled, title, type_) 18 | import Html.Events exposing (onClick) 19 | import Instruction 20 | import Json.Decode as Json 21 | import Keyboard 22 | import Memory 23 | import ParseInt exposing (toHex) 24 | import Ports 25 | import Registers 26 | import Set exposing (Set) 27 | import Step 28 | import Styles 29 | import Task 30 | import ToggleBreakpoint 31 | import ToggleNmiBreakpoint 32 | import WebSocket 33 | 34 | 35 | { id, class, classList } = 36 | Styles.helpers 37 | 38 | 39 | wsDebuggerEndpoint : String 40 | wsDebuggerEndpoint = 41 | "ws://localhost:9976" 42 | 43 | 44 | main : Program Never Model Msg 45 | main = 46 | Html.program 47 | { init = init 48 | , view = view 49 | , update = update 50 | , subscriptions = subscriptions 51 | } 52 | 53 | 54 | 55 | -- MODEL 56 | 57 | 58 | type alias Model = 59 | { appState : AppState.AppState 60 | , messages : List ( String, Int ) 61 | , consoleInput : String 62 | , cycles : Int 63 | , instructionsDisplayed : Int 64 | , disassembleOffset : Int 65 | , memory : Memory.Memory 66 | , memoryViewOffset : Int 67 | , registers : Registers.Registers 68 | , showConsoleInput : Bool 69 | , breakpoints : Breakpoints.Breakpoints 70 | , memoryByteFormat : Byte.Format 71 | , registersByteFormat : Byte.Format 72 | , offsetByteFormat : Byte.Format 73 | , operandByteFormat : Byte.Format 74 | , screen : DebuggerState.Screen 75 | , breakOnNmi : Bool 76 | , focusState : FocusState 77 | } 78 | 79 | 80 | init : ( Model, Cmd Msg ) 81 | init = 82 | let 83 | model = 84 | { appState = AppState.NotConnected 85 | , messages = [ ( "Welcome to the rs-nes debugger!", 0 ) ] 86 | , cycles = 0 87 | , consoleInput = "" 88 | , instructionsDisplayed = 100 89 | , disassembleOffset = 0 90 | , memory = ( 0, ByteArray.empty ) 91 | , memoryViewOffset = 0 92 | , registers = Registers.new 93 | , breakpoints = Set.empty 94 | , showConsoleInput = False 95 | , memoryByteFormat = Byte.Hex 96 | , registersByteFormat = Byte.Hex 97 | , offsetByteFormat = Byte.Hex 98 | , operandByteFormat = Byte.Hex 99 | , screen = { width = 0, height = 0, imgData = "" } 100 | , breakOnNmi = False 101 | , focusState = InstructionsFocused 102 | } 103 | in 104 | ( model, Cmd.none ) 105 | 106 | 107 | type FocusState 108 | = InstructionsFocused 109 | | HexEditorFocused 110 | | ConsoleFocused 111 | 112 | 113 | 114 | -- UPDATE 115 | 116 | 117 | type Msg 118 | = DebuggerConnectionOpened String 119 | | DebuggerConnectionClosed String 120 | | DebuggerCommandReceived DebuggerCommand.ReceiveResult 121 | | ToggleBreakpoint Int 122 | | ToggleBreakpointResult ToggleBreakpoint.Result 123 | | ToggleNmiBreakpoint 124 | | ToggleNmiBreakpointResult ToggleNmiBreakpoint.Result 125 | | Step 126 | | StepResult Step.Result 127 | | Continue 128 | | ContinueResult Continue.Result 129 | | ScrollInstructionIntoView 130 | | UpdateMemoryByteFormat Byte.Format 131 | | UpdateConsoleInput String 132 | | SubmitConsoleCommand 133 | | ShowConsoleInput Bool 134 | | KeyPressed Int 135 | | UpdateFocusState FocusState 136 | | PageUp 137 | | PageDown 138 | | NoOp 139 | 140 | 141 | instructionPageAmount : Int 142 | instructionPageAmount = 143 | 15 144 | 145 | 146 | update : Msg -> Model -> ( Model, Cmd Msg ) 147 | update msg model = 148 | case msg of 149 | DebuggerConnectionOpened name -> 150 | ( model, Cmd.none ) 151 | |> transitionAppState AppState.Connect 152 | |> andThen 153 | (\input -> 154 | clearCpuState input 155 | |> consoleMessage ("Connected to debugger at " ++ name) 156 | ) 157 | 158 | DebuggerConnectionClosed _ -> 159 | ( model, Cmd.none ) 160 | |> transitionAppState AppState.Disconnect 161 | |> andThen 162 | (\input -> 163 | consoleMessage "Disconnected from debugger" input 164 | ) 165 | 166 | DebuggerCommandReceived result -> 167 | case result of 168 | DebuggerCommand.Success debuggerCommand -> 169 | ( model, Cmd.none ) 170 | |> handleDebuggerCommand debuggerCommand 171 | |> unwrap 172 | 173 | DebuggerCommand.Error msg -> 174 | ( model, Cmd.none ) 175 | |> consoleMessage ("Unable to receive debugger command: " ++ msg) 176 | 177 | ToggleBreakpoint address -> 178 | ( model, Cmd.none ) 179 | |> ToggleBreakpoint.request address ToggleBreakpointResult 180 | 181 | ToggleBreakpointResult resp -> 182 | case resp of 183 | ToggleBreakpoint.Success { isSet, offset } -> 184 | let 185 | message = 186 | if isSet then 187 | "Breakpoint set @ 0x" ++ toHex offset 188 | else 189 | "Breakpoint unset @ 0x" ++ toHex offset 190 | in 191 | ( { model | breakpoints = Breakpoints.toggleBreakpoint model isSet offset }, Cmd.none ) 192 | |> consoleMessage message 193 | 194 | ToggleBreakpoint.Error msg -> 195 | consoleMessage ("Set breakpoint fail: " ++ msg) ( model, Cmd.none ) 196 | 197 | ToggleNmiBreakpoint -> 198 | ( model, ToggleNmiBreakpoint.request ToggleNmiBreakpointResult ) 199 | 200 | ToggleNmiBreakpointResult resp -> 201 | case resp of 202 | ToggleNmiBreakpoint.Success { isSet } -> 203 | let 204 | message = 205 | if isSet then 206 | "Break-on-NMI set" 207 | else 208 | "Break-on-NMI unset" 209 | in 210 | ( { model | breakOnNmi = isSet }, Cmd.none ) 211 | |> consoleMessage message 212 | 213 | ToggleNmiBreakpoint.Error msg -> 214 | consoleMessage ("Break-on-NMI toggle fail: " ++ msg) ( model, Cmd.none ) 215 | 216 | Step -> 217 | ( model, Cmd.none ) 218 | |> transitionAppState AppState.Step 219 | |> andThen (Step.request StepResult) 220 | 221 | StepResult resp -> 222 | case resp of 223 | Step.Success _ -> 224 | ( model, Cmd.none ) 225 | |> transitionAppState AppState.Pause 226 | |> unwrap 227 | 228 | Step.Error msg -> 229 | ( model, Cmd.none ) 230 | |> consoleMessage ("Step request failed:" ++ msg) 231 | |> transitionAppState AppState.Pause 232 | |> unwrap 233 | 234 | Continue -> 235 | ( model, Cmd.none ) 236 | |> transitionAppState AppState.Continue 237 | |> andThen 238 | (\input -> 239 | consoleMessage "Continuing execution..." input 240 | |> Continue.request ContinueResult 241 | ) 242 | 243 | ContinueResult resp -> 244 | case resp of 245 | Continue.Success _ -> 246 | ( model, Cmd.none ) 247 | 248 | Continue.Error msg -> 249 | ( model, Cmd.none ) 250 | |> consoleMessage ("Continue request failed: " ++ msg) 251 | |> transitionAppState AppState.Pause 252 | |> unwrap 253 | 254 | ScrollInstructionIntoView -> 255 | ( model, Cmd.none ) 256 | |> scrollElementIntoView (toString Styles.CurrentInstruction) 257 | 258 | UpdateMemoryByteFormat byteFormat -> 259 | ( { model | memoryByteFormat = byteFormat }, Cmd.none ) 260 | 261 | UpdateConsoleInput input -> 262 | ( { model | consoleInput = input }, Cmd.none ) 263 | 264 | SubmitConsoleCommand -> 265 | ( model, Cmd.none ) 266 | |> executeConsoleCommand 267 | 268 | KeyPressed keyCode -> 269 | ( model, Cmd.none ) 270 | |> handleKeyPress keyCode 271 | 272 | ShowConsoleInput shouldShow -> 273 | let 274 | task = 275 | if shouldShow then 276 | Dom.focus (toString Styles.ConsoleInput) 277 | else 278 | Dom.blur (toString Styles.ConsoleInput) 279 | in 280 | ( { model | showConsoleInput = shouldShow }, Task.attempt (\_ -> NoOp) task ) 281 | 282 | UpdateFocusState focusState -> 283 | ( { model | focusState = focusState }, Cmd.none ) 284 | 285 | PageUp -> 286 | case model.focusState of 287 | InstructionsFocused -> 288 | ( { model | disassembleOffset = max 0 (model.disassembleOffset - instructionPageAmount) }, Cmd.none ) 289 | 290 | HexEditorFocused -> 291 | consoleMessage "page up hex editor not implemented" ( model, Cmd.none ) 292 | 293 | ConsoleFocused -> 294 | consoleMessage "page up console not implemented" ( model, Cmd.none ) 295 | 296 | PageDown -> 297 | case model.focusState of 298 | InstructionsFocused -> 299 | ( { model | disassembleOffset = min 0xFFFF (model.disassembleOffset + instructionPageAmount) }, Cmd.none ) 300 | 301 | HexEditorFocused -> 302 | consoleMessage "page down hex editor not implemented" ( model, Cmd.none ) 303 | 304 | ConsoleFocused -> 305 | consoleMessage "page down console not implemented" ( model, Cmd.none ) 306 | 307 | NoOp -> 308 | ( model, Cmd.none ) 309 | 310 | 311 | unwrap : Result a a -> a 312 | unwrap input = 313 | case input of 314 | Ok output -> 315 | output 316 | 317 | Err output -> 318 | output 319 | 320 | 321 | andThen : (( a, Cmd msg ) -> ( a, Cmd msg )) -> Result ( a, Cmd msg ) ( a, Cmd msg ) -> ( a, Cmd msg ) 322 | andThen handler input = 323 | case input of 324 | Ok output -> 325 | handler output 326 | 327 | Err output -> 328 | output 329 | 330 | 331 | handleKeyPress : Int -> ( Model, Cmd Msg ) -> ( Model, Cmd Msg ) 332 | handleKeyPress keyCode ( model, cmd ) = 333 | case keyCode of 334 | 191 -> 335 | -- "/" for displaying console input 336 | let 337 | ( newModel, newCmd ) = 338 | update (ShowConsoleInput True) model 339 | in 340 | ( newModel, Cmd.batch [ cmd, newCmd ] ) 341 | 342 | 83 -> 343 | -- "s" for step 344 | let 345 | ( newModel, newCmd ) = 346 | update Step model 347 | in 348 | ( newModel, Cmd.batch [ cmd, newCmd ] ) 349 | 350 | 70 -> 351 | -- "f" for find current instruction 352 | let 353 | ( newModel, newCmd ) = 354 | update ScrollInstructionIntoView model 355 | in 356 | ( newModel, Cmd.batch [ cmd, newCmd ] ) 357 | 358 | 67 -> 359 | -- "c" for continue 360 | let 361 | ( newModel, newCmd ) = 362 | update Continue model 363 | in 364 | ( newModel, Cmd.batch [ cmd, newCmd ] ) 365 | 366 | 85 -> 367 | -- "u" for page up 368 | let 369 | ( newModel, newCmd ) = 370 | update PageUp model 371 | in 372 | ( newModel, Cmd.batch [ cmd, newCmd ] ) 373 | 374 | 68 -> 375 | -- "d" for page down 376 | let 377 | ( newModel, newCmd ) = 378 | update PageDown model 379 | in 380 | ( newModel, Cmd.batch [ cmd, newCmd ] ) 381 | 382 | _ -> 383 | ( model, cmd ) 384 | 385 | 386 | executeConsoleCommand : ( Model, Cmd Msg ) -> ( Model, Cmd Msg ) 387 | executeConsoleCommand ( model, cmd ) = 388 | let 389 | ( newModel, newCmd ) = 390 | case model.consoleInput of 391 | "" -> 392 | ( model, cmd ) 393 | 394 | _ -> 395 | let 396 | ( newerModel, newerCmd ) = 397 | consoleMessage ("> " ++ model.consoleInput) ( model, cmd ) 398 | in 399 | case ConsoleCommand.parse model.consoleInput of 400 | Ok consoleCommand -> 401 | case consoleCommand of 402 | ConsoleCommand.SetOffsetByteView byteFormat -> 403 | ( { newerModel | offsetByteFormat = byteFormat }, newerCmd ) 404 | |> consoleMessage ("Updated offset byte format to " ++ toString byteFormat) 405 | 406 | ConsoleCommand.SetMemoryByteView byteFormat -> 407 | ( { newerModel | memoryByteFormat = byteFormat }, newerCmd ) 408 | |> consoleMessage ("Updated memory byte format to " ++ toString byteFormat) 409 | 410 | ConsoleCommand.SetOperandByteView byteFormat -> 411 | ( { newerModel | operandByteFormat = byteFormat }, newerCmd ) 412 | |> consoleMessage ("Updated operand byte format to " ++ toString byteFormat) 413 | 414 | ConsoleCommand.SetRegistersByteView byteFormat -> 415 | ( { newerModel | registersByteFormat = byteFormat }, newerCmd ) 416 | |> consoleMessage ("Updated registers byte format to " ++ toString byteFormat) 417 | 418 | ConsoleCommand.ToggleBreakpoint bpType -> 419 | case bpType of 420 | ConsoleCommand.Offset offset -> 421 | update (ToggleBreakpoint offset) newerModel 422 | 423 | ConsoleCommand.Nmi -> 424 | update ToggleNmiBreakpoint newerModel 425 | 426 | ConsoleCommand.JumpToMemory offset -> 427 | updateMemoryViewOffset offset ( newerModel, newerCmd ) 428 | 429 | ConsoleCommand.SetDisassembleOffset offset -> 430 | updateDisassembleOffset offset ( newerModel, newerCmd ) 431 | 432 | Err _ -> 433 | ( newerModel, newerCmd ) 434 | |> consoleMessage ("Unknown console command: " ++ model.consoleInput) 435 | 436 | ( finalModel, showConsoleInputCmd ) = 437 | update (ShowConsoleInput False) newModel 438 | in 439 | ( { finalModel | consoleInput = "" }, Cmd.batch [ newCmd, showConsoleInputCmd ] ) 440 | 441 | 442 | updateMemoryViewOffset : Int -> ( Model, Cmd Msg ) -> ( Model, Cmd Msg ) 443 | updateMemoryViewOffset offset ( model, cmd ) = 444 | if offset >= 0 && offset <= 0xFFFF then 445 | ( { model | memoryViewOffset = offset }, cmd ) 446 | |> consoleMessage ("Displaying memory starting at offset 0x" ++ toHex offset) 447 | else 448 | consoleMessage "Invalid offset specified" ( model, cmd ) 449 | 450 | 451 | updateDisassembleOffset : Int -> ( Model, Cmd Msg ) -> ( Model, Cmd Msg ) 452 | updateDisassembleOffset offset ( model, cmd ) = 453 | if offset >= 0 && offset <= 0xFFFF then 454 | ( { model | disassembleOffset = offset }, cmd ) 455 | |> consoleMessage ("Showing disassembly starting at offset 0x" ++ toHex offset) 456 | else 457 | consoleMessage "Invalid offset specified" ( model, cmd ) 458 | 459 | 460 | transitionAppState : AppState.Input -> ( Model, Cmd Msg ) -> Result ( Model, Cmd Msg ) ( Model, Cmd Msg ) 461 | transitionAppState smInput appInput = 462 | let 463 | ( inputModel, inputCmd ) = 464 | appInput 465 | 466 | oldState = 467 | inputModel.appState 468 | in 469 | case AppState.transition smInput oldState of 470 | Ok newState -> 471 | if newState == oldState then 472 | Ok appInput 473 | else 474 | Ok ( { inputModel | appState = newState }, inputCmd ) 475 | 476 | Err ( input, oldState ) -> 477 | Err 478 | (appInput 479 | |> consoleMessage ("Unhandled transition: State = " ++ toString oldState ++ ", Input = " ++ toString input) 480 | ) 481 | 482 | 483 | clearCpuState : ( Model, Cmd Msg ) -> ( Model, Cmd Msg ) 484 | clearCpuState appInput = 485 | let 486 | ( model, cmd ) = 487 | appInput 488 | 489 | newModel = 490 | { model 491 | | cycles = 0 492 | , memory = ( 0, ByteArray.empty ) 493 | , registers = Registers.new 494 | , breakpoints = Set.empty 495 | } 496 | in 497 | ( newModel, cmd ) 498 | 499 | 500 | scrollElementIntoView : String -> ( Model, Cmd Msg ) -> ( Model, Cmd Msg ) 501 | scrollElementIntoView class appInput = 502 | appInput 503 | |> (\( inputMessage, inputCmd ) -> 504 | ( inputMessage, Cmd.batch [ inputCmd, Ports.scrollElementIntoViewCommand class ] ) 505 | ) 506 | 507 | 508 | onBreakpoint : Model -> Bool 509 | onBreakpoint model = 510 | Set.member model.registers.pc model.breakpoints 511 | 512 | 513 | consoleMessage : String -> ( Model, Cmd Msg ) -> ( Model, Cmd Msg ) 514 | consoleMessage message appInput = 515 | Console.addMessage NoOp message appInput 516 | 517 | 518 | handleDebuggerCommand : DebuggerCommand -> ( Model, Cmd Msg ) -> Result ( Model, Cmd Msg ) ( Model, Cmd Msg ) 519 | handleDebuggerCommand debuggerCommand appInput = 520 | case debuggerCommand of 521 | Break reason snapshot -> 522 | appInput 523 | |> transitionAppState AppState.Pause 524 | |> Result.map 525 | (\successInput -> 526 | handleBreakCondition reason snapshot successInput 527 | |> (\( outputModel, outputCmd ) -> ( applySnapshot outputModel snapshot, outputCmd )) 528 | ) 529 | 530 | Crash reason snapshot -> 531 | appInput 532 | |> transitionAppState AppState.Pause 533 | |> Result.map 534 | (\( outputModel, outputCmd ) -> 535 | ( applySnapshot outputModel snapshot, outputCmd ) 536 | |> consoleMessage ("A crash has occurred: " ++ crashReasonToString reason) 537 | ) 538 | 539 | 540 | applySnapshot : Model -> DebuggerState.State -> Model 541 | applySnapshot model snapshot = 542 | { model 543 | | registers = snapshot.registers 544 | , cycles = snapshot.cycles 545 | , memory = snapshot.memory 546 | , screen = snapshot.screen 547 | , disassembleOffset = snapshot.registers.pc 548 | } 549 | 550 | 551 | handleBreakCondition : BreakReason -> DebuggerState.State -> ( Model, Cmd Msg ) -> ( Model, Cmd Msg ) 552 | handleBreakCondition breakReason snapshot appInput = 553 | case breakReason of 554 | DebuggerCommand.Breakpoint -> 555 | appInput 556 | |> consoleMessage ("Hit breakpoint @ 0x" ++ toHex snapshot.registers.pc) 557 | 558 | DebuggerCommand.Trap -> 559 | appInput 560 | |> consoleMessage ("Trap detected @ 0x" ++ toHex snapshot.registers.pc) 561 | 562 | DebuggerCommand.Nmi -> 563 | appInput 564 | |> consoleMessage "Breaking on NMI" 565 | 566 | _ -> 567 | appInput 568 | 569 | 570 | subscriptions : Model -> Sub Msg 571 | subscriptions model = 572 | Sub.batch 573 | [ Keyboard.ups (\keyCode -> KeyPressed keyCode) 574 | , WebSocket.onOpen DebuggerConnectionOpened 575 | , WebSocket.onClose DebuggerConnectionClosed 576 | , WebSocket.listen wsDebuggerEndpoint <| 577 | DebuggerCommand.decode model.memory DebuggerCommandReceived 578 | ] 579 | 580 | 581 | 582 | -- VIEW 583 | 584 | 585 | view : Model -> Html Msg 586 | view model = 587 | div [ id Styles.Container ] 588 | [ div [ id Styles.TwoColumn ] 589 | [ div [ id Styles.LeftColumn ] 590 | [ div [ id Styles.RegistersContainer ] [ Registers.view model ] 591 | , div [ id Styles.InstructionsContainer, Html.Attributes.tabindex 1, Html.Events.onFocus (UpdateFocusState InstructionsFocused) ] 592 | [ Instruction.view (\address -> ToggleBreakpoint address) model 593 | ] 594 | ] 595 | , div [ id Styles.RightColumn ] 596 | [ div [ id Styles.ConsoleContainer, Html.Attributes.tabindex 3, Html.Events.onFocus (UpdateFocusState ConsoleFocused) ] 597 | [ Console.view model 598 | ] 599 | , div [ id Styles.HexEditorContainer, Html.Attributes.tabindex 2, Html.Events.onFocus (UpdateFocusState HexEditorFocused) ] 600 | [ HexEditor.view model 601 | ] 602 | ] 603 | ] 604 | , div 605 | [ id Styles.StatusStrip ] 606 | [ Html.span [] 607 | [ text "Break-on-NMI: " 608 | , Html.span [] [ text (toString model.breakOnNmi) ] 609 | ] 610 | , Html.span [] 611 | [ text "Status: " 612 | , Html.span 613 | [ id Styles.ConnectionStatus 614 | , classList 615 | [ ( Styles.DebuggerConnected, model.appState /= AppState.NotConnected ) 616 | , ( Styles.DebuggerNotConnected, model.appState == AppState.NotConnected ) 617 | ] 618 | ] 619 | [ text <| toString model.appState ] 620 | ] 621 | ] 622 | , input 623 | [ id Styles.ConsoleInput 624 | , classList [ ( Styles.ConsoleInputDisplayed, model.showConsoleInput ) ] 625 | , Html.Attributes.type_ "text" 626 | , Html.Events.onInput UpdateConsoleInput 627 | , Html.Events.onBlur (ShowConsoleInput False) 628 | , Html.Attributes.value model.consoleInput 629 | , handleInput 630 | ] 631 | [] 632 | , div [ id Styles.ScreenContainer ] [ screen model ] 633 | ] 634 | 635 | 636 | screen : Model -> Html Msg 637 | screen { screen } = 638 | case screen.imgData of 639 | "" -> 640 | div [ id Styles.NoScreen ] [ text "No screen data provided" ] 641 | 642 | _ -> 643 | Html.img 644 | [ id Styles.Screen 645 | , Html.Attributes.src ("data:image/png;base64," ++ screen.imgData) 646 | ] 647 | [] 648 | 649 | 650 | handleInput : Html.Attribute Msg 651 | handleInput = 652 | Html.Events.onWithOptions "keyup" 653 | { stopPropagation = True, preventDefault = False } 654 | (Json.map 655 | (\keyCode -> 656 | case keyCode of 657 | 13 -> 658 | SubmitConsoleCommand 659 | 660 | 27 -> 661 | ShowConsoleInput False 662 | 663 | _ -> 664 | NoOp 665 | ) 666 | Html.Events.keyCode 667 | ) 668 | 669 | 670 | registersContainerHeight : Float 671 | registersContainerHeight = 672 | 40.0 673 | 674 | 675 | styles : List Css.Snippet 676 | styles = 677 | [ Styles.id Styles.Container 678 | [ Css.displayFlex 679 | , Css.flexDirection Css.column 680 | , Css.height (Css.vh 100) 681 | , Css.children 682 | [ Styles.id Styles.StatusStrip 683 | [ Css.width (Css.pct 100) 684 | , Css.borderTop3 (Css.px 1) Css.solid Colors.headerBorder 685 | , Css.padding2 (Css.em 0.2) (Css.em 0.4) 686 | , Css.textAlign Css.right 687 | , Css.color (Css.hex "#ffffff") 688 | , Css.backgroundColor Colors.statusStripBackgroundColor 689 | , Css.children 690 | [ Css.everything 691 | [ Css.paddingRight (Css.em 1.0) 692 | , Css.lastChild [ Css.paddingRight (Css.em 0) ] 693 | ] 694 | ] 695 | , Css.descendants 696 | [ Styles.id Styles.ConnectionStatus 697 | [ Styles.withClass Styles.DebuggerConnected 698 | [ Css.color Colors.statusConnected ] 699 | , Styles.withClass Styles.DebuggerNotConnected 700 | [ Css.color Colors.statusDisconnected ] 701 | ] 702 | ] 703 | ] 704 | , Styles.id Styles.TwoColumn 705 | [ Css.displayFlex 706 | , Css.flexDirection Css.row 707 | , Css.flexGrow (Css.num 1) 708 | , Css.children 709 | [ Styles.id Styles.LeftColumn 710 | [ Css.displayFlex 711 | , Css.flexDirection Css.column 712 | , Css.flexGrow (Css.num 0.8) 713 | , Css.flexBasis (Css.px 0) 714 | , Css.overflowY Css.auto 715 | , Css.overflowX Css.hidden 716 | , Css.children 717 | [ Styles.id Styles.RegistersContainer 718 | [ Css.height (Css.px registersContainerHeight) 719 | , Css.backgroundColor Colors.statusStripBackgroundColor 720 | , Css.flexGrow (Css.num 1) 721 | , Css.flexBasis (Css.px 0) 722 | ] 723 | , Styles.id Styles.InstructionsContainer 724 | [ Css.borderTop3 (Css.px 1) Css.solid Colors.headerBorder 725 | , Css.flexGrow (Css.num 1) 726 | , Css.overflowY Css.auto 727 | , Css.property "height" ("calc(100% - " ++ toString registersContainerHeight ++ "px)") 728 | , canFocus 729 | ] 730 | ] 731 | ] 732 | , Styles.id Styles.RightColumn 733 | [ Css.displayFlex 734 | , Css.flex3 (Css.num 2) (Css.num 0) (Css.num 0) 735 | , Css.flexDirection Css.columnReverse 736 | , Css.children 737 | [ Styles.id Styles.ConsoleContainer 738 | [ Css.backgroundColor Colors.consoleBackground 739 | , Css.displayFlex 740 | , Css.flexDirection Css.row 741 | , Css.flex3 (Css.num 1) (Css.num 0) (Css.num 0) 742 | , canFocus 743 | ] 744 | , Styles.id Styles.HexEditorContainer 745 | [ Css.flex3 (Css.num 2) (Css.num 0) (Css.num 0) 746 | , Css.overflowY Css.auto 747 | , Css.position Css.relative 748 | , canFocus 749 | ] 750 | ] 751 | ] 752 | ] 753 | ] 754 | ] 755 | ] 756 | , Styles.id Styles.ConsoleInput 757 | [ Css.position Css.fixed 758 | , Css.display Css.block 759 | , Css.property "transition" "bottom 100ms ease-out" 760 | , Css.bottom (Css.em -2) 761 | , Css.left (Css.px 0) 762 | , Css.width (Css.em 40) 763 | , Css.height (Css.em 2) 764 | , Css.marginTop Css.auto 765 | , Css.outline Css.none 766 | , Css.border (Css.px 0) 767 | , Css.fontFamily Css.monospace 768 | , Css.backgroundColor Colors.consoleInputBackground 769 | , Css.color Colors.consoleInputText 770 | , Css.fontSize (Css.em 1) 771 | , Css.padding2 (Css.em 0.2) (Css.em 0.4) 772 | , Styles.withClass Styles.ConsoleInputDisplayed 773 | [ Css.bottom (Css.em 0) 774 | ] 775 | ] 776 | , Styles.id Styles.ScreenContainer 777 | [ Css.position Css.fixed 778 | , Css.right (Css.px 0) 779 | , Css.top (Css.px 0) 780 | ] 781 | ] 782 | 783 | 784 | canFocus : Css.Mixin 785 | canFocus = 786 | [ Css.outline Css.none 787 | , Css.border3 (Css.px 1) Css.solid (Css.hex "#000000") 788 | , Css.focus 789 | [ Css.borderColor (Css.hex "#A0522D") 790 | ] 791 | ] 792 | |> Css.mixin 793 | -------------------------------------------------------------------------------- /src/Memory.elm: -------------------------------------------------------------------------------- 1 | module Memory exposing (Memory, MemoryMessage(..), messageDecoder) 2 | 3 | import Bitwise 4 | import ByteArray 5 | import Json.Decode as Json exposing (Decoder, field) 6 | 7 | 8 | type alias Memory = 9 | ( Int, ByteArray.ByteArray ) 10 | 11 | 12 | type MemoryMessage 13 | = NoChange Int 14 | | Updated Memory 15 | 16 | 17 | messageDecoder : Decoder MemoryMessage 18 | messageDecoder = 19 | field "state" Json.string 20 | |> Json.andThen 21 | (\state -> 22 | case state of 23 | "NoChange" -> 24 | field "hash" Json.int 25 | |> Json.andThen (\hash -> Json.succeed <| NoChange hash) 26 | 27 | "Updated" -> 28 | Json.map2 (,) 29 | (field "hash" Json.int) 30 | (field "base64" Json.string) 31 | |> Json.andThen 32 | (\( hash, base64 ) -> 33 | case ByteArray.fromBase64 base64 of 34 | Ok byteArray -> 35 | Json.succeed <| Updated ( hash, byteArray ) 36 | 37 | Err err -> 38 | Json.fail "Unable to decode base64-encoded memory" 39 | ) 40 | 41 | _ -> 42 | Json.fail <| "unexpected memory state: " ++ state 43 | ) 44 | -------------------------------------------------------------------------------- /src/Native/ByteArray.js: -------------------------------------------------------------------------------- 1 | var _bgourlie$rs_nes_debugger_frontend$Native_ByteArray = function () { 2 | 3 | var empty = new Uint8ClampedArray(0); 4 | 5 | function fromBase64(base64) 6 | { 7 | try 8 | { 9 | var arr = Uint8ClampedArray.from(atob(base64), c => c.charCodeAt(0)); 10 | return _elm_lang$core$Result$Ok(arr); 11 | } 12 | catch (e) 13 | { 14 | return _elm_lang$core$Result$Err('The base64-encoded string must consist of ASCII-encoded characters in multiples of 4.') 15 | } 16 | } 17 | 18 | function get(i, arr) 19 | { 20 | if (i < 0 || arr.byteLength <= i) 21 | { 22 | return _elm_lang$core$Maybe$Nothing; 23 | } 24 | 25 | return _elm_lang$core$Maybe$Just(arr[i]); 26 | } 27 | 28 | function slice(start, end, arr) 29 | { 30 | return arr.slice(start, end); 31 | } 32 | 33 | function toList(arr) 34 | { 35 | var list = _elm_lang$core$Native_List.Nil; 36 | 37 | for (var i = arr.byteLength - 1; i >= 0; i--) 38 | { 39 | list = _elm_lang$core$Native_List.Cons(arr[i], list) 40 | } 41 | 42 | return list; 43 | } 44 | 45 | return { 46 | fromBase64: fromBase64, 47 | empty: empty, 48 | get: F2(get), 49 | slice: F3(slice), 50 | toList: toList 51 | }; 52 | 53 | }(); -------------------------------------------------------------------------------- /src/Native/WebSocket.js: -------------------------------------------------------------------------------- 1 | var _bgourlie$rs_nes_debugger_frontend$Native_WebSocket = function() { 2 | 3 | function open(url, settings) 4 | { 5 | return _elm_lang$core$Native_Scheduler.nativeBinding(function(callback) 6 | { 7 | try 8 | { 9 | var socket = new WebSocket(url); 10 | socket.elm_web_socket = true; 11 | } 12 | catch(err) 13 | { 14 | return callback(_elm_lang$core$Native_Scheduler.fail({ 15 | ctor: err.name === 'SecurityError' ? 'BadSecurity' : 'BadArgs', 16 | _0: err.message 17 | })); 18 | } 19 | 20 | socket.addEventListener("open", function(event) { 21 | callback(_elm_lang$core$Native_Scheduler.succeed(socket)); 22 | }); 23 | 24 | socket.addEventListener("message", function(event) { 25 | _elm_lang$core$Native_Scheduler.rawSpawn(A2(settings.onMessage, socket, event.data)); 26 | }); 27 | 28 | socket.addEventListener("close", function(event) { 29 | _elm_lang$core$Native_Scheduler.rawSpawn(settings.onClose({ 30 | code: event.code, 31 | reason: event.reason, 32 | wasClean: event.wasClean 33 | })); 34 | }); 35 | 36 | return function() 37 | { 38 | if (socket && socket.close) 39 | { 40 | socket.close(); 41 | } 42 | }; 43 | }); 44 | } 45 | 46 | function send(socket, string) 47 | { 48 | return _elm_lang$core$Native_Scheduler.nativeBinding(function(callback) 49 | { 50 | var result = 51 | socket.readyState === WebSocket.OPEN 52 | ? _elm_lang$core$Maybe$Nothing 53 | : _elm_lang$core$Maybe$Just({ ctor: 'NotOpen' }); 54 | 55 | try 56 | { 57 | socket.send(string); 58 | } 59 | catch(err) 60 | { 61 | result = _elm_lang$core$Maybe$Just({ ctor: 'BadString' }); 62 | } 63 | 64 | callback(_elm_lang$core$Native_Scheduler.succeed(result)); 65 | }); 66 | } 67 | 68 | function close(code, reason, socket) 69 | { 70 | return _elm_lang$core$Native_Scheduler.nativeBinding(function(callback) { 71 | try 72 | { 73 | socket.close(code, reason); 74 | } 75 | catch(err) 76 | { 77 | return callback(_elm_lang$core$Native_Scheduler.fail(_elm_lang$core$Maybe$Just({ 78 | ctor: err.name === 'SyntaxError' ? 'BadReason' : 'BadCode' 79 | }))); 80 | } 81 | callback(_elm_lang$core$Native_Scheduler.succeed(_elm_lang$core$Maybe$Nothing)); 82 | }); 83 | } 84 | 85 | function bytesQueued(socket) 86 | { 87 | return _elm_lang$core$Native_Scheduler.nativeBinding(function(callback) { 88 | callback(_elm_lang$core$Native_Scheduler.succeed(socket.bufferedAmount)); 89 | }); 90 | } 91 | 92 | return { 93 | open: F2(open), 94 | send: F2(send), 95 | close: F3(close), 96 | bytesQueued: bytesQueued 97 | }; 98 | 99 | }(); -------------------------------------------------------------------------------- /src/Ports.elm: -------------------------------------------------------------------------------- 1 | port module Ports exposing (..) 2 | 3 | {-| Given a class name, scroll the first element with that class into view. 4 | -} 5 | 6 | 7 | port scrollElementIntoViewCommand : String -> Cmd msg 8 | -------------------------------------------------------------------------------- /src/Registers.elm: -------------------------------------------------------------------------------- 1 | module Registers exposing (Registers, decoder, new, styles, view) 2 | 3 | import Bitwise exposing (and) 4 | import Byte 5 | import Css 6 | import Html exposing (Html, div, h4, li, table, td, text, th, tr, ul) 7 | import Html.Attributes exposing (colspan, title) 8 | import Json.Decode as Json exposing (Decoder, field) 9 | import ParseInt exposing (toHex) 10 | import Styles 11 | 12 | 13 | { id, class, classList } = 14 | Styles.helpers 15 | 16 | 17 | getCarry : Registers -> Bool 18 | getCarry model = 19 | and model.stat 0x01 > 0 20 | 21 | 22 | getZero : Registers -> Bool 23 | getZero model = 24 | and model.stat 0x02 > 0 25 | 26 | 27 | getInterrupt : Registers -> Bool 28 | getInterrupt model = 29 | and model.stat 0x04 > 0 30 | 31 | 32 | getDecimal : Registers -> Bool 33 | getDecimal model = 34 | and model.stat 0x08 > 0 35 | 36 | 37 | getBreak : Registers -> Bool 38 | getBreak model = 39 | and model.stat 0x10 > 0 40 | 41 | 42 | getUnused : Registers -> Bool 43 | getUnused model = 44 | and model.stat 0x20 > 0 45 | 46 | 47 | getOverflow : Registers -> Bool 48 | getOverflow model = 49 | and model.stat 0x40 > 0 50 | 51 | 52 | getNegative : Registers -> Bool 53 | getNegative model = 54 | and model.stat 0x80 > 0 55 | 56 | 57 | type alias Registers = 58 | { acc : Int 59 | , x : Int 60 | , y : Int 61 | , pc : Int 62 | , sp : Int 63 | , stat : Int 64 | } 65 | 66 | 67 | type alias Model a = 68 | { a 69 | | registers : Registers 70 | , cycles : Int 71 | , registersByteFormat : Byte.Format 72 | } 73 | 74 | 75 | new : Registers 76 | new = 77 | { acc = 0 78 | , x = 0 79 | , y = 0 80 | , pc = 0 81 | , sp = 0 82 | , stat = 0 83 | } 84 | 85 | 86 | decoder : Decoder Registers 87 | decoder = 88 | Json.map6 Registers 89 | (field "acc" Json.int) 90 | (field "x" Json.int) 91 | (field "y" Json.int) 92 | (field "pc" Json.int) 93 | (field "sp" Json.int) 94 | (field "status" Json.int) 95 | 96 | 97 | view : Model a -> Html msg 98 | view model = 99 | let 100 | registers = 101 | model.registers 102 | 103 | display = 104 | model.registersByteFormat 105 | 106 | cycles = 107 | model.cycles 108 | in 109 | table [ id Styles.Registers ] 110 | [ tr [] 111 | [ th [ title "Program Counter" ] [ text "PC" ] 112 | , th [ title "Stack Pointer" ] [ text "SP" ] 113 | , th [ title "Accumulator" ] [ text "ACC" ] 114 | , th [ title "Index (X)" ] [ text "X" ] 115 | , th [ title "Index (Y)" ] [ text "Y" ] 116 | , th [ title "Status Flags" ] [ text "NV-BDIZC" ] 117 | , th [] [ text "Cycles" ] 118 | ] 119 | , tr [] 120 | [ td [] [ view16 display registers.pc ] 121 | , td [] [ view8 display registers.sp ] 122 | , td [] [ view8 display registers.acc ] 123 | , td [] [ view8 display registers.x ] 124 | , td [] [ view8 display registers.y ] 125 | , td [] 126 | [ text <| 127 | flagDisplay (getNegative registers) 128 | ++ flagDisplay (getOverflow registers) 129 | ++ flagDisplay (getUnused registers) 130 | ++ flagDisplay (getBreak registers) 131 | ++ flagDisplay (getDecimal registers) 132 | ++ flagDisplay (getInterrupt registers) 133 | ++ flagDisplay (getZero registers) 134 | ++ flagDisplay (getCarry registers) 135 | ] 136 | , td [] [ text <| toString cycles ] 137 | ] 138 | ] 139 | 140 | 141 | flagDisplay : Bool -> String 142 | flagDisplay val = 143 | if val then 144 | toString 1 145 | else 146 | toString 0 147 | 148 | 149 | view8 : Byte.Format -> Int -> Html msg 150 | view8 display byte = 151 | let 152 | str = 153 | case display of 154 | Byte.Dec -> 155 | String.padLeft 3 '0' (toString byte) 156 | 157 | _ -> 158 | -- Default to hex 159 | "0x" ++ String.padLeft 2 '0' (toHex byte) 160 | in 161 | Html.span [] [ text str ] 162 | 163 | 164 | view16 : Byte.Format -> Int -> Html msg 165 | view16 display byte = 166 | let 167 | str = 168 | case display of 169 | Byte.Dec -> 170 | String.padLeft 5 '0' (toString byte) 171 | 172 | _ -> 173 | -- Default to hex 174 | "0x" ++ String.padLeft 4 '0' (toHex byte) 175 | in 176 | Html.span [] [ text str ] 177 | 178 | 179 | styles : List Css.Snippet 180 | styles = 181 | [ Styles.id Styles.Registers 182 | [ Css.property "border-spacing" "8px 0" 183 | ] 184 | ] 185 | -------------------------------------------------------------------------------- /src/Step.elm: -------------------------------------------------------------------------------- 1 | module Step exposing (Result(..), request) 2 | 3 | import Http 4 | import Json.Decode exposing (Decoder, field) 5 | 6 | 7 | type alias SuccessModel = 8 | { stepped : Bool 9 | } 10 | 11 | 12 | type Result 13 | = Success SuccessModel 14 | | Error String 15 | 16 | 17 | decoder : Decoder SuccessModel 18 | decoder = 19 | Json.Decode.map SuccessModel 20 | (field "stepped" Json.Decode.bool) 21 | 22 | 23 | endpoint : String 24 | endpoint = 25 | "http://localhost:9975/step" 26 | 27 | 28 | request : (Result -> msg) -> ( a, Cmd msg ) -> ( a, Cmd msg ) 29 | request handler ( inputModel, inputCmd ) = 30 | let 31 | result = 32 | \r -> 33 | case r of 34 | Ok r -> 35 | handler <| Success r 36 | 37 | Err e -> 38 | handler <| Error (toString e) 39 | in 40 | ( inputModel, Cmd.batch [ inputCmd, Http.send result (Http.get endpoint decoder) ] ) 41 | -------------------------------------------------------------------------------- /src/Styles.elm: -------------------------------------------------------------------------------- 1 | module Styles exposing (Class(..), Id(..), class, helpers, id, withClass) 2 | 3 | import Css exposing (class, id) 4 | import Html.CssHelpers 5 | 6 | 7 | helpers : Html.CssHelpers.Namespace String Class Id msg 8 | helpers = 9 | Html.CssHelpers.withNamespace "" 10 | 11 | 12 | class : Class -> List Css.Mixin -> Css.Snippet 13 | class classType mixins = 14 | Css.class classType mixins 15 | 16 | 17 | id : Id -> List Css.Mixin -> Css.Snippet 18 | id idType mixins = 19 | Css.id idType mixins 20 | 21 | 22 | withClass : Class -> List Css.Mixin -> Css.Mixin 23 | withClass class mixins = 24 | Css.withClass class mixins 25 | 26 | 27 | type Class 28 | = MessageRepeats 29 | | MessageRepeatsShow 30 | | RowOffset 31 | | OffsetColumn 32 | | BytesRow 33 | | ButtonIcon 34 | | BreakpointIcon 35 | | InstructionGutter 36 | | InstructionValue 37 | | BreakpointHitBox 38 | | BreakpointOn 39 | | MemoryLocation 40 | | AddressModeValues 41 | | AddressModeMemoryLocation 42 | | AddressModeMemoryValue 43 | | Mnemonic 44 | | Operand 45 | | UndefinedOpcode 46 | | CurrentInstruction 47 | | Instruction 48 | | ConsoleLine 49 | | DebuggerConnected 50 | | DebuggerNotConnected 51 | | ConsoleInputDisplayed 52 | 53 | 54 | type Id 55 | = Container 56 | | TwoColumn 57 | | LeftColumn 58 | | ConsoleContainer 59 | | HexEditorContainer 60 | | RightColumn 61 | | ConsoleLines 62 | | ConsoleInput 63 | | HexEditor 64 | | HexEditorBody 65 | | InstructionsContainer 66 | | Instructions 67 | | StatusStrip 68 | | RegistersContainer 69 | | Registers 70 | | ScreenContainer 71 | | Screen 72 | | NoScreen 73 | | ConnectionStatus 74 | -------------------------------------------------------------------------------- /src/Stylesheets.elm: -------------------------------------------------------------------------------- 1 | port module Stylesheets exposing (..) 2 | 3 | import AppCss 4 | import Css.File exposing (..) 5 | 6 | 7 | port files : CssFileStructure -> Cmd msg 8 | 9 | 10 | fileStructure : CssFileStructure 11 | fileStructure = 12 | Css.File.toFileStructure 13 | [ ( "styles.css", Css.File.compile [ AppCss.css ] ) ] 14 | 15 | 16 | main : CssCompilerProgram 17 | main = 18 | Css.File.compiler files fileStructure 19 | -------------------------------------------------------------------------------- /src/ToggleBreakpoint.elm: -------------------------------------------------------------------------------- 1 | module ToggleBreakpoint exposing (Result(..), request) 2 | 3 | import Http 4 | import Json.Decode exposing (Decoder, field) 5 | 6 | 7 | endpoint : Int -> String 8 | endpoint address = 9 | "http://localhost:9975/toggle_breakpoint/" ++ toString address 10 | 11 | 12 | type Result 13 | = Success ResponseModel 14 | | Error String 15 | 16 | 17 | type alias ResponseModel = 18 | { offset : Int 19 | , isSet : Bool 20 | } 21 | 22 | 23 | responseModelDecoder : Decoder ResponseModel 24 | responseModelDecoder = 25 | Json.Decode.map2 ResponseModel 26 | (field "offset" Json.Decode.int) 27 | (field "is_set" Json.Decode.bool) 28 | 29 | 30 | request : Int -> (Result -> msg) -> ( a, Cmd msg ) -> ( a, Cmd msg ) 31 | request address handler ( inputModel, inputCmd ) = 32 | let 33 | result = 34 | \r -> 35 | case r of 36 | Ok r -> 37 | handler <| Success r 38 | 39 | Err e -> 40 | handler <| Error (toString e) 41 | in 42 | ( inputModel, Cmd.batch [ inputCmd, Http.send result (Http.get (endpoint address) responseModelDecoder) ] ) 43 | -------------------------------------------------------------------------------- /src/ToggleNmiBreakpoint.elm: -------------------------------------------------------------------------------- 1 | module ToggleNmiBreakpoint exposing (Result(..), request) 2 | 3 | import Http 4 | import Json.Decode as Json 5 | 6 | 7 | type Result 8 | = Success ResponseModel 9 | | Error String 10 | 11 | 12 | type alias ResponseModel = 13 | { isSet : Bool 14 | } 15 | 16 | 17 | responseModelDecoder : Json.Decoder ResponseModel 18 | responseModelDecoder = 19 | Json.map ResponseModel 20 | (Json.field "is_set" Json.bool) 21 | 22 | 23 | endpoint : String 24 | endpoint = 25 | "http://localhost:9975/toggle_break_on_nmi" 26 | 27 | 28 | request : (Result -> msg) -> Cmd msg 29 | request handler = 30 | let 31 | result = 32 | \r -> 33 | case r of 34 | Ok r -> 35 | handler <| Success r 36 | 37 | Err e -> 38 | handler <| Error (toString e) 39 | in 40 | Http.send result (Http.get endpoint responseModelDecoder) 41 | -------------------------------------------------------------------------------- /src/WebSocket.elm: -------------------------------------------------------------------------------- 1 | effect module WebSocket 2 | where { command = MyCmd, subscription = MySub } 3 | exposing 4 | ( listen 5 | , onClose 6 | , onOpen 7 | , send 8 | ) 9 | 10 | {-| Web sockets make it cheaper to talk to your servers. 11 | 12 | Connecting to a server takes some time, so with web sockets, you make that 13 | connection once and then keep using. The major benefits of this are: 14 | 15 | 1. It faster to send messages. No need to do a bunch of work for every single 16 | message. 17 | 18 | 2. The server can push messages to you. With normal HTTP you would have to 19 | keep _asking_ for changes, but a web socket, the server can talk to you 20 | whenever it wants. This means there is less unnecessary network traffic. 21 | 22 | The API here attempts to cover the typical usage scenarios, but if you need 23 | many unique connections to the same endpoint, you need a different library. 24 | 25 | 26 | # Web Sockets 27 | 28 | @docs listen, onOpen, onClose, send 29 | 30 | -} 31 | 32 | import Dict 33 | import Process 34 | import Task exposing (Task) 35 | import WebSocket.LowLevel as WS 36 | 37 | 38 | -- COMMANDS 39 | 40 | 41 | type MyCmd msg 42 | = Send String String 43 | 44 | 45 | {-| Send a message to a particular address. You might say something like this: 46 | 47 | send "ws://echo.websocket.org" "Hello!" 48 | 49 | **Note:** It is important that you are also subscribed to this address with 50 | `listen`. If you are not, the web socket will be created to send one message 51 | and then closed. Not good! 52 | 53 | -} 54 | send : String -> String -> Cmd msg 55 | send url message = 56 | command (Send url message) 57 | 58 | 59 | cmdMap : (a -> b) -> MyCmd a -> MyCmd b 60 | cmdMap _ (Send url msg) = 61 | Send url msg 62 | 63 | 64 | 65 | -- SUBSCRIPTIONS 66 | 67 | 68 | type MySub msg 69 | = MySub String String (String -> msg) 70 | 71 | 72 | {-| Subscribe to any incoming messages on a websocket. You might say something 73 | like this: 74 | 75 | type Msg = Echo String | ... 76 | 77 | subscriptions model = 78 | listen "ws://echo.websocket.org" Echo 79 | 80 | **Note:** If the connection goes down, the effect manager tries to reconnect 81 | with an exponential backoff strategy. 82 | 83 | -} 84 | listen : String -> (String -> msg) -> Sub msg 85 | listen url tagger = 86 | subscription (MySub "listen" url tagger) 87 | 88 | 89 | {-| Subscribe to websocket open events. You might say something 90 | like this: 91 | 92 | type Msg = WsOpened String | ... 93 | 94 | subscriptions model = 95 | onOpen WsOpened 96 | 97 | -} 98 | onOpen : (String -> msg) -> Sub msg 99 | onOpen tagger = 100 | subscription (MySub "onOpen" "" tagger) 101 | 102 | 103 | {-| Subscribe to websocket close events. You might say something 104 | like this: 105 | 106 | type Msg = WsClosed String | ... 107 | 108 | subscriptions model = 109 | onClose WsClosed 110 | 111 | -} 112 | onClose : (String -> msg) -> Sub msg 113 | onClose tagger = 114 | subscription (MySub "onClose" "" tagger) 115 | 116 | 117 | subMap : (a -> b) -> MySub a -> MySub b 118 | subMap func sub = 119 | case sub of 120 | MySub category url tagger -> 121 | MySub category url (tagger >> func) 122 | 123 | 124 | 125 | -- MANAGER 126 | 127 | 128 | type alias State msg = 129 | { sockets : SocketsDict 130 | , subs : SubsDict msg 131 | } 132 | 133 | 134 | type alias SocketsDict = 135 | Dict.Dict String Connection 136 | 137 | 138 | type alias SubsDict msg = 139 | Dict.Dict String (Dict.Dict String (String -> msg)) 140 | 141 | 142 | type Connection 143 | = Opening Int Process.Id 144 | | Connected WS.WebSocket 145 | 146 | 147 | init : Task Never (State msg) 148 | init = 149 | Task.succeed (State Dict.empty Dict.empty) 150 | 151 | 152 | 153 | -- HANDLE APP MESSAGES 154 | 155 | 156 | (&>) t1 t2 = 157 | Task.andThen (\_ -> t2) t1 158 | 159 | 160 | onEffects : 161 | Platform.Router msg Msg 162 | -> List (MyCmd msg) 163 | -> List (MySub msg) 164 | -> State msg 165 | -> Task Never (State msg) 166 | onEffects router cmds subs state = 167 | let 168 | newSubs = 169 | buildSubDict subs Dict.empty 170 | 171 | newEntries = 172 | buildEntriesDict subs Dict.empty 173 | 174 | leftStep category _ getNewSockets = 175 | getNewSockets 176 | |> Task.andThen 177 | (\newSockets -> 178 | attemptOpen router 0 category 179 | |> Task.andThen (\pid -> Task.succeed (Dict.insert category (Opening 0 pid) newSockets)) 180 | ) 181 | 182 | bothStep category _ connection getNewSockets = 183 | Task.map (Dict.insert category connection) getNewSockets 184 | 185 | rightStep category connection getNewSockets = 186 | closeConnection connection &> getNewSockets 187 | 188 | collectNewSockets = 189 | Dict.merge leftStep bothStep rightStep newEntries state.sockets (Task.succeed Dict.empty) 190 | in 191 | cmdHelp router cmds state.sockets 192 | &> collectNewSockets 193 | |> Task.andThen (\newSockets -> Task.succeed (State newSockets newSubs)) 194 | 195 | 196 | cmdHelp : Platform.Router msg Msg -> List (MyCmd msg) -> SocketsDict -> Task Never SocketsDict 197 | cmdHelp router cmds socketsDict = 198 | case cmds of 199 | [] -> 200 | Task.succeed socketsDict 201 | 202 | (Send name msg) :: rest -> 203 | case Dict.get name socketsDict of 204 | Just (Connected socket) -> 205 | WS.send socket msg 206 | &> cmdHelp router rest socketsDict 207 | 208 | _ -> 209 | -- TODO: Since messages are no longer queued, this probably shouldn't just succeed 210 | Task.succeed socketsDict 211 | 212 | 213 | buildSubDict : List (MySub msg) -> SubsDict msg -> SubsDict msg 214 | buildSubDict subs dict = 215 | case subs of 216 | [] -> 217 | dict 218 | 219 | (MySub category name tagger) :: rest -> 220 | buildSubDict rest (Dict.update category (set ( name, tagger )) dict) 221 | 222 | 223 | buildEntriesDict : List (MySub msg) -> Dict.Dict String (List a) -> Dict.Dict String (List a) 224 | buildEntriesDict subs dict = 225 | case subs of 226 | [] -> 227 | dict 228 | 229 | (MySub category name tagger) :: rest -> 230 | case category of 231 | "listen" -> 232 | buildEntriesDict rest (Dict.update name (Just << Maybe.withDefault []) dict) 233 | 234 | _ -> 235 | buildEntriesDict rest dict 236 | 237 | 238 | set : ( comparable, b ) -> Maybe (Dict.Dict comparable b) -> Maybe (Dict.Dict comparable b) 239 | set value maybeDict = 240 | case maybeDict of 241 | Nothing -> 242 | Just (Dict.fromList [ value ]) 243 | 244 | Just list -> 245 | Just (Dict.fromList [ value ]) 246 | 247 | 248 | 249 | -- HANDLE SELF MESSAGES 250 | 251 | 252 | type Msg 253 | = Receive String String 254 | | Die String 255 | | GoodOpen String WS.WebSocket 256 | | BadOpen String 257 | 258 | 259 | onSelfMsg : Platform.Router msg Msg -> Msg -> State msg -> Task Never (State msg) 260 | onSelfMsg router selfMsg state = 261 | case selfMsg of 262 | Receive name str -> 263 | let 264 | sends = 265 | Dict.get "listen" state.subs 266 | |> Maybe.withDefault Dict.empty 267 | |> Dict.toList 268 | |> List.map (\( _, tagger ) -> Platform.sendToApp router (tagger str)) 269 | in 270 | Task.sequence sends &> Task.succeed state 271 | 272 | Die name -> 273 | case Dict.get name state.sockets of 274 | Nothing -> 275 | Task.succeed state 276 | 277 | Just (Connected _) -> 278 | let 279 | sends = 280 | Dict.get "onClose" state.subs 281 | |> Maybe.withDefault Dict.empty 282 | |> Dict.toList 283 | |> List.map (\( _, tagger ) -> Platform.sendToApp router (tagger name)) 284 | in 285 | Task.sequence sends 286 | &> attemptOpen router 0 name 287 | |> Task.andThen (\pid -> Task.succeed (updateSocket name (Opening 0 pid) state)) 288 | 289 | Just (Opening n _) -> 290 | retryConnection router n name state 291 | 292 | GoodOpen name socket -> 293 | let 294 | sends = 295 | Dict.get "onOpen" state.subs 296 | |> Maybe.withDefault Dict.empty 297 | |> Dict.toList 298 | |> List.map (\( _, tagger ) -> Platform.sendToApp router (tagger name)) 299 | in 300 | Task.sequence sends 301 | &> Task.succeed (updateSocket name (Connected socket) state) 302 | 303 | BadOpen name -> 304 | case Dict.get name state.sockets of 305 | Nothing -> 306 | Task.succeed state 307 | 308 | Just (Opening n _) -> 309 | retryConnection router n name state 310 | 311 | Just (Connected _) -> 312 | Task.succeed state 313 | 314 | 315 | retryConnection : 316 | Platform.Router msg Msg 317 | -> Int 318 | -> String 319 | -> State msg 320 | -> Task x (State msg) 321 | retryConnection router n name state = 322 | attemptOpen router (n + 1) name 323 | |> Task.andThen (\pid -> Task.succeed (updateSocket name (Opening (n + 1) pid) state)) 324 | 325 | 326 | updateSocket : String -> Connection -> State msg -> State msg 327 | updateSocket name connection state = 328 | { state | sockets = Dict.insert name connection state.sockets } 329 | 330 | 331 | 332 | -- OPENING WEBSOCKETS WITH EXPONENTIAL BACKOFF 333 | 334 | 335 | attemptOpen : Platform.Router msg Msg -> Int -> String -> Task x Process.Id 336 | attemptOpen router backoff name = 337 | let 338 | goodOpen ws = 339 | Platform.sendToSelf router (GoodOpen name ws) 340 | 341 | badOpen _ = 342 | Platform.sendToSelf router (BadOpen name) 343 | 344 | actuallyAttemptOpen = 345 | open name router 346 | |> Task.andThen goodOpen 347 | |> Task.onError badOpen 348 | in 349 | Process.spawn (after backoff &> actuallyAttemptOpen) 350 | 351 | 352 | open : String -> Platform.Router msg Msg -> Task WS.BadOpen WS.WebSocket 353 | open name router = 354 | WS.open name 355 | { onMessage = \_ msg -> Platform.sendToSelf router (Receive name msg) 356 | , onClose = \details -> Platform.sendToSelf router (Die name) 357 | } 358 | 359 | 360 | after : Int -> Task x () 361 | after backoff = 362 | if backoff < 1 then 363 | Task.succeed () 364 | else 365 | Process.sleep (toFloat (10 * 2 ^ backoff)) 366 | 367 | 368 | 369 | -- CLOSE CONNECTIONS 370 | 371 | 372 | closeConnection : Connection -> Task x () 373 | closeConnection connection = 374 | case connection of 375 | Opening _ pid -> 376 | Process.kill pid 377 | 378 | Connected socket -> 379 | WS.close socket 380 | -------------------------------------------------------------------------------- /src/WebSocket/LowLevel.elm: -------------------------------------------------------------------------------- 1 | module WebSocket.LowLevel 2 | exposing 3 | ( BadClose(..) 4 | , BadOpen(..) 5 | , BadSend(..) 6 | , Settings 7 | , WebSocket 8 | , bytesQueued 9 | , close 10 | , closeWith 11 | , open 12 | , send 13 | ) 14 | 15 | {-| Low-level bindings to [the JavaScript API for web sockets][ws]. This is 16 | useful primarily for making effect modules like . So 17 | if you happen to be the creator of Elixir’s Phoenix framework, and you want 18 | it to be super easy to use channels, this module will help you make a really 19 | nice subscription-based API. If you are someone else, you probably do not want 20 | these things. 21 | 22 | [ws]: https://developer.mozilla.org/en-US/docs/Web/API/WebSocket 23 | 24 | 25 | # WebSockets 26 | 27 | @docs WebSocket 28 | 29 | 30 | # Using WebSockets 31 | 32 | @docs open, Settings, send, close, closeWith, bytesQueued 33 | 34 | 35 | # Errors 36 | 37 | @docs BadOpen, BadClose, BadSend 38 | 39 | -} 40 | 41 | import Native.WebSocket 42 | import Task exposing (Task) 43 | 44 | 45 | {-| A value representing an open connection to a server. Normally every single 46 | HTTP request must establish a connection with the server, but here we just set 47 | it up once and keep using it. This means it is faster to send messages. 48 | 49 | There is a request/response pattern for all HTTP requests. Client asks for 50 | something, server gives some response. With websockets, you can drive messages 51 | from the server instead. 52 | 53 | -} 54 | type WebSocket 55 | = WebSocket 56 | 57 | 58 | {-| Attempt to open a connection to a particular URL. 59 | -} 60 | open : String -> Settings -> Task BadOpen WebSocket 61 | open = 62 | Native.WebSocket.open 63 | 64 | 65 | {-| The settings describe how a `WebSocket` works as long as it is still open. 66 | 67 | The `onMessage` function gives you access to (1) the `WebSocket` itself so you 68 | can use functions like `send` and `close` and (2) the `Message` from the server 69 | so you can decide what to do next. 70 | 71 | The `onClose` function tells you everything about why the `WebSocket` is 72 | closing. There are a ton of codes with standardized meanings, so learn more 73 | about them [here](https://developer.mozilla.org/en-US/docs/Web/API/CloseEvent). 74 | 75 | You will typically want to set up a channel before opening a WebSocket. That 76 | way the `onMessage` and `onClose` can communicate with the other parts of your 77 | program. **Ideally this is handled by the effect library you are using though. 78 | Most people should not be working with this stuff directly.** 79 | 80 | -} 81 | type alias Settings = 82 | { onMessage : WebSocket -> String -> Task Never () 83 | , onClose : { code : Int, reason : String, wasClean : Bool } -> Task Never () 84 | } 85 | 86 | 87 | {-| Opening the websocket went wrong because: 88 | 89 | 1. Maybe you are on an `https://` domain trying to use an `ws://` websocket 90 | instead of `wss://`. 91 | 92 | 2. You gave an invalid URL or something crazy. 93 | 94 | -} 95 | type BadOpen 96 | = BadSecurity 97 | | BadArgs 98 | 99 | 100 | {-| Close a `WebSocket`. If the connection is already closed, it does nothing. 101 | -} 102 | close : WebSocket -> Task x () 103 | close socket = 104 | Task.map 105 | (always ()) 106 | (closeWith 1000 "" socket) 107 | 108 | 109 | {-| Closes the `WebSocket`. If the connection is already closed, it does nothing. 110 | 111 | In addition to providing the `WebSocket` you want to close, you must provide: 112 | 113 | 1. A status code explaining why the connection is being closed. The default 114 | value is 1000, indicating indicates a normal "transaction complete" closure. 115 | There are a ton of different status codes though. See them all 116 | [here](https://developer.mozilla.org/en-US/docs/Web/API/CloseEvent). 117 | 118 | 2. A human-readable string explaining why the connection is closing. This 119 | string must be no longer than 123 bytes of UTF-8 text (not characters). 120 | 121 | -} 122 | closeWith : Int -> String -> WebSocket -> Task x (Maybe BadClose) 123 | closeWith = 124 | Native.WebSocket.close 125 | 126 | 127 | {-| It is possible to provide invalid codes or reasons for closing a 128 | connection. The connection will still be closed, but the `closeWith` function 129 | will give you `BadCode` if an invalid code was specified or `BadReason` if your 130 | reason is too long or contains unpaired surrogates. 131 | -} 132 | type BadClose 133 | = BadCode 134 | | BadReason 135 | 136 | 137 | {-| Send a string over the `WebSocket` to the server. If there is any problem 138 | with the send, you will get some data about it as the result of running this 139 | task. 140 | -} 141 | send : WebSocket -> String -> Task x (Maybe BadSend) 142 | send = 143 | Native.WebSocket.send 144 | 145 | 146 | {-| There are a few ways a send can go wrong. The send function will ultimately 147 | give you a `NotOpen` if the connection is no longer open or a `BadString` if 148 | the string has unpaired surrogates (badly formatted UTF-16). 149 | -} 150 | type BadSend 151 | = NotOpen 152 | | BadString 153 | 154 | 155 | {-| The number of bytes of data queued by `send` but not yet transmitted to the 156 | network. If you have been sending data to a closed connection, it will just 157 | pile up on the queue endlessly. 158 | -} 159 | bytesQueued : WebSocket -> Task x Int 160 | bytesQueued = 161 | Native.WebSocket.bytesQueued 162 | -------------------------------------------------------------------------------- /webpack.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | entry: './index.js', 3 | 4 | output: { 5 | path: './dist', 6 | filename: 'index.js' 7 | }, 8 | 9 | resolve: { 10 | modulesDirectories: ['node_modules'], 11 | extensions: ['', '.js', '.elm'] 12 | }, 13 | 14 | module: { 15 | loaders: [ 16 | { 17 | test: /\.html$/, 18 | exclude: /node_modules/, 19 | loader: 'file?name=[name].[ext]' 20 | }, 21 | { 22 | test: /\.elm$/, 23 | exclude: [/elm-stuff/, /node_modules/, /Stylesheets\.elm$/], 24 | loader: 'elm-webpack' 25 | }, 26 | { 27 | test: /Stylesheets\.elm$/, 28 | loader: "style!css!elm-css-webpack" 29 | } 30 | ] 31 | }, 32 | 33 | target: 'web', 34 | 35 | devServer: { 36 | inline: true, 37 | stats: 'errors-only' 38 | } 39 | }; --------------------------------------------------------------------------------