mystring.c

ngspice又一个电子CAD仿真软件代码.功能更全

    return c
  EndIf
EndFunc

Func Bool alfa( char  c)
Begin
  return ((c>='a') And (c<='z')) Or ((c>='A') And (c<='Z'));
EndFunc

Func  Bool num( char  c)
Begin
  return (c>='0') And (c<='9');
EndFunc

Func Bool alfanum(char c)
Begin 
  return
  ((c>='a') And (c<='z')) Or ((c>='A')And(c<='Z')) 
  Or ((c>='0')And(c<='9'))
  Or (c=='_')
EndFunc

Func short freadstr(Pfile f, Pchar s, short max)
/* read a line from a file. 
   BUG: long lines truncated without warning, ctrl chars are dumped.
*/
Begin 
  char c; 
  short i=0, mxlen=maxlen(s); 
  If mxlen<max Then max=mxlen EndIf
  Repeat 
     c=fgetc(f); /*  tab is the only control char accepted */
    If ((c>=' ') Or (c<0) Or (c==Tab)) And (i<max) Then
      s[i]=c; Inc(i)
    EndIf
  Until feof(f) Or (c=='\n') EndRep
  s[i]=0; 
  s[i+1]= Hi(mxlen); s[i+2]= Lo(mxlen);
  return i
EndProc

Func char freadc(Pfile f)
Begin
  return fgetc(f)
EndFunc

Func long freadi(Pfile f)
/* reads next integer, but returns 0 if none found. */
Begin 
  long z=0;
  Bool minus=False;
  char c;
  Repeat c=fgetc(f) 
  Until feof(f) Or  Not ((c>0) And (c<=' ')) EndRep /* skip space */
  If c=='-' Then
    minus=True; c=fgetc(f)
  EndIf
  While num(c) Do
    z= 10*z + c-'0'; c=fgetc(f)
  Done
  ungetc(c,f) ; /* re-push character lookahead */
  If minus Then z= -z EndIf;
  return z
EndFunc

Func Pchar stupcase( Pchar s)
Begin
  short i=0; 
  While s[i] !=0 Do
    s[i]= upcase(s[i]); Inc(i)
  Done
  return s
EndFunc

/*****  pointer tricks: app won't use naked malloc(), free() ****/

Proc dispose(Pointer p)
Begin 
  If p != Null Then free(p) EndIf 
EndProc

Func Pointer new(long sz)
Begin
  Pointer p;
  If sz<=0 Then
    return Null
  Else
#ifdef __TURBOC__ 
    /* truncate to 64 K ! */
    If sz> 0xffff Then sz= 0xffff EndIf
    p= malloc((Word)sz);
#else
    p= malloc(sz);
#endif
    If p==Null Then /* fatal error */
      ws(" new() failure. Program halted.\n");
      exit(1);
    EndIf
    return p
  EndIf
EndFunc

Func Pchar newstring(short n)
Begin
  Pchar s= (Pchar)new(n+4);
  sini(s, n); 
  return s
EndFunc

/***** elementary math *******/

Func double sqr(double x)
Begin
  return x*x
EndFunc

Func double absf(double x)
Begin
  If x<0.0 Then
    return -x
  Else
    return x
  EndIf
EndFunc

Func long  absi(long i)
Begin
  If i>=0 Then
    return(i)
  Else
    return(-i)
  EndIf
EndFunc

Proc strif(long i, short f, Pchar s)
/* formatting like str(i:f,s) in Turbo Pascal */
Begin
  short j,k,n,max;
  char cs;
  char t[32];
  k=0;
  max=maxlen(s);
  If i<0 Then
    i= -i; cs='-'
  Else
    cs=' '
  EndIf;
  While i>0 Do
    j=(short)(i Mod 10);
    i=(long)(i Div 10);
    t[k]=chr('0'+j); Inc(k)
  Done
  If k==0 Then
    t[k]='0'; Inc(k)
  EndIf
  If cs=='-' Then
    t[k]=cs
  Else
    Dec(k)
  EndIf;
    /* now the string  is in 0...k in reverse order */
  For j=1; j<=k; Inc(j) Do t[k+j]=t[k-j] Done /* mirror image */
  t[2*k+1]=0; /* null termination */
  n=0;
  If (f>k) And (f<40) Then /* reasonable format */
    For j=k+2; j<=f; Inc(j) Do
      s[n]=' '; Inc(n)
    Done
  EndIf
  For j=0; j<=k+1; Inc(j) Do s[n+j]=t[k+j] Done; /* shift t down */
  k=length(s); 
  sfix(s,k,max);
EndProc

Func Bool odd(long x)
Begin
  return NotZ(x AND 1)
EndFunc

Func short vali(Pchar s, long * i)
/* convert s to integer i. returns error code 0 if Ok */
/* BUG: almost identical to ival() with arg/return value swapped ... */
Begin
  short k=0, digit=0, ls;
  long z=0;
  Bool minus=False, ok=True;
  char c;
  ls=length(s);
  Repeat 
    c=s[k]; Inc(k) 
  Until (k>=ls) Or  Not ((c>0) And (c<=' ')) EndRep /* skip space */
  If c=='-' Then
    minus=True; 
    c=s[k]; Inc(k)
  EndIf
  While num(c) Do
    z= 10*z + c-'0';
    c=s[k]; Inc(k);
    Inc(digit)
  Done
  If minus Then z= -z EndIf;
  *i= z; 
  ok= (digit>0) And (c==0); /* successful end of string */
  If ok Then
    return 0
  Else
    return k /* one beyond error position */
  EndIf
EndFunc

Intern 
Func Bool match
  (Pchar s, Pchar t, short n, short tstart, Bool testcase)
