|
Post by B+ on May 8, 2018 23:14:46 GMT
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
|
|
|
Post by B+ on May 9, 2018 3:35:20 GMT
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
|
|
|
Post by B+ on May 9, 2018 6:03:28 GMT
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
|
|
|
Post by B+ on May 18, 2018 18:25:44 GMT
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
|
|