hey bplus

[marshawn]

is your JB portfolio as rich as prolific as the one on Steve's forum?

[plus]

Jul 27, 2022 5:05:09 GMT marshawn said:

is your JB portfolio as rich as prolific as the one on Steve's forum?

No graphics and speed are not nearly as good. But GUI is inspiration! So is arbitrary math, endless integers... my first Eval function was in JB. 

I wonder if I can dig that up? Probably peaked out in JB by 2018.

Ah yes! Here is some graphing with the help of Eval:
'graphing eval.txt for JB [B+=MGA] 2017-03-10
'combine evalW 2.txt and Graph Dialog 4 graphing evalB

global form$, evalErr$, pi, rad, deg, Dflag, globalx
global sminx, sminy, smaxx, smaxy  'for xScreen, yScreen functions
pi = acs(-1) : rad = pi / 180 : deg = 180 / pi
Dflag = 1 : globalx = 5  'changeable

nomainwin
WindowWidth = 525
WindowHeight = 680
UpperLeftX = int((DisplayWidth - WindowWidth) / 2)
UpperLeftY = int((DisplayHeight - WindowHeight) / 2)

textbox #g.tbForm, 5, 5, 455, 30

textbox #g.tbStartX 5, 40, 60, 30
statictext #g.lbStartX, "X Start", 70, 45, 50, 30
textbox #g.tbEndX 125, 40, 60, 30
statictext #g.lbEndX, "X End", 190, 45, 50, 30

textbox #g.tbStartY 5, 75, 60, 30
statictext #g.lbStartY, "Y Min", 75, 80, 50, 30
textbox #g.tbEndY 125, 75, 60, 30
statictext #g.lbEndY, "Y Max", 190, 80, 50, 30

button #g.btoggle, "Angles", toggleMeas, UL, 250, 40
statictext #g.lbAngle, "Degrees", 325, 45, 55, 30
button #g.bGraph, "GRAPH", graph, UL, 400, 40

graphicbox #g.gb 5, 115, 510, 500
statictext #g.lbZoom, "Zoom: i = in o = out     Arrows: left, right, up down", 100, 620, 340, 25

open "Graphing function strings" for graphics_nsb_nf as #g
#g "font arial 12"
#g "trapclose quit"
#g.tbForm "cos(x())"  '<< whatever formula string to start with
#g.tbStartX "-360"     '<< for starters
#g.tbEndX "360"        '<<
#g.tbStartY "-2"     '<< for starters
#g.tbEndY "2"
wait

sub graph h$
   #g.tbForm "!contents? form$"
   if form$ = "" then
       notice "Formula text box is empty."
       exit sub
   end if
   #g.tbStartX "!contents? xStart$"
   if xStart$ = "" then
       notice "X start is empty."
       exit sub
   else
       sminx = val(xStart$)
   end if
   #g.tbEndX "!contents? xEnd$"
   if xEnd$ = "" then
       notice "X End is empty."
       exit sub
   else
       smaxx = val(xEnd$)
   end if

   #g.tbStartY "!contents? xStart$"
   if xStart$ = "" then
       notice "Y Min is empty."
       exit sub
   else
       sminy = val(xStart$)
   end if
   #g.tbEndY "!contents? xEnd$"
   if xEnd$ = "" then
       notice "Y Max is empty."
       exit sub
   else
       smaxy = val(xEnd$)
   end if

   call showGraph form$

end sub

sub toggleMeas h$
   if Dflag = 0 then Dflag = 1 else Dflag = 0
   if Dflag then
       #g.lbAngle "Degrees"
   else
       #g.lbAngle "Radians"
   end if
end sub

sub fore r, g, b
   #g.gb "color ";r;" ";g;" ";b
end sub

sub aline x0, y0, x1, y1
   #g.gb "line ";x0;" ";y0;" ";x1;" ";y1
end sub

sub stext x, y, message$
   #g.gb "place ";x;" ";y;";|";message$
end sub

sub quit H$
   close #g
   end
end sub

sub showGraph gTitle$
   #g.gb "when characterInput [keyHandler]"
   #g.gb "font arial 8"
   #g.gb "down"
   #g.gb "setfocus"

