Skip to content

Commit

Permalink
Finally got image scaling to work!
Browse files Browse the repository at this point in the history
  • Loading branch information
Gregory Crosswhite authored and gcross committed Oct 10, 2015
1 parent 54f8159 commit 273e38b
Show file tree
Hide file tree
Showing 4 changed files with 86 additions and 73 deletions.
4 changes: 2 additions & 2 deletions example.hs
Original file line number Diff line number Diff line change
Expand Up @@ -53,9 +53,9 @@ main = do
(fromJust $ Map.lookup "logo_mechanic" actor)
(fromJust $ Map.lookup "logo_gear" actor)
(fromJust $ Map.lookup "logo_gear_tail" actor)
renderToDocument logo_state =
renderToDocument scale logo_state =
svg (document ^. header)
1
scale
[defs
,renderActor $ logo_state ^. actor_logo_the
,renderActor $ logo_state ^. actor_logo_uantum
Expand Down
44 changes: 17 additions & 27 deletions src/Slick/Render.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@

module Slick.Render where

import Control.Lens ((%=),(<%=),makeLenses,use)
import Control.Lens ((^.),(%=),(<%=),makeLenses,use)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.State.Strict (StateT, runStateT)

Expand All @@ -18,7 +18,7 @@ import Data.IORef
import Data.Time.Clock (UTCTime, NominalDiffTime, diffUTCTime, getCurrentTime)

import Foreign.C.String (CString)
import Foreign.C.Types (CULong(..))
import Foreign.C.Types (CDouble(..),CInt(..),CULong(..))
import Foreign.Ptr (Ptr)
import Foreign.StablePtr

Expand All @@ -27,9 +27,10 @@ import Text.XML (Document)

import Slick.Animation
import Slick.Presentation
import Slick.SVG

foreign import ccall "slick_write_to_handle" c_slick_write_to_handle :: Ptr () CString CULong IO ()
foreign import ccall "slick_run" c_slick_run :: Ptr () IO ()
foreign import ccall "slick_run" c_slick_run :: CInt CInt Ptr () IO ()

data Mode =
RunMode UTCTime NominalDiffTime
Expand All @@ -38,25 +39,10 @@ data Mode =
data SlickState s = SlickState
{ _s_mode :: Mode
, _s_animation_and_state :: AnimationAndState Double s
, _s_renderer :: s Document
, _s_renderer :: Double s Document
}
makeLenses ''SlickState

fixSize :: (RealFrac α, Integral β, Integral ɣ) α β β (ɣ, ɣ)
fixSize correct_aspect_ratio width height = (fixed_width, fixed_height)
where
width_f = fromIntegral width
height_f = fromIntegral height
current_aspect_ratio = width_f/height_f
fixed_width = round $
if current_aspect_ratio > correct_aspect_ratio
then width_f / current_aspect_ratio * correct_aspect_ratio
else width_f
fixed_height = round $
if current_aspect_ratio < correct_aspect_ratio
then height_f * current_aspect_ratio / correct_aspect_ratio
else height_f

withState :: Ptr () StateT (SlickState s) IO α IO α
withState state_ptr action = do
state_ref deRefStablePtr . castPtrToStablePtr $ state_ptr
Expand All @@ -65,10 +51,10 @@ withState state_ptr action = do
writeIORef state_ref new_state
return result

foreign export ccall slick_write_document :: Ptr () Ptr () IO ()
foreign export ccall slick_write_document :: Ptr () CDouble Ptr () IO ()

slick_write_document :: Ptr () Ptr () IO ()
slick_write_document state_ptr rsvg_handle = withState state_ptr $ do
slick_write_document :: Ptr () CDouble Ptr () IO ()
slick_write_document state_ptr scale rsvg_handle = withState state_ptr $ do
mode use s_mode
time liftIO $ case mode of
RunMode starting_time additional_time do
Expand All @@ -77,7 +63,7 @@ slick_write_document state_ptr rsvg_handle = withState state_ptr $ do
PauseMode time return . realToFrac $ time
AnimationAndState _ new_state s_animation_and_state <%= runAnimationAndState time
renderer use s_renderer
let document = renderer new_state
let document = renderer (realToFrac scale) new_state
consumer = do
mbs await
case mbs of
Expand All @@ -87,6 +73,7 @@ slick_write_document state_ptr rsvg_handle = withState state_ptr $ do
c_slick_write_to_handle rsvg_handle ptr (fromIntegral $ BS.length bs))
consumer
runConduit $ XML.renderBytes def document =$= consumer
liftIO $ XML.writeFile def "test.svg" document

