Post by tsh73 on Apr 11, 2018 7:59:36 GMT -5
I found an old program of mine, from 2009.
And went on to add some text to it:
("XB" is common abbreviation for "Christ is Risen" in Russian - traditional thing to write on Easter eggs)
While adding text I found /fixed a few quirks what just did not show through until this.
And color system works but is really weird.
And went on to add some text to it:
("XB" is common abbreviation for "Christ is Risen" in Russian - traditional thing to write on Easter eggs)
While adding text I found /fixed a few quirks what just did not show through until this.
And color system works but is really weird.
'3d easter egg (beaded)
'by tsh73, January 2009
'v.09
'revised April 2018 - text added
nomainwin
DIM p(10000, 6)
ltrW=22
dim ltr$(ltrW) 'Times New Roman italic via GetPixelValue$
'hand-tuned a little bit
ltr$( 1)=" "
ltr$( 2)=" ** *** "
ltr$( 3)=" ***** **** "
ltr$( 4)=" *** * * "
ltr$( 5)=" ** * "
ltr$( 6)=" **** "
ltr$( 7)=" ** "
ltr$( 8)=" ** "
ltr$( 9)=" ** ********* "
ltr$(10)=" * ** **** *** "
ltr$(11)=" * ** *** *** "
ltr$(12)=" * ** * *** *** "
ltr$(13)=" ** * ** * *** *** "
ltr$(14)=" **** **** *** ** "
ltr$(15)=" *** ** ****** "
ltr$(16)=" *** *** "
ltr$(17)=" *** *** "
ltr$(18)=" *** *** "
ltr$(19)=" *** *** "
ltr$(20)=" *** **** "
ltr$(21)=" *** **** "
ltr$(22)=" ********* "
ltrH=len(ltr$(1))
global width, minX, maxX, height, minY, maxY, sqr3half, Pi
'some constants
grad2rad = 3.1415915 / 180
sqr3half = SQR(3) / 2
Pi = acs(-1)
'indeed for 60 bands pearls look real size. That is, too small
'So I scale it up twice
WindowWidth = 600
WindowHeight = 600+25
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
open "Beaded Easter Egg" for graphics_nsb_nf as #grFunc
#grFunc, "trapclose [trapclosehLabel]"
#grFunc, "home ; down ; posxy x y"
'x, y give us width, height
width = 2*x : height = 2*y
#grFunc, "fill darkgreen; color white; flush"
minX = -1.5
maxX = 1.5
minY = -1.5
maxY = 1.5
beadR = 7
nBands = 60
nMaxCols = 86
'experimentally I got 40 beads of r=10 for circle r = 1
'that is, for 2Pi, or 40/2/Pi per length unit.
n = nBands
i = 1
for k = 1 to n-1 'parallels (bands)
phi = Pi*k/n - Pi/2
rParr = cos(phi) 'this is band radius
'change sphere to egg
d = 1/6 'slant
kk = 0.75 'how narrow
rParr = rParr * kk*((1-sin(phi))*d+(1-d))
nn = int(nMaxCols*rParr/kk)
'parallel at phi
alpha0=Pi*.65 'rotation, where j=0 is
FOR j = 0 TO nn-1
SCAN
'alpha = 2*Pi*i/nn'+Pi/2
alpha = alpha0-2*Pi*j/nn
x = cos(alpha)*rParr
y = sin(alpha)*rParr
z = sin(phi)
p(i, 1) = x
p(i, 2) = y
p(i, 3) = z 'radial bands
'p(i, 3) = z+(alpha-alpha0-Pi)/5 'spiral. doesn't exactly work
p(i, 4) = fnx(x, y, z)
p(i, 5) = fny(x, y, z)
'PSET (p(i, 4), p(i, 5)) 'draw
xx = sx(p(i, 4))
yy = sy(p(i, 5))
p(i, 6) = 0
'read bitmap from ltr$() array.
offY=k-24
offX=j
if offY <= ltrW and offY >0 _
and offX < ltrH and offX>0 then
if mid$(ltr$(ltrW-offY+1),offX,1)="*" then p(i, 6)=1 'It reads upside down
end if
'uncomment to see 'zero' position
'if k = 30 then p(i, 6)=1 'about middle line
'if j=0 then p(i, 6)=1
i = i+1
NEXT
next
n = i-1
print "nBeads=",n
'now, paint them in Z-order
dim ord(n,2)
for i = 1 to n
ord(i,1) = i
ord(i,2) = p(i, 1)+p(i, 2)+p(i, 3) 'this works as Zorder for izometry
next
print "Sorting..."
t0 = time$("ms")
call QSort 1, n 'ord() by ord(i,2)
print "Sorting done, took "; time$("ms")- t0
'then redraw in order.
for i = 1 to n
SCAN 'so you can break it
xx = sx(p(ord(i,1), 4))
yy = sy(p(ord(i,1), 5))
colNum = p(ord(i,1), 3) ' = z
if p(ord(i,1), 6)=1 then colNum = 1
gosub [drawBead]
if n mod 100 = 0 then #grFunc, "discard"
next
#grFunc, "flush"
wait
end
[trapclosehLabel]
close #grFunc
end
'***********************************************************************
[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 = (colNum+1)*180 'continuous band color
'h = (colNum+1)*1000 'continuous band color variant that looks pretty random
s=1
v=.5
for currR = beadR to 1 step -1
v=1-.5*currR/beadR
gosub [HSV_2_RGB]
#grFunc, "color ";RGB$;";backcolor ";RGB$
#grFunc, "place "; int(xx-3*(beadR-currR)/beadR); " "; int(yy-3*(beadR-currR)/beadR)
#grFunc, "circlefilled ";currR
next
return
'***********************************************************************
'3d to plabe
function fnx(x, y, z)
fnx = (x - y) * sqr3half
end function
function fny(x, y, z)
fny = z - (x + y) / 2
end function
'conversions (logical coords to screen)
function sx(x)
'screen X. Depends on width, minX, maxX
sx = (x- minX)/(maxX-minX) * width
end function
function sy(y)
'screen Y. Depends on height, minY, maxY. Upside down.
sy = (1-(y- minY)/(maxY-minY)) * height
end function
'***********************************************************************
'based on JB examples
sub QSort Start, Finish 'sort ord() by ord(i,2)
i = Start
j = Finish
x = ord(int((i+j)/2),2)
while i <= j
while ord(i,2) < x
i = i + 1
wend
while ord(j,2) > x
j = j - 1
wend
if i <= j then
'swap i and j
'a = NumArray(i)
'NumArray(i) = NumArray(j)
'NumArray(j) = a
tmp1 = ord(i,1)
tmp2 = ord(i,2)
ord(i,1)=ord(j,1)
ord(i,2)=ord(j,2)
ord(j,1)=tmp1
ord(j,2)=tmp2
i = i + 1
j = j - 1
end if
wend
if j > Start then call QSort Start, j
if i < Finish then call QSort i, Finish
end sub
