'===========================================================================
' Subject: PB SMOOTH ROTATION V2             Date: 05-02-97 (00:00)       
' Author:  Angelo Ken Pesce                  Code: PB                     
' Origin:  ken@uniserv.uniplan.it          Packet: GRAPHICS.ABC
'===========================================================================
' APSOFTWARE 1997
' POWERBASIC ROTATE+SMOOTH EFFECT TEST v2

' ------------------------------------------------------------
' This is only a test version
' to do list:

' I have to use shift left instead of constant mult (*320)
' I have to make a better trail effect
' ------------------------------------------------------------

$OPTIMIZE SPEED
$CPU 80386
$FLOAT NPX
$LIB ALL OFF
$ERROR ALL OFF


' ------------------------------------------------------------
' Some math constants
pi = 3.1415

' Multiplication factor
mult = 20

' Number of points in data
pts = (106+7)

' Trail lenght ( trf=(63-lenght) )
trf = 4

' Look up tables
DIM r(pts)
DIM alpha(pts)

' Points x,y arrays
DIM xp(pts)
DIM yp(pts)

' TEST DATA (X,Y)

' line 1
DATA -4,1,-3,1,-2,1,5,1,6,1
' line 2
DATA -3,2,-2,2,4,2,5,2,6,2,7,2
' line 3
DATA -3,3,-2,3,3,3,4,3,7,3,8,3
' line 4
DATA -3,4,-2,4,3,4,4,4,7,4,8,4
' line 5
DATA -3,5,-2,5,2,5,3,5,9,5,10,5
' line 6
DATA -7,6,-6,6,-5,6,-4,6,-3,6,-2,6,2,6,3,6,4,6,5,6,6,6,7,6,8,6,9,6,10,6
' line 7
DATA -8,7,-7,7,-6,7,-5,7,-4,7,-3,7,-2,7,2,7,3,7,4,7,5,7,6,7,7,7,8,7,9,7,10,7
' line 8
DATA -8,8,-7,8,-3,8,-2,8,2,8,3,8,9,8,10,8
' line 9
DATA -8,9,-7,9,-3,9,-2,9,2,9,3,9,9,9,10,9
' line 10
DATA -8,10,-7,10,-3,10,-2,10,2,10,3,10,9,10,10,10
' line 11
DATA -8,11,-7,11,-6,11,-5,11,-4,11,-3,11,-2,11,2,11,3,11,9,11,10,11
' line 12 (at last...)
DATA -8,12,-7,12,-6,12,-5,12,-4,12,-3,12,-2,12,2,12,3,12,9,12,10,12
' latest additions
data 4,5,4,6,4,8,4,9,4,10,4,11,4,12
' ------------------------------------------------------------



' ------------------------------------------------------------

FOR i = 1 TO pts
READ b, a
xp(i) = a * mult
yp(i) = b * mult
NEXT

FOR i = 1 TO pts
r(i) = SQR((xp(i) ^ 2) + (yp(i) ^ 2))
NEXT

FOR i = 1 TO pts
alpha(i) = ATN(yp(i) / xp(i))
NEXT
' ------------------------------------------------------------


GOTO maincode


' ------------------------------------------------------------
' Subroutine: RotatePoints(D,COL)
rotp:
FOR k = 1 TO pts
angle = alpha(k) + d
radius = r(k)
x = INT(radius * SIN(angle))
y = INT(radius * COS(angle))
IF x < 0 OR y < 0 THEN GOTO skipd

' SLOW MULT     --- TO BE REPLACED using shift left...---
yy = (y * 320) + x
yy1 = ((y - 1) * 320) + x
yy2 = ((y + 1) * 320) + x
POKE (yy), 63

POKE (yy1), 50
POKE (yy2), 50
POKE (yy + 1), 50
POKE (yy - 1), 50
POKE (yy1 - 1), 30
POKE (yy1 + 1), 30
POKE (yy2 - 1), 30
POKE (yy2 + 1), 30

skipd:
NEXT
RETURN

' Subroutine: Waitkpress
wkp:
DO: LOOP UNTIL INKEY$ <> ""
RETURN

' Subroutine: Smooth
flm:
FOR y = 0 TO 199

ym=y*320

FOR x = 0 TO 319
ymm = ym + x
cl = PEEK(ymm)
IF cl > trf THEN cl = cl - trf ELSE cl = 0
POKE (ymm), cl
NEXT
NEXT
RETURN
' ------------------------------------------------------------


maincode:

' Screen mode 13 needed
! mov ax,&h13
! int &h10

' Set up 64 color palette (form 0 to 63, grey background)
OUT &H3C8, 0
OUT &H3C9, 40
OUT &H3C9, 40
OUT &H3C9, 40
FOR i = 1 TO 63
c=40-i
if abs(c)<>c then c=0
OUT &H3C9, c
OUT &H3C9, c
OUT &H3C9, abs(i-32)*2
NEXT

DEF SEG = &HA000

DO
FOR d = 0 TO pi STEP .01
GOSUB rotp
GOSUB flm
if inkey$<>"" then goto fade
NEXT
FOR d = pi TO 0 STEP -.01
GOSUB rotp
GOSUB flm
if inkey$<>"" then goto fade
NEXT
LOOP

fade:
trf=2
for i=0 to 3000000
x=rnd*320
y=rnd*200
yy=y*320+x
cc=peek(yy)+1
if cc>63 then cc=0
poke(yy),cc
next
for i=0 to 32
gosub flm
next
END