A Little Challenge: Japanese Pattern

[B+]

tsh73 started it!

Here is my version of Japanese Pattern:
'Japanese Pattern.txt for JB v2.0 by B+ 2018-05-08
' translate from: japanese pattern.bas SmallBASIC 0.12.11 (B+=MGA) 2018-05-08

'tsh73 little challenge 2018-05-08

global xmax, ymax, pi, sz, xa, ya
xmax = 1200
ymax = 700
pi = acs(-1)
nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = 300
UpperLeftY = 150

open "Little Challenge by tsh 2018-05-08  *** Japanese Pattern *** " for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "color white"

sx = 300 : sy = 200 : sa = 0 : w = 9
for sz = 21 to 3 step -3
   scan
   #gr "discard"
   #gr "fill black"
   w = w - 1
   #gr "size ";w
   xstop = int(xmax / (sz * 20))
   ystop = int(2 * ymax / (sz * 20))
   for y = -1 to ystop
       if y mod 2 then xoff = sz * 10 else xoff = 0
       for x = -1 to xstop
           scan
           call jptile x * sz * 20 + xoff, y * sz * 10, sa
       next
   next
   #gr "flush"
   call pause 2000
next
wait

sub jptile x, y, sa
   call hue 200, 100, 0
   call jp2 x, y, sa
   call hue 160, 80, 0
   call jp2 x + 8 * sz, y + 15 *sz, sa - pi/2
end sub

sub jp2 x, y, a
   call jp x, y, a
   call jp xa, ya, a + pi
end sub

sub jp x, y, a
   xa = x
   ya = y
   call go xa, ya, 13 * sz, a + 0
   call go xa, ya, 1 * sz, a + pi/2
   call go xa, ya, 2 * sz, a + pi
   call go xa, ya, 2 * sz, a + pi/2
   call go xa, ya, 1 * sz, a + pi
   call go xa, ya, 2 * sz, a - pi/2
   call go xa, ya, 3 * sz, a + pi
   call go xa, ya, 15 * sz, a + pi/2
   call go xa, ya, 3 * sz, a + 0
   call go xa, ya, 2 * sz, a - pi/2
   call go xa, ya, 1 * sz, a + 0
   call go xa, ya, 2 * sz, a + pi/2
   call go xa, ya, 2 * sz, a + 0
   call go xa, ya, 1 * sz, a + pi/2
end sub

sub go x, y, sz, ra
 xa = xa + sz * cos(ra)
 ya = ya + sz * sin(ra)
 #gr "line ";x;" ";y;" ";xa;" ";ya
end sub

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

sub fore r, g, b
   #gr "color ";r;" ";g;" ";b
end sub

sub back r, g, b  'backcolor is used for fills
   #gr "backcolor ";r;" ";g;" ";b
end sub

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

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

sub quit H$
   close #H$
   end
end sub

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


[B+]

OK, I decided to air out my drawString code with this:

'Japanese Pattern w DrawString.txt for JB v2.0 by B+ 2018-05-08
' translate from: Japanese pattern.txt for JB v2.0 B+ 2018-05-08
' with modified drawString code from SmallBASIC
' v2 tg2 mod.bas  SmallBASIC 0.12.2 [B+=MGA] 2016-04-05


'tsh73 little challenge 2018-05-08

global xmax, ymax, pi, sz, xa, ya, tx, ty, ta, tc, tv
xmax = 1200
ymax = 700
pi = acs(-1)
nomainwin

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

open "Little Challenge by tsh 2018-05-08  *** Japanese Pattern *** " 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"
'test
sz = 10
'call drawString "p15x200y100a0f100"
'call jpat 200, 100, 0
w = 9
for sz = 25 to 3 step -7
   scan
   #gr "discard"
   #gr "fill black"
   w = w - 2
   #gr "size ";w
   xstop = int(xmax / (sz * 20))
   ystop = int(2 * ymax / (sz * 20))
   for y = -1 to ystop
       if y mod 2 then xoff = sz * 10 else xoff = 0
       for x = -1 to xstop
           scan
           call jpat x * sz * 20 + xoff, y * sz * 10
       next
   next
   #gr "flush"
   call pause 2000
next
wait

sub jpat x, y
   dstart$ = "p";9;"x";x;"y";y;"a0"
   ds$ = "R2F";13*sz;"T90F";sz;"T90F";2*sz;"T-90F";2*sz;"T90F";sz;"T90F";2*sz
   ds$ = ds$ + "T-90F";3*sz;"T-90F";15*sz;"T-90F";3*sz;"T-90F";2*sz;"T90F";sz;"T90F";2*sz;"T-90F";2*sz
   ds$ = ds$ + "T90F";sz;"T90"
   call drawString dstart$ + ds$
   x1 = x + 8 * sz
   y1 = y + 15 * sz
   dstart$ = "p";3;"x";x1;"y";y1;"A-90"
   call drawString dstart$ + ds$
end sub

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

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

sub quit H$
   close #H$
   end
end sub

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

sub drawString tstring$
   'global tx, ty, ta, tc, tv
   tstring$ = upper$(tstring$)
   cmd$ = "" : ds$ = ""
   for i = 1 to len(tstring$)
       c$ = mid$(tstring$, i, 1)
       if c$ = "V" then ds$ = str$(tv)
       if instr("0123456789.-", c$) then ds$ = ds$ + c$
       if instr("ATFPXYGHRIS", c$) or i = len(tstring$) then
           'execute last cmd if one
           if cmd$ <> ""  then
               d = val(ds$)
               select case cmd$
               case "G" : tx = tx + d  'mod x
               case "H" : ty = ty + d  'mod y
               case "X" : tx = d       'hard x
               case "Y" : ty = d       'hard y
               case "P" : tc = d       'pallette
               case "A" : ta = d       'hard angle
               case "T" : ta = ta + d  'mod angle
               case "I" : tv = tv + d  'increment variable
               case "S" : tv = d       'set variable
               case "R"                'repeat a drawstring d times
                   tst$ = mid$(tstring$, i)
                   call repete tst$, d
                   exit sub
               case "F"  'this draws a line!!!! forward d = distance ( from current x, y at angle)
                   across = d * cos(pi/180 * ta)
                   down   = d * sin(pi/180 * ta)
                   if tc > -1 then
                       select case tc
                       case 0   : #gr "color black"
                       case 1   : #gr "color darkblue"
                       case 2   : #gr "color brown"
                       case 3   : #gr "color darkcyan"
                       case 4   : #gr "color darkred"
                       case 5   : #gr "color darkpink"
                       case 6   : #gr "color darkgreen"
                       case 7   : #gr "color lightgray"
                       case 8   : #gr "color darkgray"
                       case 9   : #gr "color blue"
                       case 10  : #gr "color green"
                       case 11  : #gr "color cyan"
                       case 12  : #gr "color red"
                       case 13  : #gr "color pink"
                       case 14  : #gr "color yellow"
                       case 15  : #gr "color white"
                       end select
                   end if
                   #gr "line ";tx;" ";ty;" ";tx + across;" ";ty + down
                   tx = tx + across : ty = ty + down
               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



[B+]

Now able to do Japanese Pattern at an Angle!

'Japanese Pattern at Angle with DrawString.txt for JB v2.0 by B+ 2018-05-09
' Japanese Pattern w DrawString.txt for JB v2.0 by B+ 2018-05-08
' with modified drawString code from SmallBASIC
' v2 tg2 mod.bas  SmallBASIC 0.12.2 [B+=MGA] 2016-04-05
' translate from: Japanese pattern.txt for JB v2.0 B+ 2018-05-08

' now try doing at angle

global xmax, ymax, pi, sz, xa, ya, tx, ty, ta, tc, tv, a
xmax = 1200
ymax = 700
pi = acs(-1)
nomainwin

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

