10 SCREEN 1
20 DEFINT a-z
20 n=30
30 DIM x(n), y(n), z(n), rx(n), ry(n)
100 LINE(0,0)-(319,199),0,BF
110 WHILE INKEY$ = ""
120 FOR a=1 TO n
130 PSET (rx(a),ry(a)),0
140 z(a) = z(a) - 50
150 IF z(a) >= 6 THEN 160
155 z(a) = 5000
156 x(a) = (RND-0.5)*9000
157 y(a) = (RND-0.5)*9000
160 rx(a) = INT(160+160!*x(a)/z(a))
170 ry(a) = INT(100+100!*y(a)/z(a))
175 IF rx(a) < 0 OR ry(a) < 0 OR rx(a) > 319 OR ry(a) > 199 THEN 155
180 PSET (rx(a),ry(a)), 4-z(a)/(5000!/3)
190 NEXT
200 WEND
210 SCREEN 0
220 WIDTH 80,25
Download DOSBox, download GW-BASIC [here], and run.
(To run:
linux command: dosbox
dos command: mount c .
dos command: c:
dos command: gwbasic tmp.bas
in program: <any key to interrupt>
in gwbasic: system, to quit gwbasic
in gwbasic: load "tmp.bas", to reload the program
Joined: 2/28/2006
Posts: 2275
Location: Milky Way -> Earth -> Brazil
Are you some kind of programming languages bot? Or is this a programmers forum now?
"Genuine self-esteem, however, consists not of causeless feelings, but of certain knowledge about yourself.
It rests on the conviction that you — by your choices, effort and actions — have made yourself into the
kind of person able to deal with reality. It is the conviction — based on the evidence of your own volitional
functioning — that you are fundamentally able to succeed in life and, therefore, are deserving of that success."
- Onkar Ghate
Bisqwit wrote:
Hahaha! We had Q-Basic at school, and I programmed a very similar starfield effect whilst there. I also did a snowfall (which lands on words saying 'Merry Christmas') program.
Here's a 3D renderer a-la Wolfenstein (without textures):
1 DEFINT a-z : REM Define the default type for all variables to be INT.
2 xm=8 : ym = 6 : REM maximum extents of the map we're prepared for.
3 DIM maze(xm,ym) : REM REM stands for "remark", i.e. a comment.
4 pi! = 3.141592653 : REM The "!" stands for explicitly FLOAT type variable.
10 REM Read the maze data.
11 y = 1
12 READ s$
20 IF s$ = "end" THEN 100
30 l=LEN(s$)
40 FOR x=1 TO l
50 IF MID$(s$, x, 1) = "1" THEN px!=x:py!=y:GOTO 70
60 IF MID$(s$, x, 1) = "X" THEN maze(x,y)=1
70 NEXT
80 y = y+1
90 GOTO 12
92 REM Maze data
93 DATA XXXXXXXX
94 DATA X X X
95 DATA X X XX X
96 DATA X X
97 DATA X X1 XXX
98 DATA XXXXXXXX,end
100 SCREEN 1 : REM Set 320x200 quadcolor mode
102 DIM visible(xm,ym)
103 DIM renderlistx(xm*ym), renderlisty(xm*ym)
103 DIM floorlistx(xm*ym), floorlisty(xm*ym)
104 REM Center the observer in the tile he's standing on
105 px! = px!+0.5 : py! = py!+0.5
107 look! = 0.1 : REM Camera angle
108 sinlook! = SIN(look!)
109 coslook! = COS(look!)
110 REM With raycasting, figure out which walls stand in our view
111 FOR x=1 TO xm: FOR y=1 TO ym: visible(x,y)=0 : NEXT y,x
112 rendercount = 0 : floorcount = 0
113 CLS:KEY OFF:PRINT "Tracing..."
120 FOR angle! = pi!*-.5 TO pi!*.5 STEP pi!*(2/180)
130 REM Calculate the unit vector pointing to this direction.
131 REM Scale by 0.3 to ensure we're seeing everything we should.
140 xo!= SIN(angle! + look!) * 0.1
141 yo!=-COS(angle! + look!) * 0.1
150 distance = 0
160 REM Find an obstacle. Since we're in a closed maze, this loop is finite.
170 distance = distance + 1
171 xposint = INT(px! + distance * xo!) : REM INT truncates.
172 yposint = INT(py! + distance * yo!)
173 IF maze(xposint,yposint) > 0 THEN 180
174 IF visible(xposint,yposint) > 0 THEN 160 : REM Only add to floor-list once
175 visible(xposint,yposint) = distance
176 floorcount = floorcount + 1
177 floorlistx(floorcount) = xposint
178 floorlisty(floorcount) = yposint
179 GOTO 160
180 IF visible(xposint,yposint) > 0 THEN 190 : REM Only add to wall-list once
185 visible(xposint,yposint) = distance
186 rendercount = rendercount + 1
187 renderlistx(rendercount) = xposint
188 renderlisty(rendercount) = yposint
190 NEXT
195 CLS
220 REM Render each seen floor tile.
230 FOR wallno = 1 TO floorcount : GOSUB 900 : NEXT
240 REM Render each seen wall.
250 FOR wallno = 1 TO rendercount : GOSUB 300 : NEXT
260 REM IF INKEY$ = "" THEN GOTO 110 : REM loop
270 a$=INPUT$(1)
280 GOTO 9999 : REM end
300 REM Render the wall.
303 blockx=renderlistx(wallno)
304 blocky=renderlisty(wallno)
310 facecx!(0)=blockx :facecy!(0)=blocky+.5 : REM west wall
311 facecx!(1)=blockx+ 1:facecy!(1)=blocky+.5 : REM east wall
312 facecx!(2)=blockx+.5:facecy!(2)=blocky : REM north wall
313 facecx!(3)=blockx+.5:facecy!(3)=blocky+1 : REM south wall
314 FOR n=0 TO 3: GOSUB 700: NEXT : REM Draw walls.
399 RETURN
700 REM Draw a wall. Determine the two XY coordinates
701 REM that define the wall edges on the 2D map.
702 REM Note: We use the difference between INT and CINT on 0.5
703 REM value for benefit. 0.5 was previously used to indicate
704 REM a midpoint in a wall (lines 310-313). Neat trick.
710 cx! = facecx!(n) : x1! = INT(cx!) : x2! = CINT(cx!)
711 cy! = facecy!(n) : y1! = INT(cy!) : y2! = CINT(cy!)
720 REM Translate and rotate the coordinates around the player.
721 x! = x1!-px! : y! = y1!-py! : GOSUB 820 : x1! = x! : y1! = y!
722 x! = x2!-px! : y! = y2!-py! : GOSUB 820 : x2! = x! : y2! = y!
730 REM Put object somewhat front of the camera and apply a zoom to
731 REM avoid ugly distortions with lines that cross the camera plane
732 y1! = (-y1! + 2) * 0.5
733 y2! = (-y2! + 2) * 0.5
740 REM Calculate the screen coordinates. Start with X.
741 REM Y is determined by ceiling and floor....
742 x1 = 160 * (1 + x1! / y1!)
743 x2 = 160 * (1 + x2! / y2!)
744 y1c = 100 * (1 - 0.9 / y1!)
745 y2c = 100 * (1 - 0.9 / y2!)
746 y1f = 100 * (1 + 0.8 / y1!)
747 y2f = 100 * (1 + 0.8 / y2!)
750 REM Orient the wall.
751 IF x1 > x2 THEN SWAP x1,x2 : SWAP y1c,y2c: SWAP y1f,y2f
760 REM Render the wall.
766 REM Bound the loop
767 x = x1 : GOSUB 830 : x1b = x
768 x = x2 : GOSUB 830 : x2b = x
769 IF x1=x2 THEN 799 : REM Avoid division by zero in the loop
770 FOR x = x1b TO x2b
775 p! = (x-x1) / (x2-x1)
780 y2 = y1f + p! * (y2f-y1f)
781 y1 = y1c + p! * (y2c-y1c)
782 y1clip = y1: IF y1clip < 0 THEN y1clip = 0
785 IF POINT(x,y1clip) >= 2 THEN 795 : REM Poor man's zbuffer
788 IF x = x1 OR x = x2 THEN LINE(x,y1)-(x,y2),3:GOTO 795
789 PSET (x,y1),3 : PSET (x,y2),3
790 LINE (x,y1+1)-(x,y2-1),2
795 NEXT
799 RETURN : REM Done rendering that wall
800 REM This helper function calculates the distance of the wall.
801 a = facecx!(n) - px!
802 b = facecy!(n) - py!
803 facedist!(n) = a*a + b*b
804 RETURN
810 REM This helper function swaps the two wall specifications.
811 SWAP facedist!(a), facedist!(b)
812 SWAP facecx!(a), facecx!(b)
813 SWAP facecy!(a), facecy!(b)
814 RETURN
820 REM Rotate the coordinates to accommodate the camera's angle.
821 n! = x!
822 x! = n! * coslook! - y! * sinlook!
823 y! = n! * sinlook! + y! * coslook!
824 RETURN
830 REM Clipping horizontal coordinate to the screen range.
831 IF x < 0 THEN x=0
832 IF x > 319 THEN x=319
833 RETURN
900 REM Render the floor tile.
905 REM Get the tile coordinate, translate and rotate it around the player.
906 x! = floorlistx(wallno) + 0.5 - px!
907 y! = floorlisty(wallno) + 0.5 - py!
908 GOSUB 820
910 y! = (-y! + 2) * 0.5 : REM Fixup the z coordinate
915 REM Generate screen coordinates for the ceiling and the floor
920 x = 160 * (1 + x! / y!)
921 yc = 100 * (1 - 0.9 / y!)
922 yf = 100 * (1 + 0.8 / y!)
925 zs! = 2.5/y!
930 REM In the ceiling, draw a lighting device.
932 CIRCLE(x,yc),7*zs!, 1, ,, 0.1
935 CIRCLE(x,yc),2*zs!, 3
940 REM In the floor, draw a spot.
945 CIRCLE(x,yf),7*zs!, 1, ,, 0.1
999 RETURN
9999 SCREEN 0 : WIDTH 80,25 : REM Restore text mode
10000 END
10001 System error! Crash! Bing, bang!
10002 Funny fact: GW-BASIC is interpreted as it goes. That means you
10003 can include quite blatant syntax errors on any lines that are
10004 not executed, and it will do no harm whatsoever. Same goes for
10005 BAT files in DOS. However, you must still put a line number on
10006 each line, because otherwise the interpreter will complain about
10007 direct statements in the file.
9 PRINT "Reading map data..."
10008 Funny fact 2: Line numbers decide the order of program
10009 lines, not their location in the source code file.
100 PRINT "Done." : SCREEN 1 : CLS
10010 You can ever replace the previous content of the line
10011 by specifying the same line number twice.
Screenshot:
Now, who can find the most annoying bug in it?
(And who can build a game around it? :P )
Edit: Oh, and yes, I just wrote it, to refresh my GW-BASIC skills; I didn't pick it from archives ― back then, I couldn't even have programmed something like this.
1 DEFINT a-z
10 SCREEN 1:RESTORE 80
20 READ s$
30 IF s$="z" THEN 80
40 FOR a=1 TO 55 STEP 6
45 basex=0:basey=0
50 k$=MID$(s$,a+2,1):GOSUB 98:x1=v+basex
51 k$=MID$(s$,a+3,1):GOSUB 98:y1=v+basey
52 k$=MID$(s$,a+4,1):GOSUB 98:x2=v+basex
53 k$=MID$(s$,a+5,1):GOSUB 98:y2=v+basey
54 c=VAL(MID$(s$,a+1,1))
55 IF MID$(s$,a,1)="B" THEN LINE(x1,y1)-(x2,y2),c,BF:GOTO 60
56 IF MID$(s$,a,1)="L" THEN LINE(x1,y1)-(x2,y2),c :GOTO 60
59 PRINT "DATA ERROR(";MID$(s$,a,6);")":GOTO 98
60 basex=basex+46:IF basex+40 < 320 THEN 50
61 basey=basey+60:basex=0:IF basey+60 < 200 THEN 50
62 NEXT
70 GOTO 20
80 DATA B2!!N\B3!!'NB3H!N\B3!!1+B0C.L3B09<?QB0'C+QB3-F9LB3DOG\B0#PCR
81 DATA B3!!G"B0)AKBB31S3\B0KCLLB1![C[B0`M/ZB0H8I=B3ADKJB01048B05UCW
82 DATA B0+=0?B1/NJNB09#B$B20)G/B0+-I-B07MJMB2$QBQB05YBYB0(/)9B3!!6%
83 DATA B3!<*@B079^<B0E%E6L0)09#L3)7BGL088GKL0&FG?L04/H7L3!9DPL343E>
84 DATA L0"S%\L01><OL0C$H0L3>2JAL3!R-4B26VAVL079DTL0*\+^L2+A-YB0GDGG
85 DATA L3"29"L20.>ML0<7=/L0(/FBB3E!G%L0&N(\B3/Z8\L04U8LL2``J0L02I4J
86 DATA L32=^3L0'73'L3=7H^B3DBECL2`@1DL0&G8UL363A>L1+36=L06.M2B3!X"\
87 DATA L1=+@'L1'B)LL3!P)(L0"U'[L12B<NB0E%E5L0(9^GL3#O*4B3=C?CL3C!M/
88 DATA L0/Q=NL14Q9OL0=FI=L1;GFLL25AENL3>MCOB2*F*IB2</H/L3-F5DB0K0M1
89 DATA L2$R*NL0"R`[L00*^$B3>(B(B3BZC\L0&I.OL3>5IDL05PD?L28^?AL2)9`0
90 DATA B3!!.`L1/M3LL05QDSL0"W#YL33N7ML3F4K^L30X<\B0KEKEL2-B1AB3!<*@
91 DATA L07^;CL0D%F)L0/DG?L2<ODUB0.7.9L3*51;L2);17B0B4B6L13@4BL0<)>'
92 DATA L2%T+OL2>=A@L0/156L3%+=!L3?3B2L02L3ML0'L0UB3<X@XL0?ZBXL3@GGK
93 DATA z
94 LOCATE 24:KEY OFF:PRINT "Press any key";:s$=INPUT$(1):KEY ON
95 SCREEN 0: WIDTH 80,25: END
98 v=ASC(k$):IF v=96 THEN v=11 ELSE IF v=94 THEN v=25 ELSE v=v-33
99 RETURN
I could probably understand it if I opened it in a text editor and read over it a few times, but right now holy crap that code gives me a headache.
Methinks your head aches a bit too easily.
But that's so little code, and in BASIC, you cannot hide a lot of meaning to little code, unlike in e.g. Perl!
Methinks your head aches a bit too easily.
But that's so little code, and in BASIC, you cannot hide a lot of meaning to little code, unlike in e.g. Perl!
It isn't so much "hiding a lot of meaning" as "code density".
Having multiple commands on the same line without any spacing (or even just one space) tends to make things look cluttered and difficult to follow, as opposed to having empty space.
It isn't so much "hiding a lot of meaning" as "code density".
Meh. I guess it's just still a bit of my Finnish background showing through.
I prefer "a feather-decorated blue hat donning man" rather
than "a man who dons a hat that is decorated with a feather and is blue"
or "there is a hat. the hat is blue. there is a feather. the hat is decorated with the feather. there is a man. the man dons the hat."
Ehh, you can make write-only code in any language. Just because you can't pack a lot of meaning into a little code doesn't mean that you can't make code that makes no sense. :)
I'm curious what the DATA block does. Is it a set of instructions for how to draw the image? A bitmap? I might be able to figure it out myself if I knew what MID does, but there's also those $ and : businesses. Who puts $ after the variable name, anyway?
Edit:
Bisqwit wrote:
"there is a hat. the hat is blue. there is a feather. the hat is decorated with the feather. there is a man. the man dons the hat."
This version's a lot more amenable to change if, say, you need the man to have a scarf too. :)
Pyrel - an open-source rewrite of the Angband roguelike game in Python.
It isn't so much "hiding a lot of meaning" as "code density".
Meh. I guess it's just still a bit of my Finnish background showing through.
I prefer "a feather-decorated blue hat donning man" rather
than "a man who dons a hat that is decorated with a feather and is blue"
or "there is a hat. the hat is blue. there is a feather. the hat is decorated with the feather. there is a man. the man dons the hat."
I prefer that version too, the "who" adds an unnecessary pause in speech and it translates in my head to "a man... i'm now waiting until you get that part.. who blablabla". But I also prefer your Finnish inspired version when reading because it keeps me curious. Also when I read "a man" I already paint a picture in my head and with those added descriptions I have to change it which can be kind of annoying (a "Why didn't you tell me earlier?"-thing).
When programming I also started out with trying to fit as much of trivial code into one line as possible, but later I was forced to change habits.
dude, great wtf factor. I'll go with XK and confirm that your code has a great unmaintenability factor, like this kind of wtf. Very high magic numbers per line of code ratio.
Please do not proceed the same at work, for your colleagues sanity.
I never sleep, 'cause sleep is the cousin of death - NAS
Ehh, you can make write-only code in any language. Just because you can't pack a lot of meaning into a little code doesn't mean that you can't make code that makes no sense. :)
I'm curious what the DATA block does. Is it a set of instructions for how to draw the image? A bitmap? I might be able to figure it out myself if I knew what MID does, but there's also those $ and : businesses. Who puts $ after the variable name, anyway?
Edit:
Bisqwit wrote:
"there is a hat. the hat is blue. there is a feather. the hat is decorated with the feather. there is a man. the man dons the hat."
This version's a lot more amenable to change if, say, you need the man to have a scarf too. :)
MID$ is basically BASIC's version of php's substr.
The reason the $ comes after a variable is because $ is an identifier. For example, "a!" is an integer, "a#" is another type, etc. $ is "string".
The data block is instructions on how to draw the image. I found out enough to tell that B is a box and L isn't, but not much else.
I still prefer QBASIC over this.
I'm curious what the DATA block does. Is it a set of instructions for how to draw the image? A bitmap? I might be able to figure it out myself if I knew what MID does, but there's also those $ and : businesses. Who puts $ after the variable name, anyway?
: separates statements.
DATA declares data storage. A RESTORE statement can be used to alter the global pointer from which data is read, and successive READ statements will fetch an item from the data storage, incrementing the global pointer in the process.
I.e.
10 DATA 1
20 READ a,b
30 READ c
40 DATA 2,3
This reads the values 1 to a, 2 to b and 3 to c.
w=MID$(x,y,z) assigns a z-character substring of x into w, starting from position y (1-based).
In BASIC, there are five basic data types. Each datatype is denoted by a suffix in the variable name: A% is INT, A! is SINGLE, A# is DOUBLE, A& is LONG and A$ is STRING.
Every single variable name can exist in any of these data type spaces. For example, you can have A% and A$ is the same problem.
A variable, without a suffix, is one of these. Which one it is, is determined by the DEF statement. DEFINT A-Z declares that all suffixless variables that begin with a letter A to Z are INTEGER. The specification defaults to SGN, so in a DEF-less program, all suffixless variables are SINGLE types.
Example:
10 DEFINT C
20 A = 5 ' defaults to A! (DEFSNG)
30 C = 10 ' defaults to C% (DEFINT)
35 A! = 15 ' same as A
40 C! = 20 ' unassigned earlier
45 C% = 25 ' same as C
50 PRINT A; C; A!; C!; C%
This prints " 15 25 15 20 25 ".
If you want a string variable and you haven't used DEFSTR for the starting character of that variable name, you must use $ to explicitly identify the type.
By convention, for some reason, built-in functions returning a string value are all named with the $ suffix.
sure, translate to C ;)
I did a similar 3D-renderer back during school days, but instead of graphics mode I used the 80x25 text mode terminal (1 character = 1 pixel) and pushed the image data via ANSI sequences over a phone line - the 3D renderer was a plugin to a BBS system.
I later ported it to TurboPascal during school (we had to use TP there) to pass time during boring CS lessons.
However, I used basic raycasting and immediately rendered one column of the wall, instead of adding the tiles to a renderlist and using a zbuffer. Worked well for walls and kept the algorithm simple, but didn't allow floor/ceiling textures or consistent wall outlines.
As an example, here's something I wrote in an hour or two in QBASIC. Anybody who knows me very well (or knows the origins of my username) should be able to tell what it does without even looking at the filename.
As stated, QBASIC only.
I'm curious what the DATA block does. Is it a set of instructions for how to draw the image? A bitmap?
It is a set of instructions. Each instruction is 6 characters.
The first character denotes the operation type: B = draw filled rectangle, L = draw line.
The second character denotes the colour. [0,1,2,3] = [black,cyan,red,white].
The next four characters denote the coordinates. x1,y1,x2,y2.
The coordinates are in the range 0<=x<46 and y<=0<60.
A coordinate is translated into a character by adding 33 to it ("!"). If the result produces ":" (command separator), a "^" is produced instead. If the result produces "," (data separator), a "`" is produced instead. The subroutine at line 98 does the reverse of this transformation
Xkeeper wrote:
I still prefer QBASIC over this.
QBASIC is really not very much different.
In fact, this very same code works fine in QBASIC without modifications.
The parser abuses mentioned at the end of the FPS renderer however wouldn't work without changes.
Though if you want to write the Mario renderer in a QBASICcy way, it would become like this:
DEFINT a-z
DECLARE FUNCTION untrans(k AS STRING)
SCREEN 1
PALETTE 2, 12 'Needed for CGA compatibility
RESTORE imagedata
DO
READ s$
IF s$ = "z" THEN EXIT DO
FOR a=1 TO 55 STEP 6
FOR basey = 0 TO 200-60 STEP 60
FOR basex = 0 TO 320-40 STEP 46
x1 = untrans(MID$(s$,a+2,1)) + basex
y1 = untrans(MID$(s$,a+3,1)) + basey
x2 = untrans(MID$(s$,a+4,1)) + basex
y2 = untrans(MID$(s$,a+5,1)) + basey
c = VAL(MID$(s$,a+1,1))
IF MID$(s$,a,1) = "B" THEN
LINE (x1,y1)-(x2,y2),c,BF
ELSEIF MID$(s$,a,1) = "L" THEN
LINE (x1,y1)-(x2,y2),c
ELSE
PRINT "DATA ERROR("; MID$(s$,a,6); ")"
EXIT DO
END IF
NEXT basex, basey
NEXT
LOOP
LOCATE 24: KEY OFF: PRINT "Press any key";: s$=INPUT$(1): KEY ON
SCREEN 0,1,0,0: WIDTH 80,25
END
imagedata:
DATA B2!!N\B3!!'NB3H!N\B3!!1+B0C.L3B09<?QB0'C+QB3-F9LB3DOG\B0#PCR
DATA B3!!G"B0)AKBB31S3\B0KCLLB1
Now, who can find the most annoying bug in it?
(And who can build a game around it? :P )
Edit: Oh, and yes, I just wrote it, to refresh my GW-BASIC skills; I didn't pick it from archives ― back then, I couldn't even have programmed something like this.
