Board Logo
« On a recurring theme »

Welcome Guest. Please Login or Register.
Nov 24th, 2017, 6:21pm


Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Please use the forums Search feature before asking.
Please post code using the code box described in Format Your Messages.
This will keep indentation, separate it better form the message and prevent gibberish.
If the code is too long for one post or additional files are needed, upload a ZIP archive to the Just BASIC Files Archive Site.

« Previous Topic | Next Topic »
Pages: 1 2  Notify Send Topic Print
 hotthread  Author  Topic: On a recurring theme  (Read 427 times)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1213
xx On a recurring theme
« Thread started on: Aug 7th, 2017, 2:15pm »

Hi John!

Here is a mod of some old code that I always liked. I wonder why?

Code:
'pulse plus.txt for JB (B+=MGA) 2017-08-07

global H$, XMAX, YMAX
H$ = "gr"
XMAX = 729
YMAX = 729

nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (700 - YMAX) / 2   'or delete if YMAX is 700 or above
ttl$ = "press or click any to quit...";space$(57);"Pulsing Plus"
open ttl$ for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "fill white"

global sq, pulse
sq = 729 'needs to be power of 3 because recursive tile 1/3 of last sq side
while 1
    scan
   call PlusX4 0, 0, 1
   if pulse then pulse = 0 else pulse = 1
wend
wait

sub PlusX4 x,y,r
    s = sq / 3 ^ r
    if pulse then
        call hue 255-r*35, 0, 0
    else
        call hue r*35, 0, 0
    end if
    call fbox x+s, y, x+2*s, y+3*s
    call fbox x, y+s, x+3*s, y+2*s
    if r > 4 then exit sub
    call PlusX4 x, y, r+1
    call PlusX4 x+2*s, y, r+1
    call PlusX4 x, y+2*s, r+1
    call PlusX4 x+2*s, y+2*s, r+1
end sub

sub hue r, g, b 'fore and back
    #gr "color ";r;" ";g;" ";b
    #gr "backcolor ";r;" ";g;" ";b
end sub

sub fbox x0, y0, x1, y1
    #gr "place ";x0;" ";y0
    #gr "boxfilled ";x1+1;" ";y1+1
end sub

sub lButtonUp H$, mx, my  'must have handle and mouse x,y
    call quit H$          '<=== H$ global window handle
end sub

sub charIn H$, c$ 
    call quit H$
end sub

sub quit H$
    close #H$ '<=== this needs Global H$ = "gr"
    end       'Thanks Facundo, close graphic wo error
end sub

sub pause mil   'tsh version has scan built-in
    t0 = time$("ms")
    while time$("ms") < t0 + mil : scan : wend
end sub

 
User IP Logged

B+
tenochtitlanuk ( John F)
Full Member
ImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 422
xx Re: On a recurring theme
« Reply #1 on: Aug 7th, 2017, 3:44pm »

