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



Well, there goes another QB site.

by (Login ComputerGhost)
R

I thought we once had a subforum for posts like this? Maybe my memory serves me wrong.

It's a bit late, and I don't know if anyone will miss my old tutorials and QB command reference, but <http://www.peltkore.net/~computerghost/QBasic.htm> is no more. My host wanted to use the server for business purposes.

My old OLD website <http://www.freewebs.com/computerghost> seems to still be up and has the content on it. The page doesn't seem to work well, so here's the direct link to the QBasic section: <http://www.freewebs.com/computerghost/qbasic.htm>.

I do plan to put the site back up at some time in the future, once I knock these other projects I have out and have time to design a better website than my previous two.

All that said, I hope that the QBasic forum community is doing well, and I bid you all a good night! Au revoir!

-- Nathan

Posted on Nov 11, 2011, 7:54 PM

Respond to this message   

Return to Index


*P.S. I'm sorry some of the links don't work. I can get those pages for anyone interested.

by (Login ComputerGhost)
R

Posted on Nov 11, 2011, 7:57 PM

Respond to this message   

Return to Index


*Good luck, CG!

by (Login qb432l)
R

*

Posted on Nov 11, 2011, 9:14 PM

Respond to this message   

Return to Index


Yeah, good to see that you are still around CG.

by (Login burger2227)
R

Me and bob are lonely here a lot...

Posted on Nov 12, 2011, 4:00 PM

Respond to this message   

Return to Index


*Don't give him the wrong idea -- I also have a goldfish to help keep me company.

by (Login qb432l)
R

*

Posted on Nov 13, 2011, 9:45 AM

Respond to this message   

Return to Index


* That goldfish is NOT gonna like your igloo! :-)

by (Login burger2227)
R

Posted on Nov 13, 2011, 1:03 PM

Respond to this message   

Return to Index


* I'm here, looking in at least once or twice a day.

by Solitaire (Login Solitaire1)
S

Posted on Nov 13, 2011, 12:08 PM

Respond to this message   

Return to Index


I see you ,but you don't say much...

by (Login burger2227)
R

How is .NET treating you? I hope their forums are more active than this.

Posted on Nov 13, 2011, 1:35 PM

Respond to this message   

Return to Index


Yes, the .NET forums are very active.

by Solitaire (Login Solitaire1)
S

There are literally dozens of them, each dedicated to a single specialty.  I usually frequent the VB Express forum (where I am also known as Solitaire):

http://social.msdn.microsoft.com/Forums/en-US/Vsexpressvb/threads

But I often come back to the simplicity of QB in order to test the logic of some code before translating it into VB.

Posted on Nov 13, 2011, 3:29 PM

Respond to this message   

Return to Index


Oh, I still haunt these forums a few times a week...

by (Login ComputerGhost)
R

I mostly keep a look-out in the linux and C++ subforums. I haven't used QBasic in years.

Posted on Nov 13, 2011, 7:48 PM

Respond to this message   

Return to Index


*because you are a ghost hahahaha

by george (no login)

Posted on Nov 13, 2011, 11:11 PM

Respond to this message   

Return to Index


Can't open short GW Basic program with QB64

by (no login)

I have an old GW Basic program that causes the QB64 install on my 2009 Mac to hang with an IDE module error when opened:

http://dl.dropbox.com/u/4147630/IDE%20Module%20error.png


When I click OK, QB64 crashes and the System can't restart it.


Can anyone tell me what the problem is? The program is here:

http://dl.dropbox.com/u/4147630/Dialog3Demo/CONDFORM.BAS


Posted on Nov 10, 2011, 4:13 PM

Respond to this message   

Return to Index


What is all of the ASCII garbage?

by (Login burger2227)
R

Can you read the ALL of the code in a text editor before you run it?

It looks like the text was formatted by QB4.5 when it was saved. If you have QB4.5 Save As text readable.

Posted on Nov 10, 2011, 4:48 PM

Respond to this message   

Return to Index


It is tokenized

by (no login)

Can't read code in text editor.

The program is tokenized and I have no "Save as text" option in the current implementation. Might be possible to boot directly, not in DosBox, and save as text.

Posted on Nov 11, 2011, 1:46 AM

Respond to this message   

Return to Index


Re: It is tokenized

by (Login MCalkins)
Moderator

You needed to go into gwbasic, type:
load "condform.bas"
save "condform.txt", a

Regards,
Michael


10 REM ===== THIS PROGRAM MUST BE IMPLEMENTED ON A SYSTEM THAT ACCEPTS A
20 REM ===== STATEMENT THAT READS A CHARACTER FROM THE KEYBOARD WHITHOUT
30 REM ===== INTERRUPTING THE PROGRAM (E.G. INKEY$).
40 GOSUB 1290
50 REM ===== CLEAR THE SCREEN
60 PRINT "*** DIALOG SUPPORT SYSTEM ***"
70 PRINT "COPYRIGHT DAVID STODOLSKY, 1986"
80 PRINT
90 PRINT "PRESS RETURN FOR INSTRUCTIONS"
100 INPUT Z$
110 GOSUB 1290
120 GOSUB 1340
130 DIM N6$(20)
140 DIM G$(30)
150 DIM U(20)
160 DIM Q(20)
170 FOR I = 0 TO 26
180     READ G$(I)
190 NEXT I
200 LET P = 36
210 PRINT "PROGRAM LOOPS PER SECOND SET TO "; P
220 GOTO 280
230 LET S7 = S7 + 1
240 LET S1 = S7 / P
250 LET C = S1
260 REM ----- C = CURRENT TIME
270 RETURN
280 REM ===== INITIALIZATION ==================================
290 PRINT "TURN LIMIT (SEC.)";
300 INPUT T
310 REM ----- T = TURN LIMIT
320 PRINT "DISCUSSION LIMIT (MIN.)";
330 INPUT D
340 LET D = D * 60
350 REM ----- D = DISCUSSION LIMIT
360 PRINT "NUMBER OF PEOPLE";
370 INPUT N2
380 FOR N1 = 1 TO N2
390     PRINT "NAME "; G$(N1)
400     INPUT N6$(N1)
410 NEXT N1
420 PRINT "IF A PERSON GETS INTERRUPTED, SHALL HE OR SHE"
430 PRINT "BE REMOVED FROM THE QUEUE? (Y/N) ";
440 INPUT P$
450 IF P$ = "Y" THEN 510
460 IF P$ = "y" THEN 510
470 IF P$ = "n" THEN 510
480 PRINT
490 IF P$ = "N" THEN 510
500 GOTO 420
510 GOSUB 1290
520 PRINT D/60;" MIN.CONFERENCE. ";T;" SEC. TURNS."
530 GOSUB 580
540 PRINT "TIME IS UP. ************"
550 BEEP
560 BEEP
570 END
580 REM ================================================  DIALOG SUBRUTINE
590 GOSUB 230
600 REM ----- E IS THE END OF DISCUSSION TIME
610 LET E = C + D
620 GOSUB 230
630 PRINT "DISCUSSION TIME LEFT ";INT(E - C);" SECONDS."
640 GOSUB 670
650 IF C < E THEN 620
660 RETURN
670 REM ================================================  SELECT SUBRUTINE
680 GOSUB 1120
690 GOSUB 230
700 IF R=0 THEN 750
710 REM ----- R = RESPONSE, 1-9 = REQUEST, 0 = RELEASE
720 IF C < N THEN 680
730 REM ----- N = END OF TURN LIMIT
740 REM ----- U IS TIME USED
750 LET U(S9) = U(S9) + C - S
760 REM ----- S IS START TIME
770 REM ----- M IS THE MINIMUM ELAPSED TIME
780 LET M = 10 ^ 37
790 LET N = C
800 LET G1 = 0
810 LET L = S9
820 LET S9 = N2 + 1
830 FOR F = 1 TO N2
840     IF Q(F) = 0 THEN 910
850     IF U(F) > M THEN 910
860     LET G1 = 1
870     LET M = U(F)
880     LET N = C + T
890     LET S9 = F
900     LET X$ = N6$(S9)
910 NEXT F
920 IF G1 = 0 THEN GOTO 1070
930 PRINT "CURRENT SPEAKER IS ";X$
940 LET R = S9
950 LET S = C
960 IF L = S9 THEN GOTO 1060
970 IF P$ = "N" THEN 1010
980 IF P$ = "n" THEN 1010
990 LET Q(L) = 0
1000 REM ----- 920-950 IS ADEQUATE FOR PRODUCING BEEPS ON SOME MACHINES
1010 REM ----- LET S8 = -16336
1020 REM ----- FOR A = 1 TO 5
1030 REM ----- LET B = PEEK (S8) - PEEK (S8) + PEEK (S8) - PEEK (S8)
1040 REM ----- NEXT A
1050 BEEP
1060 RETURN
1070 PRINT "WAITING FOR A NEW SPEAKER"
1080 GOTO 950
1090 REM ================================================  DISPLAY SUBRUTINE
1100 PRINT W$
1110 RETURN
1120 REM ===============================================  COLLECT SUBRUTINE
1130 LET W$ = "ENTER REQUEST"
1140 LET L$ = INKEY$
1150 IF L$ = "" THEN 1260
1160 FOR I = 0 TO 9
1170     IF L$ = G$(I) THEN GOTO 1270
1180 NEXT I
1190 REM ----- SPEAKER INDICATES END
1200 IF R = 0 THEN 1230
1210 LET Q(R) = 1
1220 GOTO 1240
1230 LET Q(S9) = 0
1240 LET W$ = N6$(R)
1250 GOSUB 1090
1260 RETURN
1270 LET R = I
1280 GOTO 1190
1290 REM ================================================  CLEAR THE SCREEN SUB
1300 FOR I = 1 TO 24
1310     PRINT
1320 NEXT I
1330 RETURN
1340 REM ===============================================  INSTRUCTIONS
1350 PRINT "THIS PROGRAM MEDIATES DIALOG"
1360 PRINT "BY RESOLVING CONFLICTING REQUESTS"
1370 PRINT "TO SPEAK IN FAVOR OF THE PERSON"
1380 PRINT "WHO HAS THUS FAR SPOKEN THE LEAST."
1390 PRINT "ASSIGN EACH PERSON A CARD"
1400 PRINT "LETTERED A THROUGH Z."
1410 PRINT "ENTER THE LETTER WHEN THEY"
1420 PRINT "HOLD UP THE CARD."
1430 PRINT
1440 PRINT "                   PRESS RETURN FOR MORE."
1450 INPUT Z$
1460 GOSUB 1290
1470 PRINT " WHEN THE PERSON FINISHES "
1480 PRINT "ENTER A ZERO AND THE NAME"
1490 PRINT "OF THE NEXT SPEAKER WILL"
1500 PRINT "APPEAR."
1510 PRINT
1520 PRINT " THE PROGRAM WILL ASK FOR THE"
1530 PRINT "NUMBER OF SECONDS EACH TURN WILL "
1540 PRINT "BE LIMITED TO, THE TIME LIMIT"
1550 PRINT "FOR THE DISCUSSION IN MINUTES,"
1560 PRINT "AND THE NUMBER OF SPEAKERS."
1570 PRINT "AFTER THE NAMES HAVE BEEN"
1580 PRINT "ENTERED THE PROGRAM WILL START."
1590 PRINT "                   PRESS RETURN FOR MORE."
1600 INPUT Z$
1610 GOSUB 1290
1620 PRINT "WHEN THE TIME RUNS OUT"
1630 PRINT "THE PROGRAM TERMINATES!"
1640 PRINT
1650 PRINT "PRESS RETURN TO START"
1660 INPUT Z$
1670 RETURN
1680 DATA 0,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z
1690 REM ===============================================  VARIABLE NAMES
1700 REM   C     CURRENT TIME
1710 REM   D     DISCUSSION LIMIT
1720 REM   E     END OF DISCUSSION TIME
1730 REM   F     A COUNTER
1740 REM   G1    IF G1 = 0 THEN OUTPUT IS "WAITING FOR A NEW SPEAKER"
1750 REM         IF G1 = 1 THEN OUTPUT IS "CURRENT SPEAKER IS"...
1760 REM   I     A COUNTER
1770 REM   L     THE NUMBER OF THE PERSON WHO IS SPEAKING
1780 REM   L$    THE CHARACTER THAT IS RETURNED BY INKEY$
1790 REM   M     THE MINIMUM ELAPSED TIME
1800 REM   N     END OF TURN LIMIT (C + T)
1810 REM   N1    A COUNTER
1820 REM   N2    NUMBER OF PEOPLE
1830 REM   N6$   AN ARRAY WITH NAMES OF PERSONS IN THE DISCUSSION
1840 REM   P$    CAN BE "Y" OR "N". DETERMINES IF A PERSON WHO IS
1850 REM         INTERUPTED GETS THROWN OUT OF THE QUE
1860 REM   Q     REQUEST TO SPEAK. IN Q(N) IS A NUMBER THAT SIGNIFIES
1870 REM         IF PERSON N WANTS TO SPEAK (1) OR WANTS TO FINISH
1880 REM         SPEAKING (0).
1890 REM   R     RESPONSE (1-9 = REQUEST, 0 = RELEASE)
1900 REM   S     START TIME
1910 REM   S1    HAS TO DO WITH THE "CLOCK"
1920 REM   S7    HAS ALSO TO DO WITH THE "CLOCK"
1930 REM   S9    THE NUMBER OF THE PERSON WHO HAS THUS FAR SPOKEN THE
1940 REM         LEAST OF THE PERSON WHO WANTS TO SPEAK
1950 REM   T     TURN LIMIT
1960 REM   U     IN U(N) IS THE TIME PERSON N HAS USED
1970 REM   W$    TEXT THAT SHALL BE PRINTED ON THE SCREEN
1980 REM   X$    THE NAME OF THE CURRENT SPEAKER
1990 REM   Z$    INPUT OF RETURN
2000 REM ===============================================  SUBROUTINE LOCATIONS
2010 REM  580 - 660  DIALOG SUBROUTINE
2020 REM  670 - 1080 SELECT SUBROUTINE
2030 REM 1090 - 1110 DISPLAY SUBROUTINE
2040 REM 1120 - 1280 COLLECT SUBROUTINE
2050 REM 1290 - 1330 CLEAR THE SCREEN SUBROUTINE
2060 REM 1340 - 1680 INSTRUCTIONS
2070 REM 1690 - 1990 VARIABLE NAMES
2080 REM 2000 - 2080 SUBROUTINE LOCATIONS

Posted on Nov 11, 2011, 5:59 AM

Respond to this message   

Return to Index


thanks

by (no login)

Thanks for text. The save command doesn't work for me.

Posted on Nov 11, 2011, 11:33 AM

Respond to this message   

Return to Index


*yw.

by (Login MCalkins)
Moderator

Posted on Nov 11, 2011, 3:24 PM

Respond to this message   

Return to Index


* LOL

by (Login burger2227)
R

Posted on Nov 10, 2011, 5:12 PM

Respond to this message   

Return to Index


QB64 and older versions of QB

by (Login wulfit)

I haven't used QB for a few years and am more of a novice user. I have some .bas files saved, and I'd like to start using them again but they are under the an older version of QBasic from about 3 years ago - probably the last version. When I googled it, I got a whole lot of stuff about QB64, but I'm not sure how new this is and if my older files would work on it. I have Vista, so it may be ideal for me. Please excuse my lack of knowledge, but any advice would be appreciated. When I've managed to get QB working in the past it has been ideal, so I'd like to use it again. If my older files are not compatible with QB64, I can download hte older verison.

Posted on Nov 1, 2011, 3:37 AM

Respond to this message   

Return to Index


You're in luck...

by (Login qb432l)
R

QB64 will run all of your QBasic code -- and in Vista or W7, too. What's more, it has umpteen new commands, higher screen resolution and any bit-depth of color. You can play .WAV files, display .BMP or .JPG's, and memory is bottomless. It's also very fast.

Galleon, who wrote it, is part of our QBasic community, and I for one, am grateful to him for having created it.

Here's the URL for his site:

http://www.qb64.net/

You can also post questions here or in the QB64 Project forum. Just click Subforums and Chat Room at the top of the page -- it's the 7th one down.

-Bob

Posted on Nov 1, 2011, 9:15 AM

Respond to this message   

Return to Index


QB64 download

by (Login wulfit)

Thanks for that advice - was able to download it and have got it working. It will be a big learning curve but it's worth the effort

Posted on Nov 1, 2011, 11:21 AM

Respond to this message   

Return to Index


download 64 bit qbasic

by (no login)

download it

Posted on Dec 9, 2011, 5:55 AM

Respond to this message   

Return to Index


A further question

by (Login wulfit)

I also have the older version of QB installed, and I remember using DOSBOX to enlarge the QB window a little in Vista. The advice to use QB with DOSBOX is to enter a command which reads something like C MOUNT in the DOSBOX window, but it's not working. I have DOSBOX and the older version of QB installed - can you advise exactly what I need to do to get them working together? I can't remember what I did last time.

Posted on Nov 1, 2011, 12:16 PM

Respond to this message   

Return to Index


Re: A further question

by (Login MCalkins)
Moderator

Welcome to the forum, Mike.

In DOSBox you can type "help" for help. For help on the Mount command, you can type "mount /?".

The syntax of the mount command is:

mount d path

where d is the drive letter you want to use, and path is the actual path of the folder you want to mount. So, for example, my qbasic folder on my computer is c:\q. If I wanted to mount c:\q as drive x: within DOSBox, I would type:

mount x c:\q

Then I could type:

x:

to switch to the newly created x: drive.

I think the main advantage of actual QBASIC over QB64 is that QBASIC is an interpreter, and therefore makes debugging much easier. But otherwise, QB64 works very well.

Regards,
Michael

Posted on Nov 1, 2011, 12:42 PM

Respond to this message   

Return to Index


qbasic and dosbox

by (Login wulfit)

Thanks Michael, your advice is much appreciated. I chose the letter Q to mount and it worked for me. I ended up with a statement "Drive Q is mounted as local directory c:\users\wulfit\qbasic\" where qbasic is the folder containing all my qbasic files. While the DOSBOX window was still open, I entered "q:" and it opened the q drive on DOSBOX.

What is the next step to actually open any of the .bas files in the qbasic folder in the expanded window? Sorry if this seems a bit "basic", but I'm not an expert in this area and I simply don't know.

Posted on Nov 3, 2011, 7:19 AM

Respond to this message   

Return to Index


From that point on, it's business as usual...

by (Login qb432l)
R

Enter QBASIC for QBasic 1.1, or QB for QuickBASIC 4.5 and you'll see the opening screen.

You can also go directly to a specific file, such as:

Q:\>QBASIC Myfile

...in which case QBasic will open with your designated file displayed (upper/lower case are optional, of course).

-Bob

Posted on Nov 3, 2011, 8:35 AM

Respond to this message   

Return to Index


qb45 program w/ 5 modules

by (no login)

If 64 doesn't use the *.mak file to combine modules

with the main module, how is this done in 64?

If you copy them into the main module, shouldn't

you remove some beginning info from each module

Posted on Oct 31, 2011, 8:21 PM

Respond to this message   

Return to Index


QB64 can use $INCLUDE text files with basic code

by (Login burger2227)
R

You can combine all 5 basic code modules into one BAS file as QB64 has no size or memory limitations.

You can INCLUDE CONST, DIM, COMMON, SHARED and DATA statements at the beginning of the main program.

SUBs and FUNCTIONs would be included at the bottom of the main module after all sub-procedures in the main.

If QB64 does not find the text files it should let you know.

QB64 can also work with DLL Libraries using DECLARE LIBRARY

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

Posted on Oct 31, 2011, 9:03 PM

Respond to this message   

Return to Index


Tips for optimizing my screen 12 BMP loader

by Pharoah (no login)

