QBasic Forum BASIC Discussion Board

[QB FAQ] [QB Archives, Links and Downloads] [Subforums and Chat Room] [Search]

Run QBasic Code on Modern Systems:  QB64   Post Code or Ask for Help:  Post Code   Homework Policy



Earlier problem with File/Path Access Error

by (no login)

I had an issue last month with not being able to save any new files to my QBasic directory, including files opened for output within BAS files. At the time I was also having other problems with my computer's operation and I eventually found the problem - one or more drivers were corrupted, which seemed to affect the overall performance. I wasn't able to find which drivers were corrupted, so I chose to do a complete factory reinstall of the computer. This solved some of the issues, although not all of them, but it completely fixed the QBasic issues I had. Just wanted to say thanks for the suggestions I received at the time relating to these issues, even though there was no way of diagnosing the real problem at the time. I always find this forum very helpful.

Posted on Apr 14, 2013, 10:08 AM

Respond to this message   

Return to Index


*(URL) someone just posted a cool program in a very old topic

by (Login MCalkins)
Moderator

http://www.network54.com/Forum/648955/thread/1249609625/Moving+QBasic.com+from+one+host+to+another.

The post "test".

Regards,
Michael

Posted on Apr 10, 2013, 5:50 AM

Respond to this message   

Return to Index


Great stuff! ...

by (Login qb432l)
Mod

...and so little code to produce so much.
I edited it to eliminate the line down to the right and to make the patterns all draw within screen size. I also added a more effective Escape key exit:

DEFSNG A-Z
SCREEN 12

DO
i = i + 1
a = 100 * COS(i / 10)
b = 10 * SIN(i / 10)

LINE (0, 0)-(640, 480), 0, BF
FOR t = 0 TO 100 STEP 0.01
IF t = 0 THEN Colr = 0 ELSE Colr = 11
x = 120 * COS(t) + a * COS(b * t)
y = 120 * SIN(t) + a * SIN(b * t)
LINE -(x + 320, y + 240), Colr
NEXT
k$ = INPUT$(1)

LOOP UNTIL k$ = CHR$(27)
SYSTEM

Posted on Apr 11, 2013, 3:48 PM

Respond to this message   

Return to Index


Hold or press the space key

by (Login GarryRicketson)
R

That is pretty neat, but it should have a comment, to press the space key,... at first I thought, "just a circle, What is so great about that,.. Then I decided to see what happend if I press the space key,...some people might not figure that out.
thanks for sharing this,..
From Garry
P.S. The Bob, If I remember correctly, in your tutorial,or some where, I have seen a "animation" a FirePlace, with a yule log in it, at least I think it was animated, and the flames fickered, I have the tutorial, but have not been able to get it to compile and run, on my Linux, qb64,... so I was not able to look for the "demo",.. and then I am not positive that is where I saw it,.. If it is, and you remember, or know what I am reffering to, Would you mind, posting, or sending me, the .bas, just to run the "fireplace" or yule log,..
I was going to go to your graphics forum just now, but since I am here , I decided to ask here,.. thanks , from Garry

Posted on Apr 12, 2013, 4:22 PM

Respond to this message   

Return to Index


You're right about displaying instructions...

by (Login qb432l)
Mod

Perhaps on an opening screen before proceeding. In any case, it isn't my program - I only corrected a couple of flaws.

The fire you refer to is an example file that comes with my animation utility Animax. Both Animax and the file FIRE.AMV are bundled with QBG.ZIP. The example file will not run without Animax. If you want to run it separately (although it isn't that impressive) let me know and I'll post the necessary code.

-Bob

Posted on Apr 12, 2013, 5:13 PM

Respond to this message   

Return to Index


Please do, if

by (Login GarryRicketson)
R

""Perhaps on an opening screen before proceeding"", That is what I did, I added a
PRINT " Try hitting the space key"
SLEEP

"" If you want to run it separately (although it isn't that impressive) let me know and I'll post the necessary code. ""
If you don't mind, please do,it was so long ago, but if I remember, I had tried to figure out how to get it to run seperately, and never could, I do have the FIRE.AMV
Thanks,from Garry

Posted on Apr 12, 2013, 6:01 PM

Respond to this message   

Return to Index


Here's the code...

by (Login qb432l)
Mod

But as I said, it isn't very impressive all by itself. It runs in QB64 a little smoother than in QBasic, and you can replace the TIMER delay section with just _DELAY .08

NOTE: You will have to replace (less-than-symbol) with an actual less-than symbol for it to work. N54 has trouble with HTML symbols even if the formatted text box is un-checked.

-Bob


DIM FrameBOX(1 TO 1650) AS INTEGER

Red = 12
Grn = 2
Blu = 4
FrameSIZE& = 1650

OPEN "Fire.AMV" FOR RANDOM AS #1 LEN = 2
GET #1, 57, NumFRAMES%

SCREEN 12

OUT &H3C8, 0
FOR PaletteVALUE = 9 TO 56
GET #1, PaletteVALUE, Intensity%
OUT &H3C9, Intensity%
NEXT PaletteVALUE

DO
FOR n% = 0 TO NumFRAMES% - 1
FOR Index% = 1 TO 1650
GET #1, 57 + n% * FrameSIZE& + Index%, FrameBOX(Index%)
NEXT Index%
PUT (275, 200), FrameBOX(1), PSET
Flicker = INT(RND * 5)
OUT &H3C8, 11
OUT &H3C9, Red + Flicker
OUT &H3C9, Grn + Flicker
OUT &H3C9, Blu + Flicker
k$ = INKEY$
IF LEN(k$) THEN EXIT DO
StartTIME# = TIMER
DO
LOOP WHILE TIMER (less-than-symbol) StartTIME# + .01
NEXT n%
LOOP

CLOSE #1

SYSTEM

Posted on Apr 12, 2013, 6:57 PM

Respond to this message   

Return to Index


*THANKS!

by (Login GarryRicketson)
R

Posted on Apr 12, 2013, 7:01 PM

Respond to this message   

Return to Index


Thanks Again,

by (Login GarryRicketson)
R

It works great,..to me it is impressive,..
Now not only with qb64, but Linux,..
Do you mind if I share this, on qb64.net
too,.. ? I will be sure to include that it is you that wrote it.
thanks

Posted on Apr 12, 2013, 7:10 PM

Respond to this message   

Return to Index


*By all means, share anything of mine -- that's what Freeware is all about :-)

by (Login qb432l)
Mod

*

Posted on Apr 12, 2013, 8:08 PM

Respond to this message   

Return to Index


Space bar?

by Solitaire (no login)

Does it matter which key you press? I pressed random keys but not sure if it matters which one will get different results, or if it's just the same order no matter which keys are pressed.

Posted on Apr 12, 2013, 6:50 PM

Respond to this message   

Return to Index


Re: Space bar?

by (Login GarryRicketson)
R

No it dosen't, actually, but I had not tried it with just any key, duh,..so I didn't realize any key,.would work, it just happened that the space bar was the first key I tried,
If I had looked closer at the code, to start with I would have seen that,.. happy.gif sorry

Posted on Apr 12, 2013, 7:00 PM

Respond to this message   

Return to Index


Sequence

by Solitaire (no login)

Actually, it looks like the same sequence of designs no matter which key is pressed, every time the program is restarted. I just took a closer look at the code and saw that it uses any keypress with K$ = INPUT$(1).

I was wondering if it was possible to pick up the sequence somewhere in the middle, but unlikely, unless maybe the value of the counter in the DO loop is changed. It resembles a sequence of random numbers that are generated from a seed rather than from the timer, every time the program restarts.

Perhaps one of the keys can be dedicated to changing the counter to something other than 1, or the value of i can be changed before the DO loop starts. It would be fun to play around with it.

Posted on Apr 12, 2013, 7:04 PM

Respond to this message   

Return to Index


Revised code

by Solitaire (Login Solitaire1)
S

I added option to change the counter by pressing the Tab key. Here is the revised code:

=========================================================================================
CLS
PRINT "Press any key to continue; Tab to change counter; Esc to stop..."
K$ = INPUT$(1)

DEFSNG A-Z
SCREEN 12

DO
    i = i + 1
    a = 100 * COS(i / 10)
    b = 10 * SIN(i / 10)

    LINE (0, 0)-(640, 480), 0, BF
    FOR t = 0 TO 100 STEP .01
        IF t = 0 THEN Colr = 0 ELSE Colr = 11
        x = 200 * COS(t) + a * COS(b * t)
        y = 200 * SIN(t) + a * SIN(b * t)
        LINE -(x + 320, y + 240), Colr
    NEXT
    K$ = INPUT$(1)
    IF K$ = CHR$(9) THEN
        INPUT "Enter value of counter:  ", C$
        i = VAL(C$)
    END IF

LOOP UNTIL K$ = CHR$(27)
CLS
SYSTEM

Posted on Apr 12, 2013, 7:23 PM

Respond to this message   

Return to Index


*thats a neat addition

by (Login GarryRicketson)
R

Posted on Apr 12, 2013, 7:54 PM

Respond to this message   

Return to Index


Wondering....

by Solitaire (no login)

I was wondering if the sequence repeats at any point or if it has infinite variations. Also, is there a limit to the value of the counter (other than the limit of an Integer type) before it goes out of range and generates an error?

Posted on Apr 13, 2013, 8:31 AM

Respond to this message   

Return to Index


*You'd have to ask the OP, and no one knows exactly who it was (test).

by (Login qb432l)
Mod

*

Posted on Apr 13, 2013, 8:33 AM

Respond to this message   

Return to Index


it does repeat itself

by Docfxit (no login)

the variation in the pattern is determined by variables a, b and they repeat themselves being sin and cos functions:

SCREEN 12
FOR i = 0 TO 640
a = 100 * COS(i / 10)
b = 10 * SIN(i / 10)
PSET (i, a + 240)
PSET (i, b + 240)
NEXT

you can add randomness to the patterns by giving variables a and b a random value every ith iteration.

Posted on Apr 13, 2013, 12:42 PM

Respond to this message   

Return to Index


It may not

by lawgin (no login)

At least not exactly.
a = 100 * COS(i / 10)
b = 10 * SIN(i / 10)

When i=10:
a = 100 * COS(1)
b = 10 * SIN(1)

The arguments are in radians. In order for these to repeat the argument would have to be 1+pi,1+2pi,1+3pi,etc. But these are all irrational numbers, and the argument (i/10) is rational.

Posted on Apr 13, 2013, 2:53 PM

Respond to this message   

Return to Index


there are no irrational numbers in QB

by Docfxit (no login)

how do you explain this:

SCREEN 12
do
j=j+1
locate 1,1:? j
FOR i = j TO j+640
a = 100 * COS(i / 10)
b = 10 * SIN(i / 10)
PSET (i, a + 240)
PSET (i, b + 240)
NEXT
_display
_limit 50
loop until inp(&h60)=1

Posted on Apr 13, 2013, 8:54 PM

Respond to this message   

Return to Index


I mean this

by Docfxit (no login)

SCREEN 12
do
j=j+1
line(0,0)-(640,480),0,bf
line(320,0)-step(0,480),12
locate 1,1:? j
FOR i = 0 TO 640
a = 100 * COS((i+j) / 10)
b = 10 * SIN((i+j) / 10)
PSET (i, a + 240)
PSET (i, b + 240)
NEXT
_display
_limit 50
loop until inp(&h60)=1

Posted on Apr 13, 2013, 8:57 PM

Respond to this message   

Return to Index


Looks pretty and I see your point, but...

by lawgin (no login)

I checked to see if the variables a and b ever return to their initial values and it seems that they don't. Perhaps this is inherent with floating point arithmetic. This modified code has the initial values saved as ai and bi. The program should pause when these exact values pop up again.

DEFSNG A-Z
SCREEN 12

DO
i = i + 1
a = 100 * COS(i / 10)
b = 10 * SIN(i / 10)
IF i = 1 THEN ai = a: bi = b
IF i > 1 THEN IF (a = ai) AND (b = bi) THEN SLEEP


LINE (0, 0)-(640, 480), 0, BF
FOR t = 0 TO 100 STEP 0.01
IF t = 0 THEN Colr = 0 ELSE Colr = i MOD 8 + 1
x = 120 * COS(t) + a * COS(b * t)
y = 120 * SIN(t) + a * SIN(b * t)
LINE -(x + 320, y + 240), Colr
NEXT
k$ = INKEY$

LOOP UNTIL k$ = CHR$(27)
SYSTEM

Posted on Apr 14, 2013, 10:18 AM

Respond to this message   

Return to Index


Not as involved, but still kinda cool

by lawgin (no login)

Press any key, esc to exit


SCREEN 12
pi = 3.1415926
r = 240
DO
n = n + 1
FOR t = 0 TO 2 * pi STEP .001
x = r * COS(t) * SIN(n) ^ 2
y = r * SIN(t) * COS(n) ^ 2
PSET (x + 320, y + 240), n MOD 15
NEXT t
k$ = INPUT$(1)
LOOP UNTIL k$ = CHR$(27)

Posted on Apr 12, 2013, 7:10 PM

Respond to this message   

Return to Index


how do you know which functions to use and stuff to make those patterns?

by Docfxit (no login)

x = r * COS(t) * SIN(n) ^ 2
y = r * SIN(t) * COS(n) ^ 2

Posted on Apr 12, 2013, 7:49 PM

Respond to this message   

Return to Index


I don't know enough to explain

by (Login GarryRicketson)
R

But hopefully some one will,
in the meantime, there are a lot of tutorials
herhttp://www.petesqbsite.com/sections/tutorials/beginners.shtml

And another qood one is:
http://tedfelix.com/qbasic/index.html
Also if you use the search option, on this forum, type in " tutorials" it lists a whole bunch of them.
Another good place, is the QB64 wiki,
http://qb64.net/wiki/index.php

You can enter keywords, and get some good explanations, on the qbasic commands and key words, I would start with DRAW even though they do not use the command in these,
http://qb64.net/wiki/index.php?title=DRAW
and in that there is a link to
LINE
http://qb64.net/wiki/index.php?title=LINE
which they do use, and then there is a lot more,..
Best start out with just some simple circles,and elipes, etc,..
sorry i can't help more
EDITED:
ALSO at the wiki:
http://qb64.net/wiki/index.php?title=BASIC_Programming_Basics
Another good one for qbasic is
Clippy's "qbasics.zip"
qbasics.zip

Posted on Apr 12, 2013, 8:32 PM

Respond to this message   

Return to Index


I just started with a circle and improvised

by lawgin (no login)

The code below draws a circle. This was the starting point. The parts REMarked out were added strictly by experimentation. Trial and error. There was really nothing erudite involved.



SCREEN 12
pi = 3.1415926
r = 240
DO
REM n = n + 1
FOR t = 0 TO 2 * pi STEP .001
x = r * COS(t) REM* SIN(n) ^ 2
y = r * SIN(t) REM* COS(n) ^ 2
PSET (x + 320, y + 240) REM, n MOD 15
NEXT t
k$ = INPUT$(1)
LOOP UNTIL k$ = CHR$(27)

Posted on Apr 13, 2013, 10:47 AM

Respond to this message   

Return to Index


I like that, and was

by (Login GarryRicketson)
R

thinking about how to do something similar with the other one, adding different colors,..?

Posted on Apr 12, 2013, 8:04 PM

Respond to this message   

Return to Index


That's easily done

by lawgin (no login)

Using BOB's code as an example, change this:

IF t = 0 THEN Colr = 0 ELSE Colr = 11
to this:
IF t = 0 THEN Colr = 0 ELSE Colr = i MOD 15+1

This gives you 15 colors. If you only want 5, use MOD 5+1

Posted on Apr 13, 2013, 11:03 AM

Respond to this message   

Return to Index


* Very nice!

by Solitaire (no login)

Posted on Apr 13, 2013, 8:31 AM

Respond to this message   

Return to Index


* How did you get the different colors?

by Solitaire (no login)

Posted on Apr 13, 2013, 8:42 AM

Respond to this message   

Return to Index


Re: * How did you get the different colors?

by lawgin (no login)

PSET (x + 320, y + 240), n MOD 15

n MOD 15 is the color attribute. n increases by 1 for each loop, so n MOD 15 will vary from 0 to 14 sequentially.

Posted on Apr 13, 2013, 10:52 AM

Respond to this message   

Return to Index


experiment

by Mike (no login)

DECLARE SUB mouse (ax AS INTEGER, mb AS INTEGER, mx AS INTEGER, my AS INTEGER)

DIM SHARED m(7) AS LONG
m(0) = &H8BE58955
m(1) = &H48B0C76
m(2) = &H768B33CD
m(3) = &H8B1C890A
m(4) = &HC890876
m(5) = &H8906768B
m(6) = &H8CA5D14


DIM mb AS INTEGER, mx AS INTEGER, my AS INTEGER
SCREEN 12
mouse 1, mb, mx, my

CIRCLE (320, 240), 200, 8

DO
mouse 3, mb, mx, my

CIRCLE (520 - .5 * SQR((mx - 520) ^ 2 + (my - 240) ^ 2), 240), .5 * SQR((mx - 520) ^ 2 + (my - 240) ^ 2)
IF mb = 1 THEN
r1 = 200
r2 = .5 * SQR((mx - 520) ^ 2 + (my - 240) ^ 2)

LINE (0, 0)-(640, 480), 0, BF
CIRCLE (320, 240), 200, 8
CIRCLE (520 - .5 * SQR((mx - 520) ^ 2 + (my - 240) ^ 2), 240), .5 * SQR((mx - 520) ^ 2 + (my - 240) ^ 2), 8
SLEEP

FOR t = 0 TO 2 * 3.141593 STEP .01
x = r1 * COS(t) + r2 * COS(t * r2)
y = r1 * SIN(t) + r2 * SIN(t * r2)

LINE -(x + 320, y + 240)

NEXT


END IF

LOCATE 1, 1: PRINT mb, mx, my
LOOP UNTIL INP(&H60) = 1
SYSTEM

DEFINT A-Z
SUB mouse (ax AS INTEGER, mb AS INTEGER, mx AS INTEGER, my AS INTEGER)
DEF SEG = VARSEG(m(0))
CALL absolute(ax, mb, mx, my, VARPTR(m(0)))
END SUB

Posted on Apr 14, 2013, 11:46 AM

Respond to this message   

Return to Index


Alarmclock just ringing !

by (no login)

Sorry, hope i do not disturb every one's siesta.

Posted on Apr 7, 2013, 7:07 AM

Respond to this message   

Return to Index


*more bells ringing alot !

by (no login)

*

Posted on Apr 7, 2013, 12:25 PM

Respond to this message   

Return to Index


Simple general program structure

by (no login)

It looks like this to me :

1) Define object (& initial conditions)
DO
2) Initialize object,
3) Collecting data about the actual state of object,
4) Compute object + data-to-new-state => new object
5) (exit condition)
6) Update 2) with the new object
LOOP
END

Posted on Apr 1, 2013, 6:29 AM

Respond to this message   

Return to Index


program decided not to work atm

by (no login)

I eliminated some bugs, but there remain at least one enormous monster bug, some alien arachnoid somewhere at loop 2. I'm a bit sort in debugging capacities... the first loop runs quiet wonderful, but the second jumps out of boundaries.

'Vector example program.

DECLARE SUB distance (b, c, d, e, dd!)
DECLARE SUB coefficient (b, c, d, e, coef!, zflag)
DECLARE SUB populate (ox, oy)

TYPE surround
xx AS INTEGER
yy AS INTEGER
dd AS SINGLE
pt AS INTEGER
END TYPE

DIM SHARED crew(9) AS surround

SCREEN 12
WINDOW (-320, -240)-(321, 241)

'Hi Mister, draw me a Vector !
'initializing (define object's state) :

botX = 0
boty = 0
tipx = 5
tipy = 10

'START

ON ERROR GOTO ERRORHANDLE

FOR n = 1 TO 3

LINE (botx, boty)-(tipx, tipy)

'getting object's data :

CALL coefficient(botx, boty, tipx, tipy, coef!, zflag)
CALL distance (botx, boty, tipx, tipy, dd!)

'PRINT coef!; dd!; zflag

'computing side :

CALL populate(tipx, tipy)

FOR i = 1 TO 8
crew(i).pt = POINT(crew(i).xx, crew(i).yy)
IF crew(i).pt > 0 THEN best = i
NEXT i

' left pixels in crew :

offset = - 2
index = best

index = (index + offset) - 8 * INT((index + offset) / 8)


' setup 2 mirror pixels
isz = 10
coef! = 1 / coef!
dd! = dd! + isz

x = CINT(SQR((dd! ^ 2) / (coef! + 1)))
y = CINT(coef! * x)

ax = tipx - x
ay = tipy + y
bx = tipx + x
by = tipy - y

b = crew(index).xx
c = crew(index).yy

CALL distance (b, c, ax, ay, dd!)
add! = dd!

CALL distance (b, c, bx, by, dd!)
bdd! = dd!

IF add! < bdd! THEN
cx = ax : cy = ay
ELSE
cx = bx : cy = by
END IF

botx = tipx : boty = tipy
tipx = cx: tipy = cy

PRINT ax; ay
PRINT bx; by
PRINT cx; cy
PRINT botx; boty
PRINT tipx; tipy

END

NEXT n

ERRORHANDLE:

PRINT crew(index).xx
PRINT crew(index).yy
PRINT coef!
PRINT dd!
PRINT ax; ay
PRINT bx; by
PRINT cx; cy
PSET (ax, ay)
PSET (bx, by)
PRINT botx; boty; tipx; tipy


END

SUB distance (b, c, d, e, dd!)

absc! = d - b
ordo! = e - c
dd! = (SQR(absc! ^ 2 + ordo! ^ 2))

END SUB

SUB coefficient (b, c, d, e, coef!, zflag)

zflag = 0
absc! = d - b
ordo! = e - c

IF absc! = 0 THEN
absc! = 0.01
zflag = 1
END IF

coef! = (ordo! / absc!)

END SUB

SUB populate (ox, oy)

a = 1

crew(1).xx = ox + 0: crew(1).yy = oy + a

crew(2).xx = ox - a: crew(2).yy = oy + a
crew(3).xx = ox - a: crew(3).yy = oy + 0
crew(4).xx = ox - a: crew(4).yy = oy - a

crew(5).xx = ox + 0: crew(5).yy = oy - a
crew(6).xx = ox + a: crew(6).yy = oy - a

crew(7).xx = ox + a: crew(7).yy = oy + 0
crew(8).xx = ox + a: crew(8).yy = oy + a

crew(9).xx = ox: crew(9).yy = oy

END SUB





Posted on Apr 6, 2013, 1:30 PM

Respond to this message   

Return to Index


Something is working now

by (no login)

I wanted it to do some square though. But it turns left, that's a good point. Now the algo seems not absolutely sure in my brain...

'Vector example program.

DECLARE SUB distance (b, c, d, e, dd!)
DECLARE SUB coefficient (b, c, d, e, coef!, zflag)
DECLARE SUB populate (ox, oy)

TYPE surround
xx AS INTEGER
yy AS INTEGER
dd AS SINGLE
pt AS INTEGER
END TYPE

DIM SHARED crew(9) AS surround

SCREEN 12
WINDOW (-320, -240)-(321, 241)

'Hi Mister, draw me a Vector !
'initializing (define object's state) :

botx = 0
boty = 0
tipx = 5
tipy = 10

'START

ON ERROR GOTO ERRORHANDLE

FOR n = 1 TO 6

LINE (botx, boty)-(tipx, tipy)

'getting object's data :

CALL coefficient(botx, boty, tipx, tipy, coef!, zflag)
CALL distance (botx, boty, tipx, tipy, dd!)

PRINT coef!; dd!; zflag

'computing side :

CALL populate(tipx, tipy)

FOR i = 1 TO 8
crew(i).pt = POINT(crew(i).xx, crew(i).yy)
IF crew(i).pt > 0 THEN best = i
NEXT i

' left pixels in crew :

offset = - 2
index = best

index = (index + offset) - 8 * INT((index + offset) / 8)


' setup 2 mirror pixels
isz = 10
coef! = 1 / coef!
dd! = dd! + isz

x = CINT(SQR((dd! ^ 2) / (coef! + 1)))
y = CINT(coef! * x)


sign = ABS(coef!) / coef!

ax = tipx + x * sign
ay = tipy + y * sign
bx = tipx - x * sign
by = tipy - y * sign

b = crew(index).xx
c = crew(index).yy

CALL distance (b, c, ax, ay, dd!)
add! = dd!

CALL distance (b, c, bx, by, dd!)
bdd! = dd!

IF add! < bdd! THEN
cx = ax : cy = ay
ELSE
cx = bx : cy = by
END IF

botx = tipx : boty = tipy
tipx = cx: tipy = cy

'PRINT ax; ay
'PRINT bx; by
'PRINT cx; cy
'PRINT botx; boty
'PRINT tipx; tipy

SLEEP

NEXT n

ERRORHANDLE:

PRINT crew(index).xx
PRINT crew(index).yy
PRINT coef!
PRINT dd!
PRINT ax; ay
PRINT bx; by
PRINT cx; cy
PSET (ax, ay)
PSET (bx, by)
PRINT botx; boty; tipx; tipy


END

SUB distance (b, c, d, e, dd!)

absc! = d - b
ordo! = e - c
dd! = (SQR(absc! ^ 2 + ordo! ^ 2))

