Programming by Example

 

A BB4W Compendium

freeman69@gmx.com

IDIC BBC_Owl2 M&P

Archery

Knock the apples from the tree using your bow and arrows.

 

         Z= Increase force

         X= Decrease force

         K= Angle up

         M= Angle down

         L= Fire/Loose

 

    Game includes:

 

         Animated stick figure archer

         Arrow

         Multiple apples

         Fractal based tree design

 

  10 MODE 9:OFF

  20 *REFRESH OFF

  30 DIM shapes(25,1),td(2,1)

  40 MAXSTIX=200

  50 DIM sticks(MAXSTIX,4),buds(MAXSTIX,1)

  60 DIM apples{(11) status,x,y,yvel,size}

  70

  80 PROCreaddata

  90 px=150:py=160:pangle=-45:pull=0:REM Bow variables

 100 ax=0:ay=0:axvel=0:ayvel=0:inflight=FALSE:REM Arrow variables

 110 hx=0:hy=0:power=0:REM Hand position and force

 120 scale=8:hiscore=0:REM Archer scale and Hi-score

 130

 140 REPEAT

 150   gameover=FALSE:score=0:level=0

 160   REPEAT

 170     stickptr=-1:budptr=-1:PROCmaketree(800,0,800,0,0,0)

 180     tapples=((level MOD 4)+1)*2

 190     arrows=(3-((level DIV 8)MOD 2))*4-level DIV 16

 200     falling=FALSE

 210     appleptr=-1:PROCplantfruit(tapples)

 220     REPEAT

 230       TIME=0

 240       CLS

 250       PRINTTAB(0,2);"Arrows: ";arrows

 260       PRINTTAB(0,4);"Angle: ";pangle

 270       PRINTTAB(0,5);"Force: ";INT(power*10)

 280       PRINTTAB(0,0);"Level: ";level+1

 290       PRINTTAB(12,0);"Score: ";score

 300       PRINTTAB(25,0);"Hi-score: ";hiscore

 310      

 320       PROCdrawtree

 330       shapes(1,0)=6-pull:REM adjust bow string

 340       PROCdrawarcher

 350      

 360       IF inflight PROCarrowflight

 370      

 380       IF NOT inflight THEN

 390         IF arrows=0 AND NOT falling gameover=TRUE

 400         PROCcalcarrowstart:power=pull

 410         IF arrows>0 PROCdrawobject(1,ax,ay,scale,pangle,7)

 420       ENDIF

 430      

 440       PROCdraworchard

 450      

 460       IF INKEY(-98) AND NOT inflight AND pull<6 pull+=0.1

 470       IF INKEY(-67) AND NOT inflight AND pull>0 pull-=0.1

 480       IF INKEY(-102) AND pangle>-75 pangle-=3

 490       IF INKEY(-71) AND pangle<75 pangle+=3

 500       IF INKEY(-87) AND arrows>0 AND NOT inflight PROCloose

 510      

 520       *REFRESH

 530       WHILE TIME<4:ENDWHILE

 540       *FX21

 550     UNTIL gameover OR tapples=0

 560     IF tapples=0 level+=1:inflight=FALSE

 570   UNTIL gameover

 580   IF score>hiscore hiscore=score

 590   PRINTTAB(16,12);"GAME OVER"

 600   PRINTTAB(11,14);"Press SPACE to play"

 610   *REFRESH

 620   REPEATUNTILGET=32

 630 UNTIL FALSE

 640 END

 650

 660 DEF PROCreaddata

 670 FOR a=0 TO 24:READ shapes(a,0),shapes(a,1):NEXT

 680 FOR a=0 TO 2:READ td(a,0),td(a,1):NEXT

 690 ENDPROC

 700 REM Bow

 710 DATA 6,7,0,0,6,-7,8,-5,9,-2,9,2,8,5,6,7

 720 REM Arrow

 730 DATA -3,0,-4,1,-6,1,-5,0,-6,-1,-4,-1

 740 DATA -3,0,4,0,4,-1,6,0,4,1,4,0

 750 REM Body and legs

 760 DATA 0,0,0,-11,4,-20,0,-11,-4,-20

 770 REM Pointers & counts

 780 DATA 0,8,8,12,20,5

 790

 800 DEF PROCdrawobject(type,x,y,scale,angle,col)

 810 LOCAL first,a,cx,cy

 820 first=TRUE:GCOL 0,col

 830 FOR a=td(type,0) TO td(type,0)+td(type,1)-1

 840   cx=FNrotx(shapes(a,0),shapes(a,1),angle)

 850   cy=FNroty(shapes(a,0),shapes(a,1),angle)

 860   IF first THEN

 870     MOVE x+cx*scale,y+cy*scale:first=FALSE

 880   ELSE

 890     DRAW x+cx*scale,y+cy*scale

 900   ENDIF

 910 NEXT

 920 ENDPROC

 930

 940 DEF FNrotx(x,y,angle)

 950 =COS(RAD(angle))*x-SIN(RAD(angle))*y

 960

 970 DEF FNroty(x,y,angle)

 980 =SIN(RAD(angle))*x+COS(RAD(angle))*y

 990

1000 DEF PROCcalcarrowstart

1010 ax=px+COS(RAD(pangle))*scale*(11-pull)

1020 ay=py+SIN(RAD(pangle))*scale*(11-pull)

1030 ENDPROC

1040

1050 DEF PROCloose

1060 axvel=COS(RAD(pangle))*(pull+1)*4

1070 ayvel=SIN(RAD(pangle))*(pull+1)*4

1080 inflight=TRUE:pull=0:arrows-=1

1090 ENDPROC

1100

1110 DEF PROCarrowflight

1120 LOCAL angle

1130 ax+=axvel:ayvel-=0.3:ay+=ayvel

1140 angle=DEG(ASN(ayvel/SQR(axvel^2+ayvel^2)))

1150 PROCdrawobject(1,ax,ay,scale,angle,7)

1160 IF ax>1280 OR ay<0 OR ay>1024 inflight=FALSE

1170 PROCkebab(angle)

1180 ENDPROC

1190

1200 DEF PROCdrawarcher

1210 LOCAL x,y,f,elbowx

1220 x=px+COS(RAD(pangle))*9*scale

1230 y=py+SIN(RAD(pangle))*9*scale

1240 GCOL 0,2:LINE px,py-4*scale,x,y:REM Bow arm

1250 PROCdrawobject(2,px,py,scale,0,2):REM Body

1260 GCOL0,5:CIRCLEFILL px,py,scale*3:REM Head

1270 IF inflight THEN

1280   x=hx:y=hy

1290 ELSE

1300   x=COS(RAD(pangle))*scale*(6-pull)

1310   y=SIN(RAD(pangle))*scale*(6-pull)

1320   hx=x:hy=y

1330 ENDIF

1340 f=6*scale:REM Length of string forearm

1350 elbowx=x-SQR(f^2-y^2)

1360 GCOL 0,2:LINE px+x,py+y,px+elbowx,py-4*scale

1370 DRAW px,py-4*scale:REM String arm

1380 PROCdrawobject(0,px,py,scale,pangle,1):REM Bow

1390 ENDPROC

1400

1410 DEF PROCdrawapple(x,y,size)

1420 LOCAL f

1430 f=size*0.75

1440 GCOL0,3:LINE x,y,x,y+size

1450 GCOL 0,2

1460 CIRCLEFILL x-(size-f),y,f

1470 CIRCLEFILL x+(size-f),y,f

1480 GCOL0,3:CIRCLEFILL x+(size-f*0.75),y-f*0.25,f*0.4

1490 ENDPROC

1500

1510 DEF PROCplantfruit(n)

1520 LOCAL a,size,okay,r,b,xd,yd

1530 FOR a=1 TO n

1540   IF RND(2)=1 OR level<4 size=32 ELSE size=28

1550   REPEAT

1560     okay=TRUE

1570     r=RND(budptr)

1580     IF buds(r,1)-size*2>0 AND buds(r,0)+size<1280 THEN

1590       b=0

1600       WHILE b<=appleptr AND okay

1610         xd=apples{(b)}.x-buds(r,0)

1620         yd=apples{(b)}.y-(buds(r,1)-size)

1630         IF SQR(xd^2+yd^2)<apples{(b)}.size+size okay=FALSE

1640         b+=1

1650       ENDWHILE

