ASCII MoviePlayer

This code will play Movies in ASCII (BlitzPlus compatible):

AppTitle "ASCII MoviePlayer - F1 for FPS"
Graphics 640, 480, 32, 2
SetBuffer BackBuffer()

Global FPS#, FPSTime

Global file$ = RequestFile("", "avi")
Global movie% = OpenMovie(file$)

buffer% = CreateImage(640, 480)
asciiimage% = CreateImage(640, 480)

While Not KeyHit(1)
	SetBuffer ImageBuffer(buffer%):Cls
	DrawMovie(movie%, 0, 0, ImageWidth(buffer%), ImageHeight(buffer%))
	ImageToChars(buffer%, asciiimage%)
	
	SetBuffer FrontBuffer()
	Cls
	DrawImage asciiimage%, 0, 0
	Color 255, 255, 255
	
	If KeyDown(59) Then Text 5, 5, "FPS: " + Int(FPS)
	
	Flip
	CountFPS()
Wend
End

Function ImageToChars(source%, target%, colors% = True)
	Local chars$ = " .,:`;'^" + Chr(34) + "<>\-/_!~=?)(|t+i7{j}lv]%[1cf32Jr$CuIyz9o6wTna5sk&VY40LO8mG*hexSgApqbZdUPQFDXKW#RNEHBM@"
	Local w% = 0, char$ = "", argb%, red%, green%, blue%
	
	For i = 1 To Len(chars$)
		If StringWidth(Mid$(chars$, i, 1)) > w% Then w% = StringWidth(Mid$(chars$, i, 1))
	Next
	
	LockBuffer ImageBuffer(source%)
	Local buffer% = GraphicsBuffer()
	SetBuffer ImageBuffer(target%)
	Cls
	For y = 0 To (ImageHeight(source%) / FontHeight()) - 1
		For x = 0 To (ImageWidth(source%) / w%) - 1
			argb% = ReadPixelFast((x + .5) * w%, (y + .5) * FontHeight(), ImageBuffer(source%))
				red% = (argb Shr 16) And $FF
				green% = (argb Shr 8) And $FF
				blue% = argb And $FF
			col# = (Float red + green + blue) / (3 * 255)
			
			If colors% Then Color red, green, blue
			
			char$ = Mid$(chars$, (Len(chars$) - 1) * col# + 1, 1)
			Text x% * w%, y% * FontHeight(), char$
		Next
	Next
	SetBuffer buffer%
	UnlockBuffer ImageBuffer(source%)
End Function

Function CountFPS()
	FPS# = 1000.0 / (MilliSecs() - fpstime)
	FPSTime = MilliSecs()
End Function

I love those Ascii movie players. Cannot test this one since I ain't got BlitzPlus. Is it supporting color? I take it this is the warner bros lion logo. (or was it mgm?)

neat stuff, although pretty useless for movie watching :D

Yeah, it supports colors and it should be logo of MGM.

OK downloading now -

EDIT :( my pc is a bit slow for this processing!)

IPete2.

this is pretyt nuts.

Hey, can you explain a little how this works? Looks good.

Nice. It's a shame the "Text" command is so slow. I get 7-8 fps with Text enabled, and 25-30 fps with it disabled (I substituted the text for rect).

it would be possible to use bitmaps instead that might be faster. Just create 256 bitmaps, for each character one, then print the chast to them and mask them negatively. Sou you only need to draw a filled Rect of the right color, then draw the bitmap to it. The character (that's transparent on the bitmap) will be left.

This one is using bitmaps. The images "buffer" and "asciiimage" are not used anymore. Instead the movie is drawn to the backbuffer, readpixel will then be stored in an array "rgb()", to allow readpixelfast with a locked backbuffer and Drawimage with an unlocked backbuffer.

On my old terminal it runs at ~double speed.

AppTitle "ASCII MoviePlayer - F1 for FPS"
Graphics 640, 480, 32, 2
SetBuffer BackBuffer()

Global FPS#, FPSTime
Global chars$ = " .,:`;'^" + Chr(34) + "<>\-/_!~=?)(|t+i7{j}lv]%[1cf32Jr$CuIyz9o6wTna5sk&VY40LO8mG*hexSgApqbZdUPQFDXKW#RNEHBM@"

Global file$ = "C:\WINDOWS\Desktop\ttttt\genom\content\genom_trailer.rm";RequestFile("", "avi")
Global movie% = OpenMovie(file$)

Global fowi=StringWidth("W")
Global fohe=StringHeight("§")
Color 255,0,0
Dim ascii_bmp(255)
Dim rgb(GraphicsWidth(),GraphicsHeight())
For i = 0 To 255
 ascii_bmp(i)=CreateImage(fowi,fohe)
 SetBuffer ImageBuffer(ascii_bmp(i))
 Text 0,0,Chr$(i)
 MaskImage ascii_bmp(i),255,0,0
Next

; -------------------------------
While Not KeyHit(1)

 DrawMovie(movie%, 0, 0, GraphicsWidth(),GraphicsHeight())
 ImageToChars()

 If KeyDown(59) Then 
  Color 255, 255, 255
  Text 5, 5, "FPS: " + Int(FPS)
 EndIf

 Flip
 CountFPS()
Wend
End




Function ImageToChars()
 Local w% = 0, char$ = "", argb%, red%, green%, blue%
 w=fowi

 SetBuffer BackBuffer()
 LockBuffer BackBuffer()
 For y = 0 To ((GraphicsHeight()-1) / fohe)
  For x = 0 To (GraphicsWidth() / w%) - 1
   rgb(x,y) = ReadPixel((x + .5) * w%, (y + .5) * fohe)
  Next
 Next
 UnlockBuffer BackBuffer()

 For y = 0 To ((GraphicsHeight()-1) / fohe)
  For x = 0 To (GraphicsWidth() / w%) - 1
   argb%=rgb(x,y)
   red% = (argb Shr 16) And $FF
   green% = (argb Shr 8) And $FF
   blue% = argb And $FF
   col# = (Float red + green + blue) / (765)

   Color red, green, blue
   Rect x*w,y*fohe,fowi,fohe,1

   char$ = Mid$(chars$, (Len(chars$) - 1) * col# + 1, 1)
   DrawImage ascii_bmp(Asc(char$)), x% * w%, y% * fohe
  Next
 Next
End Function


Function CountFPS()
 FPS# = 1000.0 / (MilliSecs() - fpstime)
 FPSTime = MilliSecs()
End Function

On my computer, this second version gives me 8-9 FPS instead of 12.

really :) well certain things do happen.

Anyone care to explain how this works? I gather your reading pixels from the screen, but how do you determine which character gets used?

@RossC: I haven't checked the code, but I would guess that each pixel is shifted to a greyscale value and the relative greyness used as an index into an array of characters that are sorted according to their 'screen density'. That would be my first stab at getting this kind of thing working...

Exactly, BlackJumper

Sausage me sideways - this looks interesting.

I don't have BPlus - sniffage.

Thanks guys, seems pretty straight forward :D

cool

puki you don't need it, simply remove the line that requests the filerequest box and relace it by a direct file path assignement like

global file$="mymovie.avi"

That said, the shades of grey thing wouldn't be required since you could use any character (everytime) and simply color it with the corresponding rgb value (where I want to mention that picking only one pixel is not very accurate, you should pick the entire block, then calculate the average RGB, but that would be even slower). At the other hand, you can use the greyscale character selection with only one color to get a BW conversion.

I already have a parameter for non-color version of it. I'm reading only one pixel,b ut it's still pretty slow :P