Source code in the action! programming language

INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit

BYTE FUNC AreEqual(CHAR ARRAY a,b)
  BYTE i

  IF a(0)#b(0) THEN
    RETURN (0)
  FI
  FOR i=1 to a(0)
  DO
    IF a(i)#b(i) THEN
      RETURN (0)
    FI
  OD
RETURN (1)

BYTE FUNC IsNumeric(CHAR ARRAY s)
  CHAR ARRAY tmp(20)
  INT i
  CARD c
  REAL r

  i=ValI(s)
  StrI(i,tmp)
  IF AreEqual(s,tmp) THEN
    RETURN (1)
  FI

  c=ValC(s)
  StrC(c,tmp)
  IF AreEqual(s,tmp) THEN
    RETURN (1)
  FI
    
  ValR(s,r)
  StrR(r,tmp)
  IF AreEqual(s,tmp) THEN
    RETURN (1)
  FI
RETURN (0)

PROC Test(CHAR ARRAY s)
  BYTE res

  res=IsNumeric(s)
  Print(s)
  Print(" is ")
  IF res=0 THEN
    Print("not ")
  FI
  PrintE("a number.")
RETURN

PROC Main()
  Put(125) PutE() ;clear the screen
  Test("56233")
  Test("-315")
  Test("1.36")
  Test("-5.126")
  Test("3.7E-05")
  Test("1.23BC")
  Test("5.6.3")
RETURN

BYTE FUNC IsSign(CHAR c)
  IF c='- OR c='+ THEN
    RETURN (1)
  FI
RETURN (0)

BYTE FUNC IsDigit(CHAR c)
  IF c>='0 AND c<='9 THEN
    RETURN (1)
  FI
RETURN (0)

BYTE FUNC IsDot(CHAR c)
  IF c='. THEN
    RETURN (1)
  FI
RETURN (0)

BYTE FUNC IsExpSymbol(CHAR c)
  IF c='E OR c='e THEN
    RETURN (1)
  FI
RETURN (0)

BYTE FUNC IsNumeric(CHAR ARRAY s)
  DEFINE S_BEGIN="0"
  DEFINE S_SIGN="1"
  DEFINE S_BEFORE_DOT="2"
  DEFINE S_DOT="3"
  DEFINE S_AFTER_DOT="4"
  DEFINE S_EXP_SYMBOL="5"
  DEFINE S_EXP_SIGN="6"
  DEFINE S_EXP="7"
  
  BYTE i,state
  CHAR c

  i=1
  state=S_BEGIN
  WHILE i<=s(0)
  DO
    c=s(i)

    IF state=S_BEGIN THEN
      IF IsSign(c) THEN
        state=S_SIGN
      ELSEIF IsDigit(c) THEN
        state=S_BEFORE_DOT
      ELSEIF IsDot(c) THEN
        state=S_DOT
      ELSE
        RETURN (0)
      FI
    ELSEIF state=S_SIGN THEN
      IF IsDigit(c) THEN
        state=S_BEFORE_DOT
      ELSEIF IsDot(c) THEN
        state=S_DOT
      ELSE
        RETURN (0)
      FI
    ELSEIF state=S_BEFORE_DOT THEN
      IF IsDigit(c) THEN
        state=S_BEFORE_DOT
      ELSEIF IsDot(c) THEN
        state=S_DOT
      ELSEIF IsExpSymbol(c) THEN
        state=S_EXP_SYMBOL
      ELSE
        RETURN (0)
      FI
    ELSEIF state=S_DOT THEN
      IF IsDigit(c) THEN
        state=S_AFTER_DOT
      ELSEIF IsExpSymbol(c) THEN
        state=S_EXP_SYMBOL
      ELSE
        RETURN (0)
      FI
    ELSEIF state=S_AFTER_DOT THEN
      IF IsDigit(c) THEN
        state=S_AFTER_DOT
      ELSEIF IsExpSymbol(c) THEN
        state=S_EXP_SYMBOL
      ELSE
        RETURN (0)
      FI
    ELSEIF state=S_EXP_SYMBOL THEN
      IF IsSign(c) THEN
        state=S_EXP_SIGN
      ELSEIF IsDigit(c) THEN
        state=S_EXP
      ELSE
        RETURN (0)
      FI
    ELSEIF state=S_EXP_SIGN THEN
      IF IsDigit(c) THEN
        state=S_EXP
      ELSE
        RETURN (0)
      FI
    ELSEIF state=S_EXP THEN
      IF IsDigit(c) THEN
        state=S_EXP
      ELSE
        RETURN (0)
      FI
    ELSE
      RETURN (0)
    FI
    i==+1
  OD

  IF state=S_BEGIN OR state=S_DOT OR
    state=S_EXP_SIGN OR state=S_EXP_SIGN THEN
    RETURN (0)
  FI
RETURN (1)

PROC Test(CHAR ARRAY s)
  BYTE res

  res=IsNumeric(s)
  Print(s)
  Print(" is ")
  IF res=0 THEN
    Print("not ")
  FI
  PrintE("a number.")
RETURN

PROC Main()
  Test("56233")
  Test("-315")
  Test("1.36")
  Test("-5.126")
  Test("3.7E-05")
  Test("1.23BC")
  Test("5.6.3")
RETURN