'===========================================================================
' Subject: WAVING FLAG                       Date: 06-30-97 (18:51)       
' Author:  Angelo Ken Pesce                  Code: PB                     
' Origin:  us0082@uniserv.uniplan.it       Packet: GRAPHICS.ABC
'===========================================================================
' INIT -----------------------------------------------------------------*-*----
$OPTIMIZE SPEED
' 386 is REQUIRED...
$CPU 80386
$LIB ALL OFF
$ERROR ALL OFF
$FLOAT NPX
$DIM ARRAY
' ----------------------------------------------------------------------*-*----


' --------------------------------------------------------*-*--
' WAVETEST By Angelo KEN Pesce 1997 ken@uniserv.uniplan.it
' With FakeDoubleSmoothing
' --------------------------------------------------------*-*--


' --------------------------------------------------------*-*--
 DEFINT a-z

' INIT MODE 13h
! mov ax,&h13
! int &h10

' DIMENSION RADIANS VARS
DIM rr as DOUBLE

' WAVE LENGTH FACTOR1 *********
 %factor1 = 10
' FACTOR2
 addval = 38
' *****************************

' INIT SIN LOOKUP TABLE
dim sint(3600) as integer
for i=0 to 3600
sint(i)=%factor1*sin(rr)
incr rr,(3.14159*2)/3600
next

' INIT BUFFER
 DIM bf(32000) as INTEGER
 DIM segm as WORD
 segm = varseg(bf(0))

' INIT PALETTE
for i=0 to 63
setpal i,i,0,0
next
for i=0 to 63
setpal i+64,i,i,i
next
for i=0 to 63
setpal i+128,0,i,0
next
%coladd=63-(%factor1*2)

' --------------------------------------------------------*-*--


 DO

' DO WAVE ------------------------------------------------*-*--

' RESET G
 g = gg

FOR y = 20 to 180 step 2
' INIT X1 : RESET G1
 x1 = sint(g) : g1 = gg

FOR x = 35 to 277 step 2
' INCR G1
 IF g1 > 3600 THEN g1 = 0 ELSE incr g1, addval
' INIT Y1
 y1 = sint(g1)

' PUTPIXEL
 select case x
  case <116:col=(x1+y1)+%coladd:'RED
  case <197:col=(x1+y1)+(%coladd+64):'WHITE
  case else:col=(x1+y1)+(%coladd+128):'GREEN
 end select

x2= x + x1
y2= y + y1

 !Mov     es, segm
 !Mov     di, y2
' SHL DI,8
 !Dw      &hE7C1
 !Db      8
 !Mov     bx, y2
' SHL BX,6
 !Dw      &hE3C1
 !Db      6
 !Add     di, x2
 !Add     di, bx
 !Mov     dl, col
 !Mov     es:[di], dl
 !Sub     dl,10
 !Mov     dh,dl
 !Mov     es:[di-1],dl
 !Mov     es:[di+319],dx
 !Mov     es:[di-321],dx

NEXT

' INCR G
IF g > 3600 THEN g = 0 ELSE incr g, addval
NEXT

' --------------------------------------------------------*-*--

' DOUBLESMOOTH BUFFER (remove this routine to gain more speed)
! mov es,segm
! xor di,di
! mov cx,&hfa00-320
! xor bx,bx
jmp1:
! mov bl,byte ptr es:[di-1]
! mov dx,bx
! mov bl,byte ptr es:[di+1]
! add dx,bx
! mov bl,byte ptr es:[di+320]
! add dx,bx
! mov bl,byte ptr es:[di]
! mov ax,dx
! add ax,bx
' SHR AX,2
! dw &he8c1
! db 2
! jz jmp2
! dec al
jmp2:
! add ax,dx
' SHR AX,2
! dw &he8c1
! db 2
! jz jmp3
! dec al
jmp3:
! stosb
! dec cx
! jnz jmp1


' COPY BUFFER TO SCREEN
 !Push    ds
 !Push    si
 !Mov     ds, segm
 !Mov     si, 0
 !Mov     di, 0
 !Mov     ax, &ha000
 !Mov     es,ax
 !Mov     cx, &hfa00
 !Shr     cx, 1
 !Shr     cx, 1
' rep movsd
 !Db      &hF3
 !Db      &h66
 !Db      &hA5
 !Pop     si
 !Pop     ds

' CLEAR BUFFER (I HAVE TO WRITE A FILLMEM4 ROUTINE)
 !Mov     es, segm
 !Xor     di, di
 !Mov     cx, &hfa00
 !Shr     cx, 1
 !Xor     ax,ax
 !Rep     stosw
asmjmp10:
 !Test    cx, cx
 !Je      asmjmp9
 !Jmp     asmjmp10
asmjmp9:

' INCR GG
 IF gg > 3600 THEN gg = 0 ELSE incr gg, addval

' WAIT VRT (Vertical ReTrace, remove this routine for more speed)
asmjmp14:
 !Mov     dx, &h3DA
asmjmp12:
 !In      al, dx
 !Test    al, 8
 !Jnz     asmjmp12
asmjmp13:
 !In      al, dx
 !Test    al, 8
 !Jz      asmjmp13


LOOP UNTIL len(inkey$)


' SUBROUTINEZ *******************************

SUB setpal (BYVAL slot as INTEGER, BYVAL red as INTEGER,_
         BYVAL green as INTEGER, BYVAL blue as INTEGER)
' Sets palette color number slot
' Max red:63 Max blue:63 Max green:63 Max Slot:255

 out &h3C8, slot
 out &h3C9, red
 out &h3C9, green
 out &h3C9, blue
END SUB