open "  *** Japanese Pattern at Angle *** " 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"
w = 9
a = 45  '<<<<<<<<<<<<<<<<<<<<<< at this angle!
for sz = 25 to 3 step -7
   scan
   #gr "discard"
   #gr "fill black"
   w = w - 2
   #gr "size ";w
   xstop = int(xmax / (sz * 20)) + 10
   ystop = int(2 * ymax / (sz * 20)) + 10
   for y = -1*ystop to ystop
       if y mod 2 then xoff = sz * 10 else xoff = 0
       for x = -1 to xstop
           scan
           call drawString "p-1x0y0a";a;"F";x*sz*20+xoff;"T90F";y*sz*10
           call jpat
       next
   next
   #gr "flush"
   call pause 2000
next
wait

sub jpat ' x, y
   dstart$ = "p";14;"a";a
   ds$ = "R2F";13*sz;"T90F";sz;"T90F";2*sz;"T-90F";2*sz;"T90F";sz;"T90F";2*sz
   ds$ = ds$ + "T-90F";3*sz;"T-90F";15*sz;"T-90F";3*sz;"T-90F";2*sz;"T90F";sz;"T90F";2*sz;"T-90F";2*sz
   ds$ = ds$ + "T90F";sz;"T90"
   call drawString dstart$ + ds$
   dstart$ = "p";-1;"F";8*sz;"T90F";15*sz;"p12T180"
   call drawString dstart$ + ds$
end sub

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

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

sub quit H$
   close #H$
   end
end sub

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

sub drawString tstring$
   'global tx, ty, ta, tc, tv
   tstring$ = upper$(tstring$)
   cmd$ = "" : ds$ = ""
   for i = 1 to len(tstring$)
       c$ = mid$(tstring$, i, 1)
       if c$ = "V" then ds$ = str$(tv)
       if instr("0123456789.-", c$) then ds$ = ds$ + c$
       if instr("ATFPXYGHRIS", c$) or i = len(tstring$) then
           'execute last cmd if one
           if cmd$ <> ""  then
               d = val(ds$)
               select case cmd$
               case "G" : tx = tx + d  'mod x
               case "H" : ty = ty + d  'mod y
               case "X" : tx = d       'hard x
               case "Y" : ty = d       'hard y
               case "P" : tc = d       'pallette
               case "A" : ta = d       'hard angle
               case "T" : ta = ta + d  'mod angle
               case "I" : tv = tv + d  'increment variable
               case "S" : tv = d       'set variable
               case "R"                'repeat a drawstring d times
                   tst$ = mid$(tstring$, i)
                   call repete tst$, d
                   exit sub
               case "F"  'this draws a line!!!! forward d = distance ( from current x, y at angle)
                   across = d * cos(pi/180 * ta)
                   down   = d * sin(pi/180 * ta)
                   if tc > -1 then
                       select case tc
                       case 0   : #gr "color black"
                       case 1   : #gr "color darkblue"
                       case 2   : #gr "color brown"
                       case 3   : #gr "color darkcyan"
                       case 4   : #gr "color darkred"
                       case 5   : #gr "color darkpink"
                       case 6   : #gr "color darkgreen"
                       case 7   : #gr "color lightgray"
                       case 8   : #gr "color darkgray"
                       case 9   : #gr "color blue"
                       case 10  : #gr "color green"
                       case 11  : #gr "color cyan"
                       case 12  : #gr "color red"
                       case 13  : #gr "color pink"
                       case 14  : #gr "color yellow"
                       case 15  : #gr "color white"
                       end select
                       #gr "line ";tx;" ";ty;" ";tx + across;" ";ty + down
                   end if
                   '#gr "line ";tx;" ";ty;" ";tx + across;" ";ty + down
                   tx = tx + across : ty = ty + down
               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




[B+]

And now able to do the weave$ Tiling at angle and a whole bunch more!


