Emulation/Stellarator
1
0
Fork 0
mirror of https://github.com/dpiponi/Stellarator.git synced 2024-05-16 19:10:42 -04:00
Code Issues Packages Projects Releases Wiki Activity

hlint suggestions

Browse source
This commit is contained in:
Dan Piponi 2020-09-29 16:04:20 -07:00
parent 65924a7f60
commit d8d9b0f698
13 changed files with 189 additions and 118 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
app/Main.hs
View file

@ -10,17 +10,18 @@
module Main where
import Atari2600
import Binary
( useStellaClock, with2600, Atari2600, MonadAtari )
import Binary ( readBinary )
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Control.Monad.Reader
import Data.Array.IO
import Data.Array.IO ( IOUArray, MArray(newArray) )
#if TRACE
import Data.Array.Storable
#endif
import Data.Binary hiding (get)
import Debugger
import Debugger ( runDebugger )
import Delays
import Display
import Emulation
@ -107,11 +108,11 @@ main = do
let Just atariKeys = keysFromOptions options'
rc <- init -- init video
when (not rc) $ die "Couldn't init graphics"
unless rc $ die "Couldn't init graphics"
queue <- newTQueueIO
window <- makeMainWindow screenScale'
setKeyCallback window (Just $ keyCallback queue)
void $ setWindowCloseCallback window $ Just $ \_ -> exitSuccess
void $ setWindowCloseCallback window $ Just $ const exitSuccess
state <- startingState args' options' window

2
src/Binary.hs
View file

@ -32,7 +32,7 @@ readBinary arr filename origin = do
forM_ (zip [0..] contents) $ \(i, c) ->
writeArray arr (i+fromIntegral origin) (BS.c2w c)
let blankPage = all (== (toEnum 0)) $ take 256 contents
let blankPage = all (== toEnum 0) $ take 256 contents
case romSize of
0x1000 -> return UnBanked
0x2000 -> return $ if blankPage then ModeF8SC else ModeF8

10
src/BitManips.hs
View file

@ -20,19 +20,19 @@ reverseTable = listArray (0, 0xff) $ map slowReverse [0..0xff :: Word8]
assemblePlayFieldFwd :: Word8 -> Word8 -> Word8 -> Word64
assemblePlayFieldFwd pf0 pf1 pf2 = (fromIntegral pf0 `shift` (-4)) .|.
((fromIntegral (reverseTable!pf1)) `shift` 4) .|.
(fromIntegral (reverseTable!pf1) `shift` 4) .|.
(fromIntegral pf2 `shift` 12) .|.
(fromIntegral (pf0 .&. 0xf0) `shift` 16) .|.
((fromIntegral (reverseTable!pf1)) `shift` 24) .|.
(fromIntegral (reverseTable!pf1) `shift` 24) .|.
(fromIntegral pf2 `shift` 32)
assemblePlayFieldRev :: Word8 -> Word8 -> Word8 -> Word64
assemblePlayFieldRev pf0 pf1 pf2 = (fromIntegral pf0 `shift` (-4)) .|.
((fromIntegral (reverseTable!pf1)) `shift` 4) .|.
(fromIntegral (reverseTable!pf1) `shift` 4) .|.
(fromIntegral pf2 `shift` 12) .|.
((fromIntegral (reverseTable!pf0)) `shift` 36) .|.
(fromIntegral (reverseTable!pf0) `shift` 36) .|.
(fromIntegral pf1 `shift` 28) .|.
((fromIntegral (reverseTable!pf2)) `shift` 20)
(fromIntegral (reverseTable!pf2) `shift` 20)
assemblePlayfield :: Bool -> Word8 -> Word8 -> Word8 -> Word64
assemblePlayfield False = assemblePlayFieldFwd

4
src/DebugCmd.hs
View file

