'===========================================================================
' Subject: PB CROSS-FADE ROUTINE             Date: 09-01-98 (15:11)       
' Author:  Dave Navarro, Jr.                 Code: PB                     
' Origin:  dave@powerbasic.com             Packet: GRAPHICS.ABC
'===========================================================================
'Converted to PowerBASIC by Dave Navarro, Jr. (dave@powerbasic.com)
'Original Pascal code by Bas van Gallen and David Proper.
'
'If you make any changes, I would appreciate it if you would email
'them to me.

$OPTIMIZE SPEED
$ERROR BOUNDS OFF       'this is a MUST! for version 3.00c or later

DEFINT A-Z
DIM creds$(0:12)

creds$( 0)="This cross-fade routine"
creds$( 1)="was converted to PowerBASIC by"
creds$( 2)="Dave Navarro, Jr."
creds$( 3)="Original Pascal code written by"
creds$( 4)="David Proper and..."
creds$( 5)="Bas van Gaalen."
creds$( 6)="This routine was"
creds$( 7)="enhanced a bit"
creds$( 8)="in comparison with"
creds$( 9)="the Pascal version by"
creds$(10)="using more assembler code..."
creds$(11)="May the Force Be With You..."

'set 320x200x256 mode
! push DS
! mov  AX, &H13
! int  &H10
! pop  DS

SetPal 1,0,0,0
SetPal 2,0,0,0
SetPal 3, 31, 63, 31
curcol = 1
txtidx = 0
DO
  ClearTxt curcol, 3-curcol
  WriteTxt curcol, 3-curcol, creds$(txtidx)
  FOR i = 0 TO 63
    SetPal curcol, i \ 2, i, i \ 2
    SetPal 3-curcol, (63-i) \ 2, 63-i, (63-i) \ 2
  NEXT i
  curcol = 1+(curcol MOD 2)
  txtidx = (1+txtidx) MOD 13
  SLEEP 1
LOOP UNTIL LEN(INKEY$)

'set text mode
! push DS
! mov  AX, &H3
! int  &H10
! pop  DS

END


SUB SetPal(BYVAL c AS BYTE,BYVAL r AS BYTE,BYVAL g AS BYTE,BYVAL b AS BYTE)

  ! push DS

  ! mov  DX, &H3DA
Vert1:
  ! in   AL,DX
  ! test AL,8
  ! jz   Vert1
Vert2:
  ! in   AL,DX
  ! test AL,8
  ! jnz  Vert2
  ! mov  DX,&H3C8
  ! mov  AX, c
  ! out  DX, AL
  ! inc  DX
  ! mov  AL, r
  ! out  DX, AL
  ! mov  AL, g
  ! out  DX, AL
  ! mov  AL, b
  ! out  DX, AL

  ! push DS

END SUB

SUB ClearTxt(BYVAL col AS BYTE, BYVAL newc AS BYTE)
  DEF SEG=&HA000
    FOR x=0 TO 319
      FOR y=100 TO 107
        vofs??=y * 320 + x
        IF PEEK(vofs??)=col THEN
          POKE vofs??,0
        ELSEIF PEEK(vofs??)<>0 THEN
          POKE vofs??,newc
        END IF
      NEXT y
    NEXT x
  DEF SEG
END SUB

SUB WriteTxt(BYVAL col AS BYTE, BYVAL cur AS BYTE, txt$)
  fseg??=&HF000
  fofs??=&HFA6E
  x = (300 - 8 * LEN(txt$)) \ 2
  y = 100
  FOR i = 1 TO LEN(txt$)
    ch = ASCII(MID$(Txt$, I, 1))
    IF ch = -1 THEN ch = 0
    FOR j = 0 TO 7
      FOR k = 0 TO 7
        DEF SEG=fseg??
        z = PEEK(fofs??+ch*8+j)
        SHIFT LEFT z, k
        IF (z AND 128) <> 0 THEN
          DEF SEG=&HA000
          vofs?? = (y+j)*320+(i*8)+x+k
          IF PEEK(vofs??) = cur THEN
            POKE vofs??, col+cur
          ELSE
            POKE vofs??, col
          END IF
        END IF
      NEXT k
    NEXT j
  NEXT i
  DEF SEG
END SUB