Move adjacency map stuff to C for performance reasons.
authormdw <mdw>
Fri, 7 Mar 2003 00:43:50 +0000 (00:43 +0000)
committermdw <mdw>
Fri, 7 Mar 2003 00:43:50 +0000 (00:43 +0000)
elite.c

diff --git a/elite.c b/elite.c
index c9a9773..8c7aeee 100644 (file)
--- a/elite.c
+++ b/elite.c
@@ -1,6 +1,6 @@
 /* -*-c-*-
  *
- * $Id: elite.c,v 1.1 2003/02/24 01:13:12 mdw Exp $
+ * $Id: elite.c,v 1.2 2003/03/07 00:43:50 mdw Exp $
  *
  * Elite planet data
  *
@@ -27,6 +27,9 @@
 /*----- Revision history --------------------------------------------------* 
  *
  * $Log: elite.c,v $
+ * Revision 1.2  2003/03/07 00:43:50  mdw
+ * Move adjacency map stuff to C for performance reasons.
+ *
  * Revision 1.1  2003/02/24 01:13:12  mdw
  * Initial import.
  *
 /*----- Header files ------------------------------------------------------*/
 
 #include <ctype.h>
+#include <math.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
 
 #include <tcl.h>
 
+
 /*----- Data structures ---------------------------------------------------*/
 
 typedef struct world {
@@ -380,6 +385,7 @@ static int cmd_worldinfo(ClientData cd, Tcl_Interp *ti,
   /* --- Get the basic information --- */
 
   getworldinfo(&wi, w);
+  Tcl_UnsetVar(ti, arr, 0);
   if (!Tcl_SetVar2Ex(ti, arr, "x", Tcl_NewIntObj(wi.x * 4),
                     TCL_LEAVE_ERR_MSG) ||
       !Tcl_SetVar2Ex(ti, arr, "y", Tcl_NewIntObj(wi.y * 2),
@@ -509,6 +515,7 @@ static int cmd_market(ClientData cd, Tcl_Interp *ti,
     return (TCL_ERROR);
   getworldinfo(&wi, w);
 
+  Tcl_UnsetVar(ti, arr, 0);
   for (i = items; i->name; i++) {
     unsigned pr, qt;
     Tcl_Obj *oo[2];
@@ -788,6 +795,7 @@ static int cmd_unpackcmdr(ClientData cd, Tcl_Interp *ti,
 
   /* --- Deconstruct the data --- */
 
+  Tcl_UnsetVar(ti, arr, 0);
   for (c = cmdtab; c->name; c++) {
     if (c->get && c->get(ti, arr, p + c->off, c))
       return (TCL_ERROR);
@@ -822,6 +830,154 @@ static int cmd_packcmdr(ClientData cd, Tcl_Interp *ti,
   return (0);
 }
 
+/*----- Optimizations -----------------------------------------------------*/
+
+/* --- @elite-galaxylist SEED@ --- *
+ *
+ * Returns a SEED/X/Y list for the worlds in galaxy SEED.
+ */
+
+static int cmd_galaxylist(ClientData cd, Tcl_Interp *ti,
+                         int objc, Tcl_Obj *const *objv)
+{
+  world *w, ww;
+  worldinfo wi;
+  int i;
+  Tcl_Obj *o;
+
+  if (objc != 2)
+    return (err(ti, "usage: elite-galaxylist SEED"));
+  if ((w = world_get(ti, objv[1])) == 0)
+    return (TCL_ERROR);
+  ww = *w;
+  o = Tcl_NewListObj(0, 0);
+  for (i = 0; i < 256; i++) {
+    getworldinfo(&wi, &ww);
+    Tcl_ListObjAppendElement(ti, o, world_new(&ww));
+    Tcl_ListObjAppendElement(ti, o, Tcl_NewIntObj(wi.x * 4));
+    Tcl_ListObjAppendElement(ti, o, Tcl_NewIntObj(wi.y * 2));
+    waggle(&ww, &ww); waggle(&ww, &ww); waggle(&ww, &ww); waggle(&ww, &ww);
+  }
+  Tcl_SetObjResult(ti, o);
+  return (TCL_OK);
+}
+
+/* --- @elite-distance X Y XX YY@ --- *
+ *
+ * Returns the distance between two points.
+ */
+
+static int cmd_distance(ClientData cd, Tcl_Interp *ti,
+                       int objc, Tcl_Obj *const *objv)
+{
+  long x, y, xx, yy;
+  long d;
+
+  if (objc != 5)
+    return (err(ti, "usage: elite-distance X Y XX YY"));
+  if (Tcl_GetLongFromObj(ti, objv[1], &x) != TCL_OK ||
+      Tcl_GetLongFromObj(ti, objv[2], &y) != TCL_OK ||
+      Tcl_GetLongFromObj(ti, objv[3], &xx) != TCL_OK ||
+      Tcl_GetLongFromObj(ti, objv[4], &yy) != TCL_OK)
+    return (TCL_ERROR);
+  xx = xx >= x ? xx - x : x - xx; xx >>= 2; xx *= xx;
+  yy = yy >= y ? yy - y : y - yy; yy >>= 2; yy *= yy;
+  d = sqrt(xx + yy); d <<= 2;
+  Tcl_SetObjResult(ti, Tcl_NewLongObj(d));
+  return (TCL_OK);
+}
+
+/* --- @elite-adjacency ADJ LIST [DIST]@ --- *
+ *
+ * Construct an adjacency table from a world list.
+ */
+
+static int cmd_adjacency(ClientData cd, Tcl_Interp *ti,
+                        int objc, Tcl_Obj *const *objv)
+{
+  int oc;
+  Tcl_Obj **ov;
+  size_t i, j;
+  long x, y, xx, yy, d;
+  Tcl_Obj *a;
+  char *s, *ss;
+  Tcl_HashTable done;
+  long dd = 70;
+  int rc = TCL_ERROR;
+  int dummy;
+  Tcl_Obj *o;
+
+  if (objc < 3 || objc > 4)
+    return (err(ti, "usage: elite-adjacency ADJ LIST [DIST]"));
+  a = objv[1];
+  if (Tcl_ListObjGetElements(ti, objv[2], &oc, &ov) != TCL_OK)
+    return (TCL_ERROR);
+  if (oc % 3 != 0)
+    return (err(ti, "world array not a multiple of three in size"));
+  if (objc >= 4 && Tcl_GetLongFromObj(ti, objv[3], &dd) != TCL_OK)
+    return (TCL_ERROR);
+
+  Tcl_InitHashTable(&done, TCL_ONE_WORD_KEYS);
+  Tcl_UnsetVar(ti, Tcl_GetString(a), 0);
+  o = Tcl_NewObj();
+  Tcl_IncrRefCount(o);
+  for (i = 0; i < oc; i += 3) {
+    s = Tcl_GetString(ov[i]);
+    if (Tcl_ObjSetVar2(ti, a, ov[i], o, TCL_LEAVE_ERR_MSG) == 0)
+      goto done;
+  }
+  for (i = 0; i < oc; i += 3) {
+    s = Tcl_GetString(ov[i]);  
+    Tcl_CreateHashEntry(&done, s, &dummy);
+    if (Tcl_GetLongFromObj(ti, ov[i + 1], &x) != TCL_OK ||
+       Tcl_GetLongFromObj(ti, ov[i + 2], &y) != TCL_OK)
+      goto done;
+    for (j = 0; j < oc; j += 3) {
+      ss = Tcl_GetString(ov[j]);
+      if (Tcl_FindHashEntry(&done, ss))
+       continue;
+      if (Tcl_GetLongFromObj(ti, ov[j + 1], &xx) != TCL_OK ||
+         Tcl_GetLongFromObj(ti, ov[j + 2], &yy) != TCL_OK)
+       goto done;
+      xx = xx >= x ? xx - x : x - xx; xx >>= 2; xx *= xx;
+      yy = yy >= y ? yy - y : y - yy; yy >>= 2; yy *= yy;
+      d = sqrt(xx + yy); d <<= 2;
+      if (d <= dd) {
+       if (Tcl_ObjSetVar2(ti, a, ov[i], ov[j],
+                          (TCL_APPEND_VALUE |
+                           TCL_LIST_ELEMENT |
+                           TCL_LEAVE_ERR_MSG)) == 0 ||
+           Tcl_ObjSetVar2(ti, a, ov[i], ov[j + 1],
+                          (TCL_APPEND_VALUE |
+                           TCL_LIST_ELEMENT |
+                           TCL_LEAVE_ERR_MSG)) == 0 ||
+           Tcl_ObjSetVar2(ti, a, ov[i], ov[j + 2],
+                          (TCL_APPEND_VALUE |
+                           TCL_LIST_ELEMENT |
+                           TCL_LEAVE_ERR_MSG)) == 0 ||
+           Tcl_ObjSetVar2(ti, a, ov[j], ov[i],
+                          (TCL_APPEND_VALUE |
+                           TCL_LIST_ELEMENT |
+                           TCL_LEAVE_ERR_MSG)) == 0 ||
+           Tcl_ObjSetVar2(ti, a, ov[j], ov[i + 1],
+                          (TCL_APPEND_VALUE |
+                           TCL_LIST_ELEMENT |
+                           TCL_LEAVE_ERR_MSG)) == 0 ||
+           Tcl_ObjSetVar2(ti, a, ov[j], ov[i + 2],
+                          (TCL_APPEND_VALUE |
+                           TCL_LIST_ELEMENT |
+                           TCL_LEAVE_ERR_MSG)) == 0)
+         goto done;
+      }
+    }
+  }
+  rc = TCL_OK;
+
+done:
+  Tcl_DeleteHashTable(&done);
+  return (rc);
+}
+
 /*----- Initialization ----------------------------------------------------*/
 
 int Elite_SafeInit(Tcl_Interp *ti)
@@ -836,6 +992,9 @@ int Elite_SafeInit(Tcl_Interp *ti)
     { "elite-market",          cmd_market },
     { "elite-unpackcmdr",      cmd_unpackcmdr },
     { "elite-packcmdr",                cmd_packcmdr },
+    { "elite-distance",                cmd_distance },
+    { "elite-galaxylist",      cmd_galaxylist },
+    { "elite-adjacency",       cmd_adjacency },
     { 0,                       0 }
   };
 
@@ -843,7 +1002,7 @@ int Elite_SafeInit(Tcl_Interp *ti)
   for (c = cmds; c->name; c++)
     Tcl_CreateObjCommand(ti, c->name, c->proc, 0, 0);
   Tcl_RegisterObjType(&world_type);
-  if (Tcl_PkgProvide(ti, "elite-bits", "1.0.0"))
+  if (Tcl_PkgProvide(ti, "elite-bits", "1.0.1"))
     return (TCL_ERROR);
   return (TCL_OK);
 }