PlatformGameEngine.Asc

'Dual Playfield Tile Scroller Platform Game Engine For AmosPro
'Author: Alper Sönmez (06.04.2021) v0.34
'Background graphics: Amatnieks (aamatniekss.itch.io)
'Sprite graphics: Legnops (legnops.itch.io)

Set Buffer 24

Gosub _INIT_VARIABLES
PREP_SCREEN_BITMAPS
Load "Tileset.abk",2
Gosub _READ_MAP
CUSTOM_SPRITE_LOAD["sprites.spr"]

Copper Off
CUSTOM_COPPER_LIST
INIT_FADE
_FADE=IN
Gosub _FILL_SCREEN

'Main Loop
'*********
   Do
      _TIMER=Timer
      _ODD_FRAME=Btst(0,_TIMER)

      If PL_Y>200 Then Goto QUIT

      If Key State($4C)=True
         Gosub _JUMP
      End If
      If Key State($4D)=True

      End If

      If Key State($4E)=True
         Gosub _GO_RIGHT
      Else If Key State($4F)=True
         Gosub _GO_LEFT
      Else
         Gosub _IDLE
      End If

      If Key State($45)=True and _FADE=0
         _FADE=OUT
      End If

      Gosub _DO_ANIM
      Gosub _VBL_ACTIONS
   Loop

QUIT:
'Production state code -- You can remove below 3 before release
'*********************
   Copper On
   Erase 2
   Erase 5
'*********************
End

'***********
'Subroutines
'***********

_INIT_VARIABLES:
   'Scroll Engine specific variables
   '********************************
   'Scroll Position: The amount of pixels the screen is scrolled right.
   '                 With this implementation you can only initialize it
   '                 to 0. :(
   '                 SCR_MAX holds the maximum value for SCR_POS
   SCR_POS=0

   'Map Position: Indicates what column of map data is being displayed
   '              at the current SCR_POS. At SCR_POS=0, MAP_POS must be -1
   '              because of the way the algorithm is implemented.
   '              At SCR_POS=1 it is 1, at SCR_POS=16 it is still 1, yet
   '              at SCR_POS=17 it is 2... etc.
   '              MRR and MRC is calculated from MAP_POS.
   '              MRR: (M)ap (R)ead (R)ow, holds row of the next incoming
   '                   tile to be filled from map data.
   '              MRC: (M)ap (R)ead (C)olumn, holds the current column
   '                   of the map data the incoming tiles will be read.
   MAP_POS=-1

   '(N)ext (F)ill (R)ow: Holds the screen Y coordinate on the fill column
   '                     for the next incoming tile to be filled.
   NFR_Y=0

   '(F)ill (C)olumn (L)eft: The screen X coordinate of the left fill column
   '                        At SCR_POS=0 it must be initialized to 336.
   '                        At SCR_POS=1 it becomes 0 as expected.
   '                        At SCR_POS=16 it is still 0.
   '                        At SCR_POS=17 it becomes 16.
   '                        At SCR_POS=352 it becomes 0 again, and so on...
   FCL_X=336

   'Scroll speed: How many pixels to scroll with a call to _SCROLL_LEFT/RIGHT
   SPEED=1

   'An internal modulus value to be memorized after every scroll.
   OLD_SCR_MOD=16

   'Sprite Engine variables
   '***********************
   'Sprite Strobe Addresses
   '   8 two LONGs of memory. Each first long will be a strobe register. The
   '   address held in it will be set to the corresponding sprite instruction
   '   on the copper list during the vertical blank (vbl) and after that will
   '   be set back to zero.
   '   Each 2nd LONG will hold the two control WORDs that will be poked into
   '   the corresponding sprite structure the 1st LONG points to.
   '   All this is to be able to do the sprite calculations during display
   '   and setting the results to the copper list only during vbl.
   Dim _SPRITE_STROBE(15)
   _SPRITE_STROBE_PT=Varptr(_SPRITE_STROBE(0))

   'Color palette (values for all color instructions in the copper list)
   '*************
   '   This implementation has 33 color instructions on the custom copper list
   '   it creates.
   '   A color value in ECS/OCS is 2 bytes. So WORDs are used to store
   '   them to conserve memory. Every array item in Amos is a LONG so we can
   '   store 2 color values per every item. One in 1st WORD other in the 2nd.
   '   The table is dimensioned as: 33/2=16 and traversed using a pointer.
   '   When new color instructions are added to the copper list, first thing
   '   to do is to update the value below. Otherwise memory will be trashed.
   '   Using the helper procedure DUMP_COPPER_COLORS is recommended.
   _COLOR_INSTRUCTIONS=33

   Dim _COLOR_TABLE(_COLOR_INSTRUCTIONS/2)
   _COLOR_TABLE_PT=Varptr(_COLOR_TABLE(0))

   _COLOR_TABLE(0)=$58D07AD
   _COLOR_TABLE(1)=$ACE0386
   _COLOR_TABLE(2)=$DEF0255
   _COLOR_TABLE(3)=$7BA05A7
   _COLOR_TABLE(4)=$446
   _COLOR_TABLE(5)=$CE40212
   _COLOR_TABLE(6)=$5320963
   _COLOR_TABLE(7)=$18406C1
   _COLOR_TABLE(8)=$111
   _COLOR_TABLE(9)=$AAA0822
   _COLOR_TABLE(10)=$2010221
   _COLOR_TABLE(11)=$4010534
   _COLOR_TABLE(12)=$6440554
   _COLOR_TABLE(13)=$6550755
   _COLOR_TABLE(14)=$A540A64
   _COLOR_TABLE(15)=$9880A99
   _COLOR_TABLE(16)=$0

   'FADE ENGINE variables
   '*********************
   '   _FADE_TABLE() holds precalculated increment and current state values
   '   for the 3 components of all color values for all color instructions
   '   in the copper list (yes we fade the Rainbows too).
   '   So it will use a fair amount of memory if the copper is rich with color
   '   instructions. But this is essential to be able to calculate every fade
   '   step using only lookups and additions.
   Dim _FADE_TABLE(_COLOR_INSTRUCTIONS*3)
   _FADE_TABLE_PT=Varptr(_FADE_TABLE(0))

   'FADE_STEPS determines fade speed (in how many frames the fade will take)
   '           It can be minimum 1 and maximum 256!
   _FADE_STEPS=20

   'Setting variable _FADE to one of the below will start a fade (in or out)
   IN=_FADE_STEPS
   OUT=-_FADE_STEPS

   R=0 : Rem Red component of the color value
   G=0 : Rem Green component of the color value
   B=0 : Rem Blue component of the color value
   W=0 : Rem (4 bytes of) work buffer
   'Some pointers to 3rd byte of each above variables
   W3=Varptr(W)+2
   R3=Varptr(R)+2
   G3=Varptr(G)+2
   B3=Varptr(B)+2

   'Player Animation specific values
   '*********************************
   'Player direction (only used in sprite animations)
   RIGHT=1
   LEFT=0
   PL_DIRECTION=RIGHT

   'Player states
   STANDING=0
   WALKING=1
   JUMPING=2
   FALLING=3
   LANDING=4
   PL_STATE=STANDING

   'Jump animation acceleration values
   Dim _JUMP_ACCEL(8)
   _JUMP_ACCEL(0)=0
   _JUMP_ACCEL(1)=0
   _JUMP_ACCEL(2)=-8
   _JUMP_ACCEL(3)=-7
   _JUMP_ACCEL(4)=-6
   _JUMP_ACCEL(5)=-5
   _JUMP_ACCEL(6)=-4
   _JUMP_ACCEL(7)=-3
   _JUMP_ACCEL(8)=-1

   'Fall animation acceleration values
   Dim _FALL_ACCEL(10)
   _FALL_ACCEL(0)=1
   _FALL_ACCEL(1)=3
   _FALL_ACCEL(2)=4
   _FALL_ACCEL(3)=5
   _FALL_ACCEL(4)=6
   _FALL_ACCEL(5)=7
   _FALL_ACCEL(6)=8
   _FALL_ACCEL(7)=10
   _FALL_ACCEL(8)=12
   _FALL_ACCEL(9)=14
   _FALL_ACCEL(10)=16 : Rem Warning! Can not go more than tile height!!!

   'Sprite image bank specific values
   IMG_IDLE_STR_R=0
   IMG_IDLE_END_R=17
   IMG_IDLE_STR_L=61
   IMG_IDLE_END_L=78

   IMG_WALK_STR_R=18
   IMG_WALK_END_R=41
   IMG_WALK_STR_L=79
   IMG_WALK_END_L=102

   IMG_JUMP_STR_R=42
   IMG_JUMP_END_R=50
   IMG_JUMP_STR_L=103
   IMG_JUMP_END_L=111

   IMG_FALL_STR_R=51
   IMG_FALL_END_R=55
   IMG_FALL_RPT_R=54
   IMG_FALL_STR_L=112
   IMG_FALL_END_L=116
   IMG_FALL_RPT_L=115

   IMG_LAND_STR_R=57
   IMG_LAND_END_R=60
   IMG_LAND_STR_L=118
   IMG_LAND_END_L=121

   'Player sprite start coordinates
   SCR_CENTER=146
   PL_X=0
   PL_Y=107

   'Precalculated offsets for each foot of the player sprite image used in
   '   detecting if the player is standing on a platform.
   '   Values depend on the player image artwork.
   _LEFT_FOOT=27
   _RIGHT_FOOT=33

   'TILESET SPECIFIC values
   '***********************
   '   Tile TS_PLATFORM and ahead will be treated as platforms which player
   '   can stand on. This value is specific to the tileset. So obviously the
   '   the tileset must be ordered to have platform tiles to be contigous and
   '   in the end of the set.
   TS_PLATFORM=42
