rev: 3827f53bae88e48a594610914ba74b9512ead6dd tukan/testing/test_vulkan.sc -rw-r--r-- 4.1 KiB View raw Log this file
3827f53bae88 — Leonard Ritter * more work on module system 3 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
using import ..tukan.vulkan

import ..tukan.sdl
let sdl = tukan.sdl
using import ..tukan.sdl

fn main ()
    #var context = (nullof SDL_GLContext)
    var window = (nullof (pointer SDL_Window 'mutable))
    var surface = (VkSurfaceKHR)

    fn option (default value)
        if (none? value) default
        else value

    fn sdl-error-string ()
        string.from-cstr (SDL_GetError)
    fn handle-error ()
        error! (sdl-error-string)

    fn handle-vulkan-result (result)
        match result
            VK_SUCCESS
                return;
            VK_ERROR_OUT_OF_HOST_MEMORY
                error! "VK_ERROR_OUT_OF_HOST_MEMORY"
            VK_ERROR_OUT_OF_DEVICE_MEMORY
                error! "VK_ERROR_OUT_OF_DEVICE_MEMORY"
            VK_ERROR_INITIALIZATION_FAILED
                error! "VK_ERROR_INITIALIZATION_FAILED"
            VK_ERROR_LAYER_NOT_PRESENT
                error! "VK_ERROR_LAYER_NOT_PRESENT"
            VK_ERROR_EXTENSION_NOT_PRESENT
                error! "VK_ERROR_EXTENSION_NOT_PRESENT"
            VK_ERROR_INCOMPATIBLE_DRIVER
                error! "VK_ERROR_INCOMPATIBLE_DRIVER"
            else
                error! "unknown vulkan error"

    fn init (opts...)
        SDL_Init
            |
                SDL_INIT_AUDIO
                SDL_INIT_VIDEO
                SDL_INIT_EVENTS

        let resizable = (option false (va@ 'resizable opts...))
        let title =
            option "Vulkan" (va@ 'title opts...)
        window =
            SDL_CreateWindow title
                SDL_WINDOWPOS_UNDEFINED
                SDL_WINDOWPOS_UNDEFINED
                option 640 (va@ 'width opts...)
                option 480 (va@ 'height opts...)
                | SDL_WINDOW_VULKAN
                    SDL_WINDOW_SHOWN
                    ? resizable (u32 SDL_WINDOW_RESIZABLE) 0:u32
        assert (window != null) (sdl-error-string)

        var extension-count = 0:u32
        if ((SDL_Vulkan_GetInstanceExtensions window extension-count null) == SDL_FALSE)
            handle-error;
        var extension-names @ (extension-count as immutable) : rawstring
        if ((SDL_Vulkan_GetInstanceExtensions window extension-count extension-names) == SDL_FALSE)
            handle-error;
        let count = (extension-count as immutable)

        var app =
            VkApplicationInfo
                sType = VK_STRUCTURE_TYPE_APPLICATION_INFO
                pNext = null
                pApplicationName = title
                applicationVersion = 0
                pEngineName = title
                engineVersion = 0
                apiVersion = VK_API_VERSION_1_0

        var inst_info =
            VkInstanceCreateInfo
                sType = VK_STRUCTURE_TYPE_INSTANCE_CREATE_INFO
                pNext = null
                pApplicationInfo = app
                enabledLayerCount = 0
                ppEnabledLayerNames = null
                enabledExtensionCount = extension-count
                ppEnabledExtensionNames = extension-names

        var instance = (VkInstance)
        handle-vulkan-result
            vkCreateInstance inst_info null instance

        let sdl_instance =
            bitcast (load instance) SDL_vulkanInstance
        var sdl_surface = (SDL_vulkanSurface)
        if ((SDL_Vulkan_CreateSurface window sdl_instance sdl_surface) == SDL_FALSE)
            handle-error;

        surface =
            bitcast (load sdl_surface) VkSurfaceKHR

        return;

    fn window-size ()
        var w = 0
        var h = 0
        SDL_GetWindowSize window w h
        return w h

    #fn shutdown ()
        SDL_GL_DeleteContext context
        SDL_DestroyWindow window

        SDL_Quit;

    fn swap ()
        SDL_GL_SwapWindow window

    var quit = false
    fn handle_events ()
        var event = (SDL_Event)
        while ((SDL_PollEvent event) != 0)
            if (event.type == SDL_QUIT)
                quit = true

    fn loop ()
        while (not quit)
            handle_events;
            swap;

    init
        title = "Tukan"
        width = 800
        height = 600
        resizable = true

    #loop;

    #shutdown;

main;
#dump-label
    typify main
#compile
    typify main
    'dump-module