More Old Basic Books

[tsh73]

Got something really close I think

'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


[bplus]

3 Improvements:
1. Cleaned up the edges with simple little line.
2. show more of the gem in the middle, finally got numbers right where I wanted
3. I stole tsh73 color ;-))

' 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
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


[tenochtitlanuk]

Just a codicil.

For this task it took me ages to do the coordinate geometry to draw arcs of specified radius throught two points. Then I realised it has been on Rosetta Code for years for LB!

One of the reasons I support Rosetta Code is that it is such a great resource- if there is no solution in LB I can follow solutions in any other language I know- eg BASIC variants, Python, Fortran, w.h.y. and translate.

So I learned a lot- including from my colleagues on the forum!

[tsh73]

John,
it would be really helpful if you post a link to Rosetta Code
I just was not able to find that code

[tenochtitlanuk]

rosettacode.org/wiki/Circles_of_given_radius_through_two_points

Tsh73
19:03, 1 May 2015 (diff | hist) . . (+585)‎ . . m Circles of given radius through two points ‎ (→‎{{header|Liberty BASIC}})

Long time ago perhaps??!!

[tsh73]

Lol surely way too long ago!
And I was searching for ARC, so found nothing.

[tenochtitlanuk]

I'm still playing with arcs and LB's colour graphics.... will add a web page soon.

[tenochtitlanuk]

Posted a summary of what I've been doing with arcs.Arcs- on diga.me.uk