QBasic and QB64 Discussion Board

# Tan

SCREEN 12

CLS

CONST PI = 3.1415926#
R = 100
X0 = 320: Y0 = 240

PSET (X0, Y0)

ON ERROR GOTO ERRORHANDLE

FOR i = 5 TO 90 STEP 5

t = TAN(i * PI / 180)

x = SQR(ABS((R ^ 2) / (t ^ 2 + 1)))
y = x * t

PSET (X0 + x, Y0 - y)

NEXT i

ERRORHANDLE:

RESUME NEXT

END

Posted on Oct 13, 2010, 5:59 AM

# NEVER put program END after GOSUB procedure!

R

You can get RETURN without GOSUB error! Only the error handler saves you in this instance.

 This message has been edited by burger2227 on Oct 13, 2010 12:17 PM

Posted on Oct 13, 2010, 12:14 PM

# *Yeah, an interesting exception -- "RESUME without error" providing the error!

R

*

Posted on Oct 13, 2010, 12:37 PM

# check Angle ?

Regarding a figure like the letter "Y", is it possible to check in case we have only 1 of the 2 upper "arms", which one we have, the right or thee left, regardless from the position of the figure in the plan ... ?

Posted on Oct 7, 2010, 1:48 PM

by Not me neither (Login burger2227)
R

Posted on Oct 7, 2010, 4:40 PM

# the V in Y

Posted on Oct 7, 2010, 7:33 PM

# *More context needed. Give us some example code?

Moderator

Posted on Oct 7, 2010, 9:54 PM

# I will not spam the forum !

An example is my previous program on this page, post = "Perpendicularity". This is the clearest, the other is the fractal attempt also posted here.

In Perpendicularity, the ABS statement means that i add ever the same way to the coordinates of X (center of the blue line), so if the blue line would go further the routine would fail :

1) blue line is drawn.
2) a perpendicular line is draw.
3) how to set the point (red circle) ever on the same side on the green line... ?

Not to forget the annoying "DIVISION BY ZERO" error :(

All my construction on recursivity has many drawbacks (cf. fractal attempt):

1) All "code" should be set inside the CALL statement, (So no IF, etc) since outside this statement on never knows what is executed by who and with what value of variables !!!

2) Stack space could cause some troubles.

3) no way to fake a nested loop ! at least for me, current state.

SCREEN 12

CLS

X1 = 320
Y1 = 240

D = 100

FOR X2 = 120 TO 520 STEP 30

'X2 = 488
Y2 = 15

ON ERROR GOTO ERRORHANDLE

p = (Y2 - Y1) / (X2 - X1)
pp = -1 / p

PRINT pp

LINE (X1, Y1)-(X2, Y2), 1

xp = (320 + (X2 - X1) / 2 - ABS(X2 - 320))
yp = (240 + (Y2 - Y1) / 2 - ABS(X2 - X1) * pp)

LINE (320 + (X2 - X1) / 2, 240 + (Y2 - Y1) / 2)-(xp, yp), 3

xx = 320 + (X2 - X1) / 2 - SQR(ABS(D ^ 2 / (1 + pp ^ 2)))
yy = 240 + (Y2 - Y1) / 2 - (SQR(ABS(D ^ 2 / (1 + pp ^ 2)))) * pp

CIRCLE (xx, yy), 10, 4

'SLEEP 1

NEXT X2

ERRORHANDLE:

p = 1000

RESUME NEXT

END

Posted on Oct 8, 2010, 3:29 AM

# WT FEATHERS? GET OUT OF THIS THREAD SPAMMER!

R

DAMMIT, WHEN are the EVER gonna fix N54 to recognize people????????

I HATE THIS CRAP! EVERY post I have to RE-ENTER my name AND EMAIL!!!!!!!!!

I'd move this place and just place a NEW link here with the FREE with ADS service and NEVER look back! Those N54 people are aholes and they don't really CARE about the forums! They just like the money! \$50 is TOO MUCH for LIP SERVICE!

Ted

Posted on Oct 8, 2010, 11:30 AM

# *If I open source the new forum, will you finish it?

Moderator

Posted on Oct 8, 2010, 2:44 PM

# Hmmmmmmm

R

Pete has the archives so it would be his call. I cannot see having a forum without the archives. I don't even know how to make a web site and I'm unfamiliar with the forum software involved. I have learned a bit about the phpBB from moderating Pete's Site, but the software is old.

Pete has been hinting at combining with the QB64 Forum, but Galleon has not bitten. What would it cost to maintain a site with the archives in your estimation and who can I count on to help get it running? We can't even get TheBob or Soliaire to visit the QB64 site! At least they don't post there.

We "could" just let this one run with ads and get the other site established before moving it. Maybe Mark from Qbasic.com would let us use the name and we could run it. I am not in the greatest health either, so somebody may need to fill in or take it over within the next 5 years.

Ted

 This message has been edited by burger2227 on Oct 8, 2010 9:56 PMThis message has been edited by burger2227 on Oct 8, 2010 9:55 PM

Posted on Oct 8, 2010, 9:52 PM

# archives are read-only here anyway, so just mirror the archive site and start new forum

Posted on Oct 9, 2010, 4:33 PM

# * Anonymous posters that don't follow rules here will be the first to go!

R

Posted on Oct 9, 2010, 4:53 PM

# Some responses

Moderator

First, be it known that I was half-joking. (Which suggests that I was half-serious...)

> Pete has the archives so it would be his call. I cannot see having a forum without the archives.

I've previously discussed scraping the archives and importing them into the new forum. I'd be happy to code that. Of course one could just copy all the old pages verbatim and leave them read-only, but why not do it properly?

> I'm unfamiliar with the forum software involved.

Obviously! -- Because I wrote the software, and didn't show it to anyone.

It's less than 400 lines of code, though. Figuring out how the current code works and picking up some PHP shouldn't be that hard. Especially if you channel your anger at N54 into it. ;)

> What would it cost to maintain a site with the archives in your estimation and who can I count on to help get it running?

I probably pay less for my Dreamhost space than a premier account costs here. I can host multiple websites for no extra charge and have ridiculous amounts of disk space so I'll happily provide the web space for a forum.

I will also inspect all code changes for security/quality reasons before installing them to the live site.

> I am not in the greatest health either

All the best with your health.

Posted on Oct 10, 2010, 2:24 AM

# * Left a message there...

R

Posted on Oct 10, 2010, 4:25 AM

# what is left to finish?

Posted on Oct 9, 2010, 1:13 PM

# See for yourself (*URL)

Moderator

Posted on Oct 10, 2010, 1:09 AM

# Quick Sort

Hi
what is quick sort in qbasic, i am unable to do a pro gramme for the same, can somebody help me in same, i know i have use the following loop and while , for endif statements.

Posted on Oct 6, 2010, 10:35 PM

# *URL

http://qbasicnews.com/abc/showsnippet.php?filename=ALGOR.ABC&snippet=25

Posted on Oct 6, 2010, 11:40 PM

# Gif

http://cjoint.com/data/0khjUIgTPSp.htm

Posted on Oct 7, 2010, 12:47 AM

# Careful!

The referenced code by Ethan Winer is a DEMONSTRATION, and does not reflect his latest version of his algorithm.

Also, the Quick Sort algorithm has been slightly modified recently by Ethan Winer, per my suggestion, to clear the "stack" initially. Download the latest version from the Ethan Winer site.

Regards..... Moneo

Posted on Oct 11, 2010, 9:53 AM

# * Errrrrrrrr.........WHAT are you talking about and to WHO?

R

Posted on Oct 11, 2010, 10:00 AM

# Re: * Errrrrrrrr.........WHAT are you talking about and to WHO?

WHAT: I'm talking about Ethan Winer's Quicksort algorithm.

WHO: OPRESION gave us an URL which displayed a demonstration program which uses an old, obsolete version of Ethan Winer's Quicksort algorithm.
OPRESION's post was in response to Babu's request regarding quick sort.

Regards... Moneo

Posted on Oct 11, 2010, 6:02 PM

# * Where is your version? Why not post it Moneo?

R

Posted on Oct 12, 2010, 1:25 AM

# Re: * Where is your version? Why not post it Moneo?

Ted,

First of all, I'd like to make it clear than this is not "my version" of Quicksort. It was written by Ethan Winer and appears in his book on programming. (Visit his site at www.ethanwiner.com). All I did was inform Ethan that his Quicksort code needed a correction with an additional one-line of code. Ethan then incorporated my change into the latest copy of his book.

I'm in the process of retrieving the Quicksort section from his book. It has a lot of very pertinent and interesting explanations before and after the actual code. Do you want these explanations to appear in my post?

Regards..... Moneo

Posted on Oct 13, 2010, 8:20 PM

# * Sure, show us what he added too.

R

Posted on Oct 13, 2010, 9:16 PM

# Ok Ted, here's Ethan Winer's version of Quicksort

BASIC TECHNIQUES AND UTILITIES BOOK
By Ethan Winer
Chapter 8 Sorting and Searching
Extract only of Quick Sort Algorithm (without recursion)

THE QUICK SORT ALGORITHM
========================
It should be obvious to you by now that a routine written in assembly
language will always be faster than an equivalent written in BASIC.
However, simply translating a procedure to assembly language is not always
the best solution. Far more important than which language you use is
selecting an appropriate algorithm. The best sorting method I know is the
Quick Sort, and a well-written version of Quick Sort using BASIC will be
many times faster than an assembly language implementation of the Bubble
Sort.
The main problem with the Bubble Sort is that the number of comparisons
required grows exponentially as the number of elements increases. Since
each pass through the array exchanges only a few elements, many passes are
required before the entire array is sorted. The Quick Sort was developed
by C.A.R. (Tony) Hoare, and is widely recognized as the fastest algorithm
available. In some special cases, such as when the data is already sorted
or nearly sorted, the Quick Sort may be slightly slower than other methods.
But in most situations, a Quick Sort is many times faster than any other
sorting algorithm.
As with the Bubble Sort, there are many different variations on how a
Quick Sort may be coded. (You may have noticed that the Bubble Sort shown
in Chapter 7 used a nested FOR/NEXT loop, while the one shown here uses a
FOR/NEXT loop within a DO/WHILE loop.) A Quick Sort divides the array into
sections--sometimes called partitions--and then sorts each section
individually. Many implementations therefore use recursion to invoke the
subprogram from within itself, as each new section is about to be sorted.
However, recursive procedures in any language are notoriously slow, and
also consume stack memory at an alarming rate.
The Quick Sort version presented here avoids recursion, and instead uses
a local array as a form of stack. This array stores the upper and lower
bounds showing which section of the array is currently being considered.
Another refinement I have added is to avoid making a copy of elements in
the array. As a Quick Sort progresses, it examines one element selected
arbitrarily from the middle of the array, and compares it to the elements
that lie above and below it. To avoid assigning a temporary copy this
version simply keeps track of the selected element number.
When sorting numeric data, maintaining a copy of the element is
reasonable. But when sorting strings--especially strings whose length is
not known ahead of time--the time and memory required to keep a copy can
become problematic. For clarity, the generic Quick Sort shown below uses
the copy method. Although this version is meant for sorting a single
precision array, it can easily be adapted to sort any type of data by
simply changing all instances of the "!" type declaration character.

