Another drawString Sample

[B+]

A sample of the shorthand I've developed for drawing, same idea as old Basic Draw string$.

Here is the code for the main event:
call drawString "r440x600y350p-1t127.5i1fzp990d30p900c30"
the rest is just setup (that can be reused over and over for many other purposes).

It says:
r440 = repeat 440 times
x600y350 = Set x, y to 600, 350
p-1 = Turn off pen (pen is off when below 0)
t127.5 = Turn 127.5 degrees from current angle setting, this creates spiral when the radius ever increases (or decreases)
i1 = increment internal variable (z) by +1
fz = go forward z amount (if pen had color loaded it would draw lines)
p990 = set the pen color at 990 (full red 9, and full green 9, no blue) makes yellow
d30 = draw a filled circle with radius 30 (d comes after c for circle)
p900 = set the pen color at 900 (highest red)
c30 = circle radius 30 (at same x, y from forward move)

' spiral.txt for JB v2 B+ 2018-05-21
'from
'DrawString Tester Sampler.txt for JB v2 B+ 2018-05-11, 2018-05-18 finish angled tiles challenge

global xmax, ymax, pi, sz, goON, tx, ty, ta, tc$, tz, tv, tw, th
xmax = 1200
ymax = 700
pi = acs(-1)
nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = 100
UpperLeftY = 20

open "  *** Spiral - Sample  post 2018-05-21 *** " for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "color white"
#gr "fill black"
sz = 1
#gr "size ";sz  'drawing rectangle fills needs a fatter line

cx = xmax/2 : cy = ymax/2
Homer$ = "JP-1A0S0X";cx;"Y";cy  'erase screen, pen off = -1, 0 out Angle, x, y at center of screen
call drawString "r440x600y350p-1t127.5i1fzp990d30p900c30"   '<<<< noted above
call wait4Spacebar
call drawString Homer$;"x";450;"y";250;"h";200;"w";300;"p002mu";20;"v";20;"h";160;"w";260;"p039b"
call label "999", "002", 550, 350, "That's All Folks!"
wait

' procedures this window controls

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$
   if asc(c$) = 32 then
       goON = 1 - goON
   else
       call quit H$
   end if
end sub

sub wait4Spacebar 'when pause is just too rigid a time to wait
   call label "999", "002", 20, 40, "press spacebar to continue..."
   goON = 0
   while goON = 0
       scan
   wend
end sub

sub quit H$
   close #gr
   end
end sub


'drawing procedures for testing and sampling

sub drawString tstring$  'can't use E????
   'global tx, ty, ta, tc, tv
   tstring$ = upper$(tstring$);" " 'needed in case tstring$ end with command
   cmd$ = "" : ds$ = ""
   for i = 1 to len(tstring$)
       c$ = mid$(tstring$, i, 1)
       if c$ = "Z" then ds$ = str$(tz)  'Z is a varaible set with S or incremented with I
       if instr("0123456789.-", c$) then ds$ = ds$ + c$
       if instr("RXYPATCDFHWLBMJISUV", c$) or i = len(tstring$) then
           'execute last cmd if one
           if cmd$ <> ""  then
               d = val(ds$)
               select case cmd$
               case "R"                'repeat a drawstring d times
                   tst$ = mid$(tstring$, i)
                   call repete tst$, d
                   exit sub
               case "X" : tx = d       'hard x
               case "Y" : ty = d       'hard y
               case "P" : tc$ = ds$       'reset color
                   if val(tc$) >= 0 then call RGB tc$
               case "A" : ta = d       'hard angle
               case "T" : ta = ta + d  'mod angle
               case "C" : #gr "place ";tx;" ";ty;"; circle ";d
               case "D" : #gr "place ";tx;" ";ty;"; circlefilled ";d

               case "F"  'this draws a line!!!! forward d = distance ( from current x, y at angle)
                   across = d * cos(pi/180 * ta - pi/2)
                   down   = d * sin(pi/180 * ta - pi/2)
                   if val(tc$) > -1 then
                       #gr "line ";tx;" ";ty;" ";tx + across;" ";ty + down
                   end if
                   '#gr "line ";tx;" ";ty;" ";tx + across;" ";ty + down
                   tx = tx + across : ty = ty + down

               case "H" : th = d  'h for height
               case "W" : tw = d  'w for width
               case "L" : #gr "line ";tx;" ";ty;" ";tx+tw;" ";ty+th
               case "B"
                   if d = 0 then
                       #gr "place ";tx;" ";ty;";box ";tx+tw;" ";ty+th
                   else
                       call drawRect ta, tx, ty, tw, th
                   end if
               case "M"
                   if d = 0 then 'normal rectangle a = 0
                       #gr "place ";tx;" ";ty;";boxfilled ";tx+tw;" ";ty+th
                   else
                       call dfrt ta, tx, ty, tw, th
                   end if

               case "J" : #gr "cls;fill black" 'e (for erase) doesn't work

               case "I" : tz = tz + d  'increment variable
               case "S" : tz = d       'set variable

               case "U" : tx = tx + d  'mod x step
               case "V" : ty = ty + d  'mod y step
               end select
               ds$ = "" : cmd$ = ""
           end if
           cmd$ = c$
       end if
   next
