'===========================================================================
' Subject: PERSPECTIVE SCROLLER (WAVEY)      Date: 06-05-97 (16:45)       
' Author:  The ABC Programmer                Code: QB, QBasic, PDS        
' Origin:  voxel@freenet.edmonton.ab.ca    Packet: GRAPHICS.ABC
'===========================================================================
'-----------------------------------------------------------------------------
'Hmmm, this is a small, but neat routine. Really something to post. I hope you
'like it. Made by Jeroen Bouwens, Holland. This routine is PD, Freeware and
'Smileware, which means bla..blabla...blablabla. Got it? See ya! :-)
'O Yeah, I nearly forgot. It is a perspective scroller that comes right at you.
'
' Converted from Pascal Code to BASIC by William Yu (06-05-97). PUBLIC DOMAIN
' Some notes: The scroller is wider in this BASIC version (don't know why).
'             It's much slower, but that's no surprise.
'             When compiled, the colours are mixed up!
'             Something to do with the &HFA6E, and make sure the Tekst is
'             defined (ie, don't use Tekst$).  Patches welcome!
'-----------------------------------------------------------------------------

DECLARE SUB Rotate (X AS SINGLE, Y AS SINGLE, Z AS SINGLE, Alpha%, Beta%, Gamma%)
DECLARE SUB PrecalcPoints ()
DEFINT A-Z

'DIM I, J, XS, YS, TL, XT, YT, ZY AS INTEGER
'DIM Alpha, Beta, Gamma, G, Tel AS INTEGER
DIM XX, YY, ZZ, BX, BY AS INTEGER
DIM TOf, TSeg, SL, ArrayTel, LOff AS INTEGER
DIM SHARED VX AS SINGLE
DIM SHARED VY AS SINGLE
DIM SHARED VZ AS SINGLE
DIM SHARED XT1 AS SINGLE
DIM SHARED YT1 AS SINGLE
DIM SHARED ZT1 AS SINGLE
DIM SHARED Offsets(0 TO 160 * 50) AS LONG
DIM SHARED Colours(0 TO 160 * 50) AS INTEGER
DIM SHARED Cosinus(0 TO 360) AS INTEGER
DIM SHARED Sinus(0 TO 360) AS INTEGER
DIM Tekst AS STRING * 255

CONST False = 0
CONST True = NOT False

  SCREEN 13
  CALL PrecalcPoints
  Tekst = "                   Well, this is an interesting routine (and it seems to work too :-)"
  Length = LEN(RTRIM$(Tekst))
  TOf = VARPTR(Tekst): TSeg = VARSEG(Tekst)
  Tel = 0
  DO
    FOR TL = 0 TO 7
      ArrayTel = 8 * 49 + 1
      FOR I = 1 TO 19
        DEF SEG = TSeg
        SL = PEEK(TOf + I + Tel)
        LOff = &HFA6E + SL * 8
        FOR XS = 0 TO 7
          FOR YS = 1 TO 8
            DEF SEG = &HF000
            IF (PEEK(LOff) AND (128 \ (2 ^ XS))) <> 0 THEN
              DEF SEG = &HA000
              POKE Offsets(ArrayTel - TL * 49), Colours(ArrayTel - TL * 49)
              POKE Offsets(ArrayTel + 1 - TL * 49), Colours(ArrayTel - TL * 49)
              POKE Offsets(ArrayTel + 2 - TL * 49), Colours(ArrayTel - TL * 49)
              POKE Offsets(ArrayTel + 3 - TL * 49), Colours(ArrayTel - TL * 49)
              POKE Offsets(ArrayTel + 4 - TL * 49), Colours(ArrayTel - TL * 49)
              POKE Offsets(ArrayTel + 5 - TL * 49), Colours(ArrayTel - TL * 49)
            ELSE
              DEF SEG = &HA000
              POKE Offsets(ArrayTel - TL * 49), 0
              POKE Offsets(ArrayTel + 1 - TL * 49), 0
              POKE Offsets(ArrayTel + 2 - TL * 49), 0
              POKE Offsets(ArrayTel + 3 - TL * 49), 0
              POKE Offsets(ArrayTel + 4 - TL * 49), 0
              POKE Offsets(ArrayTel + 5 - TL * 49), 0
            END IF
            LOff = LOff + 1
            ArrayTel = ArrayTel + 6
          NEXT YS
          LOff = LOff - 8
          POKE Offsets(ArrayTel - TL * 49), 0
          ArrayTel = ArrayTel + 1
        NEXT XS
      NEXT I
    NEXT TL
    Tel = Tel + 1
    IF Tel >= Length THEN Tel = 0
  LOOP UNTIL INKEY$ <> ""
END

SUB PrecalcPoints
  FOR I = 0 TO 360
    Cosinus(I) = COS(I / 57.29578)
    Sinus(I) = SIN(I / 57.29578)
  NEXT I
  G = 250 'Find some well working value for this (250 is fine for VZ=300)
  Alpha = 320: Beta = 310: Gamma = 330 'Change these for an other orientation of
                                       'the scroll
  VX = 0: VY = 0: VZ = 300     'Don't make VZ 0 -> division by zero!!
  XX = -160: YY = -25: ZZ = 0
  DEF SEG = &HA000
  FOR I = 1 TO 160 * 50
    XT1 = XX: YT1 = YY: ZT1 = COS(XX / 10) * 2 + SIN(YY / 5) * 2 'Play with these!
    Colours(I) = INT(ZT1 * 3 + 44)
    CALL Rotate(XT1, YT1, ZT1, Alpha, Beta, Gamma)
    BX = 160 + INT((XT1 * G) / (ZT1 + VZ))
    BY = 100 + INT((YT1 * G * .8333) / (ZT1 + VZ))
    Offsets(I) = 320& * BY + BX                'Must use long unfortunately
    IF Offsets(I) > 65535 THEN Offsets(I) = 0  'Pascal doesn't need this
    POKE Offsets(I), 15
    YY = YY + 1
    IF YY >= 24 THEN
      YY = -25
      XX = XX + 2  'Also change size of arrays:Offsets,Colors if you change this
      IF XX >= 159 THEN XX = -160: YY = -25
    END IF
  NEXT I
  'LINE (0, 0)-(319, 199), 0, BF
END SUB

SUB Rotate (X AS SINGLE, Y AS SINGLE, Z AS SINGLE, Alpha, Beta, Gamma)
DIM X1 AS SINGLE
DIM X2 AS SINGLE
DIM Y1 AS SINGLE
DIM Y2 AS SINGLE
DIM Z1 AS SINGLE
DIM Z2 AS SINGLE
  X1 = X
  Y1 = Cosinus(Alpha) * Y - Sinus(Alpha) * Z
  Z1 = Sinus(Alpha) * Y + Cosinus(Alpha) * Z
  X2 = Cosinus(Beta) * X1 + Sinus(Beta) * Z1
  Y2 = Y1
  Z2 = Cosinus(Beta) * Z1 - Sinus(Beta) * X1
  X = Cosinus(Gamma) * X2 - Sinus(Gamma) * Y2
  Y = Sinus(Gamma) * X2 + Cosinus(Gamma) * Y2
  Z = Z2
END SUB