Post subject: GW-BASIC fun (QuickBASIC too!)
Active player, Editor (296)
Joined: 3/8/2004
Posts: 7468
Location: Arzareth
Classic starfield effect!
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
) Can anyone make this program perform faster?
Sir_VG
He/Him
Player (39)
Joined: 10/9/2004
Posts: 1911
Location: Floating Tower
Damn, GWBasic. It's been too long... I used to program in it a lot, but it's been years, so I'm probably very rusty.
Taking over the world, one game at a time. Currently TASing: Nothing
Active player (308)
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:
Drama, too long, didn't read, lol.
Joined: 3/7/2006
Posts: 720
Location: UK
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.
Voted NO for NO reason
Active player, Editor (296)
Joined: 3/8/2004
Posts: 7468
Location: Arzareth
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.
Post subject: Re: GW-BASIC fun
Banned User
Joined: 3/10/2004
Posts: 7698
Location: Finland
Bisqwit wrote:
linux command: dosbox
dos command: mount c .
dos command: c:
Or you could simply replace the above with:
linux command: dosbox .
(Notice the dot. The actual directory, if not the current one, will also work.)
Post subject: Mario Mario Mario Mario Mario Mario Mario
Active player, Editor (296)
Joined: 3/8/2004
Posts: 7468
Location: Arzareth
Mario Mario Mario Mario Mario Mario Mario [img_left]http://bisqwit.iki.fi/kala/snap/gwbasicmario.png[/img_left] Constructed as follows:
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
Banned User
Joined: 12/23/2004
Posts: 1850
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.
Perma-banned
Active player, Editor (296)
Joined: 3/8/2004
Posts: 7468
Location: Arzareth
Xkeeper wrote:
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!
Banned User
Joined: 12/23/2004
Posts: 1850
Bisqwit wrote:
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.
Perma-banned
Active player, Editor (296)
Joined: 3/8/2004
Posts: 7468
Location: Arzareth
Xkeeper wrote:
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."
Banned User
Joined: 12/23/2004
Posts: 1850
I was meaning more the completelackofspacebetweencommandssothateverythingisbunchedtogetherandunreadable over excessive verbosity. i.e., whitespace.
Perma-banned
Joined: 7/2/2007
Posts: 3960
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.
Joined: 10/20/2006
Posts: 1248
Bisqwit wrote:
Xkeeper wrote:
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.
SXL
Joined: 2/7/2005
Posts: 571
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
Banned User
Joined: 12/23/2004
Posts: 1850
Derakon wrote:
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.
Perma-banned
Active player, Editor (296)
Joined: 3/8/2004
Posts: 7468
Location: Arzareth
Derakon wrote:
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.
Joined: 3/7/2006
Posts: 720
Location: UK
I've always liked BASIC's DATA command. And your code for drawing 'vector graphics' makes me smile.
Voted NO for NO reason
Post subject: Re: GW-BASIC fun
Tub
Joined: 6/25/2005
Posts: 1377
Bisqwit wrote:
Can anyone make this program perform faster?
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.
m00
Banned User
Joined: 12/23/2004
Posts: 1850
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.
Perma-banned
Active player, Editor (296)
Joined: 3/8/2004
Posts: 7468
Location: Arzareth
Derakon wrote:
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![C[B0`M/ZB0H8I=B3ADKJB01048B05UCW
   DATA B0+=0?B1/NJNB09#B$B20)G/B0+-I-B07MJMB2$QBQB05YBYB0(/)9B3!!6%
   DATA B3!<*@B079^<B0E%E6L0)09#L3)7BGL088GKL0&FG?L04/H7L3!9DPL343E>
   DATA L0"S%\L01><OL0C$H0L3>2JAL3!R-4B26VAVL079DTL0*\+^L2+A-YB0GDGG
   DATA L3"29"L20.>ML0<7=/L0(/FBB3E!G%L0&N(\B3/Z8\L04U8LL2``J0L02I4J
   DATA L32=^3L0'73'L3=7H^B3DBECL2`@1DL0&G8UL363A>L1+36=L06.M2B3!X"\
   DATA L1=+@'L1'B)LL3!P)(L0"U'[L12B<NB0E%E5L0(9^GL3#O*4B3=C?CL3C!M/
   DATA L0/Q=NL14Q9OL0=FI=L1;GFLL25AENL3>MCOB2*F*IB2</H/L3-F5DB0K0M1
   DATA L2$R*NL0"R`[L00*^$B3>(B(B3BZC\L0&I.OL3>5IDL05PD?L28^?AL2)9`0
   DATA B3!!.`L1/M3LL05QDSL0"W#YL33N7ML3F4K^L30X<\B0KEKEL2-B1AB3!<*@
   DATA L07^;CL0D%F)L0/DG?L2<ODUB0.7.9L3*51;L2);17B0B4B6L13@4BL0<)>'
   DATA L2%T+OL2>=A@L0/156L3%+=!L3?3B2L02L3ML0'L0UB3<X@XL0?ZBXL3@GGK
   DATA z

FUNCTION untrans(k AS STRING)
  v = ASC(k)
  IF v = 96 THEN v = 11 ELSE IF v = 94 THEN v = 25 ELSE v = v - 33
  untrans = v
END FUNCTION
Banned User
Joined: 12/23/2004
Posts: 1850
Ah, okay. The end block is still somewhat nonsensical, but I managed to make sense of it. Rather clever, heh.
Perma-banned
Active player, Editor (296)
Joined: 3/8/2004
Posts: 7468
Location: Arzareth
Xkeeper wrote:
The end block is still somewhat nonsensical
KEY ON = puts on the display of function key labels at the screen bottom KEY OFF = hides those In GW-BASIC, hitting F1 gives you "LIST ", hitting F2 gives you "RUN" and a newline, hitting F3 gives you "LOAD" and a quote character, and so on. Those are always displayed on the screen bottom, even when the program runs. However, KEY ON/OFF can show/hide them. The macroes can also be redefined if one so chooses ― for example, KEY 1, "GRUU" changes the F1 key to produce the string "GRUU". Try this (in either GW-BASIC or QBASIC):
10 KEY 1, "Mary"
20 KEY 2, "had"
30 KEY 3, "a"
40 KEY 4, "little"
50 KEY 5, "lamb"
60 KEY 6, " "
70 KEY ON
80 PRINT "Hit F1, F6, F2, F6, F3, F6, F4, F6 and F5, in this order."
90 INPUT s$
EDIT: Or if you are referring to the untrans function… well, it does what it must do in no particularly elegant manner.
Banned User
Joined: 12/23/2004
Posts: 1850
I wasn't aware KEY had any function in QBASIC, as those aren't generally displayed... Oh well. Edit: Perhaps when I'm on my older computer. And I still hate that blasted "YOU HAVE IMAGES" dialog box. Ugh.
Perma-banned
Active player, Editor (296)
Joined: 3/8/2004
Posts: 7468
Location: Arzareth
[img_left]http://bisqwit.iki.fi/kala/snap/qbasicnovatron.png[/img_left][img_right]http://bisqwit.iki.fi/kala/snap/novatron_000.png[/img_right] There was once this game called NOVATRON. I still suck at it btw. This is something like that except with no sounds and with a weaker AI. On the left: QuickBasic game, source code below On the right: Original Novatron
DEFINT A-Z
DECLARE SUB plot(screenx, screeny)
DECLARE SUB setp(fieldx,fieldy, pal)
DECLARE FUNCTION shadows(fieldx,fieldy,fieldz)
DECLARE SUB AI(botx,boty,botdir)
CONST xdim = 200
CONST ydim = 110
CONST wallheight = 15
TYPE dircfg
  x AS INTEGER
  y AS INTEGER
  k AS STRING*1
END TYPE
OPTION BASE 0
DIM SHARED fld(xdim-1, ydim-1), palettes(1 TO 3,9), dircfg(3) AS dircfg
SCREEN 13 ' 320x200 256-color mode, very popular

' configure input and axial directions
DATA 0,-1,H, 0,1,P, -1,0,K, 1,0,M
FOR n=0 TO 3: READ dircfg(n).x, dircfg(n).y, dircfg(n).k: NEXT

' Colors
FOR p=1 TO 3:FOR c=0 TO 9:READ palettes(p,c):NEXT c,p
DATA 11, 11,3, 3,1,  9, 9,1, 3,1 : REM Wall colours
DATA 14, 14,6, 6,4, 12,12,4, 6,4 : REM Protagonist colours
DATA 13, 13,5, 5,1,  9, 9,1, 3,1 : REM Antagonist colours

' Create edge walls
FOR y = 0 TO ydim - 1: fld(0,y)=1: fld(xdim-1,y)=1: NEXT
FOR x = 0 TO xdim - 1: fld(x,0)=1: fld(x,ydim-1)=1: NEXT
' Render the entire field
FOR y = 50 TO 199-20
  FOR x = 50 TO 319-30
    plot x,y
NEXT x,y

botx=xdim*3\4  : yourx=xdim\2
boty=ydim*3\4  : youry=ydim\2

dir=3
win=0
botdir=2
DO
  IF fld(botx,boty) THEN win=1: EXIT DO
  setp botx,boty, 3

  IF fld(yourx,youry) THEN win=0: EXIT DO
  setp yourx,youry, 2
  y$ = RIGHT$(INKEY$,1)
  IF y$ = CHR$(27) THEN win=2: EXIT DO
  FOR n=0 TO 3
    IF y$ = dircfg(n).k THEN dir = n
  NEXT
  AI botx,boty,botdir
  yourx = yourx + dircfg(dir).x
  youry = youry + dircfg(dir).y
  botx = botx + dircfg(botdir).x
  boty = boty + dircfg(botdir).y
LOOP
IF win=1 THEN PRINT "You win" ELSE IF win=0 THEN PRINT "You lose"
WHILE INKEY$<>"":WEND
PRINT "Game over; press any key"; : s$ = INPUT$(1)
SCREEN 0,1,0,0 : WIDTH 80,25

END

' Field is mapped with fieldx,fieldy. fieldz = vertical(0=root of wall, positive=up).
' Screen is mapped with screenx,screeny.
' 
' screenx = fieldx + fieldy*0.3 + 50
' screeny = fieldy - fieldz     + 70
'
' This gives us:
'  fieldy  =            (screeny+fieldz-70)
'  fieldx  = screenx - ((screeny+fieldz-70)*0.3 + 50)
'
' The light vector is (field coordinates) x=0.4, y=0.6, z=0.2
'
SUB plot(screenx, screeny)
  xorpt = 1 AND (screenx XOR screeny)
  FOR fieldz = wallheight TO 0 STEP -1
    fieldy = (screeny + fieldz - 70)  
    fieldx = screenx - (fieldy*3\10 + 50)
    IF  fieldx>=0 AND fieldx<xdim _ 
    AND fieldy>=0 AND fieldy<ydim THEN
      pal = fld(fieldx,fieldy)
      IF pal THEN
        palindex = 5 ' Default wall colour
        IF fieldz >= wallheight THEN palindex = 0 ' Top of the wall
        ' Check shadow
        SELECT CASE shadows(fieldx,fieldy,fieldz)
          CASE 1: palindex = palindex + 1+xorpt 'shadowing thing on the right side
          CASE 2: palindex = palindex + 3+xorpt 'shadowing thing on the left side
        END SELECT
        ' Plot the wall pixel
        PSET(screenx,screeny), palettes(pal,palindex)
        EXIT SUB
      END IF
    ELSE
      IF fieldz=0 THEN EXIT SUB 'always out of bounds
      IF fieldx<-15 OR fieldy<-15 THEN EXIT SUB
      IF fieldx>=xdim+15 OR fieldy>=ydim+15 THEN EXIT SUB
    END IF
  NEXT
  'Plot floor   
  c = xorpt
  fieldz = 0
  fieldy = (screeny + fieldz - 70)
  fieldx = screenx - (fieldy*3\10 + 50)
  IF shadows(fieldx,fieldy,fieldz) THEN
    c = c AND ((2 AND (screenx XOR screeny))\2) ' any shadow
  END IF
  PSET (screenx,screeny), c
END SUB

' Calculate whether there is something that shadows this spot
FUNCTION shadows(fieldx,fieldy,fieldz)
  FOR shadowvec = 1 TO wallheight ' (upper limit must be >= ceil(wallheight))
    fx = CINT(fieldx + 0.4 * shadowvec)
    fy =     (fieldy +       shadowvec)   
    fz =     (fieldz +       shadowvec)
    IF fz > wallheight OR fx >= xdim OR fy >= ydim THEN EXIT FOR ' out of bounds
    IF fld(fx, fy) THEN shadows = 1: EXIT FUNCTION
  NEXT
  FOR shadowvec = 1 TO wallheight ' (upper limit must be >= ceil(wallheight))
    fx = CINT(fieldx - 0.7 * shadowvec)
    fy =     (fieldy +       shadowvec)
    fz =     (fieldz +       shadowvec)
    IF fz > wallheight OR fx < 0 OR fy >= ydim THEN EXIT FOR ' out of bounds
    IF fld(fx, fy) THEN shadows = 2: EXIT FUNCTION
  NEXT  
END FUNCTION

' Set this pixel and plot the field
SUB setp(fieldx,fieldy, pal)
  fld(fieldx,fieldy)=pal
  screenx = fieldx+fieldy*0.3+50
  screeny = fieldy          +70
  FOR x=screenx-12 TO screenx+8
    FOR y=screeny-23 TO screeny   
      plot x,y
  NEXT y,x
END SUB

' The computer player's AI. Quite bad.
SUB AI(botx,boty, botdir)
  DIM dists(3)
  FOR n=0 TO 3: dists(n) = 9: NEXT
  FOR dist=8 TO 1 STEP -1
    FOR n=0 TO 3
      IF fld(botx + dist*dircfg(n).x, boty + dist*dircfg(n).y) THEN dists(n) = dist
  NEXT n,dist
  ' Go to whichever direction that is furthest away from any walls
  IF RND > 0.93 THEN botdir = INT(RND*4) 'randomly change direction
  bestdist=0: dir=botdir
  FOR n=0 TO 3
    testdir=(botdir+n)AND 3
    IF dists(testdir) > bestdist THEN bestdist=dists(testdir): dir=testdir
  NEXT
  botdir=dir AND 3
END SUB