'===========================================================================
' Subject: SINGLE PIXEL SCROLLING            Date: 04-10-97 (09:00)       
' Author:  Stephen L. Maxson                 Code: QB, QBasic, PDS        
' Origin:  comp.lang.basic.misc            Packet: GRAPHICS.ABC
'===========================================================================
'** SPSCROLL.BAS
'** QBasic source
'** April, 1997
'** Description:
'** Demo for single-pixel scrolling, using a graphic image that
'** is larger than the defined "viewport".  Note that the sprite
'** "jumps" when scrolling.  This is because the sprite is actually
'** scrolled along with the screen, and then erased and redrawn in
'** proper position.  The alternative of erasing the sprite,
'** scrolling, and then redrawing causes the sprite to spend so much
'** time offscreen that you get an unacceptable amount of flickering,
'** particularly during diagonal scrolls, when the sprite would be
'** offscreen for twice as long.  Page flipping would take care of
'** it, but I'm using screen 13 for this demo.
'**
'** Stephen L. Maxson
'** smax@isc-durant.com
'**
'** Public Domain, (ab)use at your own risk
'**
DECLARE FUNCTION GetKey$ ()
DECLARE SUB KillPalette ()
DECLARE SUB CenterColoredText (Text$, Row%)
DECLARE SUB DrawInitScreen ()
DECLARE SUB ScrollScreen (Direction%)
DEFINT A-Z
'** Dimension an array for 320 x 200 screen.
DIM BigGraphic(319, 199) AS STRING * 1
'** 20 x 20 sprite, mask for the sprite, and buffer to save background.
DIM Sprite(202), SpriteMask(202), SaveBuffer(202)
SCREEN 13
CLS
'** Kill palette to black to "hide" drawing.
KillPalette
'** First, our sprite (The LifeSaver (TM) Invasion craft).
FOR I = 0 TO 19
  LINE (0, I)-(19, 19 - I), I + 32
  LINE (I, 0)-(19 - I, 19), I + 32
NEXT I
CIRCLE (9, 9), 8, 15, , , 1
PAINT (0, 0), 0, 15
CIRCLE (9, 9), 4, 15, , , 1
PAINT (9, 9), 0, 15
GET (0, 0)-(19, 19), Sprite
'** Now the mask.
FOR I = 0 TO 19
  FOR J = 0 TO 19
    SELECT CASE POINT(I, J)
      CASE 0
        PSET (I, J), 255
      CASE ELSE
        PSET (I, J), 0
    END SELECT
  NEXT J
NEXT I
GET (0, 0)-(19, 19), SpriteMask
CLS
'** Let's make some graphics for our array.
'** The large section following creates a very crowded cityscape.
FOR I = 0 TO 7
  I0 = I * 40
  I1 = I0 + 10
  I2 = I0 + 20
  I3 = I0 + 30
  I4 = I0 + 40
  LINE (I0, 0)-(I0, 199), 8
  LINE (I1, 0)-(I1, 199), 8
  LINE (I2, 0)-(I2, 199), 8
  LINE (I3, 0)-(I3, 199), 8
  FOR J = 0 TO 4
    J0 = J * 40
    J1 = J0 + 10
    J2 = J0 + 20
    J3 = J0 + 30
    J4 = J0 + 40
    FOR K = 0 TO 1
      K1 = K * 5
      FOR L = 0 TO 7
        L1 = L * 5
        IF INT(RND * 4) > 0 THEN
          IF INT(RND * 2) = 0 THEN M = 8 ELSE M = 15
          LINE (I0 + K1 + 2, J0 + L1 + 2)-(I0 + K1 + 2, J0 + L1 + 4), M
          LINE (I0 + K1 + 3, J0 + L1 + 3)-(I0 + K1 + 3, J0 + L1 + 5), M
          LINE (I1 + K1 + 2, J0 + L1 + 3)-(I1 + K1 + 2, J0 + L1 + 5), M
          LINE (I1 + K1 + 3, J0 + L1 + 2)-(I1 + K1 + 3, J0 + L1 + 4), M
          LINE (I2 + K1 + 2, J0 + L1 + 2)-(I2 + K1 + 2, J0 + L1 + 4), M
          LINE (I2 + K1 + 3, J0 + L1 + 3)-(I2 + K1 + 3, J0 + L1 + 5), M
          LINE (I3 + K1 + 2, J0 + L1 + 3)-(I3 + K1 + 2, J0 + L1 + 5), M
          LINE (I3 + K1 + 3, J0 + L1 + 2)-(I3 + K1 + 3, J0 + L1 + 4), M
        END IF
      NEXT L
    NEXT K
    LINE (I0, J1)-(I1, J0), 7
    LINE (I1, J0)-(I2, J1), 7
    LINE (I2, J1)-(I1, J2), 7
    LINE (I1, J2)-(I0, J1), 7
    PAINT (I1, J1), 0, 7
    LINE (I1, J1 - 3)-(I1, J1), 8
    PSET (I1, J1 - 4), 4
    LINE (I2, J3)-(I3, J2), 7
    LINE (I3, J2)-(I4, J3), 7
    LINE (I4, J3)-(I3, J4), 7
    LINE (I3, J4)-(I2, J3), 7
    PAINT (I3, J3), 0, 7
    LINE (I3, J3 - 3)-(I3, J3), 8
    PSET (I3, J3 - 4), 4
  NEXT J
NEXT I
'** Let's put a red line around the entire graphic, so we can
'** see where the border is when we scroll.
LINE (0, 0)-(319, 199), 4, B
'** Whew!  Now let's put it into memory.
FOR X = 0 TO 319
  FOR Y = 0 TO 199
    BigGraphic(X, Y) = CHR$(POINT(X, Y))
  NEXT Y
NEXT X
'** Clear the screen and perform inital screen setup.
CLS
'** Print some instructions.
CenterColoredText "Single-Pixel Scrolling Demo", 1
CenterColoredText "Use Numeric Keypad To Move", 3
CenterColoredText "Press <Esc> To Exit", 23
'** Let's start at the center: 159, 99.
PlayerX = 159
PlayerY = 99
'** We'll use a 160 x 100 "viewport" centered on the screen,
'** which means 80, 50 to 239, 149.
'** How about a nifty border for our "viewport"?
LINE (70, 40)-(249, 159), 3, BF
FOR I = 70 TO 249 STEP 4
  LINE (I, 40)-(319 - I, 159), 11
NEXT I
FOR I = 40 TO 159 STEP 4
  LINE (70, I)-(249, 199 - I), 11
NEXT I
LINE (70, 40)-(249, 159), 15, B
LINE (79, 49)-(240, 150), 15, B
'** Let's draw the screen for the first time.
DrawInitScreen
'** Let's save the background and then draw our sprite for the first time.
'** The values 150, 90 will always be used for our sprite, so that
'** the center of the sprite will be in the center of the screen
'** (which also happens to be the center of our "viewport").
GET (150, 90)-(169, 109), SaveBuffer
PUT (150, 90), SpriteMask, AND
PUT (150, 90), Sprite, OR
'** PALETTE statement restores the palette, everything becomes visible.
PALETTE
'** Now for our main control loop.  We'll wait for a keypress, and
'** then scroll in the appropriate direction.  If the key pressed is
'** a diagonal key, two scrolls are actually performed, one for each
'** of the two directions the diagonal leads in.
DO
  A$ = GetKey$
  SELECT CASE A$
    '** Home or 7.
    CASE CHR$(0) + "G", "7"
      ScrollScreen 0
      ScrollScreen 2
      '** Let's put the saved background back in place to erase
      '** the scrolled sprite.
      PUT (151, 91), SaveBuffer, PSET
    '** Up Arrow or 8.
    CASE CHR$(0) + "H", "8"
      ScrollScreen 0
      '** Let's put the saved background back in place to erase
      '** the scrolled sprite.
      PUT (150, 91), SaveBuffer, PSET
    '** PgUp or 9.
    CASE CHR$(0) + "I", "9"
      ScrollScreen 0
      ScrollScreen 3
      '** Let's put the saved background back in place to erase
      '** the scrolled sprite.
      PUT (149, 91), SaveBuffer, PSET
    '** Left Arrow or 4.
    CASE CHR$(0) + "K", "4"
      ScrollScreen 2
      '** Let's put the saved background back in place to erase
      '** the scrolled sprite.
      PUT (151, 90), SaveBuffer, PSET
    '** Right Arrow or 6.
    CASE CHR$(0) + "M", "6"
      ScrollScreen 3
      '** Let's put the saved background back in place to erase
      '** the scrolled sprite.
      PUT (149, 90), SaveBuffer, PSET
    '** End or 1.
    CASE CHR$(0) + "O", "1"
      ScrollScreen 1
      ScrollScreen 2
      '** Let's put the saved background back in place to erase
      '** the scrolled sprite.
      PUT (151, 89), SaveBuffer, PSET
    '** Down Arrow or 2.
    CASE CHR$(0) + "P", "2"
      ScrollScreen 1
      '** Let's put the saved background back in place to erase
      '** the scrolled sprite.
      PUT (150, 89), SaveBuffer, PSET
    '** PgDn or 3.
    CASE CHR$(0) + "Q", "3"
      ScrollScreen 1
      ScrollScreen 3
      '** Let's put the saved background back in place to erase
      '** the scrolled sprite.
      PUT (149, 89), SaveBuffer, PSET
    '** Any other key.
    CASE ELSE
      '** Put the background back, or we end up with
      '** LifeSavers (TM) all over the place.
      PUT (150, 90), SaveBuffer, PSET
  END SELECT
  '** Save the background again.
  GET (150, 90)-(169, 109), SaveBuffer
  '** PUT our sprite back on the screen.
  PUT (150, 90), SpriteMask, AND
  PUT (150, 90), Sprite, OR
  '** The next four lines clear the keyboard buffer.
  DEF SEG = &H40         'switch to BIOS data segment
  POKE &H1A, PEEK(&H1C)  '\ make KBbuffer head pointer
  POKE &H1B, PEEK(&H1D)  '/ equal KBbuffer tail pointer
  DEF SEG                'back to default data segment
'** Pressing ESC will exit program.
LOOP UNTIL A$ = CHR$(27)
SCREEN 0, 0, 0
WIDTH 80
END

SUB CenterColoredText (Text$, Row%)

'** I is starting point of centered text.
I = 20 - (LEN(Text$) \ 2)
FOR J = 1 TO LEN(Text$)
  '** K is the color counter.
  COLOR K + 1
  LOCATE Row%, I + J
  PRINT MID$(Text$, J, 1);
  K = K + 1
  IF K = 15 THEN K = 0
NEXT J

END SUB

SUB DrawInitScreen

'** We need to use BigGraphic, PlayerX, and PlayerY from the main module.
SHARED BigGraphic() AS STRING * 1, PlayerX, PlayerY
'** Work through the entire "viewport".
FOR PlotX = 0 TO 159
  ViewX = PlayerX - 79 + PlotX
  '** Correct the value if it wraps-around in the array.
  IF ViewX < 0 THEN ViewX = ViewX + 320
  IF ViewX > 319 THEN ViewX = ViewX - 320
  FOR PlotY = 0 TO 99
    '** Find current Y point in the "viewport" in relation the player.
    ViewY = PlayerY - 49 + PlotY
    '** Correct the value if it wraps-around in the array.
    IF ViewY < 0 THEN ViewY = ViewY + 200
    IF ViewY > 199 THEN ViewY = ViewY - 200
    '** Find what's in the pixel at ViewX, ViewY in our array.
    Pixel = ASC(BigGraphic(ViewX, ViewY))
    '** PSET the point in the "viewport" (starting at 80, 50).
    PSET (PlotX + 80, PlotY + 50), Pixel
  NEXT PlotY
NEXT PlotX

END SUB

FUNCTION GetKey$

'** Wait until a key is pressed, then return it in GetKey$.
DO
  A$ = INKEY$
LOOP WHILE A$ = ""
GetKey$ = A$

END FUNCTION

SUB KillPalette

'** DIMing this array sets all elements to 0.
DIM Junk&(255)
'** PALETTE USING the null array changes all colors to 0 (black).
PALETTE USING Junk&

END SUB

SUB ScrollScreen (Direction%)

'** We need to use BigGraphic, PlayerX, and PlayerY
'** from the main module.
SHARED BigGraphic() AS STRING * 1, PlayerX, PlayerY
'** We need an array to capture all but one line of our "viewport",
'** so that we can scroll it on screen.
DIM ViewportBuffer(7952)
'** Which way to scroll?
SELECT CASE Direction%
  CASE 0  '** Up, screen scrolls down.
    '** Move player position.
    PlayerY = PlayerY - 1
    '** Wrap-around?
    IF PlayerY < 0 THEN PlayerY = PlayerY + 200
    '** Grab all but the bottom line of the viewport.
    GET (80, 50)-(239, 148), ViewportBuffer
    '** Scroll it down one pixel.
    PUT (80, 51), ViewportBuffer, PSET
    '** We need a new line of pixels at the top, so we'll check our
    '** array to see what has just scrolled onto the screen.
    '** Find current Y point in the "viewport" in relation to player.
    ViewY = PlayerY - 49
    '** Correct the value if it wraps-around in the array.
    IF ViewY < 0 THEN ViewY = ViewY + 200
    FOR PlotX = 0 TO 159
      '** Find current X point in the "viewport" in relation to player.
      ViewX = PlayerX - 79 + PlotX
      '** Correct the value if it wraps-around in the array.
      IF ViewX < 0 THEN ViewX = ViewX + 320
      IF ViewX > 319 THEN ViewX = ViewX - 320
      '** Find what's in the pixel at ViewX, ViewY in our array.
      Pixel = ASC(BigGraphic(ViewX, ViewY))
      '** PSET the point in the "viewport" (starting at 80, 50).
      PSET (PlotX + 80, 50), Pixel
    NEXT PlotX
  CASE 1  '** Down, screen scrolls up.
    '** Move player position.
    PlayerY = PlayerY + 1
    '** Wrap-around?
    IF PlayerY > 199 THEN PlayerY = PlayerY - 200
    '** Grab all but the top line of the viewport.
    GET (80, 51)-(239, 149), ViewportBuffer
    '** Scroll it up one pixel.
    PUT (80, 50), ViewportBuffer, PSET
    '** We need a new line of pixels at the bottom, so we'll check our
    '** array to see what has just scrolled onto the screen.
    '** Find current Y point in the "viewport" in relation to player.
    ViewY = PlayerY + 50
    '** Correct the value if it wraps-around in the array.
    IF ViewY > 199 THEN ViewY = ViewY - 200
    FOR PlotX = 0 TO 159
      '** Find current X point in the "viewport" in relation to player.
      ViewX = PlayerX - 79 + PlotX
      '** Correct the value if it wraps-around in the array.
      IF ViewX < 0 THEN ViewX = ViewX + 320
      IF ViewX > 319 THEN ViewX = ViewX - 320
      '** Find what's in the pixel at ViewX, ViewY in our array.
      Pixel = ASC(BigGraphic(ViewX, ViewY))
      '** PSET the point in the "viewport" (starting at 80, 50).
      PSET (PlotX + 80, 149), Pixel
    NEXT PlotX
  CASE 2  '** Left, screen scrolls right.
    '** Move player position.
    PlayerX = PlayerX - 1
    '** Wrap-around?
    IF PlayerX < 0 THEN PlayerX = PlayerX + 320
    '** Grab all but the right line of the viewport.
    GET (80, 50)-(238, 149), ViewportBuffer
    '** Scroll it right one pixel.
    PUT (81, 50), ViewportBuffer, PSET
    '** We need a new line of pixels at the left, so we'll check our
    '** array to see what has just scrolled onto the screen.
    '** Find current X point in the "viewport" in relation to player.
    ViewX = PlayerX - 79
    '** Correct the value if it wraps-around in the array.
    IF ViewX < 0 THEN ViewX = ViewX + 320
    FOR PlotY = 0 TO 99
      '** Find current Y point in the "viewport" in relation to player.
      ViewY = PlayerY - 49 + PlotY
      '** Correct the value if it wraps-around in the array.
      IF ViewY < 0 THEN ViewY = ViewY + 200
      IF ViewY > 199 THEN ViewY = ViewY - 200
      '** Find what's in the pixel at ViewX, ViewY in our array.
      Pixel = ASC(BigGraphic(ViewX, ViewY))
      '** PSET the point in the "viewport" (starting at 80, 50).
      PSET (80, PlotY + 50), Pixel
    NEXT PlotY
  CASE 3  '** Right, screen scrolls left.
    '** Move player position.
    PlayerX = PlayerX + 1
    '** Wrap-around?
    IF PlayerX > 319 THEN PlayerX = PlayerX - 320
    '** Grab all but the left line of the viewport.
    GET (81, 50)-(239, 149), ViewportBuffer
    '** Scroll it left one pixel.
    PUT (80, 50), ViewportBuffer, PSET
    '** We need a new line of pixels at the right, so we'll check our
    '** array to see what has just scrolled onto the screen.
    '** Find current X point in the "viewport" in relation to player.
    ViewX = PlayerX + 80
    '** Correct the value if it wraps-around in the array.
    IF ViewX > 319 THEN ViewX = ViewX - 320
    FOR PlotY = 0 TO 99
      '** Find current Y point in the "viewport" in relation to player.
      ViewY = PlayerY - 49 + PlotY
      '** Correct the value if it wraps-around in the array.
      IF ViewY < 0 THEN ViewY = ViewY + 200
      IF ViewY > 199 THEN ViewY = ViewY - 200
      '** Find what's in the pixel at ViewX, ViewY in our array.
      Pixel = ASC(BigGraphic(ViewX, ViewY))
      '** PSET the point in the "viewport" (starting at 80, 50).
      PSET (239, PlotY + 50), Pixel
    NEXT PlotY
END SELECT

END SUB