Return

'Animation Subroutines
'*********************

_DO_ANIM:
   'A dispatcher for all animation events

   'Only animate on even frames
   If _ODD_FRAME=False
      If _OLD_DIRECTION<>PL_DIRECTION
         If PL_DIRECTION=RIGHT
            'IMG_IDLE_STR_L is the first image that is facing left
            'All images before that are facing right
            Add IMG_NUM,-IMG_IDLE_STR_L
         Else
            Add IMG_NUM,IMG_IDLE_STR_L
         End If
      End If
      _OLD_DIRECTION=PL_DIRECTION

      If PL_STATE=STANDING
         Gosub _DO_IDLE
      Else If PL_STATE=WALKING
         Gosub _DO_WALK
         Gosub _CHECK_PLATFORM
      Else If PL_STATE=JUMPING
         Gosub _DO_JUMP
      Else If PL_STATE=FALLING
         Gosub _DO_FALL
         Gosub _CHECK_PLATFORM
      Else If PL_STATE=LANDING
         Gosub _DO_LAND
         Gosub _CHECK_PLATFORM
      End If
   End If

   CUSTOM_SPRITE[0,IMG_NUM,PL_X,PL_Y]
Return

_IDLE:
   If PL_STATE=WALKING
      PL_STATE=STANDING
   End If
Return

_DO_IDLE:
   If PL_DIRECTION=RIGHT
      If IMG_NUM>=IMG_IDLE_STR_R and IMG_NUM<=IMG_IDLE_END_R : Rem Already idling
         Inc IMG_NUM
         If IMG_NUM>IMG_IDLE_END_R
            IMG_NUM=IMG_IDLE_STR_R
         End If
      Else
         IMG_NUM=IMG_IDLE_STR_R
      End If
   Else
      If IMG_NUM>=IMG_IDLE_STR_L and IMG_NUM<=IMG_IDLE_END_L : Rem Already idling
         Inc IMG_NUM
         If IMG_NUM>IMG_IDLE_END_L
            IMG_NUM=IMG_IDLE_STR_L
         End If
      Else
         IMG_NUM=IMG_IDLE_STR_L
      End If
   End If
Return

