« previous next »
Pages: [1]   Go Down

Author Topic: Shifting Blocks  (Read 5794 times)

0 Members and 1 Guest are viewing this topic.

Offline bikemadness

  • Amiga 1200
  • ****
  • Posts: 322
  • Karma: 25
  • Hard players don't go home.
    • View Profile
Shifting Blocks
« on: July 22, 2007 »
This is an emulation of a program that I saw and can't find anymore, but I found so cool, I had to try and and understand.
I failed.
But I figured out how to do the same effect, without the same amazingly complicated math.

up/down D-pad to choose, X to activate.

Code: [Select]
open window 640,512
show=0
restore shape
read maxnum
dim shape$(maxnum),m(maxnum)
for a=1 to maxnum
read shape$(a)
m(a)=0
next a
sel=1
ang=pi/180
blox=108
l=360/blox
dim x(blox),y(blox),x1(blox),y1(blox)
for a=1 to blox
x(a)=int(ran(25))*20+20
y(a)=int(ran(23))*20+20
x1(a)=x(a)
y1(a)=y(a)
next a
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
c=peek("port1")
setrgb 1,100,100,100
fill rectangle 0,0 to 640,512
for a=1 to maxnum
if sel=a and m(a)=-20 then
setrgb 1,0,250,0
else
setrgb 1,30,30,30
endif
if sel=a and and(c,16384)>0 setrgb 1,250,0,0
if sel=a then
m(a)=m(a)-1
text 560+m(a),a*20+100,shape$(a)
else
m(a)=m(a)+1
text 560+m(a),a*20+100,shape$(a)
endif
if m(a)<-20 m(a)=-20
if m(a)>0 m(a)=0
next a
go=go+1
if go>10 go=10
if and(c,16)>0 and go=10 then
sel=sel-1
go=0
endif
if sel<1 sel=1
if and(c,64)>0 and go=10 then
sel=sel+1
go=0
endif
if sel>maxnum sel=maxnum
for a=1 to blox
if x(a)>x1(a) x(a)=x(a)-1
if x(a)<x1(a) x(a)=x(a)+1
if y(a)>y1(a) y(a)=y(a)-1
if y(a)<y1(a) y(a)=y(a)+1
if and(c,16384)>0 and x(a)=x1(a) and y(a)=y1(a) and sel=1 then
x1(a)=int(ran(25))*20+20
y1(a)=int(ran(23))*20+20
endif
if and(c,16384)>0 and sel=2 then
x1(a)=a*(500/(blox/2))
y1(a)=200
if a>blox/2 then
x1(a)=a*(500/(blox/2))-500
y1(a)=240
endif
endif
if and(c,16384)>0 and sel=3 then
x1(a)=300
y1(a)=a*(500/(blox/2))
if a>blox/2 then
x1(a)=340
y1(a)=a*(500/(blox/2))-500
endif
endif
if and(c,16384)>0 and sel=4 then
x1(a)=int(cos(l*ang*a)*150+250)
y1(a)=int(sin(l*ang*a)*150+250)
endif
if and(c,16384)>0 and sel=5 then
x1(a)=int(cos(l*2*ang*a)*100+150)
y1(a)=int(sin(l*2*ang*a)*100+150)
if a>blox/2 then
x1(a)=int(cos(l*2*ang*a)*100+350)
y1(a)=int(sin(l*2*ang*a)*100+350)
endif
endif
if and(c,16384)>0 and sel=6 then
x1(a)=int(cos((l*3)*ang*a)*(2*a)+250)
y1(a)=int(sin((l*3)*ang*a)*(2*a)+250)
endif
if and(c,16384)>0 and sel=7 then
x1(a)=int(5*a)
y1(a)=int(sin(a/6)*200+260)
endif
if and(c,16384)>0 and sel=8 then
x1(a)=int(ran(50))+200
y1(a)=int(ran(50))+200
endif
if and(c,16384)>0 and sel=9 then
x1(a)=int(cos(l*ang*a)*200+250)
y1(a)=int(sin(l*ang*a)*100+250)
endif
if and(c,16384)>0 and sel=10 then
zx=(blox-a)^1.2
zy=(a)^1.2
x1(a)=int(cos((l*3)*ang*a)*zx+250)
y1(a)=int(sin((l*3)*ang*a)*zy+250)
endif
if and(c,16384)>0 and sel=11 then
if a<28 then
x1(a)=int(cos(l*4*ang*a)*100+150)
y1(a)=int(sin(l*4*ang*a)*100+150)
endif
if a>26 and a<55 then
x1(a)=int(cos(l*4*ang*a)*100+350)
y1(a)=int(sin(l*4*ang*a)*100+150)
endif
if a>54 and a<82 then
x1(a)=int(cos(l*4*ang*a)*100+150)
y1(a)=int(sin(l*4*ang*a)*100+350)
endif
if a>81 then
x1(a)=int(cos(l*4*ang*a)*100+350)
y1(a)=int(sin(l*4*ang*a)*100+350)
endif
endif

