QBasic and QB64 Discussion Board

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

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



Hey, Remember Me?

by Jonathan (no login)

Wow, I haven't been here in years, but last night I had this dream.. and sure enough, here I am! I dreamt that I visited the old Qbasic.com forum, except it was different, beautiful, amazing stuff, and I had the most hilarious amazing post ever to post, maybe about how it felt to watch Ren and Stimpy for the first time at the age of 6. I'm happy, in searching, that there's other nostalgics out there like me. Anyways, the message got interrupted cause I wrote the wrong thing, Ctrl+Z'd, and some how it all got messed up!
So here I am. The board really resembled the chat room for than anything, but I felt that fun again, of feeling connected. Like the internet, you know I just felt it in real life when seeing a review on Amazon and it was only from May 20-something of this year! So I felt that old feeling that the internet used to give - how you'd be a part of something, how there was someone out there, waiting to hear from you. I miss it. Luckily, now I'm so smart I can actually build the next "great" site! I plan on doing it to.. but it all comes back to QB for me, and those fun times we had. You gotta go with simplicity even if you are applying it to the new technologies. Everyone uses all these hacks to make stuff happen.. I want real programming!
Well, if anyone remembers me, that's a good thing. It's been soooo long, and it eats at you, right in the center of your heart. Wanting it to be like it used to be, when it was really fun, really happening.. but eventually, you just sorta realize that you have to keep voyaging on into the night, looking for that ray of hope at the end of the tunnel, or something like that!
Well, that's all for now. I'm not even sure if this is what I was "supposed" to find, haha.. I'll keep looking for a forum that looked like the one in the dream, although it never existed in my experience before... gee, I really miss being able to write on a board without logging in. It's coming back, though, ;).
-Jon

Posted on Aug 10, 2012, 7:34 PM

Respond to this message   

Return to Index


* Welcome back.

by (Login MCalkins)
Moderator

Posted on Aug 10, 2012, 7:50 PM

Respond to this message   

Return to Index


*Yeah, hi again!

by (Login qb432l)
R

*

Posted on Aug 10, 2012, 8:48 PM

Respond to this message   

Return to Index


HAHA YOURE CRAZY :-p

by gopus (no login)

Posted on Sep 10, 2012, 4:47 AM

Respond to this message   

Return to Index


Rewrit from scratch

by (no login)

How to rewrite from scratch ?

I have a 48 kb program, and i should rewrite it from scratch, because i though about some improvements, but it's just too much work... Every thing could be improved, the display for information, help, etc, the way buffer are handle for restoring the screen, the data structure, implement more user configuration, but there are so much variables, that the only thing is to pull a part the whole program, in all it parts, with a list of variables, and trying to build a new program from this collection of sub-routines...!

Prior i though about ending all lines with a

: line_number = line_number + 1

to spot unused lines of code.

Any way, maintaining code is a big deal, should be thought about while writing the first version, and i don't know so much how...

I feel just scared about this !

Posted on Aug 10, 2012, 6:28 AM

Respond to this message   

Return to Index


I would do one piece at a time....

by Solitaire (Login Solitaire1)
S

and save each major change by a different version number, making sure it works correctly. That way, if the next change doesn't work out, you can go back to the previous version and start again.

Clean up the main program first, and see that each call to a subprocedure is clearly marked. Use a DO loop with a menu in the main program and SELECT CASE to call each of the subs. Declare each of the variables by type at the top of the main program.

Then do the subprocedures one by one, making sure arguments and parameters match when variables are passed down from the main program. Declare all local variables by type in the sub.

Good luck.

Posted on Aug 10, 2012, 9:56 AM

Respond to this message   

Return to Index


Good advice, Solitaire

by Moneo (no login)

especially about changing and testing each changed piece (version) at a time. This way you don't have to re-think the entire program all at once.

Posted on Sep 21, 2012, 10:13 AM

Respond to this message   

Return to Index


consider this:

by AlGoreIthm (no login)

It's not essential to have an individual line counter to track which lines are being used, not used, or used the most:

If you set your code up with IF - THEN / END IF sections, you will be able to track which blocks of code are being used the most. Ex:

CONST TRUE = 1
CONST FALSE = 0

status% = TRUE ' or FALSE

IF status% = TRUE THEN
section1 = section1 + 1
..........
..........
..........
' possibility of one of these lines of code to change the status% variable
which in turn will decide if the next section will execute or not
END IF

IF status% = FALSE THEN
section2 = section2 + 1
..........
..........
..........
' possibility of one of these lines of code to change the status% variable etc.
END IF


This type of organization will allow you to track which areas are most active or not active, rather than line by line which is probably too much information anyway.

Where you have nested IF THEN / END IFs, you can add secondary counters like section1a, section1b, section2a, section2b etc.

At the end of execution, a listing of variables section1, section2, and all others will show where the execution spent the most time during the run, and any values of 0 will show that the related blocks of code were not used at all during execution.

Of course this type of technique should be understood as a programming and debugging aid, once the program is complete the section variables should probably all be removed unless you want to go on measuring performance even after your program is completed and in proper working order.

Posted on Aug 10, 2012, 11:31 AM

Respond to this message   

Return to Index


Hel with QBASIC errors

by (no login)

Hi guys!
I'm fairly new to QBASIC and i'm trying to make my first full program. The program has three "save slots" and a variable that makes sure that the player is playing in one of the save slots before they can play the game. It is this variable that is giving me difficulty.

This is the first line of code:

logincheck$ = "no"

And it has an error which says "SELECT without END SELECT"
Can anyone help me? I'll post the full code below for anyone who can help further.
Thanks,
Jake. :)

logincheck$ = "no"
clearscreen:
CLS
menu:
PRINT "Welcome to Learn French!"
PRINT "Please select an option!"
PRINT "Load Profile"
PRINT "New Profile"
PRINT "Start Learning"
PRINT "Exit"
INPUT "...", option1$
IF option1$ = "Load Profile" THEN GOTO load
IF option1$ = "New Profile" THEN GOTO NEW
IF option1$ = "Start Learning" THEN GOTO BEGIN
IF option1$ = "Exit" THEN GOTO FIN1
GOTO wrong
END
NEW:
PRINT "Welcome to the create an account wizard!"
PRINT "________________________________________"
PRINT "Please select a save slot:"
PRINT "1", oneavailability$
PRINT "2", twoavailability$
PRINT "3", treavailability$
INPUT "...", slotselectnew$
IF slotselectnew$ = "1" THEN GOTO newslotone
IF slotselectnew$ = "2" THEN GOTO newslottwo
IF slotselectnew$ = "3" THEN GOTO newslottre
GOTO wrong
newslotone:
INPUT "Please select a name...", name1$
OPEN "profile1.txt" FOR OUTPUT AS #7
WRITE #7, name1$
CLOSE #7
OPEN "p1points.txt" FOR OUTPUT AS #8
WRITE #8, "0"
CLOSE #8
points = 0
INPUT "New account has been created successfully! Press ENTER to continue...", cont1$
logincheck$ = "yes"
GOTO clearscreen
END
newslottwo:
INPUT "Please select a name...", name1$
OPEN "profile2.txt" FOR OUTPUT AS #9
WRITE #9, name1$
CLOSE #9
OPEN "p2points.txt" FOR OUTPUT AS #10
WRITE #10, "0"
CLOSE #10
points = 0
INPUT "New account has been created successfully! Press ENTER to continue...", cont1$
logincheck$ = "yes"
GOTO clearscreen
END
newslottre:
INPUT "Please select a name...", name1$
OPEN "profile3.txt" FOR OUTPUT AS #11
WRITE #11, name1$
CLOSE #11
OPEN "p3points.txt" FOR OUTPUT AS #12
WRITE #12, "0"
CLOSE #12
points = 0
INPUT "New account has been created successfully! Press ENTER to continue...", cont1$
logincheck$ = "yes"
GOTO clearscreen
END
load:
PRINT "Welcome to the load an account wizard!"
PRINT "________________________________________"
PRINT "Please select a save slot:"
PRINT "1", oneavailability$
PRINT "2", twoavailability$
PRINT "3", treavailability$
INPUT "...", slotselectload$
IF slotselectload$ = "1" THEN GOTO loadslotone
IF slotselectload$ = "2" THEN GOTO loadslottwo
IF slotselectload$ = "3" THEN GOTO loadslottre
GOTO wrong
loadslotone:
OPEN "profile1.txt" FOR INPUT AS #1
INPUT #1, name1$
CLOSE #1
OPEN "p1points.txt" FOR INPUT AS #2
INPUT #2, points
CLOSE #2
INPUT "Loaded Successfully! Press ENTER to continue...", cont1$
logincheck$ = "yes"
GOTO clearscreen
END
loadslottwo:
OPEN "profile2.txt" FOR INPUT AS #3
INPUT #3, name1$
CLOSE #3
OPEN "p2points.txt" FOR INPUT AS #4
INPUT #4, points
CLOSE #4
INPUT "Loaded Successfully! Press ENTER to continue...", cont1$
logincheck$ = "yes"
GOTO clearscreen
END
loadslottre:
OPEN "profile3.txt" FOR INPUT AS #5
INPUT #5, name1$
CLOSE #5
OPEN "p3points.txt" FOR INPUT AS #6
INPUT #6, points
CLOSE #6
INPUT "Loaded Successfully! Press ENTER to continue...", cont1$
logincheck$ = "yes"
GOTO clearscreen
END
BEGIN:
IF logincheck$ = "no" THEN GOTO load
PRINT "Welcome to Learn French, "; name1$
PRINT "_______________________________"
PRINT "Instructions:"
PRINT "To play this game you must type the definition of the French word in "
PRINT "English to score a point, use a dictionary only if you have to!"
PRINT "To EXIT and SAVE the game at any time, you should type EXIT "
PRINT "into the answer box."
INPUT "Are you ready??? Press ENTER to continue...", cont1$
wordslist:
CLS
PRINT "You have "; points; "points!"

