November 28, 2020, 11:47:22 AM

Author Topic: [bb] Image to ASCII by Andres [ 1+ years ago ]  (Read 692 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
[bb] Image to ASCII by Andres [ 1+ years ago ]
« on: June 29, 2017, 12:28:43 AM »
Title : Image to ASCII
Author : Andres
Posted : 1+ years ago

Description : This function will redraw an image in ASCII symbols.



Code :
Code: BlitzBasic
  1. Function ImageToChars(source%, target%, colors% = True)
  2.         Local chars$ = " .,:`;'^" + Chr(34) + "<>-/_!~=?)(|t+i7{j}lv]%[1cf32Jr$CuIyz9o6wTna5sk&VY40LO8mG*hexSgApqbZdUPQFDXKW#RNEHBM@"
  3.         Local w% = 0, char$ = "", argb%, red%, green%, blue%
  4.        
  5.         For i = 1 To Len(chars$)
  6.                 If StringWidth(Mid$(chars$, i, 1)) > w% Then w% = StringWidth(Mid$(chars$, i, 1))
  7.         Next
  8.        
  9.         LockBuffer ImageBuffer(source%)
  10.         Local buffer% = GraphicsBuffer()
  11.         SetBuffer ImageBuffer(target%)
  12.         For y = 0 To (ImageHeight(source%) / FontHeight()) - 1
  13.                 For x = 0 To (ImageWidth(source%) / w%) - 1
  14.                         argb% = ReadPixel(x * w%, y * FontHeight(), ImageBuffer(source%))
  15.                                 red% = (argb Shr 16) And $FF
  16.                                 green% = (argb Shr 8) And $FF
  17.                                 blue% = argb And $FF
  18.                         col# = (Float red + green + blue) / (3 * 255)
  19.                        
  20.                         If colors% Then Color red, green, blue
  21.                        
  22.                         char$ = Mid$(chars$, (Len(chars$) - 1) * col# + 1, 1)
  23.                         Text x% * w%, y% * FontHeight(), char$
  24.                 Next
  25.         Next
  26.         SetBuffer buffer%
  27.         UnlockBuffer ImageBuffer(source%)
  28. End Function


Comments :


Subirenihil(Posted 1+ years ago)

 Interesting... Very creative.  I don't know what I might use it for, but I like it.


markcw(Posted 1+ years ago)

 i can't get it to work.


markcw(Posted 1+ years ago)

 nice effect! but it didn't work until i took out the lockbuffers.
Code: [Select]
;Image to Ascii example

Graphics3D 640,480,0,2
SetBuffer BackBuffer()

image=LoadImage("yourname.bmp") ;source

ascii=CreateImage(ImageWidth(image),ImageHeight(image)) ;target

ImageToChars(image,ascii,1)

ClsColor 0,0,0 : Color 255,255,255 ;reset colors

While Not KeyHit(1)

 Cls
 DrawImage ascii,50,50

 Text 0,0,"image="+image+" ascii="+ascii

Flip
Wend

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%)
 For y = 0 To (ImageHeight(source%) / FontHeight()) - 1
  For x = 0 To (ImageWidth(source%) / w%) - 1
   argb% = ReadPixel(x * w%, y * 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



Sauer(Posted 1+ years ago)

 Definitely going to use this in my next game, thanks! [/i]

 

SimplePortal 2.3.6 © 2008-2014, SimplePortal