QBasic Virtual world

My attenp at a virtual world

Page 1 of 1

3 Replies - 1578 Views - Last Post: 15 June 2008 - 03:58 PM Rate Topic: -----

#1 calvinthedestroyer  Icon User is offline

  • D.I.C Lover

Reputation: 172
  • View blog
  • Posts: 1,928
  • Joined: 13-October 07

QBasic Virtual world

Posted 05 June 2008 - 07:12 PM

I was digging through some of my old code and came across this program that I was trying to make.

My end goal was to have a Virtual camera that can be placed onto this world and the video out would be your screen so as to say, you would be able to move around the world and maybe even do things.

Of course this is as far as I got, never did get the camera routine from flow chart to code. Any way let me know what you think.

Enjoy
DIM SHARED Planet.x(1 TO 20) AS SINGLE
DIM SHARED Planet.y(1 TO 20) AS SINGLE
DIM SHARED Planet.z(1 TO 20) AS SINGLE

DIM SHARED VPlanet.x(1 TO 20) AS SINGLE
DIM SHARED VPlanet.y(1 TO 20) AS SINGLE
DIM SHARED VPlanet.z(1 TO 20) AS SINGLE

DIM SHARED newPl.x AS SINGLE
DIM SHARED newPl.y AS SINGLE
GEAR = 1
ScaleFactor = -.001
'						__
'				|	   /\
'				|		|
'	   ------------>	 |= 10 pixels
'				|		|
'				|	   \/
'						--
'	   |<------>| = 10 pixels
'
'dimentions for the small "mini" camera.
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
'
'	   ver 0001 was just to enter in the data and veiw it from a X/Y angle.
'	   Andrew S. Buczko		07-04-2002
'
'	   Ver 0002 rotates the veiw on the Z axsis. Also cleaned up some really
'	   big dents in the planet.
'
'	   Ver 0003 takes and rotates the Planet arrond all three axsis.  
'	   Andrew S. Buczko		07-04-2002
'
Planet.x(1) = 0
Planet.x(2) = -5740
Planet.x(3) = -1145
Planet.x(4) = 5155
Planet.x(5) = 6000
Planet.x(6) = -5750
Planet.x(7) = -4600
Planet.x(8) = 1715
Planet.x(9) = 6000
Planet.x(10) = 0
Planet.x(11) = 4530
Planet.x(12) = 3325
Planet.x(13) = -2460
Planet.x(14) = -4550
Planet.x(15) = 0
Planet.x(16) = 0
Planet.x(17) = 0
Planet.x(18) = 0
Planet.x(19) = 1500
Planet.x(20) = 1500

Planet.y(1) = 6990
Planet.y(2) = 3100
Planet.y(3) = 3135
Planet.y(4) = 3175
Planet.y(5) = 3285
Planet.y(6) = -2375
Planet.y(7) = -2380
Planet.y(8) = -2275
Planet.y(9) = -2470
Planet.y(10) = -6280
Planet.y(11) = -2650
Planet.y(12) = 1690
Planet.y(13) = -1535
Planet.y(14) = 3110
Planet.y(15) = 0
Planet.y(16) = 0
Planet.y(17) = 0
Planet.y(18) = 0
Planet.y(19) = 5900
Planet.y(20) = 6000

Planet.z(1) = 0
Planet.z(2) = 1650
Planet.z(3) = 5655
Planet.z(4) = 3965
Planet.z(5) = -1905
Planet.z(6) = -1675
Planet.z(7) = 4000
Planet.z(8) = 5660
Planet.z(9) = 1600
Planet.z(10) = 0
Planet.z(11) = -4505
Planet.z(12) = -6280
Planet.z(13) = -6325
Planet.z(14) = -4415
Planet.z(15) = 0
Planet.z(16) = 0
Planet.z(17) = 0
Planet.z(18) = 0
Planet.z(19) = 0
Planet.z(20) = 0
ctr = 0
ctr2 = 0
ctr3 = 0
ctr4 = 0
ctr5 = 0

200
SCREEN 12			   '640 x 480 = 320 x 240 center
LINE (50, 50)-(600, 450), 0, BF

'lets try to shrink this Planet...
'ctr5 = ctr5 + 1
' IF ctr5 > 10 THEN
	ScaleFactor = ScaleFactor + .0001