'DrawString Tester Sampler.txt for JB v2 B+ 2018-05-11, 2018-05-18 finish angled tiles challenge
'Japanese Pattern at Angle with DrawString.txt for JB v2.0 by B+ 2018-05-09
' Japanese Pattern w DrawString.txt for JB v2.0 by B+ 2018-05-08
' with modified drawString code from SmallBASIC
' v2 tg2 mod.bas  SmallBASIC 0.12.2 [B+=MGA] 2016-04-05
' translate from: Japanese pattern.txt for JB v2.0 B+ 2018-05-08

'2018-05-11
' new c, l, b, m commands added but can I draw a box on angle
' I have signaled drawing box bn or rectangle (box filled) mn  if n <> 0 then use angle and draw box or filled box at angle

'2018-05-18
'next I need to fill tile at angle, OK got it!

'now tile the tiles in the very same fashion
'then need to tile at angle which is just like drawing tile at angle
'OK but holes are back and some mighty raggity edges

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 "  *** DrawString and Tile Tester - Sampler  post 2018-05-18 *** " 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

'Celtic$ build
Celtic$ = "wwwkwkwwwkwkwwwwwwwwwwwwwwwwwwwwwkwkrrrkwkwwwkwkwwwrwrwwwkwkwwwwyyryyyywwwwkwkwywrwrwy"
Celtic$ = Celtic$ + "wkwkwwbbybbbrbbbbwwwwbwywrwrwywbwwwwbbbbrbbbybbwwkwkwywrwrwywkwkwwwwyyyyryywwwwkw"
Celtic$ = Celtic$ + "kwwwrwrwwwkwkwwwkwkrrrkwkwwwwwwwwwwwwwwwwwwwwwkwkwwwkwkwww"
Weave$ = "kyyykkyyykryyyrrrrrrryyyrrrrrrryyyrrrrrrkyyykkyyykkyyykkyyykrrrrrryyyrrrrrrryyyrrrrrrryyyrkyyykkyyyk"
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
test = 1

if test + 1 then                         'test drawFilledRect
   for a = 0 to 360 step 10
       scan
       #gr "fill black"
       call RGB "050"
       call dfrt a, 600, 350, 300, 100  'JB Turtle Method fast but wrong! at certain angles Green
       call RGB "208"
       call dfrds a + 180, 600, 350, 300, 100  'My drawString Method is slower  Blue
       call RGB "802"
       call drawFilledRect a + 90, 600, 350, 300, 100  'using Andy's Triangle Fills Red
       call RGB "999"
       call drawRect a, 600, 350, 300, 100
       call drawRect a + 90, 600, 350, 300, 100
       call drawRect a + 180, 600, 350, 300, 100
       call pause 200
   next
end if

if test + 1 then 'test some new drawString commands with new colors system
   call drawString Homer$
   call drawString "s0h15w200r16x";cx;"y";cy;"p-1f200i13pzm1p999b1t22.5"
   call drawString "x";cx;"y";cy;"p703d120s0p999r12i10cZ"
   call wait4Spacebar
end if

if test + 1 then 'test some tiling, was going to use drawString stuff but too slow!
   for i = 0 to 3
       call drawString Homer$
       '' make call  tile x, y, sectionWidth, sectionHeight, tilesWide, tilesHigh, tileMakerPattern$
       call tile 25, 25, 650, 650, 2 + 3*i, 3, Celtic$
       call tile 725, 25, 450, 450, 4, 2 + 3*i, Weave$
       call tile 725, 500, 450, 175, 1+2*i, 1+2*i, Weave$
       call pause 1000
   next
end if

if test + 1 then      'check colors for Tile Maker patterns, now test tile at angles
   'test one tile
   call drawString Homer$
   for a = 0 to 360 step 30
       call drawString "j"
       call drawTileAtAngle a, 300, 200, "rgbozkwvcorgyozv", 200, 160
       call pause 100
   next
   call wait4Spacebar
