-- | This module defines the structure of a TI-85 variable file.
module Data.TI85.File.Variable (
    -- * Types
    TIVar(..),
    TIVarData(..),
    VarField(..),
    VarType(..),
    -- * Utilities
    idToType,
    typeToId,
    showType
    ) where

import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.Word (Word8,Word16)

-- | The structure of a single variable.
-- For the meaning of variable IDs, see `idToType`.
data TIVar = TIVar {
    TIVar -> Word16
varOffset :: Word16,
    TIVar -> Word16
varLen :: Word16,
    TIVar -> Word8
varId :: Word8,
    TIVar -> Word8
varNameLen :: Word8,
    TIVar -> ByteString
varName :: ByteString,
    TIVar -> Word16
varDataLen :: Word16,
    TIVar -> ByteString
varData :: ByteString
    } deriving Int -> TIVar -> ShowS
[TIVar] -> ShowS
TIVar -> String
(Int -> TIVar -> ShowS)
-> (TIVar -> String) -> ([TIVar] -> ShowS) -> Show TIVar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TIVar -> ShowS
showsPrec :: Int -> TIVar -> ShowS
$cshow :: TIVar -> String
show :: TIVar -> String
$cshowList :: [TIVar] -> ShowS
showList :: [TIVar] -> ShowS
Show

-- | The contents of a variable file (minus standard
-- header and checksum).
newtype TIVarData = TIVarData {
    TIVarData -> [TIVar]
varsData :: [TIVar]
    } deriving Int -> TIVarData -> ShowS
[TIVarData] -> ShowS
TIVarData -> String
(Int -> TIVarData -> ShowS)
-> (TIVarData -> String)
-> ([TIVarData] -> ShowS)
-> Show TIVarData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TIVarData -> ShowS
showsPrec :: Int -> TIVarData -> ShowS
$cshow :: TIVarData -> String
show :: TIVarData -> String
$cshowList :: [TIVarData] -> ShowS
showList :: [TIVarData] -> ShowS
Show

-- | Scalar values can either be real or complex.
-- Likewise, vectors, lists, etc can contain values
-- of either.
data VarField = VarReal | VarComplex deriving Int -> VarField -> ShowS
[VarField] -> ShowS
VarField -> String
(Int -> VarField -> ShowS)
-> (VarField -> String) -> ([VarField] -> ShowS) -> Show VarField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarField -> ShowS
showsPrec :: Int -> VarField -> ShowS
$cshow :: VarField -> String
show :: VarField -> String
$cshowList :: [VarField] -> ShowS
showList :: [VarField] -> ShowS
Show

-- | Possible variable types.
-- See also `Data.TI85.Var.Variable`.
data VarType = VarUnknown
    | VarValue VarField
    | VarVector VarField
    | VarList VarField
    | VarMatrix VarField
    | VarConstant VarField
    | VarEquation
    | VarString
    | VarGDBFunc
    | VarGDBPolar
    | VarGDBParam
    | VarGDBDiff
    | VarPicture
    | VarProgram
    | VarDirectory
    | VarSettingsFunc
    | VarSettingsPolar
    | VarSettingsParam
    | VarSettingsDiff
    | VarSavedWinSize
    | VarMemory
    deriving Int -> VarType -> ShowS
[VarType] -> ShowS
VarType -> String
(Int -> VarType -> ShowS)
-> (VarType -> String) -> ([VarType] -> ShowS) -> Show VarType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarType -> ShowS
showsPrec :: Int -> VarType -> ShowS
$cshow :: VarType -> String
show :: VarType -> String
$cshowList :: [VarType] -> ShowS
showList :: [VarType] -> ShowS
Show

