'The following program is the sole creation of David Grace
'PRODIGY (CDRS62D). David Grace, like so many other good  
'programmers, has left PRODIGY. So if you wish to comment or
'leave a reply about this DEMO, please address it to David
'Gentry using the above I.D. number!                      
DECLARE SUB PUT2P (X%, Y%, AR%())
DECLARE SUB FONT (a$, X%, Y%, stepX%, stepY%, CO%, Background%, SHADOW%)
'  This short demo for an action-shoot'em-up game was     
'  posted because of several questions about animation.   
'  In this code you will find examples of page-flipping   
'  animation, including a new sprite-clipping routine that
'  allows you to place a GETted sprite past the boundaries
'  of the screen.  Also, scrolling stars, explosions,     
'  sprite movement/limitation on movement is shown.  Using
'  ideas here, one could possibly build an entire game from
'  this concept.  (BTW: Format of title screen was gotten 
'  from a Genesis game.)  Title: SHIPDEMO.BAS (1-6)       
CLEAR , , 2000: DEFINT A-Z: SCREEN 7: CLS
  DEF FNR (X) = INT(RND * X) + 1
  DIM E1(150), E2(50), E3(15), S1(500) ' dim arrays       
  DIM S2(500), F1(70), F2(40), R1(200)
  DIM CX(50), CY(50), CT(50)
  DIM TEMP(500)
  DIM SX(50), SY(50), ST(50)
                                                            
                                                            
  SCREEN , , 0, 1  ' set paging mode                      
  CIRCLE (50, 50), 10, 7
  PAINT (50, 50), 7
  LINE (40, 50)-(60, 51), 12, B
  LINE (40, 50)-(60, 51), 9, B, &H5555
  LINE (53, 43)-(54, 44), 15, B
  PSET (57, 45), 15
  LINE (45, 55)-(55, 55), 12
  LINE (46, 56)-(54, 56), 4
  PSET (45, 45), 1: PSET (44, 46), 1
  PSET (46, 45), 11: PSET (45, 46), 11
  LINE (43, 45)-(42, 46), 1
  GET (40, 40)-(60, 60), E1  'draw & get enemy1           
  CLS
  CIRCLE (50, 50), 5, 7: PAINT (50, 50), 7
  LINE (45, 50)-(55, 50), 9
  LINE (45, 50)-(55, 50), 12, , &H5555
  LINE (48, 53)-(52, 53), 4
  PSET (52, 47), 15: PSET (48, 47), 1
  GET (45, 45)-(55, 55), E2  'draw & get enemy2           
  CLS
  CIRCLE (50, 50), 2, 7
  PAINT (50, 50), 7
  LINE (48, 50)-(52, 50), 4
  LINE (48, 50)-(52, 50), 1, , &H5555
  PSET (51, 48), 15
  GET (48, 48)-(52, 52), E3  'draw & get enemy3           
  CLS
  LINE (50, 50)-(100, 50), 7
  LINE (60, 45)-(100, 50), 7
  LINE (60, 45)-(50, 45), 7

  LINE -(50, 50), 7
  PAINT (51, 49), 15, 7
  LINE (50, 54)-(100, 54), 7
  LINE (100, 54)-(60, 59), 7
  LINE (60, 59)-(50, 59), 7
  LINE -(50, 54), 7: PAINT (51, 55), 15, 7
  LINE (50, 51)-(95, 53), 3, BF
  LINE (82, 51)-(80, 53), 1, BF: PSET (80, 51), 9
  LINE (76, 50)-(79, 54), 1, BF: PSET (79, 50), 9
  LINE (72, 49)-(75, 55), 1, BF: PSET (78, 50), 9
  LINE (71, 49)-(71, 55), 11: PSET (76, 49), 9
  LINE (60, 49)-(70, 55), 5, BF
  LINE (60, 50)-(70, 54), 13, BF
  LINE (59, 49)-(59, 55), 11
  FOR I = 50 TO 58 STEP 2
    LINE (I, 51)-(I, 53), 8
  NEXT
  LINE (90, 44)-(70, 40), 8
  LINE (70, 40)-(50, 40), 8
  LINE -(50, 37), 8
  LINE -(76, 37), 8
  LINE -(90, 44), 8
  PAINT (51, 38), 7, 8
  LINE (55, 41)-(56, 44), 11, B
  LINE (75, 42)-(71, 46), 11
                                                            
  LINE (90, 60)-(70, 64), 8
  LINE (70, 64)-(50, 64), 8
  LINE -(50, 67), 8
  LINE -(76, 67), 8
  LINE -(90, 60), 8
  PAINT (51, 65), 7, 8
  LINE (55, 63)-(56, 60), 11, B
  LINE (75, 62)-(71, 58), 11
                                                            
  LINE (49, 46)-(49, 58), 8
  LINE (48, 47)-(48, 57), 8
  LINE (47, 46)-(47, 58), 7
  LINE (47, 46)-(47, 58), 8, , &H5555
  GET (47, 37)-(100, 67), S1  'draw & get ship1           
                                                            
                                                            
  CLS
  CIRCLE (50, 50), 7, 4: PAINT (50, 50), 4
  CIRCLE (50, 50), 5, 12: PAINT (50, 50), 12
  CIRCLE (50, 50), 3, 14: PAINT (50, 50), 14
  LINE (51, 43)-(58, 57), 0, BF
  GET (43, 43)-(50, 57), F1  'draw & get flame1           
                                                            
                                                            
  CLS
  CIRCLE (50, 50), 4, 12: PAINT (50, 50), 12
  CIRCLE (50, 50), 2, 14: PAINT (50, 50), 14
  LINE (51, 46)-(54, 54), 0, BF
  GET (46, 46)-(50, 54), F2  'draw & get flame2           
                                                            
                                                            
  CLS
  PUT (50, 50), S1
  GET (50, 50)-(100, 56), TEMP
  PUT (50, 51), TEMP, PSET
  LINE (50, 50)-(90, 50), 0
  GET (50, 61)-(105, 90), TEMP
  PUT (50, 59), TEMP, PSET
  LINE (53, 79)-(79, 79), 8
  LINE -(93, 71), 8
  GET (50, 51)-(103, 79), S2  'alter & get ship2          
                                                            
                                                            
  CLS
  LINE (50, 50)-(50, 100), 7
  LINE (48, 51)-(49, 99), 7, B
  LINE (46, 54)-(47, 96), 7, B
  LINE (45, 56)-(45, 94), 7
  LINE (50, 70)-(49, 80), 8, B
  PSET (50, 69), 15: PSET (50, 81), 15
  LINE (48, 57)-(49, 64), 3, B
  LINE (48, 86)-(49, 93), 3, B
  LINE (44, 60)-(44, 68), 8
  LINE (44, 83)-(44, 91), 8
  GET (44, 50)-(50, 100), R1  'draw & get rship           
  CLS : PCOPY 0, 2  'prepare our "background" page        
  FOR I = 1 TO 50  'sprinkle some stars                   
    SX(I) = FNR(319): SY(I) = FNR(199)
    ST(I) = FNR(2)
  NEXT
                                                            
                                                            
  ED = 0: ET = 0: TOG = 0
  DO
    PCOPY 2, 0  'copy background to template              
    FOR I = 1 TO 50  'move & display stars                
      IF ST(I) = 1 THEN C = 1 ELSE C = 9
      PSET (SX(I), SY(I)), C
      SX(I) = SX(I) - ST(I) * 5
      IF SX(I) < 0 THEN
        SX(I) = 319: SY(I) = FNR(199)
        ST(I) = FNR(2)
      END IF
      IF ET > 550 THEN SY(I) = SY(I) - (550 - ET)
    NEXT
    IF ED = 1 AND EXD = 0 THEN  'short burst              
      PUT2P EX - 8, EY + 3, F1()
      PUT2P EX - 28, EY - 17, F1()
      PUT2P EX - 48, EY - 37, F1()
    END IF
    SELECT CASE ED  'display enemies                      
      CASE IS = 1:                                        
        PUT2P EX, EY, E1()
        PUT2P EX - 20, EY - 20, E1()
        PUT2P EX - 40, EY - 40, E1()
      CASE IS = 2:                                        
        PUT2P EX + 5, EY + 5, E2()
        PUT2P EX - 15, EY - 15, E2()
        PUT2P EX - 35, EY - 35, E2()
      CASE IS = 3:                                        
        PUT2P EX + 7, EY + 7, E3()
        PUT2P EX - 13, EY - 13, E3()
                                                            

        PUT2P EX - 33, EY - 33, E3()
    END SELECT
    IF Y <> 0 THEN  'display ship                         
      IF YD <> 0 THEN
        PUT2P X, Y + 2, S2()
      ELSE
        PUT2P X, Y, S1()
      END IF
      IF TOG = 0 THEN  'fire flame                        
        TOG = 1: PUT2P X - 8, Y + 8, F1()
      ELSE
        TOG = 0: PUT2P X - 5, Y + 11, F2()
      END IF
    END IF
    IF EXR <> 0 THEN  'put rship                          
      PUT2P EXR, 70, R1()
      IF TOG = 0 THEN  'give it some flames               
        PUT2P EXR - 8, 77, F1()
        PUT2P EXR - 8, 99, F1()
      ELSE
        PUT2P EXR - 5, 80, F2()
        PUT2P EXR - 5, 102, F2()
      END IF
    END IF
    IF YD = 0 AND XD = 0 AND ET > 121 AND X <= 63 THEN
      IF TOG = 0 THEN  'lasergun shots                    
        LINE (X + 35, Y + 9)-(319, Y + 9), 9, , &HFF00
        LINE (X + 35, Y + 9)-(319, Y + 9), 3, , &HCC00
        LINE (X + 35, Y + 21)-(319, Y + 21), 9, , &HFF00
        LINE (X + 35, Y + 21)-(319, Y + 21), 3, , &HCC00
      ELSE
        LINE (X + 35, Y + 9)-(319, Y + 9), 1, , &HFF
        LINE (X + 35, Y + 9)-(319, Y + 9), 11, , &HCC
        LINE (X + 35, Y + 21)-(319, Y + 21), 1, , &HFF
        LINE (X + 35, Y + 21)-(319, Y + 21), 11, , &HCC
      END IF
      FOR I = 1 TO 5  '"puff" of damage                   
        PSET (317 - FNR(10), FNR(18) + Y + 5), 15
      NEXT
    END IF
    IF EX = 1 THEN  'random explosions                    
      C = FNR(2)
      IF C = 1 THEN C = 4 ELSE C = 12
      a = FNR(30) + 299: B = FNR(50) + 75
      CIRCLE (a, B), FNR(20) + 10, C
      PAINT (a - 9, B), C
      IF X > 62 THEN
        EXR = EXR + 1: IF EXR > 330 THEN EXR = 330
      END IF
    END IF
    IF EX = 2 THEN  'debris falling behind                
      FOR I = 1 TO 20
        IF CX(I) > 0 THEN
          PSET (CX(I), CY(I)), 15
          CX(I) = CX(I) - CT(I)
          IF CX(I) < 0 THEN CX(I) = 0
        END IF
      NEXT
    END IF
    IF X = 80 THEN  'large flame burst                    
      CIRCLE (X - 5, Y + 20), 100, 15
      PAINT (X - 5, Y + 20), 15
      XD = 30: X = X + 1
    END IF
    IF ET < 20 THEN  'text                                
      FONT "Coming soon...", 100, 95, 8, 0, 15, 0, 8
    END IF
    IF ET > 390 AND ET < 450 THEN  'text2                 
      FONT "...to a computer near you...", 50, 95, 8, 0, 11, 0, 0
    END IF
    IF ET > 450 AND ET < 550 THEN  'text3                 
      a$ = "* S T A R S H I P   L E G E N D  I I *"
      FONT a$, 10, 85, 8, 0, 14, 0, 0
      FONT "(don't miss it!)", 100, 100, 8, 0, 6, 0, 0
    END IF
    PCOPY 0, 1  'copy template to viewing screen          
    ET = ET + 1  'cycle timer (add delays if too fast)    
    IF ET = 30 THEN 'activate enemies                 
      EX = 350: EY = 200: ED = 1: EXD = -23: EYD = -8
    END IF
    IF ED > 0 THEN  'enemy move parser                    
      EX = EX + EXD: EY = EY + EYD
      EXD = EXD + 1: IF EXD > 20 THEN EXD = 20
      IF (EX MOD 2) = 0 THEN
                                                            
        EYD = EYD + 1: IF EYD > 2 THEN EYD = 2
      END IF
      IF EXD > 1 AND (ET MOD 3) = 0 THEN
        ED = ED + 1: IF ED > 3 THEN ED = 3
      END IF
      IF EX > 350 THEN ED = 0
    END IF
    IF ET = 120 THEN  'activate ship                      
      X = 0: Y = 200: XD = 10: YD = -15: EX = 0: EXR = 340
    END IF
    IF ET > 121 THEN  'ship move parser                   
      IF EX = 0 THEN
        EXR = EXR - 1: IF EXR < 314 THEN EXR = 314
      END IF
      X = X + XD: Y = Y + YD
      XD = XD - 1: IF XD < 0 THEN XD = 0
      YD = YD + 1: IF YD > 0 THEN YD = 0
      IF XD = 0 AND (ET MOD 7) = 0 THEN X = X + 1
    END IF
    IF X > 65 AND EX = 1 THEN  'explosion parser          
      EXR = 0
      PALETTE 0, 15
      EX = 2
      FOR I = 1 TO 20
        CX(I) = 319 + FNR(50): CY(I) = FNR(50) + 70
        CT(I) = FNR(20) + 10
      NEXT
      PALETTE 0, 0
    END IF
    IF X > 60 AND EX = 0 THEN EX = 1  'switch expls       
                                                            

  LOOP UNTIL INKEY$ <> "" OR ET > 570  'repeat            
  CLS : PCOPY 0, 1  'clear active page                    
  END
                                                            
