TXT2ANSI 1/1

Area:    Quik_Bas
  Msg:    #364
 Date:    02-20-93 19:11 (Public) 
 From:    Jeff Freeman             
 To:      Quinn Tyler Jackson      
 Subject: TXT2ANSI 1/1             

DECLARE SUB sjfParse (Temp$(), Temp$, Tsep$, twc%)
DECLARE FUNCTION fjfTOANSI$ (Cmnd$)
DECLARE FUNCTION Txt2Ansi% (Txt$, Ansi$)
DECLARE FUNCTION sjfTOANSI$ (Cmnd$)
DEFINT A-Z

  'Load ANSI.SYS and execute this program to view @-commands
  ' translated to ANSI

  OPEN "cons:" FOR OUTPUT AS #1

  X = Txt2Ansi("@CLS;Down:9;fore:bold@This _
        @Fore:blink,bold,white;Back:blue@is_
         really@fore:green,bold;back:black@ _
        neat!@fore:white;back:black;locate:12,10@_
        using @@-commands", Ansi$)
  PRINT #1, Ansi$

  'valid commands are:

  'CLS                - Clears the screen
  'FORE:color,attrib  - Sets foreground color, BLINK and/or BOLD
  'BACK:color         - Sets background color
  'UP:xx              - moves the cursor xx spaces
  'DOWN:xx
  'RIGHT:xx
  'LEFT:xx
  'LOCATE:row,column  - move cursor to row,column
  'EOL                - erase to end of line
  'SAVE               - save cursor position.
  'RESTORE            - restore cursor position.

END

'
' Format of CmndLine$ is:
'     @command:parameter@
'
' multiple parameters:
'     @command:parm,parm@
'
' multiple commands:
'     @command:parm,parm;command;command:parm@
'
'     ***There are no spaces in CmndLine$***
'
FUNCTION fjfTOANSI$ (CmndLine$)

  'return @ if passed @@
  IF CmndLine$ = "@@" THEN fjfTOANSI$ = "@": EXIT FUNCTION
  IF CmndLine$ = "" THEN EXIT FUNCTION

  'strip the leading and trailing @'s
  CmndLine$ = MID$(CmndLine$, 2, LEN(CmndLine$) - 2)

  DIM Cmnds$(9), Params$(9):  Out$ = ""

  'put each command in a separate Cmnds$()
  sjfParse Cmnds$(), CmndLine$, ";", NumCmnds

  FOR CmndNum = 1 TO NumCmnds
    'separate the command from the Params$
    sjfParse Params$(), Cmnds$(CmndNum), ":", NumParams
    Cmnd$ = UCASE$(Params$(1)): ListParams$ = Params$(2)

    'put each Param in a separate Params$()
    sjfParse Params$(), ListParams$, ",", NumParm
    Out$ = Out$ + CHR$(27) + "["

    SELECT CASE Cmnd$
      CASE IS = "FORE"
        Out$ = Out$ + "0"
        FOR Parm = 1 TO NumParm
          SELECT CASE UCASE$(Params$(Parm))
            CASE "BOLD": Out$ = Out$ + ";1"
            CASE "BLINK": Out$ = Out$ + ";5"
            CASE "BLACK": Out$ = Out$ + ";30"
            CASE "RED": Out$ = Out$ + ";31"
            CASE "GREEN": Out$ = Out$ + ";32"
            CASE "YELLOW", "BROWN": Out$ = Out$ + ";33"
            CASE "BLUE": Out$ = Out$ + ";34"
            CASE "MAGENTA", "PURPLE": Out$ = Out$ + ";35"
            CASE "CYAN": Out$ = Out$ + ";36"
            CASE "WHITE": Out$ = Out$ + ";37"
          END SELECT
        NEXT Parm
        Out$ = Out$ + "m"
      CASE "BACK"
        SELECT CASE UCASE$(Params$(1))
            CASE "BLACK": Out$ = Out$ + "40"
            CASE "RED": Out$ = Out$ + "41"
            CASE "GREEN": Out$ = Out$ + "42"
            CASE "YELLOW", "BROWN": Out$ = Out$ + "43"
            CASE "BLUE": Out$ = Out$ + "44"
            CASE "MAGENTA", "PURPLE": Out$ = Out$ + "45"
            CASE "CYAN": Out$ = Out$ + "46"
            CASE "WHITE": Out$ = Out$ + "47"
        END SELECT
        Out$ = Out$ + "m"
      CASE "CLS": Out$ = Out$ + "2J"
      CASE "UP": Out$ = Out$ + Params$(1) + "A"
      CASE "DOWN": Out$ = Out$ + Params$(1) + "B"
      CASE "RIGHT": Out$ = Out$ + Params$(1) + "C"
      CASE "LEFT": Out$ = Out$ + Params$(1) + "D"
      CASE "LOCATE": Out$ = Out$ + Params$(1) + ";" + Params$(2) + "H"
      CASE "EOL":  Out$ = Out$ + "K"
      CASE "SAVE":  Out$ = Out$ + "s"
      CASE "RESTORE":  Out$ = Out$ + "u"
      CASE ELSE: Out$ = ""
    END SELECT

  NEXT CmndNum

  fjfTOANSI$ = Out$

END FUNCTION

SUB sjfParse (Temp$(), Temp$, Tsep$, twc)

  L = LEN(Temp$): wc = 0
  FOR z = 1 TO L
    ch$ = MID$(Temp$, z, 1)
    IF ch$ <> Tsep$ THEN
      word$ = ""
      wc = wc + 1
      FOR z1 = z TO L
        ch$ = MID$(Temp$, z1, 1)
        IF ch$ = Tsep$ THEN EXIT FOR
        word$ = word$ + ch$
      NEXT z1
      z = z1
      'IF wc <= twc THEN Temp$(wc) = word$
      Temp$(wc) = word$
    END IF
  NEXT z
  twc = wc

END SUB

FUNCTION Txt2Ansi (Txt$, Ansi$)

  Ansi$ = ""

  DO
    StrStart = INSTR(Txt$, "@")
    IF StrStart = 0 THEN StrStart = LEN(Txt$) + 1
    IF StrStart <> 1 THEN
      Ansi$ = Ansi$ + LEFT$(Txt$, StrStart - 1)
      Txt$ = MID$(Txt$, StrStart)
    END IF
    StrEnd = INSTR(2, Txt$, "@")
    IF StrEnd = 0 THEN StrEnd = LEN(Txt$)
    Cmnd$ = LEFT$(Txt$, StrEnd)
    Ansi$ = Ansi$ + fjfTOANSI$(Cmnd$)
    Txt$ = MID$(Txt$, StrEnd + 1)
  LOOP WHILE LEN(Txt$)

END FUNCTION

---
 * Origin: WarWorld's point away from home... (1:124/7006.1)