This program* loads 24 color bitmaps into screen 12 using error diffusion dithering. Specifically, it uses the "filter lite" algorithm which is optimized for bit shifts (too bad QBasic doesn't support them). At any rate, I find that this runs painfully slow in dosbox**, and I'd like to make it faster if I can. Does anyone have any ideas? I've tried using a 512 entry LUT to perform the initial color quantization, but the results were awful.

DEFINT A-Z

TYPE bmpFileHeader
&nbsp;&nbsp;&nbsp;&nbsp;magic AS STRING * 2
&nbsp;&nbsp;&nbsp;&nbsp;size AS LONG
&nbsp;&nbsp;&nbsp;&nbsp;zeros AS LONG
&nbsp;&nbsp;&nbsp;&nbsp;offset AS LONG
END TYPE

TYPE bmpInfoHeader
&nbsp;&nbsp;&nbsp;&nbsp;headerSize AS LONG
&nbsp;&nbsp;&nbsp;&nbsp;w AS LONG
&nbsp;&nbsp;&nbsp;&nbsp;h AS LONG
&nbsp;&nbsp;&nbsp;&nbsp;planes AS INTEGER
&nbsp;&nbsp;&nbsp;&nbsp;bpp AS INTEGER '1, 4, 8, or 24
&nbsp;&nbsp;&nbsp;&nbsp;compression AS LONG
&nbsp;&nbsp;&nbsp;&nbsp;imageSize AS LONG
&nbsp;&nbsp;&nbsp;&nbsp;ppmx AS LONG
&nbsp;&nbsp;&nbsp;&nbsp;ppmy AS LONG
&nbsp;&nbsp;&nbsp;&nbsp;colors AS LONG
&nbsp;&nbsp;&nbsp;&nbsp;importantColors AS LONG
END TYPE

TYPE rgbColor
&nbsp;&nbsp;&nbsp;&nbsp;b AS STRING * 1
&nbsp;&nbsp;&nbsp;&nbsp;g AS STRING * 1
&nbsp;&nbsp;&nbsp;&nbsp;r AS STRING * 1
END TYPE

TYPE intColor
&nbsp;&nbsp;&nbsp;&nbsp;r AS INTEGER
&nbsp;&nbsp;&nbsp;&nbsp;g AS INTEGER
&nbsp;&nbsp;&nbsp;&nbsp;b AS INTEGER
END TYPE

'=== CONSTANTS
file$ = "test2.bmp"

'=== MAIN
SCREEN 12
DIM fileHeader AS bmpFileHeader
DIM infoHeader AS bmpInfoHeader
DIM rawPixel AS rgbColor
DIM intPixel AS intColor
DIM errors AS intColor
DIM blank AS intColor
DIM bestErrors AS intColor
blank.r = 0
blank.g = 0
blank.b = 0

'Build lookup table
DIM lookup(0 TO 15) AS intColor
FOR i = 0 TO 15
&nbsp;&nbsp;&nbsp;&nbsp;READ lookup(i).r, lookup(i).g, lookup(i).b
NEXT i

'Read the image data and display it
OPEN file$ FOR BINARY AS #1
GET #1, , fileHeader
GET #1, , infoHeader
IF infoHeader.bpp &lt;&gt; 24 THEN
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PRINT "Can only read true color bitmaps."
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PRINT "BPP = " + STR$(infoHeader.bpp)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;END
ELSEIF infoHeader.compression &lt;&gt; 0 THEN
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PRINT "Can't read compressed bitmaps."
END IF


DIM quantErrors(-1 TO 0, 0 TO infoHeader.w - 1) AS intColor
qeLine = 0

' Move to the actual image data
SEEK #1, fileHeader.offset + 1


endSkip = (infoHeader.w * 3) MOD 4 ' This meets an alignment requirement
DIM dummy AS STRING * 1
FOR y = infoHeader.h - 1 TO 0 STEP -1
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;FOR x = 0 TO infoHeader.w - 1
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;GET #1, , rawPixel

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;' Add the pixel value to the diffused error
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;intPixel.r = ASC(rawPixel.r) + quantErrors(qeLine, x).r
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;IF intPixel.r &lt; 0 THEN intPixel.r = 0 ELSE IF intPixel.r &gt; 255 THEN intPixel.r = 255
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;intPixel.g = ASC(rawPixel.g) + quantErrors(qeLine, x).g
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;IF intPixel.g &lt; 0 THEN intPixel.g = 0 ELSE IF intPixel.g &gt; 255 THEN intPixel.g = 255
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;intPixel.b = ASC(rawPixel.b) + quantErrors(qeLine, x).b
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;IF intPixel.b &lt; 0 THEN intPixel.b = 0 ELSE IF intPixel.b &gt; 255 THEN intPixel.b = 255
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;quantErrors(qeLine, x) = blank

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;' Find the best match
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;best = 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;DIM e AS LONG
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;e = 100000000
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;FOR i = 0 TO 15
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;errors.r = intPixel.r - lookup(i).r
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;errors.g = intPixel.g - lookup(i).g
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;errors.b = intPixel.b - lookup(i).b
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ee = ABS(errors.r) + ABS(errors.g) + ABS(errors.b)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;IF ee &lt; e THEN
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;e = ee
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;best = i
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;bestErrors = errors
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;END IF
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;NEXT i

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;' Diffuse the error to neighboring pixels in this pattern:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'&nbsp;&nbsp;&nbsp;&nbsp; X .5
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'.25 .25
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;bestErrors.r = bestErrors.r \ 4
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;bestErrors.g = bestErrors.g \ 4
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;bestErrors.b = bestErrors.b \ 4

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;quantErrors(NOT qeLine, x).r = quantErrors(NOT qeLine, x).r + bestErrors.r
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;quantErrors(NOT qeLine, x).g = quantErrors(NOT qeLine, x).g + bestErrors.g
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;quantErrors(NOT qeLine, x).b = quantErrors(NOT qeLine, x).b + bestErrors.b
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;IF x &gt; 0 THEN
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;quantErrors(NOT qeLine, x - 1).r = quantErrors(NOT qeLine, x - 1).r + bestErrors.r
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;quantErrors(NOT qeLine, x - 1).g = quantErrors(NOT qeLine, x - 1).g + bestErrors.g
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;quantErrors(NOT qeLine, x - 1).b = quantErrors(NOT qeLine, x - 1).b + bestErrors.b
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;END IF

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;IF x &lt; infoHeader.w - 1 THEN
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;quantErrors(qeLine, x + 1).r = quantErrors(qeLine, x + 1).r + bestErrors.r + bestErrors.r
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;quantErrors(qeLine, x + 1).g = quantErrors(qeLine, x + 1).g + bestErrors.g + bestErrors.g
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;quantErrors(qeLine, x + 1).b = quantErrors(qeLine, x + 1).b + bestErrors.b + bestErrors.b
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;END IF
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PSET (x, y), best
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;NEXT x
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;qeLine = NOT qeLine
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;FOR i = 1 TO endSkip
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;GET #1, , dummy
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;NEXT i
NEXT y

DATA 0,&nbsp;&nbsp;&nbsp;&nbsp;0,&nbsp;&nbsp;&nbsp;&nbsp;0
DATA 0,&nbsp;&nbsp;&nbsp;&nbsp;0, 170
DATA 0, 170,&nbsp;&nbsp;&nbsp;&nbsp;0
DATA 0, 170, 170
DATA 170,&nbsp;&nbsp;&nbsp;&nbsp;0,&nbsp;&nbsp;&nbsp;&nbsp;0
DATA 170,&nbsp;&nbsp;&nbsp;&nbsp;0, 170
DATA 170, 85,&nbsp;&nbsp;&nbsp;&nbsp;0
DATA 170, 170, 170
DATA 85, 85, 85
DATA 85, 85, 255
DATA 85, 255, 85
DATA 85, 255, 255
DATA 255, 85, 85
DATA 255, 85, 255
DATA 255, 255, 85
DATA 255, 255, 255



* In case someone finds this code useful later, I'm releasing it into the public domain.

*&#42; Yes, I know I could be using NTVDM or dosemu or qb64, but that's not the point.

Posted on Oct 26, 2011, 8:16 AM

Respond to this message   

Return to Index


Can somebody fix that?

by Pharoah (no login)

The "preview" function lied to me! Here's the code:

DEFINT A-Z

TYPE bmpFileHeader
    magic AS STRING * 2
    size AS LONG
    zeros AS LONG
    offset AS LONG
END TYPE

TYPE bmpInfoHeader
    headerSize AS LONG
    w AS LONG
    h AS LONG
    planes AS INTEGER
    bpp AS INTEGER  '1, 4, 8, or 24
    compression AS LONG
    imageSize AS LONG
    ppmx AS LONG
    ppmy AS LONG
    colors AS LONG
    importantColors AS LONG
END TYPE

TYPE rgbColor
    b AS STRING * 1
    g AS STRING * 1
    r AS STRING * 1
END TYPE

TYPE intColor
    r AS INTEGER
    g AS INTEGER
    b AS INTEGER
END TYPE

'=== CONSTANTS
file$ = "test2.bmp"

'=== MAIN
SCREEN 12
DIM fileHeader AS bmpFileHeader
DIM infoHeader AS bmpInfoHeader
DIM rawPixel AS rgbColor
DIM intPixel AS intColor
DIM errors AS intColor
DIM blank AS intColor
DIM bestErrors AS intColor
blank.r = 0
blank.g = 0
blank.b = 0

'Build lookup table
DIM lookup(0 TO 15) AS intColor
FOR i = 0 TO 15
    READ lookup(i).r, lookup(i).g, lookup(i).b
NEXT i

'Read the image data and display it
OPEN file$ FOR BINARY AS #1
GET #1, , fileHeader
GET #1, , infoHeader
IF infoHeader.bpp <> 24 THEN
        PRINT "Can only read true color bitmaps."
        PRINT "BPP = " + STR$(infoHeader.bpp)
        END
ELSEIF infoHeader.compression <> 0 THEN
        PRINT "Can't read compressed bitmaps."
END IF


DIM quantErrors(-1 TO 0, 0 TO infoHeader.w - 1) AS intColor
qeLine = 0

' Move to the actual image data
SEEK #1, fileHeader.offset + 1


endSkip = (infoHeader.w * 3) MOD 4  ' This meets an alignment requirement
DIM dummy AS STRING * 1
FOR y = infoHeader.h - 1 TO 0 STEP -1
        FOR x = 0 TO infoHeader.w - 1
                GET #1, , rawPixel

                ' Add the pixel value to the diffused error
                intPixel.r = ASC(rawPixel.r) + quantErrors(qeLine, x).r
                IF intPixel.r < 0 THEN intPixel.r = 0 ELSE IF intPixel.r > 255 THEN intPixel.r = 255
                intPixel.g = ASC(rawPixel.g) + quantErrors(qeLine, x).g
                IF intPixel.g < 0 THEN intPixel.g = 0 ELSE IF intPixel.g > 255 THEN intPixel.g = 255
                intPixel.b = ASC(rawPixel.b) + quantErrors(qeLine, x).b
                IF intPixel.b < 0 THEN intPixel.b = 0 ELSE IF intPixel.b > 255 THEN intPixel.b = 255
                quantErrors(qeLine, x) = blank

                ' Find the best match
                best = 0
                DIM e AS LONG
                e = 100000000
                FOR i = 0 TO 15
                    errors.r = intPixel.r - lookup(i).r
                    errors.g = intPixel.g - lookup(i).g
                    errors.b = intPixel.b - lookup(i).b
                    ee = ABS(errors.r) + ABS(errors.g) + ABS(errors.b)
                    IF ee < e THEN
                            e = ee
                            best = i
                            bestErrors = errors
                    END IF
                NEXT i

                ' Diffuse the error to neighboring pixels in this pattern:
                '     X  .5
                '.25 .25
                bestErrors.r = bestErrors.r \ 4
                bestErrors.g = bestErrors.g \ 4
                bestErrors.b = bestErrors.b \ 4

                quantErrors(NOT qeLine, x).r = quantErrors(NOT qeLine, x).r + bestErrors.r
                quantErrors(NOT qeLine, x).g = quantErrors(NOT qeLine, x).g + bestErrors.g
                quantErrors(NOT qeLine, x).b = quantErrors(NOT qeLine, x).b + bestErrors.b
                IF x > 0 THEN
                        quantErrors(NOT qeLine, x - 1).r = quantErrors(NOT qeLine, x - 1).r + bestErrors.r
                        quantErrors(NOT qeLine, x - 1).g = quantErrors(NOT qeLine, x - 1).g + bestErrors.g
                        quantErrors(NOT qeLine, x - 1).b = quantErrors(NOT qeLine, x - 1).b + bestErrors.b
                END IF

                IF x < infoHeader.w - 1 THEN
                        quantErrors(qeLine, x + 1).r = quantErrors(qeLine, x + 1).r + bestErrors.r + bestErrors.r
                        quantErrors(qeLine, x + 1).g = quantErrors(qeLine, x + 1).g + bestErrors.g + bestErrors.g
                        quantErrors(qeLine, x + 1).b = quantErrors(qeLine, x + 1).b + bestErrors.b + bestErrors.b
                END IF
        
                PSET (x, y), best
        NEXT x
        qeLine = NOT qeLine
        
        FOR i = 1 TO endSkip
                GET #1, , dummy
        NEXT i
NEXT y

DATA  0,    0,    0
DATA  0,    0,  170
DATA  0,  170,    0
DATA  0,  170,  170
DATA  170,    0,    0
DATA  170,    0,  170
DATA  170,   85,    0
DATA  170,  170,  170
DATA   85,   85,   85
DATA   85,   85,  255
DATA   85,  255,   85
DATA   85,  255,  255
DATA  255,   85,   85
DATA  255,   85,  255
DATA  255,  255,   85
DATA  255,  255,  255

Posted on Oct 26, 2011, 8:17 AM

Respond to this message   

Return to Index


nbsp is

by Clippy (no login)

CHR$(255) or ALT + 255 like this:

   hello

Posted on Oct 26, 2011, 10:52 AM

Respond to this message   

Return to Index


Re: Can somebody fix that?

by (Login MCalkins)
Moderator

I ran the program in your second post through this:


'public domain, michael calkins
DIM i AS LONG
DIM b AS STRING * 1
DIM t AS STRING
LINE INPUT t
IF t = "" THEN t = "delme.bas"
OPEN t FOR INPUT AS 1
CLOSE
OPEN t FOR BINARY AS 1
OPEN "---tmp.txt" FOR OUTPUT AS 2
CLOSE 2
OPEN "---tmp.txt" FOR BINARY AS 2
FOR i = 1 TO LOF(1)
GET 1, , b
IF ASC(b) = &H20 THEN b = CHR$(&HA0)
PUT 2, , b
NEXT i
CLOSE
SHELL "notepad ---tmp.txt"
SYSTEM


Regards,
Michael

Posted on Oct 26, 2011, 12:31 PM

Respond to this message   

Return to Index


* CHR$(255) works too...

by (Login burger2227)
R

Posted on Oct 26, 2011, 1:09 PM

Respond to this message   

Return to Index


It depends on code page translation.

by (Login MCalkins)
Moderator

I use CHR$(&ha0) because I am opening the file in Notepad, which will open it as Windows-1252. If you were to copy the text directly out of the console window, then you could use CHR$(&hff), because Windows would translate it from CP437 for you. If you change &ha0 to &hff in my program, then Notepad will show a bunch of "ÿ"s.

Regards,
Michael

Posted on Oct 26, 2011, 1:37 PM

Respond to this message   

Return to Index


That's better than...

by (Login burger2227)
R

...better than á ?


wink.gif


DEFINT A-Z

TYPE bmpFileHeader
ÿÿÿÿmagic AS STRING * 2
ÿÿÿÿsize AS LONG
ÿÿÿÿzeros AS LONG
ÿÿÿÿoffset AS LONG
END TYPE

TYPE bmpInfoHeader
ÿÿÿÿheaderSize AS LONG
ÿÿÿÿw AS LONG
ÿÿÿÿh AS LONG
ÿÿÿÿplanes AS INTEGER
ÿÿÿÿbpp AS INTEGER '1, 4, 8, or 24
ÿÿÿÿcompression AS LONG
ÿÿÿÿimageSize AS LONG
ÿÿÿÿppmx AS LONG
ÿÿÿÿppmy AS LONG
ÿÿÿÿcolors AS LONG
ÿÿÿÿimportantColors AS LONG
END TYPE

TYPE rgbColor
ÿÿÿÿb AS STRING * 1
ÿÿÿÿg AS STRING * 1
ÿÿÿÿr AS STRING * 1
END TYPE

TYPE intColor
ÿÿÿÿr AS INTEGER
ÿÿÿÿg AS INTEGER
ÿÿÿÿb AS INTEGER
END TYPE

'=== CONSTANTS
file$ = "test2.bmp"

'=== MAIN
SCREEN 12
DIM fileHeader AS bmpFileHeader
DIM infoHeader AS bmpInfoHeader
DIM rawPixel AS rgbColor
DIM intPixel AS intColor
DIM errors AS intColor
DIM blank AS intColor
DIM bestErrors AS intColor
blank.r = 0
blank.g = 0
blank.b = 0

'Build lookup table
DIM lookup(0 TO 15) AS intColor
FOR i = 0 TO 15
ÿÿÿÿREAD lookup(i).r, lookup(i).g, lookup(i).b
NEXT i

'Read the image data and display it
OPEN file$ FOR BINARY AS #1
GET #1, , fileHeader
GET #1, , infoHeader
IF infoHeader.bpp 24 THEN
ÿÿÿÿÿÿÿÿPRINT "Can only read true color bitmaps."
ÿÿÿÿÿÿÿÿPRINT "BPP = " + STR$(infoHeader.bpp)
ÿÿÿÿÿÿÿÿEND
ELSEIF infoHeader.compression 0 THEN
ÿÿÿÿÿÿÿÿPRINT "Can't read compressed bitmaps."
END IF


DIM quantErrors(-1 TO 0, 0 TO infoHeader.w - 1) AS intColor
qeLine = 0

' Move to the actual image data
SEEK #1, fileHeader.offset + 1


endSkip = (infoHeader.w * 3) MOD 4 ' This meets an alignment requirement
DIM dummy AS STRING * 1
FOR y = infoHeader.h - 1 TO 0 STEP -1
ÿÿÿÿÿÿÿÿFOR x = 0 TO infoHeader.w - 1
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿGET #1, , rawPixel

ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ' Add the pixel value to the diffused error
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿintPixel.r = ASC(rawPixel.r) + quantErrors(qeLine, x).r
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿIF intPixel.r 255 THEN intPixel.r = 255
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿintPixel.g = ASC(rawPixel.g) + quantErrors(qeLine, x).g
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿIF intPixel.g 255 THEN intPixel.g = 255
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿintPixel.b = ASC(rawPixel.b) + quantErrors(qeLine, x).b
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿIF intPixel.b 255 THEN intPixel.b = 255
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿquantErrors(qeLine, x) = blank

ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ' Find the best match
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿbest = 0
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿDIM e AS LONG
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿe = 100000000
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿFOR i = 0 TO 15
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿerrors.r = intPixel.r - lookup(i).r
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿerrors.g = intPixel.g - lookup(i).g
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿerrors.b = intPixel.b - lookup(i).b
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿee = ABS(errors.r) + ABS(errors.g) + ABS(errors.b)
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿIF ee
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿe = ee
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿbest = i
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿbestErrors = errors
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿEND IF
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿNEXT i

ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ' Diffuse the error to neighboring pixels in this pattern:
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ X .5
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ'.25 .25
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿbestErrors.r = bestErrors.r \ 4
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿbestErrors.g = bestErrors.g \ 4
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿbestErrors.b = bestErrors.b \ 4

ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿquantErrors(NOT qeLine, x).r = quantErrors(NOT qeLine, x).r + bestErrors.r
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿquantErrors(NOT qeLine, x).g = quantErrors(NOT qeLine, x).g + bestErrors.g
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿquantErrors(NOT qeLine, x).b = quantErrors(NOT qeLine, x).b + bestErrors.b
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿIF x > 0 THEN
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿquantErrors(NOT qeLine, x - 1).r = quantErrors(NOT qeLine, x - 1).r + bestErrors.r
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿquantErrors(NOT qeLine, x - 1).g = quantErrors(NOT qeLine, x - 1).g + bestErrors.g
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿquantErrors(NOT qeLine, x - 1).b = quantErrors(NOT qeLine, x - 1).b + bestErrors.b
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿEND IF

ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿIF x
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿquantErrors(qeLine, x + 1).r = quantErrors(qeLine, x + 1).r + bestErrors.r + bestErrors.r
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿquantErrors(qeLine, x + 1).g = quantErrors(qeLine, x + 1).g + bestErrors.g + bestErrors.g
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿquantErrors(qeLine, x + 1).b = quantErrors(qeLine, x + 1).b + bestErrors.b + bestErrors.b
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿEND IF
ÿÿÿÿÿÿÿÿ
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿPSET (x, y), best
ÿÿÿÿÿÿÿÿNEXT x
ÿÿÿÿÿÿÿÿqeLine = NOT qeLine
ÿÿÿÿÿÿÿÿ
ÿÿÿÿÿÿÿÿFOR i = 1 TO endSkip
ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿGET #1, , dummy
ÿÿÿÿÿÿÿÿNEXT i
NEXT y

DATA 0,0,0
DATA 0,0, 170
DATA 0, 170,0
DATA 0, 170, 170
DATA 170,0,0
DATA 170,0, 170
DATA 170, 85,0
DATA 170, 170, 170
DATA 85, 85, 85
DATA 85, 85, 255
DATA 85, 255, 85
DATA 85, 255, 255
DATA 255, 85, 85
DATA 255, 85, 255
DATA 255, 255, 85
DATA 255, 255, 255

But this prints it out fine in QB64:

OPEN "TestNBSP.txt" FOR INPUT AS #1
OPEN "NBSPCHR$.txt" FOR OUTPUT AS #2
DO WHILE NOT EOF(1)
LINE INPUT #1, text$
add$ = ""
DO
posit = INSTR(1, text$, "nbsp;")
IF posit THEN
add$ = add$ + CHR$(255)
text$ = MID$(text$, posit + 5)
END IF
LOOP UNTIL posit = 0
PRINT #2, add$ + text$
LOOP
CLOSE
OPEN "NBSPCHR$.txt" FOR INPUT AS #1
DO WHILE NOT EOF(1): _LIMIT 2
LINE INPUT #1, text$
PRINT text$
LOOP

Don't use this code as it will only work with "nbsp;"


Ted

Posted on Oct 26, 2011, 2:11 PM

Respond to this message   

Return to Index


I'd originally done a similar thing...

by Pharoah (no login)

...and replaced the spaces with literal non-breaking spaces, but that looked wrong when I clicked Preview, so I resorted to the HTML tag instead (which looked right in preview!).

Posted on Oct 26, 2011, 4:04 PM

Respond to this message   

Return to Index


*Nice job, Pharoah! Of course, writing it must have been less work than posting it (lol)!

by (Login qb432l)
R

*

Posted on Oct 26, 2011, 5:26 PM

Respond to this message   

Return to Index


* Great job Pharoah! I hear ya Bob...:-)

