The Sinclair QL Forum

Happy 2020 to all!!!

Hi,
Here's a QL screen demo present, just in case you missed getting it before... ( Just c

opy and paste it ...)
Happy New Year,
Steve .

_______________________________
100 :
110 REMark TEXT_TUMBLER4. QL Perspective Animation. by S.Poole. v10may2018
120 REMark DATA_AREA 20: REMark for TURBO_SMS_CODE: REMark written on QPC2
130 :
140 WINDOW 512,256,0,0: BORDER 0: CLS
150 REMark INITialise variables :
160 Nb=13: DIM t(Nb,5),t2(Nb,5),i$(8)
170 qz=0: REMark slp=0: qz=rs*TAN(RAD(slp)): REMark for future use.
180 Xaxis=1: Yaxis=2: Zaxis=3
190 r90=RAD(90): r180=PI: r270=RAD(270): r360=PI*2: ac=412: dn=256
200 w=.2: sw=-1: scy=2: swx=-1: swy=-1: swz=-1: swt=-1: nng=0: tz=0
210 cx=RND(-.9 TO .9): cy=RND(-.9 TO .9): cz=qz : cz=RND(-1.5 TO 1.5)
220 :
230 WINDOW ac,dn,48,0: BORDER 2,2: PAPER 0: INK 7: CLS
240 RESTORE 1550: REMark get end_points for yellow QL :
250 FOR f=1 TO Nb: READ t(f,Xaxis),t(f,Yaxis),t(f,Zaxis)
260 RESTORE 1550: REMark repeat for parallel white QL :
270 FOR f=1 TO Nb:READ t2(f,Xaxis),t2(f,Yaxis),t2(f,Zaxis):t2(f,Zaxis)=t2(f,Zaxis)+1
280 :
290 REPeat loop
300 RANDOMISE DATE: REMark Reseed regularly :
310 ::
320 FOR axis=2,1,3
330 REMark Spin QL around each of three axes in turn :
340 :::
350 FOR rs=RND(20 TO 110)
360 REMark Vary the radius from view-point to QL position :
370 rdd=1.2: rnd1=2+RND*rdd-RND*rdd : rnd2=2+RND*rdd-RND*rdd
380 ::::
390 FOR thru=0 TO r360 STEP PI/30, r360 TO PI/30 STEP -PI/30
400 REMark rotate through smooth steps :
410 :::::
420 REMark Zoom in and out as QL moves :
430 scy=scy+5E-2*sw: IF scy<.5: sw=sw*-1: END IF : IF scy>5: sw=sw*-1
440 scx=.76*scy*(ac/dn): SCALE scy,-scx/rnd1,-scy/rnd2 : fr=2: nng=nng+RAD(30)
450 :
460 REMark Vary Centre-point in xyz on screen :
470 cx=cx+.2*swx: IF cx<-fr: swx=swx*-1: END IF : IF cx>fr: swx=swx*-1
480 cy=cy+.1*swy: IF cy<-fr: swy=swy*-1: END IF : IF cy>fr: swy=swy*-1
490 cz=cz+.1*swz: IF cz<-fr: swz=swz*-1: END IF : IF cz>fr: swz=swz*-1
500 tz=tz-.1*swt: IF tz<-fr: swt=swt*-1: END IF : IF tz>fr: swt=swt*-1
510 :
520 REMark T rajectory point of QL , and F ocal x,y,z points & directions on screen :
530 tx=(rs*SIN(RAD(nng-180)))+cx: ty=(rs*COS(RAD(nng-180)))+cy
540 Fx=cx-tx: fy=cy-ty: fz=cz-tz: fh=((Fx^2)+(fy^2))^.5
550 c=ATAN_(fy,Fx): b=ATAN_(fz,fh)
560 ::::::
570 FOR f=1 TO Nb
580 REMark f calculates the perspective coordinates :
590 rotate axis,thru,t(f,Xaxis),t(f,Yaxis),t(f,Zaxis)
600 ok=VIEW_(Rx,Ry,Rz): t(f,4)=m: t(f,5)=n
610 rotate axis,thru,t(f,Xaxis),t(f,Yaxis),t2(f,Zaxis)
620 ok=VIEW_(Rx,Ry,Rz): t2(f,4)=m: t2(f,5)=n
630 END FOR f: INK 1: CIRCLE 0,0,3: REMark Draw background.
640 ::::::
650 FOR j=6,0
660 INK j: REMark j draws yellow & white lines in perspective :
670 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)
680 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)
690 LINE TO t(1,4),t(1,5), t(9,4),t(9,5) TO t(10,4),t(10,5)
700 LINE t(11,4),t(11,5) TO t(12,4),t(12,5) TO t(13,4),t(13,5)
710 IF j=6: INK 7
720 LINE t2(1,4),t2(1,5) TO t2(2,4),t2(2,5) TO t2(3,4),t2(3,5) TO t2(4,4),t2(4,5)
730 LINE TO t2(5,4),t2(5,5) TO t2(6,4),t2(6,5) TO t2(7,4),t2(7,5) TO t2(8,4),t2(8,5)
740 LINE TO t2(1,4),t2(1,5), t2(9,4),t2(9,5) TO t2(10,4),t2(10,5)
750 LINE t2(11,4),t2(11,5) TO t2(12,4),t2(12,5) TO t2(13,4),t2(13,5)
760 IF j<>0: i$=INKEY$(2): IF i$<>'': EXIT loop
770 END FOR j
780 :::::
790 END FOR thru
800 ::::
810 END FOR rs
820 :::
830 END FOR axis
840 ::
850 END REPeat loop
860 PAUSE: STOP
870 :::::::::::::::::::::::::::::::
880 : REMark End of MAIN program
890 :::::::::::::::::::::::::::::::
900 DEFine PROCedure rotate(axe,agl,xx,yy,zz)
910 Rx=xx: Ry=yy: Rz=zz: IF Rx=0 : IF Ry=0: IF Rz=0: RETurn
920 REMark OPposite & AJacent sides :
930 op=Rz: aj=Rx: IF axe=Xaxis: aj=Ry: END IF : IF axe=Zaxis: op=Ry
940 REMark get the signs of the line angles :
950 Sop=(op>0)-(op<0): Saj=(aj>0)-(aj<0): hp=((op^2)+(aj^2))^.5
960 :
970 REMark get the trigonometric angles from the sides :
980 IF Sop=0 AND Saj=0: GO TO 1210
990 IF Sop=0 AND Saj>0: ang=0
1000 IF Sop>0 AND Saj>0: ang=ASIN(ABS(op/hp))
1010 IF Sop>0 AND Saj=0: ang=r90
1020 IF Sop>0 AND Saj<0: ang=r180-ASIN(ABS(op/hp))
1030 IF Sop=0 AND Saj<0: ang=r180
1040 IF Sop<0 AND Saj<0: ang=r180+ASIN(ABS(op/hp))
1050 IF Sop<0 AND Saj=0: ang=r270
1060 IF Sop<0 AND Saj>0: ang=r360-ASIN(ABS(op/hp))
1070 :
1080 REMark rotate the lines by adding agl on axis :
1090 ang=ang+agl: IF ang<0 : ang=ang+r360: END IF
1100 IF ang>=r360:ang=ang-r360: END IF
1110 IF ang=0 : Sop=0: Saj=1: op=0: aj=hp
1120 IF ang>0: IF ang<r90 : Sop=1: Saj=1: op=hp*SIN(ang): aj=hp*COS(ang)
1130 IF ang=r90 : Sop=1: Saj=0: op=hp: aj=0
1140 IF ang>r90 : IF ang<r180 : Sop=1: Saj=-1:ng=r180-ang:op=hp*SIN(ng):aj=hp*COS(ng)
1150 IF ang=r180 : Sop=0: Saj=-1: op=0: aj=hp
1160 IF ang>r180: IF ang<r270 : Sop=-1:Saj=-1:ng=ang-r180:op=hp*SIN(ng):aj=hp*COS(ng)
1170 IF ang=r270 : Sop=-1: Saj=0: op=hp: aj=0
1180 IF ang>r270 : Sop=-1: Saj=1:ng=r360-ang:op=hp*SIN(ng):aj=hp*COS(ng)
1190 :
1200 REMark get transformed absolute coordinates :
1210 IF axe=Xaxis: Ry=aj*Saj: Rz=op*Sop: Rx=xx
1220 IF axe=Yaxis: Rx=aj*Saj: Rz=op*Sop: Ry=yy
1230 IF axe=Zaxis: Rx=aj*Saj: Ry=op*Sop: Rz=zz
1240 END DEFine rotate
1250 :
1260 DEFine FuNction VIEW_(vx,vy,vz)
1270 REMark get perspective coordinates from absolute ones :
1280 REMark V(xyz)iew-point to T(xyz)rajectory point : H ypotenuse :
1290 lx=vx-tx: ly=vy-ty: lz=vz-tz : lh=((lx^2)+(ly^2))^.5
1300 REMark h is azimut : e is dip-slope :
1310 e=ATAN_(lz,lh)-b: h=ATAN_(ly,lx)-c
1320 REMark keep angles within whole circle range :
1330 IF h > PI: h=h-PI*2: END IF : IF h<-PI: h=h+PI*2: END IF
1340 IF e > PI: e=e-PI*2: END IF : IF e<-PI: e=e+PI*2: END IF
1350 REMark m & n are screen coordinates :
1360 m=TAN(h)*1: n=-1*TAN(e)*((m^2)+1)^.5: RETurn 1
1370 END DEFine VIEW
1380 :
1390 DEFine FuNction ATAN_(oo,aa)
1400 REMark adapt QL trigonometry to 3D trigonometry :
1410 REMark first get the line direction signs :
1420 so=(oo>0)-(oo<0): sa=(aa>0)-(aa<0)
1430 IF (so=0 OR so=+1) AND sa=0: RETurn 0
1440 IF so=0 AND sa=+1 : RETurn r90
1450 IF so=-1 AND sa=0 : RETurn r180
1460 IF so=0 AND sa=-1 : RETurn -r90
1470 oa=ATAN(aa/oo)
1480 IF so=+1 AND sa=+1 : RETurn oa
1490 IF so=-1 AND sa=+1 : RETurn oa-r360
1500 IF so=-1 AND sa=-1 : RETurn oa-r360
1510 IF so=+1 AND sa=-1 : RETurn oa
1520 END DEFine ATAN_
1530 :
1540 REMark Get line end-points to construct Q & L :
1550 DATA -7,-6,-9, -9,-6,-9, -11,-4,-9, -11,4,-9, -9,6,-9, -5,6,-9, -3,4,-9
1560 DATA -3,-2,-9, -3,-6,-9, -7,-2,-9, 3,6,-9, 3,-6,-9, 11,-6,-9

