Board Logo
« Simple Curves »

Welcome Guest. Please Login or Register.
Jan 21st, 2018, 12:47am


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 3  Notify Send Topic Print
 veryhotthread  Author  Topic: Simple Curves  (Read 4032 times)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Simple Curves
« Reply #30 on: Oct 26th, 2016, 10:01pm »

Is colordialog an LB thing?
I am getting syntax error on third to last line.

This gets things going for Menu Color sub:
Code:
[colour]    '   Choose a colour for the text
  #wg "color "; int( 256 *rnd( 1)); " "; int( 256 *rnd( 1)); " "; int( 256 *rnd( 1))
  wait
 


I've heard of alphabet soup but alphabet paint? ;P

Well maybe alphabet toothpaste!
« Last Edit: Oct 26th, 2016, 10:18pm by bplus » User IP Logged

B+
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3636
xx Re: Simple Curves
« Reply #31 on: Oct 27th, 2016, 03:11am »

Yes, colordialog is LB-only.
I just found uninitialised variable
"oldeY" in
Code:
if abs( newX -oldX) <30 or abs( newY -oldeY) <20 then wait 


But I suggest comparing distance
Code:
if sqr(( newX -oldX)^2+( newY -oldY)^2) <30 then wait 
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)
tenochtitlanuk ( John F)
Full Member
ImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 430
xx Re: Simple Curves
« Reply #32 on: Oct 27th, 2016, 07:00am »

Whoops! Sorry guys. Late night carelessness strikes again.

I originally used exactly that random color selection. Must have re-loaded in LB without thinking when I added the color selector.
'olde' was a definite typo. Introduced when I edited two lines of 'if' conditions into one. In the UK you see 'olde' in things like pub names- 'Ye olde King's Head' where it is supposed to make it seem to date back hundreds of years. So a bit like me...

I left out the Pythagoras distance test in the interest of speed.

So new contributions to ideas on how to debug
....don't do coding in a rush when you are tired and the hour is late.
....don't assume it runs and is therefore free of bugs/problems
....try to remember what language you are using!!

PS I'd always encourage JB users to at least try the free LB download- and ideally pay for it. It really DOES have a lot of extra power!
Thanks Anatoly and bplus.
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: 1255
xx Re: Simple Curves
« Reply #33 on: Oct 27th, 2016, 11:26am »

I am getting a much smoother (and more fun) squirting of text by changing the condition of painting a letter to avoiding another wait statement. Also I test distance to minimum distance.

Code:
    nomainwin
    minDrawLimit = (30^2 + 20^2)^.5  'diagonal distance of letter rectangle
    message$  ="Squirting text like paint from a tube!"
    l = len( message$)
    i = 1
    oldX = 0
    oldY = 0
    WindowWidth = 1200   'more squirting room
    WindowHeight = 700

    menu #wg, "Options", "Save", [save], "Size", [size], "Color", [colour]
    open "Paint something!" for graphics_nsb as #wg
    #wg "when leftButtonMove [paint]"
    #wg "down ; fill 200 200 200 ; backcolor 200 200 200"
    #wg "font Ubuntu_Mono 24 bold"
    wait

[paint]
    newX = MouseX
    newY = MouseY

    'I am getting a smoother outpput of text using this condition that does not call another wait
    if ((newX - oldX) ^ 2 + (newY - oldY) ^ 2) ^ .5 > minDrawLimit then
        #wg "set "; newX; " "; newY
        #wg "|"; mid$( message$, int(i), 1)  '<<<< changed \ to |
        i =i + 1
        if i > l then
            i = 1
            #wg "color "; int( 256 * rnd(1)); " "; int(256 * rnd(1)); " "; int(256 * rnd(1))
        end if
        oldX = newX
        oldY = newY
    end if
    scan
  wait

[save]
  #wg "getbmp scr 0 0 500 500"
  bmpsave "scr", "message" +str$( time$( "seconds")) +".bmp"
  wait

[size]  '   Select random size ( change fontname to a MS font if needed or add font dialogue)
  #wg "font Ubuntu_Mono "; str$( int( 50 *rnd(1) + 10)) +" bold"
  wait

[colour]    '   Choose a colour for the text
  #wg "color "; int( 256 * rnd(1)); " "; int(256 * rnd(1)); " "; int(256 * rnd(1))
  wait

 


In USA, something called "Ye Olde King's Head" would not be expected to be a pub or bar. ;-))

PS Oh dang, I see more stuff to change too like Font size limit and messages to squirt.
« Last Edit: Oct 27th, 2016, 11:33am by bplus » User IP Logged

B+
tenochtitlanuk ( John F)
Full Member
ImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 430
xx Re: Simple Curves
« Reply #34 on: Oct 27th, 2016, 12:30pm »

Ideas keep coming...
New version of the (tooth)fairy painter...
User Image
Code:
    nomainwin

    fontSize     =24

    message$     = "Squirting text like paint or toothpaste from a tube!"
    lText        = len( message$)
    i            = 0
    oldX         = 0
    oldY         = 0
    incr         = 0.1

    WindowWidth = 1200
    WindowHeight = 700

    menu #wg, "File", "Save", [save], "Reverse", [reverse]
    open "The tooth( paste) fairy paints again!!" for graphics_nsb as #wg

    #wg "when leftButtonMove [paint]"
    #wg "down ; fill 40 40 40 ; backcolor 40 40 40"
    #wg "font Ubuntu_Mono 24 bold"
    wait

[paint]
    newX = MouseX
    newY = MouseY

    if (( newX -oldX)^2 + ( newY -oldY)^2) > minDrawLimit then
        minDrawLimit = fontSize^2 + ( fontSize *0.8)^2  'diagonal distance_squared of letter rectangle
        #wg "set "; newX; " "; newY
        #wg "|"; mid$( message$, p, 1)
        p           =p +1
        if p >lText then p =1
        i           =i + 1
        #wg "font Ubuntu_Mono "; str$( int( fontSize)); " "; "bold"
        fontSize    =fontSize +incr
        if fontSize < 8 then incr = 0.4
        if fontSize >48 then incr =-0.4
        #wg "color "; str$( int( 128 +127 *cos( i /11))) +" " +str$( int( 128 +127 *sin( i /17))) +" " +str$( int( 128 +127 *sin( i /23)))
        oldX = newX
        oldY = newY
    end if
    scan
  wait

[save]
  #wg "getbmp scr 0 0 1200 700"
  bmpsave "scr", "message" +str$( time$( "seconds")) +".bmp"
  wait

[reverse]
  incr =-1 *incr
  wait
 


This version automatically cycles colour and fontsize.

PS corrected the save routine so it covered your chosen larger area...
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!
Facundo
Board Moderator


member is offline

Avatar




PM

Gender: Male
Posts: 1303
xx Re: Simple Curves
« Reply #35 on: Oct 27th, 2016, 12:37pm »

hehe

Code:
nomainwin

    WindowWidth = 640 : WindowHeight = 480
    UpperLeftX = INT((DisplayWidth-WindowWidth)/2)
    UpperLeftY = INT((DisplayHeight-WindowHeight)/2)

    Open "Graphic" for graphics_nf_nsb as #main
        #main "trapclose [quit]"

        #main "font Courier_New 20 50 bold"

        #main "down;fill white;flush"
        myName$ = "JustBASIC forum!: shake it!"
        #main "place 0 100"
        #main "backcolor cyan;color darkblue"

        listOfColors$  = "red darkgreen blue darkpink pink yellow"
        for i = 1 to len(myName$)
        #main "backcolor cyan;color "; word$(listOfColors$, int( rnd(1)*6 )+1)
        #main "|"; mid$( myName$, i, 1 )
        #main "place ";i*20;" 100"
        next

        lenght = Len(myName$)

        for x = 1 to 20*lenght step 2
         idx=idx+1
         #main "getbmp bmp";idx ;" ";x;" "; 0 ;" ";2;" ";50+50+50
        next

         #main "cls;fill white"
        a = 0
        'call hue 255, 255, 255
        while 1
        #main "discard"

           for i = 1 to idx
                scan
                y = y + sin( i/10 + a )
             '   call fbox i*2 + 50, 150 , i*2 + 52, 250
                #main "drawbmp bmp"; i;" ";i*2 +50 ;" "; int(y) +i/2-50
            next
            a = a + .5
        wend
    wait



    [quit]
    for i = 1 to idx
    unloadbmp "bmp";i
    next
    close #main : end


sub fbox x0,y0,x1,y1
    #main "place ";x0;" ";y0
    #main "boxfilled ";x1;" ";y1
end sub

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




 
User IP Logged

cundo aka MSlayer
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Simple Curves
« Reply #36 on: Oct 27th, 2016, 1:24pm »

smiley I like the different ways you both handled color changing!

John F, you are using a nice subtle change, and Facundo, you have given me an idea for palette for a color dialog.

I definitely like to see the text moving around, then you know you are not looking at a photo image. Ooohp! just got another idea!

Using mouse to draw the curve, allows any kind of curve without a bunch of math!
« Last Edit: Oct 27th, 2016, 1:32pm by bplus » User IP Logged

B+
tenochtitlanuk ( John F)
Full Member
ImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 430
xx Re: Simple Curves
« Reply #37 on: Oct 27th, 2016, 2:19pm »

Like that, facundo!
You can have a wider selection of colours if you use a comma-separated rather than space-separated string, specifying new colours in RGB format, eg
Code:
        listOfColors$  = "red,darkgreen,blue,darkpink,pink,yellow,100 100 200, 255 120 50"
 

...and increasing the index range..
Code:
        #main "backcolor cyan;color "; word$( listOfColors$, int( rnd(1)*8 )+1, ",")
 

Might try now something with a few sliders or similar controlling parameters of an animated text-on-a-path. Fun.
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: 1255
xx Re: Simple Curves
« Reply #38 on: Oct 28th, 2016, 2:51pm »

Write your name with Paint Balls!

Code:
'Paint Balls.txt for JB 2016-10-28
'from paint balls v1.bas SmallBASIC 2015-05-28 MGA/B+
'2016-10-28 tiny mod to call ball at mouse left button down
'add John's neat idea for key checking

global H$, XMAX, YMAX, cx$

H$ = "gr"
XMAX = 1200 '< actual drawing space needed
YMAX = 700  '< actual drawing space needed
cx$ = "r" 'red
Drawing = 0

nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = 100
UpperLeftY = 40

open "Paint Balls" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonDown lBD"
#gr "when leftButtonMove lButtonMove"
#gr "when characterInput charIn"
#gr "down"
#gr "fill black"
call help
wait

'============================= window procedures
sub lBD H$, x, y
    call ball x, y
end sub

sub lButtonMove H$, mx, my
    call ball mx, my
end sub

sub charIn H$, k$
   if instr( "rbgyvwcok", k$) then cx$ = k$ 
   if k$ = "h" then call help
   if k$ = "a" then call autofill
   if k$ = "f" then call fill
   if k$ = "q" then call quit H$
end sub

sub quit H$
    close #H$
    end
end sub

'====================================== drawing procedures

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

sub fcirc x, y, radius
    #gr "place ";x;" ";y;"; circlefilled ";radius
end sub

'========================================== Paint Ball procedures

sub help
    nl$ = chr$(13)
          ns$ = "*   ***** **** *** ** * Paint Balls Help * ** *** **** ******   *" + nl$ + nl$
    ns$ = ns$ + "*            Click the mouse, paint a ball              *" + nl$ + nl$

    ns$ = ns$ + "               Current Color Key is " + cx$ + nl$ +nl$

    ns$ = ns$ + "               Keys to 9 Colors:" + nl$ + nl$
    ns$ = ns$ + "r = red"    + nl$
    ns$ = ns$ + "g = green"  + nl$
    ns$ = ns$ + "b = blue"   + nl$
    ns$ = ns$ + "o = orange" + nl$
    ns$ = ns$ + "y = yellow" + nl$
    ns$ = ns$ + "v = violet" + nl$
    ns$ = ns$ + "c = cyan"   + nl$
    ns$ = ns$ + "w = white"  + nl$
    ns$ = ns$ + "k = black"  + nl$ + nl$

    ns$ = ns$ + "               Keys to other functions:" + nl$ + nl$
    ns$ = ns$ + "a = autofill 100 random balls" + nl$
    ns$ = ns$ + "f = fill in current color 100 random balls" + nl$
    ns$ = ns$ + "h = help (this dialog)" + nl$
    ns$ = ns$ + "q = quit" + nl$ + nl$

    ns$ = ns$ + "               OK, ready to paint?"
    notice ns$
end sub

sub ball x, y
    'cx$ is global variable for color setting
    for r = 32 to 0 step -1
        select case cx$
        case "r" : call hue 255 - 6 * r, 0, 0
        case "b" : call hue 0, 0, 255 - 6 * r
        case "g" : call hue 0, 220 - 6 * r, 0
        case "o" : call hue 255 - 3 * r, 180 - 4 * r, 0
        case "y" : call hue 255 - 4 * r, 255 - 4 * r, 0
        case "v" : call hue 255 - 7 * r, 0, 255 - 7 * r
        case "w" : call hue 255 - 4 * r, 255 - 4 * r, 255 - 4 * r
        case "c" : call hue 0, 196 - 3 * r, 196 - 3 * r
        case "k" : call hue 128 - 4 * r, 128 - 4 * r, 128 - 4 * r
        end select
        call fcirc x, y, r
    next
end sub

sub autofill
    'random cx$ (global)
    for i = 1 to 100
        x = rnd(0) * XMAX
        y = rnd(0) * YMAX
        c = int(rnd(0) * 9) + 1
        cx$ = mid$("rgbyovkcw", c, 1)
        call ball x, y
    next
end sub

sub fill
    'at current cx$ (global)
    for i = 1 to 100
        x = rnd(0) * XMAX
        y = rnd(0) * YMAX
        call ball x, y
    next
end sub


 


Edited 2016-10-28 with John's excellent mod, plus I wanted to draw a ball from just a click as well as from a mouse move with left button down.
« Last Edit: Oct 28th, 2016, 8:46pm by bplus » User IP Logged

B+
tenochtitlanuk ( John F)
Full Member
ImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 430
xx Re: Simple Curves
« Reply #39 on: Oct 28th, 2016, 6:34pm »

Pretty and fun!
I'd prefer to replace
Code:
sub charIn H$, k$
   'if k$ = "r" or k$ = "b" or k$ = "g" or k$ = "y" or k$ = "v" or k$ = "w" or k$ = "c" or k$ = "o" or k$ = "k" then cx$ = k$
 

..with the clearer
Code:
   if instr( "rbgyvwcok", k$) then cx$ = k$ 
but it's quibbling!
Neat..
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: 1255
xx Re: Simple Curves
« Reply #40 on: Oct 28th, 2016, 8:43pm »

John thanks! that is literally a neat idea laugh

I also edited the code allowing a ball to be drawn from just a click of the mouse. Now you can dot the i.
User IP Logged

B+
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3636
xx Re: Simple Curves
« Reply #41 on: Oct 30th, 2016, 02:22am »

Really this pain ball thing requires new thread. So I'll start one
Paint Balls (continued)
(this thread is about fitting TEXT, after all)
« Last Edit: Oct 30th, 2016, 02:25am 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: 1255
xx Re: Simple Curves
« Reply #42 on: Oct 30th, 2016, 1:44pm »

on Oct 30th, 2016, 02:22am, tsh73 wrote:
Really this pain ball thing requires new thread. So I'll start one
Paint Balls (continued)
(this thread is about fitting TEXT, after all)


Really, I hope not too much of a "pain ball"! grin

Yes, I debated that. This thread was what inspired me
to translate Paint Balls to JB (and when I found circle
drawing full of holes but fortunately not filled circles when
used in Paint Balls).

Fork is good because I have something almost ready as mod
of John's thingy. smiley
« Last Edit: Oct 30th, 2016, 1:59pm by bplus » User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Simple Curves
« Reply #43 on: Oct 30th, 2016, 9:40pm »

Whew! It seemed so easy when I imagined it, finally got it working.

Code:
'Mouse Memory Writer.txt JB
' started with code by John Tenochtitlanuk copied 2016-10-26
'2016-10-26/27 mods [B+=MGA]
' add SW, SH, minDrawLimit, menu Message and it's sub, Clear Screen and
' it's sub. Check for next letter "paint" using distance formula
' remove 2nd wait in [paint]
'2016-10-30 mods [B+=MGA] message, getMessage to change message
' Mouse memory, mouseMemory tracking first 50 letter positions
' to redraw message in loop going down track. Removed drawLimit and
' recalibrated lettering for font being used, so can cover last letter
' drawn and draw next in same spot without clearing screen.
' Random color sub added to go with chocolate$ background.
' Now sizing isn't random but prompted.
' Date_time stamp with file name MMessage when save pictures.


global curColor$

nomainwin

SW = 1200
SH = 700
chocolate$ = "60 30 20"  'background color

message$ = "The mouse is remembering first 50 positions."
l = len(message$)
i = 1     'index in message

oldX = 0  'positions of mouse
oldY = 0
top = 50  'memory positions
index = 0 'index for memory positions to fill arrays

'mouse track arrays
dim mtX(top - 1), mtY(top -1)

WindowWidth = SW + 8
WindowHeight = SH + 32
UpperLeftX = 100
UpperLeftY = 20


menu #wg, "Options", "All Clear", [CLR], "Change Message",_
    [getTheMessage], "Mouse Memory", [mouseMemory], "Size",_
    [size], "Color", rColor, "Save", [save]

open "Mouse Memory, wait for it to stop moving (after you start it)."_
    for graphics_nsb as #wg

#wg "trapclose quit"
#wg "when leftButtonMove [paint]"
#wg "down"
#wg "fill ";chocolate$
#wg "backcolor ";chocolate$
#wg "font Ubuntu_Mono 24 bold"
call rColor
wait

[paint]
    newX = MouseX
    newY = MouseY
    if abs(newX - oldX) > 36 or abs(newY - oldY) > 42 then
        #wg "set "; newX; " "; newY
        #wg "|"; mid$( message$, int(i), 1)
        i = i + 1
        if i > l then
            i = 1
            call rColor
        end if
        oldX = newX
        oldY = newY
        if index < top then
            mtX(index) = oldX
            mtY(index) = oldY
            index = index + 1
        end if
    end if
    scan
    wait

[mouseMemory]
    if index < top -1 then
        notice "Mouse is still memorizing track."
    else
        #wg "fill ";chocolate$;"backcolor ";chocolate$
        embed$ = "   " + message$ + space$(top - l - 3)
        while instr(embed$, message$) <> 2
            scan
            for tmt = 0 to top -1
                scan
                #wg "backcolor ";chocolate$
                #wg "color ";chocolate$
                #wg "place ";mtX(tmt)- 3;" ";mtY(tmt) + 8
                #wg "boxfilled ";mtX(tmt) + 31;" ";mtY(tmt) - 31
                #wg "color "; curColor$
                #wg "set "; mtX(tmt);" ";mtY(tmt)
                #wg "|"; mid$( embed$, tmt + 1, 1)
                call pause 1
            next
            embed$ = mid$(embed$, top, 1) + mid$(embed$, 1, top - 1)
        wend
    end if
    wait

[CLR]
    #wg "fill ";chocolate$; "backcolor ";chocolate$
    i = 1
    dim mtX(top - 1), mtY(top - 1)
    index = 0
    wait

[getTheMessage]
    prompt "Message" + chr$(13) + "Enter new message to squirt."; test$
    if len(test$) > 0 then message$ = test$ + "  "_
     : l = len(message$) : i = 1
    wait

[size]  'Select size (this code setup for font named below.)
    prompt "Enter a size from 8 to 24 inclusive.";test$
    t = val(test$)
    if t > 7 and t < 25 then #wg "font Ubuntu_Mono "; test$ +" bold"
    wait

[save]
    #wg "getbmp scr 0 0 ";SW;" ";SH
    d$ = date$("yyyy/mm/dd")
    d$ = mid$(d$, 1, 4) + "-" + mid$(d$, 6, 2) + "-" + mid$(d$, 9, 2)
    t$ = time$()
    t$ = mid$(t$, 1, 2) + "_" + mid$(t$, 4, 2)
    bmpsave "scr", "MMessage " + d$ + "-" + t$ + ".bmp"
    wait

sub rColor    'random color on bright side
    curColor$ = str$(127 + int( 128 * rnd(1))); " ";_
    str$(127 + int(128 * rnd(1))); " ";str$(127 + int(128 * rnd(1)))
    #wg "color "; curColor$
end sub

sub quit H$
    close #wg
    end
end sub

sub pause mil
    timer mil, [timesup]
    wait
[timesup]
    timer 0
end sub

 
User IP Logged

B+
Pages: 1 2 3  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