if and(c,1)>0 show=0
if and(c,8)>0 show=1
if show=0 then
setrgb 1,250,150,0
fill rectangle x(a)-10,y(a)-10 to x(a)+10,y(a)+10
setrgb 1,0,0,0
rectangle x(a)-10,y(a)-10 to x(a)+10,y(a)+10
endif
if show=1 then
setrgb 1,0,0,0
line to x(a),y(a)
fill rectangle x(a)-2,y(a)-2 to x(a)+2,y(a)+2
endif
next a
until (1=0)
label shape
data 7
data "random","h.lines","v.lines","circle"
data "circles","swirl","sine"

anybody else a bit more fluent in math?

have a Yahappy day.
« Last Edit: December 29, 2010 by bikemadness »
Logged
Have a Yahappy day.
I don't know what is wrong with the world - but I know how to fix it.

Offline Clanky

  • Laser Guided Memories
  • Amiga 1200
  • ****
  • Posts: 340
  • Karma: 16
  • kiss that sound that pounds your senses
    • View Profile
Re: Shifting Blocks
« Reply #1 on: July 22, 2007 »
Wow. Nice.
Logged
He tilts, and his eyes are focused on the ground far below.. Wind? Angels? Men..

Offline Jim

  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 5301
  • Karma: 402
    • View Profile
Re: Shifting Blocks
« Reply #2 on: July 22, 2007 »
I would guess the complicated math in the other one has all the original positions in x,y and all the final positions in x1,y1, and then has a value that goes from 0->1 in little steps (call it t) then you can make any position between them by saying
sx = x + t*(x1-x)
sy = y + t*(y1-y)

But your demo achieves that a different, and that's what counts :)  So, cool!

Jim
Logged
Challenge Trophies Won:

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17422
  • Karma: 499
  • evil/good
    • View Profile
    • My Homepage
Re: Shifting Blocks
« Reply #3 on: July 22, 2007 »
Works well enough here :) This sort of thing can form the basis of a lot of effects like text writers and morphing vectors etc, all good practice.
Logged
Shockwave ^ Codigos
Challenge Trophies Won:

Offline rain_storm

  • Here comes the Rain
  • DBF Aficionado
  • ******
  • Posts: 3088
  • Karma: 182
  • Rain never hurt nobody
    • View Profile
    • org_100h
Re: Shifting Blocks
« Reply #4 on: August 07, 2007 »
that is clever i wish i knew what the original was like
Logged
Challenge Trophies Won:

Offline bikemadness

  • Amiga 1200
  • ****
  • Posts: 322
  • Karma: 25
  • Hard players don't go home.
    • View Profile
Re: Shifting Blocks
« Reply #5 on: November 04, 2007 »
I just had to mess around with this. I added couple more shapes and animated the menu a bit.

