-
Notifications
You must be signed in to change notification settings - Fork 0
/
ReadSMB1.hs
180 lines (149 loc) · 6.5 KB
/
ReadSMB1.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
{-# LANGUAGE GADTs, LambdaCase, ScopedTypeVariables #-}
module ReadSMB1 (readSMB1) where
import Control.Applicative
import Control.Monad.Reader
import Control.Monad.Trans.Class
import Data.Maybe
import Data.Word
import System.Exit
import System.IO
import FloatStuff
import HexStuff
import Nat
import ReadCommon
import ReadMonad
import Types
import Vector
newtype LevelModelEntry = LevelModelEntry { getLevelModelEntry :: String }
newtype ReflectiveModelEntry = ReflectiveModelEntry { getReflectiveModelEntry :: String }
instance MyLength CollisionHeader where
myLength _ = 196
instance MyLength Goal where
myLength _ = 20
instance MyLength LevelModelEntry where
myLength _ = 12
instance MyLength ReflectiveModelEntry where
myLength _ = 8
instance MyLength AnimFrame where
myLength _ = 20
bytesToGoalType :: Vector Nat2 Char -> GoalType
bytesToGoalType (Cons '\x42' (Cons '\x00' Nil)) = BlueG
bytesToGoalType (Cons '\x47' (Cons '\x00' Nil)) = GreenG
bytesToGoalType (Cons '\x52' (Cons '\x00' Nil)) = RedG
bytesToGoalType _ = UnknownG
getGlobalOffsets :: ReadIO GlobalOffsets
getGlobalOffsets = absSeekThenDo 0 $
let
getOffsetAt r = seekThenChars r readWord
in pure GlobalOffsets
<*> getOffsetAt 0x1c
<*> getOffsetAt 0x2c
<*> getOffsetAt 0x34
<*> getOffsetAt 0x3c
<*> getOffsetAt 0x44
<*> getOffsetAt 0x4c
<*> getOffsetAt 0x54
<*> getOffsetAt 0x5c
<*> getOffsetAt 0x84
chasePointer :: Offset -> ReadIO a -> ReadIO a
chasePointer roff m = do
off <- seekThenChars roff readWord
-- liftIO $ hPutStrLn stderr $ "Maximum overdrive to " ++ show (Hex off)
absSeekThenDo off m
chasePointerNullable :: Offset -> ReadIO a -> ReadIO (Maybe a)
chasePointerNullable roff m = do
seekThenChars roff readWord >>= \case
0x0 -> do
-- liftIO $ hPutStrLn stderr $ "Encountered null, not jumping"
return Nothing
off -> do
-- liftIO $ hPutStrLn stderr $ "Maximum overdrive to " ++ show (Hex off)
Just <$> absSeekThenDo off m
chaseListGivenLength :: Offset -> Integer -> ReadIO a -> ReadIO [a]
chaseListGivenLength loff len m = do
(num,noff) <- seekThenChars loff (liftA2 (,) readWord readWord)
-- liftIO $ hPutStrLn stderr $ "Maximum overdrive to " ++ show (Hex noff)
forM (take num $ [0,len..]) $
\off2 -> absSeekThenDo (noff+off2) m
chaseListPointer :: forall a . MyLength a => Offset -> ReadIO a -> ReadIO [a]
chaseListPointer loff m = chaseListGivenLength loff (myLength (undefined :: a)) m
chaseListSimple :: Int -> Offset -> Integer -> ReadIO a -> ReadIO [a]
chaseListSimple num loff len m = do
noff <- seekThenChars loff readWord
-- liftIO $ hPutStrLn stderr $ "Maximum overdrive to " ++ show (Hex noff)
forM (take num $ [0,len..]) $
\off2 -> absSeekThenDo (noff+off2) m
readGoal :: CharIO Goal
readGoal = pure Goal
<*> readChars
<*> (bytesToGoalType <$> readChars)
readString :: CharIO String
readString = readChar >>= \case
'\0' -> return []
c -> fmap (c:) readString
readListOffset :: Offset -> CharIO ListOffset
readListOffset initOffset = pure ListOffset
<*> readWord
<*> fmap (\off -> off - initOffset) readWord
chaseAndReadTriIndexList :: ReadIO [Word16]
chaseAndReadTriIndexList = fmap (maybe [] id) $ chasePointerNullable 0x0 $ syncThenChars $
fix $ \loop -> readHalf >>= \case
0xffff -> return []
ind -> (ind:) <$> loop
readCollisionHeader :: GlobalOffsets -> ReadIO CollisionHeader
readCollisionHeader (GlobalOffsets off1 off2 off3 off4 off5 off6 off7 off8 off9) = do
-- Calculate triangle stuff
numTriLists <- seekThenChars 0x34 $ pure (*) <*> readWord <*> readWord
triIndexLists <- chaseListSimple numTriLists 0x20 0x4 chaseAndReadTriIndexList
let numTris = fromIntegral $ maximum $ (0:) $ map (+1) $ concat triIndexLists -- map (+1) is where it is to handle null case
tris <- chaseListSimple numTris 0x1c (myLength (undefined :: Triangle)) $ syncThenChars readChars
pure CollisionHeader
<*> seekThenChars 0x0 (liftM3 (,,) readFloat readFloat readFloat)
<*> seekThenChars 0xc (liftM3 (,,) readHalf readHalf readHalf)
<*> seekThenChars 0x12 readHalf
<*> fmap (maybe (AnimData [] [] [] [] [] []) id) (chasePointerNullable 0x14 readAnimHeader)
<*> fmap (maybe 0 id) (chasePointerNullable 0x14 getAnimLoopTime)
<*> pure tris
<*> pure triIndexLists
<*> seekThenChars 0x24 readChars
<*> seekThenChars 0x3c (readListOffset off1) -- Goals
<*> seekThenChars 0x4c (readListOffset off2) -- Bumpers
<*> seekThenChars 0x54 (readListOffset off3) -- Jamabars
<*> seekThenChars 0x5c (readListOffset off4) -- Bananas
<*> seekThenChars 0x64 (readListOffset off5) -- Cones
<*> seekThenChars 0x6c (readListOffset off6) -- Spheres
<*> seekThenChars 0x74 (readListOffset off7) -- Cylinders
<*> seekThenChars 0x7c (readListOffset off8) -- Level Models
<*> seekThenChars 0x8c (readListOffset off9) -- Reflective Models. docs seem to imply it should be 0xa4, but that's wrong
readAnimFrame :: CharIO AnimFrame
readAnimFrame = liftM4 AnimFrame readChars readFloat readFloat readChars
traverseAnimHeader :: (a -> a -> a -> a -> a -> a -> b) -> (Offset -> ReadIO a) -> ReadIO b
traverseAnimHeader f k =
pure f
<*> k 0
<*> k 8
<*> k 16
<*> k 24
<*> k 32
<*> k 40
readAnimHeader = traverseAnimHeader AnimData $ flip chaseListPointer (syncThenChars readAnimFrame)
getAnimLoopTime = traverseAnimHeader mex act
where
act loff = chaseListGivenLength loff 0x14 $ fmap hexToFloat $ seekThenChars 0x4 readWord
mex l1 l2 l3 l4 l5 l6 = maximum $ (0:) $ l1 ++ l2 ++ l3 ++ l4 ++ l5 ++ l6
readSMB1 :: ReadIO LZData
readSMB1 =
getGlobalOffsets >>= \globalOffsets -> absSeekThenDo 0x0 $
pure LZData
<*> chaseListPointer 0x8 (readCollisionHeader globalOffsets)
<*> chasePointer 0x10 (syncThenChars readChars)
<*> chasePointer 0x14 (syncThenChars readChars)
<*> chaseListPointer 0x18 (syncThenChars readGoal)
<*> chaseListPointer 0x28 (syncThenChars readChars) -- bumpears
<*> chaseListPointer 0x30 (syncThenChars readChars) -- jamabears
<*> chaseListPointer 0x38 (syncThenChars readChars) -- BA NA NA
<*> chaseListPointer 0x40 (syncThenChars readChars) -- Cones
<*> chaseListPointer 0x48 (syncThenChars readChars) -- Spheres
<*> chaseListPointer 0x50 (syncThenChars readChars) -- Cylinders
<*> fmap (map getLevelModelEntry) (chaseListPointer 0x58 $ fmap LevelModelEntry $ chasePointer 0x4 (syncThenChars readString))
<*> fmap (map getReflectiveModelEntry) (chaseListPointer 0x80 $ fmap ReflectiveModelEntry $ chasePointer 0x0 (syncThenChars readString))