RE: micro(A)v11 - aurel - 07-16-2023
simple doodle
Code: (Select All) 'by "roquedrivel" 15/07/23
'this program creates a "doodle" type effect
' which goes beyond four-leaf clovers and stuff like that
mode 1
var a1, a2, b1, b2, f1, f2, g1, g2, i1, i2, j1, j2, xx, yy
var z1, z2, d2r, xo, yo, xoff, yoff
var xa, ya, xs, ys, xl, yl, xshrink, yshrink, rr, gg, bb
var i, j, o
var x[1000], y[1000]
'"ptr" keyword is useless LOL
'initialize
d2r = (4 * atan(1)) / 180.0
xoff = 600
yoff = 400
rr = rand(32) * 4 + 96
gg = rand(32) * 4 + 96
bb = rand(32) * 4 + 96
a2 = 0
b1 = 180
b2 = 315
f1 = rand(10) / 2 + 1
f2 = rand(10) / 2 + 1
g1 = rand(11) / 4 + 1.5
g2 = rand(11) / 4 + 1.5
f1 = f1 * 100
f2 = f2 * 100
g1 = g1 * 100
g2 = g2 * 100
i1 = rand(1000) / 1000
i2 = rand(1000) / 1000
a1 = rand(1000) / 1000
if i1 > a1
j1 = i1
i1 = (rand(33) + 67) / 100
endif
if i2 > a1
j2 = i2
i2 = (rand(33) + 100) / 100
endif
i1 = i1 + rand(3)
i2 = i2 + rand(3)
j1 = j1 + rand(3)
j2 = j2 + rand(3)
o = rand(4)
a1 = 0
'create the plot
'there's no "for" loop, this really sucks! I hate "while" without "do... loop"!
i = 1
label fori01
'for i = 1 to 1000
if o = 1
z1 = a1 * d2r : z2 = b1 * d2r
xx = f1 * cos(z1) + g1 * sin(z2)
z1 = a2 * d2r : z2 = b2 * d2r
yy = f2 * sin(z1) + g2 * sin(z2)
endif
if o = 2
z1 = a1 * d2r : z2 = b1 * d2r
xx = f1 * cos(z1) + g1 * sin(z2)
z1 = a2 * d2r : z2 = b2 * d2r
yy = f2 * (sin(z1) + sin(z2))
endif
if o = 3
z1 = a1 * d2r : z2 = b1 * d2r
xx = f1 * (cos(z1) + sin(z2))
z1 = a2 * d2r : z2 = b2 * d2r
yy = f2 * sin(z1) * g2 * sin(z2)
endif
if o = 4
z1 = a1 * d2r : z2 = b1 * d2r
xx = f1 * (cos(z1) + sin(z2))
z1 = a2 * d2r : z2 = b2 * d2r
yy = f2 * (sin(z1) + sin(z2))
endif
x[i] = int(xx)
y[i] = int(yy)
a1 = a1 + i1
if a1 > 360 : a1 = a1 - 360 : endif
a2 = a2 + i2
if a2 > 360 : a2 = a2 - 360 : endif
b1 = a1 + j1
if b1 > 360 : b1 = b1 - 360 : endif
b2 = b2 + j2
if b2 > 360 : b2 = b2 - 360 : endif
i = i + 1
if i < 1000 : goto fori01 : endif
'next
'figure out which is the smallest of X and Y
xa = x[1]
ya = y[1]
i = 2
label fori02
'for i = 2 to 1000
if x[i] < xa : xa = x[i] : endif
if y[i] < ya : ya = y[i] : endif
i = i + 1
if i < 1000 : goto fori02 : endif
'next
'make all coordinates positive or zero
wcolor 0, 0, 0
xa = xa * (-1)
ya = ya * (-1)
i = 1
label fori04
x[i] = x[i] + xa
y[i] = y[i] + ya
i = i + 1
if i < 1000 : goto fori04 : endif
'figure out the total width and height of the plot
xs = x[1]
ys = y[1]
xl = x[1]
yl = y[1]
i = 2
label fori05
'for i = 2 to 1000
if x[i] < xs : xs = x[i] : endif
if y[i] < ys : ys = y[i] : endif
if x[i] > xl : xl = x[i] : endif
if y[i] > yl : yl = y[i] : endif
i = i + 1
if i < 1000 : goto fori05 : endif
'next
'use that information to scale the drawing to our graphics screen
xa = xl - xs
ya = yl - ys
if xa > xoff : j = 1 : endif
if ya > yoff : j = 1 : endif
if j = 1
i = 1
label fori06
x[i] = (x[i] / xa) * xoff
y[i] = (y[i] / ya) * yoff
i = i + 1
if i < 1000 : goto fori06 : endif
endif
'actually draw the thing
xo = x[1]
yo = y[1]
i = 2
label fori03
'for i = 1 to 1000
fcolor rr, gg, bb
line xo, yo, x[i], y[i]: 'swap
xo = x[i]
yo = y[i]
i = i + 1
if i < 1000 : goto fori03 : endif
'next
fcolor 128, 0, 216
print 0, 0, "DONE"
swap
RE: micro(A)v11 - bplus - 07-16-2023
Try a translation to QB64:
Code: (Select All) Option _Explicit
'by "roquedrivel" 15/07/23
'this program creates a "doodle" type effect
' which goes beyond four-leaf clovers and stuff like that
''mode 1
Dim a1, a2, b1, b2, f1, f2, g1, g2, i1, i2, j1, j2, xx, yy
Dim z1, z2, d2r, xo, yo
Dim xa, ya, xs, ys, xl, yl, xshrink, yshrink
Dim As Long i, j, o, rr, gg, bb, xoff, yoff
Dim x(1000), y(1000)
'"ptr" keyword is useless LOL
'initialize
d2r = _Pi / 180.0
xoff = 600
yoff = 400
rr = rand(32) * 4 + 96
gg = rand(32) * 4 + 96
bb = rand(32) * 4 + 96
a2 = 0
b1 = 180
b2 = 315
f1 = rand(10) / 2 + 1
f2 = rand(10) / 2 + 1
g1 = rand(11) / 4 + 1.5
g2 = rand(11) / 4 + 1.5
f1 = f1 * 100
f2 = f2 * 100
g1 = g1 * 100
g2 = g2 * 100
i1 = rand(1000) / 1000
i2 = rand(1000) / 1000
a1 = rand(1000) / 1000
If i1 > a1 Then
j1 = i1
i1 = (rand(33) + 67) / 100
End If
If i2 > a1 Then
j2 = i2
i2 = (rand(33) + 100) / 100
End If
i1 = i1 + rand(3)
i2 = i2 + rand(3)
j1 = j1 + rand(3)
j2 = j2 + rand(3)
o = rand(4)
a1 = 0
'create the plot
Randomize Timer
Screen _NewImage(xoff, yoff, 32)
restart:
'there's no "for" loop, this really sucks! I hate "while" without "do... loop"!
i = 1
fori01:
'for i = 1 to 1000
If o = 1 Then
z1 = a1 * d2r: z2 = b1 * d2r
xx = f1 * Cos(z1) + g1 * Sin(z2)
z1 = a2 * d2r: z2 = b2 * d2r
yy = f2 * Sin(z1) + g2 * Sin(z2)
End If
If o = 2 Then
z1 = a1 * d2r: z2 = b1 * d2r
xx = f1 * Cos(z1) + g1 * Sin(z2)
z1 = a2 * d2r: z2 = b2 * d2r
yy = f2 * (Sin(z1) + Sin(z2))
End If
If o = 3 Then
z1 = a1 * d2r: z2 = b1 * d2r
xx = f1 * (Cos(z1) + Sin(z2))
z1 = a2 * d2r: z2 = b2 * d2r
yy = f2 * Sin(z1) * g2 * Sin(z2)
End If
If o = 4 Then
z1 = a1 * d2r: z2 = b1 * d2r
xx = f1 * (Cos(z1) + Sin(z2))
z1 = a2 * d2r: z2 = b2 * d2r
yy = f2 * (Sin(z1) + Sin(z2))
End If
x(i) = Int(xx)
y(i) = Int(yy)
a1 = a1 + i1
If a1 > 360 Then a1 = a1 - 360
a2 = a2 + i2
If a2 > 360 Then a2 = a2 - 360
b1 = a1 + j1
If b1 > 360 Then b1 = b1 - 360
b2 = b2 + j2
If b2 > 360 Then b2 = b2 - 360
i = i + 1
If i < 1000 Then GoTo fori01
'next
'figure out which is the smallest of X and Y
xa = x(1)
ya = y(1)
i = 2
fori02:
'for i = 2 to 1000
If x(i) < xa Then xa = x(i)
If y(i) < ya Then ya = y(i)
i = i + 1
If i < 1000 Then GoTo fori02
'next
'make all coordinates positive or zero
Color , &HFF000000
xa = xa * (-1)
ya = ya * (-1)
i = 1
fori04:
x(i) = x(i) + xa
y(i) = y(i) + ya
i = i + 1
If i < 1000 Then GoTo fori04
'figure out the total width and height of the plot
xs = x(1)
ys = y(1)
xl = x(1)
yl = y(1)
i = 2
fori05:
'for i = 2 to 1000
If x(i) < xs Then xs = x(i)
If y(i) < ys Then ys = y(i)
If x(i) > xl Then xl = x(i)
If y(i) > yl Then yl = y(i)
i = i + 1
If i < 1000 Then GoTo fori05
'next
'use that information to scale the drawing to our graphics screen
xa = xl - xs
ya = yl - ys
If xa > xoff Then j = 1
If ya > yoff Then j = 1
If j = 1 Then
i = 1
fori06:
x(i) = (x(i) / xa) * xoff
y(i) = (y(i) / ya) * yoff
i = i + 1
If i < 1000 Then GoTo fori06
End If
'actually draw the thing
xo = x(1)
yo = y(1)
i = 2
fori03:
'for i = 1 to 1000
'Color _RGB32(rr, gg, bb)
Line (xo, yo)-(x(i), y(i)), _RGB32(rr, gg, bb) 'swap
xo = x(i)
yo = y(i)
i = i + 1
If i < 1000 Then GoTo fori03
'next
Color _RGB32(128, 0, 216)
_PrintString (0, 0), "ZZZ..."
'swap
Sleep
Cls
If _KeyDown(27) Then End
GoTo restart
Function rand% (n)
rand% = Int(Rnd * (n + 1))
End Function
Well it can't be this messy and uncolorful! I guess something was lost in translation ;-))
How about a screen shot, sir!
RE: micro(A)v11 - aurel - 07-16-2023
Yes sir MarkOfOhio
well i don't blame him but he can use subroutines instead few goto-loops
but ok
RE: micro(A)v11 - bplus - 07-16-2023
(07-16-2023, 06:19 PM)aurel Wrote: Yes sir MarkOfOhio
well i don't blame him but he can use subroutines instead few goto-loops
but ok
Ah, Mr >= 2 cats owner my code is not far off then. Here is "best of" from my translation:
RE: micro(A)v11 - mnrvovrfc - 07-16-2023
I wanted to submit a program that I converted from QB64, but I am running into some problems with the interpreter.
It doesn't support double-dimensional arrays, and it has nothing like SPACE$() to be able to fake it with strings. It doesn't look even concatenation is supported. This is what I'm trying to do:
Code: (Select All) var i, x, y, coord
'DIM scre(1 to 30, 1 to 80) as string
var scre[2400]
i = 1
while i < 2401
scre[i] = 0
i = i + 1
wend
'put something in center of screen
x = 40
y = 15
coord = (y - 1) * 80 + (x - 1)
scre[coord] = 1
i = 1
while i < 101
x = Rand(4) + 38
y = Rand(4) + 13
coord = (y - 1) * 80 + (x - 1)
if scre[coord] = 1
fcolor 255, 255, 255
print 0, 0, "FOUND IT!"
print 0, 20, i
print 20, 20, "tries."
i = 101
swap
endif
i = i + 1
wend
Because there is no POINT() neither I need a double-dimensional array to keep track of a fake screen to check stuff. The interpreter seems to have a problem with indexing the arrays. I have gone over an hour with this and am sure my code is correct.
One more thing: when a subscript for an array is out of range, this interpreter does nothing about it. Therefore it could become difficult to catch bugs.
EDIT: made a small change to the program. Saving wear and tear having to click the mouse button too many times.
RE: micro(A)v11 - aurel - 07-16-2023
Quote:but I am running into some problems with the interpreter.
hi @mnrvovrfc
( i am going to breaking my keyboard typing your nickname )
yes i have some problems too
thanks for trying
RE: micro(A)v11 - aurel - 07-16-2023
Your code now work
i changed 80 to 8 ...smaller scale
Code: (Select All) var i, x, y, coord
wcolor 0,0,0
'DIM scre(1 to 30, 1 to 80) as string
var scre[2400]
'you fill array with zeros
i = 1
while i < 2401
scre[i] = 0
i = i + 1
wend
'put something in center of screen
x = 40
y = 15
coord = (y - 1) * 8 + (x - 1)
scre[coord] = 1
i = 1
while i < 101
x = Rand(79) + 1
y = Rand(29) + 1
coord = (y - 1) * 8 + (x - 1)
if scre[coord] = 1
fcolor 255, 255, 255
print 0, 0, "FOUND IT!"
print 0, 20, i
print 20, 20, "tries."
i = 101
swap
endif
i = i + 1
swap
wend
RE: micro(A)v11 - aurel - 07-19-2023
Silly Tiles...by "roquedrivel"
Code: (Select All) 'by "roquedrivel" 19-July-2023
'silly tiles
var i, p, f, ybot, lchoic
str choic
var sx[80], sy[80], si[80], ss[80]
'initialize
choic = "111111222223334"
lchoic = len(choic) - 1
ybot = 560
'set black window background color
wcolor 0, 0, 0
'initialize tiles
i = 1
label lb01
sx[i] = (i - 1) * 10
sy[i] = ybot
si[i] = 0
ss[i] = 0
i = i + 1
if i < 80 : goto lb01 : endif
'main loop
label mloop
fcolor 142, 180, 230
i = 1
label lb02
'this is in case the programmer wants to change to a diamond or something else
drawfigure()
i = i + 1
if i < 80 : goto lb02 : endif
swap
fcolor 0, 0, 0
i = 1
label lb03
drawfigure()
i = i + 1
if i < 80 : goto lb03 : endif
'choose a tile and how to move it
p = Rand(lchoic) + 1
f = val(mstr(choic, p, 1))
p = Rand(78) + 1
if ss[p] = 0
si[p] = (f * 64 * (Rand(39) + 1)) / 10
ss[p] = 1
endif
'check all tiles to see if they need to be moved
i = 1
label lb04
if ss[i] > 0
sy[i] = sy[i] - si[i]
si[i] = si[i] - 0.1
if si[i] > 0 : si[i] = si[i] - 0.1 : endif
if si[i] > 2 : si[i] = 2 : endif
if sy[i] > ybot
sy[i] = ybot
ss[i] = 0
si[i] = 0
endif
endif
i = i + 1
if i < 80 : goto lb04 : endif
goto mloop
func drawfigure()
line sx[i], sy[i], sx[i] + 9, sy[i]
line sx[i], sy[i] + 1, sx[i] + 9, sy[i] + 1
line sx[i], sy[i] + 2, sx[i] + 9, sy[i] + 2
endfn
RE: micro(A)v11 - aurel - 07-21-2023
RoboFloorPainter by roq/mnr
Code: (Select All) 'by "roquedrivel" 16/07/23
'robot floor painter
var xi, yi, px, py, xm, ym, ox, oy, i, p, q, f
var mza, dtime, kount, myd1, myd2
var mz[3000]
'initialize
px = Rand(200)
py = Rand(150)
i = 1
label lb01
mz[i] = 0
i = i + 1
if i < 3001 : goto lb01 : endif
wcolor 0, 0, 0
q = 0
choosedirection()
kount = 0
label mloop
'display the robot
mza = 200 * py - 200
mza = mza + px - 1
mz[mza] = 1
ox = (px - 1) * 3
oy = (py - 1) * 3
fcolor 255, 160, 64
dasprite()
swap
fcolor 255, 255, 255
rect 0,0,100,26 : print 4, 4, px : print 60, 4, py
'swap
dtime = 10
mydelay()
'fcolor 0, 0, 0
'print 0, 0, px
'print 40, 0, py
'swap
fcolor 96, 96, 96
dasprite()
pset ox + 1, oy
pset ox + 2, oy + 1
pset ox, oy + 1
pset ox + 1, oy + 2
'attempt to move the robot
xm = 1
ym = 1
f = 0
ox = px
oy = py
px = px + xi
py = py + yi
if px < 1
f = 1
endif
if px > 200
f = 1
endif
if py < 1
f = 1
endif
if py > 150
f = 1
endif
if f = 1
choosedirection()
getoffedge()
endif
mza = 200 * (py - 200)
mza = mza + px - 1
if mz[mza] = 1
px = ox
py = oy
label lb11
choosedirection()
tryagain()
if f = 0 : goto cloop : endif
px = ox
py = oy
kount = kount + 1
if kount < 10000 : goto lb11 : endif
goto cloop
endif
label cloop
'swap
if kount < 10000 : goto mloop : endif
fcolor 192, 192, 192
print 0, 40, "I have gone on strike!"
swap
func mydelay()
myd1 = 0
while myd1 < 100
myd1 = myd1 + 1
myd2 = 0
while myd2 < dtime
myd2 = myd2 + 1
wend
wend
endfn
func choosedirection()
label choosedirection01
xi = Rand(2) - 1
yi = Rand(2) - 1
if xi = 0 : if yi = 0 : goto choosedirection01 : endif : endif
endfn
func dasprite()
pset ox, oy
pset ox + 1, oy + 1
pset ox + 2, oy + 2
pset ox, oy + 2
pset ox + 2, oy
'swap
endfn
func tryagain()
p = Rand(1) + 1
if p = 1 : xm = xm + 1 : endif
if p = 2 : ym = ym + 1 : endif
px = px + xi * xm
py = py + yi * ym
mza = 200 * (py - 200)
mza = mza + px - 1
f = mz[mza]
endfn
func getoffedge()
if px < 1
px = 1
xi = 1
xm = xm + 1
px = px + xi * xm
endif
if px > 200
px = 200
xi = (-1)
xm = xm + 1
px = px + xi * xm
endif
if py < 1
py = 1
yi = 1
ym = ym + 1
py = py + yi * ym
endif
if py > 150
py = 150
yi = 1 ' -1
ym = ym + 1
py = py + yi * ym
endif
endfn
RE: micro(A)v11 - mnrvovrfc - 07-21-2023
Huh? This "roquedrivel" is a pretty good programmer. I guess I have to head over to the other forum to see what I have missed.
More than likely this other person took the idea from the "Robot Floor Painter" that I presented here. Too bad it's not executed as well on the interpreter. Let's see, it's going to be difficult without "FOR... NEXT" loops and that sort of stuff.
Well, I got to read a bit into it. It looks like the "screen" would have to be made much smaller than 200x150. Since there is no POINT() or anything else to pick up the color of a pixel on the screen, to be able to tell what is one object or another. That's why the array is needed. This is the way I program but for text-mode junk. Something like those "matrix rain" screens or "bee in carrot patch" type of stuff.
I don't think "roquedrivel" meant for the robot to dance around LOL, maybe for it to keep moving in one direction until it hits an edge of the screen or it finds a tile that it already painted. Then the robot tries to "jump" over painted tiles to get to one not painted yet to resume its normal course. Because that's the way it works in my program.
|