extX% = stepX%: extY% = stepY%
DEF SEG = &HFFA6
 FOR I% = 1 TO LEN(a$)
   addr% = 8 * ASC(MID$(a$, I%)) + 14
IF Background% THEN
IF Background% = 256 THEN BG% = FALSE ELSE BG% = Background%
                                                            
IF I% = LEN(a$) THEN extX% = FALSE: extY% = FALSE
LINE (X%, Y%)-(X% + 7 + extX%, Y% + 7 + extY%), BG%, BF
END IF
FOR j% = 0 TO 7
mask% = PEEK(addr% + j%) * 128
IF SHADOW% > 0 THEN
LINE (X% + 9, Y% + j% + 2)-(X% + 2, Y% + j% + 2), SHADOW%, , mask%
END IF
LINE (X% + 7, Y% + j%)-(X%, Y% + j%), CO%, , mask%
NEXT
X% = X% + extX%
Y% = Y% + extY%
NEXT
DEF SEG

SUB FONT (a$, X%, Y%, stepX%, stepY%, CO%, Background%, SHADOW%)

END SUB

' PUT2P - PUT Type II:                                    
' Clipping PUT routine.                                   
'                                                         
SUB PUT2P (X, Y, AR()) STATIC
  IF X < 0 OR Y < 0 THEN EXIT SUB  'off screen            
  IF X + AR(0) < 320 AND Y + AR(1) < 200 THEN
    PUT (X, Y), AR, PSET: EXIT SUB
  END IF  'already on screen                              
  IF X > (320 - AR(0)) THEN VL = 320 - X ELSE VL = AR(0)
  IF VL < 1 THEN EXIT SUB  'no need                       
  IF Y > (200 - AR(1)) THEN VL2 = 200 - Y ELSE VL2 = AR(1)
  IF VL2 < 1 THEN EXIT SUB  'no need                      
  SAR = AR(0): SAR1 = AR(1)  'hold copy                   
  AR(0) = VL: AR(1) = VL2
  PUT (X, Y), AR, PSET  'put modified array               
  AR(0) = SAR: AR(1) = SAR1  'restore altered bytes       
END SUB