Advertisement
LBASIC

ANIMA5.BAS

Jun 5th, 2023
566
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
QBasic 5.05 KB | Software | 0 0
  1. DECLARE SUB Attrib (Attribute%, r%, g%, b%)
  2. DECLARE SUB InitPalette ()
  3. DECLARE SUB DrawBackdrop ()
  4. DECLARE SUB DrawSprite ()
  5. DECLARE SUB PageCopyBox (x AS INTEGER, y AS INTEGER, PageNumber AS INTEGER)
  6. DECLARE SUB Stamp2 (x AS INTEGER, y AS INTEGER, s AS INTEGER)
  7. DECLARE SUB PagePSet3 (x AS INTEGER, y AS INTEGER, Page AS INTEGER, C AS INTEGER)
  8. DECLARE SUB Snapshot (x AS INTEGER, y AS INTEGER, s AS INTEGER)
  9. 'From: TONY CAVE                 Conference: QUIK_BAS -Qui (298)
  10. 'Date: 07-02-97 23:51              BBS Name: YE OLDE PAWN SHOPPE ]I[
  11. 'Subject: anima5.bas (1/3)              BBS ID: YOPSIII
  12. 'The following is by no means a finished product.  I just thought
  13. 'you might want to see the no-flicker animation and page swapping
  14. 'on screen 13.  The program uses PUT to copy the page to the screen.
  15. 'Copying a whole page, though, slows down the animation considerably.
  16. 'Any suggestions would be appreciated.  Just bear in mind that the
  17. 'program is not finished, and some of the subs with "Page" in the name
  18. 'only work with page one.  The animaiton is done by:
  19. '1 copy screen to memory pages, page1 and page2
  20. '2 do
  21. '3  place a sprite on page1 (color 0 is transparent).
  22. '4  copy page1 to the screen
  23. '5  erase the sprite from page1 by copying part of page2 (PageCopyBox)
  24. '6 loop
  25. '''Begin ANIMA5.BAS
  26. COMMON SHARED snap() AS INTEGER, leaf() AS INTEGER, swp() AS INTEGER
  27. COMMON SHARED OldX AS INTEGER, OldY AS INTEGER
  28. COMMON SHARED Page1() AS INTEGER, Page2() AS INTEGER
  29. COMMON SHARED CurrentSegment AS LONG
  30. DIM Page1(32001) AS INTEGER, Page2(32001) AS INTEGER
  31. DIM snap(15, 15, 20) AS INTEGER, x AS INTEGER, y AS INTEGER
  32. DIM leaf(10, 10, 20) AS INTEGER, swp(10, 10, 20) AS INTEGER
  33. DIM t AS INTEGER, T2 AS INTEGER, T3  AS INTEGER: SCREEN 13
  34. CurrentSegment = &HA000: DrawSprite: InitPalette: DrawBackdrop
  35. GET (0, 0)-(319, 199), Page1(0): GET (0, 0)-(319, 199), Page2(0)
  36. step1 = 3
  37. DO: FOR t = 0 TO 628 STEP step1
  38.       y = COS(t / 100) * 320 / step1 + 100
  39.       x = SIN(t / 100) * 240 / step1 + 160
  40.       Stamp2 x, y, t / step1 MOD 5
  41.       PUT (0, 0), Page1(0), PSET: PageCopyBox x, y, 1
  42.       IF INKEY$ > "" THEN DEF SEG : EXIT DO
  43.    NEXT: LOOP: SCREEN 0: WIDTH 80, 25: SYSTEM
  44.  
  45. SUB Attrib (Attribute%, r%, g%, b%)
  46.    IF -1 < Attribute% AND Attribute% < 256 THEN
  47.       OUT &H3C8, Attribute%: OUT &H3C9, r%
  48.       OUT &H3C9, g%: OUT &H3C9, b%
  49.    END IF: END SUB
  50.  
  51. SUB DrawBackdrop
  52.    'Draw Sky
  53.    FOR y = 0 TO 199: LINE (0, y)-(319, y), y + 56: NEXT
  54.    'Draw Planet
  55.    CIRCLE (160, 800), 770, 2: PAINT (160, 190), 2, 2
  56.    FOR y = 0 TO 5: CIRCLE (160, 800), 770 + y, 50 + y: NEXT
  57. END SUB
  58.  
  59. SUB DrawSprite : DIM t AS INTEGER
  60.    FOR t = 0 TO 2: CIRCLE (6, 5), t, 21 - t * 3 + 16
  61.       CIRCLE (5, 5), t, 21 - t * 3 + 16
  62.       CIRCLE (6, 4), t, 18 - t * 3 + 16
  63.       CIRCLE (5, 4), t, 18 - t * 3 + 16
  64.       IF t > 4 THEN Snapshot 0, 0, t    '  X, Y, snapshot#
  65.    NEXT
  66.    FOR t = 3 TO 4
  67.       LINE (-t + 6, 2 + t)-(t + 6, 2 + t), 21 - t * 3 + 16: NEXT
  68.    FOR t = 0 TO 4
  69.       LINE (-4 + 6, 7)-(3 + 6, 2 + 4), 21 - 4 * 3 + 16, BF
  70.       LINE (t * 2 + 2, 6)-(t * 2 + 3, 7), 14, BF
  71.       Snapshot 0, 0, t                  '  X, Y, snapshot#
  72.    NEXT: END SUB
  73.  
  74. SUB InitPalette : DIM pu AS INTEGER
  75.    FOR y = 0 TO 199
  76.       Attrib y + 56, 0, 0, INT(y * 63 / 199): NEXT
  77.    FOR y = 0 TO 5
  78.       Attrib 50 + y, 0, (5 - y) / 5 * 20 + 20, y / 5 * 40 + 15
  79.    NEXT: END SUB
  80.  
  81. SUB PageCopy (PageNumber AS INTEGER)
  82.    IF PageNumber = 1 THEN
  83.       FOR count% = 0 TO 32001: Page1(count%) = Page2(count%): NEXT
  84.    ELSE
  85.       FOR count% = 0 TO 32001: Page2(count%) = Page1(count%): NEXT
  86.    END IF: END SUB
  87.  
  88. SUB PageCopyBox (x AS INTEGER, y AS INTEGER, PageNumber AS INTEGER)
  89.    DIM xt AS INTEGER, yt AS INTEGER, P AS LONG, c1 AS LONG
  90.    PCBSeg& = CurrentSegment
  91.    FOR xt = 0 TO 10: FOR yt = 0 TO 10
  92.       P = 320& * (y + yt) + x + xt
  93.       IF P < 32000 THEN
  94.          CurrentSegment = VARSEG(Page2(0)): DEF SEG = CurrentSegment
  95.          PagePSet3 x + xt, y + yt, 1, PEEK(P + 4)
  96.       ELSE
  97.          CurrentSegment = VARSEG(Page2(0))
  98.          CurrentSegment = CurrentSegment + 2000
  99.          DEF SEG = CurrentSegment
  100.          PagePSet3 x + xt, y + yt, 1, PEEK(P - 31996)
  101.       END IF
  102.    NEXT: NEXT
  103.    CurrentSegment = PCBSeg&: DEF SEG = CurrentSegment: END SUB
  104.  
  105. SUB PagePSet3 (x AS INTEGER, y AS INTEGER, Page AS INTEGER, C AS INTEGER)
  106.    IF (x < 0) OR (y < 0) OR (x > 319) OR (y > 199) THEN EXIT SUB
  107.    DIM P AS LONG, c1 AS LONG: c1 = VARSEG(Page1(0)): P = 320& * y + x
  108.    IF P < 32000 THEN
  109.       DEF SEG = VARSEG(Page1(0)): POKE P + 4, C
  110.    ELSE
  111.       DEF SEG = c1 + 2000: POKE P - 31996, C
  112.    END IF: DEF SEG = CurrentSegment: END SUB
  113.  
  114. SUB Snapshot (x AS INTEGER, y AS INTEGER, s AS INTEGER)
  115.    DIM xt AS INTEGER, yt AS INTEGER
  116.    FOR xt = 0 TO 10: FOR yt = 0 TO 10
  117.       snap(xt, yt, s) = POINT(xt + x, yt + y): NEXT: NEXT: END SUB
  118.  
  119. SUB Stamp2 (x AS INTEGER, y AS INTEGER, s AS INTEGER)
  120.    DIM xt AS INTEGER, yt AS INTEGER
  121.    FOR xt = 0 TO 10: FOR yt = 0 TO 10
  122.       IF snap(xt, yt, s) > 0 THEN
  123.          PagePSet3 x + xt, y + yt, 1, snap(xt, yt, s)
  124.       END IF
  125.    NEXT: NEXT: END SUB
  126.  
  127.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement