+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: People in SCREEN 0 (/showthread.php?tid=1370)
People in SCREEN 0 - mnrvovrfc - 01-06-2023
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