CGA example.

If you have questions about any aspect of QBasic programming, or would like to help fellow programmers solve their problems, check out this board!

Moderators: Pete, Mods

Post Reply
iamdenteddisk
Veteran
Posts: 185
Joined: Mon Jun 30, 2008 4:10 pm

CGA example.

Post by iamdenteddisk »

a cool CGA program I made a while back with some help from clippy or (burger2227 here) and SmcNeill from the qb64 website.

I suggest just enjoy the pretty Computer generated graphics.

probably go great with Mozart and mushrooms lol..

this program is in 1024x768 resolution make sure you can run it before you do. also the R key restarts the action at any time and esc key exits.

note also, this is a growing life example that qb64 couldn't display correctly so I simply converted it to do artwork but it has a special task for my purpose, "it models the birth of a singularity"..it takes a while to grow and is super interesting in time depending on how slow your computer is..

Code: Select all


'A multi cell organism in matrix
'-----
scrn& = _NEWIMAGE(1024, 768, 256)
SCREEN scrn&

DIM cell(1025, 770)
DIM Tempcell(1025, 770)
cntr = .5 'radius of shell
CLS

DO
    ' RANDOMIZE TIMER
    ' Fill in some contents, otherwise there will be no initial growth.  What
    ' values we put here, is all important.
    '000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
    'INPUT "NUMBER OF SPORES TO CULTURE: "; nn
    nn = 1


    '00000000000000000000



    'INPUT "NUMBER OF PROTIENS IN LATICE: "; culture '%%%%% this is the start rnd  we want
    'RANDOMIZE culture '%%%%%
    RANDOMIZE nn
    'RANDOMIZE TIMER



    '***  A change here to Set the original cell with data, not the tempcell ****

    FOR f = 0 TO 1025: FOR j = 0 TO 770: cell(f, j) = 1: NEXT j: NEXT f
    'CLS , 1



    '*** A change here to set where our original cells start at. ****
    FOR f = 1 TO nn 'starting with number of cells up to 300
        x = 512 ' INT(RND(1) * 1024) + 1
        y = 384 'INT(RND(1) * 768) + 1
        cell(x, y) = 4
        PSET (x, y), 4
    NEXT f


    ' Life Loop:


    DO

        '*** A change here, to get the tempcell data
        '*** Get a buffered snapshot of what the original cell look like at the start of your life loop
        FOR f = 0 TO 1025: FOR j = 0 TO 770: Tempcell(f, j) = cell(f, j): NEXT j: NEXT f




        FOR f = 1 TO 1024 '80
            FOR j = 2 TO 768 '40

                ' Calculate neighbours of cell:


                '*** You're using Tempcell correctly here.
                '*** Use it to compare your neighbors as we're not going to change the tempcell.
                '*** It's there holding a buffer of unaltered data which we change change our actual, usable data against.

                neighbours = 0
                '******************************************************
                IF Tempcell(f - 1, j) = 6 THEN neighbours = neighbours + 1
                IF Tempcell(f + 1, j) = 6 THEN neighbours = neighbours + 1
                IF Tempcell(f, j - 1) = 6 THEN neighbours = neighbours + 1
                IF Tempcell(f, j + 1) = 6 THEN neighbours = neighbours + 1
                IF Tempcell(f - 1, j - 1) = 6 THEN neighbours = neighbours + 1
                IF Tempcell(f + 1, j - 1) = 6 THEN neighbours = neighbours + 1
                IF Tempcell(f - 1, j + 1) = 6 THEN neighbours = neighbours + 1
                IF Tempcell(f + 1, j + 1) = 6 THEN neighbours = neighbours + 1
                '*******************************************************
                IF Tempcell(f - 1, j) = 7 THEN neighbours = neighbours + 1
                IF Tempcell(f + 1, j) = 7 THEN neighbours = neighbours + 1
                IF Tempcell(f, j - 1) = 7 THEN neighbours = neighbours + 1
                IF Tempcell(f, j + 1) = 7 THEN neighbours = neighbours + 1
                IF Tempcell(f - 1, j - 1) = 7 THEN neighbours = neighbours + 1
                IF Tempcell(f + 1, j - 1) = 7 THEN neighbours = neighbours + 1
                IF Tempcell(f - 1, j + 1) = 7 THEN neighbours = neighbours + 1
                IF Tempcell(f + 1, j + 1) = 7 THEN neighbours = neighbours + 1
                '******************************************************
                IF Tempcell(f - 1, j) = 12 THEN neighbours = neighbours + 1
                IF Tempcell(f + 1, j) = 12 THEN neighbours = neighbours + 1
                IF Tempcell(f, j - 1) = 12 THEN neighbours = neighbours + 1
                IF Tempcell(f, j + 1) = 12 THEN neighbours = neighbours + 1
                IF Tempcell(f - 1, j - 1) = 12 THEN neighbours = neighbours + 1
                IF Tempcell(f + 1, j - 1) = 12 THEN neighbours = neighbours + 1
                IF Tempcell(f - 1, j + 1) = 12 THEN neighbours = neighbours + 1
                IF Tempcell(f + 1, j + 1) = 12 THEN neighbours = neighbours + 1
                '******************************************************
                IF Tempcell(f - 1, j) = 4 THEN neighbours = neighbours + 1
                IF Tempcell(f + 1, j) = 4 THEN neighbours = neighbours + 1
                IF Tempcell(f, j - 1) = 4 THEN neighbours = neighbours + 1
                IF Tempcell(f, j + 1) = 4 THEN neighbours = neighbours + 1
                IF Tempcell(f - 1, j - 1) = 4 THEN neighbours = neighbours + 1
                IF Tempcell(f + 1, j - 1) = 4 THEN neighbours = neighbours + 1
                IF Tempcell(f - 1, j + 1) = 4 THEN neighbours = neighbours + 1
                IF Tempcell(f + 1, j + 1) = 4 THEN neighbours = neighbours + 1
                '*************************************************************
                'IF Tempcell(f - 1, j) = 1 THEN neighbours = neighbours - 1
                'IF Tempcell(f + 1, j) = 1 THEN neighbours = neighbours - 1
                'IF Tempcell(f, j - 1) = 1 THEN neighbours = neighbours - 1
                'IF Tempcell(f, j + 1) = 1 THEN neighbours = neighbours - 1
                'IF Tempcell(f - 1, j - 1) = 1 THEN neighbours = neighbours - 1
                'IF Tempcell(f + 1, j - 1) = 1 THEN neighbours = neighbours - 1
                'IF Tempcell(f - 1, j + 1) = 1 THEN neighbours = neighbours - 1
                'IF Tempcell(f + 1, j + 1) = 1 THEN neighbours = neighbours - 1
                '********
                ' What Happens
                '
                ' if Neighbours is 2 or 3, it lives.
                ' = 3 born
                ' >=4 Death
                ' <2> 1 THEN cell(f, j) = 4: PSET (f, j), 4 ''if cell is dead and has at least 1 neighbors then birth new cell
                IF Tempcell(f, j) = 4 AND neighbours > 1 THEN cell(f, j) = 4: PSET (f, j), 4 '
                IF Tempcell(f, j) = 4 AND neighbours <2> 1 THEN cell(f, j) = 1: PSET (f, j), 1 ' if poison goes uneaten let it dissolve
                IF Tempcell(f, j) = 6 AND neighbours <1> 3 THEN cell(f, j) = 4: PSET (f, j), 4
                IF Tempcell(f, j) = 12 AND neighbours = 3 THEN cell(f, j) = 7: PSET (f, j), 7 '4or3
                'IF Tempcell(f, j) = 12 AND neighbours = 3 THEN cell(f, j) = 4: PSET (f, j), 0 '4or3
                'IF point(f, j) = 12 AND neighbours = 3 THEN color 7 '4or3
                '**********************************these numbers represent 5 sliding weights***********************

                'color chart to help you edit program
                ' 0 = black       4 = red           8 = grey             12 = light red
                ' 1 = blue        5 = magenta       9 = light blue       13 = light magenta
                ' 2 = green       6 = brown        10 = light green      14 = yellow
                ' 3 = cyan        7 = white        11 = light cyan       15 = bright white

                '****  A change here to what you had.
                '**** Remember, Tempcell is the unchanged original data.
                '**** You don't want to reset cell back to its unaltered state -- you just updated its life cycle above.
                'So I took out the loop you had here.


                ' Check for key presses

                key$ = INKEY$
                IF key$ <> "" THEN
                    SELECT CASE LCASE$(key$)
                        CASE "r": RUN
                        CASE CHR$(27): SYSTEM
                    END SELECT
                END IF
            NEXT j
        NEXT f
        cntr = cntr + .5
        CIRCLE (512, 384), cntr, 128 'circle with radius of 110 and dark gray
        PAINT STEP(300, 300), 0, 128
    LOOP
LOOP
CLS

'------

'Concerning the death rule, (2 or less), I found that killed too many cells,
'so I changed it to LESS than 2.  Any comments

iamdenteddisk
Veteran
Posts: 185
Joined: Mon Jun 30, 2008 4:10 pm

Post by iamdenteddisk »

45 views no reply's, I am wondering if these are just bots?

you'd need be comatose not to complain about my coding, if you ran it most would say wow how did he get that slop to work. I don't get it..
User avatar
burger2227
Veteran
Posts: 2466
Joined: Mon Aug 21, 2006 12:40 am
Location: Pittsburgh, PA

Post by burger2227 »

The M$ and Google Bots come here every day to update the site. I've seen 10 or more instances here at once. All I have to do is ping their IP in the Administration Index to see if one is a spammer and they all go away LOL.
Please acknowledge and thank members who answer your questions!
QB64 is a FREE QBasic compiler for WIN, MAC(OSX) and LINUX : https://www.qb64.org/forum/index.php
Get my Q-Basics demonstrator: https://www.dropbox.com/s/fdmgp91d6h8ps ... s.zip?dl=0
iamdenteddisk
Veteran
Posts: 185
Joined: Mon Jun 30, 2008 4:10 pm

Post by iamdenteddisk »

IDK you could get that info, you give me an idea there..

what would a repeated ping on those ip's do for the online experience?
User avatar
burger2227
Veteran
Posts: 2466
Joined: Mon Aug 21, 2006 12:40 am
Location: Pittsburgh, PA

Post by burger2227 »

I pinged them, not their address. It could be tossing everybody else off for all I know.

PS: My Preview before posting idea seems to eliminate the Invalid Session Error most of the time. Better than having to go back to add my signature.
Please acknowledge and thank members who answer your questions!
QB64 is a FREE QBasic compiler for WIN, MAC(OSX) and LINUX : https://www.qb64.org/forum/index.php
Get my Q-Basics demonstrator: https://www.dropbox.com/s/fdmgp91d6h8ps ... s.zip?dl=0
User avatar
GarryRicketson
Veteran
Posts: 90
Joined: Fri Jul 16, 2010 10:02 am
Location: Cuencame,Durango,Mexico
Contact:

above my head

Post by GarryRicketson »

Well , just to let you know, I looked at it, but it is "above " my head,.. I tried it and just get a blank black screen ?? What is it supposed to do ?
Post Reply