end sub

sub repete tts$, times
  for i = 1 to times
    call drawString tts$
  next
end sub


' handy supplemental procedures ==============================================

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

sub label fColor$, bColor$, x, y, text$

   call fRGB fColor$

   call bRGB bColor$

   #gr "place ";x;" ";y;";\";text$

end sub



sub fRGB s3$ 'foreground New Color System 1000 colors with 3 digits!!!!!!!!!!!!!!!!
   l = len(s3$)
   if l    then r = 28 * val(mid$(s3$, 1, 1)) + 3
   if l>=2 then g = 28 * val(mid$(s3$, 2, 1)) + 3
   if l>=3 then b = 28 * val(mid$(s3$, 3, 1)) + 3
   #gr "color ";r;" ";g;" ";b
end sub

sub bRGB s3$ 'background New Color System 1000 colors with 3 digits!!!!!!!!!!!!!!!!
   l = len(s3$)
   if l    then r = 28 * val(mid$(s3$, 1, 1)) + 3
   if l>=2 then g = 28 * val(mid$(s3$, 2, 1)) + 3
   if l>=3 then b = 28 * val(mid$(s3$, 3, 1)) + 3
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub RGB s3$      ' New Color System 1000 colors with 3 digits!!!!!!!!!!!!!!!!
   l = len(s3$)
   if l    then r = 28 * val(mid$(s3$, 1, 1)) + 3
   if l>=2 then g = 28 * val(mid$(s3$, 2, 1)) + 3
   if l>=3 then b = 28 * val(mid$(s3$, 3, 1)) + 3
   #gr "color ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
   tc$ = s3$ 'update turtle with color?
end sub

sub drawRect a, x, y, w, h  'draw a rectangle frame at a given angle
   #gr "size 2"
   ra = a * pi/180
   x1 = x + w * cos(ra)
   y1 = y + w * sin(ra)
   x2 = x + h * cos(ra + pi/2)
   y2 = y + h * sin(ra + pi/2)
   x3 = x2 + w * cos(ra)
   y3 = y2 + w * sin(ra)
   #gr "line ";x;" ";y;" ";x1;" ";y1
   #gr "line ";x1;" ";y1;" ";x3;" ";y3
   #gr "line ";x3;" ";y3;" ";x2;" ";y2
   #gr "line ";x2;" ";y2;" ";x;" ";y
   #gr "size ";sz
end sub

'draw string commands use this turtle method command mn where n = 1
sub dfrt a, x, y, w, h  '(d)raw (f)illed (r)ectangle at given angle (t)urtle method
   #gr "size 2;north;turn 180;turn ";a
   for i = 1 to h  'draw *part of* bigger and bigger rectangles, tsh fixed and cut 1/2 drawing
       #gr "place ";x;" ";y;";go ";i;";turn -90;go ";w;";turn 90"
   next
   #gr "size 1"
end sub



[B+]

