Generate GIF from Forth Haiku

This is using a hardcoded Haiku but this will eventually be something
that users will be able to upload and edit and mix, similar to the Forth
Salon website.

src/samples/forthsalon/CMakeLists.txt

@@ -9,3 +9,16 @@ target_link_libraries(forth
 	${ADDITIONAL_LIBRARIES}
 	m
 )
+
+add_executable(forthsalon
+	forth.c
+	main.c
+)
+
+ADD_DEFINITIONS(-fstack-usage)
+
+target_link_libraries(forthsalon
+	${LWAN_COMMON_LIBS}
+	${ADDITIONAL_LIBRARIES}
+	m
+)

src/samples/forthsalon/forth.c

@@ -14,7 +14,8 @@
  *
  * You should have received a copy of the GNU General Public License
  * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
+ * USA.
  */
 
 /*
@@ -37,6 +38,8 @@
 #include "lwan-array.h"
 #include "lwan-private.h"
 
+#include "forth.h"
+
 enum forth_opcode {
     OP_CALL_BUILTIN,
     OP_EVAL_CODE,
@@ -65,7 +68,8 @@ DEFINE_ARRAY_TYPE(forth_code, struct forth_inst)
 struct forth_word {
     union {
         bool (*callback)(struct forth_ctx *ctx, struct forth_vars *vars);
-        const char *(*callback_compiler)(struct forth_ctx *ctx, const char *code);
+        const char *(*callback_compiler)(struct forth_ctx *ctx,
+                                         const char *code);
         struct forth_code code;
     };
     bool is_builtin;
@@ -89,11 +93,6 @@ struct forth_ctx {
     bool is_inside_word_def;
 };
 
-struct forth_vars {
-    double x, y;
-    int t, dt;
-};
-
 #define PUSH_D(value_)                                                         \
     ({                                                                         \
         if (UNLIKELY(ctx->d_stack.pos >= N_ELEMENTS(ctx->d_stack.values)))     \
@@ -126,7 +125,6 @@ static inline double pop_r(struct forth_ctx *ctx)
     return (double)NAN;
 }
 
-
 #if DUMP_CODE
 static void dump_code(const struct forth_code *code)
 {
@@ -181,7 +179,8 @@ static bool eval_code(struct forth_ctx *ctx,
     LWAN_ARRAY_FOREACH (code, inst) {
         switch (inst->opcode) {
         case OP_EVAL_CODE:
-            if (UNLIKELY(!eval_code(ctx, inst->code, vars, recursion_limit - 1)))
+            if (UNLIKELY(
+                    !eval_code(ctx, inst->code, vars, recursion_limit - 1)))
                 return false;
             break;
         case OP_CALL_BUILTIN:
@@ -509,7 +508,8 @@ BUILTIN_COMPILER("if")
     return code;
 }
 
-static const char* builtin_else_then(struct forth_ctx *ctx, const char *code, bool is_then)
+static const char *
+builtin_else_then(struct forth_ctx *ctx, const char *code, bool is_then)
 {
     double v = POP_R();
     if (UNLIKELY(isnan(v))) {
@@ -1034,6 +1034,16 @@ void forth_free(struct forth_ctx *ctx)
     free(ctx);
 }
 
+size_t forth_d_stack_len(const struct forth_ctx *ctx)
+{
+    return ctx->d_stack.pos;
+}
+
+double forth_d_stack_pop(struct forth_ctx *ctx)
+{
+    return POP_D();
+}
+
 #if defined(FUZZ_TEST)
 int LLVMFuzzerTestOneInput(const uint8_t *data, size_t size)
 {
@@ -1069,7 +1079,9 @@ int main(int argc, char *argv[])
     if (!ctx)
         return 1;
 
-    if (!forth_parse_string(ctx, ": nice 60 5 4 + + ; : juanita 400 10 5 5 + + + ; x if nice  else juanita then 2 * 4 / 2 *")) {
+    if (!forth_parse_string(ctx,
+                            ": nice 60 5 4 + + ; : juanita 400 10 5 5 + + + ; "
+                            "x if nice  else juanita then 2 * 4 / 2 *")) {
         lwan_status_critical("could not parse forth program");
         forth_free(ctx);
         return 1;

src/samples/forthsalon/forth.h

@@ -0,0 +1,39 @@
+/*
+ * lwan - web server
+ * Copyright (c) 2025 L. A. F. Pereira <[email protected]>
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
+ * USA.
+ */
+
+#pragma once
+
+struct forth_ctx;
+
+struct forth_vars {
+    double x, y;
+    double t, dt;
+};
+
+bool forth_run(struct forth_ctx *ctx, struct forth_vars *vars);
+bool forth_parse_string(struct forth_ctx *ctx, const char *code);
+void forth_free(struct forth_ctx *ctx);
+struct forth_ctx *forth_new(void);
+size_t forth_d_stack_len(const struct forth_ctx *ctx);
+double forth_d_stack_pop(struct forth_ctx *ctx);
+
+
+
+