home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l076 / 1.ddi / FORMAT.TRU < prev    next >
Encoding:
Text File  |  1986-12-08  |  9.1 KB  |  309 lines
  1. EXTERNAL
  2.  
  3. SUB Format (line$(),arg$)
  4.  
  5.     ! FORMAT
  6.     !
  7.     ! a True BASIC(tm), Inc. product
  8.     !
  9.     ! ABSTRACT
  10.     !    Indents a True BASIC program, and 
  11.     !    capitalizes the leading keywords
  12.     !    and certain other keywords.
  13.     !
  14.     ! SYNTAX
  15.     !    DO FORMAT [ , NOCAP ]
  16.     !
  17.     ! Copyright (c) 1985, 1987 by True BASIC, Incorporated
  18.  
  19.     LET mincom = 35               ! Comments start here
  20.     LET newind = 0                ! Indentation for next line
  21.     LET numflag = 0               ! Line number flag
  22.     LET c$ = line$(1)[1:1]        ! Are there line numbers?
  23.     IF c$ >= "0" and c$ <= "9" then LET numflag = 1 else LET num$ = ""
  24.     IF arg$ <> "" then
  25.        IF pos("NOCAP",ucase$(arg$)) <> 1 then
  26.           CAUSE ERROR 1, "Try ""DO FORMAT"" or ""DO FORMAT, NOCAP"""
  27.        END IF
  28.        LET nocap = 1
  29.     END IF
  30.  
  31.     FOR i = 1 to ubound(line$)
  32.         LET l$ = line$(i)
  33.         CALL trisect              ! Divide l$ into num$, text$, com$
  34.         LET utext$ = ucase$(text$)     ! For comparing and capitalizing
  35.         LET p2 = 0                ! Character pointer for keyword
  36.         CALL keyword              ! Find command and capitalize
  37.         LET ind = newind
  38.         IF key$ = "IF" then CALL onelineif
  39.         CALL indent               ! Calculate amount of indentation
  40.         CALL join                 ! Put line together
  41.         LET line$(i) = l$
  42.     NEXT i
  43.  
  44.     DECLARE DEF posnq
  45.  
  46.     SUB trisect                   ! Divide into num$, text$, com$
  47.  
  48.         IF numflag = 1 then
  49.            CALL getlinenum (l$, num$, text$)
  50.            LET num$ = num$ & " "
  51.         ELSE
  52.            LET text$ = l$
  53.         END IF
  54.  
  55.         CALL sepcom (text$, com$)
  56.  
  57.         LET text$ = rtrim$(ltrim$(text$))   ! Stripped body
  58.  
  59.     END SUB
  60.  
  61.     SUB keyword
  62.  
  63.         ! Find keyword(s) starting at p
  64.         ! key$ = keywords
  65.         ! Capitalize them
  66.  
  67.         CALL nextword (utext$, p, p2, key$)      ! Move pointers to next word
  68.  
  69.         LET c = ncpos(utext$, " ", p2+1)    ! find next non-blank
  70.         LET c = pos(" =(,",utext$[c:c])     ! see if possible assignment
  71.         IF c > 1 then
  72.            SELECT CASE key$       ! not possible if reserved
  73.            CASE "IF", "ELSE", "ELSEIF", "PRINT", "REM", "DATA"
  74.            CASE else              ! insert LET if "=" follows
  75.                 IF posnq(utext$,"=",p2+1) > 0 then
  76.                    LET utext$[p:0] = "LET "      ! insert in both copies
  77.                    LET text$[p:0] = "let "  ! maybe leave it lowercase
  78.                    LET p2 = p + 2
  79.                    LET key$ = "LET"
  80.                 END IF
  81.            END SELECT
  82.         END IF
  83.  
  84.         SELECT CASE key$
  85.  
  86.         CASE "SELECT", "LINE", "BOX", "OPTION", "EXIT", "CAUSE", "DECLARE"
  87.              CALL addkey          ! Additional keyword
  88.  
  89.         CASE "PLOT"
  90.              LET c2 = p2
  91.              CALL nextword (utext$, c, c2, x$)   ! Look at next word
  92.              SELECT CASE x$
  93.              CASE "POINTS", "LINES", "AREA"
  94.                   LET p2 = c2
  95.              CASE "TEXT"
  96.                   LET p2 = c2
  97.                   CALL addkey     ! also add "AT"
  98.              CASE else
  99.              END SELECT
  100.  
  101.         CASE "END"
  102.              IF p2 < len(utext$) then
  103.                 CALL addkey       ! Not simply END
  104.                 LET key$ = key$ & " " & x$  ! Make sure one space
  105.              END IF
  106.  
  107.         CASE "MAT"
  108.              LET c2 = p2
  109.              CALL nextword (utext$, c, c2, x$)   ! Look at next word
  110.              SELECT CASE x$
  111.              CASE "INPUT", "PRINT", "READ", "WRITE"
  112.                   LET p2 = c2     ! Add second word
  113.              CASE "LINE", "PLOT"
  114.                   LET p2 = c2
  115.                   CALL addkey     ! Third word
  116.              CASE else            ! Nothing to do
  117.              END SELECT
  118.  
  119.         CASE "GET"
  120.              CALL addkey
  121.  
  122.         CASE "SET", "ASK"
  123.              CALL setask
  124.  
  125.         CASE "ELSE"               ! Handle ELSE IF
  126.              CALL addkey          ! Must be IF, if anything
  127.              LET key$ = key$ & x$      ! Treat like ELSEIF
  128.  
  129.         CASE else                 ! Nothing to do
  130.  
  131.         END SELECT
  132.  
  133.         IF nocap = 0 then
  134.            LET text$[p:p2] = utext$[p:p2]   ! Capitalize keywords(s)
  135.         END IF
  136.  
  137.     END SUB
  138.  
  139.     SUB addkey                    ! Add next word to keyword
  140.  
  141.         CALL nextword (utext$, c, p2, x$)   ! Move p2 only
  142.  
  143.     END SUB
  144.  
  145.     SUB setask                    ! Check for SET COLOR MIX, etc.
  146.  
  147.         LET c = posnq (utext$, ":", p2)
  148.         IF c = 0 then             ! Ordinary SET or ASK
  149.            CALL addkey
  150.            IF x$ = "COLOR" then   ! Look for SET COLOR MIX
  151.               LET c2 = p2
  152.               CALL nextword (utext$, c, c2, x$)
  153.               IF x$ = "MIX" then LET p2 = c2
  154.            ELSE IF x$ = "MAX" or x$ = "BACKGROUND" or x$ = "FREE" then
  155.               CALL addkey         ! Allow for ASK MAX XXXXX
  156.            END IF
  157.         ELSE                      ! File SET / ASK
  158.            LET c2 = c+1           ! Find word AFTER #n:
  159.            CALL nextword (utext$, c, c2, x$)
  160.            IF nocap = 0 then
  161.               LET text$[c:c2] = utext$[c:c2]     ! Capitalize it
  162.            END IF
  163.         END IF
  164.  
  165.     END SUB
  166.  
  167.     SUB onelineif                 ! Checks for keywords in one-line if-then
  168.  
  169.         ! Isoneline = 1 if a one-line if-then.  Used in indent
  170.         LET isoneline = 0
  171.  
  172.         LET savedkey$ = key$
  173.  
  174.         LET p = posnq (utext$, "THEN", p)   ! Locate THEN
  175.  
  176.         LET p2 = p + 4
  177.         IF p2 <= len(utext$) then      ! One line if-then
  178.            LET isoneline = 1
  179.            CALL keyword           ! Capitalize it
  180.            LET p = posnq (utext$, "ELSE", p)     ! Look for ELSE
  181.            IF p <> 0 then
  182.               LET p2 = p + 4      ! Start of word to capitalize
  183.               CALL keyword        ! Capitalize it
  184.            END IF
  185.         END IF
  186.         LET key$ = savedkey$
  187.  
  188.     END SUB
  189.  
  190.     SUB indent                    ! Calculate number of spaces to indent
  191.  
  192.         SELECT CASE key$
  193.  
  194.         CASE "DO"
  195.              LET newind = ind + 3
  196.  
  197.         CASE "IF"
  198.              IF isoneline = 0 then LET newind = ind + 3
  199.  
  200.         CASE "FOR", "SUB", "PICTURE", "MODULE"
  201.              LET newind = ind + 4
  202.  
  203.         CASE "DEF", "FUNCTION"
  204.              IF posnq (utext$, "=", p) = 0 then LET newind = ind + 4
  205.  
  206.         CASE "SELECT", "WHEN"
  207.              LET newind = ind + 5
  208.  
  209.         CASE "LOOP", "END IF"     ! Structure closers
  210.              LET newind, ind = ind - 3
  211.  
  212.         CASE "NEXT", "END SUB", "END DEF", "END PICTURE", "END FUNCTION", "END MODULE"
  213.              LET newind, ind = ind - 4
  214.  
  215.         CASE "END SELECT", "END WHEN"
  216.              LET newind, ind = ind - 5
  217.  
  218.         CASE "ELSE", "ELSEIF"     ! In middle
  219.              LET ind = ind - 3
  220.  
  221.         CASE "CASE", "USE"
  222.              LET ind = ind - 5
  223.  
  224.         CASE else                 ! Nothing to do
  225.  
  226.         END SELECT
  227.  
  228.     END SUB
  229.  
  230.     SUB join                      ! Put line together
  231.  
  232.         IF ind < 0 then LET ind = 0    ! To prevent abort
  233.  
  234.         IF text$ <> "" then       ! Normal case
  235.  
  236.            LET l$ = num$ & repeat$(" ", ind) & text$  ! Line number and indented text
  237.            IF com$ <> "" then     ! Must add comment
  238.               LET l = len(l$)
  239.               LET l2 = l + 3      ! At least 3 spaces
  240.               LET l2 = max(mincom,l2)  ! At least mincom
  241.               LET r2 = mod(l2,5)
  242.               IF r2 > 0 then LET l2 = l2 + 5 - r2     ! Multiple of 5
  243.               LET l$ = l$ & repeat$(" ", l2-l-1) & com$
  244.            END IF
  245.         ELSE                      ! No text
  246.            LET l$ = num$
  247.            IF com$ <> "" then LET l$ = l$ & repeat$(" ", ind) & com$
  248.         END IF
  249.  
  250.     END SUB
  251.  
  252. END SUB                           ! Subroutine format
  253.  
  254. SUB getlinenum (line$, num$, rest$)
  255.  
  256.     LET i = ncpos(line$,"0123456789")
  257.     IF i = 0 then LET i = maxnum
  258.  
  259.     LET num$ = line$[1:i-1]
  260.     LET rest$ = line$[i:maxnum]
  261.  
  262. END SUB
  263.  
  264. SUB sepcom (line$, comment$)
  265.  
  266.     ! Separate on-line comment, if any
  267.  
  268.     DECLARE DEF posnq
  269.  
  270.     LET p = posnq (line$, "!", 1)
  271.     IF p = 0 then
  272.        LET comment$ = ""
  273.     ELSE
  274.        LET comment$ = line$[p:maxnum]
  275.        LET line$ = line$[1:p-1]
  276.     END IF
  277.  
  278. END SUB
  279.  
  280. SUB nextword (line$, p1, p2, word$)
  281.  
  282.     ! word$ = next word AFTER character p2
  283.     ! p1 points to begin, p2 to end of word$
  284.  
  285.     LET p1 = ncpos(line$ & "x", " ,:=(;+-""#", p2 + 1)
  286.     LET p2 = cpos(line$ & " ", " ,:=(;+-""#", p1) - 1
  287.  
  288.     LET word$ = line$[p1:p2]
  289.  
  290. END SUB
  291.  
  292. DEF posnq (line$, s$, p)
  293.  
  294.     ! Search for first occurrence, on or after p, of s$ in line$,
  295.     ! not in quotes.  Return position, or 0 if none.
  296.  
  297.     DO
  298.        LET p, posnq = pos(line$, s$, p)
  299.        IF p = 0 then EXIT DEF
  300.        DO
  301.           LET q = pos(line$, """", q+1)
  302.           IF q = 0 then EXIT DEF  ! call it unquoted if no " follows
  303.           LET unq = 1 - unq
  304.        LOOP until q > p
  305.        LET p = p + 1              ! prepare to find next occurence
  306.     LOOP until unq = 1            ! unless this one was unquoted
  307.  
  308. END DEF
  309.