_GO_RIGHT:
   PL_DIRECTION=RIGHT

   'Corner case when the player is on the left edge of the map
   If SCR_POS=0 and PL_X<SCR_CENTER
      Inc PL_X
      If PL_STATE>=JUMPING
         Return
      Else
         PL_STATE=WALKING
         Return
      End If
   End If

   'Corner case when the player is on the right edge of the map
   If SCR_POS=SCR_MAX
      Inc PL_X
      If PL_STATE>=JUMPING
      Else
         PL_STATE=WALKING
      End If
      If PL_X>288
         PL_X=288
         If PL_STATE=WALKING
            PL_STATE=STANDING
         End If
      End If
      Return
   End If

   Gosub _SCROLL_RIGHT

   If PL_STATE>=JUMPING Then Return
   PL_STATE=WALKING
Return

_GO_LEFT:
   PL_DIRECTION=LEFT

   'Corner case when the player is on the right edge of the map
   If SCR_POS=SCR_MAX and PL_X>SCR_CENTER
      Dec PL_X
      If PL_STATE>=JUMPING
         Return
      Else
         PL_STATE=WALKING
         Return
      End If
   End If

   'Corner case when the player is on the left edge of the map
   If SCR_POS=0
      Dec PL_X
      If PL_STATE>=JUMPING
      Else
         PL_STATE=WALKING
      End If
      If PL_X<0
         PL_X=0
         If PL_STATE=WALKING
            PL_STATE=STANDING
         End If
      End If
      Return
   End If

   Gosub _SCROLL_LEFT
   If PL_STATE>=JUMPING Then Return
   PL_STATE=WALKING
Return

_DO_WALK:
   If PL_DIRECTION=RIGHT
      If IMG_NUM>=IMG_WALK_STR_R and IMG_NUM<=IMG_WALK_END_R : Rem Already walking
         Inc IMG_NUM
         If IMG_NUM>IMG_WALK_END_R
            IMG_NUM=IMG_WALK_STR_R
         End If
      Else : Rem Was not walking
         IMG_NUM=IMG_WALK_STR_R
      End If
   Else
      If IMG_NUM>=IMG_WALK_STR_L and IMG_NUM<=IMG_WALK_END_L : Rem Already walking
         Inc IMG_NUM
         If IMG_NUM>IMG_WALK_END_L
            IMG_NUM=IMG_WALK_STR_L
         End If
      Else : Rem Was not walking
         IMG_NUM=IMG_WALK_STR_L
      End If
   End If
Return

_JUMP:
   If PL_STATE<JUMPING
      PL_STATE=JUMPING
      _JUMP_INDEX=0
   End If
Return

_DO_JUMP:
   If PL_DIRECTION=RIGHT
      If IMG_NUM>=IMG_JUMP_STR_R and IMG_NUM<=IMG_JUMP_END_R
         Inc IMG_NUM
         Inc _JUMP_INDEX
         If IMG_NUM=IMG_JUMP_END_R
            PL_STATE=FALLING
         End If
      Else
         IMG_NUM=IMG_JUMP_STR_R
      End If
   Else
      If IMG_NUM>=IMG_JUMP_STR_L and IMG_NUM<=IMG_JUMP_END_L
         Inc IMG_NUM
         Inc _JUMP_INDEX
         If IMG_NUM=IMG_JUMP_END_L
            PL_STATE=FALLING
         End If
      Else
         IMG_NUM=IMG_JUMP_STR_L
      End If
   End If

   Add PL_Y,_JUMP_ACCEL(_JUMP_INDEX)
Return

_DO_FALL:
   If PL_DIRECTION=RIGHT
      If IMG_NUM>=IMG_FALL_STR_R and IMG_NUM<=IMG_FALL_END_R
         Inc IMG_NUM
         Inc _FALL_INDEX
         If IMG_NUM>IMG_FALL_END_R
            IMG_NUM=IMG_FALL_RPT_R
         End If
      Else
         IMG_NUM=IMG_FALL_STR_R
         _FALL_INDEX=0
      End If
   Else
      If IMG_NUM>=IMG_FALL_STR_L and IMG_NUM<=IMG_FALL_END_L
         Inc IMG_NUM
         Inc _FALL_INDEX
         If IMG_NUM>IMG_FALL_END_L
            IMG_NUM=IMG_FALL_RPT_L
         End If
      Else
         IMG_NUM=IMG_FALL_STR_L
         _FALL_INDEX=0
      End If
   End If

   If _FALL_INDEX>10
      _FALL_INDEX=10
   End If

   Add PL_Y,_FALL_ACCEL(_FALL_INDEX)
Return

_DO_LAND:
   _FALL_INDEX=0
   If PL_DIRECTION=RIGHT
      If IMG_NUM>=IMG_LAND_STR_R and IMG_NUM<=IMG_LAND_END_R
         Inc IMG_NUM
         If IMG_NUM=IMG_LAND_END_R
            PL_STATE=STANDING
         End If
      Else
         IMG_NUM=IMG_LAND_STR_R
      End If
   Else
      If IMG_NUM>=IMG_LAND_STR_L and IMG_NUM<=IMG_LAND_END_L
         Inc IMG_NUM
         If IMG_NUM=IMG_LAND_END_L
            PL_STATE=STANDING
         End If
      Else
         IMG_NUM=IMG_LAND_STR_L
      End If
   End If
Return

_READ_MAP:
   Open In 1,"TestMap.txt"
      Input #1,MAP_X_SIZE,MAP_Y_SIZE
      MAP_MODULO=MAP_X_SIZE+2
      Dim MAP(MAP_MODULO*MAP_Y_SIZE)

      For R=0 To MAP_Y_SIZE-1
         MAP(MAP_MODULO*R)=1
         For C=1 To MAP_MODULO-2
            Input #1,MAP(C+MAP_MODULO*R)
         Next C
         MAP(MAP_MODULO*(R+1)-1)=1
      Next R
   Close 1

   SCR_MAX=MAP_X_SIZE*16-320

   'Create correspondence table
   Dim TABLE(17)
   TABLE(0)=MAP_Y_SIZE
   For I=1 To 15
      TABLE(I)=((I*MAP_Y_SIZE)/16)
   Next I
   TABLE(16)=MAP_Y_SIZE
   TABLE(17)=0
Return

_FILL_SCREEN:
   Screen 1
   For R=0 To MAP_Y_SIZE-1
      For C=0 To 24
         Paste Icon C*16,R*16,MAP(R*MAP_MODULO+C)
      Next C
   Next R
Return

_SCROLL_LEFT:
   Add SCR_POS,-SPEED
   If SCR_POS<0
      DISTANCE=SPEED-(0-SCR_POS)
      SCR_POS=0
   Else
      DISTANCE=SPEED
   End If

   SCR_MOD=SCR_POS mod 16

   'TODO: Table this??
   If SCR_MOD=0
      P2HS=0
   Else
      P2HS=16-SCR_MOD
   End If

   MRC=MAP_POS

   If OLD_SCR_MOD-DISTANCE<1
      'Fill all incoming tiles for the current fill up column
      COUNT=TABLE(OLD_SCR_MOD)
      While COUNT>0
         Dec MRR
         Add NFR_Y,-16
         Gosub _FILL_TILE
         Dec COUNT
      Wend

      'Recalculate MAP_POS, MRC
      Dec MAP_POS
      Dec MRC

      'Recalculate BPL pointers, FCR_X and FCL_X
      Add BPL2,-2
      Add BPL4,-2
      Add BPL6,-2
      If BPL2<BPL2PT
         Add BPL2,44
         Add BPL4,44
         Add BPL6,44
      End If

      Add FCL_X,-16
      If FCL_X<0
         Add FCL_X,352
      End If
      FCR_X=FCL_X+352 : Rem 352=22*16

      BPL2_UPD=True

      'Reset NFR_Y and MRR
      NFR_Y=192
      MRR=MAP_Y_SIZE
      OLD_SCR_MOD=0
   End If

   'Fill as much tiles needed for this screen position
   COUNT=TABLE(OLD_SCR_MOD)-TABLE(SCR_MOD)
   While COUNT>0
      Dec MRR
      Add NFR_Y,-16
      Gosub _FILL_TILE
      Dec COUNT
   Wend

   Gosub _SCROLL_APPLY
Return

_SCROLL_RIGHT:
   Add SCR_POS,SPEED
   If SCR_POS>SCR_MAX
      DISTANCE=SPEED-(SCR_POS-SCR_MAX)
      SCR_POS=SCR_MAX
   Else
      DISTANCE=SPEED
   End If

   SCR_MOD=SCR_POS mod 16

   'TODO: Table this??
   If SCR_MOD=0
      P2HS=0
   Else
      P2HS=16-SCR_MOD
   End If
   MRC=MAP_POS+22

   If DISTANCE+OLD_SCR_MOD>16
      'Fill all incoming tiles for current fill up column
      COUNT=MAP_Y_SIZE-TABLE(OLD_SCR_MOD)
      While COUNT>0
         Gosub _FILL_TILE
         Inc MRR
         Add NFR_Y,16
         Dec COUNT
      Wend

      'Recalculate MAP_POS, MRC
      Inc MAP_POS
      Inc MRC

      'Recalculate BPL pointers, FCR_X and FCL_X
      Add BPL2,2
      Add BPL4,2
      Add BPL6,2
      If BPL2>=BPL2PTM
         Add BPL2,-44
         Add BPL4,-44
         Add BPL6,-44
      End If

      Add FCL_X,16
      If FCL_X>=352
         Add FCL_X,-352
      End If
      FCR_X=FCL_X+352 : Rem 352=22*16

      BPL2_UPD=True

      'Reset NFR_Y and MRR
      NFR_Y=0
      MRR=0
      OLD_SCR_MOD=17
   End If

   'Fill as much tiles needed at this screen position
   COUNT=TABLE(SCR_MOD)-TABLE(OLD_SCR_MOD)
   While COUNT>0
      Gosub _FILL_TILE
      Inc MRR
      Add NFR_Y,16
      Dec COUNT
   Wend

   Gosub _SCROLL_APPLY
Return

_SCROLL_APPLY:
   'Memorize the current SCR_MOD for future scroll calculations
   'TODO: Table this?
   If SCR_MOD=0
      OLD_SCR_MOD=16
   Else
      OLD_SCR_MOD=SCR_MOD
   End If

   'Background scroll
   '*****************
   OLD_BG_POS=BG_POS+16
   BG_POS=SCR_POS/2 : Rem Scroll Plane 1 half as fast
   BG_POS=BG_POS mod 320

   'Calculate new bitmap addresses
   'TODO: Optimize using tables and use addition+margin check?
   BG_SCR_MOD=BG_POS mod 16
   If BG_SCR_MOD=0
      P1HS=0
      P1BPLO=((BG_POS/16)*2)
   Else
      P1HS=16-BG_SCR_MOD
      P1BPLO=2+((BG_POS/16)*2)
   End If

   If BPL1<>BPL1PT+P1BPLO
      BPL1_UPD=True
      BPL1=BPL1PT+P1BPLO
      BPL3=BPL3PT+P1BPLO
      BPL5=BPL5PT+P1BPLO
   End If

   BPLCON1_VAL=P1HS+(P2HS*16)
   SCRL_UPD=True
Return

