/* Modul 5 : String-Befehle */

#include<exec/types.h>

struct paar { int knotentyp;
              WORD *CAR,*CDR;
            };
struct atom { int knotentyp;
              char zeichenkette[2];
            };
struct bruch { int knotentyp;
               char kennung[2];
               int zaehler,nenner;
             };

#define new(a) a=neu((ULONG)sizeof(int)+8L)

extern BYTE genug_parameter();
extern void fehler(),nprint();
extern void delete(),dispose();
extern WORD *neu(),*evaluate();
extern int fehlerport;
extern long int string_int();
extern WORD *input();
extern char* textpointer;

/* stringlength berechnet die Länge eines Strings */

long int stringlength(parameter)
struct atom *parameter;
{  if((parameter==0L)||(parameter->knotentyp==1)||(parameter->
      zeichenkette[0]!='"'))
   {  fehler(2,parameter);
      return(-1);
   }
   else
   {  register char *hilf;
      register long int i=0L;
      hilf=&(parameter->zeichenkette[1]);
      while(*hilf!='"')
      {  hilf++;
         i++;
      }
      return(i);
   }
}

/* strcat verbindet zwei Strings zu einem */

struct atom* strcat_(parameter)
struct paar *parameter;
{  if(genug_parameter(parameter,2,2))
   {  struct atom *hilf1,*hilf2;
      hilf1=evaluate(parameter->CAR);
      hilf2=evaluate(((struct paar*)(parameter->CDR))->CAR);
      dispose(parameter->CDR);
      dispose(parameter);
      if((hilf1==-1L)||(hilf2==-1L))
      {  delete(hilf1);delete(hilf2);
         return(-1L);
      }
      else
      {  long int l1,l2;
         l1=stringlength(hilf1);
         l2=stringlength(hilf2);
         if((l1==-1L)||(l2==-1L))
         {  delete(hilf1);delete(hilf2);
            return(-1L);
         }
         else
         {  register struct atom *hilf3;
            register char *z1,*z2;
            hilf3=neu((ULONG)sizeof(int)+l1+l2+3L);
            hilf3->knotentyp=2;
            z1=hilf3->zeichenkette;
            *z1++='"'; /*Ergebnisstring beginnen*/
            z2=&(hilf1->zeichenkette[1]); /*String 1 kopieren*/
            while(*z2 != '"')
               *z1++=*z2++;
            z2=&(hilf2->zeichenkette[1]); /*String 2 kopieren*/
            while(*z2 != '"')
               *z1++=*z2++;
            *z1++='"';*z1=0;
            dispose(hilf1);dispose(hilf2);
            return(hilf3);
         }
      }
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

/* strlen errechnet die Länge eines Stringatoms */

struct atom* strlen_(parameter)
struct paar* parameter;
{  if(genug_parameter(parameter,1,1))
   {  struct atom *hilf;
      struct bruch *zahl;

      hilf=evaluate(parameter->CAR);dispose(parameter);
      if(hilf==-1L)
         return(-1L);
      else
      {  long int i;
         i=stringlength(hilf);
         dispose(hilf);
         if(i==-1L)
            return(-1L);
         else
         {  zahl=neu(sizeof(struct bruch));
            zahl->knotentyp=2;
            zahl->kennung[0]='æ';
            zahl->kennung[1]='B';
            zahl->zaehler=i;
            zahl->nenner=1;
            return(zahl);
         }
      }
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

extern int getint();

/* substr entspricht MID$ in Basic */

struct atom *substr(parameter)
struct paar *parameter;
{  if(genug_parameter(parameter,2,3))
   {  struct atom *hilf1;
      register struct paar *hilf2;
      long int i,j=-1L;
      hilf1=evaluate(parameter->CAR);
      if((hilf1==-1L)||(hilf1->knotentyp==1)||(hilf1->zeichenkette[0]!='"'))
      {  delete(parameter->CDR);
         dispose(parameter);
         if(hilf1!=-1L)
         {  fehler(2,hilf1);
            delete(hilf1);
         }
         return(-1L);
      }
      else
      { hilf2=parameter->CDR;
        dispose(parameter);
        parameter=evaluate(hilf2->CAR);
        if((parameter!=-1L)&&(parameter!=0L)&&(parameter->knotentyp==2)&&
           (((struct atom*)parameter)->zeichenkette[0]=='æ'))
        {  fehlerport=1;
           i=getint(parameter);
           dispose(parameter);
           if(hilf2->CDR!=0L)
           {  parameter=hilf2->CDR;
              dispose(hilf2);
              hilf2=evaluate(parameter->CAR);
              dispose(parameter);
              if((hilf2!=0L)&&(hilf2!=-1L)&&(hilf2->knotentyp==2)&&
              fehlerport&&(((struct atom*)hilf2)->zeichenkette[0]=='æ'))
              {
                 j=getint(hilf2);
                 dispose(hilf2);
              }
              else
              {  if(fehlerport&&(hilf2!=-1L))
                    fehler(2,hilf2);
                 delete(hilf2);
                 fehlerport=0;
              }
           }
           else
              dispose(hilf2);
           if(!fehlerport)
           {  dispose(hilf1);
              return(-1L);
           }
           else
           {  /*hier kann nun endlich kopiert werden...*/
              register char *z1,*z2;
              long int z=0L;
              z1=z2=&(hilf1->zeichenkette[1]);
              while((*z2!='"')&&(z<i))
              {  z2++;z++; }
              z=0L;
              while((*z2!='"')&&((z<j)||(j==-1L)))
              {  *z1++=*z2++; z++; }
              *z1++='"';
              *z1=0;
              return(hilf1);
           }
        }
        else
        {  dispose(hilf1);
           delete(hilf2->CDR);
           dispose(hilf2);
           if(parameter!=-1L)
           {  fehler(2,parameter);
              delete(parameter);
           }
           return(-1L);
        }
      }
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

/* ascii wie in XLisp wird erster Bst. eines String in Zahl umg. */

struct atom *ascii(parameter)
struct paar *parameter;
{  if(genug_parameter(parameter,1,1))
   {  register struct bruch* hilf;
      hilf=evaluate(parameter->CAR);
      dispose(parameter);
      if((hilf==-1L)||(hilf==0L)||(hilf->knotentyp==1)||(hilf->
         kennung[0]!='"'))
      {  if(hilf!=-1L)
         {  fehler(2,hilf);
            delete(hilf);
         }
         return(-1L);
      }
      else
      {  long int i;
         i=(long int)(hilf->kennung[1]);
         dispose(hilf);
         hilf=neu(sizeof(struct bruch));
         hilf->knotentyp=2;
         hilf->kennung[0]='æ';hilf->kennung[1]='B';
         hilf->zaehler=i;
         hilf->nenner=1;
         return(hilf);
      }
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

/* chr wandelt Zahl in das zugehörige ASCII-Zeichen um */

struct atom *chr(parameter)
struct paar *parameter;
{  if(genug_parameter(parameter,1,1))
   {  register struct atom *hilf;
      hilf=evaluate(parameter->CAR);
      dispose(parameter);
      if((hilf!=-1L)&&(hilf!=0L)&&(hilf->knotentyp!=1)&&
         (hilf->zeichenkette[0]=='æ'))
      {  long int i;
         i=getint(hilf);
         dispose(hilf);
         if((i>=0L)&&(i<256L))
         {  hilf=neu((ULONG)sizeof(int)+4L);
            hilf->knotentyp=2;
            hilf->zeichenkette[0]=hilf->zeichenkette[2]='"';
            hilf->zeichenkette[1]=(char)i;
            hilf->zeichenkette[3]=0;
            return(hilf);
         }
         else
         {  fehler(30,0L);
            return(-1L);
         }
      }
      else
      {  if(hilf!=-1L)
         {  fehler(2,hilf);
            delete(hilf);
         }
         return(-1L);
      }
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

struct paar *read_(parameter)
struct paar *parameter;
{  extern char *newcon();
   extern BYTE menuflag;
   if((parameter==0L)||(parameter->CDR==0L))
   {  char *tex;
      tex=textpointer;
      if(parameter==0L) /*Eingabe*/
      {  char *zeile;
         struct paar *merke;
         register int i=0;
         nprint("\n[Eingabe]");
         menuflag=0; /*Bei der Eingabe keine Menüabfrage*/
         zeile=newcon();
         merke=input(zeile);
         textpointer=tex;
         return(merke);
      }
      else /*Es soll aus einem String gelesen werden... */
      {  register struct atom *hilf;
         hilf=evaluate(parameter->CAR);
         dispose(parameter);
         if((hilf==0L)||(hilf==-1L)||(hilf->knotentyp==1)||
            (hilf->zeichenkette[0]!='"'))
         {  if(hilf!=-1L)
            {  fehler(2,hilf);
               delete(hilf);
            }
            return(-1L);
         }
         else
         {  register char *such;
            struct paar *merke;
            such=&(hilf->zeichenkette[1]);
            while(*such!='"') such++;
            *such=0; /*Stringende besonders kennzeichnen !*/
            merke=input(&(hilf->zeichenkette[1]));
            dispose(hilf);
            textpointer=tex;
            return(merke);
         }
      }
   }
   else
   {  fehler(3,parameter);
      delete(parameter);
      return(-1L);
   }
}