The Demos:
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