| … | |
… | |
| 126 | sv = newSV (0); |
126 | sv = newSV (0); |
| 127 | sv_magic (sv, 0, PERL_MAGIC_ext, (char *)ptr, 0); |
127 | sv_magic (sv, 0, PERL_MAGIC_ext, (char *)ptr, 0); |
| 128 | return sv_bless (newRV_noinc (sv), gv_stashpv (klass, 1)); |
128 | return sv_bless (newRV_noinc (sv), gv_stashpv (klass, 1)); |
| 129 | } |
129 | } |
| 130 | |
130 | |
|
|
131 | static void |
|
|
132 | SVptr_cache_set (void *ptr, SV *sv) |
|
|
133 | { |
|
|
134 | hv_store (obj_cache, (char *)&ptr, sizeof (ptr), sv, 0); |
|
|
135 | } |
|
|
136 | |
| 131 | static SV * |
137 | static SV * |
| 132 | SVptr_cached (void *ptr) |
138 | SVptr_cache_get (void *ptr) |
| 133 | { |
139 | { |
| 134 | SV **he = hv_fetch (obj_cache, (char *)&ptr, sizeof (ptr), 0); |
140 | SV **he = hv_fetch (obj_cache, (char *)&ptr, sizeof (ptr), 0); |
| 135 | |
141 | |
| 136 | return he ? *he : 0; |
142 | return he ? *he : 0; |
| 137 | } |
143 | } |
| … | |
… | |
| 142 | SV *sv; |
148 | SV *sv; |
| 143 | |
149 | |
| 144 | if (!ptr) |
150 | if (!ptr) |
| 145 | return &PL_sv_undef; |
151 | return &PL_sv_undef; |
| 146 | |
152 | |
| 147 | sv = SVptr_cached (ptr); |
153 | sv = SVptr_cache_get (ptr); |
| 148 | |
154 | |
| 149 | if (!sv) |
155 | if (!sv) |
| 150 | { |
156 | { |
| 151 | HV *hv = newHV (); |
157 | HV *hv = newHV (); |
| 152 | sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0); |
158 | sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0); |
| 153 | sv = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); |
159 | sv = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); |
| 154 | hv_store (obj_cache, (char *)&ptr, sizeof (ptr), sv, 0); |
160 | |
|
|
161 | SVptr_cache_set (ptr, sv); |
| 155 | } |
162 | } |
| 156 | |
163 | |
| 157 | return newSVsv (sv); |
164 | return newSVsv (sv); |
| 158 | } |
165 | } |
| 159 | |
166 | |
| … | |
… | |
| 1564 | case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; |
1571 | case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; |
| 1565 | } |
1572 | } |
| 1566 | OUTPUT: |
1573 | OUTPUT: |
| 1567 | RETVAL |
1574 | RETVAL |
| 1568 | |
1575 | |
|
|
1576 | # "serialise" map perl data into a ref |
| 1569 | void |
1577 | void |
| 1570 | _get_obs (mapstruct *map) |
1578 | _get_obs (mapstruct *map) |
| 1571 | PPCODE: |
1579 | PPCODE: |
| 1572 | { |
1580 | { |
| 1573 | object *o; |
1581 | object *o; |
| … | |
… | |
| 1580 | { |
1588 | { |
| 1581 | AV *av = newAV (); |
1589 | AV *av = newAV (); |
| 1582 | |
1590 | |
| 1583 | for (o = GET_MAP_OB (map, x, y); o; o = o->above) |
1591 | for (o = GET_MAP_OB (map, x, y); o; o = o->above) |
| 1584 | { |
1592 | { |
| 1585 | SV *sv = SVptr_cached (o); |
1593 | SV *sv = SVptr_cache_get (o); |
| 1586 | |
1594 | |
| 1587 | if (sv && HvFILL (SvRV (sv))) |
1595 | if (sv && HvFILL (SvRV (sv))) |
| 1588 | { |
1596 | { |
| 1589 | nonnull = 1; |
1597 | nonnull = 1; |
| 1590 | sv = newSVsv (sv); |
1598 | sv = newSVsv (sv); |
| … | |
… | |
| 1602 | XPUSHs (sv_2mortal (newRV_noinc ((SV *)obs))); |
1610 | XPUSHs (sv_2mortal (newRV_noinc ((SV *)obs))); |
| 1603 | else |
1611 | else |
| 1604 | SvREFCNT_dec (obs); |
1612 | SvREFCNT_dec (obs); |
| 1605 | } |
1613 | } |
| 1606 | |
1614 | |
|
|
1615 | # "deserialise" perl map data into the map |
|
|
1616 | void |
|
|
1617 | _set_obs (mapstruct *map, SV *sv) |
|
|
1618 | CODE: |
|
|
1619 | { |
|
|
1620 | object *o; |
|
|
1621 | AV *av; |
|
|
1622 | int x, y; |
|
|
1623 | AV *obs = (AV *)SvRV (sv); |
|
|
1624 | |
|
|
1625 | for (y = 0; y < MAP_HEIGHT (map); y++) |
|
|
1626 | for (x = 0; x < MAP_WIDTH (map); x++) |
|
|
1627 | { |
|
|
1628 | sv = *av_fetch (obs, x + y * MAP_HEIGHT (map), 1); |
|
|
1629 | |
|
|
1630 | if (!SvROK (sv)) |
|
|
1631 | continue; |
|
|
1632 | |
|
|
1633 | av = (AV *)SvRV (sv); |
|
|
1634 | |
|
|
1635 | for (o = GET_MAP_OB (map, x, y); o; o = o->above) |
|
|
1636 | { |
|
|
1637 | sv = av_shift (av); |
|
|
1638 | |
|
|
1639 | if (SvROK (sv)) |
|
|
1640 | { |
|
|
1641 | sv_magic ((SV *)SvRV (sv), 0, PERL_MAGIC_ext, (char *)o, 0); |
|
|
1642 | SVptr_cache_set (o, sv); |
|
|
1643 | } |
|
|
1644 | } |
|
|
1645 | } |
|
|
1646 | } |
|
|
1647 | |
| 1607 | MODULE = cf PACKAGE = cf::arch PREFIX = cf_archetype_ |
1648 | MODULE = cf PACKAGE = cf::arch PREFIX = cf_archetype_ |
| 1608 | |
1649 | |
| 1609 | archetype *cf_archetype_get_first() |
1650 | archetype *cf_archetype_get_first() |
| 1610 | PROTOTYPE: |
1651 | PROTOTYPE: |
| 1611 | ALIAS: first = 0 |
1652 | ALIAS: first = 0 |