question = INT(RND * 6 + 1)
SELECT CASE question



CASE 1
PRINT "Bonjour"
INPUT "English Translation: ", answer1$
IF answer1$ = "hello" THEN points = points + 1 ELSE GOTO wronganswer
PRINT "Well Done!"
INPUT "Press ENTER for another Question...", cont1$
GOTO wordslist
CASE 2
PRINT "Bon"
INPUT "English Translation: ", answer1$
IF answer1$ = "good" THEN points = points + 1 ELSE GOTO wronganswer
PRINT "Well Done!"
INPUT "Press ENTER for another Question...", cont1$
GOTO wordslist

CASE 3
PRINT "Mal"
INPUT "English Translation: ", answer1$
IF answer1$ = "bad" THEN points = points + 1 ELSE GOTO wronganswer
PRINT "Well Done!"
INPUT "Press ENTER for another Question...", cont1$
GOTO wordslist

CASE 4
PRINT "D'accord"
INPUT "English Translation: ", answer1$
IF answer1$ = "ok" THEN points = points + 1 ELSE GOTO wronganswer
PRINT "Well Done!"
INPUT "Press ENTER for another Question...", cont1$
GOTO wordslist

CASE 5
PRINT "un"
INPUT "English Translation: ", answer1$
IF answer1$ = "one" THEN points = points + 1 ELSE GOTO wronganswer
PRINT "Well Done!"
INPUT "Press ENTER for another Question...", cont1$
GOTO wordslist

CASE 6
PRINT "deux"
INPUT "English Translation: ", answer1$
IF answer1$ = "two" THEN points = points + 1 ELSE GOTO wronganswer
PRINT "Well Done!"
INPUT "Press ENTER for another Question...", cont1$
GOTO wordslist

wronganswer:
PRINT "That's not right!"
INPUT "Press ENTER for another question...", cont1$






END
wrong:
PRINT "Incorrect Menu option! Please restart the program!"
FIN1:
END

Posted on Aug 6, 2012, 2:44 AM

Respond to this message   

Return to Index


Logically, add END SELECT, if it tells you so

by (no login)

END SELECT

and

CASE ELSE for any other responses you want to deal with,

Now the hint someone gave me is to put the Selection routine inside a SUB... anyway.

Posted on Aug 6, 2012, 6:10 AM

Respond to this message   

Return to Index


Thanks

by (no login)

Thanks I'll try it once I get round to editing it and then I'll post back with any changes I've made :)

Posted on Aug 8, 2012, 1:51 AM

Respond to this message   

Return to Index


Some suggestions

by Solitaire (Login Solitaire1)
S

You have a multitude of bugs in your program. Here are a few simple suggestions to start you off:

1. Add
END SELECT
just before the "wronganswer:"

2. Add
GOTO wordslist
and delete the END in the wronganswer section.

3. Add
IF cont1$ = "EXIT" THEN END
right after wordslist:
This will allow user to end the program after any of the words.

4. User input of a phrase to make a selection is very tricky. It's best to present a single number or letter for the user to enter. Here is how you can do it:

menu:
PRINT "Welcome to Learn French!"
PRINT "Please select an option!"
PRINT "1: Load Profile"
PRINT "2: New Profile"
PRINT "3: Start Learning"
PRINT "4: Exit"
INPUT "...", option1$
IF option1$ = "1" THEN GOTO load
IF option1$ = "2" THEN GOTO NEW
IF option1$ = "3" THEN GOTO BEGIN
IF option1$ = "4" THEN GOTO FIN1

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

The overall design of your program leaves a great deal to be desired. If you are starting out with QB, then you should be learning how to use structured programming and NOT using GOTO at all. At the least, you should use subroutines with GOSUB and RETURN for each of the separate sections.

Here is a simple example of a menu with subroutines. It uses a DO loop to repeat. Copy it and paste it into a new QB program to see how it works. Then see if you can adapt it to use with your own program.

============================================================
DO
  CLS
  PRINT "MENU"
  PRINT : PRINT "1- Chess"
  PRINT "2- Checkers"
  PRINT "3- Monopoly"
  PRINT "4- Quit"
  PRINT : INPUT "Enter 1, 2, 3, or 4: ", choice$
  CLS
  SELECT CASE choice$
    CASE "1"
      GOSUB Chess
    CASE "2"
      GOSUB Checkers
    CASE "3"
      GOSUB Monopoly
    CASE "4"
      END
  END SELECT
LOOP

Chess:
PRINT "Play chess here."
INPUT "Enter to return to menu. ", E$
RETURN

Checkers:
PRINT "Play checkers here."
INPUT "Enter to return to menu. ", E$
RETURN

Monopoly:
PRINT "Play Monopoly here."
INPUT "Enter to return to menu. ", E$
RETURN


Posted on Aug 6, 2012, 11:32 AM

Respond to this message   

Return to Index


Thanks

by (no login)

Thanks, I'll try all these suggestions, I've only just started really and I am trying to learn some basics as I go. Thanks for the advice anyway :)

Posted on Aug 8, 2012, 1:55 AM

Respond to this message   

Return to Index


QB64 and MySQL

by (no login)

Hi all;

I am in desperate need for some example code where QB64 can read a mysql db but ALL rows - the examples on the QB64 forum seem to only access the first row

for example, if data in SQL is

1, bob, toronto, canada
2, bill, hamilton, canada
3, frank, newyork, usa

the only thing the demo program shows is

bob
bill
frank


Please help ! any demo code is appreciated.

Posted on Aug 4, 2012, 2:38 PM

Respond to this message   

Return to Index


legacy program

by (no login)

i wrote a program in qb, 30 yrs ago that runs ok up to windows xp, never had vista. just got win7 home premium 64. can't run program, downloaded qb64 and freebasic, program comes up in gibberish. any thoughts on how to run my progam ?

(converted to lowercase - mc)

Posted on Aug 3, 2012, 1:11 PM

Respond to this message   

Return to Index


Your program is saved in Binary Format

by anon (no login)

Binary format is a tokenized format that saves space and makes QuickBasic load files faster. However, standard programs (like Notepad, Emacs, QB64, etc.) cannot read it, because it is not text.
Open it in QB4.5 and resave in "Text format" using the save as command.
Alternatively, there is a QB45 binary save decoder here: http://www.qb64.net/forum/index.php?topic=1771.0
which is available as BASIC source code.

Posted on Aug 3, 2012, 2:27 PM

Respond to this message   

Return to Index


* great, change to text solved problem, thanks

by joe (no login)

(added asterisk - mc)

Posted on Aug 4, 2012, 5:39 AM

Respond to this message   

Return to Index


*Please do NOT post in all capital letters. It's the same as shouting and considered rude.

by Solitaire (no login)

Posted on Aug 3, 2012, 11:36 PM

Respond to this message   

Return to Index


* get a life

by joe (no login)

(added asterisk - mc)

Posted on Aug 4, 2012, 5:38 AM

Respond to this message   

Return to Index


*If you say "get a life" why are you here annoying others?

by angros47 (no login)

Posted on Aug 5, 2012, 4:09 AM

Respond to this message   

Return to Index


Did you know that using ALL CAPITAL letters saved space

by Anon (no login)

On certain magnetic tape storage devices, such as cassete tapes on the original IBM PC (most people bought the IBM PC with a disk drive). The original IBM PC used Frequency Shift Keying with each bit represented by a single pulse. A 1 took more time than a 0 due to a lower frequency. So ALL CAPS used less tape space due to fewer one bits.

Posted on Aug 4, 2012, 10:07 AM

Respond to this message   

Return to Index


Forum conventions

by Solitaire (Login Solitaire1)
S

Interesting information regarding caps, but they do not save space in the forum posts. It is considered rude to shout, and using all caps is the same as shouting, according to forum conventions. This rule is pointed out to new posters who may not be aware of it.

The "get a life" comment joe posted was very rude. As one of the forum moderators, I was tempted to delete it.

In this forum, the convention is to use an asterisk * before the title if there is no content inside. This alerts users that they don't have to bother clicking on the title.

Welcome to the forum, and hope you can benefit from it as well as make any valuable contributions.

Please log in with a username instead of using anonymous. Thank you.

Posted on Aug 4, 2012, 10:58 AM

Respond to this message   

Return to Index


rules (URL) (edited)

by (Login MCalkins)
Moderator

The rules:

http://www.network54.com/Forum/171757/message/1067226652/How+to+post+on+the+QBasic+Forum+without+getting+flamed-

My opinions regarding them:

I would say that rules 4 and 5 should be lax within the bounds of common sense. For example, if your original topic has scrolled off of the first page, it might be good to start a new one, on subforums that don't bump topics to the top. I've also seen quite a few regulars change their "handle" (examples: Artelius and ChronoKitsune), or temporarily use joke handles (examples: Pete and Clippy), or post anonymously (example: ChronoKitsune). I've done it a few times. However, people who post anonymously shouldn't be too surprised if they get treated a little differently... Also, I don't think people should use anonymity as an excuse to be rude.

If a poster is anonymous, you don't have much "state" to work with. You don't know what the person's experience and capabilities are. Is he a beginner that you have to explain everything to, or is he an experienced programmer that you can give a more technical answer to? Sometimes, it is obvious from the post. But then, even within the same topic, you might not know how many "Anonymous"s you have. "Anon" and "Anonymous from Hungary" are a little more distinctive.

Personally, I like having something to identify someone by, if I am having a conversation with him. (Replying to a post is like having a conversation.) However, I recognize that some people might prefer various degrees of anonymity.

Regards,
Michael

P.S. I am getting cached versions of modified pages. I am having to manually refresh.

Posted on Aug 5, 2012, 1:41 PM

Respond to this message   

Return to Index


*Gopus will handle that, he's the best :-)

by (no login)

*

Posted on Aug 6, 2012, 8:56 AM

Respond to this message   

Return to Index


youre the best. asterickz!

by gopus (no login)

Posted on Sep 10, 2012, 4:42 AM

Respond to this message   

Return to Index


Need help about sleep() keyword

by (no login)

I a m doing a program that involves using sleep keyword. But i noticed that when i used sleep(1) it waits for one second and then runs rest of the program.But we can't do the same thing in less than 1 second.Is there any any way to do so in less than 1 second.Plz help.Thanks in advance

Posted on Jul 31, 2012, 12:43 AM

Respond to this message   

Return to Index


Delay SUB

by (Login burger2227)
R

Another problem with SLEEP is that a key press can interrupt the delay.

DO
PRINT "Hello";
Delay .5 '<<<<<<<<<<<< any number of seconds down to .05
PRINT "World!";
LOOP UNTIL INKEY$ <> ""

END

SUB Delay (dlay!)
start! = TIMER
DO WHILE start! + dlay! >= TIMER
IF start! > TIMER THEN start! = start! - 86400
LOOP
END SUB


In QB64 _DELAY can be used to do the same thing down to .001 or one millisecond.

Posted on Jul 31, 2012, 4:24 AM

Respond to this message   

Return to Index


tab moving to new line

by Leon Schrecengost (no login)

I don't know why the pgm is ignoring the semi colon after the tab. It moves the following print strings to a new line.The following is the code. If I remove the tab it prints all strings on the same line but the first string is not indented.

PRINT #1, TAB(12);,Z$(0,1),TAB(26);,Z1$(0,2),TAB(40);,Z2$(0,1),Z2$(0,2)

Everything after the tab 12 prints on the same line only down one
Any ideas?
Leon

Posted on Jul 27, 2012, 6:16 AM

Respond to this message   

Return to Index


*Maybe it's the commas right after the semi-colons

by AlGoreIthm (no login)

Posted on Jul 27, 2012, 5:21 PM

Respond to this message   

Return to Index


* After 46 horizontal columns, it goes to the next row

by (Login burger2227)
R

Posted on Jul 27, 2012, 5:48 PM

Respond to this message   

Return to Index


tab problem

by Leon Schrecengost (no login)

I understand but I'm only telling it to tab to col 12. The line prior to this I put a CRLF$.

Posted on Jul 28, 2012, 8:02 AM

Respond to this message   

Return to Index


tab problem -- check your string lengths

by Solitaire (Login Solitaire1)
S

Are you sure the string is not extending past the next tab stop? It should be at least one less than the next setting.

A comma takes it to the next default tab setting.

Posted on Jul 28, 2012, 9:11 AM

Respond to this message   

Return to Index


Commas take up SPACES too!

by (Login burger2227)
R

TAB(12);,Z$(0,1),TAB(26);,

12 + 15 + 15 = column 42 which is way above 26 so it goes to the next row.

Try this:

PRINT TAB(15); "T"

PRINT , "T"

PRINT TAB(20); "T"; TAB(10); "A"; TAB(7); "B"

The last print will print on 3 separate rows because the column position is less than the previous one. TAB designates the actual screen column position!


Posted on Jul 28, 2012, 10:12 AM

Respond to this message   

Return to Index


Problem downloading QB64

by jane ransom (no login)

Has anyone else had the problem of a corrupt file when downloading QB64?
I succeeded a few months ago and have built a programming course using QB64 but now when I come to write the instructions for downloading it I get this corrupt file message when ever I try.
HELP?

Jane

Posted on Jul 22, 2012, 12:48 AM

Respond to this message   

Return to Index


Re: Problem downloading QB64

by jane ransom (no login)

It's ok - my fault - I'm a twit :(

Posted on Jul 22, 2012, 1:57 AM

Respond to this message   

Return to Index


did you get the problem resolved?

by (Login MCalkins)
Moderator

qb64v0954-win.7z
size: 30,801,179
sha256: 95b4a904bd4ba4527ff1fc31660b202b2d9a8c31467004467e41f33a3e0adcc0
sha1: 32c9224b5512fefc9652cbc297f74d0811bffc19

You can get sha1sum here:
ftp://ftp.gnupg.org/gcrypt/binary/sha1sum.exe

Regards,
Michael

Posted on Jul 22, 2012, 7:23 AM

Respond to this message   

Return to Index


Hey all...

by gopus (no login)

I just came to see how the board was going and to make sure Clippy hasn't ruined it. If there are any problems, please feel free to let me know. I will try to make this board as amazing as it was in the past. I have an invested interest in this board. Talk to you later.

Posted on Jul 20, 2012, 1:27 PM

Respond to this message   

Return to Index


Re: Hey all...

by shellreef (no login)

Wow, gopus, its been a while. I vividly remember you on this forum nearly ten years ago, and your efforts on the QB Inquirer. Good times. It was amazing back then, I loved this forum. Glad you're back! Just like old times..

Posted on Sep 2, 2012, 9:36 PM

Respond to this message   

Return to Index


* welcome back :-)

by (Login MCalkins)
Moderator

Posted on Sep 3, 2012, 1:00 AM

Respond to this message   

Return to Index


your a nice boy... what are you up to?

by gopus (no login)

Posted on Sep 10, 2012, 4:43 AM

Respond to this message   

Return to Index


me thinks this is just Gopus answering himself...

by (Login burger2227)
R

Nobody bothered to answer his post until now...


sad.gif

Posted on Sep 3, 2012, 6:52 AM

Respond to this message   

Return to Index


Problem with (grammatical) person changing program

by (no login)

I had written a program to change the person of any text from 1st to 2nd person (you becomes I etc.)

For some reason it isn't working (i've written the details in the comments of the code) and i don't understand why

Thanks


Source Code:


PRINT changePerson$("your my your my mine yours")
'should be changed to "my your my your yours mine"
'right now it's change to "my,my,my,my,mine,yours"
'the last word isn't being changed and the words in first person
'aren't being changed to second person



FUNCTION changePerson$ (toChange$)
DIM space(1000)
DIM word$(1000)
changed$ = ""
space(0) = 0
spacenum = 0
FOR x = 1 TO LEN(toChange$) 'loop continues until end of command
IF RIGHT$(LEFT$(toChange$, x), 1) = " " THEN 'finds a space
spacenum = spacenum + 1
space(spacenum) = x
word$(spacenum) = RIGHT$(LEFT$(toChange$, space(spacenum) - 1), space(spacenum) - space(spacenum - 1) - 1)
IF LCASE$(word$(spacenum)) = "i" THEN word$(spacenum) = "you"
IF LCASE$(word$(spacenum)) = "my" THEN word$(spacenum) = "your"
IF LCASE$(word$(spacenum)) = "mine" THEN word$(spacenum) = "yours"
IF LCASE$(word$(spacenum)) = "me" THEN word$(spacenum) = "you"
IF LCASE$(word$(spacenum)) = "myself" THEN word$(spacenum) = "yourself"
IF LCASE$(word$(spacenum)) = "you" THEN word$(spacenum) = "me"
IF LCASE$(word$(spacenum)) = "yours" THEN word$(spacenum) = "mine"
IF LCASE$(word$(spacenum)) = "your" THEN word$(spacenum) = "my"
changed$ = changed$ + word$(spacenum) + " "
END IF
NEXT x
spacenum = spacenum + 1
word$(spacenum) = LTRIM$(RIGHT$(toChange$, LEN(toChange$) - space(spacenum - 1)))
IF LCASE$(word$(spacenum)) = "you" THEN word$(spacenum) = "me"
IF LCASE$(word$(spacenum)) = "yours" THEN word$(spacenum) = "mine"
IF LCASE$(word$(spacenum)) = "your" THEN word$(spacenum) = "my"
IF LCASE$(word$(spacenum)) = "i" THEN word$(spacenum) = "you"
IF LCASE$(word$(spacenum)) = "my" THEN word$(spacenum) = "your"
IF LCASE$(word$(spacenum)) = "mine" THEN word$(spacenum) = "yours"
IF LCASE$(word$(spacenum)) = "me" THEN word$(spacenum) = "you"
IF LCASE$(word$(spacenum)) = "myself" THEN word$(spacenum) = "yourself"
changed$ = changed$ + word$(spacenum)
changePerson$ = changed$
END FUNCTION

Posted on Jul 19, 2012, 4:34 PM

Respond to this message   

Return to Index


*Classic case of 'too many IF-THENs'

by AlGoreIthm (no login)

Posted on Jul 19, 2012, 6:33 PM

Respond to this message   

Return to Index


*I concur. SELECT CASE is the way to go here.

by (Login MCalkins)
Moderator

Posted on Jul 19, 2012, 6:44 PM

Respond to this message   

Return to Index


... nope ...

by AlGoreIthm (no login)

Simple table-driven method is always my preference - SELECT CASE is too cumbersome for my taste, never use it.

DECLARE FUNCTION changeperson$ (tochange$)

INPUT tochange$

IF tochange$ <> "" THEN
i$ = changeperson$(tochange$)
PRINT i$
END IF


FUNCTION changeperson$ (tochange$)

DIM s$(9)

s$(1) = "i you"
s$(2) = "my your"
s$(3) = "mine yours"
s$(4) = "me you"
s$(5) = "myself yourself"
s$(6) = "you me"
s$(7) = "yours mine"
s$(8) = "your my"
s$(9) = "yourself myself"

tochange$ = LCASE$(LTRIM$(RTRIM$(tochange$))) + " "

looper% = 1
found% = 0

DO

IF LEFT$(s$(looper%), LEN(tochange$)) = tochange$ THEN found% = looper% ELSE looper% = looper% + 1

LOOP UNTIL found% = looper% OR looper% = 10

IF found% THEN
changed$ = MID$(s$(found%), LEN(tochange$) + 1, LEN(s$(found%)) - LEN(tochange$))
PRINT changed$
ELSE PRINT "NOT FOUND in table"
END IF

END FUNCTION

Posted on Jul 19, 2012, 7:29 PM

Respond to this message   

Return to Index


alternative

by AlGoreIthm (no login)

This is a way to remove duplicate info in the table - but in this situation a space must be added to the end of each entry AND they must be set in a decreasing length order - PLUS there is no entry for 'me'.

This reduces the program by 5 lines (all of which are data) but adds about 5 lines of programming. The first way is superior in my opinion, because it's simpler and the version below would need a special case to identify when the grammar calls for 'I' to be 'me'. Also, having more lines of data rather than code tends to be superior, since data never needs to be 'debugged'.


DECLARE FUNCTION changeperson$ (tochange$)

INPUT tochange$

IF tochange$ <> "" THEN
i$ = changeperson$(tochange$)
PRINT i$
END IF

FUNCTION changeperson$ (tochange$)

DIM s$(4)

s$(1) = "myself yourself "
s$(2) = "mine yours "
s$(3) = "my your "
s$(4) = "i you "

tochange$ = LCASE$(LTRIM$(RTRIM$(tochange$))) + " "

looper% = 1
found% = 0

DO

IF INSTR(s$(looper%), tochange$) THEN found% = looper% ELSE looper% = looper% + 1

LOOP UNTIL found% = looper% OR looper% = 5

'PRINT found%: END

IF found% THEN

IF INSTR(s$(found%), tochange$) = 1 THEN
b% = LEN(tochange$) + 1
e% = LEN(s$(found%)) - LEN(tochange$)
ELSE
b% = 1
e% = INSTR(s$(found%), " ") - 1
END IF

changed$ = MID$(s$(found%), b%, e%)
PRINT changed$
ELSE PRINT "NOT FOUND in table"
END IF

END FUNCTION

Posted on Jul 19, 2012, 8:17 PM

Respond to this message   

Return to Index


Re: alternative

by (no login)

The problem is that I need it for entire sentences but yours only seems to change single words.

Posted on Jul 20, 2012, 6:09 AM

Respond to this message   

Return to Index


Yes

by AlGoreIthm (no login)


it was not my intention to change your entire program, just make the conversion process work well. From here it's up to you.

Posted on Jul 20, 2012, 6:37 AM

Respond to this message   

Return to Index


Re: Yes

by (no login)

oh ok...Thanks.

Posted on Jul 20, 2012, 7:31 AM

Respond to this message   

Return to Index


program not undestood.

by (no login)

1) You don't have a "table".

You have strings.

Is it faster to access the info inside your strings or to go inside a table retrieving the correct string ? Here you have to extract the part of the string you want. In a table, no. So the way to hold information seems not optimal, regarding speed.

The way a program should look, here you see that i comment every thing that is being done ! And i would be very happy every one would ever had done this, this would avoid me many headaches over the years. A program is mostly understandable only for the programmer himself, so without explanations don't ask me to struggle trough your code, however efficient it is.

http://www.network54.com/Forum/648955/message/1338475297/SRTDELAY-BAS+working

Posted on Jul 21, 2012, 8:26 AM

Respond to this message   

Return to Index


Please ...

by (no login)

Would you mind commenting what you are doing ?

1) The most important thing is the text you write as comment above the program statements, telling yourself and other peoples what is being done there.

2) Please, don't put IF... THEN... ELSE on a single line ! my goddess :

IF... THEN
...
ELSE
...
END IF

Posted on Jul 21, 2012, 8:08 AM

Respond to this message   

Return to Index


Re: Please ...

by (no login)

i wrote this a really long time ago and i didn't know about IF blocks or SELECT CASE then. I just found it recently and realized it wasn't working even though the code looked fine.

Posted on Jul 21, 2012, 10:59 AM

Respond to this message   

Return to Index


Very well

by AlGoreIthm (no login)

Our friend Lisztfr brings up an excellent point. Document what your program is doing so that others may follow the logic more easily.

Hopefully this will pass your evaluation:
It is as I understand pmarathe's original intention was described, but using
a completely different method not relying on series of 'IF THEN ELSEs' or
'SELECT CASE'. Enjoy.

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

DECLARE FUNCTION changeperson$ (tochange$)

' Word substitution program by AlGoreIthm
' This version: Saturday July 21st 2012 pm
' NOT extensively tested, NOT guaranteed 'bug-free'.

' IMPORTANT NOTE: this version does not have a method of analyzing
' for the correct use of 'I' versus 'me'.

' User INPUT tochange$ will be scanned by the changeperson$() FUNCTION
' and certain words from a list will be substitued with their antonyms

INPUT tochange$
PRINT
IF tochange$ <> "" THEN PRINT changeperson$(tochange$)

END

FUNCTION changeperson$ (tochange$)

' This function scans the user INPUT tochange$ for data as per the
' list below, to be substituted with the second word in the string, in
' this case, the antonym or 'opposite' meaning.

' Provided that the line with DIM s$(9) is dimensioned to the correct value,
' FUNCTION changeperson$ will always perform the same way, regardless of
' the number of items in the list, no change in program code will be required

' Due to the nature of INSTR, this list of items must be ordered with the
' longest item from a group first: therefore all words beginning with 'you'
' must be in order of longest first -
' example: yourself before yours before your before you etc.

DIM s$(9)
s$(1) = "myself yourself"
s$(2) = "my your"
s$(3) = "mine yours"
s$(4) = "me you"
s$(5) = "yourself myself"
s$(6) = "yours mine"
s$(7) = "your my"
s$(8) = "you me"
s$(9) = "i you"

's$(10) = "white black" ' these additional data items
's$(11) = "black white" ' can be used to demonstrate that the logic
's$(12) = "day night" ' will always perform the same way
's$(13) = "night day" ' regardless of how many items appear in this list
's$(14) = "yes no" ' remember to set the line DIM s$()
's$(15) = "no yes" ' to the correct UPPER BOUNDARY value
's$(16) = "wet dry"
's$(17) = "dry wet"

