QBasic and QB64 Discussion Board

[QB Forum Archives (1999-2009)/ ] [QB FAQ] [QB Links and Downloads] [Subforums and Chat Room] [Search]

QB64.Net Homepage   QB/QB64 Keywords   QB Graphics Forum   Homework Policy



Quirky behavior

by lawgin (no login)

In the code below e evaluates as 19/95 which is equal to 1/5 or .2
And a/d is also equal to .2, but the last statement declares them not equal. DEFDBL A-E fixes this in qb64, but why is double precision needed for a single decimal place? In qb4.5, the DEFDBL does not help.

a = 1: b = 9: c = 9: d = 5
e = (10 * a + b) / (10 * c + d)
PRINT e, a / d
IF e = a / d THEN PRINT "equal" ELSE PRINT "not equal"

Posted on Feb 19, 2012, 9:11 AM

Respond to this message   

Return to Index


.2 is a "repeating" binary number...

by (Login MCalkins)
Moderator

DIM d AS DOUBLE
DIM i AS INTEGER

d = .2
CLS

PRINT "0.";

FOR i = -1 TO -25 STEP -1
IF d >= 2 ^ i THEN
PRINT "1";
d = d - 2 ^ i
ELSE
PRINT "0";
END IF
NEXT
PRINT

--------------------

So, .2 decimal = 0.0011001100110011001100110... binary.

As it is not composed just of powers of 2, it is a repeating number. This is like 1/3 in decimal.

Just like any reciprocal of an integer that has factors other than 2 and 5 will repeat in decimal, so any reciprocal of an integer that has a factor other than 2 will repeat in binary, I think.

As such, it cannot be represented accurately by a floating point variable of any precision.

A work around for the equality test would be to test for proximity. IF abs(e - (a/d)) < some small number. That is crude, though, and still prone to error.

Regards,
Michael

Posted on Feb 19, 2012, 11:52 AM

Respond to this message   

Return to Index


No programming required

by aoeu (no login)

1/5 = 1/4 - 1/20
1/5 = 1/4 - 1/4 ( 1/5 )
i.e.
1/5 = 1/4 - 1/16 + 1/64 - 1/256 + 1/1024 - 1/4096 + ...
or
1/5 = 3/16 + 3/256 + 3/4096 + ...
0, 0011 0011 0011 0011 ...

Posted on Feb 19, 2012, 3:48 PM

Respond to this message   

Return to Index


*Clever

by lawgin (no login)

Posted on Feb 20, 2012, 9:20 AM

Respond to this message   

Return to Index


Re: Quirky behavior (added PS)

by (Login MCalkins)
Moderator

By the way, I got "not equal" with DEFDBL A-Z in qb64 also. Any discrepancy between qbasic and qb64 would indicate a bug in qb64. However, I think they both use the x87 FPU, so there shouldn't be any discrepancy.

--------

However, try this:

CLS
DEFDBL A-Z
a = 1: b = 9: c = 9: d = 5
e = (10 * a + b) / (10 * c + d)
PRINT e, a / d
f = a / d
PRINT
PRINT e = f
PRINT e = a / d
PRINT f = a / d
PRINT
PRINT e - (a / d)
PRINT
PRINT hexdouble(e), MKD$(e)
PRINT hexdouble(a / d), MKD$(a / d)
PRINT MKD$(e) = MKD$(a / d)

----

By adding:
f = a / d
e = f is true.

qbasic 1.1 and qb64 0.951 produce the same output for that program.

Somehow it's not equal until it's assigned to a variable. Perhaps the math is being done in 80 bits, and the value doesn't become 64 bits until assigned to a DOUBLE? The x87 usually does floating point math in 80 bits, even if the variable is stored as 64 bits or 32 bits. That might account for why assigning it to a variable makes a difference.

If you are using qb64 0.942, and it produces different results, it's probably due to:

http://www.qb64.net/forum/index.php?topic=5123.0

which is fixed in qb64 0.951.

Regards,
Michael

P.S.

I've gotten used to copying the whole program out in QB64, and forgot to copy the function:

FUNCTION hexdouble$ (d AS DOUBLE)
DIM t AS STRING
DIM t1 AS STRING * 16
DIM t2 AS INTEGER
DIM i AS INTEGER
t = MKD$(d)
t1 = STRING$(&H10, &H30)
FOR i = 1 TO 8
t2 = ASC(MID$(t, i, 1))
MID$(t1, i + i + (t2 >= &H10), 1 - (t2 >= &H10)) = HEX$(t2)
NEXT
hexdouble = LCASE$(t1)
END FUNCTION

I'm pretty sure what was happening is this:

e, a, and d are all 64 bit variables.

a / d causes the 64 bit variables to be loaded into the x87 FPU registers as 80 bit values. The division is performed. The result is, of course, 80 bits.

Then the 64 bit e is loaded as an 80 bit value to compare with the result of the division, which has not yet been rounded. Since e's value has been previously rounded, but the division result has not, the two are not equal.

When the division result is saved to f, it is rounded to a 64 bit variable. When e is compared with f, they are both converted from 64 bits back to 80 bits, and compared. Since they were both previously rounded to 64 bits, they are equal.

I think that's what's happening.

Posted on Feb 19, 2012, 12:22 PM

Respond to this message   

Return to Index


I see what you mean

by lawgin (no login)

.2 can't be expressed exactly in binary form. This must be true for all decimals unless they are combined from 1/2,1/4,1/8,...
.5=.1
.625=.101
.0625=.0001
.75=.11
.984375=.111111

How assigning a variable to the expression fixes this is still a mystery. Btw, I am still using qb64 v0.942 so that explains the discrepancy.

Posted on Feb 19, 2012, 4:00 PM

Respond to this message   

Return to Index


*I started adding a PS to my earlier post before I saw your response.

by (Login MCalkins)
Moderator

Posted on Feb 19, 2012, 4:14 PM

Respond to this message   

Return to Index


Comment on Michael's response

by (no login)

Michael, brilliant solution to this issue.

Regards..... Moneo

Posted on Feb 19, 2012, 6:48 PM

Respond to this message   

Return to Index


* :-P :-)

by (Login MCalkins)
Moderator

Posted on Feb 19, 2012, 6:52 PM

Respond to this message   

Return to Index


I second the motion.

by Solitaire (no login)

Michael is an absolute genius. AND he is also a brilliant teacher, as he takes the time to carefully explain his reasoning.

Posted on Feb 20, 2012, 11:07 AM

Respond to this message   

Return to Index


Re: I second the motion.

by (Login MCalkins)
Moderator

Thanks. I'll try to not let it go to my head. :-)

I kind of feel that way about several people here. I guess there are a number of people that really excel in their own specialties. I probably shouldn't name names, but I will anyway. Artelius (Ildûrest), ChronoKitsune, ComputerGhost, TheBOB, Matthewr2_1, and of course, Galleon all come to mind. There are others, also. Some of those have shown remarkable skill or understanding in certain specific areas, or in general.

Several others, including lawgin, David, and Ellipse (walrus) have impressed me with their math knowledge.

Lately, I think ChronoKitsune (rpgfan3233) has been doing a good job of explaining things.

I also admire his attitude. I remember quite a few years ago, I jumped on him because I thought he was wrong about a certain aspect of QBASIC behavior. It turned out that I was wrong and he was right. But he took it very well.

http://www.network54.com/Forum/190883/message/1122999179/

Regards,
Michael

Posted on Feb 22, 2012, 12:42 AM

Respond to this message   

Return to Index


Regarding that specific topic...

by ChronoKitsune (no login)

MS-DOS was a single-tasking OS. Naturally the OS made an attempt to free any resources held by a program when the program quit. If QBASIC wasn't closed, neither was the open file unless a CLOSE command was used. Of course, you didn't notice this because of the fact that all you ran was QBASIC. I wonder if the file buffer would be flushed if you left QBASIC open and invoked the DOS shell from the File menu... Of course, all of this is moot at this point, but I think the only other way you might have discovered this from running in MS-DOS is by using a network connection and trying to open the file over the network.

Thanks for the praise, but honestly as I said back then, we all make mistakes. It isn't that some of us are better than others. Some of us are a bit more curious at times is all, not to mention a bit of programming with even a slightly lower-level language such as C++ can shed some light on things that don't occur without such knowledge. Ultimately, it's a learning experience, and that's something we all can benefit from.

Posted on Feb 22, 2012, 1:23 PM

Respond to this message   

Return to Index


Thanks for clarifying

by lawgin (no login)

I wondered what that hexdouble was, though I forgot to mention it.

It seems that this problem occurs only when there is a division involved in the comparison. I thought the same might happen with this, but it doesn't:

a = 1: b = SQR(5)
e = 1 + SQR(5)
PRINT e = 1 + b

I suppose SQR(5) is already returned as 64 bit. Change + to / and the statement is false.





Posted on Feb 20, 2012, 9:27 AM

Respond to this message   

Return to Index


Re: Thanks for clarifying

by (Login MCalkins)
Moderator

You're welcome.

