|
Post by tsh73 on Dec 25, 2023 8:39:22 GMT -5
'Merry Christmas 2024! 'Christmas coin, made with CNC tools (kind of) 'tsh73 Dec 2023
nomainwin
desiredWidth = 600 desiredHeight = 600 pi=acs(-1) pi2=pi/2
gosub [ajustWindow] UpperLeftX = (DisplayWidth - WindowWidth)/2 UpperLeftY = (DisplayHeight - WindowHeight)/2 width=desiredWidth height=desiredHeight
open "Christmas coin 2024" for graphics_nsb_nf as #gr #gr, "trapclose [quit]"
#gr "home; posxy cx cy" #gr "down"
#gr "fill black" #gr "color white"
#gr "backcolor black"
'curving year along upper edge #gr "color yellow" #gr "font Times_New_Roman 32 bold" s$="2024" #gr "stringwidth? s$ w" #gr "place ";cx-w/2;" ";cy #gr "\";s$
''a=w/(cx*0.80*2*pi)*2*pi a=w/(cx*0.80) dd=a/w a2=a/2
#gr "size 2" for a1 = 0-a2 to a2 step dd for r = 0 to cx*0.1 SCAN y0=cy-r x0=cx+w*a1/a #gr "getbmp pix "; x0; " "; y0; " 1 1" '#gr "set "; x0; " "; y0 rr=cx*0.7 +r x=cx-rr*cos(a1+pi2) y=cy+rr*sin(a1-pi2) #gr "drawbmp pix "; x; " "; y next next
#gr "color black" #gr "place ";cx-w/2;" ";cy #gr "\";s$
'curving "Merry Christmas!" along bottom edge #gr "color yellow" #gr "font Times_New_Roman 24 italic bold" s$="Merry Christmas!" #gr "stringwidth? s$ w" #gr "place ";cx-w/2;" ";cy #gr "\";s$
a=w/(cx*0.80) dd=a/w a2=a/2
#gr "size 2" for a1 = 0-a2 to a2 step dd for r = 0 to cx*0.1 SCAN y0=cy-(22-r) '22 for hanger of "y" x0=cx+w*a1/a #gr "getbmp pix "; x0; " "; y0; " 1 1" rr=cx*0.7 +r x=cx+rr*cos(0-a1+pi2) y=cy+rr*sin(a1+pi2) #gr "drawbmp pix "; x; " "; y next next
#gr "color black" #gr "place ";cx-w/2;" ";cy #gr "\";s$
'now, the tree. 9pt taken from picture data 300 , 141 data 371 , 230 data 361 , 250 data 416 , 320 data 401 , 345 data 456 , 430 data 346 , 460 data 336 , 480 data 300 , 488
'#gr "color white" numPt=16 dim xp(numPt), yp(numPt) 'polygon points for AndyAmaya PointInPoligon
read x, y y=y-20 xp(0)=x:yp(0)=y x1=x:y1=y x2=x:y2=y '#gr "set ";x1;" ";y1
For i = 2 to 9 read x, y y=y-20 '#gr "set ";x1;" ";y1 '#gr "goto ";x;" ";y x1=x:y1=y xp(i-1)=x1:yp(i-1)=y1 '#gr "set ";x2;" ";y2 '#gr "goto ";300-(x-300);" ";y x2=300-(x-300):y2=y xp(16+1-i)=x2:yp(16+1-i)=y2 next
#gr "flush"
sz=6 sz2=sz*sqr(2) x=0 y=int(sz2) #gr "size 1" d=1 'CNC zig-zag path 'move up/ till y <= 0 'move -> for sz2 'move down/ till x<=0 'move down for sz2 'that will be triangle
#gr "size 1" #gr "color red"
FOR pass=1 TO 2 'upper left triangle x=0 y=int(sz2) while 1 while y > 0 gosub [drawDot] x=x+d:y=y-d wend xx=x+sz2 while x < xx gosub [drawDot] x=x+d wend while x > 0 gosub [drawDot] x=x-d:y=y+d wend yy=y+sz2 while y < yy gosub [drawDot] y=y+d wend if y >height then exit while wend 'wait 'now same but lower right triangle y=height 'or I got out x=0 while 1 while x < width gosub [drawDot] x=x+d:y=y-d wend yy=y+sz2 while y < yy gosub [drawDot] y=y+d wend while y < height gosub [drawDot] x=x-d:y=y+d wend xx=x+sz2 while x < xx gosub [drawDot] x=x+d wend if x >width then exit while wend next
#gr "discard"
'now add some balls h=0 'red beadR = 13 for y = -2 to 2 for x = -2 to 2 xx=cx+(x+y/4)*cx/5 +25 yy = cy+(y+x/3)*cy/3 -30 if pNp(xx, yy, numPt) <>0 then call pause 200 gosub [drawBead] 'from some old program h=h+185 'in degrees, trial and error end If Next next
wait
[drawDot] SCAN dist=sqr((x-cx)^2+(y-cy)^2) if pass=1 then if (dist > cx*0.65) and (dist < cx*0.85 ) then return #gr "set ";x;" ";y return end if 'print x, y, dist, dist/cx select case case dist > cx*0.90 #gr "color black" #gr "size ";1 case dist > cx*0.85 #gr "color white" szz=sz*(1.4-abs(dist-cx*0.875)/8) #gr "size ";szz case dist > cx*0.65 return case pNp(x, y, numPt) <>0 #gr "color green" szz=sz*(1.2-abs(x-cx)/(xx(y,numPt)-cx)) #gr "size ";szz case Else #gr "color white" #gr "size ";1 end select #gr "set ";x;" ";y return
[quit] close #gr end
'------------------------------------------------- [ajustWindow] UpperLeftX = 20 UpperLeftY = 20 WindowWidth = 200 '100 seems to be too much - works different WindowHeight = 100 open "Ajusting..." for graphics_nsb_nf as #gr
#gr, "home ; down ; posxy x y" 'x, y give us width, height width = 2*x : height = 2*y close #gr
slackX = 200-width slackY = 100-height
WindowWidth = desiredWidth + slackX WindowHeight = desiredHeight + slackY
return
Function xx(y, npol) 'get corresponding x for y For i = 0 To npol/2 if (yp(i) <= y) and (y < yp(i+1)) then f=1: exit for Next if f Then xx = xp(i) + (y-yp(i))/(yp(i+1)-yp(i))*(xp(i+1)-xp(i)) else 'not found xx=0 'special value, to be checked end if End Function
''Point in Polygon 'Andres Amaya Jr Function pNp(x, y, npol) c = 0 For i = 0 To npol-1 j = (i+1) Mod npol v1 = (yp(i) <= y) v2 = (y < yp(j)) v3 = (yp(j) <= y) v4 = (y < yp(i)) v5 = (xp(j) - xp(i)) * (y - yp(i)) v6 = (yp(j) - yp(i)) If v6 = 0.0 then v6 = 0.0001 v7 = xp(i) If (((v1 And v2)) Or (v3 And v4)) And (x < v5 / v6 + v7) Then c = 1 - c Next i pNp = c End Function
'*********************************************************************** [HSV_2_RGB] 'Input: (h,s,v) 'h in the range [0, 360), indicating the angle, in degrees of the hue 's and v varying between 0 and 1, representing the saturation and value, respectively 'Output: r,g,b [0,1] 'and to be useful, R G B [0 255] 'or to JB RGB$ as "R G B" string.
hi = int(h/60) mod 6 f = h/60 - int(h/60) p = v*(1-s) q = v*(1-f*s) t = v*(1-(1-f)*s) ' print hi, select case hi case 0 r = v: g = t: b = p case 1 r = q: g = v: b = p case 2 r = p: g = v: b = t case 3 r = p: g = q: b = v case 4 r = t: g = p: b = v case 5 r = v: g = p: b = q end select R = int(r*255) G = int(g*255) B = int(b*255) RGB$= R;" ";G;" ";B return
'*********************************************************************** [drawBead] 'h = rnd(1)*360 'random band color s=1 v=.5
for currR = beadR to 1 step -1 v=1-.5*currR/beadR gosub [HSV_2_RGB] #gr, "color ";RGB$ #gr, "backcolor ";RGB$ #gr, "place "; xx-3*(beadR-currR)/beadR; " "; yy-3*(beadR-currR)/beadR #gr, "circlefilled ";currR next return
sub pause mil t0=time$("ms") while time$("ms")-t0<mil scan wend end sub
|
|
|
Post by Carl Gundel on Dec 25, 2023 14:07:48 GMT -5
Merry Christmas everyone!
|
|
|
Post by Marco Kurvers on Dec 25, 2023 16:48:43 GMT -5
Merry Christmas and a happy New Year!
|
|
|
Post by Brandon Parker on Dec 25, 2023 22:30:06 GMT -5
Merry Christmas!!
{:0)
Brandon Parker
|
|