@ -59,7 +59,7 @@ parseCommands:: ParsecT String u Identity Command
parseCommands = Block <$> semiSep1 lexer parseCommand
parseCommand :: ParsecT String u Identity Command
parseCommand = Block <$> (braces lexer $ semiSep1 lexer parseCommand)
parseCommand = Block <$> braces lexer (semiSep1 lexer parseCommand)
<|> (char 'c' >> whiteSpace lexer >> return Cont)
<|> (char 'g' >> whiteSpace lexer >> return DumpGraphics)
<|> (char 's' >> whiteSpace lexer >> return Step)
@ -128,7 +128,7 @@ table = [ [prefix "-" Neg, prefix "+" id,
]
binary :: String -> (a -> a -> a) -> Assoc -> Operator String u Identity a
binary name fun assoc = Infix (do{ reservedOp lexer name; return fun }) assoc
binary name fun = Infix (do { reservedOp lexer name; return fun })
prefix :: String -> (a -> a) -> Operator String u Data.Functor.Identity.Identity a
prefix name fun = Prefix (do{ reservedOp lexer name; return fun })
postfix :: String -> (a -> a) -> Operator String u Data.Functor.Identity.Identity a

1
src/Delays.hs
View file

@ -4,6 +4,7 @@ import Data.Word
delayList :: [(Word16, Int)]
delayList = [
#if 1
-- My figures
(0x00, 0), -- VSYNC

38
src/Display.hs
View file

@ -4,15 +4,15 @@
{-# LANGUAGE OverloadedStrings #-}
module Display where
import Control.Monad
import Data.Array.Unboxed
import Data.Bits
import Data.Word
import Metrics
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import System.Exit
import Control.Monad ( forM_, unless )
import Data.Array.Unboxed ( (!) )
import Data.Bits ( Bits(shift) )
import Data.Word ( Word8, Word32 )
import Metrics ( screenWidth, screenHeight )
import Foreign.Marshal.Alloc ( mallocBytes )
import Foreign.Ptr ( Ptr )
import Foreign.Storable ( Storable(pokeElemOff) )
import System.Exit ( die )
import System.Exit (exitFailure)
import System.IO
@ -42,7 +42,7 @@ createImageTexture texName = do
textureData <- mallocBytes (fromIntegral $ screenWidth*screenHeight) :: IO (Ptr Word8)
forM_ [0..screenHeight-1] $ \i ->
forM_ [0..screenWidth-1] $ \j -> do
forM_ [0..screenWidth-1] $ \j ->
pokeElemOff textureData (fromIntegral $ screenWidth*i+j) 0
GL.textureBinding GL.Texture2D $= Just texName
@ -67,7 +67,7 @@ createLUTTexture :: GL.TextureObject -> IO ()
createLUTTexture texName = do
textureData2 <- mallocBytes (4*256) :: IO (Ptr Word32)
forM_ [0..255] $ \i ->
pokeElemOff textureData2 (fromIntegral $ i) (fromIntegral $ lut!(i `shift` (-1)))
pokeElemOff textureData2 (fromIntegral i) (fromIntegral $ lut!(i `shift` (-1)))
GL.textureBinding GL.Texture1D $= Just texName
@ -114,15 +114,17 @@ createShaderProgram = do
GL.attribLocation program "coord2d" $= GL.AttribLocation 0
GL.linkProgram program
linkOK <- GL.get $ GL.linkStatus program
checkProgram linkOK "GL.linkProgram error" program
return program
unless linkOK $ do
hPutStrLn stderr "GL.linkProgram error"
checkProgram :: Bool -> String -> GL.Program -> IO ()
checkProgram ok msg program =
unless ok $ do
hPutStrLn stderr msg
plog <- GL.get $ GL.programInfoLog program
putStrLn plog
exitFailure
return program
-- | Bind textures to appropriate locations in shader program.
connectProgramToTextures :: GL.Program -> Float ->
GL.TextureObject -> GL.TextureObject -> GL.TextureObject -> IO ()
@ -153,11 +155,7 @@ connectProgramToTextures program alpha current_frame_tex last_frame_tex lut_tex
GL.validateProgram program
status <- GL.get $ GL.validateStatus program
unless status $ do
hPutStrLn stderr "GL.linkProgram error"
plog <- GL.get $ GL.programInfoLog program
putStrLn plog
exitFailure
checkProgram status "GL.validateProgram error" program
GL.currentProgram $= Just program
-- | Create all OpenGL objects required including shaders and textures.

170
src/Emulation.hs
View file

@ -7,7 +7,80 @@
module Emulation where
import Asm hiding (a, s)
import Asm
( Reg(store, load),
oldGrp0,
oldGrp1,
newGrp0,
newGrp1,
vsync,
nusiz0,
nusiz1,
colup0,
colup1,
colupf,
colubk,
ctrlpf,
refp0,
refp1,
pf0,
pf1,
pf2,
enam0,
enam1,
hmp0,
hmp1,
hmm0,
hmm1,
hmbl,
resmp0,
resmp1,
inpt0,
inpt1,
inpt2,
inpt3,
inpt4,
inpt5,
swcha,
swacnt,
swchb,
maxWord8,
delayP0,
delayP1,
delayBall,
oldBall,
newBall,
kbd,
maxBool,
maxWord64,
hpos,
vpos,
ppos0,
ppos1,
mpos0,
mpos1,
bpos,
xbreak,
ybreak,
maxInt,
pc,
pcStep,
pcResp0,
pcResp1,
pcResm0,
pcResm1,
pcResbl,
pcColup0,
pcColup1,
pcColupf,
pcColubk,
pcPf0,
pcPf1,
pcPf2,
maxWord16,
st,
(@=),
(@->) )
import Atari2600
import Control.Lens hiding (set, op, index)
import Control.Monad.Reader
@ -159,7 +232,13 @@ writeAbs src = do
writeMemoryTick addr src
addPC 2
-- 6 clock cycles
writeMemoryIndexed :: Word16 -> Word8 -> Word8 ->MonadAtari ()
writeMemoryIndexed addr index src = do
let (halfAddrY, addrY) = halfSum addr index
discard $ readMemoryTick halfAddrY
writeMemoryTick addrY src
-- 6 clock cycles
-- {-# INLINABLE writeIndY #-}
writeIndY :: Word8 -> MonadAtari ()
writeIndY src = do
@ -167,24 +246,22 @@ writeIndY src = do
addr' <- fetchByteTick
addr <- read16zpTick addr'
let (halfAddrY, addrY) = halfSum addr index
discard $ readMemoryTick halfAddrY
writeMemoryTick addrY src
writeMemoryIndexed addr index src
incPC
zeroPageXAddr :: MonadAtari Word8
zeroPageXAddr = do
index <- getX
addr <- fetchByteTick
discard $ readZpTick addr
return (addr + index)
-- 4 clock cycles
-- {-# INLINABLE writeZeroPageX #-}
writeZeroPageX :: Word8 -> MonadAtari ()
writeZeroPageX src = do
index <- getX
addr <- fetchByteTick
discard $ readZpTick addr
writeMemoryTick (i16 $ addr+index) src -- writezp
addr <- zeroPageXAddr
writeMemoryTick (i16 addr) src -- writezp
incPC
-- 4 clock cycles
@ -206,10 +283,7 @@ writeAbsY src = do
index <- getY
addr <- getPC >>= read16tick
let (halfAddrY, addrY) = halfSum addr index
discard $ readMemoryTick halfAddrY
writeMemoryTick addrY src
writeMemoryIndexed addr index src
addPC 2
-- 5 clock cycles
@ -272,13 +346,9 @@ readIndY = do
-- {-# INLINABLE readZeroPageX #-}
readZeroPageX :: MonadAtari Word8
readZeroPageX = do
index <- getX
addr <- fetchByteTick
discard $ readZpTick addr -- wraps
addr <- zeroPageXAddr
incPC
readZpTick (addr+index) -- wraps
readZpTick addr -- wraps
-- 4 clock cycles
-- {-# INLINABLE readZeroPageY #-}
@ -363,10 +433,9 @@ jmp = getPC >>= read16tick >>= putPC
-- Not correct here.
-- Looks like the torture test might not catch this.
-- Aha! That's why ALIGN is used before addresses!
-- {-# INLINABLE jmp_indirect #-}
jmp_indirect :: MonadAtari ()
jmp_indirect = do
getPC >>= read16tick >>= read16tick >>= putPC
-- {-# INLINABLE jmpIndirect #-}
jmpIndirect :: MonadAtari ()
jmpIndirect = getPC >>= read16tick >>= read16tick >>= putPC
-- {-# INLINABLE uselessly #-}
uselessly :: m () -> m ()
@ -460,7 +529,7 @@ withAbsY op = do
-- {-# INLINABLE brk #-}
brk :: MonadAtari ()
brk = do
discard $ fetchByteTick
discard fetchByteTick
incPC
p1 <- getPC
@ -483,9 +552,7 @@ brk = do
irq :: MonadAtari ()
irq = do
fi <- getI
if not fi
then nmi False
else return ()
when (not fi) $ nmi False
-- {-# INLINABLE pushTick #-}
pushTick :: Word8 -> MonadAtari ()
@ -582,6 +649,12 @@ nmi sw = do
read16 0xfffe >>= putPC -- irq/brk XXX
tick 7
spinTOS :: MonadAtari ()
spinTOS = do
tick 1
s <- getS
discard $ readMemory (0x100 + fromIntegral s)
-- 6 clock cycles
-- {-# INLINABLE rti #-}
rti :: MonadAtari ()
@ -590,9 +663,7 @@ rti = do
p0 <- getPC
void $ readMemory p0
tick 1
s <- getS
discard $ readMemory (0x100 + fromIntegral s)
spinTOS
tick 1
pull >>= putP
@ -608,9 +679,7 @@ jsr = do
pcl <- readMemory p0
incPC
tick 1
s <- getS
discard $ readMemory (0x100 + fromIntegral s)
spinTOS
p2 <- getPC
@ -625,12 +694,16 @@ jsr = do
putPC $ make16 pcl pch
spinInstruction :: MonadAtari ()
spinInstruction = do
tick 1
discard $ getPC >>= readMemory
-- 6 clock cycles
-- {-# INLINABLE rts #-}
rts :: MonadAtari ()
rts = do
tick 1
discard $ getPC >>= readMemory
spinInstruction
tick 1
s <- getS
@ -645,7 +718,7 @@ rts = do
makeDelayArray:: [(Word16, Int)] -> IO (IOUArray Word16 Int)
makeDelayArray delayList = do
delayArray <- newArray (0, 0x2c) 0
forM_ delayList $ \(addr, d) -> writeArray delayArray addr d
forM_ delayList $ uncurry (writeArray delayArray)
return delayArray
initState :: (Int, Int) -> Int -> Int ->
@ -887,12 +960,12 @@ dumpMemory = do
b0 <- readMemory regPC
b1 <- readMemory (regPC+1)
b2 <- readMemory (regPC+2)
liftIO $ putStr $ "(PC) = "
liftIO $ putStr "(PC) = "
liftIO $ putStr $ showHex b0 "" ++ " "
liftIO $ putStr $ showHex b1 "" ++ " "
liftIO $ putStrLn $ showHex b2 ""
let (_, mne, _) = disasm regPC [b0, b1, b2]
liftIO $ putStrLn $ mne
liftIO $ putStrLn mne
-- {-# INLINABLE dumpRegisters #-}
dumpRegisters :: MonadAtari ()
@ -904,10 +977,10 @@ dumpRegisters = do
putStr $ " flags = " ++ showHex regP ""
putStr $ "(N=" ++ showHex ((regP `shift` (-7)) .&. 1) ""
putStr $ ",V=" ++ showHex ((regP `shift` (-6)) .&. 1) ""
putStr $ ",B=" ++ showHex (regP `shift` ((-4)) .&. 1) ""
putStr $ ",D=" ++ showHex (regP `shift` ((-3)) .&. 1) ""
putStr $ ",I=" ++ showHex (regP `shift` ((-2)) .&. 1) ""
putStr $ ",Z=" ++ showHex (regP `shift` ((-1)) .&. 1) ""
putStr $ ",B=" ++ showHex (regP `shift` (-4) .&. 1) ""
putStr $ ",D=" ++ showHex (regP `shift` (-3) .&. 1) ""
putStr $ ",I=" ++ showHex (regP `shift` (-2) .&. 1) ""
putStr $ ",Z=" ++ showHex (regP `shift` (-1) .&. 1) ""
putStr $ ",C=" ++ showHex (regP .&. 1) ""
regA <- getA
liftIO $ putStr $ ") A = " ++ showHex regA ""
@ -1045,8 +1118,7 @@ writeStella addr v = do
0x2a -> stellaHmove -- HMOVE
0x2b -> stellaHmclr -- HMCLR
0x2c -> stellaCxclr -- CXCLR
0x280 -> do
swcha @= v -- XXX just added
0x280 -> swcha @= v -- XXX just added
0x281 -> swacnt @= v
0x294 -> startIntervalTimerN 1 v
0x295 -> startIntervalTimerN 8 v

10
src/Events.hs
View file

@ -24,14 +24,14 @@ import System.IO
import Data.IORef
#endif
{- INLINE isPressed -}
{-# INLINE isPressed #-}
isPressed :: KeyState -> Bool
isPressed KeyState'Pressed = True
isPressed KeyState'Repeating = True -- I don't know!
isPressed KeyState'Released = False
-- XXX Move to Stella?
{- INLINE setBreak -}
{-# INLINE setBreak #-}
setBreak :: Int -> Int -> MonadAtari ()
setBreak breakX breakY = do
xbreak @= (breakX+picx)
@ -123,7 +123,7 @@ handleKey atariKeys motion key = do
GameSelect -> modify swchb $ bitAt 1 .~ not pressed
GameReset -> modify swchb $ bitAt 0 .~ not pressed
DumpState -> Emulation.dumpState
GameQuit -> liftIO $ exitSuccess
GameQuit -> liftIO exitSuccess
EnterDebugger -> when pressed $ do
-- Throw away SDL events
-- Rewrite as a withXXX XXX
@ -156,8 +156,8 @@ handleKey atariKeys motion key = do
#else
WriteRecord -> when pressed $ liftIO $ print "Trace not enabled at compilation"
#endif
DelayUp -> when pressed $ doDelayUp
DelayDown -> when pressed $ doDelayDown
DelayUp -> when pressed doDelayUp
DelayDown -> when pressed doDelayDown
DelayLeft -> when pressed $ liftIO $ print "Left"
DelayRight -> when pressed $ liftIO $ print "Right"

4
src/Keys.hs
View file

@ -307,7 +307,7 @@ type AtariKeys = M.Map Key AtariKey
keysFromOptions :: Options -> Maybe AtariKeys
keysFromOptions options = do
scancodes <- sequence $ map (sequence . map scancodeFromString) [
scancodes <- mapM (sequence . map scancodeFromString) [
joystick1Left options,
joystick1Right options,
joystick1Up options,
@ -403,7 +403,7 @@ keysFromOptions options = do
KeyboardController 3 4,
KeyboardController 3 5
]
return $ M.fromList $ concat $ [zip scancodeLists (repeat deviceKeys) |
return $ M.fromList $ concat [zip scancodeLists (repeat deviceKeys) |
(scancodeLists, deviceKeys) <- zip scancodes atariKeys]
data UIKey = UIKey { uiKey :: Key, uiScancode :: Int, uiState :: KeyState, uiMods :: ModifierKeys }

12
src/Memory.hs
View file

@ -191,21 +191,21 @@ bankSwitch _ _ state = state
superchipRamAddress :: Word16 -> Word16 -> Int
superchipRamAddress offset addr =
let zaddr = iz addr .&. 0xfff
in if zaddr < 0x100 then (zaddr .&. 0x7f) else zaddr+iz offset
in if zaddr < 0x100 then zaddr .&. 0x7f else zaddr+iz offset
-- 256 bytes RAM
cbsRamAddress :: Word16 -> Word16 -> Int
cbsRamAddress offset addr =
let zaddr = iz addr .&. 0xfff
in if zaddr < 0x200 then (zaddr .&. 0xff) else zaddr+iz offset
in if zaddr < 0x200 then zaddr .&. 0xff else zaddr+iz offset
bankAddress :: BankState -> Word16 -> Int
bankAddress NoBank addr = iz (addr .&. 0xfff)
bankAddress (BankF8 offset) addr = ((iz addr .&. 0xfff)+iz offset)
bankAddress (BankF8 offset) addr = (iz addr .&. 0xfff) + iz offset
bankAddress (BankF8SC offset) addr = superchipRamAddress offset addr
bankAddress (BankF6 offset) addr = ((iz addr .&. 0xfff)+iz offset)
bankAddress (BankF6 offset) addr = (iz addr .&. 0xfff) + iz offset
bankAddress (BankF6SC offset) addr = superchipRamAddress offset addr
bankAddress (BankF4 offset) addr = ((iz addr .&. 0xfff)+iz offset)
bankAddress (BankF4 offset) addr = (iz addr .&. 0xfff) + iz offset
bankAddress (BankF4SC offset) addr = superchipRamAddress offset addr
bankAddress (BankE0 a b c) addr = let zaddr = iz addr .&. 0x3ff -- 1K blocks
@ -216,7 +216,7 @@ bankAddress (BankE0 a b c) addr = let zaddr = iz addr .&. 0x3ff -- 1K bl
0x0c00 -> 0x1c00+zaddr
_ -> error "Provably impossible"
bankAddress (Bank3F _) addr | addr > 0x1800 = iz addr
bankAddress (Bank3F offset) addr = ((iz addr .&. 0x7ff)+iz offset)
bankAddress (Bank3F offset) addr = (iz addr .&. 0x7ff) + iz offset
bankAddress (BankFA offset) addr = cbsRamAddress offset addr

29
src/Stella.hs
View file

@ -81,22 +81,21 @@ stellaTickFor d = do
else ahead @= (n-d)
stellaTickFor' :: Int -> MonadAtari ()
stellaTickFor' diff = do
when (diff >= 0) $ do
-- Batch together items that don't need to be
-- carried out on individual ticks
modifyStellaClock id (+ fromIntegral diff)
replicateM_ (fromIntegral diff) $ timerTick
resmp0' <- load resmp0
resmp1' <- load resmp1
-- XXX surely this must be done every time - collisions
clampMissiles resmp0' resmp1'
stellaTickFor' diff = when (diff >= 0) $ do
-- Batch together items that don't need to be
-- carried out on individual ticks
modifyStellaClock id (+ fromIntegral diff)
replicateM_ (fromIntegral diff) timerTick
resmp0' <- load resmp0
resmp1' <- load resmp1
-- XXX surely this must be done every time - collisions
clampMissiles resmp0' resmp1'
parityRef <- view frameParity
parity <- liftIO $ readIORef parityRef
ptr' <- view (if parity then textureData else lastTextureData)
-- XXX Not sure stellaDebug actually changes here so may be some redundancy
stellaTick (fromIntegral diff) ptr'
parityRef <- view frameParity
parity <- liftIO $ readIORef parityRef
ptr' <- view (if parity then textureData else lastTextureData)
-- XXX Not sure stellaDebug actually changes here so may be some redundancy
stellaTick (fromIntegral diff) ptr'
timerTick' :: Word8 -> Int -> Int -> Word8 -> (Word8, Int, Int, Word8)
timerTick' 0 0 _ _ = (0xff, 3*1-1, 1, 0x80)

4
src/Step.hs
View file

@ -22,7 +22,7 @@ step = do
case i of
0x00 -> brk
0x01 -> ora readIndX
0x04 -> void $ readZeroPage -- XXX undocumented "DOP" nop
0x04 -> void readZeroPage -- XXX undocumented "DOP" nop
0x05 -> ora readZeroPage
0x06 -> asl withZeroPage
0x08 -> php
@ -82,7 +82,7 @@ step = do
0x68 -> pla
0x69 -> adc readImm
0x6a -> ror withAcc
0x6c -> jmp_indirect
0x6c -> jmpIndirect
0x6d -> adc readAbs
0x6e -> ror withAbs
0x70 -> bra getV True

12
src/VideoOps.hs
View file

@ -158,7 +158,7 @@ testReflectedBit bitmap reflect o = testBit bitmap (flipIf reflect $ fromIntegra
{-
- See http://atarihq.com/danb/files/stella.pdf page 39
-}
{- INLINE stretchPlayer' -}
{-# INLINE stretchPlayer' #-}
stretchPlayer' :: Bool -> Word8 -> Int -> Word8 -> Bool
stretchPlayer' reflect 0b000 o bitmap = o < 8 && testReflectedBit bitmap reflect o
stretchPlayer' reflect 0b001 o bitmap = (o < 8 || o >= 16 && o < 24) && testReflectedBit bitmap reflect o
@ -170,7 +170,7 @@ stretchPlayer' reflect 0b110 o bitmap = (o < 8 || o >= 32 && o < 40 || o >= 64)
stretchPlayer' reflect 0b111 o bitmap = o < 32 && testReflectedBit bitmap reflect (o `shift` (-2))
stretchPlayer' _ _ _ _ = error "Impossible"
{- INLINE stretchPlayer -}
{-# INLINE stretchPlayer #-}
stretchPlayer :: Bool -> Int -> Word8 -> Word8 -> Bool
stretchPlayer _ o _ _ | o < 0 || o >= 72 = False
stretchPlayer reflect o sizeCopies bitmap = stretchPlayer' reflect sizeCopies o bitmap
@ -214,10 +214,10 @@ ball :: Bool -> Bool -> Bool -> Word8 -> Int -> Bool
ball _ _ _ _ o | o < 0 = False
ball delayBall' oldBall' newBall' ctrlpf' o = do
let enabl' = if delayBall' then oldBall' else newBall'
if enabl'
then let ballSize = 1 `shift` (fromIntegral ((ctrlpf' `shift` (-4)) .&. 0b11))
in o >= 0 && o < ballSize
else False
enabl' && (
let ballSize = 1 `shift` fromIntegral ((ctrlpf' `shift` (-4)) .&. 0b11)
in o >= 0 && o < ballSize)
missileSize :: Word8 -> Int
missileSize nusiz = 1 `shift` (fromIntegral ((nusiz `shift` (-4)) .&. 0b11))