Embeddable CL(2)

#include <stdio.h>
#include <ecl/ecl.h>

cl_object c_func(cl_object cl_x)
/* вообразим, что эта функция делает что-то важное и полезное. Например, умножает аргумент на 2 */
{
  int x = fixint(cl_x);
  printf ("c function called from LISP\n");
  return ecl_make_int(2 * x); /* возвернём результат, обернув его в ECL-структуру */
}

cl_object draw_line (cl_object StartPoint, cl_object EndPoint)
/* а тут вообразим функцию, рисующую линию между двумя точками */
{
    int x1, y1, x2, y2;
    /* выудим данные из структур POINT (см. код another-one.lisp) */
    x1 = fixint (funcall (2, c_string_to_object("point-x"), StartPoint));
    y1 = fixint (funcall (2, c_string_to_object("point-y"), StartPoint));
    x2 = fixint (funcall (2, c_string_to_object("point-x"), EndPoint));
    y2 = fixint (funcall (2, c_string_to_object("point-y"), EndPoint));
    printf ("Will draw a line from (%d,%d) to (%d,%d)\n", x1, y1, x2, y2);
    /*
    ** Тут как бы вызов графического движка
    */
    return Ct; /* у нас всё хорошо, возвернём true */
}

inline cl_object eval(char *str) /* удобная обёртка к eval */
{
  return cl_safe_eval(c_string_to_object(str), Cnil, OBJNULL);
}

int main(int argc, char *argv[])
{
  int res;
  
  /* Включаем LISP-движок */
  cl_boot(argc, argv);

  /* подключаем интерфейсы к Си-функциям */
  cl_def_c_function(c_string_to_object("C-FUNC"), (cl_objectfn_fixed)c_func, 1);
  cl_def_c_function(c_string_to_object("draw-line"), (cl_objectfn_fixed)draw_line, 2);

  /* Загружаем lisp-код. С тем же успехом можно загрузить .FASы */
  eval("(load \"embedded.lisp\")");
  eval("(load \"another-one.lisp\")");
  
  /* Вызовем сишную функцию через лисп-движок (чисто из любви к искусству) */
  printf ("Calling... Result is %d\n", fixint (eval ("(c-func 10)")));

  /* Вызовем лисп-функцию */
  res = fixint(eval("(just-return-something)"));
  printf ("Just Returned Something: %d\n", res);

  /* Вызовем ещё одну лисп-функцию и другого "модуля" */
  res = fixint(eval("(call-another-one)"));
  printf ("...Returned Something: %d\n", res);

  /* Выключаем движок и уходим */
  cl_shutdown();
  return 0;
}

; code to invoke from ECL binary, will call C-FUNC

(format t "Trying to call c-func; result is here: ~A~%" (c-func 2))

(setf testl (list 1 2 "string" 'A 3 4))

(defun just-return-something ()
    666
)

(defun call-another-one ()
 (format t "This is another one piece of a LISP code!~%")
 (some-func) 
 (some-func 'a)
 (some-func 1)
 (draw-lines lines)
 1
)

(defun some-func (&optional arg)
 (if (null arg)
  (progn
   (format t "Have no args to work with~%")
   0
  )
  (progn
   (format t "Have an arg with TYPE ~A and VALUE ~A~%" (type-of arg) arg)
   1
  )
 )
)

(defun draw-lines (linelist)
 (format t "Drawing the lines...~%")
 (if (null linelist)
  (format t "linelist is empty, nothing to do~%")
  (progn
    (format t "working with linelist~%")
    (dolist (line linelist)
      ;(draw (point-x (line-start line)) (point-y (line-start line)) (point-x (line-end line)) (point-y (line-end line)))
      (draw-line (line-start line) (line-end line))
    )
    nil
  )
 )
)

(defstruct Point
 (x 0 :type integer)
 (y 0 :type integer)
)

(defstruct Line
 (Start (make-point) :type Point)
 (End (make-point) :type Point)
)

(defvar lines
  (list 
    (make-line :start (make-point :x 1 :y 1) :end (make-point :x 10 :y 10))
    (make-line :start (make-point :x 10 :y 10) :end (make-point :x 30 :y 40))
  )
)