mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-15 18:12:47 +03:00
Remove Isle for now.
This commit is contained in:
Benjamin Summers
parent
b5919df50d
commit
3a99fe7834
@ -1,130 +0,0 @@
|
||||
{-# OPTIONS_GHC -Wwarn #-}
|
||||
|
||||
module Vere.Isle where
|
||||
|
||||
import ClassyPrelude
|
||||
import Data.Word
|
||||
|
||||
import qualified Data.Vector as V
|
||||
import qualified SDL as SDL
|
||||
import qualified Vere.Isle.Util as C
|
||||
|
||||
import Data.Bits (testBit)
|
||||
import Data.Vector ((!))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
newtype Word4 = Word4 Word8
|
||||
deriving newtype (Eq, Ord, Num, Integral, Real, Enum)
|
||||
|
||||
newtype Word10 = Word10 Word16
|
||||
deriving newtype (Eq, Ord, Num, Integral, Real, Enum)
|
||||
|
||||
data RGB = RGB !Word8 !Word8 !Word8
|
||||
|
||||
type Bitmap = Word64 -- 8x8 bitmap
|
||||
|
||||
{-
|
||||
TODO Storable instance?
|
||||
(Then I can use an unboxed vector)
|
||||
-}
|
||||
data Tile = Tile
|
||||
{ tFore :: !Word4
|
||||
, tBack :: !Word4
|
||||
, tSpry :: !Word10
|
||||
}
|
||||
|
||||
data Display = Display
|
||||
{ dColors :: V.Vector RGB -- size: 16
|
||||
, dSprites :: V.Vector Bitmap -- size: 1024
|
||||
, dTiles :: V.Vector Tile -- size: 3600 (80x45)
|
||||
, dSurf :: V.Vector SDL.Surface -- size: 3600 (80x45)
|
||||
}
|
||||
|
||||
initializeSurfaces :: IO (V.Vector SDL.Surface)
|
||||
initializeSurfaces =
|
||||
V.generateM 3600
|
||||
$ const
|
||||
$ SDL.createRGBSurface (SDL.V2 8 8)
|
||||
$ SDL.RGB888
|
||||
|
||||
initialDisplay :: IO Display
|
||||
initialDisplay =
|
||||
do
|
||||
surf <- initializeSurfaces
|
||||
pure $ Display (V.generate 16 initialColors)
|
||||
(V.generate 1024 initialSprites)
|
||||
(V.generate 3600 initialTiles)
|
||||
surf
|
||||
where
|
||||
initialSprites :: Int -> Bitmap
|
||||
initialSprites = fromIntegral
|
||||
|
||||
green = 4
|
||||
white = 15
|
||||
|
||||
initialTiles :: Int -> Tile
|
||||
initialTiles i =
|
||||
Tile green white (fromIntegral i `mod` 1024)
|
||||
|
||||
initialColors :: Int -> RGB
|
||||
initialColors = \case
|
||||
0 -> RGB 0x00 0x00 0x00 -- Black
|
||||
1 -> RGB 0x55 0x55 0x55 -- DarkGray
|
||||
2 -> RGB 0x00 0x00 0xAA -- Blue
|
||||
3 -> RGB 0x55 0x55 0xFF -- LightBlue
|
||||
4 -> RGB 0x00 0xAA 0x00 -- Green
|
||||
5 -> RGB 0x55 0xFF 0x55 -- LightGreen
|
||||
6 -> RGB 0x00 0xAA 0xAA -- Cyan
|
||||
7 -> RGB 0x55 0xFF 0xFF -- LightCyan
|
||||
8 -> RGB 0xAA 0x00 0x00 -- Red
|
||||
9 -> RGB 0xFF 0x55 0x55 -- LightRed
|
||||
10 -> RGB 0xAA 0x00 0xAA -- Magenta
|
||||
11 -> RGB 0xFF 0x55 0xFF -- LightMagenta
|
||||
12 -> RGB 0xAA 0x55 0x00 -- Brown
|
||||
13 -> RGB 0xFF 0xFF 0x55 -- Yellow
|
||||
14 -> RGB 0xAA 0xAA 0xAA -- LightGray
|
||||
15 -> RGB 0xFF 0xFF 0xFF -- White
|
||||
n -> error ("bad color: " <> show n)
|
||||
|
||||
renderTile :: Display -> Tile -> SDL.Surface -> IO ()
|
||||
renderTile d (Tile fg bg tx) surf = do
|
||||
let for = dColors d ! fromIntegral fg
|
||||
let bac = dColors d ! fromIntegral bg
|
||||
let spry = dSprites d ! fromIntegral tx
|
||||
for_ [0..63] $ \i -> do
|
||||
let col = if testBit spry i then for else bac
|
||||
renderPixel i surf col
|
||||
|
||||
renderPixel :: Int -> SDL.Surface -> RGB -> IO ()
|
||||
renderPixel = undefined
|
||||
|
||||
|
||||
-- data Display = Display
|
||||
{-dColors :: V.Vector RGB -- size: 16
|
||||
, dSprites :: V.Vector Bitmap -- size: 1024
|
||||
, dTiles :: V.Vector Tile -- size: 3600 (80x45)
|
||||
, dSurf :: V.Vector SDL.Surface -- size: 3600 (80x45)
|
||||
-}
|
||||
|
||||
render :: Display -> IO ()
|
||||
render = undefined
|
||||
|
||||
draw :: Display -> IO ()
|
||||
draw = undefined
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
main :: IO ()
|
||||
main = C.withSDL $ C.withWindow "Lesson 01" (640, 480) $
|
||||
\w -> do
|
||||
|
||||
screen <- SDL.getWindowSurface w
|
||||
-- pixelFormat <- SDL.surfaceFormat `applyToPointer` screen
|
||||
-- color <- SDL.mapRGB pixelFormat 0xFF 0xFF 0xFF
|
||||
SDL.surfaceFillRect screen Nothing (SDL.V4 maxBound maxBound maxBound maxBound)
|
||||
SDL.updateWindowSurface w
|
||||
|
||||
SDL.delay 2000
|
||||
|
||||
SDL.freeSurface screen
|
||||
@ -1,94 +0,0 @@
|
||||
module Vere.Isle.Util where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Data.Text (Text)
|
||||
import SDL (($=))
|
||||
|
||||
import qualified SDL
|
||||
import qualified SDL.Image
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
withSDL :: (MonadIO m) => m a -> m ()
|
||||
withSDL op = do
|
||||
SDL.initialize []
|
||||
void op
|
||||
SDL.quit
|
||||
|
||||
|
||||
withSDLImage :: (MonadIO m) => m a -> m ()
|
||||
withSDLImage op = do
|
||||
SDL.Image.initialize []
|
||||
void op
|
||||
SDL.Image.quit
|
||||
|
||||
|
||||
withWindow :: (MonadIO m) => Text -> (Int, Int) -> (SDL.Window -> m a) -> m ()
|
||||
withWindow title (x, y) op = do
|
||||
w <- SDL.createWindow title p
|
||||
SDL.showWindow w
|
||||
void $ op w
|
||||
SDL.destroyWindow w
|
||||
|
||||
where
|
||||
p = SDL.defaultWindow { SDL.windowInitialSize = z }
|
||||
z = SDL.V2 (fromIntegral x) (fromIntegral y)
|
||||
|
||||
|
||||
withRenderer :: (MonadIO m) => SDL.Window -> (SDL.Renderer -> m a) -> m ()
|
||||
withRenderer w op = do
|
||||
r <- SDL.createRenderer w (-1) rendererConfig
|
||||
void $ op r
|
||||
SDL.destroyRenderer r
|
||||
|
||||
|
||||
rendererConfig :: SDL.RendererConfig
|
||||
rendererConfig = SDL.RendererConfig
|
||||
{ SDL.rendererType = SDL.AcceleratedVSyncRenderer
|
||||
, SDL.rendererTargetTexture = False
|
||||
}
|
||||
|
||||
|
||||
renderSurfaceToWindow :: (MonadIO m) => SDL.Window -> SDL.Surface -> SDL.Surface -> m ()
|
||||
renderSurfaceToWindow w s i
|
||||
= SDL.surfaceBlit i Nothing s Nothing
|
||||
>> SDL.updateWindowSurface w
|
||||
|
||||
|
||||
isContinue :: Maybe SDL.Event -> Bool
|
||||
isContinue = maybe True (not . isQuitEvent)
|
||||
|
||||
|
||||
conditionallyRun :: (Monad m) => m a -> Bool -> m Bool
|
||||
conditionallyRun f True = True <$ f
|
||||
conditionallyRun _ False = pure False
|
||||
|
||||
|
||||
isQuitEvent :: SDL.Event -> Bool
|
||||
isQuitEvent (SDL.Event _t SDL.QuitEvent) = True
|
||||
isQuitEvent _ = False
|
||||
|
||||
|
||||
setHintQuality :: (MonadIO m) => m ()
|
||||
setHintQuality = SDL.HintRenderScaleQuality $= SDL.ScaleNearest
|
||||
|
||||
|
||||
loadTextureWithInfo :: (MonadIO m) => SDL.Renderer -> FilePath -> m (SDL.Texture, SDL.TextureInfo)
|
||||
loadTextureWithInfo r p = do
|
||||
t <- SDL.Image.loadTexture r p
|
||||
i <- SDL.queryTexture t
|
||||
pure (t, i)
|
||||
|
||||
|
||||
mkPoint :: a -> a -> SDL.Point SDL.V2 a
|
||||
mkPoint x y = SDL.P (SDL.V2 x y)
|
||||
|
||||
|
||||
mkRect :: a -> a -> a -> a-> SDL.Rectangle a
|
||||
mkRect x y w h = SDL.Rectangle o z
|
||||
where
|
||||
o = SDL.P (SDL.V2 x y)
|
||||
z = SDL.V2 w h
|
||||
Loading…
Reference in New Issue
Block a user