by (Login burger2227)
R

Posted on Oct 26, 2011, 7:52 PM

Respond to this message   

Return to Index


Two Qbasic Programmes

by (Login aleatorylamp)

Hello!
I´m a newbe to the forum, and as I rather enjoy Qbasic, I have written two programmes. One is a cell-survival "game" called AMOEBAS where you can manipulate different parameters like cells movement and food availability, to examine how it affects cell survival:

http://www.fileswap.com/dl/3VMr1cBAkK/AMOEBAS.BAS.html

Also, there is a small text-adventure RPG with an ascii-symbol map called SHIPREKT.BAS, about a shipwrecked sailor who needs help to repair his damaged ship:

http://www.fileswap.com/dl/bJpXr2nou1/SHIPREKT.BAS.html

Instructions to both games are in REM lines at the beginning of the game listings.

Cheers and enjoy!

Posted on Oct 25, 2011, 1:47 PM

Respond to this message   

Return to Index


Welcome to the forum.

by (Login MCalkins)
Moderator

You can also post programs here:

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

although you would need to replace spaces with NBSP characters, CHR$(&ha0). Otherwise, Network54 removes all leading spaces, and compresses all multliple spaces into one.

That subforum doesn't have it, but some of the others have a check box that says "Enable formatted text". That needs to be unchecked to post code, otherwise, Network54 interprets < as the start of an HTML tag.

Regards,
Michael

Posted on Oct 25, 2011, 6:54 PM

Respond to this message   

Return to Index


*CHR$(&HA0)?

by george (no login)

Posted on Oct 25, 2011, 8:31 PM

Respond to this message   

Return to Index


scroll?

by (no login)

I just d'loaded a copy of QB64. I started writing my program and the thing would not scroll past the bottom of the first page. I can't continue writing. How ddo I tell it how to continue scrolling??? Thanks, Len

Posted on Oct 20, 2011, 8:34 AM

Respond to this message   

Return to Index


It will scroll when you type on the bottom line and hit enter.

by (Login burger2227)
R

Type ? and hold down the enter key until PRINT scolls up. It actually scrolls BETTER than Qbasic did.

Posted on Oct 20, 2011, 8:48 AM

Respond to this message   

Return to Index


Added Docfxit and Loudhvx to the "R" Group.

by Pete (Login The-Universe)
Admin

Your pirate eye patch will arrive in 6-8 weeks. It's not quite as stylish as the Windows XP patches were, but it will still make you pretty popular with the ladies... well, OK, just the ugly ladies, but hey, if that bothers you, just cover the other eye, matey.

OK, what it really does is to allow you to edit your posts and code, provided you are signed in to your N54 account. You should see an "Edit Post" button/link when you go back to any of your new posts starting now.

Just be sure you "uncheck" the Enable formatted text box if you are posting code. If you don't, some code will get posted incorrectly. Mostly this has to do with the "<>" signs, if I recall correctly. I think it removes them if the box is checked.

Welcome aboard,

Pete

- Network54 forums: You have to be smart as a whip to use one, but dumb as a stump to own one.

Posted on Oct 17, 2011, 7:42 PM

Respond to this message   

Return to Index


* Awesome, thanks!

by (no login)

Posted on Oct 17, 2011, 10:28 PM

Respond to this message   

Return to Index


RE: Network54: You have to be smart as a whip to use one, but dumb as a stump to own one

by Galleon (no login)

ROFL.0E+37

Posted on Oct 18, 2011, 11:51 AM

Respond to this message   

Return to Index


Smoke

by lawgin (no login)

It resembles smoke from a cigarette wafting through the air.


CLS
SCREEN 9
COLOR , 7
DO
xn = (SIN(xo) - COS(yo)) ^ 2
yn = LOG(ABS(xo - yo + 1))
yo = yn
xo = xn
PSET (INT(200 * xn) + 100, 100 - INT(30 * yn)), 8
LOOP UNTIL INKEY$ <> ""
SYSTEM

Posted on Oct 14, 2011, 11:12 AM

Respond to this message   

Return to Index


I don't know about that...

by (Login burger2227)
R

It resembles a program that doesn't Ctrl-break and I have to minimize using the Windows key and then force closed. In QB4.5 that is. Didn't do much in QB64 either but it exited with key press.


sad.gif



Posted on Oct 14, 2011, 12:29 PM

Respond to this message   

Return to Index


*Looks pretty with qb64, and I'm not smoking anything

by lawgin (no login)

Posted on Oct 14, 2011, 1:22 PM

Respond to this message   

Return to Index


A FROZEN RIFT OF SMOKE? GET REAL BOGART!

by (Login burger2227)
R

[linked image]

Posted on Oct 14, 2011, 7:34 PM

Respond to this message   

Return to Index


* That was not very nice, nor was it necessary.

by (Login MCalkins)
Moderator

Posted on Oct 15, 2011, 7:51 AM

Respond to this message   

Return to Index


Well I call them how I see them Michael and it didn't work

by (Login burger2227)
R

It froze full screen so I had to hit the Windows key to minimize it and close it forcefully. I can't figure out why, but it did. No kind key press would end it.

Posted on Oct 15, 2011, 9:23 AM

Respond to this message   

Return to Index


*look at that smiley

by george (no login)

*******

Posted on Oct 15, 2011, 5:10 PM

Respond to this message   

Return to Index


good ****

by george (no login)

SCREEN 12
DO
j = j - 1

LINE (0, 0)-(639, 479), 0, BF
FOR i = 0 TO 480
a = i * .1 * SIN(i * .05 + j) + 320
b = i * .1 * COS(i * .05 + j) + 320
c = ABS(a - b)
PSET (a + (RND * c) + f(i), 480 - i), 8
PSET (b + (RND * c) + f(i), 480 - i), 7
PSET (a + (RND * c) + f(i), 480 - i), 8
PSET (b + (RND * c) + f(i), 480 - i), 7
NEXT
_DISPLAY
_LIMIT 10
LOOP

FUNCTION f (i)
f = RND * i / 10 - (i / 10)
END FUNCTION

Posted on Oct 14, 2011, 8:37 PM

Respond to this message   

Return to Index


* GOOD one GEO! Beats the heck out of the frozen screen!

by (Login burger2227)
R

Posted on Oct 14, 2011, 8:51 PM

Respond to this message   

Return to Index


George

by (Login MCalkins)
Moderator

that's too much vulgarity.

See the post:
http://www.network54.com/Forum/171757/message/1067226652/

In that post, Mac said:

"Well, like all forums, there is standard "netiquette" such as DO NOT USE ALL CAPS (that's shouting), avoid vulgar language, etc."

Also, when Pete made me a moderator, he said:

"Use your good judgment, mostly I like to follow Mac's example and keep vulgarity, spam, and inappropriate posts, like the ones that make absolutely no sense, off the forum."

I tend to be a bit lenient when it comes to nonsensical posts. I tend to leave them unless they are overt spam.

With regard to vulgarity, try to avoid it please, George. I don't think we have an absolute rule against it, but try to avoid it, please. I will edit it out at my discretion. The other moderators edit at their discretion.

There was an obscene, nonsensical post by someone named "goerge" a few days ago, many pages back on the forum. I only saw it because it showed up in the index. I assume that was also you.

Regards,
Michael

Posted on Oct 15, 2011, 7:45 AM

Respond to this message   

Return to Index


Nice try Michael

by lawgin (no login)

It's been my experience that attempting to reform the ill-mannered in such an impersonal setting as an internet forum is usually an exercise in futility. Those lacking communication skills often feel compelled to resort to cheap shots and vulgarity.

Posted on Oct 15, 2011, 10:35 AM

Respond to this message   

Return to Index


FAILURE to respond to LEGITIMATE problems with a program can cause that!

by (Login burger2227)
R

Why is the program FREEZING when I run it?

ARE YOU CALLING ME A LIAR? I SURE HOPE NOT! Because THAT would DESERVE the responses you got!

BESIDES! George's worked BETTER and looked more realistic WITHOUT the errors!

Posted on Oct 15, 2011, 10:46 AM

Respond to this message   

Return to Index


*Thank you for proving my point

by lawgin (no login)

Posted on Oct 15, 2011, 11:59 AM

Respond to this message   

Return to Index


NO PROBLEM! I know how you are! You hate criticism...:-)

by (Login burger2227)
R

EVEN when I am right!

But the program STILL FREEZES in QB4.5 so I won't be using it any time soon!

Posted on Oct 15, 2011, 12:14 PM

Respond to this message   

Return to Index


for the record.

by (Login MCalkins)
Moderator

I have tried Lawgin's program in QBASIC 1.1, QB 4.5 interpreted, QB 4.5 compiled, and QB64. In all of them, pressing a key recognizable by INKEY$ results in normal termination.

On the other hand, George's program contains an infinite loop.

Regards,
Michael

Posted on Oct 15, 2011, 12:31 PM

Respond to this message   

Return to Index


I dunno, I just know that it freezes on mine

by (Login burger2227)
R

Ctrl + Break won't even work. I can't see why though. It works OK in QB64 but the smoke doesn't seem to do much of anything. All I get is a stationary image in both.

At least I can use Ctrl + Break on George's! That's an easy fix.

Posted on Oct 15, 2011, 12:49 PM

Respond to this message   

Return to Index


Re: Nice try Michael

by (Login MCalkins)
Moderator

Due to human nature, a certain amount of mutual toleration is necessary. I think that it is to be expected that anytime that you have a group of people, that not everyone will always agree. Occasional personality conflicts are to be expected also.

However, to the extent possible, I think that we should try to have mutual respect. What Jesus said at Matthew 7:12 applies as much on the Internet as it does face to face:

"“All things, therefore, that YOU want men to do to YOU, YOU also must likewise do to them; this, in fact, is what the Law and the Prophets mean."

(In the New World Translation, a pronoun in all caps indicates that the pronoun is plural.)

This forum does have a few rules. There aren't very many, they tend to not be absolute, and they aren't consistently enforced. But there are rules. Excessive usage of vulgarity or excessive usage of all caps in the form of shouting are against the rules.

Clippy has been a member of this forum for almost as long as I have. (Considering my several periods of inactivity, he has been active longer). He has been a very active member, and has made countless valuable contributions. I appreciate the fact that his knowledge, experience, and skill are enriching this forum. Unless I am much mistaken, both he and you are far older than me, and therefore, I believe that you are both worthy of extra consideration. I do not want to discourage either of you from participating positively in this forum, or make either of you feel unwelcome. I would prefer that noone here makes anyone else here feel unwelcome.

There was a time a few years ago when I felt that Clippy was a very negative influence on this forum. I even felt that the forum would be better off without him, because I thought his abrasiveness was driving away regulars and newbies alike. I have since changed my mind. He is still abrasive, but that can be tolerated with patience. As I just indicated, he is a valuable member. As long as new members can adjust to him, I think everything will be okay.

I have gotten used to Clippy using all caps and exclamation points. I know it is against the rules, and I'm pretty sure that he does too. But I don't think he's going to stop anytime soon. Toleration is necessary.

What am I supposed to do? For example, in this thread, he is clearly abusing you, and breaking the rules in the process. Am I supposed to delete his posts? I really don't want to do that, but I probably should. I fear that doing so would anger him further and/or make him feel unwelcome. Deleting posts keeps the forum clean, but it doesn't solve the underlying problems. Perhaps I shouldn't even be publicly expressing these uncertainties, as it makes me appear weak as a moderator.

Everyone: Please refrain from any more abusive, vulgar, or insulting posts, anywhere on the forums, but especially in this thread. If you have personal problems with each other, please try to sort them out in private, if possible. Otherwise, just try to tolerate, or, if necessary, ignore each other, please. If there are any new abusive posts in this thread, I will probably delete them. As it is, I wouldn't be too surprised if Solitaire or Pete delete some of the existing posts.

We are here to assist and encourage each other as fellow programmers. We aren't here to fight, make enemies, or hurl insults.

Regards,
Michael

Posted on Oct 15, 2011, 1:12 PM

Respond to this message   

Return to Index


Excellent comments, Michael. You are doing your best as moderator. More:

by Solitaire (Login Solitaire1)
S

Sometimes you need to tiptoe around touchy issues.

Members & Posters:  Please think twice and calm down before posting comments that may be abusive or offensive to others.  If a program doesn't work as described, then your computer software and hardware may differ from others.  A full description by all parties involved may be called for to seek resolution of such problems.

 

Posted on Oct 15, 2011, 4:55 PM

Respond to this message   

Return to Index


A teachable moment?

by lawgin (no login)

Please excuse the trite expression in the title, but I think this thread illustrates how otherwise sane people can be emotionally swept away by the most innocuous post.
I posted a 10 line program that I thought was somewhat interesting but certainly not special or brilliant in any way. What followed was a maelstrom of invective comments with a dash of vulgarity thrown in the mix.

Constructive criticism should be welcomed, but ridicule, contempt, and derision reflects badly on the speaker.

Posted on Oct 16, 2011, 10:33 AM

Respond to this message   

Return to Index


Contempt? I just told you your code didnt work is all...:-)

by (Login burger2227)
R

I don't hate you and I could have come up with something way better than Bogart...believe that!

(edited to remove all caps - mc)

Posted on Oct 16, 2011, 6:07 PM

Respond to this message   

Return to Index


Writing maintanable code...

by (no login)

After sometime, (1 year) i look at my program which i thought finish, but reminiscing i could do better... finally i knew it's only alpha stage, quick hake, not optimized.

It was my first attempt to make something usable, and it is, no bug, it does what it says, - but no more. Now, i look at it in the scarring attempt to change 1 variable, but this is mission impossible. After a while i know : The only way is to take apart this big SUB which has grown up to a monster, by the many quick attempts to add some fixes, etc.

This SUB cannibalized everything because i wrote GOSUBs inside. But writing SUBs oblige you to think carefully about every variable, more than GOSUBs because a SUB is a self with takes only the variables one give it.

Now the only way is to take outside the BIG SUB every thing i can, hoping to simply the problem and taking control over the variables. Hence getting maintainable code.

Posted on Oct 12, 2011, 8:16 AM

Respond to this message   

Return to Index


* Right. That's the evil of using GOTOs and GOSUBs.

by Solitaire (Login Solitaire1)
S

Posted on Oct 12, 2011, 11:51 AM

Respond to this message   

Return to Index


* Am I evil? Yes, I am. Am I evil? I am, man. Yes, I am. (Metallica lyrics)

by (Login MCalkins)
Moderator

>:-)

Posted on Oct 13, 2011, 4:59 AM

Respond to this message   

Return to Index


Hey, he's from Texas! What can I say?

by (Login burger2227)
R

LOOK OUT when they catch him though! He'll be in for LIFE, IF he is LUCKY!

Perry RULES them Texas fools!


sad.gif

Posted on Oct 14, 2011, 12:31 PM

Respond to this message   

Return to Index


How to see my entire array ?

by (no login)

Usually i load a .DAT file which contains all graphics :

loadfont:
DEF SEG = VARSEG(array(0))
'load the array
fontload$ = PATH$ + font$
BLOAD fontload$, VARPTR(array(0))
DEF SEG

'CLS

'PUT (0, 0), array(30 * array(0) + 2)

'END

RETURN

Example, here the PUT will display "?" because it was GET before.

Should i BSAVE the array, BLOAD and then... PUT it ? or put each pixel with a double loop , x, y ?

Posted on Oct 12, 2011, 3:07 AM

Respond to this message   

Return to Index


You don't need an x/y loop...

by (Login qb432l)
R

The x/y loops are only used when you are creating/modifying characters during the creation of a font. Once the font exists and was BSAVE'd, you simply BLOAD it whenever you wish to use it, then PUT each character based on its location in the array (Index):

Char$ = "?"
Index = (ASC(Char$) - 33) * Array(0) + 2
PUT (x, y), Array(Index) ',PSET or default XOR

Check out the PrintSTRING sub program in QBASICS.BAS (included in the QBG zip files) for all the details about how these font files are used.

-Bob

Posted on Oct 12, 2011, 5:09 AM

Respond to this message   

Return to Index


Custom Fonts and Unicode for Qbasic using QB64

by (Login burger2227)
R

This routine can be used to create data files of fonts and Unicode for Qbasic programs to use also. Works with most fonts pretty well!

http://qb64.net/wiki/index.php?title=Text_Using_Graphics#Font_and_Unicode_Conversion

The TextSave SUB can only be used in QB64, but the DisplayText SUB can be used with Qbasic. You will need to load the array data from a file. Haven't gotten around to that yet.

Ted

PS: I CANNOT POST IN Bob's Forum!

Posted on Oct 11, 2011, 5:59 PM

Respond to this message   

Return to Index


I have finished making a QB64 font converter for Qbasic here:

by (Login burger2227)
R

http://qb64.net/wiki/index.php?title=Text_Using_Graphics#Font_and_Unicode_Conversion

It now includes a Qbasic routine to use QB64 font data files.

Posted on Oct 12, 2011, 3:15 PM

Respond to this message   

Return to Index


I had a look at your program...

by (Login qb432l)
R

Looks good (and tight). I'm afraid I can't use it, however, I'd have to know more about the Windows font stuff and QB64 commands, which implies a learning curve. These days, my brain freezes when any kind of learning is called for.

In any case, good luck, Clipster.
-Bob

Posted on Oct 12, 2011, 4:47 PM

Respond to this message   

Return to Index


All ya gotta do is find a font you like

by (Login burger2227)
R

The procedures already look in the Windows' Font folder. Try Comic! Ya don't even have to type in TTF. Qbasic can read the font data files created too. At least it is not as hard as the way you used to do it...

wink.gif

Posted on Oct 12, 2011, 4:58 PM

Respond to this message   

Return to Index


*I'll check it out -- not as hard, but not as much fun, either, I'll bet ;)

by (Login qb432l)
R

*

Posted on Oct 12, 2011, 7:19 PM

Respond to this message   

Return to Index


*I tried it with COMIC -- worked flawlessly! Nice job!

by (Login qb432l)
R

*

Posted on Oct 12, 2011, 7:22 PM

Respond to this message   

Return to Index


*About posting in my forum -- smiley problem again, I'm guessing :(

by (Login qb432l)
R

*

Posted on Oct 12, 2011, 4:40 PM

Respond to this message   

Return to Index


pmarathe... (pong within command processor)

by (Login MCalkins)
Moderator

You mentioned that you were still having trouble including your pong program into your command processor. However, that thread got scrolled off onto page 2 of the forum, so I'll respond with a new thread.

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

DECLARE SUB pong ()
CONST pi = 3.1415926536#
CONST e = 2.71828182818#
CONST mole = 6.022E+23

DIM word$(0 TO 1000)
DIM Ke$(0 TO 6)

RANDOMIZE TIMER
SCREEN 0
COLOR 25, 0
CLS
PRINT "|";
ddcol = 9
COLOR 9
x = 20
DO
 IF x > 999 THEN x = 20
 k$ = INKEY$
 IF k$ <> "" THEN
  IF k$ = CHR$(8) THEN
   IF LEN(wholesent$) THEN
    typed$ = LEFT$(typed$, LEN(typed$) - 1)
    wholesent$ = LEFT$(wholesent$, LEN(wholesent$) - 1)
   END IF
   curlet$ = ""
  ELSE
   curlet$ = k$
  END IF
  COLOR 9, 0
  CLS
  typed$ = typed$ + curlet$
  PRINT typed$;
  IF ddcol < 15 THEN
   COLOR ddcol + 16
  ELSE
   COLOR ddcol - 16
  END IF
  PRINT "|";
  COLOR ddcol
  IF curlet$ = " " THEN
   GOSUB wordparser
   wholesent$ = ""
  ELSE
   wholesent$ = wholesent$ + curlet$
  END IF
 END IF
LOOP

