'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'³                                                                             ³
'³   Source code formatter for PowerBASIC 3.1                                  ³
'³   Copyright (c) 1995 by PowerBASIC, Inc.  All Rights Reserved.              ³
'³                                                                             ³
'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

$CPU 8086                 ' program works on any CPU
$COMPILE EXE              ' compile to an EXE

$STRING 32                ' set largest string size at 32k
$STACK  4096              ' use a 4k stack

$DYNAMIC                  ' all arrays will be dynamic by default

$OPTION CNTLBREAK OFF     ' don't allow Ctrl-Break to exit program
$LIB ALL OFF              ' turn off all unused libraries

DEFINT A-Z                ' default all variables to integers for maximum
                          ' speed and minimum size

$LINK "DOSUNIT.PBU"       ' link in DOSUNIT

'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

SHARED IndentStart, IndentSize, KeywordCase, Cmds$

' PowerBASIC 3.1 metastatements

Cmds$ = ""
Cmds$ = Cmds$ + " $ALIAS $CODE $COM $COM1 $COM2 $COMPILE $CPU $DEBUG $DIM"
Cmds$ = Cmds$ + " $DYNAMIC $ELSE $ENDIF $ERROR $EVENT $FLOAT $HUGE $IF"
Cmds$ = Cmds$ + " $INCLUDE $INLINE $LIB $LINK $LIST $OPTIMIZE $OPTION $SEGMENT"
Cmds$ = Cmds$ + " $SOUND $STACK $STATIC $STRING"

' PowerBASIC 3.1 supported BASIC commands

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

' PowerBASIC 3.1 special variables

Cmds$ = Cmds$ + " PBVBINBASE PBVCPU PBVCURSOR1 PBVCURSOR2 PBVCURSORVIS"
Cmds$ = Cmds$ + " PBVDEFSEG PBVERR PBVFIXDIGITS PBVFLEXCHR PBVHOST PBVMINUSONE"
Cmds$ = Cmds$ + " PBVNPX PBVONE PBVREVISION PBVREVLTR PBVSCRNAPAGE PBVSCRNBUFF"
Cmds$ = Cmds$ + " PBVSCRNCARD PBVSCRNCOLS PBVSCRNMODE PBVSCRNPXLATTR"
Cmds$ = Cmds$ + " PBVSCRNROWS PBVSCRNTXTATTR PBVSCRNVPAGE PBVSWITCH"
Cmds$ = Cmds$ + " PBVUSERAREA PBVUSINGCHRS PBVVTXTX1 PBVVTXTX2 PBVVTXTY1"
Cmds$ = Cmds$ + " PBVVTXTY2 PBVZERO"

IndentStart = 0           'starting column for indenting
IndentSize  = 2           'number of spaces to indent
KeywordCase = 0           'don't change keyword case
            ' 1           'convert keywords to upper case
            ' 2           'convert keywords to lower case

%FALSE = 0
%TRUE  = NOT %FALSE

'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

PRINT "PowerBASIC Source Code Formatter v1.0a"
PRINT "Copyright (c) 1994 PowerBASIC, Inc.  All Rights Reserved."
PRINT

OutFile$  = UCASE$(COMMAND$)

'***  Assume a .BAS extension  ***
IF INSTR(OutFile$, ".") = 0 THEN
  OutFile$ = OutFile$ + ".BAS"
END IF

IF NOT Exist(OutFile$) THEN
  PRINT "File Not Found."
  BEEP
  END 1
END IF

SplitPath OutFile$, Drive$, Path$, InFile$

'***  Backup original file  ***
Dot = INSTR(InFile$, ".")
IF Dot = 0 THEN
  InFile$ = InFile$ + ".BAK"
ELSE
  InFile$ = LEFT$(InFile$, Dot) + "BAK"
END IF

InFile$ = Drive$ + Path$ + InFile$

IF Exist(InFile$) THEN
  KILL InFile$
END IF

'***  Backup the original file  ***
NAME OutFile$ AS InFile$


'***  Open file and process it  ***
OPEN "I", 1, InFile$
  OPEN "O", 2, OutFile$
    Length& = LOF(1)
    WHILE NOT EOF(1)
      LINE INPUT# 1, Tmp$
      BytesRead& = BytesRead& + LEN(Tmp$) + 2
      Percent = (BytesRead& * 100) \ Length&
      LOCATE ,1
      PRINT STR$(Percent);"% Done";
      Tmp$ = FormatLine$(Tmp$)
      PRINT# 2, Tmp$
    WEND
  CLOSE 2
CLOSE 1

PRINT
END

'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

FUNCTION FormatLine$(BYVAL Source$)

  STATIC InComment

  Original$ = LTRIM$(RTRIM$(Source$, ANY CHR$(9,32)), ANY CHR$(9,32))
  Work$     = UCASE$(Original$)
  TempStart = -1

  IF LEN(Work$) = 0 THEN
    EXIT FUNCTION
  END IF

  KeyWord$ = UCASE$(EXTRACT$(Work$, ANY " ,="))

  IF InComment = %TRUE THEN
    FormatLine$ = Source$
    EXIT FUNCTION
  ELSEIF UCASE$(LEFT$(Work$, 5)) = "$IF 0" THEN
    InComment = %TRUE
    TempStart = 0
    GOTO ExtendLine
  ELSEIF KeyWord$ = "$ENDIF" THEN
    InComment = %FALSE
    TempStart = 0
    GOTO ExtendLine
  ELSEIF (ASCII(Work$) = 39) OR (UCASE$(LEFT$(Work$, 3)) = "REM") THEN
    FormatLine$  = Source$
    EXIT FUNCTION
  ELSEIF KeyWord$ = "DATA" THEN                'don't mess with DATA statements
    FormatLine$  = Source$
    EXIT FUNCTION
  ELSEIF (ASCII(Work$) = 36) THEN              'meta-statement
    TempStart = 0
    GOTO ExtendLine
  END IF

  IF KeyWord$ = "IF" THEN
    Tmp = INSTR(UCASE$(Work$), "THEN")
    IF (Tmp + 3) = LEN(Work$) THEN
      TempStart = IndentStart
      INCR IndentStart, IndentSize
      GOTO ExtendLine
    END IF
    Tmp$ = LTRIM$(MID$(Work$, Tmp+4))
    IF ASCII(Tmp$) = 39 THEN
      TempStart = IndentStart
      INCR IndentStart, IndentSize
      GOTO ExtendLine
    END IF
    GOTO ExtendLine
  END IF

  IF (KeyWord$ = "ELSE") OR (KeyWord$ = "ELSEIF") THEN
    Tmp = IndentStart - IndentSize
    IF Tmp< 0 THEN
      Tmp = 0
    END IF
    TempStart = Tmp
    GOTO ExtendLine
  END IF

  IF KeyWord$ = "END" THEN
    Tmp$ = UCASE$(Work$)
    IF (INSTR(Tmp$, "IF") = 5) OR (INSTR(Tmp$, "TYPE") = 5) THEN
      DECR IndentStart, IndentSize
      GOTO ExtendLine
    ELSEIF (INSTR(Tmp$, "FUNCTION") = 5) OR (INSTR(Tmp$, "SUB") = 5) THEN
      IndentStart = 0
    ELSEIF INSTR(Tmp$, "SELECT") = 5 THEN
      DECR IndentStart, IndentSize
      DECR IndentStart, IndentSize
      GOTO ExtendLine
    END IF
  END IF

  IF (KeyWord$ = "SUB") OR (KeyWord$ = "FUNCTION") THEN
    TempStart = 0
    IndentStart = IndentSize
    GOTO ExtendLine
  END IF

  IF KeyWord$ = "TYPE" THEN
    TempStart = IndentStart
    INCR IndentStart, IndentSize
    GOTO ExtendLine
  END IF

  IF KeyWord$ = "SELECT" THEN
    TempStart = IndentStart
    INCR IndentStart, IndentSize
    INCR IndentStart, IndentSize
    GOTO ExtendLine
  END IF

  IF KeyWord$ = "CASE" THEN
    Tmp = IndentStart - IndentSize
    IF Tmp< 0 THEN
      Tmp = 0
    END IF
    TempStart = Tmp
    GOTO ExtendLine
  END IF

  IF KeyWord$ = "FOR" THEN
    IF INSTR(Work$, "NEXT") = 0 THEN
      TempStart = IndentStart
      INCR IndentStart, IndentSize
      GOTO ExtendLine
    END IF
  ELSEIF KeyWord$ = "NEXT" THEN
    DECR IndentStart, IndentSize
    GOTO ExtendLine
  END IF

  IF KeyWord$ = "WHILE" THEN
    IF INSTR(Work$, "WEND") = 0 THEN
      TempStart = IndentStart
      INCR IndentStart, IndentSize
      GOTO ExtendLine
    END IF
  ELSEIF KeyWord$ = "WEND" THEN
    DECR IndentStart, IndentSize
    GOTO ExtendLine
  END IF

  IF KeyWord$ = "DO" THEN
    IF INSTR(Work$, "LOOP") = 0 THEN
      TempStart = IndentStart
      INCR IndentStart, IndentSize
      GOTO ExtendLine
    END IF
  ELSEIF KeyWord$ = "LOOP" THEN
    DECR IndentStart, IndentSize
    GOTO ExtendLine
  END IF

