home *** CD-ROM | disk | FTP | other *** search
AmigaBASIC Source Code | 1988-09-06 | 3.6 KB | 196 lines |
- REM --- Demo - Amiga BASIC Graphics demo --- 20-July-85
- REM --- Modified 08/87 C. Scheppner - added Close gadget/logic to final window
- DEFINT a-z
-
- wins = 0 'cs
-
- IF FRE(-1)<60000 THEN
- REM --- on 256k machine, this is more limited demo
- WINDOW 1,,,15
- GOSUB InitAnimation
- WHILE (WINDOW(7))
- SLEEP 'Object Collisions will wake us up
- WEND
- ELSE
- WINDOW 1,"Animation",(10,10)-(270,70),15
- WINDOW 2,"Lines",(310,10)-(580,70),30
- WINDOW 3,"Polygons",(10,95)-(270,170),30
- COLOR 1,3
- CLS
- WINDOW 4,"Circles",(310,95)-(580,170),30
- GOSUB InitAnimation
- iDraw = 30
- iErase = 0
-
- wins = 15 'cs 4 bits, 1 for each window
-
- WHILE (wins > 0)
-
- WINDOW OUTPUT 1
- IF WINDOW(7)=0 THEN wins = wins AND 14
-
- NextLine 2
- NextPoly 3
- NextCircle 4
-
- WEND
-
- END IF
-
- END 'cs
-
-
- SUB NextLine(win) STATIC
- SHARED iDraw, iErase
- WINDOW OUTPUT win
- 'See if user closed the window
- IF WINDOW(7)=0 THEN
- wins = wins AND 13 'cs
- EXIT SUB
- END IF
- DrawLine iDraw,1
- DrawLine iErase,0
- END SUB
-
- SUB DrawLine(iStep, fDraw) STATIC
- GetWindowDim winWidth, winHeight
- iStep = (iStep + 1) MOD 60
- hue = fDraw * ((iStep MOD 3) + 1)
- side = INT(iStep / 15)
- i!=(iStep MOD 15)/15
- i1!=1-i!
- ON side+1 GOSUB top,left,bottom,right
- EXIT SUB
- top:
- LINE(winWidth*i!,0)-(winWidth,winHeight*i!),hue
- RETURN
- left:
- LINE(winWidth,winHeight*i!)-(winWidth*i1!,winHeight),hue
- RETURN
- bottom:
- LINE(winWidth*i1!,winHeight)-(0,winHeight*i1!),hue
- RETURN
- right:
- LINE(0,winHeight*i1!)-(winWidth*i!,0),hue
- RETURN
- END SUB
-
- SUB NextPoly(win) STATIC
- WINDOW OUTPUT win
- 'See if user closed the window
- IF WINDOW(7)=0 THEN
- wins = wins AND 11 'cs
- EXIT SUB
- END IF
- GetWindowDim winWidth, winHeight
- i=(i MOD 8) + 1
- IF i=1 THEN CLS
- x = winWidth/2
- y = winHeight/2
- cosI! = (9-i)*0.1*COS(i)
- sinI! = (9-i)*0.1*SIN(i)
- XcosI = x*cosI!
- XsinI = x*sinI!
- YcosI = y*cosI!
- YsinI = y*sinI!
- AREA (x+XcosI,y+YsinI)
- AREA (x+XsinI,y-YcosI)
- AREA (x-XcosI,y-YsinI)
- AREA (x-XsinI,y+YcosI)
- COLOR RND*3
- AREAFILL
- END SUB
-
- SUB NextCircle(win) STATIC
- WINDOW OUTPUT win
- 'See if user closed the window
- IF WINDOW(7)=0 THEN
- winds = wins AND 7 'cs
- EXIT SUB
- END IF
- GetWindowDim winWidth, winHeight
- x = RND*winWidth
- y = RND*winHeight
- radius = RND*30+20
- hue = INT(RND*4)
- CIRCLE (x,y),radius,hue
- PAINT (x,y),hue
- END SUB
-
- SUB GetWindowDim(winWidth, winHeight) STATIC
- winWidth = WINDOW(2)
- winHeight = WINDOW(3)
- END SUB
-
- InitAnimation:
- WINDOW 1
- LOCATE 4,4
- COLOR 3,2
- PRINT "Amiga Microsoft BASIC"
- COLOR 1,0
- ON COLLISION GOSUB BounceOff
- COLLISION ON
- OPEN "ball" FOR INPUT AS 1
- OBJECT.SHAPE 1,INPUT$(LOF(1),1)
- CLOSE 1
- OBJECT.X 1,60
- OBJECT.Y 1,50
- OBJECT.VX 1,80
- OBJECT.VY 1,80
-
- OBJECT.SHAPE 2,1
- OBJECT.X 2,50
- OBJECT.Y 2,10
- OBJECT.VX 2,40
- OBJECT.VY 2,40
- OBJECT.ON
- OBJECT.START
- RETURN
-
- REM - BouncOff is called between BASIC
- REM - statements whenever an object
- REM - collides with another object or
- REM - the border.
- BounceOff:
- saveId = WINDOW(1)
- WINDOW OUTPUT 1
- 'See if user closed the window
- IF WINDOW(7)=0 THEN RETURN
- 'Make object border sensitive to change in wie
- CountDown = CountDown-1
- IF CountDown<0 THEN
- CountDown=10
- OBJECT.CLIP (0,0)-(WINDOW(2),WINDOW(3))
- END IF
- BounceLoop:
- i=COLLISION(0)
- IF i=0 THEN BounceExit
- j=COLLISION(i)
- vxi = OBJECT.VX(i)
- vyi = OBJECT.VY(i)
- IF (j=-1 AND vyi < 0) OR (j=-3 AND vyi > 0) THEN
- 'object bounced off top or bottom border
- OBJECT.VY i,-vyi
- ELSEIF (j=-2 AND vxi < 0) OR (j=-4 AND vxi > 0) THEN
- 'object bounced off left or right border
- OBJECT.VX i,-vxi
- ELSEIF j>0 THEN
- '2 objects bounced off each other
- vyj = OBJECT.VY(j)
- vxj = OBJECT.VX(j)
- IF vyi*vyj < 0 THEN
- OBJECT.VY i,-vyi
- OBJECT.VY j,-vyj
- END IF
- IF vxi*vxj < 0 THEN
- OBJECT.VX i,-vxi
- OBJECT.VX j,-vxj
- END IF
- OBJECT.START j
- END IF
- OBJECT.START i
- GOTO BounceLoop
- BounceExit:
- WINDOW OUTPUT saveId
- RETURN
-