[Stratagus-CVS] stratagus/src clone/ccl.c clone/ccl_helpers.c i...

[ludovic pollet]

CVSROOT:        /cvsroot/stratagus
Module name:    stratagus
Branch:         
Changes by:     ludovic pollet <address@hidden> 03/11/14 11:47:41

Modified files:
        src/clone      : ccl.c ccl_helpers.c 
        src/include    : ccl.h 

Log message:
        lprin1CL for guile (i.e. correct saving for triggers & AI)

Patches:
Index: stratagus/src/clone/ccl.c
diff -u stratagus/src/clone/ccl.c:1.130 stratagus/src/clone/ccl.c:1.131
--- stratagus/src/clone/ccl.c:1.130     Wed Nov 12 15:40:22 2003
+++ stratagus/src/clone/ccl.c   Fri Nov 14 11:47:40 2003
@@ -26,7 +26,7 @@
 //      Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 //      02111-1307, USA.
 //
-//     $Id: ccl.c,v 1.130 2003/11/12 20:40:22 jsalmon3 Exp $
+//     $Id: ccl.c,v 1.131 2003/11/14 16:47:40 pludov Exp $
 
 //@{
 
@@ -1794,6 +1794,11 @@
     EditorCclRegister();
 
 #if defined(USE_GUILE) || defined(USE_SIOD)
+
+#if defined(USE_GUILE)
+    gh_eval_str("(define as-string (lambda (obj) (with-output-to-string 
(lambda () (write obj)))))");
+#endif
+
     gh_new_procedure1_0("load-pud", CclLoadPud);
     gh_new_procedure1_0("load-map", CclLoadMap);
     gh_new_procedure2_0("define-map", CclDefineMap);
@@ -1980,7 +1985,7 @@
     }
 
     fprintf(fd, ";;; -----------------------------------------\n");
-    fprintf(fd, ";;; $Id: ccl.c,v 1.130 2003/11/12 20:40:22 jsalmon3 Exp $\n");
+    fprintf(fd, ";;; $Id: ccl.c,v 1.131 2003/11/14 16:47:40 pludov Exp $\n");
 
     fprintf(fd, "(set-video-resolution! %d %d)\n", VideoWidth, VideoHeight);
     
@@ -2000,7 +2005,7 @@
     }
 
     fprintf(fd, "--[[\n");
-    fprintf(fd, "      $Id: ccl.c,v 1.130 2003/11/12 20:40:22 jsalmon3 Exp 
$\n");
+    fprintf(fd, "      $Id: ccl.c,v 1.131 2003/11/14 16:47:40 pludov Exp $\n");
     fprintf(fd, "]]\n");
 
     fprintf(fd, "SetVideoResolution(%d, %d)\n", VideoWidth, VideoHeight);
@@ -2027,7 +2032,7 @@
     }
 
     fprintf(fd, ";;; -----------------------------------------\n");
-    fprintf(fd, ";;; $Id: ccl.c,v 1.130 2003/11/12 20:40:22 jsalmon3 Exp $\n");
+    fprintf(fd, ";;; $Id: ccl.c,v 1.131 2003/11/14 16:47:40 pludov Exp $\n");
 
     // Global options
     if (OriginalFogOfWar) {
@@ -2108,7 +2113,7 @@
     }
 
     fprintf(fd, "--[[\n");
