Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
People in SCREEN 0
#1
Lightbulb 
This is a silly program that could make a good screensaver LOL. I wrote something like this for one of my Tandy1000's many years back with QuickBASIC. Technology has gone such that it's amazing this program could run many times as fast on 64-bit, while being more bloated than a 16-bit program, and with single-core CPU barely capable of multimedia.

Code: (Select All)
''by mnrvovrfc 06-Jan-2023
OPTION _EXPLICIT
CONST NUMPEOPLE = 80
'fields:
'x, y = position of "person"
'xd, yd = direction is changed when the "person" reaches an edge of the screen
'c = color
'h = open or filled face
'k = count
'l = length of fixed path taken by the "person"
TYPE peoplette
    AS INTEGER x, y, xd, yd, c, k, l, h
END TYPE
DIM p(1 TO NUMPEOPLE) AS peoplette
DIM AS INTEGER i, j, k, kl, u, v, x, y, ox, oy, wd, ht, kc
DIM a$, found AS _BYTE

RANDOMIZE TIMER

'no two "persons" may have the same path but could look alike LOL
'kc = to repeat one direction a "person" takes up to four times
'kl = the number of times the "person" could change direction
DIM check$(1 TO NUMPEOPLE)
FOR i = 1 TO NUMPEOPLE
    kl = INT(RND * 10 + 5)
    kc = INT(RND * 4 + 1)
    k = kl
    a$ = ""
    DO WHILE k > 0
        DO
            x = INT(RND * 3) - 1
            y = INT(RND * 3) - 1
        LOOP WHILE x = 0 AND y = 0
        a$ = a$ + repeat$(STR$(x) + STR$(y), kc)
        k = k - 1
    LOOP
    IF i > 1 THEN
        found = 0
        FOR j = 1 TO i - 1
            IF a$ = check$(j) THEN found = 1: EXIT FOR
        NEXT
        IF found THEN _CONTINUE
    END IF
    check$(i) = a$
    p(i).l = kl
    p(i).k = 0
    p(i).c = INT(RND * 14 + 1)
    p(i).h = INT(RND * 2 + 1)
    p(i).xd = 1
    p(i).yd = 1
NEXT

'spread the people all over the screen
wd = _WIDTH
ht = _HEIGHT
u = wd * ht
u = u \ NUMPEOPLE
v = u \ 2
FOR i = 1 TO NUMPEOPLE
    p(i).x = (v MOD 80) + 1
    p(i).y = (v \ 80) + 1
    v = v + u
NEXT

'main loop
DO
    'change the following line to taste, to make it run faster
    _LIMIT 10
    FOR i = 1 TO NUMPEOPLE
        p(i).k = p(i).k + 1
        IF p(i).k > p(i).l THEN p(i).k = 1
        ox = p(i).x
        oy = p(i).y
        p(i).x = p(i).x + VAL(MID$(check$(i), p(i).k * 4 - 3, 2)) * p(i).xd
        p(i).y = p(i).y + VAL(MID$(check$(i), p(i).k * 4 - 1, 2)) * p(i).yd
        '"persons" aren't allowed to go off the screen nor run into each other
        IF p(i).x < 1 OR p(i).x > wd OR p(i).y < 1 OR p(i).y > ht THEN
            IF p(i).x < 1 OR p(i).x > wd THEN
                p(i).xd = p(i).xd * (-1)
            ELSE
                p(i).yd = p(i).yd * (-1)
            END IF
            p(i).x = ox: p(i).y = oy
        ELSEIF SCREEN(p(i).y, p(i).x) <> 32 THEN
            p(i).x = ox: p(i).y = oy
        END IF
    NEXT
    CLS
    FOR i = 1 TO NUMPEOPLE
        LOCATE p(i).y, p(i).x
        COLOR p(i).c
        PRINT CHR$(p(i).h);
    NEXT
    _DISPLAY
    'press [ESC] to leave program
LOOP UNTIL _KEYDOWN(27)
SYSTEM


FUNCTION repeat$ (astr AS STRING, numtimes AS INTEGER)
    DIM sret AS STRING, i AS INTEGER
    IF numtimes < 2 THEN repeat$ = astr: EXIT FUNCTION
    FOR i = 1 TO numtimes
        sret = sret + astr
    NEXT
    repeat$ = sret
END FUNCTION
Reply




Users browsing this thread: 3 Guest(s)