fxpak-0.0.1: Interface to the FXPak/FXPak Pro USB interface
Copyright(c) Christina Wuest 2021
LicenseBSD-style
Maintainertina@wuest.me
Stabilityexperimental
Portabilitynon-portable
Safe HaskellSafe-Inferred
LanguageHaskell2010

FXPak

Description

Interface to working with the FXPak/FXPak Pro flash cart devices for the SNES/Super Famicom

Synopsis

Documentation

type FXPak = SerialPort Source #

An FXPak device (which is exposed as a serial device)

type Packet = Packet Source #

A packet representing a single complete to send to the FXPak

data Opcode o where Source #

The Opcode representing the command to perform

Constructors

Get :: Opcode (Opcode' 'Get)

Depending on context, either return the contents of a given file, or read memory

Put :: Opcode (Opcode' 'Put)

Depending on context, either allow the upload of a file, or write bytes to memory

VGet :: Opcode (Opcode' 'VGet)

Retrieve from 1-4 regions of memory

VPut :: Opcode (Opcode' 'VPut)

Write from 1-4 bytes to memory

List :: Opcode (Opcode' 'List)

List files in a given directory

Mkdir :: Opcode (Opcode' 'Mkdir)

Make a given directory on the FXPak's filesystem

Delete :: Opcode (Opcode' 'Delete)

Delete a given path on the FXPak's filesystem

Move :: Opcode (Opcode' 'Move)

Move a given path on the FXPak's filesystem to a new location

Reset :: Opcode (Opcode' 'Reset)

Reset the SNES/SFC

Boot :: Opcode (Opcode' 'Boot)

Boot a given file

PowerCycle :: Opcode (Opcode' 'PowerCycle)

Reset the SNES/SFC

Info :: Opcode (Opcode' 'Info)

Return information about the running FXPak

MenuReset :: Opcode (Opcode' 'MenuReset)

Reset the SNES/SFC, returning to the FXPak's main menu

Stream :: Opcode (Opcode' 'Stream) 
Time :: Opcode (Opcode' 'Time) 
Response :: Opcode (Opcode' 'Response)

Indicates a response packet

data Context c where Source #

The context in which a packet's command operates

Constructors

File :: Context (Context' 'File)

In the File mode, files can be managed directly, and booted

SNES :: Context (Context' 'SNES)

In the SNES context, bytes can be written to and read from memory, and all system commands (e.g. reset, powercycle, reset to menu, system info, and stream data) are passed through

MSU :: Context (Context' 'MSU) 
Config :: Context (Context' 'Config) 

data Arguments a where Source #

Arguments indicating the desired action taken by a given operation

Constructors

None :: Arguments (Arguments' 'None)

No arguments - valid only with the Reset, MenuReset, Info, Stream, and PowerCycle opcodes

Path :: FilePath -> Arguments (Arguments' ('Path (a :: FilePath)))

Path to a given object - valid for Get, List, Mkdir, Delete, and Boot in the File context

PathContents :: FilePath -> ByteString -> Arguments (Arguments' ('PathContents (a :: FilePath) (b :: ByteString)))

Path with an accompanying ByteString - valid only for Put in the File context

PathRename :: FilePath -> FilePath -> Arguments (Arguments' ('PathRename (a :: FilePath) a))

Source and destination paths - valid only for Move in the File context

GetBytes :: AddressGet -> Arguments (Arguments' ('GetBytes (a :: AddressGet)))

An address and length of data to be read for non-File context Get and VGet opcodes

GetBytes2 :: AddressGet -> AddressGet -> Arguments (Arguments' ('GetBytes2 (a :: (AddressGet, AddressGet))))

Two address/length pairs to be read for non-File context VGet

GetBytes3 :: AddressGet -> AddressGet -> AddressGet -> Arguments (Arguments' ('GetBytes3 (a :: (AddressGet, AddressGet, AddressGet))))

Three address/length pairs to be read for non-File context VGet

GetBytes4 :: AddressGet -> AddressGet -> AddressGet -> AddressGet -> Arguments (Arguments' ('GetBytes4 (a :: (AddressGet, AddressGet, AddressGet, AddressGet))))

Four address/length pairs to be read for non-File context VGet

SetByte :: AddressSet -> Arguments (Arguments' ('SetByte (a :: AddressSet)))

A target address and byte to be written for non-File context Put and VPut opcodes

SetByte2 :: AddressSet -> AddressSet -> Arguments (Arguments' ('SetByte2 (a :: (AddressSet, AddressSet))))

Two address/data pairs to be written for non-File context VPut

SetByte3 :: AddressSet -> AddressSet -> AddressSet -> Arguments (Arguments' ('SetByte3 (a :: (AddressSet, AddressSet, AddressSet))))

Three address/data pairs to be written for non-File context VPut

SetByte4 :: AddressSet -> AddressSet -> AddressSet -> AddressSet -> Arguments (Arguments' ('SetByte4 (a :: (AddressSet, AddressSet, AddressSet, AddressSet))))

Four address/data pairs to be written for non-File context VPut

data AddressGet Source #

Represents an address to fetch memory from and a length to read

Constructors

AddressGet 

Fields

Instances

Instances details
Show AddressGet Source # 
Instance details

Defined in FXPak.Internal

data AddressSet Source #

Represents a value and the address to which it should be written

Constructors

AddressSet 

Fields

Instances

Instances details
Show AddressSet Source # 
Instance details

Defined in FXPak.Internal

data Flag Source #

Flags to be encoded as a 1-byte bit map Note: No checking of flag validity is done in the original usb2snesw software and as such research into which combinations produce expected results is still underway

Instances

Instances details
Bounded Flag Source # 
Instance details

Defined in FXPak.Internal

Enum Flag Source # 
Instance details

Defined in FXPak.Internal

Methods

succ :: Flag -> Flag #

pred :: Flag -> Flag #

toEnum :: Int -> Flag #

fromEnum :: Flag -> Int #

enumFrom :: Flag -> [Flag] #

enumFromThen :: Flag -> Flag -> [Flag] #

enumFromTo :: Flag -> Flag -> [Flag] #

enumFromThenTo :: Flag -> Flag -> Flag -> [Flag] #

Eq Flag Source # 
Instance details

Defined in FXPak.Internal

Methods

(==) :: Flag -> Flag -> Bool #

(/=) :: Flag -> Flag -> Bool #

Show Flag Source # 
Instance details

Defined in FXPak.Internal

Methods

showsPrec :: Int -> Flag -> ShowS #

show :: Flag -> String #

showList :: [Flag] -> ShowS #

type Flags = Flags Source #

List of Flags to be encoded for a given packet

open :: FilePath -> IO FXPak Source #

Open a given serial device as an FXPak

packet :: ValidPacket c o a ~ 'True => Context (Context' c) -> Opcode (Opcode' o) -> Flags -> Arguments (Arguments' a) -> Packet Source #

Encode a packet to send to an FXPak, preventing encoding of invalid packets

send :: FXPak -> Packet -> IO (Maybe ByteString) Source #

Sends a given packet to an FXPak device, returning a ByteString if a response is expected