module Stunts.Loader where import Control.Applicative import Control.Monad import Data.Binary as B import Data.Binary.Get as B import Data.Bits import qualified Data.ByteString as SB import qualified Data.ByteString.Char8 as SB8 import qualified Data.ByteString.Lazy as LB import Data.Int import Data.IntMap (Key) import qualified Data.IntMap as IM import Data.List import qualified Data.Map as M import qualified Data.Vector as V import Stunts.Color getString :: Int -> Get String getString = fmap (SB8.unpack . SB8.takeWhile (/= '\0')) . getByteString getWord :: Get Word32 getWord = getWord32le getUByte :: Get Word8 getUByte = B.get :: Get Word8 getInt8 :: Get Int getInt8 = fromIntegral <$> getUByte :: Get Int getInt16' :: Get Int16 getInt16' = fromIntegral <$> getWord16le :: Get Int16 getInt16 :: Get Int getInt16 = fromIntegral <$> getInt16' :: Get Int getInt' :: Get Int32 getInt' = fromIntegral <$> getWord32le :: Get Int32 getInt :: Get Int getInt = fromIntegral <$> getInt' :: Get Int data PrimitiveType = Particle | Line | Polygon | Sphere | Wheel | Ignored deriving (Eq,Ord,Show) data Primitive = Primitive { prType :: PrimitiveType , prTwoSided :: Bool , prZBias :: Bool , prMaterials :: [Int] , prIndices :: [Int] } deriving Show data Model = Model { mdVertices :: [(Float,Float,Float)] , mdPrimitives :: [Primitive] } deriving Show getVertex :: Get (Float, Float, Float) getVertex = do x <- getInt16 y <- getInt16 z <- getInt16 let aspectCorrection = 1 -- 6.0/5.0 f = fromIntegral :: Int -> Float y' = aspectCorrection * f y return (f x,y',-f z) getPrimitive :: Int -> Get Primitive getPrimitive numPaintJobs = do let convertType c | c == 1 = (1,Particle) | c == 2 = (2,Line) | 3 <= c && c <= 10 = (c,Polygon) | c == 11 = (2,Sphere) | c == 12 = (6,Wheel) | otherwise = (0,Ignored) (cnt,ptype) <- convertType <$> getInt8 (twosided,zbias) <- (\i -> (testBit i 0,testBit i 1)) <$> getUByte materials <- replicateM numPaintJobs getInt8 indices <- replicateM cnt getInt8 return $ Primitive ptype twosided zbias materials indices getModel :: Get Model getModel = do numVertices <- getInt8 numPrimitives <- getInt8 numPaintJobs <- getInt8 getInt8 vertices <- replicateM numVertices getVertex _cullFront <- replicateM numPrimitives getWord _cullBack <- replicateM numPrimitives getWord primitives <- replicateM numPrimitives (getPrimitive numPaintJobs) return $ Model vertices primitives getResources :: Get [(String, LB.ByteString)] getResources = do _fileLength <- getInt numResources <- getInt16 ids' <- replicateM numResources $ getString 4 offsets' <- map fromIntegral <$> replicateM numResources getInt dat <- getRemainingLazyByteString let (ids,offsets) = unzip $ sortBy (\(_,a) (_,b) -> compare a b) $ zip ids' offsets' lens = snd $ foldl' (\(p,l) o -> (o,(p-o):l)) ((LB.length dat),[]) $ reverse offsets return [(i,LB.take l $ LB.drop o dat) | (i,o,l) <- zip3 ids offsets lens] readResources :: LB.ByteString -> M.Map String LB.ByteString readResources dat = M.fromList $ runGet getResources dat -- bitmap data Bitmap = Bitmap { width :: Int , height :: Int , positionX :: Int , positionY :: Int , image :: SB.ByteString -- RGB data } {- uint16 width uint16 height uint16 unknown1[2] uint16 positionX uint16 positionY uint8 unknown2[4] uint8 image[width * height] -} getBitmap :: Get Bitmap getBitmap = do width <- getInt16 height <- getInt16 getInt16 getInt16 positionX <- getInt16 positionY <- getInt16 getInt8 getInt8 getInt8 getInt8 image <- replicateM (width * height) ((vgaPal IM.!) <$> getInt8) return $ Bitmap width height positionX positionY $ SB.pack $ concat image data Car = Car -- Number of gears. { gears :: Int -- The gear ratios are overall values, representing the effects both the gearbox -- and the final drive gears as well as those of the wheel radius. -- car_speed_mph = 256*engine_speed_rpm/gear_ratio , gearRatios :: [Int] -- Every byte navigated forward corresponds to increments of 128rpm, -- so that byte 61h covers 0...127rpm; 62h, 128...255rpm and so on -- There are 103 bytes in total, and so the engine can deliver power over a range of 13184rpm. , torqueCurve :: [Int] -- The main function of the parameter is to define up to which rpm value -- the "idle rpm torque" will be used instead of the regular torque curve for the second gear and above. , idleRpm :: Int -- This may be thought as a special point in the torque curve. -- It overrides a section of the curve at low rpms, -- in order to better represent the car launch from a standstill. , idleRpmTorque :: Int -- This is the downshift rpm point used by the automatic transmission. , downshiftRpm :: Int -- This is the upshift rpm point used by the automatic transmission. , upshiftRpm :: Int -- This parameter is the maximum rpm (the "redline") of the engine. , maxRpm :: Int -- Car mass. , mass :: Int -- Tells how powerful the car brakes will be. , braking :: Int -- This elusive parameter controls aerodynamic resistance encountered by the car when accelerating down a straight. , aeroResistance :: Int -- This is the primary handling parameter. Higher values make it possible to take corners at higher speeds without skidding, -- and thus raise cornering speeds as well as lower the risk of loss of control -- (at the rather small cost of making controlled sliding harder, which sometimes can be an inconvenience in competition racing). , grip :: Int -- These values are responsible for modifying the car grip according to the kind of surface it is on. -- The four integer values correspond to the four kinds of surface of Stunts -- asphalt, dirt, ice and grass, in that order. , surfaceGrip :: [Int] -- These four integers set half-width, height and two half-length values for the car. -- These are only used for the detection of car-car collisions. , collision :: [Int] -- The first triplet corresponds to the front/left wheel; -- the other three stand for the remaining ones, ordered clockwise. , wheelPos :: [(Int,Int,Int)] -- graphical properties , cockpitHeight :: Int -- This sets the apparent height from the ground on the inside (F1) view. , shiftingKnobPos :: [(Int,Int)] -- shifting knob coordinates , steeringDot :: [(Int,Int)] -- 1+33 pairs -- , speedometerNeedle :: [(Int,Int)] , digitalSpeedometer :: [(Int,Int)] -- , revMeterNeedle :: [(Int,Int)] -- text properties -- , infoText :: String -- , scoreboardName :: String } getCar :: Get Car getCar = do let pos i g = lookAhead $ do skip i g gears <- pos 0x26 getInt8 mass <- pos 0x28 getInt16 braking <- pos 0x2A getInt16 idleRpm <- pos 0x2C getInt16 downshiftRpm <- pos 0x2E getInt16 upshiftRpm <- pos 0x30 getInt16 maxRpm <- pos 0x32 getInt16 gearRatios <- pos 0x36 (replicateM 6 getInt16) shiftingKnobPos <- pos 0x44 (replicateM 6 ((,) <$> getInt16 <*> getInt16)) aeroResistance <- pos 0x5D getInt16 idleRpmTorque <- pos 0x60 getInt16 torqueCurve <- pos 0x61 (replicateM 105 getInt8) grip <- pos 0xCA getInt16 surfaceGrip <- pos 0xDC (replicateM 4 getInt16) collision <- pos 0xEE (replicateM 4 getInt16) cockpitHeight <- pos 0xF6 getInt16 wheelPos <- pos 0xF8 (replicateM 4 ((,,) <$> getInt16 <*> getInt16 <*> getInt16)) steeringDot <- pos 0x110 (replicateM 34 ((,) <$> getInt8 <*> getInt8)) -- speedometerNeedle <- pos 0x14E (replicateM 34 ((,) <$> getInt8 <*> getInt8) digitalSpeedometer <- pos 0x154 (replicateM 3 ((,) <$> getInt8 <*> getInt8)) return $ Car { gears = gears , gearRatios = gearRatios , torqueCurve = torqueCurve , idleRpm = idleRpm , idleRpmTorque = idleRpmTorque , downshiftRpm = downshiftRpm , upshiftRpm = upshiftRpm , maxRpm = maxRpm , mass = mass , braking = braking , aeroResistance = aeroResistance , grip = grip , surfaceGrip = surfaceGrip , collision = collision , wheelPos = wheelPos , cockpitHeight = cockpitHeight , shiftingKnobPos = shiftingKnobPos , steeringDot = steeringDot , digitalSpeedometer = digitalSpeedometer } {- opponent data: - files: sdosel.pvs (bitmaps) opp0 - opp6 : opponent portraits (opp0 is actually the chronometer for the time trial option) scrn clip opponent animations: opp?win.pvs, opp?lose.pvs - bitmaps op01 - op08 : the actual number of frames within a file varies from 3 to 8 opp?.pre winn, lose - Each byte in these NULL-terminated resources is a numerical index to the op01 ... op08 bitmaps, and the overall sequence is the succession of frames. sped - Opponent performance path - (186 bytes) numerical data resource which function is not yet understood. -} {- data OpponentData = OpponentData { screen :: Bitmap , clip :: Bitmap , opponents :: [Opponent] } data Opponent = Opponent { avatar :: Bitmap , winAnim :: [Bitmap] , looseAnim :: [Bitmap] , speed :: OpponentPerformance } data OpponentPerformance = OpponentPerformance { road :: Int3 -- paved, dirt and icy road , smallCorner :: Int3 -- paved, dirt and icy small corner , largeCorner :: Int3 -- paved, dirt and icy large corner , bankedCorner :: Int , bridge :: Int , slalom :: Int , corkUpDown :: Int , chicane :: Int , loop :: Int , corkLeftRight :: Int } get3Int8 :: Get (Int, Int, Int) get3Int8 = (,,) <$> getInt8 <*> getInt8 <*> getInt8 getOpponentPerformance :: Get OpponentPerformance getOpponentPerformance = OpponentPerformance <$> get3Int8 <*> get3Int8 <*> get3Int8 <*> getInt8 <*> getInt8 <*> getInt8 <*> getInt8 <*> getInt8 <*> getInt8 <*> getInt8 -} readTrack :: SB8.ByteString -> ([(Int, Int, Int, Bool)], [(Key, Int, Int, Bool)]) readTrack dat = (filter filterTerrainItem (idx (@/)), mapTrackItem =<< idx (@=)) where trkData = map fromEnum (SB.unpack dat) idx sel = [(sel x y,x,y,x @/ y == 0x06) | y <- [0..29], x <- [0..29]] x @/ y = V.fromList ter V.! (y*30+x) x @= y = V.fromList trk V.! ((29-y)*30+x) (trk,_:ter) = splitAt 900 trkData roadV = [0x04,0x0E,0x18] roadH = [0x05,0x0F,0x19] map07 = IM.fromList $ [(i,0x67) | i <- [0x27,0x3B,0x62]] ++ zip roadV [0xD0,0xD4,0xD8] map09 = IM.fromList $ [(i,0x67) | i <- [0x26,0x3A,0x61]] ++ zip roadV [0xD2,0xD6,0xDA] map08 = IM.fromList $ [(i,0x68) | i <- [0x24,0x38,0x5F]] ++ zip roadH [0xD1,0xD5,0xD9] map0A = IM.fromList $ [(i,0x68) | i <- [0x25,0x39,0x60]] ++ zip roadH [0xD3,0xD7,0xDB] mapTrackItem i@(c,x,y,e) -- remove filler elements | elem c [0x00,0xFE,0xFD,0xFF] = [] -- this is composed from two elements | c == 0x65 = [(0x67,x,y,e),(0x05,x,y,e)] | c == 0x66 = [(0x68,x,y,e),(0x04,x,y,e)] -- ramp on brae is replaced with elevated road | x @/ y == 0x07 && IM.member c map07 = [(map07 IM.! c,x,y,e)] | x @/ y == 0x09 && IM.member c map09 = [(map09 IM.! c,x,y,e)] | x @/ y == 0x08 && IM.member c map08 = [(map08 IM.! c,x,y,e)] | x @/ y == 0x0A && IM.member c map0A = [(map0A IM.! c,x,y,e)] | otherwise = [i] filterTerrainItem (c,x,y,_) | elem c [0x07,0x09] && elem (x @= y) roadV = False | elem c [0x08,0x0A] && elem (x @= y) roadH = False | otherwise = True