Kaleidoscope by Midi Boink

Also see the Tapestry demo program included in the zip archive with this newsletter. Midi Boink has created an electronic keyboard that paints a tapestry as you play it. Neat stuff!

noMainWin
dim color$(4)
UpperLeftX = 32
UpperLeftY = 32
WindowWidth = 800
WindowHeight = 600
open "Kalidoscope by Midi Boink" for graphics as #1
[start]
print #1, "trapclose [quit]"
w=800
h=600
count = 1
print #1, "home"
print #1, "down"
print #1, "size 6"
c=400
d=300
a=c:b=d
[loop]
    k=k+1
    x=int(rnd(1)*255)
    y=int(rnd(1)*255)
    z=int(rnd(1)*255)
    c=c+int(rnd(1)*15)-int(rnd(1)*15)
    d=d+int(rnd(1)*15)-int(rnd(1)*15)
    if c>800 then c=int(rnd(1)*40+300):a=c:b=d
    if d>600 then d=int(rnd(1)*40+300):a=c:b=d
    if c<2 then c=2:a=c:b=d
    if d<2 then d=2:a=c:b=d
    print #1, "color "; x;" ";y;" ";z
    print #1, "line "; a;" ";b;" ";c;" ";d
    print #1, "line ";w-a;" ";b;" ";w-c;" ";d
    print #1, "line "; a;" ";h-b;" ";c;" ";h-d
    print #1, "line ";w-a;" ";h-b;" ";w-c;" ";h-d
    a=c:b=d
    timer 10,[stall]
    wait
[stall]
    if k<255 then goto [loop]
    k=0
    print #1, "cls"
    goto [start]
    wait

[quit]
    close #1
    end

Decimal to Roman Numeral Conversion in Mimimal Code

In response to a challenge by Norman, Brad Moore produced this code, with some modifications by Andy Amaya.

dim i(13)
dim r$(13)
key$ = "1000 M 900 CM 500 D 400 CD 100 C 90 XC 50 L 40 XL 10 X 9 IX 5 V 4 IV 1 I"
roman$ = ""
input "Please enter a number:";num
for x = 0 to 12
i(x+1) = val(word$(key$,(x*2)+1))
r$(x+1) = word$(key$,(x*2)+2)
while num >= i(x+1)
    roman$ = roman$ + r$(x+1)
    num = num - i(x+1)
wend
next x
print "The ROMAN conversion is: ";roman$

Bill Beasley also contributed a version, and Norman shared some code from the 1980's. Andy Amaya put them all together and did a bench mark test. Here are the three methods of doing deciman to roman numeral conversion.

[a]
'Scrunched Brad Moore Entry
'234 characters - 14 lines
'2nd Fastest

Dim i(13)
Dim r$(13)

'Input n         replaced for timing test
n = 3999
sTime = time$("ms")
for timeLoop=0 to 499

k$="1000 M 900 CM 500 D 400 CD 100 C 90 XC"
k$=k$+" 50 L 40 XL 10 X 9 IX 5 V 4 IV 1 I"
For x=0 To 12
i(x+1)=val(word$(k$,(x*2)+1))
r$(x+1)=word$(k$,(x*2)+2)
While n>=i(x+1)
r$=r$+r$(x+1)
n=n-i(x+1)
Wend
Next x
Print r$

next timeLoop
ET1 = time$("ms")-sTime

[b]
'Scrunched Bill Beasley Entry
'467 characters - 10 lines
'Fastest routine
'Input a$         replaced for timing test
a$ = "3999"
sTime = time$("ms")
for timeLoop = 0 to 499


v$="3MMM 2MM 1M 0     9CM 8DCCC7DCC 6DC 5D 4CD 3CCC 2CC "
v$=v$+"1C 0     9XC 8LXXX7LXX 6LX 5L 4XL 3XXX 2XX 1X "
v$=v$+"0     9IX 8VIII7VII 6VI 5V 4IV 3III 2II 1I 0     "
L=Len(a$)
If L =4 Then r$=Trim$(Mid$(v$,Instr(v$,Mid$(a$,L-3,1),1)+1,4))
If L>=3 Then r$=r$+Trim$(Mid$(v$,Instr(v$,Mid$(a$,L-2,1),21)+1,4))
If L>=2 Then r$=r$+Trim$(Mid$(v$,Instr(v$,Mid$(a$,L-1,1),71)+1,4))
If L>=1 Then r$=r$+Trim$(Mid$(v$,Instr(v$,Mid$(a$,L,1),121)+1,4))
Print r$

next timeLoop
ET2 = time$("ms")-sTime

[c]
'1980's routine
'183 characters - 6 lines
'3rd Fastest
'Input a$         replaced for timing test
a$ = "3999"
sTime = time$("ms")
for timeLoop = 0 to 499

for j=1 to len(a$)
x=val(mid$("0111344447",val(mid$(a$,j,1))+1,1))
y=val(mid$("0123212342",val(mid$(a$,j,1))+1,1))
print mid$("IIIVIIIXXXLXXXCCCDCCCMMM",7*(len(a$)-j)+x,y);
next j

next timeLoop
ET3 = time$("ms")-sTime
print

print "Routine [a] (Brad Moore): ";ET1
print "Routine [b] (Bill Beasley): ";ET2
print "Routine [c] (80's Routine): ";ET3
end

Rotating 3-D Wire Frame Cube by Thomas Watson

Editor's Note

Since Thomas is my son, I watched him develop this method. He contended that the fun for him was in figuring it out himself, so he steadfastly refused to look at any tutorials or existing algorithms. He wasn't happy with his implementation, so he brainstormed with me. I suggested casting the points towards a vanishing point to render 3-D objects in 2-D space. I had no idea how to go about this, but he had no trouble at all grabbing this idea and writing the code in just a few minutes. It appears to work just fine. Watching the cube swoop around and rotate can be mesmerizing! The caveat: we have no idea how other graphics programmers render 3-D animations!

