Figured a thing or two about haskell ffi

.gitignore

@@ -15,3 +15,5 @@ vgcore.*
 GRAPH*.gv
 GRAPH*.png
 SICK_JOKE*
+*.hi
+*_stub.h

src/l1/anne/alice.h

@@ -0,0 +1,25 @@
+#ifndef prototype1_src_l1_anne_alice_h
+#define prototype1_src_l1_anne_alice_h
+
+#include "../codegen/codegen.h"
+
+void generate_code_for_alice_on_l1(){
+    mkdir_nofail("l1/eve/alice");
+    mkdir_nofail("l1/eve/alice");
+    SpanU8 l = cstr("l1"), ns = cstr("alice");
+    /* Assets: model topology */
+    generate_eve_span_company_for_primitive(l, ns, cstr("GenericMeshVertexInc"), true, true);
+    generate_eve_span_company_for_non_primitive_clonable(l, ns, cstr("GenericMeshInSceneTemplate"), true, false);
+    generate_eve_span_company_for_primitive(l, ns, cstr("ShinyMeshVertexInc"), true, true);
+    generate_eve_span_company_for_non_primitive_clonable(l, ns, cstr("ShinyMeshTopology"), true, false);
+
+    /* Engine stuff */
+    generate_eve_span_company_for_primitive(l, ns, cstr("GenericModelOnSceneMem"), true, false);
+    generate_eve_span_company_for_primitive(l, ns, cstr("ShinyModelOnSceneMem"), true, false);
+    generate_eve_span_company_for_primitive(l, ns, cstr("GenericModelTexVulkPointers"), true, false);
+
+
+    generate_eve_span_company_for_primitive(l, ns, cstr("ObjectInfo"), true, false); // todo: delete this crap
+}
+
+#endif

src/l1/anne/codegen.c

@@ -13,6 +13,7 @@
 #include "embassy_l1_5.h"
 #include "margaret/png_pixel_masses.h"
 #include "lucy.h"
+#include "alice.h"
 
 int main() {
     mkdir_nofail("l1");
@@ -26,10 +27,10 @@ int main() {
     generate_marie_headers_for_graphics_geom();
     generate_liza_l1_headers();
     generate_l1_headers_for_l1_5();
-    mkdir_nofail("l1/margaret");
     generate_margaret_eve_for_vulkan_utils(); /* margaret misc */
     generate_margaret_png_pixel_masses_header();
     generate_l1_lucy_headers();
+    generate_code_for_alice_on_l1();
     finish_layer(cstr("l1"));
     return 0;
 }

src/l1/anne/margaret/margaret_misc.h

@@ -7,6 +7,7 @@
 void generate_margaret_eve_for_vulkan_utils() {
     SpanU8 l = cstr("l1");
     SpanU8 ns = cstr("margaret");
+    mkdir_nofail("l1/margaret");
     mkdir_nofail("l1/eve/margaret");
     generate_util_templ_inst_eve_header(l, ns, (util_templates_instantiation_options){
         .T = cstr("MargaretScoredPhysicalDevice"), .t_primitive = true, .vec = true, .sort = true

src/l1/anne/some_tests.h

@@ -5,22 +5,12 @@
 
 void generate_headers_for_r0_r1_r2_r3() {
     SpanU8 l = cstr("l1");
+    mkdir_nofail("l1/eve");
     mkdir_nofail("l1/eve/r0");
     {    /* Needed in r0_assets.h */
         SpanU8 ns = cstr("r0");
-        generate_eve_span_company_for_primitive(l, ns, cstr("GenericMeshVertexInc"), true, true);
-        generate_eve_span_company_for_non_primitive_clonable(l, ns, cstr("GenericMeshInSceneTemplate"), true, false);
-        generate_eve_span_company_for_primitive(l, ns, cstr("ShinyMeshVertexInc"), true, true);
-        generate_eve_span_company_for_non_primitive_clonable(l, ns, cstr("ShinyMeshTopology"), true, false);
         generate_eve_span_company_for_primitive(l, ns, cstr("Wimbzle"), true, false);
         generate_eve_span_company_for_primitive(l, ns, cstr("Nibzle"), true, false);
-        /* r0_scene.h */
-        generate_eve_span_company_for_primitive(l, ns, cstr("GenericModelOnSceneMem"), true, false);
-        generate_eve_span_company_for_primitive(l, ns, cstr("ShinyModelOnSceneMem"), true, false);
-
-        generate_eve_span_company_for_primitive(l, ns, cstr("ObjectInfo"), true, false);
-        /* r0 */
-        generate_eve_span_company_for_primitive(l, ns, cstr("GenericModelTexVulkPointers"), true, false);
     }
     mkdir_nofail("l1/eve/r2");
     {   /* r2 */

src/l2/alice/assets.h

@@ -10,7 +10,7 @@ typedef struct {
     vec2 tex;
 } GenericMeshVertexInc;
 
-#include "../../../gen/l1/eve/r0/VecAndSpan_GenericMeshVertexInc.h"
+#include "../../../gen/l1/eve/alice/VecAndSpan_GenericMeshVertexInc.h"
 
 typedef struct {
     GenericMeshVertexInc base;
@@ -54,7 +54,7 @@ GenericMeshInSceneTemplate GenericMeshInSceneTemplate_clone(const GenericMeshInS
     .specular_texture_path = VecU8_clone(&self->specular_texture_path)};
 }
 
-#include "../../../gen/l1/eve/r0/VecGenericMeshInSceneTemplate.h"
+#include "../../../gen/l1/eve/alice/VecGenericMeshInSceneTemplate.h"
 
 typedef struct {
     mat4 model_t;
@@ -74,7 +74,7 @@ typedef struct {
     ShinyMeshVertexInc base;
     vec3 normal;
 } ShinyMeshVertex;
-#include "../../../gen/l1/eve/r0/VecAndSpan_ShinyMeshVertexInc.h"
+#include "../../../gen/l1/eve/alice/VecAndSpan_ShinyMeshVertexInc.h"
 
 typedef struct {
     VecShinyMeshVertexInc vertices;
@@ -91,7 +91,7 @@ ShinyMeshTopology ShinyMeshTopology_clone(const ShinyMeshTopology* self) {
         VecU32_clone(&self->indexes)};
 }
 
-#include "../../../gen/l1/eve/r0/VecShinyMeshTopology.h"
+#include "../../../gen/l1/eve/alice/VecShinyMeshTopology.h"
 
 typedef struct{
     mat4 model_t;

src/l2/allie/Allie.hs

@@ -1,5 +1,80 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RankNTypes #-}
 
-module Allie (allieRun) where
+module Allie (justFuckingDoSomething) where
 
-foreign import ccall "allie_run" allieRun :: IO ()
+import Data.Word (Word8, Word16, Word32, Word64)
+import Data.Int (Int8, Int16, Int32, Int64)
+import Foreign.Ptr (Ptr, FunPtr, nullPtr, plusPtr, castPtr)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Storable (Storable(..))
+import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef)
+import qualified Data.Text
+import Data.Text.Encoding (encodeUtf8)
+import Data.ByteString (useAsCStringLen)
+
+data AliceOpaque
+type Alice = Ptr AliceOpaque
+
+foreign import ccall "Alice_new" newAlice :: IO Alice
+
+data AliceAnotherFrameCap s = AliceAnotherFrameCap Alice
+
+foreign import ccall "wrapper" allieMkAliceOnWaylandKeyboardKey :: (Alice -> IO ()) -> IO (FunPtr (Alice -> IO ()))
+foreign import ccall "wrapper" allieMkAliceOnAnotherFrame :: (Alice -> IO ()) -> IO (FunPtr (Alice -> IO ()))
+
+data Callbacks = Callbacks {
+  onWaylandKeyboardKey :: (Alice -> IO ()),
+  onAnotherFrame :: (forall s. AliceAnotherFrameCap s -> IO ())
+  }
+
+instance Storable Callbacks where
+  sizeOf _ = 8 + 8
+  alignment _ = 8
+  peek _ = error "Зачем тебе?"
+  poke ptr Callbacks{..} = do
+    poke (castPtr ptr) =<< allieMkAliceOnWaylandKeyboardKey onWaylandKeyboardKey
+    poke (castPtr ptr `plusPtr` 8) =<< allieMkAliceOnAnotherFrame onAnotherFramePrepared where
+      onAnotherFramePrepared = (\alice -> onAnotherFrame (AliceAnotherFrameCap alice))
+
+foreign import ccall "Alice_mainloop" allieAliceMainloop :: Alice -> Ptr Callbacks -> IO ()
+
+aliceMainloop :: Alice -> Callbacks -> IO ()
+aliceMainloop alice cb = alloca $ \ptr -> do
+    poke ptr cb
+    allieAliceMainloop alice ptr
+
+-- These are only correct in another_frame_callback, actually
+foreign import ccall "Alice_clear_screen_text" allieAliceClearScreenText :: Alice -> IO ()
+
+aliceClearScreenTextLabel :: AliceAnotherFrameCap s -> IO ()
+aliceClearScreenTextLabel (AliceAnotherFrameCap alice) = allieAliceClearScreenText alice
+
+foreign import ccall "allie_Alice_add_screen_text_label" allieAliceAddScreenTextLabel :: Alice -> Ptr Word8 -> Word64 -> IO ()
+
+aliceAddScreenTextLabel :: AliceAnotherFrameCap s -> String -> IO ()
+aliceAddScreenTextLabel (AliceAnotherFrameCap alice) str = useAsCStringLen (encodeUtf8 $ Data.Text.pack $ str) $ \(cstr, len) -> allieAliceAddScreenTextLabel alice (castPtr cstr) (fromIntegral len)
+
+-- Function to run the main loop with callbacks
+justFuckingDoSomething :: IO ()
+justFuckingDoSomething = do
+  alice <- newAlice
+  state <- newIORef 67
+  -- Create the Callbacks structure.
+  let callbacks = Callbacks myonKeyboardKey myonAnotherFrame where
+      myonKeyboardKey _ = do
+        old <- readIORef state
+        writeIORef state (old + 1)
+        putStrLn ("Doing" ++ show old ++ "this!") 
+      myonAnotherFrame alicePerm = do
+        cur <- readIORef state
+        aliceClearScreenTextLabel alicePerm
+        aliceAddScreenTextLabel alicePerm ("Current value is = " ++ show cur)
+  
+
+  -- Allocate space for the struct, poke it, and pass to C.
+  aliceMainloop alice callbacks

src/l3/r4/R4.hs

@@ -1,4 +1,4 @@
 import Allie
 
 main :: IO()
-main = allieRun
+main = justFuckingDoSomething