REXX

/****************************** REXX ***********************************/
/*                                                                     */
/* Name: NETSOL.REX                                                    */
/*                                                                     */
/* Type: REXX Command Procedure                                        */
/*                                                                     */
/* Desc: Screen Definition Facility                                    */
/*                                                                     */
/***********************************************************************/
SIGNAL ON NOVALUE
CALL Initialize
ARG File
IF ARG()=0 THEN Filename='turnkey'
           ELSE Filename=STRIP(ARG(1))
In_file=Filename  || '.map'
Out_file=Filename || '.asm'
LBL=TRANSLATE(STRIP(Filename))
LBLA=SUBSTR(LBL||COPIES(' ',8),1,8)
LBLB=SUBSTR(LBL||'L'||COPIES(' ',8),1,8)
Process_status = '.NONE'
/*CALL SysFileDelete Out_file*/
DO WHILE LINES(In_file)
   My_rec=LINEIN(In_file)
   SELECT
      WHEN My_rec = ".ATTR" THEN DO
         Process_status = ".ATTR"
         A = 0
         attrlist=''
         ITERATE
         END
      WHEN My_rec = ".SCREEN" THEN DO
         Process_status = ".SCREEN"
         L = 0
         L = L + 1; LINE.L = '$ESC'
                    LINE.L.VARIABLE = TRUE
         L = L + 1; LINE.L = '$IO   ERASE/WRITE'
                    LINE.L.VARIABLE = TRUE
         L = L + 1; LINE.L = '$WCC  (RESETKBD,MDT)'
                    LINE.L.VARIABLE = TRUE
         LINE.0 = L
         B = 0
         B = B + 1; BEMERK.B = '* >>>>>>>>>>>>>>>>>>>>>> Sample Screen Layout <<<<<<<<<<<<<<<<<<<<<<<<'
         B = B + 1; BEMERK.B = '* '
         B = B + 1; BEMERK.B = '* ----+----1----5----2----+----3----+----4----+----5----+----6----+---'
         DATA = ''
         Row = 0
         Col = 0
         NO_Attrib = TRUE
         ITERATE
         END
      WHEN My_rec = ".VARS" THEN DO
         Process_status = ".VARS"
         V = 0
         V = V + 1; VAR.V = LBL||'E'
         V = V + 1; VAR.V = LBL||'I'
         V = V + 1; VAR.V = LBL||'W'
         VAR.0 = V
         ITERATE
         END
      WHEN My_rec = ".MARKS" THEN DO
         Process_status = ".MARKS"
         MarksList=''
         M = 0
         ITERATE
         END
      OTHERWISE DO
         CALL Process_Myrec
         END
   END
END
IF DATA \= "" THEN               /* If we still have data      */
   DO
      CALL Write_DC              /* Write data for last field  */
   END
/* ENDIF */
Outlist=COPIES(' ',LENGTH(ATTRLIST)+LENGTH(MarksList))
DO B = 1 TO BEMERK.0
   X = TRANSLATE(BEMERK.B,Outlist,Attrlist||MarksList)
   CALL LINEOUT Out_file,X
END
V=0
CALL LINEOUT Out_file,'         PUSH  PRINT'
CALL LINEOUT Out_file,'         PRINT OFF'
CALL LINEOUT Out_file,LBLA||' DS    0D'
DO L = 1 TO LINE.0
   IF LINE.L.VARIABLE THEN
      DO
         V = V + 1
         ASMLINE = SUBSTR(VAR.V||'         ',1,9)
      END
   ELSE
      DO
         ASMLINE = COPIES(' ',9)
      END
   /* ENDIF */
   ASMLINE = ASMLINE || LINE.L
   IF LENGTH(ASMLINE) < 72 THEN
      DO
         CALL LINEOUT Out_file,ASMLINE
      END
   ELSE
      DO
         CALL LINEOUT Out_file,SUBSTR(ASMLINE,1,71)||'C'
         CALL LINEOUT Out_file,COPIES(' ',15) || SUBSTR(ASMLINE,72,LENGTH(ASMLINE)-71)
      END
END
CALL LINEOUT Out_file,LBLB||' EQU   *-' || LBL
CALL LINEOUT Out_file,'         POP   PRINT'
CALL STREAM In_file,"CMD","CLOSE"
CALL STREAM Out_file,"CMD","CLOSE"
RETURN
Process_Myrec:
   SELECT
      WHEN Process_status = ".ATTR"    THEN CALL Process_attribute
      WHEN Process_status = ".SCREEN"  THEN CALL Process_screen
      WHEN Process_status = ".VARS"    THEN CALL Process_vars
      WHEN Process_status = ".MARKS"   THEN CALL Process_marks
   END
   RETURN

