ANIMA6.BAS

'From: TONY CAVE                 Conference: QUIK_BAS -Qui (298)
'Date: 07-02-97 23:51              BBS Name: YE OLDE PAWN SHOPPE ]I[
'Subject: anima5.bas (1/3)              BBS ID: YOPSIII
'The following is by no means a finished product.  I just thought
'you might want to see the no-flicker animation and page swapping
'on screen 13.  The program uses PUT to copy the page to the screen.
'Copying a whole page, though, slows down the animation considerably.
'Any suggestions would be appreciated.  Just bear in mind that the
'program is not finished, and some of the subs with "Page" in the name
'only work with page one.  The animaiton is done by:
'1 copy screen to memory pages, page1 and page2
'2 do
'3  place a sprite on page1 (color 0 is transparent).
'4  copy page1 to the screen
'5  erase the sprite from page1 by copying part of page2 (PageCopyBox)
'6 loop
'''Begin ANIMA5.BAS
COMMON SHARED snap() AS INTEGER, leaf() AS INTEGER, swp() AS INTEGER
COMMON SHARED OldX AS INTEGER, OldY AS INTEGER
COMMON SHARED Page1() AS INTEGER, Page2() AS INTEGER
COMMON SHARED CurrentSegment AS LONG
DIM Page1(32001) AS INTEGER, Page2(32001) AS INTEGER
DIM snap(15, 15, 20) AS INTEGER, x AS INTEGER, y AS INTEGER
DIM leaf(10, 10, 20) AS INTEGER, swp(10, 10, 20) AS INTEGER
DIM t AS INTEGER, T2 AS INTEGER, T3  AS INTEGER: SCREEN 13
CurrentSegment = &HA000: DrawSprite: InitPalette: DrawBackdrop
GET (0, 0)-(319, 199), Page1(0): GET (0, 0)-(319, 199), Page2(0)
step1 = 3
DO: FOR t = 0 TO 628 STEP step1: y = COS(t / 100) * 320 / step1 + 100
    x = SIN(t / 100) * 240 / step1 + 160: Stamp2 x, y, t / step1 MOD 5
    PUT (0, 0), Page1(0), PSET: PageCopyBox x, y, 1
    IF INKEY$ > "" THEN DEF SEG : EXIT DO
  NEXT: LOOP: SCREEN 0: WIDTH 80, 25: SYSTEM
SUB Attrib (Attribute%, r%, g%, b%)
  IF -1 < Attribute% AND Attribute% < 256 THEN
    OUT &H3C8, Attribute%: OUT &H3C9, r%
    OUT &H3C9, g%: OUT &H3C9, b%
  END IF: END SUB
SUB DrawBackdrop
  FOR y = 0 TO 199: LINE (0, y)-(319, y), y + 56: NEXT  'Draw Sky
  CIRCLE (160, 800), 770, 2: PAINT (160, 190), 2, 2     'Draw Planet
  FOR y = 0 TO 5: CIRCLE (160, 800), 770 + y, 50 + y: NEXT: END SUB
SUB DrawSprite : DIM t AS INTEGER
  FOR t = 0 TO 2: CIRCLE (6, 5), t, 21 - t * 3 + 16
    CIRCLE (5, 5), t, 21 - t * 3 + 16
    CIRCLE (6, 4), t, 18 - t * 3 + 16
    CIRCLE (5, 4), t, 18 - t * 3 + 16
    IF t > 4 THEN Snapshot 0, 0, t    '  X, Y, snapshot#
  NEXT:FOR t=3 TO 4:LINE(-t+6,2+t)-(t+6,2+t),21-t*3+16:NEXT
  FOR t=0 TO 4:LINE(-4+6,7)-(3+6,2+4),21-4*3+16,BF
    LINE (t * 2 + 2, 6)-(t * 2 + 3, 7), 14, BF
    Snapshot 0, 0, t: NEXT: END SUB   'X, Y, snapshot#
SUB InitPalette : DIM pu AS INTEGER
  FOR y=0 TO 199: Attrib y+56,0,0,INT(y*63/199): NEXT
  FOR y=0 TO 5:Attrib 50+y,0,(5-y)/5*20+20,y/5*40+15:NEXT: END SUB
SUB PageCopy (PageNm AS INTEGER)
  IF PageNm=1 THEN FOR c%=0 TO 32001:Page1(c%)=Page2(c%):NEXT
  IF PageNm<>1 THEN FOR c%=0 TO 32001:Page2(c%)=Page1(c%):NEXT
  END SUB
SUB PageCopyBox (x AS INTEGER, y AS INTEGER, PageNumber AS INTEGER)
  DIM xt AS INTEGER, yt AS INTEGER, P AS LONG, c1 AS LONG
  PCBSeg& = CurrentSegment
  FOR xt = 0 TO 10: FOR yt = 0 TO 10: P = 320& * (y + yt) + x + xt
    IF P < 32000 THEN
      CurrentSegment = VARSEG(Page2(0)): DEF SEG = CurrentSegment
      PagePSet3 x + xt, y + yt, 1, PEEK(P + 4)
    ELSE
      CurrentSegment=VARSEG(Page2(0)):CurrentSegment=CurrentSegment+2000
      DEF SEG = CurrentSegment:PagePSet3 x+xt,y+yt,1,PEEK(P-31996)
    END IF: NEXT: NEXT
  CurrentSegment = PCBSeg&: DEF SEG = CurrentSegment: END SUB
SUB PagePSet3 (x AS INTEGER, y AS INTEGER, Page AS INTEGER, C AS INTEGER)
  IF (x < 0) OR (y < 0) OR (x > 319) OR (y > 199) THEN EXIT SUB
  DIM P AS LONG, c1 AS LONG: c1 = VARSEG(Page1(0)): P = 320& * y + x
  IF P < 32000 THEN DEF SEG = VARSEG(Page1(0)): POKE P + 4, C
  IF P > 31999 THEN DEF SEG = c1 + 2000: POKE P - 31996, C
  DEF SEG = CurrentSegment: END SUB
SUB Snapshot (x%, y%, s%)
  FOR xt% = 0 TO 10: FOR yt% = 0 TO 10
    snap(xt%,yt%,s%)=POINT(xt%+x%,yt%+y%):NEXT:NEXT:END SUB
SUB Stamp2 (x%, y%, s%)
  FOR xt% = 0 TO 10: FOR yt% = 0 TO 10
    IF snap(xt%, yt%, s%) > 0 THEN
      PagePSet3 x% + xt%, y% + yt%, 1, snap(xt%, yt%, s%)
    END IF: NEXT: NEXT: END SUB