I've always wanted try a gears thing...
Here is a demo showing why square gear teeth need to have corners trimmed:
'Gear 1.txt for JB v2 B+ 2018-05-22
'from spiral.txt for JB v2 B+ 2018-05-21
'from DrawString Tester Sampler.txt for JB v2 B+ 2018-05-11, 2018-05-18 finish angled tiles challenge

global xmax, ymax, pi, sz, goON, tx, ty, ta, tc$, tz, tv, tw, th
xmax = 1200
ymax = 700
pi = acs(-1)
nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = 100
UpperLeftY = 20

open "  *** Gears 1 - Sample  post 2018-05-22 *** " for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "color white"
#gr "fill black"
sz = 1
#gr "size ";sz  'drawing rectangle fills needs a fatter line

cx = xmax/2 : cy = ymax/2
Homer$ = "JP-1A0S0X";cx;"Y";cy  'erase screen, pen off = -1, 0 out Angle, x, y at center of screen
teeth = 8
sections = 2 * teeth
innerA = 360 / sections
innerB = (180 - innerA)/2
polyAngle = 180 - 2 * innerB
side = 40
radius = .5 * side / sin( pi/180 * ( .5 * innerA ) )

Bteeth =  2*teeth
Bsections = 2 * Bteeth
BinnerA = 360 / Bsections
BinnerB = (180 - BinnerA)/2
BpolyAngle = 180 - 2 * BinnerB
'side the same!
Bradius = .5 * side / sin( pi/180 * ( .5 * BinnerA ) )

'debug with nomainwin commented out
'print "teeth ";teeth, Bteeth
'print "sections ";sections, Bsections
'print "innerA ";innerA, BinnerA
'print "innerB ";innerB, BinnerB
'print "polyAngle ";polyAngle, BpolyAngle
'print "radius ";radius, Bradius

call drawString Homer$
'good gear but need to control center and radius
'call drawString "s";side;"r";teeth;"p009fzt";polyAngle;"p-1fzt-90p009fzt-90fzt-90fzt-90p-1fzt";polyAngle
while 1
   scan
   call drawString "J"
   ao = ao + 5
   if ao > 359 then ao = 0
   for a = 0 to 360 step (360/teeth)
       call drawString "A"; a + ao;"X";cx;"Y";cy;"p-1f";radius;"t";180 - innerB
       call drawString "s";side;"p-1fzt-90p009fzt-90fzt-90fzt-90p-1fzt";polyAngle;"p009fz"
   next
   for a = 0 to 360 step (360/teeth)
       call drawString "A"; a - ao ;"X";cx-2*radius-side;"Y";cy;"p-1f";radius;"t";180 - innerB
       call drawString "s";side;"p-1fzt-90p009fzt-90fzt-90fzt-90p-1fzt";polyAngle;"p009fz"
   next
   'for a = 0 to 360 step (360/teeth)
   '    call drawString "A"; a - ao ;"X";cx+2*radius+side;"Y";cy;"p-1f";radius;"t";180 - innerB
   '    call drawString "s";side;"p-1fzt-90p009fzt-90fzt-90fzt-90p-1fzt";polyAngle;"p009fz"
   'next
   for a = 0 to 360 step (360/Bteeth)
       call drawString "A"; a - .5 * ao ;"X";cx+radius+Bradius+side;"Y";cy;"p-1f";Bradius;"t";180 - BinnerB
       call drawString "s";side;"p-1fzt-90p009fzt-90fzt-90fzt-90p-1fzt";BpolyAngle;"p009fz"
   next
   call pause 100
wend
wait

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$
   if asc(c$) = 32 then
       goON = 1 - goON
   else
       call quit H$
   end if
end sub

sub wait4Spacebar 'when pause is just too rigid a time to wait
   call label "999", "002", 20, 40, "press spacebar to continue..."
   goON = 0
   while goON = 0
       scan
   wend
end sub

sub quit H$
   close #gr
   end
end sub


'drawing procedures for testing and sampling