1660     ELSE

1670       okay=FALSE

1680     ENDIF

1690   UNTIL okay

1700   appleptr+=1

1710   apples{(appleptr)}.status=1

1720   apples{(appleptr)}.x=buds(r,0)

1730   apples{(appleptr)}.y=buds(r,1)-size

1740   apples{(appleptr)}.yvel=0

1750   apples{(appleptr)}.size=size

1760 NEXT

1770 ENDPROC

1780

1790 DEF PROCdraworchard

1800 LOCAL a

1810 falling=FALSE

1820 FOR a=0 TO appleptr

1830   IF apples{(a)}.status=2 THEN

1840     falling=TRUE

1850     apples{(a)}.yvel-=0.5

1860     apples{(a)}.y+=apples{(a)}.yvel

1870     IF apples{(a)}.y<0 apples{(a)}.status=0:tapples-=1

1880   ENDIF

1890   IF apples{(a)}.status>0 THEN

1900     PROCdrawapple(apples{(a)}.x,apples{(a)}.y,apples{(a)}.size)

1910   ENDIF

1920 NEXT

1930 ENDPROC

1940

1950 DEF PROCkebab(angle)

1960 LOCAL x,y,xd,yd

1970 x=ax+COS(RAD(angle))*scale*6

1980 y=ay+SIN(RAD(angle))*scale*6

1990 FOR a=0 TO appleptr

2000   IF apples{(a)}.status=1 THEN

2010     xd=x-apples{(a)}.x

2020     yd=y-apples{(a)}.y

2030     IF SQR(xd^2+yd^2)<=apples{(a)}.size THEN

2040       apples{(a)}.status=2

2050       IF apples{(a)}.size>30 score+=10 ELSE score+=15

2060     ENDIF

2070   ENDIF

2080 NEXT

2090 ENDPROC

2100

2110 DEF PROCdrawtree

2120 LOCAL a,c

2130 a=0:GCOL 0,8

2140 WHILE a<=stickptr

2150   c=sticks(a,4)+1

2160   COLOUR 8,c*32,c*16,0

2170   VDU 23,23,6-sticks(a,4);0;0;0;

2180   LINE sticks(a,0),sticks(a,1),sticks(a,2),sticks(a,3)

2190   a+=1

2200 ENDWHILE

2210 ENDPROC

2220

2230 DEF PROCmaketree(x1,y1,x2,y2,entryangle,level)

2240 LOCAL branches,freeangle,longb,startangle,a,b,L,x3,y3,c,d

2250 CASE level OF

2260   WHEN 0 : branches=1:freeangle=5:longb=320

2270   WHEN 1 : branches=4:freeangle=30:longb=180

2280   OTHERWISE : branches=3:freeangle=35:longb=240/level

2290 ENDCASE

2300 startangle=branches/-2*freeangle

2310 FOR b=0 TO branches-1

2320   a=RND(freeangle)+startangle+freeangle*b+entryangle

2330   L=RND(INT(longb*0.2))+longb

2340   IF RND(5)=1 THEN

2350     c=x1+(x2-x1)/2

2360     d=y1+(y2-y1)/2

2370   ELSE

2380     c=x2:d=y2

2390   ENDIF

2400   x3=c+SIN(RAD(a))*L

2410   y3=d+COS(RAD(a))*L

2420   IF stickptr<MAXSTIX THEN

2430     stickptr+=1

2440     sticks(stickptr,0)=c

2450     sticks(stickptr,1)=d

2460     sticks(stickptr,2)=x3

2470     sticks(stickptr,3)=y3

2480     sticks(stickptr,4)=level

2490     IF level<4 THEN

2500       PROCmaketree(c,d,x3,y3,a,level+1)

2510     ELSE

2520       budptr+=1

2530       buds(budptr,0)=x3

2540       buds(budptr,1)=y3

2550     ENDIF

2560   ENDIF

2570 NEXT

2580 ENDPROC

Archery

Archery: Code explained...

 

  30 DIM shapes(25,1),td(2,1)

  40 MAXSTIX=200

  50 DIM sticks(MAXSTIX,4),buds(MAXSTIX,1)

  60 DIM apples{(11) status,x,y,yvel,size}

 