'modify tochange$ to assist the scanning process by ensuring that
'the entire string is in completely in lowercase,
'with only one leading space and one trailing space

tochange$ = " " + LCASE$(LTRIM$(RTRIM$(tochange$))) + " "

begin% = 1

DO 'External loop scans the length of User INPUT tochange$

' setup to scan the INPUT tochange$ word by word

scan% = INSTR(begin%, tochange$, " ") + 1
found% = 0
looper% = 0

DO 'Internal loop scans to find a match in the data list

looper% = looper% + 1 ' loop counter index increase
match$ = LEFT$(s$(looper%), INSTR(s$(looper%), " ") - 1)

' when a word in tochange $ is found in the data list
' its counterpart will be set in tochange$ at the same position
' effectively replacing the found match$
' ---------------------------------------------------------------------------

IF MID$(tochange$, scan%, LEN(match$)) = match$ THEN

' setup the replacement word
with$ = RIGHT$(s$(looper%), LEN(s$(looper%)) - LEN(match$) - 1)

' retain the remainder of tochange$
therest$ = MID$(tochange$, scan% + LEN(match$))

' modify tochange$ with the substitution
tochange$ = LEFT$(tochange$, scan% - 1) + with$ + therest$

found% = looper% ' will terminate the Internal DO LOOP
' because a match has been found
END IF

' ---------------------------------------------------------------------------

' The Internal loop terminates if a match has been found or after
' the entire data list has been searched and returned no match
' for the current word

LOOP UNTIL found% = looper% OR looper% = UBOUND(s$)

'moving the search scan index towards the next word
begin% = scan% + 2

'once tochange$ has been completely scanned the External loop can terminate
IF begin% >= LEN(tochange$) - 1 THEN terminate% = 1

LOOP WHILE terminate% = 0

changeperson$ = tochange$

END FUNCTION

SUB z.ADDITIONAL.INFORMATION

' For more information on Table-Driven Methods,
' Please refer to CODE COMPLETE by Steve McConnell
' Microsoft Press Copyright 1993 pages 271 - ...

'quote from page 271-272:

' " A table-driven method is a scheme that allows you to look up information
' in a table rather than using logic statements (if and case) to figure
' it out. Virtually anything you can select with logic statements, you
' can select with tables instead. " end quote -

' Programmer's notes:
' -------------------
' The strong point to this method is that it forces the separation of data
' from the programming code, ensuring that a change in data will not tamper
' with extensively tested code possibly causing a bug.

' When the data itself is included within the code, a change in data
' may inadvertently cause a problem with the code, or vice versa.

' Ideally, all the data would be 'hidden' in a disk file and not be visible
' in any section of the program itself.
' The code should be versatile enough to handle any properly formatted data.

' Although it may not be the optimal or fastest method, today's computers
' are fast enough that the human user will not notice a delay of a few extra
' milliseconds. It should probably be considered that 'speed' does not only
' consist of how fast a program runs, but also how quickly it can be
' modified without the consequence of having unforeseen 'bugs' appear. : )

END SUB

Posted on Jul 21, 2012, 5:43 PM

Respond to this message   

Return to Index


Is this even possible?

by Anon (no login)

"Marie Curie is smarter than you are." => "Marie Curie is smarter than I am."
"Bill Gates will give you the directions." => "Bill Gates will give me the directions."

So switching 1st and 2nd persons requires more than simple text replacement.

Posted on Jul 24, 2012, 8:31 PM

Respond to this message   

Return to Index


The MID$ statement can only swap strings of same length

by (Login burger2227)
R

So you have to split up the string into sections:

text$ = "This is my sentence to change."
word1$ = "my"
word2$ = "your"

find = INSTR(text$, word1$)

start$ = LEFT$(text$, find - 1)
ending$ = RIGHT$(text$, LEN(text$) - (find + LEN(word1$) - 1))

PRINT start$ + word2$ + ending$

Posted on Jul 25, 2012, 5:33 AM

Respond to this message   

Return to Index


it's more complicated than it looks

by AlGoreIthm (no login)


Example: " I am ..."

even if 'You' correctly substitutes for 'I', your would have 'You am..." which is not correct.

if you have 'You are...", whether the substitution produces 'I are...' or 'Me are...", neither are correct.

The program would require a section to identify the use of 'you', and a method for the correct substitution of the 'you' PLUS a modification of the verb that follows, when required. But a section of code like that might end up being lengthy.

Whereas if the data list incorporated more detailed strings like:

s$(x%) "i am / you are"
etc.

the substitution would be more straight forward.

But this string structure won't work with the current program because of the additional spacing after 'i' and 'you'. Might be an interesting challenge...

Posted on Jul 25, 2012, 7:06 AM

Respond to this message   

Return to Index


You can figure out the words, here's a function

by (Login burger2227)
R


text$ = "This is my sentence to change my words."
PRINT text$
oldword$ = "my"
newword$ = "your"

x = Replace(text$, oldword$, newword$)
IF x THEN PRINT text$; x

END

FUNCTION Replace (text$, old$, new$) 'can also be used as a SUB
DO
find = INSTR(start + 1, text$, old$) 'find location of a word in text
IF find THEN
count = count + 1
first$ = LEFT$(text$, find - 1) 'text before word including spaces
last$ = RIGHT$(text$, LEN(text$) - (find + LEN(old$) - 1)) 'text after word
text$ = first$ + new$ + last$
END IF
start = find
LOOP WHILE find
Replace = count ' function returns the number of replaced words
END FUNCTION

Posted on Jul 25, 2012, 9:34 AM

Respond to this message   

Return to Index


This is just a basic version

by (no login)

I wanted to start off with nouns, then move to verbs. Later I'm going to implement a function to check the function of the noun in the sentence (subject, direct object, indirect object etc.)

Posted on Jul 25, 2012, 9:22 AM

Respond to this message   

Return to Index


Going past input kepyword

by (no login)

I am writing a q-basic chat program with my my friends but we are stuck at a certain part.

(We have a LAN connection and we have typed the same code in both the computer and our first part of the program opens a file in .txt extension for another computer to take as input and second part takes input from file in .txt extension which is sent by another computer as input for us.So the problem is we won't be able to see the result of the second part of the program until we get past line 2 i.e input keyword)
Our program goes like this:

Open"file.extension" for output as #1 ]
input a$ :'this is line 2. ] THIS IS THE FIRST PART OF THE PROGRAM
write #1,a$ ]
close ]

open "file.extension" for input as #2 ]
while not EOF(2) ]
input a$ ] This is the second part of the program
wend ]
print a$ ]

Posted on Jul 19, 2012, 1:16 AM

Respond to this message   

Return to Index


Re: Going past input kepyword

by (Login MCalkins)
Moderator

I take it that "file.extension" is a shared file on the LAN?

It seems to me that this method would be problematic. Perhaps others will be able to give better advice.

If the chat didn't need to be instant, perhaps you could do something like this: Have two files, one for communication going each way. The program sending opens the file for append, locking it, then writes to it, and immediately closes it. It does this at intervals of a few seconds. the other program receiving opens it, locking it, reads it, then immediately deletes it. (If the other program has already started writing again, the delete will hopefully fail.) It does this at intervals of a few seconds. You'll need to have error handling code to handle the failures from when both programs are trying to access the file at the same time.

You might consider the built in networking capabilities of QB64 as an alternative.

Regards,
Michael

Posted on Jul 19, 2012, 4:13 AM

Respond to this message   

Return to Index


Re: Going past input kepyword

by (no login)

You said i need error handling codes? Can you send me a link or tips that describes clearly about error handling codes? And thanks for replying

Posted on Jul 24, 2012, 1:23 AM

Respond to this message   

Return to Index


Re: Going past input kepyword

by (Login MCalkins)
Moderator

Here are some links to the QB64 wiki. It contains information for both QBASIC 1.1 and QB64. Anything that starts with an underscore is only for QB64.

If you want information just for QBASIC 1.1, try the built in help.

http://www.qb64.net/wiki/index.php?title=OPEN

http://www.qb64.net/wiki/index.php?title=Keyword_Reference_-_By_usage#Error_Trapping:
http://www.qb64.net/wiki/index.php?title=ON_ERROR

While you're there:

http://www.qb64.net/wiki/index.php?title=Keyword_Reference_-_By_usage#TCP.2FIP_Networking_and_Email:

If you're willing to switch to QB64, you'll probably find its networking capability more convenient.

Regards,
Michael

Posted on Jul 24, 2012, 1:53 AM

Respond to this message   

Return to Index


Anybody know some simple tunes

by (no login)

Anybody know of a site with some short tunes that can be played in qbasic? I would like to add some simple sounds to my text adventure and while I understand how to use the play command I don't know anything about making music. Just mainly looking for something simple for example a short tune similar to what you hear in the original pitfall when you pick up a treasure. Have tried googling qbasic music, qbasic sheet music, etc and all I found was the happy birthday theme. I have created some neat stuff with for x loops but unfortunately you can't main buffer that stuff and execute other commands while they play.