A-plus, bplus!!
Recursion is fun.
Try the following- easily modified for '+' rather than 'H'...
Code:

    '***************************************************
    '**                                               **
    '**  Recursive4.bas Aug 2017 tenochtitlanuk       **
    '**                                               **
    '***************************************************


    nomainwin

    WindowWidth  = 760
    WindowHeight = 760

    open "Recursive H" for graphics_nsb_nf as #wg

    #wg "trapclose quit"

    #wg "down ; color white"
    #wg "cls ; fill 40 40 40 ; size 2"

    global length

    for index =0 to 8
        length =int( 700 /2^index)
        call H 380, 380, 680
        #wg "getbmp scr 1 1 760 760"
        bmpsave "scr", "recH" +str$( index) +".bmp"
        timer 4000, [p]
        wait
        [p]
        timer 0
    next index

    wait
    end
    '   ________________________________________________

    sub H x, y, size    '    position x, y of figure centre and size to draw
        scan
        XX =x: YY =y -5

        if size > length then
            select case
            case size >  340
                #wg "backcolor  red;       color  red        ; size 16"
            case size >  170
                #wg "backcolor  green ;    color  green      ; size  8"
            case size >   85
                #wg "backcolor  blue;      color  blue       ; size  4"
            case size >   42
                #wg "backcolor  cyan;      color  cyan       ; size  2"
            case size >   21
                #wg "backcolor  255 0 255; color  255 0 255  ; size  1"
            case size >   10
                #wg "backcolor  yellow;    color  yellow"
            case size >    5
                #wg "backcolor  white ;    color  white"
            end select

            #wg "up ; goto "; int( XX); " ";  int( YY); " ; north"

            #wg "up;    goto "; XX -size /4; " "; YY -size /4
            #wg "down ; goto "; XX -size /4; " "; YY +size /4
            #wg "up;    goto "; XX -size /4; " "; YY
            #wg "down ; goto "; XX +size /4; " "; YY
            #wg "up;    goto "; XX +size /4; " "; YY -size /4
            #wg "down ; goto "; XX +size /4; " "; YY +size /4

            call H XX -size /4, YY -size /4, int( size /2)
            call H XX -size /4, YY +size /4, int( size /2)
            call H XX +size /4, YY +size /4, int( size /2)
            call H XX +size /4, YY -size /4, int( size /2)

        end if

    end sub

    sub quit h$
        close #wg
        end
    end sub
 
User IP Logged

Visit my LB/JB pages at http://www.diga.me.uk/index.html
I use XP and Ubuntu Linux on old machines!
tenochtitlanuk ( John F)
Full Member
ImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 422
xx Re: On a recurring theme
« Reply #2 on: Aug 7th, 2017, 4:55pm »

User Image
User IP Logged

Visit my LB/JB pages at http://www.diga.me.uk/index.html
I use XP and Ubuntu Linux on old machines!
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1213
xx Re: On a recurring theme
« Reply #3 on: Aug 7th, 2017, 7:38pm »

Very lovely!

Four Square:
Code:
'recurring four square.txt for JB (B+=MGA) 2017-08-07

global H$, XMAX, YMAX
H$ = "gr"
XMAX = 729
YMAX = 729

nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (700 - YMAX) / 2   'or delete if YMAX is 700 or above
ttl$ = "press or click any to quit...";space$(57);"Four Square"
open ttl$ for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "fill black"
#gr "size 2"

oset = 0 : dir = 1
while 1
    scan
    call hue 255, 255, 255
    call drawrect .25 * XMAX, .25 * YMAX, .5 * XMAX, .5 * YMAX, oset
    oset = oset + .01 * dir
    if oset > .25 then oset = .25 : dir = dir * -1
    if oset < 0 then
        call pause 2500
        oset = 0 : dir = dir * -1
        call hue 0, 0, 0
        call fbox 0, 0, XMAX, YMAX
    end if
    call pause 200
wend

sub drawrect x, y, w, h, oset
    scan
    call box x, y, w, h
    if h > 20 then
        call hue 0, 0, 255
        call drawrect x - oset * w, y - oset * h, 2 * oset * w, 2 * oset * h, oset
        call hue 255, 255, 0
        call drawrect x + w - oset * w, y - oset * h, 2 * oset * w, 2 * oset * h, oset
        call hue 0, 160, 0
        call drawrect x - oset * w, y +  h - oset * h, 2 * oset * w, 2 * oset * h, oset
        call hue 255, 0, 0
        call drawrect x +  w  - oset * w, y +  h - oset * h, 2 * oset * w, 2 * oset * h, oset
    end if
end sub

sub hue r, g, b 'fore and back
    #gr "color ";r;" ";g;" ";b
    #gr "backcolor ";r;" ";g;" ";b
end sub

sub box x0, y0, x1, y1
    #gr "place ";x0;" ";y0
    #gr "box ";x0+x1+1;" ";y0+y1+1
end sub

sub fbox x0, y0, x1, y1
    #gr "place ";x0;" ";y0
    #gr "boxfilled ";x0+x1+1;" ";y0+y1+1
end sub

sub lButtonUp H$, mx, my  'must have handle and mouse x,y
    call quit H$          '<=== H$ global window handle
end sub

sub charIn H$, c$ 
    call quit H$
end sub

sub quit H$
    close #H$ '<=== this needs Global H$ = "gr"
    end       'Thanks Facundo, close graphic wo error
end sub

sub pause mil   'tsh version has scan built-in
    t0 = time$("ms")
    while time$("ms") < t0 + mil : scan : wend
end sub

 
User IP Logged

B+
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3619
xx Re: On a recurring theme
« Reply #4 on: Aug 8th, 2017, 01:06am »

John you got me puzzled in Reply#1
Surely recursion should not work like this?

Indeed if changed to
Code:
for index =8 to 8 

it works as I expect ;)
User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3619
xx Re: On a recurring theme
« Reply #5 on: Aug 8th, 2017, 01:08am »

Bplus, Reply #3 - feathers!
User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1213
xx Re: On a recurring theme
« Reply #6 on: Aug 8th, 2017, 10:24am »

Feathers?

Then here are eggs (maybe for Easter or Peacocks or pontificating mathematicians)
Code:
'recurring ellipsii.txt for JB (B+=MGA) 2017-08-07

global H$, XMAX, YMAX
H$ = "gr"
XMAX = 1000
YMAX = 700

nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (700 - YMAX) / 2   'or delete if YMAX is 700 or above
ttl$ = "press or click any to quit...";space$(100);"Recurring Ellipsii"
open ttl$ for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "fill black"

oset = 0 : dr = 1
while 1
    scan
    call hue 255, 255, 255
    call drawEllipsii XMAX/2, YMAX/2, XMAX, YMAX, oset
    oset = oset + .0025 * dr
    if oset >= .25 then dr = dr * -1 : oset = .25
    if oset < 0 then dr = dr * -1 : oset = 0
    'call pause 200
wend

sub drawEllipsii x, y, w, h, oset
    if w <> 0 then call ellips x, y, w, h
    scan
    if h > 40 then
        call hue 225, 0, 0
        call drawEllipsii x + w*oset, y, 2*w*oset, 2*h*oset, oset
        call hue 0, 0, 225
        call drawEllipsii x - w*oset, y, 2*w*oset, 2*h*oset, oset
        call hue 0, 180, 0
        call drawEllipsii x, y + h*oset, 2*w*oset, 2*h*oset, oset
        call hue 255, 255, 0
        call drawEllipsii x, y - h*oset, 2*w*oset, 2*h*oset, oset
    end if
end sub

sub hue r, g, b 'fore and back
    #gr "color ";r;" ";g;" ";b
    #gr "backcolor ";r;" ";g;" ";b
end sub

sub ellips x, y, w, h
    #gr "place ";x;" ";y;"; ellipse ";w;" ";h
end sub

sub lButtonUp H$, mx, my  'must have handle and mouse x,y
    call quit H$          '<=== H$ global window handle
end sub

sub charIn H$, c$ 
    call quit H$
end sub

sub quit H$
    close #H$ '<=== this needs Global H$ = "gr"
    end       'Thanks Facundo, close graphic wo error
end sub

sub pause mil   'tsh version has scan built-in
    t0 = time$("ms")
    while time$("ms") < t0 + mil : scan : wend
end sub

 
User IP Logged

B+
tenochtitlanuk ( John F)
Full Member
ImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 422
xx Re: On a recurring theme
« Reply #7 on: Aug 8th, 2017, 4:03pm »

Bplus, Yup, another nice one.

Anatoly- the for /next loop is so I could grab the screen at each depth of recursion for display as an animated GIF. It shows the need for a limit on any recursive function- otherwise it'd just draw a filled box completely full! Try say 10 or 11...

Also, oops- I left in a '-5' that shouldn't be there....
User IP Logged

Visit my LB/JB pages at http://www.diga.me.uk/index.html
I use XP and Ubuntu Linux on old machines!
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1213
xx Re: On a recurring theme
« Reply #8 on: Oct 1st, 2017, 9:33pm »

This is 4th Basic I tried this on and in JB the pattern is the same on both axis which it should NOT be with 2 different borders colors.

Oh well, the colors are marvelous!

Code:
'Persian Carpets.txt for Just Basic v1.01 [B+=MGA] 2017-10-01
'based on orig by Anne M Burns

global H$, XMAX, YMAX
H$ = "gr" : XMAX = 532 : YMAX = 532

nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2
UpperLeftY = (700 - YMAX) / 2

open "Persian Carpets" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "down"
#gr "fill black"

xo = (XMAX - 512) / 2 : yo = (YMAX - 512) / 2
while 1
  #gr "fill black"
  Dim vScreen(XMAX, YMAX)
  lft = xo : rght = 512 + xo : top = yo: bot = 512 + yo
  a = int(rnd(0)*16)
  b = int(rnd(0)*16)
  c = int(rnd(0)*16)
  call vLINE lft, top, rght, top, a
  call vLINE lft, bot, rght, bot, a
  call vLINE lft, top, lft, bot, b
  call vLINE rght, top, rght, bot, b
  call DetermineColr lft, rght, top, bot, c
  call pause 2500
wend

' Determine the color based on function f
sub DetermineColr lft, rght, top, bot, a
    scan
    IF lft < rght -2 THEN  '<<<< if you like intricate paterns go -1, for speed go -5
        c = findClr(lft, rght, top, bot, a)
        middlecol = int((lft + rght) / 2)
        middlerow = int((top + bot) / 2)
        call vLINE lft, middlerow, rght, middlerow, c
        call vLINE middlecol, top, middlecol, bot, c
        call DetermineColr lft, middlecol, top, middlerow, a
        call DetermineColr middlecol, rght, top, middlerow, a
        call DetermineColr lft, middlecol, middlerow, bot, a
        call DetermineColr middlecol, rght, middlerow, bot, a
    else
        exit sub
    end if
end sub

function findClr(lft, rght, top, bot, a)
    'dang no POINT(x, y) oh well...
    p = (vScreen(lft, top) + vScreen(rght, top) + vScreen(lft, bot) + vScreen(rght, bot))*7
    'Try values of b = 4 or b = 7
    b = 4
    findClr = int(p + a) mod 15
end function

#gr "flush"
wait

sub QBcolr colrNum
    select case colrNum
    case 0   : #gr "color black"
    case 1   : #gr "color darkblue"
    case 2   : #gr "color brown"
    case 3   : #gr "color darkcyan"
    case 4   : #gr "color darkred"
    case 5   : #gr "color darkpink"
    case 6   : #gr "color darkgreen"
    case 7   : #gr "color lightgray"
    case 8   : #gr "color darkgray"
    case 9   : #gr "color blue"
    case 10  : #gr "color green"
    case 11  : #gr "color cyan"
    case 12  : #gr "color red"
    case 13  : #gr "color pink"
    case 14  : #gr "color yellow"
    case 15  : #gr "color white"
    end select
end sub

sub vLINE x0, y0, x1, y1, QBc
    'record our line on the virtual screen
    if x0 = x1 then
        if y0 > y1 then start = y1 : fini = y0 else start = y0 : fini = y1
        for i = start to fini
            vScreen(x0, i) = QBc
        next
    else
        if x0 > x1 then start = x1 : fini = x0 else start = x0 : fini = x1
        for i = start to fini
            vScreen(i, y0) = QBc
        next
    end if
    call QBcolr QBc
    #gr "line ";x0;" ";y0;" ";x1;" ";y1  'add 1 to end point?
end sub

sub quit H$
    close #H$ 
    end
end sub

sub pause mil   'tsh version has scan built-in
    t0 = time$("ms")
    while time$("ms") < t0 + mil : scan : wend
end sub
 

User IP Logged

B+
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3132
xx Re: On a recurring theme
« Reply #9 on: Oct 3rd, 2017, 09:39am »

I am not near a computer but I wonder if the difference is that Just basic draws up to but not including the last pixel specified. Will experiment later on.
User IP Logged

bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1213
xx Re: On a recurring theme
« Reply #10 on: Oct 3rd, 2017, 11:15am »

I did try different lengths of line drawing.

But the crucial aspect of code is to have the colors recorded in the vScreen array aligned with the drawing.

512 x 512 was used so you can divide in half again and again and it always comes out an integer. This avoids rounding errors that would ruin the symmetries needed to make the piece work.
User IP Logged

B+
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3619
xx Re: On a recurring theme
« Reply #11 on: Oct 4th, 2017, 05:23am »

Quote:
This is 4th Basic I tried this on and in JB the pattern is the same on both axis which it should NOT be with 2 different borders colors.

Ha! I found it.
You code takes color from four corner points.
Code:
p = (vScreen(lft, top) + vScreen(rght, top) + vScreen(lft, bot) + vScreen(rght, bot))*7 

But if your 2 last lines
(before first call DetermineColr)
were horisontal of same color, you have four ponts of same color!

So you probably should change line array filling to
Code:
for i = start to fini-1 

so it SKIPS last point in array (as it does in real drawing).
Or think about coloring corner ponts and start it somehow differently.

Also
Quote:
'add 1 to end point?

would be
Code:
    #gr "line ";x0;" ";y0;" ";x1;" ";y1  'add 1 to end point?
    #gr "set ";x1;" ";y1
 
.

Last thing. That is
Code:
'Try values of b = 4 or b = 7
    b = 7
 
supposed to do? It seems unused...
« Last Edit: Oct 4th, 2017, 05:26am by tsh73 » User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1213
xx Re: On a recurring theme
« Reply #12 on: Oct 4th, 2017, 07:01am »

Hi tsh73,

That's it! You get an A for today! (Now I have to figure out why non-symmetrical in the other Basic. Oh, after first division, the other corners of the divided quadrant come into play, so if you have one color on left and right sides and another along the tops and bottom lines, you should get bi-lateral symmetry. But the newly drawn lines (the cross) draw over the edges... ha! I guess the 4 corners are all that matters and it has to be symmetric on both axis.)

Yes b is remains of old code I failed to remove.
I think this was the original code for the findClr function originally named f()
Code:
function findClr(lft, rght, top, bot, a)
    'dang no POINT(x, y) oh well...
    p = (vScreen(lft, top) + vScreen(rght, top) + vScreen(lft, bot) + vScreen(rght, bot))/4
    'Try values of b = 4 or b = 7
    'b = 4 'eh
    'b = 7 'eh..
    b = 13 'hmm... maybe prime numbers are better
    findClr = int(p/b + a) mod 15
end function
 


I've fiddled with the function so much... for me this was too dark in another Basic so I went int(p/b + a) mod 8 + 8 but loose richness of having more colors. With JB just about anything works as long as p is used and a modifier the a variable and modulus of course.
« Last Edit: Oct 4th, 2017, 07:20am by bplus » User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1213
xx Re: On a recurring theme
« Reply #13 on: Oct 4th, 2017, 08:05am »

Oh yeah! here we go! Bi-lateral symmetry from the occasional shortening of lines:

Code:
'Persian Carpets.txt for Just Basic v1.01 [B+=MGA] 2017-10-01
'based on orig by Anne M Burns
'2017-10-04 bi-lateral symmetry fixed! Now with color themes!

global H$, XMAX, YMAX
H$ = "gr" : XMAX = 532 : YMAX = 532

nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2
UpperLeftY = (700 - YMAX) / 2

open "Persian Carpets" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "down"
#gr "fill black"

xo = (XMAX - 512) / 2 : yo = (YMAX - 512) / 2
while 1
  #gr "fill black"
  Dim vScreen(XMAX, YMAX)
  lft = xo : rght = 512 + xo : top = yo: bot = 512 + yo
  a = int(rnd(0)*16)
  b = int(rnd(0)*16)
  c = int(rnd(0)*16)
  call vLINE lft+1, top, rght-1, top, a
  call vLINE lft+1, bot, rght-1, bot, a
  call vLINE lft, top, lft, bot, b
  call vLINE rght, top, rght, bot, b
  call DetermineColr lft, rght, top, bot, c
  call pause 2500
wend

' Determine the color based on function f
sub DetermineColr lft, rght, top, bot, a
    scan
    IF lft < rght -2 THEN  '<<<< if you like intricate paterns go -1, for speed go -5
        c = findClr(lft, rght, top, bot, a)
        middlecol = int((lft + rght) / 2)
        middlerow = int((top + bot) / 2)
        call vLINE lft, middlerow, rght, middlerow, c
        call vLINE middlecol, top, middlecol, bot, c
        call DetermineColr lft, middlecol, top, middlerow, a
        call DetermineColr middlecol, rght, top, middlerow, a
        call DetermineColr lft, middlecol, middlerow, bot, a
        call DetermineColr middlecol, rght, middlerow, bot, a
    else
        exit sub
    end if
end sub

function findClr(lft, rght, top, bot, a)
    'dang no POINT(x, y) oh well...
    p = (vScreen(lft, top) + vScreen(rght, top) + vScreen(lft, bot) + vScreen(rght, bot))*33
    'Try values of b = 4 or b = 7
    'b = 4
    'findClr = int(p + a) mod 16 'too much
    findClr = int(p/13 + a) mod 8 * 2   'less is more, yellow, green, red, brown theme
    'findClr = int(p/13 + a) mod 8 * 2 + 1  'less is more, blue and white theme
end function

'============================== sets drawing
#gr "flush"
wait

sub QBcolr colrNum
    select case colrNum
    case 0   : #gr "color black"
    case 1   : #gr "color darkblue"
    case 2   : #gr "color brown"
    case 3   : #gr "color darkcyan"
    case 4   : #gr "color darkred"
    case 5   : #gr "color darkpink"
    case 6   : #gr "color darkgreen"
    case 7   : #gr "color lightgray"
    case 8   : #gr "color darkgray"
    case 9   : #gr "color blue"
    case 10  : #gr "color green"
    case 11  : #gr "color cyan"
    case 12  : #gr "color red"
    case 13  : #gr "color pink"
    case 14  : #gr "color yellow"
    case 15  : #gr "color white"
    end select
end sub

sub vLINE x0, y0, x1, y1, QBc
    'record our line on the virtual screen
    if x0 = x1 then
        if y0 > y1 then start = y1 : fini = y0 else start = y0 : fini = y1
        for i = start+1 to fini-1
            vScreen(x0, i) = QBc
        next
    else
        if x0 > x1 then start = x1 : fini = x0 else start = x0 : fini = x1
        for i = start+1 to fini-1
            vScreen(i, y0) = QBc
        next
    end if
    call QBcolr QBc
    #gr "line ";x0;" ";y0;" ";x1;" ";y1  'add 1 to end point?
end sub

sub quit H$
    close #H$ 
    end
end sub

sub pause mil   'tsh version has scan built-in
    t0 = time$("ms")
    while time$("ms") < t0 + mil : scan : wend
end sub

 


tsh73, you were half right
Code:
   for i = start+1 to fini-1 

« Last Edit: Oct 4th, 2017, 08:15am by bplus » User IP Logged

B+
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3619
xx Re: On a recurring theme
« Reply #14 on: Oct 4th, 2017, 08:38am »

Now that's some really cool patterns.
smiley

Somehow - sometimes - some rectangles end up solid BLACK.
(I once seen central half black).
Is where a way around it?
User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
Pages: 1 2  Notify Send Topic Print
« Previous Topic | Next Topic »

Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls