mirror of
https://github.com/dpiponi/Stellarator.git
synced 2024-06-01 02:37:48 -04:00
RESMPn during hblank sets missile pos to 68+2
This commit is contained in:
Dan Piponi
parent
ec00feff54
commit
2a70b9645c
|
|
@ -27,20 +27,20 @@ address8 :: Word8 -> String
|
|||
address8 x =
|
||||
if isTIA (fromIntegral x)
|
||||
then inHex8 x ++ case (x .&. 0x3f) of
|
||||
0x00 -> "; VSYNC"
|
||||
0x01 -> "; VBLANK"
|
||||
0x02 -> "; WSYNC"
|
||||
0x03 -> "; RSYNC"
|
||||
0x04 -> "; NUSIZ0"
|
||||
0x05 -> "; NUSIZ1"
|
||||
0x06 -> "; COLUP0"
|
||||
0x07 -> "; COLUP1"
|
||||
0x08 -> "; COLUPF"
|
||||
0x09 -> "; COLUBK"
|
||||
0x0a -> "; CTRLPF"
|
||||
0x0b -> "; REFP0"
|
||||
0x0c -> "; REFP1"
|
||||
0x0d -> "; PF0"
|
||||
0x00 -> "; VSYNC or CXM0P"
|
||||
0x01 -> "; VBLANK or CXM1P"
|
||||
0x02 -> "; WSYNC or CXP0FB"
|
||||
0x03 -> "; RSYNC or CXP1FB"
|
||||
0x04 -> "; NUSIZ0 or CXM0FB"
|
||||
0x05 -> "; NUSIZ1 or CXM1FB"
|
||||
0x06 -> "; COLUP0 or CXBLPF"
|
||||
0x07 -> "; COLUP1 or CXPPMM"
|
||||
0x08 -> "; COLUPF or INPT0"
|
||||
0x09 -> "; COLUBK or INPT1"
|
||||
0x0a -> "; CTRLPF or INPT2"
|
||||
0x0b -> "; REFP0 or INPT3"
|
||||
0x0c -> "; REFP1 or INPT4"
|
||||
0x0d -> "; PF0 or INPT5"
|
||||
0x0e -> "; PF1"
|
||||
0x0f -> "; PF2"
|
||||
0x10 -> "; RESP0"
|
||||
|
|
|
|||
|
|
@ -120,6 +120,7 @@ stellaHmove = do
|
|||
modify s_mpos1 $ \mpos1' -> wrap160 (mpos1'-clockMove moffset1)
|
||||
|
||||
boffset <- load hmbl
|
||||
bpos' <- load s_bpos
|
||||
modify s_bpos $ \bpos' -> wrap160 (bpos'-clockMove boffset)
|
||||
|
||||
{-
|
||||
|
|
@ -541,7 +542,7 @@ writeStella addr v = do
|
|||
0x11 -> graphicsDelay 5 >> load hpos >>= store s_ppos1 -- RESP1
|
||||
0x12 -> graphicsDelay 4 >> load hpos >>= store s_mpos0 -- RESM0
|
||||
0x13 -> graphicsDelay 4 >> load hpos >>= store s_mpos1 -- RESM1
|
||||
0x14 -> graphicsDelay 4 >> load hpos >>= store s_bpos -- RESBL
|
||||
0x14 -> graphicsDelay 4 >> load hpos >>= (return . max (picx+2)) >>= store s_bpos -- RESBL
|
||||
0x1b -> do -- GRP0
|
||||
store newGrp0 v
|
||||
load newGrp1 >>= store oldGrp1
|
||||
|
|
|
|||
|
|
@ -2,9 +2,11 @@ module TIAColors where
|
|||
|
||||
import Data.Array.Unboxed
|
||||
import Data.Word
|
||||
import Data.Bits
|
||||
|
||||
{-
|
||||
- Extracted from https://en.wikipedia.org/wiki/Television_Interface_Adaptor
|
||||
- NTSC only
|
||||
-}
|
||||
lutList :: [Word32]
|
||||
lutList = [
|
||||
|
|
@ -30,3 +32,23 @@ lutList = [
|
|||
-- Remember to `shift` (-1) before lookup
|
||||
lut :: UArray Word8 Word32
|
||||
lut = listArray (0, 0x7f) lutList
|
||||
|
||||
colorName :: Word8 -> String
|
||||
colorName i = colorName' (i `shift` (-4)) where
|
||||
colorName' 0 = "black-grey"
|
||||
colorName' 1 = "brown-yellow"
|
||||
colorName' 2 = "rust-orange"
|
||||
colorName' 3 = "red-orange"
|
||||
colorName' 4 = "red-pink"
|
||||
colorName' 5 = "purple"
|
||||
colorName' 6 = "purple"
|
||||
colorName' 7 = "blue"
|
||||
colorName' 8 = "blue"
|
||||
colorName' 9 = "blue"
|
||||
colorName' 10 = "blue"
|
||||
colorName' 11 = "teal"
|
||||
colorName' 12 = "green"
|
||||
colorName' 13 = "green"
|
||||
colorName' 14 = "green"
|
||||
colorName' 15 = "brown-beige"
|
||||
colorName' _ = error "Impossible"
|
||||
|
|
|
|||
|
|
@ -56,12 +56,20 @@ dumpStella = do
|
|||
grp1' <- load oldGrp1
|
||||
liftIO $ putStrLn $ "GRP0 = " ++ showHex grp0' "" ++ "(" ++ inBinary 8 grp0' ++ ")"
|
||||
liftIO $ putStrLn $ "GRP1 = " ++ showHex grp1' "" ++ "(" ++ inBinary 8 grp1' ++ ")"
|
||||
ctrlpf' <- load ctrlpf
|
||||
liftIO $ putStrLn $ "CTRLPF = " ++ showHex ctrlpf' "" ++ ": " ++
|
||||
(if testBit ctrlpf' 0 then "reflected" else "not reflected") ++ ", " ++
|
||||
(if testBit ctrlpf' 1 then "score mode" else "not score mode") ++ ", " ++
|
||||
(if testBit ctrlpf' 2 then "playfield priority" else "player priority")
|
||||
liftIO $ putStrLn $ "ball size = " ++ show (1 `shift` fromIntegral ((ctrlpf' `shift` (-4)) .&. 3) :: Int)
|
||||
pf0' <- load pf0
|
||||
pf1' <- load pf1
|
||||
pf2' <- load pf2
|
||||
liftIO $ putStrLn $ "PF = " ++ reverse (inBinary 4 (pf0' `shift` (-4)))
|
||||
++ inBinary 8 pf1'
|
||||
++ reverse (inBinary 8 pf2')
|
||||
pf' <- load pf
|
||||
liftIO $ putStrLn $ inBinary 40 pf'
|
||||
nusiz0' <- load nusiz0
|
||||
nusiz1' <- load nusiz1
|
||||
liftIO $ putStrLn $ "NUSIZ0 = " ++ showHex nusiz0' "" ++ "(" ++ explainNusiz nusiz0' ++
|
||||
|
|
@ -75,16 +83,33 @@ dumpStella = do
|
|||
liftIO $ putStrLn $ " ENABL = " ++ show (enablOld, enablNew)
|
||||
mpos0' <- load s_mpos0
|
||||
mpos1' <- load s_mpos1
|
||||
ppos0' <- load s_ppos0
|
||||
ppos1' <- load s_ppos1
|
||||
bpos' <- load s_bpos
|
||||
hmm0' <- load hmm0
|
||||
hmm1' <- load hmm1
|
||||
hmp0' <- load hmp0
|
||||
hmp1' <- load hmp1
|
||||
hmbl' <- load hmbl
|
||||
liftIO $ putStr $ "missile0 @ " ++ show mpos0' ++ "(" ++ show (clockMove hmm0') ++ ")"
|
||||
liftIO $ putStrLn $ " missile1 @ " ++ show mpos1' ++ "(" ++ show (clockMove hmm1') ++ ")"
|
||||
liftIO $ putStr $ "player0 @ " ++ show ppos0' ++ "(" ++ show (clockMove hmp0') ++ ")"
|
||||
liftIO $ putStrLn $ " player1 @ " ++ show ppos1' ++ "(" ++ show (clockMove hmp1') ++ ")"
|
||||
liftIO $ putStrLn $ "ball @ " ++ show bpos' ++ "(" ++ show (clockMove hmbl') ++ ")"
|
||||
vdelp0' <- load delayP0
|
||||
vdelp1' <- load delayP1
|
||||
vdelbl' <- load delayBall
|
||||
liftIO $ putStrLn $ "VDELP0 = " ++ show vdelp0' ++ " " ++
|
||||
"VDELP1 = " ++ show vdelp1' ++ " " ++
|
||||
"VDELBL = " ++ show vdelbl'
|
||||
colubk' <- load colubk
|
||||
colupf' <- load colupf
|
||||
colup0' <- load colup0
|
||||
colup1' <- load colup1
|
||||
liftIO $ putStrLn $ "COLUBK = " ++ showHex colubk' "" ++ " " ++ colorName colubk'
|
||||
liftIO $ putStrLn $ "COLUPF = " ++ showHex colupf' "" ++ " " ++ colorName colupf'
|
||||
liftIO $ putStrLn $ "COLUP0 = " ++ showHex colup0' "" ++ " " ++ colorName colup0'
|
||||
liftIO $ putStrLn $ "COLUP1 = " ++ showHex colup1' "" ++ " " ++ colorName colup1'
|
||||
|
||||
{-# INLINABLE updatePos #-}
|
||||
updatePos :: Int -> Int -> (Int, Int)
|
||||
|
|
@ -161,6 +186,8 @@ ball delayBall' oldBall' newBall' ctrlpf' o = do
|
|||
missileSize :: Word8 -> Int
|
||||
missileSize nusiz = 1 `shift` (fromIntegral ((nusiz `shift` (-4)) .&. 0b11))
|
||||
|
||||
--
|
||||
-- Pri sco pf ball m0 m1 p0 p1 pixelx
|
||||
chooseColour :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Int -> TypedIndex Word8
|
||||
chooseColour True _ _ True _ _ _ _ _ = colupf
|
||||
chooseColour True True True False _ _ _ _ pixelx = if pixelx < 80 then colup0 else colup1
|
||||
|
|
@ -236,11 +263,24 @@ compositeAndCollide pixelx hpos' = do
|
|||
|
||||
doCollisions lplayfield lball lmissile0 lmissile1 lplayer0 lplayer1
|
||||
|
||||
load $ chooseColour (testBit ctrlpf' 2)
|
||||
(testBit ctrlpf' 1)
|
||||
let scoreMode = testBit ctrlpf' 1
|
||||
let playfieldPriority = testBit ctrlpf' 2
|
||||
z <- load $ chooseColour playfieldPriority
|
||||
scoreMode
|
||||
lplayfield lball
|
||||
lmissile0 lmissile1
|
||||
lplayer0 lplayer1 pixelx
|
||||
vpos' <- load vpos
|
||||
if vpos' == 174 && hpos' == 175
|
||||
then do
|
||||
return z
|
||||
{-
|
||||
liftIO $ print $ "lball = " ++ show lball
|
||||
liftIO $ print $ "scoreMode = " ++ show scoreMode
|
||||
liftIO $ print $ "z=" ++ show z
|
||||
return 0xff
|
||||
-}
|
||||
else return z
|
||||
|
||||
{-# INLINE stellaTick #-}
|
||||
stellaTick :: Int -> Ptr Word32 -> MonadAtari ()
|
||||
|
|
|
|||
Loading…
Reference in a new issue