view release on metacpan or  search on metacpan

lib/AntTweakBar.xs  view on Meta::CPAN

    Perl_croak(aTHX_ "Hashref cannot be undefined");
  }
  HV* hv =(HV*) SvRV(hash_ref);
  HE* entry;
  U32 total_keys = 0;
  hv_iterinit(hv);
  while((entry = hv_iternext(hv)) != NULL){
    I32 key_length;
    char* key = hv_iterkey(entry, &key_length);
    SV* sv_index = hv_iterval(hv, entry);
    if(sv_index && SvOK(sv_index)){
      total_keys++;
    }
  }
  TwEnumVal* enum_values = (TwEnumVal*) malloc(sizeof(TwEnumVal) * total_keys);
  TwEnumVal* enum_ptr = enum_values;
  while((entry = hv_iternext(hv)) != NULL){
    I32 key_length;
    char* key = hv_iterkey(entry, &key_length);
    SV* sv_label = hv_iterval(hv, entry);
    if(sv_label && SvOK(sv_label)){
      const char* label = SvPV_nolen(sv_label);
      (*enum_ptr).Value = atoi(key);
      (*enum_ptr).Label = label;
      enum_ptr++;
    }
  }
  TwType new_type = !_disabled_lib_mode()
    ? TwDefineEnum(name, enum_values, total_keys)
    : TW_TYPE_UNDEF;
  _add_type(name, new_type, &_int_getter, &_int_setter, &_int_getter_cb, &_int_setter_cb);
  free(enum_values);
  return new_type;
}

void _refresh(TwBar* bar){
  dTHX;
  int result = TwRefreshBar(bar);
  if(!result)
    Perl_croak(aTHX_ "Refreshing error: %s", TwGetLastError());
}

void _set_bar_parameter(TwBar* bar, const char* param_name, const char* param_value) {
  dTHX;
  int result = TwSetParam(bar, NULL, param_name, TW_PARAM_CSTRING, 1, param_value);
  if(!result)
    Perl_croak(aTHX_ "Error applying value '%s' to parameter %s : %s",
	       param_value, param_name, TwGetLastError());
}

void _set_variable_parameter(TwBar* bar, const char* variable, 
			     const char* param_name, const char* param_value) {
  dTHX;
  int result = TwSetParam(bar, variable, param_name, TW_PARAM_CSTRING, 1, param_value);
  if(!result)
    Perl_croak(aTHX_ "Error applying value '%s' of parameter %s to variable %s : %s",
	       param_value, param_name, variable, TwGetLastError());
}

/* CALLBACKS */
/* int/bool callbacks */

void TW_CALL _int_getter(void* value, void* data){
  dTHX;
  SV* sv = SvRV((SV*) data);
  SvGETMAGIC(sv);
  int iv = SvOK(sv) ? SvIV(sv) : 0;
  *(int*)value = iv;
}

void TW_CALL _int_getter_cb(void* value, void* data){
  dTHX;
  SV** cb = hv_fetch(_cb_read_map, (char*) data, sizeof(SV*), 0);
  dSP;
  PUSHMARK(SP);
  int count = call_sv(*cb, G_NOARGS|G_SCALAR);
  SPAGAIN;
  if (count != 1)
    Perl_croak(aTHX_ "Expected 1 arg to be returned from _int_getter \n");
  SV* sv = POPs;
  *(int*)value = SvOK(sv) ? SvIV(sv) : 0;
}

void TW_CALL _int_setter(const void* value, void* data){
  dTHX;
  SV* sv = SvRV((SV*) data);
  sv_setiv(sv, *(int*)value );
  SvSETMAGIC(sv);
}

void TW_CALL _int_setter_cb(const void* value, void* data){
  dTHX;
  SV** cb = hv_fetch(_cb_write_map, (char*) data, sizeof(SV*), 0);
  dSP;
  ENTER;
  SAVETMPS;
  PUSHMARK(SP);
  XPUSHs(sv_2mortal(newSViv(*(int*)value)));
  PUTBACK;
    call_sv(*cb, G_DISCARD);
  FREETMPS;
  LEAVE;
}

/* number(double) callbacks */

void TW_CALL _number_getter(void* value, void* data){
  dTHX;
  SV* sv = SvRV((SV*) data);
  SvGETMAGIC(sv);
  double dv = SvOK(sv) ? SvNV(sv) : 0.0;
  *(double*)value = dv;
}

void TW_CALL _number_setter(const void* value, void* data){
  dTHX;
  SV* sv = SvRV((SV*) data);
  sv_setnv(sv, *(double*)value );
  SvSETMAGIC(sv);
}

void TW_CALL _number_getter_cb(void* value, void* data){
  dTHX;
  SV** cb = hv_fetch(_cb_read_map, (char*) data, sizeof(SV*), 0);
  dSP;
  PUSHMARK(SP);
  int count = call_sv(*cb, G_NOARGS|G_SCALAR);
  SPAGAIN;
  if (count != 1)
    Perl_croak(aTHX_ "Expected 1 arg to be returned from _number_getter_cb \n");
  SV* sv = POPs;
  *(double*)value = SvOK(sv) ? SvNV(sv) : 0.0;
}

void TW_CALL _number_setter_cb(const void* value, void* data){
  dTHX;
  SV** cb = hv_fetch(_cb_write_map, (char*) data, sizeof(SV*), 0);
  dSP;
  ENTER;
  SAVETMPS;
  PUSHMARK(SP);
  XPUSHs(sv_2mortal(newSVnv(*(double*)value)));
  PUTBACK;
    call_sv(*cb, G_DISCARD);
  FREETMPS;
  LEAVE;
}

/* string callbacks */

void TW_CALL _string_getter(void* value, void* data){
  dTHX;
  SV* sv = SvRV((SV*) data);
  SvGETMAGIC(sv);
  const char* string = SvOK(sv) ? SvPV_nolen(sv) : "";
  *(const char**)value = string;
}

void TW_CALL _string_getter_cb(void* value, void* data){
  dTHX;
  SV** cb = hv_fetch(_cb_read_map, (char*) data, sizeof(SV*), 0);
  dSP;
  PUSHMARK(SP);
  int count = call_sv(*cb, G_NOARGS|G_SCALAR);
  SPAGAIN;
  if (count != 1)
    Perl_croak(aTHX_ "Expected 1 arg to be returned from _string_getter_cb \n");
  SV* sv_string = POPs;
  if(!SvPOK(sv_string)) {
    Perl_croak(aTHX_ "_string_getter_cb got not a string\n");
  }
  *(const char**)value = SvPV_nolen(sv_string);
}

void TW_CALL _string_setter(const void* value, void* data){
  dTHX;
  SV* sv = SvRV((SV*) data);
  const char* string = *(const char**)value;
  printf("set string: %s\n", string);
  sv_force_normal(sv);
  sv_setpv(sv, string);
  SvSETMAGIC(sv);
}

void TW_CALL _string_setter_cb(const void* value, void* data){
  dTHX;
  SV** cb = hv_fetch(_cb_write_map, (char*) data, sizeof(SV*), 0);
  dSP;
  ENTER;
  SAVETMPS;
  PUSHMARK(SP);
  XPUSHs(sv_2mortal(newSVpv(*(char**)value, 0)));
  PUTBACK;
    call_sv(*cb, G_DISCARD);
  FREETMPS;
  LEAVE;
}

/* double/float array callback generators */

#define DOUBLE_CALLBACK_GETTER(NAME, NUMBER, TYPE)	 \
void TW_CALL NAME(void* value, void* data) { \
  dTHX; \
  SV* sv = SvRV((SV*) data); \
  if(!(SvTYPE(SvRV(sv)) == SVt_PVAV)){ \
    croak("reference does not point to array any more\n"); \
  } \
  SvGETMAGIC(sv); \
  AV* av = (AV*)SvRV(sv); \