end if

if test + 1 then       '!!!!!!!!!!!!!!! Here was my counter challenge to tsh73, to draw weave at angles
   call drawString Homer$
   for a = 0 to 90 step 15
       call drawString "j"
   '       angle, left X, top Y, section Width, section Height, number tiles across, number tiles down, pattern$
       call tileAtAngle a, cx, 0, 700, 700, 5, 5, Weave$
       call pause 100
   next
   call wait4Spacebar
end if

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 come reason had to add +5.5
       next
   next
   call wait4Spacebar
end if

if test + 1 then  '              old drawstring code, heart like
   call drawString Homer$;"p802"
   call drawString "r360azfzx";cx;"y";cy+100;"i1"
   for n = 0 to 360
       call drawString "a";n;"f";360-n;"x";cx;"y";cy+100
   next
   call wait4Spacebar
end if
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

'draw a number of tiles to fill in a rectangular screen section top, left x, y
sub tile x, y, sectionWidth, sectionHeight, tilesWide, tilesHigh, tileMakerPattern$
   sideW = int(sectionWidth / tilesWide)
   sideH = int(sectionHeight / tilesHigh)
   for yy = y to y + sectionHeight-sideH step sideH
       for xx = x to x + sectionWidth-sideW step sideW
           scan
           call drawTile xx, yy, tileMakerPattern$, sideW, sideH
       next
   next
end sub

'this draws a number of tiles to fill a rectangle section of screen but at angle at x, y
sub tileAtAngle a, x, y, sectionWidth, sectionHeight, tilesWide, tilesHigh, tileMakerPattern$
   ra = a * pi/180
   tileW = sectionWidth / tilesWide
   tileH = sectionHeight / tilesHigh
   for oy = 0 to tilesHigh - 1
       'consider x1, y1 new origins for a line at angle a, parallel to line at x, y
       x1 = x + oy * tileH * cos(ra + pi/2)  'this is a + pi/2 line down from x, y
       y1 = y + oy * tileH * sin(ra + pi/2)
       for ox = 0 to tilesWide - 1
           scan
           x2 = x1 + ox * tileW * cos(ra)
           y2 = y1 + ox * tileW * sin(ra)
           'drawTileAtAngle a, x, y, pattern$, sideW, sideH
           call drawTileAtAngle a, x2, y2, tileMakerPattern$, tileW,  tileH
       next
   next
end sub

'a tile here a rectangle with a number of smaller rectangles colored by pattern$
sub drawTile x, y, pattern$, sideW, sideH 'sideW, sideH are sides of tile in pixels
   N = sqr(len(pattern$))
   sqW = sideW / N : sqH = sideH / N   'determine smaller rectangle sizes
   for oy = 0 to N-1
       for ox = 0 to N-1
           colr$ = mid$(pattern$, oy * N + ox + 1, 1)
           if instr("rbgoyvcwkz", colr$) then
               select case colr$
               case "r" : call RGB "700"  '3 primary colors r, y, b
               case "b" : call RGB "007"
               case "g" : call RGB "050"
               case "o" : call RGB "940"  '3 secondary colors o, g, v
               case "y" : call RGB "990"
               case "v" : call RGB "705"
               case "c" : call RGB "076"  'cyan
               case "w" : call RGB "999"  '        white black and gray
               case "k" : call RGB "000"
               case "z" : call RGB "433"
               end select
               #gr "place ";x + ox * sqW;" ";y + oy * sqH
               #gr "boxfilled ";x + ox * sqW + sqW;" ";y + oy * sqH + sqH
           end if
       next
   next
end sub

