-- | As a kind of object file or byte code, TI-85 programs can be -- represented as list of tokens. -- -- The contents of this module describe the possible tokens, and a way -- to convert from byte to token. module Data.TI85.Token where import Data.Word import Data.Array.Unboxed (Array, array) import Data.Text (Text) -- | There are several types of tokens. Most come -- with some instructions for what do to with the -- bytes following the token. data TokenDef = Invalid | Fixed Text -- ^ Representation of specific text | QuoteText -- ^ Quoted string | NameLength -- ^ A string specified by length | FixedLength Int -- ^ A fixed-length string | Extended -- ^ Look up the next token in the extended token table | Conversion -- ^ Unit conversion | Literal -- ^ Literal value, represented as text | Label -- ^ Lbl, with a text label | Goto -- ^ Goto, with a text label deriving Show -- | Mapping from byte to TokenDef. tokenTable :: Array Word8 TokenDef tokenTable = array (0x00,0xff) [ (0x00, Invalid), (0x01, Fixed "▸Rec"), (0x02, Fixed "▸Pol"), (0x03, Fixed "▸Cyl"), (0x04, Fixed "▸Sph"), (0x05, Fixed "▸DMS"), (0x06, Fixed "▸Bin"), (0x07, Fixed "▸Hex"), (0x08, Fixed "▸Oct"), (0x09, Fixed "▸Dec"), (0x0A, Fixed "▸Frac"), (0x0B, Fixed "→"), (0x0C, Fixed "["), (0x0D, Fixed "]"), (0x0E, Fixed "{"), (0x0F, Fixed "}"), (0x10, Fixed "("), (0x11, Fixed ")"), (0x12, Fixed "round"), (0x13, Fixed "max"), (0x14, Fixed "min"), (0x15, Fixed "mod"), (0x16, Fixed "cross"), (0x17, Fixed "dot"), (0x18, Fixed "aug"), (0x19, Fixed "rSwap"), (0x1A, Fixed "rAdd"), (0x1B, Fixed "multR"), (0x1C, Fixed "mRAdd"), (0x1D, Fixed "sub"), (0x1E, Fixed "lcm"), (0x1F, Fixed "gcd"), (0x20, Fixed "simult"), (0x21, Fixed "inter"), (0x22, Fixed "pEval"), (0x23, Fixed "randM"), (0x24, Fixed "seq"), (0x25, Fixed "evalF"), (0x26, Fixed "fnInt"), (0x27, Fixed "arc"), (0x28, Fixed "fMin"), (0x29, Fixed "fMax"), (0x2A, Fixed "der1"), (0x2B, Fixed "der2"), (0x2C, Fixed "nDer"), (0x2D, QuoteText), (0x2E, Fixed "∠"), (0x2F, Fixed ","), (0x30, Fixed " or "), (0x31, Fixed " xor "), (0x32, NameLength), (0x33, FixedLength 1), (0x34, FixedLength 2), (0x35, FixedLength 3), (0x36, FixedLength 4), (0x37, FixedLength 5), (0x38, FixedLength 6), (0x39, FixedLength 7), (0x3A, FixedLength 8), (0x3B, NameLength), (0x3C, NameLength), (0x3D, Extended), (0x3E, Conversion), (0x3F, Fixed "="), (0x40, Fixed " and "), (0x41, Fixed "rand"), (0x42, Fixed "π"), (0x43, Fixed "getKy"), (0x44, Literal), (0x45, Fixed "%"), (0x46, Fixed "!"), (0x47, Fixed "ʳ"), (0x48, Fixed "°"), (0x49, Fixed "⁻¹"), (0x4A, Fixed "²"), (0x4B, Fixed "ᵀ"), (0x4C, Fixed "Menu"), (0x4D, Fixed "P2Reg"), (0x4E, Fixed "P3Reg"), (0x4F, Fixed "P4Reg"), (0x50, Fixed "=="), (0x51, Fixed "<"), (0x52, Fixed ">"), (0x53, Fixed "<="), (0x54, Fixed ">="), (0x55, Fixed "≠"), (0x56, Fixed "Radian"), (0x57, Fixed "Degree"), (0x58, Fixed "Normal"), (0x59, Fixed "Sci"), (0x5A, Fixed "Eng"), (0x5B, Fixed "Float"), (0x5C, Fixed "Fix"), (0x5D, Fixed "RectV"), (0x5E, Fixed "CylV"), (0x5F, Fixed "SphereV"), (0x60, Fixed "+"), (0x61, Fixed "-"), (0x62, Fixed "Func"), (0x63, Fixed "Param"), (0x64, Fixed "Pol"), (0x65, Fixed "DifEq"), (0x66, Fixed "Bin"), (0x67, Fixed "Oct"), (0x68, Fixed "Hex"), (0x69, Fixed "Dec"), (0x6A, Fixed "RectC"), (0x6B, Fixed "PolarC"), (0x6C, Fixed "dxDer1"), (0x6D, Fixed "dxNDer"), (0x6E, Fixed ":"), (0x6F, Fixed "\n"), (0x70, Fixed "*"), (0x71, Fixed "/"), (0x72, Fixed "SeqG"), (0x73, Fixed "SimulG"), (0x74, Fixed "PolarGC"), (0x75, Fixed "RectGC"), (0x76, Fixed "CoordOn"), (0x77, Fixed "CoordOff"), (0x78, Fixed "DrawLine"), (0x79, Fixed "DrawDot"), (0x7A, Fixed "AxesOn"), (0x7B, Fixed "AxesOff"), (0x7C, Fixed "GridOn"), (0x7D, Fixed "GridOff"), (0x7E, Fixed "LabelOn"), (0x7F, Fixed "LabelOff"), (0x80, Fixed "nPr"), (0x81, Fixed "nCr"), (0x82, Fixed "Trace"), (0x83, Fixed "ClDrw"), (0x84, Fixed "ZStd"), (0x85, Fixed "ZTrig"), (0x86, Fixed "ZFit"), (0x87, Fixed "ZIn"), (0x88, Fixed "ZOut"), (0x89, Fixed "ZSqr"), (0x8A, Fixed "ZInt"), (0x8B, Fixed "ZPrev"), (0x8C, Fixed "ZDecm"), (0x8D, Fixed "ZRcl"), (0x8E, Fixed "PrtScrn"), (0x8F, Fixed "DrawF"), (0x90, Fixed "FnOn "), (0x91, Fixed "FnOff "), (0x92, Fixed "StPic"), (0x93, Fixed "RcPic"), (0x94, Fixed "StGDB"), (0x95, Fixed "RcGDB"), (0x96, Fixed "Line"), (0x97, Fixed "Vert"), (0x98, Fixed "PtOn"), (0x99, Fixed "PtOff"), (0x9A, Fixed "PtChg"), (0x9B, Fixed "Shade"), (0x9C, Fixed "Circl"), (0x9D, Fixed "Axes"), (0x9E, Fixed "TanLn"), (0x9F, Fixed "DrInv"), (0xA0, Fixed "√"), (0xA1, Fixed "-"), (0xA2, Fixed "abs"), (0xA3, Fixed "iPart"), (0xA4, Fixed "fPart"), (0xA5, Fixed "int"), (0xA6, Fixed "ln"), (0xA7, Fixed "e^"), (0xA8, Fixed "log"), (0xA9, Fixed "10^"), (0xAA, Fixed "sin "), (0xAB, Fixed "sin⁻¹ "), (0xAC, Fixed "cos "), (0xAD, Fixed "cos⁻¹ "), (0xAE, Fixed "tan "), (0xAF, Fixed "tan⁻¹ "), (0xB0, Fixed "sinh "), (0xB1, Fixed "sinh⁻¹ "), (0xB2, Fixed "cosh "), (0xB3, Fixed "cosh⁻¹ "), (0xB4, Fixed "tanh "), (0xB5, Fixed "tanh⁻¹ "), (0xB6, Fixed "sign "), (0xB7, Fixed "det "), (0xB8, Fixed "ident"), (0xB9, Fixed "unitV"), (0xBA, Fixed "norm"), (0xBB, Fixed "rnorm"), (0xBC, Fixed "cnorm"), (0xBD, Fixed "ref"), (0xBE, Fixed "rref"), (0xBF, Fixed "dim"), (0xC0, Fixed "dimL"), (0xC1, Fixed "sum"), (0xC2, Fixed "prod"), (0xC3, Fixed "sortA"), (0xC4, Fixed "sortD"), (0xC5, Fixed "li▸vc"), (0xC6, Fixed "vc▸li"), (0xC7, Fixed "lngth"), (0xC8, Fixed "conj"), (0xC9, Fixed "real"), (0xCA, Fixed "imag"), (0xCB, Fixed "angle"), (0xCC, Fixed "not"), (0xCD, Fixed "rotR"), (0xCE, Fixed "rotL"), (0xCF, Fixed "shftR"), (0xD0, Fixed "shftL"), (0xD1, Fixed "eigVl"), (0xD2, Fixed "eigVc"), (0xD3, Fixed "cond"), (0xD4, Fixed "poly"), (0xD5, Fixed "fcstx"), (0xD6, Fixed "fcsty"), (0xD7, Fixed "eval "), (0xD8, Fixed "If "), (0xD9, Fixed "Then"), (0xDA, Fixed "Else"), (0xDB, Fixed "While "), (0xDC, Fixed "Repeat "), (0xDD, Fixed "For"), (0xDE, Fixed "End"), (0xDF, Fixed "Return"), (0xE0, Label), (0xE1, Goto), (0xE2, Fixed "Pause"), (0xE3, Fixed "Stop"), (0xE4, Fixed "IS>"), (0xE5, Fixed "DS<"), (0xE6, Fixed "Input "), (0xE7, Fixed "Prompt "), (0xE8, Fixed "InpSt "), (0xE9, Fixed "Disp "), (0xEA, Fixed "DispG"), (0xEB, Fixed "Outpt"), (0xEC, Fixed "ClLCD"), (0xED, Fixed "Eq▸St"), (0xEE, Fixed "St▸Eq"), (0xEF, Fixed "Fill"), (0xF0, Fixed "^"), (0xF1, Fixed "ˣ√"), (0xF2, Fixed "Solver"), (0xF3, Fixed "OneVar"), (0xF4, Fixed "LinR"), (0xF5, Fixed "ExpR"), (0xF6, Fixed "LnR"), (0xF7, Fixed "PwrR"), (0xF8, Fixed "ShwSt"), (0xF9, Fixed "Hist"), (0xFA, Fixed "xyLine"), (0xFB, Fixed "Scatter"), (0xFC, Fixed "SortX"), (0xFD, Fixed "SortY"), (0xFE, Fixed "LU"), (0xFF, Invalid) ] -- | Extended table of tokens. -- When the token is 'Extended' this table -- is used to look up the final token. tokenTableExtended :: Array Word8 TokenDef tokenTableExtended = array (0x00,0x35) [ (0x00, Fixed "zxScl"), (0x01, Fixed "zyScl"), (0x02, Fixed "xScl"), (0x03, Fixed "yScl"), (0x04, Fixed "xMin"), (0x05, Fixed "xMax"), (0x06, Fixed "yMin"), (0x07, Fixed "yMax"), (0x08, Fixed "tMin"), (0x09, Fixed "tMax"), (0x0a, Fixed "tStep"), (0x0b, Fixed "θStep"), (0x0c, Fixed "ztStep"), (0x0d, Fixed "zθStep"), (0x0e, Fixed "tPlot"), (0x0f, Fixed "θMin"), (0x10, Fixed "θMax"), (0x11, Fixed "zxMin"), (0x12, Fixed "zxMax"), (0x13, Fixed "zyMin"), (0x14, Fixed "zyMax"), (0x15, Fixed "ztPlot"), (0x16, Fixed "zθMin"), (0x17, Fixed "zθMax"), (0x18, Fixed "ztMin"), (0x19, Fixed "ztMax"), (0x1a, Fixed "lower"), (0x1b, Fixed "upper"), (0x1c, Fixed "Δx"), (0x1d, Fixed "Δy"), (0x1e, Fixed "xFact"), (0x1f, Fixed "yFact"), (0x20, Fixed "difTol"), (0x21, Fixed "tol"), (0x22, Fixed "δ"), (0x23, Fixed "Na"), (0x24, Fixed "k"), (0x25, Fixed "Cc"), (0x26, Fixed "ec"), (0x27, Fixed "Rc"), (0x28, Fixed "Gc"), (0x29, Fixed "g"), (0x2a, Fixed "Me"), (0x2b, Fixed "Mp"), (0x2c, Fixed "Mn"), (0x2d, Fixed "µ0"), (0x2e, Fixed "ε0"), (0x2f, Fixed "h"), (0x30, Fixed "c"), (0x31, Fixed "u"), (0x32, Fixed "e"), (0x33, Fixed "xStat"), (0x34, Fixed "yStat"), (0x35, Fixed "Plot") ]