sub drawString tstring$  'can't use E????
   'global tx, ty, ta, tc, tv
   tstring$ = upper$(tstring$);" " 'needed in case tstring$ end with command
   cmd$ = "" : ds$ = ""
   for i = 1 to len(tstring$)
       c$ = mid$(tstring$, i, 1)
       if c$ = "Z" then ds$ = str$(tz)  'Z is a varaible set with S or incremented with I
       if instr("0123456789.-", c$) then ds$ = ds$ + c$
       if instr("RXYPATCDFHWLBMJISUV", c$) or i = len(tstring$) then
           'execute last cmd if one
           if cmd$ <> ""  then
               d = val(ds$)
               select case cmd$
               case "R"                'repeat a drawstring d times
                   tst$ = mid$(tstring$, i)
                   call repete tst$, d
                   exit sub
               case "X" : tx = d       'hard x
               case "Y" : ty = d       'hard y
               case "P" : tc$ = ds$       'reset color
                   if val(tc$) >= 0 then call RGB tc$
               case "A" : ta = d       'hard angle
               case "T" : ta = ta + d  'mod angle
               case "C" : #gr "place ";tx;" ";ty;"; circle ";d
               case "D" : #gr "place ";tx;" ";ty;"; circlefilled ";d

               case "F"  'this draws a line!!!! forward d = distance ( from current x, y at angle)
                   across = d * cos(pi/180 * ta - pi/2)
                   down   = d * sin(pi/180 * ta - pi/2)
                   if val(tc$) > -1 then
                       #gr "line ";tx;" ";ty;" ";tx + across;" ";ty + down
                   end if
                   '#gr "line ";tx;" ";ty;" ";tx + across;" ";ty + down
                   tx = tx + across : ty = ty + down

               case "H" : th = d  'h for height
               case "W" : tw = d  'w for width
               case "L" : #gr "line ";tx;" ";ty;" ";tx+tw;" ";ty+th
               case "B"
                   if d = 0 then
                       #gr "place ";tx;" ";ty;";box ";tx+tw;" ";ty+th
                   else
                       call drawRect ta, tx, ty, tw, th
                   end if
               case "M"
                   if d = 0 then 'normal rectangle a = 0
                       #gr "place ";tx;" ";ty;";boxfilled ";tx+tw;" ";ty+th
                   else
                       call dfrt ta, tx, ty, tw, th
                   end if

               case "J" : #gr "cls;fill black" 'e (for erase) doesn't work

               case "I" : tz = tz + d  'increment variable
               case "S" : tz = d       'set variable

               case "U" : tx = tx + d  'mod x step
               case "V" : ty = ty + d  'mod y step
               end select
               ds$ = "" : cmd$ = ""
           end if
           cmd$ = c$
       end if
   next
end sub

'                                   4 procedures needed for drawString
sub repete tts$, times
  for i = 1 to times
    call drawString tts$
  next
end sub

sub RGB s3$      ' New Color System 1000 colors with 3 digits!!!!!!!!!!!!!!!!
   l = len(s3$)
   if l    then r = 28 * val(mid$(s3$, 1, 1)) + 3
   if l>=2 then g = 28 * val(mid$(s3$, 2, 1)) + 3
   if l>=3 then b = 28 * val(mid$(s3$, 3, 1)) + 3
   #gr "color ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
   tc$ = s3$ 'update turtle with color?
end sub

sub drawRect a, x, y, w, h  'draw a rectangle frame at a given angle
   #gr "size 2"
   ra = a * pi/180
   x1 = x + w * cos(ra)
   y1 = y + w * sin(ra)
   x2 = x + h * cos(ra + pi/2)
   y2 = y + h * sin(ra + pi/2)
   x3 = x2 + w * cos(ra)
   y3 = y2 + w * sin(ra)
   #gr "line ";x;" ";y;" ";x1;" ";y1
   #gr "line ";x1;" ";y1;" ";x3;" ";y3
   #gr "line ";x3;" ";y3;" ";x2;" ";y2
   #gr "line ";x2;" ";y2;" ";x;" ";y
   #gr "size ";sz
end sub

'draw string commands use this turtle method command mn where n = 1
sub dfrt a, x, y, w, h  '(d)raw (f)illed (r)ectangle at given angle (t)urtle method
   #gr "size 2;north;turn 180;turn ";a
   for i = 1 to h  'draw *part of* bigger and bigger rectangles, tsh fixed and cut 1/2 drawing
       #gr "place ";x;" ";y;";go ";i;";turn -90;go ";w;";turn 90"
   next
   #gr "size 1"
end sub

' handy supplemental procedures ==============================================

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

sub label fColor$, bColor$, x, y, text$
   call fRGB fColor$
   call bRGB bColor$
   #gr "place ";x;" ";y;";\";text$
end sub

sub fRGB s3$ 'foreground New Color System 1000 colors with 3 digits!!!!!!!!!!!!!!!!
   l = len(s3$)
   if l    then r = 28 * val(mid$(s3$, 1, 1)) + 3
   if l>=2 then g = 28 * val(mid$(s3$, 2, 1)) + 3
   if l>=3 then b = 28 * val(mid$(s3$, 3, 1)) + 3
   #gr "color ";r;" ";g;" ";b
end sub

sub bRGB s3$ 'background New Color System 1000 colors with 3 digits!!!!!!!!!!!!!!!!
   l = len(s3$)
   if l    then r = 28 * val(mid$(s3$, 1, 1)) + 3
   if l>=2 then g = 28 * val(mid$(s3$, 2, 1)) + 3
   if l>=3 then b = 28 * val(mid$(s3$, 3, 1)) + 3
   #gr "backcolor ";r;" ";g;" ";b
end sub



[johnno56]

Cool...

J

[B+]

Welcome to the forum Johnno!

Here is an attempt with filled in gears, orange and yellow as per Spock's request.
'gears 2.txt for JB v2 B+ 2018-05-22
'from spiral.txt for JB v2 B+ 2018-05-21
'DrawString Tester Sampler.txt for JB v2 B+ 2018-05-11, 2018-05-18 finish angled tiles challenge

' try filled in grear colors

global xmax, ymax, pi, sz, goON, tx, ty, ta, tc$, tz, tv, tw, th
xmax = 1200
ymax = 700
pi = acs(-1)
nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = 100
UpperLeftY = 20

open "  *** Gears 2 - Sample  post 2018-05-22 *** " for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "fill black"
sz = 1
#gr "size ";sz  'drawing rectangle fills needs a fatter line

cx = xmax/2 : cy = ymax/2
Homer$ = "JP-1A0S0X";cx;"Y";cy  'erase screen, pen off = -1, 0 out Angle, x, y at center of screen

nteeth = 8
sqtooth = 20
radius = .5 * sqtooth / sin( .5 * pi / nteeth )

Bteeth =  2 * nteeth
BinnerA = pi / Bteeth
Bradius = .5 * sqtooth / sin( .5 * pi / Bteeth )

for ra = 0 to 2 * pi step pi/90   'one turn of gears
   scan
   call drawString "J"
   'gear x, y, nteeth, sqtooth - 2, raOffset, clr3$
   call gear cx, cy + 1, nteeth, sqtooth - 1, ra, "990"
   call gear cx - radius - Bradius - sqtooth - 2, cy, Bteeth, sqtooth, -.5 * ra + BinnerA, "950"
   call pause 600
next

call wait4Spacebar
call drawString Homer$;"x";450;"y";250;"h";200;"w";300;"p002mu";20;"v";20;"h";160;"w";260;"p039b"
call label "999", "002", 550, 350, "That's All Folks!"
wait

'========================================================    procedures for gear 2

sub gear x, y, nteeth, sqtooth, raOffset, clr3$
   sections = 2 * nteeth
   innerRA = 2 * pi / sections
   radius = .5 * sqtooth / sin( .5 * innerRA )
   for ra = 0 to 2 * pi step 2 * pi / nteeth
       x2 = x + (radius + sqtooth) * cos(ra + raOffset)
       y2 = y + (radius + sqtooth) * sin(ra + raOffset)
       call tline x, y, x2, y2, sqtooth, clr3$
   next
   'to speed things up and reduce blicking just do a circle fill x, y already set and pen color too
   #gr "place ";x;" ";y;"; circlefilled ";radius
end sub

sub tline x1, y1, x2, y2, thick, clr3$
   d = ((x1-x2)^2 + (y1-y2)^2)^.5
   t2 = thick/2
   ra = Atan2((y1-y2),(x1-x2))
   a = ra * 180/pi
   x3 = x1 + t2 * cos(ra - pi/2)
   y3 = y1 + t2 * sin(ra - pi/2)
   call drawString "x";x3;"y";y3;"w";d;"h";thick;"a";a;"p";clr3$;"m1"
end sub

' procedures this window controls

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$
   if asc(c$) = 32 then
       goON = 1 - goON
   else
       call quit H$
   end if
end sub

sub wait4Spacebar 'when pause is just too rigid a time to wait
   call label "999", "002", 20, 40, "press spacebar to continue..."
   goON = 0
   while goON = 0
       scan
   wend
end sub

sub quit H$
   close #gr
   end
end sub

'==================================   drawing procedures for testing and sampling drawString

sub drawString tstring$  'can't use E????
   'global tx, ty, ta, tc, tv
   tstring$ = upper$(tstring$);" " 'needed in case tstring$ end with command
   cmd$ = "" : ds$ = ""
   for i = 1 to len(tstring$)
       c$ = mid$(tstring$, i, 1)
       if c$ = "Z" then ds$ = str$(tz)  'Z is a varaible set with S or incremented with I
       if instr("0123456789.-", c$) then ds$ = ds$ + c$
       if instr("RXYPATCDFHWLBMJISUV", c$) or i = len(tstring$) then
           'execute last cmd if one
           if cmd$ <> ""  then
               d = val(ds$)
               select case cmd$
               case "R"                'repeat a drawstring d times
                   tst$ = mid$(tstring$, i)
                   call repete tst$, d
                   exit sub
               case "X" : tx = d       'hard x
               case "Y" : ty = d       'hard y
               case "P" : tc$ = ds$       'reset color
                   if val(tc$) >= 0 then call RGB tc$
               case "A" : ta = d       'hard angle
               case "T" : ta = ta + d  'mod angle
               case "C" : #gr "place ";tx;" ";ty;"; circle ";d
               case "D" : #gr "place ";tx;" ";ty;"; circlefilled ";d

               case "F"  'this draws a line!!!! forward d = distance ( from current x, y at angle)
                   across = d * cos(pi/180 * ta - pi/2)
                   down   = d * sin(pi/180 * ta - pi/2)
                   if val(tc$) > -1 then
                       #gr "line ";tx;" ";ty;" ";tx + across;" ";ty + down
                   end if
                   '#gr "line ";tx;" ";ty;" ";tx + across;" ";ty + down
                   tx = tx + across : ty = ty + down

               case "H" : th = d  'h for height
               case "W" : tw = d  'w for width
               case "L" : #gr "line ";tx;" ";ty;" ";tx+tw;" ";ty+th
               case "B"
                   if d = 0 then
                       #gr "place ";tx;" ";ty;";box ";tx+tw;" ";ty+th
                   else
                       call drawRect ta, tx, ty, tw, th
                   end if
               case "M"
                   if d = 0 then 'normal rectangle a = 0
                       #gr "place ";tx;" ";ty;";boxfilled ";tx+tw;" ";ty+th
                   else
                       call dfrt ta, tx, ty, tw, th
                   end if

               case "J" : #gr "cls;fill black" 'e (for erase) doesn't work

               case "I" : tz = tz + d  'increment variable
               case "S" : tz = d       'set variable

               case "U" : tx = tx + d  'mod x step
               case "V" : ty = ty + d  'mod y step
               end select
               ds$ = "" : cmd$ = ""
           end if
           cmd$ = c$
       end if
   next
end sub

'                                   4 procedures needed for drawString
sub repete tts$, times
  for i = 1 to times
    call drawString tts$
  next
end sub

sub RGB s3$      ' New Color System 1000 colors with 3 digits!!!!!!!!!!!!!!!!
   l = len(s3$)
   if l    then r = 28 * val(mid$(s3$, 1, 1)) + 3
   if l>=2 then g = 28 * val(mid$(s3$, 2, 1)) + 3
   if l>=3 then b = 28 * val(mid$(s3$, 3, 1)) + 3
   #gr "color ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
   tc$ = s3$ 'update turtle with color?
