home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / bbs / ansig100.zip / PCBTRANS.BAS < prev    next >
BASIC Source File  |  1993-11-05  |  7KB  |  186 lines
  1. DECLARE FUNCTION pbtxtfix$ (TextIn$)
  2. DECLARE FUNCTION Pcb2PbTxt$ (StringInput$)
  3. DEFINT A-Z
  4. DECLARE SUB PBPrint (b$)
  5. CONST true = -1, false = 0
  6. 'AnsiGraph Toolkit...
  7. '         ┌┬──┐ ┌┬──┐ ┌┐ ┐ ┐ ┌┬──┐ ┌┬──┐ ┌┬─┐  ┌┬──┐ ┌┬──┐ ┌┬──┐ ┬┬──┐
  8. '         ├┼──┘ ├┤  │ ├┤ │ │ ├┼─   ├┼─┬┘ ├┼─┴┐ ├┤  │ ├┼──┤ ├┼─┬┘ ├┤  │
  9. '         └┘    └┴──┘ └┴─┴─┘ └┴──┘ └┘ └  └┴──┘ └┴──┘ └┘  ┘ └┘ └  ┴┴──┘
  10. '                                                                 Version
  11. '                       █▀▀▄ █▀▀▄     █▀▀█ █▄  █ ▄▀▀▀ ▀█▀           1.5
  12. '                       █▀▀  █▀▀▄ ▀▀▀ █▀▀█ █ ▀▄█  ▀▀▄  █
  13. '                       ▀    ▀▀▀      ▀  ▀ ▀   ▀ ▀▀▀  ▀▀▀
  14. '
  15. '███████ ██████▄ ▄█████▄ ▄█████▄ ▄█████▄ ██      ▄█████▄ ███████ ▄█████▄ ██████▄
  16. '  ▐█▌   ██   ██ ██▄▄▄██ ██   ██ ██▄▄▄▄  ██      ██▄▄▄██   ▐█▌   ██   ██ ██   ██
  17. '  ▐█▌   ██████  ██▀▀▀██ ██   ██  ▀▀▀▀██ ██      ██▀▀▀██   ▐█▌   ██   ██ ██████
  18. '  ▐█▌   ██  ▀██ ██   ██ ██   ██ ▀█████▀ ███████ ██   ██   ▐█▌   ▀█████▀ ██  ▀██
  19. '
  20. '     █▀▄ ╓──┐ ╥─┐  ╥──┐ ╥──┐ ╓─╥─┐      ▄▀▀ ╥──┐ ─╥─ ╥──┐ ╥──┐
  21. '     █▀▄ ║  │ ╟─┴┐ ╟─   ╟─┬┘   ║         ▀▄ ╟──┘  ║  ╟─   ╟─┬┘
  22. '     ▀ ▀ ╙──┘ ╨──┘ ╨──┘ ╨ ┴    ╨        ▀▀  ╨    ─╨─ ╨──┘ ╨ ┴
  23. '
  24. '────────────────────────────────────────────────────────────────────────────────
  25. '         ───┐ ─╖                                        ▀
  26. '         ╓──┘  ║   █▀█ █▀▄ █▀█ █▀█ █▀▄ █▀█  █▀█▀█ █▀█▀█ █ █▀█ █▀█
  27. '         ╙─── ─╨─  █▀▀ ▀   ▀▀▀ ▀▀█ ▀   ▀▀ ▀ ▀ ▀ ▀ ▀ ▀ ▀ ▀ ▀ ▀ ▀▀█
  28. ' ──────────────────────────────▀▀─────────────────────────────▀▀────────────────
  29. '
  30. '        Robert L. Spier                Internet: robert.spier@hardgood.com
  31. '        One Lookout Circle             Rime: Robert Spier -> APPLEWIZ or -> ACC
  32. '        Larchmont, NY 10538            Intelec: Robert Spier in Netchat, Programming.
  33. '
  34. '  See AnsiG.txt for more info.  Registration $20.
  35. '
  36. '   Pcb2PbTxt - Translates a string from PCBANSI to PBANSI!
  37. '   PbTXTFix - Compresses the PBANSI String.
  38.  
  39. 'Demo:
  40. 'oPEN "C:\comm\ansi\bartman.pcb" FOR INPUT AS 1
  41. 'dO
  42. 'LINE INPUT #1, a$
  43. 'PBPrint pbtxtfix$((Pcb2PbTxt(a$)))  'This is not reccomended because of the
  44.                                      'overhead in passing strings.  It is faster
  45.                                      'to translate the file once, and then PBPrint
  46.                                      'it when you need it.
  47. 'LOOP UNTIL EOF(1)
  48. 'CLOSE
  49. 'END
  50.  
  51. PRINT "PCBAnsi to PBAnsi Translator ■ Copyright 1993 Robert Spier ■ Version 1.5"
  52. DO WHILE InputName$ = ""
  53. INPUT "Input File: ", InputName$
  54. LOOP
  55. DO WHILE OutPutNamE$ = ""
  56. INPUT "Output File: ", OutPutNamE$
  57. LOOP
  58. OPEN InputName$ FOR INPUT AS 1
  59. OPEN OutPutNamE$ FOR OUTPUT AS 2
  60. DO
  61. LINE INPUT #1, a$
  62. PRINT #2, pbtxtfix$((Pcb2PbTxt(a$)))
  63. LOOP WHILE NOT EOF(1)
  64. PRINT
  65.  
  66.  
  67.  
  68. FUNCTION pbtxtfix$ (TextIn$)
  69. b$ = TextIn$
  70. itr = false
  71. DO
  72.         'Figure out whether we are talking about Foreground or BackGround
  73.         NextInF = INSTR(b$, "&")
  74.         NextInB = INSTR(b$, "$")
  75.         IF NextInF < NextInB AND NextInF <> 0 OR NextInB = 0 THEN
  76.                 SearchChar$ = "&"
  77.                 Fg = true
  78.                 NextIn = NextInF
  79.         ELSE
  80.                 NextIn = NextInB
  81.                 SearchChar$ = "$"
  82.                 Fg = false
  83.         END IF
  84.  
  85.         IF NextIn THEN
  86.                 a$ = a$ + LEFT$(b$, NextIn - 1)
  87.                 b$ = RIGHT$(b$, LEN(b$) - NextIn)
  88.                 NextIn = INSTR(b$, SearchChar$)
  89.                 Form$ = MID$(b$, 1, NextIn - 1)
  90.                 t = VAL(Form$)
  91.                 IF itr THEN
  92.                         IF Fg = true THEN
  93.                                 IF CurFgColor = t THEN
  94.                                         GOTO skip:
  95.                                 END IF
  96.                         ELSE
  97.                                 IF CurBgColor = t THEN
  98.                                         GOTO skip:
  99.                                 END IF
  100.                         END IF
  101.                 END IF
  102.                 IF Fg = true THEN
  103.                         CurFgColor = t
  104.                         a$ = a$ + "&" + LTRIM$(STR$(t)) + "&"
  105.                 ELSE
  106.                         CurBgColor = t
  107.                         a$ = a$ + "$" + LTRIM$(STR$(t)) + "$"
  108.                 END IF
  109. skip:
  110.                 b$ = RIGHT$(b$, LEN(b$) - NextIn)
  111.                 NextInF = INSTR(b$, "&")
  112.                 NextInB = INSTR(b$, "$")
  113.                 IF NextInF < NextInB OR NextInB = 0 THEN
  114.                         another = NextInF
  115.                 ELSE
  116.                         another = NextInB
  117.                 END IF
  118.                 IF another THEN
  119.                         a$ = a$ + LEFT$(b$, another - 1)
  120.                         b$ = RIGHT$(b$, LEN(b$) - another + 1)
  121.                 END IF
  122.         ELSE
  123.                 EXIT DO
  124.         END IF
  125. itr = true
  126. LOOP
  127.   
  128.     a$ = a$ + b$
  129. pbtxtfix$ = a$
  130.  
  131. END FUNCTION
  132.  
  133. FUNCTION Pcb2PbTxt$ (StringInput$)
  134. b$ = StringInput$
  135. DO
  136. EmergencyExitFromDo:  
  137.         NextIn = INSTR(b$, "@")
  138.                   IF NextIn <> INSTR(b$, "@X") THEN
  139.                           NextNext = INSTR(2, b$, "@")
  140.                           b$ = RIGHT$(b$, LEN(b$) - NextNext)
  141.                           GOTO EmergencyExitFromDo:
  142.                   ELSE
  143.                         NextIn = INSTR(b$, "@X")
  144.                         IF NextIn > 1 OR NextIn <> 0 THEN
  145.                             a$ = a$ + LEFT$(b$, NextIn - 1)
  146.                             b$ = RIGHT$(b$, LEN(b$) - NextIn + 1)
  147.                         ELSEIF NextIn = 0 THEN
  148.                             a$ = a$ + b$ + (CHR$(13))
  149.                             Pcb2PbTxt$ = a$
  150.                             EXIT FUNCTION
  151.                         END IF
  152.                         Form$ = LEFT$(b$, 4)
  153.                         b$ = RIGHT$(b$, LEN(b$) - 4)
  154.                         GOSUB FormatCheck:
  155.                         another = INSTR(b$, "@X")
  156.                         IF another THEN
  157.                                 a$ = a$ + LEFT$(b$, another - 1)
  158.                                 b$ = RIGHT$(b$, LEN(b$) - another + 1)
  159.                         END IF
  160.                 'ELSE
  161.                 '        EXIT DO
  162.                 END IF
  163. LOOP
  164.     a$ = a$ + b$ + CHR$(13)
  165.     Pcb2PbTxt$ = a$
  166.     EXIT FUNCTION
  167. FormatCheck:
  168.         IF LEN(Form$) <> 4 THEN RETURN
  169.         Code$ = RIGHT$(Form$, 2)
  170.         Fg$ = MID$(Form$, 4, 1)      'Last one is FG     ----\
  171.         bg$ = MID$(Form$, 3, 1)      'First one is BG    ---\|
  172.         IF Fg$ = "," THEN                                  '||
  173.                 CBColor = VAL("&h" + bg$)                  '||
  174.         ELSEIF bg$ = "," THEN
  175.                 CfColor = VAL("&h" + Fg$)
  176.         ELSE
  177.                 CBColor = VAL("&h" + bg$)
  178.                 CfColor = VAL("&h" + Fg$)
  179.                 a$ = a$ + "&" + LTRIM$(STR$(CfColor)) + "&"
  180.                 a$ = a$ + "$" + LTRIM$(STR$(CBColor)) + "$"
  181.                 END IF
  182.         RETURN
  183.         
  184.     END FUNCTION
  185.  
  186.