_VBL_ACTIONS:
   'By waiting the beam to pass line 192 (where our display ends in this
   'implementation) instead of using Wait Vbl, we can begin to process our
   'vbl actions earlier. Value 242 is Y Hard(192)
   Repeat
   Until Peek($DFF005)>0 or Peek($DFF006)>242

   If SCRL_UPD=True
      'Set new bitmap addresses in copper list
      If BPL1_UPD=True
         Doke BPL1PTH,Deek(Varptr(BPL1))
         Doke BPL1PTL,Deek(Varptr(BPL1)+2)
         Doke BPL3PTH,Deek(Varptr(BPL3))
         Doke BPL3PTL,Deek(Varptr(BPL3)+2)
         Doke BPL5PTH,Deek(Varptr(BPL5))
         Doke BPL5PTL,Deek(Varptr(BPL5)+2)
         BPL1_UPD=False
      End If

      If BPL2_UPD=True
         Doke BPL2PTH,Deek(Varptr(BPL2))
         Doke BPL2PTL,Deek(Varptr(BPL2)+2)
         Doke BPL4PTH,Deek(Varptr(BPL4))
         Doke BPL4PTL,Deek(Varptr(BPL4)+2)
         Doke BPL6PTH,Deek(Varptr(BPL6))
         Doke BPL6PTL,Deek(Varptr(BPL6)+2)
         BPL2_UPD=False
      End If

      'Set hscroll values
      Doke BPLCON1,BPLCON1_VAL

      SCRL_UPD=False
   End If

   'Process sprite activities
   SI=_SPRITE_STROBE_PT
   SE=_SPRITE_STROBE_PT : Add SE,64
   SC=SPT0PTH
   While SI<SE
      If Leek(SI)<>0
         'get sprite address
         SA=Leek(SI)
         'Poke copper list
         Doke SC,Deek(SI) : Add SC,4 : Add SI,2
         Doke SC,Deek(SI) : Add SI,-2
         'reset strobe
         Loke SI,0
         'set sprite's control words
         Add SI,4
         Loke SA,Leek(SI)
         'step to the next hardware sprite
         Add SI,4
         Add SC,4
      Else
         Add SI,8
         Add SC,8
      End If
   Wend

   If _FADE>0
      Dec _FADE
      Gosub _FADE_IN
   Else If _FADE<0
      Inc _FADE
      Gosub _FADE_OUT
   End If

   'To call a WaitTOF() just call a Wait Vbl ;)
   Wait Vbl
Return

_FILL_TILE:
   'We need MRR, MRC, NFR_Y, FCL_X and FCR_X set before coming here
   Paste Icon FCL_X,NFR_Y,MAP(MRR*MAP_MODULO+MRC)
   Paste Icon FCR_X,NFR_Y,MAP(MRR*MAP_MODULO+MRC)
Return

_CHECK_PLATFORM:
   _MYP=(PL_Y+37+_FALL_ACCEL(_FALL_INDEX))/16
   If _MYP<0 or _MYP>11 Then Return
   TILE1=MAP(((SCR_POS+PL_X+_LEFT_FOOT)/16)+_MYP*MAP_MODULO)
   TILE2=MAP(((SCR_POS+PL_X+_RIGHT_FOOT)/16)+_MYP*MAP_MODULO)

   If TILE1>TS_PLATFORM or TILE2>TS_PLATFORM
      If PL_STATE=FALLING
         PL_STATE=LANDING
         PL_Y=(_MYP*16)-37
      End If
   Else
      PL_STATE=FALLING
   End If
Return

_FADE_IN:
   WA=CL_COLORS_PT
   RA=_FADE_TABLE_PT

   If _FADE=0
      Gosub _SET_PALETTE_TO_COLOR_TABLE
   Else
      While Leek(WA)<>$FFFFFFFE
         I=Deek(WA) : Add WA,2
         If I>=$180 and I<=$1BE
            'Get the current state of the split R,G,B values of this color
            Add RA,2 : R=Deek(RA)
            Add RA,4 : G=Deek(RA)
            Add RA,4 : B=Deek(RA) : Add RA,-10

            'Add the precalculated incremental
            Add R,Deek(RA) : Add RA,4
            Add G,Deek(RA) : Add RA,4
            Add B,Deek(RA) : Add RA,-6

            'Store the current state
            Doke RA,R : Add RA,4
            Doke RA,G : Add RA,4
            Doke RA,B : Add RA,2

            'Pack the split R,B,G values into a color value
            W=0
            Poke W3,Peek(B3) : Ror.l 4,W
            Poke W3,Peek(G3) : Ror.l 4,W
            Poke W3,Peek(R3)

            'Update the color value on the copper list
            Doke WA,W
         End If
         Add WA,2
      Wend
   End If
Return

_FADE_OUT:
   WA=CL_COLORS_PT
   RA=_FADE_TABLE_PT

   If _FADE=0
      Gosub _SET_PALETTE_TO_BLACK
   Else
      While Leek(WA)<>$FFFFFFFE
         I=Deek(WA) : Add WA,2
         If I>=$180 and I<=$1BE
            Add RA,2 : R=Deek(RA)
            Add RA,4 : G=Deek(RA)
            Add RA,4 : B=Deek(RA) : Add RA,-10
            Add R,-Deek(RA) : Add RA,4
            Add G,-Deek(RA) : Add RA,4
            Add B,-Deek(RA) : Add RA,-6
            Doke RA,R : Add RA,4
            Doke RA,G : Add RA,4
            Doke RA,B : Add RA,2

            W=0
            Poke W3,Peek(B3) : Ror.l 4,W
            Poke W3,Peek(G3) : Ror.l 4,W
            Poke W3,Peek(R3)
            Doke WA,W
         End If
         Add WA,2
      Wend
   End If
Return

_SET_PALETTE_TO_COLOR_TABLE:
   WA=CL_COLORS_PT
   RA=_COLOR_TABLE_PT
   While Leek(WA)<>$FFFFFFFE
      I=Deek(WA) : Add WA,2
      If I>=$180 and I<=$1BE
         Doke WA,Deek(RA)
         Add RA,2
      End If
      Add WA,2
   Wend
Return

_SET_PALETTE_TO_BLACK:
   WA=CL_COLORS_PT
   While Leek(WA)<>$FFFFFFFE
      I=Deek(WA) : Add WA,2
      If I>=$180 and I<=$1BE
         Doke WA,$0
      End If
      Add WA,2
   Wend
   Goto QUIT
Return

'**********
'Procedures
'**********