'******** QSORT.BAS, Quick Sort algorithm demonstration

DEFINT A-Z
DECLARE SUB QSort (Array!(), StartEl, NumEls)

RANDOMIZE TIMER 'generate a new series each run

DIM Array!(1 TO 21) 'create an array
FOR X = 1 TO 21 'fill with random numbers
Array!(X) = RND(1) * 500 'between 0 and 500
NEXT

FirstEl = 6 'sort starting here
NumEls = 10 'sort this many elements

CLS
PRINT "Before Sorting:"; TAB(31); "After sorting:"
PRINT "==============="; TAB(31); "=============="

FOR X = 1 TO 21 'show them before sorting
IF X >= FirstEl AND X <= FirstEl + NumEls - 1 THEN
PRINT "==>";
END IF
PRINT TAB(5); USING "###.##"; Array!(X)
NEXT

CALL QSort(Array!(), FirstEl, NumEls)

LOCATE 3
FOR X = 1 TO 21 'print them after sorting
LOCATE , 30
IF X >= FirstEl AND X <= FirstEl + NumEls - 1 THEN
PRINT "==>"; 'point to sorted items
END IF
LOCATE , 35
PRINT USING "###.##"; Array!(X)
NEXT

SUB QSort (Array!(), StartEl, NumEls) STATIC

REDIM QStack(NumEls \ 5 + 10) 'create a stack array

First = StartEl 'initialize work variables
Last = StartEl + NumEls - 1
StackPtr = 0 'added 10/31/2005 - thanks to Edward F. Moneo

DO
DO
Temp! = Array!((Last + First) \ 2) 'seek midpoint
I = First
J = Last

DO 'reverse both < and > below to sort descending
WHILE Array!(I) < Temp!
I = I + 1
WEND
WHILE Array!(J) > Temp!
J = J - 1
WEND
IF I > J THEN EXIT DO
IF I < J THEN SWAP Array!(I), Array!(J)
I = I + 1
J = J - 1
LOOP WHILE I <= J

IF I < Last THEN
QStack(StackPtr) = I 'Push I
QStack(StackPtr + 1) = Last 'Push Last
StackPtr = StackPtr + 2
END IF

Last = J
LOOP WHILE First < Last

IF StackPtr = 0 THEN EXIT DO 'Done
StackPtr = StackPtr - 2
First = QStack(StackPtr) 'Pop First
Last = QStack(StackPtr + 1) 'Pop Last
LOOP

ERASE QStack 'delete the stack array

END SUB

Notice that I have designed this routine to allow sorting only a portion
of the array. To sort the entire array you'd simply omit the StartEl and
NumEls parameters, and assign First and Last from the LBOUND and UBOUND
element numbers. That is, you will change these:

First = StartEl
and
Last = StartEl + NumEls - 1

to these:

First = LBOUND(Array!)
and
Last = UBOUND(Array!)

As I mentioned earlier, the QStack array serves as a table of element
numbers that reflect which range of elements is currently being considered.
You will need to dimension this array to one element for every five
elements in the primary array being sorted, plus a few extra for good
measure. In this program I added ten elements, because one stack element
for every five main array elements is not enough for very small arrays.
For data arrays that have a large amount of duplicated items, you will
probably need to increase the size of the stack array.
Note that this ratio is not an absolute--the exact size of the stack
that is needed depends on how badly out of order the data is to begin with.
Although it is possible that one stack element for every five in the main
array is insufficient in a given situation, I have never seen this formula
fail. Because the stack is a dynamic integer array that is stored in far
memory, it will not impinge on near string memory. If this routine were
designed using the normal recursive method, BASIC's stack would be used
which is in near memory.
Each of the innermost DO loops searches the array for the first element
in each section about the midpoint that belongs in the other section. If
the elements are indeed out of order (when I is less than J) the elements
are exchanged. This incrementing and comparing continues until I and J
cross. At that point, assuming the variable I has not exceeded the upper
limits of the current partition, the partition bounds are saved and Last
is assigned to the top of the next inner partition level. When the entire
partition has been processed, the previous bounds are retrieved, but as a
new set of First and Last values. This process continues until no more
partition boundaries are on the stack. At that point the entire array is
sorted.
On the accompanying disk you will find a program called SEEQSORT.BAS
that contains an enhanced version of the QSort demo and subprogram. This
program lets you watch the progress of the comparisons and exchanges as
they are made, and actually see this complex algorithm operate. Simply
load SEEQSORT.BAS into the BASIC editor and run it. A constant named
Delay! is defined at the beginning of the program. Increasing its value
makes the program run more slowly; decreasing it causes the program to run
faster.

*****

Posted on Oct 14, 2010, 12:10 PM

# Thanks! I had a problem, but it was something I did.

R

I used UBOUND(Array!) but since I set lower bound to 0, you have to add one or the last element is never worked on. Perhaps you might wanna tell him.

IF LBOUND(Array!) = 0 THEN ELNUM = UBOUND(Array!) + 1

LOL, I actually contacted him about another program that had a minor problem. It was a monitor test that actually never could ever say that it could not determine the monitor type. It was just a problem with his IF statements.

Perhaps you've seen that one? It's in his book I think. It finds EGA and VGA using Interrupt.

Ted

 This message has been edited by burger2227 on Oct 14, 2010 2:21 PMThis message has been edited by burger2227 on Oct 14, 2010 2:02 PMThis message has been edited by burger2227 on Oct 14, 2010 1:48 PM

Posted on Oct 14, 2010, 1:42 PM

# Re: Thanks! I had a problem, but it was something I did.

You're right, Ted. Ethan's algorithm is based on a starting array element number of 1, which he codes explicitly. This, of course, affects the value produced by UBOUND. At first glance, your fix solves the problem, but my gut feel tells me that other related adjustments may have to be made in Ethan's code for a general solution to handle a starting array element of zero. I don't know. I'll contact him about this next chance I get.

For now, I suggest you use a starting element number of 1 to satisfy Ethan's code.

Regarding the EGA and VGA problem, I'm not familiar with this. Did Ethan ever get back to you? Do you think he fixed the related code? I'll try to search the latest copy of Ethan's book to find something related to EGA/VGA, and let you know.

Thanks Ted..... Moneo

Posted on Oct 14, 2010, 5:47 PM

# * You know me Moneo. I NEVER follow the rules! That's no fun..:-)

R

Posted on Oct 14, 2010, 6:22 PM

# Determine EGA/VGA using Interrupt

Ted. In Ethan Winer's book, I finally located the code which uses Interrupt to identify EGA/VGA. I don't see any comments there which would indicate that any changes were suggested. Maybe he never got your mail. I would be very surprised if he just ignored you. Try sending it again.

Regards..... Moneo

Posted on Oct 18, 2010, 11:36 AM

# * He didn't ignore me. He answered my email about it. NO BIGGIE!

R

Posted on Oct 18, 2010, 1:18 PM

# He should use First and Last as values from user or LBOUND and UBOUND to do it.

R

Instead of calculating the number of elements in the array, the procedure could do it all internally. Then you would only need the Array parameter using any array type.

SUB QSort (Array!()) STATIC
First = LBOUND(Array!) 'initialize work variables
Last = UBOUND(Array!)
NumEls = (Last - First) + 1
REDIM QStack(NumEls \ 5 + 10) 'create a stack array

Also you could add an ascending or descending parameter that could set up First and Last to do the appropriate sort by exchanging them before the calculations begin. Then you don't need to change the > or < conditions.

Of course you would need the First and Last parameters if only sorting parts of an array, but the calculation for NumEls would remain the same and the value could not be accidentally calculated incorrectly no matter which values are used.

As FAST as this sort works, why NOT sort the whole array, LOL.

Ted

 This message has been edited by burger2227 on Oct 15, 2010 2:06 AMThis message has been edited by burger2227 on Oct 15, 2010 2:05 AM

Posted on Oct 15, 2010, 2:04 AM

# Re: He should use First and Last as values from user or LBOUND and UBOUND to do it.

Ted. Since you are intimately involved with the changes that you feel Ethan should make to his Quicksort logic, I think it would be best if you wrote to him yourself at: ethanw@ethanwiner.com

Regards..... Moneo

Posted on Oct 18, 2010, 11:30 AM

# getting confused with quick sort

Can you all tell me what is problem with earier post, and which is the link where i can get new version of quick sort

Posted on Oct 12, 2010, 10:12 PM

# YOUR CONFUSED? Where ya been for 6 days? Trying to find us again?

R

If you look right BELOW THIS POST, you will see QUICK SORT IN BIG LETTERS!

BET you take it and never look back!!!!!!! Don't even say thanks...

Posted on Oct 13, 2010, 2:02 AM

# QuickSort SUB

R

DEFINT A-Z
DIM array(1000) AS SINGLE 'array can hold any type value
RANDOMIZE TIMER
FOR i = 0 TO 1000
array(i) = RND * 1000 'populate array with random values to sort
NEXT
start = LBOUND(array) 'lowest element
finish = UBOUND(array) 'highest element
swap2 = 0 'start at 0
CALL QuickSort(start, finish, array(), swap2)
FOR n = 0 TO 1000
IF array(n) >= max! THEN
max! = array(n)
ELSE BEEP
EXIT FOR
END IF
NEXT
END