'   ctr5 = 0
'	ScaleFactor = -.01	  'lets go from -.001 to -.05
' END IF

FOR ctr = 1 TO 20
		VPlanet.x(ctr) = Planet.x(ctr) * ScaleFactor
		VPlanet.y(ctr) = Planet.y(ctr) * ScaleFactor
		VPlanet.z(ctr) = Planet.z(ctr) * ScaleFactor 'here z needs to be shrunk
NEXT ctr

FOR ctr = 1 TO 20
		VPlanet.x(ctr) = VPlanet.x(ctr) + 320
NEXT ctr

FOR ctr = 1 TO 20
		VPlanet.y(ctr) = VPlanet.y(ctr) + 240
NEXT ctr
'LINE (1, 1)-(VPlanet.x(19), VPlanet.y(19)), 1

LINE (VPlanet.x(1), VPlanet.y(1))-(VPlanet.x(2), VPlanet.y(2)), 1	'line 1
LINE (VPlanet.x(1), VPlanet.y(1))-(VPlanet.x(14), VPlanet.y(14)), 1  'line 2
LINE (VPlanet.x(1), VPlanet.y(1))-(VPlanet.x(3), VPlanet.y(3)), 1	'line 3
LINE (VPlanet.x(1), VPlanet.y(1))-(VPlanet.x(12), VPlanet.y(12)), 1  'line 4
LINE (VPlanet.x(1), VPlanet.y(1))-(VPlanet.x(4), VPlanet.y(4)), 1	'line 5
	  
LINE (VPlanet.x(1), VPlanet.y(1))-(VPlanet.x(5), VPlanet.y(5)), 1	'line 6
LINE (VPlanet.x(2), VPlanet.y(2))-(VPlanet.x(3), VPlanet.y(3)), 2	'line 7
LINE (VPlanet.x(3), VPlanet.y(3))-(VPlanet.x(4), VPlanet.y(4)), 2	'line 8
LINE (VPlanet.x(4), VPlanet.y(4))-(VPlanet.x(5), VPlanet.y(5)), 2	'line 9
LINE (VPlanet.x(5), VPlanet.y(5))-(VPlanet.x(12), VPlanet.y(12)), 2  'line 10
'
LINE (VPlanet.x(12), VPlanet.y(12))-(VPlanet.x(14), VPlanet.y(14)), 2'line 11
LINE (VPlanet.x(14), VPlanet.y(14))-(VPlanet.x(2), VPlanet.y(2)), 2  'line 12
LINE (VPlanet.x(10), VPlanet.y(10))-(VPlanet.x(9), VPlanet.y(9)), 3  'line 13
LINE (VPlanet.x(10), VPlanet.y(10))-(VPlanet.x(11), VPlanet.y(11)), 3'line 14
LINE (VPlanet.x(10), VPlanet.y(10))-(VPlanet.x(8), VPlanet.y(8)), 3  'line 15
'
LINE (VPlanet.x(10), VPlanet.y(10))-(VPlanet.x(13), VPlanet.y(13)), 3'line 16
LINE (VPlanet.x(10), VPlanet.y(10))-(VPlanet.x(7), VPlanet.y(7)), 3  'line 17
LINE (VPlanet.x(10), VPlanet.y(10))-(VPlanet.x(6), VPlanet.y(6)), 3  'line 18
LINE (VPlanet.x(6), VPlanet.y(6))-(VPlanet.x(7), VPlanet.y(7)), 2	'line 19
LINE (VPlanet.x(7), VPlanet.y(7))-(VPlanet.x(8), VPlanet.y(8)), 2	'line 20
'	 
LINE (VPlanet.x(8), VPlanet.y(8))-(VPlanet.x(9), VPlanet.y(9)), 2	'line 21
LINE (VPlanet.x(9), VPlanet.y(9))-(VPlanet.x(11), VPlanet.y(11)), 2  'line 22
LINE (VPlanet.x(11), VPlanet.y(11))-(VPlanet.x(13), VPlanet.y(13)), 2'line 23
LINE (VPlanet.x(13), VPlanet.y(13))-(VPlanet.x(6), VPlanet.y(6)), 2  'line 24
LINE (VPlanet.x(6), VPlanet.y(6))-(VPlanet.x(2), VPlanet.y(2)), 4	'line 25
'	
LINE (VPlanet.x(2), VPlanet.y(2))-(VPlanet.x(7), VPlanet.y(7)), 4	'line 26
LINE (VPlanet.x(7), VPlanet.y(7))-(VPlanet.x(3), VPlanet.y(3)), 4	'line 27
LINE (VPlanet.x(3), VPlanet.y(3))-(VPlanet.x(8), VPlanet.y(8)), 4	'line 28
LINE (VPlanet.x(8), VPlanet.y(8))-(VPlanet.x(4), VPlanet.y(4)), 4	'line 29
LINE (VPlanet.x(4), VPlanet.y(4))-(VPlanet.x(9), VPlanet.y(9)), 4	'line 30
'
LINE (VPlanet.x(9), VPlanet.y(9))-(VPlanet.x(5), VPlanet.y(5)), 4	'line 31
LINE (VPlanet.x(5), VPlanet.y(5))-(VPlanet.x(11), VPlanet.y(11)), 4  'line 32
LINE (VPlanet.x(11), VPlanet.y(11))-(VPlanet.x(12), VPlanet.y(12)), 4'line 33
LINE (VPlanet.x(12), VPlanet.y(12))-(VPlanet.x(13), VPlanet.y(13)), 4'line 34
LINE (VPlanet.x(13), VPlanet.y(13))-(VPlanet.x(14), VPlanet.y(14)), 4'line 35
LINE (VPlanet.x(14), VPlanet.y(14))-(VPlanet.x(6), VPlanet.y(6)), 4  'line 36

'LINE (VPlanet.x(19), VPlanet.y(19))-(VPlanet.x(20), VPlanet.y(20)), 2
'LINE (VPlanet.x(1), VPlanet.y(1))-(VPlanet.x(20), VPlanet.y(20)), 2
'LINE (VPlanet.x(1), VPlanet.y(1))-(VPlanet.x(19), VPlanet.y(19)), 2
'LINE (VPlanet.x(19), VPlanet.y(19))-(VPlanet.x(4), VPlanet.y(4)), 2
'LINE (VPlanet.x(20), VPlanet.y(20))-(VPlanet.x(5), VPlanet.y(5)), 2

SELECT CASE GEAR
CASE IS = 1
		CHANGE = .05
		FOR ctr2 = 1 TO 20
				newPl.x = Planet.x(ctr2) * COS(CHANGE) - Planet.y(ctr2) * SIN(CHANGE)
				newPl.y = Planet.y(ctr2) * COS(CHANGE) + Planet.x(ctr2) * SIN(CHANGE)
				Planet.x(ctr2) = newPl.x
				Planet.y(ctr2) = newPl.y
		NEXT ctr2
CASE IS = 2
		CHANGE = .05
		FOR ctr2 = 1 TO 20
				newPl.z = Planet.z(ctr2) * COS(CHANGE) - Planet.y(ctr2) * SIN(CHANGE)
				newPl.y = Planet.y(ctr2) * COS(CHANGE) + Planet.z(ctr2) * SIN(CHANGE)
				Planet.z(ctr2) = newPl.z
				Planet.y(ctr2) = newPl.y
		NEXT ctr2
CASE IS = 3
		CHANGE = .05
		FOR ctr2 = 1 TO 20
				newPl.x = Planet.x(ctr2) * COS(CHANGE) - Planet.z(ctr2) * SIN(CHANGE)
				newPl.z = Planet.z(ctr2) * COS(CHANGE) + Planet.x(ctr2) * SIN(CHANGE)
				Planet.x(ctr2) = newPl.x
				Planet.z(ctr2) = newPl.z
		NEXT ctr2
END SELECT

ctr3 = ctr3 + 1
IF ctr3 > 50 THEN
		IF GEAR = 3 THEN
				GEAR = 1
		ELSE
				IF GEAR = 2 THEN
						GEAR = 3
				ELSE
						IF GEAR = 1 THEN
								GEAR = 2
						END IF
				END IF
		END IF
ctr3 = 0
END IF

LOCATE 28, 1: PRINT "GEAR "; GEAR
ctr4 = ctr4 + 1
IF ctr4 > 500 THEN
		GOTO 32676
ELSE
		GOTO 200
END IF
'DFDFDFDFFDFDFDFDFDFFDFDFDFDFDFFDFDFDFFDFDFDFDFDFFDFDF
32676
END



Is This A Good Question/Topic? 0
  • +