foreign export ccall slick_toggle_mode :: Ptr () IO ()

Expand All @@ -100,15 +87,18 @@ slick_toggle_mode state_ptr = withState state_ptr $ do
PauseMode additional_time RunMode current_time additional_time
)

viewAnimation :: AnimationAndState Double s (s Document) IO ()
viewAnimation :: AnimationAndState Double s (Double s Document) IO ()
viewAnimation animation_and_state render = do
starting_time getCurrentTime
state_ref newIORef $ SlickState (PauseMode 0.0000001) animation_and_state render
let initial_state = SlickState (PauseMode 0.0000001) animation_and_state render
initial_document = render 1 $ animation_and_state ^. as_state
Header initial_width initial_height = initial_document ^. header
state_ref newIORef initial_state
state_ref_ptr newStablePtr state_ref
c_slick_run . castStablePtrToPtr $ state_ref_ptr
c_slick_run (round initial_width) (round initial_height) . castStablePtrToPtr $ state_ref_ptr
freeStablePtr state_ref_ptr

viewPresentation :: CombinationMode s (s Document) Presentation Double s () IO ()
viewPresentation :: CombinationMode s (Double s Document) Presentation Double s () IO ()
viewPresentation combination_mode initial_state render presentation =
viewAnimation (execPresentationIn combination_mode initial_state presentation) render

Expand Down
77 changes: 42 additions & 35 deletions src/Slick/SVG.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ import Control.Monad (forM_)
import Control.Monad.Trans.State.Strict (execState,get,put)

import Data.Attoparsec.Text (Parser, choice, double, endOfInput, parseOnly, string)
import Data.Default (Default(..))
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe (fromMaybe)
Expand Down Expand Up @@ -88,25 +89,18 @@ document_root = lens getter setter

root_element_attributes = document_root . element_attributes

scaleDocument :: Double Document Document
scaleDocument scale document =
(header .~ Header (width*scale) (height*scale))
.
(document_root . elementAttribute "transform" %~
(\old_transform old_transform
<> (pack $ "scale(" ++ show scale ++ ")")
<> (pack $ "translate(" ++ show (-dx) ++ " " ++ show (-dy) ++ ")")
)
)
$
document
where
Header width height = document ^. header
dx = width*(scale-1)/2
dy = height*(scale-1)/2
transformScale scale = pack $ "scale(" ++ show scale ++ ")"
transformTranslate dx dy = pack $ "translate(" ++ show dx ++ " " ++ show dy ++ ")"

groupTransform :: Text [Element] Element
groupTransform transform elements =
Element
(mkName "g")
(Map.singleton "transform" transform)
(map NodeElement elements)

svg :: Header [Element] Document
svg header elements =
svg :: Header Double [Element] Document
svg header scale elements =
Document
(Prologue [] Nothing [])
(Element
Expand All @@ -115,18 +109,26 @@ svg header elements =
[("xmlns","http://www.w3.org/2000/svg")
,("xmlns:xlink","http://www.w3.org/1999/xlink")
,("version","1.1")
,("width",pack . show $ (header ^. header_width))
,("height",pack . show $ (header ^. header_height))
,("viewBox",pack $ "0 0 " ++
show (header ^. header_width) ++
" " ++
show (header ^. header_height)
)
,("width",pack . show $ width)
,("height",pack . show $ height)
,("viewBox",pack $ "0 0 " ++ show width ++ " " ++ show height)
,("transform",transform)
]
)
(map NodeElement elements)
)
[]
where
width = header ^. header_width * scale
height = header ^. header_height * scale
fixed_x = header ^. header_width / 2
fixed_y = header ^. header_height / 2
transform =
transformTranslate (-width/2) (-height/2)
<>
transformScale scale
<>
transformTranslate fixed_x fixed_y

mkName :: Text Name
mkName name = Name name Nothing Nothing
Expand All @@ -151,6 +153,9 @@ data Scale =
| NonPropScale Double Double
deriving (Eq,Ord,Read,Show)

instance Default Scale where
def = PropScale 1

instance Interpolatable Double Scale where
interpolateUnitInterval (PropScale before) (PropScale after) t =
PropScale (interpolateUnitInterval before after t)
Expand Down Expand Up @@ -184,6 +189,17 @@ instance Default Attributes where
mkActor :: Text Text Actor
mkActor actor_id parent_transform = Actor actor_id parent_transform def

