Monday 26 December 2011

SBASIC another listing

There are a plethora of interesting listings to be found in QL User, QL World, Quanta magazine, QLToday and other defunct publications. The length of the listing to be typed is often off putting. Interest in listings here at QL Heaven has been revived with the realisation that the new scanner has inbuilt OCR software that is really quite good. So as a starter here is a snipped of code written by Steve Poole, published in Quanta magazine some time ago and scanned, OCRed and touched up in less than an hour. 

100 :
110 CLEAR : REMark Text-Tumbler. Perspective Animation by S. Poole v30
120 rs=50 : slp = 0 : qz=rs*TAN(RAD(slp)):scy = .5 : Nb = 13 : DIM t(Nb,5): zz =  -5
130 Xaxis = 1 : Yaxis = 2 : Zaxis = 3
140 r90 = RAD(90) : r180 = PI : r270 = RAD(270) : r360=PI*2 : ac = 512 : dn = 256
150 WINDOW ac,dn,0,0 :PAPER 0 : INK 7 : CLS : WINDOW #2,512,206,0,0 : INK#0,7
160 SCX = .75*scy*(ac/dn) : SCALE scy,-SCX/2,-scy/2
170 cx = 0 : cy = scy : cz = qz : tz = qz : REMark cy=scy
180 tx = (rs*SIN(RAD(ng-180)))+cx : ty=(rs*COS(RAD(ng-180)))+cy : Fx=cx-tx: fy=cy-ty
190 fh=((Fx^2)+(fy^2))^.5 : fz=cz-tz : c=ATAN_(fy,Fx) : b=ATAN_(fz,fh)
200 RESTORE
210 FOR f=1 TO Nb : READ t(f,Xaxis),t(f,Yaxis),t(f,Zaxis):END FOR f
215 REPeat loop
220   FOR axis = 3 TO 1 STEP -1
230     FOR thru=0 TO r360 STEP PI/10
240       CLS
250       FOR f = 1 TO Nb
255         CIRCLE 0,0,1E-2
260         rotate axis,thru,t(f,Xaxis),t(f,Yaxis),t(f,Zaxis)
270         ok=VIEW_(Rx,Ry,Rz) : t(f,4)=m : t(f,5)=n
280       END FOR f
290     LINE t(1,4),t(1,5) TO t(2,4),t(2,5) TO t(3,4),t(3,5) TO t(4,4),t(4,5)
300     LINE TO t(5,4),t(5,5) TO t(6,4),t(6,5) TO t(7,4),t(7,5) TO t(8,4),t(8,5)
310     LINE TO t(1,4),t(1,5), t(9,4),t(9,5) TO t(10,4),t(10,5)
320     LINE t(11,4),t(11,5) TO t(12,4),t(12,5) TO t(13,4),t(13,5)
325     PAUSE 10: IF KEYROW(1): EXIT loop
330    END FOR thru
340  END FOR axis
345 END REPeat loop
350 WINDOW 512,206,0,0: CLS
360 :
370 DEFine PROCedure rotate(axe,agl,xx,yy,zz)
380 Rx=xx: Ry=yy: Rz=zz : IF Rx=0: IF Ry=0 : IF Rz=0: RETurn
390 op=Rz : aj=Rx: IF axe=Xaxis: aj=Ry: END IF : IF axe=Zaxis: op=Ry
400 Sop=(op>0)-(op<0): Saj=(aj>0)-(aj<0): hp=((op^2)+(aj^2))^.5
410 IF Sop=0 AND Saj=0: GO TO 590
420 IF Sop=0 AND Saj>0: ang=0
430 IF Sop>0 AND Saj>0: ang=ASIN(ABS(op/hp))
440 IF Sop>0 AND Saj=0: ang=r90
450 IF Sop>0 AND Saj<0: ang=r180-ASIN(ABS(op/hp))
460 IF Sop=0 AND Saj<0: ang=r180
470 IF Sop480 IF Sop<0 AND Saj=0: ang=r270
490 IF Sop<0 AND Saj>0: ang=r360-ASIN(ABS(op/hp))
500 ang=ang+agl: IF ang<0 : ang=ang+r360: END IF
505 IF ang>=r360:ang=ang-r360: END IF
510 IF ang=0 : Sop=0: Saj=1 : op=0 :aj=hp
520 IF ang>0: IF ang530 IF ang=r90: Sop=1: Saj=0 : op=hp: aj=0
540 IF ang>r90 : IF ang550 IF ang=r180 : Sop=0 : Saj=-1:op=0: aj=hp
560 IF ang>r180 : IF ang570 IF ang=r270: Sop=-1: Saj=0:op=hp: aj=0
580 IF ang>r270 :Sop=-1:Saj=l:ng=r360-ang:op=hp*SIN(ng):aj=hp*COS(ng)
590 IF axe=Xaxis: Ry=aj*Saj: Rz=op*Sop: Rx=xx
600 IF axe=Yaxis: Rx=aj*Saj: Rz=op*Sop: Ry=yy
610 IF axe=Zaxis : Rx=aj*Saj: Ry=op-Sop : Rz=zz
620 END DEFine rotate
630 :
640 DEFine FuNction VIEW_(vx,vy,vz)
650 lx=vx-tx: ly=vy-ty: lh=((lx^2)+(ly^2))^.5
660 lz=vz-tz: e=ATAN_(lz,lh)-b: h=ATAN_(ly,lx)-c
670 IF h > PI: h=h-PI*2: END IF : IF h<-PI: h=h+PI*2: END IF
680 IF e > PI: e=e-PI*2: END IF : IF e<-PI: e=e+PI*2: END IF
690 m=TAN(h)*1 : n=-1*TAN(e)*((m^2)+1)^.5: RETurn 1
700 END DEFine  VIEW_
710 :
720 DEFine FuNction ATAN_(oo,aa)
730 so=(oo>0)-(oo<0): sa=(aa>0)-(aa<0)
740 IF (so=0 OR so='1') AND sa=0: RETurn 0: END IF
750 IF so=0 AND sa='1': RETurn r90: END IF
760 IF so=-1 AND sa=0: RETurn r180 : END IF
770 IF so=0 AND sa=-1: RETurn r270: END IF
780 oa=ATAN(aa/oo)
790 IF so='1'AND sa='1': RETurn oa: END IF
800 IF so=-1 AND (sa='1'OR sa=-1): RETurn r180+oa: END IF
810 IF so='1'AND sa=-1: RETurn r360+oa: END IF
820 END DEFine ATAN_
830 :
840 DATA -7,-6,zz,-9,-6,zz,-11,-4,zz,-11,4,zz,-9,6,zz,-5,6,zz,-3,4,zz
850 DATA -3,-2,zz,-3,-6,zz,-7,-2,zz,3,6,zz,3,-6,zz,11,-6,zz

No comments:

Post a Comment