Process_marks:
   Parse VAR My_rec Mark Type
   Mark=STRIP(Mark)
   Type=STRIP(Type)
   M = M + 1; MARKS.LIST.M = Type
              MARKS.Type = Mark
              MARKS.LIST.0 = M
              MarksList=MarksList || Mark
   RETURN

Process_attribute:
   Parse VAR My_rec Attrib Text
   temp = ''
   IC = FALSE
   DO K = 1 TO WORDS(Text)
      IF TRANSLATE(WORD(Text,K)) = 'CUR' THEN
         DO
            IC=TRUE
         END
      ELSE
         DO
            temp=temp||','||TRANSLATE(WORD(Text,K))
         END
     /* ENDIF */
   END
   temp = SUBSTR(TEMP,2,LENGTH(Temp)-1)
   A = A + 1; ATTR.A = '('||Temp||')'
              ATTR.A.CURSOR = IC
   ATTR.0 = A
   attrlist=Attrlist||Attrib
   RETURN

Process_screen:
   ROW = ROW + 1                                /* count row we are working on */
   X = SUBSTR(My_REC||COPIES(' ',80),1,80)      /* make full 80 byte record    */
   B = B + 1; BEMERK.B = '* ' || SUBSTR(X,1,69)
   BEMERK.0 = B
   DO C = 1 TO 80                               /* Process one by one          */
      K = SUBSTR(X,C,1)                         /* get next byte               */
      DO A = 1 TO ATTR.0                        /* test if attribute           */
         IF SUBSTR(Attrlist,A,1)=K THEN         /* If we find an attribute     */
            DO
               No_Attrib = FALSE
               IF DATA \= "" THEN               /* And we already have data    */
                  DO
                    CALL Write_DC               /* Write data for prev. field  */
                  END
               /* ENDIF */                      /* Write orders for this field */
               L = L + 1; LINE.L ='$SBA  (' || ROW || ',' || C || ')'
                                   LINE.L.VARIABLE = FALSE
               L = L + 1; LINE.L ='$SF   '  || ATTR.A
                                   LINE.L.VARIABLE = FALSE
               IF ATTR.A.CURSOR THEN
                  DO
                     L = L + 1; LINE.L = '$IC'
                                LINE.L.VARIABLE = FALSE
                  END
               /*ENDIF*/
               LINE.0 = L
               LEAVE A
            END
         /* ENDIF */
      END
      IF No_attrib THEN
         DO
            NOP
         END
      ELSE
         DO
            DATA = DATA || SUBSTR(X,C,1)
            IF SUBSTR(X,C,1)= "'" THEN DATA = DATA || "'"
         END
      /* ENDIF */
   END
   RETURN

Write_DC:
   Constant = STRIP(SUBSTR(DATA,2,LENGTH(DATA)-1),'T',' ')
   SELECT
     WHEN LENGTH(CONSTANT) = 0 THEN
          NOP
     WHEN Constant = COPIES(Marks.var,LENGTH(CONSTANT)) THEN
        DO
           L = L + 1; LINE.L = 'DC    CL' || LENGTH(constant) || ''' '''
                      LINE.L.VARIABLE = TRUE
        END
     WHEN Constant = COPIES(' ',LENGTH(CONSTANT)) THEN
        DO
           NOP
        END
     OTHERWISE
        DO
           L = L + 1; Line.L = 'DC    C''' || Constant ||''''
                      LINE.L.VARIABLE = FALSE
        END
   END
   LINE.0 = L
   DATA=''
   RETURN

Process_vars:
   DO I = 1 TO Words(My_rec)
      V = V + 1; VAR.V = TRANSLATE(WORD(My_rec,I))
   END
   VAR.0 = V
   RETURN

INITIALIZE:
   TRUE = (1=1)
   FALSE = \TRUE
   Marks.var = '_'
   RETURN

Novalue:
   MsgText = ''
   MsgText = 'An unitialized variable has been used' CRLF
   MsgText = MsgText || 'Linenumber was' SIGL CRLF
   MsgText = MsgText || 'Sourceline was' SOURCELINE(SIGL) CRLF
   RC = RxMessageBox(Msgtext,'Novalue Condition','OK','STOP')
   EXIT
   ADDRESS 'CMD' 'PAUSE'
   ADDRESS 'CMD' 'EXIT'