SUB QuickSort (start AS INTEGER, finish AS INTEGER, array() AS SINGLE, swap2 AS LONG)
DIM Hi AS INTEGER, Lo AS INTEGER, Middle AS SINGLE
Hi = finish: Lo = start
Middle = array((Lo + Hi) / 2) 'find middle of array
DO
DO WHILE array(Lo) < Middle: Lo = Lo + 1: LOOP
DO WHILE array(Hi) > Middle: Hi = Hi - 1: LOOP
IF Lo <= Hi THEN
SWAP array(Lo), array(Hi)
swap2 = swap2 + 1
Lo = Lo + 1: Hi = Hi - 1
END IF 'If homework, you will fail
LOOP UNTIL Lo > Hi
IF Hi > start THEN CALL QuickSort(start, Hi, array(), swap2)
IF Lo < finish THEN CALL QuickSort(Lo, finish, array(), swap2)
END SUB

 This message has been edited by burger2227 on Oct 12, 2010 11:22 PMThis message has been edited by burger2227 on Oct 12, 2010 10:57 PMThis message has been edited by burger2227 on Oct 12, 2010 10:50 PM

Posted on Oct 7, 2010, 5:01 AM

# Re: QuickSort SUB

R

and here is another version, recursive like clippy's but uses TYPE records.
TYPE SortType
TheData AS SINGLE
TheIndex AS SINGLE
END TYPE
MaxItems& = 131071
REDIM DataArray(0 TO MaxItems&) AS SortType

FOR i& = 0 TO MaxItems&
DataArray(i&).TheData = INT(RND * MaxItems&)
DataArray(i&).TheIndex = i&
NEXT
QuickSort DataArray(), LBOUND(DataArray), UBOUND(DataArray)
FOR i& = LBOUND(DataArray) TO UBOUND(DataArray)
PRINT DataArray(i&).TheData, DataArray(i&).TheIndex
NEXT

SUB QuickSort (array() AS SortType, start&, finish&)
SELECT CASE finish& - start&
CASE 1
IF array(start&).TheData > array(finish&).TheData THEN
SWAP array(start&), array(finish&)
END IF
CASE IS > 1
i& = start&
j& = finish&
DIM Median AS SortType '* this way median is ALWAYS same type as list being sorted
m& = start& + (finish& - start&) \ 2
Median.TheData = array(m&).TheData
DO
WHILE array(i&).TheData
i& = i& + 1
WEND

WHILE array(j&).TheData > Median.TheData
j& = j& - 1
WEND

IF i& <= j& then
SWAP array(i&), array(j&)
i& = i& + 1
j& = j& - 1
END IF

LOOP UNTIL i& > j&
QuickSort array(), i&, finish&
QuickSort array(), start&, j&
END SELECT
END SUB
and again, i refuse to let you have my secret optimizations for this. but it does work as is

 This message has been edited by codeguy on Oct 13, 2010 10:00 PM

Posted on Oct 13, 2010, 9:58 PM

# Questions on Subs, Goto,etc.

-Why does a question mark appear whenever I have a variable right after a semicolon on an INPUT line like this: INPUT "Name:"; name\$

-Why ever use GOTO instead of GOSUB. If it's the same thing except GOSUB has support for the RETURN Statment?

-What's the best way to define variables? Using the DIM function or characters (\$,%,&,!,#)? Or does it depend on something specific?

-Why do certain commands like CHR\$ have a "\$" character at the end of it, why can't it be just CHR?

-I'm trying to shorten the following code using SUBS:
CLS
value% = 5

'TEST 1
INPUT "", more%
IF more% <= value% THEN
value% = 1
ELSE
value% = 10
END IF

PRINT "Test 1"
PRINT value%

'TEST 2
INPUT "", more%
IF more% <= value% THEN
value% = 1
ELSE
value% = 10
END IF

PRINT "Test 2"
PRINT value%

'TEST 3
INPUT "", more%
IF more% <= value% THEN
value% = 1
ELSE
value% = 10
END IF

PRINT "Test 3"
PRINT value%

What I want to do is turn this part:
IF more% <= value% THEN
value% = 1
ELSE
value% = 10
END IF

Into a SUB so the code will be shorter.

I tried this:
(Sub:)
SUB Stuff
IF more% <= value% THEN
value% = 1
ELSE
value% = 10
END IF
END SUB

(Main Module:)
DECLARE SUB Stuff (value%)
CLS
value% = 5

'TEST 1
INPUT "", more%

Stuff

PRINT "Test 1"
PRINT value%

'TEST 2
INPUT "", more%

Stuff

PRINT "Test 2"
PRINT value%

'TEST 3
INPUT "", more%

Stuff

PRINT "Test 3"
PRINT value%

That failed so I tried using arguments:

(Sub:)
SUB Stuff (value%)
IF more% <= value% THEN
value% = 1
ELSE
value% = 10
END IF
END SUB

(Main Module:)
DECLARE SUB Stuff (value%)
CLS
value% = 5

'TEST 1
INPUT "", more%

Stuff (value%)

PRINT "Test 1"
PRINT value%

'TEST 2
INPUT "", more%

Stuff (value%)

PRINT "Test 2"
PRINT value%

'TEST 3
INPUT "", more%

Stuff (value%)

PRINT "Test 3"
PRINT value%

Which also fails.. Why?

Posted on Oct 6, 2010, 4:15 PM

# A semicolon creates ? after statement. Use comma if you don't want that.

R

I recommend that beginners NOT use GOTO as it will become a crutch that will follow you forever! Only use it when there is no other solution or you need to use ON ERROR GOTO for error handling(not GOSUB).

GOSUB calls a procedure placed in the main module. It should be called when you need to do something more than once just like a SUB or FUNCTION. RETURN does what it says and returns to the code immediately after the Sub call. I normally place ALL GOSUB procedures AFTER the main code. Even after END or SYSTEM that close the program.

BEST way to define variables?: DIM at start of procedure, but you can use suffixes on the fly. Either way is fine!

\$ is the STRING type suffix. It just denotes that the function will return a string value. Like INKEY\$ returns keypress characters. CHR\$(27) is the Escape key. Each key has a character code. See ASCII for codes.

SUB calls need to pass the values they use so:

SUB Stuff (value%, more%)
IF more%
value% = 1
ELSE
value% = 10
END IF
END SUB

To call it use:

Stuff 10, 5

OR

CALL Stuff(x%, y%)

The call variable names do NOT have to be the same as the variable names used in the SUB. They must be of the same value type however. So you cannot send an integer value to a string parameter.

See my demonstrator for more answerhttp://dl.dropbox.com/u/8440706/Q-Basics.zip

Ted

 This message has been edited by burger2227 on Oct 6, 2010 5:52 PMThis message has been edited by burger2227 on Oct 6, 2010 5:46 PMThis message has been edited by burger2227 on Oct 6, 2010 5:45 PMThis message has been edited by burger2227 on Oct 6, 2010 5:44 PM

Posted on Oct 6, 2010, 5:42 PM

S

To eliminate the \$ after an INPUT, use a comma instead of a semicolon.
Example:
INPUT "Enter your name: ", name\$

In order to transition to a modern language, you need to avoid using the older commands. You should try to use subprocedures instead of the obsolete GOTO and GOSUB commands. GOTO is especially evil, resulting in spaghetti code if misused.

Use DIM to declare variables by type. The suffix symbols are obsolete. However, you should continue using the string \$ suffix even after declaring those variables by type.
Example:
DIM myname AS STRING, mynum AS INTEGER
myname\$ = "George"
mynum = 25

If you do not declare a variable by type with DIM, it takes on the default SINGLE type.

CHR\$ is a function, not a command. A function returns a value of a certain type. CHR\$ returns a STRING value and it must include the \$ suffix as part of its name. A function without the \$ returns a number value of the default SINGLE type.

SUBprocedures use local variables, which go out of memory when the sub ends. In order to pass on values from the main program to a SUB, you need to use arguments and parameters. The default in QBasic is to pass values BYREF, which alters the original variable, so the variable takes on the changed value when you return to the main program.

In your program, you need to pass both the value variable and the more variable to the SUB. The problem is that the original value will change. If you want it to go back to being 5, then you either should reinitialize the value variable, or use a different variable for the value always to be 5, or you can simply use a literal value, or a local variable in the sub.

I am assuming that you always want the value to start out as being 5. This first example reinitializes the value variable before calling the SUB:

=================================================================
DECLARE SUB Stuff (value AS INTEGER, more AS INTEGER)
CLS
DIM value AS INTEGER, more AS INTEGER
value = 5
'TEST 1
INPUT "Enter test 1: ", more
CALL Stuff(value, more)
PRINT "Test 1"
PRINT "Value = "; value

value = 5
'TEST 2
INPUT "Enter test 2: ", more
CALL Stuff(value, more)
PRINT "Test 2"
PRINT "Value = "; value

value = 5
'TEST 3
INPUT "Enter test 3: ", more
CALL Stuff(value, more)
PRINT "Test 3"
PRINT "Value = "; value

SUB Stuff (value AS INTEGER, more AS INTEGER)
IF more <= value THEN
value = 1
ELSE
value = 10
END IF
END SUB
=======================================================================

The next example uses three variables. The original value is not changed.

=======================================================================
DECLARE SUB Stuff (value AS INTEGER, more AS INTEGER, newval AS INTEGER)
CLS
DIM value AS INTEGER, more AS INTEGER, newval AS INTEGER
value = 5

'TEST 1
INPUT "Enter test 1: ", more
CALL Stuff(value, more, newval)
PRINT "Test 1"
PRINT "New Value = "; newval

'TEST 2
INPUT "Enter test 2: ", more
CALL Stuff(value, more, newval)
PRINT "Test 2"
PRINT "New Value = "; newval

'TEST 3
INPUT "Enter test 3: ", more
CALL Stuff(value, more, newval)
PRINT "Test 3"
PRINT "New Value = "; newval

SUB Stuff (value AS INTEGER, more AS INTEGER, newval AS INTEGER)
IF more <= value THEN
newval = 1
ELSE
newval = 10
END IF
END SUB
===============================================================

You can also use literal values to pass down, using three arguments like this:
CALL Stuff(5, more, newval)
That way, you don't need to declare or initialize the value variable at all.

But since you are always using the same value of 5, You can simply declare the value variable locally only in the SUB. That way, you only need to pass two variables. Example 3:

===============================================================
DECLARE SUB Stuff (more AS INTEGER, newval AS INTEGER)
CLS
DIM more AS INTEGER, newval AS INTEGER