'shapes' and 'td' hold outline shape co-ordinates and co-ordinate pointers.

'sticks' holds a list of two pairs of co-ordinates (x,y & x,y) for drawing lines that are branches of a tree.

'buds' holds the final co-ordinates of the end of the smallest twigs; potential locations for randomly placed apples.

Each apple has a position, size and velocity.

 

  90 px=150:py=160:pangle=-45:pull=0:REM Bow variables

 

'px' & 'py' are the centre of rotation for the bow ('pangle'). The graphics for the archer are defined relative to this point. The bow string is stretched using the value held in 'pull'.

 

 100 ax=0:ay=0:axvel=0:ayvel=0:inflight=FALSE:REM Arrow variables

 

Only one arrow can be in flight at a time. The arrow has a velocity vector of 'axvel', 'ayvel'. These two values define a direction of movement. The magnitude of this movement can be calculated using Pythagoras:

 

magnitude = sqr(axvel^2+ayvel^2)

 

 110 hx=0:hy=0:power=0:REM Hand position and force

 

'hx' & 'hy' store the position of the archer's right hand when the arrow is fired.

 

 170     stickptr=-1:budptr=-1:PROCmaketree(800,0,800,0,0,0)

 180     tapples=((level MOD 4)+1)*2

 190     arrows=(3-((level DIV 8)MOD 2))*4-level DIV 16

 200     falling=FALSE

 210     appleptr=-1:PROCplantfruit(tapples)

 

A randomly generated tree (without leaves) is created for each new level.

The number of apples on a tree cycle from 2 to 8 in steps of 2.

The number of arrows cycle between 12 and 8 every 8 levels, but one arrow is lost every 16 levels.

'falling' is used to prevent the game from ending prematurely in instances when the last available arrow has knocked the last apple from the tree, but the apple has yet to hit the ground.

Apples hang from the end of randomly selected twigs.

 

 330       shapes(1,0)=6-pull:REM adjust bow string

 

Line 330 adjusts the template of the bow held in the 'shapes' array. It simply repositions the centre of the bowstring depending on the force applied by the archer. Whenever the bow is drawn, the string will automatically be drawn in the updated position.

 

 800 DEF PROCdrawobject(type,x,y,scale,angle,col)

 

This routine is virtually identical to the routine used in Asteroid Belt. It is used to draw the bow, an arrow and the stick body of the archer (head and arms are drawn separately).

 

1000 DEF PROCcalcarrowstart

1010 ax=px+COS(RAD(pangle))*scale*(11-pull)

1020 ay=py+SIN(RAD(pangle))*scale*(11-pull)

1030 ENDPROC

 

Before being fired, the arrow sits on the bow and is drawn back with the string of the bow. This routine calculates the correct position and angle to draw the arrow, given the position and angle of the bow.

 

1050 DEF PROCloose

1060 axvel=COS(RAD(pangle))*(pull+1)*4

1070 ayvel=SIN(RAD(pangle))*(pull+1)*4

1080 inflight=TRUE:pull=0:arrows-=1

1090 ENDPROC

 

This routine calculates the initial velocity vector of the arrow, based on the angle of the bow and the amount the string has been drawn back.

 

1110 DEF PROCarrowflight

1120 LOCAL angle

1130 ax+=axvel:ayvel-=0.3:ay+=ayvel

1140 angle=DEG(ASN(ayvel/SQR(axvel^2+ayvel^2)))

1150 PROCdrawobject(1,ax,ay,scale,angle,7)

1160 IF ax>1280 OR ay<0 OR ay>1024 inflight=FALSE

1170 PROCkebab(angle)

1180 ENDPROC

 

The position of the arrow is updated by adding its velocity. The angle of the arrow while in flight is calculated using Pythagoras and the inverse of the SIN function (ASN) i.e. the arrow points in the direction of flight.

This routines also checks for the arrow going beyond the limits of the window, and calls the routine that checks for collisions with apples.

 

1200 DEF PROCdrawarcher

 

The position of the archer's arms depend on the position of the bow and the bow string. As with the design of each graphic, the movement was designed 'on paper' first.

 

1410 DEF PROCdrawapple(x,y,size)

 

Apples are drawn as a combination of 3 overlapping circles and a line for the stalk.

 