[restartGraphDialog]
   scan
   #g.gb "cls"
   #g.gb "size 1"

   'graph box section
   #g.gb "color cyan"
   #g.gb "backcolor lightgray"
   #g.gb "place ";0;" ";0
   #g.gb "boxfilled ";400;" ";400
   #g.gb "backcolor white"

   x0 = xScreen(0) : y0 = yScreen(0)

   'xgrid lines
   inc = (smaxx - sminx) / 20
   #g.gb "color cyan"
   if 0 <= x0  and x0 <= 400 then
       start = 0
       while start <= smaxx
           scan
           #g.gb "line ";xScreen(start);" ";0;" ";xScreen(start);" ";400
           start = start + inc
       wend
       start = 0
       while start >= sminx
           scan
           #g.gb "line ";xScreen(start);" ";0;" ";xScreen(start);" ";400
           start = start - inc
       wend
   else
       start = sminx
       for i = 0 to 20
           #g.gb "line ";i * 20;" ";0;" ";i * 20;" ";400
           start = start + inc
       next
   end if
   #g.gb "color black"
   #g.gb "place ";  2;" ";415;";| x min (left) is ";sminx;"."
   #g.gb "place ";145;" ";430;";| x scale increment is ";inc;"."
   #g.gb "place ";170;" ";445;";| x middle is ";sminx + 10 * inc;"."
   #g.gb "place ";325;" ";460;";| x max (right) is ";smaxx;"."

   'y grid lines
   inc = (smaxy - sminy) / 20
   if 0 <= y0  and y0 <= 400 then
       start = 0
       while start <= smaxy
           scan
           #g.gb "color cyan"
           #g.gb "line ";0;" ";yScreen(start);" ";400;" ";yScreen(start)
           #g.gb "color black"
           #g.gb "place ";405;" ";yScreen(start);";|";start
           start = start + inc
       wend
       start = 0
       while start >= sminy
           scan
           #g.gb "color cyan"
           #g.gb "line ";0;" ";yScreen(start);" ";400;" ";yScreen(start)
           #g.gb "color black"
           #g.gb "place ";405;" ";yScreen(start);";|";start
           start = start - inc
       wend
   else
       start = sminy
       for i = 0 to 20
           #g.gb "color cyan"
           #g.gb "line ";0;" ";i * 20;" ";400;" ";i * 20
           #g.gb "color black"
           #g.gb "place ";405;" ";400 -(i*20);";|";start
           start = start + inc
       next
   end if

   #g.gb "size 2"

   'x, y axis if in graph
   #g.gb "color yellow"
   if 0 <= y0  and y0 <= 400 then
       #g.gb "line ";xScreen(sminx);" ";y0;" ";xScreen(smaxx);" ";y0
   end if
   if 0 <= x0  and x0 <= 400 then
       #g.gb "line ";x0;" ";yScreen(sminy);" ";x0;" ";yScreen(smaxy)
   end if

   'fx graph just dots now
   #g.gb "color blue"
   stepper = (smaxx - sminx)/400
   for xfx = sminx to smaxx step stepper
       x = xScreen(xfx) : y = yScreen(fx(xfx))
       if x > 0 and x < 400 and y > 0 and y < 400 then
           #g.gb "set ";x;" ";y
       end if
   next
   #g.gb "flush"
   wait

[keyHandler] 'all these just readjust sminx, smaxx, sminx, sminy
   key$ = Inkey$
   if len(key$) < 2 then
       if key$ = "o" then
           diff = (smaxx - sminx) / 2 : sminx = sminx - diff : smaxx = smaxx + diff
           diff = (smaxy - sminy) / 2 : sminy = sminy - diff : smaxy = smaxy + diff
       end if
       if key$ = "i" then
           diff = (smaxx - sminx) / 4 : sminx = sminx + diff : smaxx = smaxx - diff
           diff = (smaxy - sminy) / 4 : sminy = sminy + diff : smaxy = smaxy - diff
       end if
   else
       select case asc(right$(key$, 1))
       case 37 'left
           diff = (smaxx - sminx) * .1 : sminx = sminx - diff : smaxx = smaxx - diff
       case 38 'up
           diff = (smaxy - sminy) * .1 : sminy = sminy + diff : smaxy = smaxy + diff
       case 39 'right
           diff = (smaxx - sminx) * .1 : sminx = sminx + diff : smaxx = smaxx + diff
       case 40 'down
           diff = (smaxy - sminy) * .1 : sminy = sminy - diff : smaxy = smaxy - diff
       end select
   end if
goto [restartGraphDialog]

end sub

'conversions (logical coords to screen) tsh73 2017-03-04
function xScreen(x)
   'global sminx, sminy, smaxx, smaxy  'for xScreen, yScreen functions
   xScreen = (x - sminx) / (smaxx - sminx) * 400
end function

function yScreen(y)
   'global sminx, sminy, smaxx, smaxy  'for xScreen, yScreen functions
   yScreen = (1 - (y - sminy) / (smaxy - sminy)) * 400
end function

function fx(x) 'any general function of x
   globalx = x : evalErr$ = ""
   r = evaluate(form$)
   if evalErr$ = "" then fx = r
end function

function evaluate(e$)
   'make sure ( ) + * / % ^ are wrapped with spaces on your own with -
   for i = 1 to len(e$)   'filter chars and count ()
       c$ = lower$(mid$(e$, i, 1))
       select case
       case c$ = ")" : po = po - 1 : b$ = b$;" ) "
       case c$ = "(" : po = po + 1 : b$ = b$;" ( "
       case instr("+*/%^", c$) > 0 : b$ = b$;" ";c$;" "
       case instr(" -.0123456789abcdefghijklmnopqrstuvwxyz", c$) > 0 : b$ = b$;c$
       end select
       if po < 0 then evalErr$ = "Too many )" : exit function
   next
   if po <> 0 then evalErr$ = "Unbalanced ()" : exit function
   e$ = b$
   for i = 1 to 3
       p = wIn(e$, word$("x e pi", i))
       while p > 0
           select case i
               case 1 : subst$ = str$(globalx)
               case 2 : subst$ = str$(exp(1))
               case 3 : subst$ = str$(pi)
           end select
           call wsSub e$, p, p, subst$
           p = wIn(e$, word$("x e pi", i))
       wend
   next
   evaluate = evalW(e$)
end function

function evalW(s$)
   scan
   pop = wIn(s$, "(") 'parenthesis open place
   while pop > 0
       scan
       if pop = 1 then
           fun$ = "" : lPlace = 1
       else
           test$ = word$(s$, pop - 1)
           funPlace = wIn("sin cos tan asin acos atan log exp sqr rad deg", test$)
           if funPlace > 0 then
               fun$ = test$ : lPlace = pop - 1
           else
               fun$ = "" : lPlace = pop
           end if
       end if
       wc = wCnt(s$) : po = 1
       for i = pop + 1 to wc
           if word$(s$, i) = "(" then po = po + 1
           if word$(s$, i) = ")" then po = po - 1
           if po = 0 then rPlace = i : exit for
       next
       inner$ = ""
       for i = (pop + 1) to (rPlace - 1)
           w$ = word$(s$, i)
           inner$ = inner$;w$;" "
           if wIn("( + - * / % ^", w$) > 0 then recurs = 1
       next
       if recurs then inner = evalW(inner$) else inner = val(inner$)
       select case fun$
           case ""    : m = inner
           case "sin" : if Dflag then m = sin(rad * inner) else m = sin(inner)
           case "cos" : if Dflag then m = cos(rad * inner) else m = cos(inner)
           case "tan" : if Dflag then m = tan(rad * inner) else m = tan(inner)
           case "asin": if Dflag then m = deg * (asn(inner)) else m = asn(inner)
           case "acos": if Dflag then m = deg * (acs(inner)) else m = acs(inner)
           case "atan": if Dflag then m = deg * (atn(inner)) else m = atn(inner)
           case "log"
               if inner > 0 then
                   m = log(inner)
               else
                   evalErr$ = "LOG only works on numbers > 0." : exit function
               end if
           case "exp"  'the error limit is inconsistent!!!!!!!!!!!!!!!!!
               'I had to readjust limit, memory problem ????????????????????????
               'this worked fine tested alone up to -708 +709

               if -693 <= inner and inner <= 709 then 'your system may have different results
                   m = exp(inner)
               else
                   ' what the heck???? 708 works fine all alone as limit ?????
                   evalErr$ = "EXP only works for ABS(number) <= ??? using 693." : exit function
               end if
           case "sqr"
               if inner >= 0 then
                   m = sqr(inner)
               else
                   evalErr$ = "SQR only works for numbers >= 0." : exit function
               end if
           case "rad" : m = inner * rad
           case "deg" : m = inner * deg
           case else  : evalErr$ = "Unidentified function ";fun$ : exit function
       end select
       call wsSub s$, lPlace, rPlace, str$(m)
       pop = wIn(s$, "(")
   wend
   ops$ = "%^/*-+"   'all () cleared, now for binary ops
   for o = 1 to 6
       op$ = mid$(ops$, o, 1)
       p = wIn(s$, op$)
       while p > 0
           scan
           a = val(word$(s$, p - 1))
           b = val(word$(s$, p + 1))
           select case op$
           case "%"
               if b >= 2 then
                   middle$ = str$(int(a) mod int(b))
               else
                   evalErr$ = "For a Mod b, b value < 2."
                   exit function
               end if
           case "^"
               if int(b) = b or a >= 0 then
                   middle$ = str$(a ^ b)
               else
                   evalErr$ = "For a ^ b, a needs to be >= 0 when b not integer."
                   exit function
               end if
           case "/"
               if b <> 0 then
                   middle$ = str$(a / b)
               else
                   evalErr$ = "Div by 0"
                   exit function
               end if
           case "*" : middle$ = str$(a * b)
           case "-" : middle$ = str$(a - b)
           case "+" : middle$ = str$(a + b)
           end select
           call wsSub s$, p - 1, p + 1, middle$
           p = wIn(s$, op$)
       wend
   next
   evalW = val(s$)
end function

sub wsSub byref s$, first, last, subst$  'far more powerful
   wc = wCnt(s$)
   for i = 1 to wc
       if first <= i and i <= last then 'do this only once!
           if subF = 0 then b$ = b$;subst$;" " : subF = 1
       else
           b$ = b$;word$(s$, i);" "
       end if
   next
   s$ = b$
end sub

function wIn(s$, w$) 'first in s$ that matches w$ (no spaces in w$!)
   wIn = 0 : wc = wCnt(s$)
   for i = 1 to wc
       if w$ = word$(s$, i) then wIn = i : exit function
   next
end function

function wCnt(s$) 'of default space delimited string
   while word$(s$, wc + 1) <> "" : wc = wc + 1 : wend
   wCnt = wc
end function

Eval was inspired by my favorite JB Function Word$().

[plus]

Here is another Gem from bplus JB Treasure Chest:

Dragged out and posted at Liberty Forum but why should they have all the fun?

'Rotate colors on a sphere.txt for JB v2.0 bplus 2018-04-16
'2018-04-16 EDIT #1 Fix final circle drawn and add discard to clear memory

'from (extremely simplified)
' Double spiral.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-03-28
'from figosdev post at http://smallbasic.sourceforge.net/?q=node/1684#comment-1955
'translating fig to SmallBASIC for alittle cross pollination...

global rrr, ggg, bbb, ccc  'mod
global  XMAX, YMAX, pi
XMAX = 600  '< actual drawing space needed
YMAX = 600  '< actual drawing space needed
pi = acs(-1)
nomainwin
WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = 300
UpperLeftY = 40

open "Rotate colors on sphere     press q to quit " for graphics_nsb_nf as #gr
#gr "trapclose quit"
#gr "setfocus"
#gr "when characterInput charIn"
#gr "down"
#gr "fill black;flush"
cx = 300
ww = 3.14159 / 2  'fix to return back to this after each run
while 1
   scan
   #gr "discard" 'fix to clear memory
   call setRGB
   w = ww        'fix
   for r = 490 to 300 step -.25
       scan
       e = w - pi / 4 / (490 - 300)
       'swap w, e
       tmp = e : e = w : w = tmp
       for p = -1 * pi to pi step pi / 144
           scan
           e = int((cos(w) * 380) / 2)
           x = int(cos(p * 2) * e + cx)
           y = int(sin(p * 2) * e + r - 50)
           lc = lc + 1
           if lc mod 90 = 0 then
               ccc = ccc + .2
               call changeRGB
               #gr "place ";x;" ";y
               #gr "circlefilled ";12
           end if
       next
       call pause 10
   next
   '#gr "color white"
   '#gr "backcolor black"
   '#gr "place ";x-7;" ";y+5;";|";"B+"  'make new JB avatar
   #gr "flush"
   call pause 5000
wend
wait

sub quit h$
   close #gr
   end
end sub

sub charIn h$, k$    'mod
   if k$ = "q" then call quit h$
end sub

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

sub setRGB 'mod
   rrr = rnd(0)^2 : ggg = rnd(0)^2 : bbb = rnd(0)^2
end sub

sub changeRGB 'mod
   c$ = 127 + 127 * sin(rrr * ccc);" ";127 + 127 * sin(ggg * ccc);" ";127 + 127 * sin(bbb * ccc)
   #gr "color ";c$
   #gr "backcolor ";c$
end sub



[plus]

Here is another one I just dug up from out of the sand:
'_Title "Shell of another color 3" 'b+2020-01-25 trans 2022-07-30
'inspired by "shell-like thing" by tsh73 Jan 2020 at JB
' 2020-01-27 Shell of another color 3 adds more improvements

global H$, XMAX, YMAX, PI, DEG, RAD, goON
H$ = "gr"
Xmax = 660 '<======================================== actual drawing space needed
Ymax = 660 '<======================================== actual drawing space needed
Pi = acs(-1)
Deg = 180 / Pi
Rad = Pi / 180

nomainwin

WindowWidth = Xmax + 8
WindowHeight = Ymax + 32
UpperLeftX = (DisplayWidth - Xmax) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (DisplayHeight - Ymax) / 2   'or delete if YMAX is 700 or above

open "Shell of another color" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "size 2"
#gr "down"
#gr "fill black"

Dim x(1600), y(1600)
' dim c As _Unsigned Long
cx = 340: cy = 390: stepper = 1/200*Pi
For a = 0 To Pi*8 Step stepper ' load x, y arrays
   scan
   x(i) = cx + ra * Cos(a): y(i) = cy + ra * Sin(a)
   dr = dr + 1 / 1700: ra = ra + dr ^ 2: i = i + 1
Next
While 1
   scan
   R = Rnd(0) ^ 2: G = Rnd(0) ^ 2: B = Rnd(0) ^ 2: PN = 0: size = 1
   For i = 0 To 1139
       scan
       dx = x(i + 400) - x(i): dy = y(i + 400) - y(i)
       dist = Sqr(dx * dx + dy * dy): dx = dx / dist: dy = dy / dist: PN = PN + .73
       if i > 950 then
           #gr "size 6"
       else
           If i > 820 Then
               #gr "size 5"
           Else
               if i > 370 then
                   #gr "size 3"
               end if
           End If
       End If
       For j = 0 To dist
           scan
           shade = 1 - ((dist / 2 - j + 1 / 2) / (dist / 2)) ^ 2
           rr = shade * Int(127 + 127 * Sin(R * PN))
           if rr < 0 then rr = 0
           gg = shade * Int(127 + 127 * Sin(G * PN))
           if gg < 0 then gg = 0
           bb = shade * Int(127 + 127 * Sin(B * PN))
           if bb < 0 then bb = 0
           #gr "color ";rr;" ";gg;" ";bb
           #gr "set ";x(i) + j * dx;" ";y(i) + j * dy
       Next
   Next
   #gr "flush"
   call pause 2000
Wend
wait

sub quit H$
   close #gr '<=== 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


[plus]

This one might be very close to what Rod is looking for BUT these are straight lines across AND we need to taper down so we end with nice round circle... just got done writing up a Sub I call, ArcOfTheChord(Ax, Ay, Bx, By), coming soon if all goes well ;-))

[marshawn]

Wow, that is some serious JB, bplus, really nice.  post more mods if you have.

Here is your graphing calc running in your new favourite os, linux

[plus]

Hey marshawn Rod has shown me a link to this sorta challenge at Liberty Basic (LB), JB's big brother:
libertybasiccom.proboards.com/thread/2062/more-old-basic-books
John T ( T for tenochtitlanuk, T is much easier) a great JB, more LB, graphics fan too!

Write a program that attempts to duplicate the graphic of that old magazine cover. I don't think you need to add the warps, worn edges or scotch tape ;-)) I've been working on it all day yesterday, not the prettiest of graphics but good challenge. Close to finishing and will post here unless Rod or someone else tsh73? John T himself?, starts a thread for it here. I can now draw arcs on 2 points of a line, or endpoints of line segment. At first I did it from a given radius but the arcs in the magazine cover seemed much flatter from radii possibly the outer edge of circle or beyond...

Personal update: back to Windows 10 OS now that I have my old computer hard drive replaced with SSD and even bought a sweet little refurbished Dell with SSD and fresh install of Windows 10. Bootups are a second or 2! Sure beats minutes to boot up the old hard drive and then wait until Windows gets done fooling around with my Disk Usage enough that I can use the computer.

BTW, your screen shot is curious, I am looking at the 2 sets of controls on the running JB IDE app, seems to have a link right in Title bar?.
Is that running in Mint or some other app that can run Windows exes?

[Rod]

If there is a specific way to get JB running happily in Linux a little tutorial or list of preferred options installing Linux would be good.

I dabbled with Apple MAC M1 and running Windows on Parallels but it is an expensive way to get to Windows and buggy too, if not buggy slow!

So I too am back to a Windows machine.

[plus]

Re:

Rod has shown me a link to this sorta challenge at Liberty Basic (LB), JB's big brother:

libertybasiccom.proboards.com/thread/2062/more-old-basic-books

Well this is about as good as I can make it, wasted enough time on it:

' Title "Graphic Challenge LB 2022-07-30" 'b+2022-07-30
' 2022-07-30 started from Shell of Another Color added ArcOfTheChord
' 2022-07-31 final touch ups and post 2 version color scheme

global Xmax, Ymax, Pi
Xmax = 660
Ymax = 660
Pi = acs(-1)

nomainwin

WindowWidth = Xmax + 8
WindowHeight = Ymax + 32
UpperLeftX = (DisplayWidth - Xmax) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (DisplayHeight - Ymax) / 2   'or delete if YMAX is 700 or above

toner$ = 100;" ";220;" ";50 ' Attempt to tone down big contrast between yellow and black

' !!!!!!!!!!!!!!!!!!!!!!!!!!!!! Switch for 2 Coloring Versions !!!!!!!!!!!!!!!!!!!!!!!!!!!
ToneDown = 1 ' switch for 2 versions of coloring

open "Grpahic Challenge at LB 2022-07-30" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "size 1"
#gr "down"
if ToneDown then
   #gr "fill ";toner$  ' loaded with allot of yellow to reduce contrast with background
else
   #gr "fill black"
end if

Dim x(2200), y(2200)  ' oversized
cx = 330: cy = 330: rLimit = 300: stepper = Pi/200
For a = 0 To Pi*11 Step stepper ' load x, y arrays
   scan
   x(i) = cx + ra * Cos(a): y(i) = cy + ra * Sin(a)
   If Sqr((x(i) - cx) ^ 2 + (y(i) - cy) ^ 2) > rLimit Then
       x(i) = cx + 300 * Cos(a): y(i) = cy + 300 * Sin(a)
   End If
   dr = dr + 1 / 1700: ra = ra + dr ^ 2: i = i + 1
Next

#gr "color yellow"         'for shell color
#gr "backcolor yellow"
For i = 0 To 1500 Step 2
   scan
   #gr "size 1"
   call ArcOfTheChord x(i), y(i), x(i + 400), y(i + 400) ' 400
   select case
   case i < 400
       #gr "size 4"
   case i < 600
       #gr "size 5"
   case i < 700
       #gr "size 6"
   case i < 800
       #gr "size 8"
   case i < 900
       #gr "size 10"
   case i < 975
       #gr "size 11"
   case i < 1050
       #gr "size 12"
   case i < 1100
       #gr "size 13"
   case i < 1150
       #gr "size 14"
   case i < 1600
       #gr "size 15"
   end select
   #gr "set ";x(i + 400);" ";y(i + 400)
Next

#gr "size 1"
if ToneDown then              ' center "hole"
   #gr "color ";toner$       ' for shell background closer to yellow
   #gr "backcolor ";toner$
else
   #gr "color black"    ' for shell background to match magazine cover
   #gr "backcolor black"
end if
#gr "place ";310;" ";310
#gr "boxfilled ";350;" ";350

#gr "color yellow"            'for shell color
#gr "backcolor yellow"
#gr "line ";330;" ";300;" ";330;" ";360  ' 2 center crosses crissed
#gr "line ";300;" ";330;" ";360;" ";330
#gr "line ";300;" ";300;" ";360;" ";360
#gr "line ";300;" ";360;" ";360;" ";300

dx = 15: dx1 = 13
While accum < 30             ' more lines blending to solid yellow
   accum = accum + dx
   accum1 = accum1 + dx1
   #gr "line ";330 - accum1;" ";330 - accum1;" ";330 - accum1;" ";330 + accum1
   #gr "line ";330 + accum1;" ";330 - accum1;" ";330 + accum1;" ";330 + accum1
   #gr "line ";330 - accum1;" ";330 - accum1;" ";330 + accum1;" ";330 - accum1
   #gr "line ";330 - accum1;" ";330 + accum1;" ";330 + accum1;" ";330 + accum1

   #gr "line ";330;" ";330-accum;" ";330+accum;" ";330
   #gr "line ";330;" ";330+accum;" ";330+accum;" ";330
   #gr "line ";330;" ";330+accum;" ";330-accum;" ";330
   #gr "line ";330;" ";330-accum;" ";330-accum;" ";330

   dx = dx * .5
   if dx < 1 then dx = 1
   dx1 = dx1 * .5
   if dx1 < 1 then dx1 = 1
Wend
for r = 20 to 30
   #gr "place ";330;" ";330;"; circle ";r
next
#gr "Flush"
wait

sub quit H$
   close #gr
   end
end sub

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

' modified and simplified for flatter arcs attempting to match magazine cover
Sub ArcOfTheChord Ax, Ay, Bx, By ' well one of them anyway ;-)) 2022-07-30 for LB Challenge
   pd2 = Pi/2 ' constant for 90 degrees
   dd2 = .5 * Sqr((Ax - Bx) ^ 2 + (Ay - By) ^ 2) ' dist between A and B want mid point
   mx = (Ax + Bx) / 2: my = (Ay + By) / 2
   a = Atan2(By - Ay, Bx - Ax) ' angle of B to A
   r = 100  ' just make up a radius that gets close to flatness in magazine cover
   ox = mx + r * Cos(a + pd2): oy = my + r * Sin(a + pd2)
   r1 = Sqr((ox - Ax) ^ 2 + (oy - Ay) ^ 2) ' Now find distance of O to A !!! that radius
   oa = Atan2(Ay - oy, Ax - ox)
   ob = Atan2(By - oy, Bx - ox)
   call arc ox, oy, r1, oa, ob
End Sub

'use radians
Sub arc x, y, r, raBegin, raEnd ' updated 2021-09-09
   ' raStart is first angle clockwise from due East = 0 degrees
   ' arc will start drawing there and clockwise until raStop angle reached
   'x, y origin, r = radius, c = color
   p = Pi: p2 = p * 2

   ' Last time I tried to use this SUB it hung the program, possible causes:
   ' Make sure raStart and raStop are between 0 and 2pi.
   ' This sub does not have to be recursive, use GOSUB to do drawing to execute arc in one call.

   'make copies before changing
   raStart = raBegin: raStop = raEnd
   While raStart < 0: raStart = raStart + p2: Wend
   While raStart >= p2: raStart = raStart - p2: Wend
   While raStop < 0: raStop = raStop + p2: Wend
   While raStop >= p2: raStop = raStop - p2: Wend

   If raStop < raStart Then
       dStart = raStart: dStop = p2 - .00001
       GoSub [drawArc]
       dStart = 0: dStop = raStop
       GoSub [drawArc]
   Else
       dStart = raStart: dStop = raStop
       GoSub [drawArc]
   End If
   Exit Sub
   [drawArc]
   al = p * r * r * (dStop - dStart) / p2
   For a = dStart To dStop Step 10 / al   ' orig 1/al
       #gr "set ";x + r * Cos(a);" ";y + r * Sin(a)
   Next
   Return
End Sub

Function Atan2(y, x)
   'Atan2 is a function which determines the angle between points
   'x1, y1 and x2, y2. The angle returned is in radians
   'The angle returned is always in the range of
   '-PI to PI radians (-180 to 180 degrees)
   '==============================================================
   'NOTE the position of Y and X arguments
   'This keeps Atan2 function same as other language versions
   '==============================================================
  If x = 0 Then
      If y < 0 Then
           Atan2 = -1.5707963267948967
       Else
           Atan2 = 1.5707963267948967
       End If
  Else
      chk = atn(y/x)
      If x < 0 Then
          If y < 0 Then
               chk = chk - 3.1415926535897932
           Else
               chk = chk + 3.1415926535897932
           End If
      End If
       Atan2 = chk
  End If
  'thanks Andy Amaya
End Function



The code has a "ToneDown" switch that when <>0 makes a background with lots of yellow to "Tone Down" all the interference patterns that Yellow lines on Black background make. see first screen shot.


Turn the switch to false ToneDown = 0 and you will see my best attempt to duplicate that magazine cover from the link.

[tsh73]

It happened to be harder then it looks.

'spiral-like thing - old book cover contest
'tsh73 Jul2022
nomainwin

WindowHeight = 1040
WindowWidth = 1010
WindowHeight = 740
WindowWidth = 710

open "Old book cover" for graphics_nsb_nf as #gr
#gr "home; down; posxy cx cy"
#gr "trapclose [quit]"
#gr "fill black"
#gr "color yellow"
#gr "color 196 225 72"  'screengrabbed color

pi = acs(-1)

R0=30
#gr "circle ";R0
'goto [central]
R=300
#gr "circle ";R
n = 10
da1=pi/6
aN =  2.7*pi

[central]
'now central thing. 10 pixels widest cell...
x=0-R0+1
while x < R0
   SCAN
   y=sqr(R0^2-x^2)
   #gr "line ";cx+x;" ";cy+y;" ";cx+x;" ";cy-y
   #gr "line ";cx+y;" ";cy+x;" ";cx-y;" ";cy+x
  x=x+10*y^2/R0^2
wend
x=0-R0+1
while x < R0 'somehow made diagonals too
   SCAN
   y=sqr(R0^2-x^2)
   #gr "line ";cx+x;" ";cy+y;" ";cx+y;" ";cy+x
   #gr "line ";cx-x;" ";cy-y;" ";cx+y;" ";cy+x
  x=x+15*y^2/R0^2
wend
'wait

'goto [skip1]
for a = 0 to aN-da1 step 1/R0
   #gr "set ";cx+R0*cos(a-pi/2) ;" " ;   cy+R0*sin(a-pi/2)
    R1= a*R/aN
    if R1>R0 then
       R1= (a+da1*(R1-R0)/(R-R0))*R/aN
        for i = 1 to n
           r1=R0+(R1-R0)*i/n
           a1=a+da1*(R1-R0)/(R-R0)*i/n
           #gr "goto ";cx+r1*cos(a1-pi/2) ;" " ;   cy+r1*sin(a1-pi/2)
       next
   end if

next
#gr "flush"
'wait
[skip1]

a =0
while a<aN
   SCAN
   r = R*a/aN
   if r <1 then r = 1':da=1/R
   da=1/r*1
   k=k+1
   if k mod 2 <> 0 then [cont]
   if a <0.55*pi then [cont]   'cheating here
   #gr "set ";cx+r*cos(a-pi/2) ;" " ;   cy+r*sin(a-pi/2)
   for i = 1 to n
       r1=r+(R-r)*i/n
       a1=a-pi/2+da1*(R-r)/(R-R0)*i/n
       #gr "goto ";cx+r1*cos(a1) ;" " ;   cy+r1*sin(a1)
   next

[cont]
   a=a+da
wend

#gr "flush"
wait

[quit]
   timer 0
   close #gr
end


[tenochtitlanuk]

My wife sticks with MS W11, but I do everything in Linux- I use Mint and other flavours for all my LB/JB stuff, except when trying LB5. No need for instructions on 'a way to get JB running happily in Linux'. Just make sure you've got Wine installed and run the JB install exe downloaded from Carl's site. I'm not aware of many problems or quirks other than being aware of Linux pathname conventions. No current experience with Apple- surely it runs Parallels/JB?? I dislike the way Microsoft and Apple have distorted and financially profited from their public. I voluntarily contribute to various Open Source projects on Linux- but 'own' NO commercial ( paid for) softare or licences for operating system, Office and graphic software, etc. Well, except my valued LB licence..

That latest code, 'plus', is a pretty good approximation. As a long-retired pensioner I'm lucky enough that this kind of play is fun and not entirely a 'waste of time'! Always enjoy seeing others rising to a challenge.

[plus]

Well not a complete waste of time, I can draw an arc on a line segment with or without a given radius.

And there was this little gem in the middle!

[plus]

Ah finally my Ying Yang Variation has finished about 1/2 hour to draw:





I think I've discovered the formula for Curly Fries!

[plus]

3 Improvements: 
1. Cleaned up edges with simple line
2. Show more of the Gem in middle
3. Stole tsh73's color ;-))

' Title "Graphic Challenge v3 LB 2022-07-30" 'b+2022-07-30
' 2022-07-30 started from Shell of Another Color added ArcOfTheChord
' 2022-07-31 final touch ups and post 2 version color scheme
' 2022-07-31 3 fixes for this v
3
global Xmax, Ymax, Pi
Xmax = 660
Ymax = 660
Pi = acs(-1)

nomainwin

WindowWidth = Xmax + 8
WindowHeight = Ymax + 32
UpperLeftX = (DisplayWidth - Xmax) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (DisplayHeight - Ymax) / 2   'or delete if YMAX is 700 or above

toner$ = 100;" ";220;" ";50 ' Attempt to tone down big contrast between yellow and black
shell$ = 196;" ";225;" ";72 ' Ok yeah, I took tsh73 color, so! LOL

' !!!!!!!!!!!!!!!!!!!!!!!!!!!!! Switch for 2 Coloring Versions !!!!!!!!!!!!!!!!!!!!!!!!!!!
ToneDown = 0 ' switch for 2 versions of coloring

open "Grpahic Challenge at LB v3 2022-07-30" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "down"
if ToneDown then
   #gr "fill ";toner$  ' loaded with allot of yellow to reduce contrast with background
else
   #gr "fill black"
end if

Dim x(2200), y(2200)  ' oversized
cx = 330: cy = 330: rLimit = 300: stepper = Pi/200
For a = 0 To Pi*11 Step stepper ' load x, y arrays
   scan
   x(i) = cx + ra * Cos(a): y(i) = cy + ra * Sin(a)
   If Sqr((x(i) - cx) ^ 2 + (y(i) - cy) ^ 2) > rLimit Then
       x(i) = cx + 300 * Cos(a): y(i) = cy + 300 * Sin(a)
   End If
   dr = dr + 1 / 1700: ra = ra + dr ^ 2: i = i + 1
Next
top = i -1
#gr "color ";shell$         'for shell color
#gr "backcolor ";shell$
For i = 0 To 1500 Step 2
   scan
   call ArcOfTheChord x(i), y(i), x(i + 400), y(i + 400) ' 400
   call ArcOfTheChord x(i)+1, y(i), x(i + 400), y(i + 400) ' 400
   if i > 1 then #gr "line ";x(i-2);" ";y(i-2);" ";x(i);" ";y(i)
Next
for i = 1500 to top
   #gr "line ";x(i-2);" ";y(i-2);" ";x(i);" ";y(i)
next

#gr "size 1"
if ToneDown then              ' center "hole"
   #gr "color ";toner$       ' for shell background closer to yellow
   #gr "backcolor ";toner$
else
   #gr "color black"    ' for shell background to match magazine cover
   #gr "backcolor black"
end if
#gr "place ";310;" ";310
#gr "boxfilled ";350;" ";350

#gr "color ";shell$             'for shell color
#gr "backcolor "; shell$
#gr "line ";330;" ";300;" ";330;" ";360  ' 2 center crosses crissed
#gr "line ";300;" ";330;" ";360;" ";330
#gr "line ";300;" ";300;" ";360;" ";360
#gr "line ";300;" ";360;" ";360;" ";300

dx = 15: dx1 = 13
While accum < 36             ' more lines blending to solid yellow
   accum = accum + dx
   accum1 = accum1 + dx1
   #gr "line ";330 - accum1;" ";330 - accum1;" ";330 - accum1;" ";330 + accum1
   #gr "line ";330 + accum1;" ";330 - accum1;" ";330 + accum1;" ";330 + accum1
   #gr "line ";330 - accum1;" ";330 - accum1;" ";330 + accum1;" ";330 - accum1
   #gr "line ";330 - accum1;" ";330 + accum1;" ";330 + accum1;" ";330 + accum1

   #gr "line ";330;" ";330-accum;" ";330+accum;" ";330
   #gr "line ";330;" ";330+accum;" ";330+accum;" ";330
   #gr "line ";330;" ";330+accum;" ";330-accum;" ";330
   #gr "line ";330;" ";330-accum;" ";330-accum;" ";330

   dx = dx * .5
   if dx < 1 then dx = 1
   dx1 = dx1 * .5
   if dx1 < 1 then dx1 = 1
Wend
#gr "Flush"
wait

sub quit H$
   close #gr
   end
end sub

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

' modified and simplified for flatter arcs attempting to match magazine cover
Sub ArcOfTheChord Ax, Ay, Bx, By ' well one of them anyway ;-)) 2022-07-30 for LB Challenge
   pd2 = Pi/2 ' constant for 90 degrees
   dd2 = .5 * Sqr((Ax - Bx) ^ 2 + (Ay - By) ^ 2) ' dist between A and B want mid point
   mx = (Ax + Bx) / 2: my = (Ay + By) / 2
   a = Atan2(By - Ay, Bx - Ax) ' angle of B to A
   r = 100  ' just make up a radius that gets close to flatness in magazine cover
   ox = mx + r * Cos(a + pd2): oy = my + r * Sin(a + pd2)
   r1 = Sqr((ox - Ax) ^ 2 + (oy - Ay) ^ 2) ' Now find distance of O to A !!! that radius
   oa = Atan2(Ay - oy, Ax - ox)
   ob = Atan2(By - oy, Bx - ox)
   call arc ox, oy, r1, oa, ob
End Sub

'use radians
Sub arc x, y, r, raBegin, raEnd ' updated 2021-09-09
   ' raStart is first angle clockwise from due East = 0 degrees
   ' arc will start drawing there and clockwise until raStop angle reached
   'x, y origin, r = radius, c = color
   p = Pi: p2 = p * 2

   ' Last time I tried to use this SUB it hung the program, possible causes:
   ' Make sure raStart and raStop are between 0 and 2pi.
   ' This sub does not have to be recursive, use GOSUB to do drawing to execute arc in one call.

   'make copies before changing
   raStart = raBegin: raStop = raEnd
   While raStart < 0: raStart = raStart + p2: Wend
   While raStart >= p2: raStart = raStart - p2: Wend
   While raStop < 0: raStop = raStop + p2: Wend
   While raStop >= p2: raStop = raStop - p2: Wend

   If raStop < raStart Then
       dStart = raStart: dStop = p2 - .00001
       GoSub [drawArc]
       dStart = 0: dStop = raStop
       GoSub [drawArc]
   Else
       dStart = raStart: dStop = raStop
       GoSub [drawArc]
   End If
   Exit Sub
   [drawArc]
   al = p * r * r * (dStop - dStart) / p2
   For a = dStart To dStop Step 10 / al   ' orig 1/al
       #gr "set ";x + r * Cos(a);" ";y + r * Sin(a)
   Next
   Return
End Sub

Function Atan2(y, x)
   'Atan2 is a function which determines the angle between points
   'x1, y1 and x2, y2. The angle returned is in radians
   'The angle returned is always in the range of
   '-PI to PI radians (-180 to 180 degrees)
   '==============================================================
   'NOTE the position of Y and X arguments
   'This keeps Atan2 function same as other language versions
   '==============================================================
  If x = 0 Then
      If y < 0 Then
           Atan2 = -1.5707963267948967
       Else
           Atan2 = 1.5707963267948967
       End If
  Else
      chk = atn(y/x)
      If x < 0 Then
          If y < 0 Then
               chk = chk - 3.1415926535897932
           Else
               chk = chk + 3.1415926535897932
           End If
      End If
       Atan2 = chk
  End If
  'thanks Andy Amaya
End Function


[marshawn]

Nice mods, B+. I think Bill did something similar with pendulii cycles or some such... nice improvements!