'TEST 1
INPUT "Enter test 1: ", more
CALL Stuff(more, newval)
PRINT "Test 1"
PRINT "New Value = "; newval

'TEST 2
INPUT "Enter test 2: ", more
CALL Stuff(more, newval)
PRINT "Test 2"
PRINT "New Value = "; newval

'TEST 3
INPUT "Enter test 3: ", more
CALL Stuff(more, newval)
PRINT "Test 3"
PRINT "New Value = "; newval

SUB Stuff (more AS INTEGER, newval AS INTEGER)
DIM value AS INTEGER
value = 5
IF more <= value THEN
newval = 1
ELSE
newval = 10
END IF
END SUB
=============================================================

If you actually want the value to change to 1 or 10 every time you call the SUB, then you can simply use the first example without reinitializing value to 5 each time.

Note: Your program repeats the same thing three times. I assume you haven't yet learned how to use loops or arrays, which will shorten your code considerably.

 This message has been edited by Solitaire1 on Oct 6, 2010 6:22 PMThis message has been edited by Solitaire1 on Oct 6, 2010 6:14 PM

Posted on Oct 6, 2010, 6:08 PM

# * Did I NOT answer these questions or did I just beat you at posting them ?...............

R

Posted on Oct 6, 2010, 6:43 PM

# You beat me at posting while I was writing the sample programs.

S

Besides, my answers are not quite the same as yours. I went into greater detail, which is why it took me longer to finish and post.

 This message has been edited by Solitaire1 on Oct 6, 2010 8:40 PM

Posted on Oct 6, 2010, 8:37 PM

# * No problem teacher. Glad somebody besides Litzsfr is here.

R

Posted on Oct 6, 2010, 10:24 PM

# I too :-)

http://cjoint.com/data/0khjUIgTPSp.htm

Posted on Oct 7, 2010, 12:51 AM

# A different spin

Moderator

-Why does a question mark appear whenever I have a variable right after a semicolon on an INPUT line like this: INPUT "Name:"; name\$

Is that really the question you wanted to ask, or did you want to know how to get rid of the question mark?

-Why ever use GOTO instead of GOSUB. If it's the same thing except GOSUB has support for the RETURN Statment?

If you *don't* RETURN then the return location remains on the stack. Eventually you will run out of stack space. E.g.

self:
GOSUB self

-What's the best way to define variables? Using the DIM function or characters (\$,%,&,!,#)? Or does it depend on something specific?

Do what you prefer. As a general rule, DIM-style declarations are preferable for larger codebases or code that you are likely to use/modify many times.

Many languages (such as C, C++, C#, Java) require/encourage DIM-like declaration. Many others, particularly scripting languages (such as PHP, Python, Ruby) allow variables to take any type so declarations do not make sense. Perl has something vaguely related to QB's type suffixes. Haskell on the other hand is very particular about types however can figure out and check most of the types for you!

There's clearly a lot of choice. Some tools are better for certain tasks, of course. As you get more experience with larger projects you will appreciate this more.

-Why do certain commands like CHR\$ have a "\$" character at the end of it, why can't it be just CHR?

In Visual Basic, it is just CHR. (At least in the versions I've used.) So it's a choice of the language designers. Solitaire and Clippy have already explained what the \$ signifies.

Posted on Oct 7, 2010, 3:35 AM

# It's past your curfew. Your should have been back to the forum weeks ago.

For your punishment, you have to stand in the chat room, and blog about Windows 7.

But we're glad to have you back!

Pete

 This message has been edited by The-Universe on Oct 9, 2010 9:00 AM

Posted on Oct 7, 2010, 4:29 AM

# ...

-Why does a question mark appear whenever I have a variable right after a semicolon on an INPUT line like this: INPUT "Name:"; name\$

Is that really the question you wanted to ask, or did you want to know how to get rid of the question mark? Well actually yes, i already new how to get rid of the question mark (coma). I was just curious what is the point of this, maybe it serves some kind of purpose besides making things more complicated.

And thx for the answers =]

Posted on Oct 10, 2010, 4:34 PM

# It's an input feature...

A question mark implies input. If a coma is ued to remove it, it will cause the cursor to be right up against the printed text, unless of course a space is included.

So the "?" mark is added to the text, and a space is made before the input line. That's just the way the creators intended it to be.

Pete

- And on the seventh day, they all got drunk and created FreeBasic.

Posted on Oct 10, 2010, 6:03 PM

# Probably historical reasons

Moderator

I could be wrong but I'd guess that the ? has been around since the earliest incarnations of BASIC. Perhaps it was a convenient indication that the computer was ready to accept input. (I wouldn't be surprised if BASIC was initially run on a computer without a blinking cursor, or that ignored keys which were pressed when the computer was busy doing something else.)

For purposes of program compatibility the ? would have been retained even when it became less useful, and a new syntax created for leaving it out.

As I said, just a guess.

Posted on Oct 11, 2010, 5:18 AM

# Help !

Ahhhhhhhhhhhhhh .... WTF ? Something is rotten in the kingdome of Danemark

=> The 2 CALLs don't work together properly...

DECLARE SUB TRIAN (Lx, Ly, Rx, Ry, Xx, Yy, Sx, Sy, D, C, n)

COMMON SHARED B, BY, C, H, X

SCREEN 12

'INPUT "n "; n
'INPUT "C "; C

n = 6
C = 15

CONST EQ = .8860254#
B = 200 ' half edge
H = (B * 2 * EQ) ' high
X = 320 ' Sommet 0
C = 15 ' Color
BY = 480 - ((480 - (B * 2 * EQ)) / 2) ' Base line

' First pattern :

LINE (X - B, BY)-(X + B, BY)
LINE -(X, BY - H)
LINE -(X - B, BY)

Lx = X - B: Ly = BY
Rx = X + B: Ry = BY
Sx = X: Sy = BY - H

D = EQ * 1 / 3 * SQR(ABS((Sx - Lx) ^ 2 + (Sy - Ly) ^ 2))

'SLEEP

ON ERROR GOTO ERRORHANDLE

CALL TRIAN(Lx, Ly, Rx, Ry, Xx, Yy, Sx, Sy, D, C, n)

ERRORHANDLE:

RESUME NEXT

END

SUB TRIAN (Lx, Ly, Rx, Ry, Xx, Yy, Sx, Sy, D, C, n)

'STATIC p, pp

IF n <= 1 THEN EXIT SUB

LINE (Lx, Ly)-(Rx, Ry), 0
LINE -(Sx, Sy)
LINE -(Lx, Ly)

'GOTO skip1

'L1x = (Sx - Lx) * 1 / 3 + Lx
'L1y = (Sy - Ly) * 1 / 3 + Ly

'CIRCLE (L1x, L1y), 5, 4

'R1x = (Sx - Lx) * 2 / 3 + Lx
'R1y = (Sy - Ly) * 2 / 3 + Ly

'CIRCLE (R1x, R1y), 5, 4

'X1x = (Sx - Lx) * 1 / 2 + Lx
'X1y = (Sy - Ly) * 1 / 2 + Ly

'OR

'CIRCLE (X1x, X1y), 5, 4

skip1:

'========= NOTICE =========
'pente :
'p = (Sy - Ly) / (Sx - Lx)
'pp = -1 / p
' -(Sx - Lx) / (Sy - Ly)

'Distance D :
'D = EQ * 1 / 3 * SQR(ABS((Sx - Lx) ^ 2 + (Sy - Ly) ^ 2))

'PRINT D

'S1x = X1x - SQR(ABS(D ^ 2 / (1 + pp ^ 2)))
'S1y = X1y - (SQR(ABS(D ^ 2 / (1 + pp ^ 2)))) * pp

'CIRCLE (S1x, S1y), 5, 4
'PRINT S1x, S1y

'CALL TRIAN((Sx - Lx) * 1 / 3 + Lx, (Sy - Ly) * 1 / 3 + Ly, (Sx - Lx) * 2 / 3 + Lx, (Sy - Ly) * 2 / 3 + Ly, (Sx - Lx) * 1 / 2 + Lx, (Sy - Ly) * 1 / 2 + Ly, ((Sx - Lx) * 1 / 2 + Lx) - SQR(ABS(D ^ 2 / (1 + (-(Sx - Lx) / (Sy - Ly)) ^ 2))), ((Sy - Ly) * 1 / 2 + Ly) - (SQR(ABS(D ^ 2 / (1 + (-(Sx - Lx) / (Sy - Ly)) ^ 2)))) * (-(Sx - Lx) / (Sy - Ly)), D / 3, C, n - 1)

CALL TRIAN((Rx - Sx) * 1 / 3 + Sx, (Ry - Sy) * 1 / 3 + Sy, (Rx - Sx) * 2 / 3 + Sx, (Ry - Sy) * 2 / 3 + Sy, (Rx - Sx) * 1 / 2 + Sx, (Ry - Sy) * 1 / 2 + Sy, ((Rx - Sx) * 1 / 2 + Sx) + SQR(ABS(D ^ 2 / (1 + (-(Rx - Sx) / (Ry - Sy)) ^ 2))), ((Ry - Sy) * _
1 / 2 + Sy) + (SQR(ABS(D ^ 2 / (1 + (-(Rx - Sx) / (Ry - Sy)) ^ 2)))) * (-(Rx - Sx) / (Ry - Sy)), D / 3, C, n - 1)

END SUB

Posted on Oct 6, 2010, 2:55 PM

# * WHAT do you think this is? Your own private forum????

R

Posted on Oct 6, 2010, 4:04 PM

# Awaiting program

What ever.

Good programming rules :

- Avoid nested loops, why ? because it's cumbersome. And for leaving from the inner loop it's like hell. (Exit For, exit for, exit for,...)

- use recursion

- avoid draw, this doesn't exist in more modern languages.

use recursion....

- No GOTO (spaghetti code... )

No division by zero also. Try to remember, when life was so tender.. and follow.

Posted on Oct 4, 2010, 5:59 AM

# Perpendicularity

SCREEN 12

CLS

X1 = 320
Y1 = 240

D = 100

FOR X2 = 120 TO 520 STEP 30

'X2 = 488
Y2 = 150

ON ERROR GOTO ERRORHANDLE

p = (Y2 - Y1) / (X2 - X1)
pp = -1 / p

PRINT pp

LINE (X1, Y1)-(X2, Y2), 1

xp = (320 + (X2 - X1) / 2 - ABS(X2 - 320))
yp = (240 + (Y2 - Y1) / 2 - ABS(X2 - X1) * pp)

LINE (320 + (X2 - X1) / 2, 240 + (Y2 - Y1) / 2)-(xp, yp), 3

xx = 320 + (X2 - X1) / 2 - SQR(ABS(D ^ 2 / (1 + pp ^ 2)))
yy = 240 + (Y2 - Y1) / 2 - (SQR(ABS(D ^ 2 / (1 + pp ^ 2)))) * pp

CIRCLE (xx, yy), 10, 4

'SLEEP 1

NEXT X2

ERRORHANDLE:

p = 1000

RESUME NEXT

END

Posted on Oct 4, 2010, 7:56 AM

# *Yup, all perpendicular -- also looks like some sort of weird, deep ocean fish.

R

*

Posted on Oct 4, 2010, 4:50 PM

# * This is only the helper program for the next fractal... if any (hard)

*

Posted on Oct 5, 2010, 1:50 PM

# I completely disagree with your condemnation of nested loops.

S

Without nested loops, you wouldn't be able to do any of this:

==========================================================

CLS 'Nested FOR-NEXT loop to print multiplication tables
FOR i = 1 TO 10
FOR j = 1 TO 5
PRINT j; "x"; i; "="; j * i,
NEXT j
PRINT
NEXT i
END

===========================================================

CLS
PRINT "Nested FOR-NEXT loops to print star formations"
PRINT
FOR x = 1 TO 10
FOR y = 1 TO x
PRINT "*";
NEXT y
PRINT
NEXT x
PRINT
FOR x = 10 TO 1 STEP -1
FOR y = x TO 1 STEP -1
PRINT "*";
NEXT y
PRINT
NEXT x
END

===========================================================

REM Triangle formations using nested FOR loops
CLS
INPUT "Enter your name:  ", name\$
n = LEN(name\$)
PRINT
PRINT "8 different triangle formations will be shown."
INPUT "Keep pressing Enter to continue after each ?  ", E\$
CLS
FOR x = 1 TO n
FOR y = 1 TO x
PRINT MID\$(name\$, x, 1);
NEXT y
PRINT
NEXT x
PRINT : INPUT E\$: CLS
FOR x = n TO 1 STEP -1
FOR y = 1 TO x
PRINT MID\$(name\$, n + 1 - x, 1);
NEXT y
PRINT
NEXT x
PRINT : INPUT E\$: CLS
FOR x = 1 TO n
PRINT SPC(n - x);
FOR y = 1 TO x
PRINT MID\$(name\$, x, 1);
NEXT y
PRINT
NEXT x
PRINT : INPUT E\$: CLS
FOR x = n TO 1 STEP -1
PRINT SPC(n - x);
FOR y = 1 TO x
PRINT MID\$(name\$, n + 1 - x, 1);
NEXT y
PRINT
NEXT x
PRINT : INPUT E\$: CLS
FOR x = 1 TO n
FOR y = 1 TO x
PRINT MID\$(name\$, n - x + 1, 1);
NEXT y
PRINT
NEXT x
PRINT : INPUT E\$: CLS
FOR x = n TO 1 STEP -1
FOR y = 1 TO x
PRINT MID\$(name\$, x, 1);
NEXT y
PRINT
NEXT x
PRINT : INPUT E\$: CLS
FOR x = 1 TO n
PRINT SPC(n - x);
FOR y = 1 TO x
PRINT MID\$(name\$, n - x + 1, 1);
NEXT y
PRINT
NEXT x
PRINT : INPUT E\$: CLS
FOR x = n TO 1 STEP -1
PRINT SPC(n - x);
FOR y = 1 TO x
PRINT MID\$(name\$, x, 1);
NEXT y
PRINT
NEXT x
END

===========================================================

REM Enter daily sales and compute weekly totals using nested FOR loops
CLS
DIM weeks AS INTEGER, days AS INTEGER, entries AS INTEGER
DIM snum AS STRING, x AS INTEGER, y AS INTEGER, z AS INTEGER
DIM wtot AS SINGLE, dtot AS SINGLE, gtot AS SINGLE, sale AS SINGLE
DIM numdays AS INTEGER, totavg AS SINGLE, dayavg AS SINGLE
INPUT "How many weeks"; snum\$
weeks = VAL(snum\$)
INPUT "How many days each week"; snum\$
days = VAL(snum\$)
INPUT "How many entries each day"; snum\$
entries = VAL(snum\$)
DIM avweek(1 TO weeks) AS SINGLE
DIM avday(1 TO days) AS SINGLE
FOR x = 1 TO weeks
PRINT "Enter sales for week"; x;
wtot = 0
FOR y = 1 TO days
dtot = 0
FOR z = 1 TO entries
PRINT TAB(30); "day #"; y;
PRINT "entry #"; z;
INPUT "  \$", snum\$
sale = VAL(snum\$)
dtot = dtot + sale
NEXT z
avday(y) = dtot / entries
wtot = wtot + dtot
PRINT TAB(5); "Sales for week"; x; "day"; y; "is \$"; dtot;
PRINT TAB(55); "Daily average is \$"; avday(y)
NEXT y
avweek(x) = wtot / days
gtot = gtot + wtot
PRINT "Total sales for week"; x; "is \$"; wtot;
PRINT TAB(50); "Weekly average is \$"; avweek(x)
PRINT
NEXT x
totavg = gtot / weeks
numdays = weeks * days
dayavg = gtot / numdays
PRINT : PRINT TAB(30); "SUMMARY"
PRINT : PRINT
FOR x = 1 TO weeks
PRINT : PRINT "WEEK"; x; "Daily averages:"
FOR y = 1 TO days
PRINT "Day"; y; "is \$"; avday(y)
NEXT y
PRINT "Average for week"; x; "is \$"; avweek(x)
NEXT x
PRINT : PRINT "Grand total sales for all"; weeks; "weeks is \$"; gtot
PRINT "Total weekly average is \$"; totavg
PRINT "Total daily average is \$"; dayavg
END

 This message has been edited by Solitaire1 on Oct 5, 2010 12:15 PMThis message has been edited by Solitaire1 on Oct 5, 2010 11:54 AMThis message has been edited by Solitaire1 on Oct 5, 2010 11:45 AM

Posted on Oct 5, 2010, 11:03 AM

# The cosmic power of recursion

No nested loop, Solitaire :) but reversed display...

=======================

DECLARE SUB TRIAL (M, n)

CLS 'Nested FOR-NEXT loop to print multiplication tables
FOR i = 1 TO 10
FOR j = 1 TO 5
PRINT j; "x"; i; "="; j * i,
NEXT j
PRINT
NEXT i

SLEEP

CLS

n = 5

FOR M = 1 TO 10
CALL TRIAL(M, n)
PRINT
NEXT M

SLEEP
SYSTEM
END

SUB TRIAL (M, n)

if n =< 0 THEN EXIT SUB

PRINT M; "x"; n; "="; M * n,

CALL TRIAL (M, n - 1)

END SUB

Posted on Oct 6, 2010, 2:01 AM

# You can get out of nested FOR loops using a one loop DO loop

R

DO
FOR x = 0 TO 30000

FOR y = 0 TO 30000

IF INKEY\$ <> "" THEN EXIT FOR

NEXT: NEXT

LOOP UNTIL 1 = 1 'just make true statement for one loop

PRINT "DONE FORs!"

FOR i = 1 TO 1 ' Same thing with DO using a one loop FOR loop

DO '2, count them, 2 endless loops
DO

IF INKEY\$ <> "" THEN EXIT FOR

LOOP
LOOP

NEXT

PRINT "DONE DO's!"

Posted on Oct 6, 2010, 3:01 AM

# * Ctrl + Alt + Sup ? :)

*

Posted on Oct 6, 2010, 3:36 AM

# Trouble of elimitating redundancy ?

An attempt of finding all possibles combinations of 3 numbers, with recursion. But this is not working... at least because of many redundancies.

DECLARE SUB comb (M, n, o)

CLS

M = 3: n = 3: o = 3

'FOR M = 1 TO 3
CALL comb(M, n, o)
PRINT
'NEXT M

SLEEP
END

SUB comb (M, n, o)

IF M <= 0 OR o <= 0 OR n <= 0 THEN EXIT SUB

'IF o <> n AND n <> M THEN
PRINT STR\$(M); STR\$(n); STR\$(o),
'END IF

CALL comb(M, n, o - 1)
CALL comb(M, n - 1, o)
CALL comb(M - 1, n, o)

END SUB

Posted on Oct 6, 2010, 3:29 AM

# Draw not good for fractals

Cannot eliminate the line in order to make it 1 piece... So i have to do it the hard way, with Pythagoras.

COMMON SHARED B, BY, C

SCREEN 12

'INPUT "n "; n
'INPUT "C "; C

n = 7

C = 15

CONST EQ = .8860254#
B = 200 ' half edge
H = (B * 2 * EQ) ' high
X = 320 ' Sommet 0
C = 15 ' Color
BY = 480 - ((480 - (B * 2 * EQ)) / 2) ' Base line

'Coordinates

PSET (X - B, BY)
DRAW "S4 r400 ta30 U400 ta-30 D400"

PSET (X - B + B / 3, BY - H / 3)
DRAW "S4 ta60 r133 ta90 U133 ta30 D133"

END

Posted on Oct 6, 2010, 7:35 AM

# Scan codes ?

Is it possible to print the keyboard's scan codes, with Qbasic or any other mean ? i have Dobox... on C1000. Qbasic is running. I need the scan codes for setting up Xkeyb.

FR.KEY

50 , ? #0 #0 #0
51 ; . #0 #0 <
52 : / #0 #0 >
53 #33 õ #0 #0 #0
86 < > #0 #0 #0

[SHIFTS]
54 42 29 56 70 69 58 82

SHIT1-SHIFT2-CTRL-ALT

You can see that ALT is here bind to key 56, which i don't have.

Example, if i replace 56 with 52, the "/" key will be Alt.

Or if i replace one of the SHifts with 56 they will be Alt....

The scan code for "/" is 52, the first number from the line.

I need a way to get all these codes from my Zaurus Keyboard...

thanks, l

Posted on Oct 1, 2010, 1:34 AM

# INP(&H60)

R

DO
code = INP(96)
IF code <> pcode THEN LOCATE 10, 10: PRINT code; " "
K\$ = INKEY\$ 'clear kb buffer
pcode = code
LOOP UNTIL K\$ = CHR\$(27)

 This message has been edited by burger2227 on Oct 1, 2010 2:04 AMThis message has been edited by burger2227 on Oct 1, 2010 2:03 AM

Posted on Oct 1, 2010, 2:02 AM

# OK

But it crashs the Dosbox :)

It was exactly what i meant ...

Posted on Oct 1, 2010, 3:19 AM

# Why you using DOSBOX, LOL? Use QB64

R

QB64 can run that code! You should not need DOSBOX. Galleon is gonna update QB64 soon so that foreign computers should not have keyboard problems anymore.

Only Ben still uses that stuff!

Posted on Oct 1, 2010, 12:44 PM

# Zaurus C1000

I'm trying to test a few Qbasic programs on this Sharp PDA, which runs linux. Also, not a single person on the world thought about putting the scan codes on the web... And, my ROM (Cacko) can't run Showkeys, nor Keydump. So i'm tipping in the dark guessing for scan codes, trying to do my best with xkeyb. But i'm relying now of someone give me the codes :)

The reason is that Dosbox... gosh, all this stuff is more or less abandon ware and obsolete hardware : Dosbox cannot map correctly the keys. Mapper.txt is ignored, imho, on 0.63.

Posted on Oct 1, 2010, 3:21 PM

# *Can't you find the codes on your PC?

Moderator

Posted on Oct 1, 2010, 4:15 PM

# HERE, I hope you can use bitmaps

R

These codes are from my demonstrator.

Ted

Posted on Oct 1, 2010, 5:06 PM

# * That's purddy! :)

Posted on Oct 1, 2010, 6:57 PM

# * It's purddy because it is in SCREEN 12

R

Posted on Oct 1, 2010, 9:20 PM

# Very nice :-)

BTW there is a much more difficult fractal to program...

The previous i posted where only with shifting and /, *, +...

Posted on Oct 2, 2010, 12:43 AM

# Can you use PEEK? You can read the CAPS, SHIFT, ALT, CTRL NUM LOCK etc.

R

DEF SEG = 0
DO
port = PEEK(1047)
IF port > 0 THEN LOCATE 26, 19: COLOR 11: PRINT "Turn ALL Locks off to see each key's bit value!"
COLOR 14: LOCATE 8, 23: PRINT "PEEK(1047) ="; port; "'save initial value to reset later! "
LOCATE 9, 45
IF (port AND 4) = 4 THEN COLOR 10: PRINT "CTRL KEY PRESSED " ELSE COLOR 12: PRINT "CTRL KEY RELEASED"
LOCATE 10, 45
IF (port AND 8) = 8 THEN COLOR 10: PRINT "ALT KEY PRESSED " ELSE COLOR 12: PRINT "ALT KEY RELEASED"
LOCATE 13, 45
IF (port AND 16) = 16 THEN COLOR 10: PRINT "SCROLL LOCK ON " ELSE COLOR 12: PRINT "SCROLL LOCK OFF"
LOCATE 17, 45
IF (port AND 32) = 32 THEN COLOR 10: PRINT "NUMBER LOCK ON " ELSE COLOR 12: PRINT "NUMBER LOCK OFF"
LOCATE 21, 45
IF (port AND 64) = 64 THEN COLOR 10: PRINT "CAPS LOCK ON " ELSE COLOR 12: PRINT "CAPS LOCK OFF"
LOCATE 25, 45
IF (port AND 128) = 128 THEN COLOR 10: PRINT "INSERT MODE ON " ELSE COLOR 12: PRINT "INSERT MODE OFF"
Align 11, 29, "Press mode keys to change or ESC to quit!"
LOOP UNTIL INKEY\$ = CHR\$(27) 'escape key exit
DEF SEG

Posted on Oct 2, 2010, 7:41 AM

# *Align ? (syntax error)

*

Posted on Oct 2, 2010, 9:09 AM

# i think thats clippys stupid text center routine

Posted on Oct 2, 2010, 9:16 AM

# STUPID people post anonymously cause they have no guts!

R

SUB Align (Tclr, Trow, txt\$)
Tcol = 41 - (LEN(txt\$) \ 2)
COLOR Tclr: LOCATE Trow, Tcol: PRINT txt\$;
END SUB

Don't mind the ASS, if I ran this forum, he would be long gone. He contributes nothing here and is an imbecile derelict.

 This message has been edited by burger2227 on Oct 2, 2010 9:51 AM

Posted on Oct 2, 2010, 9:47 AM

# This is working !

Thanks Clippy, this works, at least, since on the Zaurus for the moment i didn't map Alt, nor Scroll, and Insert, or num...

It shows me Ctrl, and Shift (shift prints 0E 52)

Mapped in xkeyb to :

[SHIFTS]
54 42 29 56 70 69 58 82

54 or 42 (scan codes)...

'Just completed SCREEN 12.

Any chance to see scan codes ?

=========================================================

DECLARE SUB Align (Tclr, Trow, txt\$)

SCREEN 12

DEF SEG = 0
DO
port = PEEK(1047)
IF port > 0 THEN LOCATE 26, 19: COLOR 11: PRINT "Turn ALL Locks off to see each key's bit value!"
COLOR 14: LOCATE 8, 23: PRINT "PEEK(1047) ="; port; "'save initial value to reset later! "
LOCATE 9, 45
IF (port AND 4) = 4 THEN COLOR 10: PRINT "CTRL KEY PRESSED " ELSE COLOR 12: PRINT "CTRL KEY RELEASED"
LOCATE 10, 45
IF (port AND 8) = 8 THEN COLOR 10: PRINT "ALT KEY PRESSED " ELSE COLOR 12: PRINT "ALT KEY RELEASED"
LOCATE 13, 45
IF (port AND 16) = 16 THEN COLOR 10: PRINT "SCROLL LOCK ON " ELSE COLOR 12: PRINT "SCROLL LOCK OFF"
LOCATE 17, 45
IF (port AND 32) = 32 THEN COLOR 10: PRINT "NUMBER LOCK ON " ELSE COLOR 12: PRINT "NUMBER LOCK OFF"
LOCATE 21, 45
IF (port AND 64) = 64 THEN COLOR 10: PRINT "CAPS LOCK ON " ELSE COLOR 12: PRINT "CAPS LOCK OFF"
LOCATE 25, 45
IF (port AND 128) = 128 THEN COLOR 10: PRINT "INSERT MODE ON " ELSE COLOR 12: PRINT "INSERT MODE OFF"
Align 11, 29, "Press mode keys to change or ESC to quit!"
LOOP UNTIL INKEY\$ = CHR\$(27) 'escape key exit
DEF SEG

END

SUB Align (Tclr, Trow, txt\$)
Tcol = 41 - (LEN(txt\$) \ 2)
COLOR Tclr: LOCATE Trow, Tcol: PRINT txt\$;
END SUB

Posted on Oct 2, 2010, 11:49 AM

# Looks like you want to run a forum, can I help?

If you could manage to tone down the rhetoric, and come up with more constructive ways to deal with problem posters, sure, you probably could get mod privilages.

In the future, please consider that. I don't want to bother flagging posts, that experiment didn't go well when Mac tried it, and I fully get why. My take on this is there isn't enough wood left around here to bother starting a flame war, anyway.

Pete

Posted on Oct 2, 2010, 2:47 PM

# * I considered that, but I didn't want you to be overwhelmed with posts from Phylo. :-)

R

Posted on Oct 2, 2010, 5:04 PM

# Just checking...

Just checking to see if anything new has come up....

Posted on Oct 6, 2010, 8:07 PM

# Are you under the impression that I've posted recently?

Moderator

The last time I posted was before school started, over two months ago, in this thread: http://www.network54.com/Forum/648955/message/1280445220/What+if

Just in case you thought I'd been posting anonymously or something.

PhyloGenesis

- QBasic Rules - Mac (RIP)

Posted on Oct 26, 2010, 12:29 AM

# Complete scankey program listed in sub-forum:

S

 This message has been edited by Solitaire1 on Oct 1, 2010 10:02 AM

Posted on Oct 1, 2010, 9:59 AM

# *It's official, I need glasses. I swore I read it as: "Complete skanky program..."

Posted on Oct 2, 2010, 2:49 PM

I have got all kind of connections to QBasic via Google, but don't see a way to download it onto my Vista laptop. Help please. Thanx.

Posted on Sep 30, 2010, 10:42 AM

# * Can't you unzip it or what?

R

Posted on Sep 30, 2010, 11:50 AM

# Iff your Vista is 64-bit, don't bother...

QB only runss on 32 and 16-bit platforms. go to www.qb64.net, instaed. If your vista is 32-bit, Some of QB will work. but you won't be able to run any graphics programs, as Vista doesn't support full-screen mode.

Pete

Posted on Sep 30, 2010, 12:00 PM

# Simple DARN recursive circles fractal !

Beware, this is TRUE : All you wanted to know about recursivity without darning to ask, in a demo. Ye it is unbelievable.

I would be glad to see a *clear* code for this with nested loops :) Or anything ITERATIVE.

Does QB64 run recursive code ?

And don't run this with n = 32, this ends never on my P III 750 Mhz, while n = 16 is still ok.

=============== CODE =================

DECLARE SUB CIRCLES (X, Y, R, C, n)
COMMON SHARED n, X, Y, R, C

SCREEN 12

n = 16

X = 320
Y = 240
R = 220
C = 1

PSET (X, Y)
CIRCLE (X, Y), R, C

CALL CIRCLES(X, Y, R, C, n)

a\$ = INPUT\$(1)

SYSTEM
END

SUB CIRCLES (X, Y, R, C, n)

IF n <= 0 THEN EXIT SUB

CIRCLE (X, Y), R, C

CALL CIRCLES(X - (R / 2), Y, (R / 2), 1, n - 1)

CALL CIRCLES(X + (R / 2), Y, (R / 2), 5, n - 1)

END SUB

Posted on Sep 28, 2010, 8:14 AM

# Re: Simple DARN recursive circles fractal !

http://www.network54.com/Forum/648955/message/1252828047/This+method+will+be+hard+to+better---

Posted on Sep 28, 2010, 8:30 AM

# Sorry but this is not the spirit of recursion ;-)

Is recursion only the fact of calling one's self ? no... In that case it can be replaced by a loop.

I tried something like this before posting my code, like here : the counter was put inside the sub. This didn't make any sens.

My code here is a level beyond that :-) :

1) the counter is put inside the set of variables called by the sub (n)
2) the sub calls itself twice.

In fact circles are draw in 2 ^ n times. The recursion is true, it's not a loop... each time we have x 2 more circles. This is exponential calling.

If a function is calling it self, it also like f(n - 1).

Posted on Sep 28, 2010, 8:48 AM

Moderator

Posted on Oct 1, 2010, 8:57 PM

# Triangle fractal recursiv

DECLARE SUB TRI (X, BY, B, H, C, n)

COMMON SHARED B, BY, C

SCREEN 12

n = 8

CONST EQ = .8860254#
B = 200 ' half edge
H = (B * 2 * EQ) ' high
X = 320 ' Sommet 0
C = 15 ' Color
BY = 480 - ((480 - (B * 2 * EQ)) / 2) ' Base line

' coordinates :

'BL = (320 - B, BY) ' base left
'BR = (320 + B, BY)
'S = (320, BY - (B * 2 * .866)) ' peak

'PSET (320, 240)

LINE (X - B, BY)-(X + B, BY), C
LINE -(X, BY - H), C
LINE -(X - B, BY), C

'Upside Down :

'S = (320, BY)
'RU = (320 + B / 2, BY - ((B * 2 * EQ)) / 2)
'LU = (320 - B / 2, BY - ((B * 2 * EQ)) / 2)

LINE (X, BY)-(X + B / 2, BY - H / 2), C
LINE -(X - B / 2, BY - H / 2), C
LINE -(X, BY), C

CALL TRI(X, BY, B, H, C, n)

a\$ = INPUT\$(1)

SYSTEM

END

SUB TRI (X, BY, B, H, C, n)

IF n <= 1 THEN EXIT SUB

LINE (X, BY)-(X + B / 2, BY - H / 2), C
LINE -(X - B / 2, BY - H / 2), C
LINE -(X, BY), C

CALL TRI(X - B / 2, BY, B / 2, H / 2, C, n - 1)
CALL TRI(X + B / 2, BY, B / 2, H / 2, C, n - 1)

CALL TRI(X, BY - H / 2, B / 2, H / 2, C, n - 1)

END SUB

Posted on Sep 28, 2010, 12:19 PM

# Beautiful! ...

R

The triangles remind me of lace or jewelry -- btw, both the circle and triangle examples run fine in QB64 -- and are completed instantly!

-Bob

P.S. I'd hate to have to guess the number of triangles on the latest example!

Posted on Sep 28, 2010, 1:47 PM

# Colors

Have you notice one can tweak the colors ? like here :

CALL TRI(X - B / 2, BY, B / 2, H / 2, 1, n - 1)
CALL TRI(X + B / 2, BY, B / 2, H / 2, 2, n - 1)

CALL TRI(X, BY - H / 2, B / 2, H / 2, 3, n - 1)

Replace C with any color code.

It is then really nice. But i'm much more amazed by beauty of the code : Only 3 lines to draw a fractal, easy readable code, working like a charm !

The number of triangles grows by a factor 3 with n :)

The total number.. ok.

I'm just wondering if i can do the arithmetic challenge i posted few days ago, with recursivity...

Posted on Sep 28, 2010, 2:13 PM

# *The colors thing is great, and yes, I should have commented on the code -- very elegant!

R

*

Posted on Sep 28, 2010, 7:53 PM

# *Thanks, but not running in XP ?

*

Posted on Sep 29, 2010, 12:14 PM

# I have Windows 7...

R

I tried it under DOSBox and it ran fine -- a bit slower than QB64 but fine. Like I said, it's instantaneous in QB64.

Not sure why it won't run in XP. Do other graphics programs run? I've run QBasic graphics programs in XP 32-bit just fine. XP 64-bit, they won't work and you must use a DOS emulator like DOSBox. Fortunately, with QB64 those days are behind me.

-Bob

Posted on Sep 29, 2010, 6:00 PM

# Vesa stuff .. ?

I guess it's an XP problem like here, and maybe it was Clippy who made that "patch" ? (bugerXXXX)

i didn't try it yet... it's my dad's PC.

Posted on Sep 30, 2010, 3:43 AM

# I didn't make the patch. Found it at Phatcode.net.

R

Another fix is to copy Autoexec.NT found in Repair folder if QB won't run correctly:

COPY C:\Windows\Repair\AutoExec.nt C:\Windows\System32

Just make a BAT file or run from command line. The file in the Repair folder is an original copy. As are the other files in that folder.

 This message has been edited by burger2227 on Sep 30, 2010 9:58 AM

Posted on Sep 30, 2010, 9:42 AM

# Micro\$oft's goal is to eventually create operating systems that any idiot can run...

But for now we're content to create operating systems that any idiot can own.

Posted on Sep 30, 2010, 8:07 PM

# *I would love to see how many they would sell, if they didn't come bundled with new comps!

R

*

Posted on Oct 1, 2010, 11:55 AM

# on error goto

I'm trying to delete some .tmp files from one directory, everything is ok but when there is no file i got an error, how I can skip that? I tried this.

on error goto salir
kill ("C:\test\*.tmp")
print "Files Deleted"
sleep 3
end
salir:
print "There are no files to delete"
on error goto 0
resume next
end

Posted on Sep 27, 2010, 12:37 PM

# on error goto 0 ??

What for ? i would delet that.

Posted on Sep 27, 2010, 1:52 PM

# Deleted

Ok, deleted, the main problem is: when I try to compile my .bas the compiler says

warning errors 0
severe errors 2

on error goto salida
^missing on error (/E) option
resume next
^ Missing resume next (/X)

Posted on Sep 27, 2010, 2:03 PM

# Use those options when compiling with BC.exe

R

SHELL "BC MODULE1.BAS /O/S/E/X;"

or command line: BC MODULE1.BAS /O/S/E/X;

Posted on Sep 27, 2010, 2:51 PM

# Open each FOR APPEND before killing them

R

Open each file name with APPEND. It will create files that don't exist.

OPEN file\$ FOR APPEND AS #1
CLOSE #1
KILL file\$

WHY are you trying to kill non-existant files? That's silly!

Posted on Sep 27, 2010, 3:00 PM

# Re: Open each FOR APPEND before killing them

I don't want to kill non-existant files, but what happen if I run my .exe one time? everything is good right? what about twice? that's the error I don't want, I tried to skip error the way I showed you but now the problem is compiling .bas, Ok, I will follow up your advice, I create at least one file before kill.

thank you very much to all of you, and sorry for my english!!

Posted on Sep 29, 2010, 12:46 PM

# Unfortunately you gotta OPEN them to check em

R

You don't want to OPEN FOR INPUT ...error if not exist!

OPEN FOR OUTPUT blanks the file, so APPEND, BINARY or RANDOM are the only safe modes to use if you want to see if they exist.

THAT creates a file if it DID NOT exist, but you are gonna kill them anyhow.

WHAT would you suggest and if so, WHY ASK US?????????

WARNING! Using KILL *. ANYTHING is NOT a good idea unless you KNOW what you are doing! YOU DON'T APPARENTLY!

 This message has been edited by burger2227 on Sep 29, 2010 3:25 PM

Posted on Sep 29, 2010, 3:24 PM

# I would change the code a bit, too...

on error goto salir
kill ("C:\test\*.tmp")
on error goto 0
of er1 = 0 the print "Files Deleted" else print "There are no files to delete"
sleep 3
end

salir:
er1 = ERR
resume next
end

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

Pete

PS BC with compiler switches /O/S/E/X; For some reason, I never forget them. If you auto-compile with QB, they will be automatically added when the compiler detects the error handler statement.

PPS Clippy uses them too, but he compiles by hand. :O

Posted on Sep 28, 2010, 12:00 AM

# Correct way to check for file existence:

S

There are two different approaches. The first is by using an error handler:

CLS
flag = 0
INPUT "Enter filename: ", filenom\$
ON ERROR GOTO check
OPEN filenom\$ FOR INPUT AS #1
IF flag = 1 THEN
PRINT "File does not exist."
flag = 0
ELSE
PRINT "File "; filenom\$; "exists."
CLOSE #1
END IF
END

check:
flag = 1
RESUME NEXT

========================================================================

The second way is much simpler. However, if the file exists but is empty, it will be deleted:

CLS
INPUT "Enter file name: ", filenom\$
OPEN filenom\$ FOR APPEND AS #1
N = LOF(1)
CLOSE #1
IF N = 0 THEN
PRINT "File does not exist"
KILL filenom\$
ELSE
PRINT "File "; filenom\$; exists; ""
END IF
END

 This message has been edited by Solitaire1 on Sep 30, 2010 4:33 PM

Posted on Sep 28, 2010, 12:09 PM

# * ? exists; "" :-)

R

Posted on Sep 29, 2010, 9:25 PM

# access qbasic

I have windows xp. I am assuming that I have qbasic installed as part of windows. I bought the book qbasic for dummies. It tells me to enter qbasic.exe in the directory, but I don't know how to get to the directory. Thank you for your help.

Posted on Sep 26, 2010, 8:32 AM

# Wrong

False assuming

Then install Locate32.

Posted on Sep 26, 2010, 8:51 AM

# Don't assume anything.

QBasic is NOT installed with Windows, never was. It came with MS-DOS version 5. It's a DOS program and is no longer compatible with the newer versions of Windows.

You need to download QBasic and install it yourself, in a directory of your choosing. This program is text-based. You must be familiar with the Command prompt and DOS commands in order to proceed with installation.

You can get to the Command prompt in Windows XP by clicking Start in the bottom left corner of the desktop. Then click Run and type CMD. At this point you need to start entering DOS commands. To exit the Command window, type EXIT and press the Enter key.

Note: A DOS directory is equivalent to a Windows folder. You can bypass the Command prompt window by copying the QBasic program to a folder. In order to run the program, you need to click on the QB.EXE file. This is NOT a regular Windows installation. All DOS programs are simply copied to a folder/directory and run directly from the EXE file.

Posted on Sep 26, 2010, 10:33 AM

# Or