wordparser:
 x = x + 1
 word$(x) = wholesent$

 IF INSTR(LCASE$(word$(x)), "pong") <> 0 THEN
  pong
  PRINT "You may resume typing."
 END IF
 
 IF INSTR(LCASE$(word$(x - 2)), "c;") <> 0 AND INSTR(LCASE$(word$(x - 1)), "f;") <> 0 THEN
  PRINT word$(x); " degrees C = "; (9 / 5 * (VAL(word$(x)))) + 32; " degrees F."
 END IF
 IF INSTR(LCASE$(word$(x - 1)), "c;") <> 0 AND INSTR(LCASE$(word$(x - 2)), "f;") <> 0 THEN
  PRINT word$(x); " degrees F = "; (5 / 9) * (VAL(word$(x)) - 32); " degrees C."
 END IF

 IF INSTR(LCASE$(word$(x)), "end") > 0 OR INSTR(LCASE$(word$(x)), "exit") > 0 THEN END

 IF INSTR(LCASE$(word$(x)), "pranav") <> 0 THEN
  CLS
  PRINT "O' Great One. Thou art wonderful!."
 END IF

 firstnum = 0
 secondnum = 0

 IF INSTR(LCASE$(word$(x - 1)), "+") <> 0 THEN
  CLS
  GOSUB gettwovals
  PRINT firstnum + secondnum
 END IF
 IF INSTR(LCASE$(word$(x - 1)), "-") <> 0 THEN
  CLS
  GOSUB gettwovals
  PRINT firstnum - secondnum
 END IF
 IF INSTR(LCASE$(word$(x - 1)), "/") <> 0 THEN
  CLS
  GOSUB gettwovals
  PRINT firstnum / secondnum
 END IF
 IF INSTR(LCASE$(word$(x - 1)), "*") <> 0 THEN
  CLS
  GOSUB gettwovals
  PRINT firstnum * secondnum
 END IF
 IF INSTR(LCASE$(word$(x - 1)), "^") <> 0 THEN
  CLS
  GOSUB gettwovals
  PRINT firstnum ^ secondnum
 END IF

 IF INSTR(LCASE$(word$(x - 4)), "print") <> 0 AND INSTR(LCASE$(word$(x - 3)), "random") <> 0 AND INSTR(LCASE$(word$(x - 2)), "number") <> 0 THEN
  RANDOMIZE TIMER
  CLS
  PRINT INT(RND * (VAL(word$(x)) - VAL(word$(x - 1)))) + 1 + VAL(word$(x - 1))
 END IF
 IF INSTR(LCASE$(word$(x - 5)), "print") <> 0 AND INSTR(LCASE$(word$(x - 4)), "random") <> 0 AND INSTR(LCASE$(word$(x - 3)), "nos") <> 0 THEN
  RANDOMIZE TIMER
  CLS
  FOR dds = 1 TO VAL(word$(x))
   PRINT INT(RND * (VAL(word$(x - 1)) - VAL(word$(x - 2)))) + 1 + VAL(word$(x - 2))
  NEXT dds
 END IF

 IF INSTR(LCASE$(word$(x - 2)), "i") <> 0 AND INSTR(LCASE$(word$(x - 1)), "love") <> 0 AND INSTR(LCASE$(word$(x)), "you") <> 0 THEN
  CLS
  PRINT "Why Thank You!!! I love me too!"
 END IF
 IF INSTR(LCASE$(word$(x)), "atharv") <> 0 THEN
  CLS
  PRINT "Atharv the 12 year old, Atharv the 12 year old, Atharvaaa the 12 year old!!!... but seriously Athu's pretty cool.."
 END IF
 IF INSTR(LCASE$(word$(x - 1)), "shit") <> 0 THEN
  CLS
  PRINT "Wait, Wait... Did you just say shit?? Dont give me shit you turd..."
 END IF

 IF INSTR(LCASE$(word$(x - 1)), "start") <> 0 AND INSTR(LCASE$(word$(x)), "timer") <> 0 THEN
  CLS
  temp = 0
  rr$ = "0"
  PRINT "Press any key to start the timer"
  DO
  LOOP WHILE INKEY$ = ""
  DO
   temp = VAL(rr$) + .01
   rr$ = STR$(temp)
   FOR yyy = 1 TO 1
    FOR ddf = 1 TO 1000000
    NEXT ddf
   NEXT yyy
   CLS
   IF VAL(rr$) < 10 AND VAL(rr$) > 1 THEN PRINT LEFT$(rr$, 5)
   IF VAL(rr$) < 100 AND VAL(rr$) > 10 THEN PRINT LEFT$(rr$, 6)
   IF VAL(rr$) < 1000 AND VAL(rr$) > 100 THEN PRINT LEFT$(rr$, 7)
   IF VAL(rr$) < 10000 AND VAL(rr$) > 1000 THEN PRINT LEFT$(rr$, 8)
   IF VAL(rr$) < 100000 AND VAL(rr$) > 10000 THEN PRINT LEFT$(rr$, 9)
   IF VAL(rr$) < 1000000 AND VAL(rr$) > 100000 THEN PRINT LEFT$(rr$, 10)
   IF VAL(rr$) < 10000000 AND VAL(rr$) > 1000000 THEN PRINT LEFT$(rr$, 11)
   PRINT "Press any key to stop the timer."
  LOOP WHILE INKEY$ = ""
 END IF

 IF INSTR(LCASE$(word$(x - 1)), "start") <> 0 AND INSTR(LCASE$(word$(x)), "encoder") <> 0 THEN
  codenum = 1
  CLS
  DO
   key$ = LCASE$(INKEY$)
   IF key$ <> "" THEN
    IF key$ = "~" THEN RETURN
    IF codenum = 1 THEN
     codenum = 2
     SELECT CASE key$
     CASE "a" TO "z"
      PRINT CHR$(&H7A - (ASC(key$) - &H61));
     CASE CHR$(8)
      CLS
     CASE ELSE
      PRINT key$;
     END SELECT
    ELSE
     codenum = 1
     SELECT CASE key$
     CASE "a" TO "n"
      PRINT MID$("/.,';\[1234567", ASC(key$) - &H60, 1);
     CASE "o" TO "z"
      PRINT MID$("89+-`~|*=_}{", &H7B - ASC(key$), 1);
     CASE CHR$(8)
      CLS
      codenum = 2
     CASE ELSE
      temp = INSTR("/.,';\[1234567", key$)
      IF temp THEN
       PRINT CHR$(&H60 + temp);
      ELSE
       temp = INSTR("89+-`~|*=_}{", key$)
       IF temp THEN
        PRINT CHR$(&H7B - temp);
       ELSE
        PRINT key$;
       END IF
      END IF
     END SELECT
    END IF
   END IF
  LOOP
 END IF

 IF INSTR(LCASE$(word$(x - 2)), "enable") <> 0 AND INSTR(LCASE$(word$(x - 1)), "quick") <> 0 AND INSTR(LCASE$(word$(x)), "coding") <> 0 THEN
  DO
   k$ = INKEY$
   IF k$ = "~" THEN RETURN
   RANDOMIZE TIMER
   coding = INT(RND * 8) + 1
   a$(1) = "Print "
   a$(2) = "11001011010110101010111110101010100100100010000100101011111010101 "
   a$(3) = "cos_y278 "
   a$(4) = "System.out.exput.7.556.44 "
   a$(5) = "input "
   a$(6) = "goto 667 "
   a$(7) = "delete pagefile.sys "
   a$(8) = "Execute nngks.exe.ff775831"
   IF k$ <> "" THEN
    PRINT a(INT(RND * 8) + 1)
   END IF
  LOOP
 END IF

 IF INSTR(LCASE$(word$(x - 2)), "start") <> 0 AND INSTR(LCASE$(word$(x - 1)), "fortune") <> 0 AND INSTR(LCASE$(word$(x)), "teller") <> 0 THEN
  CLS
  COLOR 12
  DO
   DO
    CLS
    INPUT "Ask a question - a yes or no question"; a$
    IF a$ = "~" THEN RETURN
    IF RIGHT$(a$, 1) = "?" THEN EXIT DO
    PRINT "Put a QUESTION MARK in front of the QUESTION, genius!"
    SLEEP 1
   LOOP
   CLS
   RANDOMIZE TIMER
   a = INT(RND * 2) + 1
   SLEEP 1
   PRINT "Processing Question..."
   SLEEP 1
   PRINT
   PRINT "Processing-"
   SLEEP 1
   CLS
   INPUT "View Processing"; s$
   f$ = LEFT$(s$, 1)
   IF f$ = "y" OR f$ = "Y" THEN
    FOR n = 0 TO LEN(a$)
     z$ = LEFT$(a$, 5 + n)
     FOR somekindofvariable = 1 TO 2000000
     NEXT somekindofvariable
     PRINT z$
     c = INT(RND * 2) + 1
     IF c = 1 THEN PRINT "<variable>sin35cos92*trialf+trial b outcome ="; n * c ELSE PRINT "<variable>sin39cos"; n + c; "trial d ="; n * c
     IF a = 1 AND c = 2 THEN PRINT "true" ELSE PRINT "false"
     IF a = 2 AND c = 2 THEN PRINT "<variable probability="; INT(RND * 100) + 1; "%>"
    NEXT n
   ELSE
    PRINT "Processing..."
    SLEEP 15
   END IF
   SLEEP 3
   CLS
   SELECT CASE a
   CASE 1
    PRINT "Yes"
   CASE 2
    PRINT "No"
   END SELECT
   SLEEP 1
   CLS
   INPUT "Go again"; b$
   c$ = LEFT$(b$, 1)
  LOOP WHILE c$ = "y" OR c$ = "Y"
  RETURN
 END IF

 IF INSTR(LCASE$(word$(x - 1)), "start") <> 0 AND INSTR(LCASE$(word$(x)), "virus.exe") <> 0 THEN
  CLS
  PRINT "10 seconds left...Do not press a button... or else.."
  DO
  LOOP UNTIL INKEY$ <> ""
  CLS
  FOR i = 10 TO 0 STEP -1
   PRINT i
   SLEEP 1
   CLS
  NEXT i
  CLS
  FOR dooo = 1 TO 13
   PRINT "Connecting to vrhacks.net."
   FOR xxx = 1 TO 16000000
   NEXT xxx
   CLS
   PRINT "Connecting to vrhacks.net.."
   FOR xxx = 1 TO 16000000
   NEXT xxx
   CLS
   PRINT "Connecting to vrhacks.net..."
   FOR xxx = 1 TO 16000000
   NEXT xxx
   CLS
  NEXT dooo
  PRINT "Connected!"
  SLEEP 1
  FOR dooo = 1 TO 13
   PRINT "Downloading."
   FOR xxx = 1 TO 16000000
   NEXT xxx
   CLS
   PRINT "Connected!"
   PRINT "Downloading.."
   FOR xxx = 1 TO 16000000
   NEXT xxx
   CLS
   PRINT "Connected!"
   PRINT "Downloading..."
   FOR xxx = 1 TO 16000000
   NEXT xxx
   CLS
   PRINT "Connected!"
  NEXT dooo
  PRINT "Download Complete!"
  SLEEP 1
  RANDOMIZE TIMER
  FOR hjk = 1 TO 442
   binaryc = INT(RND * 2)
   PRINT binaryc;
   FOR xxx = 1 TO 1000000
   NEXT xxx
  NEXT hjk
  PRINT "Executing..."
  SLEEP 1
  PRINT "System Reboot in Progress..."
  SLEEP 1
  CLS
  SLEEP 5
  PRINT "Welcome to Windows 7. This is a command prompt version..."
  SLEEP 2
  CLS
  DO
   CLS
   PRINT "Password:";
   FOR pass = 1 TO 6
    DO
     Ke$(pass) = INKEY$
     IF Ke$(pass) <> "" THEN
      PRINT CHR$(8);
     END IF
    LOOP WHILE Ke$(pass) = ""
   NEXT pass
   IF Ke$(1) + Ke$(2) + Ke$(3) + Ke$(4) + Ke$(5) + Ke$(6) = "orange" THEN
    CLS
    EXIT DO
   END IF
   PRINT "Incorrect Password"
   SLEEP 1
   count = count + 1
  LOOP WHILE count < 4
  CLS
  PRINT "Welcome"
  SLEEP 1
  CLS
  PRINT "Sending information..."
  SLEEP 1
  CLS
  PRINT "Send var$ = (password) 'orange'/input.sysin.ln."
  SLEEP 1
  PRINT "Password sent successfully."
  SLEEP 1
  PRINT "System Shutdown is in progress..."
  SLEEP 1
  CLS
  PRINT "PWND"
  SLEEP 5
  RETURN
 END IF


 IF INSTR(LCASE$(word$(x - 1)), "start") <> 0 AND INSTR(LCASE$(word$(x)), "game") <> 0 THEN
  CLS
  RANDOMIZE TIMER
  mynum = INT(RND * 10) + 1
  FOR numba = 10 TO 1 STEP -1
   INPUT "Guess a number between 1 and 10"; uresponse$
   IF LEFT$(uresponse$, 3) = "end" OR LEFT$(uresponse$, 3) = "END" OR LEFT$(uresponse$, 3) = "End" OR LEFT$(uresponse$, 4) = "exit" OR LEFT$(uresponse$, 4) = "Exit" OR LEFT$(uresponse$, 4) = "EXIT" THEN
    RETURN
   END IF
   uresponse = VAL(uresponse$)
   CLS
   IF uresponse = mynum THEN
    COLOR 20
    PRINT "Correct!!"
    RETURN
   ELSEIF uresponse > mynum THEN
    IF numba < 2 THEN EXIT FOR
    PRINT "Guess lower..."; numba - 1; "chances left." 'changed x to numba...
   ELSEIF uresponse < mynum THEN
    IF numba < 2 THEN EXIT FOR
    PRINT "Guess higher.... "; numba - 1; "chances left." 'changed x to numba...
   END IF
   IF numba < 6 THEN PRINT "Remember, that the number is between 1 and 10...and you can exit by typing exit or end at any time...."
   SLEEP 3
   CLS
  NEXT numba
  PRINT "My number was"; mynum
 END IF

 IF INSTR(LCASE$(word$(x)), "clear") <> 0 THEN
  typed$ = ""
  CLS
 END IF

 IF INSTR(LCASE$(word$(x)), "help") <> 0 THEN
  CLS
  PRINT "Command Chart : "
  PRINT " ~ : Used to exit most programs."
  PRINT "f; c; 'number' : Converts Fahrenheit to Celcius."
  PRINT "c; f; 'number' : Converts Celcius to Fahrenheit."
  PRINT "chr 'number' : Prints a character in front of the cursor."
  PRINT "start game : Starts a guessing game."
  PRINT "clear : Clears the screen. "
  PRINT "end/exit : Ends program"
  PRINT "print random nos 'min' 'max' 'number of random number numbers that should be printed' : Prints the number of random numbers specified within the specified range."
  PRINT "print random number 'min' 'max' : Prints a random number between the min. and max."
  PRINT "start timer : Starts an accurate timer. "
  PRINT "start encoder : Starts an encoding software. Completely nondecodable. "
  PRINT "enable quick coding : Enables a quick coding mode with shortcuts for codes."
  PRINT "start fortune teller : Starts a fortune telling program."
  PRINT "color chart : Shows a color chart."
  PRINT "clr 'number' : Changes the text to a specific color."
  PRINT "start virus.exe : Executes a virus program. ";
  COLOR 28
  PRINT "WARNING! THIS MAY CRASH YOUR COMPUTER. USE WITH CARE."
  COLOR 9
 END IF

 IF INSTR(LCASE$(word$(x - 1)), "chr") <> 0 THEN
  typed$ = typed$ + CHR$(VAL(word$(x)))
 END IF

 IF INSTR(LCASE$(word$(x - 1)), "color") <> 0 AND INSTR(LCASE$(word$(x)), "chart") <> 0 THEN
  FOR ddx = 1 TO 31
   COLOR ddx
   PRINT "Color "; ddx; " ";
  NEXT ddx
 END IF

 IF INSTR(LCASE$(word$(x - 1)), "clr") <> 0 THEN
  ddcol = VAL(word$(x))
  COLOR VAL(word$(x))
 END IF

RETURN
     
gettwovals:
 firstnum = VAL(word$(x - 2))
 secondnum = VAL(word$(x))
 IF word$(x - 2) = "e" THEN firstnum = e
 IF word$(x - 2) = "pi" THEN firstnum = pi
 IF word$(x) = "e" THEN secondnum = e
 IF word$(x - 2) = "mole" THEN firstnum = mole
 IF word$(x) = "pi" THEN secondnum = pi
 IF word$(x) = "mole" THEN secondnum = mole
RETURN

SUB pong
 COLOR 7
 CLS

 INPUT "Choose AI difficulty: easy, medium, hard "; difficult$
 IF LCASE$(LEFT$(difficult$, 1)) = "e" THEN speed = 2
 IF LCASE$(LEFT$(difficult$, 1)) = "m" THEN speed = 4
 IF LCASE$(LEFT$(difficult$, 1)) = "h" THEN speed = 8

 SCREEN 12

 ' Set aside enough space to hold the sprite
 ' Draw a filled circle for our sprite
 DIM ball%(33)
 CIRCLE (4, 3), 4, 4
 PAINT (4, 3), 12, 4
 ' Get the sprite into the Ball% array
 GET (0, 0)-(8, 7), ball%(0)

 ponescore = 0
 ptwoscore = 0