The original had flower shapes.

Code: [Select]
open window 640,512
show=0
restore shape
read maxnum
dim shape$(maxnum),m(maxnum)
for a=1 to maxnum
read shape$(a)
m(a)=0
next a
sel=1
ang=pi/180
blox=108
l=360/blox
dim x(blox),y(blox),x1(blox),y1(blox)
for a=1 to blox
x(a)=int(ran(25))*20+20
y(a)=int(ran(23))*20+20
x1(a)=x(a)
y1(a)=y(a)
next a
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
c=peek("port1")
setrgb 1,100,100,100
fill rectangle 0,0 to 640,512
for a=1 to maxnum
if sel=a and m(a)=-20 then
setrgb 1,0,250,0
else
setrgb 1,30,30,30
endif
if sel=a and and(c,16384)>0 setrgb 1,250,0,0
if sel=a then
m(a)=m(a)-1
text 560+m(a),a*20+100,shape$(a)
else
m(a)=m(a)+1
text 560+m(a),a*20+100,shape$(a)
endif
if m(a)<-20 m(a)=-20
if m(a)>0 m(a)=0
next a
go=go+1
if go>10 go=10
if and(c,16)>0 and go=10 then
sel=sel-1
go=0
endif
if sel<1 sel=1
if and(c,64)>0 and go=10 then
sel=sel+1
go=0
endif
if sel>maxnum sel=maxnum
for a=1 to blox
if x(a)>x1(a) x(a)=x(a)-1
if x(a)<x1(a) x(a)=x(a)+1
if y(a)>y1(a) y(a)=y(a)-1
if y(a)<y1(a) y(a)=y(a)+1
if and(c,16384)>0 and x(a)=x1(a) and y(a)=y1(a) and sel=1 then
x1(a)=int(ran(25))*20+20
y1(a)=int(ran(23))*20+20
endif
if and(c,16384)>0 and sel=2 then
x1(a)=a*(500/(blox/2))
y1(a)=200
if a>blox/2 then
x1(a)=a*(500/(blox/2))-500
y1(a)=240
endif
endif
if and(c,16384)>0 and sel=3 then
x1(a)=300
y1(a)=a*(500/(blox/2))
if a>blox/2 then
x1(a)=340
y1(a)=a*(500/(blox/2))-500
endif
endif
if and(c,16384)>0 and sel=4 then
x1(a)=int(cos(l*ang*a)*150+250)
y1(a)=int(sin(l*ang*a)*150+250)
endif
if and(c,16384)>0 and sel=5 then
x1(a)=int(cos(l*2*ang*a)*100+150)
y1(a)=int(sin(l*2*ang*a)*100+150)
if a>blox/2 then
x1(a)=int(cos(l*2*ang*a)*100+350)
y1(a)=int(sin(l*2*ang*a)*100+350)
endif
endif
if and(c,16384)>0 and sel=6 then
x1(a)=int(cos((l*3)*ang*a)*(2*a)+250)
y1(a)=int(sin((l*3)*ang*a)*(2*a)+250)
endif
if and(c,16384)>0 and sel=7 then
x1(a)=int(5*a)
y1(a)=int(sin(a/6)*200+260)
endif
if and(c,16384)>0 and sel=8 then
x1(a)=int(ran(50))+200
y1(a)=int(ran(50))+200
endif
if and(c,16384)>0 and sel=9 then
x1(a)=int(cos(l*ang*a)*200+250)
y1(a)=int(sin(l*ang*a)*100+250)
endif
if and(c,16384)>0 and sel=10 then
zx=(blox-a)^1.2
zy=(a)^1.2
x1(a)=int(cos((l*3)*ang*a)*zx+250)
y1(a)=int(sin((l*3)*ang*a)*zy+250)
endif
if and(c,16384)>0 and sel=11 then
if a<28 then
x1(a)=int(cos(l*4*ang*a)*100+150)
y1(a)=int(sin(l*4*ang*a)*100+150)
endif
if a>26 and a<55 then
x1(a)=int(cos(l*4*ang*a)*100+350)
y1(a)=int(sin(l*4*ang*a)*100+150)
endif
if a>54 and a<82 then
x1(a)=int(cos(l*4*ang*a)*100+150)
y1(a)=int(sin(l*4*ang*a)*100+350)
endif
if a>81 then
x1(a)=int(cos(l*4*ang*a)*100+350)
y1(a)=int(sin(l*4*ang*a)*100+350)
endif
endif