Theres a active forum where you can ask any questions you want, and QB64 makes doing a lot of stuff a lot easier. It can play mp3s, load images with one command and even use TCP/IP!! There are loads of demos and programs on the forum, have a look around ask anything you want, and have fun coding!!!

Posted on Sep 26, 2010, 11:57 AM

# Random Number Help

I need help writing random numbers. It must calculate a random number 1-18 and the outputs all numbers that add up to that number. Example: if a random number is 5 the output should look like:

1
2
3
4
5

Sorry for the amateur question but I've just started QB. Thanks for the help!

Posted on Sep 25, 2010, 8:07 PM

R

Posted on Sep 25, 2010, 9:36 PM

# Look up

Firstly, clippys right, i cant give you code, however i can point you in the right direction.

Look in the wiki, or qb helpfile if your using original qbasic for the following

RND
RANDOMIZE
TIMER

For the counting up to the number bit, use could use a FOR loop. Start at 1 and loop until your random number is reached.

Have a go and post your code, then i can help more.

Posted on Sep 25, 2010, 9:56 PM

# Some nice fractal

' DECLARE SUB TRI 'later...

SCREEN 12

CONST EQ = .8860254#
COT = 200 ' half edge
BY = 480 - ((480 - (COT * 2 * EQ)) / 2) ' Base line

' coordinates :

'BL = (320 - COT, BY) ' base left
'BR = (320 + COT, BY)
'S = (320, BY - (COT * 2 * .866)) ' peak

'PSET (320, 240)

LINE (320 - COT, BY)-(320 + COT, BY)
LINE -(320, BY - (COT * 2 * EQ))
LINE -(320 - COT, BY)

'Upside Down :

'S = (320, BY)
'RU = (320 + COT / 2, BY - ((COT * 2 * EQ)) / 2)
'LU = (320 - COT / 2, BY - ((COT * 2 * EQ)) / 2)

LINE (320, BY)-(320 + COT / 2, BY - ((COT * 2 * EQ)) / 2)
LINE -(320 - COT / 2, BY - ((COT * 2 * EQ)) / 2)
LINE -(320, BY)

' Low left :

LINE (320 - COT / 2, BY)-(320 - COT / 4, BY - ((COT * 2 * EQ)) / 4)
LINE -(320 - (COT / 4) * 3, BY - ((COT * 2 * EQ)) / 4)
LINE -(320 - COT / 2, BY)

' Low right :

LINE (320 - COT / 2 + COT, BY)-(320 - COT / 4 + COT, BY - ((COT * 2 * EQ)) / 4)
LINE -(320 - (COT / 4) * 3 + COT, BY - ((COT * 2 * EQ)) / 4)
LINE -(320 - COT / 2 + COT, BY)

' Up :

LINE (320 - COT / 2 + (COT / 2), BY - ((COT * 2 * EQ)) / 2)-(320 - COT / 4 + (COT / 2), BY - ((COT * 2 * EQ)) / 4 - ((COT * 2 * EQ)) / 2)
LINE -(320 - (COT / 4) * 3 + (COT / 2), BY - ((COT * 2 * EQ)) / 4 - ((COT * 2 * EQ)) / 2)
LINE -(320 - COT / 2 + (COT / 2), BY - ((COT * 2 * EQ)) / 2)

END

=================

Hand made, - depth ? not much.

The goal is to increase the depth using a RECURS(ed)IVE SUB...

Posted on Sep 24, 2010, 12:28 PM

# The Sorcerer's Apprentice

I searched for recursion in the archives also. It seems that it was not innvestigated as something different or special... But it is :

Now I'll throw myself upon you,
and the sharpness of my axe
I will test, o spirit, on you.
Well, a perfect hit!
See how he is split!
Now there's hope for me,
and I can breathe free!

Woe is me! Both pieces
come to life anew,
now, to do my bidding
I have servants two!
Help me, o great powers!

And they're running! Wet and wetter
get the stairs, the rooms, the hall!
What a deluge! What a flood!
Lord and master, hear my call!

CALL !

Posted on Sep 25, 2010, 8:04 AM

# You've given new meaning to recursion...

R

Who knew that black magic was a capability in QBasic.

BTW, your fractal triangles look promising. The output reminds me of that riddle: "How many triangles do you see?".

-Bob

 This message has been edited by qb432l on Sep 25, 2010 8:33 AM

Posted on Sep 25, 2010, 8:32 AM

# Sierpinsky recursiv

DECLARE SUB TRI (X, BY, B, H, C, n)

COMMON SHARED B, BY, C

SCREEN 12

n = 8

CONST EQ = .8860254#
B = 200 ' half edge
H = (B * 2 * EQ) ' high
X = 320 ' Sommet 0
C = 15 ' Color
BY = 480 - ((480 - (B * 2 * EQ)) / 2) ' Base line

' coordinates :

'BL = (320 - B, BY) ' base left
'BR = (320 + B, BY)
'S = (320, BY - (B * 2 * .866)) ' peak

'PSET (320, 240)

LINE (X - B, BY)-(X + B, BY), C
LINE -(X, BY - H), C
LINE -(X - B, BY), C

'Upside Down :

'S = (320, BY)
'RU = (320 + B / 2, BY - ((B * 2 * EQ)) / 2)
'LU = (320 - B / 2, BY - ((B * 2 * EQ)) / 2)

LINE (X, BY)-(X + B / 2, BY - H / 2), C
LINE -(X - B / 2, BY - H / 2), C
LINE -(X, BY), C

CALL TRI(X, BY, B, H, C, n)

a\$ = INPUT\$(1)

SYSTEM

END

SUB TRI (X, BY, B, H, C, n)

IF n <= 1 THEN EXIT SUB

LINE (X, BY)-(X + B / 2, BY - H / 2), C
LINE -(X - B / 2, BY - H / 2), C
LINE -(X, BY), C

CALL TRI(X - B / 2, BY, B / 2, H / 2, C, n - 1)
CALL TRI(X + B / 2, BY, B / 2, H / 2, C, n - 1)

CALL TRI(X, BY - H / 2, B / 2, H / 2, C, n - 1)

END SUB

Posted on Sep 28, 2010, 12:18 PM

# *That's Sierpiński to you.

Moderator

Posted on Sep 30, 2010, 6:05 PM

# * I did not know that Australians used oomlauts! :-P

R

Posted on Sep 30, 2010, 6:08 PM

# * Tak, rozumiem, miniej więcej

*

Posted on Oct 1, 2010, 3:24 PM

# * It is a fractal. Looking like Sierpinki's, very close.

*

Posted on Oct 1, 2010, 3:28 PM

# problem with GOTO commmand inside SUB

hello ppl,

i'll make it short
i use a QBX 7.1 qbasic compiler.
and i'm programming a progam that need's to
open a sub routine inspect which button pressed or mouse
and go to the defined choosen label outside of the sub!
in the main program area.

but when i type let's say "goto NEW" new is name of the label
inside the sub it gives me "error 8" label not defined something
i must add that label "NEW" is located outside of the sub in
the main program area.

i need to go to the label "new" from inside of the sub
pl'z help

YanR,
10x.

Posted on Sep 23, 2010, 12:26 PM

# GOTO

You have to exit the sub and return before the label, with a flag for example to tell the main what to do. At least in QB 4,5.

Or put the code you want to run in the main into another SUB and call it from your SUB.

Posted on Sep 23, 2010, 12:45 PM

# GOTO inside SUB

I don't quite get it, if i exit the sub
it will exit to commands under the sub.

and what is a flag and how do i put it?

i can't put it into anthor sub it's a big program,
with lot's of integers and strings.

please show QB code with example next time, if u can.

is there maybe a command to make the label shared or something like that?

YanR
10x

Posted on Sep 23, 2010, 12:57 PM

# 2 cents..

If someone can tell better ?

Please look at Buffer (TXT1\$). The only way i have to go to Start0 label i want to, is to wait for the SUB has returned from where it was called, line 3. In QB 4.5 i don't know an other way ! But after RETURNed, i check the flag (line 4, 5) and then from this place i can GOTO the label...

IF PRINTX > linelength% THEN
GOSUB LineCut
Buffer (TXT1\$)
IF flags% = 1 THEN GOTO Start0 'new start after search routin
IF flagtf% = 1 THEN GOTO Start0
GOTO PRINTALL
ELSE
Buffer (linebuf\$)
IF flags% = 1 THEN GOTO Start0 'same
IF flagtf% = 1 THEN GOTO Start0
END IF

Posted on Sep 23, 2010, 2:13 PM

# even better dont use GOTO

It is old and outdated, and viewed by most as bad coding practice. It makes it hard for others to read your code, and can make it difficult in debugging. Try using a main do loop with triggered calls to subs that perform specific tasks. Other than that i cant help sorry, but best of luck.

Posted on Sep 23, 2010, 7:26 PM

# Sure

I know other bad practices :

-Nested loops, :)

To prevent people accidentally understanding your code... Same as the Hight Priest in ancient Egypt : The secret must be kept away from profane.

Posted on Sep 24, 2010, 12:55 AM

# Nested loops are necessary,

especially when working with arrays, or validating data within a loop.

Posted on Sep 26, 2010, 3:33 PM

# * Another thing to avoid...being French! Nasty people! :-P

R

Posted on Sep 26, 2010, 8:38 PM

hey guys, I'm really confused about qbasic. I need to learn how to loop, and in doing so create a line of circles going across the middle of the screen. I have no idea how to do this, can anyone help me?

Posted on Sep 22, 2010, 10:02 PM

# * Homework? Post what you have done so far.

R

Posted on Sep 22, 2010, 10:29 PM

# Loop demo

First, you should post your code. Second here's a Do style loop that exits when you press the Esc key

DO:LOOP UNTIL INKEY\$ = CHR\$(27)

if you need to do something a set number of times you can use a FOR loop

for i = 1 to 100
print i
next

will print 1 to 100 on the screen

in older basic you could (qbasic supports it)

i = 0
while i < 100
i = i + 1
print i
wend

this will also print 1 to 100 on the screen

for the drawing of circles, you will need to be in a graphics display mode (any screen mode above 0) and know how to draw circles. Look up CIRCLE, PSET, DRAW, and PAINT all available in the qb64 wiki http://qb64.net/wiki/index.php?title=Main_Page , or if your using original qbasic, press shift and F1 and use the index.

Posted on Sep 23, 2010, 7:19 PM