M lib/tukan/main.sc +11 -0
@@ 92,6 92,17 @@ inline ()
'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
M lib/tukan/module.sc +20 -26
@@ 265,29 265,31 @@ type+ Act
#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 @@ type+ EditAct
;
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
M lib/tukan/uvm.sc +50 -7
@@ 745,7 745,8 @@ struct Cell
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 @@ struct Cell
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 @@ let
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 @@ type+ Atom
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 @@ type+ Atom
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 @@ type+ Atom
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
M testing/test_uvm.sc +13 -0
@@ 101,6 101,19 @@ fn testfunc ()
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
M testing/testaudio.sc +4 -2
@@ 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
M testing/testfragment.sc +7 -6
@@ 3,13 3,14 @@ using import glm
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
A => testing/uvmedit.sc +222 -0
@@ 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."
+
+
+;