If there are no sites anybody have some interesting tunes to share? Just would like some simple stuff.

Posted on Jul 18, 2012, 9:39 AM

Respond to this message   

Return to Index


Re: Anybody know some simple tunes

by (no login)

QB64 allows you to load actual Sound files - so you can do that instead of using SOUND and PLAY. You can just load your favorite mp3 and use that as the background music.

Check out the QB64 wiki for syntax details

http://qb64.net/wiki/index.php?title=SNDOPEN

Posted on Jul 18, 2012, 11:20 AM

Respond to this message   

Return to Index


Re: Anybody know some simple tunes

by (Login MCalkins)
Moderator

You know how to transpose sheet music to PLAY statements, right? (In other words, can you read sheet music?)

There should be plenty of public domain classical music and folk tunes on the internet. I'd look for older stuff with expired copyright. (Everything published prior to 1923 is public domain.)

You can use PLAY "MB", to play in the background. You can use ON PLAY event trapping to continue to feed the buffer.

QB64 extends the PLAY statement by letting you play multiple notes at once, bit it doesn't (as far as I know) support ON PLAY event trapping. QB64 will also let you play MIDI files.

Regards,
Michael

Posted on Jul 18, 2012, 11:29 AM

Respond to this message   

Return to Index


MAYBE? ...

by OPRESION (no login)

http://qbasicnews.com/abc/showpacket.php?packet=SOUND.ABC

Posted on Jul 18, 2012, 9:09 PM

Respond to this message   

Return to Index


qb4.5 to qb64

by (no login)

I have a rather small (100line) program that works fine in qb4.5
How do I copy this to qb64.
When I just copy source program into qb64 it is not readable.

However, if I just re-code the 100 lines exactly as in qb4.5 it compiles and runs exactly as qb4.5.

How am I suppose to copy a qb4.5 source to qb64. Do I convert to text first. Thanks

Posted on Jul 18, 2012, 8:53 AM

Respond to this message   

Return to Index


Re: qb4.5 to qb64

by (Login MCalkins)
Moderator

When you are in QB 4.5, go to "File", "Save As...", and make sure that you select "Text - Readable by Other Programs".

Regards,
Michael

Posted on Jul 18, 2012, 9:31 AM

Respond to this message   

Return to Index


Re: qb4.5 to qb64

by richard (no login)

ok. this worked fine thanks very much
I assumed there was a simple solution, but your help was quick and saved me lots of time.

Posted on Jul 18, 2012, 10:50 AM

Respond to this message   

Return to Index


*yw

by (Login MCalkins)
Moderator

Posted on Jul 18, 2012, 11:18 AM

Respond to this message   

Return to Index


Antialiasing in QB64

by (no login)

I made an antialiasing program - it scans the screen for pixels which need to be antialiased(edge pixels) and then blurs them accordingly. The problem is, it doesn't do anything. This is my source code :

SUB antialias (screenx, screeny)
FOR dx = 1 TO screenx - 1
FOR dy = 1 TO screeny - 1
op = POINT(dx, dy)
ra = 0
ba = 0
ga = 0
FOR cx = -1 TO 1
FOR cy = -1 TO 1
cp = POINT(dx + cx, dy + cy)
comparison = ABS(_RED32(op) - _RED32(cp)) + ABS(_BLUE32(op) - _BLUE32(cp)) + ABS(_GREEN32(cp) - _GREEN32(op))
IF comparison > 100 THEN
difpix = difpix + 1
END IF
ra = ra + (_RED32(cp) / 9)
ba = ba + (_BLUE32(cp) / 9)
ga = ga + (_GREEN32(cp) / 9)
NEXT cy
NEXT cx
IF difpix >= 1 AND difpix <= 4 THEN
difpix = 0
PSET (dx, dy), _RGB(ra, ga, ba)
END IF
NEXT dy
NEXT dx
END SUB

Posted on Jul 17, 2012, 7:52 AM

Respond to this message   

Return to Index


Update

by (no login)

This is what I have now :

SUB antialias (screenx, screeny)
FOR dx = 1 TO screenx - 1
FOR dy = 1 TO screeny - 1
ra = 0
ba = 0
ga = 0
op~&& = POINT(dx, dy)
FOR cx = -1 TO 1
FOR cy = -1 TO 1
cp~&& = POINT(dx + cx, dy + cy)
comparison = ABS(_RED32(op~&&) - _RED32(cp~&&)) + ABS(_BLUE32(op~&&) - _BLUE32(cp~&&)) + ABS(_GREEN32(cp~&&) - _GREEN32(op~&&))
IF comparison > 100 THEN
difpix = difpix + 1
END IF
averagecolor~&& = averagecolor~&& + (cp~&& / 9)
NEXT cy
NEXT cx
IF difpix >= 1 AND difpix <= 4 THEN
difpix = 0
PSET (dx, dy), average~&&
END IF
NEXT dy
NEXT dx
END SUB

Posted on Jul 17, 2012, 10:45 AM

Respond to this message   

Return to Index


Another Update

by (no login)

I revised my anti aliasing program (again), but the colors are completely wrong. I checking the averaging algorithm and it seems fine...but the program just doesn't work...I have no idea what the issue is..

Source code (I added comments) :


SCREEN _NEWIMAGE(1280, 720, 32)

' Draws some shapes to test the subroutine
'LINE (0, 0)-(720, 720), _RGB(255, 0, 0)
CIRCLE (500, 500), 100, _RGB(255, 255, 255)
PAINT (500, 500), _RGB(255, 255, 255), _RGB(255, 255, 255)

'call the sub after drawing the shapes.
CALL antialias(1280, 720)


SUB antialias (screenx, screeny)
FOR dx = 1 TO screenx - 1 'goes through each pixel for the entire area of the screen
FOR dy = 1 TO screeny - 1
averagecolor~&& = 0 'reset average color and other values
difpix = 0
op~&& = POINT(dx, dy) ' get the color of the main pixel
FOR cx = -1 TO 1 'gets the 8 pixels around (dx,dy)
FOR cy = -1 TO 1
cp~&& = POINT(dx + cx, dy + cy) 'get the color of each of the 8 pixels

IF (cp~&& > op~&& AND (cp~&& / op~&&) > 1.000459770087633) OR (op~&& > cp~&& AND (op~&& / cp~&& > 1.000459770087633)) THEN difpix = difpix + 1
'check if the colors of the pixels are different enough to antialias them

averagecolor~&& = averagecolor~&& + (cp~&& / 9)
'find the average color of (dx,dy) and the 8 pixels surrounding it regardless of whether the pixel needs antialiasing

NEXT cy
NEXT cx
IF difpix >= 1 AND difpix < 5 THEN 'if there are different colored pixels among the 8
'(but not too many otherwise it would antialias a 1-pixel line causing it to lose color. EG. any point on a vertical 1-pixel line has 6 different colored pixels around it)
' antialiasing this sort of line would only cause it to lose color

PSET (dx, dy), averagecolor~&&

'PRINT , dx, dy, _RED32(averagecolor~&&), _GREEN32(averagecolor~&&), _BLUE32(averagecolor~&&)
'SLEEP
'For debugging - goes through each pixel which needs to be antialiased and gives its
' coordinates and RGB values.
END IF
NEXT dy
NEXT dx
END SUB

Posted on Jul 18, 2012, 8:26 AM

Respond to this message   

Return to Index


One thing you might try...

by (Login qb432l)
R

In this example, the antialiasing color should be R:128,G:128,B:128 -- in other words, a medium gray, since the foreground is white and the background is black. Do some simple experiments with just that part of your code that determines the average color.

Try it out with different foreground/background colors where you know in advance what the answer should be, for example, if you had used the red background, the antialiasing color should have been R:192,G:128,B:128.

That's the way I'd proceed, anyway.

-Bob

Posted on Jul 19, 2012, 5:04 AM

Respond to this message   

Return to Index


This is what I have so far

by (no login)

The averaging part is fine but it doesn't look good because of some of the checks i've put in (specifically the one i've marked)


SCREEN _NEWIMAGE(1280, 720, 32)
LOCATE 25, 20
PRINT "This is aliased"
' Draws some shapes to test the subroutine
LINE (0, 0)-(720, 720), _RGB(255, 0, 0)
CIRCLE (500, 500), 100, _RGB(255, 255, 255)
PAINT (500, 500), _RGB(255, 255, 255), _RGB(255, 255, 255)
_DELAY 2
'call the sub after drawing the shapes.
CALL antialias(1280, 720)
LOCATE 25, 20
PRINT "This is antialiased"


SUB antialias (screenx, screeny)
FOR dx = 1 TO screenx - 1 'goes through each pixel for the entire area of the screen
FOR dy = 1 TO screeny - 1
ra = 0
ga = 0
ba = 0 'reset color and other values
difpix = 0
weightednum = 0
op~&& = POINT(dx, dy) ' get the color of the main pixel
FOR cx = -1 TO 1 'gets the 8 pixels around (dx,dy)
FOR cy = -1 TO 1
cp~&& = POINT(dx + cx, dy + cy) 'get the color of each of the 8 pixels
IF (cp~&& > op~&& AND (cp~&& / op~&&) > 1.001226993792092) OR (op~&& > cp~&& AND (op~&& / cp~&& > 1.001226993792092)) THEN
difpix = difpix + 1
ra = ra + (_RED32(cp~&&))
ga = ga + (_GREEN32(cp~&&))
ba = ba + (_BLUE32(cp~&&))
weightednum = weightednum + 1
END IF
'check if the colors of the pixels are different enough to antialias them
weightednum = weightednum + 1
ra = ra + (_RED32(cp~&&))
ga = ga + (_GREEN32(cp~&&))
ba = ba + (_BLUE32(cp~&&))
'find the average color of (dx,dy) and the 8 pixels surrounding it regardless of whether the pixel needs antialiasing

NEXT cy
NEXT cx
' The Difpix part is ruining the effect but it's necessary because otherwise the subroutine would blur lines unnecessarily
IF difpix >= 1 AND difpix < 6 THEN 'if there are different colored pixels among the 8
'(but not too many otherwise it would antialias a 1-pixel line causing it to lose color. EG. any point on a vertical 1-pixel line has 6 different colored pixels around it)
' antialiasing this sort of line would only cause it to lose color

PSET (dx, dy), _RGB((ra / weightednum), (ga / weightednum), (ba / weightednum))

'PRINT , dx, dy, _RED32(averagecolor~&&), _GREEN32(averagecolor~&&), _BLUE32(averagecolor~&&)
'SLEEP
'For debugging - goes through each pixel which needs to be antialiased and gives its
' coordinates and RGB values.
END IF
NEXT dy
NEXT dx
END SUB

Thanks for your help

Posted on Jul 19, 2012, 6:04 AM

Respond to this message   

Return to Index


*Hey, not bad -- and the red line works well, too! :-)

by (Login qb432l)
R

*

Posted on Jul 19, 2012, 7:34 PM

Respond to this message   

Return to Index


I made it even better

by (no login)

In my previous program, straight lines would be blurred as well(and straight edges + corners of objects). It would blur the entire boundary of a rectangle and the circle didn't look so good.So I modified it to ignore 1-pixel lines(because from far away it didn't seem to make a difference) and straight edges completely and this is what I ended up with :


SCREEN _NEWIMAGE(1280, 720, 32)
LOCATE 5, 20
PRINT "This is aliased"
' Draws some shapes to test the subroutine
LINE (0, 0)-(720, 720), _RGB(255, 0, 0)
LINE (110, 110)-(720, 720), _RGB(255, 0, 0), BF
CIRCLE (500, 500), 100, _RGB(255, 255, 255)
PAINT (500, 500), _RGB(255, 255, 255), _RGB(255, 255, 255)
SLEEP
'call the sub after drawing the shapes.
s# = TIMER(.001)
CALL antialias(1280, 720, 1)
tiaa = TIMER(.001) - s#
PRINT
LOCATE 5, 20
PRINT "This is antialiased. It took "; tiaa; " seconds to antialias the image"
SLEEP
CLS
LINE (0, 0)-(720, 720), _RGB(255, 0, 0)
LINE (110, 110)-(720, 720), _RGB(255, 0, 0), BF
CIRCLE (500, 500), 100, _RGB(255, 255, 255)
PAINT (500, 500), _RGB(255, 255, 255), _RGB(255, 255, 255)
df# = TIMER(.001)
CALL blur(1280, 720)
tiblur = TIMER(.001) - df#
LOCATE 5, 20
PRINT "This is blurred. It took "; tiblur; " seconds to blur the image"
SLEEP
CLS
PRINT "Antialiasing was "; (tiblur / tiaa) * 100 - 100; "% faster."

SUB antialias (screenx, screeny, quality)
FOR main = 1 TO quality
ws& = _NEWIMAGE(screenx + 1, screeny + 1, 32)
_PUTIMAGE (0, 0)-(screenx, screeny), , ws&, (0, 0)-(screenx, screeny)
_SOURCE ws&
FOR dx = 1 TO screenx - 1 'goes through each pixel for the entire area of the screen
FOR dy = 1 TO screeny - 1
ra = 0
ga = 0
ba = 0 'reset color and other values
difpix = 0
weightednum = 0
op~&& = POINT(dx, dy) ' get the color of the main pixel
FOR cx = -1 TO 1 'gets the 8 pixels around (dx,dy)
FOR cy = -1 TO 1
cp~&& = POINT(dx + cx, dy + cy) 'get the color of each of the 8 pixels
comparison = ABS(_RED32(op~&&) - _RED32(cp~&&)) + ABS(_BLUE32(op~&&) - _BLUE32(cp~&&)) + ABS(_GREEN32(cp~&&) - _GREEN32(op~&&))
IF comparison > 175 THEN
difpix = difpix + 1
END IF
'check if the colors of the pixels are different enough to antialias them
weightednum = weightednum + 1
ra = ra + (_RED32(cp~&&))
ga = ga + (_GREEN32(cp~&&))
ba = ba + (_BLUE32(cp~&&))
'find the average color of (dx,dy) and the 8 pixels surrounding it regardless of whether the pixel needs antialiasing

NEXT cy
NEXT cx
IF difpix > 3 AND difpix < 5 THEN 'if there are different colored pixels among the 8
'(but not too many otherwise it would antialias a 1-pixel line causing it to lose color. EG. any point on a vertical 1-pixel line has 6 different colored pixels around it)
' antialiasing this sort of line would only cause it to lose color

PSET (dx, dy), _RGB((ra / weightednum), (ga / weightednum), (ba / weightednum))

'PRINT , dx, dy, _RED32(averagecolor~&&), _GREEN32(averagecolor~&&), _BLUE32(averagecolor~&&)
'SLEEP
'For debugging - goes through each pixel which needs to be antialiased and gives its
' coordinates and RGB values.
END IF
NEXT dy
NEXT dx
_FREEIMAGE ws&
NEXT main
END SUB

SUB blur (x, y)
ws& = _NEWIMAGE(x + 1, y + 1, 32)
_PUTIMAGE (0, 0)-(x, y), , ws&, (0, 0)-(x, y)
_SOURCE ws&
DIM p~&(9)
FOR cx = 1 TO x - 1 STEP 1
FOR cy = 1 TO y - 1 STEP 1
index = 0
FOR dx = -1 TO 1
FOR dy = -1 TO 1
index = index + 1
p~&(index) = POINT(cx + dx, cy + dy)
NEXT dy
NEXT dx
redaverage~& = 0
blueaverage~& = 0
greenaverage~& = 0
FOR dd = 1 TO 9
redaverage~& = (_RED32(p~&(dd)) / 9) + redaverage~&
NEXT dd
FOR dd = 1 TO 9
greenaverage~& = (_GREEN32(p~&(dd)) / 9) + greenaverage~&
NEXT dd
FOR dd = 1 TO 9
blueaverage~& = (_BLUE32(p~&(dd)) / 9) + blueaverage~&
NEXT dd
PSET (cx, cy), _RGB(redaverage~&, greenaverage~&, blueaverage~&)
NEXT cy
NEXT cx
_FREEIMAGE (ws&)
END SUB

Posted on Jul 20, 2012, 6:14 AM

Respond to this message   

Return to Index


*Yeah -- definitely a speed improvement. Nice going.

by (Login qb432l)
R

*

Posted on Jul 20, 2012, 7:49 AM

Respond to this message   

Return to Index


failure to go to subroutine

by Leon Schrecengost (no login)

I have a subroutine that will send data from an array to the printer. I use the lprint command. My problem is when I call the routine nothing happens. When I exit the program it sends the data to the printer. If I change the first line from lprint to print it will display it on the screen what I write but does not contingue to exicute the rest of the routine. Any ideas.
Leon

Posted on Jul 16, 2012, 1:12 PM

Respond to this message   

Return to Index


hm...

by (no login)

Not a clue, sorry.

You should try to print something at some place in the man program as test.

Posted on Jul 16, 2012, 2:01 PM

Respond to this message   

Return to Index


Re: failure to go to subroutine

by (Login MCalkins)
Moderator

Are you using QBASIC or QB64?
What Windows version?
How is your printer connected?
What happens when you:

LPRINT CHR$(&HC);

Does that make it print the page?

Regards,
Michael

Posted on Jul 16, 2012, 2:18 PM

Respond to this message   

Return to Index


failure to go to sub routine

by Leon Schrecengost (no login)

I am using Qbasic. Yes I can print to the printer. If I run the subroutine as a stand alone pgm. it works fine. I can send printer commands such as Chr$(10) to insert spaces between lines and the ,,moves the cursor 28 spaces.

So does any of this make any sense?
Leon

Posted on Jul 16, 2012, 4:23 PM

Respond to this message   

Return to Index


Re: failure to go to sub routine

by (Login MCalkins)
Moderator

Yeah, but it's been many years since I've done anything with a printer from QBASIC. At the moment, I only have two suggestions:

Try LPRINTing something, then LPRINT CHR$(12); which is the form feed character. See if that causes it to spit out a page.

Perhaps, try OPENing "LPT1" FOR OUTPUT, and PRINT #1, etc. You might also send CHR$(12), then CLOSE the device, and see if that causes it to print...

Note: these are just ideas. I really don't know if they will work.

You're trying to print whole pages at once, right, not just a few lines at a time?

Regards,
Michael

Posted on Jul 17, 2012, 12:24 AM

Respond to this message   

Return to Index


failure to go to sub routine

by Leon Schrecengost (no login)

What I don't understand is why It will not go to the subroutine and why when I end the program it prints. The following is a short sample of the pgm.


10 cls
20 DIM Z$(10,3)
30 let I$ = inkey$
40 Print "press v to view array data"
50 Print "press p to print array data"
60 Press "press e to exit pgm"
70 P1$ = Z$(0,0):P2$ = Z$(0,1):P3$ = Z$(0,2)
80 If I$ = "e" then end
90 IF I$ = "v" then gosub 700 This displays data in the array {works fine)
100 If I$ = "p" then gosub 3000
110 goto 30

This is a very abrevated version of the pgm

Subroutine for lprint

3000 LPRINT CHR$(10) : LPRINT P1$,,P2$,,P3$
3010 RETURN

Posted on Jul 17, 2012, 5:06 AM

Respond to this message   

Return to Index


It is going to the subroutine

by (Login MCalkins)
Moderator

That's not the problem. As you discovered when you changed the LPRINT to PRINT, it is going to the subroutine.

I think it's most likely that the printing output is being queued. That is why it prints when the program ends. Perhaps, it's waiting until it has a full page to start printing? Hence, my CHR$(12) suggestion.

Entirely separate from the printer problems, I would suggest using a cleaner coding style.

Regards,
Michael

-----

DIM z(0 TO 10, 0 TO 3) AS STRING
DIM i AS STRING, p1 AS STRING, p2 AS STRING, p3 AS STRING

CLS
DO
 i = INKEY$
 PRINT "press v to view array data"
 PRINT "press p to print array data"
 PRINT "press e to exit pgm"
 p1 = z(0, 0): p2 = z(0, 1): p3 = z(0, 2)
 SELECT CASE i
  CASE "e": END
  CASE "v": GOSUB ViewArray
  CASE "p": GOSUB PrintArray
 END SELECT
LOOP

ViewArray:
RETURN

PrintArray:
LPRINT CHR$(10): LPRINT p1$, , p2$, , p3$
RETURN

Posted on Jul 17, 2012, 6:51 AM

Respond to this message   

Return to Index


not going to subroutine

by Leon Schrecengost (no login)

I put the LPRINT CHR$(12)in and now it will print and expell the page.
It still will not print unless I exit the pgm. I have the printer status box open and it's not being sent to the printer until the end cmd. I think you're on the right track. If I end the pgm with out calling the print routine it just exits.I'm completly baffled.

Posted on Jul 17, 2012, 10:13 AM

Respond to this message   

Return to Index


try something like this

by (Login MCalkins)
Moderator

I'm not in a good position to test it, as I don't have an LPT printer hooked up...
Regards,
Michael

DIM i AS INTEGER
OPEN "LPT1" FOR OUTPUT AS 1
FOR i = 0 TO 15: PRINT #1 "Hello": NEXT
PRINT #1, CHR$(12);
CLOSE

PRINT "Did that print yet?"
SLEEP: WHILE LEN(INKEY$): WEND

OPEN "LPT1" FOR OUTPUT AS 1
FOR i = 0 TO 15: PRINT #1 "Goodbye": NEXT
PRINT #1, CHR$(12);
CLOSE
SYSTEM

Posted on Jul 17, 2012, 12:15 PM

Respond to this message   

Return to Index


try this

by Leon Schrecengost (no login)

Michael, I get an error message line 3

FOR i=0 TO 15:PRINT #1 "HELLO":NEXT

The error message is (EXPECTED) : and highlites the "H

I'm using DOS print to redirect the LPT1 port to my hp 4400 USB printer
works for everything except the sub routine call.

Posted on Jul 17, 2012, 12:58 PM

Respond to this message   

Return to Index


I forgot the commas

by (Login MCalkins)
Moderator

DIM i AS INTEGER
OPEN "LPT1" FOR OUTPUT AS 1
FOR i = 0 TO 15: PRINT #1, "Hello": NEXT
PRINT #1, CHR$(12);
CLOSE

PRINT "Did that print yet?"
SLEEP: WHILE LEN(INKEY$): WEND

OPEN "LPT1" FOR OUTPUT AS 1
FOR i = 0 TO 15: PRINT #1, "Goodbye": NEXT
PRINT #1, CHR$(12);
CLOSE
SYSTEM

Posted on Jul 17, 2012, 1:23 PM

Respond to this message   

Return to Index


commas

by Leon Schrecengost (no login)

That worked fine. I still have the issue of not going to the sub routine. I'm going to try your program imbedded in mine as a sub routine and see if it will work. will keep you posted.

Posted on Jul 17, 2012, 4:40 PM

Respond to this message   

Return to Index


commas

by Leon Schrecengost (no login)

Michael, That was it it runs ok. I used your pgm as a sub routine in my pgm. I even added the same line numbers and it worked. I totaly don't understand why it will work and not mine.(Maybe your just good) Any way can I subtitute my array name z$ and the location in that pgm and print the array data. I will remove the loop funtion and add CHR$(10) to get the line space between array address. I would have something that would look like this in place of "HELLO" z$(0,1). I would not use the quotation marks.

Posted on Jul 18, 2012, 5:34 AM

Respond to this message   

Return to Index


Good. Now that your initial problem is resolved ....

by Solitaire (Login Solitaire1)
S

Please get rid of those obsolete numbered lines and learn to use stuctured loops! That outdated practice goes back to GWBASIC, which is even older than QBasic.

I was going to suggest using a menu in a DO loop but Michael beat me to it. I strongly suggest using the code he posted above (repeated below), and move your program over to a structured version:

DIM z(0 TO 10, 0 TO 3) AS STRING
DIM i AS STRING, p1 AS STRING, p2 AS STRING, p3 AS STRING

CLS
DO
 i = INKEY$
 PRINT "press v to view array data"
 PRINT "press p to print array data"
 PRINT "press e to exit pgm"
 p1 = z(0, 0): p2 = z(0, 1): p3 = z(0, 2)
 SELECT CASE i
  CASE "e": END
  CASE "v": GOSUB ViewArray
  CASE "p": GOSUB PrintArray
 END SELECT
LOOP

ViewArray:
RETURN

PrintArray:
LPRINT CHR$(10): LPRINT p1$, , p2$, , p3$
RETURN

Posted on Jul 18, 2012, 7:12 AM

Respond to this message   

Return to Index


yeah

by (Login MCalkins)
Moderator

I think the difference is opening and closing the device. I'm guessing that doing that tells NTVDM to go ahead and print. Even without the CHR$(12) I've got my doubts whether you'll be able to print just lines at a time. You might get forced into printing whole pages at once.

The "Hello" bit was just an test/example. You should be able to substitute your own strings.

Regards,
Michael

Posted on Jul 18, 2012, 8:12 AM

Respond to this message   

Return to Index


yeah

by Leon Schrecengost (no login)

Thanks to everyone who helped. I made the subtitions for hello and it works fine. Just have to work out the page layout.
Leon

Posted on Jul 18, 2012, 8:39 AM

Respond to this message   

Return to Index


print formatting

by LeonSchrecengost (no login)

Now that I,m able to print i'm trying to format the data. The only issue is getting the print back to the left margin. I tried chr$(13) which should be CR I thought after that I would be able to tab to the position I wanted to start the next print string. Does not work for me.

Posted on Jul 19, 2012, 8:41 AM

Respond to this message   

Return to Index


Try CHR$(10) Line feed or CHR$(13) + CHR$(10)

by (Login burger2227)
R

CRLF$ = CHR$(13) + CHR$(10)

add it to the end of the string or

LPRINT CRLF$


CHR$(12) is form feed to eject paper.

Posted on Jul 19, 2012, 2:44 PM

Respond to this message   

Return to Index


Line feed

by Leon Schrecengost (no login)

CRLF$ works thanks

Posted on Jul 20, 2012, 7:27 AM

Respond to this message   

Return to Index

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