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