1510 DEF PROCplantfruit(n)

 

When the tree has been created, the co-ordinates of the end of the smallest twigs are held in the 'buds' array. This routine randomly selects a bud to hang an apple from, but checks that the apple fits within the limits of the window and does not overlap an apple already placed upon the tree.

 

1790 DEF PROCdraworchard

 

Apples start life by hanging from a twig, but may be knocked loose by an arrow. Falling apples accelerate towards the ground and disappear on impact.

 

1950 DEF PROCkebab(angle)

 

Any arrow in flight is tested for possible collision with all apples still hanging from the tree. The collision test looks for the point of the arrow falling within the radius of the apple graphic. Large apples score 10, small apples score 15.

 

2110 DEF PROCdrawtree

 

Every branch stored in 'sticks' is drawn every animation frame. The colour shade and thickness of the branch depends on the level of its creation (see PROCmaketree).

 

2230 DEF PROCmaketree(x1,y1,x2,y2,entryangle,level)

2240 LOCAL branches,freeangle,longb,startangle,a,b,L,x3,y3,c,d

2250 CASE level OF

2260   WHEN 0 : branches=1:freeangle=5:longb=320

2270   WHEN 1 : branches=4:freeangle=30:longb=180

2280   OTHERWISE : branches=3:freeangle=35:longb=240/level

2290 ENDCASE

2300 startangle=branches/-2*freeangle

2310 FOR b=0 TO branches-1

2320   a=RND(freeangle)+startangle+freeangle*b+entryangle

2330   L=RND(INT(longb*0.2))+longb

2340   IF RND(5)=1 THEN

2350     c=x1+(x2-x1)/2

2360     d=y1+(y2-y1)/2

2370   ELSE

2380     c=x2:d=y2

2390   ENDIF

2400   x3=c+SIN(RAD(a))*L

2410   y3=d+COS(RAD(a))*L

2420   IF stickptr<MAXSTIX THEN

2430     stickptr+=1

2440     sticks(stickptr,0)=c

2450     sticks(stickptr,1)=d

2460     sticks(stickptr,2)=x3

2470     sticks(stickptr,3)=y3

2480     sticks(stickptr,4)=level

2490     IF level<4 THEN

2500       PROCmaketree(c,d,x3,y3,a,level+1)

2510     ELSE

2520       budptr+=1

2530       buds(budptr,0)=x3

2540       buds(budptr,1)=y3

2550     ENDIF

2560   ENDIF

2570 NEXT

2580 ENDPROC

 

Random tree design is based on the fractal pattern of large branches splitting into smaller branches. To automate the creation of this pattern, we make use of a procedure that calls itself (recursively).

 

The general idea is that any branch (including the trunk) will split and divide into smaller branches. There are limits to angle of the split, as well as the number of branches forking from a split.

 

Our recursive algorithm makes use of local variables to store vital details about the pattern. A procedure that calls itself, clones itself (sort of), but each clone will have its own unique set of local variables. Each 'clone' knows where it is in the pattern and where to go when it has finished its part of the process.

 

Obviously, the pattern begins with the base of the trunk (level zero). The trunk begins as a single branch; it has a random height and angle to the ground (both within limits). Once defined, the routine calls itself, passing forward details of the branch just created.

The 'cloned' routine finds itself at level 1. The end of the trunk can split 4 ways. Each new branch is defined within a loop, and each loop calls PROCmaketree again, passing forward the details of the branch just created...

 

The procedure places a limit on the total number of levels, which forces the process to stop and forces the procedure to end. On ending, the variables of the previous level are restored and the process continues forward again, until all the branches for a level have been defined (which also forces the procedure to end).

The pattern resulting from a routine calling itself multiple times per level, is inherently tree-shaped. Recursive routines are often used for searching tree structures such as folders within folders.

 

The random angles and branch lengths imitate the natural appearance of a tree. This routine goes one step further by allowing a few of the branches to split from halfway up the parent branch (instead of at the end).

 

At the highest level (4), the routine stores the last co-ordinate of the end of each twig, placing the details in the 'buds' array. This is used for the placement of apples.

 

When drawing the tree, the level determines the thickness of the line and the colour of the bark.

Arrow black large Arrow black large