I was kind of hoping Galleon would weigh in on this, because I'm sure he knows what's happening. (I'm kind of guessing.) I guess he's busy with other things.

I haven't gotten around to investigating your latest finding yet. I hope to get to it soon.

Regards,
Michael

Posted on Feb 22, 2012, 12:25 AM

Respond to this message   

Return to Index


Open a program form QB64 using SHELL command

by (no login)

I'm writing a program and part of it includes opening other programs

I'm using the following line of code :

SHELL "start /max "+rtrim$(file$)

this line opens files which do not have a space in the name, but if i try to open a file with space, it says file could not be located..(all the files are in the same folder.. only the ones with spaces in the name do not work...)

what is causing this?

Posted on Feb 15, 2012, 3:36 PM

Respond to this message   

Return to Index


try using quotation marks.

by (Login MCalkins)
Moderator

SHELL "start /max "+chr$(&h22)+rtrim$(file$)+chr$(&h22)

Regards,
Michael

Posted on Feb 15, 2012, 3:54 PM

Respond to this message   

Return to Index


If i do that, it does nothing

by (no login)

I tried that and it did nothing. it works for files with no spaces in the name but not for those with spaces... is there any other way i can run other qbasic programs without closing this one? i tried RUN and CHAIN, but they both close the program which calls them.. how can i avoid this?

Posted on Feb 15, 2012, 4:01 PM

Respond to this message   

Return to Index


Re: If i do that, it does nothing

by Pete (no login)

Shell "cmd /c start " + chr$(34) + "my file.exe" + chr$(34)

Use COMMAND /c if it's a Windows system before XP.

If you are running in DOSBOX, forget it.

Anyway, using CHR$(34) puts file names with spaces in them in quotes, so they will be accepted."

Pete

Posted on Feb 15, 2012, 11:41 PM

Respond to this message   

Return to Index


Re: If i do that, it does nothing

by (no login)

I'm using windows 7 and qb64.. so that is not the issue

if i put the extra quotes around file$, it just opens up a regular command prompt.

What i want to do is open one qbasic program from another without closing the original one

Posted on Feb 16, 2012, 2:39 PM

Respond to this message   

Return to Index


Got it, Thanks

by (no login)

It was the quotes after all.. i had to put them in the path as well..

Thanks guys

Posted on Feb 16, 2012, 6:06 PM

Respond to this message   

Return to Index


help/intruction/tutor with program

by (no login)

in desperate need of walk through and instruction on how to complete this assignment.
any help would be appreciated...

write a program to determine the maturity value of an investment of D dollars for Y years at P percent converted quarterly.use the following formula
s=d(1+p/m) s = maturity value
d = investment in dollars
p = nominal interest
y = time in years
m = number of conversions per year

use the following sample data in response to the appropriate input statements:
investment = $5000
interest = 5.25%
time = 2 years 3 months
Conversions = 4

the following results should be displayed
please enter the:
investment in $ ====> 5000
nominal rate in % ===> 5.25
time in years===> 2.25
Number of conversions ===> 4
Maturity value ============> $5622.602

Posted on Feb 15, 2012, 10:12 AM

Respond to this message   

Return to Index


Re: help/intruction/tutor with program

by (Login MCalkins)
Moderator

You'll need variables. You can declare them with the DIM statement.

Remember to use asterisk, *, as the multiplication operator.

+ is addition
- is subtraction (you won't need this for your assignment)
* is multiplication
/ is division
^ is exponentiation
() can be used to force a certain order of operations.

= can be used as an assignment. (It can also be used as an equality tester, but you don't need that now.)

Use INPUT to get input from the user. Use PRINT to display the results.

Just as an example of the language, Here is a program to print the area of a triangle:

DIM h AS SINGLE
DIM b AS SINGLE
DIM a AS SINGLE

INPUT "base"; b
INPUT "height"; h

a = b * h / 2

PRINT "Area"; a
END

a is assigned the value of b times h divided by 2.

See if you can apply that concept to the compound interest formula.

Look carefully at the compound interest formula here:

http://en.wikipedia.org/wiki/Compound_interest#Compound

Notice that you'll need to divide p by 100 to convert it from a percentage.

Using the variable names in your assignment:

You will assign to p the value of p divided by 100.

m times y will need to be inside parenthesis. This will be the rightmost part.

1 plus p divided by m will need to be inside parenthesis. This will be the center part.

You will assign to s the value of d times the center part to the power of the rightmost part.

Regards,
Michael

Posted on Feb 15, 2012, 12:53 PM

Respond to this message   

Return to Index


* You are not the first person to come here with that exact homework assignment.

by (Login MCalkins)
Moderator

Posted on Feb 15, 2012, 12:57 PM

Respond to this message   

Return to Index


Re:

by (no login)

Everyone says its not difficult... But for
Some reason I'm not grasping concept... And have spent considerable time on it

Posted on Feb 15, 2012, 1:28 PM

Respond to this message   

Return to Index


Re: Re:

by (Login MCalkins)
Moderator

What part are you not understanding?

Do you understand the formula? Are you able to work it out with a calculator?

p divided by 100
5.25 / 100 is .0525

s = 5000 * (1 + .0525 / 4) ^ (4 * 2.25)

m times y
4 * 2.25 is 9

p divided by m
.0525 / 4 is .013125

1 plus ...
1 + .013125 is 1.013125

... to the power of ...
1.013125 ^ 9 is 1.1245202739653070820020716198051

d times ...
5000 * 1.1245202739653070820020716198051 is 5622.6013698265354100103580990253

Make sure you understand how to use the formula. Then, write the DIM statements for all the variables. Put the INPUT statements for the variables whose values the user needs to supply. Perform the math. The first assignment assigns to p the value of p divided by 100. The second assignment assigns to s using the formula. You will need 2 sets of parenthesis. Display the result with a PRINT statement. End the program with END.

Did you understand my triangle area example? If not, what part don't you understand? If you understand the formula as demonstrated above, and the QBASIC language as demonstrated in the triangle area example, you should be able to solve the problem.

Remember to use parenthesis to force higher priority evaluation.
Use * for multiplication.
Use ^ for exponents.
Use / for division.
Use + for addition.
Use = for assignment.

Regards,
Michael

Posted on Feb 15, 2012, 2:17 PM

Respond to this message   

Return to Index


help with a Qbasic program

by (no login)

Hi,

i am not a user of q-basic and i am crap in programming. that said, i am trying to run a simple, i woould say, program on q-basic that gives me an error message

"input past end of file"

which i don´t undersatnd since the data files are the same ones i did use long time ago (and it worked !!), can anyone give me a hand? if so, please let me know and i could send you the code to see if you can make sense

thanks a lolt in adavance

cheers

jorge

Posted on Feb 15, 2012, 2:08 AM

Respond to this message   

Return to Index


Re: help with a Qbasic program

by (Login MCalkins)
Moderator

Please post your code here on the forum.

Open the program in Notepad. Under the "Format" menu, make sure "Word Wrap" is unchecked. Right click anywhere in the text area, and select "Select All". All the text will turn blue. Right click anywhere in the text area, and select "Copy".

Then, in your reply here on the forum, right click in the "Message Text" part of the web page, and click "Paste".

Do the same for your data in a separate forum response. (Assuming it's ASCII data. If' it's binary data, say so, and someone will give you a program to convert it to hex values.)

Web browsers will not show multiple spaces, but I can edit your posts to convert them to NBSPs.

Regards,
Michael

Posted on Feb 15, 2012, 6:17 AM

Respond to this message   

Return to Index


Please use this program to convert your data file to hex byte values for posting.

by (Login MCalkins)
Moderator

'public domain, michael calkins

CONST t = "del-me.tmp"  '<-- this file gets clobered.

DIM i AS LONG
DIM f AS STRING
DIM h AS STRING
DIM b AS STRING * 1

LINE INPUT "Input file? "; f
OPEN f FOR BINARY ACCESS READ AS 1
OPEN t FOR OUTPUT AS 2

FOR i = 1 TO LOF(1)
 GET 1, , b
 h = LCASE$(HEX$(ASC(b)))
 IF LEN(h) = 1 THEN h = "0" + h
 PRINT #2, h;
 IF (i AND &H1F) = 0 THEN
  PRINT i
  PRINT #2, ""
 END IF
NEXT
CLOSE
PRINT "this program will end when you close Notepad."
SHELL "notepad " + t
KILL t
SYSTEM

Posted on Feb 15, 2012, 6:34 AM

Respond to this message   

Return to Index


there you are !

by (no login)

Hi,

thnaks a lot for your quick respone,

please find below the program (the data file, ascii, will follow in a second message)

5 DIM YY(12, 100), XX(12, 100), NFE$(12), HH(12), NPP(12), Y(500), X(500), A(12), NP1(12), HH$(12), NFS$(12)
10 KEY OFF
15 DEB = 0
21 OPEN "I", #1, "c:\Jorge\Acscal\dinamic4.DAT"
22 INPUT #1, NF$, NC$, C1$, C2$: REM nr filenames, fields, fields to treat
23 FOR I = 1 TO VAL(NF$)
24 INPUT #1, NFE$(I): INPUT #1, HH$(I): PRINT NFE$(I): NEXT I: REM HH=freq
25 INPUT #1, TC$
26 INPUT #1, DELT$
27 INPUT #1, BETA$
29 CLOSE 1
80 CLS : DEF SEG = &HB800: BLOAD "c:\Jorge\Acscal\dinamic.scr"
90  LA$ = NF$: LC% = 2: NX% = 3: NY% = 19: GOSUB 1050: NF% = VAL(LR$): NF$ = LR$
100 LA$ = NC$: LC% = 1: NX% = 3: NY% = 39: GOSUB 1050: NC% = VAL(LR$): NC$ = LR$
110 LA$ = C1$: LC% = 1: NX% = 3: NY% = 66: GOSUB 1050: C1% = VAL(LR$): C1$ = LR$
120 LA$ = C2$: LC% = 1: NX% = 3: NY% = 68: GOSUB 1050: C2% = VAL(LR$): C2$ = LR$
130 NX% = 5: NY% = 29: LC% = 10: FOR I = 1 TO NF%
140 IF I = 5 THEN NX% = 6: NY% = 29
141 IF I = 9 THEN NX% = 7: NY% = 29
150 LA$ = NFE$(I): GOSUB 1050: NFE$(I) = LR$: NY% = NY% + 11
160 NEXT I
170 LC% = 5: NX% = 8: NY% = 14: FOR I = 1 TO NF%
180 LA$ = HH$(I): GOSUB 1050: HH(I) = VAL(LR$): HH$(I) = LR$: NY% = NY% + 6
190 NEXT I
195 FOR I = 1 TO NF%: NFS$(I) = NFE$(I) + ".ESC": NEXT I
200 FOR I = 1 TO NF%
210 NPP(I) = 0
215 IF DEB = 1 THEN PRINT I
216 IF DEB = 1 THEN PRINT NFE$(I)
217 IF DEB = 1 THEN PRINT NC%
220 CLOSE 2: A$ = NFE$(I) + ".DAT": OPEN "I", 2, A$
230 IF NC% = 6 THEN INPUT #2, A(1), A(2), A(3), A(4), A(5), A(6)
280 NPP(I) = NPP(I) + 1: NN = NPP(I)
290 XX(I, NN) = A(C1%)
300 YY(I, NN) = A(C2%)
310 IF EOF(2) = 0 GOTO 230
315 IF DEB = 1 THEN PRINT "I read one file."
320 NEXT I
330 OP1$ = "1": OP2$ = "3"
340 LC% = 15: LA$ = TC$: NX% = 17: NY% = 13: GOSUB 1050: TC$ = LR$: TC = VAL(LR$)
350 LC% = 15: LA$ = DELT$: NX% = 19: NY% = 13: GOSUB 1050: DELT$ = LR$: DELT = VAL(LR$)
360 LC% = 15: LA$ = BETA$: NX% = 21: NY% = 13: GOSUB 1050: BETA$ = LR$: BETA = VAL(LR$)
380 LC% = 1: LA$ = OP1$: NX% = 21: NY% = 49: GOSUB 1050: OP1$ = LR$
390 LC% = 1: LA$ = OP2$: NX% = 21: NY% = 75: GOSUB 1050: OP2$ = LR$
400 XMIN = 1E+30: XMAX = -1E+30: YMIN = XMIN: YMAX = XMAX: NN = 0
410 FOR I = 1 TO NF%
420 H = HH(I): NP1(I) = 0: BETDELT = DELT
430 FOR J = 1 TO NPP(I)
440 T = (1 - XX(I, J) / TC)
450 IF OP2$ = "1" AND T > 0 THEN GOTO 540
460 IF OP2$ = "2" AND T < 0 THEN GOTO 540
462 T = ABS(T)
465 IF T = 0 GOTO 540
470 NP1(I) = NP1(I) + 1: NN = 1 + NN
480 X(NN) = H / (T ^ BETDELT): Y(NN) = YY(I, J) / (T ^ BETA)
490 IF OP1$ = "1" THEN X(NN) = LOG(ABS(X(NN))): Y(NN) = LOG(ABS(Y(NN)))
500 IF X(NN) > XMAX THEN XMAX = X(NN)
510 IF X(NN) < XMIN THEN XMIN = X(NN)
520 IF Y(NN) > YMAX THEN YMAX = Y(NN)
530 IF Y(NN) < YMIN THEN YMIN = Y(NN)
540 NEXT J
550 NEXT I
551 XMIN = INT(XMIN * 10) / 10
552 S% = XMAX / ABS(XMAX): XMAX = -INT(-ABS(XMAX * 10)) / 10 * S%
553 S% = YMAX / ABS(YMAX): YMAX = -INT(-ABS(YMAX * 10)) / 10 * S%
554 YMIN = INT(YMIN * 10) / 10
570 IF OP$ = "V" THEN SCREEN 12: CLS
580 IF OP$ = "C" THEN SCREEN 2: CLS
590 PSET (60, 1): LINE -(639, 1): LINE -(639, NLV): LINE -(60, NLV): LINE -(60, 1)
600 LOCATE 24, 7: PRINT XMIN; : N1 = 80 - LEN(STR$(XMAX)): LOCATE 24, N1: PRINT XMAX;
601 IF OP2$ = "1" THEN LOCATE 25, 15: PRINT "T>Tc    BETA = "; BETA$; "   DELTA = "; DELT$; "   Tc = "; TC;
602 IF OP2$ = "2" THEN LOCATE 25, 15: PRINT "T<Tc    BETA = "; BETA$; "   DELTA = "; DELT$; "   Tc = "; TC;
603 IF OP2$ = "3" THEN LOCATE 25, 15: PRINT "T><Tc    BETA = "; BETA$; "   DELTA = "; DELT$; "   Tc = "; TC;
604 IF OP1$ = "1" THEN LOCATE 24, 20: PRINT "Ln(X''/t**beta) v.s. Ln(W/t**(z*Nu))";
605 IF OP1$ = "2" THEN LOCATE 24, 20: PRINT "(X''/t**beta) v.s. (W/t**(z*Nu))";
610 N1 = 7 - LEN(STR$(YMAX)): IF N1 < 1 THEN N1 = 1
620 LOCATE 1, N1: PRINT YMAX;
630 N1 = 7 - LEN(STR$(YMIN)): IF N1 < 1 THEN N1 = 1
640 LOCATE 23, N1: PRINT YMIN;
650 X1 = 60: FOR I = 1 TO 4: X1 = X1 + 116: PSET (X1, NLV): LINE -(X1, NLV - 7): PSET (X1, 1): LINE -(X1, 8): NEXT I
660 X1 = 0: FOR I = 1 TO 3: X1 = X1 + INT(NLV / 3): PSET (60, X1): LINE -(68, X1): PSET (639, X1): LINE -(631, X1): NEXT I
670 DY = NLV / (YMAX - YMIN)
680 DX = 580 / (XMAX - XMIN)
690 NC = 0
700 FOR J = 1 TO NF%
710 FOR I = NC + 1 TO NP1(J) + NC
720 YS = NLV - (Y(I) - YMIN) * DY
730 XS = 60 + (X(I) - XMIN) * DX
740 IJ = J: GOSUB 4000
780 NEXT I
790 NC = NC + NP1(J)
800 NEXT J
810 IF INKEY$ = "" THEN GOTO 810
820 SCREEN 0: CLS
1031 LOCATE 10, 20: PRINT "GRABAR FICHEROS (S/N)": LA$ = "N": LC% = 1: NX% = 10: NY% = 44: GOSUB 1050
1032 IF LR$ = "S" OR LR$ = "s" THEN NC = 0: FOR I = 1 TO NF%: CLOSE 1: OPEN "O", #1, NFS$(I): FOR J = NC + 1 TO NP1(I) + NC: PRINT #1, X(J); ","; Y(J): NEXT J: NC = NP1(I) + NC: NEXT I: CLOSE 1
1037       LOCATE 12, 20: PRINT "SALIR DEL PROGRAMA(S/N)": LA$ = "N": LC% = 1: NX% = 12: NY% = 44: GOSUB 1050
1038 IF LR$ = "S" OR LR$ = "s" THEN OPEN "O", #1, "b:dinamic.DAT": PRINT #1, NF$; ","; NC$; ","; C1$; ","; C2$: FOR I = 1 TO NF%: PRINT #1, NFE$(I): PRINT #1, HH$(I): NEXT I: PRINT #1, TC$: PRINT #1, DELT$: PRINT #1, BETA$: CLOSE 1: STOP
1039 BLOAD "a:dinamic.scR": LOCATE 3, 19: PRINT NF$: LOCATE 3, 39: PRINT NC$
1040 LOCATE 3, 66: PRINT C1$: LOCATE 3, 68: PRINT C2$
1041 NX% = 5: NY% = 29: LC% = 10: FOR I = 1 TO NF%
1042 IF I = 5 THEN NX% = 6: NY% = 29
1043 IF I = 9 THEN NX% = 7: NY% = 29
1044 LOCATE NX%, NY%: PRINT NFE$(I): NY% = NY% + 11: NEXT I
1045 NX% = 8: NY% = 14: FOR I = 1 TO NF%
1046 LOCATE NX%, NY%: PRINT HH$(I): NY% = NY% + 6: NEXT I
1047 GOTO 340
1050 '------------------------------------------------------------------------
1060 '                 SUBRUTINA DE INPUT ALFANUMERICO
1070 ' Subrutina para la lectura de campos alfanumericos
1080 ' Parametros de entrada :
1090 '    LC%   : longitud maxima del campo
1100 '    LA$   : valor actual del campo
1110 '    NX%   : fila
1120 '    NY%   : columna
1130 ' Parametros de salida
1140 '    LR$   : lectura
1150 '------------------------------------------------------------------------
1160 LOCATE NX%, NY%: PRINT SPACE$(LC%)
1170 LOCATE NX%, NY%: PRINT MID$(LA$, 1, LC%)
1180 IF LA$ = "" THEN LR$ = SPACE$(LC%) ELSE LR$ = LA$
1190 NN% = 1: LOCATE NX%, NY%, 1, 7
1200 A$ = "": A$ = INKEY$: IF A$ = "" THEN GOTO 1200
1210 IF ASC(A$) = 13 THEN RETURN
1220 IF LEN(A$) = 1 THEN GOTO 1280
1230 IF ASC(MID$(A$, 2, 1)) = 75 THEN NN% = NN% - 1
1240 IF ASC(MID$(A$, 2, 1)) = 77 THEN NN% = NN% + 1
1250 IF NN% < 1 THEN NN% = 1
1260 IF NN% > LC% THEN NN% = LC%
1270 LOCATE NX%, NY% + NN% - 1, 1, 7: GOTO 1200
1280 LOCATE NX%, NY% + NN% - 1, 1, 7: PRINT A$;
1290 IF NN% = 1 THEN LR$ = A$ + MID$(LR$, 2, LEN(LR$) - 1)
1300 IF NN% = LEN(LR$) THEN LR$ = MID$(LR$, 1, LEN(LR$) - 1) + A$
1310 IF NN% > 1 AND NN% < LEN(LR$) THEN LR$ = MID$(LR$, 1, NN% - 1) + A$ + MID$(LR$, NN% + 1, LEN(LR$) - NN%)
1320 IF NN% = LEN(LR$) + 1 THEN LR$ = LR$ + A$
1330 IF NN% > LEN(LR$) + 1 THEN LR$ = LR$ + SPACE$(NN% - LEN(LR$) - 1) + A$
1340 NN% = NN% + 1
1350 IF NN% > LC% THEN NN% = LC%
1360 LOCATE NX%, NY% + NN% - 1, 1, 7
1370 GOTO 1200
4000 IF IJ > 10 THEN IJ = IJ - 10: GOTO 4000
4010 NS% = 2
4030 IF IJ = 1 THEN XI = XS - 2: XF = XS + 2: YI = YS - NS%: YF = YS + NS%: FOR Y1 = YI TO YF: PSET (XI, Y1): LINE -(XF, Y1): NEXT Y1
4040 IF IJ = 2 THEN PSET (XS - 2, YS - NS%): LINE -(XS + 2, YS - NS%): LINE -(XS + 2, YS + NS%): LINE -(XS - 2, YS + NS%): LINE -(XS - 2, YS - NS%)
4050 IF IJ = 3 THEN PSET (XS, YS - NS%): LINE -(XS, YS + NS%): PSET (XS - 2, YS): LINE -(XS + 2, YS)
4060 IF IJ = 4 THEN PSET (XS - 2, YS - NS%): LINE -(XS + 2, YS + NS%): PSET (XS + 2, YS - NS%): LINE -(XS - 2, YS + NS%)
4070 IF IJ = 5 THEN PSET (XS, YS + NS%): LINE -(XS + 2, YS - NS%): LINE -(XS - 2, YS - NS%): LINE -(XS, YS + NS%)
4080 IF IJ = 6 THEN PSET (XS, YS - NS%): LINE -(XS + 2, YS + NS%): LINE -(XS - 2, YS + NS%): LINE -(XS, YS - NS%)
4090 IF IJ = 7 THEN PSET (XS, YS - NS%): LINE -(XS - 2, YS): LINE -(XS, YS + NS%): LINE -(XS + 2, YS): LINE -(XS, YS - NS%)
4100 IF IJ = 8 THEN PSET (XS - 2, YS + NS%): LINE -(XS, YS): LINE -(XS, YS - NS%): PSET (XS + 2, YS + NS%): LINE -(XS, YS)
4110 IF IJ = 9 THEN PSET (XS - 2, YS - NS%): LINE -(XS + 2, YS + NS%): PSET (XS + 2, YS - NS%): LINE -(XS - 2, YS + NS%): PSET (XS, YS - NS%): LINE -(XS, YS + NS%): PSET (XS - 2, YS): LINE -(XS + 2, YS)
4120 IF IJ = 10 THEN PSET (XS - 2, YS - NS%): LINE -(XS, YS): LINE -(XS, YS + NS%): PSET (XS + 2, YS - NS%): LINE -(XS, YS)
4130 RETURN

Posted on Feb 15, 2012, 7:58 AM

Respond to this message   

Return to Index


thanks again

by (no login)

Hi, me again

as you suggested i post the data in a different message. the data are XY being the first number x and the second y, and so on.

data1a:

59.180,2.7228,61.310,2.6742,63.190,2.6202,65.370,2.5146,67.350,2.4405,69.380,2.3820,71.360,2.3364,73.365,2.3823,74.330,2.4225,74.775,2.4363,75.305,2.4357,75.770,2.4747,76.260,2.5335,76.780,2.5929,77.260,2.6631,77.795,2.7453,78.260,2.8173,79.300,2.9994,79.445,3.0096,79.630,3.0099,79.890,3.0399,80.080,3.0312,80.260,3.0300,80.450,2.9601,80.690,2.9688,80.870,2.9430,81.060,2.8893,81.270,2.8281,81.510,2.7324,81.710,2.6496,81.890,2.5926,82.090,2.4459,82.340,2.3637,82.540,2.2428,82.690,2.1474,82.880,2.0520,83.070,1.9509,83.270,1.8495,83.455,1.7763,83.700,1.6428,83.890,1.5720,84.080,1.4601,84.330,1.3686,84.515,1.2597,84.720,1.1786,84.960,1.0785,85.160,1.0203,85.340,0.95380,85.590,0.82850,85.780,0.77330,85.970,0.68400,86.320,0.56720,86.600,0.46510,86.870,0.37920,87.230,0.29060,87.495,0.18820,89.040,-0.10530,89.560,-0.17490,90.070,-0.22060,90.540,-0.27110,91.090,-0.29360,91.590,-0.31120,92.110,-0.31770,93.200,-0.34550,94.145,-0.31760,95.110,-0.33620,96.110,-0.34250,97.080,-0.32780,98.080,-0.31260,99.060,-0.29120,100.28,-0.27110,101.27,-0.28930,102.23,-0.25240,103.26,-0.26220,104.23,-0.23890,105.27,-0.21940,106.22,-0.19600,107.21,-0.20840,108.20,-0.19470,109.17,-0.19110,111.20,-0.18260,113.67,-0.12790,116.26,-0.098100,118.16,-0.054300,117.21,-0.10850,119.95,-0.041300,122.23,-0.028300,124.79,-0.011500,127.00,-0.0062000

data3a:
59.180,3.7428,61.310,3.6792,63.190,3.6012,65.370,3.4638,67.350,3.3390,69.380,3.2931,71.360,3.2628,73.365,3.3198,74.330,3.3474,74.775,3.3855,75.305,3.4038,75.770,3.4641,76.260,3.5337,76.780,3.6273,77.260,3.7116,77.795,3.8370,78.260,3.9260,79.300,4.1960,79.445,4.1530,79.630,4.1650,79.890,4.2440,80.080,4.2100,80.260,4.2340,80.450,4.2050,80.690,4.2170,80.870,4.1650,81.060,4.1000,81.270,4.0400,81.510,3.9190,81.710,3.8420,81.890,3.7632,82.090,3.5892,82.340,3.4485,82.540,3.3258,82.690,3.1935,82.880,3.0234,83.070,2.8737,83.270,2.7483,83.455,2.6274,83.700,2.4534,83.890,2.3361,84.080,2.2224,84.330,2.0727,84.515,1.9140,84.720,1.8348,84.960,1.6830,85.160,1.5561,85.340,1.4517,85.590,1.3224,85.780,1.1603,85.970,1.0614,86.320,0.90130,86.600,0.74120,86.870,0.64050,87.230,0.46010,87.495,0.35310,89.040,-0.11310,89.560,-0.20970,90.070,-0.34050,90.540,-0.40920,91.090,-0.44340,91.590,-0.44600,92.110,-0.50520,93.200,-0.54260,94.145,-0.55480,95.110,-0.54490,96.110,-0.52890,97.080,-0.55670,98.080,-0.53690,99.060,-0.49330,100.28,-0.47350,101.27,-0.46710,102.23,-0.44970,103.26,-0.43270,104.23,-0.43190,105.27,-0.41260,106.22,-0.38670,107.21,-0.40260,108.20,-0.37920,109.17,-0.37120,111.20,-0.34400,113.67,-0.25290,116.26,-0.22710,118.16,-0.18590,117.21,-0.20530,119.95,-0.18420,122.23,-0.15680,124.79,-0.10860,127.00,-0.10270

data5a:
59.180,5.5600,61.285,5.4830,63.220,5.4070,65.360,5.2560,67.330,5.0880,69.350,5.0140,71.330,4.9520,73.340,5.0540,74.315,5.1310,74.760,5.1610,75.290,5.1960,75.770,5.2930,76.250,5.4000,76.780,5.5140,77.260,5.6730,77.780,5.8230,78.245,6.0190,79.290,6.3270,79.430,6.3950,79.640,6.4520,79.890,6.4920,80.080,6.5140,80.240,6.4920,80.450,6.4780,80.690,6.5020,80.885,6.4780,81.060,6.3700,81.260,6.2910,81.510,6.1920,81.700,6.0710,81.880,5.9330,82.100,5.7620,82.325,5.5160,82.530,5.3520,82.690,5.1120,82.880,4.9460,83.070,4.7260,83.270,4.5040,83.470,4.3580,83.700,4.1030,83.890,3.9160,84.080,3.7194,84.330,3.4989,84.530,3.3009,84.720,3.1374,84.970,2.9199,85.160,2.7522,85.340,2.5800,85.580,2.3754,85.770,2.1999,85.970,2.0634,86.320,1.7784,86.600,1.5369,86.870,1.3383,87.200,1.1124,87.495,0.93220,89.025,0.14520,89.550,0.007200,90.070,-0.17640,90.540,-0.26190,91.070,-0.35480,91.590,-0.40660,92.100,-0.45930,93.185,-0.50270,94.120,-0.51260,95.090,-0.52980,96.075,-0.52340,97.070,-0.49870,98.055,-0.50400,99.035,-0.47780,100.28,-0.44600,101.25,-0.43070,102.23,-0.39120,103.26,-0.36750,104.22,-0.36550,105.25,-0.32120,106.22,-0.30040,107.21,-0.27070,108.18,-0.24620,109.15,-0.24490,113.71,-0.085100,116.26,-0.042100,118.11,-0.0071000,117.26,-0.020300,119.85,0.043700,122.32,0.089400,124.80,0.13010,127.02,0.18140

data6a:
59.180,8.8610,61.285,8.7700,63.220,8.6120,65.360,8.3900,67.330,8.1430,69.350,8.0320,71.330,8.0010,73.340,8.0740,74.315,8.1500,74.760,8.2300,75.290,8.2630,75.770,8.4020,76.250,8.5460,76.780,8.7840,77.260,8.9480,77.780,9.1830,78.245,9.4340,79.290,9.9390,79.430,10.019,79.640,10.103,79.890,10.155,80.080,10.202,80.240,10.207,80.450,10.261,80.690,10.225,80.885,10.201,81.060,10.103,81.260,10.072,81.510,9.9290,81.700,9.7560,81.880,9.5620,82.100,9.3950,82.325,9.0750,82.530,8.8040,82.690,8.5360,82.880,8.2700,83.070,7.9970,83.270,7.6390,83.470,7.3540,83.700,6.9610,83.890,6.6320,84.080,6.3690,84.330,6.0000,84.530,5.6830,84.720,5.4050,84.970,5.0980,85.160,4.8060,85.340,4.5600,85.580,4.2580,85.770,3.9980,85.970,3.8472,86.320,3.4188,86.600,3.0675,86.870,2.7276,87.200,2.3523,87.495,2.0688,89.025,0.78630,89.550,0.48300,90.070,0.21480,90.540,0.0003000,91.070,-0.14700,91.590,-0.28660,92.100,-0.31590,93.185,-0.44730,94.120,-0.46140,95.090,-0.47910,96.075,-0.48570,97.070,-0.47490,98.055,-0.51300,99.035,-0.41280,100.28,-0.36760,101.25,-0.30000,102.23,-0.25290,103.26,-0.22200,104.22,-0.17420,105.25,-0.12420,106.22,-0.13080,107.21,-0.054900,108.18,-0.010500,109.15,0.032700,113.71,0.25230,116.26,0.32660,118.11,0.45450,117.26,0.41790,119.85,0.51990,122.32,0.59370,124.80,0.67480,127.02,0.77700

data7a:
59.180,18.192,61.270,17.934,63.220,17.607,65.350,17.043,67.315,16.476,69.340,16.053,71.330,15.855,73.330,15.900,74.300,16.044,74.760,16.080,75.290,16.245,75.770,16.410,76.250,16.662,76.780,16.980,77.260,17.289,77.780,17.712,78.245,18.111,79.27519.173,79.430,19.266,79.640,19.434,79.875,19.593,80.080,19.746,80.250,19.863,80.440,19.896,80.690,19.953,80.870,19.980,81.060,19.941,81.270,19.818,81.500,19.650,81.700,19.491,81.890,19.242,82.090,18.885,82.340,18.408,82.530,17.940,82.690,17.652,82.880,17.124,83.070,16.572,83.260,15.945,83.455,15.330,83.700,14.583,83.890,13.887,84.080,13.308,84.330,12.304,84.515,11.671,84.720,11.074,84.950,10.380,85.160,9.7450,85.340,9.1830,85.580,8.5180,85.770,7.9400,85.970,7.3830,86.310,6.4790,86.590,5.6940,86.870,4.9830,87.200,4.1970,87.495,3.8742,89.025,0.92340,89.550,0.093300,90.070,-0.53460,90.540,-1.0259,91.070,-1.4706,91.580,-1.8006,92.100,-2.0250,93.160,-2.3715,94.100,-2.5197,95.090,-2.5440,96.060,-2.5101,97.060,-2.4588,98.040,-2.5790,99.035,-2.2998,100.27,-2.0982,101.25,-2.1730,102.21,-1.9011,103.24,-1.7364,104.22,-2.0650,105.25,-1.5054,106.19,-1.4442,107.21,-1.3002,108.17,-1.1631,109.14,-1.0401,111.14,-0.75540,113.74,-0.38790,116.27,-0.10530,118.02,0.13440,117.35,0.024900,119.82,0.36840,122.43,0.69450,124.81,0.9558,126.99,1.2192

data8a:

59.180,23.610,61.270,23.004,63.220,22.179,65.350,21.132,67.315,20.061,69.340,19.104,71.330,18.504,73.330,18.270,74.300,18.327,74.760,18.342,75.290,18.510,75.770,18.675,76.250,18.924,76.780,19.335,77.260,19.716,77.780,20.217,78.245,20.814,79.275,22.122,79.430,22.272,79.640,22.557,79.875,22.812,80.080,22.905,80.250,23.133,80.440,23.232,80.690,23.379,80.870,23.412,81.060,23.430,81.270,23.304,81.500,23.070,81.700,22.947,81.890,22.644,82.090,22.155,82.340,21.609,82.530,21.015,82.690,20.715,82.880,20.022,83.070,19.254,83.260,18.477,83.455,17.496,83.700,16.395,83.890,15.381,84.080,14.451,84.330,13.122,84.515,11.896,84.720,10.940,84.950,9.7580,85.160,8.7500,85.340,7.8800,85.580,6.7770,85.770,5.9280,85.970,5.1030,86.310,3.5580,86.590,3.5853,86.870,2.4198,87.200,1.0542,87.495,-0.03600,89.025,-6.2050,89.550,-7.5390,90.070,-8.6780,90.540,-9.4120,91.070,-10.249,91.580,-10.780,92.100,-11.225,93.160,-11.863,94.100,-12.112,95.090,-12.175,96.060,-12.114,97.060,-12.073,98.040,-12.043,99.035,-11.716,100.27,-11.472,101.25,-11.289,102.21,-11.004,103.24,-10.732,104.22,-10.474,105.25,-10.250,106.19,-10.096,107.21,-9.7860,108.17,-9.5300,109.14,-9.2660,111.14,-8.6880,113.74,-8.0400,116.27,-7.4440,118.02,-7.0160,117.35,-7.1140,119.82,-6.5120,122.43,-5.8550,124.81,-5.2530,126.99,-4.7590

then there are two further files to which the program refers, dinamic4.dat and dinamic.scr
the first one (dinamic4.dat):
6,2,1,2,c:\Jorge\Acscal\data1a,111,c:\Jorge\Acscal\data3a,153,c:\Jorge\Acscal\data5a,222,c:\Jorge\Acscal\data6a,333,c:\Jorge\Acscal\data7a,666,c:\Jorge\Acscal\data8a,1000,80.1,10.5,0.56

the other one, dinamic.scr, i don´t what it is or what format it has since when editing it in a text editor i only get funny characters ????

hope this is useful.
what i wanted to mention is, please do not get crazy with it if it is not a stupid mistake somewhere. i mean, i think it will probably be so since, as i mentioned, i run the program, with the same data, long time ago and it worked. so i can onlything that somehow some allocation of files or something silly is wrong. by the way, the program is for scaling XY data so if it useful for anyone, please feel free to use it

thank you so much for your help

jorge

Posted on Feb 15, 2012, 8:15 AM

Respond to this message   

Return to Index


Re: thanks again

by (Login MCalkins)
Moderator

Well, I saved that data as .DAT files in c:\Jorge\Acscal

Also, I commented out the BLOAD.

When I run it, I get "subscript out of range" on this line:

290 XX(I, NN) = A(C1%)

This block of code:

230 IF NC% = 6 THEN INPUT #2, A(1), A(2), A(3), A(4), A(5), A(6)
280 NPP(I) = NPP(I) + 1: NN = NPP(I)
290 XX(I, NN) = A(C1%)
300 YY(I, NN) = A(C2%)
310 IF EOF(2) = 0 GOTO 230

is looping continually. EOF(2) is always 0 because nothing is reading the file. NC% = 2, so the INPUT statement is not being executed.

Are there lines missing between 230 and 280?

Regards,
Michael

Posted on Feb 15, 2012, 12:10 PM

Respond to this message   

Return to Index


help on qbasic program pg 84 #2

by (no login)

help on qbasic program pg 84 #2 (text book qbasic using subprograms 2nd edition)
anyone?

Posted on Feb 13, 2012, 12:15 PM

Respond to this message   

Return to Index


homework...

by (Login MCalkins)
Moderator

Please read the homework policy:

http://www.network54.com/Realm/QBasicFAQ/QBasicHomework.html

Try doing yourself first. If you get stuck or need advice, post the details of the assignment (don't expect us to have a copy of the book), and post your code so far.

Regards,
Michael

Posted on Feb 13, 2012, 12:44 PM

Respond to this message   

Return to Index


*too lazy to even copy the problem from the book haha

by Ben (no login)

Posted on Feb 13, 2012, 5:54 PM

Respond to this message   

Return to Index


Why does serial com occasionally stall (on WinXP)?

by (no login)

Hi, I have a program reading serial data as it comes in on COM1 with no flow control. The data comes in bursts (1684 bytes) with a 2 or 3 second pause before the next burst.

I've tested it on 3 machines, two running XP, and one running Win2K. It works for the most part on all three, but one of the XP computers is slow at getting the data. This slowness seems to be because it doesn't get the data steadily as it comes in, it seems to get "hung up" sometimes where the buffer fills up, then it empties. This leads to the occasional buffer overflow.

The other two computers get the data at a steady rate during the burst, and seems to have plenty of time to process the data. The bad computer is clearly getting hiccups while getting the data during the burst.

My questions are: is there something that commonly causes this? Is there something in Windows that would interfere with Qbasic getting access to the Receive-buffer of COM1?

I wrote a little test program that measures how much the buffer fills up before Qbasic empties it. The two computers that have no problem keep the buffer consistently low, but the computer with problems will sometimes empty the buffer quickly, and sometimes the buffer will nearly get full before emptying.

Here's a copy of the test program:

'This program shows the number of bytes in the receive buffer just prior to GETting one byte from the buffer.

DIM byt AS STRING * 1 'byt is a 1-byte character
DIM Buf AS INTEGER 'number of bytes in the receive buffer
DIM BufMax AS INTEGER 'peak number of bytes in the receive buffer
DIM KeyPress AS STRING * 1 'holds whatever key was pressed on the keyboard

CLS
VIEW PRINT 21 TO 25
PRINT "--------------------------------------------------------------------------------"
PRINT "Showing buffer size in bytes before reading a byte."
PRINT ""
PRINT "Press Esc to quit. c to clear. "

'open the com and file
OPEN "COM1:9600,N,8,1,BIN,CD0,CS0,DS0,OP0,RS,TB512,RB2000" FOR RANDOM AS #1 LEN = 2000 'Using the option list 2. RB (receive buffer) is 2000 bytes, as is the RANDOM buffer.

VIEW PRINT 1 TO 20
DO
Buf = LOC(1) 'find where in the buffer the last byt was written to or read from
IF Buf > 0 THEN 'if Buf > 0, then there is serial data in the buffer
IF Buf > BufMax THEN 'If the current buffer position is greater than the peak position,
BufMax = Buf 'this is a new peak position.
VIEW PRINT 23 TO 24 'Print the max value at line 23
PRINT "Buffer filled to a maximum of"; BufMax; "Bytes."
VIEW PRINT 1 TO 20 'return cursor to display field
END IF
PRINT Buf; 'display the buffer size before taking one byte.
GET #1, , byt 'get 1 byte from serial buffer. (Won't use it for anything.)
END IF
KeyPress = INKEY$ 'look at keyboard for input.
IF KeyPress = "c" THEN '"c" will clear the peak value and the screen.
BufMax = 0
CLS 2
END IF
LOOP WHILE KeyPress <> CHR$(27) 'escape will exit program
CLOSE
SYSTEM

Posted on Feb 12, 2012, 8:25 PM

Respond to this message   

Return to Index


*Sorry, could not get code to format with indents.

by Lou (no login)

Posted on Feb 12, 2012, 8:28 PM

Respond to this message   

Return to Index


* What are the differences between the 2 XP's?

by (Login burger2227)
R

Posted on Feb 12, 2012, 8:39 PM

Respond to this message   

Return to Index


Re: * What are the differences between the 2 XP's?

by Lou (no login)

The slow one is a Compaq desktop with 2.4Ghz Celeron and 760 Mb ram, XP Home. The fast one is a Dell laptop, but with a slightly slower processor, I think, and a little more ram with XP Pro.

The desktop does go online. The laptop never does. Both have ethernet cards, but I never use the one on the laptop. I disconnected the ethernet connection on the desktop and it made no difference.

Neither one had any other devices connected to USB etc.

The Win2K machine is an old Dell laptop, but it's a 233 Mhz, with probably 128 Mb of ram or less.

Posted on Feb 12, 2012, 10:40 PM

Respond to this message   

Return to Index


Check for viruses

by (no login)

Try Malewarebytes free trial. Uncheck the always run with Windows option when it is in the tray. Run it once a month with new updates.

Viruses can really slow things down with XP's NTVDM.

Posted on Feb 14, 2012, 4:01 PM

Respond to this message   

Return to Index


QBasic procedure capacity

by (no login)

Is there a way to increase the capacity of QBasic beyond 64KB?

Posted on Feb 12, 2012, 4:35 PM

Respond to this message   

Return to Index


qb64 it's a better way but...

by OPRESION (no login)

THIS IS ANOTHER POSSIBILITY:
http://www.emsmagic.com/

Posted on Feb 12, 2012, 6:15 PM

Respond to this message   

Return to Index


WHO wants DOS screen modes limitations anyhow?

by (Login burger2227)
R

64 bit running 16 bit? Why did you buy it in the first place?

Posted on Feb 12, 2012, 6:42 PM

Respond to this message   

Return to Index


re: "why did you buy it? ..."

by OPRESION (no login)

I DIDN'T BUY IT BECAUSE IT'S FREE FOR
PERSONAL USE. BUT I HAVE NOT TESTED IT
YET BECAUSE MY PROGRAMS MOSTLY ARE
NOT SO BIG.

Posted on Feb 13, 2012, 7:07 PM

Respond to this message   

Return to Index


*please don't use all capitals.

by (Login MCalkins)
Moderator

Posted on Feb 14, 2012, 7:54 AM

Respond to this message   

Return to Index


Re: QBasic procedure capacity

by (Login MCalkins)
Moderator

As mentioned, the best option is probably to use QB64.

If you mean code capacity, I think QB4.5 will let you exceed 64KB by using multiple modules. But you will still be subject to the ≈1MB real mode limit.

For data: QBASIC 1.1 gives you ≈160KB regular data and ≈32KB variable length string data. You can request more conventional memory from DOS. You can also request a bunch of memory through XMS.

But using QB64 is probably better by far, unless you really need to target DOS.

Regards,
Michael

Posted on Feb 14, 2012, 8:04 AM

Respond to this message   

Return to Index


Matrix Solving program

by (no login)

What is wrong with my code? It's meant to multiply a matrix...

Source code :


'Header
'
SCREEN _NEWIMAGE(1920, 1080, 32)
_FONT _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_FULLSCREEN

'Program
'
INPUT "What are the dimensions of the first matrix"; row1, column1
INPUT "What are the dimensions of the second matrix"; row2, column2
DIM m1(row1, column1)
DIM m2(row2, column2)
FOR x = 1 TO row1
FOR y = 1 TO column1
PRINT "What is the value of "; x; ","; y; " in the first matrix"
INPUT m1(x, y)
NEXT y
NEXT x
FOR x = 1 TO row2
FOR y = 1 TO column2
PRINT "What is the value of "; x; ","; y; " in the second matrix"
INPUT m2(x, y)
NEXT y
NEXT x

DIM answer(row1, column2)
IF column1 = row2 THEN
FOR d = 1 TO column2
FOR x = 1 TO row1
FOR y = 1 TO column1
answer(x, d) = answer(x, d) + (m1(x, y) * m2(y, x))
NEXT y
NEXT x
NEXT d
ELSE
PRINT "Cannot be done!"
END IF

FOR x = 1 TO row2
FOR y = 1 TO column1
PRINT x; ","; y; " :"; answer(x, y)
NEXT y
NEXT x

Posted on Feb 10, 2012, 8:51 PM

Respond to this message   

Return to Index


This is how I have done it

by David (no login)

This is a subroutine that multiplies matrix X and matrix E to give matrix F

FOR I = 1 TO N
FOR J = 1 TO N
F(I, J) = 0!
FOR K = 1 TO N
F(I, J) = F(I, J) + X(I, K) * E(K, J)
NEXT K
NEXT J
NEXT I

Posted on Feb 12, 2012, 8:04 AM

Respond to this message   

Return to Index


Thanks

by (no login)

Why do you need an exclamation mark after the 0 ? i thought qb doesn't do factorial.. or is it a data type?

Posted on Feb 12, 2012, 9:09 AM

Respond to this message   

Return to Index


how can i make an image smoother?

by (no login)

How can i make the image smoother?

Source Code :

'Header
'
SCREEN _NEWIMAGE(1920, 1080, 32)
_FONT _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_FULLSCREEN

'Program
'
r = 0
g = 0
b = 0
radius = 255 * 2
FOR x = 1 TO 255 STEP 1
radius = radius - 2
CIRCLE (960, 540), radius, _RGB(r, g, b)
CIRCLE (961, 540), radius, _RGB(r, g, b)
CIRCLE (960, 541), radius, _RGB(r, g, b)
CIRCLE (960, 539), radius, _RGB(r, g, b)
CIRCLE (959, 540), radius, _RGB(r, g, b)
CIRCLE (961, 541), radius, _RGB(r, g, b)
CIRCLE (959, 539), radius, _RGB(r, g, b)
CIRCLE (959, 541), radius, _RGB(r, g, b)
CIRCLE (961, 539), radius, _RGB(r, g, b)
b = x: g = x: r = x
NEXT x

Posted on Feb 10, 2012, 3:52 PM

Respond to this message   

Return to Index


*What do you mean? That's already very smooth. And what image?

by (Login qb432l)
R

*

Posted on Feb 10, 2012, 6:49 PM

Respond to this message   

Return to Index


I meant the concentric circles

by (no login)

I can see a distinct color difference between each of the circles; how can i eliminate this?

also, i revised the program

Source code:


'Header
'
SCREEN _NEWIMAGE(1920, 1080, 32)
_FONT _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_FULLSCREEN

'Program
'
r = 0
g = 0
b = 0
radius = 255 * 2
FOR x = 1 TO 255 STEP 1
radius = radius - 2
CIRCLE (960, 540), radius, _RGB(r, g, b)
PAINT (960, 540), _RGB(r, g, b), _RGB(r, g, b)
b = x: g = x: r = x
NEXT x

Posted on Feb 10, 2012, 7:20 PM

Respond to this message   

Return to Index


Your sense of color must be more refined than mine...

by (Login qb432l)
R

I see no difference from instance to instance except for brightness. As such, I wouldn't know where to begin solving your problem.

-Bob

Posted on Feb 11, 2012, 3:29 AM

Respond to this message   

Return to Index


Re: Your sense of color must be more refined than mine...

by (no login)

So how can i make the brightness difference between the circles less?

It could just be my monitor otherwise...

Posted on Feb 11, 2012, 7:36 AM

Respond to this message   

Return to Index


*My monitor says "no support" when I run it

by lawgin (no login)

Posted on Feb 11, 2012, 9:16 AM

Respond to this message   

Return to Index


Try this...

by (no login)

Run this one :

'Header
'
SCREEN _NEWIMAGE(_width, _height, 32)
_FONT _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_FULLSCREEN

'Program
'
r = 0
g = 0
b = 0
radius = 255 * 2
FOR x = 1 TO 255 STEP 1
radius = radius - 2
CIRCLE (_width/2, _height/2), radius, _RGB(r, g, b)
PAINT (_width/2, _height/2), _RGB(r, g, b), _RGB(r, g, b)
b = x: g = x: r = x
NEXT x

Posted on Feb 11, 2012, 11:34 AM

Respond to this message   

Return to Index


That worked

by lawgin (no login)

I see a fuzzy lower case e with a nice sharp bar under it.

Posted on Feb 11, 2012, 1:11 PM

Respond to this message   

Return to Index


Wonder what creates the e?

by (Login burger2227)
R

Try this:


SCREEN _NEWIMAGE(_WIDTH, _HEIGHT, 32)
_FONT _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_FULLSCREEN

Make the font 15...

It is not printing anything...now comment out fullscreen...small window

Posted on Feb 11, 2012, 4:01 PM

Respond to this message   

Return to Index


*press any key to continu"e"

by (no login)

Posted on Feb 11, 2012, 5:24 PM

Respond to this message   

Return to Index


Yeah, SLEEP disappears the e

by lawgin (no login)

Posted on Feb 11, 2012, 7:36 PM

Respond to this message   

Return to Index


That's why I said to change the font size.

by (Login burger2227)
R

Then it prints "inue"

The _WIDTH and _HEIGHT won't read the size of the desktop when it starts unless you read the _SCREENIMAGE handle. But apparently they are not returning 0 either as there is no _NEWIMAGE error.

The window is not 0 X 0 so it must be returning the SCREEN size as 80 by 25 pixels?...


x% = _WIDTH
y% = _HEIGHT

SCREEN _NEWIMAGE(x%, y%, 32)
PRINT x%; y%

SLEEP

It isn't printing anything so it must be screen 0 text that is 80 X 25.

Posted on Feb 11, 2012, 8:00 PM

Respond to this message   

Return to Index


Gradate the R,G,B changes independently

by Galleon (no login)

SCREEN _NEWIMAGE(1920, 1080, 32)
_FULLSCREEN

'Program
'
r = 1
g = 1
b = 1
radius = 255 * 2
b = 1: g = 1: r = 1
FOR x = 1 TO 512 STEP 1
radius = radius - 1
CIRCLE (960, 540), radius, _RGB(r, g, b)
CIRCLE (961, 540), radius, _RGB(r, g, b)
CIRCLE (960, 541), radius, _RGB(r, g, b)
CIRCLE (960, 539), radius, _RGB(r, g, b)
CIRCLE (959, 540), radius, _RGB(r, g, b)
CIRCLE (961, 541), radius, _RGB(r, g, b)
CIRCLE (959, 539), radius, _RGB(r, g, b)
CIRCLE (959, 541), radius, _RGB(r, g, b)
CIRCLE (961, 539), radius, _RGB(r, g, b)
IF x MOD 2 THEN g = g + 1 ELSE b = b + 1: r = r + 1
NEXT x

Posted on Feb 11, 2012, 9:51 PM

Respond to this message   

Return to Index


Why isn't this working ?

by (no login)

I tried to do what you said except incrementing all 3 separately :

IF x MOD 3 = 0 THEN
r = x
ELSEIF x MOD 3 = 1 THEN
b = x
ELSE
g = x
END IF

but it doesn't work... the whole screen turns blue or red or green...

Posted on Feb 12, 2012, 7:37 AM

Respond to this message   

Return to Index


Functions

by (no login)

Can a function return an array? if so, what is the correct syntax? (i'm using qb64)

Posted on Feb 7, 2012, 4:04 PM

Respond to this message   

Return to Index


Also...

by (no login)

How can i set two arrays(which are holding images (through GET and PUT)) equal to each other? Set each corresponding term in each array equal to each other doesn't work; the image array contains only 0's..

Posted on Feb 7, 2012, 4:09 PM

Respond to this message   

Return to Index


*I'm using two dimensional arrays by the way

by (no login)

*

Posted on Feb 7, 2012, 4:17 PM

Respond to this message   

Return to Index


I switched back to 1 dimensional arrays and used indices instead

by (no login)


i'm trying to write a matrix program of my own, like the one that was posted here earlier

This is what i have so far...

Source Code :

SCREEN _NEWIMAGE(1920, 1080, 32)
_FONT _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_SCREENMOVE 0, 0
DIM SHARED green(0 TO 25)
DIM SHARED Trail(27592 * 11)
FOR g = 255 TO 5 STEP -10
green(FIX(g / 10)) = g
NEXT g
DIM num(27592 * 11)
DIM SHARED position
position = -1

FOR dd = 1 TO 10
getTrail
' FOR x = 1 TO 27592
' num(x) = Trail(x)
' NEXT x
num(27592 * position) = Trail(27592 * position)
NEXT dd
FOR x = 0 TO 9
RANDOMIZE TIMER
PUT (INT(RND * 1820) + 1, INT(RND * 200) + 1), num(27592 * (x))

NEXT x
END

SUB getTrail
position = position + 1
RANDOMIZE TIMER
CLS
FOR x = 0 TO 25
COLOR _RGB(0, green(x), 0)
PRINT CHR$(INT(RND * 245) + 10)
NEXT x
GET (0, 0)-(50, 540), Trail(27592 * position)
CLS
END SUB

Posted on Feb 7, 2012, 4:43 PM

Respond to this message   

Return to Index


Re: *I'm using two dimensional arrays by the way

by (Login MCalkins)
Moderator

Yeah:

--------------------------------

DIM a(0 TO 3, 0 TO 3) AS LONG
DIM b(0 TO 3, 0 TO 3) AS LONG
DIM x AS LONG
DIM y AS LONG
RANDOMIZE TIMER

'random test data:

FOR x = 0 TO 3
FOR y = 0 TO 3
a(x, y) = INT(RND * 6) + 1
NEXT
NEXT

'copy 2D array:

FOR x = 0 TO 3
FOR y = 0 TO 3
b(x, y) = a(x, y)
NEXT
NEXT

'display:

PRINT "x" + CHR$(&H1A)
PRINT "y" + CHR$(&H18)
PRINT
PRINT "a"
FOR y = 3 TO 0 STEP -1
FOR x = 0 TO 3
PRINT a(x, y);
NEXT
PRINT
NEXT

PRINT
PRINT "b"
FOR y = 3 TO 0 STEP -1
FOR x = 0 TO 3
PRINT b(x, y);
NEXT
PRINT
NEXT

--------------------------------

If you are careful, in QB64, you can also use the C standard library's memcpy function. You have to know the destination and source memory addresses, and the number of bytes to copy.

--------------------------------

DECLARE CUSTOMTYPE LIBRARY
SUB memcpy (BYVAL dest AS _OFFSET, BYVAL src AS _OFFSET, BYVAL count AS _UNSIGNED _INTEGER64)

'memcpy is actually a function, but we don't need the returned value.
'on a 64 bit target, count is an _unsigned _integer64
'on a 32 bit target, count is an _unsigned long.
'there is no harm in using the _integer64 on a 32 bit target, but it would be
'bad to use the long on a 64 bit target.
END DECLARE

DIM a(0 TO 3, 0 TO 3) AS LONG
DIM b(0 TO 3, 0 TO 3) AS LONG
DIM x AS LONG
DIM y AS LONG
RANDOMIZE TIMER

'random test data:

FOR x = 0 TO 3
FOR y = 0 TO 3
a(x, y) = INT(RND * 6) + 1
NEXT
NEXT

'copy it:

memcpy _OFFSET(b(0, 0)), _OFFSET(a(0, 0)), LEN(b())

' _OFFSET(b(0, 0)) is the destination memory address
' _OFFSET(a(0, 0)) is the source memory address
' notice that it is necessary to specifiy the subsripts with _OFFSET().

' LEN(b()) is the size of the destination array (64 in this case)

PRINT "x" + CHR$(&H1A)
PRINT "y" + CHR$(&H18)
PRINT
PRINT "a"
FOR y = 3 TO 0 STEP -1
FOR x = 0 TO 3
PRINT a(x, y);
NEXT
PRINT
NEXT

PRINT
PRINT "b"
FOR y = 3 TO 0 STEP -1
FOR x = 0 TO 3
PRINT b(x, y);
NEXT
PRINT
NEXT
END

--------------------------------

Notice that you have to use _OFFSET(b(0,0)).
_OFFSET(b) or _OFFSET(b()) would be wrong.

LEN(b()) is the size of the destination array in bytes. In this case, the source and destination arrays are each 64 bytes. (LONGs are 4 bytes each, and there are 4 * 4 of them.)

You could copy portions of arrays like this, but be careful. Make sure that you don't overwrite anything outside of the area occupied by the destination array. For example, you could change LEN(b()) to 60, and copy everything except element (3,3), but changing it to 68 would overwrite memory that doesn't belong to b.

If you were to copy only 56 bytes, you might expect to be omitting (3,3) and (3,2), but you're actually omitting (3,3) and (2,3). This is because QBASIC and QB64 store arrays in "column major" order.

http://en.wikipedia.org/wiki/Row-major_order#Column-major_order

If you want to copy memory where the destination area overlaps the source area, use memmove instead of memcpy. memmove automatically detects whether the source address is before or after the destination address, so it knows whether to work forward or backward. (Otherwise, you might be overwriting part of the source before you've copied it.)

Regards,
Michael

P.S. I don't have much experience with QB64's new graphics capabilities, so someone else might be able to better help you on the GET/PUT stuff.

Posted on Feb 7, 2012, 10:50 PM

Respond to this message   

Return to Index


Re: Functions

by (Login MCalkins)
Moderator

I don't think so, at least not directly.

However, since QBASIC passes "by reference" instead of "by value", you can pass an array as a parameter to the SUB/FUNCTION, and the SUB/FUNCTION can modify it.

----------

DIM a(0 TO 3) AS LONG '<--- not SHARED
DIM i AS LONG

a(0) = 1
a(1) = 3
a(2) = 5
a(3) = 7

doublethem a()

FOR i = 0 TO 3
PRINT a(i)
NEXT
END

SUB doublethem (n() AS LONG)
DIM i AS LONG
FOR i = 0 TO UBOUND(n)
n(i) = n(i) * 2
NEXT
END SUB

----------

Note that a() is not SHARED. It is passed "by reference" as a parameter. Note that the array bounds are not specified in n() AS LONG, but the sub can find the UBOUND whichever 1 dimensional array it is passed.

Here is a 2D array example:

----------

DIM a(0 TO 1, 0 TO 1) AS LONG '<--- not SHARED
DIM i AS LONG

a(0, 0) = 0
a(0, 1) = 1
a(1, 0) = 2
a(1, 1) = 3

doublethem a()

PRINT a(0, 0)
PRINT a(0, 1)
PRINT a(1, 0)
PRINT a(1, 1)
END

SUB doublethem (n() AS LONG)
DIM x AS LONG
DIM y AS LONG
FOR x = 0 TO UBOUND(n, 1)
FOR y = 0 TO UBOUND(n, 2)
n(x, y) = n(x, y) * 2
NEXT
NEXT
END SUB


----------

Of course, you could just make the array SHARED, and not need to pass it at all...

Regards,
Michael

Posted on Feb 7, 2012, 9:51 PM

Respond to this message   

Return to Index


Re: Functions

by (no login)

So how would i set two arrays equal to each other? I tried setting each term equal to its counterpart in the other array but it didn't work...
I also tried : example1() = example2()
but that didn't work either. However, when i did the for loop then the 'example1() = example2()', it worked. After i started using indices, it stopped working again.

This is the source code :

SCREEN _NEWIMAGE(1920, 1080, 32)
_FONT _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_SCREENMOVE 0, 0
DIM SHARED green(0 TO 25)
DIM SHARED Trail(27592 * 11)
FOR g = 255 TO 5 STEP -10
green(FIX(g / 10)) = g
NEXT g
DIM num(27592 * 11)
DIM SHARED position
position = -1

FOR dd = 1 TO 10
getTrail
' FOR x = 1 TO 27592
' num(x) = Trail(x)
' NEXT x
num(27592 * position) = Trail(27592 * position)
NEXT dd
FOR x = 0 TO 9
RANDOMIZE TIMER
PUT (INT(RND * 1820) + 1, INT(RND * 200) + 1), num(27592 * (x))

NEXT x
END

SUB getTrail
position = position + 1
RANDOMIZE TIMER
CLS
FOR x = 0 TO 25
COLOR _RGB(0, green(x), 0)
PRINT CHR$(INT(RND * 245) + 10)
NEXT x
GET (0, 0)-(50, 540), Trail(27592 * position)
CLS
END SUB

Posted on Feb 8, 2012, 1:51 PM

Respond to this message   

Return to Index


You can have the array inside of the function too!

by (Login burger2227)
R

The following function uses the key code as a parameter to read the contents of an array inside of it. Each reference also sets values in the array.

A simple ping pong game using an array function to read multiple keys for two players.

DEFINT A-Z
SCREEN 12
DIM ball%(100) ' Set aside enough space to hold the ball sprite
CIRCLE (4, 3), 4, 4
PAINT (4, 3), 12, 4 ' Draw a filled circle and fill for ball
GET (0, 0)-(8, 7), ball%(0) ' Get the sprite into the Ball% array

begin:
xmin = 10: ymin = 10
xmax = 630: ymax = 470
x = 25: y = 25
dx = 1: dy = 1
LTpos = 50: RTpos = 50

DO: _LIMIT 100 'adjust higher for faster
CLS
IF ScanKey%(17) THEN LTpos = LTpos - 1
IF ScanKey%(31) THEN LTpos = LTpos + 1
IF ScanKey%(72) THEN RTpos = RTpos - 1
IF ScanKey%(80) THEN RTpos = RTpos + 1

PRINT "Player 1 : "; ponescore; " Player 2 : "; ptwoscore

IF x > xmax - 15 AND y >= RTpos AND y dx = -1
ELSEIF x > xmax THEN
ponescore = ponescore + 1
GOSUB begin
END IF

IF x = LTpos AND y dx = 1
ELSEIF x ptwoscore = ptwoscore + 1
GOSUB begin
END IF

IF y > ymax - 5 THEN dy = -1
IF y ' Display the sprite elsewhere on the screen

x = x + dx
y = y + dy

PUT(x, y), ball%(0)


LINE (20, LTpos)-(20, LTpos + 100)
LINE (620, RTpos)-(620, RTpos + 100)

_DISPLAY 'shows completed screen every call

LOOP UNTIL ScanKey%(1)
END


FUNCTION ScanKey% (scancode%)
STATIC Ready%, keyflags%()
IF NOT Ready% THEN REDIM keyflags%(0 TO 127): Ready% = -1
i% = INP(&H60) 'read keyboard states
IF (i% AND 128) THEN keyflags%(i% XOR 128) = 0
IF (i% AND 128) = 0 THEN keyflags%(i%) = -1
K$ = INKEY$
ScanKey% = keyflags%(scancode%)
END FUNCTION

The STATIC Ready% variable will be 0 when the function is first called to create the array initially.

Posted on Feb 7, 2012, 10:35 PM

Respond to this message   

Return to Index


Re: You can have the array inside of the function too!

by (no login)

But this seems to return only one value. What do i do to return the entire array? Also, the array is an image array.

Posted on Feb 8, 2012, 1:45 PM

Respond to this message   

Return to Index


Update

by (no login)

I got it to work...sort of. Still don't understand why i need the for loop and the 'example1 () = example2()' statement...

It also looks very grainy...

This is the code :

SCREEN _NEWIMAGE(1920, 1080, 32)
_FONT _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_SCREENMOVE 0, 0
DIM SHARED green(0 TO 25)
DIM SHARED Trail(27592 * 11)
FOR g = 255 TO 5 STEP -10
green(FIX(g / 10)) = g
NEXT g
DIM num(27592 * 11)
DIM SHARED position
position = -1

FOR dd = 0 TO 9
getTrail
FOR x = 1 TO 27592
num(x * dd) = Trail(x * dd)
NEXT x
num(27592 * position) = Trail(27592 * position)
NEXT dd
FOR x = 0 TO 9
RANDOMIZE TIMER
PUT (INT(RND * 1820) + 1, INT(RND * 200) + 1), num(27592 * (x))

NEXT x
END

SUB getTrail
position = position + 1
RANDOMIZE TIMER
CLS
FOR x = 0 TO 25
COLOR _RGB(0, green(x), 0)
PRINT CHR$(INT(RND * 245) + 10)
NEXT x
GET (0, 0)-(50, 540), Trail(27592 * position)
CLS
END SUB

Posted on Feb 8, 2012, 1:54 PM

Respond to this message   

Return to Index


Got it!

by (no login)

Source code :

SCREEN _NEWIMAGE(1920, 1080, 32)
_FONT _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_SCREENMOVE 0, 0
DIM SHARED green(0 TO 25)
DIM SHARED Trail(27700 * 51)
DIM SHARED x(50)
DIM SHARED y(50)
FOR g = 255 TO 5 STEP -10
green(FIX(g / 10)) = g
NEXT g
DIM SHARED position
position = -1

FOR dd = 1 TO 50
getTrail
NEXT dd

FOR fx = 1 TO 50
RANDOMIZE TIMER
x(fx) = INT(RND * 1820) + 1
y(fx) = INT(RND * 200) + 1
NEXT fx

FOR fx = 0 TO 49
PUT (x(fx + 1), y(fx + 1)), Trail(27700 * (fx))
NEXT fx

END

SUB getTrail
position = position + 1
RANDOMIZE TIMER
CLS
FOR fx = 0 TO 25
COLOR _RGB(0, green(fx), 0)
PRINT CHR$(INT(RND * 245) + 10)
NEXT fx
GET (0, 0)-(50, 540), Trail(27700 * position)
CLS
END SUB

Posted on Feb 8, 2012, 2:39 PM

Respond to this message   

Return to Index


How can i make the text scroll?

by (no login)

How can i make the text in this program scroll off the bottom of the screen and restart at the top?

Source code:
SCREEN _NEWIMAGE(1920, 1080, 32)
_FONT _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_SCREENMOVE 0, 0
DIM SHARED green(0 TO 25)
DIM SHARED Trail(27700 * 51)
DIM SHARED x(50)
DIM SHARED y(50)
FOR g = 255 TO 5 STEP -10
green(FIX(g / 10)) = g
NEXT g
DIM SHARED position
position = -1

FOR dd = 1 TO 50
getTrail
NEXT dd

FOR fx = 1 TO 50
RANDOMIZE TIMER
x(fx) = INT(RND * 1820) + 1
y(fx) = INT(RND * 200) + 1
NEXT fx
DO
FOR fx = 0 TO 49
IF y(fx) >= 500 THEN y(fx) = 100
PUT (x(fx + 1), y(fx + 1)), Trail(27700 * (fx))
y(fx) = y(fx) + INT(RND * 10) + 1
NEXT fx
_DISPLAY
CLS
LOOP
END

SUB getTrail
position = position + 1
RANDOMIZE TIMER
CLS
FOR fx = 0 TO 25
COLOR _RGB(0, green(fx), 0)
PRINT CHR$(INT(RND * 245) + 10)
NEXT fx
GET (0, 0)-(50, 540), Trail(27700 * position)
CLS
END SUB

Posted on Feb 8, 2012, 2:55 PM

Respond to this message   

Return to Index


Illegal function call

by (no login)

What is wrong with the following code?

Code :

SCREEN _NEWIMAGE(1920, 1080, 32)
_FONT _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_SCREENMOVE 0, 0
DIM SHARED green(0 TO 25)
DIM SHARED Trail(27700 * 51)
DIM SHARED x(50)
DIM SHARED y(50)
FOR g = 255 TO 5 STEP -10
green(FIX(g / 10)) = g
NEXT g
DIM SHARED position
position = -1

FOR dd = 1 TO 50
getTrail
NEXT dd

FOR fx = 1 TO 50
RANDOMIZE TIMER
x(fx) = INT(RND * 1820) + 1
y(fx) = INT(RND * 200) + 1
NEXT fx

posit = 0
FOR dd = 1 TO 50
posit = posit + 1
FOR fx = 0 TO 24
IF y(fx) >= 500 THEN y(fx) = 100
PUT (x(fx + 1), y(fx + 1)), Trail(posit * 27700 * (fx) / 25)
y(fx) = y(fx) + INT(RND * 10) + 1
NEXT fx
_DISPLAY
CLS
NEXT dd
END

SUB getTrail
position = position + 1
RANDOMIZE TIMER
CLS
FOR fx = 0 TO 25
COLOR _RGB(0, green(fx), 0)
PRINT CHR$(INT(RND * 245) + 10)
NEXT fx
FOR dx = 1 TO (25)
GET (0, (540 / 25) * (dx - 1))-(50, (540 / 25) * dx), Trail((postion + 1) * (27700 / 25) * (dx - 1))
NEXT dx
CLS
END SUB

Posted on Feb 8, 2012, 3:19 PM

Respond to this message   

Return to Index


PUT images must be on the screen!

by (Login burger2227)
R

Somewhere the coordinates go off the screen or the image parts do. In QB64 you can add _CLIP to allow that, but then the graphics will fail.

Try:

PUT (x(fx + 1), y(fx + 1)), Trail(posit 27700 (fx) / 25), _CLIP

Posted on Feb 8, 2012, 3:49 PM

Respond to this message   

Return to Index


Re: PUT images must be on the screen!

by (no login)

mine showed only dots with _CLIP...

i'll go back to the other version(with the lines of characters). How can i make it scroll off the bottom and continue from the top?

Posted on Feb 8, 2012, 3:59 PM

Respond to this message   

Return to Index


* You can try VIEW PRINT

by (Login burger2227)
R

Posted on Feb 8, 2012, 5:19 PM

Respond to this message   

Return to Index


*Same result

by (no login)

*

Posted on Feb 8, 2012, 6:34 PM

Respond to this message   

Return to Index


Very confused about how to use QB64.

by Solitaire (Login Solitaire1)
S

I have a program that I wrote in QB 4.5 and saved it as an EXE file.  It's a demo program that shows comparable code written in machine language, assembly language, and BASIC.  I used that file to run in my classroom under Windows XP, and it worked just fine.  Now the school upgraded to Windows 7 and my program will no longer run.

I figured I would import the program to QB64 and create a new EXE file that I could use to run at school.  However, I ran into a lot of problems.

First, I downloaded QB64 for Win and saved the zipped file.  Extracted the zipped files.  Located QB64.EXE and tried to run it.  It took several minutes to list a lot of files before the IDE started up.  There was no option to set the data path so I had to navigate to my file.  Opened the file, and it automatically saved it as an EXE (but I don't know where to).   Unable to create a shortcut for QB64 to the desktop. 

I went back to QB64.EXE and clicked again.  It asked me to unzip the file all over again.  It listed all those other files before opening the IDE.  I opened my file and saved it under a new name, then saved it again as an EXE.  Closed QB64 and went in search of the newly named EXE file but it wasn't in my data folder.  Did a search and it was found inside the zipped file. 

That doesn't make any sense to me.  I want a copy of QB64 that will run same as the original QB.  I want to be able to make a shortcut of QB64 to my desktop, so when I click on it, it will run.  The shortcut can also include the data path but I would prefer to set it inside the IDE.  Most of all, I need to extract the exe file of my own program so that I can copy it to my flash disk and bring it to school.  I need to be able to run that exe file on my school computer under Windows 7.

Answers?

Posted on Feb 7, 2012, 11:27 AM

Respond to this message   

Return to Index


Re: Very confused about how to use QB64.

by (Login MCalkins)
Moderator

You say you unzipped it, but it sounds like you are running qb64.exe directly inside the .ZIP file. Make sure that you've actually extracted the contents of qb64v0942-win.zip to a specific folder, perhaps "c:\qb64". (The rest of this post will assume that you choose "c:\qb64".)

Once you've done that, you should be able to make a shortcut to "c:\qb64\qb64.exe".

I don't think QB64 let's you choose a default folder. I think it always defaults to the folder that qb64.exe is located in. It puts the executables in that folder also.

Be advised that the executables generated by QB64 require some or all of the .DLL files in the "c:\qb64" folder. You can copy them to the "c:\Windows\System32" folder, but I would recommend against that. So, if you copy your .EXE file anywhere, you will need to copy the .DLL files also.

The easiest thing is just to have your qb64 .BAS files (or, at least copies) in the c:\qb64 folder.

You should be able to drag and drop .BAS files onto the desktop shortcut, and QB64 will open them, no matter what folder they are in. However, the compiled .EXE files will always go in "c:\qb64".

You could make a .BAT file to automatically compile the .BAS file (using qb64.exe's "-c" switch), then copy/move the executable to the folder that you want. Remember that the destination folder will also need to have copies of the .DLL files.

-----

On my own computer, I have QBASIC 1.1 in "c:\q". I have QB64 in "c:\q\qb64". Also, I have QB4.5 and FreeBASIC in 2 other subfolders of "c:\q", although I almost never use them.

I almost always invoke QBASIC and QB64 from the command line (cmd.exe). I don't have short cuts to them, but I do have a short cut to cmd.exe on my quick launch toolbar.

I keep most of my QBASIC 1.1 programs in "c:\q" and my QB64 programs in "c:\q\qb64".

-----

If you haven't already, you might check out QB64's forums:

http://www.qb64.net/forum/

They are significantly more active than these forums. A number of our regulars are also there.

Please remember that QB64 is a work in progress. Galleon just made some improvements to the IDE, although he hasn't released a new .ZIP file for that yet. He is currently working on numerous bug fixes. Later this year, he will be making QB64 more modular.

Regards,
Michael

Posted on Feb 7, 2012, 9:26 PM

Respond to this message   

Return to Index


Re: Very confused about how to use QB64.

by Pete (no login)

MC appears to have nailed it. That folder did not unzip. Win 7 should be able to unzip it, but you could download 7-zip, which is a good open source alternative, or buy Win-zip, which I also use.

Anyway, once it is unzipped, just permanently delete the zip folder, move the unzipped qb64 folder anywhere you like, open the QB64 folder, right click the qb64.exe file, and make your desktop shortcut. Click the shortcut icon and you're good to go, just like Michael posted.

Note: As MC stated, exe files are created in the QB64 folder, not the DATA folder. In fact, if you have a data folder, you probably have an older copy of QB64. I recommend yo visit the qb64.net website and download the latest .95 Windows version.

Pete

Posted on Feb 8, 2012, 1:48 AM

Respond to this message   

Return to Index


* I don't think that Windows 7 has a ZIP utility. Use 7 ZIP!

by (Login burger2227)
R

Posted on Feb 8, 2012, 10:19 AM

Respond to this message   

Return to Index


I keep the .Zip file...

by (Login MCalkins)
Moderator

so that I can reinstall it, or install it on other computers.

However, when she ran QB64 inside the .Zip file, it might have changed it.

Windows XP and later can extract .Zip files without any extra software.

Regards,
Michael

Posted on Feb 8, 2012, 12:40 PM

Respond to this message   

Return to Index


Doesn't look viable.

by Solitaire (no login)

I use Windows XP on my home computer. I originally unzipped the downloaded file and ran it, but haven't tried anything else since then. The need to install a bunch of dll support files is a downer.

I have no permission (administrative privilege) to install software on my school computer, which is running Windows 7. So installing QB64 in order to run my software on it is out. What I need is a single exe file that I can place in a folder on my school computer, and that can run with a click, same as the old QB exe file I've been using for years on Windows XP before the school upgraded to new computers. Is that possible?

Or (assuming I am able to isolate QB64 from the zipped file) can QB64 be placed in a folder along with supporting files, and run from there without affecting the registry?

Otherwise, it looks like I will have to redo my program using VB 2010, but it will be like starting from scratch and significantly different.

Posted on Feb 9, 2012, 11:24 AM

Respond to this message   

Return to Index


There is no QB64 installation required

by (Login burger2227)
R

Just unzip it somewhere and the sub-folders, QB64.EXE and DLL files will all be in the QB64 folder.

Then compile the program and run it from there just like you did in Qbasic.

If you want to run the EXE program from a different folder, put the DLL files in that place next to the EXE.

Posted on Feb 9, 2012, 1:42 PM

Respond to this message   

Return to Index


Re: Doesn't look viable.

by (Login MCalkins)
Moderator

QB64 itself does not put anything in the registry.

qb64.exe itself, in IDE mode, seems to require being Admin. However, it can compile programs from the command line, for example: "qb64.exe -c guestt.bas", without being Admin.

The programs compiled by QB64 don't generally require being Admin. (That is, unless they themselves try to do something that requires it.)

You should be able to use qb64.exe on your home computer to compile your program. Then copy the resulting .EXE, as well as all .DLL files in the QB64 folder (there are 16 of them) to some folder on the Win 7 computer. Your program should run without Admin privilege.

I don't know if all 16 .DLLs are necessary. The easiest thing to do would be to copy all of them. Otherwise, you could copy your .EXE file to a new folder, and repeatedly try to run it, copying the specific .DLL file to its folder for each error message, and rerunning it. When it runs with no error message, you have all the needed .DLLs.

When I tried that with one of my programs just now, these were the ones needed:

libfreetype-6.dll
libgcc_s_sjlj-1.dll
libstdc++-6.dll
SDL.dll
SDL_image.dll
SDL_mixer.dll
SDL_net.dll
SDL_ttf.dll

Regards,
Michael

Posted on Feb 9, 2012, 5:17 PM

Respond to this message   

Return to Index


* Thanks. I'll give it a shot when I have time.

by Solitaire (no login)

Posted on Feb 9, 2012, 8:12 PM

Respond to this message   

Return to Index


Matrix green screen simulator

by Dave (no login)

DECLARE SUB findcol ()
DIM SHARED a AS INTEGER, t AS SINGLE, x AS INTEGER, y AS INTEGER, temp2 AS INTEGER
DIM SHARED temp AS INTEGER, noo AS INTEGER, xx AS INTEGER, yy AS INTEGER, findc AS INTEGER
SCREEN 12
PALETTE 1, 2 * 256
PALETTE 2, 3 * 256
PALETTE 3, 4 * 256
PALETTE 4, 6 * 256
PALETTE 5, 8 * 256
PALETTE 6, 10 * 256
PALETTE 7, 13 * 256
PALETTE 8, 16 * 256
PALETTE 9, 20 * 256
PALETTE 10, 25 * 256
PALETTE 11, 30 * 256
PALETTE 12, 36 * 256
PALETTE 13, 44 * 256
PALETTE 14, 55 * 256
PALETTE 15, 63 * 256
FOR a = 1 TO 15
COLOR a
PRINT a
NEXT
CLS
RANDOMIZE TIMER
DO
t = TIMER
WHILE t > TIMER - .05
if inkey$ = chr$(27) then end
WEND
FOR y = 1 TO 25
FOR x = 1 TO 80
IF SCREEN(y, x) <> 32 THEN
'PRINT SCREEN(y, x)
findcol
temp = findc
temp = temp - 1
COLOR temp
IF y > 1 THEN LOCATE y - 1, x: PRINT CHR$(SCREEN(y, x))
temp2 = INT(RND * 222) + 33
COLOR (temp + 1)
LOCATE y, x: PRINT CHR$(temp2)
END IF
NEXT
NEXT
noo = INT(RND * 1) + 1
IF noo = 1 THEN
a = INT(RND * 222) + 33
x = INT(RND * 80) + 1
y = INT(RND * 25) + 1
LOCATE y, x: COLOR 15: PRINT CHR$(a)
END IF
LOOP

SUB findcol
FOR xx = x * 8 - 8 TO x * 8
FOR yy = y * 16 - 16 TO y * 16
IF POINT(xx, yy) <> 0 THEN temp = POINT(xx, yy): GOTO findcolend
NEXT
NEXT
findcolend:
findc = temp
END SUB

Posted on Feb 6, 2012, 9:33 PM

Respond to this message   

Return to Index


* cool.

by (Login MCalkins)
Moderator

Posted on Feb 6, 2012, 11:08 PM

Respond to this message   

Return to Index


What is wrong with this SUB?

by (no login)

i made a sub which is supposed to print dots after text. first it prints 1, then 2, then 3, then erases them and starts again (for a loading screen)

so if you didn't clear the screen, it would do this

Step 1 : text
Step 2 : text.
Step 3 : text..
Step 4 : text...
Step 5 : text
Step 6 : text.
Step 7 : text..
Step 8 : text...

etc.

However, mine stops at step 4


This is the source code :

SUB adddots (temp$, numofdots)
PRINT
FOR y = 1 TO 10
FOR x = 0 TO numofdots
LOCATE CSRLIN - 1, POS(0)'go back a line and write new text
PRINT SPACE$(LEN(temp$))
LOCATE CSRLIN - 1, POS(0)'csrlin gives current row, pos gives column(overwrite previous text with spaces)
PRINT temp$; STRING$(x, ".")
_DELAY .1
NEXT x
NEXT y
END SUB

Posted on Feb 4, 2012, 3:34 PM

Respond to this message   

Return to Index


Re: What is wrong with this SUB?

by lawgin (no login)

Insert PRINT just before _DELAY .1

Posted on Feb 4, 2012, 4:18 PM

Respond to this message   

Return to Index


Re: What is wrong with this SUB?

by (no login)

the example was supposed to be showing one line...sorry... that wasn't very clear. so the whole program should be overwriting the same line...

Posted on Feb 4, 2012, 5:13 PM

Respond to this message   

Return to Index


OK, try this

by lawgin (no login)

You're not erasing your dots.

PRINT SPACE$(LEN(temp$) + 3)

Posted on Feb 4, 2012, 5:41 PM

Respond to this message   

Return to Index


Re: OK, try this

by (no login)

Thanks, it worked.

Posted on Feb 4, 2012, 8:11 PM

Respond to this message   

Return to Index


I'd do it this way

by Galleon (no login)

temp$ = "Loading nothing"
numofdots = 3

cx = POS(0)
cy = CSRLIN
FOR y = 1 TO 10
FOR x = 0 TO numofdots
LOCATE cy, cx
PRINT temp$ + STRING$(x, ".") + SPACE$(numofdots - x);
_DELAY .25
NEXT x
NEXT y

Posted on Feb 4, 2012, 8:20 PM

Respond to this message   

Return to Index


*Yeah, that's more efficient

by (no login)

Posted on Feb 5, 2012, 8:16 AM

Respond to this message   

Return to Index


this type of thing is usually done in the middle of some process

by (no login)

like you're loading something doing something,let user know it's not frozen, i'd put it in the middle of a main loop drawing one dot per loop cycle.

temp$ = "Loading something"
numofdots = 3

DO

'main process, could be any loop


i = i + 1
LOCATE 1, 1
j = i MOD (numofdots + 1)
PRINT temp$ + STRING$(j, ".") + SPACE$(numofdots - j);
_DELAY .25
LOOP

Posted on Feb 5, 2012, 12:20 PM

Respond to this message   

Return to Index


* WHY are you using MOD 0 + 1??? :-P

by (Login burger2227)
R

Posted on Feb 5, 2012, 12:55 PM

Respond to this message   

Return to Index


I guess MOD's never good

by (no login)

here's an alternative:

temp$ = "Loading something"
numofdots = 3


DO

'main process, could be any loop


i = -(i + 1) * (i <> numofdots)
LOCATE 1, 1
PRINT temp$ + STRING$(i, ".") + SPACE$(numofdots - i);
_DELAY .25
LOOP

Posted on Feb 5, 2012, 11:11 PM

Respond to this message   

Return to Index


The MOD wouldn't have been a problem unless i overflowed.

by (Login MCalkins)
Moderator

Please stop naming your variables like that. Solitaire would probably have deleted your whole post.

Regards,
Michael

DEFINT A-Z ' <-- replace with appropriate DIMs
DIM temp AS STRING

temp = "Loading nothing"
numdots = 3

cx = POS(0)
cy = CSRLIN
x = 0
DO
 LOCATE cy, cx
 IF x > numdots THEN
  PRINT temp$ + SPACE$(numdots);
  x = 1
 ELSE
  PRINT temp$ + STRING$(x, ".");
  x = x + 1
 END IF
 _DELAY .25 ' <-- remove from actual program
LOOP

Posted on Feb 6, 2012, 12:41 AM

Respond to this message   

Return to Index


Re: this type of thing is usually done in the middle of some process

by (no login)

So is there any way i can make it a sub/function without it stopping the rest of the program? I don't want to put it in the main loop...

Posted on Feb 6, 2012, 2:45 PM

Respond to this message   

Return to Index


Re: this type of thing is usually done in the middle of some process

by (Login MCalkins)
Moderator

DO
'do whatever else needs to be done

adddots "please wait", 3
_DELAY .25 ' <-- remove
LOOP UNTIL LEN(INKEY$)
END

SUB adddots (temp AS STRING, numofdots AS INTEGER)
STATIC x AS INTEGER

IF numofdots = 0 THEN
x = 0
EXIT SUB
END IF

LOCATE , 1
IF x > numofdots THEN
PRINT temp + SPACE$(numofdots);
x = 1
ELSE
PRINT temp + STRING$(x, ".");
x = x + 1
END IF
END SUB

--------------------------------

STATIC x AS INTEGER means that x is local to the function, but retains its value between calls.

You can call adddot with numofdots=0 between loops to reset x to 0.

Or, you can rename x to adddots_x, move it to a DIM SHARED in the main program (instead of a STATIC in adddots), and reset it directly between loops. I'd prefer this latter option, as it is more efficient, but the former is more self contained...

Regards,
Michael

Posted on Feb 6, 2012, 11:08 PM

Respond to this message   

Return to Index


Yes! In QB64 using ON TIMER will work, here's an example...

by Galleon (no login)

DIM SHARED DisplayDots_Dots, DisplayDots_CX, DisplayDots_CY, DisplayDots_Text AS STRING, DisplayDots_X
t = _FREETIMER
ON TIMER(t, 0.25) DisplayDots

DisplayDots_Text = "Waiting"
DisplayDots_CX = POS(0)
DisplayDots_CY = CSRLIN
DisplayDots_Dots = 3
TIMER(t) ON
DO
'do stuff here
_LIMIT 30
LOOP UNTIL INKEY$ <> ""
TIMER(t) OFF

SUB DisplayDots
LOCATE DisplayDots_CY, DisplayDots_CX
PRINT DisplayDots_Text + STRING$(DisplayDots_X, ".") + SPACE$(DisplayDots_Dots - DisplayDots_X);
DisplayDots_X = DisplayDots_X + 1: IF DisplayDots_X > DisplayDots_Dots THEN DisplayDots_X = 0
END SUB

Posted on Feb 7, 2012, 11:27 AM

Respond to this message   

Return to Index


*Oh Okay, thanks

by (no login)

Posted on Feb 7, 2012, 4:06 PM

Respond to this message   

Return to Index


QB64 Forum is down

by Pete (no login)

I'm not sure if it is a tempory problem or not. There have been post time outs for a few days, but now the entire forum just went down. Hopefully it will be back soon. Feel free to post here in the meantime.

Pete

Posted on Feb 3, 2012, 8:16 PM

Respond to this message   

Return to Index


More info...

by Pete (no login)

This message now appears:

Okay faithful users...we're attempting to restore an older backup of the database...news will be posted once we're back!

Posted on Feb 3, 2012, 8:18 PM

Respond to this message   

Return to Index


And it's back

by Pete (no login)

Has a different look though. I'm not sure if they are "upgrading" or trying to avoid some kind of a server meltdown.

Pete

Posted on Feb 3, 2012, 10:12 PM

Respond to this message   

Return to Index


*Forum upgrade (major version change from SMF 1.x to SMF 2.x)

by Galleon (no login)

Posted on Feb 3, 2012, 11:07 PM

Respond to this message   

Return to Index


*Oh, and I always backup so meltdowns don't really worry me

by Galleon (no login)

Posted on Feb 3, 2012, 11:07 PM

Respond to this message   

Return to Index


* looks pretty good

by Ben (no login)

Posted on Feb 4, 2012, 5:09 PM

Respond to this message   

Return to Index


*That message is a some default, it was misleading

by Galleon (no login)

Posted on Feb 3, 2012, 11:16 PM

Respond to this message   

Return to Index


Physics simulation

by (no login)

I've made a program which simulates a ball falling due to gravity. 450 pixels = 10000 meters. It falls realistically...but i don't know how to simulate the physics for it bouncing up...
how would i account for elasticity? and how would i know how much force it comes back up with?

This is my source code so far :

SCREEN _NEWIMAGE(1600, 900, 32)
f& = _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_FULLSCREEN
_FONT f&
x = 800
y = 450

t = 0

DIM ball(441)
CIRCLE (10, 10), 10, _RGB(157, 56, 89)
PAINT (10, 10), _RGB(157, 56, 89), _RGB(157, 56, 89)
GET (0, 0)-(20, 20), ball()
CLS

DO
_LIMIT 60
t = t + (1 / 60)
CLS
PUT (x, y), ball()
y = y + ((9.8 * 450 / 10000) * (t ^ 2))
IF y > 790 THEN END

_DISPLAY
LOOP

Posted on Feb 2, 2012, 3:27 PM

Respond to this message   

Return to Index


Re: Physics simulation

by lawgin (no login)

I would just calculate the velocity of the ball for each time increment. In a perfectly elastic collision, the ball would bounce back at the same velocity that it struck the ground. Realistically the velocity would decrease somewhat. Then on the way up, you just need to change plus signs to minus:

v = v-9.8*t
y = v*t-etc.

SCREEN _NEWIMAGE(1600, 900, 32)
f& = _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_FULLSCREEN
_FONT f&
x = 800
y = 450

t = 0

DIM ball(441)
CIRCLE (10, 10), 10, _RGB(157, 56, 89)
PAINT (10, 10), _RGB(157, 56, 89), _RGB(157, 56, 89)
GET (0, 0)-(20, 20), ball()
CLS

DO
_LIMIT 60
t = t + (1 / 120)
v = v + 9.8 * t
CLS
PUT (x, y), ball()
y = v * t + ((9.8 * 450 / 10000) * (t ^ 2))
IF y > 790 THEN END

_DISPLAY
LOOP

Posted on Feb 2, 2012, 5:29 PM

Respond to this message   

Return to Index


I did that and it works but...

by (no login)

something is wrong with it...it looks like its bumping into an invisible wall...its very jerky and abrupt and it speeds up over time...

This is what i've done so far...
Code :

SCREEN _NEWIMAGE(1600, 900, 32)
f& = _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_FULLSCREEN
_FONT f&
x = 800
y = 450

t = 0

DIM ball(441)
CIRCLE (10, 10), 10, _RGB(157, 56, 89)
PAINT (10, 10), _RGB(157, 56, 89), _RGB(157, 56, 89)
GET (0, 0)-(20, 20), ball()
CLS
dist = 450
bounceback = 1
DO
_LIMIT 60
CLS
PUT (x, y), ball()
LINE (0, dist)-(1600, dist)
IF o = 0 THEN t = t + (1 / 60) ELSE t = t - (1 / 60)
y = y + (((9.8 * 450 / 10000) * (t ^ 2)) * bounceback)
IF y > 870 THEN
bounceback = -1
dist = dist * 1.05
o = 1
END IF
IF y < dist THEN
bounceback = 1
o = 0
END IF
ON ERROR GOTO errorhandle
_DISPLAY
LOOP

errorhandle:
END

Posted on Feb 2, 2012, 6:35 PM

Respond to this message   

Return to Index


Looks smooth

by lawgin (no login)

I don't see any jerkiness or speeding up at all on my monitor.

Posted on Feb 3, 2012, 9:37 AM

Respond to this message   

Return to Index


Re: Physics simulation

by (no login)

i remember writing one or something its accelreation so it's like quadrtatic and it ends up bouncing in a bow shape depending on this and that if thats what your lookin for

Posted on Feb 3, 2012, 12:24 AM

Respond to this message   

Return to Index


*Thats what i was hoping to get at sooner or later

by (no login)

Posted on Feb 3, 2012, 1:47 PM

Respond to this message   

Return to Index


What's going on?

by (no login)

Why is the ball stopping randomly and then continuing? I have no idea whats going on...

Source Code :


SCREEN _NEWIMAGE(1600, 900, 32)
f& = _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_FULLSCREEN
_FONT f&
CONST Gravity = 9.8
DIM SHARED v
DIM SHARED u
DIM SHARED t
DIM SHARED s

s = 450
DIM SHARED ball(441)
CIRCLE (10, 10), 10, _RGB(255, 196, 129)
PAINT (10, 10), _RGB(255, 196, 129), _RGB(255, 196, 129)
GET (0, 0)-(20, 20), ball()
CLS
DO
t = 0
down
t = 0
up
LOOP

SUB down
u = 0
DO
_LIMIT 10000
t = t + (1 / 10000)
PUT (800, s), ball()
v = u + (Gravity * t)
s = s + v * t * (450 / 10000)
u = v
PRINT s
_DISPLAY
CLS
LOOP UNTIL s > 770
END SUB

SUB up
u = -.9 * v
DO
CLS
IF s >= 870 THEN s = 870
_LIMIT 1000
t = t + (1 / 1000)
PUT (800, s), ball()
v = u + (Gravity * t)
s = s + (v * t * (450 / 10000))
u = v
_DISPLAY
LOOP WHILE v >= -10
END SUB


Posted on Feb 3, 2012, 3:16 PM

Respond to this message   

Return to Index


For one thing...

by lawgin (no login)

In the up sub, you need a minus sign when calculating position (s).

s = s - (v * t * (450 / 10000))

Posted on Feb 3, 2012, 5:31 PM

Respond to this message   

Return to Index


i made 'u' negative so...

by (no login)

i made 'u' negative so that accounts for the up part... it doesn't come out of the do..loop for some reason..

i revised it and it works...but i dont know why the do...loop never terminates(in the "down" sub)

Source code :

SCREEN _NEWIMAGE(1600, 900, 32)
f& = _LOADFONT("C:\WINDOWS\Fonts\Lucon.ttf", 21)
_FULLSCREEN
_FONT f&
CONST Gravity = 9.8
DIM SHARED v
DIM SHARED u
DIM SHARED t
DIM SHARED s
s = 450
DIM SHARED ball(441)
CIRCLE (10, 10), 10, _RGB(255, 196, 129)
PAINT (10, 10), _RGB(255, 196, 129), _RGB(255, 196, 129)
GET (0, 0)-(20, 20), ball()
CLS
DO
down
LOOP

SUB up
u = -.8 * v
DO
CLS
IF s >= 870 THEN s = 870
_LIMIT 10000
t = t + (1 / 10000)
PUT (800, s), ball()
v = u + (Gravity * t)
s = s + (v * t * (450 / 10000))
u = v
_DISPLAY
LOOP WHILE v >= -10
END SUB


SUB down
u = 0
DO
_LIMIT 10000
t = t + (1 / 10000)
PUT (800, s), ball()
v = u + (Gravity * t)
s = s + v * t * (450 / 10000)
u = v
_DISPLAY
CLS
IF s > 870 THEN up
LOOP 'UNTIL s > 870
END SUB





Posted on Feb 3, 2012, 5:34 PM

Respond to this message   

Return to Index


Here's what i have so far...

by (no login)

Source code :
SCREEN _NEWIMAGE(1920, 1080, 32)
_FONT _LOADFONT("C:\WINDOWS\Fonts\lucon.ttf", 21)
_FULLSCREEN
CIRCLE (10, 10), 10, _RGB(255, 198, 67)
PAINT (10, 10), _RGB(255, 198, 67), _RGB(255, 198, 67)
DIM ball(441)
GET (0, 0)-(20, 20), ball()
t = 0

ON ERROR GOTO errorhandle
x = 960
RANDOMIZE TIMER
d = INT(RND * 1050) + 1
dx = 1
frict = .0002
windspeed = (INT(RND * 20) - 9) / 100
CLS
DO
windspeed = windspeed + ((INT(RND * 3) - 1) / 800)
_LIMIT 10000
PUT (x, d), ball()
IF switch = 0 THEN t = t + (1 / 10000)
x = x + dx - frict + windspeed + momentum
momentum = dx * (((momentum + dx + windspeed) - frict) / 5)

IF x >= 1850 THEN
dx = dx * -1
frict = frict * -1
END IF
IF x <= 50 THEN
dx = dx * -1
frict = frict * -1
END IF

IF ABS(frict) > ABS(dx + momentum) THEN
frict = dx + momentum
ELSE
frict = frict * 1.01
END IF
v = v + (9.8 * t)
d = d + v * t * (450 / 1000)
IF (d + v * t * (450 / 1000)) > 1050 THEN
v = -(v * (.8))
END IF
IF windspeed > 0 THEN
PRINT "WindSpeed : ";
PRINT USING "#####.#"; ABS(windspeed * 100);
PRINT "---->"
ELSE
PRINT "WindSpeed : ";
PRINT USING "#####.#"; ABS(windspeed * 100);
PRINT "<----"
END IF
_DISPLAY
CLS
LOOP
errorhandle:
v = 0
t = 0
switch = 1
d = 1050
RESUME NEXT

Posted on Feb 4, 2012, 6:43 AM

Respond to this message   

Return to Index


Your ball needs more bounce

by lawgin (no login)

On my screen the ball often starts near the bottom, slowly falls past the bottom of the screen, and never reappears. Maybe starting nearer the top and giving it more initial velocity in both x and y directions might help.

Posted on Feb 4, 2012, 10:03 AM

Respond to this message   

Return to Index


*you have to change the resolution according to your monitor

by (no login)

Posted on Feb 4, 2012, 1:19 PM

Respond to this message   

Return to Index


Use _SCREENIMAGE with _WIDTH and _HEIGHT to get the present resolution.

by (Login burger2227)
R

You could also use _FULLSCREEN but you could also use _SCREENMOVE _MIDDLE after you get the user's desktop resolution using the _SCREENIMAGE handle and creating the proper program window size.

Posted on Feb 4, 2012, 1:45 PM

Respond to this message   

Return to Index


*Okay, I'll add that

by (no login)

Posted on Feb 4, 2012, 2:56 PM

Respond to this message   

Return to Index


look at this

by (no login)

i honestly dont know what im doing here though, maybe lawgin the mathematician can be of assistance here:

SCREEN 12

xf = 2
yf = 5
yyf = 0
yyyf = .001

DO
yyf = yyf + yyyf
x = x + xf
y = y + yf
yf = yf + yyf

CLS
CIRCLE (x, y), 20, , , , 1
_DISPLAY
_LIMIT 50

IF y > 470 THEN
yf = yf * -1
END IF
IF x > 640 OR x < 0 THEN
xf = xf * -1
END IF
LOOP UNTIL INP(&H60) = 1
SYSTEM

Posted on Feb 3, 2012, 7:10 PM

Respond to this message   

Return to Index


That looks pretty good!

by (Login burger2227)
R

Now all you have to do is decrease the bounce instead of increasing it. It looks pretty good gravity wise.

Posted on Feb 3, 2012, 7:23 PM

Respond to this message   

Return to Index


how?

by (no login)

Posted on Feb 3, 2012, 8:37 PM

Respond to this message   

Return to Index


Here's one way

by lawgin (no login)

Use a new variable (k) which starts off as 1, then slowly decreases every time the ball hits bottom, slowly sapping energy from the ball.


SCREEN 12
k = 1
xf = 2
yf = 5
yyf = 0
yyyf = .001

DO
yyf = yyf + yyyf
x = x + xf
y = y + yf
yf = yf + yyf

CLS
CIRCLE (x, y), 20, , , , 1
_DISPLAY
_LIMIT 50

IF y > 470 THEN
k = k - .005
yf = yf * -1 * k
END IF
IF x > 640 OR x < 0 THEN
xf = xf * -1
END IF
LOOP UNTIL INP(&H60) = 1
SYSTEM

Posted on Feb 4, 2012, 10:07 AM

Respond to this message   

Return to Index

 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement