+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Robot floor painter (/showthread.php?tid=1667)
Robot floor painter - mnrvovrfc - 05-08-2023
This is a silly program that could almost be used as screensaver. It needs music LOL, so it's better.
I derrived the idea from a book on programming games in GW-BASIC by David L. Heiserman (had to look it up), but it's not the book being sold on Amazon that readily comes up in the searches. I think it was called "101 Games In BASIC" or alike. The programs weren't all games; some of them did silly things on the screen. My favorite from them was the "Hacker's Aid". I made my own version with fancy text-graphics and with beeping from "SOUND". It even emulated dial-tone telephone and ringing LOL.
Honorable mention was the "Surrogate Cusser" which could have gotten boring quickly. Fiddlesticks!
I don't remember very well but there might have been a version of that book for the Radio Shack TRS-80 Color Computer, or for the Model III which was incapable of sound. Instead of sound it had a subroutine that "blinked" a short message on the screen. That was its favorite trick.
This program has the "robot" moving in a different way from the old program it was derrived from. It has a quirk not found in the old program.
Code: (Select All)
'by mnrvovrfc 8-May-2023
OPTION _EXPLICIT
DIM AS LONG scren
DIM AS INTEGER px, py, xi, yi, xn, yn, xx, yy, c, l, nivel
DIM AS _UNSIGNED _BYTE redo
RANDOMIZE TIMER
scren = _NEWIMAGE(120, 31, 0)
SCREEN scren
_DELAY 0.5
_SCREENMOVE 0, 0
_TITLE "Press [ESC] to quit."
nivel = 1
px = Random1(100) + 10
py = Random1(29) + 1
xi = (Random1(2) - 1) * 2 - 1
yi = (Random1(2) - 1) * 2 - 1
xn = nivel
yn = nivel
c = 0
l = Random1(8) + 4
redo = 0
DO
_LIMIT 100
IF redo THEN
redo = 0
ELSE
outchar px, py, 219, 0
END IF
px = px + xi * xn
py = py + yi * yn
IF px < 1 OR px > 120 THEN
px = px - xi * xn
py = py - yi * yn
redo = 1
END IF
IF py < 1 OR py > 30 THEN
px = px - xi * xn
py = py - yi * yn
IF nivel > 1 THEN nivel = nivel - 1
IF Random1(2) = 1 AND xn > 1 THEN xn = xn - 1
IF Random1(2) = 1 AND yn > 1 THEN yn = yn - 1
redo = 1
END IF
IF redo = 0 THEN
IF SCREEN(py, px) = 219 THEN
px = px - xi * xn
py = py - yi * yn
IF c < l THEN
IF Random1(2) = 1 THEN
xn = nivel
IF xn > 40 THEN xn = 40
ELSEIF Random1(2) = 1 THEN
yn = nivel
IF yn > 16 THEN yn = 16
ELSE
nivel = nivel + 1
IF nivel > 50 THEN
nivel = 1
FOR yy = 1 TO 30
FOR xx = 1 TO 120
outchar xx, yy, 32, 219
NEXT
NEXT
END IF
END IF
END IF
END IF
c = c + 1
IF c > l THEN
outchar px, py, 219, 0
IF nivel > 1 THEN nivel = nivel - 1
IF Random1(2) = 1 AND xn > 1 THEN xn = xn - 1
IF Random1(2) = 1 AND yn > 1 THEN yn = yn - 1
redo = 1
END IF
END IF
IF redo THEN
xi = (Random1(2) - 1) * 2 - 1
yi = (Random1(2) - 1) * 2 - 1
c = 0
l = Random1(8) + 4
ELSE
outchar px, py, 82, 0
_DISPLAY
END IF
LOOP UNTIL _KEYDOWN(27)
_AUTODISPLAY
SYSTEM
SUB outchar (x AS INTEGER, y AS INTEGER, ca AS _UNSIGNED _BYTE, cb AS _UNSIGNED _BYTE)
STATIC sch AS _UNSIGNED _BYTE
IF cb THEN
sch = SCREEN(y, x)
IF sch = cb THEN sch = ca ELSE sch = cb
ELSE
sch = ca
END IF
LOCATE y, x: PRINT CHR$(sch);
END SUB
FUNCTION Random1& (maxvaluu&)
DIM sg%
sg% = SGN(maxvaluu&)
IF sg% = 0 THEN
Random1& = 0
ELSE
IF sg% = -1 THEN maxvaluu& = maxvaluu& * -1
Random1& = INT(RND * maxvaluu& + 1) * sg%
END IF
END FUNCTIONRE: Robot floor painter - bplus - 05-09-2023
Order out of Chaos
Code: (Select All)
'by mnrvovrfc 8-May-2023 with tiny little mod by b+
Option _Explicit
Dim As Long scren
Dim As Integer px, py, xi, yi, xn, yn, xx, yy, c, l, nivel
Dim As _Unsigned _Byte redo
Randomize Timer
scren = _NewImage(120, 31, 0)
Screen scren
_Delay 0.5
_ScreenMove 0, 0
_Title "Press [ESC] to quit."
nivel = 1
px = Random1(100) + 10
py = Random1(29) + 1
xi = (Random1(2) - 1) * 2 - 1
yi = (Random1(2) - 1) * 2 - 1
xn = nivel
yn = nivel
c = 0
l = Random1(8) + 4
redo = 0
Do
_Limit 100
If redo Then
redo = 0
Else
outchar px, py, 219, 0
End If
px = px + xi * xn
py = py + yi * yn
If px < 1 Or px > 120 Then
px = px - xi * xn
py = py - yi * yn
redo = 1
End If
If py < 1 Or py > 30 Then
px = px - xi * xn
py = py - yi * yn
If nivel > 1 Then nivel = nivel - 1
If Random1(2) = 1 And xn > 1 Then xn = xn - 1
If Random1(2) = 1 And yn > 1 Then yn = yn - 1
redo = 1
End If
If redo = 0 Then
If Screen(py, px) = 219 Then
px = px - xi * xn
py = py - yi * yn
If c < l Then
If Random1(2) = 1 Then
xn = nivel
If xn > 40 Then xn = 40
ElseIf Random1(2) = 1 Then
yn = nivel
If yn > 16 Then yn = 16
Else
nivel = nivel + 1
If nivel > 50 Then
nivel = 1
For yy = 1 To 30
For xx = 1 To 120
outchar xx, yy, 32, 219
Next
Next
End If
End If
End If
End If
c = c + 1
If c > l Then
outchar px, py, 219, 0
If nivel > 1 Then nivel = nivel - 1
If Random1(2) = 1 And xn > 1 Then xn = xn - 1
If Random1(2) = 1 And yn > 1 Then yn = yn - 1
redo = 1
End If
End If
If redo Then
xi = (Random1(2) - 1) * 2 - 1
yi = (Random1(2) - 1) * 2 - 1
c = 0
l = Random1(8) + 4
Else
outchar px, py, 82, 0
_Display
End If
Loop Until _KeyDown(27)
_AutoDisplay
System
Sub outchar (x As Integer, y As Integer, ca As _Unsigned _Byte, cb As _Unsigned _Byte)
Static sch As _Unsigned _Byte
If cb Then
sch = Screen(y, x)
If sch = cb Then sch = ca Else sch = cb
Else
sch = ca
End If
Color (y + x) Mod 16 + 1
Locate y, x: Print Chr$(sch);
End Sub
Function Random1& (maxvaluu&)
Dim sg%
sg% = Sgn(maxvaluu&)
If sg% = 0 Then
Random1& = 0
Else
If sg% = -1 Then maxvaluu& = maxvaluu& * -1
Random1& = Int(Rnd * maxvaluu& + 1) * sg%
End If
End FunctionRE: Robot floor painter - bplus - 05-09-2023
Another way to color:
Code: (Select All)
'by mnrvovrfc 8-May-2023 another little mod by b+
Option _Explicit
Dim As Long scren
Dim As Integer px, py, xi, yi, xn, yn, xx, yy, c, l, nivel
Dim As _Unsigned _Byte redo
Randomize Timer
scren = _NewImage(120, 31, 0)
Screen scren
_Delay 0.5
_ScreenMove 0, 0
_Title "Press [ESC] to quit."
nivel = 1
px = Random1(100) + 10
py = Random1(29) + 1
xi = (Random1(2) - 1) * 2 - 1
yi = (Random1(2) - 1) * 2 - 1
xn = nivel
yn = nivel
c = 0
l = Random1(8) + 4
redo = 0
Do
_Limit 100
If redo Then
redo = 0
Else
outchar px, py, 219, 0
End If
px = px + xi * xn
py = py + yi * yn
If px < 1 Or px > 120 Then
px = px - xi * xn
py = py - yi * yn
redo = 1
End If
If py < 1 Or py > 30 Then
px = px - xi * xn
py = py - yi * yn
If nivel > 1 Then nivel = nivel - 1
If Random1(2) = 1 And xn > 1 Then xn = xn - 1
If Random1(2) = 1 And yn > 1 Then yn = yn - 1
redo = 1
End If
If redo = 0 Then
If Screen(py, px) = 219 Then
px = px - xi * xn
py = py - yi * yn
If c < l Then
If Random1(2) = 1 Then
xn = nivel
If xn > 40 Then xn = 40
ElseIf Random1(2) = 1 Then
yn = nivel
If yn > 16 Then yn = 16
Else
nivel = nivel + 1
If nivel > 50 Then
nivel = 1
For yy = 1 To 30
For xx = 1 To 120
outchar xx, yy, 32, 219
Next
Next
End If
End If
End If
End If
c = c + 1
If c > l Then
outchar px, py, 219, 0
If nivel > 1 Then nivel = nivel - 1
If Random1(2) = 1 And xn > 1 Then xn = xn - 1
If Random1(2) = 1 And yn > 1 Then yn = yn - 1
redo = 1
End If
End If
If redo Then
xi = (Random1(2) - 1) * 2 - 1
yi = (Random1(2) - 1) * 2 - 1
c = 0
l = Random1(8) + 4
Else
outchar px, py, 82, 0
_Display
End If
Loop Until _KeyDown(27)
_AutoDisplay
System
Sub outchar (x As Integer, y As Integer, ca As _Unsigned _Byte, cb As _Unsigned _Byte)
Static sch As _Unsigned _Byte
If cb Then
sch = Screen(y, x)
If sch = cb Then sch = ca Else sch = cb
Else
sch = ca
End If
Color Int(x / 8) Mod 15 + 1
Locate y, x: Print Chr$(sch);
End Sub
Function Random1& (maxvaluu&)
Dim sg%
sg% = Sgn(maxvaluu&)
If sg% = 0 Then
Random1& = 0
Else
If sg% = -1 Then maxvaluu& = maxvaluu& * -1
Random1& = Int(Rnd * maxvaluu& + 1) * sg%
End If
End Function