Procedure PREP_SCREEN_BITMAPS
   Auto View Off
   'DualPlayfield: 0)Distant background / 1)TileMapped Background
   Screen Open 0,656,200,8,Lowres : Screen Hide 0 : Curs Off : Flash Off : Cls 0
   Screen Open 1,704,200,8,Lowres : Screen Hide 1 : Curs Off : Flash Off : Cls 0

   'Distant background image
   Load Iff "Background.iff",2 : Screen Hide 2
   Screen Copy 2,0,0,320,200 To 0,16,0
   Screen Copy 2,0,0,320,200 To 0,336,0
   Screen Close 2
   Screen 0
End Proc
Procedure CUSTOM_COPPER_LIST
   Shared CL_PT,CL_COLORS_PT
   Shared BPL1PT,BPL2PT,BPL3PT,BPL4PT,BPL5PT,BPL6PT
   Shared BPL1,BPL2,BPL3,BPL4,BPL5,BPL6
   Shared BPL1PTM,BPL2PTM
   Shared BPL1PTH,BPL1PTL,BPL2PTH,BPL2PTL,BPL3PTH,BPL3PTL
   Shared BPL4PTH,BPL4PTL,BPL5PTH,BPL5PTL,BPL6PTH,BPL6PTL
   Shared BPLCON0,BPLCON1,BPLCON2,BPLCON3
   Shared SPT0PTH,SPT0PTL,SPT1PTH,SPT1PTL,SPT2PTH,SPT2PTL,SPT3PTH,SPT3PTL
   Shared SPT4PTH,SPT4PTL,SPT5PTH,SPT5PTL,SPT6PTH,SPT6PTL,SPT7PTH,SPT7PTL

   'Dummy Sprite Address
   DSA=Start(5)
      DSA_H=Deek(Varptr(DSA))
      DSA_L=Deek(Varptr(DSA)+2)

   'Address of our new copper list
   CL_PT=Cop Logic

   'Get bitplane addresses
   Screen 0
   BPL1PT=Phybase(0)
   BPL3PT=Phybase(1)
   BPL5PT=Phybase(2)
   Screen 1
   BPL2PT=Phybase(0)
   BPL4PT=Phybase(1)
   BPL6PT=Phybase(2)
   Screen 0

   BPL1=BPL1PT
   BPL2=BPL2PT
   BPL3=BPL3PT
   BPL4=BPL4PT
   BPL5=BPL5PT
   BPL6=BPL6PT

   BPL1PTM=BPL1PT+40
   BPL2PTM=BPL2PT+44

   'Prepare copper list poke addresses
   '  You have to count copper instructions by hand and calculate as
   '  byte offsets to CL_PT  :(
   SPT0PTH=CL_PT+2 : SPT0PTL=SPT0PTH+4
   SPT1PTH=SPT0PTH+8 : SPT1PTL=SPT1PTH+4
   SPT2PTH=SPT1PTH+8 : SPT2PTL=SPT2PTH+4
   SPT3PTH=SPT2PTH+8 : SPT3PTL=SPT3PTH+4
   SPT4PTH=SPT3PTH+8 : SPT4PTL=SPT4PTH+4
   SPT5PTH=SPT4PTH+8 : SPT5PTL=SPT5PTH+4
   SPT6PTH=SPT5PTH+8 : SPT6PTL=SPT6PTH+4
   SPT7PTH=SPT6PTH+8 : SPT7PTL=SPT7PTH+4

   BPL1PTH=CL_PT+(18*4)+2
   BPL1PTL=BPL1PTH+4
   BPL2PTH=BPL1PTH+8
   BPL2PTL=BPL2PTH+4
   BPL3PTH=BPL2PTH+8
   BPL3PTL=BPL3PTH+4

   BPL4PTH=BPL3PTH+8
   BPL4PTL=BPL4PTH+4
   BPL5PTH=BPL4PTH+8
   BPL5PTL=BPL5PTH+4
   BPL6PTH=BPL5PTH+8
   BPL6PTL=BPL6PTH+4

   BPLCON0=CL_PT+(36*4)+2
   BPLCON1=BPLCON0+4
   BPLCON2=BPLCON1+4
   BPLCON3=BPLCON2+4

   CL_COLORS_PT=CL_PT+(40*4)

   'Copper List Instructions
   '************************

   'Sprite stuff here
   Cop Move $120,DSA_H
   Cop Move $122,DSA_L
   Cop Move $124,DSA_H
   Cop Move $126,DSA_L
   Cop Move $128,DSA_H
   Cop Move $12A,DSA_L
   Cop Move $12C,DSA_H
   Cop Move $12E,DSA_L
   Cop Move $130,DSA_H
   Cop Move $132,DSA_L
   Cop Move $134,DSA_H
   Cop Move $136,DSA_L
   Cop Move $138,DSA_H
   Cop Move $13A,DSA_L
   Cop Move $13C,DSA_H
   Cop Move $13E,DSA_L

   Cop Wait 2,31
   'DMACON unset BPENA
   Cop Move $96,%100000000

   'Bitplane pointers
   Cop Movel $E0,BPL1PT
   Cop Movel $E4,BPL2PT
   Cop Movel $E8,BPL3PT
   Cop Movel $EC,BPL4PT
   Cop Movel $F0,BPL5PT
   Cop Movel $F4,BPL6PT

   'Dwstart/stop
   Cop Move $8E,$181
   Cop Move $90,$37C1

   'DDFSTART/STOP
   Cop Move $92,$30 : Rem "Wide" Data Fetch (starts 16px early)
   Cop Move $94,$D0 : Rem ...this also makes us lose sprite 8 :(

   'BitPlane Modulos:
   '  These values should be calculated very carefully.
   '  Screen Bitmap horizontal size is 656. Normal DataFetch would read 320px
   '  of it at every scanline.
   '  However we are starting 16px early. This means it will read 336px.
   '  Remaining pixels of the bitmap should be skipped (when horizontal
   '  blanking comes) to get to the beginning of the next line: 656-336=320px
   '  How many bytes is 320px : 320/8=40. 40 in Hex is $28.
   '  So the modulo for playfield 1 is $28.
   Cop Move $108,$28
   Cop Move $10A,$2E

   'Set BPLCON
   Cop Move $100,%110011000000001
   Cop Move $102,$0
   Cop Move $104,%1001100100
   Cop Move $106,%110000100000 : Rem eab.abime.net/showthread.php?t=71661

   'Color Palette
   '  All are initialized to $0 to welcome with a blank black screen to
   '  be faded into their values set in _COLOR_TABLE() later
   Cop Move $180,$0 : Rem $58d
   Cop Move $182,$0 : Rem $7ad
   Cop Move $184,$0 : Rem $ace
   Cop Move $186,$0 : Rem $386
   Cop Move $188,$0 : Rem $def
   Cop Move $18A,$0 : Rem $255
   Cop Move $18C,$0 : Rem $7BA
   Cop Move $18E,$0 : Rem $5A7

   Cop Move $190,$0 : Rem $0
   Cop Move $192,$0 : Rem $446
   Cop Move $194,$0 : Rem $CE4
   Cop Move $196,$0 : Rem $212
   Cop Move $198,$0 : Rem $532
   Cop Move $19A,$0 : Rem $963
   Cop Move $19C,$0 : Rem $184
   Cop Move $19E,$0 : Rem $6C1

   'Sprite palette
   Cop Move $1A0,$0 : Rem $0
   Cop Move $1A2,$0 : Rem $111
   Cop Move $1A4,$0 : Rem $AAA
   Cop Move $1A6,$0 : Rem $822
   Cop Move $1A8,$0 : Rem $201
   Cop Move $1AA,$0 : Rem $221
   Cop Move $1AC,$0 : Rem $401
   Cop Move $1AE,$0 : Rem $534
   Cop Move $1B0,$0 : Rem $644
   Cop Move $1B2,$0 : Rem $554
   Cop Move $1B4,$0 : Rem $655
   Cop Move $1B6,$0 : Rem $755
   Cop Move $1B8,$0 : Rem $A54
   Cop Move $1BA,$0 : Rem $A64
   Cop Move $1BC,$0 : Rem $988
   Cop Move $1BE,$0 : Rem $A99

   'Enable All DMA (except disk) in DMACON
   Cop Wait 2,50
   Cop Move $96,%1000000111100000

   'Color changes (aka Rainbows):
   '  Implement your rainbows below as pairs of Wait and Move instructions
   '  example:
   '     Cop Wait 0,Y Hard(10)
   '     Cop Move $180,$69E
   '
   '  With the code above, color0 ($180) will be whatever value it was set in
   '  the Color Palette section above. After raster line 10 it will change to
   '  $69E. You can create vertical color gradients (Rainbows) by stacking
   '  these pairs. You can create simultaneous rainbows for different colors
   '  as many as Copper DMA can handle. This is not possible with the builtin
   '  Rainbow command.

   Cop Wait 0,Y Hard(192) : Rem Bottom of screen
   Cop Move $180,$0 : Rem Make bottom of the display black

   'Disable BPENA in DMACON
   Cop Move $96,$100
   Cop Wait 255,254

   'Install this copper list
   Cop Swap
End Proc
Procedure CUSTOM_SPRITE_LOAD[FILE$]
   Shared CUSTOM_SPRITE_TABLE_PT
   Shared CUSTOM_SPRITES_PT
   Shared CUSTOM_SPRITES

   'Reserve 4 NULL bytes at start for the dummy (null) sprite
   Open In 1,FILE$
      Reserve As Chip Data 5,Lof(1)+4
   Close 1

   Loke Start(5),$0
   Bload FILE$,Start(5)+4

   CUSTOM_SPRITES=Deek(Start(5)+4)
   CUSTOM_SPRITE_TABLE_PT=Start(5)+6
   CUSTOM_SPRITES_PT=CUSTOM_SPRITE_TABLE_PT+(CUSTOM_SPRITES*4)+2
End Proc
Procedure CUSTOM_SPRITE[HSN,IMG,X,Y]
'  This is the custom sprite engine implementation.
'  All infromation on the sprites to display are looked up from a table
'  in the bank, and calculated automatically.

'  Input values:
'  HSN : is hardware sprite number
'  IMG : is image number (from custom the sprite bank)
'  X   : is x screen coordinate for the sprite
'  Y   : is y screen coordinate for the sprite

   Shared CUSTOM_SPRITE_TABLE_PT,CUSTOM_SPRITES_PT,_SPRITE_STROBE_PT

   'We will iterate a pointer to do as less as possible multiplications
   PT=CUSTOM_SPRITE_TABLE_PT+(IMG*4)

   'Get requested image parameters from the table
   OFFSET=Deek(PT) : Add PT,2
   TYPE=Peek(PT) : Inc PT
   VOFFS=Peek(PT) : Inc PT
   OFFSET_NEXT=Deek(PT)

   'How many sprites used (attached and/or glued) for this image
   NUM_SPRITES=TYPE : Bclr 4,NUM_SPRITES

   'Production state code - Remove before release
   '*********************************************
   Shared CUSTOM_SPRITES
   If IMG>=CUSTOM_SPRITES or NUM_SPRITES+HSN>8
      Error 149
   End If
   '*********************************************

   'Calculate sprite height (TODO: maybe optimized using Add and Ror.l)
   SSIZE=(OFFSET_NEXT-OFFSET)/NUM_SPRITES
   HEIGHT=(SSIZE/4)-2

   'Get Sprite's address
   SADDR=CUSTOM_SPRITES_PT+OFFSET

   'Get hang address (where to hang the sprite on the strobe array)
   HADDR=_SPRITE_STROBE_PT+(HSN*8)

   'Screen/Hardware coords conversion
   Add X,128
   Add Y,50
   Add Y,VOFFS
   S=Y+HEIGHT

   'Two different algorithms for attached/not attached sprite images
   If Btst(4,TYPE)
      CONTROL=%10000000 : Rem Attachment bit

      'VSTART_L
      Poke Varptr(CONTROL),Peek(Varptr(Y)+3)

      'VSTOP_L
      Poke Varptr(CONTROL)+2,Peek(Varptr(S)+3)

      'CTRL byte
      Add CONTROL,X mod 2 : Rem HSTART_L bit
      Add CONTROL,Peek(Varptr(S)+2)*2 : Rem VSTOP_H bit
      Add CONTROL,Peek(Varptr(Y)+2)*4 : Rem VSTART_H bit

      While NUM_SPRITES>0
         'HSTART_H
         Poke Varptr(CONTROL)+1,X/2 : Rem TODO: divide outside

         'Hang this sprite to the custom strobe register
         Loke HADDR,SADDR

         'Hang the control words as well
         Add HADDR,4
         Loke HADDR,CONTROL

         'Get to the attached sprite
         Add SADDR,SSIZE

         'Hang it to the corresponding strobe register
         Add HADDR,4
         Loke HADDR,SADDR

         'hang the same control words for this sprite as well
         Add HADDR,4
         Loke HADDR,CONTROL

         'Get to the next glued sprite (if there's any)
         Add SADDR,SSIZE
         Add HADDR,4
         Add X,16 : Rem TODO: if divided outside Add 8
         Add NUM_SPRITES,-2
      Wend
   Else
      CONTROL=%0

      'VSTART_L
      Poke Varptr(CONTROL),Peek(Varptr(Y)+3)

      'VSTOP_L
      Poke Varptr(CONTROL)+2,Peek(Varptr(S)+3)

      'CTRL byte
      Add CONTROL,X mod 2 : Rem HSTART_L bit
      Add CONTROL,Peek(Varptr(S)+2)*2 : Rem VSTOP_H bit
      Add CONTROL,Peek(Varptr(Y)+2)*4 : Rem VSTART_H bit

      While NUM_SPRITES>0
         'HSTART_H
         Poke Varptr(CONTROL)+1,X/2 : Rem TODO: divide outside

         'Hang this sprite to the custom strobe register
         Loke HADDR,SADDR

         'Hang the control words as well
         Add HADDR,4
         Loke HADDR,CONTROL

         Add SADDR,SSIZE
         Add HADDR,4
         Add X,16 : Rem TODO: if divided outside Add 8
         Dec NUM_SPRITES
      Wend
   End If
End Proc
Procedure CUSTOM_SPRITE_OFF[HSN,NUM]
'  Removes NUM sprites from display starting from HSN

'  HSN : is hardware sprite number
'  IMG : is how many sprites to turn off starting from HSN

   Shared CUSTOM_SPRITE_TABLE_PT,CUSTOM_SPRITES_PT,_SPRITE_STROBE_PT

   'Production state code - Remove before release
   '*********************************************
   Shared CUSTOM_SPRITES
   If NUM+HSN>8
      Error 149
   End If
   '*********************************************

   'Get hang address (where to hang the sprite on the strobe array)
   HADDR=_SPRITE_STROBE_PT+(HSN*8)

   While NUM>0
      'Hang dummy (null) sprite to the custom strobe register
      Loke HADDR,Start(5)

      'Clear the control words from previous sprite
      Add HADDR,4
      Loke HADDR,$0

      Add HADDR,4
      Dec NUM
   Wend
End Proc
Procedure INIT_FADE
'  Fills the _FADE_TABLE with precalculated incremental values according to
'  the value of _FADE_STEPS.

   Shared _FADE_STEPS,_FADE_TABLE_PT,_COLOR_TABLE_PT,_COLOR_INSTRUCTIONS

   RA=_COLOR_TABLE_PT
   EA=_COLOR_TABLE_PT+(_COLOR_INSTRUCTIONS*2)
   WA=_FADE_TABLE_PT

   Inc _FADE_STEPS
   BETTER_PRECISION=(_FADE_STEPS/64)
   Add _FADE_STEPS,-BETTER_PRECISION

   While RA<EA
      W=Deek(RA) : Add RA,2
      R=W : Poke Varptr(R)+3,0 : Add W,-R : Rol.l 4,W : Add R,$100
      G=W : Poke Varptr(G)+3,0 : Add W,-G : Rol.l 4,W : Add G,$100
      B=W : Add B,$100
      Doke WA,R/_FADE_STEPS : Add WA,4
      Doke WA,G/_FADE_STEPS : Add WA,4
      Doke WA,B/_FADE_STEPS : Add WA,4
   Wend

   Add _FADE_STEPS,BETTER_PRECISION
   Dec _FADE_STEPS
