TIP: Click on subject to list as thread! ANSI
echo: power_bas
to: ALL
from: ANDRAS HOEFFKEN
date: 1996-07-25 11:24:00
subject: PB upper case keywords

Hallo all,
upper case keywords in a PB source file make a program better 
readable, that's why PB Inc. added the utility PBSF.BAS to the 
PB3.1 and PB3.2 distribution.
But this tool very unfortionately changes too much the 
individual writing style of a programmer (by e.g. performing 
brutal indentation, imbedding spaces etc.).
The following program only changes the key words but does NOT 
change the length of the lines:
-=-=-=-=-=-=-=-=-=-=-=-=-=- cut -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'KW2UCASE.BAS - Key Words to Upper Case
'Changes PB Keywords to upper case notation, does NOT change indentation,
'does NOT add spaces! The individual style of source writing is retained.
'Derived from the PB3.2 distribution utility PBSF.BAS (does not need the 
B!)
' Call from DOS as:  KW2UCASE filename.ext
' KW2UCASE renames your source code file to filename.BAK, then reads that
' file and formats each line of code.  To restore the original source code,
' just rename it back to it's original filename.
'public domain by:
'  Andras Hoeffken  2:2480/13.34 @ fidonet,  130:1322/302 @ basnet/Germany
'                   email: ah@confusion.rmc.de
'Munich, 25 July 1996
$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
$ERROR ALL ON             ' turn on all error checking
DEFINT A-Z                ' default all variables to integers for maximum
                          ' speed and minimum size
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
SHARED KeywordCase, Cmds$
KeywordCase = 1           ' 1 = convert keywords to upper case
                          ' 2 = convert keywords to lower case
Cmds$ = ""
' PowerBASIC 3.x metastatements:
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.x 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 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 PTR PUBLIC"
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 "
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.x 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"
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
ON ERROR GOTO ErrorHandler
CLS
PRINT "Changing PowerBASIC Keywords to Upper Case Notation"
PRINT
OutFile$  = UCASE$(COMMAND$)
'***  Check for filename on command line  ***
IF LEN(OutFile$) = 0 THEN
  PRINT "Usage:  KW2UCASE filename.ext"
  END 1
END IF
'***  Assume a .BAS extension  ***
IF INSTR(OutFile$, ".") = 0 THEN
  OutFile$ = OutFile$ + ".BAS"
END IF
'***  Backup original file  ***
Infile$ = LEFT$(Outfile$, LEN(outfile$)-1)+"K"  'xxx.BAK
ON ERROR RESUME NEXT            'if there is not yet a .BAK
KILL infile$                    'delete old Backup file
ON ERROR GOTO ErrorHandler
NAME outfile$ AS infile$        'new Backup file
'***  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";
      Tmp1$=Tmp$                 'remember old line
      Tmp$ = FormatLine$(Tmp$)   'new line with upper case keywords
      IF LEN(tmp1$)LEN(tmp$) THEN
        BEEP: CLOSE 1
        CLOSE 2
        PRINT:PRINT "ERROR: Line length 'old - new' is unequal"
        WHILE inkey$="":WEND
        GOTO fini
      END IF
      PRINT# 2, Tmp$
    WEND
  CLOSE 2
CLOSE 1
PRINT
END
ErrorHandler:
  BEEP
  ErCode  = ERR
  Address = ERADR
  RESUME DisplayCode
DisplayCode:
  PRINT ""
  PRINT "Error"; ErCode; " at "; Address;"  ";
  SELECT CASE ErCode
    CASE 53: PRINT "File not found"
    CASE 58: PRINT "File already exists"
    CASE 75: PRINT "Wrong Pathname"
    CASE ELSE: PRINT
  END SELECT
  PRINT "  Free Memory:"; FRE(-1)
  PRINT "  Free String:"; FRE(-7)
  PRINT "  Free Stack :"; FRE(-2)
fini:
  PRINT
  PRINT "Your original source code is in ";Infile$
END 1
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
FUNCTION FormatLine$(BYVAL Source$)
  STATIC InComment
  Work$     = Source$
  IF LEN(Work$) = 0 THEN
    EXIT FUNCTION
  END IF
  NewLine$ = ""
  TempLine$ = Work$
  WHILE LEN(TempLine$)
    KeyWord$ = BasParse$( TempLine$ )
    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
    IF KeyWord$ = "'" THEN
      NewLine$ = NewLine$ + KeyWord$ + TempLine$
      EXIT DO
    ELSE
      NewLine$ = NewLine$ + KeyWord$
    END IF
  WEND
  FormatLine$ = RTRIM$(NewLine$)
END FUNCTION
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Parse the next word in a BASIC source code line
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
FUNCTION BasParse$( Source$ )
  Char = ASCII(Source$)
  SELECT CASE Char
    CASE = -1                         '?
      BasParse$ = ""
      Source$ = ""
      EXIT FUNCTION
    CASE 32,36,39,40,41,42,43,44,45,47,58,59,60,61,62,92,94,95
      BasParse$ = CHR$(Char)          'step over all delimiters except "
      IF LEN(Source$) > 1 THEN
        Source$ = MID$(Source$, 2)    '(remove 1 byte)
      ELSE
        Source$ = ""
      END IF
      EXIT FUNCTION
    CASE = 34                         '"
      FOR X = 2 TO LEN(Source$)       'look for 2nd "
        IF MID$(Source$, X, 1) = CHR$(34) THEN
          EXIT FOR
        END IF
      NEXT X
      IF X >= LEN(Source$) THEN       'if not found
        BasParse$ = RTRIM$(Source$)   '  overtake rest of the line
        Source$ = ""
        EXIT FUNCTION
      ELSE
        BasParse$ = RTRIM$(LEFT$(Source$, X))
        Source$ = MID$(Source$, X+1)  'overtake the string
        EXIT FUNCTION
      END IF
  END SELECT
  'take out next word up to the delimiter
  Tmp$ = EXTRACT$(Source$,_
         ANY CHR$(32,34,36,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$ = MID$(Source$, LEN(Tmp$) + 1)
  END IF
END FUNCTION
-=-=-=-=-=-=-=-=-=-=-=-=-=- cut -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Have fun
               Andras
--- CrossPoint v3.11 R
---------------
* Origin: Fido Point of Disillusion (2:2480/13.34)

SOURCE: echomail via exec-pc

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.