Happy New Year !

Hi again,
Fine firework display !
Here's an old program dressed up for a New Year...
( line 310 is for 128ko... )
( line 315 needs LRESPR ..._Chans_Code from Simon Goodwin's tollkits....)
Steve.
______________

90 REMark TEXT_3D2_bas
100 init: REMark TEXT_3D, by S.Poole, v9,91.
110 PRINT#0,'HIT any KEY to continue......': PAUSE -1: CSIZE#0,0,0
120 :
130 DEFine PROCedure init
140 LOCal m$(9,120)
150 INK#0,7: WINDOW#2,512,206,0,0
160 WINDOW 512,256,0,0: PAPER 0: INK 7: CLS: SCALE 2,2/-1.5,-2
170 m$(1)=" PERSPECTIVE 3D TEXT......(15 mins on 128ko.)"
180 m$(2)="This program creates a page which is swung around the Z-axis."
190 m$(3)="The structure is similar to that in the QL 'world' program."
200 m$(4)="See that program for more detailed commentaries in REMs."
210 m$(5)="The text is automatically centered, depending on row & column settings."
220 m$(6)="The Page has 3 rows & 8 cols, Slope 45º and a 20º swivel."
230 m$(7)="A modified Zoom parameter gives a wide-angular stretch."
240 m$(8)="Ink colours are overlaid to give solidity, with no hidden-face arrays."
250 m$(9)='HIT any KEY to continue........'
260 FOR f=1 TO 9: PRINT m$(f)\\
270 PAUSE -1: CLS: REPeat again: main: END REPeat again: END DEFine
280 :
290 DEFine PROCedure main
305 q$='SinclairHappy QL 2020 ! ': rows=3: cols=8: slp=45: stp=30: front=0
310 REMark k=PEEK_L(PEEK_L(PEEK_L(163960)+4)+42)-277 : REMark on 128ko...
315 font1=CHAN_L(1,42): k=font1-277 : REMark LRESPR chans_code
320 sy=-10 : Yorg= (rows DIV 2)*-sy +4.5 +4.5*(NOT(rows MOD 2))
330 sx=7 : Xorg= (cols DIV 2)*-sx +2.5 +2.5*(NOT(cols MOD 2 ))
340 rs= INT((((sy*rows)^2)+((sx*cols)^2))^.5)/1.9: z=rs*TAN(RAD(slp))
350 r1=RAD(90): r2=RAD(180): mx=RAD(85): cx=0: cy=0: cz=z: tz=z
360 FOR ng=0 TO 360 STEP 20
370 ct=0: tx=(rs*SIN(RAD(ng-180)))+cx: ty=(rs*COS(RAD(ng-180)))+cy
380 Fx=cx-tx: fy=cy-ty: c=atan_(fy,Fx): b=atan_(cz-tz,(((Fx^2)+(fy^2))^.5))
390 FOR row= Yorg TO (Yorg-((rows-1)*-sy)) STEP sy
400 FOR col= Xorg TO (Xorg+((cols-1)* sx)) STEP sx
410 ct=ct+1: cd=CODE(q$(ct)): FOR ik=2,6
420 INK ik: Z1=ik*.2: p=k+9*cd: FOR y=0 TO 8
430 pk= PEEK(p+y): FOR x=0 TO 4
440 f1=2^(6-x): IF pk&&f1 THEN
450 x1=col+x: x2=x1+1: y1=row-y: y2=y1-1
460 V x1,y1: m1=m: n1=n: V x2,y1: m2=m: n2=n: V x2,y2: m3=m: n3=n: V x1,y2
470 FILL 1: LINE m,n TO m1,n1 TO m2,n2 TO m3,n3 TO m,n : FILL 0: IF y=8: GO TO 560
480 pk2=PEEK(p+y+1): IF pk2&&f1:GO TO 560: END IF : lf=2^(6-(x-1)): rt=2^(6-(x+1))
490 IF (x<4) AND (pk2&&rt) AND (NOT(pk&&rt)) THEN
500 V x2,y1: m1=m: n1=n: V x2+1,y2: m2=m: n2=n: V x2,y2-1: m3=m: n3=n: V x1,y2
510 FILL 1: LINE m,n TO m1,n1 TO m2,n2 TO m3,n3 TO m,n: FILL 0: END IF
520 IF (x>0) AND (pk2&&lf) AND (NOT(pk&&lf)) THEN
530 V x1,y1: m1=m: n1=n: V x2,y2: m2=m: n2=n: V x1,y2-1: m3=m: n3=n: V x1-1,y2
540 FILL 1: LINE m,n TO m1,n1 TO m2,n2 TO m3,n3 TO m,n : FILL 0: END IF
550 END IF
560 END FOR x:END FOR y:END FOR ik:END FOR col:END FOR row:PAUSE 29:CLS:END FOR ng
570 END DEFine
580 :
590 DEFine PROCedure V(vx,vy)
600 lx=vx-tx: ly=vy-ty: e=atan_(Z1-tz,(((lx^2)+(ly^2))^.5))-b: h=atan_(ly,lx)-c
610 IF h > PI: h=h-PI*2: END IF : IF h<-PI: h=h+PI*2: IF ABS(h)>mx: NEXT x
620 IF e > PI: e=e-PI*2: END IF : IF e<-PI: e=e+PI*2: IF ABS(e)>mx: NEXT x
630 m=TAN(h)*-1: n=TAN(e)*((m^2)+1)^.5: END DEFine
640 :
650 DEFine FuNction atan_(g,d)
660 IF d<0 AND g<0: a=ATAN(g/d)-r2: END IF : IF d=0 AND g<0: a=r1*-1
670 IF d>0 : a=ATAN(g/d): END IF : IF d<0 AND g>=0: a=ATAN(g/d)+r2
680 IF d=0 AND g>=0: a=r1: END IF : RETurn a: END DEFine

Nice one, Steve

Thank you Derek, Tobias etc. for your testing. I'm happy you all liked my little "greetings software". That morning I had to stay home with a cold and headache, so I decided to write the program.
@ Per: we're almost a team: I create the plain code, then you optimize it for faster platforms

Cristian wrote:@ Per: we're almost a team: I create the plain code, then you optimize it for faster platforms

Inventing stuff is the clever bit. The rest is just programming