-Alyce

'Thomas Watson, July 20, 2003
'rotating 3-D wire frame cube with axes

nomainwin

dim view(10)
view(1)=0       'center x
view(2)=0       'center y
view(3)=0       'center z
view(4)=8       'vanishing distance
view(5)=0       'xz angle
view(6)=0       'y angle
view(7)=90      'viewing angle
view(8)=75      'magnification
view(9)=800     'window width
view(10)=600    'window height
dim points(15,6)
for i=1 to 15
for j=1 to 6
read dummy
points(i,j)=dummy
next
next
dim ret(2)
rad=-2.5

WindowWidth=view(9)
WindowHeight=view(10)
open "Cube" for graphics_nf_nsb as #1
#1 "trapclose [quit]"
#1 "down"

[loop]
calldll #kernel32,"Sleep",85 as long,re as long
scan

'modify the angles and coordinates to get the twirling effect
view(5)=view(5)+5
view(6)=view(6)+4
view(7)=view(7)+3
if view(5)>180 then view(5)=view(5)-360
if view(6)>180 then view(6)=view(6)-360
if view(7)>180 then view(7)=view(7)-360

'stationary, rotating cube:
'view(1)=rad*cos(view(5)*3.1415926536/180)*cos(view(6)*3.1415926536/180)
'view(2)=rad*sin(view(6)*3.1415926536/180)
'view(3)=rad*sin(view(5)*3.1415926536/180)*cos(view(6)*3.1415926536/180)

'swooping, rotating cube:
view(1)=rad*cos(view(5)*3.1415926536/180)*cos(view(6)*3.1415926536/180)
view(2)=rad*sin(view(5)*3.1415926536/180)*cos(view(6)*3.1415926536/180)
view(3)=rad*sin(view(6)*3.1415926536/180)

'draw the twelve lines of the cube in a loop
#1 "cls;color black"
for i=1 to 12
call getpoint points(i,1),points(i,2),points(i,3)
x1=ret(1)
y1=ret(2)
call getpoint points(i,4),points(i,5),points(i,6)
x2=ret(1)
y2=ret(2)
#1 "line ";x1;" ";y1;" ";x2;" ";y2
next i

'draw the x-axis
#1 "color red"
call getpoint points(13,1),points(13,2),points(13,3)
x1=ret(1)
y1=ret(2)
call getpoint points(13,4),points(13,5),points(13,6)
x2=ret(1)
y2=ret(2)
#1 "line ";x1;" ";y1;" ";x2;" ";y2

'draw the y-axis
#1 "color green"
call getpoint points(14,1),points(14,2),points(14,3)
x1=ret(1)
y1=ret(2)
call getpoint points(14,4),points(14,5),points(14,6)
x2=ret(1)
y2=ret(2)
#1 "line ";x1;" ";y1;" ";x2;" ";y2

'draw the z-axis
#1 "color blue"
call getpoint points(15,1),points(15,2),points(15,3)
x1=ret(1)
y1=ret(2)
call getpoint points(15,4),points(15,5),points(15,6)
x2=ret(1)
y2=ret(2)
#1 "line ";x1;" ";y1;" ";x2;" ";y2

goto [loop]

[quit] close #1:end

sub getpoint x,y,z  'convert a point in 3d space to 2d screen
x=x-view(1)
y=y-view(2)
z=z-view(3)
pr=sqr(x^2+z^2)
pa=myarctangent(x,z)
x=cos((pa-view(5)+90)*3.1415926536/180)*pr
z=sin((pa-view(5)+90)*3.1415926536/180)*pr
pr=sqr(z^2+y^2)
pa=myarctangent(z,y)
z=cos((pa-view(6))*3.1415926536/180)*pr
y=sin((pa-view(6))*3.1415926536/180)*pr
pr=sqr(x^2+y^2)
pa=myarctangent(x,y)
x=cos((pa-view(7)+90)*3.1415926536/180)*pr
y=sin((pa-view(7)+90)*3.1415926536/180)*pr
x=x*(view(4)-z)/view(4)
y=y*(view(4)-z)/view(4)
x=x*view(8)+view(9)/2
y=-1*y*view(8)+view(10)/2
ret(1)=x
ret(2)=y
end sub

function myarctangent(x,y)
select case
case (y=0)
    if x<0 then myarctangent=180 else myarctangent=0
case (y>0)
    select case
    case (x>0)
        myarctangent=atn(y/x)*180/3.1415926536
    case (x=0)
        myarctangent=90
    case else
        myarctangent=atn(y/x)*180/3.1415926536+180
    end select
case else
    select case
    case (x>0)
        myarctangent=atn(y/x)*180/3.1415926536
    case (x=0)
        myarctangent=90
    case else
        myarctangent=atn(y/x)*180/3.1415926536-180
    end select
end select
end function

data -.5,-.5,-.5,.5,-.5,-.5
data .5,-.5,-.5,.5,.5,-.5
data .5,.5,-.5,-.5,.5,-.5
data -.5,.5,-.5,-.5,-.5,-.5
data -.5,-.5,-.5,-.5,-.5,.5
data -.5,.5,-.5,-.5,.5,.5
data .5,.5,-.5,.5,.5,.5
data .5,-.5,-.5,.5,-.5,.5
data -.5,-.5,.5,.5,-.5,.5
data .5,-.5,.5,.5,.5,.5
data .5,.5,.5,-.5,.5,.5
data -.5,.5,.5,-.5,-.5,.5
data -2,0,0,2,0,0
data 0,-2,0,0,2,0
data 0,0,-2,0,0,2