End Proc
Procedure CHANGE_FADE_STEPS[NEW_VALUE]
   Shared _FADE_STEPS,IN,OUT

   _FADE_STEPS=NEW_VALUE
   IN=NEW_VALUE
   OUT=-NEW_VALUE
   INIT_FADE
End Proc

'*******************************
'--Production state procedures--
'  remove below before release
'*******************************

Procedure DUMP_COPPER_COLORS[FILE$]
'  This is a helper procedure. Do a call to this procedure after the creation
'  of the copper list to dump the color values of every color instruction in
'  it out to an ascii file. Just merge the created ascii file into your code
'  and replace it with the color table set in _INIT_VARIABLES subroutine.
'  This procedure is Production state code.
'  Don't forget to remove before release.

   Shared CL_COLORS_PT

   Open Out 1,FILE$

   L=0
   RA=CL_COLORS_PT
   Do
      Gosub _NEXT

      CV=Deek(RA) : Add RA,2
      Rol.l 16,CV

      HALF_DONE=True
      Gosub _NEXT
      HALF_DONE=False

      Add CV,Deek(RA) : Add RA,2

      Print #1,"_COLOR_TABLE("+Right$(Str$(L),Len(Str$(L))-1)+")="+Hex$(CV)
      CV=0
      Inc L
   Loop

   _NEXT:
      While Leek(RA)<>$FFFFFFFE
         I=Deek(RA) : Add RA,2
         If I>=$180 and I<=$1BE
            Return
         End If
         Add RA,2
      Wend
      If HALF_DONE=True
         Print #1,"_COLOR_TABLE("+Right$(Str$(L),Len(Str$(L))-1)+")="+Hex$(CV)
      End If
      Goto _END
   Return

   _END:
   Close 1
   Copper On
   End
End Proc