ExtendLine:
  IF TempStart = -1 THEN
    NewLine$ = SPACE$(IndentStart)
  ELSE
    NewLine$ = SPACE$(TempStart)
  END IF

  TempLine$ = Original$
  WHILE LEN(TempLine$)
    KeyWord$ = BasParse$( TempLine$ )

    IF KeyWordCase > 0 THEN
      IF INSTR(UCASE$(Cmds$), UCASE$(" "+KeyWord$+" ")) > 0 THEN
        IF     KeyWordCase = 1 THEN               ' upper case
          KeyWord$ = UCASE$(KeyWord$)
        ELSEIF KeyWordCase = 2 THEN               ' lower case
          KeyWord$ = LCASE$(KeyWord$)
        END IF
      END IF
    END IF

    IF KeyWord$ = "'" THEN
      NewLine$ = NewLine$ + KeyWord$ + TempLine$
      EXIT DO
    ELSEIF (KeyWord$ = ",") OR (KeyWord$ = ";") OR (KeyWord$ = ":") THEN
      NewLine$ = RTRIM$(NewLine$) + KeyWord$ + " "
    ELSEIF KeyWord$ = "-" THEN
      IF LastKeyWord$ = "(" THEN
        NewLine$ = NewLine$ + KeyWord$ + BasParse$( TempLine$ ) + " "
      ELSEIF (INSTR("+=/\<>*^-", LastKeyWord$)) AND (INSTR(TempLine$, ANY "0123456789") < 0) THEN
        NewLine$ = NewLine$ + KeyWord$ + BasParse$( TempLine$ ) + " "
      ELSE
        NewLine$ = NewLine$ + KeyWord$ + " "
      END IF
    ELSEIF KeyWord$ = "(" THEN
      IF (INSTR("-+/\*^<>=", LastKeyWord$)>0) OR (INSTR("ELSEIFANDXORMOD", LastKeyWord$)>0) THEN
        NewLine$ = NewLine$ + KeyWord$ + " "
      ELSE
        NewLine$ = RTRIM$(NewLine$) + KeyWord$ + " "
      END IF
    ELSEIF KeyWord$ = ")" THEN
      IF INSTR("()", LastKeyWord$) THEN
        NewLine$ = RTRIM$(NewLine$) + KeyWord$ + " "
      ELSEIF ASCII(TempLine$) = 46 THEN
        NewLine$ = NewLine$ + KeyWord$
      ELSE
        NewLine$ = NewLine$ + KeyWord$ + " "
      END IF
    ELSE
      NewLine$ = NewLine$ + KeyWord$ + " "
    END IF
    LastKeyWord$ = UCASE$(KeyWord$)
  WEND

  FormatLine$ = RTRIM$(NewLine$)

END FUNCTION

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Parse the next word in a BASIC source code line
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
FUNCTION BasParse$( Source$ )

  Source$ = LTRIM$(Source$, ANY " " + CHR$(9))  'trim spaces and tabs

  Char = ASCII(Source$)

  SELECT CASE Char
    CASE = -1
      BasParse$ = ""
      Source$ = ""
      EXIT FUNCTION

    CASE 39, 40, 41, 42, 43, 44, 45, 47, 58, 59, 60, 61, 62, 92, 94, 95
      BasParse$ = CHR$(Char)
      IF LEN(Source$) > 1 THEN
        Source$ = LTRIM$(MID$(Source$, 2))
      ELSE
        Source$ = ""
      END IF
      EXIT FUNCTION

    CASE = 34
      FOR X = 2 TO LEN(Source$)
        IF MID$(Source$, X, 1) = CHR$(34) THEN
          EXIT FOR
        END IF
      NEXT X
      IF X >= LEN(Source$) THEN
        BasParse$ = RTRIM$(Source$)
        Source$ = ""
        EXIT FUNCTION
      ELSE
        BasParse$ = RTRIM$(LEFT$(Source$, X))
        Source$ = LTRIM$(MID$(Source$, X+1))
        EXIT FUNCTION
      END IF

  END SELECT

  Tmp$ = EXTRACT$(Source$, ANY CHR$(32,34,39,40,41,42,43,44,45,47,58,59,60,61,62,92,94,95))
  BasParse$ = Tmp$

  IF LEN(Tmp$) = LEN(Source$) THEN
    Source$ = ""
  ELSE
    Source$ = LTRIM$(MID$(Source$, LEN(Tmp$) + 1))
  END IF

END FUNCTION