-    fprintf(fd, "      $Id: ccl.c,v 1.130 2003/11/12 20:40:22 jsalmon3 Exp 
$\n");
+    fprintf(fd, "      $Id: ccl.c,v 1.131 2003/11/14 16:47:40 pludov Exp $\n");
     fprintf(fd, "]]\n");
 
     fprintf(fd, "SetVideoFullscreen(%s)\n", VideoFullScreen ? "true" : 
"false");
@@ -2163,7 +2168,7 @@
     extern SCM oblistvar;
 
     CLprintf(file, "\n;;; -----------------------------------------\n");
-    CLprintf(file, ";;; MODULE: CCL $Id: ccl.c,v 1.130 2003/11/12 20:40:22 
jsalmon3 Exp $\n\n");
+    CLprintf(file, ";;; MODULE: CCL $Id: ccl.c,v 1.131 2003/11/14 16:47:40 
pludov Exp $\n\n");
 
     for (list = oblistvar; gh_list_p(list); list = gh_cdr(list)) {
        SCM sym;
Index: stratagus/src/clone/ccl_helpers.c
diff -u stratagus/src/clone/ccl_helpers.c:1.7 
stratagus/src/clone/ccl_helpers.c:1.8
--- stratagus/src/clone/ccl_helpers.c:1.7       Wed Nov 12 15:40:23 2003
+++ stratagus/src/clone/ccl_helpers.c   Fri Nov 14 11:47:41 2003
@@ -26,7 +26,7 @@
 //      Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 //      02111-1307, USA.
 //
-//      $Id: ccl_helpers.c,v 1.7 2003/11/12 20:40:23 jsalmon3 Exp $
+//      $Id: ccl_helpers.c,v 1.8 2003/11/14 16:47:41 pludov Exp $
 
 //@{
 
@@ -268,7 +268,7 @@
        ++IOTabLevel;
        while (*((void **) current)) {
            IOPrintTabs();
-           IOStructPtr(gh_car(scmfrom), current, itemDef);
+           IOStructPtr(SCM_UNSPECIFIED, current, itemDef);
            CLprintf(IOOutFile, "\n");
 
            // Get the next...
@@ -367,8 +367,47 @@
     }
     if (IOLoadingMode) {
        (*((char **) binaryform)) = gh_scm2newstr(scmfrom, 0);
-    } else {                           // FIXME : (pludov) better string 
support
-       CLprintf(IOOutFile, " \"%s\"", (*((char **) binaryform)));
+    } else {
+       char* str, *escape;
+       char buffer[1024];
+       int i;
+       
+       str = (*((char **) binaryform));
+       
+       // Escape '"' & '\n'
+       CLprintf(IOOutFile," \"");
+       do {
+           escape = str;
+           while (*escape && (*escape != '\n' && *escape != '"')) {
+               escape++;
+           }
+
+           if (!*escape) {
+               CLprintf(IOOutFile, "%s", str);
+               break;
+           }
+           
+           while (str < escape) {
+               i = 0;
+               while (str < escape && i < 1023) {
+                   buffer[i] = *str;
+                   str++;
+                   i++;
+               }
+               buffer[i] = 0;
+               CLprintf(IOOutFile, "%s", buffer);
+           }
+           switch (*escape) {
+               case '\n':
+                   CLprintf(IOOutFile, "\\n");
+                   break;
+               case '"':
+                   CLprintf(IOOutFile, "\\\"");
+                   break;
+           }
+           str = escape + 1;
+       }while(1);
+       CLprintf(IOOutFile,"\"");
     }
 }
 
@@ -571,7 +610,7 @@
 **
 **     @param  scmform         When loading, the scm data to load
 **     @param  binaryform      Pointer to the array ( int * )
-**     @param  para            Size of array to allocate/save 
+**     @param  para            Size of array to load/save 
 */
 global void IOIntArray(SCM scmfrom, void *binaryform, void *para)
 {
@@ -714,5 +753,16 @@
        CLprintf(IOOutFile, " %d", playerid);
     }
 }
+
+#if defined(USE_GUILE)
+global char* CclRepresentation(SCM value)
+{
+    SCM eval,string;
+    eval = 
gh_list(gh_symbol2scm("as-string"),gh_list(gh_symbol2scm("quote"),value,SCM_UNDEFINED),SCM_UNDEFINED);
+    string = gh_eval(eval, NIL);
+    return gh_scm2newstr(string, 0);
+}
+#endif
+
 #elif defined(USE_LUA)
 #endif
Index: stratagus/src/include/ccl.h
diff -u stratagus/src/include/ccl.h:1.42 stratagus/src/include/ccl.h:1.43
--- stratagus/src/include/ccl.h:1.42    Wed Nov 12 15:03:46 2003
+++ stratagus/src/include/ccl.h Fri Nov 14 11:47:41 2003
@@ -26,7 +26,7 @@
 //      Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 //      02111-1307, USA.
 //
-//     $Id: ccl.h,v 1.42 2003/11/12 20:03:46 jsalmon3 Exp $
+//     $Id: ccl.h,v 1.43 2003/11/14 16:47:41 pludov Exp $
 
 #ifndef __CCL_H__
 #define __CCL_H__
@@ -57,8 +57,7 @@
 #  define setvar(sym, value, env) scm_define(sym,value)
 #  define vload(buf,cflag,rflag)  gh_load(buf)
 #  define errl(message, value)    { fputs(message, stdout); gh_display(value); 
putchar('\n'); }
-// FIXME : support for guile lprin1CL needed
-#  define lprin1CL(var, file)
+#  define lprin1CL(var, file)    { char * tmp; tmp=CclRepresentation(var); 
CLprintf(file,"%s",tmp); free(tmp); }
 #  define gh_new_procedureN(name, proc) gh_new_procedure(name, proc, 0, 0, 1)
 #  define aset1(array, pos, value)      gh_vector_set_x(array, pos, value)
 #  define repl_c_string(msg, a, b, c  ) gh_eval_str(msg)
@@ -73,6 +72,7 @@
 extern int siod_verbose_level;
 struct gen_printio* f;
 typedef scm_t_bits ccl_smob_type_t;
+extern char* CclRepresentation(SCM value);
 
 
 #elif defined(USE_SIOD)