if and(c,1)>0 show=0
if and(c,8)>0 show=1
if show=0 then
setrgb 1,250,150,0
fill rectangle x(a)-10,y(a)-10 to x(a)+10,y(a)+10
setrgb 1,0,0,0
rectangle x(a)-10,y(a)-10 to x(a)+10,y(a)+10
endif
if show=1 then
setrgb 1,0,0,0
line to x(a),y(a)
fill rectangle x(a)-2,y(a)-2 to x(a)+2,y(a)+2
endif
next a
until (1=0)
label shape
data 11
data "random","h.lines","v.lines","circle"
data "circles","swirl","sine","clump"
data "ellipse","knot","clover"

This is a cleaner version. You only need to use the up/down keys.

Code: [Select]
open window 640,512
show=0
restore shape
read maxnum
dim shape$(maxnum),m(maxnum)
for a=1 to maxnum
read shape$(a)
m(a)=0
next a
sel=1
ang=pi/180
blox=108
l=360/blox
dim x(blox),y(blox),x1(blox),y1(blox)
for a=1 to blox
x(a)=int(ran(25))*20+20
y(a)=int(ran(23))*20+20
x1(a)=x(a)
y1(a)=y(a)
next a
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
c=peek("port1")
setrgb 1,100,100,100
fill rectangle 0,0 to 640,512
for a=1 to maxnum
if sel=a and m(a)=-20 then
setrgb 1,0,250,0
else
setrgb 1,30,30,30
endif
if sel=a then
m(a)=m(a)-1
text 560+m(a),a*20+100,shape$(a)
else
m(a)=m(a)+1
text 560+m(a),a*20+100,shape$(a)
endif
if m(a)<-20 m(a)=-20
if m(a)>0 m(a)=0
next a
go=go+1
if go>10 go=10
if and(c,16)>0 and go=10 then
sel=sel-1
go=0
endif
if sel<1 sel=1
if and(c,64)>0 and go=10 then
sel=sel+1
go=0
endif
if sel>maxnum sel=1
if sel<1 sel=maxnum
go1=go1+1
if go1>10 go1=10
if sel<>1 go1=1
for a=1 to blox
if x(a)>x1(a) x(a)=x(a)-1
if x(a)<x1(a) x(a)=x(a)+1
if y(a)>y1(a) y(a)=y(a)-1
if y(a)<y1(a) y(a)=y(a)+1
if sel=1 and go1<9 then
x1(a)=int(ran(25))*20+20
y1(a)=int(ran(23))*20+20
endif
if sel=2 then
xx=xx+1
if xx>18 then
xx=1
yy=yy+1
endif
if yy>6 yy=1
x1(a)=xx*20+75
y1(a)=yy*40+100
endif
if sel=3 then
xx=xx+1
if xx>6 then
xx=1
yy=yy+1
endif
if yy>18 yy=1
x1(a)=xx*40+125
y1(a)=yy*20+75
endif
if sel=4 then
x1(a)=int(cos(l*ang*a)*150+250)
y1(a)=int(sin(l*ang*a)*150+250)
endif
if sel=5 then
x1(a)=int(cos(l*2*ang*a)*100+150)
y1(a)=int(sin(l*2*ang*a)*100+150)
if a>blox/2 then
x1(a)=int(cos(l*2*ang*a)*100+350)
y1(a)=int(sin(l*2*ang*a)*100+350)
endif
endif
if sel=6 then
x1(a)=int(cos((l*3)*ang*a)*(2*a)+250)
y1(a)=int(sin((l*3)*ang*a)*(2*a)+250)
endif
if sel=7 then
x1(a)=int(5*a)
y1(a)=int(sin(a/6)*200+260)
endif
if sel=8 then
xx=xx+1
if xx>12 then
xx=1
yy=yy+1
endif
if yy>9 yy=1
x1(a)=xx*20+150
y1(a)=yy*20+150
endif
if sel=9 then
x1(a)=int(cos(l*ang*a)*200+250)
y1(a)=int(sin(l*ang*a)*100+250)
endif
if sel=10 then
zx=(blox-a)^1.2
zy=(a)^1.2
x1(a)=int(cos((l*3)*ang*a)*zx+250)
y1(a)=int(sin((l*3)*ang*a)*zy+250)
endif
if sel=11 then
if a<28 then
x1(a)=int(cos((l*4)*ang*a)*80+170)
y1(a)=int(sin((l*4)*ang*a)*80+170)
endif
if a>27 and a<55 then
x1(a)=int(cos((l*4)*ang*a)*80+170)
y1(a)=int(sin((l*4)*ang*a)*80+330)
endif
if a>54 and a<82 then
x1(a)=int(cos((l*4)*ang*a)*80+330)
y1(a)=int(sin((l*4)*ang*a)*80+170)
endif
if a>81 then
x1(a)=int(cos((l*4)*ang*a)*80+330)
y1(a)=int(sin((l*4)*ang*a)*80+330)
endif
endif
if sel=12 then
if a<28 then
x1(a)=int(cos(l*3*ang*(a+7))*80+170)
y1(a)=int(sin(l*3*ang*(a+7))*80+170)
endif
if a>27 and a<55 then
x1(a)=int(cos(l*3*ang*(a+8))*80+170)
y1(a)=int(sin(l*3*ang*(a+8))*80+330)
endif
if a>54 and a<82 then
x1(a)=int(cos(l*3*ang*(a+1))*80+330)
y1(a)=int(sin(l*3*ang*(a+1))*80+170)
endif
if a>81 then
x1(a)=int(cos(l*3*ang*(a+18))*80+330)
y1(a)=int(sin(l*3*ang*(a+18))*80+330)
endif
endif
if and(c,1)>0 show=0
if and(c,8)>0 show=1
if show=0 then
setrgb 1,250,150,0
fill rectangle x(a)-10,y(a)-10 to x(a)+10,y(a)+10
setrgb 1,0,0,0
rectangle x(a)-10,y(a)-10 to x(a)+10,y(a)+10
endif
if show=1 then
setrgb 1,0,0,0
line to x(a),y(a)
fill rectangle x(a)-2,y(a)-2 to x(a)+2,y(a)+2
endif
next a
until (1=0)
label shape
data 12
data "random","h.lines","v.lines","circle"
data "circles","swirl","sine","clump"
data "ellipse","knot","clover","cloverleaf"
« Last Edit: February 05, 2013 by bikemadness »
Logged
Have a Yahappy day.
I don't know what is wrong with the world - but I know how to fix it.

Offline rain_storm

  • Here comes the Rain
  • DBF Aficionado
  • ******
  • Posts: 3088
  • Karma: 182
  • Rain never hurt nobody
    • View Profile
    • org_100h
Re: Shifting Blocks
« Reply #6 on: November 04, 2007 »
The spiral looks a lot better with double the blocks, the knot was a nice addition too
Logged
Challenge Trophies Won:

Offline Galileo

  • ZX 81
  • *
  • Posts: 22
  • Karma: 0
    • View Profile
Re: Shifting Blocks
« Reply #7 on: September 04, 2014 »
As usual, you've done a good job.  :clap:
Logged
Pages: [1]   Go Up
« previous next »