FTN IO API

[StephenG1CMZ]

Version 0.001

Code:



 //Fortran IO 2017 StephenG1CMZ

 FTN_FMT_SP(); //FORWARD
 FTN_FMT_SS(); //FORWARD

 LOCAL SP:=" ";

 LOCAL STMINUS:="-";  //IN IO TEXT MAY USE -
 LOCAL STNEGATE:="−"; //WHEN PARSING USE NEGATE PLUSMINUS
 LOCAL STMINUSES:=STMINUS+STNEGATE;
 LOCAL STPLUSES :="+ ";

 //CUSTOMISE
 LOCAL FTN_SIGNALLING_NAN:=0; //
 LOCAL AVOID_IE; //1 0 PREVENT EG 1ᴇ12 ON INTEGER OUT
 //LOCAL STMINUSOUT:=STNEGATE;//USE THIS ON OUTPUT
 LOCAL CHPLUS_DEFAULT:=FTN_FMT_SS(); //_SP  OR _SS
 LOCAL CHNEGS_DEFAULT:=STNEGATE; // NEGATE OR MINUS OUT 
 LOCAL LimRec:=128;//LIMIT RECURSION
 //END CUSTOM

 LOCAL STPOS;

 LOCAL CHNEGS:=CHNEGS_DEFAULT;
 LOCAL CHPLUS:=CHPLUS_DEFAULT;//CURRENT USAGE
 
 LOCAL ZNaN;

 NOTIMP()
 BEGIN
  MSGBOX("FTN: FMT NOT IMPLEMENTED");
 END;

 PAD(Ncopies,CH)
 //GENERATE NN COPIES OF CH (CH NORMALLY 1CH)
 BEGIN
  LOCAL NN:=MIN(LimRec,Ncopies);//AVOID EXCESS RECURSION
  //LOCAL ST:="";
  //LOCAL COUNT:=NN;
  RETURN IFTE(NN>0,CH+PAD(NN-1,CH),"");
 END;

 RAISE_NAN()
 BEGIN
  ZNaN:=ZNaN+1;
  IF FTN_SIGNALLING_NAN THEN
   MSGBOX("NaN:"+ZNaN);
  END;
 END;
  
 PLAYFMT(RL,ST)
 //JUST TRY SYNTAX
 //RL:REAL
 //ST:En or Fn or Sn
 BEGIN
  //LOCAL RL:=#2;
  MSGBOX(CAS(format(RL,ST)));
  RETURN 1;
 END;
  

 //SUPPLEMENTARY HANDLING

 FTN_FMT_S()
 //FTN: RESET SHOWPLUSSIGN (TO OUR CHOSEN DEFAULT DEFINED HERE)
 //(APPLIES:MANTISSA; EE N/A)
 BEGIN
  CHPLUS:=CHPLUS_DEFAULT;
 END;

 FTN_FMT_SP()
 //FTN: SET SHOWPLUSSIGN
 BEGIN
  CHPLUS:="+";
 END;

 FTN_FMT_SS()
 //FTN:SUPPRESS SHOWPLUSSIGN
 BEGIN
  CHPLUS:=" ";
 END;

 FTN_FMT_IN_BLANK(ST)
 //HANDLE BLANK CHARS ON INPUT
 //HANDLE FMT BLANKS:B BN BZ
 BEGIN
  IF INSTRING(ST,"BZ") THEN
    NOTIMP();
  END; 
 END;

 FTN_FMT_OUT_NUMSIGN(ST)
 //HANDLE FMT SIGNS: S SP SS 
 //Z:NULL ST=RESET
 //INSTRING DETECTION EG "I SP" OK

 BEGIN
  FTN_FMT_S();//SIGN: OUR SYSTEM DEFAULT

  CASE
   IF INSTRING(ST,"SP") THEN
    FTN_FMT_SP();
   END;
   IF INSTRING(ST,"SS") THEN 
    FTN_FMT_SS();
   END;
   DEFAULT
  END;
 END;

 EXPORT FTN_FMT_II (FWIDTH,STR)
 //FTN: INPUT ST: INTEGER
 //GET INTEGER FROM STR OF FWIDTH DIGITS
 //FWIDTH:1..N INCLUDES SIGN
 //FWIDTH 0:F90: PARSE INTEGER IN STR 
 //(SHOULD PARSE DIGITS. FOR NOW JUST EXPR ENTIRE STR)
 //STR:INCLUDES INTEGER,SPACE=0,*=OVERFLOW IN STR FORMAT
 BEGIN
  LOCAL ST;
  LOCAL INUM:=0;
  LOCAL FW:=IP(FWIDTH);

  FTN_FMT_IN_BLANK("");//WHERE TO GET INPUT FORMAT FROM?

  //IGNORE WSP
  ST:=REPLACE(STR,SP,"");
  ST:=REPLACE(ST,STMINUS,STNEGATE);
  IF SIZE(ST) THEN
   IF FW THEN
    ST:=MID(ST,FW);
   END;
   IF INSTRING(ST,"*")  THEN
    //NAN- 0
    RAISE_NAN;
   ELSE //ASSUME DECIMAL NUM
    INUM:=EXPR(ST);
   END;
  ELSE //WSP==0
  END;
  RETURN IP(INUM); 
 END;

 EXPORT FTN_FMT_A(FWIDTH,STR)
 //FTN:IO AN ST: ALPHA STRNG WIDTH FW
 //FTN:0: NO PADDING OR TRUNC
 BEGIN
  LOCAL FW:=IP(FWIDTH);
  LOCAL ST:=IFTE(FW,MID(STR,1,FW),STR);//TRUNC

  IF FW THEN
   IF FW-DIM(STR)>0 THEN
    //PAD TBD FW-LEN SP AT LEFT
    ST:=ST;
   END;
  END;
  RETURN ST;
 END;

 EXPORT FTN_FMT_I(FMTLST,INUM)
 //FTN:OUTPUT ST: INTEGER
 //FMTLST:"MAX.MIN" WIDTHS AS LIST
 //F90: MAX 0=NO PADDING
 //INUM:INTEGER
 BEGIN
  LOCAL SCHAR;
  LOCAL ST:="";
  LOCAL FMT_ST;//PARAM TBD
  LOCAL FW:=0; //MAXWIDTH
  LOCAL FM:=0; //MINWIDTH 
  //LOCAL FM:=5;//TEST
  LOCAL NUM:=IP(INUM);  //INGUARD
  LOCAL POSNUM:=ABS(NUM);
  LOCAL MODE_STD:=1; //STANDARD NUM FMT

 
  IF SIZE(FMTLST) THEN
   FMT_ST:=FMTLST(1);
   FW:=IP(FMTLST(2));//MAXWIDTH
   IF SIZE(FMTLST)>2 THEN
    FM:=FMTLST(3);
   END;
   ELSE //EMPTY LIST:DEFAULTS?
  END;
  
  FTN_FMT_OUT_NUMSIGN(FMT_ST);
 
  ST:=STRING(POSNUM,MODE_STD); //POSNUM
  IF FM THEN //MIN FIELD WIDTH
   ST:=PAD(FM-DIM(ST),"0")+ST; //INSERT LEADING ZEROS AS REQD
   //POSNUM WITH ANY LEADING ZEROS
  END;
  IF (NUM≥0) AND (DIM(ST)==FW) THEN
   SCHAR:=""; //SUPPRESS "+ " WHEN NEEDED TO FIT
  ELSE
   SCHAR:=IFTE(NUM≥0,CHPLUS,CHNEGS); //SELECT CURRENT SIGN
  END;
  ST:=SCHAR+ST;//SIGNED NUM WITH LEADING ZEROS

  IF AVOID_IE AND INSTRING(ST,"ᴇ") THEN
    //Bug: THE INSTRING HANDLES SYSTEMS LIKE HP
    //WHICH DELIVER INTEGERS WITH EXPONENTS 
    //FORMATTED LIKE 1ᴇ12 IT MIGHT FIT
    //NB THE POINT AT WHICH HP STRING(N) RETURNS 1ᴇ12
    //IS GOVERNED BY N, IRRESPECTIVE OF FW
    ST:=PAD(MAX(FW,1),"*"); //OVERFLOW:STR TOO LARGE FOR HP INTEGER
    //IF FW 0 EMIT ONE *
   END;

  IF FW THEN //MAX FIELD WIDTH CHECKS
   CASE
    IF DIM(ST)>FW THEN
     ST:=PAD(FW,"*"); //OVERFLOW
    END;
    IF DIM(ST)<FW THEN
     ST:=PAD(FW-DIM(ST)," ")+ST; //PAD LEFT WITH SP
    END; 
    DEFAULT
    //FITTED JUST RIGHT
   END;
  END;
  RETURN ST; 
 END;

 EXPORT FTN_FMT_F()
 //FTN:OUTPUT ST: REAL FLOATING
 BEGIN

 END;

 EXPORT FTN_FMT_E()
 //FTN:OUTPUT REAL EXPONENTIAL
 BEGIN

 END;

 EXPORT FTN_FMT_G()
 //FTN:OUTPUT GENERAL REAL (E/F PER SIZE)
 BEGIN

 END;

 //END FTN FMT API

 
 FTN_IO_RESET()
 //OUR COMMAND: RESET FTN DEFAULTS
 BEGIN
  
 END;

 EXPORT FTNIO()
 BEGIN
  STPOS:=1;
  FTN_IO_RESET(); 
  PLAYFMT(STPOS,"S0");
 END;