Replies To: QBasic Virtual world

#2 NickDMax  Icon User is offline

  • Can grep dead trees!
  • member icon

Reputation: 2255
  • View blog
  • Posts: 9,245
  • Joined: 18-February 07

Re: QBasic Virtual world

Posted 07 June 2008 - 04:11 PM

Pretty neat. As long as we are shareing old QBasic programs here is one of my very first 3D programs written way back in about 1992 when I was in high school.

Its rather painful for me to spend too much time looking at the code. I have a much more sophisticated style now. But what can I say. I was a kid, and most of what a knew of programming came from copying programs from magazines. (I was completely self taught, I didn't even have forums to peruse for code).

'------------ BOUNCE3D.BAS -------------
' This program was written in about 1992
' and represents one of my initial
' attempts at 3D computer graphics.
,---------------------------------------
DECLARE SUB delay (n!)
DECLARE SUB paint3d (x!, y!, z!, c!, B!)
DECLARE SUB circle3d (x!, y!, z!, R!, c!)
DECLARE SUB BOX3D (x1!, y1!, x2!, y2!, z!, c!)
DECLARE SUB line3d (x1!, y1!, Z1!, x2!, y2!, Z2!, c!)
DECLARE SUB SETUP ()

DIM SHARED TRY AS SINGLE, AR AS INTEGER
DIM SHARED array(3500) AS INTEGER
DIM SHARED ball(3000) AS INTEGER

SCREEN 12
TRY = .03
w1 = 60
WINDOW (-w1, -w1)-(w1, w1): CLS
SETUP
RANDOMIZE TIMER
XD = RND: YD = RND: ZD = RND: x = 0: y = 0: z = 0
OX = x: OY = y: OZ = z
circle3d x, y, z, .4, 15
DO
	IF x > 20 OR x < -20 THEN XD = 0 - XD: SOUND 100, 1
	IF y > 20 OR y < -20 THEN YD = 0 - YD: SOUND 200, 1
	IF z > 20 THEN ZD = 0 - ZD: SOUND 300, 1
	IF z < -20 THEN ZD = 0 - ZD: SOUND 300, 1
	x = x + XD: y = y + YD: z = z + ZD
	circle3d OX, OY, OZ, .4, 0
	circle3d x, y, z, .4, 15
	OX = x: OY = y: OZ = z
	OXD = DX: OYD = YD: OZD = ZD
	a$ = INKEY$
	IF a$ = "1" THEN w1 = w1 + 2: GOSUB DOWIN
	IF a$ = "2" THEN w1 = w1 - 2: GOSUB DOWIN
	IF a$ = "3" THEN TRY = TRY + .001: GOSUB RETRY
	IF a$ = "4" THEN TRY = TRY - .001: GOSUB RETRY
	delay .01
LOOP UNTIL a$ = CHR$(27)
END

DOWIN:
	IF w1 = 0 THEN w1 = 1
	WINDOW (-w1, -w1)-(w1, w1): CLS
	LOCATE 1, 1: PRINT TRY, w1
	SETUP
	RETURN

RETRY:
	CLS
	LOCATE 1, 1: PRINT TRY, w1
	SETUP
	RETURN


SUB BOX3D (x1, y1, x2, y2, z, c)
	H = 1 / (z * TRY + 1)
	xp1 = H * x1: xp2 = H * x2
	yp1 = H * y1: yp2 = H * y2
	LINE (xp1, yp1)-(xp2, yp2), c, B
END SUB

SUB circle3d (x, y, z, R, c)
	H = 1 / (z * TRY + 1)
	xp = H * x
	yp = H * y
	rad = H * R
	IF AR = 0 THEN
		GET (xp + rad + 2, yp + rad + 2)-(xp - rad - 2, yp - rad - 2), array
		CIRCLE (xp, yp), rad, c
		PAINT (xp, yp), c, c
		AR = 1
	ELSE
		PUT (xp - rad - 2, yp - rad - 2), array, PSET
		AR = 0
	END IF
'SLEEP
END SUB

SUB delay (n!)
	now! = TIMER
	DO: LOOP UNTIL TIMER > now! + n!
END SUB

SUB LCLINE3D (x1, y1, Z1, x2, y2, Z2, ud, rd, c)
	h1 = Z1 * .5: h2 = Z2 * .5
	xp1 = (1 / h1) * x1 - (rd * Z1)
	xp2 = (1 / h2) * x2 - (rd * Z2)
	yp1 = (1 / h1) * y1 + (ud * Z1)
	yp2 = (1 / h2) * y2 + (ud * Z2)
	LINE (xp1, yp1)-(xp2, yp2), c
END SUB

SUB line3d (x1, y1, Z1, x2, y2, Z2, c)
	h1 = 1 / (Z1 * TRY + 1): h2 = 1 / (Z2 * TRY + 1)
	xp1 = h1 * x1: xp2 = h2 * x2
	yp1 = h1 * y1: yp2 = h2 * y2
	LINE (xp1, yp1)-(xp2, yp2), c
END SUB

SUB paint3d (x, y, z, c, B)
	H = 1 / (z * TRY + 1)
	xp = H * x
	yp = H * y
	PAINT (xp, yp), c, B
END SUB

SUB PLOT3D (x, y, z, c)
	H = 1 / (z + 1)
	xp = H * x
	yp = H * y
	PSET (xp, yp), c
END SUB

SUB SETUP
	FOR y = -20 TO 20 STEP 2
		line3d 20, y, -20, 20, y, 20, 1
		line3d -20, y, -20, -20, y, 20, 1
		line3d y, 20, -20, y, 20, 20, 1
		line3d y, -20, -20, y, -20, 20, 1
		line3d 20, 20, y, 20, -20, y, 1
		line3d 20, 20, y, 20, -20, y, 1
		line3d -20, 20, y, -20, -20, y, 1
		line3d -20, 20, y, -20, -20, y, 1
		line3d 20, 20, y, -20, 20, y, 1
		line3d 20, 20, y, -20, 20, y, 1
		line3d 20, -20, y, -20, -20, y, 1
		line3d 20, -20, y, -20, -20, y, 1
		line3d y, 20, 20, y, -20, 20, 1
		line3d -20, y, 20, 20, y, 20, 1
	NEXT y
	line3d -20, -20, -20, -20, -20, 20, 1
	line3d 20, 20, -20, 20, 20, 20, 1
	line3d -20, 20, -20, -20, 20, 20, 1
	line3d 20, -20, -20, 20, -20, 20, 1
	BOX3D -20, -20, 20, 20, 20, 1
	BOX3D -20, -20, 20, 20, -20, 1
END SUB


I had actually worked out the plot3d routine by myself without any outside help. I remember sitting in trig class when the idea struck me. -- never paid much attention in school, but stuff sort of seeped in.

This post has been edited by NickDMax: 07 June 2008 - 04:13 PM

Was This Post Helpful? 0
  • +
  • -

#3 calvinthedestroyer  Icon User is offline

  • D.I.C Lover

Reputation: 172
  • View blog
  • Posts: 1,928
  • Joined: 13-October 07

Re: QBasic Virtual world

Posted 10 June 2008 - 05:35 PM

Thanks for the comment :)
I really like yours.
Posted Image
I bet you could make that into a cool game of Pong.
Was This Post Helpful? 0
  • +
  • -

#4 NickDMax  Icon User is offline

  • Can grep dead trees!
  • member icon

Reputation: 2255
  • View blog
  • Posts: 9,245
  • Joined: 18-February 07

Re: QBasic Virtual world

Posted 15 June 2008 - 03:58 PM

That was the idea... that program was my "proof of concept" I actually have a version somewhere with a paddle. The paddle didn't work well because Qbasic's basic graphics routines do not do flicker free animation well (no sync with the vertical retrace). To really do things well in strait QB you needed to use page flipping. But by the time I learned the secrets of animation I had moved on to C/C++.

What is annoying is that I can't find any of my QB animation programs. I have a bitmap editor (called EditBlock) that I used to create sprites. We found a Nintendo magazine that showed you how to make various Nintendo characters, so I made screen savers with Zelda and Mario characters fighting. Can't find any of those (though I have found some of the graphic files with EditBlock).

all of that was done back in the days of Diskettes... guess some of my programs never made it onto a modern HD (as I have been pretty careful about maintaining copies since then).

The best program I ever did (in high school anyway) was a ball that bounced inside of a bouncing cube. It was just an extension of this program, but it was freakin' cool (well... at the time anyway). -- again, it is lost.
Was This Post Helpful? 0
  • +
  • -

Page 1 of 1