[bb] LoadWebImage by BlitzSupport [ 1+ years ago ]

Started by BlitzBot, June 29, 2017, 00:28:43

Previous topic - Next topic

BlitzBot

Title : LoadWebImage
Author : BlitzSupport
Posted : 1+ years ago

Description : This is pretty cool! You can load an image stored on your web server (or from any site really), and use it in your game :)

Very easily adapted for other kinds of files, of course!

Keeping up with latest BlitzGet function (progress readout while loading, etc)!

[EDITED, yikes, 10 year old post... to fix example URL!]


Code :
Code: blitzbasic
; -----------------------------------------------------------------------------
; LoadWebImage -- uses BlitzGet Deluxe, based on Mark Sibly's HTTPGet
; -----------------------------------------------------------------------------
; james@hi-toro.com
; -----------------------------------------------------------------------------

AppTitle "LoadWebImage"

Graphics 640, 480

SetBuffer BackBuffer ()

; -----------------------------------------------------------------------------
; Load an image from the web, straight into our game!
; -----------------------------------------------------------------------------
rocket = LoadWebImage ("http://www.hi-toro.com/boing.png")

; -----------------------------------------------------------------------------
; Check for failure
; -----------------------------------------------------------------------------
If rocket = 0

	RuntimeError "Failed to load web image!": End
	
	; Alternative (BETTER) failure method -- use a default local image supplied with your game...
	; rocket = LoadImage ("rocket.bmp")
	
EndIf

MaskImage rocket, 255, 0, 255

x = 50
y = 50

ClsColor 70, 110, 190

Repeat

	Cls
	
	DrawImage rocket, MouseX (), MouseY ()

	Flip

Until KeyDown (1) = 1

End

Function LoadWebImage (webFile$)
	If BlitzGet (webFile$, CurrentDir (), "temp_web_image.bmp")
		image = LoadImage ("temp_web_image.bmp")
		DeleteFile "temp_web_image.bmp"
	EndIf
	Return image
End Function

