100 ::

110 REMark HOVER_bas. by S.Poole. v1jan08

120  REMark for QL Today. Beta-test by B.Coativy.

130 :

140 CLEAR: OPEN#1,con_16

150  WINDOW 512,256,0,0: PAPER 0: INK 7: CLS

160  AT 1,1: INPUT 'Difficulty? (easy:1 to hard:16) >'!i$

170  IF i$='': GO TO 160: ELSE Ntwr=i$

180  SELect Ntwr: =1 TO 16: =REMAINDER : GO TO 160

190  :

200 REMark Do not alter scale. It controls off-screen lines:

210  scy=5: SCALE scy,-scy/1.5,-scy/2: CLS: high=12

220 :

230 REMark P holds coordinates, T holds presents delivered:

240  DIM p(Ntwr+1,3),p_2(Ntwr+1,3),T(Ntwr+1,high)

250  x=1: y=2: z=3: p1=PI*.49: p2=PI*2: L=.5

260  left=192: right=200: up=208: down=216: fore=102: back=98

270  r90=RAD(90): r180=RAD(180): r270=RAD(270): r360=RAD(360)

280  ct=Ntwr: kt=0: Get_random_towers: Fix_reference_line: D1=DATE

290 :

300 REPeat play_loop

310     Set_perspective_referentials

320     Get_tower_coordinates

330     REMark Draw Aiming cross-wires:

340     OVER 0:INK 0,7,3:LINE 0,L TO 1,L, L,0 TO L,1: FILL 1: CIRCLE L,L,.35: FILL 0

350     get_key: IF ct=kt: won: ELSE : CLS

360 END REPeat play_loop

370 ::

390 DEFine PROCedure Get_random_towers

400  REMark Get Random towers on a 7 by 7 by 7 cubic volume:

410  FOR f=1 TO Ntwr

420      REMark Leave space around towers:

430      pfx=RND(-3 TO 3): SELect pfx: =-2,0,2: GO TO 430

440      pfy=RND(-3 TO 3): SELect pfy: =-2,0,2: GO TO 440

450      pfz=RND(1 TO high)

460      :

470      REMark Don't build two towers on same spot:

480      FOR j=1 TO Ntwr

490          IF p(j,x)=pfx: IF pfy=p(j,y): GO TO 430

500      END FOR j

510      REMark Tower origin coordinates:

520      p(f,x)=pfx: p(f,y)=pfy: p(f,z)=pfz: ct=ct+pfz

530  END FOR f: sortem

540 END DEFine

550 :

560 DEFine PROCedure sortem

570  np=1

580  FOR yy=3 TO -3 STEP -1

590      FOR xx=-3 TO 3

600          FOR tw=1 TO Ntwr

610              IF p(tw,x)=xx THEN

620                 IF p(tw,y)=yy THEN

630                    p_2(np,x)=xx: p_2(np,y)=yy: p_2(np,z)=p(tw,z): np=np+1

640                 END IF

650               END IF

660          END FOR tw

670      END FOR xx

680  END FOR yy

690 END DEFine

700 :

710 DEFine PROCedure Fix_reference_line

720  REMark Leave space around towers:

730  tx=RND(-3 TO 3): SELect tx: =-2,0,2: =REMAINDER : GO TO 730

740  ty=RND(-3 TO 3): SELect ty: =-2,0,2: =REMAINDER : GO TO 740

750  tz=RND(1 TO high): D1=DATE

760  Rx=tx: Ry=ty+2 : Rz=tz: REMark target-position.

770 END DEFine

780 :

790 DEFine PROCedure Get_tower_coordinates

800  FOR twr=1 TO Ntwr

810      REMark coordinates of front-lower-left position of building:

820      xQ=p_2(twr,x): Yq=p_2(twr,y): zQ=p_2(twr,z): INK twr,twr+3,3

830      IF tx=xQ: IF ty=Yq: IF tz<=zQ: lost

840      REMark Get each floor:

850      FOR box_=0 TO zQ

860          Get_box_coordinates

870          IF NOT Get_perspective_coordinates: GO TO 890

880          draw_box

890      END FOR box_

900  END FOR twr

910 END DEFine

920 :

930 DEFine PROCedure Set_perspective_referentials

940  REMark consider eye to target triangle

950  Fx=Rx-tx: fy=Ry-ty: fz=Rz-tz: fh=SQRT((Fx^2)+(fy^2))

960  REMark eye to target polar orientations:

970  c=ATAN_(fy,Fx): IF c>PI: c=c-p2: END IF : IF c<-PI: c=c+p2

980  b=ATAN_(fz,fh): IF b>PI: b=b-p2: END IF : IF b<-PI: b=b+p2

990 END DEFine

1000 :

1010 DEFine FuNction Get_perspective_coordinates

1020  IF VIEW_(XA,yA,zA): mA=m: nA=n: ELSE RETurn 0

1030  IF VIEW_(xB,yB,zB): mB=m: nB=n: ELSE RETurn 0

1040  IF VIEW_(xC,yC,zC): mC=m: nC=n: ELSE RETurn 0

1050  IF VIEW_(Xd,yD,zD): mD=m: nD=n: ELSE RETurn 0

1060  IF VIEW_(xE,yE,zE): mE=m: nE=n: ELSE RETurn 0

1070  IF VIEW_(xF,yF,zF): mF=m: nf=n: ELSE RETurn 0

1080  IF VIEW_(xG,yG,zG): mG=m: nG=n: ELSE RETurn 0

1090  IF VIEW_(xH,yH,zH): mH=m: nH=n: ELSE RETurn 0

1100 RETurn 1: END DEFine

1110 :

1120 DEFine PROCedure Get_box_coordinates

1130  XA=xQ  : yA=Yq  : zA=box_

1140  xB=XA+1: yB=yA  : zB=zA

1150  xC=XA  : yC=yA+1: zC=zA

1160  Xd=xB  : yD=yC  : zD=zA

1170  xE=XA  : yE=yA  : zE=zA+1

1180  xF=xB  : yF=yB  : zF=zE

1190  xG=xC  : yG=yC  : zG=zE

1200  xH=Xd  : yH=yD  : zH=zE

1210 END DEFine

1220 :

1230 DEFine PROCedure draw_box

1240  AmA=ABS(mA): AnA=ABS(nA)

1250  REMark Test if aligned with origin-corner:

1260  IF AmA<5E-2 THEN

1270     IF AnA<5E-2: IF p_2(twr,y)=ty+1: IF T(twr,box_)=0: kt=kt+1: T(twr,box_)=1

1280  END IF

1290  AT 1,1: INK 7: PRINT ct!kt,: INK twr,twr+4,3

1300  fl=T(twr,box_)

1310  FILL fl: LINE mA,nA TO mE,nE TO mG,nG TO mC,nC TO mA,nA: FILL 0

1320  FILL fl: LINE mC,nC TO mG,nG TO mH,nH TO mD,nD TO mC,nC: FILL 0

1330  FILL fl: LINE mB,nB TO mF,nf TO mH,nH TO mD,nD TO mB,nB: FILL 0

1340  FILL fl: LINE mA,nA TO mE,nE TO mF,nf TO mB,nB TO mA,nA: FILL 0

1350 END DEFine

1360 :

1370 DEFine PROCedure get_key

1380  BEEP 1234,5: i$=INKEY$(#1,-1)

1390  IF i$<>'': cd=CODE(i$): ELSE GO TO 1380

1400  SELect cd

1410     =left : tx=tx-1: IF tx<-3: tx=-3: END IF : Rx=tx

1420     =right: tx=tx+1: IF tx>+4: tx=+4: END IF : Rx=tx

1430     =down : tz=tz-1: IF tz<0 : tz=0 : END IF : Rz=tz

1440     =up   : tz=tz+1: IF tz>high : tz=high : END IF : Rz=tz

1450     =fore : ty=ty+1: IF ty>+4: ty=+4: END IF : Ry=ty+2

1460     =back : ty=ty-1: IF ty<-7: ty=-7: END IF : Ry=ty+2

1470    =REMAINDER : GO TO 1380

1480  END SELect

1490 END DEFine get_key

1500 :

1510 DEFine FuNction VIEW_(vx,vy,vz)

1520  REMark (Append underscore_ or else crash the name_table).

1530  REMark Consider (eye to target) & (eye to viewed-point) triangle:

1540   lx=vx-tx: ly=vy-ty: lz=vz-tz: lh=((lx^2)+(ly^2))^.5

1550  REMark Keep orientation angles in a simple positive circle:

1560   h=ATAN_(ly,lx)-c: IF h>PI: h=h-p2: END IF : IF h<(-PI): h=h+p2

1570   e=ATAN_(lz,lh)-b: IF e>PI: e=e-p2: END IF : IF e<(-PI): e=e+p2

1580  REMark See if angles mean that the point is off-screen:

1590   IF h>p1 OR h<(-p1): RETurn 0

1600   IF e>p1 OR e<(-p1): RETurn 0

1610  REMark Perspective screen coordinates:

1620   m=TAN(h): n=-1*TAN(e)*((m^2)+1)^.5: RETurn 1

1630 END DEFine VIEW_

1640 :

1650 DEFine FuNction ATAN_(oo,aa)

1660  REMark Gets ATAN right in all signed quarters:

1670  REMark Sign(opposite side) & Sign(adjacent side):

1680   so=(oo>0)-(oo<0): sa=(aa>0)-(aa<0)

1690   IF so=0 OR so=1: IF sa=0: RETurn 0

1700   IF so=0 : IF sa=1 : RETurn r90

1710   IF so=-1: IF sa=0 : RETurn r180

1720   IF so=0 : IF sa=-1: RETurn r270

1730   oa=ATAN(aa/oo): REMark hypoteneuse angle in RADs.

1740   IF so=1 : IF sa=1 : RETurn oa

1750   IF so=-1: IF sa=1 OR sa=-1: RETurn r180+oa

1760   IF so=1 : IF sa=-1: RETurn r360+oa

1770 END DEFine ATAN_

1780 :

1790 DEFine PROCedure won

1800  d2=DATE-D1: score=INT(100*(d2/ct))

1810  AT 3,1: INK 7: PRINT'Bravo...'!score: BEEP 12345,6

1820  AT 5,1: PRINT'Another? (y/n):': i$=INKEY$(#1,-1)

1830  IF i$='': GO TO 1820

1840  IF i$=='y': RUN: ELSE : STOP

1850 END DEFine

1860 :

1870 DEFine PROCedure lost

1880  AT 3,1: INK 7: PRINT'You Crashed...': BEEP 12345,67

1890  AT 5,1: PRINT'Another? (y/n):': i$=INKEY$(#1,-1)

1900  IF i$='': GO TO 1890

1910  IF i$=='y': RUN: ELSE : STOP

1920 END DEFine

1930 ::