ABBUC e.V. Forum

Code: Alles auswählen

' TETRIS - for BASIC 10Liner Contest 2024
' ====================================
' 
' Author  : Eric Carr
' Language: FastBasic 4.6
' Platform: Atari 8-bit (800 48K or XE/XL)
' Category: EXTREM-256
'
' Un-minified source code with comments
' h/i/j/k vars are for local/temp use
' All _vars are renamed when minified
' 
' Tools Used
' ==========
' - FastBasic 4.6 Cross Compiler - Compile BASIC to XEX
'   https://github.com/dmsc/fastbasic/releases/tag/v.6

' - Visual Studio Code - Editing the .BAS file
'   https://code.visualstudio.com/download

' - FastBasic Debugger for VSCode Extension (I wrote it to help debug FastBasic)
'   https://marketplace.visualstudio.com/items?itemName=EricCarr.fastbasic-debugger

' - Atari FontMaker - Defining chars as block sprites
'   http://matosimi.websupport.sk/atari/atari-fontmaker/

' - Atari800MacX and Altirra


' The DATA statements below are compacted into a string in _data()

' (7 bytes) Which char to use to draw each of the 7 tetrominos.
'DATA _data() byte = $82,$81,$01,$02,$82,$01,$81, 

' (8 bytes) Random number generator array to pick the next piece - similar to the Grand Master Tetris.
' rnd() was not random enough and created draught, repeated the same piece, etc, so I found a good
' reference on Tetris RNGs (below) and created hybrid logic that was small and made the game more fun.
' https://simon.lc/the-history-of-tetris-randomizers

'DATA byte = 1,2,3,7,5,6,4,0,

' (7 bytes) Start of rotations offset for each Tetromino
'DATA byte = 19,23,31,39,47,63,79,

' (76 bytes) Now the 4 square rotation offsets for each tetromino. These are offsets from the cursor position for poking to the screen
'DATA byte = 63,64,95,96,                                         ' O
'DATA byte = 63,64,96,97, 33,64,65,96,                            ' Z
'DATA byte = 64,65,95,96, 32,64,65,97,                            ' S
'DATA byte = 62,63,64,65,  0,32,64,96,                            ' I
'DATA byte = 63,64,65,96, 32,64,65,96, 32,63,64,65, 32,63,64,96,  ' T
'DATA byte = 63,64,65,97, 32,33,64,96, 31,63,64,65, 32,64,95,96,  ' J
'DATA byte = 63,64,65,95, 32,64,96,97, 33,63,64,65, 31,32,64,96,  ' L

' (11 bytes) Level based tetromino colors: Blue/Green/Gold/Purple/Pink/Teal/Light Green/Yellow/Red/Light Gray/Dark Gray
' Each level will select two adjacent colors. Lev0=Blue/Green, Lev2=Green/Gold, and so on.

'data byte = $76,$A6,$18,$66,$48,$96,$B8,$eA,$24,$08,$04

' (4 bytes) Score table for clearing N rows ( 40,100,300,1200 ). 
' The values are stored divided by 20 to save a space and then multiplied by 20 in code.

'data byte = 2,5,15,60

' (24 bytes) Music Patterns forming the background song
'data byte =  $00,$01,$02,$01, $00,$01,$02,$01, $03,$04,$03,$05, $00,$01,$02,$01,  $00,$01,$02,$01, $06,$03,$06,$05
         

' (Design Notes) Type of screen characters. Used to optimize how I checked what type of character
' on the screen, when checking if a piece can be drawn in a new location, if it is within the playfield, etc.

' Available chars for tetromino blocks
' A. Empty playfield     "."
' B. UI Above playfield  "-[="
' C. Active block        "@"
' S. Empty "Next" space  " "

' Unavailable chars for tetromino blocks
' D. Locked block        "#"
' E. Left/Right edge     "|"
' F. UI below playfield  "_"
' G. Box corners         "()"

'0123456789ABCDEF0     <- Char values
' @@.- [=##._()()0

' "##._" @ $08 is copied to $01 as "@@.-". 

' Chars 0-7 (lacking bit 8) represent empty spots to move/rotate to   

' Music Note Data (Grouped into LEAD/BASS patterns.) 
da._music()b.=""$2f$00$40$3c$35$00$3c$40$48$00$48$3c$2f$00$35$3c$40$00$00$3c$35$00$2f$00$3c$00$48$00$48$00$00$00$00$35$00$2d$23$00$28$2d$2f$00$00$3c$2f$00$35$3c$2f$2f$00$00$3c$3c$00$00$35$35$00$00$40$40$00$00$3c$3c$00$00$48$48$00$00$4c$4c$4c$40$00$00$00$00$48$00$2f$00$23$23$00$00$25$25$25$00$00$00$00$00$48$00$00$3c$3c$00$00$00$40$40$00$35$00$00$00$00$c1$61$c1$61$c1$61$c1$61$90$61$90$61$90$61$90$61$99$4c$99$4c$c1$61$c1$61$90$61$90$61$90$00$90$61$d9$6c$00$90$6c$d9$6c$00$f3$79$f3$79$f3$a2$f3$a2$90$00$90$48$90$00$90$48$99$00$99$00$99$00$99$4c$90$00$90$48$90$00$90$00$c1$00$c1$60$c1$00$c1$60$90$00$90$48$90$00$90$48$c1$00$c1$00$c1$b6$ad$a2$90$90$00$90$90$00$90$48$a2$00$a2$51$99$00$99$c1
                
' Set index for pokey sound
_sound=$D206

' Set graphics mode to 5 color text mode, 40x24 (it will be changed to 32x24 narrow mode below for space and speed considerations)
graphics 28 

' Pointer to screen memory
_scr=$7000

' Data compacted from DATA statements above
da._data()b.=""$82$81$01$02$82$01$81$01$02$03$07$05$06$04$00$13$17$1F$27$2F$3F$4F$3F$40$5F$60$3F$40$60$61$21$40$41$60$40$41$5F$60$20$40$41$61$3E$3F$40$41$00$20$40$60$3F$40$41$60$20$40$41$60$20$3F$40$41$20$3F$40$60$3F$40$41$61$20$21$40$60$1F$3F$40$41$20$40$5F$60$3F$40$41$5F$20$40$60$61$21$3F$40$41$1F$20$40$60$76$A6$18$66$48$96$B8$EA$24$08$04$02$05$0F$3C$00$01$02$01$00$01$02$01$03$04$03$05$00$01$02$01$00$01$02$01$06$03$06$05
               
' Dim some variables that will be reset to 0 at the start of each game using a MSET
dim _topScore%,_level,_score%,_lines,_noteBeat,_musicI,_clearedRow(4)

' Point Display List to our custom screen memory
dpoke dpeek 560 +4,_scr

' Proc - Initialize graphics and draw screen
PR.G

' Hide screen for faster drawing/computing
poke 559,0

' Draw gray tiled background
F.I=0t.384:D._SCR+I*2,$706:n.

' Set drop counter to appropriate value based on starting level. This controls how fast the pieces fall.
_dropCounterStart=30-_level*2

' Setup vars to draw bordered boxes (_brush=fill char, k= width)
_brush=0:k=9

' Draw Top Score box
@O 51,7

' Draw Next box
@O 531,7

' Draw Level box
@O 275,4

' Draw Lines box
@O 403,4

' Store custom charset location temporarily in K (saves code size)
k=$4808

' Copy base character set from ROM to modify
M.$E008,k,1016

' Make alpha numeric characters a single color for this multi-color mode by removing every even bit (85 = binary 01010101)
' This is so space doesn't have to be taken up with a complete custom set of letters and numbers.
' I did fix a few letters (next line) that were left less legible.
FOR I=k to k+503:POKE i,PEEK i&85:NEXT


' Print Labels TOP, SCORE, LEVEL, LINES, NEXT; POKE 87,0 (remove need for #6 when printing) & DPoke 88,$6FFD to set screen location for ?; Poke playfield color 708,$0E(white), 709,$04 (gray); load 11 custom chars; custom char R fix; POKE 756,72 set charset; Fix "X"; Fix "S"; POKE 559, 33 (narrow playfield); 
' Poking the screen to 88 so I can ? instead of ?#6, also shifting three bytes to the left, otherwise the hi-score location would wrap a line and cause issues. 
@C 1+&""$03$55$70$34$10$30$05$B5$70$33$23$10$32$25$05$35$71$2C$25$36$25$2C$05$B5$71$2C$29$2E$25$33$04$36$72$2E$25$38$34$03$57$00$00$FD$6F$02$C4$02$0E$04$58$30$48$AA$AA$AA$A8$A8$A8$A8$00$A8$A8$A8$00$AA$AA$AA$00$5C$7C$FC$FC$FC$FC$00$00$54$54$74$74$54$54$00$00$22$00$88$00$22$00$88$00$00$AA$55$55$AA$AA$00$00$A0$82$05$15$16$1A$18$18$0A$02$60$50$58$98$18$18$18$16$15$25$2A$0A$80$A0$18$58$58$68$A0$82$0A$00$00$10$44$44$44$44$10$00$01$94$49$50$01$F4$02$48$02$C3$49$10$10$01$2F$02$21$05$9A$49$40$50$14$04$50$00

' Copy some chars to a different location. Used for less code to check valid spaces
' when moving/rotating the current tetromino
m.k+56,k,32

' First piece will not be S,Z
_nextPiece=rand 4 +4 



' Finally, change fill/width/height and draw main tetris box
k=11:_brush=3:@O 35,22

' Display top score
POS.0,3
?_topScore%

' Start music at the first pattern
_pattern=1

' Display score/level/lines values on screen
@V
ENDP.


' Proc - Generate next tetromino piece
PR.N
  ' General reset of falling piece
  _rotIndex=1
  _dropCounter=_dropCounterStart

  ' Clear old "next" piece from screen
  _tetIndex=_nextPiece
  _tetPos = $7238:_brush=0
  @W:@D
  
  ' Play sound
  @s 255,5
      
  ' Determine and draw new "next" piece, ensuring a roughly even distribution
  ' by keeping a queue of all 7, and only choosing a piece that has not been chosen the past 4 times.
  i=&_data+8+r.3
  _tetIndex=peek i
  move i+1,i,6
  _data(14)=_tetIndex

  ' Play a frame of music, then draw piece under "NEXT"
  _dirBak=_tetIndex
  _brush=_data(_tetIndex)
  @W:@D 
  
  ' Prep and draw current piece in playfield
  _tetIndex=_nextPiece
  _brush=_data(_tetIndex)
  _tetPos=_scr+9
  @D

  ' Assign next piece, reset drop related vars
  _nextPiece=_dirBak
  _canDrop=0
  _dropScore=0

ENDP.


' Proc - Draw box at screen offset J with height H by width K, using _brush as the fill. (K and _brush are set prior to calling)
PR.O j h

  ' Add screen memory to offset
  j=j+_scr

  ' I draw the box line by line. For each line, I'll draw a Left char, Fill chars, then a Right char.
  ' LFFFFFFFFFR
  ' LFFFFFFFFFR
  ' LFFFFFFFFFR
  ' LFFFFFFFFFR

  ' To avoid creating extra variables to store "L", "F", and "R" for this proc,
  ' I use _rotBak for F and _dirBack to hold L and R values (2 8 bit values in a 16 bit number)
  ' These variables are reset during game play so I'm free to use them here during game setup.
  
  ' Top line. Set Fill to the horizontal border char and Left/Right to corner chars 
   _rotBak=4:_dirBak=$D0C

  FOR i=1 to h
    
    ' If at the last (Bottom) line, set Fill to the horizontal border char and Left/Right to corner chars 
    iF i=h 
      _rotBak=11:_dirBak=$F0E
    ENDIF

    ' Draw the Fill char
    mset j,k,_rotBak

    ' Draw the Left char
    poke j,_dirBak

    ' Draw the Right char
    poke j+k,_dirBak/256

    ' Increment screen pointer to next row
    j=j+32

    ' Middle lines - set Fill to _brush, and Left/Right to vertical border lines
    ' I set this last so it ends up applying to all but the first and last lines
    ' without needing extra code for IF/THEN
    _rotBak=_brush
    _dirBak=$7C7C
  NEXT
ENDP.

' Proc - SOUND 0,X,10,X shortcut
PR.S I J
  S.0,I,10,J
endp.

' Proc - Compute I (space saving helper method for @D and @L)
PR.I
  i=_data(_tetIndex+15)+_rotIndex*4
ENDP.

' Proc - Draw tetromino
PR.D
  @I
  _oldCalcPos=i
  FOR i=i to i+3
    h=_tetPos+_data(i)
    if h>$7043 then poke h,_brush
  NEXT
ENDP.

' Proc - Update screen with values
PR.V
  ' Set theme color
  dpoke 710,dpeek(&_data+99+_level mod 10)

  ' Print the level, adding a space afterward, in case the player is choosing
  ' a level to play on a new game, and the previous game had achieved a 2 digit level
  POS.24,8:?_level;" ";

  ' Update the score and lines if in-game (_brush will have a value)
  if _brush
    ' Update score and lines counter
    POS.16,5:?_score%
    POS.32,11:?_lines
  endif
ENDP.

' Draw background UI 
@G

' Proc - Wait (pause) and play a bit of music. I call this throughout the game to wait for vertical blank and to keep music playing at a mostly consistent speed
pr.W
 
 ' Play music every other frame
  _playMusic=not _playMusic
  if _playMusic

    if _noteBeat 
      ' This executes between the notes
      dec _noteBeat

      ' Fade base note volume
      poke _sound-1,$a1+_noteBeat
    else
      ' Play new note
      inc _musicI
      
      ' Play the bass note (dpoke to set both the note byte and the volume byte)
      dpoke _sound-2,_music(_musicI+112)+$A200

      ' Play the lead note, or decrease volume if 0 (fade away)
      IF _music(_musicI):poke _sound,_music(_musicI):_vol=3: elif _vol: dec _vol: endif
      poke _sound+1,$a0+_vol
    
      
      if not _musicI&15
        _pattern = _pattern mod 24 + 1
        _musicI = _data(_pattern+113)*16
      endif ' Pattern mode

      ' There are 4 beats between each note
      _noteBeat=4
    endif
  endif

  ' Pause the frame
  pause
endp.

' ===== Outer loop - starts a new game
do

' Prompt Title and wait for key press to continue

' Draw title box
_brush=0:k=13:@O 226,10

' Print labels:TETRIS,PICK LEVEL,PRESS FIRE; POKE 709,4 to reset background color
'@C 1+&""$08$25$71$01$34$25$34$32$29$33$81$0A$84$71$30$29$23$2B$00$2C$25$36$25$2C$0A$C4$71$30$32$25$33$33$00$26$29$32$25$01$C5$02$04$00
@C 1+&""$06$26$71$34$25$34$32$29$33$0A$84$71$30$29$23$2B$00$2C$25$36$25$2C$0A$C4$71$30$32$25$33$33$00$26$29$32$25$01$C5$02$04$00

' Wait a bit before allowing input
pause 30

' Update high score if the new score is the best
if _score%>_topScore%then _topScore% =_score%


' Proc - Starting at memory address h, loop through multiple entries of [length][dest address][data...] 
' and copies data to destination address. Loops until it reads a [length] of 0, signifying end of entries.
' This allows me to copy text to the screen, set data in memory, etc. in less code than using POS./?/POKE
PR.C h
  while peek h
    move h+3,dpeek(h+1),peek h
    h=h+peek h + 3
  wend
ENDP.


' Reset level, lines, etc variables to 0
mset &_level,14,0

' Wait until joystick trigger is pressed to start game
while peek 644

  ' Get current joystick state (1 for up or 9 (same as -1 when mod 10 is applied) when down). s.0 is shorthand for stick(0)
  k=(not s.0&1) + 9*not s.0&2
  
  ' Detect if up/down is newly pressed, and play sound, change level, update value on screen
  if k-h and k
    @s 55,5
    _level=(_level+k) mod 10
    @V
    pause:sound
  endif
  
  ' Track current joystick state to know when it is newly pressed
  h=k

wend

' Begin new game
@g
  
' New piece
@N

' TEMP TEST - draw a bunch of pieces for an easy tetris
'for i=0 to 3:mset _scr+580+32*i,9,9:next:_nextPiece=4

' ============ Main gameplay loop ============
do
  
  ' Pause game on key press - covers tetris playfield to stop cheating ;)
  ' K. is a shortcut for KEY()
  if K.
    SOUND ' Clear sound

    ' Backup the screen
    -move _scr,_scr+768,768

    ' Fill in the tetris playfield with the current brush
    k=11:@O 35,22

    ' Consume the pressed key (do this after blanking, since CAPS LOCK triggers a key waiting but does not get K)
    GET K

    ' Wait for another key press
    GET K

    ' Restore the screen
    move _scr+768,_scr,768
  endif
  
  ' Count down until the next frame where the piece auto drops
  dec _dropCounter
  
  ' Track current piece rotation and position in case we need to restore to it after attempting an invalid move
  _rotIndexBak=_rotIndex
  _tetPosBak=_tetPos

  ' Clear intermittent gameplay sounds (moving/rotating piece)
  sound 0

  ' Read Joystick 
  k=stick 0

  ' If joystick is not "down", clear "can drop" flag, allowing the player to soft drop when
  ' they next press down 
  if k&2
    _canDrop=1
    _dropScore=0
  ' Start soft drop if "down" is pressed
  elif _canDrop 
    _dropCounter=0
    inc _dropScore
  endif

  ' Check if joystick is pressed left or right
  k=(n.k&8)-n.k&4

  ' Set h to 0. This will be set to indicate a move/sound has occurred
  h=0

  ' If joystick was pressed in a direction, check if we should move
  if k

    ' Keep track of frames joystick held in a direction. If held long enough, repeat move.
    dec _framesHeld    
    if _framesHeld<0 or k-_dirBak 
      ' Flag we will move and set beep frequency with one statement
      h=35

      ' Set new position
      _tetPos=_tetPos+k

      ' Wait a few frames before continuing to repeat move
      _framesHeld=_framesHeld+3
    endif
  else
    _framesHeld=9
  endif
  
  ' Store direction to allow only once left/right movement per joystick push, except when holding for some time (handled by _framesHeld)
  _dirBak=k

  ' Read joystick button
  k = not peek 644

  if k>_rotBak
    ' Flag we will rotate and set beep frequency with one statement
    h=55

    ' Set new rotation index, using a formula to determine max rotation positions (1,2, or 4) based on tetIndex
    ' The formula was less code than storing the rotation max per type
    ' Using & since it is less chars than MOD (e.g. &1 instead of MOD 2, &2 instead of MOD 2)
    _rotIndex = _rotIndex&((_tetIndex+1)/3+_tetIndex/5) + 1
    
  endif

  ' Store rotBak to only rotate once per joystick button press
  _rotBak=k
  
  ' Do one of three options
  if h ' 1) Draw moved/rotated piece
    @L
  elif _dropCounter>0 ' 2) Wait if still counting down to drop
    @W
  else ' 3) Drop
    _dropCounter = _dropCounterStart
   
    ' Test/Move to new location
    _tetPos=_tetPos+32
    @L
    @W
    
    ' New position not valid - lock piece into place
    if not i
      
      ' Proc - Check if new Location is valid for a tetromino to move/rotate to.
        ' If valid, it plays a sound and draws the piece in its new location
        ' If invalid, it sets i=0 so the caller knows movement failed
        PR.L
          @I
          FOR j=0 to 3
            if peek(_tetPos+_data(i+j))&8
              i=0
              _tetPos=_tetPosBak
              _rotIndex=_rotIndexBak
            endif
          n.

          ' Play rotate/movement sound if piece moved left/right or rotated
          if i*h then @s h,5
          
          ' Wait a frame
          @W

          ' If the new location is valid, move to that location
          if i
          
            ' Clear old position
            for i=_oldCalcPos to _oldCalcPos+3
              h=_tetPosBak+_data(i)
              if h>$7043 then poke h,3
            next

            ' Draw piece in new position
            @D 
          endif
        ENDP.


      ' Draw using locked chars
      _brush=_brush+7
      @D

      ' Check for filled rows to clear
      ' Starts at the first square (always top most of a tetromino) and the 3 rows below that
      k=0
      h=(_tetPos+_data(_oldCalcPos)-_scr)/32*32+_scr+4
      
      ' Loop through 4 rows to check if any are completely filled in
      FOR I=0 to 3

        ' Check all ten blocks are filled. Break early if empty playfield or ui element found
        j=h:while peek j>7:inc j:wend
        
        ' If we got to the end without an empty space, and we are within the 
        ' bounds of the playfield, we have cleared the row!
        if j>h+9 and h>$7043 
          
          ' Increment cleared lines counter
          inc _lines
          
          ' Store this as a row to clear
          inc k
          _clearedRow(k)=h
  
          ' Check if the player moved to the next level
          if _lines mod 10=0
            ' Increase level
            inc _level
              
            ' Increase drop speed
            if _dropCounterStart>6 then _dropCounterStart=_dropCounterStart-2
          endif
        endif 

        ' Wait a frame, then move to the next row on screen (32 chars per screen row)
        @W
        h=h+32

        ' If we reached the end of the playfield, exit early
        if h>_scr+676 then exit
        
      n.

      ' One or more rows was filled
      if k 
      
        ' Score appropriate based on level and rows filled
        _score%=_score%+_data(k+109)*(_level+1)*20
        
        ' Animation - Visually clear out the rows from center out, with sound effect!
        for h=1 to 5
        
          ' Temporarily use _dropCounter to set sound pitch
          _dropCounter=70-h*10

          ' Flash screen on a full tetris (clear 4 lines)
          if k=4
            poke 709,6-h&1
            _dropCounter=23+24*h&1
          endif

          ' Play sound, wait
          @S _dropCounter,3
          @W

          ' Play sound at a lower pitch
          @S _dropCounter+50*(k<4),5

          ' Clear a section of each row
          @W
          for i=1 to k
            mset _clearedRow(i)+5-h,h+h,3
          next

          ' Wait, play sound
          @W
          @S _dropCounter,2
          @W
        next

        ' Stop attract mode in case keyboard key hasn't been pressed in awhile
        poke 77,0

        ' Clear sound effect
        s.0
        
        ' Shift upper rows down in place of the cleared rows - 41 chars left
        for i=1 to k
          for h=_clearedRow(i) to _scr+69 step -32
            move h-32,h,10
          next
          @W
        next

        ' Clear top row after sliding everything down, otherwise it will stay unchanged
        mset _scr+68,10,3
        
      endif
      
       ' Score soft drop
      _score% = _score% + _dropScore
      
      ' Update stats on screen
      @V
      
      ' Check if game ended (the top tetromino was locked before it could fall)
      if k=0 and _tetPos=_scr+9 then exit
     
      ' Get next tetromino
      @N
    endif
  endif
  
loop

' GAME OVER

' Clear sound
sound

' Darken the background for a bit and pause to signify game over
poke 709,3
pause 40

loop

Code: Alles auswählen

PROC C H:WHILE PEEK(H):MOVE H+3,DPEEK(H+1),PEEK(H):H=H+PEEK(H)+3:WEND:ENDPROC

PR.C H:W.P.H:M.H+3,D.(H+1),P.H:H=H+P.H+3:WE.:ENDP.