sub drawTileAtAngle a, x, y, pattern$, sideW, sideH
   ra = a * pi/180
   N = sqr(len(pattern$))
   'divide tile section area sideW, sideH into smaller squares to color pattern
   sqW = sideW / N : sqH = sideH / N

   'find each new x2, y2 for top left corner start of squares
   for oy = 0 to N-1

       'consider x1, y1 new origins for a line at angle a, parallel to line at x, y
       x1 = x + oy * sqH * cos(ra + pi/2)  'this is a + pi/2 line down from x, y
       y1 = y + oy * sqH * sin(ra + pi/2)

       for ox = 0 to N-1
           'get our color from pattern
           colr$ = mid$(pattern$, oy * N + ox + 1, 1)
           if instr("rbgoyvcwkz", colr$) then
               select case colr$
               case "r" : call RGB "700"  '3 primary colors r, y, b
               case "b" : call RGB "007"
               case "g" : call RGB "050"
               case "o" : call RGB "940"  '3 secondary colors o, g, v
               case "y" : call RGB "990"
               case "v" : call RGB "705"
               case "c" : call RGB "076"  'cyan
               case "w" : call RGB "999"  '        white black and gray
               case "k" : call RGB "000"
               case "z" : call RGB "433"
               end select

               'decide top left corner for each square off the x1, y1 line
               x2 = x1 + ox * sqW * cos(ra)
               y2 = y1 + ox * sqW * sin(ra)

               ' 3 Methods tested for drawing rectangles at angle dfrt is fastest!

               'now draw the colored square at the angle, at x2, y2 top left corner

               'fastest lots of holes and extra dots
               '(d)raw (f)illed (r)ectangle at given angle (t)urtle method
               call dfrt a, x2, y2, sqW, sqH

               'slowest! but best fills? no Andy;s tri fill is good at fills too
               'try drawString Method works now because RGB updates the turtle color string = cs$
               'call dfrds a, x2, y2, sqW, sqH

               'no holes but raggity edges
               'Andy's fill triangle works
               'call drawFilledRect a, x2, y2, sqW, sqH

           end if
       next
   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 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 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

'Fast Filled Triangle Sub by AndyAmaya
Sub ftriangle x1, y1, x2, y2, x3, y3
   'triangle coordinates must be ordered: where x1 < x2 < x3
   If x2 < x1 Then x = x2 : y = y2 : x2 = x1 : y2 = y1 : x1 = x : y1 = y
   'swap x1, y1, with x3, y3
   If x3 < x1 Then x = x3 : y = y3 : x3 = x1 : y3 = y1 : x1 = x : y1 = y
   'swap x2, y2 with x3, y3
   If x3 < x2 Then x = x3 : y = y3 : x3 = x2 : y3 = y2 : x2 = x : y2 = y
   If x1 <> x3 Then slope1 = (y3 - y1) /(x3 - x1)
   'draw the first half of the triangle
   length = x2 - x1
   If length <> 0 Then
       slope2 = (y2 - y1)/(x2 - x1)
       For x = 0 To length
           #gr "Line ";int(x + x1);" ";int(x * slope1 + y1);" ";int(x + x1);" ";int(x * slope2 + y1)
       Next
   End If
   'draw the second half of the triangle
   y = length * slope1 + y1 : length = x3 - x2
   If length <> 0 Then
       slope3 = (y3 - y2) /(x3 - x2)
       For x = 0 To length
           #gr "Line ";int(x + x2);" ";int(x * slope1 + y+1);" ";int(x + x2+1);" ";int(x * slope3 + y2)
       Next
   End If
End Sub

sub drawFilledRect a, x, y, w, h  'draw Filled Rectangle 2 filled triangles method
   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 "size 2"
   call ftriangle x, y, x1, y1, x2, y2
   call ftriangle x1, y1, x2, y2, x3, y3
   #gr "size ";sz
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

'this needs to set color
sub dfrds a, x, y, w, h  'draw filled rectangle at given angle draw string method
   #gr "size 2"
   call drawString "a";a+90;"x";x;"y";y;"s0r";h;"f";w;"t90fzt90f";w;"t90fzt90i1"
   #gr "size ";sz
end sub