END SUB

SUB coefficient (b, c, d, e, coef!, zflag)

zflag = 0
absc! = d - b
ordo! = e - c

IF absc! = 0 THEN
absc! = 0.01
zflag = 1
END IF

coef! = (ordo! / absc!)

END SUB

SUB populate (ox, oy)

a = 1

crew(1).xx = ox + 0: crew(1).yy = oy + a

crew(2).xx = ox - a: crew(2).yy = oy + a
crew(3).xx = ox - a: crew(3).yy = oy + 0
crew(4).xx = ox - a: crew(4).yy = oy - a

crew(5).xx = ox + 0: crew(5).yy = oy - a
crew(6).xx = ox + a: crew(6).yy = oy - a

crew(7).xx = ox + a: crew(7).yy = oy + 0
crew(8).xx = ox + a: crew(8).yy = oy + a

crew(9).xx = ox: crew(9).yy = oy

END SUB





Posted on Apr 6, 2013, 2:49 PM

Respond to this message   

Return to Index


Now it gives an idea

by (no login)

Corrected the coefficient bug. Now, i wanted merely to prove that one can turn left without using draw... i feel that i will need such a routine soon.


'Vector example program.

DECLARE SUB distance (b, c, d, e, dd!)
DECLARE SUB coefficient (b, c, d, e, coef!, zflag)
DECLARE SUB populate (ox, oy)

TYPE surround
xx AS INTEGER
yy AS INTEGER
dd AS SINGLE
pt AS INTEGER
END TYPE

DIM SHARED crew(9) AS surround

SCREEN 12
WINDOW (-320, -240)-(321, 241)

'Hi Mister, draw me a Vector !
'initializing (define object's state) :

botx = 0
boty = 0
tipx = 5
tipy = 10

'START

ON ERROR GOTO ERRORHANDLE

FOR n = 1 TO 8

LINE (botx, boty)-(tipx, tipy)

'getting object's data :

CALL coefficient(botx, boty, tipx, tipy, coef!, zflag)
CALL distance(botx, boty, tipx, tipy, dd!)

PRINT coef!; dd!; zflag

'computing side :

CALL populate(tipx, tipy)

FOR i = 1 TO 8
crew(i).pt = POINT(crew(i).xx, crew(i).yy)
IF crew(i).pt > 0 THEN best = i
NEXT i

' left pixels in crew :

offset = -2
index = best

index = (index + offset) - 8 * INT((index + offset) / 8)


' setup 2 mirror pixels
isz = 2
coef! = - 1 / coef!
dd! = dd! + isz

x = CINT(SQR((dd! ^ 2) / (coef! + 1)))
y = CINT(coef! * x)

ax = tipx + x
ay = tipy + y
bx = tipx - x
by = tipy - y

b = crew(index).xx
c = crew(index).yy

CALL distance(b, c, ax, ay, dd!)
add! = dd!

CALL distance(b, c, bx, by, dd!)
bdd! = dd!

IF add! < bdd! THEN
cx = ax: cy = ay
ELSE
cx = bx: cy = by
END IF

botx = tipx: boty = tipy
tipx = cx: tipy = cy

'PRINT ax; ay
'PRINT bx; by
'PRINT cx; cy
'PRINT botx; boty
'PRINT tipx; tipy

SLEEP

NEXT n

ERRORHANDLE:

PRINT crew(index).xx
PRINT crew(index).yy
PRINT coef!
PRINT dd!
PRINT ax; ay
PRINT bx; by
PRINT cx; cy
PSET (ax, ay)
PSET (bx, by)
PRINT botx; boty; tipx; tipy


END

SUB coefficient (b, c, d, e, coef!, zflag)

zflag = 0
absc! = d - b
ordo! = e - c

IF absc! = 0 THEN
absc! = .01
zflag = 1
END IF

coef! = (ordo! / absc!)

END SUB

SUB distance (b, c, d, e, dd!)

absc! = d - b
ordo! = e - c
dd! = (SQR(absc! ^ 2 + ordo! ^ 2))

END SUB

SUB populate (ox, oy)

a = 1

crew(1).xx = ox + 0: crew(1).yy = oy + a

crew(2).xx = ox - a: crew(2).yy = oy + a
crew(3).xx = ox - a: crew(3).yy = oy + 0
crew(4).xx = ox - a: crew(4).yy = oy - a

crew(5).xx = ox + 0: crew(5).yy = oy - a
crew(6).xx = ox + a: crew(6).yy = oy - a

crew(7).xx = ox + a: crew(7).yy = oy + 0
crew(8).xx = ox + a: crew(8).yy = oy + a

crew(9).xx = ox: crew(9).yy = oy

END SUB

Posted on Apr 6, 2013, 3:27 PM

Respond to this message   

Return to Index


What are you trying to achieve?

by Rick (no login)

Posted on Apr 6, 2013, 7:35 PM

Respond to this message   

Return to Index


For drawing Koch snowflakes

by (no login)

I made an attempt last year, but some triangles where drawn toward the inside of the polygonal shape.

http://en.wikipedia.org/wiki/Koch_snowflake

Posted on Apr 7, 2013, 12:24 AM

Respond to this message   

Return to Index


Interesting algorithm

by Ben (no login)

slow but easily optimizable

pi = 3.141593
DIM s AS STRING
DIM i AS INTEGER
SCREEN 12
PSET (320, 480)
FOR t = 1 TO 6000
x = 0
FOR i = 0 TO 15
x = x - ((t AND 2 ^ i) <> 0)
NEXT
IF x AND 1 THEN
a = a + pi / 3
ELSE
LINE -STEP(3 * COS(a), 3 * SIN(a))
END IF
NEXT

Posted on Apr 7, 2013, 3:50 PM

Respond to this message   

Return to Index


*kind of magic :)

by (no login)

*

Posted on Apr 8, 2013, 1:08 AM

Respond to this message   

Return to Index


Correct equation

by (no login)

I forgot some square last time. Slowly math skills are coming back...

x = CINT(SQR((dd! ^ 2) / (coef! ^ 2 + 1)))
y = CINT(coef! * x)

You should replace the lines in the program with theses ones, or just ^ 2 after coef!

Now it draws what it should...

Posted on Apr 7, 2013, 2:16 AM

Respond to this message   

Return to Index


Last version, to be sure.

by (no login)

'Vector example program.

DECLARE SUB distance (b, c, d, e, dd!)
DECLARE SUB coefficient (b, c, d, e, coef!, zflag)
DECLARE SUB populate (ox, oy)

TYPE surround
xx AS INTEGER
yy AS INTEGER
dd AS SINGLE
pt AS INTEGER
END TYPE

DIM SHARED crew(9) AS surround

SCREEN 12
WINDOW (-320, -240)-(321, 241)

'Hi Mister, draw me a Vector !
'initializing (define object's state) :

botx = 0
boty = 0
tipx = 5
tipy = 10

'START

ON ERROR GOTO ERRORHANDLE

FOR n = 1 TO 64

LINE (botx, boty)-(tipx, tipy)

'getting object's data :

CALL coefficient(botx, boty, tipx, tipy, coef!, zflag)
CALL distance(botx, boty, tipx, tipy, dd!)

'PRINT coef!; dd!; zflag

'computing side :

CALL populate(tipx, tipy)

FOR i = 1 TO 8
crew(i).pt = POINT(crew(i).xx, crew(i).yy)
IF crew(i).pt > 0 THEN best = i
NEXT i

' left pixels in crew :

offset = -2
index = best

index = (index + offset) - 8 * INT((index + offset) / 8)


' setup 2 mirror pixels
isz = 2
coef! = -1 / coef!
dd! = dd! + isz

x = CINT(SQR((dd! ^ 2) / (coef! ^ 2 + 1)))
y = CINT(coef! * x)

ax = tipx + x
ay = tipy + y
bx = tipx - x
by = tipy - y

b = crew(index).xx
c = crew(index).yy

CALL distance(b, c, ax, ay, dd!)
add! = dd!

CALL distance(b, c, bx, by, dd!)
bdd! = dd!

IF add! < bdd! THEN
cx = ax: cy = ay
ELSE
cx = bx: cy = by
END IF

botx = tipx: boty = tipy
tipx = cx: tipy = cy

'PRINT ax; ay
'PRINT bx; by
'PRINT cx; cy
'PRINT botx; boty
'PRINT tipx; tipy

' SLEEP

NEXT n

ERRORHANDLE:

PRINT crew(index).xx
PRINT crew(index).yy
PRINT coef!
PRINT dd!
PRINT ax; ay
PRINT bx; by
PRINT cx; cy
PSET (ax, ay)
PSET (bx, by)
PRINT botx; boty; tipx; tipy


END

SUB coefficient (b, c, d, e, coef!, zflag)

zflag = 0
absc! = d - b
ordo! = e - c

IF absc! = 0 THEN
absc! = .01
zflag = 1
END IF

coef! = (ordo! / absc!)

END SUB

SUB distance (b, c, d, e, dd!)

absc! = d - b
ordo! = e - c
dd! = (SQR(absc! ^ 2 + ordo! ^ 2))

END SUB

SUB populate (ox, oy)

a = 1

crew(1).xx = ox + 0: crew(1).yy = oy + a

crew(2).xx = ox - a: crew(2).yy = oy + a
crew(3).xx = ox - a: crew(3).yy = oy + 0
crew(4).xx = ox - a: crew(4).yy = oy - a

crew(5).xx = ox + 0: crew(5).yy = oy - a
crew(6).xx = ox + a: crew(6).yy = oy - a

crew(7).xx = ox + a: crew(7).yy = oy + 0
crew(8).xx = ox + a: crew(8).yy = oy + a

crew(9).xx = ox: crew(9).yy = oy

END SUB

Posted on Apr 7, 2013, 3:10 AM

Respond to this message   

Return to Index


*need to avoid errorhandle

by (no login)

*

Posted on Apr 7, 2013, 3:14 AM

Respond to this message   

Return to Index


Major flaws one should avoid

by (no login)

This program is adding errors in chain, since each vector is processed from n - 1 antecedent. bad, bad, bad... awful.
And straight vertical (0 divide) needs a work around.

Posted on Apr 7, 2013, 5:57 AM

Respond to this message   

Return to Index


Error codes (in Dosbox) ?

by (no login)

ON ERROR GOTO ERRORHANDLE

CLS

a% = 1 / 0

PRINT a%

END

ERRORHANDLE:

PRINT ERR

END

This will not produce an error, the ERRORHANDLE is never used but i checked that the error code for divide by Zero is 11 :

http://www.qbasic.com/2009/04/26/qb-error-codes/

11 Division by zero -

So it's rather unexpected, also replacing a% by a, will return #1.INF...

a% = -32***
a = #1.INF

http://jpsor.ucoz.com/publ/1-1-0-32

There we can get the error code which is in a QBASIC variable called "ERR" and copy it to our own variable "ErrorCode". -

Divide by zero is an error, i would like to be able to retrace that as an error which it is... I don't like surprises...




Posted on Mar 30, 2013, 7:53 AM

Respond to this message   

Return to Index


QB64 or DosBox?

by (Login MCalkins)
Moderator

QBasic 1.1 inside DosBox 0.74 performs as expected.

QB64 ignores floating point division by zero. (Although you are assigning to an integer, the division is floating point because you used "/" instead of "\".) (By the way, QB64 also ignores integer overflow.)

For integer division by zero, QB64 has a non-recoverable error. The error trapping doesn't work for it. See this by changing the "/" to "\".

I would consider this to be a bug in QB64. However, I suggest that it is better to test the divisor ahead of time to make sure that it is non-zero, rather than trying to trap the error.

Regards,
Michael

Posted on Mar 30, 2013, 2:29 PM

Respond to this message   

Return to Index


*I was using qb 4.5, it's just suited to my needs for now

by (no login)

*

Posted on Mar 30, 2013, 4:42 PM

Respond to this message   

Return to Index


* Indeed. It looks like you found a bug in DosBox...

by (Login MCalkins)
Moderator

Posted on Mar 30, 2013, 4:54 PM

Respond to this message   

Return to Index


That is strange.

by Solitaire (Login Solitaire1)
S

I tried this in QB (under Windows XP) and got a series of 11 and 0.

CLS
a = 1
b = 0
ON ERROR GOTO nogood
c% = a / b
PRINT c
d% = 1 / 0
PRINT d%
e = 1 / 0
PRINT e
c% = a \ b
PRINT c
d% = 1 \ 0
PRINT d%
e = 1 \ 0
PRINT e
END
nogood:
PRINT ERR
RESUME NEXT

In Visual Basic, integer division with \ can only be done with integer variables.
Division by zero with / or \ is not permitted with integers. Otherwise, the result is INFINITY. The following is a Console application:

Dim a, b As Integer
Dim c, d As Double
b = 12
d = 12
' a = b / 0     'ERROR with Option Strict Off; not permitted with Option Strict On
' Console.WriteLine(a)
' a = b \ 0     'ERROR
' Console.WriteLine(a)
c = d / 0     'INFINITY
Console.WriteLine(c)
' c = d \ 0     'ERROR with Option Strict Off; not permitted with Option Strict On
' Console.WriteLine(c)
Console.ReadLine()

Posted on Mar 30, 2013, 3:01 PM

Respond to this message   

Return to Index


Re: That is strange.

by (Login MCalkins)
Moderator

If you put this at the start of your program:

c = -123
c% = -123
d% = -123
e = -123

You'll see that it is just printing the existing value of the variable. The RESUME NEXT skips the division and assignment.

Be advised that you are trying to set c%, but then print c, without a suffix.

Regards,
Michael

Posted on Mar 30, 2013, 4:06 PM

Respond to this message   

Return to Index


Circee now working !

by (no login)

The proof that it is working, - the proof of concept.

Z should be adjusted, or the routine stopped according to some other condition.

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

DECLARE SUB distance (b, c, d, e, dd!)
DECLARE SUB populate (ox, oy)

TYPE surround
xx AS INTEGER
yy AS INTEGER
dd AS SINGLE
pt AS INTEGER
END TYPE

DIM SHARED crew(9) AS surround

SCREEN 12
WINDOW (-320, -240)-(321, 241)

'initialize :

oy = 100
ox = 0

CALL distance(0, 0, ox, oy, dd!)
rad = dd!

PSET (ox, oy)

' ******************************

'start :

FOR z = 1 TO 550

CALL populate(ox, oy)

' updating the pixel crew :

FOR i = 1 TO 8
d = crew(i).xx: e = crew(i).yy
CALL distance(0, 0, d, e, dd!)
crew(i).dd = ABS(dd! - rad)
crew(i).pt = POINT(crew(i).xx, crew(i).yy)
' PRINT crew(i).pt; crew(i).xx; crew(i).yy
' PSET (crew(i).xx, crew(i).yy)
NEXT i


' sorting algo for the closest pixel to rad for pt = 0

a! = 2

FOR i = 1 TO 8
IF a! > crew(i).dd AND crew(i).pt = 0 THEN
a! = crew(i).dd
best = i
END IF
NEXT

' PSETting the pixel, updating

PSET (crew(best).xx, crew(best).yy)
ox = crew(best).xx
oy = crew(best).yy


NEXT z


END

SUB distance (b, c, d, e, dd!)

absc! = d - b
ordo! = e - c
dd! = (SQR(absc! ^ 2 + ordo! ^ 2))

END SUB

SUB populate (ox, oy)

a = 1

crew(1).xx = ox + 0: crew(1).yy = oy + a

crew(2).xx = ox - a: crew(2).yy = oy + a
crew(3).xx = ox - a: crew(3).yy = oy + 0
crew(4).xx = ox - a: crew(4).yy = oy - a

crew(5).xx = ox + 0: crew(5).yy = oy - a
crew(6).xx = ox + a: crew(6).yy = oy - a

crew(7).xx = ox + a: crew(7).yy = oy + 0
crew(8).xx = ox + a: crew(8).yy = oy + a

crew(9).xx = ox: crew(9).yy = oy

END SUB

Posted on Mar 24, 2013, 3:20 AM

Respond to this message   

Return to Index


Something weird ...

by (no login)

As you can see, to achieve an almost complete circle,

z = 560.

But rad = 100.

Usually, the circumference should be 2 * PI * rad, = 628

L

Posted on Mar 24, 2013, 3:26 AM

Respond to this message   

Return to Index


Some other nice (unexpected!) stuff !

by (no login)

An attempt to draw a spiral, by decreasing rad, but something else was displayed :

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

DECLARE SUB distance (b, c, d, e, dd!)
DECLARE SUB populate (ox, oy)

TYPE surround
xx AS INTEGER
yy AS INTEGER
dd AS SINGLE
pt AS INTEGER
END TYPE

DIM SHARED crew(9) AS surround

SCREEN 12
WINDOW (-320, -240)-(321, 241)

'initialize :

oy = 100
ox = 0

CALL distance(0, 0, ox, oy, dd!)
rad = dd!

PSET (ox, oy)

' ******************************

'start :

FOR z = 1 TO 1560

CALL populate(ox, oy)

' updating the pixel crew :

FOR i = 1 TO 8
d = crew(i).xx: e = crew(i).yy
CALL distance(0, 0, d, e, dd!)
crew(i).dd = ABS(dd! - rad)
crew(i).pt = POINT(crew(i).xx, crew(i).yy)
' PRINT crew(i).pt; crew(i).xx; crew(i).yy
' PSET (crew(i).xx, crew(i).yy)
NEXT i


' sorting algo for the closest pixel to rad for pt = 0

a! = 2

FOR i = 1 TO 8
IF a! > crew(i).dd AND crew(i).pt = 0 THEN
a! = crew(i).dd
best = i
END IF
NEXT

' PSETting the pixel, updating

PSET (crew(best).xx, crew(best).yy)
ox = crew(best).xx
oy = crew(best).yy

' update rad :

rad = rad - rad / 560


NEXT z


END

SUB distance (b, c, d, e, dd!)

absc! = d - b
ordo! = e - c
dd! = (SQR(absc! ^ 2 + ordo! ^ 2))

END SUB

SUB populate (ox, oy)

a = 1

crew(1).xx = ox + 0: crew(1).yy = oy + a

crew(2).xx = ox - a: crew(2).yy = oy + a
crew(3).xx = ox - a: crew(3).yy = oy + 0
crew(4).xx = ox - a: crew(4).yy = oy - a

crew(5).xx = ox + 0: crew(5).yy = oy - a
crew(6).xx = ox + a: crew(6).yy = oy - a

crew(7).xx = ox + a: crew(7).yy = oy + 0
crew(8).xx = ox + a: crew(8).yy = oy + a

crew(9).xx = ox: crew(9).yy = oy

END SUB

Posted on Mar 24, 2013, 5:55 AM

Respond to this message   

Return to Index


Some "chaos" generator ?

by (no login)

Try it with :

FOR z = 1 TO 2560

and

rad = rad - rad / 1500

I don't really know why this is happens, i never expected it changing direction...

L

Posted on Mar 24, 2013, 6:08 AM

Respond to this message   

Return to Index


what are you trying to do?

by Dick (no login)

perhaps this: http://en.wikipedia.org/wiki/Midpoint_circle_algorithm

here is one using that algorithm

screen _newimage(640,480,32)

elipsex 320, 240, 300, 100, _rgb(0,255,0)
circlex 320, 240, 90, _rgb(0,0,0)
elipsex 320, 240, 10, 70, _rgb(255,0,0)

sleep
system

sub circlex ( cx as integer, cy as integer, r as integer, c as long )
dim x as long
dim y as long
dim e as long

x=r
e=-x

do while x >= y
line (cx-y, cy-x)-(cx+y, cy-x), c, bf
line (cx-x, cy-y)-(cx+x, cy-y), c, bf
line (cx-x, cy+y)-(cx+x, cy+y), c, bf
line (cx-y, cy+x)-(cx+y, cy+x), c, bf

y=y+1
e=e+y+y
if e>0 then
x=x-1
e=e-x-x
end if

loop
end sub


sub elipsex ( cx as integer, cy as integer, rx as integer, ry as integer, c as long )
dim a as long
dim b as long
dim x as long
dim y as long
dim xx as long
dim yy as long
dim sx as long
dim sy as long
dim e as long

a=2*rx*rx
b=2*ry*ry
x=rx
xx=ry*ry*(1-rx-rx)
yy=rx*rx
sx=b*rx

do while sx>=sy
line (cx-x, cy-y)-(cx+x, cy-y), c, bf
line (cx-x, cy+y)-(cx+x, cy+y), c, bf

y=y+1
sy=sy+a
e=e+yy
yy=yy+a

if (e+e+xx)>0 then
x=x-1
sx=sx-b
e=e+xx
xx=xx+b
end if
loop

x=0
y=ry
xx=rx*ry
yy=rx*rx*(1-ry-ry)
e=0
sx=0
sy=a*ry

do while sx<=sy
line (cx-x, cy-y)-(cx+x, cy-y), c, bf
line (cx-x, cy+y)-(cx+x, cy+y), c, bf

x=x+1
sx=sx+b
e=e+xx
xx=xx+b

if (e+e+yy)>0 then
y=y-1
sy=sy-a
e=e+yy
yy=yy+a
end if
loop

end sub

Posted on Mar 24, 2013, 10:51 AM

Respond to this message   

Return to Index


2 things

by (no login)

1) i can't read any math demo page from wikipedia without scratching my head.

2) i don't understand it. The step to Y + 1 is fully non-proved :

" In general, it is true that:

Y(n + 1) ^ 2 = (Yn + 1) ^ 2 "

No it's not !

So there is no algo like that.

Third, i'm not trying to do, - i do. The advantage is that i understand what i'm doing, while i will never understand the Wikipedia fairy tales...

Thanks, L

Posted on Mar 24, 2013, 2:27 PM

Respond to this message   

Return to Index


it is true for the eighth of a circle

by Dick (no login)

Y is always increasing in that particular part of the circle, so Y(n+1) is always equal to Yn + 1. Once an eighth of a circle is drawn, it is no longer the case and you stop drawing

Posted on Mar 24, 2013, 5:05 PM

Respond to this message   

Return to Index


Circle Drawing Algorithms

by (Login PhyloGenesis)
R

Do fast circle drawing algorithms draw 1/8th of a circle then reflect for all the other cases?

Posted on Mar 26, 2013, 12:45 PM

Respond to this message   

Return to Index


Like this

by David (no login)

DEFINT A-Z
SCREEN 12
y = 200 'this is the radius
xoff = 300: yoff = 200: x = -1
WHILE x < y
x = x + 1: d = d + x + x + 1
IF d > 0 THEN d = d - y - y + 1: y = y - 1
FOR k = 0 TO 7
IF k AND 4 THEN a = -x ELSE a = x
IF k AND 2 THEN b = -y ELSE b = y
IF k AND 1 THEN SWAP a, b
PSET (a + xoff, b + yoff)
NEXT k
WEND

Posted on Mar 27, 2013, 4:45 AM

Respond to this message   

Return to Index


Ellipse

by lawgin (no login)

Simply based on equation or an ellipse:
x^2/a^2 + y^2/b^2 = 1


SCREEN 12
a = 100
b = 50
FOR y = -50 TO 50 STEP .01
x = SQR(a ^ 2 - (a ^ 2 * y ^ 2 / b ^ 2))
PSET (x + 320, y + 240)
PSET (320 - x, y + 240)
NEXT



Posted on Mar 25, 2013, 2:28 PM

Respond to this message   

Return to Index


Re: Ellipse

by Ben (no login)

That method draws an unnecessary amount of pixels and causes thicker lines at different parts of the ellipse. The midpoint circle/ellipse algorithm aims to correct that issue as well as offer much better performance.

If that's not an issue, then I personally like polar coordinates:

defsng a-z
SCREEN 12
a = 100
b = 50
points = 400

pset(a + 320, 240)
for i = 0 to 2*3.14159 step 2*3.14159/points
line -(a*cos(i) + 320, b*sin(i) + 240)
next

sleep

Posted on Mar 25, 2013, 8:45 PM

Respond to this message   

Return to Index


qb64 default folder

by lawgin (no login)

qb64 saves .bas files in the qb64 installation folder by default. Is there a way to change the default? I don't mind that the exes are in the installation folder, but I would like the source files to be someplace else.

Posted on Mar 22, 2013, 11:15 AM

Respond to this message   

Return to Index


I know I'll probably get lynched for this, but...

by (Login Kewbie)
R

PowerBasic has a "directive" (they don't call it that):

#COMPILE EXE "drive:\path\nameOfYourChoice.EXE"

The source directory is whatever folder/sub folder you create with the O/S. The folder can be created from the PB IDE.

If qb64 doesn't have this feature, it should certainly be added.

Kew

P.S. Another "flavor":

#COMPILE DLL ...

Posted on Mar 22, 2013, 1:15 PM

Respond to this message   

Return to Index


PB

by (no login)

I made some tests on PB few years ago, remember it works well, and it compile automatically before execution...

L

Posted on Mar 23, 2013, 1:58 AM

Respond to this message   

Return to Index


Re: PB

by lawgin (no login)

Thanks, but I dislike piracy and I'm too cheap to pay for it.

Posted on Mar 23, 2013, 10:38 AM

Respond to this message   

Return to Index


Perhaps I didn't make my point clear.

by (Login Kewbie)
R

I'm not trying to sell anyone on buying PowerBasic and using it. I simply meant to suggest that PB has some features that might be nice to have incorporated into qb64.

Kew

Posted on Mar 24, 2013, 10:32 PM

Respond to this message   

Return to Index


You'll need to copy the QB64 DLL files to your system folder

by (Login burger2227)
R

Then you can create a batch file to compile with QB64 from anywhere. Add it to your BAS Open With right click program list to use it on any BAS file.

Get a copy of the DLL files:

http://qb64.net/wiki/index.php?title=QB64_FAQ#Q:_MUST_I_copy_or_drag_ALL_of_my_program_files_to_the_QB64_folder.3F

Batch files at bottom of page:
http://qb64.net/wiki/index.php?title=IDE

Posted on Mar 22, 2013, 6:42 PM

Respond to this message   

Return to Index


That's not what I meant

by lawgin (no login)

I keep my .bas files in a folder c:\qbsource and I can run them from there going through the editor. But the SAVE or SAVE AS dialog always comes up with c:\qb64 as the default. There is no way in the options menu to change that.

Posted on Mar 23, 2013, 10:44 AM

Respond to this message   

Return to Index


Very Simple

by (Login GarryRicketson)
R

It is actually very simple, first, you need to create the folder that you will be wanting to save the .bas files to.
Then, instead of selecting Save, select "SAVE AS", now, when you are in the save as window, look below, you should see something like this:
..
internal
Samples
This Folder
That folder
The FolderName (the name of the folder you want to save too)
Other Folders
-----------------
It is a little hard to explain, but if you use the save as option, you can select any folder you want as the path you want to save too, if you click the .. you will get all the folders,(directorys) and paths, on your HD,...
The main thing is that you do need to creat the folder first,.. the executable will remain in your qb64 working dir (folder).
The only way, I can think of to change the actual "default" would be to re-write the source code, but then you would be stuck with always saving in that folder, as default, I would think it is much more practical to use the "saves as" feature, and select which folder/path you want to save to.
Hope this helps
from Garry
[linked image]

Posted on Mar 23, 2013, 3:01 PM

Respond to this message   

Return to Index


another image

by (Login GarryRicketson)
R

this is one more screen shot
[linked image]

Posted on Mar 23, 2013, 3:28 PM

Respond to this message   

Return to Index


Thanks Garry

by lawgin (no login)

I found an IDE that makes the process you describe much easier. It's a Windows app rather than the imitation dos that comes with qb64. DavsIDE available at qbasicnews.com

Posted on Mar 23, 2013, 6:06 PM

Respond to this message   

Return to Index


I had forgotten

by (Login GarryRicketson)
R

That's right, that is a good option too, I had forgotten about that,..

Posted on Mar 24, 2013, 3:57 AM

Respond to this message   

Return to Index


lawgin / Garry - if you have that link...

by (Login The-Universe)
Admin

Could you please post it? I will add it to the resource page here.

Also, Garry, thanks for using the image feature here to demo the "Save As" feature.

Pete

Posted on Mar 26, 2013, 10:24 AM

Respond to this message   

Return to Index


Link to DavsIDE

by lawgin (no login)

http://www.qbasicnews.com/dav/files/davside-v124.zip

Posted on Mar 27, 2013, 10:22 AM

Respond to this message   

Return to Index


Hi Pete. Maybe this would be a better link to add...

by Dav (no login)

The v1.24 link given by lawgin is valid, but the link below will always direct the user to the latest IDE version.

http://www.qbasicnews.com/dav/projects.php#DAVSIDE

Thanks!

- Dav

Posted on Mar 27, 2013, 3:17 PM

Respond to this message   

Return to Index


nice program

by Ben (no login)

Is it open source and is it compiled with QB64?

Posted on Mar 27, 2013, 8:06 PM

Respond to this message   

Return to Index


Thanks.

by Dav (no login)

No, it's closed source for now. Coded in PureBasic. I'll probably put the source code up for download when it's finished (or I'm finished with it).

I started adding syntax checking to it. Been side tracked with other projects recently.

- Dav

Posted on Mar 28, 2013, 5:18 AM

Respond to this message   

Return to Index


may I recommend a feature

by Ben (no login)

it would be nice if one could comment out a selection block instantly, As in, insert a ' comment infront of every line in a selection, perhaps when pressing ctrl-R or something similar?

It is always comforting for one to have access to the source when using foreign software, you can make modifications and be aware of exactly what's running on your computer. Do programmers feel they lose a part of their soul when their source code is exposed?

Posted on Mar 28, 2013, 5:15 PM

Respond to this message   

Return to Index


That sounds handy.

by Dav (no login)

Hightlight a section of code - One click comments it all out, or uncomments it all. I'll try implementing that one. Many of the features added are because of feedback like yours, so thank you.

About your question if programmers are afraid to expose their source-code, for me no, but sometimes I'd be embarrassed.

You can have the source when I've got it release worthy (it's a bowl of Spaghetti-code right now) but to modify it you would need PureBasic.

I hear you about wanting to know what's running on your pc. I'm the same way.

- Dav

(edited per Dav's request - mc)


Posted on Mar 28, 2013, 5:54 PM

Respond to this message   

Return to Index


*With PB, Ctrl+Q comments the block, and Ctlr+Shift+Q uncomments it

by (Login Kewbie)
R

{;^)>

Posted on Mar 28, 2013, 9:21 PM

Respond to this message   

Return to Index


I don't think PB is unwelcome here

by Ben (no login)

In fact, I think Pete uses and enjoys powerbasic himself.

The real enemy, the satan here, is freebasic. Mentioning freebasic here will have you sacrificied and gutted alive to almighty bill gates the proprietary commerciliser god, while chanting from our orthodox pure-BASIC-approved bible.

Posted on Mar 28, 2013, 9:45 PM

Respond to this message   

Return to Index


*Thanks, Ben. I promise that I'll NEVER use the "f" word here, ever!

by (Login Kewbie)
R

Posted on Mar 28, 2013, 11:15 PM

Respond to this message   

Return to Index


LOL

by (Login MCalkins)
Moderator

I think that we need to keep this a QBASIC/QB64 forum. However, *mentioning* FreeBASIC, as you just did, would not seem unreasonable. As for posting FreeBASIC code, I don't think that anyone would object to using the "Computer Discussion Forum" for that purpose.

There seems to be a strong bias against FreeBASIC by some people in our community. I believe that this is a legacy of the antagonism between the two communities from some years ago. Since I have not kept up with FreeBASIC, and I don't know its current characteristics, I'm not in a position to condemn it. If it suits the needs of some people, that's all well and good.

Regards,
Michael

Posted on Mar 29, 2013, 12:22 AM

Respond to this message   

Return to Index


puzzled with PSET

by (no login)

I'm using only 1 single PSET statement, and yet POINT will return 2 pixels with value = 15 ?

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

SCREEN 12
WINDOW (-320, -240)-(320, 240)

xo = 0
yo = 100

PSET (xo, yo)

'scan

PRINT POINT(- 1, 100); POINT(0, 100); POINT(+1, 100)

END

Posted on Mar 21, 2013, 2:12 PM

Respond to this message   

Return to Index


Also funny :

by (no login)

I'm resetting the pixel next to the PSETed pixel, and it works :

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

SCREEN 12
WINDOW (-320, -240)-(320, 240)

xo = 0
yo = 100

PSET (xo, yo)

PRESET (-1, yo)

'scan

PRINT POINT(-1, 100); POINT(0, 100); POINT(1, 100)

END

Posted on Mar 21, 2013, 2:24 PM

Respond to this message   

Return to Index


Works when x-axis is odd length

by lawgin (no login)

Not sure why


SCREEN 12
WINDOW (-320, -240)-(321, 240)

xo = 0
yo = 100

PSET (xo, yo)

'scan

PRINT POINT(-1, 100); POINT(0, 100); POINT(1, 100)

END

Posted on Mar 21, 2013, 5:41 PM

Respond to this message   

Return to Index


*thanks, should be pinned on top...

by (no login)

*

Posted on Mar 22, 2013, 1:54 AM

Respond to this message   

Return to Index


It should be added to the FAQ.

by (no login)

Under section :

Sound, and Common Graphics Questions

Posted on Mar 22, 2013, 1:05 PM

Respond to this message   

Return to Index


*IT SHOULD BE ADDED TO THE FAQ !

by (no login)

*

Posted on Mar 24, 2013, 2:57 AM

Respond to this message   

Return to Index


Help debging please..

by (no login)

Hi,

It's about drawing a circle. I use a square for that, 3x3. Well it's not finished, for the moment, i can't figure out the PSET/POINT issue...

If i comment/uncomment /PSET (ox, oy)/, i get 2 pixels detected with POINT... i must be tired or somewhat !

If i PSET the central pixel of the crew, it shouldn't be detected by the routine which deals with all the 8 pixels around....

Code :

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

DECLARE SUB distance (b, c, d, e, dd!)
DECLARE SUB populate (ox, oy)

TYPE surround
xx AS INTEGER
yy AS INTEGER
dd AS SINGLE
pt AS INTEGER
END TYPE

DIM SHARED crew(9) AS surround

SCREEN 12
WINDOW (-320, -240)-(320, 240)

'initialize :

oy = 100
ox = 0

CALL distance(0, 0, ox, oy, dd!)
rad = dd!

PSET (ox, oy)
PSET (ox + 1, oy)

'start :

CALL populate(ox, oy)

' updating the pixel crew :

FOR i = 1 TO 9
d = crew(i).xx: e = crew(i).yy
CALL distance(0, 0, d, e, dd!)
crew(i).dd = ABS(dd! - rad)
crew(i).pt = POINT(crew(i).xx, crew(i).yy)
PRINT crew(i).pt; crew(i).xx; crew(i).yy
NEXT i

' sorting algo for the closes pixel to rad for pt = 0

a! = 2

FOR i = 1 TO 8
IF a! > crew(i).dd AND crew(i).pt = 0 THEN a! = crew(i).dd
NEXT

' PSETting the pixel, updating

FOR i = 1 TO 8
IF crew(i).dd = a! AND crew(i).pt = 0 THEN
' PSET (crew(i).xx, crew(i).yy), 4
' PRINT crew(i).xx; crew(i).yy
END IF

NEXT




END

SUB distance (b, c, d, e, dd!)

absc! = d - b
ordo! = e - c
dd! = (SQR(absc! ^ 2 + ordo! ^ 2))

END SUB

SUB populate (ox, oy)

crew(1).xx = ox + 0: crew(1).yy = oy + 1

crew(2).xx = ox - 1: crew(2).yy = oy + 1
crew(3).xx = ox - 1: crew(3).yy = oy + 0
crew(4).xx = ox - 1: crew(4).yy = oy - 1

crew(5).xx = ox + 0: crew(5).yy = oy - 1
crew(6).xx = ox + 1: crew(6).yy = oy - 1

crew(7).xx = ox + 1: crew(7).yy = oy + 0
crew(8).xx = ox + 1: crew(8).yy = oy + 1

crew(9).xx = ox: crew(9).yy = oy

END SUB

Posted on Mar 20, 2013, 4:03 PM

Respond to this message   

Return to Index


Better version

by (no login)

Here one can set the size of the square of surrounding pixels, with "a" in the populate sub. BTW this way of getting each pixel seems a bit sluggish...

Code :

=======================================
DECLARE SUB distance (b, c, d, e, dd!)
DECLARE SUB populate (ox, oy)

TYPE surround
xx AS INTEGER
yy AS INTEGER
dd AS SINGLE
pt AS INTEGER
END TYPE

DIM SHARED crew(9) AS surround

SCREEN 12
WINDOW (-320, -240)-(320, 240)

'initialize :

oy = 100
ox = 0

CALL distance(0, 0, ox, oy, dd!)
rad = dd!

'PSET (ox, oy)
'PSET (ox + 1, oy)

'start :

CALL populate(ox, oy)

' updating the pixel crew :

FOR i = 1 TO 8
d = crew(i).xx: e = crew(i).yy
CALL distance(0, 0, d, e, dd!)
crew(i).dd = ABS(dd! - rad)
crew(i).pt = POINT(crew(i).xx, crew(i).yy)
PRINT crew(i).pt; crew(i).xx; crew(i).yy
PSET (crew(i).xx, crew(i).yy)
NEXT i

' sorting algo for the closes pixel to rad for pt = 0

a! = 2

FOR i = 1 TO 8
IF a! > crew(i).dd AND crew(i).pt = 0 THEN a! = crew(i).dd
NEXT

' PSETting the pixel, updating

FOR i = 1 TO 8
IF crew(i).dd = a! AND crew(i).pt = 0 THEN
' PSET (crew(i).xx, crew(i).yy), 4
' PRINT crew(i).xx; crew(i).yy
END IF

NEXT




END

SUB distance (b, c, d, e, dd!)

absc! = d - b
ordo! = e - c
dd! = (SQR(absc! ^ 2 + ordo! ^ 2))

END SUB

SUB populate (ox, oy)

a = 1

crew(1).xx = ox + 0: crew(1).yy = oy + a

crew(2).xx = ox - a: crew(2).yy = oy + a
crew(3).xx = ox - a: crew(3).yy = oy + 0
crew(4).xx = ox - a: crew(4).yy = oy - a

crew(5).xx = ox + 0: crew(5).yy = oy - a
crew(6).xx = ox + a: crew(6).yy = oy - a

crew(7).xx = ox + a: crew(7).yy = oy + 0
crew(8).xx = ox + a: crew(8).yy = oy + a

crew(9).xx = ox: crew(9).yy = oy

END SUB

Posted on Mar 21, 2013, 3:26 AM

Respond to this message   

Return to Index


*night helped to solve it :)

by (no login)

*

Posted on Mar 21, 2013, 3:30 AM

Respond to this message   

Return to Index


or not

by (no login)

I still don't get it :

Pixel is PSET at ox, oy, which is 0, 100, and detected with POINT at -1, 100

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

DECLARE SUB distance (b, c, d, e, dd!)
DECLARE SUB populate (ox, oy)

TYPE surround
xx AS INTEGER
yy AS INTEGER
dd AS SINGLE
pt AS INTEGER
END TYPE

DIM SHARED crew(9) AS surround

SCREEN 12
WINDOW (-320, -240)-(320, 240)

'initialize :

oy = 100
ox = 0

CALL distance(0, 0, ox, oy, dd!)
rad = dd!

PSET (ox, oy)
'PSET (ox + 1, oy)

'start :

CALL populate(ox, oy)

' updating the pixel crew :

FOR i = 1 TO 8
d = crew(i).xx: e = crew(i).yy
CALL distance(0, 0, d, e, dd!)
crew(i).dd = ABS(dd! - rad)
crew(i).pt = POINT(crew(i).xx, crew(i).yy)
PRINT crew(i).pt; crew(i).xx; crew(i).yy
' PSET (crew(i).xx, crew(i).yy)
NEXT i



' sorting algo for the closes pixel to rad for pt = 0

a! = 2

FOR i = 1 TO 8
IF a! > crew(i).dd AND crew(i).pt = 0 THEN a! = crew(i).dd
NEXT

' PSETting the pixel, updating

FOR i = 1 TO 8
IF crew(i).dd = a! AND crew(i).pt = 0 THEN
' PSET (crew(i).xx, crew(i).yy), 4
' PRINT crew(i).xx; crew(i).yy
END IF

NEXT




END

SUB distance (b, c, d, e, dd!)

absc! = d - b
ordo! = e - c
dd! = (SQR(absc! ^ 2 + ordo! ^ 2))

END SUB

SUB populate (ox, oy)

a = 1

crew(1).xx = ox + 0: crew(1).yy = oy + a

crew(2).xx = ox - a: crew(2).yy = oy + a
crew(3).xx = ox - a: crew(3).yy = oy + 0
crew(4).xx = ox - a: crew(4).yy = oy - a

crew(5).xx = ox + 0: crew(5).yy = oy - a
crew(6).xx = ox + a: crew(6).yy = oy - a

crew(7).xx = ox + a: crew(7).yy = oy + 0
crew(8).xx = ox + a: crew(8).yy = oy + a

crew(9).xx = ox: crew(9).yy = oy

END SUB

Posted on Mar 21, 2013, 3:34 AM

Respond to this message   

Return to Index


Jackpot program needs to be optimized

by Solitaire (no login)

Here is the code for a program using 3 random numbers, and another one for 4 numbers. I found that it's extremely difficult to get a jackpot unless I add another RANDOMIZE TIMER before each one. It's probably because the random sequence very rarely includes 3 (or 4) consecutive numbers.

The IF-THEN block is manageable for 3 random numbers, but gets very unwieldy for 4. Can anyone suggest a shortcut to make it more efficient?

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

DIM A AS INTEGER, B AS INTEGER, C AS INTEGER, E AS STRING
RANDOMIZE TIMER
'Note: It's extremely difficult to win the jackpot with a single RANDOMIZE TIMER
DO
    CLS
    PRINT TAB(20); "JACKPOT"
    PRINT
    PRINT "Spin 3 random numbers.  2 out of 3 wins a prize."
    PRINT "3 out of 3 wins the jackpot."
   
    A = INT(6 * RND) + 1
    RANDOMIZE TIMER
    B = INT(6 * RND) + 1
    RANDOMIZE TIMER
    C = INT(6 * RND) + 1

    PRINT
    COLOR 14
    PRINT TAB(10); A; TAB(20); B; TAB(30); C   'Yellow
    COLOR 7
    PRINT

    IF A = B AND A = C AND B = C THEN
        COLOR 10
        PRINT "You won the jackpot!"    'Green
        COLOR 7
    ELSEIF A = B OR A = C OR B = C THEN
        PRINT "You won a prize."
    ELSE
        PRINT "Sorry, you didn't win."
    END IF
   
    PRINT : PRINT
    PRINT "Press any key to spin again, or Esc to stop..."
    E$ = INPUT$(1)
LOOP UNTIL E$ = CHR$(27)
END

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

'How can the ElseIf statement be shortened to display 3 out of 4?
DIM A AS INTEGER, B AS INTEGER, C AS INTEGER, D AS INTEGER, E AS STRING
RANDOMIZE TIMER
'Note: It's extremely difficult to win the jackpot with a single RANDOMIZE TIMER
DO
    CLS
    PRINT TAB(20); "JACKPOT"
    PRINT
    PRINT "Spin 4 random numbers.  2 out of 4 wins a small prize."
    PRINT "3 out of 4 wins a bigger prize.  4 out of 4 wins the jackpot!"
   
    A = INT(6 * RND) + 1
    RANDOMIZE TIMER
    B = INT(6 * RND) + 1
    RANDOMIZE TIMER
    C = INT(6 * RND) + 1
    RANDOMIZE TIMER
    D = INT(6 * RND) + 1

    PRINT
    COLOR 14
    PRINT TAB(10); A; TAB(20); B; TAB(30); C; TAB(40); D 'Yellow
    COLOR 7
    PRINT

    IF A = B AND A = C AND A = D AND B = C AND B = D AND C = D THEN
        COLOR 10
        PRINT "You won the jackpot!"    'Green
        COLOR 7
    ELSEIF A = B OR A = C OR A = D OR B = C OR B = D OR C = D THEN
        PRINT "You won a small prize."
    'ELSEIF A = B AND A = C OR A = B AND A = D OR A = C AND A = D OR  B = C AND B = D THEN 'This list is incomplete
     '     PRINT " You won a large prize."
    ELSE
        PRINT "Sorry, you didn't win."
    END IF
   
    PRINT : PRINT
    PRINT "Press any key to spin again, or Esc to stop..."
    E$ = INPUT$(1)
LOOP UNTIL E$ = CHR$(27)
END

Posted on Mar 16, 2013, 12:26 PM

Respond to this message   

Return to Index


Re: Jackpot program needs to be optimized

by AlGoreIthm (no login)


AT 3 of the same out of 4 possibilities, your winners must look like this:

WWW_
WW_W
W_WW
_WWW

so that would give you a line like this, with parentheses optional:

IF (A = B AND A = C) OR IF (A = B AND A = D) OR IF (A = C AND A = D) OR IF (B = C AND B = D) )

If this is wrong I hope someone will point it out.

Posted on Mar 16, 2013, 3:54 PM

Respond to this message   

Return to Index


Too many IFs

by lawgin (no login)

Only the first one is needed. Anyways both sides of OR have to be expressions, not statements.

IF (A = B AND A = C) OR (A = B AND A = D) OR (A = C AND A = D) OR (B = C AND B = D) THEN
PRINT "You won a big prize"
END IF

Posted on Mar 16, 2013, 5:48 PM

Respond to this message   

Return to Index


Yep

by AlGoreIthm (no login)


Actually after I had a chance to look at Solitaire's posted code, it looks to be the same as the line she noted as being 'This list is incomplete'.

All depending if the point of the exercise is a way to include ELSEIF in the code or if it is to find an alternative solution to making the program work correctly, this is what I would offer:


m$(0) = "Sorry, you didn't win."
m$(1) = " You won the jackpot! "
m$(2) = "You won a small prize."
m$(3) = "You won a large prize."

'How can the ElseIf statement be shortened to display 3 out of 4?
'DIM A AS INTEGER, B AS INTEGER, C AS INTEGER, D AS INTEGER, E AS STRING
RANDOMIZE TIMER
'Note: It's extremely difficult to win the jackpot with a single RANDOMIZE TIMER
DO
CLS
PRINT TAB(20); "JACKPOT"
PRINT
PRINT "Spin 4 random numbers. 2 out of 4 wins a small prize."
PRINT "3 out of 4 wins a bigger prize. 4 out of 4 wins the jackpot!"


A = INT(6 * RND) + 1
RANDOMIZE TIMER
B = INT(6 * RND) + 1
RANDOMIZE TIMER
C = INT(6 * RND) + 1
RANDOMIZE TIMER
D = INT(6 * RND) + 1

PRINT
COLOR 14
PRINT TAB(10); A; TAB(20); B; TAB(30); C; TAB(40); D 'Yellow
COLOR 7
PRINT

m% = 0 ' Default value

IF A = B AND A = C AND A = D THEN m% = 1 ' JackPOT!!
IF A = B OR A = C OR A = D OR B = C OR B = D OR C = D THEN m% = 2 ' 2 out of 4
IF (A = B AND A = C) OR (A = B AND A = D) OR (A = C AND A = D) OR (B = C AND B = D) THEN m% = 3 ' 3 out of 4

IF m% = 1 THEN COLOR 10

PRINT m$(m%)

PRINT : PRINT
PRINT "Press any key to spin again, or Esc to stop..."
E$ = INPUT$(1)
LOOP UNTIL E$ = CHR$(27)
END

Posted on Mar 16, 2013, 6:41 PM

Respond to this message   

Return to Index


I was looking for something more efficient.

by Solitaire (Login Solitaire1)
S

Instead of all those ORs in the ElseIf line (that I had commented out), I was hoping there might be some kind of shortcut, possibly using nested loops with a counter, to find any matching combinations. Understand that this can get very complicated if there were 5 or more random numbers to select. So I was looking for an algorithm that would work with any number of matches. The display (that you concocted with arrays) is not the issue.

I had tried putting the random numbers inside an array, and used a loop with a counter. It worked for 1 or 2 out of 3 matches, but not for 3 out of 3.

Posted on Mar 16, 2013, 9:23 PM

Respond to this message   

Return to Index


This should do it

by AlGoreIthm (no login)

After brief testing, it appears to work for any number of spinners

Some extra code was left in so you could comment it 'IN' and see it working for yourself if you want to.

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


total% = 3 ' or 4,5,6,7 etc - this is the number of spinners

highest.value% = 6 ' this is the highest value for a spinner, lowest is always 1

DIM spinners%(total%), compile%(highest.value%)

DO

CLS
COLOR 7
PRINT TAB(20); "JACKPOT"
PRINT
PRINT "Spin"; total%; "random numbers. 2 out of"; total%; "wins a small prize."
PRINT "3 out of 4 wins a bigger prize. 4 out of 4 wins the jackpot!"

FOR l% = 1 TO highest.value%
compile%(l%) = 0 ' ERASE or CLEAR might work to reset the array to all zeros
NEXT

FOR l% = 1 TO total%
RANDOMIZE TIMER
spinner%(l%) = INT(highest.value% * RND) + 1
compile%(spinner%(l%)) = compile%(spinner%(l%)) + 1
NEXT

PRINT
COLOR 14
FOR l% = 1 TO total%
PRINT TAB(l% * 10); (spinner%(l%));
NEXT
PRINT

max% = 0
FOR l% = 1 TO highest.value%
' PRINT compile%(l%)
IF compile%(l%) > max% THEN max% = compile%(l%)
NEXT l%
PRINT

'PRINT max%

IF max% = total% THEN
COLOR 10
PRINT "YOU WON THE JACKPOT!!"
END IF

' Here goes everything between winning the Jackpot and no win

IF max% = 1 THEN
PRINT "Sorry ... you didn't win..."
END IF

PRINT : PRINT
PRINT "Press any key to spin again, or Esc to stop..."
E$ = INPUT$(1)
LOOP UNTIL E$ = CHR$(27)
END

Posted on Mar 17, 2013, 7:51 AM

Respond to this message   

Return to Index


VERY minor correction:

by (Login Kewbie)
R

changed

PRINT "Spin"; total%; "random numbers. 2 out of"; total%; "wins a small prize."
PRINT "3 out of 4 wins a bigger prize. 4 out of 4 wins the jackpot!"

to

PRINT "Spin"; total%; "random numbers."; total% - 2; "out of"; total%; "wins a small prize."
PRINT TRIM$(STR$(total% - 1));" out of 4 wins a bigger prize. "; total%; "out of"; total%; "wins the jackpot!"

Posted on Mar 17, 2013, 8:44 AM

Respond to this message   

Return to Index


Revised code with better display and more options

by Solitaire (Login Solitaire1)
S

I had spent a couple of hours on my laptop revising the code this morning and thought I had saved it. But when I tried to copy it to my desktop computer later this afternoon, all I had was the original version!
Very frustrating, but I managed to recreate the revision, and here it is:

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

'Prepared by AlGorIthm; Revised by Solitaire
'Changed variable names; declared all variables with DIM; removed suffixes
'Corrected colors and display of instructions and results
'Added option to change number of spinners
'Cleaned up code and added indentation

DIM TOTAL AS INTEGER, high AS INTEGER, max AS INTEGER
DIM x AS INTEGER, snum AS STRING, E AS STRING

TOTAL = 3 'default number of spinners to start
high = 6 'highest value for a spinner, lowest is 1

DIM spinners(TOTAL) AS INTEGER
DIM compile(high) AS INTEGER

DO
    CLS
    PRINT TAB(20); "JACKPOT"
    PRINT
    PRINT "Spin"; TOTAL; "random numbers. ";
    IF TOTAL = 3 THEN
        PRINT " 2 out of 3 wins a prize. ";
    ELSEIF TOTAL > 3 THEN
        PRINT TOTAL - 2; "out of"; TOTAL; "wins a small prize."
        PRINT TOTAL - 1; "out of"; TOTAL; "wins a bigger prize. ";
    END IF
    PRINT TOTAL; "out of"; TOTAL; "wins the jackpot!"

    FOR x = 1 TO high
        compile(x) = 0 ' reset array to all zeros
    NEXT

    FOR x = 1 TO TOTAL
        RANDOMIZE TIMER
        spinner(x) = INT(high * RND) + 1
        compile(spinner(x)) = compile(spinner(x)) + 1
    NEXT

    PRINT
    COLOR 14
    FOR x = 1 TO TOTAL
        PRINT TAB(x * 10); (spinner(x));
    NEXT
    COLOR 7
    PRINT

    max = 0
    FOR x = 1 TO high
        IF compile(x) > max THEN max = compile(x)
    NEXT x
    PRINT

    PRINT max; " out of "; TOTAL

    IF max = TOTAL THEN
        COLOR 10
        PRINT "YOU WON THE JACKPOT!!"
        COLOR 7
    ELSEIF max = 1 THEN
        PRINT "Sorry, you didn't win."  'if less than 4 spinners
    ELSEIF TOTAL = 3 AND max = 2 THEN
        PRINT "You won a prize."
    ELSEIF max = TOTAL - 1 THEN
        PRINT "You won a big prize."
    ELSEIF max = TOTAL - 2 THEN
        PRINT "You won a small prize."
    ELSE
        PRINT "Sorry, you didn't win."  'if 4 or more spinners
    END IF

    PRINT : PRINT
    PRINT "Press any key to spin again, Tab to change number of spinners, or Esc to stop..."
    E$ = INPUT$(1)
    IF E$ = CHR$(9) THEN
        PRINT : INPUT "Enter number of spinners:  ", snum$
        TOTAL = VAL(snum$)
        IF TOTAL < 2 OR TOTAL > 6 THEN TOTAL = 3    'default number
        REDIM spinners(TOTAL)
    END IF
LOOP UNTIL E$ = CHR$(27)
END

Posted on Mar 17, 2013, 4:19 PM

Respond to this message   

Return to Index


Using an array

by (no login)

Using an array might shorten your code.

Maybe something like this :


DIM x(4)
x(1) = INT(6 * RND) + 1
RANDOMIZE TIMER
x(2) = INT(6 * RND) + 1
RANDOMIZE TIMER
x(3) = INT(6 * RND) + 1
RANDOMIZE TIMER
x(4) = INT(6 * RND) + 1

FOR index = 2 to 4
match = match + ((x(1) = x(index)) +1)
NEXT index
'This will tell you the number of numbers equal to x(1) and then you can loop it to check against the other 3.

Posted on Mar 16, 2013, 4:20 PM

Respond to this message   

Return to Index


using an array (edited)

by (Login MCalkins)
Moderator

I don't know how efficient it is, but it seems scalable.

I don't think that it needs more than one RANDOMIZE TIMER. (However, the sequence will repeat after 2^24 calls to RND.)

Regards,
Michael

' For QBasic, change _UNSIGNED _BYTE to INTEGER

CONST NumOfDice = 5 ' making this CONST allows some calculation to be done at compile time instead of runtime
' NumOfDice must be < 256, with current data types.

DIM wr AS DOUBLE, pr AS DOUBLE
DIM s AS STRING, e AS STRING
DIM w AS LONG, p AS LONG, t AS LONG
DIM r(0 TO 5) AS _UNSIGNED _BYTE
DIM d AS _UNSIGNED _BYTE, i AS _UNSIGNED _BYTE, m AS _UNSIGNED _BYTE

s = "Spin" + STR$(NumOfDice) + " random numbers." + STR$(NumOfDice - 1) + " out of" + STR$(NumOfDice) + " wins a prize." + CHR$(&HD) + LTRIM$(STR$(NumOfDice)) + " out of" + STR$(NumOfDice) + " wins the jackpot."
e = "Expected jackpots: 1 /" + STR$(6 ^ (NumOfDice - 1)) + ", Expected prizes:" + STR$(6 * NumOfDice - 1) + " /" + STR$(6 ^ (NumOfDice - 1))
wr = 1 / 6 ^ (NumOfDice - 1)
pr = (6 * NumOfDice - 1) / 6 ^ (NumOfDice - 1)
RANDOMIZE TIMER
DO
 CLS
 PRINT TAB(20); "JACKPOT"
 PRINT
 PRINT s

 ERASE r
 m = 0
 COLOR 14
 FOR i = 1 TO NumOfDice
  d = INT(6 * RND)
  r(d) = r(d) + 1
  IF m < r(d) THEN m = r(d)
  PRINT d + 1;
 NEXT
 COLOR 7
 PRINT

 SELECT CASE m
  CASE NumOfDice: COLOR 10: PRINT "You won the jackpot!": COLOR 7: w = w + 1
  CASE NumOfDice - 1: PRINT "You won a prize.": p = p + 1
  CASE ELSE: PRINT "Sorry, you didn't win."
 END SELECT
 t = t + 1
 PRINT: PRINT

 PRINT "jackpots:"; w, "prizes"; p, "total:"; t
 PRINT e
 ' I'm assuming that floating point multiplication is faster than integer division.
 ' PRINT "Expected wins by now:"; t \ 6 ^ (NumOfDice - 1)
 ' PRINT "Expected prizes by now:"; t * (6 * NumOfDice - 1) \ 6 ^ (NumOfDice - 1)
 PRINT "Expected jackpots by now:"; INT(t * wr)
 PRINT "Expected prizes by now:"; INT(t * pr)

 PRINT: PRINT
 PRINT "Press any key to spin again, or Esc to stop..."
LOOP UNTIL INPUT$(1) = CHR$(&H1B)
END

Posted on Mar 17, 2013, 3:09 AM

Respond to this message   

Return to Index


basis for the probabilities

by (Login MCalkins)
Moderator

DEFLNG A-Z

win = 0: p = 0
FOR x = 1 TO 6
 FOR y = 1 TO 6
  FOR z = 1 TO 6
   IF x = y AND x = z THEN win = win + 1
   IF x = y THEN p = p + 1 ' all but z
   IF x = z THEN p = p + 1 ' all but y
   IF y = z THEN p = p + 1 ' all but x
  NEXT
 NEXT
NEXT
PRINT win; "/"; 6 ^ 3
PRINT p, p - win
PRINT

win = 0: p = 0
FOR w = 1 TO 6
 FOR x = 1 TO 6
  FOR y = 1 TO 6
   FOR z = 1 TO 6
    IF w = x AND w = y AND w = z THEN win = win + 1
    IF w = x AND w = y THEN p = p + 1 ' all but z
    IF w = x AND w = z THEN p = p + 1 ' all but y
    IF w = y AND w = z THEN p = p + 1 ' all but x
    IF x = y AND x = z THEN p = p + 1 ' all but w
   NEXT
  NEXT
 NEXT
NEXT
PRINT win; "/"; 6 ^ 4
PRINT p, p - win
PRINT

win = 0: p = 0
FOR v = 1 TO 6
 FOR w = 1 TO 6
  FOR x = 1 TO 6
   FOR y = 1 TO 6
    FOR z = 1 TO 6
     IF v = w AND v = x AND v = y AND v = z THEN win = win + 1
     IF v = w AND v = x AND v = y THEN p = p + 1 ' all but z
     IF v = w AND v = x AND v = z THEN p = p + 1 ' all but y
     IF v = w AND v = y AND v = z THEN p = p + 1 ' all but x
     IF v = x AND v = y AND v = z THEN p = p + 1 ' all but w
     IF w = x AND w = y AND w = z THEN p = p + 1 ' all but v
    NEXT
   NEXT
  NEXT
 NEXT
NEXT
PRINT win; "/"; 6 ^ 5
PRINT p, p - win
END

Posted on Mar 17, 2013, 3:18 AM

Respond to this message   

Return to Index


Slight revision

by Solitaire (Login Solitaire1)
S

Thank you, Michael. I had worked on the revision of AlGorIthm's code before I saw your post. I just made some very minor changes to your code, mostly in the instruction and result display.

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

'by Michael Calkins
CONST NumOfDice = 5 ' making this CONST allows some calculation to be done at compile time instead of runtime
' NumOfDice must be < 256, with current data types.

DIM wr AS DOUBLE, pr AS DOUBLE
DIM s AS STRING, e AS STRING
DIM w AS LONG, p AS LONG, t AS LONG
DIM r(0 TO 5) AS INTEGER
DIM d AS INTEGER, i AS INTEGER, m AS INTEGER

'Adjusted display by Solitaire
s = "Spin" + STR$(NumOfDice) + " random numbers. " + STR$(NumOfDice - 2) + " out of" + STR$(NumOfDice) + " wins a small prize."
s = s + CHR$(13) + STR$(NumOfDice - 1) + " out of" + STR$(NumOfDice) + " wins a big prize.  " + LTRIM$(STR$(NumOfDice)) + " out of" + STR$(NumOfDice) + " wins the jackpot."
e = "Expected jackpots: 1 /" + STR$(6 ^ (NumOfDice - 1)) + ", Expected prizes:" + STR$(6 * NumOfDice - 1) + " /" + STR$(6 ^ (NumOfDice - 1))
wr = 1 / 6 ^ (NumOfDice - 1)
pr = (6 * NumOfDice - 1) / 6 ^ (NumOfDice - 1)
RANDOMIZE TIMER
DO
 CLS
 PRINT TAB(20); "JACKPOT"
 PRINT
 PRINT s
 PRINT

 ERASE r
 m = 0
 COLOR 14
 FOR i = 1 TO NumOfDice
  d = INT(6 * RND)
  r(d) = r(d) + 1
  IF m < r(d) THEN m = r(d)
  PRINT d + 1;
 NEXT
 COLOR 7
 PRINT : PRINT

 SELECT CASE m
  CASE NumOfDice: COLOR 10: PRINT "You won the jackpot!": COLOR 7: w = w + 1
  CASE NumOfDice - 1: PRINT "You won a big prize.": p = p + 1   'added "big"
  CASE NumOfDice - 2: PRINT "You won a small prize.": p = p + 1 'added by Solitaire
  CASE ELSE: PRINT "Sorry, you didn't win."
 END SELECT
 t = t + 1
 PRINT : PRINT

 PRINT "jackpots:"; w, "prizes"; p, "total:"; t
 PRINT e
 ' I'm assuming that floating point multiplication is faster than integer division.
 ' PRINT "Expected wins by now:"; t \ 6 ^ (NumOfDice - 1)
 ' PRINT "Expected prizes by now:"; t * (6 * NumOfDice - 1) \ 6 ^ (NumOfDice - 1)
 PRINT "Expected jackpots by now:"; INT(t * wr)
 PRINT "Expected prizes by now:"; INT(t * pr)

 PRINT : PRINT
 PRINT "Press any key to spin again, or Esc to stop..."
LOOP UNTIL INPUT$(1) = CHR$(&H1B)
END

Posted on Mar 17, 2013, 4:24 PM

Respond to this message   

Return to Index


File/Path access error

by (no login)

I don't have a detailed technical knowledge of QBasic but I use it very successfully for some fairly complicated number crunching operations and rarely get any problems. I've always found this forum very helpful in solving problems when I've had them.
I've just started getting the above message, which I've never seen before. The detail of the message talks about making a correct connection between the path and filename, that the file spec is formatted correctly and dealing with read-only files also seems to be a problem. I've never dealt with read-only files don't have any as far as I'm aware so that can't be the issue. I've now started getting the error whenever I try to save an existing file with a different name, and also when I try to create and use a new file to write to and read from within an existing file. An example of one of these files that has generated this is error is: OPEN, "O", #1, "LFQ3ALL".
I would appreciate any help dealing with this issue.

Posted on Mar 16, 2013, 9:18 AM

Respond to this message   

Return to Index


No comma after 'OPEN'...

by OPRESION (no login)

OPEN "O", #1, "LFQ3ALL"

Posted on Mar 17, 2013, 6:31 PM

Respond to this message   

Return to Index


File/Path access error

by (no login)

I don't understand your response. The format of the statement in my original message is what works for me in QBasic. Is there a different way of doing it?

Posted on Mar 18, 2013, 4:09 PM

Respond to this message   

Return to Index


No comma after OPEN

by (Login burger2227)
R

Did you come here to argue or for help? When you ask for Help you should listen, not argue.

Posted on Mar 18, 2013, 6:04 PM

Respond to this message   

Return to Index


Path/File access error

by (no login)

I came here looking for constructive help, not bad manners and a childish tantrum. It will no longer be an issue however, as I'll go elsewhere for assistance, from someone who knows how to behave like an adult. I am disappointed, as the people in this forum have always been very helpful in the past, but I guess that eventually there had to be someone to screw it up. It wasn't my intention to be argumentative - that is your interpretation of what I said - I simply didn't understand what you were suggesting. You might get a better response if you learn some manners.

Posted on Mar 18, 2013, 7:21 PM

Respond to this message   

Return to Index


I'm sorry about that.

by (Login MCalkins)
Moderator

Clippy's response was not appropriate. You are quite welcome at these forums.

Opression is correct, you had:

OPEN, "O", #1, "LFQ3ALL"

Which has one too many commas. QBASIC complains: "Expected: expression". It should be:

OPEN "O", #1, "LFQ3ALL"

You ask if there is another way of doing it. Actually, yes:

OPEN "LFQ3ALL" FOR OUTPUT AS 1

Is the QBasic style of doing it. The other syntax is supported for backwards compatibility, as indicated in the QBasic Help.

However, the comma was not the reason for the error. For error 75, QBASIC says:

-----
During an OPEN, MKDIR, CHDIR, or RMDIR operation, the
operating system was unable to make a correct connection
between the path and filename.

In the QBasic environment, make sure the file specification
you entered in the text box is formatted correctly. Any
filename can contain a drive name and a full or partial
path.

This error can also occur when you try to save a file which
would replace an existing read-only file.

ERR code: 75
-----

So, Can you open the file for input? Does:

OPEN "I", #1, "LFQ3ALL"

succeed, but:

OPEN "O", #1, "LFQ3ALL"

fail?

It is possible that the file is read-only. Find the file in Windows Explorer, right click, chose "Properties...", and see whether it has the "Read Only" check box checked.

Perhaps there is something wrong with the permissions for the file or the folder. Can you edit the file with Notepad? Can you create a new file in the same folder with Notepad?

Is your disk full?

Regards,
Michael

Posted on Mar 19, 2013, 1:46 AM

Respond to this message   

Return to Index


Path/File access error

by (no login)

Thank you, I appreciate that.

I now realise what generated the original issue in this thread - the comma I showed after the OPEN statement in my original post was a mis-type, and of course, I don't put commas after the OPEN statement in my files.

There is also no difference between trying to create and Input or Output file - the error happens for both. I tried your suggestion of the OPEN...FOR format of the file, thinking that I might sneak it past the system but no luck - same error. I also checked the relevant files but none of them are Read only.

The basic problem has been with attempting to create new files, either BAS files and also files that are generated from within a program - the ones that need INPUT and OUTPUT commands to work. Both types have always ended up in the relevant directory (C: in my case) in the past. However, my system suddenly started refusing to deal with anything new being added to the C: directory - which is why I suddenly started getting the error message - but the system will quite happily deal with any file that is already there.

So I found a way around it. If I want to create a brand new BAS file, which I haven't been able to do thusfar, I simply copy any existing file in the directory and paste it, then change the file name to the name of the new file I want to create. I can open it and modify it as much as I like, and the system is happy with it because it appears in the directory and thus doesn't appear to be a new file. I do something similar with the INPUT/OUTPUT type files and that also seems to work.

Seems like a bizarre way to deal with the problem but it works, so I'm happy until I find out the actual cause of the problem. I tried uninstalling and reinstalling the main QB application but that didn't make any difference. Perhaps there is a bug somewhere?

Posted on Mar 19, 2013, 4:57 PM

Respond to this message   

Return to Index


What version of Windows are you running?

by (Login MCalkins)
Moderator

The FAT file systems limited the number of entries that could occur in the root folder. NTFS does not have this problem.

I assume that your C: volume is FAT, and not NTFS?

http://support.microsoft.com/kb/120138

Regards,
Michael

Posted on Mar 19, 2013, 11:33 PM

Respond to this message   

Return to Index


File/Path access error

by (no login)

My system is NTFS

Posted on Mar 20, 2013, 4:19 PM

Respond to this message   

Return to Index


Just to verify that your copy of QB is installed properly,

by (Login Kewbie)
R

or has not somehow gotten corrupted, try running a simple program that doesn't do any file I/O.

Does:

PRINT "Hello, World!"

run, or do you still get a path error? If so, perhaps the path to one of QB's support files has somehow been changed to something invalid.

MC, if you read this, am I way off base here? I don't have any versions of QB installed to test my theory.

Kew

Posted on Mar 20, 2013, 8:54 AM

Respond to this message   

Return to Index


Re: Just to verify that your copy of QB is installed properly,

by (Login MCalkins)
Moderator

You can check whether the files are corrupted by using a file comparison utility or a cryptographic hash utility.

Qbasic 1.1 only comes with two files:

sha256 sums:

qbasic.exe dbfd7e7d27fea72877c5332551889b3d3c46fc5b72d15e35e232ea611570a2cd
qbasic.hlp 8c8d8a9004c18d56e0cd30d22fb17d7351ef7cdca5e1d7407c0b345572235e95

You can delete and recreate qbasic.ini

I have a pirated copy of QB45, but I suspect that it was corrupt from the start, as the error messages are in German, IIRC. (I think that I got it from Mark's forum.)

From what he said, he has too many files in his root folder. He is probably using the FAT file system.

Regards,
Michael

Posted on Mar 20, 2013, 10:33 AM

Respond to this message   

Return to Index


Path/File access error

by (no login)

I ran the file you suggested without a hitch. I also uninstalled and reinstalled the main QB application but it didn't make a difference. Everything runs exactly as it always has except for creating new files, whether BAS or within a BAS file. When I try to save a new file to the directory, everything works and looks like it always has until I click OK, then the error occurs. It also occurs when I run a program where I have inserted a new file, and I get the error as soon as the program reaches the OPEN statement. I know the directory isn't limited to a certain number of files because I can copy files within the directory and save the copy to the same place.

It seems like something has become corrupted, but I'm not sure how to track it down. Sure is bizarre!

Posted on Mar 20, 2013, 4:31 PM

Respond to this message   

Return to Index


Please don't do that.

by (Login MCalkins)
Moderator

He wasn't arguing. He was asking for clarification. Opression addressed one problem, but not the main problem.

Regards,
Michael

Posted on Mar 19, 2013, 1:49 AM

Respond to this message   

Return to Index


Need a good explanation about VARPTR

by (no login)

http://www.angelfire.com/scifi/nightcode/prglang/qbasic/function/memory/varptr.html

SYNOPSIS
VARPTR$(commandstring$)
o commandstring$ A string variable containing DRAW or PLAY commands.

-> Why do i need it at all ? A string with DRAW commands remains a string with commands, why do i need anything else ?

DESCRIPTION
Returns a string representation of a variable's address for use in DRAW and
PLAY statements.

Example:
Scale$ = "CDEFGAB"
PLAY "L16"
FOR i% = 0 TO 6
PLAY "O" + STR$(i%)
PLAY "X" + VARPTR$(Scale$)
NEXT i%

-> ? What "O", "X" stay for ? i don't get it at all. Also, Pete has a page, meanwhile 2 pages with tutorials on this stuff, but with explanation wholes imho :

http://www.petesqbsite.com/sections/tutorials/tuts/memory.htm

"The VARPTR function returns the address where a variable's information is stored in memory."

-> Well, what for ? If A$ = "ABCDE", then A$ returns the string.


"Example 1:

Example$ = "This is part of an example."
CLS
PRINT VARPTR(Example$) 'Display Example$'s offset.
PRINT VARSEG(Example$)"

Well, what's the use ?

http://www.petesqbsite.com/sections/tutorials/tuts/qp7_qbasic.html

" VARPTR$ stands for "variable pointer," a term you can completely ignore... "

-> I do !

"This can be accomplished by using the X command, which tells VARPTR$ where to plug in the string's address so it can be used. With box$ defined above, here's the code for a rotating box:

DO
angle% = angle% + 1
IF angle% >= 360 THEN angle% = 1
DRAW "c0 bm320,240 ta" + STR$(angle% - 1) + "X" + VARPTR$(box$)
DRAW "c1 bm320,240 ta" + STR$(angle%) + "X" + VARPTR$(box$)
LOOP WHILE INKEY$ = ""
END"

Why would i need to insert a string that way instead of just using a string variable ?

Thanks, L



Posted on Mar 14, 2013, 6:50 AM

Respond to this message   

Return to Index


Most of the time, you wouldn't need VARPTR$

by (Login MCalkins)
Moderator

The only reason to use it with PLAY or DRAW would be to avoid expensive string concatenation.

So, if I were to have:

a$ = "some really long string"

PLAY "a really long string" + a$

Concatenating those string might involve some fairly expensive memory operations. In such a case, you might get better performance out of:

PLAY "a really long string X" + VARPTR$(a$)

However, in the case of short strings, I probably wouldn't bother.


PLAY "X" + VARPTR$(Scale$)

appears in the QBasic Help. I'm pretty sure that they did that just for demonstration purposes. It would be less efficient than just having:

PLAY Scale$


There is a related, but distinct, function, VARPTR (without the $), which is quite useful in some situations, for doing things with memory, and running Assembly language functions (though CALL ABSOLUTE). The QB64 counterpart is _OFFSET, which is extremely useful, for the same reasons. It allows direct memory access, and it allows interfacing with code written in other languages (though DECLARE LIBRARY).

Regards,
Michael

Posted on Mar 14, 2013, 8:25 AM

Respond to this message   

Return to Index


Thanks Michael !

by (no login)

Let me add some thoughts about programming....

In fact this is the most important thing ever.

It's all about program structure :

The way most people think about structure is a collection of interacting elements, all on equal level, or a "menu", a succession of tasks achieved by the program. Now, there is the nested structure, like recursion, FOR loops, etc. Recursion is the nesting of itself.

All this to say that "divide to conquer" is to divide in the most simple tasks you can imagine. A very simple routine is a great help, and each time i managed to build such a simple helper i succeeded in programming. Can be such simple as a subtraction. It's an analytic thinking, which maybe can be applied to life, art, what ever, by trying to find simple sub-routines working behind the scene ; could be. Don't think successive, think inclusive.

The eye's retina is working that way too. At the cell level, line recognition is already done, and maybe motion detection etc. So, neuronal networks should be buildup that way, that on the edge to the input the neurons should only perform simple tasks and have limited interaction possibilities.

No brain simple sub routines are the most important rocks on which to build our church :-)

Posted on Mar 14, 2013, 12:12 PM

Respond to this message   

Return to Index


You are sharp as fuck, man

by Dick (no login)

Posted on Mar 24, 2013, 10:18 PM

Respond to this message   

Return to Index


qb vs. python speed check

by lawgin (no login)

Python is a pretty popular open source language nowadays, so I decided to do a quick speed check comparing it to qb. I used a recursive program that finds all the permutations of the string "abcdefghij". There are 10! or 3628800 of them.
The results are startling. qb64 finished in .49 sec, qb4.5 took 1.05 sec, but Python3.3 took over 12 sec. I tried to make the code as equivalent as possible line for line. Here's both listings. I commented out the print statements so they don't skew the results. The Basic code was adopted from the PERM02.BAS program which can be found here:
http://www.sunvaley.com/Download/ViewFiles.aspx?FileSet=QB

qb4.5/qb64:

t0 = TIMER
CALL perm("abcdefghi", 1)
t1 = TIMER - t0
PRINT t1
END
SUB perm (seq$, i)
IF i = LEN(seq$) THEN
REM PRINT seq$,
ELSE
FOR j = i TO LEN(seq$)
seq$ = LEFT$(seq$, i - 1) + RIGHT$(seq$, LEN(seq$) - i) + MID$(seq$, i, 1)
CALL perm(seq$, i + 1)
NEXT j
END IF
END SUB



python3.3:
Note: indents are vital in Python. They don't show up here, but there should be one after every colon.

def perm(seq,i):
if i==len(seq):
pass
#print(seq,end=' ')
else:
for j in range(i,len(seq)+1):
seq=seq[0:i-1]+seq[i:]+seq[i-1]
perm(seq,i+1)

import time
t0=time.time()
perm("abcdefghij",1)
t1=time.time()-t0
print (t1)
input()










Posted on Mar 1, 2013, 2:13 PM

Respond to this message   

Return to Index


Re: qb vs. python speed check

by (Login MCalkins)
Moderator

Is the python interpreted or compiled? If it's interpreted, then it is no wonder that it is slower. Interpreted QBASIC would also be significantly slower than compiled QB4.5.

>I tried to make the code as equivalent as possible line for line.

Would it make a difference if, instead of aiming for such equivalence, you optimized it for each language?

Non-inline function calls tend to have overhead, especially in QB64. If the recursive function calling could be replaced with a loop, I would expect better performance. Also, I believe that string manipulation, probably in both QB and QB64, is inefficient.

I would expect noticeably better performance if the string manipulation were written directly in C-style C++. Writing it directly in x86 assembly might mean a slight improvement over that.

If the times get too small, we might want to make the string longer...

This looks like a fun thing to play with. I'll try to come up with C++ and Assembly versions. (I'll prefer a loop to recursion). I'll probably design them to be called from QB64, so that we can use TIMER.

Regards,
Michael

Posted on Mar 1, 2013, 4:12 PM

Respond to this message   

Return to Index


Re: qb vs. python speed check

by lawgin (no login)

My understanding is that Python is compiled to bytecode rather than machine code which is supposed to improve performance somewhat. I ran the qb4.5 version directly. Creating the exe only produced a minor improvement (.97 vs. 1.05 sec).

My intention was to do a kind of "head to head" comparison of similar instructions. Python does have an optimized permutation function in it's "itertools" module.

Posted on Mar 1, 2013, 5:32 PM

Respond to this message   

Return to Index


A non-recursive version

by lawgin (no login)

The code below is based on Moneo's former posting which in turn was based on Dijkstra's algorithm for finding the next permutation. It runs significantly slower in qb64 than the recursive code I posted yesterday (1.5 vs. .5 sec). Maybe someone can find a way to speed it up. My translation of this non-recursive code to Python lags far behind at 11 sec. Again, printing to screen is commented out because it really drags down execution time.

qb version:

DEFINT A-S
n = 10
FOR x = 1 TO 10
a$(x) = CHR$(x + 96)
NEXT x
t0 = TIMER
DO
'FOR x = 1 TO n
'a$ = a$ + a$(x)
'NEXT x
'PRINT a$,
'a$ = ""
i = n - 1
WHILE a$(i) > a$(i + 1): i = i - 1
WEND
j = n
WHILE a$(i) > a$(j): j = j - 1: WEND
SWAP a$(i), a$(j)
r = n
s = i + 1
DO WHILE r > s
SWAP a$(r), a$(s)
r = r - 1
s = s + 1
LOOP
LOOP UNTIL i < 1
t1 = TIMER - t0
PRINT t1
SLEEP


Python version:

import time
n=9
i=0
a=['a','b','c','d','e','f','g','h','i','j']
t0=time.time()
while i>-1:
#print(a)
i=n-1
while a[i]>a[i+1]:
i-=1
j=n
while a[i]>a[j]:
j-=1
a[i],a[j]=a[j],a[i]
r=n
s=i+1
while r>s:
a[r],a[s]=a[s],a[r]
r-=1
s+=1
t1=time.time()-t0
print(t1)
input()




Posted on Mar 2, 2013, 2:38 PM

Respond to this message   

Return to Index


Is it ok if I chime in with a version in a different dialect?

by (Login Kewbie)
R

Here's a PowerBASIC recursive version (with some additions):

#COMPILE EXE "C:\Temp\SpeedTst.exe"
#DIM ALL

%MAXLOOPS = 100

FUNCTION PBMAIN () AS LONG
LOCAL pdx, t0, t1, tA, tH, tL AS DOUBLE

tL = 99
CLS

FOR pdx = 1 TO %MAXLOOPS
t0 = TIMER

perm("abcdefghi", 1)

t1 = TIMER - t0

tL = MIN(t1, tL)
tH = MAX(t1, tH)

tA += t1

? t1
NEXT pdx

? "Fastest:"; tL
? "Slowest:"; tH
? "Average:"; tA / %MAXLOOPS
END FUNCTION

SUB perm (seq AS STRING, i AS INTEGER)
LOCAL j AS INTEGER

IF i = LEN(seq) THEN
'PRINT seq
ELSE
FOR j = i TO LEN(seq)
'seq = LEFT$(seq, i - 1) + RIGHT$(seq, LEN(seq) - i) + MID$(seq, i, 1)
seq = LEFT$(seq, i - 1) + RIGHT$(seq, -i) + MID$(seq, i, 1)
CALL perm(seq, i + 1)
NEXT j
END IF
END SUB

This code produced the following abridged output:

.48400000000268
.43600000000594
.437000000004424
.436999999999067
.436999999993716
.
.
.
.436000000002913
.437000000001397
.43699999999604
.437000000005241
.420999999999886
Fastest: .420999999993484
Slowest: .48400000000268
Average: .434930000000535

The first iteration is always the slowest, leading me to believe that there is some initialization taking place that somehow gets timed along with the looped code. The
point being that a single execution of the perm function doesn't necessarily tell the
whole story.

As a final experiment, I ran the test simultaneously in 3 command prompt windows with
the following truncated results:

Window 1:
Fastest: .42100000000314
Slowest: .967000000002329
Average: .649550000000388

Window 2:
Fastest: .420999999998251
Slowest: 1.0140000000028
Average: .641639999999954

Window 3:
Fastest: .420999999996155
Slowest: 1.29500000000163
Average: .66997999999977

Incidentally, in the simultaneous execution test, the first interation wasn't necessarily
the slowest.

Lawgin, perhaps you could try modifying your program to run the test multiple times and
do some averaging?

MC, I'll be very interested to see the version you come up with using loops rather than
recursion.

Kew

I made a slight change to the code, taking advantage of a PB extension to the string functions, i.e. a negative length is interpreted as (LEN(string_expression) - ABS(n)).

old -> seq = LEFT$(seq, i - 1) + RIGHT$(seq, LEN(seq) - i) + MID$(seq, i, 1)
new -> seq = LEFT$(seq, i - 1) + RIGHT$(seq, -i) + MID$(seq, i, 1)

This shaved a whopping 100th/sec off of the average time.

Fastest: .42099999999278
Slowest: .452000000007104
Average: .423219999999242

But that first iteration is still the slowest.

K

Posted on Mar 1, 2013, 9:31 PM

Respond to this message   

Return to Index


The more, the merrier

by lawgin (no login)

I don't have Power Basic installed on my computer so I can't compare my results to yours in any meaningful way. I tried looping the program I posted yesterday in a single window. The timings didn't vary much: 0.492-0.496 sec with qb64.

Posted on Mar 2, 2013, 2:03 PM

Respond to this message   

Return to Index


Can't figure out the algo..

by (no login)

First I = 1, starting the FOR loop, then the recursion calls from inside the FOR, at first time, the function again (i + 1) so the loop is started again for each i until LEN(seq$), so this starts a series of nested FOR loops with decreasing length ?

And what about the stack ?

Thanks, L

Posted on Mar 2, 2013, 3:46 PM

Respond to this message   

Return to Index


I think I can help you with the stack...

by (Login Kewbie)
R

but the algorithm ties my brain in knots.

You're probably thinking with all the nested calls, that the stack must eventually overflow, but the nesting never goes any deeper than len(seq$). Once it gets to that depth, it prints that permutation, then backs out a level, swaps around the characters in seq$, and goes back in to print the next permutation.

At least, I THINK that's how it works. If it turns out that I'm wrong, somebody PLEASE produce a fully commented version of the program and enlighten all of us.

Kew

Posted on Mar 2, 2013, 9:36 PM

Respond to this message   

Return to Index


This may clarify it somewhat

by lawgin (no login)

I tried using an array instead of a string to store the permutations. This makes the code a little simpler. And you can see how the recursion always solves the minimal problem first, moving from right to left.


FOR x = 1 TO 4
a$(x) = CHR$(x + 96)
NEXT x

CALL perm(a$(), 1)
END

SUB perm (a$(), i)
n = 4
IF i = n THEN
FOR b = 1 TO n: PRINT a$(b);: NEXT
PRINT CHR$(32);
ELSE
FOR j = i TO n
SWAP a$(i), a$(j)
CALL perm(a$(), i + 1)
SWAP a$(i), a$(j)
NEXT j
PRINT
END IF
END SUB






Posted on Mar 3, 2013, 2:48 PM

Respond to this message   

Return to Index


Scheme

by aoeu (no login)