Function BlitzGet (webFile$, saveDir$, saveFile$)

	; -------------------------------------------------------------------------
	; Strip "http://" if provided
	; -------------------------------------------------------------------------
	If Left (webFile$, 7) = "http://" Then webFile$ = Right (webFile$, Len (webFile$) - 7)

	; -------------------------------------------------------------------------
	; Split into hostname and path/filename to download
	; -------------------------------------------------------------------------
	slash = Instr (webFile$, "/")
	If slash
		webHost$ = Left (webFile$, slash - 1)
		webFile$ = Right (webFile$, Len (webFile$) - slash + 1)
	Else
		webHost$ = webFile$
		webFile$ = "/"
	EndIf
		
	; -------------------------------------------------------------------------
	; Add trailing slash to download dir if not given
	; -------------------------------------------------------------------------
	If Right (saveDir$, 1) <> "" Then saveDir$ = saveDir$ + ""

	; -------------------------------------------------------------------------
	; Save filename -- get from webFile$ if not provided
	; -------------------------------------------------------------------------
	If saveFile$ = ""
		If webFile = "/"
			saveFile$ = "Unknown file.txt"
		Else
			For findSlash = Len (webFile$) To 1 Step - 1
				testForSlash$ = Mid (webFile$, findSlash, 1)
				If testForSlash$ = "/"
					saveFile$ = Right (webFile$, Len (webFile$) - findSlash)
					Exit
				EndIf
			Next
			If saveFile$ = "" Then saveFile$ = "Unknown file.txt"
		EndIf
	EndIf

	; DEBUG
	; RuntimeError "Web host: " + webHost$ + Chr (10) + "Web file: " + webFile$ + Chr (10) + "Save dir: " + saveDir$ + Chr (10) + "Save file: " + saveFile$

	www = OpenTCPStream (webHost$, 80)

	If www
	
		WriteLine www, "GET " + webFile$ + " HTTP/1.1" ; GET / gets default page...
		WriteLine www, "Host: " + webHost$
		WriteLine www, "User-Agent: BlitzGet Deluxe"
		WriteLine www, "Accept: */*"
		WriteLine www, ""
		
		; ---------------------------------------------------------------------
		; Find blank line after header data, where the action begins...
		; ---------------------------------------------------------------------
				
		Repeat
			header$ = ReadLine (www)
			If Left (header$, 16) = "Content-Length: "	; Number of bytes to read
				bytesToRead = Right (header$, Len (header$) - 16)
			EndIf
		Until header$ = "" Or (Eof (www))
		
		If bytesToRead = 0 Then Goto skipDownLoad
		
		; ---------------------------------------------------------------------
		; Create new file to write downloaded bytes into
		; ---------------------------------------------------------------------
		save = WriteFile (saveDir$ + saveFile$)
		If Not save Then Goto skipDownload

		; ---------------------------------------------------------------------
		; Incredibly complex download-to-file routine...
		; ---------------------------------------------------------------------

		For readWebFile = 1 To bytesToRead
		
			If Not Eof (www) Then WriteByte save, ReadByte (www)
			
			; Call BytesReceived with position and size every 100 bytes (slows down a LOT with smaller updates)
			
			tReadWebFile = readWebFile
			If tReadWebFile Mod 100 = 0 Then BytesReceived (readWebFile, bytesToRead)

		Next

		CloseFile save
		
		; Fully downloaded?
		If (readWebFile - 1) = bytesToRead
			success = 1
		EndIf
		
		; Final update (so it's not rounded to nearest 100 bytes!)
		BytesReceived (bytesToRead, bytesToRead)
		
		.skipDownload
		CloseTCPStream www
		
	Else
	
		RuntimeError "Failed to connect"
		
	EndIf
	
	Return success
	
End Function

; -----------------------------------------------------------------------------
; User-defined update function, called every 100 bytes of download -- alter to suit!
; -----------------------------------------------------------------------------
; TIP: Pass a user-defined type instead, with all data (this stuff plus URL, local filename, etc)
; -----------------------------------------------------------------------------
Function BytesReceived (posByte, totalBytes)
	; Example update code...
	Cls
	Text 20, 20, "Downloading file -- please wait..."
	Text 20, 40, "Received: " + posByte + "/" + totalBytes + " bytes (" + Percent (posByte, totalBytes) + "%)"
	Flip
End Function

; -----------------------------------------------------------------------------
; Handy percentage function
; -----------------------------------------------------------------------------
Function Percent (part#, total#)
	Return Int (100 * (part / total))
End Function


Comments :


jfk EO-11110(Posted 1+ years ago)

 Edit - oops, wrong button :o)


xlsior(Posted 1+ years ago)

 Alternative to load an image from a website:<div class="quote"> img:TImage = LoadImage(LoadBank("http::blitzbasic.com/img/brllogo-thin.png")) </div>


Pineapple(Posted 1+ years ago)

 First time I found this, I thought I'd post a LoadWebImage function I made a while back that I'm actually quite proud of. It's slow, messy, and mostly uncommented, but it gets the job done. I was able to learn a lot about the .bmp file format making this and how many worthless bytes is has at the beginning of the file. Oh, and I forgot to mention that it supports only the .bmp file format. You can track loading prograss in the debuglog if you like.
Code: BASIC
Graphics 800,600,0,2
SetBuffer BackBuffer()
wwwimg=LoadWebImage("http://www.d10.karoo.net/ruby/quiz/50/duck.bmp")
Repeat
Cls
DrawImage wwwimg,0,0
If KeyDown(1) Then End
Flip
Forever

Function LoadWebImage(url$)
	Local tcp,file=0,pos=7,server$=""
	Local bmp=1:png=2:jpg=3:gif=4

	DebugLog"Finding server..."
	Repeat
		pos=pos+1
		found=1
		If Mid(url$,pos,1)<>"/" Then found=0:server$=server$+Mid(url$,pos,1)
	Until found=1
	DebugLog"Server detected at: "+server
	

	;connect
	DebugLog"Connecting to server..."
	tcp=OpenTCPStream(server$,80)

	;ok?
	If tcp Then
		DebugLog"Connection to server successful."

		;request file
		DebugLog"Requesting file..."
		WriteLine tcp,"GET "+url$
		WriteLine tcp,Chr$(10)
		DebugLog"File retrieved."
		
		If ReadByte(tcp)=Asc("B") And ReadByte(tcp)=Asc("M") Then DebugLog"Image is a .bmp":file=bmp
		If file=0 Then 
			SeekFile tcp,0
			If ReadByte(tcp)=137 And ReadByte(tcp)=80 And ReadByte(tcp)=78 And ReadByte(tcp)=71 And ReadByte(tcp)=13 And ReadByte(tcp)=10 And ReadByte(tcp)=26 And ReadByte(tcp)=10 Then
				DebugLog"Image is a .png":file=1
			EndIf
		EndIf
			
			
		If file=0 Then RuntimeError"Online data is not a supported image file format."

		If file=bmp Then
			For worthlessjunk=1 To 16
			dumpdata=ReadByte(tcp)
			Next
			ms=MilliSecs()
			iw=ReadInt(tcp):DebugLog"Image width is: "+iw
			ih=ReadInt(tcp):DebugLog"Image height is: "+ih
			;make output image
			img=CreateImage(iw,ih)
			SetBuffer ImageBuffer(img)
			worthless=ReadShort(tcp)
			worthless=ReadShort(tcp)
			useful=ReadShort(tcp)
			If useful<>0 Then RuntimeError("Sorry, but this bmp format is not supported.")
			For dump=1 To 22
			garbage=ReadByte(tcp)
			Next
			
			Repeat
			If KeyHit(1) Then End
			
			For rgb=1 To 3
			Select rgb
			Case 1:b=ReadByte(tcp)
			Case 2:g=ReadByte(tcp)
			Case 3:r=ReadByte(tcp):Color r,g,b:Plot x,ih-y-1:x=x+1:If x=iw Then x=0:y=y+1
			End Select
			Next
			
			Until Eof(tcp)
		EndIf
		
		;ok
		SetBuffer BackBuffer():DebugLog"Download successful!":Return img
		
	Else
		DebugLog"Connection to server failed."	
	EndIf
End Function

WaitKey()
End