-- | Convert the variable ID word from
-- a variable file into its type.
-- From https://www.ticalc.org/pub/text/calcinfo/ti86prot.txt:
--
-- +---------+-------------------+
-- | Type ID | Description       |
-- +=========+===================+
-- |      00 | Real Number       |
-- +---------+-------------------+
-- |      01 | Complex Number    |
-- +---------+-------------------+
-- |      02 | Real Vector       |
-- +---------+-------------------+
-- |      03 | Complex Vector    |
-- +---------+-------------------+
-- |      04 | Real List         |
-- +---------+-------------------+
-- |      05 | Complex List      |
-- +---------+-------------------+
-- |      06 | Real Matrix       |
-- +---------+-------------------+
-- |      07 | Complex Matrix    |
-- +---------+-------------------+
-- |      08 | Real Constant     |
-- +---------+-------------------+
-- |      09 | Complex Constant  |
-- +---------+-------------------+
-- |      0A | Equation          |
-- +---------+-------------------+
-- |      0C | String            |
-- +---------+-------------------+
-- |      0D | Function GDB      |
-- +---------+-------------------+
-- |      0E | Polar GDB         |
-- +---------+-------------------+
-- |      0F | Parametric GDB    |
-- +---------+-------------------+
-- |      10 | Differential      |
-- |         | Equation GDB      |
-- +---------+-------------------+
-- |      11 | Picture           |
-- +---------+-------------------+
-- |      12 | Program           |
-- +---------+-------------------+
-- |      15 | Directory (only   |
-- |         | used when         |
-- |         | requesting dir)   |
-- +---------+-------------------+
-- |      17 | Function Window   |
-- |         | Settings          |
-- +---------+-------------------+
-- |      18 | Polar Window      |
-- |         | Settings          |
-- +---------+-------------------+
-- |      19 | Parametric Window |
-- |         | Settings          |
-- +---------+-------------------+
-- |      1A | Differential      |
-- |         | Equation Window   |
-- |         | Settings          |
-- +---------+-------------------+
-- |      1B | Saved Window Size |
-- |         | (ZRCL)            |
-- +---------+-------------------+
-- |      1D | Memory backup     |
-- +---------+-------------------+
-- |      1E | Unknown (only used|
-- |         | when requesting   |
-- |         | var)              |
-- +---------+-------------------+
--
idToType :: Word8 -> VarType
idToType :: Word8 -> VarType
idToType Word8
0x00 = VarField -> VarType
VarValue VarField
VarReal
idToType Word8
0x01 = VarField -> VarType
VarValue VarField
VarComplex
idToType Word8
0x02 = VarField -> VarType
VarVector VarField
VarReal
idToType Word8
0x03 = VarField -> VarType
VarVector VarField
VarComplex
idToType Word8
0x04 = VarField -> VarType
VarList VarField
VarReal
idToType Word8
0x05 = VarField -> VarType
VarList VarField
VarComplex
idToType Word8
0x06 = VarField -> VarType
VarMatrix VarField
VarReal
idToType Word8
0x07 = VarField -> VarType
VarMatrix VarField
VarComplex
idToType Word8
0x08 = VarField -> VarType
VarConstant VarField
VarReal
idToType Word8
0x09 = VarField -> VarType
VarConstant VarField
VarComplex
idToType Word8
0x0a = VarType
VarEquation
idToType Word8
0x0c = VarType
VarString
idToType Word8
0x0d = VarType
VarGDBFunc
idToType Word8
0x0e = VarType
VarGDBPolar
idToType Word8
0x0f = VarType
VarGDBParam
idToType Word8
0x10 = VarType
VarGDBDiff
idToType Word8
0x11 = VarType
VarPicture
idToType Word8
0x12 = VarType
VarProgram
idToType Word8
0x15 = VarType
VarDirectory
idToType Word8
0x17 = VarType
VarSettingsFunc
idToType Word8
0x18 = VarType
VarSettingsPolar
idToType Word8
0x19 = VarType
VarSettingsParam
idToType Word8
0x1a = VarType
VarSettingsDiff
idToType Word8
0x1b = VarType
VarSavedWinSize
idToType Word8
0x1d = VarType
VarMemory
idToType Word8
0x1e = VarType
VarUnknown
idToType Word8
_ = VarType
VarUnknown

-- | Convert the variable type into
-- its ID. See `idToType`.
typeToId :: VarType -> Word8
typeToId :: VarType -> Word8
typeToId (VarValue VarField
VarReal) = Word8
0x00
typeToId (VarValue VarField
VarComplex) = Word8
0x01
typeToId (VarVector VarField
VarReal) = Word8
0x02
typeToId (VarVector VarField
VarComplex) = Word8
0x03
typeToId (VarList VarField
VarReal) = Word8
0x04
typeToId (VarList VarField
VarComplex) = Word8
0x05
typeToId (VarMatrix VarField
VarReal) = Word8
0x06
typeToId (VarMatrix VarField
VarComplex) = Word8
0x07
typeToId (VarConstant VarField
VarReal) = Word8
0x08
typeToId (VarConstant VarField
VarComplex) = Word8
0x09
typeToId VarType
VarEquation = Word8
0x0a
typeToId VarType
VarString = Word8
0x0c
typeToId VarType
VarGDBFunc = Word8
0x0d
typeToId VarType
VarGDBPolar = Word8
0x0e
typeToId VarType
VarGDBParam = Word8
0x0f
typeToId VarType
VarGDBDiff = Word8
0x10
typeToId VarType
VarPicture = Word8
0x11
typeToId VarType
VarProgram = Word8
0x12
typeToId VarType
VarDirectory = Word8
0x15
typeToId VarType
VarSettingsFunc = Word8
0x17
typeToId VarType
VarSettingsPolar = Word8
0x18
typeToId VarType
VarSettingsParam = Word8
0x19
typeToId VarType
VarSettingsDiff = Word8
0x1a
typeToId VarType
VarSavedWinSize = Word8
0x1b
typeToId VarType
VarMemory = Word8
0x1d
typeToId VarType
VarUnknown = Word8
0x1e


-- | Convert a variable type to
-- its textual representation.
showType :: VarType -> Text
showType :: VarType -> Text
showType VarType
VarUnknown = Text
"Unknown"
showType (VarValue VarField
VarReal) = Text
"Real Value"
showType (VarValue VarField
VarComplex) = Text
"Complex Value"
showType (VarVector VarField
VarReal) = Text
"Real Vector"
showType (VarVector VarField
VarComplex) = Text
"Complex Vector"
showType (VarList VarField
VarReal) = Text
"Real List"
showType (VarList VarField
VarComplex) = Text
"Complex List"
showType (VarMatrix VarField
VarReal) = Text
"Real Matrix"
showType (VarMatrix VarField
VarComplex) = Text
"Complex Matrix"
showType (VarConstant VarField
VarReal) = Text
"Real Constant"
showType (VarConstant VarField
VarComplex) = Text
"Complex Constant"
showType VarType
VarEquation = Text
"Equation"
showType VarType
VarString = Text
"String"
showType VarType
VarGDBFunc = Text
"Function GDB"
showType VarType
VarGDBPolar = Text
"Polar GDB"
showType VarType
VarGDBParam = Text
"Parametric GDB"
showType VarType
VarGDBDiff = Text
"Differential Equation GDB"
showType VarType
VarPicture = Text
"Picture"
showType VarType
VarProgram = Text
"Program"
showType VarType
VarDirectory = Text
"Directory"
showType VarType
VarSettingsFunc = Text
"Function Settings"
showType VarType
VarSettingsPolar = Text
"Polar Settings"
showType VarType
VarSettingsParam = Text
"Parametric Settings"
showType VarType
VarSettingsDiff = Text
"Differential Equation Settings"
showType VarType
VarSavedWinSize = Text
"Saved Window Size"
showType VarType
VarMemory = Text
"Memory Backup"