renderAttributesTransform :: Attributes Text
renderAttributesTransform Attributes{..} = pack $
"scale(" ++ (
case _scale of
PropScale scale show scale
NonPropScale x y show x ++ " " ++ show y
) ++ ")" ++
"translate(" ++ show _x ++ " " ++ show _y ++ ")" ++
"rotate(" ++ show _rotation_angle ++ " " ++ show _rotation_x ++ " " ++ show _rotation_y ++ ")"


renderActor :: Actor Element
renderActor Actor{..} =
Element
Expand All @@ -195,19 +211,10 @@ renderActor Actor{..} =
)
[]
where
Attributes{..} = _attributes
transform =
actorParentTransform
<>
(pack $
"scale(" ++ (
case _scale of
PropScale scale show scale
NonPropScale x y show x ++ " " ++ show y
) ++ ")" ++
"translate(" ++ show _x ++ " " ++ show _y ++ ")" ++
"rotate(" ++ show _rotation_angle ++ " " ++ show _rotation_x ++ " " ++ show _rotation_y ++ ")"
)
renderAttributesTransform _attributes

extractActors :: Document Set Text Map Text Actor
extractActors Document{..} id_set =
Expand Down
34 changes: 25 additions & 9 deletions src/c.cc
Original file line number Diff line number Diff line change
Expand Up @@ -65,39 +65,49 @@ struct SDL_Texture_ {
~SDL_Texture_() { SDL_DestroyTexture(_); }
};

const int WIDTH = 1024;
const int HEIGHT = 576;

void write_error_and_quit(GError *error) {
std::cerr << error->message << std::endl;
abort();
}

void fix_size(double correct_aspect_ratio, int new_width, int new_height, int &fixed_width, int &fixed_height) {
double new_aspect_ratio = (double)new_width / (double)new_height;
if(new_aspect_ratio > correct_aspect_ratio) {
fixed_width = new_width / new_aspect_ratio * correct_aspect_ratio;
fixed_height = new_height;
} else {
fixed_width = new_width;
fixed_height = new_height * new_aspect_ratio / correct_aspect_ratio;
}
}

extern "C" {

void slick_write_to_handle(RsvgHandle *handle, unsigned char *buf, unsigned long count) {
if(not rsvg_handle_write(handle, buf, count, &error)) write_error_and_quit(error);
}

void slick_write_document(void *slick_state, RsvgHandle* handle);
void slick_write_document(void *slick_state, double scale, RsvgHandle* handle);
void slick_toggle_mode(void *slick_state);

int slick_run(void *slick_state) {
int slick_run(const int initial_width, const int initial_height, void *slick_state) {
int width = initial_width, height = initial_height;
double aspect_ratio = (double)width / (double)height;
SDL sdl;
SDL_Window_ window(WIDTH, HEIGHT);
SDL_Window_ window(width,height);
SDL_Renderer_ renderer(window._);
SDL_SetWindowBordered(window._, SDL_TRUE);
while(true) {
CairoImageSurface cairo_surface(WIDTH, HEIGHT);
CairoImageSurface cairo_surface(width, height);
CairoContext context(cairo_surface._);
cairo_set_source_rgb(context._, 1, 1, 1);
cairo_paint(context._);
RsvgHandle_ handle;
slick_write_document(slick_state, handle._);
slick_write_document(slick_state, (double)width/(double)initial_width, handle._);
GError *error;
if(not rsvg_handle_close(handle._, &error)) write_error_and_quit(error);
rsvg_handle_render_cairo(handle._, context._);
SDL_SurfaceFromData_ sdl_surface(cairo_image_surface_get_data(cairo_surface._), WIDTH, HEIGHT);
SDL_SurfaceFromData_ sdl_surface(cairo_image_surface_get_data(cairo_surface._), width, height);
SDL_Texture_ texture(renderer._, sdl_surface._);
SDL_RenderCopy(renderer._, texture._, NULL, NULL);
SDL_RenderPresent(renderer._);
Expand All @@ -109,6 +119,12 @@ int slick_run(void *slick_state) {
case SDL_WINDOWEVENT:
switch(event.window.event) {
case SDL_WINDOWEVENT_CLOSE: return 0;
case SDL_WINDOWEVENT_RESIZED:
case SDL_WINDOWEVENT_MAXIMIZED:
case SDL_WINDOWEVENT_RESTORED:
fix_size(aspect_ratio,event.window.data1,event.window.data2,width,height);
SDL_SetWindowSize(window._,width,height);
break;
}
break;
case SDL_KEYDOWN:
Expand Down

0 comments on commit 273e38b

Please sign in to comment.