Alexander Podkolzin (app@sbank.e-burg.su)
PB SOURCE CODE BEAUTIFIER
------------------------------------------------------------------------------

' First of all, excuse me for my English. This program is a greate deal an
' exercise in English language, not in BASIC. It's a pity, but English for
' me is "dead" language, as Latin for instance. Just image: I'v never talked
' with any alive English speaking person...
' I'v been using this program from the beginning of 1995, sucáessfully :)
' Last revision: December,1994.
'---------------------------------------------------------------------------
'                          PowerBASIC 3.0C 
'    Demonstrates some features of the best BASIC of the 20th century.
'                    Author: Alexander Podkolzin,
'                       app@nw.sbank.e-burg.su
'               Choose an author as you choose a friend!
'               USERS! THERE IS NO ANY WARRANTY FOR YOU,
'                      USE IT ON YOUR OWN RISK !
'                     This program is "FREEWARE"
'                     Fortune favours the brave !
'                    Any suggestions are welcomed!
'---------------------------------------------------------------------------
 $lib all off
 $optimize speed
 $compile exe
'---------------------------------------------------------------------------
' This program does not change your initial code.    It creates a new file
' to look through (with extension ".app") and has to be run with  filename
' you want to modify with any combination of following keys
' ( default is "/b/c/d" ):
'
'                /b..............beautifying (attempt of)
'                /c....................uppercase keywords
'                /d..................delete empty strings
'                /l....................lowercase keywords
'                /m...........minimize blanks in comments
'                /n.....................strip all indents
'                /s....................strip all comments.
'
' You can incert all these keys into the first line of your program. In
' this case first line has to contain "$PBB", followed by those keys
' and "'" in the first position, e.g.: "'     $PBB /b/c/d".
'
' P.S......Well, you know, not only programming but simple writing
'          also is a great deal of art.  So do not hope  that the
'          program will make all job for you.  Only 80%! If you want
'          a thing well done, do it yourself.
'
' P.P.S... Beauty is in the eye of the beer holder...
'
' P.P.P.S..Remember: Every last error in my program really is the last,
'                    but one.         :)
'---------------------------------------------------------------------------
' This BEAUTIFIER:  (Of course my own programming style caused its features)
'
'      - does not change your initial file;
'      - does not change strings inside block $IF 0 ... $ENDIF;
'      - does not separates long statements with "_", as nobody can foresee
'        all possible cases, even Me :-) .    I denyed  separation as it's
'        a 5% of work, but to program it I have to do 3 times more  code!
'      - does not devide strings such as "IF ... THEN ... : ... : ..."
'      - does (about comments):
'        = if nitial comment begins from 1st position it remains there,
'          in all other cases comment is to be placed from position
'          of comment (%commentpos);
'        = if comment can't be placed from %commentpos (statement is
'          longer), then it's to be placed from his statement`s position;
'
' Demands to initial code:        ( Yes, there are many things depending
'                                   on your style )
'
' 1.  The number of quotational marks in a string have to be even.
' 2.  Syntax of initial text has to submit to PowerBASIC rules, as some
'     BASICs have different key words (for example "END IF" and "ENDIF").
' 3.  ...?
'
' Play with the program and find what key (combination) you prefer.
' You can enhance the program easyly, as it's written in clear manner.
' For more readability of the code I separate logical conditions in basic
' places.
' Perhaps,there is a some kind of superfluousness in the program, sorry.
' I wish you an excelent beautifying with this program!
'---------------------------------------------------------------------------
defint a-z
'---------------------------------------------------------------------------
' Tastes differ...

%indent     =   2         ' unconditional indent
 %delta      =   3         ' indent for structured statements
  %indntincr  =   2         ' indent increment
   %maxlen     =  77         ' maximum length of line
    %maxelem    =  10         ' maximum number of string constants in a line
     %commentpos =  41         ' from this position comment begins,
                                ' if a string is longer then %commentpos,
                                 ' comment is being placed before the string
     %FALSE = 0
     %TRUE  = NOT %FALSE

     SkipBeforeLabel = %TRUE     ' if you need blank lines before label

'---------------------------------------------------------------------------
if command$="" then
   print "Using: <name[.ext]> /b/c/d/l/m/n/s"
    print "/b - beautifying,"
     print "/c - uppercase keywords,"
      print "/d - delete empty strings,"
       print "/l - lowercase keywords,"
        print "/m - shorten blanks in comments,"
         print "/n - strip indents,"
          print "/s - strip comments."
           end
end if

if %delta<>0 then                 ' It is a good horse that never stumbles.
     del$     = space$(%delta)
     else
     del$     = ""
end if

if %indntincr<>0 then
     indinc$  = space$(%indntincr)
     else
     indinc$  = ""
end if

if %indent<>0 then
     ind$     = space$(   %indent)
     ind0$=ind$
else
     ind$     = ""
end if
'---------------------------------------------------------------------------
delempty  = %FALSE         ' Tell that to the marines...
needupper    =   %FALSE
 needlower      =     %FALSE
  minblanks        =       %FALSE
  needbeauty          =         %FALSE
 stripindents            =           %FALSE
 stripcomments              =             %FALSE

  task$=combme$(lcase$(command$))

  n=instr(task$,".")
  if n<>0 then
    filename$  = left$(task$,n-1)
    extension$ = mid$(task$,n,4)
  else
    filename$  = task$
    extension$ = ".bas"
  end if

if len(filename$)=0 then
  print "Bad filename!"
  end
end if

if extension$ = ".app" then
   print "Extension .APP is not allowed!"    ' so Let well alone...
   end
end if
'---------------------------------------------------------------------------
'          Why doesn't DOS ever say "EXCELLENT command or filename!"
'---------------------------------------------------------------------------

if instr(task$,"/") = 0 then      ' default combination of keys
   sourcefile = freefile
   open filename$+extension$ for input  as sourcefile
   line input #sourcefile,s$
   s$=lcase$(s$)
   close sourcefile
   if instr(s$,"$pbb ")<>0 and instr(s$,"/")<>0 then
      task$=task$+mid$(s$,instr(s$,"/"))
   else
      task$=task$+"/b/c/d"
   end if
end if

if instr(task$,"/b") then         ' beauty indents
         task$=remove$(task$,"/b")
              needbeauty   = %TRUE
                            end if
if instr(task$,"/c") then         ' uppercase reserved words
         task$=remove$(task$,"/c")
             needupper     = %TRUE
                            end if
if instr(task$,"/l") then         ' lowercase reserved words
         task$=remove$(task$,"/l")
             needlower     = %TRUE
                            end if
if instr(task$,"/d") then         ' delete empty strings
         task$=remove$(task$,"/d")
              delempty     = %TRUE
                            end if
if instr(task$,"/m") then         ' minimize blanks in comments
         task$=remove$(task$,"/m")
              minblanks    = %TRUE
                            end if
if instr(task$,"/n") then         ' remove all indents
         task$=remove$(task$,"/n")
              stripindents = %TRUE
                            end if
if instr(task$,"/s") then         ' remove all comments
         task$=remove$(task$,"/s")
              stripcomments= %TRUE
                            end if
'---------------------------------------------------------------------------
' Here we are preparing the   '            The more haste, the less speed...
' string  of reserved  words. '
' String, because  INSTR  is  '
' faster  then    ARRAY SCAN. '    Buy a Pentium so you can reboot faster...
'
  dim mi%(%maxelem,2)

  while s$<>"Goodbye!"
     read s$
     reswd$=reswd$+s$
  wend
'---------------------------------------------------------------------------
' Come on!  Well begun is half done...

t#=timer  ' We shell see how the cat jump...

sourcefile = freefile
open filename$+extension$ for input  as sourcefile
destfile = freefile
open filename$+".app"   for output as destfile
nline=0

s$="' Date of the last formatting = " + DATE$ + "  " + TIME$
PRINT #destfile,s$

DO        ' begin of the main loop

  if eof(sourcefile) then  exit loop
  line input #sourcefile,s$
  incr nline

  if s$ = "" then            ' do we need empty strings ?
     if delempty then
        iterate              ' No? we don't.
     else
        gosub printme        ' Yes, of course.
     end if
  end if
  z$=lcase$(left$(ltrim$(s$),6))

  if instr(z$, "$if 0")<>0  then
     skipblock = %TRUE
     gosub printme
     iterate
  end if

  if instr(z$,"$endif")<>0  then
     skipblock = %FALSE
     gosub printme
     iterate
  end if

  if skipblock then          ' All lines inside of $IF 0 ... $ENDIF
    gosub printme            ' we have not to change... (My opinion).
    iterate
  end if                     ' And skip ASM-statements:

  if left$(z$,1)="!" or left$(z$,4)="asm " then
    gosub printme
    iterate
  end if

  if needbeauty or stripindents then
    oldindent$=""
  else
    oldindent$=leadingblanks$(s$)
  end if
  s$=removerubbish$(s$)
'---------------------------------------------------------------------------
  call separate(s$,lin$,comment$,cp) ' To pick the plums out of the pudding

  if minblanks then
    comment$=combme$(comment$)
  end if

  if ltrim$(lin$)="" then
    nostmnt = %TRUE
  else
    nostmnt = %FALSE
  end if
'---------------------------------------------------------------------------
  if nquo%(lin$,mi%()) then   ' makes info about string constants.
   beep
    print "Error (ODD QUOTE). Correct this error in line #"; nline
     print "and restart program. Write down the line # and press a key."
      z$=input$(1)
       end if
'---------------------------------------------------------------------------
' We have to fill all blanks with any special simbol for not to harm  the
' string constants
for  i=1 to %maxelem
  if mi%(i,1)=0 then exit for
    for  k=mi%(i,1) to mi%(i,2)
      if mid$(lin$,k,1)=" " then
        mid$(lin$,k,1)=chr$(5)
          end if
            next k
              next i
'---------------------------------------------------------------------------
lin$=combme$(lin$)   ' It's a string
cpy$=lin$            ' It's its copy
statement$=""
'---------------------------------------------------------------------------
' In this loop we sculpture '                What's done cannot be undone...
' a string word by word     '

do while lin$<>""
  st$=getword$(lin$,del$)
  z$=st$
  z$=ucase$(z$)
  if needupper and isinlist(reswd$," "+z$+" ") then st$=ucase$(st$)
  if needlower and isinlist(reswd$," "+z$+" ") then st$=lcase$(st$)
  statement$=statement$+st$+del$
loop
'---------------------------------------------------------------------------
statement$ = combme$(statement$)
replace chr$(5) with " " in statement$         ' to restore our blanks
zorro$ = lcase$(statement$)
'--------------------------------------------------------------------------
' Here  we are checking the `ends` of sructured statements;
' `ends` before `begins`, as shift for begin has to be one string later.
' For more readability of the program I separate conditions:
'
   a = ( left$(zorro$, 6) =         "end if" )
   b = ( left$(zorro$, 4) =           "wend" )
   c = ( left$(zorro$,10) =     "end select" )
   d = ( left$(zorro$, 4) =           "loop" )
   e = ( left$(zorro$, 4) =           "next" )
   f = ( left$(zorro$, 8) =       "end type" )
   g = ( left$(zorro$,12) =   "end function" )
   h = ( left$(zorro$, 7) =        "end sub" )

   if  a  OR  b  OR  c  OR  d  OR  e OR f OR g OR h then
     needshift=%FALSE

     if c then
       if len(addshift$)>%delta then
         addshift$=space$(len(addshift$)-%delta)
       end if
     end if

     if len(addshift$)>%delta then
       addshift$ = space$(len(addshift$) - %delta)
     else
       addshift$=""
     end if
   end if

'--------------------------------------------------------------------------
fullshift$=oldindent$+ind$+addshift$
if not needbeauty           then
  statement$ = oldindent$+statement$
else
  statement$ = fullshift$+statement$
end if
if stripcomments            then
  comment$ = ""
  statement$=oldindent$+statement$
end if
z$=ltrim$(statement$)
if stripindents then  statement$ = z$
' --------------------------------------------------------------------------
' And now exceptions:                      The exception proves the rule...
'
a = (not stripindents) and needbeauty
b = (left$(lcase$(z$),4) = "else")
c = (left$(lcase$(z$),4) = "case")
if (a and b) or (c) and (not stripindents) then
   statement$ = right$(rtrim$(statement$),len(statement$)-%delta-1)
end if
'--------------------------------------------------------------------------
'                 Well, at last we'v reached our goal !
                          GOSUB printstring
'--------------------------------------------------------------------------
fullshift$=""
'--------------------------------------------------------------------------
' Here we are checking the `begins` of structured statements

   a = (left$(zorro$, 3) =          "if ") and (right$(zorro$,5)="then ")
   b = (left$(zorro$, 6) =       "while ") and (instr(zorro$,"wend")=0)
   c = (left$(zorro$,12) = "select case ")
   d = (left$(zorro$, 3) =          "do ") and (instr(zorro$,"loop")=0)
   e = (left$(zorro$, 4) =         "for ") and (instr(zorro$,"next")=0)
   f = (left$(zorro$, 5) =        "type ")
   g = (left$(zorro$, 9) =    "function ")
   h = (left$(zorro$, 4) =        "sub " )
   i = (left$(zorro$, 3) =          "if ") and (right$(zorro$,2)="_ ")

   if a OR b OR c OR d OR e OR f OR g OR h OR i then
     needshift=%TRUE
     addshift$=space$(len(addshift$) + %delta)
     if c then
       addshift$=addshift$+space$(%delta)
     end if
   end if
'--------------------------------------------------------------------------
LOOP ' end of the main loop

close sourcefile
close destfile

  print
  print
  print "Your COMMAND$ was: ";command$
  print "Total lines = "; nline
  print "Total time  = "; using$("####.###",timer-t#);" s."
  print "THANK YOU, Bye-Bye !"
'
'--------------------------------------------------------------------------
' Empty vessels make the greatest...
'
  sound 524,0.5 : delay 0.10      ' C
  sound 660,0.5 : delay 0.10      ' E
  sound 784,0.5 : delay 0.10      ' G
  sound 660,0.5 : delay 0.20      ' E
  sound 524,0.2 : delay 0.10      ' C
  sound 494,0.5 : delay 0.20      ' H
  sound 880,0.5 : delay 0.10      ' A
  sound 880,1.0 : delay 1.00      ' A

'--------------------------------------------------------------------------
END  ' Bye-Bye !                               Out of sight, out of mind...
'--------------------------------------------------------------------------
printstring:
statement$ = rtrim$(statement$)
cpy$=rtrim$(cpy$)
'---------------------------------------------------------------------------
a = ( right$(cpy$,1) = ":" )
b = ( instr(cpy$, any " ()<>=\;+-,/*"+chr$(34) ) = 0)
if a and b  then                             ' In my humble opinion, labels
  statement$=ltrim$(statement$)              ' should be at the left margin.
     if SkipBeforeLabel then
       s$=""
       gosub printme
     end if
end if
'---------------------------------------------------------------------------
  comment$ = ltrim$(rtrim$(comment$))

            if nostmnt then
              if cp=1 then
                s$=comment$
              else
                 s$=space$(cp)+comment$
              end if
              if s$<>"" and not stripcomments then
                 gosub printme
              end if
              return
            end if
'---------------------------------------------------------------------------

  n = len(statement$)
  if n < %commentpos then              ' statement$ is not too long
    if comment$<>"" then
      d$=space$(%commentpos-n-1)
    else
      d$=""
    end if
    s$=statement$+d$+comment$
    gosub printme
  else                                 ' statement$ is too long
    if comment$<>"" then
      d$=leadingblanks$(statement$)
      s$=d$+ltrim$(comment$)
      gosub printme
    end if
    s$=statement$
    gosub printme
  end if
return
'---------------------------------------------------------------------------
printme:
    PRINT s$
    PRINT #destfile,s$
return
'--------------------------------------------------------------------------
FUNCTION isquoted%(ss$,n%,c$)  ' checks whether Nth simbol is quoted by c$
s$ = left$(ss$,n%-1)
isquoted% = (TALLY(s$,c$) mod 2) * (instr(n%+1,ss$,c$)<>0)
END FUNCTION
'--------------------------------------------------------------------------
FUNCTION removerubbish$(s$)
for  i%=1 to len(s$)
  k%=asc(mid$(s$,i%,1))
  if k%<32 then
    mid$(s$,i%,1)=" "
  end if
next i%
removerubbish$=s$
END FUNCTION
'--------------------------------------------------------------------------
FUNCTION nquo%(s$,mi%())
' Function creates info  about string constants in  s$.
' mi%(i,1).....................contains begin position,
' mi%(i,2)..contains end position of I-string constant.
' Returns:
' 1..........if there are ODD  number of '"' in string,
' 0..........if there are EVEN number of '"' in string.

    for k%=1 to %MAXELEM              ' Cleaning
       mi%(k%,1)=0
       mi%(k%,2)=0
    next k%
    n% =len(s$)                       ' Little pitchers have long ears
    nquo%=0
    if n%=0 then exit function
    c$=chr$(34)
    nq%=instr(s$,c$)                  ' Position of the quotational mark
    if nq%=0 then exit function
    k%  = 1
    nk% = 0
    l%  = 1
    for i%=nq% to n%                  ' Here we are
      if mid$(s$,i%,1)=c$ then        ' making our array
         k%=k% xor 1
         mi%(l%,k%+1)=i%
         incr l%,k%
         incr nk%
      end if
    next i%
    nquo% = nk% mod 2
END FUNCTION
'--------------------------------------------------------------------------
FUNCTION getword$(ss$,del$)   ' Parser. Returns regular word - unit of text
s$   = extract$(ss$, any " =()<>\;:+-,/*")
getword$=s$
ss$  = ltrim$(ss$, s$)
del$ = left$(ss$,1)
ss$  = ltrim$(ss$)
if left$(ss$,1)=del$ then ss$  = mid$(ss$,2,len(ss$)-1)
END FUNCTION
'--------------------------------------------------------------------------
FUNCTION IsInList%(RW$,s$)
  if instr(1,RW$,s$)<>0 then
     isinlist%= %TRUE
  else
     isinlist%= %FALSE
  end if
END FUNCTION
'--------------------------------------------------------------------------
FUNCTION LeadingBlanks$(ss$)
  s$=ltrim$(ss$)
  n%=len(ss$)-len(s$)
  if n%=0 then
    leadingblanks$=""
  else
    leadingblanks$=space$(n%)
  end if
END FUNCTION
'--------------------------------------------------------------------------
FUNCTION CombMe$(ss$)
  ss$=ltrim$(rtrim$(ss$))
  do
    replace "  " with " " in ss$
  loop while instr(ss$,"  ")
  combme$=ss$+" "
END FUNCTION
'--------------------------------------------------------------------------
SUB Separate(s$,lin$,comment$,cp%)        ' separates line and comment
  c$=chr$(39)                             ' cp% - comment position
  lin$ =s$
  comment$=""
  cp%=0
  z$=ucase$(s$)+" "
  m%=instr(z$,"REM ")
  if m%<>0 then mid$(s$,m%,4)=chr$(39,32,32,32)
  k%=instr(s$,c$)
  if k%<>0 then
    if isquoted(s$,k%,chr$(34))=0 then
      lin$ =rtrim$(left$(s$,k%-1))
      comment$=right$(s$,len(s$)-k%+1)
      cp%=k%
      exit sub
    else
      exit sub
    end if
  end if
END SUB

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'   ATTENTION!
' Every reserved word has to finish with " " (blank).
' The last word of the list has to be "Goodby!".
' If you want your own reserved words, which will be printed with caps or
' lowers, include them into this list!
'___________________________________________________________________________

DATA "$ALIAS $CODE $COM $COM1 $COM2 $COMPILE $CPU $DEBUG $DIM $DYNAMIC "
DATA "$ELSE $ENDIF $ERROR $EVENT $FLOAT $HUGE $IF $INCLUDE $INLINE $LIB "
DATA "$LINK $OPTIMIZE $OPTION $SEGMENT $SOUND $STACK $STATIC $STRING ABS "
DATA "ABSOLUTE ACCESS ALL AND ANY APPEND ARRAY AS ASC ASCEND ASCII ASM AT "
DATA "ATN ATTRIB BASE BEEP BIN$ BINARY BIT BITS BLOAD BSAVE BYCOPY BYVAL "
DATA "CALL CASE CBCD CBYT CDBL CDWD CEIL CEXT CFIX CLNG CHAIN CHDIR CHDRIVE "
DATA "CHR$ CINT CIRCLE CLEAR CLNG CLOSE CLS CNTLBREAK COLLATE COLOR COM "
DATA "COMMAND$ COMMON COS CQUD CSNG CSRLIN CURDIR$ CVB CVD CVE CVF CVI CVL "
DATA "CVMD CVMS CVQ CVS CWRD DATA DATE$ DECLARE DECR DEF DEFBCD DEFDBL "
DATA "DEFEXT DEFFIX DEFFLX DEFINT DEFLNG DEFQUD DEFSNG DEFSTR DELAY DELETE "
DATA "DESCEND DIM DIR$ DO DRAW DYNAMIC ELSE ELSEIF EMS END ENDMEM ENVIRON "
DATA "ENVIRON$ EOF EQV ERADR ERASE ERDEV ERDEV$ ERL ERR ERROR ERRTEST EXE "
DATA "EXECUTE EXIT EXP EXP10 EXP2 EXTERNAL EXTRACT$ FAR FIELD FILEATTR "
DATA "FILES FIX FIXDIGITS FLEXCHR$ FLUSH FN FOR FRAC FRE FREEFILE FROM "
DATA "FUNCTION GET GETSTRLOC GET$ GOSUB GOTO HEX$ IF IMP IN INCR INKEY$ "
DATA "INP INPUT INPUT$ INSERT INSTAT INSTR INT INTERRUPT IOCTL IOCTL$ "
DATA "ISFALSE ISTRUE ITERATE KEY KILL LBOUND LCASE$ LEFT LEFT$ LEN LET "
DATA "LINE LIST LOC LOCAL LOCATE LOCK LOF LOG LOG10 LOG2 LOOP LPOS LPRINT "
DATA "LSET LTRIM$ MAP MAX MAX$ MAX% MEMPACK MEMSET MID$ MIN MIN$ MIN% MKDIR "
DATA "MKB$ MKD$ MKDWD$ MKE$ MKF$ MKI$ MKL$ MKMD$ MKMS$ MKQ$ MKS$ MKWRD$ MOD "
DATA "MTIMER MULTIPLEX NAME NEXT NOT OCT$ OFF ON OPEN OPTION OR OUT OUTPUT "
DATA "PAINT PALETTE PEEK PEEK$ PEEKI PEEKL PEN PLAY PMAP POINT POKE POKE$ "
DATA "POKEI POKEL POPUP POS PRESET PRINT PSET PUBLIC PUT PUT$ QUIET RANDOM "
DATA "RANDOMIZE READ REDIM REG REM REMOVE$ REPEAT$ REPLACE RESET RESTORE "
DATA "RESUME RETURN RIGHT RIGHT$ RMDIR RND ROTATE ROUND RSET RTRIM$ RUN "
DATA "SAVE SCAN SCREEN SEEK SEG SELECT SETMEM SGN SHARED SHELL SHIFT "
DATA "SIGNED SIN SLEEP SORT SOUND SPACE$ SPC SQR STATIC STEP STICK STOP TR$ "
DATA "STRIG STRING$ STRPTR STRSEG STUFF SUB SWAP SYSTEM TAB TAGARRAY TALLY "
DATA "TAN TEXT THEN TIME$ TIMER TO TROFF TRON TYPE UBOUND UCASE UCASE$ "
DATA "UEVENT UNION UNLOCK UNTIL USING USING$ VAL VARPTR VARPTR$ VARSEG "
DATA "VERIFY VIEW WAIT WEND WHILE WIDTH WINDOW WITH WRITE XOR "
DATA "KYBD: SCRN: CONS: LPT1: LPT2: LPT3: COM1: COM2: COM3: COM4: "
DATA "BYTE WORD INTEGER LONG DOUBLE STRING "

DATA "Goodbye!"        ' End of The Key Words List.

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' Sorry, my English would even a cat laugh...
' See P.P.P.S.!
'___________________________________________________________________________