Begin
/* returns 0 If tstart is out of range. But n may be 0 ? */
/* True if s matches t[tstart...tstart+n]  */
  short i,j,lt;
  Bool ok;
  char a,b;
  i=0; j=tstart;
  lt= length(t);
  ok=(tstart<lt);
  While ok And (i<n) Do
    a=s[i]; b=t[j];
    If Not testcase Then
      a=upcase(a); b=upcase(b)
    EndIf
    ok= (j<lt) And (a==b);
    Inc(i); Inc(j);
  Done
  return ok
EndFunc

Intern 
Func short posi(Pchar sub, Pchar s, short opt)
/* find position of substring in s */
Begin
  /* opt=0: like Turbo Pascal */
 /*  opt=1: like Turbo Pascal Pos, but case insensitive */
 /*  opt=2: position in space separated wordlist for scanners */
  short a,b,k,j;
  Bool ok, tstcase;
  Str(250,t);
  ok=False;
  tstcase=( opt==0);
  If opt<=1 Then
    scopy(t,sub)
  Else
    cadd(t,' '); sadd(t,sub); cadd(t,' ');
  EndIf
  a= length(t); 
  b= (short)(length(s)-a);
  k=0; j=1;
  If a>0 Then  /*Else return 0*/
    While (k<=b) And (Not ok) Do
      ok=match(t,s, a,k, tstcase); /* we must start at k=0 ! */
      Inc(k);
      If s[k]==' ' Then Inc(j) EndIf /* word counter */
    Done
  EndIf
  If opt==2 Then k=j EndIf
  If ok Then
    return k
  Else
    return 0
  EndIf
EndFunc

Func short spos(Pchar sub, Pchar s)
/* equivalent to Turbo Pascal pos().
   BUG: counts 1 ... length(s), not from 0 like C  
*/
Begin
  return posi( sub, s, 0)
EndFunc

/**** float formatting with printf/scanf ******/

Func short valr(Pchar s, double *r)
/* returns 0 if ok, else length of partial string ? */
Begin
  short n=sscanf(s, "%lG", r);
  If n==1 Then
    return(0)
  Else
    return(1)
  EndIf
EndFunc

Proc strf( double x, short f1, short f2, Pchar t)
/* e-format if f2<0, else f2 digits after the point, total width=f1 */
/* if f1=0, also e-format with f2 digits */
Begin /*default f1=17, f2=-1*/
  Str(30,fmt);
  short n,mlt;
  mlt=maxlen(t);
  cadd(fmt,'%');
  If f1>0 Then
    nadd(fmt , f1); /* f1 is the total width */
    If f2<0 Then
      sadd(fmt,"lE") /* exponent format */
    Else
      cadd(fmt,'.');
      nadd(fmt,f2);
      sadd(fmt,"lf")
    EndIf
  Else
    cadd(fmt,'.');
    nadd(fmt, absi(f2-6)); /* note the 6 surplus positions */
    cadd(fmt,'e');
  EndIf
  n=sprintf(t, fmt, x);
  sfix(t,n, mlt);
EndProc

Func double rval(Pchar s, short *err)
/* returns err=0 if ok, else length of partial string ? */
Begin
  double r= 0.0;
  short n=sscanf(s, "%lG", &r);
  If n==1 Then
    (*err)=0
  Else
    (*err)=1
  EndIf
  return r;
EndFunc

Func long ival(Pchar s, short *err) 
/* value of s as integer string.  error code err= 0 if Ok */
Begin 
  short k=0, digit=0, ls; 
  long z=0;
  Bool minus=False, ok=True;
  char c;
  ls=length(s);
  Repeat
    c=s[k]; Inc(k) 
  Until (k>=ls) Or  Not ((c>0) And (c<=' ')) EndRep /* skip space */
  If c=='-' Then
    minus=True;
    c=s[k]; Inc(k)
  EndIf
  While num(c) Do
    z= 10*z + c-'0';
    c=s[k]; Inc(k);
    Inc(digit)
  Done
  If minus Then z= -z EndIf;
  ok= (digit>0) And (c==0); /* successful end of string */
  If ok Then
    (*err)= 0
  Else
    (*err)= k /* one beyond error position */
  EndIf
  return z
EndFunc

#ifndef _MATH_H

Func long np_round(double x)
/* using <math.h>, it would be simpler: floor(x+0.5) */
Begin
  double u; 
  long z; 
  short n;
  Str(40,s);
  u=2e9; 
  If x>u Then
    x=u
  ElsIf x< -u Then
    x= -u
  EndIf
  n=sprintf(s,"%-12.0f", x);
  s[n]=0; 
  sscanf(s,"%ld", Addr(z));
  return z
EndFunc

Func long np_trunc(double x)
Begin
  long n=np_round(x);
  If (n>x) And (x>=0.0) Then
    Dec(n) 
  ElsIf (n<x) And (x<0.0) Then
    Inc(n)
  EndIf
  return n
EndFunc

Func double frac(double x)
Begin
  return x- np_trunc(x) 
EndFunc

Func double intp(double x)
Begin
  double u=2e9;
  If (x>u) Or (x< -u) Then
    return x
  Else
    return np_trunc(x)
  EndIf
EndFunc

#else  /* use floor() and ceil() */

Func long np_round(double r)
Begin
  return (long)floor(r+0.5)
EndFunc

Func long np_trunc(double r)
Begin
  If r>=0.0 Then
    return (long)floor(r)
  Else
    return (long)ceil(r)
  EndIf
EndFunc

Func double frac(double x)
Begin
  If x>=0.0 Then
    return(x - floor(x))
  Else
    return(x - ceil(x))
  EndIf
EndFunc

Func double intp(double x) /* integral part */
Begin
  If x>=0.0 Then
    return floor(x)
  Else
    return ceil(x)
  EndIf
EndFunc

#endif  /* _MATH_H */