home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / basic / playfl / playfli.bas < prev    next >
Encoding:
BASIC Source File  |  1994-02-14  |  5.3 KB  |  228 lines
  1. '$INCLUDE: 'modex.bi'
  2. DECLARE SUB Waitvbi ()
  3. DECLARE SUB Playfli (Name$)
  4. COMMON SHARED a$
  5. 'Check out the REMs in the PLAYFLI sub
  6. 'This is a .FLI player written in Quick Basic, it's relatively fast
  7. 'I used an awesome routine I found on a BBS to do VGA paging.
  8. 'I think it was Matt Pritchard.... thanks man!
  9. 'If that dude finds this code, he can go ahead and steal this
  10. 'Player. Thanks....
  11. DEFINT A-Z
  12. CLS
  13. TYPE Fheader  'This is the format of the Header on a .FLI
  14.     Size AS LONG
  15.     Typ AS STRING * 2
  16.     Numf AS INTEGER
  17.     Wid AS INTEGER
  18.     Hei AS INTEGER
  19.     Bits AS INTEGER
  20.     Flag AS INTEGER
  21.     Speed AS INTEGER
  22.     Nex AS LONG
  23.     Fri AS LONG
  24.     Blank AS STRING * 102
  25. END TYPE
  26. TYPE Frameh 'This is the header attached to each frame on a .FLI
  27.     Size AS LONG
  28.     Typf AS INTEGER
  29.     Nchu AS INTEGER
  30.     Blank AS STRING * 8
  31. END TYPE
  32. TYPE Chunkh 'This is the header for each Chunk in a frame
  33.     Size AS LONG
  34.     Typec AS INTEGER
  35. END TYPE
  36. IF COMMAND$ = "" THEN 'Access input
  37.     PRINT "File not specified!"
  38.     END
  39. END IF
  40. Nme$ = COMMAND$
  41. IF INSTR(Nme$, ".") = 0 THEN Nme$ = Nme$ + ".FLI"
  42. PRINT "Dean's FLI player! (320x200x256)"
  43. PRINT "This was written in QUICK BASIC!!!"
  44. PRINT "Now playing: "; Nme$
  45. PRINT "Press any key to continue..."
  46. DO WHILE INKEY$ = "": LOOP
  47. SCREEN 13
  48. a = Set.Modex(Mode320x200) 'Go into the mode with paging
  49. OPEN Nme$ FOR BINARY AS #1
  50. DO UNTIL a$ <> ""
  51.     a$ = INKEY$
  52.     Playfli Nme$ 'Play the .FLI
  53. LOOP
  54. CLOSE #1
  55. SCREEN 0
  56. WIDTH 80
  57. END
  58.  
  59. SUB Playfli (Name$)
  60. DIM Byte AS STRING * 1 'Varibles for compatibility
  61. DIM Word AS INTEGER
  62. DIM Dword AS LONG
  63. DIM Qword AS DOUBLE
  64. DIM Fhead AS Fheader
  65. DIM Chunk AS Chunkh
  66.  
  67. DIM Lns AS LONG 'This is for QB enviroment (SLOW)
  68. 'Un rem the next line when compling! (FAST!)
  69. 'DIM Lns AS INTEGER
  70. SEEK #1, 1
  71. GET #1, , Fhead 'Get the header data
  72. DIM Frame AS Frameh 'Set the Frame varible
  73. Lr = LOC(1)
  74. GET #1, , Frame
  75. Seekn& = Frame.Size + Lr + 1
  76. Fm$ = SPACE$(Frame.Size)
  77. GET #1, , Fm$ 'Get the whole FIRST frame into memory
  78. DEF SEG = VARSEG(Fm$)
  79. Vl = SADD(Fm$)
  80.  
  81. Lns = 1
  82. Apage = 1
  83. Vpage = 0
  84.  
  85. FOR Frms = 1 TO Fhead.Numf
  86.     IF INKEY$ <> "" THEN
  87.         a$ = " "
  88.         EXIT SUB
  89.     END IF
  90.     SET.ACTIVE.PAGE Apage 'Do some page swapping
  91.     SET.DISPLAY.PAGE Vpage
  92.     IF Frms > 1 THEN
  93.         COPY.PAGE Vpage, Apage 'Make sure the page your using is up to date
  94.         SEEK #1, Seekn&
  95.         GET #1, , Frame 'Get the frame data
  96.         Seekn& = Seekn& + Frame.Size 'Store where next frame in file is
  97.         Fm$ = SPACE$(Frame.Size)
  98.         GET #1, , Fm$ 'Get the whole frame
  99.         DEF SEG = VARSEG(Fm$)
  100.         Vl = SADD(Fm$)
  101.         Lns = 1
  102.     END IF
  103.      
  104.     FOR t = 1 TO Frame.Nchu
  105.         Chunk.Size = CVL(MID$(Fm$, Lns, 4)) 'Get chunk data
  106.         Lns = Lns + 4
  107.         Chunk.Typec = CVI(MID$(Fm$, Lns, 2))
  108.         Lns = Lns + 2
  109.         C = Chunk.Typec
  110.         IF C = 11 THEN 'This is if its a PALETTE block
  111.             Word = CVI(MID$(Fm$, Lns, 2))
  112.             Lns = Lns + 2
  113.             Cl = 0
  114.             FOR i = 1 TO Word
  115.                 a = PEEK(Vl + Lns - 1)
  116.                 Lns = Lns + 1
  117.                 Cl = Cl + a
  118.                 f = PEEK(Vl + Lns - 1)
  119.                 Lns = Lns + 1
  120.                 IF f = 0 THEN f = 256
  121.                 FOR e = Cl TO f - 1
  122.                     OUT &H3C8, e 'I know Matt's routines
  123.                     'had a palette setting command,
  124.                     'but this is still faster
  125.                     g = PEEK(Vl + Lns - 1)
  126.                     Lns = Lns + 1
  127.                     OUT &H3C9, g
  128.                     g = PEEK(Vl + Lns - 1)
  129.                     Lns = Lns + 1
  130.                     OUT &H3C9, g
  131.                     g = PEEK(Vl + Lns - 1)
  132.                     Lns = Lns + 1
  133.                     OUT &H3C9, g
  134.                 NEXT e
  135.             NEXT i
  136.         END IF
  137.         IF C = 15 THEN 'This is if it's a FIRST frame RLE
  138.             x = 0
  139.             y = 0
  140.             DO
  141.                 Nump = PEEK(Vl + Lns - 1) 'Forget the stupid MID$ command
  142.                               'PEEK is faster!
  143.                 Lns = Lns + 1
  144.                 FOR r = 1 TO Nump
  145.                     u = PEEK(Vl + Lns - 1)
  146.                     Lns = Lns + 1
  147.                     IF u < 128 THEN
  148.                         Cr = PEEK(Vl + Lns - 1)
  149.                         Lns = Lns + 1
  150.                         DRAW.LINE x, y, x + u - 1, y, Cr
  151.                         x = x + u
  152.  
  153.                     END IF
  154.                     IF u > 127 THEN
  155.                         u = ABS(u - 255) + 1
  156.                         FOR w = 1 TO u
  157.                             f = PEEK(Vl + Lns - 1)
  158.                             Lns = Lns + 1
  159.                             SET.POINT x, y, f
  160.                             x = x + 1
  161.                         NEXT w
  162.                     END IF
  163.                 NEXT r
  164.                 x = 0
  165.                 y = y + 1
  166.             LOOP UNTIL y >= 199
  167.         END IF
  168.         IF C = 12 THEN 'This is if it's another frame, it skips lines but
  169.                     'it's also an RLE
  170.             y = CVI(MID$(Fm$, Lns, 2))
  171.             Lns = Lns + 2
  172.                        
  173.             x = 0
  174.             Clins = CVI(MID$(Fm$, Lns, 2))
  175.             Lns = Lns + 2
  176.             FOR Ncl = 1 TO Clins
  177.                 a = PEEK(Vl + Lns - 1) 'Get num of lines to skip
  178.                 Lns = Lns + 1
  179.                 IF a = 0 THEN GOTO Skip
  180.                 FOR Npa = 1 TO a
  181. Repeat:  
  182.                     Pskip = PEEK(Vl + Lns - 1) 'Get num of pixels to skip
  183.                     Lns = Lns + 1
  184.                     x = x + Pskip
  185.                     IF Pkskip = 255 THEN GOTO Repeat
  186.                     Snd = PEEK(Vl + Lns - 1)
  187.                     Lns = Lns + 1
  188.                     
  189.                     IF Snd < 128 THEN
  190.                         FOR Rd = 1 TO Snd
  191.                             Clr = PEEK(Vl + Lns - 1)
  192.                             Lns = Lns + 1
  193.                             SET.POINT x, y, Clr
  194.                             x = x + 1
  195.                         NEXT Rd
  196.                     ELSE
  197.                         Snd = ABS(Snd - 256)
  198.                         Clr = PEEK(Vl + Lns - 1)
  199.                         Lns = Lns + 1
  200.                         DRAW.LINE x, y, x + Snd - 1, y, Clr
  201.                         x = x + Snd
  202.                     END IF
  203.                 NEXT Npa
  204. Skip:
  205.             x = 0
  206.             y = y + 1
  207.             NEXT Ncl
  208.         END IF
  209.     NEXT t
  210.     SWAP Apage, Vpage 'exchange pages
  211. '     FOR Wt = 1 TO Fhead.Speed
  212. '          Waitvbi 'Do delay for num set of video cycles
  213. '     NEXT Wt 'If not needed, it goes faster on fast frame rate FLIs if REMED
  214. NEXT Frms
  215. END SUB
  216.  
  217. SUB Waitvbi
  218. Agin:
  219.     i = INP(&H3DA)
  220.     a = i AND &H8
  221.     IF a = 1 THEN GOTO Agin
  222. Agin2:
  223.     i = INP(&H3DA)
  224.     a = i AND &H8
  225.     IF a = 0 THEN GOTO Agin2
  226. END SUB
  227.  
  228.