end sub

sub drawRect a, x, y, w, h  'draw a rectangle frame at a given angle
   #gr "size 2"
   ra = a * pi/180
   x1 = x + w * cos(ra)
   y1 = y + w * sin(ra)
   x2 = x + h * cos(ra + pi/2)
   y2 = y + h * sin(ra + pi/2)
   x3 = x2 + w * cos(ra)
   y3 = y2 + w * sin(ra)
   #gr "line ";x;" ";y;" ";x1;" ";y1
   #gr "line ";x1;" ";y1;" ";x3;" ";y3
   #gr "line ";x3;" ";y3;" ";x2;" ";y2
   #gr "line ";x2;" ";y2;" ";x;" ";y
   #gr "size ";sz
end sub

'draw string commands use this turtle method command mn where n = 1
sub dfrt a, x, y, w, h  '(d)raw (f)illed (r)ectangle at given angle (t)urtle method
   #gr "size 2;north;turn 180;turn ";a
   for i = 1 to h  'draw *part of* bigger and bigger rectangles, tsh fixed and cut 1/2 drawing
       #gr "place ";x;" ";y;";go ";i;";turn -90;go ";w;";turn 90"
   next
   #gr "size 1"
end sub

' handy supplemental procedures ==============================================

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

sub label fColor$, bColor$, x, y, text$
   call fRGB fColor$
   call bRGB bColor$
   #gr "place ";x;" ";y;";\";text$
end sub

sub fRGB s3$ 'foreground New Color System 1000 colors with 3 digits!!!!!!!!!!!!!!!!
   l = len(s3$)
   if l    then r = 28 * val(mid$(s3$, 1, 1)) + 3
   if l>=2 then g = 28 * val(mid$(s3$, 2, 1)) + 3
   if l>=3 then b = 28 * val(mid$(s3$, 3, 1)) + 3
   #gr "color ";r;" ";g;" ";b
end sub

sub bRGB s3$ 'background New Color System 1000 colors with 3 digits!!!!!!!!!!!!!!!!
   l = len(s3$)
   if l    then r = 28 * val(mid$(s3$, 1, 1)) + 3
   if l>=2 then g = 28 * val(mid$(s3$, 2, 1)) + 3
   if l>=3 then b = 28 * val(mid$(s3$, 3, 1)) + 3
   #gr "backcolor ";r;" ";g;" ";b
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


[tsh73]

Hello B+
Nice work

So why

'can't use E?

statement?
I tried change J for E in CASE and INSTR - and it worked for me.

[B+]

May 23, 2018 7:50:45 GMT tsh73 said:

Hello B+
Nice work

So why

'can't use E?

statement?
I tried change J for E in CASE and INSTR - and it worked for me.

Hi tsh73, 

At time I was working with drawString sub, E was not working for erase (in first sampler code I posted way back with Japanese Pattern..? or before when first translated and was trying to get old code working as it did in other Basic) it was a new command for drawString procedure and at time I didn't want to get hung up by why it wasn't working. I don't know, could have been some other thing interfering. 

I will try it again in other code. I definitely would like E for erase! Thanks for checking and letting me know.

[B+]

Hi tsh73,

I tracked down the problem with e.
Here is the old code that was behaving strangely with e in drawString for command to erase or clear screen to black, instead of J.

if test + 1 then   '               old drawString code: Atom Orbit
   call drawString Homer$;"p395"
   for n = 1 to 11
       for i = 0 to 359
           call drawString "f1t";sin((i/2 + 5.5)*pi/180)  'for some reason had to add +5.5
       next
   next
   call wait4Spacebar
end if


BTW, it is a cool effect seeing only the particle and only a small part or it's path, more realistic of an electron of atom but it was not drawing what the old code was drawing. 

Think about it, you will know why e doesn't work! Clue: when else might e pop up, kind of unexpected like?


This old DRAW String$ code had another problem that I had to add the 5.5 to make it work as before. 

[tsh73]

think about it, you will know why e doesn't work! 

pi = acs(-1)
print pi/100
makes 
0.31415927e-1
OOPS...