(define (flatmap f seq)
(fold-right append '() (map f seq)))

(define (remove item seq)
(filter (lambda (x) (not (= item x))) seq))

(define (permutations s)
(if (null? s) (list '()) ; there is 1 permutation of the empty set
(flatmap (lambda (x)
(map (lambda (p) (cons x p)) ; move x to the beginning
(permutations (remove x s)))) ; permute rest of elements
s)))

;(permutations '(1 2 3))
;Value: ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))

Posted on Mar 4, 2013, 12:58 AM

Respond to this message   

Return to Index


Scheme Results

by PhyloGenesis (no login)

What are your results for Scheme if you run that on the same input??

Also, I'd love to see a C and C++ version of this. Let's compare all the languages while we're at it. :-D

PhyloGenesis

Posted on Mar 5, 2013, 12:39 PM

Respond to this message   

Return to Index


The List-Based Version ran out of memory

by aoeu (no login)

The following vector-based version uses the same algorithm.

;(declare (usual-integrations remove))


(define (vector-swap! v i j)
(let ((tmp (vector-ref v i)))
(vector-set! v i (vector-ref v j))
(vector-set! v j tmp)))

;(define (print-perm p) (display p) (newline))

(define (print-perm p) 0)

(define (permute p i)
(let ((n (vector-length p)))
(if (= i (- n 1)) (print-perm p)
(begin
(do ((j i (+ j 1))) ((= j n))
(vector-swap! p i j)
(permute p (+ i 1)))
(do ((j (- n 1) (- j 1))) ((< j i))
(vector-swap! p i j))))))

(define (permutations n)
(let ((p (make-vector n)))
(do ((i 0 (+ i 1))) ((= i n)) (vector-set! p i i))
(permute p 0)))


(permutations 10) takes 0.501 seconds.


Posted on Mar 6, 2013, 6:02 PM

Respond to this message   

Return to Index


A bit of a correction

by lawgin (no login)

In the first post on this thread I stated that there were 10! permutations of the string "abcdefghi". I guess I should have used my fingers to count because there are only nine characters there. I presume the Scheme based code used the full 10! permutations. If so, it looks very speedy.

This code takes an average of 3.65 seconds to run under qb64 on my machine for the full 10! perms.


t0 = TIMER
DEFINT A-S
FOR s = 1 TO 10
a$(s) = CHR$(s + 96)
NEXT s
CALL perm(a$(), 1)
t1 = TIMER - t0
PRINT t1
END


SUB perm (a$(), i)
n = 10
IF i = n THEN
'FOR b = 1 TO n: PRINT a$(b);: NEXT
'PRINT CHR$(32);
ELSE
FOR j = i TO n
SWAP a$(i), a$(j)
CALL perm(a$(), i + 1)
SWAP a$(i), a$(j)
NEXT j
PRINT
END IF
END SUB






Posted on Mar 7, 2013, 9:22 AM

Respond to this message   

Return to Index


Another correction

by lawgin (no login)

That last PRINT in the SUB should have been removed or commented out. With this done the execution time is reduced from 3.65 to 2.15 secs.

Posted on Mar 7, 2013, 9:29 AM

Respond to this message   

Return to Index


C version

by Barack Obama (no login)

void print_perm(int p[], int n)
{
int i;
/* for(i=0; i < n; i++)
printf("%d ", p[i]);
printf("\n"); */
return;
}

void permute(int p[],int i, int n)
{
int tmp;
int j;
if (i == n-1)
print_perm(p, n);
else
{
for (j=i; j<n; j++)
{
tmp = p[i]; /* swap */
p[i] = p[j];
p[j] = tmp;
permute(p,i+1,n);
}
for (j = n-1; j >= i; j--)
{
tmp = p[i];
p[i] = p[j];
p[j] = tmp;
}
}
}


int main()
{
int a[] = {1,2,3,4,5,6,7,8,9,10};
permute(a,0,10);
}

obama@lab22:~$ time ./a.out

real 0m0.167s
user 0m0.156s
sys 0m0.000s

with optimization:
obama@lab22:~$ gcc -O3 foo.c
obama@lab22:~$ time ./a.out

real 0m0.094s
user 0m0.084s
sys 0m0.000s

Posted on Mar 8, 2013, 12:42 PM

Respond to this message   

Return to Index


*Wow, that's speedy!

by (Login PhyloGenesis)
R

*

Posted on Mar 8, 2013, 3:17 PM

Respond to this message   

Return to Index


* some responses moved (URL)

by (Login MCalkins)
Moderator

http://www.network54.com/Forum/183705/message/1363055594/Political+posts+moved+from+main+subforum.

Posted on Mar 11, 2013, 7:36 PM

Respond to this message   

Return to Index


trouble compiling to exe qbasic 4.5

by (no login)

Hi everyone. I have a couple questions. I've been writing a text rpg in qbasic 4.5 and am having trouble converting it to .exe filetype. Whenever I try and convert it, it scrolls through my code really fast and I can't see the errors it says are present, but it is saying I have 2303 severe errors. My program runs fine when I play it through the editor and only says I have errors when I go to convert it. I've been able to snap a screenshot while it is converting and gives me something like below without the periods. I have a lot of comments like this which may explain the quantity of severe errors. How do I fix these? Or better yet, how do I make comments in qbasic properly? Also, is there a way to slow down the scrolling or go back and view the conversion process?

'----------look commands----------
^ Invalid character
.^ Invalid character
..^ Invalid character
...^ Invalid character
....^ Invalid character
.....^ Invalid character
......^ Invalid character
.......^ Invalid character
........^ Invalid character
.................^ Equal sign missing
........................^ Invalid character
.........................^ Invalid character
..........................^ Invalid character
...........................^ Invalid character
............................^ Invalid character
.............................^ Invalid character
..............................^ Invalid character

Posted on Feb 28, 2013, 12:23 PM

Respond to this message   

Return to Index


Re: trouble compiling to exe qbasic 4.5

by (Login MCalkins)
Moderator

Can you post your code? From within QB, save as "Text - Readable by Other Programs". Then open it in Notepad and copy and paste the code to a forum post.

Comments in QBASIC are made with the apostrophe/single quote character:
'

Can the program be compiled in QB64, perhaps after with a few modifications?

You can redirect the output of bc.exe to a file. Run:
bc delme.bas > delme.txt
Press enter twice.

Regards,
Michael

Posted on Feb 28, 2013, 1:03 PM

Respond to this message   

Return to Index


my code

by (no login)

Here's my code. Its rather long and may seem primitive for it's the first program I've written in basic. The various ascii art may look weird in the post due to the spaces being removed between characters as well as Notepad interpreting then differently than qbasic. As for compiling in QB64, it creates a .exe file without any modifications to my program, but when I run the .exe file it opens in a QB64 window. It will not load in DOSBox either through the terminal or drag-and drop method.


strength = 1
attack = 1



PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ°°°°ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ°°°°ÍÍÍÍÍÍÍÍ»"
PRINT "º °° °° °° °° º"
PRINT "º ÛßÛÛÛÛÛÛÜ °° °°° °° º"
PRINT "º ÛÛ ÛÛ °°°°° °°° º"
PRINT "º ÛÛ ÛÛ ÜÛß ÜÛ ÛÜÜÜÜ °°ÜÜÜÜÜ ÜÜÜÜ ÜÜÜÜ ÛÜÜÜÜ° ÜÜÜÜ º"
PRINT "º ÛÛ ÛÛ ÜÛß ÛÛ ÛÛ ÛÛ°°ÛÛ ÛÛ ÛÜÜÜÜß Ûß Û ÛÛ °°ÛÛ ßÜÜ º"
PRINT "º ÜÛÛÜÜÛÛß ßÛÛÛßÛÜ ÜÛ ÛÛ°°°ßÛÜÜÜÛß ÛÜÜÜÜ ßÜÜÜÜß ÜÛ °°ÛÛ ÜÜÜÜß º"
PRINT "º °°°ÜÜÜÜÜÛß °°° º"
PRINT "º °°° °° °°° º"
PRINT "º °°° °° °°° º"
PRINT "º °°° °° °°° º"
PRINT "º °°° °° °°° º"
PRINT "º °°° °° °°° º"
PRINT "º °°° °° °°° º"
PRINT "º °°° °° °°° º"
PRINT "º °°°ÛßÛÛÛÛÛÛÜ °° °°° º"
PRINT "º °°° ÛÛ ÛÛ °° °°° º"
PRINT "º °°° ÛÛ ÛÛ ÛÜÜÜÜ°° ÜÜÜÜ°°° ÜÜÜÜÜ ÜÜÜÜ ÛÜÜÜÜ º"
PRINT "º ° °°° ÛÛ ÛÛ ÛÛ ß°°ÜÛß ÛÛ° ÛÛ ÛÛ Ûß Û ÛÛ ÛÛ º"
PRINT "º °°° °°° ÜÛÛÜÜÛÛß ÜÛ ßÛÛÜÜÛßÛÜ ßÛÜÜÜÛß ßÜÜÜÜß ÜÛ ÛÛ º"
PRINT "º ° °°° °° °°° ÜÜÜÜÜÛß º"
PRINT "º ° °° °° º"
PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍ°°ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ°°ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"


SLEEP 10
FOR cnt = 0 TO 17
PRINT ""
NEXT cnt
cnt = 0
roomcnt = 0

'====================DUNGEON 1====================

'ROOM 1
20 map1 = 1
PRINT ""
PRINT "-PRISONER'S CHAMBER"
PRINT ""
PRINT ""
21 PRINT "Ughh..."
PRINT ""
SLEEP 2
PRINT "You awaken with a pounding headache and the realization that you're shackled to a wall. You look to see a skeleton next to you. There is also a door on the North wall."
PRINT ""
30 GOSUB question
40 GOSUB room1commands


'==========ROOM 1 SUBROUTINES==========
'----------look commands----------

room1commands:

IF userinput$ = "look skeleton" THEN
IF rib = 1 THEN
PRINT "The skeleton is missing a rib."
ELSE
PRINT "It seems as if the skeleton has been here a long time for there are cob webs amongst its loose ribs."
ribcnt = 1
END IF
END IF

IF userinput$ = "look shackles" THEN
IF shackles = 1 THEN
PRINT "The shackles hang from your arm."
ELSE
PRINT "The shackles appear to be made out of the wroughtest of irons with a sizeable lock binding you to the wall."
END IF
END IF

IF userinput$ = "look door" THEN
IF shackles = 1 THEN
PRINT "A tall door stands before you. A beam of light passes through the keyhole along with an unfamiliar smell."
lookdoor = 1
ELSE
PRINT "It looks to be a well crafted door, but it won't do you any good if you're shackled to a wall."
END IF
END IF

IF userinput$ = "look lock" THEN
PRINT "It's a tarnished lock with a skeleton key hole"
END IF

IF userinput$ = "look room" THEN
IF shackles = 1 THEN
50 PRINT _
"You rub your jaw and wonder 'How long have I been out for. I think these shackles gave me the tetnis...' There is a tall door constructed of oaken wood before you along with a skeleton on the floor. You notice a brick with cracks all around it by the skeleton." _

ELSE
GOTO 20
END IF
END IF

IF userinput$ = "look wall" THEN
IF shackles = 1 THEN
PRINT "You notice a brick with cracks all around it by the skeleton."
brick = 1
ELSE
PRINT "It's a brick wall with grey mortar between the bricks."
END IF
END IF

IF userinput$ = "look brick" THEN
IF shackles = 1 THEN
PRINT "The brick seems loose enough to move."
brick = 2
ELSE
END IF
END IF

IF userinput$ = "look mortar" OR userinput$ = "inspect mortar" THEN
IF shackles = 1 THEN
PRINT "There are holes in the wall from where the shackles were mounted."
ELSE
PRINT "As you rub the mortar with your hand, it crumbles off the wall and onto the floor. "
END IF
END IF
'----------action commands----------

IF userinput$ = "get rib" OR userinput$ = "take rib" THEN
IF ribcnt = 1 THEN
PRINT "You find yourself tangled amongst the cob webs (as if the shackles weren't enough already), but you manage to get a rib."
rib = 1
ELSE
PRINT "Even though you're extremely famished, eating your own ribs isn't the best idea you've had so far."
END IF
END IF

IF userinput$ = "pick lock with rib" OR userinput$ = "pick lock" THEN
IF shackles = 1 THEN
PRINT "The lock doesn't budge..."
ELSE
IF rib = 1 THEN
PRINT "You try to wedge the rib into the lock but it doesn't fit. While wrestling with the lock you notice some mortar crumbling from the wall."
cnt = 1
ELSE
END IF
END IF
END IF

IF userinput$ = "remove shackles" THEN
IF shackles = 1 THEN
PRINT "Maybe you could remove the shackles if you had a key."
GOTO 60
ELSE
PRINT "The shackles remain firmly latched around your wrist."
END IF
END IF

IF userinput$ = "remove shackles with rib" OR userinput$ = "use rib on shackles" THEN
IF shackles = 1 THEN
PRINT "I bet you wish you could don't you."
GOTO 60
ELSE
51 PRINT "As you struggle to break the lock with the rib, you notice some mortar crumbling from the wall..."
cnt = 1
END IF
END IF

IF userinput$ = "remove mortar with rib" OR userinput$ = "use rib on motrar" THEN
IF cnt = 1 THEN
PRINT "You wedge the rib into the mortar and with all your might, you break free from the wall... but the shackles remain attached to you."
PRINT ""
PRINT " >>> STRENGTH INCREASED BY 1! <<<"
strength = strength + 1
shackles = 1
cnt = 0
ELSE
GOTO 51
END IF
END IF

IF userinput$ = "move brick" OR userinput$ = "remove brick" THEN
IF brick = 2 THEN
PRINT "You wiggle the brick loose and pull it out of the wall to reveal a length of string hidden behind it."
END IF
END IF

IF userinput$ = "get string" OR userinput$ = "take string" THEN
PRINT "You take the string and put it in your pocket."
cord = 1
END IF


IF userinput$ = "open door" THEN
' IF door = 1 THEN
GOTO 70 'goto room 2
' ELSE
' PRINT "How do you plan to open the door when it's locked?"
' END IF
END IF

' IF userinput$ = "open door with rib" THEN
' PRINT "It seems you've picked the lock on the door, but the rib breaks in the process."
' rib = 0
' door = 1
' END IF

60 PRINT ""
GOTO 30

'==========ROOM 2==========
70 IF map3 = 1 OR map4 = 1 OR map5 = 1 OR map20 = 1 OR map21 = 21 THEN
map1 = 0
ELSE
map1 = 0
map2 = 1
END IF

71 PRINT ""
PRINT "-BEGINNING OF CORRIDOR"
PRINT ""
PRINT ""
72 PRINT _
"You're standing at the beginning of a long and dark corridor that extends farther than you can see. A dank and putrid smell fills the hallway. There are two doors to the East labeled '1' and '2', and one door to the West labeled '3',along with the extending corridor leading North and a door to the South. You consider looking around a bit..." _

IF lookwest = 1 THEN
PRINT ""
PRINT "There is a torch on the West wall."
END IF
PRINT ""
80 GOSUB question
90 GOSUB room2commands

'==========ROOM 2 SUBROUTINES==========

'----------look commands----------

room2commands:

IF userinput$ = "look room" THEN
GOTO 72
END IF

IF userinput$ = "look north" THEN
IF walltorch = 1 THEN
PRINT "The corridor continues this way."
ELSE
PRINT "It's too dark to see..."
END IF
END IF

IF userinput$ = "look south" THEN
PRINT "There is a tall door here."
END IF

IF userinput$ = "look east" THEN
PRINT "This door looks like it's used a lot"
END IF

IF userinput$ = "look west" THEN
IF littorch = 1 OR littorch = 2 OR unlittorch = 1 THEN
PRINT "The door is covered in various stains."
ELSE
PRINT "The door is covered in various stains. An unlit torch sits mounted on the wall."
END IF
END IF

IF userinput$ = "look northeast" THEN
PRINT "In the far right corner resides a door. A flickering glow dances from under the door."
END IF
'----------action commands-----------

IF userinput$ = "open east door" THEN
IF unlockdoor1 = 1 THEN
GOTO 180
ELSE
PRINT "The door seems to be locked."
END IF
END IF

IF userinput$ = "unlock east door with prisoner's key" AND prisonerkey = 1 THEN
unlockdoor1 = 1
GOTO 180
END IF

IF userinput$ = "open northeast door" THEN
GOTO 100
END IF

IF userinput$ = "open west door" THEN
GOTO 110
END IF

IF userinput$ = "open south door" OR userinput$ = "go south" OR userinput$ = "walk south" THEN
PRINT ""
PRINT "-Prisoner's Chamber"
PRINT ""
PRINT ""
GOTO 50
END IF

IF userinput$ = "go north" OR userinput$ = "walk north" THEN
IF littorch = 1 THEN
GOTO 120
ELSE
PRINT "It is too dark to go there yet..."
END IF
END IF

IF userinput$ = "get torch" OR userinput$ = "take torch" THEN
IF unlittorch = 1 OR littorch = 1 OR littorch = 2 THEN
PRINT "You already took the torch off the wall."
ELSE
PRINT "After some struggling, the torch comes out of its mount."
unlittorch = 1
END IF
END IF

PRINT ""
GOTO 80

'==========EAST ROOM 1==========

180 IF map3 = 1 THEN
map3 = 0
map20 = 1
END IF
IF map5 = 1 THEN
map5 = 0
map20 = 0
map21 = 1
END IF

181 PRINT ""
PRINT "-CENTIPEDE"
PRINT ""
PRINT ""
PRINT _
"This must be where the guards take their break. There is a tire swing hanging from the ceiling and a ratty looking couch in the corner. You think to yourself, 'Man these guards really know how to have fun' as you become overwhelmed with jealousy." _

PRINT ""
182 GOSUB question
GOSUB eastroom1commands

'==========EAST ROOM 1 COMMANDS==========
eastroom1commands:

'----------look commands----------
IF userinput$ = "look room" THEN
GOTO 181
END IF

IF userinput$ = "look couch" THEN
PRINT "Although it smells like it's been left under a bridge for months, it looks pretty comfortable."
END IF

IF userinput$ = "look tire swing" OR userinput$ = "look swing" THEN
PRINT "The swing slowly sways back and forth while turning about. As it turns to the other side, you notice some degenerate has painted 'peasent seat' on the tire. The nerve of some people..."
END IF

'----------action commands----------
IF userinput$ = "open door" THEN
GOTO 70
END IF

IF userinput$ = "sit couch" OR userinput$ = "sit on couch" OR userinput$ = "lay on couch" THEN
PRINT "As you sit on the couch, a giant centipede crawls out from under the cushions and up the back rest. While screaming like a wussy and leaning away, you feel something under you."
END IF

IF userinput$ = "check couch" OR userinput$ = "search couch" THEN
PRINT "You find the dungeon key under the cushions."
dungeonkey = 1
END IF

PRINT ""
GOTO 182
'==========EAST ROOM 2==========

100 IF map20 = 1 THEN
map5 = 0
ELSE
IF map4 = 1 OR map5 = 1 THEN
map3 = 0
map4 = 0
map5 = 1
ELSE
map2 = 0
map3 = 1
END IF

IF rat < 1 THEN
PRINT " >>> A RAT SUDDENLY ATTACKS! <<<"
PRINT ""
END IF
END IF
PRINT ""
PRINT "-FIREPLACE CHAMBER"
PRINT ""
PRINT ""
101 PRINT "The room is filled with the delightful glow of a fireplace. A table sits on the North wall. There is also a door to the West."
PRINT ""
102 GOSUB question
GOSUB eastroom2commands

'==========EAST ROOM 2 COMMANDS==========

eastroom2commands:

'----------look commands----------
IF userinput$ = "look room" THEN
GOTO 101
END IF

IF userinput$ = "look table" THEN
PRINT "There is nothing on the table."
END IF

IF userinput$ = "look fireplace" OR userinput$ = "look fire" THEN
PRINT "A suprisingly well-tended fire burns in the fireplace, but no one except you is around to enjoy it."
END IF

'----------action commands----------

IF userinput$ = "open door" THEN
GOTO 70
END IF

IF userinput$ = "light torch with fire" OR userinput$ = "put torch on fire" OR userinput$ = "put torch in fire" THEN
IF littorch = 1 THEN
PRINT "The torch is already lit"
ELSE
PRINT "You place the torch in the fire and the wick lights right up. You now have a lit torch."
unlittorch = 0
littorch = 1
END IF
END IF

PRINT ""
GOTO 102

'==========WEST ROOM==========


110 IF map3 = 1 OR map5 = 1 THEN
map3 = 0
map4 = 0
map5 = 1
ELSE
map2 = 0
map4 = 1
END IF
IF map20 = 1 THEN
map4 = 0
map20 = 0
map21 = 1
END IF

PRINT ""
PRINT "-DRAINAGE AREA"
PRINT ""
PRINT ""
111 PRINT "An iron grate sits in the middle of the room with the floor slanted down towardsit on all sides. Puddles of blood and other bile slowly creep towards the grate.There is a door to the East."
PRINT ""
112 GOSUB question
GOSUB westroomcommands

'==========WEST ROOM COMMANDS==========

westroomcommands:

'----------look commands----------
IF userinput$ = "look room" THEN
GOTO 111
END IF

IF userinput$ = "look grate" THEN
PRINT "It looks as if something shiny is underneath the grate."
grate = 1
END IF

'----------action commands----------

IF userinput$ = "open door" THEN
GOTO 70
END IF

IF userinput$ = "open grate" THEN
IF grate = 2 THEN
PRINT "The grate is already open."
ELSE
PRINT "You pull the grate out of the floor to discover that a dagger has been hidden inside the drain."
grate = 2
getdagger = 1
END IF
END IF

IF userinput$ = "get dagger" THEN
IF dagger = 1 THEN
PRINT "You already took the dagger."
ELSE
IF getdagger = 1 THEN
PRINT "You reach down the drain and remove the dagger."
dagger = 1
ELSE
END IF
END IF
END IF

PRINT ""
GOTO 112

'==========END OF CORRIDOR==========

'120 IF map7 = 1 OR map8 = 1 OR map9 = 1 OR map10 = 1 OR map11 = 1 THEN
' GOTO 121
' ELSE
' map6 = 1
' END IF

120 IF map7 = 1 OR map8 = 1 OR map9 = 1 OR map10 = 1 OR map11 = 1 OR map12 = 1 OR map13 = 1 OR map14 = 1 OR map15 = 1 OR map16 = 1 OR map17 = 1 OR map18 = 1 OR map19 = 1 THEN
map6 = 0
ELSE
map6 = 1
END IF

PRINT ""
121 PRINT "-END OF CORRIDOR"
PRINT ""
PRINT ""
122 PRINT "This section of the corridor doesn't smell nearly as bad. There is a hallway which extends to the West and a door to the East. A tall staircase extends upward."
PRINT ""
123 GOSUB question
GOSUB endcorridorcommands

'==========END OF CORRIDOR SUBROUTINES==========

endcorridorcommands:

'----------look commands----------
IF userinput$ = "look room" THEN
GOTO 122
END IF


'----------action commands----------
IF userinput$ = "go up stairs" OR userinput$ = "go up staircase" OR userinput$ = "go north" THEN
PRINT "You climb the stairs only to find the door at the top will not open. You'll need a key to get through."
END IF

IF userinput$ = "unlock door with dungeon key" OR userinput$ = "unlock door" OR userinput$ = "unlock north door with dungeon key" OR userinput$ = "unlock north door" OR userinput$ = "unlock north door with prisoner's key" OR userinput$ = _
"unlock door with prisoner's key" THEN
PRINT "You climb the stairs and attempt to unlock the door..."
IF dungeonkey = 1 THEN
PRINT "The dungeon key fits and the door is unlocked."
dungeon1door = 1
ELSE
PRINT "The key doesn't seem to fit."
END IF
END IF

IF userinput$ = "go west" THEN
GOTO 140
END IF

IF userinput$ = "open east door" THEN
GOTO 130
END IF

IF userinput$ = "open north door" THEN
IF dungeon1door = 1 THEN
GOTO 190
ELSE
PRINT "The door won't budge."
END IF
END IF

IF userinput$ = "go south" THEN
GOTO 70
END IF

PRINT ""
GOTO 123

'==========TREASURE ROOM==========

'130 IF map11 = 1 THEN
' GOTO 131
' END IF
' IF map10 = 1 THEN
' map10 = 0
' map11 = 1
' GOTO 131
' END IF
' IF map8 = 1 OR map9 = 1 THEN
' map7 = 0
' map8 = 0
' map9 = 1
' ELSE
' map6 = 0
' map7 = 1
' END IF

130 IF map11 = 1 OR map12 = 1 OR map13 = 1 OR map17 = 1 OR map18 = 1 OR map19 = 1 THEN
map6 = 0
map10 = 0
ELSE
map6 = 0
map10 = 1
END IF
IF map7 = 1 THEN
map7 = 0
map10 = 0
map11 = 1
END IF
IF map8 = 1 THEN
map8 = 0
map10 = 0
map11 = 0
map12 = 1
END IF
IF map9 = 1 THEN
map9 = 0
map10 = 0
map12 = 0
map13 = 1
END IF
IF map14 = 1 THEN
map10 = 0
map14 = 0
map17 = 1
END IF
IF map15 = 1 THEN
map10 = 0
map15 = 0
map17 = 0
map18 = 1
END IF
IF map16 = 1 THEN
map10 = 0
map16 = 0
map18 = 0
map19 = 1
END IF
131 PRINT ""
PRINT "-TREASURE ROOM"
PRINT ""
PRINT ""
132 PRINT "treasure room"
PRINT ""
133 GOSUB question
GOSUB treasureroomcommands
'==========TREASURE ROOM SUBROUTINES==========

treasureroomcommands:
'----------look commands----------
IF userinput$ = "look room" THEN
GOTO 132
END IF

'----------action commands----------
IF userinput$ = "open door" THEN
GOTO 121
END IF

PRINT ""
GOTO 133

'==========HALLWAY 1==========

'140 IF map11 = 1 THEN
' GOTO 141
' END IF
' IF map7 = 1 OR map9 = 1 THEN
' map7 = 0
' map8 = 0
' map9 = 1
' ELSE
' map6 = 0
' map8 = 1
' END IF

140
IF map8 = 1 OR map9 = 1 OR map11 = 1 OR map12 = 1 OR map13 = 1 OR map14 = 1 OR map15 = 1 OR map16 = 1 OR map17 = 1 OR map18 = 1 OR map19 = 1 THEN
map6 = 0
map7 = 0
ELSE
map6 = 0
map7 = 1
END IF
IF map10 = 1 THEN
map7 = 0
map10 = 0
map11 = 1
END IF

PRINT ""
141 PRINT "-HALLWAY"
PRINT ""
PRINT ""
142 PRINT "There is a door to the North and the hallway extends further West as well as going back towards the East."
PRINT ""
143 GOSUB question
GOSUB hallway1commands

'==========HALLWAY 1 SUBROUTINES==========

hallway1commands:
'----------look commands----------
IF userinput$ = "look room" THEN
GOTO 142
END IF

'----------action commands----------
IF userinput$ = "open door" THEN
GOTO 150
END IF

IF userinput$ = "go west" THEN
GOTO 160
END IF

IF userinput$ = "go east" THEN
GOTO 120
END IF

PRINT ""
GOTO 143

'==========FIEND ROOM==========

'150 IF map8 = 1 THEN
' map8 = 0
' map10 = 1
' END IF
' IF map9 = 1 THEN
' map9 = 0
' map10 = 0
' map11 = 1
' END IF

150 IF map15 = 1 OR map16 = 1 OR map17 = 1 OR map18 = 1 OR map19 = 1 THEN
map14 = 0
ELSE
map7 = 0
map14 = 1
END IF
IF map8 = 1 THEN
map8 = 0
map14 = 0
map15 = 1
END IF
IF map9 = 1 THEN
map8 = 0
map9 = 0
map14 = 0
map16 = 1
END IF
IF map11 = 1 THEN
map11 = 0
map14 = 0
map17 = 1
END IF
IF map12 = 1 THEN
map12 = 0
map14 = 0
map17 = 0
map18 = 1
END IF
IF map13 = 1 THEN
map11 = 0
map13 = 0
map14 = 0
map18 = 0
map19 = 1
END IF
151 PRINT ""
PRINT "-FIEND ROOM"
PRINT ""
PRINT ""
152 PRINT "fiend room"
PRINT ""
153 GOSUB question
GOSUB fiendroomcommands

'==========FIEND ROOM SUBROUTINES==========

fiendroomcommands:

'----------look commands----------
IF userinput$ = "look room" THEN
GOTO 152
END IF
'----------action commands----------
IF userinput$ = "open door" THEN
GOTO 141
END IF

PRINT ""
GOTO 153
'==========HALLWAY 2==========
'160 map12 = 1

160 IF map9 = 1 OR map12 = 1 OR map13 = 1 OR map15 = 1 OR map16 = 1 OR map18 = 1 OR map19 = 1 THEN
map8 = 0
ELSE
map7 = 0
map8 = 1
END IF
IF map11 = 1 THEN
map8 = 0
map11 = 0
map12 = 1
END IF
IF map14 = 1 THEN
map8 = 0
map14 = 0
map15 = 1
END IF
IF map17 = 1 THEN
map8 = 0
map17 = 0
map18 = 1
END IF
PRINT ""
PRINT "-HALLWAY"
PRINT ""
PRINT ""
161 PRINT "The hallway comes to a dead end, but there is a door to the West."
PRINT ""
162 GOSUB question
163 GOSUB hallway2commands

'==========HALLWAY 2 COMMANDS==========

hallway2commands:
'----------look commands----------
IF userinput$ = "look room" THEN
GOTO 161
END IF

'----------action commands----------
IF userinput$ = "go east" THEN
GOTO 141
END IF

IF userinput$ = "open door" THEN
GOTO 170
END IF

PRINT ""
GOTO 162

'==========EXECUTIONER'S CHAMBER==========

170 IF map13 = 1 OR map16 = 1 OR map19 = 1 THEN
map9 = 0
ELSE
map8 = 0
map9 = 1
END IF
IF map12 = 1 THEN
map9 = 0
map12 = 0
map13 = 1
END IF
IF map15 = 1 THEN
map9 = 0
map15 = 0
map16 = 1
END IF
IF map18 = 1 THEN
map9 = 0
map18 = 0
map19 = 1
END IF
171 PRINT ""
PRINT "-EXECUTIONER'S CHAMBER"
PRINT ""
PRINT ""
PRINT "Various torture devices are scattered about the floor and walls. As you walk around you accidentally bump into a prisoner who was put to death by hanging."
PRINT ""
172 GOSUB question
GOSUB executionercommands

'==========EXECUTIONER'S CHAMBER COMMANDS==========

executionercommands:
'----------look commands----------
IF userinput$ = "look room" THEN
GOTO 171
END IF

IF userinput$ = "look prisoner" OR userinput$ = "look person" OR userinput$ = "look man" THEN
PRINT "Apparently the executioner did a poor job of making sure the prisoner didn't have anything in his possession."
END IF


'----------action commands----------
IF userinput$ = "open door" THEN
GOTO 160
END IF

IF userinput$ = "search prisoner" OR userinput$ = "search person" THEN
IF prisonerkey = 1 THEN
PRINT "There is nothing more in the prisoner's pockets."
ELSE
PRINT "It seems the prisoner had plans to escape. As you rifle through his tattered clothes you find a key. Lucky for you I guess..."
prisonerkey = 1
END IF
END IF

PRINT ""
GOTO 172

'====================SWAMP====================

190 map22 = 1
PRINT ""
PRINT "-SWAMP ENTRANCE"
PRINT ""
PRINT ""
191 PRINT "You are standing at the beginning of a giant swamp. You can see smoke rising over the trees to the Northeast. Trails lead North, East, and West. The entranceto the dungeon is to the South."
PRINT ""
192 GOSUB question
GOSUB swamp1commands

'==========SWAMP 1 COMMANDS==========

swamp1commands:

'----------look commands----------
IF userinput$ = "look room" THEN
GOTO 191
END IF
'----------action commands----------
IF userinput$ = "open door" OR userinput$ = "open south door" THEN
GOTO 120
END IF



'==========MAIN SUBROUTINES==========

question:
INPUT " What shall thee do?: ", userinput$
PRINT ""

IF userinput$ = "map" THEN
GOSUB map
END IF

IF userinput$ = "stats" OR userinput$ = "statistics" THEN
GOSUB stats
END IF

IF userinput$ = "inv" OR userinput$ = "inventory" THEN
GOSUB inventory
END IF

IF userinput$ = "equipment" THEN
GOTO equip
END IF

IF userinput$ = "exit game" THEN
END
END IF

RETURN

inventory:

FOR cnt = 1 TO 5
PRINT ""
NEXT
PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
PRINT " º INVENTORY º"
PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍͼ"
FOR cnt = 5 TO 8
PRINT ""
NEXT
cnt = 11
IF rib = 1 THEN
PRINT "Rib"
cnt = cnt + 1
END IF

IF shackles = 1 THEN
PRINT "Shackles"
cnt = cnt + 1
END IF

IF cord = 1 THEN
PRINT "String"
cnt = cnt + 1
END IF

IF unlittorch = 1 THEN
PRINT "Unlit Torch"
cnt = cnt + 1
END IF

IF littorch = 1 THEN
PRINT "Lit Torch"
cnt = cnt + 1
END IF

IF dagger = 1 THEN
PRINT "Dagger"
cnt = cnt + 1
END IF

IF prisonerkey = 1 THEN
PRINT "Prisoner's Key"
cnt = cnt + 1
END IF

IF dungeonkey = 1 THEN
PRINT "Dungeon Key"
END IF

FOR cnt = cnt TO 21
PRINT ""
NEXT
INPUT " Tpye 'RETURN' to go back: ", userinput$
PRINT ""
IF userinput$ = "return" OR userinput$ = "RETURN" THEN
RETURN
ELSE
GOTO inventory
END IF


equip:

FOR cnt = 1 TO 5
PRINT ""
NEXT cnt
PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
PRINT " º EQUIPMENT º"
PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍͼ"
FOR cnt = 5 TO 8
PRINT ""
NEXT
cnt = 11

IF dagger = 1 THEN
IF eqdagger = 1 THEN
PRINT "Dagger (equipped)"
cnt = cnt + 1
ELSE
PRINT "Dagger"
cnt = cnt + 1
END IF
END IF

FOR cnt = cnt TO 19
PRINT ""
NEXT
PRINT " Enter item to equip and where to equip it,"
PRINT " Enter item to unequip (regardless of location),"
INPUT " or Enter RETURN to go back: ", userinput$
PRINT ""

IF userinput$ = "return" OR userinput$ = "RETURN" THEN
RETURN
END IF

IF userinput$ = "equip dagger to right hand" THEN
IF eqdagger = 1 OR right = 1 THEN
ELSE
attack = attack + 1
eqdagger = 1
right = 1
END IF
END IF

IF userinput$ = "equip dagger to left hand" THEN
IF eqdagger = 1 OR left = 1 THEN
ELSE
attack = attack + 1
eqdagger = 1
left = 1
END IF
END IF

IF userinput$ = "unequip dagger" THEN
eqdagger = 0
attack = attack - 1
IF left = 1 THEN
left = 0
END IF
IF right = 1 THEN
right = 0
END IF
END IF

GOTO equip

stats:

FOR cnt = 1 TO 5
PRINT ""
NEXT
PRINT " ÉÍÍÍÍÍÍÍÍÍ»"
PRINT " º STATS º"
PRINT " ÈÍÍÍÍÍÍÍÍͼ"
FOR cnt = 5 TO 8
PRINT ""
NEXT
cnt = 11

PRINT "Attack: ", attack
cnt = cnt + 1
PRINT "Strength: ", strength
cnt = cnt + 1

FOR cnt = cnt TO 21
PRINT ""
NEXT
INPUT " Tpye 'RETURN' to go back: ", userinput$
PRINT ""
IF userinput$ = "return" OR userinput$ = "RETURN" THEN
RETURN
ELSE
GOTO stats
END IF

GOTO stats
map:
PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
PRINT "º º"
PRINT "º º"
PRINT "º º"
PRINT "º º"
PRINT "º º"
PRINT "º º"
PRINT "º º"
PRINT "º º"
PRINT "º º"
PRINT "º º"
PRINT "º º"
PRINT "º º"
PRINT "º º"
PRINT "º º"
IF map22 = 1 THEN
PRINT "º º"
PRINT "º þ º"
ELSE
PRINT "º º"
PRINT "º º"
END IF
IF map6 = 1 OR map7 = 1 OR map8 = 1 OR map9 = 1 OR map10 = 1 OR map11 = 1 OR map12 = 1 OR map13 = 1 OR map14 = 1 OR map15 = 1 OR map16 = 1 OR map17 = 1 OR map18 = 1 OR map19 = 1 THEN
IF map19 = 1 THEN
PRINT "º þ³ º"
PRINT "º þÄÁÅþ º"
END IF
IF map18 = 1 THEN
PRINT "º þ³ º"
PRINT "º ÄÁÅþ º"
END IF
IF map16 = 1 THEN
PRINT "º þ³ º"
PRINT "º þÄÁÅ º"
END IF
IF map13 = 1 THEN
PRINT "º ³ º"
PRINT "º þÄÁÅþ º"
END IF
IF map12 = 1 THEN
PRINT "º ³ º"
PRINT "º ÄÁÅþ º"
END IF
IF map15 = 1 THEN
PRINT "º þ³ º"
PRINT "º ÄÁÅ º"
END IF
IF map9 = 1 THEN
PRINT "º ³ º"
PRINT "º þÄÁÅ º"
END IF
IF map8 = 1 THEN
PRINT "º ³ º"
PRINT "º ÄÁÅ º"
END IF
IF map17 = 1 THEN
PRINT "º þ³ º"
PRINT "º ÁÅþ º"
END IF
IF map14 = 1 THEN
PRINT "º þ³ º"
PRINT "º ÁÅ º"
END IF
IF map11 = 1 THEN
PRINT "º ³ º"
PRINT "º ÁÅþ º"
END IF
IF map7 = 1 THEN
PRINT "º ³ º"
PRINT "º ÁÅ º"
END IF
IF map10 = 1 THEN
PRINT "º ³ º"
PRINT "º Åþ º"
END IF
IF map6 = 1 THEN
PRINT "º ³ º"
PRINT "º Å º"
END IF

ELSE
PRINT "º º"
PRINT "º º"
END IF
IF map21 = 1 THEN
PRINT "º Ãþ º"
PRINT "º þÅþ º"
END IF
IF map20 = 1 THEN
PRINT "º Ãþ º"
PRINT "º Åþ º"
END IF
IF map5 = 1 THEN
PRINT "º Ãþ º"
PRINT "º þÅ º"
END IF
IF map4 = 1 THEN
PRINT "º Ã º"
PRINT "º þÅ º"
END IF
IF map3 = 1 THEN
PRINT "º Ãþ º"
PRINT "º Å º"
END IF
IF map2 = 1 THEN
PRINT "º Ã º"
PRINT "º Å º"
END IF
IF map1 = 1 THEN
PRINT "º º"
PRINT "º º"
END IF
PRINT "º þ º"
PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"

1 INPUT " Tpye 'RETURN' to go back: ", userinput$
IF userinput$ = "return" OR userinput$ = "RETURN" THEN
PRINT ""
RETURN
ELSE
PRINT ""
GOTO map
END IF

END

Posted on Feb 28, 2013, 2:26 PM

Respond to this message   

Return to Index


With whitespace:

by (Login MCalkins)
Moderator

strength = 1
attack = 1



PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ°°°°ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ°°°°ÍÍÍÍÍÍÍÍ»"
PRINT "º                        °°    °°                                °°    °°      º"
PRINT "º ÛßÛÛÛÛÛÛÜ             °°      °°°                             °°             º"
PRINT "º    ÛÛ   ÛÛ                   °°°°°                           °°°             º"
PRINT "º   ÛÛ    ÛÛ  ÜÛß  ÜÛ   ÛÜÜÜÜ  °°ÜÜÜÜÜ     ÜÜÜÜ    ÜÜÜÜ    ÛÜÜÜÜ°   ÜÜÜÜ       º"
PRINT "º   ÛÛ   ÛÛ  ÜÛß  ÛÛ   ÛÛ   ÛÛ°°ÛÛ   ÛÛ   ÛÜÜÜÜß  Ûß   Û  ÛÛ °°ÛÛ  ßÜÜ         º"
PRINT "º ÜÛÛÜÜÛÛß   ßÛÛÛßÛÜ  ÜÛ   ÛÛ°°°ßÛÜÜÜÛß  ÛÜÜÜÜ   ßÜÜÜÜß  ÜÛ °°ÛÛ  ÜÜÜÜß        º"
PRINT "º                           °°°ÜÜÜÜÜÛß                     °°°                 º"
PRINT "º                          °°°      °°                    °°°                  º"
PRINT "º                         °°°        °°                  °°°                   º"
PRINT "º                        °°°         °°                 °°°                    º"
PRINT "º                       °°°           °°               °°°                     º"
PRINT "º                      °°°            °°              °°°                      º"
PRINT "º                     °°°              °°            °°°                       º"
PRINT "º                    °°°               °°           °°°                        º"
PRINT "º                   °°°ÛßÛÛÛÛÛÛÜ        °°         °°°                         º"
PRINT "º                  °°°    ÛÛ   ÛÛ       °°        °°°                          º"
PRINT "º                 °°°    ÛÛ    ÛÛ   ÛÜÜÜÜ°°  ÜÜÜÜ°°°  ÜÜÜÜÜ     ÜÜÜÜ    ÛÜÜÜÜ  º"
PRINT "º         °      °°°     ÛÛ   ÛÛ   ÛÛ   ß°°ÜÛß  ÛÛ°  ÛÛ   ÛÛ   Ûß   Û  ÛÛ   ÛÛ º"
PRINT "º        °°°    °°°    ÜÛÛÜÜÛÛß   ÜÛ      ßÛÛÜÜÛßÛÜ  ßÛÜÜÜÛß  ßÜÜÜÜß  ÜÛ   ÛÛ  º"
PRINT "º         °    °°°                        °°  °°°   ÜÜÜÜÜÛß                    º"
PRINT "º          °  °°                            °°                                 º"
PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍ°°ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ°°ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
                                                                                 

SLEEP 10
FOR cnt = 0 TO 17
 PRINT ""
NEXT cnt
cnt = 0
roomcnt = 0

'====================DUNGEON 1====================

'ROOM 1
20 map1 = 1
   PRINT ""
   PRINT "-PRISONER'S CHAMBER"
   PRINT ""
   PRINT ""
21 PRINT "Ughh..."
   PRINT ""
   SLEEP 2
   PRINT "You awaken with a pounding headache and the realization that you're shackled to a wall. You look to see a skeleton next to you. There is also a door on the     North wall."
   PRINT ""
30 GOSUB question
40 GOSUB room1commands


'==========ROOM 1 SUBROUTINES==========
'----------look commands----------

room1commands:
 
   IF userinput$ = "look skeleton" THEN
      IF rib = 1 THEN
         PRINT "The skeleton is missing a rib."
      ELSE
         PRINT "It seems as if the skeleton has been here a long time for there are cob webs    amongst its loose ribs."
         ribcnt = 1
      END IF
   END IF

   IF userinput$ = "look shackles" THEN
      IF shackles = 1 THEN
         PRINT "The shackles hang from your arm."
      ELSE
         PRINT "The shackles appear to be made out of the wroughtest of irons with a sizeable   lock binding you to the wall."
      END IF
   END IF

   IF userinput$ = "look door" THEN
      IF shackles = 1 THEN
         PRINT "A tall door stands before you. A beam of light passes through the keyhole along with an unfamiliar smell."
         lookdoor = 1
      ELSE
         PRINT "It looks to be a well crafted door, but it won't do you any good if you're      shackled to a wall."
      END IF
   END IF
   
   IF userinput$ = "look lock" THEN
      PRINT "It's a tarnished lock with a skeleton key hole"
   END IF

   IF userinput$ = "look room" THEN
      IF shackles = 1 THEN
50       PRINT  _
"You rub your jaw and wonder 'How long have I been out for. I think these        shackles gave me the tetnis...' There is a tall door constructed of oaken wood  before you along with a skeleton on the floor. You notice a brick with cracks   all around it by the skeleton." _

      ELSE
         GOTO 20
      END IF
   END IF

   IF userinput$ = "look wall" THEN
      IF shackles = 1 THEN
         PRINT "You notice a brick with cracks all around it by the skeleton."
         brick = 1
      ELSE
         PRINT "It's a brick wall with grey mortar between the bricks."
      END IF
   END IF

   IF userinput$ = "look brick" THEN
      IF shackles = 1 THEN
         PRINT "The brick seems loose enough to move."
         brick = 2
      ELSE
      END IF
   END IF

   IF userinput$ = "look mortar" OR userinput$ = "inspect mortar" THEN
      IF shackles = 1 THEN
         PRINT "There are holes in the wall from where the shackles were mounted."
      ELSE
         PRINT "As you rub the mortar with your hand, it crumbles off the wall and onto the     floor. "
      END IF
   END IF
'----------action commands----------

   IF userinput$ = "get rib" OR userinput$ = "take rib" THEN
      IF ribcnt = 1 THEN
         PRINT "You find yourself tangled amongst the cob webs (as if the shackles weren't      enough already), but you manage to get a rib."
         rib = 1
      ELSE
         PRINT "Even though you're extremely famished, eating your own ribs isn't the best idea you've had so far."
      END IF
   END IF

   IF userinput$ = "pick lock with rib" OR userinput$ = "pick lock" THEN
      IF shackles = 1 THEN
         PRINT "The lock doesn't budge..."
      ELSE
         IF rib = 1 THEN
            PRINT "You try to wedge the rib into the lock but it doesn't fit. While wrestling with the lock you notice some mortar crumbling from the wall."
            cnt = 1
         ELSE
         END IF
      END IF
   END IF
  
   IF userinput$ = "remove shackles" THEN
      IF shackles = 1 THEN
         PRINT "Maybe you could remove the shackles if you had a key."
         GOTO 60
      ELSE
         PRINT "The shackles remain firmly latched around your wrist."
      END IF
   END IF

   IF userinput$ = "remove shackles with rib" OR userinput$ = "use rib on shackles" THEN
      IF shackles = 1 THEN
         PRINT "I bet you wish you could don't you."
         GOTO 60
      ELSE
51       PRINT "As you struggle to break the lock with the rib, you notice some mortar          crumbling from the wall..."
         cnt = 1
      END IF
   END IF

   IF userinput$ = "remove mortar with rib" OR userinput$ = "use rib on motrar" THEN
      IF cnt = 1 THEN
         PRINT "You wedge the rib into the mortar and with all your might, you break free from  the wall... but the shackles remain attached to you."
         PRINT ""
         PRINT "                         >>> STRENGTH INCREASED BY 1! <<<"
         strength = strength + 1
         shackles = 1
         cnt = 0
      ELSE
         GOTO 51
      END IF
   END IF

   IF userinput$ = "move brick" OR userinput$ = "remove brick" THEN
      IF brick = 2 THEN
         PRINT "You wiggle the brick loose and pull it out of the wall to reveal a length of    string hidden behind it."
      END IF
   END IF

   IF userinput$ = "get string" OR userinput$ = "take string" THEN
      PRINT "You take the string and put it in your pocket."
      cord = 1
   END IF


   IF userinput$ = "open door" THEN
'      IF door = 1 THEN
         GOTO 70     'goto room 2
'      ELSE
'         PRINT "How do you plan to open the door when it's locked?"
'      END IF
   END IF

'   IF userinput$ = "open door with rib" THEN
'      PRINT "It seems you've picked the lock on the door, but the rib breaks in the process."
'      rib = 0
'      door = 1
'   END IF

60 PRINT ""
   GOTO 30

'==========ROOM 2==========
70 IF map3 = 1 OR map4 = 1 OR map5 = 1 OR map20 = 1 OR map21 = 21 THEN
      map1 = 0
   ELSE
      map1 = 0
      map2 = 1
   END IF

71 PRINT ""
   PRINT "-BEGINNING OF CORRIDOR"
   PRINT ""
   PRINT ""
72 PRINT  _
"You're standing at the beginning of a long and dark corridor that extends       farther than you can see. A dank and putrid smell fills  the hallway. There are two doors to the East labeled '1' and '2', and one door to the West labeled '3',along with the extending corridor leading North and a door to the South. You    consider looking around a bit..." _

   IF lookwest = 1 THEN
      PRINT ""
      PRINT "There is a torch on the West wall."
   END IF
   PRINT ""
80 GOSUB question
90 GOSUB room2commands

'==========ROOM 2 SUBROUTINES==========

'----------look commands----------

room2commands:

   IF userinput$ = "look room" THEN
      GOTO 72
   END IF

   IF userinput$ = "look north" THEN
      IF walltorch = 1 THEN
         PRINT "The corridor continues this way."
      ELSE
         PRINT "It's too dark to see..."
      END IF
   END IF

   IF userinput$ = "look south" THEN
      PRINT "There is a tall door here."
   END IF
                                                     
   IF userinput$ = "look east" THEN
      PRINT "This door looks like it's used a lot"
   END IF

   IF userinput$ = "look west" THEN
      IF littorch = 1 OR littorch = 2 OR unlittorch = 1 THEN
         PRINT "The door is covered in various stains."
      ELSE
         PRINT "The door is covered in various stains. An unlit torch sits mounted  on the wall."
      END IF
   END IF

   IF userinput$ = "look northeast" THEN
      PRINT "In the far right corner resides a door. A flickering glow dances from  under the door."
   END IF
'----------action commands-----------

   IF userinput$ = "open east door" THEN
      IF unlockdoor1 = 1 THEN
         GOTO 180
      ELSE
         PRINT "The door seems to be locked."
      END IF
   END IF

   IF userinput$ = "unlock east door with prisoner's key" AND prisonerkey = 1 THEN
      unlockdoor1 = 1
      GOTO 180
   END IF

   IF userinput$ = "open northeast door" THEN
      GOTO 100
   END IF

   IF userinput$ = "open west door" THEN
      GOTO 110
   END IF

   IF userinput$ = "open south door" OR userinput$ = "go south" OR userinput$ = "walk south" THEN
      PRINT ""
      PRINT "-Prisoner's Chamber"
      PRINT ""
      PRINT ""
      GOTO 50
   END IF

   IF userinput$ = "go north" OR userinput$ = "walk north" THEN
      IF littorch = 1 THEN
         GOTO 120
      ELSE
         PRINT "It is too dark to go there yet..."
      END IF
   END IF

   IF userinput$ = "get torch" OR userinput$ = "take torch" THEN
      IF unlittorch = 1 OR littorch = 1 OR littorch = 2 THEN
         PRINT "You already took the torch off the wall."
      ELSE
        PRINT "After some struggling, the torch comes out of its mount."
        unlittorch = 1
      END IF
   END IF

   PRINT ""
   GOTO 80

'==========EAST ROOM 1==========

180 IF map3 = 1 THEN
       map3 = 0
       map20 = 1
    END IF
    IF map5 = 1 THEN
       map5 = 0
       map20 = 0
       map21 = 1
    END IF

181 PRINT ""
    PRINT "-CENTIPEDE"
    PRINT ""
    PRINT ""
    PRINT  _
"This must be where the guards take their break. There is a tire swing hanging   from the ceiling and a ratty looking couch in the corner. You think to yourself, 'Man these guards really know how to have fun' as you become overwhelmed with  jealousy." _

    PRINT ""
182 GOSUB question
    GOSUB eastroom1commands

'==========EAST ROOM 1 COMMANDS==========
eastroom1commands:

'----------look commands----------
   IF userinput$ = "look room" THEN
      GOTO 181
   END IF

   IF userinput$ = "look couch" THEN
      PRINT "Although it smells like it's been left under a bridge for months, it looks      pretty comfortable."
   END IF

   IF userinput$ = "look tire swing" OR userinput$ = "look swing" THEN
      PRINT "The swing slowly sways back and forth while turning about. As it turns to the   other side, you notice some degenerate has painted 'peasent seat' on the tire.  The nerve of some people..."
   END IF

'----------action commands----------
   IF userinput$ = "open door" THEN
      GOTO 70
   END IF
  
   IF userinput$ = "sit couch" OR userinput$ = "sit on couch" OR userinput$ = "lay on couch" THEN
      PRINT "As you sit on the couch, a giant centipede crawls out from under the cushions   and up the back rest. While screaming like a wussy and leaning away, you feel   something under you."
   END IF

   IF userinput$ = "check couch" OR userinput$ = "search couch" THEN
      PRINT "You find the dungeon key under the cushions."
      dungeonkey = 1
   END IF

   PRINT ""
   GOTO 182
'==========EAST ROOM 2==========

100 IF map20 = 1 THEN
       map5 = 0
    ELSE
    IF map4 = 1 OR map5 = 1 THEN
       map3 = 0
       map4 = 0
       map5 = 1
    ELSE
       map2 = 0
       map3 = 1
    END IF

    IF rat < 1 THEN
       PRINT "                        >>> A RAT SUDDENLY ATTACKS! <<<"
       PRINT ""
    END IF
    END IF
    PRINT ""
    PRINT "-FIREPLACE CHAMBER"
    PRINT ""
    PRINT ""
101 PRINT "The room is filled with the delightful glow of a fireplace. A table sits on the North wall. There is also a door to the West."
    PRINT ""
102 GOSUB question
    GOSUB eastroom2commands

'==========EAST ROOM 2 COMMANDS==========

eastroom2commands:

'----------look commands----------
   IF userinput$ = "look room" THEN
      GOTO 101
   END IF

   IF userinput$ = "look table" THEN
      PRINT "There is nothing on the table."
   END IF

   IF userinput$ = "look fireplace" OR userinput$ = "look fire" THEN
      PRINT "A suprisingly well-tended fire burns in the fireplace, but no one except you is around to enjoy it."
   END IF

'----------action commands----------

   IF userinput$ = "open door" THEN
      GOTO 70
   END IF

   IF userinput$ = "light torch with fire" OR userinput$ = "put torch on fire" OR userinput$ = "put torch in fire" THEN
      IF littorch = 1 THEN
         PRINT "The torch is already lit"
      ELSE
         PRINT "You place the torch in the fire and the wick lights right up. You now have a lit torch."
         unlittorch = 0
         littorch = 1
      END IF
   END IF

   PRINT ""
   GOTO 102

'==========WEST ROOM==========


110 IF map3 = 1 OR map5 = 1 THEN
       map3 = 0
       map4 = 0
       map5 = 1
    ELSE
       map2 = 0
       map4 = 1
    END IF
    IF map20 = 1 THEN
       map4 = 0
       map20 = 0
       map21 = 1
    END IF

    PRINT ""
    PRINT "-DRAINAGE AREA"
    PRINT ""
    PRINT ""
111 PRINT "An iron grate sits in the middle of the room with the floor slanted down towardsit on all sides. Puddles of blood and other bile slowly creep towards the grate.There is a door to the East."
    PRINT ""
112 GOSUB question
    GOSUB westroomcommands

'==========WEST ROOM COMMANDS==========

westroomcommands:

'----------look commands----------
   IF userinput$ = "look room" THEN
      GOTO 111
   END IF

   IF userinput$ = "look grate" THEN
      PRINT "It looks as if something shiny is underneath the grate."
      grate = 1
   END IF

'----------action commands----------
  
   IF userinput$ = "open door" THEN
      GOTO 70
   END IF

   IF userinput$ = "open grate" THEN
      IF grate = 2 THEN
         PRINT "The grate is already open."
      ELSE
         PRINT "You pull the grate out of the floor to discover that a dagger has been hidden   inside the drain."
         grate = 2
         getdagger = 1
      END IF
   END IF
  
   IF userinput$ = "get dagger" THEN
      IF dagger = 1 THEN
         PRINT "You already took the dagger."
      ELSE
         IF getdagger = 1 THEN
            PRINT "You reach down the drain and remove the dagger."
            dagger = 1
         ELSE
         END IF
      END IF
   END IF

   PRINT ""
   GOTO 112

'==========END OF CORRIDOR==========

'120 IF map7 = 1 OR map8 = 1 OR map9 = 1 OR map10 = 1 OR map11 = 1 THEN
'       GOTO 121
'    ELSE
'       map6 = 1
'    END IF

120 IF map7 = 1 OR map8 = 1 OR map9 = 1 OR map10 = 1 OR map11 = 1 OR map12 = 1 OR map13 = 1 OR map14 = 1 OR map15 = 1 OR map16 = 1 OR map17 = 1 OR map18 = 1 OR map19 = 1 THEN
       map6 = 0
    ELSE
       map6 = 1
    END IF

    PRINT ""
121 PRINT "-END OF CORRIDOR"
    PRINT ""
    PRINT ""
122 PRINT "This section of the corridor doesn't smell nearly as bad. There is a hallway    which extends to the West and a door to the East. A tall staircase extends      upward."
    PRINT ""
123 GOSUB question
    GOSUB endcorridorcommands

'==========END OF CORRIDOR SUBROUTINES==========

endcorridorcommands:
  
'----------look commands----------
   IF userinput$ = "look room" THEN
      GOTO 122
   END IF


'----------action commands----------
   IF userinput$ = "go up stairs" OR userinput$ = "go up staircase" OR userinput$ = "go north" THEN
      PRINT "You climb the stairs only to find the door at the top will not open. You'll need a key to get through."
   END IF

   IF userinput$ = "unlock door with dungeon key" OR userinput$ = "unlock door" OR userinput$ = "unlock north door with dungeon key" OR userinput$ = "unlock north door" OR userinput$ = "unlock north door with prisoner's key" OR userinput$ =  _
"unlock door with prisoner's key" THEN
      PRINT "You climb the stairs and attempt to unlock the door..."
      IF dungeonkey = 1 THEN
         PRINT "The dungeon key fits and the door is unlocked."
         dungeon1door = 1
      ELSE
         PRINT "The key doesn't seem to fit."
      END IF
   END IF
  
   IF userinput$ = "go west" THEN
      GOTO 140
   END IF

   IF userinput$ = "open east door" THEN
      GOTO 130
   END IF
   
   IF userinput$ = "open north door" THEN
      IF dungeon1door = 1 THEN
         GOTO 190
      ELSE
         PRINT "The door won't budge."
      END IF
   END IF

   IF userinput$ = "go south" THEN
      GOTO 70
   END IF
  
   PRINT ""
   GOTO 123

'==========TREASURE ROOM==========

'130 IF map11 = 1 THEN
'       GOTO 131
'    END IF
'    IF map10 = 1 THEN
'       map10 = 0
'       map11 = 1
'       GOTO 131
'    END IF
'    IF map8 = 1 OR map9 = 1 THEN
'       map7 = 0
'       map8 = 0
'       map9 = 1
'    ELSE
'       map6 = 0
'       map7 = 1
'    END IF

130 IF map11 = 1 OR map12 = 1 OR map13 = 1 OR map17 = 1 OR map18 = 1 OR map19 = 1 THEN
       map6 = 0
       map10 = 0
    ELSE
       map6 = 0
       map10 = 1
    END IF
    IF map7 = 1 THEN
       map7 = 0
       map10 = 0
       map11 = 1
    END IF
    IF map8 = 1 THEN
       map8 = 0
       map10 = 0
       map11 = 0
       map12 = 1
    END IF
    IF map9 = 1 THEN
       map9 = 0
       map10 = 0
       map12 = 0
       map13 = 1
    END IF
    IF map14 = 1 THEN
       map10 = 0
       map14 = 0
       map17 = 1
    END IF
    IF map15 = 1 THEN
       map10 = 0
       map15 = 0
       map17 = 0
       map18 = 1
    END IF
    IF map16 = 1 THEN
       map10 = 0
       map16 = 0
       map18 = 0
       map19 = 1
    END IF
131 PRINT ""
    PRINT "-TREASURE ROOM"
    PRINT ""
    PRINT ""
132 PRINT "treasure room"
    PRINT ""
133 GOSUB question
    GOSUB treasureroomcommands
'==========TREASURE ROOM SUBROUTINES==========

treasureroomcommands:
'----------look commands----------
   IF userinput$ = "look room" THEN
      GOTO 132
   END IF

'----------action commands----------
   IF userinput$ = "open door" THEN
      GOTO 121
   END IF

   PRINT ""
   GOTO 133

'==========HALLWAY 1==========

'140 IF map11 = 1 THEN
'       GOTO 141
'    END IF
'    IF map7 = 1 OR map9 = 1 THEN
'       map7 = 0
'       map8 = 0
'       map9 = 1
'    ELSE
'       map6 = 0
'       map8 = 1
'    END IF

140
    IF map8 = 1 OR map9 = 1 OR map11 = 1 OR map12 = 1 OR map13 = 1 OR map14 = 1 OR map15 = 1 OR map16 = 1 OR map17 = 1 OR map18 = 1 OR map19 = 1 THEN
       map6 = 0
       map7 = 0
    ELSE
       map6 = 0
       map7 = 1
    END IF
    IF map10 = 1 THEN
       map7 = 0
       map10 = 0
       map11 = 1
    END IF
    
    PRINT ""
141 PRINT "-HALLWAY"
    PRINT ""
    PRINT ""
142 PRINT "There is a door to the North and the hallway extends further West as well as going back towards the East."
    PRINT ""
143 GOSUB question
    GOSUB hallway1commands

'==========HALLWAY 1 SUBROUTINES==========

hallway1commands:
'----------look commands----------
   IF userinput$ = "look room" THEN
      GOTO 142
   END IF

'----------action commands----------
   IF userinput$ = "open door" THEN
      GOTO 150
   END IF

   IF userinput$ = "go west" THEN
      GOTO 160
   END IF

   IF userinput$ = "go east" THEN
      GOTO 120
   END IF

   PRINT ""
   GOTO 143

'==========FIEND ROOM==========

'150 IF map8 = 1 THEN
'       map8 = 0
'       map10 = 1
'    END IF
'    IF map9 = 1 THEN
'       map9 = 0
'       map10 = 0
'       map11 = 1
'    END IF
  
150 IF map15 = 1 OR map16 = 1 OR map17 = 1 OR map18 = 1 OR map19 = 1 THEN
       map14 = 0
    ELSE
       map7 = 0
       map14 = 1
    END IF
    IF map8 = 1 THEN
       map8 = 0
       map14 = 0
       map15 = 1
    END IF
    IF map9 = 1 THEN
       map8 = 0
       map9 = 0
       map14 = 0
       map16 = 1
    END IF
    IF map11 = 1 THEN
       map11 = 0
       map14 = 0
       map17 = 1
    END IF
    IF map12 = 1 THEN
       map12 = 0
       map14 = 0
       map17 = 0
       map18 = 1
    END IF
    IF map13 = 1 THEN
       map11 = 0
       map13 = 0
       map14 = 0
       map18 = 0
       map19 = 1
    END IF
151 PRINT ""
    PRINT "-FIEND ROOM"
    PRINT ""
    PRINT ""
152 PRINT "fiend room"
    PRINT ""
153 GOSUB question
    GOSUB fiendroomcommands

'==========FIEND ROOM SUBROUTINES==========

fiendroomcommands:

'----------look commands----------
   IF userinput$ = "look room" THEN
      GOTO 152
   END IF
'----------action commands----------
   IF userinput$ = "open door" THEN
      GOTO 141
   END IF

   PRINT ""
   GOTO 153
'==========HALLWAY 2==========
'160 map12 = 1

160 IF map9 = 1 OR map12 = 1 OR map13 = 1 OR map15 = 1 OR map16 = 1 OR map18 = 1 OR map19 = 1 THEN
       map8 = 0
    ELSE
       map7 = 0
       map8 = 1
    END IF
    IF map11 = 1 THEN
       map8 = 0
       map11 = 0
       map12 = 1
    END IF
    IF map14 = 1 THEN
       map8 = 0
       map14 = 0
       map15 = 1
    END IF
    IF map17 = 1 THEN
       map8 = 0
       map17 = 0
       map18 = 1
    END IF
    PRINT ""
    PRINT "-HALLWAY"
    PRINT ""
    PRINT ""
161 PRINT "The hallway comes to a dead end, but there is a door to the West."
    PRINT ""
162 GOSUB question
163 GOSUB hallway2commands

'==========HALLWAY 2 COMMANDS==========

hallway2commands:
'----------look commands----------
   IF userinput$ = "look room" THEN
      GOTO 161
   END IF

'----------action commands----------
   IF userinput$ = "go east" THEN
      GOTO 141
   END IF

   IF userinput$ = "open door" THEN
      GOTO 170
   END IF

   PRINT ""
   GOTO 162

'==========EXECUTIONER'S CHAMBER==========

170 IF map13 = 1 OR map16 = 1 OR map19 = 1 THEN
       map9 = 0
    ELSE
       map8 = 0
       map9 = 1
    END IF
    IF map12 = 1 THEN
       map9 = 0
       map12 = 0
       map13 = 1
    END IF
    IF map15 = 1 THEN
       map9 = 0
       map15 = 0
       map16 = 1
    END IF
    IF map18 = 1 THEN
       map9 = 0
       map18 = 0
       map19 = 1
    END IF
171 PRINT ""
    PRINT "-EXECUTIONER'S CHAMBER"
    PRINT ""
    PRINT ""
    PRINT "Various torture devices are scattered about the floor and walls. As you walk    around you accidentally bump into a prisoner who was put to death by hanging."
    PRINT ""
172 GOSUB question
    GOSUB executionercommands

'==========EXECUTIONER'S CHAMBER COMMANDS==========

executionercommands:
'----------look commands----------
   IF userinput$ = "look room" THEN
      GOTO 171
   END IF

   IF userinput$ = "look prisoner" OR userinput$ = "look person" OR userinput$ = "look man" THEN
      PRINT "Apparently the executioner did a poor job of making sure the prisoner didn't    have anything in his possession."
   END IF


'----------action commands----------
   IF userinput$ = "open door" THEN
      GOTO 160
   END IF

   IF userinput$ = "search prisoner" OR userinput$ = "search person" THEN
      IF prisonerkey = 1 THEN
         PRINT "There is nothing more in the prisoner's pockets."
      ELSE
         PRINT "It seems the prisoner had plans to escape. As you rifle through his tattered    clothes you find a key. Lucky for you I guess..."
         prisonerkey = 1
      END IF
   END IF

   PRINT ""
   GOTO 172

'====================SWAMP====================

190 map22 = 1
    PRINT ""
    PRINT "-SWAMP ENTRANCE"
    PRINT ""
    PRINT ""
191 PRINT "You are standing at the beginning of a giant swamp. You can see smoke rising    over the trees to the Northeast. Trails lead North, East, and West. The entranceto the dungeon is to the South."
    PRINT ""
192 GOSUB question
    GOSUB swamp1commands

'==========SWAMP 1 COMMANDS==========

swamp1commands:

'----------look commands----------
   IF userinput$ = "look room" THEN
      GOTO 191
   END IF
'----------action commands----------
   IF userinput$ = "open door" OR userinput$ = "open south door" THEN
      GOTO 120
   END IF



'==========MAIN SUBROUTINES==========

question:
   INPUT "  What shall thee do?: ", userinput$
   PRINT ""

   IF userinput$ = "map" THEN
      GOSUB map
   END IF

   IF userinput$ = "stats" OR userinput$ = "statistics" THEN
      GOSUB stats
   END IF

   IF userinput$ = "inv" OR userinput$ = "inventory" THEN
      GOSUB inventory
   END IF

   IF userinput$ = "equipment" THEN
      GOTO equip
   END IF

   IF userinput$ = "exit game" THEN
      END
   END IF

RETURN

inventory:

   FOR cnt = 1 TO 5
      PRINT ""
   NEXT
   PRINT "                                  ÉÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
   PRINT "                                  º  INVENTORY  º"
   PRINT "                                  ÈÍÍÍÍÍÍÍÍÍÍÍÍͼ"
   FOR cnt = 5 TO 8
      PRINT ""
   NEXT
   cnt = 11
   IF rib = 1 THEN
      PRINT "Rib"
      cnt = cnt + 1
   END IF
   
   IF shackles = 1 THEN
      PRINT "Shackles"
      cnt = cnt + 1
   END IF

   IF cord = 1 THEN
      PRINT "String"
      cnt = cnt + 1
   END IF

   IF unlittorch = 1 THEN
      PRINT "Unlit Torch"
      cnt = cnt + 1
   END IF

   IF littorch = 1 THEN
      PRINT "Lit Torch"
      cnt = cnt + 1
   END IF

   IF dagger = 1 THEN
      PRINT "Dagger"
      cnt = cnt + 1
   END IF

   IF prisonerkey = 1 THEN
      PRINT "Prisoner's Key"
      cnt = cnt + 1
   END IF

   IF dungeonkey = 1 THEN
      PRINT "Dungeon Key"
   END IF

   FOR cnt = cnt TO 21
      PRINT ""
   NEXT
   INPUT "                            Tpye 'RETURN' to go back: ", userinput$
   PRINT ""
   IF userinput$ = "return" OR userinput$ = "RETURN" THEN
      RETURN
   ELSE
      GOTO inventory
   END IF


equip:

   FOR cnt = 1 TO 5
      PRINT ""
   NEXT cnt
   PRINT "                                ÉÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
   PRINT "                                º  EQUIPMENT  º"
   PRINT "                                ÈÍÍÍÍÍÍÍÍÍÍÍÍͼ"
   FOR cnt = 5 TO 8
      PRINT ""
   NEXT
   cnt = 11

   IF dagger = 1 THEN
      IF eqdagger = 1 THEN
         PRINT "Dagger (equipped)"
         cnt = cnt + 1
      ELSE
         PRINT "Dagger"
         cnt = cnt + 1
      END IF
   END IF

   FOR cnt = cnt TO 19
      PRINT ""
   NEXT
   PRINT "                  Enter item to equip and where to equip it,"
   PRINT "                  Enter item to unequip (regardless of location),"
   INPUT "                  or Enter RETURN to go back: ", userinput$
   PRINT ""
   
   IF userinput$ = "return" OR userinput$ = "RETURN" THEN
      RETURN
   END IF

   IF userinput$ = "equip dagger to right hand" THEN
      IF eqdagger = 1 OR right = 1 THEN
      ELSE
         attack = attack + 1
         eqdagger = 1
         right = 1
      END IF
   END IF
                                    
   IF userinput$ = "equip dagger to left hand" THEN
      IF eqdagger = 1 OR left = 1 THEN
      ELSE
         attack = attack + 1
         eqdagger = 1
         left = 1
      END IF
   END IF

   IF userinput$ = "unequip dagger" THEN
      eqdagger = 0
      attack = attack - 1
      IF left = 1 THEN
         left = 0
      END IF
      IF right = 1 THEN
         right = 0
      END IF
   END IF

   GOTO equip

stats:

   FOR cnt = 1 TO 5
      PRINT ""
   NEXT
   PRINT "                                    ÉÍÍÍÍÍÍÍÍÍ»"
   PRINT "                                    º  STATS  º"
   PRINT "                                    ÈÍÍÍÍÍÍÍÍͼ"
   FOR cnt = 5 TO 8
      PRINT ""
   NEXT
   cnt = 11

   PRINT "Attack:   ", attack
   cnt = cnt + 1
   PRINT "Strength: ", strength
   cnt = cnt + 1
   
   FOR cnt = cnt TO 21
      PRINT ""
   NEXT
   INPUT "                             Tpye 'RETURN' to go back: ", userinput$
   PRINT ""
   IF userinput$ = "return" OR userinput$ = "RETURN" THEN
      RETURN
   ELSE
      GOTO stats
   END IF

   GOTO stats
map:
      PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
      PRINT "º                                                                              º"
      PRINT "º                                                                            º"
      PRINT "º                                                                                    º"
      PRINT "º                                                                                º"
      PRINT "º                                                                                    º"
      PRINT "º                                                                           º"
      PRINT "º                                                                             º"
      PRINT "º                                                                              º"
      PRINT "º                                                                              º"
      PRINT "º                                                                              º"
      PRINT "º                                                                              º"
      PRINT "º                                                                              º"
      PRINT "º                                                                              º"
      PRINT "º                                                                              º"
IF map22 = 1 THEN
      PRINT "º                                                                              º"
      PRINT "º       þ                                                                      º"
ELSE
      PRINT "º                                                                              º"
      PRINT "º                                                                              º"
END IF
IF map6 = 1 OR map7 = 1 OR map8 = 1 OR map9 = 1 OR map10 = 1 OR map11 = 1 OR map12 = 1 OR map13 = 1 OR map14 = 1 OR map15 = 1 OR map16 = 1 OR map17 = 1 OR map18 = 1 OR map19 = 1 THEN
   IF map19 = 1 THEN
      PRINT "º      þ³                                                                      º"
      PRINT "º    þÄÁÅþ                                                                     º"
   END IF
   IF map18 = 1 THEN
      PRINT "º      þ³                                                                      º"
      PRINT "º     ÄÁÅþ                                                                     º"
   END IF
   IF map16 = 1 THEN
      PRINT "º      þ³                                                                      º"
      PRINT "º    þÄÁÅ                                                                      º"
   END IF
   IF map13 = 1 THEN
      PRINT "º       ³                                                                      º"
      PRINT "º    þÄÁÅþ                                                                     º"
   END IF
   IF map12 = 1 THEN
      PRINT "º       ³                                                                      º"
      PRINT "º     ÄÁÅþ                                                                     º"
   END IF
   IF map15 = 1 THEN
      PRINT "º      þ³                                                                      º"
      PRINT "º     ÄÁÅ                                                                      º"
   END IF
   IF map9 = 1 THEN
      PRINT "º       ³                                                                      º"
      PRINT "º    þÄÁÅ                                                                      º"
   END IF
   IF map8 = 1 THEN
      PRINT "º       ³                                                                      º"
      PRINT "º     ÄÁÅ                                                                      º"
   END IF
   IF map17 = 1 THEN
      PRINT "º      þ³                                                                      º"
      PRINT "º      ÁÅþ                                                                     º"
   END IF
   IF map14 = 1 THEN
      PRINT "º      þ³                                                                      º"
      PRINT "º      ÁÅ                                                                      º"
   END IF
   IF map11 = 1 THEN
      PRINT "º       ³                                                                      º"
      PRINT "º      ÁÅþ                                                                     º"
   END IF
   IF map7 = 1 THEN
      PRINT "º       ³                                                                      º"
      PRINT "º      ÁÅ                                                                      º"
   END IF
   IF map10 = 1 THEN
      PRINT "º       ³                                                                      º"
      PRINT "º       Åþ                                                                     º"
   END IF
   IF map6 = 1 THEN
      PRINT "º       ³                                                                      º"
      PRINT "º       Å                                                                      º"
   END IF

ELSE
      PRINT "º                                                                              º"
      PRINT "º                                                                              º"
END IF
   IF map21 = 1 THEN
      PRINT "º       Ãþ                                                                     º"
      PRINT "º      þÅþ                                                                     º"
   END IF
   IF map20 = 1 THEN
      PRINT "º       Ãþ                                                                     º"
      PRINT "º       Åþ                                                                     º"
   END IF
   IF map5 = 1 THEN
      PRINT "º       Ãþ                                                                     º"
      PRINT "º      þÅ                                                                      º"
   END IF
   IF map4 = 1 THEN
      PRINT "º       Ã                                                                      º"
      PRINT "º      þÅ                                                                      º"
   END IF
   IF map3 = 1 THEN
      PRINT "º       Ãþ                                                                     º"
      PRINT "º       Å                                                                      º"
   END IF
   IF map2 = 1 THEN
      PRINT "º       Ã                                                                      º"
      PRINT "º       Å                                                                      º"
   END IF
   IF map1 = 1 THEN
      PRINT "º                                                                              º"
      PRINT "º                                                                              º"
   END IF
      PRINT "º       þ                                                                      º"
      PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
   
1  INPUT "                         Tpye 'RETURN' to go back: ", userinput$
   IF userinput$ = "return" OR userinput$ = "RETURN" THEN
      PRINT ""
      RETURN
   ELSE
      PRINT ""
      GOTO map
   END IF

END

Posted on Feb 28, 2013, 4:05 PM

Respond to this message   

Return to Index


the first error is:

by (Login MCalkins)
Moderator

02E6 002E "You rub your jaw and wonder 'How long have I been out for. I think these shackles gave me the tetnis...' There is a tall door constructed of oaken wood before you along with a skeleton on the floor. You notice a brick with cracks all around i
^ Line too long

It seems that bc.exe doesn't like long lines. I'm going to guess that the limit is 255 or 256 characters.

You can split up the longer strings. For example, you could concatenate the smaller strings together using a string variable:

Just an example:

a$ = "You rub your jaw"
a$ = a$ + " and wonder"

I see that you are using the line continuation character:
_

I'm not familiar with its use. Perhaps it could be used more extensively to also solve the problem.


As for QB64, it produces Win32 executables, which run under Windows. They cannot run in DOSBox. If you want it to use a console window instead of the SDL window, put:

$CONSOLE
$SCREENHIDE
_DEST _CONSOLE
_SOURCE _CONSOLE

at the start of your program. QB64 currently doesn't support anything like LOCATE or COLOR for console mode.

Regards,
Michael

Posted on Feb 28, 2013, 4:41 PM

Respond to this message   

Return to Index


thank you

by (no login)

Thanks for taking the time to look at my code. It would make sense that the maximum amount of characters would be about 255-256 characters. I'll try using the string variables like you suggested and post the results when it's finished.

Posted on Feb 28, 2013, 5:09 PM

Respond to this message   

Return to Index


you're welcome. (1 edit)

by (Login MCalkins)
Moderator

I meant to mention in my last post, but forgot:
On these forums, if you want to preserve whitespace, you have to replace spaces with No Break Space characters. (Unicode 0x00a0, decimal 160).

(I got the spacing from your program by going in to edit your post, and copying out the original text, but without actually editing the post.)

Regards,
Michael

Posted on Feb 28, 2013, 6:08 PM

Respond to this message   

Return to Index


any suggestions?

by (no login)

Have you been able to find any reason as to why my program won't compile?

Posted on Feb 28, 2013, 4:41 PM

Respond to this message   

Return to Index


Without knowing the first thing about QB64

by AlGoreIthm (no login)


I would offer these 2 clues, so that you could be the one who has the honor
of solving the puzzle you have yourself created:

1 - what if the programming language you used did not include 'GOTO' - how would you re-write your program?

2 - what if the only way you could print anything to the screen was to use an array containing the message you wanted to display - how would you re-write your program?

ex:

message$(1)=" ....... "
message$(2)=" ------- "
message$(3)=" ******* "

and so on.

Good luck with your project and all your efforts.

Posted on Feb 28, 2013, 5:14 PM

Respond to this message   

Return to Index


For example:

by AlGoreIthm (no login)


number.of.user.inputs% = 11
DIM userinput$(1 TO number.of.user.inputs%)

userinput$(1) = "look skeleton"
userinput$(2) = "look shackles"
userinput$(3) = "look door"
userinput$(4) = "look room"
userinput$(5) = "look wall"
userinput$(6) = "look brick"
userinput$(7) = "look mortar"
userinput$(8) = "go north"
userinput$(9) = "go south"
userinput$(10) = "go east"
userinput$(11) = "go west"


DO

PRINT
INPUT "What Shall thee do"; userinput$

userinput$ = LCASE$(LTRIM$(RTRIM$(userinput$)))
'userinput$ is now in all lowercase characters, with leading and trailing spaces removed

count% = 0
matched% = 0

DO

count% = count% + 1
IF userinput$ = userinput$(count%) THEN matched% = count%

LOOP UNTIL count% = number.of.user.inputs% OR matched% = count%

' the following is for the programmer's testing, not for the game user to see

IF matched% THEN
PRINT "user input is matched with user.input$ #"; matched%; " "; userinput$(matched%)
PRINT "Program would continue from here..."
ELSE PRINT "Your Input is not recognized, please try again ... "
END IF

LOOP WHILE matched% = 0
END

Posted on Mar 2, 2013, 8:56 AM

Respond to this message   

Return to Index


Possible forum changes...

by (Login The-Universe)
Admin

First: Thank you Solitaire and MC for becoming the named moderators in the VB / .Net (Solitaire), and C/C++. and ASM (MC) sub-forums.

Next: I have been considering this change for some time, to archive the QB64 "Project" sub-forum, and then simply use the main forum for all QB/QB64 posts. The reason is QB64 is not so much a project anymore, as it is a language. It is becoming more of a check two places instead of one situation now for these posts. Also, as more users will be coming here and using QB64, rather than using QB, it seems more appropriate to post those questions, code, and statements in the main forum. FYI: Galleon has been a Mod in the Main forum since 2008.

I am also considering removing the FORTRAN sub-forum, as it was mostly put up for Dean "QBGuy" when he frequented this forum. We removed the Pascal sub-forum some time ago, as it was mainly a place for Myst to post.

I think we need to take a look at the FAQ and Samples, and consider making it a Read Only Resource page.

The 3-D forum will probably catch on more as 3-D programming becomes increasingly more popular, and I'd like to keep it going.

All other sub-forums seem active and popular enough. All I would like to do is add some continuity, so post order and appearance is the same as the main forum.

Anyway, your feedback and suggestions will be appreciated, and will help shape whatever decisions are made. I should have some free time to respond in a couple of days, and move forward on this project.

Thanks,

Pete

Posted on Feb 24, 2013, 7:30 AM

Respond to this message   

Return to Index


Initial response...

by (Login MCalkins)
Moderator

>to archive the QB64 "Project" sub-forum,

considering that is has mostly been replaced by the qb64.net forums, that sounds reasonable.

>removing the FORTRAN sub-forum.

I'd suggest archiving it instead of deleting it. It probably wouldn't need a link on the index. A link in a post in the non-QB forum would probably suffice.

Sometimes, I wish that the links to the archived Miscellaneous and archived old main forum were a little more prominent, possibly together.

>I think we need to take a look at the FAQ and Samples, and consider making it a Read Only Resource page.

I'm not sure that I like the idea of making it read-only. However, it isn't very active lately. A lot of the info there is specific to QBASIC/QB/PDS, and does not apply at all to QB64.

I would suggest keeping that subforum, and the Tricks and Techniques subforum specific to QBASIC/QB/PDS. QB64 FAQs or tricks can be posted at qb64.net, or on the main forum here. (Not to mean that someone couldn't mention that QB64 allows something to be done more easily... What I mean is not turning it into QB64 FAQ and QB64 Tricks & Techniques subforums, as doing so would instantly dilute and make obsolete all the QBASIC-specific content.)

There is already an FAQ page that links to the posts in the forum:
http://www.network54.com/Realm/page_files/QBasicFAQ.html
perhaps it could be the focus of any needed reorganization. Perhaps there could be a new QB64 FAQ section to that page, or a new page. (I don't mean that everything has to be one or the other. There are items which are generic, and apply to both, then there are items which are QBASIC/DOS specific, and then there could be items that are QB64 specific.)

>The 3-D forum will probably catch on more as 3-D programming becomes increasingly more popular, and I'd like to keep it going.

I would expect usage of OpenGL to increase (in QB64), rather than using do-it-yourself software rendering.

>All I would like to do is add some continuity, so post order and appearance is the same as the main forum.

Oi, I hope not...

I like the fact that, for example, the challenges subforum bumps topics when you reply to them. If anything, I would consider making the main forum bump posts, rather than the other way around.

Also, I like that some of those subforums include a link to parent posts in replies.

I don't mind the visual differences between the subforums. I am very used to it, and I suspect that newcomers won't have too much problem with it.

Regards,
Michael

Posted on Feb 24, 2013, 8:24 AM

Respond to this message   

Return to Index


Forum problem

by Solitaire (no login)

Still don't understand why the latest post on the VB forum ("C# Tutorial (wilamrjoy)" --listed on the right side) does not show up in the forum itself.

Posted on Feb 24, 2013, 8:32 AM

Respond to this message   

Return to Index


*It's on page 3.

by (Login MCalkins)
Moderator

Posted on Feb 24, 2013, 8:36 AM

Respond to this message   

Return to Index


* Thanks. Found it.

by Solitaire (Login Solitaire1)
S

Posted on Feb 24, 2013, 8:38 PM

Respond to this message   

Return to Index


I'll give you permission to do that...

by gopus (no login)

That sounds like a good idea.

Posted on Feb 25, 2013, 5:48 AM

Respond to this message   

Return to Index


* Change Gopus' name to Dufus while you're at it...

by (Login burger2227)
R

Posted on Feb 26, 2013, 11:47 PM

Respond to this message   

Return to Index


*LOL

by (Login Kewbie)
R

Posted on Mar 1, 2013, 12:04 PM

Respond to this message   

Return to Index


Started making some changes.

by (Login The-Universe)
Admin

FORTRAN and QB64 project are scheduled for archiving and are now Read Only. They will be linked, and then removed from the index.

All QB64 posts can will now appear on this forum.

"QBasic" has been changed to QB, as it can be used for QBasic, QuickBasic, QB64 languages.

Garry Ricketson is our new Linux Club moderator. Thanks Garry.

I'll leave the formats of each sub-forum in their current states, no changes.

Thanks Michael for your suggestions.

Pete

Posted on Feb 28, 2013, 11:30 PM

Respond to this message   

Return to Index


Pete

by (Login burger2227)
R

I hope you are not going to leave the last post in the QB64 Forum to be Hacker's. I had to remove the same post from him at Pete's Site.

Posted on Mar 1, 2013, 1:12 AM

Respond to this message   

Return to Index


Agree on this

by (Login GarryRicketson)
R

I agree, hope it dosen't stay,...

From Garry
http://creativeminds.webege.com/SMF/index.php

Posted on Mar 1, 2013, 5:55 AM

Respond to this message   

Return to Index


I agree also.

by (Login MCalkins)
Moderator

There is a similar topic from him further down:

http://www.network54.com/Forum/585676/message/1341745871/QB64+IS+A+JOKE%21%21

But some of the responses were funny, if not appropriate...

Perhaps the last post in the forum should be a message explaining that the forum is archived, and linking to
http://www.qb64.net/forum/
and back to
http://www.network54.com/Index/10167
?

Regards,
Michael

Posted on Mar 1, 2013, 7:27 AM

Respond to this message   

Return to Index


Re: Possible forum changes...

by (Login The-Universe)
Admin

Archived some forums and took them out of the index. Links will be provided to them soon. This is a work in progress, thanks for your patience.

Pete

Posted on Mar 3, 2013, 12:54 AM

Respond to this message   

Return to Index


*Hey, Pete -- thanks for moving me up (less scrolling). I feel like a Jefferson.

by (Login qb432l)
Mod

*

Posted on Mar 3, 2013, 12:23 PM

Respond to this message   

Return to Index


*LOL... The Jeffersons. Are you in the dry cleaning business, Bob?

by (Login Kewbie)
R

Posted on Mar 3, 2013, 1:02 PM

Respond to this message   

Return to Index


Re: *Hey, Pete -- thanks for moving me up (less scrolling). I feel like a Jefferson.

by (Login The-Universe)
Admin

Well you're movin' on up
To the top side
To a deluxe sub-forum
On the website

Yeah you're movin' on up
to the top side
You've finally got a piece
of the pi...i...i


- Archie Bunker

Posted on Mar 3, 2013, 1:19 PM

Respond to this message   

Return to Index


*lol@pi...i...i!

by (Login qb432l)
Mod

*

Posted on Mar 3, 2013, 3:57 PM

Respond to this message   

Return to Index


Long Term

by (Login PhyloGenesis)
R

Hey Pete, I just noticed you're admin and I was thinking about the long term of the forum. Do you have something in place to make sure somebody can administrate this forum in case you just stop showing up one day for whatever reason?

No, I'm not trying to nominate myself, that would be silly. I'm just thinking of having a second account or something that you could give to Solitaire, TheBOB, or MC for instance, so that administration can change hands if required instead of the forum slowly dying. Even if whoever has it doesn't want to be admin, they could at least be trusted to give it to someone reasonable.

To be clear, I have no problem with you being admin. I think you've done and will continue to do a fine job. I came back after two years and this place still exists. That's a good job in my book. ;-)

PhyloGenesis

Posted on Mar 8, 2013, 3:37 PM

Respond to this message   

Return to Index


Last year I had my head placed in a jar.

by (Login The-Universe)
Admin

I've been running the forum from that jar, and intend to do so into the future. Now if you will excuse me, I think I spotted some hottie on the shelf right next to me. Oops, it was just a jar of pickled beets. What can I say, I've always had a thing for redheads.

Nice to see you back,

Pete

Posted on Mar 8, 2013, 3:53 PM

Respond to this message   

Return to Index


Fer Serius

by (Login PhyloGenesis)
R

Amusing, but you didn't answer the question. I don't care if it has anything to do with the suggestion I made or even if I know it, I'm just requesting that you have a plan. Do you have one or can you please make one? I'll be happy to help as needed. I hope it doesn't sound rude, I don't mean it that way.

PhyloGenesis

Posted on Mar 12, 2013, 12:45 PM

Respond to this message   

Return to Index


Re: Fer Serius

by (Login The-Universe)
Admin

This forum has its own Karma. It doesn't exist because I own it now, and what I've learned in life is that things like this forum will live on, with or without us. There is also a funny saying, "If you want to make God laugh, tell him you have a plan."

So God can get his jollies someplace else, as I have no plan, just as Mac had no plan. Bob has offered to help, if needed, as have others. All the mods here are very much appreciated by me. Michael is doing a lion's share of the work lately. Solitaire is a strong supported of this forum and continues to moderate all sub-forums.

A lot of the future for this place also depends on Network54. You would think in all this time they would update their boards, but they haven't. If they ever decide to quit, we would host elsewhere, and go to something like a PhpBoard, or whatever it's called.

As for the future of BASIC, that one has me wondering what will happen the most. Latin and BASIC have more in common than just 5-letters. I love what Rob has accomplished with QB64, but I wonder where will it be in five years? Ideally, get 50 genius programmers using it to build engines, and make it a sought-after hobby language, I suppose.

As for the here and now, I still want to keep this a fun place, regardless of what develops in QB64. Overly technical forums are not where my head is at... oh right, it's in a jar, I keep forgetting. Anyway, a plan at this point going forward is not needed, and if there comes a time when one is, I'm pretty certain it will appear, as life abhors a vacuum, almost as much as I abhor FB.

Pete

Posted on Mar 13, 2013, 8:00 PM

Respond to this message   

Return to Index


FB

by (Login PhyloGenesis)
R

Do you mean Facebook or FreeBasic? Both?

Anywho, thank you for the in depth response there but I think you misunderstood me! I meant JUST the administrative access. The direction you take the forum and whether or not it lasts with or without QB64, etc. I leave entirely to you and/or the wind if you choose to use that. I'm only asking that we ensure that somebody will always have administrative access to the forum to do things like create moderators, add a link to sign in (which would be nice,,, just saying), add, move, or remove forums, and so forth.

There are a myriad of reasons that life may throw at us that could cause you to never return to the forums that are horrible, just unpleasant, or even fortunate, not the least of which is someone turning your jar upside down and trapping you. http://en.wikipedia.org/wiki/Bus_factor) Our bus factor is one. I'd just like to increase that. happy.gif

Posted on Mar 14, 2013, 1:03 PM

Respond to this message   

Return to Index

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