begin:

 CLS
 xmin = 10
 ymin = 10
 xmax = 630
 ymax = 470
 x = 25
 y = 25
 dx = 1
 dy = 1
 curpos = 50
 curtpos = 50
 LINE (20, curpos)-(20, curpos + 100)
 LINE (620, curtpos)-(620, curtpos + (speed * 30)) 'length of paddle
 DO
  PRINT "Player 1 : "; ponescore; " Player 2 : "; ptwoscore / 10
  IF x = xmax - 19 AND y >= curtpos AND y <= curtpos + (speed * 30) THEN
   dx = -1
  ELSEIF x > xmax THEN
   ponescore = ponescore + 1
   GOTO begin
  END IF
  IF x = xmin + 10 AND y >= curpos AND y <= curpos + 100 THEN 'If ball goes to the edge of the screen and a paddle is present it changes direction
   dx = 1
  ELSEIF x < xmin THEN
   ptwoscore = ptwoscore + 1
   GOTO begin
  END IF

  IF y > ymax - 5 THEN dy = -1
  IF y < ymin + 5 THEN dy = 1


  IF dx = -1 THEN
   curtpos = curtpos + SGN(240 - (curtpos + (speed * 15)))
  END IF

  IF dx = 1 THEN
   curtpos = curtpos + SGN(y - (curtpos + (speed * 15)))
   IF curtpos + (speed * 30) > 479 THEN curtpos = 479 - (speed * 30)
   IF curtpos < 1 THEN curtpos = 1
  END IF

  ' Display the sprite elsewhere on the screen

  x = x + dx
  y = y + dy

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

  LINE (20, curpos)-(20, curpos + 100)
  LINE (620, curtpos)-(620, curtpos + (speed * 30))

  FOR something% = 1 TO 10000

keypress:
   k$ = INKEY$
   IF k$ <> "" THEN GOTO paddle
  NEXT something%
  CLS
 LOOP

paddle:
 IF k$ = "w" THEN curpos = curpos - 4
 IF k$ = "s" THEN curpos = curpos + 4
 IF k$ = "~" THEN
  SCREEN 0
  WIDTH 80, 25
  EXIT SUB
 END IF
 LINE (20, curpos)-(20, curpos + 100)
 LINE (620, curtpos)-(620, curtpos + (speed * 30))
 IF curpos < 1 THEN curpos = 1
 IF curpos > 379 THEN curpos = 379
GOTO keypress

END SUB

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

Basically, I've put the pong game in a SUB procedure, so all of its variables are local. (You don't have any SHARED variables.) I restore SCREEN 0 before exiting the SUB.

The above works for me in QBASIC 1.1. (The timing of your original code has been way too slow for me all along, so I have been removing the inner delay loop in the pong game.)

Note that when you come back from the pong game, you have to type something to update the screen, but even your first keystroke is part of the new word. I experimented with moving:

IF curlet$ = " " THEN
GOSUB wordparser
wholesent$ = ""
ELSE
wholesent$ = wholesent$ + curlet$
END IF

to above the display code, right above the COLOR 9, 0. However, this would make it necessary to add pauses after quite a few of the other things. For example, you would have to add a pause after displaying the help screen, otherwise it would be immediately cleared.

You could set COLOR 9, and PRINT typed$, and perhaps even print the "|" after coming back from pong, but that would be inconsistent with your other commands, like "help" and "pranav". The current result is consistent with your other commands: typed$ isn't displayed until you press a key, but the first key press is the start of the new word.

I've implemented my earlier suggestion to keep backspace from causing an illegal function call in QBASIC 1.1, when pressing backspace at the start of the current word.

I've made a few other minor changes. For example, I've added a COLOR statement, and added an explicit background color of 0 to one of the existing COLOR statements.

Regards,
Michael

Posted on Oct 10, 2011, 10:00 AM

Respond to this message   

Return to Index


Re: pmarathe... (pong within command processor)

by (no login)

With my original program, when the pong game was ended, it reset almost all of the variables to0, even then , the program would either freeze/crash or restart the pong game. Why was this happening?

Posted on Oct 11, 2011, 4:29 PM

Respond to this message   

Return to Index


Re: pmarathe... (pong within command processor)

by (Login MCalkins)
Moderator

With the program at:

http://www.network54.com/Forum/648955/message/1315431956/

If I change:

GOTO begin

to:

GOTO 1

like I described in my response, and change the array upper bounds to 1000, then the program seems to work in both QBASIC and QB64. I can type "pong ", and go into the pong game. I type "H", ENTER to select hard. I press "2" to exit. When I come back out, typing " " does not send me back into the pong game, because GOTO begin was changed to GOTO 1.

Regards,
Michael

Posted on Oct 11, 2011, 4:52 PM

Respond to this message   

Return to Index


Convert Big, Little Endian

by (no login)

Does anyone have a simple function for converting Endian on long integers?
I have a function that works, but it's awful clunky. I've searched, but nothing came up.

Given a long integer in (decimal or hexidecimal format), the function should swap endian on the four bytes, and return a long integer. I don't think it matters how the returned value is formatted (dec or hex). I plan on using PUT as BINARY to write the value to a file.

Right now, the one I wrote works, but it does a lot of string conversions etc. It just seems inefficient. I'm also afraid to do any direct memory manipulation, as I'm a novice at that.

Also, I will need one for 2-byte integers as well, but I figure that's easy to make from a 4-byte version.

Thanks in advance for any help.

Posted on Oct 9, 2011, 9:22 PM

Respond to this message   

Return to Index


Endian decides which bits are on or off in BINARY registers

by (Login burger2227)
R

PRINT &H60 will print decimal 96 so you don't need anything to convert to decimal long or integer.

Posted on Oct 9, 2011, 10:00 PM

Respond to this message   

Return to Index


Re: Endian decides which bits are on or off in BINARY registers

by Loudhvx (no login)

Sorry, I don't really follow what you mean.
I'm looking for a function to convert "Big Endian" ordered bytes, into "Little Endian" ordered bytes, (and vice versa), for long integers.

Posted on Oct 9, 2011, 11:06 PM

Respond to this message   

Return to Index


Like this

by (Login burger2227)
R

x& = 255
PRINT x&
FOR i& = 15 TO 0 STEP -1 'big endian
IF (x& AND 2 ^ i&) THEN st$ = st$ + "1" ELSE st$ = st$ + "0"
NEXT
PRINT st$
FOR b& = 1 TO 16 'little endian
IF MID$(st$, b&, 1) = "1" THEN byte& = byte& + 2 ^ (b& - 1)
NEXT
PRINT byte&

Posted on Oct 10, 2011, 10:44 AM

Respond to this message   

Return to Index


Re: Like this

by (Login MCalkins)
Moderator

It needs to reverse the bytes, not the bits. Bits within each byte are always big endian. It's the bytes that are little endian: For example:

&habcd is:

be: ab cd (10101011 11001101)
le: cd ab (11001101 10101011)

&haabbccdd is:

be: aa bb cc dd (10101010 10111011 11001100 11011101)
le: dd cc bb aa (11011101 11001100 10111011 10101010)

The bytes are reversed. The bits within the bytes are not.

Regards,
Michael

Posted on Oct 10, 2011, 11:23 AM

Respond to this message   

Return to Index


* Oh...why do you need to do that?

by (Login burger2227)
R

Posted on Oct 10, 2011, 11:39 AM

Respond to this message   

Return to Index


that's what I'm asking him... :-)

by (Login MCalkins)
Moderator

besides the two possibilities that I speculated earlier, reading UTF-16BE files might be another. But if that's all that he wanted, he wouldn't care about LONGs.

Regards,
Michael

Posted on Oct 10, 2011, 11:44 AM

Respond to this message   

Return to Index


why do x86 computers use little endian?

by (Login MCalkins)
Moderator

first of all, here's the wikipedia article for endianness:

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

but it doesn't really go into which is better or why. A google search for "reason little-endian" (without quotes) turns up, among other things, the following:

http://www.noveltheory.com/techpapers/endian.asp
http://www.technovelty.org/code/badcode/little-endian.html
http://www.cs.umass.edu/~verts/cs32/endian.html

Personally, I prefer little endian, but I have a hard time explaining why, other than that I am prejudiced in favor of it because all x86 processors use it. I do think that it is more natural. As the articles above discuss, there is an advantage to being able to read the least significant byte at offset 0.

For example, consider a union (overlapping data types) for a CP437 character encoding and a UTF-16LE character encoding. If it's a CP437 encoding, it's one byte. If it is UTF-16LE, it is two bytes. But either way, the least significant byte is first. So, if the character is "A", the first byte is &h41 either way, and the second byte is 0 (for UTF-16LE) or doesn't matter (for CP437).

"A" in CP437:
41

"A" in UTF-16LE:
41 00

In contrast, "A" in UTF-16BE:
00 41

Now, of course, the software should know whether ASCII or Unicode is being used, and therefore, whether to read a byte or a word. But still, I think it's neat that with little endian, the first byte is the same either way. I'll admit that this is a poor example.

In other words, as long as you know how big the relevant value is, you don't need to know how big the actual data type is. For example, perhaps I know that I need to read a 16 bit integer. I don't know how big the data type that holds it actually is, but I know that I only need the 16 least significant bits. I need to know its base offset. Since it is stored using little endian, I do not need to know how big the actual data type is. Suppose the value is &h1234.

It could be stored in a 16 bit data type:
34 12

It could be stored in a 32 bit data type:
34 12 00 00

It could be stored in a 64 bit data type:
34 12 00 00 00 00 00 00

As long as I know the base offset, and how many bytes I really need, I can read it. The extra bytes afterwards don't matter.

On the other hand, if it is stored as a 32 bit big endian data type:
00 00 12 34

Then I would have to know how big the data type is. (Or would have to be given an adjusted base offset.)

One of the articles I linked to above makes that point.

Regards,
Michael

Posted on Oct 10, 2011, 12:30 PM

Respond to this message   

Return to Index


Re: why do x86 computers use little endian?

by Loudhvx (no login)

I think it's really best summed up this way, quoted from the Wikipedia page:

"On Holy Wars and a Plea for Peace" by Danny Cohen ends with: "Swift's point is that the difference between breaking the egg at the little-end and breaking it at the big-end is trivial. Therefore, he suggests, that everyone does it in his own preferred way. We agree that the difference between sending eggs with the little- or the big-end first is trivial, but we insist that everyone must do it in the same way, to avoid anarchy. Since the difference is trivial we may choose either way, but a decision must be made."

:)

Posted on Oct 10, 2011, 1:19 PM

Respond to this message   

Return to Index


Re: Convert Big, Little Endian

by (Login MCalkins)
Moderator

I assume that you are using QBASIC instead of QB64.

I'm not sure what the best way is of doing this in QBASIC. Here are two different methods. One uses QBASIC's string functions to transpose the bytes, the other uses PEEK and POKE. This latter method relies on the assumption that a and b will both be in the same segment. Since they should be created as local variables on the stack, they should be in the same segment. (n cannot be relied on to be in the same segment, because it might have been passed by reference.) I believe this is a safe assumption.

I assume you already know how to use MKI$, CVI, MKL$, and CVL. They convert between numeric values and strings containing little endian binary integers. They are very similar to CHR$ and ASC, except for 2 bytes and 4 bytes instead of 1 byte.

Regards,
Michael

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

'public domain, october 2011, michael calkins

DECLARE FUNCTION rev4bytes& (n AS LONG)
DECLARE FUNCTION rev2bytesstr$ (n AS STRING)
DECLARE FUNCTION rev4bytesstr$ (n AS STRING)
DECLARE FUNCTION rev2bytes% (n AS INTEGER)

DIM i AS INTEGER
DIM l AS LONG
DIM s2 AS STRING * 2
DIM s4 AS STRING * 4

CLS

PRINT "demonstrating rev2bytes%"
i = &HABCD
PRINT LCASE$(HEX$(i)), MKI$(i)
i = rev2bytes%(i)
PRINT LCASE$(HEX$(i)), MKI$(i)
i = rev2bytes%(i)
PRINT LCASE$(HEX$(i)), MKI$(i)
PRINT

PRINT "demonstrating rev2bytesstr$"
s2 = MKI$(&HABCD)
PRINT LCASE$(HEX$(CVI(s2))), s2
s2 = rev2bytesstr$(s2)
PRINT LCASE$(HEX$(CVI(s2))), s2
s2 = rev2bytesstr$(s2)
PRINT LCASE$(HEX$(CVI(s2))), s2
PRINT

PRINT "demonstrating rev4bytes&"
l = &HAABBCCDD
PRINT LCASE$(HEX$(l)), MKL$(l)
l = rev4bytes&(l)
PRINT LCASE$(HEX$(l)), MKL$(l)
l = rev4bytes&(l)
PRINT LCASE$(HEX$(l)), MKL$(l)
PRINT

PRINT "demonstrating rev4bytesstr$"
s4 = MKL$(&HAABBCCDD)
PRINT LCASE$(HEX$(CVL(s4))), s4
s4 = rev4bytesstr$(s4)
PRINT LCASE$(HEX$(CVL(s4))), s4
s4 = rev4bytesstr$(s4)
PRINT LCASE$(HEX$(CVL(s4))), s4
PRINT

END

FUNCTION rev2bytes% (n AS INTEGER)
 DIM a AS INTEGER
 DIM b AS INTEGER
 a = n
 DEF SEG = VARSEG(b)
 POKE VARPTR(b), PEEK(VARPTR(a) + 1)
 POKE VARPTR(b) + 1, PEEK(VARPTR(a))
 rev2bytes% = b
END FUNCTION

FUNCTION rev2bytesstr$ (n AS STRING)
 rev2bytesstr$ = RIGHT$(n, 1) + LEFT$(n, 1)
END FUNCTION

FUNCTION rev4bytes& (n AS LONG)
 DIM a AS LONG
 DIM b AS LONG
 a = n
 DEF SEG = VARSEG(b)
 POKE VARPTR(b), PEEK(VARPTR(a) + 3)
 POKE VARPTR(b) + 1, PEEK(VARPTR(a) + 2)
 POKE VARPTR(b) + 2, PEEK(VARPTR(a) + 1)
 POKE VARPTR(b) + 3, PEEK(VARPTR(a))
 rev4bytes& = b
END FUNCTION

FUNCTION rev4bytesstr$ (n AS STRING)
 rev4bytesstr$ = RIGHT$(n, 1) + MID$(n, 3, 1) + MID$(n, 2, 1) + LEFT$(n, 1)
END FUNCTION

Posted on Oct 10, 2011, 4:36 AM

Respond to this message   

Return to Index


Re: Convert Big, Little Endian

by Loudhvx (no login)

Thank you very much, Michael.
Yes, Qbasic. I figured it would come down to memory manipulation or string manipulation, and of the two, I prefer strings to keep me out of trouble. :)
I was using HEX$, VAL, and CHR$, and it ended up clunky since I had to maintain leading zeros artificially.

I was unaware of MKI$, etc. That does make it a lot neater, and should work nicely. Thanks a lot!

It's going to be a few days before I can play with this again, and I'll probably have a few questions then too, regarding how this will handle negative integer values.

Thanks again,
-Lou

Posted on Oct 10, 2011, 7:55 AM

Respond to this message   

Return to Index


yw

by (Login MCalkins)
Moderator

Those functions handle negative values correctly. The values that I demonstrated are negative.

Are you asking how negative integers are stored?

http://en.wikipedia.org/wiki/Two%27s_complement

So, for 16 bit INTEGERs:

&h0000 is 0
&h7fff is 32767
&h8000 is -32768
&hffff is -1

Out of curiosity, why do you need big endian encodings? Off the top of my head, I'm thinking perhaps network packet headers, or perhaps cryptographic algorithms. I can't remember which specifically require big endian encodings. Pretty much anything PC specific would be little endian.

Regards,
Michael

Posted on Oct 10, 2011, 10:22 AM

Respond to this message   

Return to Index


Re: yw

by Loudhvx (no login)

Two's complement is what i wanted to hear. That's perfect.

I'm playing with coding WAV files to make simple test signals for use with various other projects (microcontrollers, filters etc). Wav files code the samples in Little Endian format, and I'm going to write the generator in Big Endian, just because it's easier for me to think that way.

Speed in getting the result is not critical, so even if converting Endian takes time, it'll be nicer to keep the sample generator simple.

Correct me if I'm wrong, I assumed the same function would be used to convert Big to Little and vice versa. So, in any event, it'll be a handy function to have since I've encountered this before. Previously I did it similarly by converting to strings, however your suggestion seems much better than the way I was doing it.

Thanks again,
-Lou

Posted on Oct 10, 2011, 12:03 PM

Respond to this message   

Return to Index


*That's right. The reverse of the reverse is the original.

by (Login MCalkins)
Moderator

Posted on Oct 10, 2011, 12:38 PM

Respond to this message   

Return to Index


just to be sure...

by (Login MCalkins)
Moderator

i'm not sure what your generator needs to do, but, generally, compatibility aside, programs written in high level languages like QBASIC don't need to worry too much about endianness. I just want to make sure that you know that QBASIC can write little endian integers directly. For example:

DIM l as LONG

OPEN whatever FOR BINARY AS 1
PUT 1, , l
CLOSE

writes a LONG directly to the file, as a little endian 4 byte record. A QBASIC program can then read it directly with GET 1, , l. So, no manual conversion is required to read and write little endian numbers to files. So, since QBASIC expects little endian numbers in files and you say that the wav format also expects it, then i'm not sure why your program needs to worry about endianness at all. (Unless the generator needs to work with big endian encodings in a string format for some reason. You can work with the numeric values themselves and not worry about endianness, I think. Endianness is a low level concept dealing with encoding. The numeric values themselves are at a higher level, and have nothing to do with endianness.)

Regards,
Michael


'public domain, october 2011, michael calkins

DIM l AS LONG
DIM s4 AS STRING * 4
DIM t AS STRING
DIM i AS INTEGER
DIM s2 AS STRING * 2
DIM n AS INTEGER
DIM s1 AS STRING * 1

CLS

i = &H1234
s2 = MKI$(&H1234)       'converts an INTEGER to a 2 byte string (little end.)
l = &H89ABCDEF
s4 = MKL$(&H89ABCDEF)   'converts a LONG to a 4 byte string (little endian)

OPEN "delete.me" FOR BINARY AS 1
PUT 1, , i              ' writes an INTEGER directly
PUT 1, , s2             ' writes a 2 byte string
PUT 1, , l              ' writes a LONG directly
PUT 1, , s4             ' writes a 4 byte string

PRINT "File contents as bytes:"
FOR n = 1 TO LOF(1)
 GET 1, n, s1
 t = LCASE$(HEX$(ASC(s1)))
 IF ASC(s1) < &H10 THEN t = "0" + t

 'an alternative way to add leading zeros:
 ' t = STRING$(2 - LEN(t), &H30) + t
 'this is more suitable for lengths greater than 2.

 PRINT t; " ";
NEXT
PRINT
PRINT

i = 0
l = 0
s2 = ""
s4 = ""

PRINT "The values read back:"
GET 1, 1, i             'seeks to the beginning, reads an INTEGER directly
GET 1, , s2             'reads a 2 byte string
GET 1, , l              'reads a LONG directly
GET 1, , s4             'reads a 4 byte string
PRINT LCASE$(HEX$(i))
PRINT LCASE$(HEX$(CVI(s2)))     'converts a 2 byte string to an INTEGER (le)
PRINT LCASE$(HEX$(l))
PRINT LCASE$(HEX$(CVL(s4)))     'converts a 4 byte string to a LONG (le)

CLOSE

KILL "delete.me"
SYSTEM

Posted on Oct 10, 2011, 1:47 PM

Respond to this message   

Return to Index


Ah, even better

by Loudhvx (no login)

That's even better than I'd hoped. That should work great... no conversion needed for the sample data. Perhaps that's why I did not find any conversion programs for swapping Endian. Sorry for all the bother.

However, I may still need it for the header on the file. Some of the fields are in Big Endian. But it may only be the fields designed for text. I'll have to check that out when I get some real time on the computer.

When I made my program for converting qbasic SCREENs into 24 bit bitmaps, I wondered why the RGB data was in BGR order. Now it makes sense.

Thanks again for the lessons.
-Lou

Posted on Oct 10, 2011, 7:35 PM

Respond to this message   

Return to Index


* I'm glad that I was able to help.

by (Login MCalkins)
Moderator

Posted on Oct 11, 2011, 3:30 AM

Respond to this message   

Return to Index


*update. Program worked great. Thanks!

by Loudhvx (no login)

Posted on Oct 17, 2011, 8:34 AM

Respond to this message   

Return to Index


Memory optimisation

by (no login)

Hi,

I copied most of my SCREEN 2 into an array, in small parts, and PUT it back with PRESET, so i'm sure nothing is overlapping, foremost the default XOR method also shows nothing weird... i tried also to crop the parts but then i lost content, so i wonder why the array get larger than expected. The Bob's EMPIRICAL gives 7642, but i need sometimes more than 8150...

You don't want to see the code, it's pretty obscure... but maybe a debugging idea ?

GOSUB IntSize

'LINE (639 - c%, 163)-(639, 189), 0, BF
LINE (639 - c%, 162)-(639, 190), 0, BF 'clean place
'LINE (639 - c%, 162)-(639, 188), 1, B


PY% = 162
CALL Xfprint(van$, PY%)
PRINTY = 0

'SLEEP


GET (639 - c%, 162)-(639, 188), quickbuf(Stripe(Jv%, I).InQbuf)

'3) write in the stripe for next i

Stripe(Jv%, I + 1).locX = Stripe(Jv%, I).locX + c%
Stripe(Jv%, I + 1).InQbuf = Stripe(Jv%, I).InQbuf + Isize

Isize is the amount of integer i need for a piece of screen * 27:

IntSize:

d% = c% + 1

' GOTO skipsel

SELECT CASE d%

CASE 2 TO 8: Isize = 16
CASE 9 TO 16: Isize = 29
CASE 17 TO 24: Isize = 43
CASE 25 TO 32: Isize = 56
CASE 33 TO 40: Isize = 70
CASE 41 TO 48: Isize = 83
CASE 49 TO 56: Isize = 97
CASE 57 TO 64: Isize = 110
CASE 65 TO 72: Isize = 124
CASE 73 TO 80: Isize = 137
CASE 81 TO 88: Isize = 151
CASE 89 TO 96: Isize = 164
CASE 97 TO 102: Isize = 178
CASE 103 TO 110: Isize = 191
CASE 111 TO 118: Isize = 205
CASE 119 TO 124: Isize = 218

END SELECT





Posted on Oct 9, 2011, 1:12 PM

Respond to this message   

Return to Index


A couple of questions...

by (Login qb432l)
R

I'm not sure what you're trying to do, but when you used my empirical method to establish array size, did you use a temporary PSET in attribute 15 at the bottom right corner? Very important.

Also, are you still working in SCREEN 2 -- and if so, is it on the same machine, using the same operating system?

-Bob

Posted on Oct 9, 2011, 4:16 PM

Respond to this message   

Return to Index


answer

by (no login)

= >did you use a temporary PSET in attribute 15 at the bottom right corner? Very important.

Omg, no :)

Also, are you still working in SCREEN 2 -- and if so, is it on the same machine, using the same operating system?

Screen 2 yes, but on different machines.

This is a routine to use less PUTs, there for i print in the right button corner 4 letters, then i GET them and store them into the big array. I calculate the space for storing the next 4 letters... so i get a serie of integers related to locations in the Array, but what i will do is inspect the big array, 1) printing every integer location i dumped in a file, or maybe with BSAVE & BLOAD; i need strategy to get closer to what is in the array...

-Bob


Posted on Oct 10, 2011, 5:06 AM

Respond to this message   

Return to Index


I think you already know this, but just in case...

by (Login qb432l)
R

You can store information in the array as to the size and location of an image in that array. For example, the first section of the array can be treated as a file header, wherein you store data about the number of images, their size and location within the array, etc. As data changes during program run, this "header" can be updated accordingly.

BTW, for using the temporary PSET during program run:

TempCOLOR = POINT(x, y) 'bottom-right corner of area to GET
PSET(x, y), 15 'temporary PSET
'determine array size
PSET(x, y), TempCOLOR

Although, I was thinking that if you're going to be establishing array size during program run, you may want to use QBasic's formula. It's a bit more complicated than the empirical method, but would be simpler in that it would only involve a calculation. To check it out, go to QBasic Help/Index/GET(graphics) then click (Screen Image Arrays and Compatibility).

-Bob

Posted on Oct 10, 2011, 6:49 AM

Respond to this message   

Return to Index


memory

by (no login)

Hi the Bob

Could you please remember me how to run your graphic tutos ? no readme there... also the original empirical. bas is hard to find.

i just draw a square in screen 2, like 2 x 27, and also 3 x 27 etc, and run the empirical.bas. But forgot the PSET since i thought it doesn't matter... also no clue about headers :)

Posted on Oct 10, 2011, 8:59 AM

Respond to this message   

Return to Index


Sure...

by (Login qb432l)
R

Go to my graphics forum and click "Tutorials". After downloading/unzipping the QBG1.zip and QBG2.zip files, run QBG.EXE. The section on the empirical method of determining array size is in Lesson 8.

Yes, the temporary PSET is important, since the empirical method searches for the first non-zero element in the array using a FOR loop with a minus step value. If the bottom-right pixel is a zero, for example, the loop will keep searching and the array size will be too small. Since you're GET'ing characters against a zero background, it's entirely possible that the loop will find a lot of "necessary" zeros before it gets to a non-zero pixel.

Forget the word "header". All you really have to know is that you can reserve the first, say, 20 integers in your array for saving information about where images are stored in that array. No big deal, and you may not even need it for what you're doing.

-Bob

Posted on Oct 10, 2011, 11:50 AM

Respond to this message   

Return to Index


QBG

by (no login)

Microsoft Windows XP [Version 5.1.2600]
(C) Copyright 1985-2001 Microsoft Corp.

C:\Documents and Settings\main>cd "C:\Documents and Settings\main\Desktop\36_Qbg
2"

C:\Documents and Settings\main\Desktop\36_Qbg2>qbg

File not found in module QBG at address 0F8F:008D

Hit any key to return to system

Snowfall is working :)

Posted on Oct 10, 2011, 1:38 PM

Respond to this message   

Return to Index


I notice "qbg2" in your path information...

by (Login qb432l)
R

I think that your extraction utility created separate folders for QBG1.zip and QBG2.zip, hence the "file not found". Make sure that both zip's are extracted to the same directory. I just checked the downloads and they both work fine, so that's not the problem.

-Bob

Posted on Oct 10, 2011, 9:49 PM

Respond to this message   

Return to Index

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