Happy New Year!

A place to discuss general QL issues.
stevepoole
Super Gold Card
Posts: 712
Joined: Mon Nov 24, 2014 2:03 pm

Re: Happy New Year!

Post by stevepoole »

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


    User avatar
    Andrew
    Aurora
    Posts: 786
    Joined: Tue Jul 17, 2018 9:10 pm

    Re: Happy New Year!

    Post by Andrew »

    Happy New Year !


    stevepoole
    Super Gold Card
    Posts: 712
    Joined: Mon Nov 24, 2014 2:03 pm

    Re: Happy New Year!

    Post by stevepoole »

    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


    User avatar
    pjw
    QL Wafer Drive
    Posts: 1286
    Joined: Fri Jul 11, 2014 8:44 am
    Location: Norway
    Contact:

    Re: Happy New Year!

    Post by pjw »

    Nice one, Steve 8-)


    Per
    dont be happy. worry
    - ?
    User avatar
    Cristian
    Aurora
    Posts: 960
    Joined: Mon Feb 16, 2015 1:40 pm
    Location: Veneto

    Re: Happy New Year!

    Post by Cristian »

    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 :-D


    User avatar
    pjw
    QL Wafer Drive
    Posts: 1286
    Joined: Fri Jul 11, 2014 8:44 am
    Location: Norway
    Contact:

    Re: Happy New Year!

    Post by pjw »

    Cristian wrote:@ Per: we're almost a team: I create the plain code, then you optimize it for faster platforms :-D
    Inventing stuff is the clever bit. The rest is just programming ;)


    Per
    dont be happy. worry
    - ?
    Post Reply