home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
bbs
/
ansig100.zip
/
PCBTRANS.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-11-05
|
7KB
|
186 lines
DECLARE FUNCTION pbtxtfix$ (TextIn$)
DECLARE FUNCTION Pcb2PbTxt$ (StringInput$)
DEFINT A-Z
DECLARE SUB PBPrint (b$)
CONST true = -1, false = 0
'AnsiGraph Toolkit...
' ┌┬──┐ ┌┬──┐ ┌┐ ┐ ┐ ┌┬──┐ ┌┬──┐ ┌┬─┐ ┌┬──┐ ┌┬──┐ ┌┬──┐ ┬┬──┐
' ├┼──┘ ├┤ │ ├┤ │ │ ├┼─ ├┼─┬┘ ├┼─┴┐ ├┤ │ ├┼──┤ ├┼─┬┘ ├┤ │
' └┘ └┴──┘ └┴─┴─┘ └┴──┘ └┘ └ └┴──┘ └┴──┘ └┘ ┘ └┘ └ ┴┴──┘
' Version
' █▀▀▄ █▀▀▄ █▀▀█ █▄ █ ▄▀▀▀ ▀█▀ 1.5
' █▀▀ █▀▀▄ ▀▀▀ █▀▀█ █ ▀▄█ ▀▀▄ █
' ▀ ▀▀▀ ▀ ▀ ▀ ▀ ▀▀▀ ▀▀▀
'
'███████ ██████▄ ▄█████▄ ▄█████▄ ▄█████▄ ██ ▄█████▄ ███████ ▄█████▄ ██████▄
' ▐█▌ ██ ██ ██▄▄▄██ ██ ██ ██▄▄▄▄ ██ ██▄▄▄██ ▐█▌ ██ ██ ██ ██
' ▐█▌ ██████ ██▀▀▀██ ██ ██ ▀▀▀▀██ ██ ██▀▀▀██ ▐█▌ ██ ██ ██████
' ▐█▌ ██ ▀██ ██ ██ ██ ██ ▀█████▀ ███████ ██ ██ ▐█▌ ▀█████▀ ██ ▀██
'
' █▀▄ ╓──┐ ╥─┐ ╥──┐ ╥──┐ ╓─╥─┐ ▄▀▀ ╥──┐ ─╥─ ╥──┐ ╥──┐
' █▀▄ ║ │ ╟─┴┐ ╟─ ╟─┬┘ ║ ▀▄ ╟──┘ ║ ╟─ ╟─┬┘
' ▀ ▀ ╙──┘ ╨──┘ ╨──┘ ╨ ┴ ╨ ▀▀ ╨ ─╨─ ╨──┘ ╨ ┴
'
'────────────────────────────────────────────────────────────────────────────────
' ───┐ ─╖ ▀
' ╓──┘ ║ █▀█ █▀▄ █▀█ █▀█ █▀▄ █▀█ █▀█▀█ █▀█▀█ █ █▀█ █▀█
' ╙─── ─╨─ █▀▀ ▀ ▀▀▀ ▀▀█ ▀ ▀▀ ▀ ▀ ▀ ▀ ▀ ▀ ▀ ▀ ▀ ▀ ▀▀█
' ──────────────────────────────▀▀─────────────────────────────▀▀────────────────
'
' Robert L. Spier Internet: robert.spier@hardgood.com
' One Lookout Circle Rime: Robert Spier -> APPLEWIZ or -> ACC
' Larchmont, NY 10538 Intelec: Robert Spier in Netchat, Programming.
'
' See AnsiG.txt for more info. Registration $20.
'
' Pcb2PbTxt - Translates a string from PCBANSI to PBANSI!
' PbTXTFix - Compresses the PBANSI String.
'Demo:
'oPEN "C:\comm\ansi\bartman.pcb" FOR INPUT AS 1
'dO
'LINE INPUT #1, a$
'PBPrint pbtxtfix$((Pcb2PbTxt(a$))) 'This is not reccomended because of the
'overhead in passing strings. It is faster
'to translate the file once, and then PBPrint
'it when you need it.
'LOOP UNTIL EOF(1)
'CLOSE
'END
PRINT "PCBAnsi to PBAnsi Translator ■ Copyright 1993 Robert Spier ■ Version 1.5"
DO WHILE InputName$ = ""
INPUT "Input File: ", InputName$
LOOP
DO WHILE OutPutNamE$ = ""
INPUT "Output File: ", OutPutNamE$
LOOP
OPEN InputName$ FOR INPUT AS 1
OPEN OutPutNamE$ FOR OUTPUT AS 2
DO
LINE INPUT #1, a$
PRINT #2, pbtxtfix$((Pcb2PbTxt(a$)))
LOOP WHILE NOT EOF(1)
PRINT
FUNCTION pbtxtfix$ (TextIn$)
b$ = TextIn$
itr = false
DO
'Figure out whether we are talking about Foreground or BackGround
NextInF = INSTR(b$, "&")
NextInB = INSTR(b$, "$")
IF NextInF < NextInB AND NextInF <> 0 OR NextInB = 0 THEN
SearchChar$ = "&"
Fg = true
NextIn = NextInF
ELSE
NextIn = NextInB
SearchChar$ = "$"
Fg = false
END IF
IF NextIn THEN
a$ = a$ + LEFT$(b$, NextIn - 1)
b$ = RIGHT$(b$, LEN(b$) - NextIn)
NextIn = INSTR(b$, SearchChar$)
Form$ = MID$(b$, 1, NextIn - 1)
t = VAL(Form$)
IF itr THEN
IF Fg = true THEN
IF CurFgColor = t THEN
GOTO skip:
END IF
ELSE
IF CurBgColor = t THEN
GOTO skip:
END IF
END IF
END IF
IF Fg = true THEN
CurFgColor = t
a$ = a$ + "&" + LTRIM$(STR$(t)) + "&"
ELSE
CurBgColor = t
a$ = a$ + "$" + LTRIM$(STR$(t)) + "$"
END IF
skip:
b$ = RIGHT$(b$, LEN(b$) - NextIn)
NextInF = INSTR(b$, "&")
NextInB = INSTR(b$, "$")
IF NextInF < NextInB OR NextInB = 0 THEN
another = NextInF
ELSE
another = NextInB
END IF
IF another THEN
a$ = a$ + LEFT$(b$, another - 1)
b$ = RIGHT$(b$, LEN(b$) - another + 1)
END IF
ELSE
EXIT DO
END IF
itr = true
LOOP
a$ = a$ + b$
pbtxtfix$ = a$
END FUNCTION
FUNCTION Pcb2PbTxt$ (StringInput$)
b$ = StringInput$
DO
EmergencyExitFromDo:
NextIn = INSTR(b$, "@")
IF NextIn <> INSTR(b$, "@X") THEN
NextNext = INSTR(2, b$, "@")
b$ = RIGHT$(b$, LEN(b$) - NextNext)
GOTO EmergencyExitFromDo:
ELSE
NextIn = INSTR(b$, "@X")
IF NextIn > 1 OR NextIn <> 0 THEN
a$ = a$ + LEFT$(b$, NextIn - 1)
b$ = RIGHT$(b$, LEN(b$) - NextIn + 1)
ELSEIF NextIn = 0 THEN
a$ = a$ + b$ + (CHR$(13))
Pcb2PbTxt$ = a$
EXIT FUNCTION
END IF
Form$ = LEFT$(b$, 4)
b$ = RIGHT$(b$, LEN(b$) - 4)
GOSUB FormatCheck:
another = INSTR(b$, "@X")
IF another THEN
a$ = a$ + LEFT$(b$, another - 1)
b$ = RIGHT$(b$, LEN(b$) - another + 1)
END IF
'ELSE
' EXIT DO
END IF
LOOP
a$ = a$ + b$ + CHR$(13)
Pcb2PbTxt$ = a$
EXIT FUNCTION
FormatCheck:
IF LEN(Form$) <> 4 THEN RETURN
Code$ = RIGHT$(Form$, 2)
Fg$ = MID$(Form$, 4, 1) 'Last one is FG ----\
bg$ = MID$(Form$, 3, 1) 'First one is BG ---\|
IF Fg$ = "," THEN '||
CBColor = VAL("&h" + bg$) '||
ELSEIF bg$ = "," THEN
CfColor = VAL("&h" + Fg$)
ELSE
CBColor = VAL("&h" + bg$)
CfColor = VAL("&h" + Fg$)
a$ = a$ + "&" + LTRIM$(STR$(CfColor)) + "&"
a$ = a$ + "$" + LTRIM$(STR$(CBColor)) + "$"
END IF
RETURN
END FUNCTION