Some while ago, Steve Poole sent me his QL text tumbler program. This was previously here .. https://www.qlforum.co.uk/viewtopic.php ... ion#p17050
This program involves spending lots of time computing highly complex trigonometric values to calculate succeeding points to be drawn on the screen. Once the complete picture is ready, this is drawn on the screen, and a pause is used to allow this to be seen. Because the array variables will have to be used again, the drawing is temporarily erased. The same work is carried out as before. Arriving back again at this point in the loop, the drawing is made again. The one saving grace is that QPC2 is very fast at its work, and the net outcome looks quite good.
There seems to be a better way of doing this work. After the drawing is made, the details are copied to another array. The drawing is not erased at this point, but the program continues on its way and calculates the next set of values. When the time arrives, the drawing is erased using the stored values and is followed immediately by drawing in the new set of values. These new values are again copied into the stored array, and the process continues. This turns out to produce a much better visual image. The speed of operation is not very important, at all. In fact, some pauses have to be included in the code to slow it down.
I have also included some random factors to jumble up the paths taken.
Code: Select all
100 REMark TEXT-TUMBLER. Perspective Animation. by S.Poole. v30may2000
110 ng = 0 : rs = 50 : slp = 0 : qz = rs*TAN(RAD(slp)) : scy = .5 : Nb = 13
120 DIM XXX(Nb), YYY(Nb), ZZZ(Nb), mmm(Nb), nnn(Nb), sss(Nb), ttt(Nb)
130 Xaxis = 1 : Yaxis = 2 : Zaxis = 3
140 r90 = RAD(90) : r180 = PI : r270 = RAD(270) : r360 = PI*2 : ww = 512 : wh = 256
150 WINDOW ww,wh,0,0 : PAPER 0 : CLS
160 scx = .75*scy*(ww/wh) : SCALE scy, -scx/2, -scy/2
170 Sys = 163840 : IF VER$="JSL1" OR VER$="HBA" : Sys = VER$(-2)
180 RANDOMISE : LASTKEY = Sys+139 : Esc = 27
190 REPeat loop
200 IF RND(1)
210 T1 = 0 : T2 = r360 : T3 = PI/50
220 ELSE
230 T1 = r360 : T2 = .1 : T3 = -PI/50
240 END IF
250 ik = RND(4 TO 7) : delay = RND(1 TO 3)
260 sc = RND(1 TO 6)
270 SELect ON sc
280 = 1 : aa = .5 : bb = -.375 : cc = -.25 : REMark original - goes off screen
290 = 2 : aa = .9 : bb = -.9 : cc = -.55 : REMark all fits in
300 = 3 : aa = 1.2 : bb = -1 : cc = -.92 : REMark top
310 = 4 : aa = 1 : bb = -1 : cc = -.55 : REMark middle
320 = 5 : aa = 1 : bb = -1 : cc = -.27 : REMark bottom
330 = 6 : aa = 1.1 : bb = -.9 : cc = -.45 : REMark smaller than 2
340 END SELect
350 INK 0 : LINES sss,ttt
360 SCALE aa,bb,cc
370 FOR nx = -9 TO 9 STEP 9, 3 TO -3 STEP -3
380 cx=nx: cy=scy+nx*2: cz=qz*-10: tz=qz+nx*20
390 tx=(rs*SIN(RAD(ng-180)))+cx: ty=(rs*COS(RAD(ng-180)))+cy: Fx=cx-tx: fy=cy-ty
400 fh=((Fx^2)+(fy^2))^.5: fz=cz-tz: c=ATAN_((fy),(Fx)): b=ATAN_((fz),(fh))
410 RESTORE
420 FOR f = 1 TO Nb : READ XXX(f),YYY(f),ZZZ(f)
430 FOR axis = 3 TO 1 STEP -1
440 FOR thru = T1 TO T2 STEP T3
450 FOR f = 1 TO Nb
460 rotate (axis),(thru),(XXX(f)),(YYY(f)),(ZZZ(f)),Rx,Ry,Rz
470 VIEW_ (Rx),(Ry),(Rz), m, n : mmm(f) = m : nnn(f) = n
480 END FOR f
490 INK 0 : LINES sss,ttt
500 INK ik : LINES mmm,nnn
510 FOR f = 1 TO Nb : sss(f) = mmm(f) : ttt(f) = nnn(f)
520 PAUSE delay
530 IF PEEK(LASTKEY)=Esc : POKE LASTKEY,0 : EXIT loop
540 END FOR thru
550 END FOR axis
560 END FOR nx
570 END REPeat loop
580 INK 0 : LINES sss,ttt
590 INK ik : WINDOW 512,206,0,0 : REMark STOP
600 :
610 REMark REFERENCE mmm(0),nnn(0)
620 DEFine PROCedure LINES(mmm,nnn)
630 LINE mmm(1),nnn(1) TO mmm(2),nnn(2) TO mmm(3),nnn(3) TO mmm(4),nnn(4)
640 LINE TO mmm(5),nnn(5) TO mmm(6),nnn(6) TO mmm(7),nnn(7) TO mmm(8),nnn(8)
650 LINE TO mmm(1),nnn(1), mmm(9),nnn(9) TO mmm(10),nnn(10)
660 LINE mmm(11),nnn(11) TO mmm(12),nnn(12) TO mmm(13),nnn(13)
670 END DEFine LINES
680 :
690 REMark REFERENCE Rx, Ry, Rz
700 DEFine PROCedure rotate(axe,agl,xx,yy,zz, Rx, Ry, Rz)
710 LOCal aj,ang,hp,op,Saj,Sop
720 Rx = xx : Ry = yy : Rz = zz : IF Rx=0 : IF Ry=0 : IF Rz=0 : RETurn
730 op = Rz : aj = Rx : IF axe=Xaxis : aj = Ry : END IF : IF axe=Zaxis : op = Ry
740 Sop = (op>0)-(op<0) : Saj = (aj>0)-(aj<0) : hp = ((op^2)+(aj^2))^.5
750 IF Sop=0 AND Saj=0 : GO TO 940
760 IF Sop=0 AND Saj>0 : ang = 0
770 IF Sop>0 AND Saj>0 : ang = ASIN(ABS(op/hp))
780 IF Sop>0 AND Saj=0 : ang = r90
790 IF Sop>0 AND Saj<0 : ang = r180-ASIN(ABS(op/hp))
800 IF Sop=0 AND Saj<0 : ang = r180
810 IF Sop<0 AND Saj<0 : ang = r180+ASIN(ABS(op/hp))
820 IF Sop<0 AND Saj=0 : ang = r270
830 IF Sop<0 AND Saj>0 : ang = r360-ASIN(ABS(op/hp))
840 ang = ang+agl : IF ang<0 : ang = ang+r360
850 IF ang>=r360 : ang = ang-r360
860 IF ang=0 :Sop= 0:Saj=1: op=0 :aj=hp
870 IF ang>0: IF ang<r90 :Sop= 1:Saj=1: op=hp*SIN(ang):aj=hp*COS(ang)
880 IF ang=r90 :Sop= 1:Saj=0: op=hp :aj=0
890 IF ang>r90: IF ang<r180:Sop= 1:Saj=-1:ng=r180-ang:op=hp*SIN(ng) :aj=hp*COS(ng)
900 IF ang=r180 :Sop= 0:Saj=-1: op=0 :aj=hp
910 IF ang>r180:IF ang<r270:Sop=-1:Saj=-1:ng=ang-r180:op=hp*SIN(ng) :aj=hp*COS(ng)
920 IF ang=r270 :Sop=-1:Saj=0: op=hp :aj=0
930 IF ang>r270 :Sop=-1:Saj= 1:ng=r360-ang:op=hp*SIN(ng) :aj=hp*COS(ng)
940 IF axe=Xaxis : Ry = aj*Saj : Rz = op*Sop : Rx = xx
950 IF axe=Yaxis : Rx = aj*Saj : Rz = op*Sop : Ry = yy
960 IF axe=Zaxis : Rx = aj*Saj : Ry = op*Sop : Rz = zz
970 END DEFine rotate
980 :
990 REMark REFERENCE m, n
1000 DEFine PROCedure VIEW_(vx,vy,vz, m, n)
1010 LOCal e,h,lh,lx,ly,lz
1020 lx = vx-tx : ly = vy-ty : lh = ((lx^2)+(ly^2))^.5
1030 lz = vz-tz : e = ATAN_((lz),(lh))-b : h = ATAN_((ly),(lx))-c
1040 IF h>PI : h = h-PI*2 : END IF : IF h<-PI : h = h+PI*2
1050 IF e>PI : e = e-PI*2 : END IF : IF e<-PI : e = e+PI*2
1060 m = TAN(h)*1 : n = -1*TAN(e)*((m^2)+1)^.5
1070 END DEFine VIEW_
1080 :
1090 DEFine FuNction ATAN_(oo,aa)
1100 LOCal oa,sa,so
1110 so = (oo>0)-(oo<0) : sa=(aa>0)-(aa<0)
1120 IF (so=0 OR so=1) AND sa=0 : RETurn 0
1130 IF so= 0 AND sa= 1 : RETurn r90
1140 IF so=-1 AND sa= 0 : RETurn r180
1150 IF so= 0 AND sa=-1 : RETurn r270
1160 oa = ATAN(aa/oo)
1170 IF so= 1 AND sa= 1 : RETurn oa
1180 IF so=-1 AND (sa=1 OR sa=-1) : RETurn r180+oa
1190 IF so= 1 AND sa=-1 : RETurn r360+oa
1200 END DEFine ATAN_
1210 :
1220 DATA -7,-6,-6, -9,-6,-6, -11,-4,-6, -11,4,-6, -9, 6,-6, -5, 6,-6, -3,4,-6
1230 DATA -3,-2,-6, -3,-6,-6, -7,-2,-6, -1,6,-6, -1,-6,-6, 5,-6,-6
1240 :
1250 REMark REPeat wait : PAUSE 10 : IF KEYROW(1)=1 : EX tumble_obj
1260 REMark To add a QL ... Press ENTER
1270 REMark To remove a QL ... Press Esc
1280 :
1290 REMark Note: If PE is active, use .. EXEP tumble_obj, u
The idea is that you can have several of these QL’s animated all at the same time. To do this, do something like ..
REPeat wait : PAUSE 10 : IF KEYROW(1)=1 : EX tumble_obj
or REPeat wait : PAUSE 10 : IF KEYROW(1)=1 : EXEP tumble_obj, u
The PAUSE 10 is there so that it does not hog the processor too much and slow down the performance of the other jobs.
The ‘u’ is there so they all use the same window
To add a QL, press ENTER.
To remove a QL, press Esc.
Steve likes this very much and has asked me to get this on the forum.
I personally find just 2 or sometimes 4 QL’s can make a very pleasant appearance.
It is easy enough to adjust how many QL’s show by pressing ENTER to add another, and Esc to get rid of one. ENJOY!
EmmBee