home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / clipper / ansisys / ansiclip.prg next >
Text File  |  1992-01-29  |  12KB  |  327 lines
  1. // ANSICLIP.PRG  Copyright 1992 Robert Greenlee  Released for unlimited use.
  2. //
  3. // SHOWANSI()
  4. // This function will display an ANSI encoded picture file.  ANSI.SYS
  5. // does not need to be loaded as the display is handled using Clipper
  6. // screen functions only.
  7. //
  8. // This is a rewrite of the SHOWANSI() function which was released into
  9. // the public domain by Ken LaCapria on 11/10/91 in the file SHOWANSI.PRG.
  10. // Ken's 11/10/91 version didn't work well enough to display any of the ANSI
  11. // pictures I wanted to look at so I continued its development until I
  12. // came up with this version which properly displays most of the ANSI pictures
  13. // I've found on BBS's.  I am using Clipper 5.01.  Note that I've commented
  14. // out a line below which uses the posalpha() function in the Nantucket
  15. // Tools Library and put a FOR/NEXT loop in its place.  If you have
  16. // the Nantucket Tools Library or a posalpha() equivalent you might want
  17. // to drop the FOR/NEXT.  Also the ANSI SetMode functions can be enabled
  18. // by uncommenting the line with the FT_SETMODE() function on it but you'll
  19. // need the Nanforum ToolKit NANFOR.LIB when you link (or you could use
  20. // SCRSETMODE() in Nantucket Tools).  This entire function could stand
  21. // alot more work but I'm tired of working on it for now.  
  22. // Hopefully someone else will get interested.  Currently if it detects any 
  23. // unsupported ANSI sequences such as keyboard or music commands it will 
  24. // display them on the screen along with an "Unsupported ANSI sequence" message.
  25. // I tried DO CASEing everything and taking out the LOOP's but it became slower.
  26. // I've added a timeron equate that can be set .t. to display how long it takes
  27. // to display each picture so you can see how your changes effect display speed.
  28. // I'm leaving my debug code in so that anyone interested can continue 
  29. // development and I'm including a demo, ansidemo.prg, which uses this function
  30. // to display .ANS files in the current directory.  I can be reached on the
  31. // Sabaline (619-692-1961) and Mushin (619-222-3097) BBS's in San Diego.  I
  32. // don't know where Ken LaCapria can be reached, apparently he didn't leave
  33. // any info on that in SHOWANSI.PRG/.ZIP.  
  34. //
  35. // HISTORY:
  36. // 1/28/92 - ANSICLIP.ZIP - First Release of SHOWANSI.PRG rewrite.
  37. // 1/29/92 - ANSICL52.ZIP - Second Release.  Recoded Change-Color handler
  38. //           to substantially increase display speed.
  39. //
  40. #include "inkey.ch"
  41. //
  42. // SHOWANSI returns a null string
  43. //   Syntax:   SHOWANSI(memvar)
  44. //
  45. FUNCTION showansi (ansitext)
  46. local textlen,onechar,charpos,tempstrng,sf,sb,ef,eb,uf,ub,temprow
  47. local tempcol,colnpos,tempchar,tempsubstr,X,savrow,savcol,oldcolor
  48. local valtempstr,nextcharpos,oldsf,mposalpha,showesc,debugansi,x1
  49. local mrow,mcol,gtimeons,gdateon,valtemp,timeron,templen
  50. local secson,minuteson,dayson,hourson,secsleft,arcolors
  51.  
  52. timeron = .f.  // If this is .t. then the time it takes to display the
  53.                //  picture will be displayed in the lower left corner.
  54. IF timeron
  55.   gtimeons = SECONDS()
  56.   gdateon = DATE()
  57. ENDI
  58. oldcolor = setcolor()
  59. showesc = .t.   // Display an Escape code not part of ANSI as a left arrow
  60. debugansi = .f. // Crude debug mode that stops at every Escape sequence and
  61.                 //  displays various info.  You hold the Enter key down
  62.                 //  until you get to the spot that's screwing up and then
  63.                 //  you try to see which Escape sequence is causing the problem
  64.                 //  and what's happening that's wrong and then you fix it.
  65. IF debugansi
  66.    SET CURSOR ON  // let's see where cursor is after each Escape sequence
  67. ENDI
  68.  
  69. STOR 'W' TO sf,ef,uf
  70. STOR 'N' TO sb,eb,ub
  71. arcolors = {'N','R','G','GR','B','RB','BG','W'}
  72. STOR 0 TO temprow,tempcol,colnpos,savrow,savcol,charpos
  73.  // Trim off any EOF markers like zeroes & Control-Z's
  74. DO WHIL SUBS(ansitext,LEN(ansitext),1) $ CHR(0)+CHR(26)
  75.    ansitext = SUBS(ansitext,1,LEN(ansitext)-1)
  76. ENDD
  77. textlen=LEN(ansitext)
  78. DO WHIL charpos+1<=textlen
  79.    IF debugansi
  80.       MROW = ROW()
  81.       MCOL = COL()
  82.       @ maxrow(),60 SAY 'savrow='+LTRIM(STR(savrow,3))+' savcol='+LTRIM(STR(savcol,3))
  83.       @ MROW,MCOL SAY ''
  84.    ENDI
  85.    charpos++
  86.    STOR '' TO tempstrng,tempsubstr
  87.    
  88.    nextcharpos = charpos+AT(CHR(K_ESC),SUBS(ansitext,charpos))-1
  89.     // If no more Esc's send rest of string and exit
  90.    IF nextcharpos < charpos
  91.       ?? SUBS(ansitext,charpos)
  92.       EXIT
  93.    ENDI
  94.     // If not an Esc send out up to next Esc
  95.    IF nextcharpos > charpos
  96.       ?? SUBS(ansitext,charpos,nextcharpos-charpos)   // send to next ESC
  97.    ENDI
  98.    charpos = nextcharpos + 1
  99.     // Process Esc command.  If valid next char is [
  100.    onechar=SUBS(ansitext,charpos,1)   // probably pointing to [
  101.    IF onechar<>'['
  102.       IF onechar = CHR(K_ESC) .AND. showesc
  103.          ?? CHR(K_ESC)
  104.       ENDI
  105.       charpos--   // point back to Escape, charpos gets bumped above
  106.       LOOP
  107.    ENDIF
  108.    charpos++   // skip past [
  109. //  mposalpha = posalpha(ansitext,.F.,charpos-1) + charpos-1
  110.    mposalpha = 0 
  111.    FOR x = charpos TO textlen
  112.      x1 = SUBS(ansitext,x,1)
  113.      IF !(x1==LOWER(x1) .AND. x1==UPPER(x1))
  114.        mposalpha = x
  115.        EXIT
  116.      ENDI
  117.    NEXT
  118.    IF mposalpha = 0
  119.       EXIT   // Picture ends with incomplete Esc sequence - stop now
  120.    ENDI
  121.    tempstrng = SUBS(ansitext,charpos,mposalpha-charpos)
  122.    charpos = mposalpha
  123.    onechar=SUBS(ansitext,charpos,1)
  124.    
  125.    IF debugansi
  126.       // here we display the ANSI command about to be processed and the
  127.       // row & col before, the command parameters (tempstrng), and a 40
  128.       // character chunk of the code string with the current command
  129.       // in the middle of it (Escape codes are changed to ! and carriage
  130.       // returns and line feeds are changed to ^.)
  131.       MROW = ROW()
  132.       MCOL = COL()
  133.       @ maxrow()-5,10 SAY ''
  134.       ?? 'row='+LTRIM(STR(MROW,3))+', '
  135.       ?? 'col='+LTRIM(STR(MCOL,3))+', '
  136.       ?? 'command='+onechar+'       '
  137.       @ maxrow()-4,10 SAY 'tempstrng= '+tempstrng+'             '
  138.       @ maxrow()-3,10 SAY 'ansitext-20= '+ STRTRAN(STRTRAN(STRTRAN(SUBS(ansitext,charpos-20,40),CHR(27),'!'),CHR(13),'^'),CHR(10),'^')
  139.       @ MROW,MCOL SAY ''
  140.       SET CONS OFF
  141.       wait
  142.       SET CONS ON
  143.    ENDI
  144.    
  145.    
  146.    IF ! onechar $ 'ABCDHJKfhlmsu'
  147.       MROW=ROW()
  148.       MCOL=COL()
  149.       @ maxrow(),0 SAY 'Unsupported ANSI sequence '
  150.       ?? STRTRAN(STRTRAN(STRTRAN(SUBS(ansitext,charpos,30),CHR(27),'!'),CHR(13),'^'),CHR(10),'^')
  151.       @ MROW,MCOL SAY ''
  152.       SET CONS OFF
  153.       wait
  154.       SET CONS ON
  155.       LOOP
  156.    ENDI
  157.  IF !onechar == 'm'  // This improves display time
  158.    valtemp = VAL(tempstrng)
  159.    IF onechar='K'  // Clear to End of Line
  160.       DO CASE
  161.       CASE valtemp=0
  162.          @ ROW(),COL()-1 CLEAR TO ROW(),maxcol()
  163.       CASE valtemp=1
  164.          @ ROW(),0 CLEAR TO ROW(),COL()-1
  165.       CASE valtemp=2
  166.          @ ROW(),0 CLEAR TO ROW(),maxcol()
  167.       ENDC
  168.       LOOP
  169.    ENDIF
  170.    IF onechar $ 'ABCD'  // Cursor Up/Down/Right/Left
  171.       DO CASE
  172.       CASE onechar='A'
  173.          temprow=ROW()-MAX(valtemp,1)
  174.          tempcol = COL()
  175.       CASE onechar='B'
  176.          temprow=ROW()+MAX(valtemp,1)
  177.          tempcol = COL()
  178.       CASE onechar='C'
  179.          tempcol=COL()+MAX(valtemp,1)
  180.          temprow = ROW()
  181.       CASE onechar='D'
  182.          tempcol=COL()-MAX(valtemp,1)
  183.          temprow = ROW()
  184.       ENDC
  185.       @ MIN(maxrow(),MAX(0,temprow)),MIN(maxcol(),MAX(0,tempcol)) SAY ''
  186.       LOOP
  187.    ENDIF
  188.    
  189.    IF onechar $ 'Hf' // Absolute Cursor Positioning (Both same)
  190.       colnpos=AT(';',tempstrng)
  191.       IF colnpos > 0
  192.          temprow=VAL(SUBS(tempstrng,1,colnpos-1))-1
  193.       ELSE
  194.          temprow = valtemp-1
  195.       ENDI
  196.       IF colnpos > 0 .AND. LEN(SUBS(tempstrng,colnpos+1)) > 0
  197.          tempcol=VAL(SUBS(tempstrng,colnpos+1))-1
  198.       ELSE
  199.          tempcol = 0
  200.       ENDI
  201.       @ MIN(maxrow(),MAX(0,temprow)),MIN(maxcol(),MAX(0,tempcol)) SAY ''
  202.       LOOP
  203.    ENDIF
  204.    
  205.    IF onechar='s'   // Save Current Cursor Location
  206.       savrow=ROW()
  207.       savcol=COL()
  208.       LOOP
  209.    ENDIF
  210.    
  211.    IF onechar='u'  // Return to last Saved Cursor Location
  212.       @ savrow,savcol SAY ''
  213.       LOOP
  214.    ENDIF
  215.    
  216.    IF onechar='J'  // Clear Screen - Cursor to upper left corner
  217.       DO CASE
  218.       CASE valtemp=0
  219.          @ ROW(),MAX(COL()-1,0) CLEAR TO ROW(),maxcol()
  220.          @ ROW()+1,0 CLEAR
  221.       CASE valtemp=1
  222.          @ ROW(),0 CLEAR
  223.       CASE valtemp=2
  224.          @ 0,0 CLEAR TO maxrow(),maxcol()
  225.       ENDC
  226.       LOOP
  227.    ENDIF
  228.    IF onechar$'lh' // Set screen width/height commands.
  229.        //  Esc[=#h sets screen mode
  230.        //  Esc[=#l resets screen mode
  231.        //    0 = 40x25 black & white
  232.        //    1 = 40x25 color
  233.        //    2 = 80x25 black & white
  234.        //    3 = 80x25 color
  235.        //    4 = 320x200 color graphics
  236.        //    5 = 320x200 black & white graphics
  237.        //    6 = 640x200 black & white graphics
  238.        //    7 = line-wrap on/off (Esc[=7h/Esc[=7l)
  239.        //   84 = 132x43  Paradise VGA
  240.        //   85 = 132x25  Paradise VGA
  241.        //
  242.        IF SUBS(tempstrng,1,1) == '='           // You need NanForum TookKit's
  243.          IF SUBS(tempstrng,2,1) $ '012345689'  // NANFOR.LIB for FT_SETMODE()
  244. //         FT_SETMODE(VAL(SUBS(tempstrng,2)))  // or you could use SETSCRMODE()
  245.          ENDI                                  // in Nantucket Tools.
  246.        ENDI                                    
  247.        //  Esc[?7l or Esc[=7l turns line-wrap off   Not Supported yet
  248.        //  Esc[?7h or Esc[=7h turns line-wrap on    Not Supported yet
  249.       LOOP
  250.    ENDIF
  251.   ENDIF // .NOT. onechar == 'm'
  252. // at this point onechar is ASSUMED to be 'm' since all the IF's above LOOP
  253.    X=0
  254.    templen = LEN(tempstrng)
  255.    DO WHILE .t.  // EXITS at bottom of DO/WHIL when !(x <= templen)
  256.       tempsubstr=''
  257.       x++
  258.       tempsubstr = SUBS(tempstrng,x,AT(';',SUBS(tempstrng,x)+';')-1)
  259.       x=x+LEN(tempsubstr)
  260.       
  261.       IF debugansi
  262.          // here we display each part of the screen color sequence before
  263.          // it is processed.
  264.          MROW = ROW()
  265.          MCOL = COL()
  266.          @ maxrow()-1,10 SAY 'tempsubstr= '+tempsubstr+'                       '
  267.          @ MROW,MCOL SAY ''
  268.          SET CONS OFF
  269.          wait
  270.          SET CONS ON
  271.       ENDI
  272.       
  273.       oldsf = sf
  274.       valtempstr = VAL(tempsubstr)
  275.       DO CASE
  276.       CASE valtempstr=0
  277.          STOR 'W' TO sf,ef,uf
  278.          STOR 'N' TO sb,eb,ub
  279.       CASE valtempstr=1
  280.          sf=STRTRAN(sf+'+','++','+')
  281.       CASE valtempstr=2
  282.          sf=STRTRAN(sf,'+')
  283.       CASE valtempstr=4
  284.          sf='U'
  285.       CASE valtempstr=5 .AND. .NOT. '*' $ sf
  286.          sf=sf+'*'
  287.       CASE valtempstr=7
  288.          sf='I'
  289.       CASE valtempstr=8
  290.          sf='X'
  291.       CASE valtempstr > 29 .AND. valtempstr < 38
  292.          sf = arcolors[valtempstr-29]
  293.          IF '+' $ oldsf
  294.             sf = sf+'+'
  295.          ENDI
  296.          IF '*' $ oldsf
  297.             sf = sf+'*'
  298.          ENDI
  299.       CASE valtempstr > 39 .AND. valtempstr < 48
  300.          sb = arcolors[valtempstr-39]
  301.       ENDC
  302.       IF ! x <= templen
  303.         setcolor(sf+'/'+sb+','+ef+'/'+eb+',,,'+uf+'/'+ub)
  304.         EXIT
  305.       ENDI
  306.    ENDD
  307. ENDD
  308. setcolor(oldcolor)
  309. IF timeron
  310. @ maxrow(),0 SAY 'Time: '
  311. secson = ((DATE()-gdateon)*86400)+(SECONDS()-gtimeons)
  312. dayson = INT(secson/86400)
  313. hourson = INT((secson-(dayson*86400))/3600)
  314. minuteson = INT((secson-(dayson*86400)-(hourson*3600))/60)
  315. secsleft = secson - (dayson*86400) - (hourson*3600) - (minuteson*60)
  316. ?? IIF(dayson>0,LTRIM(STR(dayson))+ ' days, ','')
  317. ?? IIF(hourson>0,LTRIM(STR(hourson))+ ' hours, ','')
  318. ?? IIF(minuteson>0,LTRIM(STR(minuteson))+ ' minute'+IIF(minuteson=1,'','s')+', ','')
  319. ?? LTRIM(STR(secsleft))
  320. ?? ' second'+IIF(secsleft=1,'','s')+'.'
  321. ENDI
  322. RETURN ''
  323.  
  324.  
  325.  
  326. //: EOF: ANSICLIP.PRG
  327.