Interface.pl

### Class Interface: Create a struct with function pointers ###################

BEGIN {
    package Interface;

    sub new {
      my $proto  = shift;
      my %params = @_;
      my $class  = ref($proto) || $proto;
      my $self   = {};
      $self->{SFD} = $params{'sfd'};
      $self->{BIAS} = -1;
      $self->{PADCNT} = 1;
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "/* Automatically generated function table (sfdc SFDC_VERSION)! Do not edit! */\n";
      print "\n";
      print "#ifndef $sfd->{'BASENAME'}_INTERFACE_DEF_H\n";
      print "#define $sfd->{'BASENAME'}_INTERFACE_DEF_H\n";
      print "\n";

      foreach my $inc (@{$$sfd{'includes'}}) {
          print "#include $inc\n";
      }

      foreach my $td (@{$$sfd{'typedefs'}}) {
          print "typedef $td;\n";
      }

      print "\n";
      $self->define_interface_data();
      print "\n";

      print "struct $sfd->{BaseName}IFace\n";
      print "{\n";

      $self->output_prelude();
    }

    sub function {
      my $self      = shift;
      my $sfd       = $self->{SFD};
      my %params    = @_;
      my $prototype = $params{'prototype'};

      if ($self->{BIAS} == -1) {
          $self->{BIAS} = $prototype->{bias} - 6;
      }

      while ($self->{BIAS} < ($prototype->{bias} - 6)) {
          print "  APTR Pad$self->{PADCNT};\n";
          $self->{BIAS} += 6;
          ++$self->{PADCNT};
      }

      $self->{BIAS} = $prototype->{bias};

      $self->output_function(@_);
    }
    
    sub footer {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "};\n";
      print "\n";
      print "#endif /* $sfd->{'BASENAME'}_INTERFACE_DEF_H */\n";
    }


    # Helper functions
    
    sub define_interface_data {
      my $self     = shift;
      my $sfd      = $self->{SFD};

      print "struct $sfd->{BaseName}InterfaceData {\n";
      print "  $sfd->{basetype} LibBase;\n";
      print "};\n";
    }


    sub output_prelude {
      my $self     = shift;
      my $sfd      = $self->{SFD};

      print "  struct $sfd->{BaseName}InterfaceData Data;\n";
      print "\n";
      print "  static struct $sfd->{BaseName}IFace* CreateIFace($sfd->{basetype} _$sfd->{base}) {\n";
      print "    struct $sfd->{BaseName}IFace* _iface = new struct $sfd->{BaseName}IFace();\n";
      print "    _iface->Data.LibBase = _$sfd->{base};\n";
      print "    return _iface;\n";
      print "  }\n";
      print "\n";
      print "  static void DestroyIFace(struct $sfd->{BaseName}IFace* _iface) {\n";
      print "    delete _iface;\n";
      print "  }\n";
      print "\n";
    }

    sub output_function {
      my $self     = shift;
      my $sfd      = $self->{SFD};
      my %params    = @_;
      my $prototype = $params{'prototype'};

      print "  $prototype->{return} ";
      print "$prototype->{funcname}(";
      print join (', ', @{$prototype->{args}});
      print ");\n";
    }
}