# HG changeset patch # User Leonard Ritter # Date 1606772521 -3600 # Mon Nov 30 22:42:01 2020 +0100 # Node ID 8b87d1d3c71fa58fbc293fba5fe3c90fe097b5d7 # Parent b034f5705a1499bf61265b61809358f4a2a9d8eb * initial check-in uvmedit diff --git a/lib/tukan/main.sc b/lib/tukan/main.sc --- a/lib/tukan/main.sc +++ b/lib/tukan/main.sc @@ -92,6 +92,17 @@ 'new-module app target_path except (err) handle-gui-error err + if (MenuItem "Open Module") + local target_path : (mutable rawstring) + let result = + NFD_OpenDialog "tuk" + module-dir + &target_path + if (result as integer == 1) + try + 'new-module app target_path + except (err) + handle-gui-error err if (WithMenu "View") MenuItem "Show Demo Window" selected = test-window-visible diff --git a/lib/tukan/module.sc b/lib/tukan/module.sc --- a/lib/tukan/module.sc +++ b/lib/tukan/module.sc @@ -265,29 +265,31 @@ #assert (atom == digest) atom - fn load (self) + fn rootkey? (self) + let key = (dbkey (Atom)) + let content = + try ('get self._txn self._db.blob key) + except (err) + return false + let digestsize digest = (unpack content) + if (digestsize != (sizeof Atom.DigestType)) + return false + true + + fn... load + case (self, cache : Atom.Set) let key = (dbkey (Atom)) let content = try ('get self._txn self._db.blob key) except (err) (raise (err as ModuleError)) let digestsize digest = (unpack content) assert (digestsize == (sizeof Atom.DigestType)) - - local cache : - Set Atom - inline (value) - static-if ((typeof value) == Atom.DigestType) - Atom.hash-from-digest value - else - hash value - va-map - inline (value) - 'insert cache value - Atom; - Atom false - Atom true - - load1 self content cache + _ + load1 self content cache + cache + case (self) + local cache : Atom.Set + this-function self cache type+ EditAct fn... store1 (self, key : db.Value, value : Atom) @@ -330,15 +332,7 @@ ; fn... store (self, root : Atom, root? : bool = true) - local done : (Set Atom) - va-map - inline (value) - local key = ('hashbits value) - 'insert done value - Atom; - Atom false - Atom true - + local done : Atom.Set fn recur (value ...) let self done = ... let recur = this-function diff --git a/lib/tukan/uvm.sc b/lib/tukan/uvm.sc --- a/lib/tukan/uvm.sc +++ b/lib/tukan/uvm.sc @@ -745,7 +745,8 @@ default; set self key (Atom) - fn... get (self, key : Atom) + fn... get + case (self, key : Atom, fallback : Atom) label do-regular-get dispatch key case Number (num) @@ -755,19 +756,21 @@ merge do-regular-get return (get-index self index) default; - fn recur (keylimb valuelimb key depth) + fn recur (keylimb valuelimb key depth fallback) returning (uniqueof Atom -1) let mask = (((('hashbits key) >> (depth * IndexBits)) as u32) & IndexMask) if (('kind keylimb) == Atom.Kind.CellLimb) # branch local newkl = (copy (keylimb as CellLimb)) local newvl = (copy (valuelimb as CellLimb)) return - this-function (newkl.cells @ mask) (newvl.cells @ mask) key (depth + 1) + this-function (newkl.cells @ mask) (newvl.cells @ mask) key (depth + 1) fallback elseif (keylimb == key) # found key return (copy valuelimb) # key not found - return (Atom) - recur self.keys self.values key 0 + return (copy fallback) + recur self.keys self.values key 0 fallback + case (self, key : Atom) + this-function self key (Atom) fn new (...) local table : this-type @@ -829,6 +832,25 @@ UCell = (UType Cell) type+ Atom + let Set = + Set this-type + inline (value) + static-if ((typeof value) == Atom.DigestType) + this-type.hash-from-digest value + else + hash value + + type+ Set + let _typecall = this-type.__typecall + + inline __typecall (cls) + local self = (_typecall cls) + 'insert self (Atom) + 'insert self (Atom false) + 'insert self (Atom true) + deref self + unlet _typecall + enum Kind plain None = 0 False @@ -890,6 +912,25 @@ viewing self ((ptrtoint (storagecast self) usize) & 0xf) as (storageof Kind) as Kind + inline cell? (self) + (kind self) == Kind.Cell + + inline number? (self) + (kind self) == Kind.Number + + fn bool? (self) + switch (kind self) + pass Kind.False + pass Kind.True + do true + default false + + fn string? (self) + (kind self) == Kind.String + + fn symbol? (self) + (kind self) == Kind.Symbol + @@ memo inline __as (cls T) static-if (T == bool) @@ -898,7 +939,8 @@ case Kind.False false case Kind.True true default - assert false "Atom isn't a boolean" + assert false + .. (repr self) " isn't a boolean" unreachable; elseif (T == Number) inline (self) @@ -915,7 +957,8 @@ elseif (T == String) inline (self) switch (kind self) - pass Kind.String + pass Kind.Blob + pass Kind.Text pass Kind.Symbol do (bitcast (topointer self) UString) . data diff --git a/testing/test_uvm.sc b/testing/test_uvm.sc --- a/testing/test_uvm.sc +++ b/testing/test_uvm.sc @@ -101,6 +101,19 @@ assert (expr == expr2) assert (result1 == result2) + # + UVM specialization: + + * count use of each expression + * track scope of each expression + * allocate temporary resources + + function input: + + list of events + + + # print diff --git a/testing/testaudio.sc b/testing/testaudio.sc --- a/testing/testaudio.sc +++ b/testing/testaudio.sc @@ -1,7 +1,9 @@ -import ..tukan.audio -using import ..tukan.sdl using import itertools + +import ..lib.tukan.use +import tukan.audio +using import tukan.sdl let audio = tukan.audio let BUFFERSIZE = 1024 diff --git a/testing/testfragment.sc b/testing/testfragment.sc --- a/testing/testfragment.sc +++ b/testing/testfragment.sc @@ -3,13 +3,14 @@ using import glsl using import struct -using import ..tukan.GLMain -using import ..tukan.Screen -using import ..tukan.GUI +import ..lib.tukan.use +using import tukan.GLMain +using import tukan.Screen +using import tukan.GUI -using import ..tukan.gl -using import ..tukan.sdl -using import ..tukan.rotation +using import tukan.gl +using import tukan.sdl +using import tukan.rotation let BUFFER_COUNT = 3 diff --git a/testing/uvmedit.sc b/testing/uvmedit.sc new file mode 100644 --- /dev/null +++ b/testing/uvmedit.sc @@ -0,0 +1,222 @@ + +using import Map +using import String +using import struct + +import ..lib.tukan.use +using import tukan.gl +using import tukan.sdl +using import tukan.module +using import tukan.uvm + +let controllerdb = + import tukan.gamecontrollerdb + +global DEFAULT_ROOT = + uquote + ; + : windows + ; + : main + ; + : title "UVM" + #: origin (100 100) + : size (960 540) + : resizable true + : visible true + +let BOOT_FILEPATH = + .. module-dir "/boot.um" + +global module = + do + report "booting" BOOT_FILEPATH + try (Module.from-path BOOT_FILEPATH) + except (err) + raise (err as Error) + +global root = + do + try + let act = ('edit module) + if true #(not ('rootkey? act)) + report "generating default object..." + 'store act DEFAULT_ROOT + 'commit act + let act = ('view module) + _ ('load act) () + except (err) + raise (err as Error) + +fn set-root (newroot) + root = newroot + try + let act = ('edit module) + 'store act root + 'commit act + except (err) + raise (err as Error) + +#report + 'tostring root + +SDL_SetHint "SDL_GAMECONTROLLERCONFIG" controllerdb + +SDL_Init + | SDL_INIT_AUDIO + SDL_INIT_VIDEO + SDL_INIT_GAMECONTROLLER + #SDL_INIT_JOYSTICK + +SDL_GL_SetAttribute SDL_GL_DOUBLEBUFFER 1 + +SDL_GL_SetAttribute SDL_GL_STENCIL_SIZE 8 +SDL_GL_SetAttribute SDL_GL_DEPTH_SIZE 24 + +SDL_GL_SetAttribute SDL_GL_CONTEXT_MAJOR_VERSION 4 +SDL_GL_SetAttribute SDL_GL_CONTEXT_MINOR_VERSION 5 +#if IS_OSX + SDL_GL_SetAttribute + SDL_GL_CONTEXT_PROFILE_MASK + SDL_GL_CONTEXT_PROFILE_CORE + +struct WindowContext + def : Atom + window : (returnof SDL_CreateWindow) + glcontext : (returnof SDL_GL_CreateContext) + + fn __drop (self) + if (self.glcontext != null) + SDL_GL_DeleteContext self.glcontext + if (self.window != null) + SDL_DestroyWindow self.window + + +global last-windows : Atom = (Cell) +global active-windows : + Map Atom WindowContext + +fn add-remove-windows () + let windows = + 'get (root as Cell) 'windows + loop () + if + for key ctx in active-windows + let windowinfo = ('get (windows as Cell) key) + if ('none? windowinfo) + report "window closed" + 'discard active-windows (copy key) + break true + else false + repeat; + else + break; + call + Cell.gen-each-pair + fn "update-window" (key value) + let windowinfo = (value as Cell) + if (not ('in? active-windows key)) + let title = + ('get windowinfo 'title) as String as string + let origin = ('get windowinfo 'origin) + let size = + ('get windowinfo 'size) as Cell + let visible = + ('get windowinfo 'visible) as bool + let resizable = + ('get windowinfo 'resizable) as bool + let x y = + if ('none? origin) + _ SDL_WINDOWPOS_UNDEFINED SDL_WINDOWPOS_UNDEFINED + else + let origin = (origin as Cell) + _ + ('get origin 0) as Number as integer + ('get origin 1) as Number as integer + # create + let window = + SDL_CreateWindow title x y + ('get size 0) as Number as integer + ('get size 1) as Number as integer + | SDL_WINDOW_OPENGL + ? visible SDL_WINDOW_SHOWN SDL_WINDOW_HIDDEN + ? resizable (u32 SDL_WINDOW_RESIZABLE) 0:u32 + let context = (SDL_GL_CreateContext window) + assert (context != null) + SDL_GL_MakeCurrent window context + SDL_GL_SetSwapInterval 1 + do + let result = (GL.gladLoadGL) + assert (result != 0) "failed to load GL core functions" + print-gl-info; + hook-gl-debug; + 'set active-windows (copy key) + WindowContext (copy value) window context + else + let ctx = + try ('get active-windows (copy key)) + else + return; + if (ctx.def != value) + report "window info changed..." + ; + + windows as Cell + last-windows = windows + +add-remove-windows; + +fn handle-events () + local event = (SDL_Event) + loop (quit = false) + if ((SDL_PollEvent &event) == 0) + break quit + if (event.type == SDL_QUIT) + repeat true + elseif + & + event.type == SDL_WINDOWEVENT + event.window.event == (SDL_WINDOWEVENT_CLOSE as integer) + local windows = + copy (('get (root as Cell) 'windows) as Cell) + local quit = quit + for key ctx in active-windows + if (event.window.windowID == (SDL_GetWindowID ctx.window)) + if (key == 'main) + quit = true + else + windows = ('del windows key) + set-root + 'set (root as Cell) 'windows windows + repeat (deref quit) + else + #on-event + event = event + glmain = self + repeat quit + +loop () + if (handle-events) + break; + add-remove-windows; + + for k ctx in active-windows + local w = 0 + local h = 0 + SDL_GetWindowSize ctx.window &w &h + SDL_GL_MakeCurrent ctx.window ctx.glcontext + GL.BindFramebuffer GL.FRAMEBUFFER 0 + GL.Viewport 0 0 w h + GL.ClearColor 0 0 0.5 1 + GL.Clear GL.COLOR_BUFFER_BIT + SDL_GL_SwapWindow ctx.window + #SDL_GL_MakeCurrent ctx.window null + repeat; + +'clear active-windows +SDL_Quit; + +report "done." + + +;