timur77
Junior Member
Someday I will tell my grandsons that I am older than the Internet. And it will blow their brain.
Posts: 79
|
Post by timur77 on Apr 1, 2020 14:31:59 GMT -5
flying and spinning cube program
|
|
timur77
Junior Member
Someday I will tell my grandsons that I am older than the Internet. And it will blow their brain.
Posts: 79
|
Post by timur77 on Apr 1, 2020 14:32:46 GMT -5
here is the code
nomainwin '=================================================== UpperLeftX = 0 UpperLeftY = 0 d=DisplayWidth sh=DisplayHeight WindowWidth = DisplayWidth WindowHeight = DisplayHeight graphicbox #gr.gb, 0, 0, d, sh open "Cub" for window_popup as #gr #gr, "trapclose [exit]" #gr.gb, "when characterInput [exit]" #gr.gb, "when leftButtonDown [exit]" #gr.gb, "setfocus" #gr.gb, "cls" #gr.gb, "down; color white; size 1; fill 0 0 0"'backcolor black; #gr.gb, "place 600 400"
pi=3.14159265359 R=30 w=0
x=d/2+Int(Rnd(1)*100)-50 y=sh/2+Int(Rnd(1)*100)-50
al=0.01'Rnd(1)*2*pi bt=0.01'Rnd(1)*2*pi ga=0.01'Rnd(1)*2*pi
[l1] ddx=Rnd(1)+0.1 ddy=Rnd(1)+0.1 dr=Rnd(1)*0.1+0.1
dal=Rnd(1)*0.005 dbt=Rnd(1)*0.005 dga=Rnd(1)*0.005 '- - - - - - - - - - - - - - - x1=100 x3=150 y1=200 y3=250
[l2] 'if sch=50 Then '#gr.gb, "color ";colR;" ";colG;" ";colB 'sch=0 'else '#gr.gb, "color ";colR/10;" ";colG/10;" ";colB/10'black" 'sch=sch+1 'end if #gr.gb, "color black"
#gr.gb, "Line ";x1;" ";y1;" ";x3;" ";y3 #gr.gb, "goto ";x5;" ";y5 #gr.gb, "goto ";x2;" ";y2 #gr.gb, "goto ";x1;" ";y1 #gr.gb, "goto ";x4;" ";y4 #gr.gb, "goto ";x7;" ";y7 #gr.gb, "goto ";x6;" ";y6 #gr.gb, "goto ";x8;" ";y8 #gr.gb, "goto ";x4;" ";y4 #gr.gb, "Line ";x3;" ";y3;" ";x7;" ";y7 #gr.gb, "Line ";x5;" ";y5;" ";x6;" ";y6 #gr.gb, "Line ";x2;" ";y2;" ";x8;" ";y8
Rx1=R*Cos(ga) Ry1=R*Sin(ga)*Sin(al) R1=Sqr(Rx1*Rx1+Ry1*Ry1) If R1=0 Then Ug1=pi/2 Else Ug1=Acs(Rx1/R1) If Ry1<0 Then Ug1=pi*2-Ug1 dx2=R1*Cos(bt+Ug1) dy2=R1*Sin(bt+Ug1)
Rx2=R*Cos(ga+pi/2) Ry2=R*Sin(ga+pi/2)*Sin(al) R2=Sqr(Rx2*Rx2+Ry2*Ry2) If R2=0 Then Ug2=pi/2 Else Ug2=Acs(Rx2/R2) If Ry2<0 Then Ug2=pi*2-Ug2 dx3=R2*Cos(bt+Ug2) dy3=R2*Sin(bt+Ug2)
Rx3=R*Cos(pi/2) Ry3=R*Sin(pi/2)*Sin(al+pi/2) R3=Sqr(Rx3*Rx3+Ry3*Ry3) If R3=0 Then Ug3=pi/2 Else Ug3=Acs(Rx3/R3) If Ry3<0 Then Ug3=pi*2-Ug3 dx4=R3*Cos(bt+Ug3) dy4=R3*Sin(bt+Ug3)
x1=x-dx2-dx3-dx4 y1=y-dy1-dy3-dy4 x2=x1+2*dx2 y2=y1+2*dy2 x3=x1+2*dx3 y3=y1+2*dy3 x4=x1+2*dx4 y4=y1+2*dy4 x5=x1+2*dx2+2*dx3 y5=y1+2*dy2+2*dy3 x6=x1+2*dx2+2*dx3+2*dx4 y6=y1+2*dy2+2*dy3+2*dy4 x7=x1+2*dx3+2*dx4 y7=y1+2*dy3+2*dy4 x8=x1+2*dx2+2*dx4 y8=y1+2*dy2+2*dy4
#gr.gb, "color ";colR;" ";colG;" ";colB'white" 'col"'???????????????????????? #gr.gb, "Line ";x1;" ";y1;" ";x3;" ";y3 #gr.gb, "goto ";x5;" ";y5 #gr.gb, "goto ";x2;" ";y2 #gr.gb, "goto ";x1;" ";y1 #gr.gb, "goto ";x4;" ";y4 #gr.gb, "goto ";x7;" ";y7 #gr.gb, "goto ";x6;" ";y6 #gr.gb, "goto ";x8;" ";y8 #gr.gb, "goto ";x4;" ";y4 #gr.gb, "Line ";x3;" ";y3;" ";x7;" ";y7 #gr.gb, "Line ";x5;" ";y5;" ";x6;" ";y6 #gr.gb, "Line ";x2;" ";y2;" ";x8;" ";y8
If x+ddx<0+50 Or x+ddx>d-50 Then ddx=(Rnd(1)+0.1)*Sgn(ddx)*(-1):ddy=(Rnd(1)+0.1)*Sgn(ddy):dal=Rnd(1)*0.05*Sgn(dal):dbt=Rnd(1)*0.05*Sgn(dbt):dga=Rnd(1)*0.05*Sgn(dga) x=x+ddx If y+ddy<0+50 Or y+ddy>sh-50 Then ddy=(Rnd(1)+0.1)*Sgn(ddy)*(-1):ddx=(Rnd(1)+0.1)*Sgn(ddx):dal=Rnd(1)*0.05*Sgn(dal):dbt=Rnd(1)*0.05*Sgn(dbt):dga=Rnd(1)*0.05*Sgn(dga) y=y+ddy
If R+dr>75 Or R+dr<25 Then dr=(Rnd(1)*0.05+0.1)*Sgn(dr)*(-1) R=R+dr
'If al+dal>2*pi Or al+dal<0 Then dal=dal*(-1) al=al+dal
'If bt+dbt>pi*2 Or bt+dbt<0 Then dbt=dbt*(-1) bt=bt+dbt
'If ga+dga>pi*2 Or ga+dga<0 Then dga=dga*(-1) ga=ga+dga
w=w+0.01 If w>pi*2 Then w=w-pi*2
'col=RGB(128+127*(Cos(w)),128+127*(cos(w+2.0943951023)),128+127*(cos(w+4.1887902047))) colR=128+127*(Cos(w)) colG=128+127*(cos(w+2.0943951023)) colB=128+127*(cos(w+4.1887902047))
timm=time$("ms") [l3] if time$("ms")<timm+30 then goto [l3]
scan
GoTo [l2] '- - - - - - - - - - - - - - - Function Sgn(ch) Sgn=(ch<0)*(-1)+(ch>0) End Function [exit] close #gr end
|
|