Search code examples
windowsassemblydosx86-16

The quintessential Snake Game. How to keep track of the snake?


The objective of this board game is to eat the food and grow.

In its most basic form, the game only uses 3 colors: one for the snake (a series of interconnected tiles), one for the food (a randomly chosen tile), and one for the background (the unoccupied tiles). Because the snake is continuously on the move, it will be obvious enough where the head of the snake is at any one time. There's no need for any graphical markings. The player can control the snake through the arrow keys on the keyboard, aiming for the food. If the food is eaten, the snake will grow an additional one segment and a following food is placed on the board. If the snake crashes into the border or bumps into itself, the game is over!

To make the snake move, a new segment is added at the 'head' side and an existing segment is removed at the 'tail' side. In the program we can store the coordinates for both 'head' and 'tail' in variables. Updating the 'head' variable is easy, but how can we unambiguously know where the new 'tail' will be? So, how can we keep track of the snake? Will it be necessary to invent some data structure?


Solution

  • To keep track of the snake we have to record the position of all of its segments. We can choose to store the actual (X,Y) coordinates or an indication of the change between successive coordinates. We can store this information in the video buffer matrix, in a matrix of our own, or in a circular buffer.

    Reading game information from the video buffer matrix.

    First let us assume using a text video mode where each character cell is represented by a character byte (ASCII), and an attribute byte (color) that enables us to choose between 16 foreground colors and 16 background colors. If the foreground and background colors happen to be equal, it won't matter anymore what character code we have stored there. The resulting output will always form a single color, solid rectangle. We can set things up so that the character byte of the tile where the current tail is located, records the direction to move to in order to position the new tail. The scancodes of the arrow keys are used for this purpose. For example, if the current tail is at (5,8) and the character byte in the video memory holds the value 48h (up), then the new tail will be positioned at (5,7).

    Instead of using the character byte to store the game information, we could also use the attribute byte. If we then select ASCII 32 (space), the video hardware only needs the background color and we can use the 4-bit space reserved for the foreground color to record our game information. Similarly if we select ASCII 219 (full block), the video hardware only needs the foreground color and we can use the 4-bit space reserved for the background color to record our game information.

    In the demonstration programs that follow, every tile on the game board is made up of 2 character cells in the video buffer of the 80x25 text video mode. This is what will produce square tiles. The simpler method to produce square tiles would have been to use the 40x25 text video mode, but as it turns out, for Microsoft Windows the 40x25 mode is the same as using the left half of the 80x25 mode. That does not help in getting nice square tiles.
    Hiding the cursor is also solely for the benefit of running the demo's in Microsoft Windows.

    figure 1

    ; The Snake Game - VRAM (c) 2021 Sep Roland
    
            ORG     256
    
    MODE=03h
    COLS=80
    ROWS=25
    SLEN=COLS/8                         ; Initial length of snake
    MIDP=((ROWS-1)/2)*256+(COLS/2)      ; Center of playfield
    BACKCOLOR=66h                       ; Brown
    FOODCOLOR=55h                       ; Magenta
    SNAKECOLOR=22h                      ; Green
    TIMER equ gs:046Ch                  ; BIOS.TimerTick
    
    STRUC Snake a, b, c, d, e
     {
      .Head         dw      a
      .Tail         dw      b
      .Length       dw      c
      .Flow         db      d
      .Speed        db      e
     }
    
            cld
            xor     ax, ax
            mov     gs, ax
            mov     ax, 0B800h
            mov     es, ax              ; VRAM
    
            mov     ax, [TIMER]         ; Seed
            mov     [Rand], ax
    
            mov     ax, MODE            ; BIOS.SetVideoMode
            int     10h
            mov     dx, ROWS*256+0      ; Hide cursor
            mov     bh, 0
            mov     ah, 02h             ; BIOS.SetCursor
            int     10h
    
    ; Paint the playfield, draw the snake and food
            xor     di, di
            mov     cx, COLS*(ROWS-1)
            mov     ax, BACKCOLOR*256+0 ; 0 is free
            rep stosw
    
            mov     di, (((ROWS-1)/2)*COLS+(COLS/2)-SLEN)*2
            mov     cx, SLEN*2
            mov     ax, SNAKECOLOR*256+4Dh
            rep stosw
    
            call    NewFood             ; -> (AX..DX)
    
    ; Show "GO" and wait for a keypress, then begin
            mov     dword [es:((ROWS-1)*COLS+4)*2], 0A4F0A47h
            mov     ah, 00h             ; BIOS.GetKey
            int     16h                 ; -> AX
            call    Status              ; -> (AX..DX)
    
    Main:   mov     ax, [TIMER]         ; Sync with real time
    @@:     cmp     ax, [TIMER]
            je      @b
    
    .kbd:   mov     ah, 01h             ; BIOS.TestKey
            int     16h                 ; -> AX ZF
            jz      .show
            mov     ah, 00h             ; BIOS.GetKey
            int     16h                 ; -> AX
            cmp     al, 27              ; <ESC>
            je      Quit
            cmp     al, 32              ; <SPC>
            jne     .arrow
    
    .speed: mov     al, 11111111b       ; Fast uses every tick
            cmp     [S.Speed], al
            jne     @f
            mov     al, 00010001b       ; Slow uses one out of four ticks
    @@:     mov     [S.Speed], al
            jmp     .show
    
    .arrow: mov     al, ah
            cmp     al, 4Dh             ; <RIGHT>
            je      @f
            cmp     al, 48h             ; <UP>
            je      @f
            cmp     al, 4Bh             ; <LEFT>
            je      @f
            cmp     al, 50h             ; <DOWN>
            jne     .show
    @@:     mov     [S.Flow], al        ; AL={4Dh=X+, 48h=Y-, 4Bh=X-, 50h=Y+}
    
    .show:  ror     [S.Speed], 1
            jnc     Main
    
            mov     al, [S.Flow]        ; {4Dh,48h,4Bh,50h}
            mov     cx, [S.Head]
            call    NextXY              ; -> CX
            call    ReadPlayfieldCell   ; -> AL={0,1,4Dh,48h,4Bh,50h} (BX)
            cmp     al, 1
            je      .eat                ; 0 is free, 1 is food
            ja      DEAD                ; other is snake
    
    .move:  call    NewHead             ; -> (AX..CX)
            call    NewTail             ; -> (AX..CX)
            jmp     Main
    
    .eat:   call    NewHead             ; -> (AX..CX)
            inc     [S.Length]
            call    Status              ; -> (AX..DX)
            call    NewFood             ; -> (AX..DX)
            jmp     Main
    ; ----------------------------------
    ; Show "GAME OVER" and wait for <ESC>, then quit
    DEAD:   mov     si, Msg
            mov     di, ((ROWS-1)*COLS+(COLS/2)-4)*2
            lodsw                       ; First char and color
    @@:     stosw
            lodsb
            cmp     al, 0
            jne     @b
    
    @@:     mov     ah, 00h             ; BIOS.GetKey
            int     16h                 ; -> AX
            cmp     al, 27              ; <ESC>
            jne     @b
    ; ---   ---   ---   ---   ---   ---
    Quit:   mov     ax, 0003h           ; BIOS.SetVideoMode
            int     10h
            mov     ax, 4C00h           ; DOS.Terminate
            int     21h
    ; ----------------------------------
    ; IN (al,cx) OUT (cx)
    NextXY: cmp     al, 4Dh             ; AL={4Dh,48h,4Bh,50h}
            jne     @f
            add     cl, 2               ; 2 character cells per playfield cell
            cmp     cl, COLS
            je      DEAD
            ret
    @@:     cmp     al, 4Bh             ; AL={48h,4Bh,50h}
            jae     @f
            sub     ch, 1
            jb      DEAD
            ret
    @@:     ja      @f
            sub     cl, 2
            jb      DEAD
            ret
    @@:     add     ch, 1
            cmp     ch, ROWS-1
            je      DEAD
            ret
    ; ----------------------------------
    ; IN (cx) OUT () MOD (ax..cx)
    NewHead:mov     al, [S.Flow]
            mov     ah, SNAKECOLOR
            call    WritePlayfieldCell  ; -> (BX)
            xchg    cx, [S.Head]
    ; ---   ---   ---   ---   ---   ---
    ; About this fall-thru: The old head needs to point at the new head,
    ; therefore we update it with possibly new directional info held in [S.Flow].
    ; ---   ---   ---   ---   ---   ---
    ; IN (ax,cx) OUT () MOD (bx)
    WritePlayfieldCell:
            movzx   bx, ch              ; CH is Row
            imul    bx, COLS
            add     bl, cl              ; CL is Column
            adc     bh, 0
            shl     bx, 1
            mov     [es:bx], ax
            mov     [es:bx+3], ah
            ret
    ; ----------------------------------
    ; IN () OUT () MOD (ax..cx)
    NewTail:mov     cx, [S.Tail]
            call    ReadPlayfieldCell   ; -> AL={4Dh,48h,4Bh,50h} (BX)
            call    NextXY              ; -> CX
            xchg    cx, [S.Tail]
            mov     ax, BACKCOLOR*256+0 ; 0 is free
            jmp     WritePlayfieldCell
    ; ----------------------------------
    ; IN () OUT () MOD (ax..dx)
    NewFood:mov     ax, [Rand]
            imul    ax, 25173
            add     ax, 13849
            mov     [Rand], ax
            mov     bx, ROWS-1
            xor     dx, dx
            div     bx
            mov     ch, dl
            mov     ax, [Rand]
            mov     bx, COLS/2
            xor     dx, dx
            div     bx
            shl     dl, 1
            mov     cl, dl
            call    ReadPlayfieldCell   ; -> AL={0,1,4Dh,48h,4Bh,50h} (BX)
            cmp     al, 0               ; 0 is free
            jne     NewFood
            mov     ax, FOODCOLOR*256+1 ; 1 is food
            jmp     WritePlayfieldCell
    ; ----------------------------------
    ; IN (cx) OUT (al) MOD (bx)
    ReadPlayfieldCell:
            movzx   bx, ch              ; CH is Row
            imul    bx, COLS
            add     bl, cl              ; CL is Column
            adc     bh, 0
            shl     bx, 1
            mov     al, [es:bx]
            ret
    ; ----------------------------------
    ; IN () OUT () MOD (ax..dx)
    Status: mov     ax, [S.Length]
            mov     bx, ((ROWS-1)*COLS+5)*2
            mov     cx, 10
    @@:     xor     dx, dx
            div     cx
            add     dx, 0F00h+'0'
            mov     [es:bx], dx
            sub     bx, 2
            test    ax, ax
            jnz     @b
            mov     byte [es:bx], ' '
            ret
    ; ----------------------------------
    Msg     db      'G', 12, 'AME OVER', 0
    
            ALIGN   2
    S       Snake   MIDP+SLEN-2, MIDP-SLEN, SLEN, 4Dh, 00010001b
    Rand    dw      ?
    

    Reading game information from a matrix of our own.

    This solution is similar to reading the video buffer matrix but is both faster and more flexible. Faster because reading from VRAM is slow compared to reading from regular RAM, and more flexible because the screen can keep displaying all of the characters and all of the color combinations. To put 'faster' in some perspective: the 'MATRIX' program runs a typical cycle in 1.1 µsec, and the 'VRAM' program runs a cycle in 2.6 µsec. Does this matter? Not really, both programs spent 99.99% of their time in the necessary delay loop.

    Because there is no shortage of memory, we can waste some and benefit from it. Even though the game board has fewer columns, we can setup our matrix for 256 columns. If we then store X in the low byte of an addres register like BX and Y in the high byte of that same address register, the reward will be that no conversion is needed to obtain the offset address BX within the matrix.

    figure 2

    ; The Snake Game - MATRIX (c) 2021 Sep Roland
    
            ORG     256
    
    MODE=03h
    COLS=80
    ROWS=25
    SLEN=COLS/8                         ; Initial length of snake
    MIDP=((ROWS-1)/2)*256+(COLS/2)      ; Center of playfield
    BACKCOLOR=66h                       ; Brown
    FOODCOLOR=55h                       ; Magenta
    SNAKECOLOR=22h                      ; Green
    TIMER equ gs:046Ch                  ; BIOS.TimerTick
    
    STRUC Snake a, b, c, d, e
     {
      .Head         dw      a
      .Tail         dw      b
      .Length       dw      c
      .Flow         db      d
      .Speed        db      e
     }
    
            cld
            xor     ax, ax
            mov     gs, ax
            mov     ax, 0B800h
            mov     es, ax              ; VRAM
    
            mov     ax, [TIMER]         ; Seed
            mov     [Rand], ax
    
            mov     ax, MODE            ; BIOS.SetVideoMode
            int     10h
            mov     dx, ROWS*256+0      ; Hide cursor
            mov     bh, 0
            mov     ah, 02h             ; BIOS.SetCursor
            int     10h
    
    ; Paint the playfield and matrix, draw the snake and food
            xor     di, di
            mov     cx, COLS*(ROWS-1)
            mov     ax, BACKCOLOR*256+0 ; 0 is free
            rep stosw
    
            mov     bx, 256*(ROWS-1)
    @@:     dec     bx
            mov     [Mat+bx], al
            jnz     @b
    
            mov     bx, MIDP-SLEN       ; TailXY
            mov     ax, SNAKECOLOR*256+4Dh
    @@:     call    WritePlayfieldCell  ; -> (CX)
            add     bl, 2               ; X+
            cmp     bl, (COLS/2)+SLEN-2 ; HeadX
            jbe     @b
    
            call    NewFood             ; -> (AX..DX)
    
    ; Show "GO" and wait for a keypress, then begin
            mov     dword [es:((ROWS-1)*COLS+4)*2], 0A4F0A47h
            mov     ah, 00h             ; BIOS.GetKey
            int     16h                 ; -> AX
            call    Status              ; -> (AX..DX)
    
    Main:   mov     ax, [TIMER]         ; Sync with real time
    @@:     cmp     ax, [TIMER]
            je      @b
    
    .kbd:   mov     ah, 01h             ; BIOS.TestKey
            int     16h                 ; -> AX ZF
            jz      .show
            mov     ah, 00h             ; BIOS.GetKey
            int     16h                 ; -> AX
            cmp     al, 27              ; <ESC>
            je      Quit
            cmp     al, 32              ; <SPC>
            jne     .arrow
    
    .speed: mov     al, 11111111b       ; Fast uses every tick
            cmp     [S.Speed], al
            jne     @f
            mov     al, 00010001b       ; Slow uses one out of four ticks
    @@:     mov     [S.Speed], al
            jmp     .show
    
    .arrow: mov     al, ah
            cmp     al, 4Dh             ; <RIGHT>
            je      @f
            cmp     al, 48h             ; <UP>
            je      @f
            cmp     al, 4Bh             ; <LEFT>
            je      @f
            cmp     al, 50h             ; <DOWN>
            jne     .show
    @@:     mov     [S.Flow], al        ; AL={4Dh=X+, 48h=Y-, 4Bh=X-, 50h=Y+}
    
    .show:  ror     [S.Speed], 1
            jnc     Main
    
            mov     al, [S.Flow]        ; {4Dh,48h,4Bh,50h}
            mov     bx, [S.Head]
            call    NextXY              ; -> BX
            cmp     byte [Mat+bx], 1
            je      .eat                ; 0 is free, 1 is food
            ja      DEAD                ; other is snake
    
    .move:  call    NewHead             ; -> (AX..CX)
            call    NewTail             ; -> (AX..CX)
            jmp     Main
    
    .eat:   call    NewHead             ; -> (AX..CX)
            inc     [S.Length]
            call    Status              ; -> (AX..DX)
            call    NewFood             ; -> (AX..DX)
            jmp     Main
    ; ----------------------------------
    ; Show "GAME OVER" and wait for <ESC>, then quit
    DEAD:   mov     si, Msg
            mov     di, ((ROWS-1)*COLS+(COLS/2)-4)*2
            lodsw                       ; First char and color
    @@:     stosw
            lodsb
            cmp     al, 0
            jne     @b
    
    @@:     mov     ah, 00h             ; BIOS.GetKey
            int     16h                 ; -> AX
            cmp     al, 27              ; <ESC>
            jne     @b
    ; ---   ---   ---   ---   ---   ---
    Quit:   mov     ax, 0003h           ; BIOS.SetVideoMode
            int     10h
            mov     ax, 4C00h           ; DOS.Terminate
            int     21h
    ; ----------------------------------
    ; IN (al,bx) OUT (bx)
    NextXY: cmp     al, 4Dh             ; AL={4Dh,48h,4Bh,50h}
            jne     @f
            add     bl, 2               ; 2 character cells per playfield cell
            cmp     bl, COLS
            je      DEAD
            ret
    @@:     cmp     al, 4Bh             ; AL={48h,4Bh,50h}
            jae     @f
            sub     bh, 1
            jb      DEAD
            ret
    @@:     ja      @f
            sub     bl, 2
            jb      DEAD
            ret
    @@:     add     bh, 1
            cmp     bh, ROWS-1
            je      DEAD
            ret
    ; ----------------------------------
    ; IN (al,bx) OUT () MOD (ax..cx)
    NewHead:xchg    bx, [S.Head]
            mov     [Mat+bx], al
            mov     ah, SNAKECOLOR
            mov     bx, [S.Head]
    ; ---   ---   ---   ---   ---   ---
    ; IN (ax,bx) OUT () MOD (cx)
    WritePlayfieldCell:
            mov     [Mat+bx], al
            movzx   cx, bh              ; BH is Row
            imul    cx, COLS
            add     cl, bl              ; BL is Column
            adc     ch, 0
            shl     cx, 1
            xchg    bx, cx
            mov     [es:bx+1], ah
            mov     [es:bx+3], ah
            mov     bx, cx
            ret
    ; ----------------------------------
    ; IN () OUT () MOD (ax..cx)
    NewTail:mov     bx, [S.Tail]
            mov     al, [Mat+bx]        ; -> AL={4Dh,48h,4Bh,50h}
            call    NextXY              ; -> BX
            xchg    bx, [S.Tail]
            mov     ax, BACKCOLOR*256+0 ; 0 is free
            jmp     WritePlayfieldCell
    ; ----------------------------------
    ; IN () OUT () MOD (ax..dx)
    NewFood:mov     ax, [Rand]
            imul    ax, 25173
            add     ax, 13849
            mov     [Rand], ax
            mov     cx, ROWS-1
            xor     dx, dx
            div     cx
            mov     bh, dl
            mov     ax, [Rand]
            mov     cx, COLS/2
            xor     dx, dx
            div     cx
            shl     dl, 1
            mov     bl, dl
            cmp     byte [Mat+bx], 0    ; 0 is free
            jne     NewFood
            mov     ax, FOODCOLOR*256+1 ; 1 is food
            jmp     WritePlayfieldCell
    ; ----------------------------------
    ; IN () OUT () MOD (ax..dx)
    Status: mov     ax, [S.Length]
            mov     bx, ((ROWS-1)*COLS+5)*2
            mov     cx, 10
    @@:     xor     dx, dx
            div     cx
            add     dx, 0F00h+'0'
            mov     [es:bx], dx
            sub     bx, 2
            test    ax, ax
            jnz     @b
            mov     byte [es:bx], ' '
            ret
    ; ----------------------------------
    Msg     db      'G', 12, 'AME OVER', 0
    
            ALIGN   2
    S       Snake   MIDP+SLEN-2, MIDP-SLEN, SLEN, 4Dh, 00010001b
    Rand    rw      1
    Mat     rb      256*(ROWS-1)
    

    Reading the actual coordinates from a ringbuffer.

    In this circular buffer we record the coordinates of all the snake's segments going from the head to the tail. The buffer's size must be such that it can accomodate the longest snake possible (or allowed by the rules). The program stores pointers to the first record (Head) and to behind the last record (Tail). For a new snake head, we lower the Head pointer and insert the new coordinates. For a new snake tail, we just lower the Tail pointer, discarding the last record.

    Because we need to stay within the confines of the ringbuffer's memory, a wraparounding mechanism is needed. Choosing a power-of-two size for the ringbuffer's memory is important because then we can wraparound via a simple AND instruction. And if we choose this power-of-two size to be 65536, then we can drop this AND operation altogether since the CPU will already automatically wraparound at 64KB in the real address mode.

    Searching the ringbuffer takes time, and this time will inevitably increase as the snake gets longer. However, in a program where, for playability reasons, more than 99% of the time is spent in a delay loop, it won't matter a bit!

    figure 3

    ; The Snake Game - RINGBUFFER (c) 2021 Sep Roland
    
            ORG     256
    
    MODE=03h
    COLS=80
    ROWS=25
    SLEN=COLS/8                         ; Initial length of snake
    MIDP=((ROWS-1)/2)*256+(COLS/2)      ; Center of playfield
    BACKCOLOR=66h                       ; Brown
    FOODCOLOR=55h                       ; Magenta
    SNAKECOLOR=22h                      ; Green
    TIMER equ gs:046Ch                  ; BIOS.TimerTick
    
    STRUC Snake a, b, c, d, e
     {
      .Head         dw      a
      .Tail         dw      b
      .Length       dw      c
      .Flow         db      d
      .Speed        db      e
     }
    
            cld
            xor     ax, ax
            mov     gs, ax
            mov     ax, cs
            add     ax, (EOF+15)/16
            mov     ss, ax              ; 512 bytes stack
            mov     sp, 512
            add     ax, 512/16
            mov     fs, ax              ; 64KB ringbuffer
            mov     ax, 0B800h
            mov     es, ax              ; VRAM
    
            mov     ax, [TIMER]         ; Seed
            mov     [Rand], ax
    
            mov     ax, MODE            ; BIOS.SetVideoMode
            int     10h
            mov     dx, ROWS*256+0      ; Hide cursor
            mov     bh, 0
            mov     ah, 02h             ; BIOS.SetCursor
            int     10h
    
    ; Paint the playfield, draw the snake and food
            xor     di, di
            mov     cx, COLS*(ROWS-1)
            mov     ax, BACKCOLOR*256+0
            rep stosw
    
            mov     cx, MIDP-SLEN       ; HeadXY==TailXY
    @@:     call    NewHead             ; -> (AX..BX)
            add     cl, 2               ; X+
            cmp     cl, (COLS/2)+SLEN-2 ; HeadX
            jbe     @b
    
            call    NewFood             ; -> (AX..DX)
    
    ; Show "GO" and wait for a keypress, then begin
            mov     dword [es:((ROWS-1)*COLS+4)*2], 0A4F0A47h
            mov     ah, 00h             ; BIOS.GetKey
            int     16h                 ; -> AX
            call    Status              ; -> (AX..DX)
    
    Main:   mov     ax, [TIMER]         ; Sync with real time
    @@:     cmp     ax, [TIMER]
            je      @b
    
    .kbd:   mov     ah, 01h             ; BIOS.TestKey
            int     16h                 ; -> AX ZF
            jz      .show
            mov     ah, 00h             ; BIOS.GetKey
            int     16h                 ; -> AX
            cmp     al, 27              ; <ESC>
            je      Quit
            cmp     al, 32              ; <SPC>
            jne     .arrow
    
    .speed: mov     al, 11111111b       ; Fast uses every tick
            cmp     [S.Speed], al
            jne     @f
            mov     al, 00010001b       ; Slow uses one out of four ticks
    @@:     mov     [S.Speed], al
            jmp     .show
    
    .arrow: mov     al, ah
            cmp     al, 4Dh             ; <RIGHT>
            je      @f
            cmp     al, 48h             ; <UP>
            je      @f
            cmp     al, 4Bh             ; <LEFT>
            je      @f
            cmp     al, 50h             ; <DOWN>
            jne     .show
    @@:     mov     [S.Flow], al        ; AL={4Dh=X+, 48h=Y-, 4Bh=X-, 50h=Y+}
    
    .show:  ror     [S.Speed], 1
            jnc     Main
    
            mov     al, [S.Flow]        ; {4Dh,48h,4Bh,50h}
            mov     bx, [S.Head]
            mov     cx, [fs:bx]
            call    NextXY              ; -> CX
            cmp     cx, [FoodXY]
            je      .eat
            call    ScanSnake           ; -> ZF (BX)
            jnz     DEAD                ; CX is (X,Y) of some snake part
    
    .move:  call    NewHead             ; -> (AX BX)
            call    NewTail             ; -> (AX..CX)
            jmp     Main
    
    .eat:   call    NewHead             ; -> (AX BX)
            inc     [S.Length]
            call    Status              ; -> (AX..DX)
            call    NewFood             ; -> (AX..DX)
            jmp     Main
    ; ----------------------------------
    ; Show "GAME OVER" and wait for <ESC>, then quit
    DEAD:   mov     si, Msg
            mov     di, ((ROWS-1)*COLS+(COLS/2)-4)*2
            lodsw                       ; First char and color
    @@:     stosw
            lodsb
            cmp     al, 0
            jne     @b
    
    @@:     mov     ah, 00h             ; BIOS.GetKey
            int     16h                 ; -> AX
            cmp     al, 27              ; <ESC>
            jne     @b
    ; ---   ---   ---   ---   ---   ---
    Quit:   mov     ax, 0003h           ; BIOS.SetVideoMode
            int     10h
            mov     ax, 4C00h           ; DOS.Terminate
            int     21h
    ; ----------------------------------
    ; IN (al,cx) OUT (cx)
    NextXY: cmp     al, 4Dh             ; AL={4Dh,48h,4Bh,50h}
            jne     @f
            add     cl, 2               ; 2 character cells per playfield cell
            cmp     cl, COLS
            je      DEAD
            ret
    @@:     cmp     al, 4Bh             ; AL={48h,4Bh,50h}
            jae     @f
            sub     ch, 1
            jb      DEAD
            ret
    @@:     ja      @f
            sub     cl, 2
            jb      DEAD
            ret
    @@:     add     ch, 1
            cmp     ch, ROWS-1
            je      DEAD
            ret
    ; ----------------------------------
    ; IN (cx) OUT (ZF) MOD (bx)
    ScanSnake:
            mov     bx, [S.Tail]
            mov     [fs:bx], cx         ; Sentinel
            mov     bx, [S.Head]
            sub     bx, 2
    @@:     add     bx, 2
            cmp     [fs:bx], cx
            jne     @b
            cmp     bx, [S.Tail]
            ret
    ; ----------------------------------
    ; IN (cx) OUT () MOD (ax,bx)
    NewHead:mov     bx, -2
            xadd    [S.Head], bx
            mov     [fs:bx-2], cx
            mov     ah, SNAKECOLOR
    ; ---   ---   ---   ---   ---   ---
    ; IN (ah,cx) OUT () MOD (bx)
    WritePlayfieldCell:
            movzx   bx, ch              ; CH is Row
            imul    bx, COLS
            add     bl, cl              ; CL is Column
            adc     bh, 0
            shl     bx, 1
            mov     [es:bx+1], ah
            mov     [es:bx+3], ah
            ret
    ; ----------------------------------
    ; IN () OUT () MOD (ax..cx)
    NewTail:mov     bx, -2
            xadd    [S.Tail], bx
            mov     cx, [fs:bx-2]
            mov     ah, BACKCOLOR
            jmp     WritePlayfieldCell
    ; ----------------------------------
    ; IN () OUT () MOD (ax..dx)
    NewFood:mov     ax, [Rand]
            imul    ax, 25173
            add     ax, 13849
            mov     [Rand], ax
            mov     bx, ROWS-1
            xor     dx, dx
            div     bx
            mov     ch, dl
            mov     ax, [Rand]
            mov     bx, COLS/2
            xor     dx, dx
            div     bx
            shl     dl, 1
            mov     cl, dl
            call    ScanSnake           ; -> ZF (BX)
            jnz     NewFood             ; CX is (X,Y) of some snake part
            mov     [FoodXY], cx
            mov     ah, FOODCOLOR
            jmp     WritePlayfieldCell
    ; ----------------------------------
    ; IN () OUT () MOD (ax..dx)
    Status: mov     ax, [S.Length]
            mov     bx, ((ROWS-1)*COLS+5)*2
            mov     cx, 10
    @@:     xor     dx, dx
            div     cx
            add     dx, 0F00h+'0'
            mov     [es:bx], dx
            sub     bx, 2
            test    ax, ax
            jnz     @b
            mov     byte [es:bx], ' '
            ret
    ; ----------------------------------
    Msg     db      'G', 12, 'AME OVER', 0
    
            ALIGN   2
    S       Snake   SLEN*2, SLEN*2, SLEN, 4Dh, 00010001b
    FoodXY  dw      ?
    Rand    dw      ?
    
    EOF: