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



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
    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



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

** 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


videoprt

by (no login)

It works nicely, but i have to reinstall it every day ?

Windows XP SP3

Posted on Oct 6, 2011, 3:18 AM

Respond to this message   

Return to Index


* Are you running as administrator?

by (Login burger2227)
R

Posted on Oct 6, 2011, 9:10 AM

Respond to this message   

Return to Index


* yes.

by (no login)

p

Posted on Oct 6, 2011, 12:15 PM

Respond to this message   

Return to Index


Apparently Windows is fixing itself

by (Login burger2227)
R

After your next install of the fix program, remember the time and check the System32 folder files to see if any were changed at that time.

Compare the autoexec.nt and config.nt files there with the ones in the C:\WINDOWS\repair folder. DON'T ALTER the files in the repair folder. They are used as backups!

Also see if you can find any other System files changed by the fix.



Posted on Oct 6, 2011, 1:26 PM

Respond to this message   

Return to Index


i get also the warning that i replace newer files with older ones.

by (no login)

However the autexec.nt and config.nt seems to be the same.

Posted on Oct 9, 2011, 2:25 AM

Respond to this message   

Return to Index


Check the file dates

by (Login burger2227)
R

We probably have to find a Windows system file that is changed by the program. Something is changed that affects the way NTVDM uses the 32 bit video drivers.

First the INSTALL.BAT file creates a copy of your existing driver called vidprt0.sys in each of the following folders:

C:\WINDOWS\system32\ServicePackFiles\i386\
C:\WINDOWS\system32\system32\drivers\
C:\WINDOWS\system32\system32\dllcache\

Then it copies OVER the old videoprt.sys file with a different version dated June 13, 2004. Check to see if the file dates have been changed back.

C:\WINDOWS\system32\ServicePackFiles\i386\videoprt.sys
C:\WINDOWS\system32\system32\drivers\videoprt.sys
C:\WINDOWS\system32\system32\dllcache\videoprt.sys

Posted on Oct 9, 2011, 7:23 AM

Respond to this message   

Return to Index


dates :

by (no login)

C:\WINDOWS\system32\ServicePackFiles\i386\videoprt.sys

Missing, folder missing too, ServicePackFiles\

C:\WINDOWS\system32\system32\drivers\videoprt.sys

13/6/2004

C:\WINDOWS\system32\system32\dllcache\videoprt.sys

13/6/2004

Now it's not working...



Posted on Oct 9, 2011, 2:33 PM

Respond to this message   

Return to Index


What is C:\WINDOWS\system32\system32\?

by (Login burger2227)
R

It should be C:\WINDOWS\system32\ not twice!

It looks like the files copied correctly in two of the folders.

You may not have ServicePackFiles\i386 but you should have an i386 folder. Is it in there? My system has an OLDER version of the videoprt.sys file there anyhow.

Do a search of C:\ and see if you can find a newer version somewhere.

Posted on Oct 9, 2011, 3:39 PM

Respond to this message   

Return to Index


It's only the laptop (IBMT43), on tower PC no problem

by (no login)

I left home so i have no more the laptop. Under the ATX-PC QB runs perfectly well, except the monitor which makes auto adjustments, so i need to set it to forget that.

however i have a ibm X41 for testing...

Posted on Oct 11, 2011, 2:44 PM

Respond to this message   

Return to Index


I'm looking for a way to tidy up code

by Docfxit (Login Docfxit)
R

Does anyone know of a way to clean up code by re-indenting the lines of code so that it's easier to read?

In HTML or AutoIt there is a program called tidy. Is there something like that for QB64?

Thanks,

Docfxit

Posted on Oct 5, 2011, 7:09 PM

Respond to this message   

Return to Index


Go to Options in the QB64 IDE

by (Login burger2227)
R

In Code Layout you can set the spacing and indentation. Then load your code.

Posted on Oct 5, 2011, 7:14 PM

Respond to this message   

Return to Index


That's super. Very easy. :-)

by Docfxit (Login Docfxit)
R

I started qb64.exe
Loaded my bas file
Saved it.
All indented perfectly.

Thank you very much,

Docfxit

Posted on Oct 5, 2011, 8:04 PM

Respond to this message   

Return to Index

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