Apple-2-SW
/
EightBall
mirror of https://github.com/bobbimanners/EightBall.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
Page: Lo Res Tetris for the Apple II
Pages
Benchmark Home Lo Res Tetris for the Apple II Roadmap String Handling Example
5 Lo Res Tetris for the Apple II
Bobbi Webber-Manners edited this page 2018-05-27 17:14:57 -04:00

This is the biggest 'real' program I have written in EightBall so far. I did this in order to show where EightBall needs improvement. It runs quite nicely, but it is only just fast enough when running under the unoptimized reference VM.

Screenshot

Keys

  • A: Left
  • D: Right
  • S: Rotate
  • There is no 'drop', you have to wait

Also contains some useful code for using Apple ][ lo-res mode and a crappy PRNG. Do not rely on this for your crypto!

' Apple II Low Res Tetris
' Bobbi 2018

word addrs[24]={$400,$480,$500,$580,$600,$680,$700,$780,$428,$4a8,$528,$5a8,$628,$6a8,$728,$7a8,$450,$4d0,$550,$5d0,$650,$6d0,$750,$7d0}

' Size of playfield
const lhs=14
const rhs=lhs+11
const top=10
const bttm=top+22

const strow=8
const stcol=18

' Apple II specific addresses
const spkr=$c030
const kbdata=$c000
const kbstrb=$c010
const hpos=36
const rnd=$4e

' ASCII
const beep=7
const clrscr=12

' Position of piece
byte col=stcol
byte row=strow
byte rot=0

' Previous col, row, rotation
byte ocol=stcol
byte orow=strow
byte orot=0

byte key=0
byte piece=0
byte done=0
word score=0

' Seed the PRNG
word rr=$4e

' Left, right, rotate permitted?
byte lok=1
byte rok=1
byte rotok=1

' First run
byte first=1

call prng()
piece=rr%5
call loresmix()
while 1
 pr.ch clrscr
 call clrlomix()
 call frame()
 call printnewlines()
 if first
  call printintro()
  kbd.ch &key
  call clearintro()
  first=0
 endif
 call printtext()
 call printscore()
 call playgame()
 kbd.ch &key
endwhile
end

sub playgame()
 score=0
 while 1
  key=getkey()
  orow=row;ocol=col;orot=rot
  if key=='s'&&rotok
   if rot==3
    rot=0
   else
    rot=rot+1
   endif
  else
   if (key=='a')&&lok
    col=col-1
   else
    if (key=='d')&&rok
     col=col+1
    endif
   endif
  endif
  key=^spkr
  row=row+1
  lok=1
  rok=1
  rotok=1
  call drawPiece(ocol,orow,orot,1); 'Erase
  if drawPiece(col,row,rot,0)
   if row==strow+1
    call loser()
    return 0
   else
    call checkframe(row)
    col=stcol;row=strow;rot=0
    call prng()
    piece=rr%5
   endif
  endif
 endwhile
endsub

sub getkey()
 if ^kbdata<128
  return 0
 endif
 ^kbstrb=0
 return ^kbdata
endsub

sub lores()
 ^$c050=0
 ^$c052=0
 ^$c054=0
 ^$c056=0
endsub

sub loresmix()
 ^$c050=0
 ^$c053=0
 ^$c054=0
 ^$c056=0
endsub

sub text()
 ^$c051=0
 ^$c054=0
endsub

sub clrlo()
 byte r=0
 byte c=0
 for r=0:23
  for c=0:39
   ^(addrs[r]+c)=0
  endfor
 endfor
endsub

sub clrlomix()
 byte r=0
 byte c=0
 for r=0:19
  for c=0:39
   ^(addrs[r]+c)=0
  endfor
 endfor
 for r=20:23
  for c=0:39
   ^(addrs[r]+c)=' '+128
  endfor
 endfor
endsub

sub plot(byte c,byte r,byte color)
 word a=addrs[r/2]+c
 if r%2
  ^a=(^a&$0f)|(color<<4)
 else
  ^a=(^a&$f0)|color
 endif
endsub

sub readpix(byte c,byte r)
 word a=addrs[r/2]+c
 if r%2
  return (^a&$f0)>>4
 else
  return ^a&$0f
 endif
endsub

sub hlin(byte c1,byte c2,byte r,byte color)
 byte i=0
 for i=c1:c2
  call plot(i,r,color)
 endfor
endsub

sub vlin(byte c,byte r1,byte r2,byte color)
 byte i=0
 for i=r1:r2
  call plot(c,i,color)
 endfor
endsub

sub frame()
 call hlin(lhs,rhs,bttm,4)
 call vlin(lhs,top,bttm,4)
 call vlin(rhs,top,bttm,4)
endsub

sub drawPiece(byte c,byte r,byte rot,byte erase)
 if piece==0
  return drawT(c,r,rot,erase)
 else; if piece==1
  return drawL(c,r,rot,erase)
 else; if piece==2
  return drawZ(c,r,rot,erase)
 else; if piece==3
  return drawSq(c,r,rot,erase)
 else
  return drawI(c,r,rot,erase)
 endif;endif;endif;endif
endsub
 
sub drawT(byte c,byte r,byte rot,byte erase)
 byte color=1
 if erase
  color=0
 endif
 if rot==0
  call plot(c,r+1,color)
  call plot(c+1,r+1,color)
  call plot(c+2,r+1,color)
  call plot(c+1,r+2,color)
  if erase
   return 0
  endif
  lok=!(readpix(c-1,r+2)||readpix(c,r+2)||readpix(c,r+3))
  rok=!(readpix(c+2,r+2)||readpix(c+3,r+2)||readpix(c+2,r+3))
  rotok=!(readpix(c,r+2)||readpix(c+1,r+3))
  return readpix(c,r+2)||readpix(c+1,r+3)||readpix(c+2,r+2)
 else
  if rot==1
   call plot(c+1,r,color)
   call plot(c,r+1,color)
   call plot(c+1,r+1,color)
   call plot(c+1,r+2,color)
   if erase
    return 0
   endif
   lok=!(readpix(c-1,r+2)||readpix(c,r+2)||readpix(c,r+3))
   rok=!(readpix(c+2,r+1)||readpix(c+2,r+2)||readpix(c+2,r+3))
   rotok=!(readpix(c,r+2)||readpix(c+2,r+2))
   return readpix(c,r+2)||readpix(c+1,r+3)
  else
   if rot==2
    call plot(c+1,r,color)
    call plot(c,r+1,color)
    call plot(c+1,r+1,color)
    call plot(c+2,r+1,color)
    if erase
     return 0
    endif
    lok=!(readpix(c-1,r+2)||readpix(c,r+2)||readpix(c+1,r+2))
    rok=!(readpix(c+1,r+2)||readpix(c+2,r+2)||readpix(c+3,r+2))
    rotok=!(readpix(c+1,r+2)||readpix(c+2,r+2)||readpix(c+1,r+3))
    return readpix(c,r+2)||readpix(c+1,r+2)||readpix(c+2,r+2)
   else
    if rot==3
     call plot(c+1,r,color)
     call plot(c+1,r+1,color)
     call plot(c+2,r+1,color)
     call plot(c+1,r+2,color)
     if erase
      return 0
     endif
     lok=!(readpix(c,r+1)||readpix(c,r+2)||readpix(c,r+3))
     rok=!(readpix(c+2,r+2)||readpix(c+3,r+2)||readpix(c+2,r+3))
     rotok=!(readpix(c,r+2)||readpix(c+2,r+2)||readpix(c+1,r+3))
     return readpix(c+1,r+3)||readpix(c+2,r+2)
    endif
   endif
  endif
 endif
endsub

sub drawL(byte c,byte r,byte rot,byte erase)
 byte color=8
 if erase
  color=0
 endif
 if rot==0
  call plot(c+1,r,color)
  call plot(c+1,r+1,color)
  call plot(c+1,r+2,color)
  call plot(c+2,r+2,color)
  if erase
   return 0
  endif
  lok=!(readpix(c,r+1)||readpix(c,r+2)||readpix(c,r+3)||readpix(c+1,r+3))
  rok=!(readpix(c+2,r+1)||readpix(c+2,r+3)||readpix(c+3,r+3))
  rotok=!(readpix(c,r+2)||readpix(c+2,r+1))
  return readpix(c+1,r+3)||readpix(c+2,r+3)
 else
  if rot==1
   call plot(c+2,r,color)
   call plot(c,r+1,color)
   call plot(c+1,r+1,color)
   call plot(c+2,r+1,color)
   if erase
    return 0
   endif
   lok=!(readpix(c-1,r+2)||readpix(c,r+2)||readpix(c+1,r+2))
   rok=!(readpix(c+1,r+2)||readpix(c+2,r+2)||readpix(c+3,r+2)||readpix(c+3,r+1))
   rotok=!(readpix(c+2,r+2)||readpix(c+2,r+3))
   return readpix(c,r+2)||readpix(c+1,r+2)||readpix(c+2,r+2)
  else
   if rot==2
    call plot(c+1,r,color)
    call plot(c+2,r,color)
    call plot(c+2,r+1,color)
    call plot(c+2,r+2,color)
    if erase
     return 0
    endif
    lok=!(readpix(c,r+1)||readpix(c+1,r+1)||readpix(c+1,r+2)||readpix(c+1,r+3))
    rok=!(readpix(c+3,r+1)||readpix(c+3,r+2)||readpix(c+3,r+3))
    rotok=!(readpix(c+1,r+1)||readpix(c+1,r+2)||readpix(c+3,r+1))
    return readpix(c+1,r+1)||readpix(c+2,r+3)
   else
    if rot==3
     call plot(c+1,r,color)
     call plot(c+2,r,color)
     call plot(c+3,r,color)
     call plot(c+1,r+1,color)
     if erase
      return 0
     endif
     lok=!(readpix(c,r+1)||readpix(c,r+2))
     rok=!(readpix(c+2,r+1)||readpix(c+3,r+1)||readpix(c+4,r+1)||readpix(c+2,r+2))
     rotok=!(readpix(c+2,r+1)||readpix(c+2,r+2)||readpix(c+2,r+3)||readpix(c+3,r+3))
     return readpix(c+1,r+2)||readpix(c+2,r+1)||readpix(c+3,r+1)
    endif
   endif
  endif
 endif
endsub

sub drawZ(byte c,byte r,byte rot,byte erase)
 byte color=2
 if erase
  color=0
 endif
 if (rot==0)||(rot==2)
  call plot(c+1,r,color)
  call plot(c+1,r+1,color)
  call plot(c+2,r+1,color)
  call plot(c+2,r+2,color)
  if erase
   return 0
  endif
  lok=!(readpix(c,r+1)||readpix(c,r+2)||readpix(c+1,r+2)||readpix(c+1,r+3))
  rok=!(readpix(c+3,r+2)||readpix(c+3,r+3))
  rotok=!(readpix(c,r+3)||readpix(c+1,r+3)||readpix(c+1,r+2))
  return readpix(c+1,r+2)||readpix(c+2,r+3)
 else
  if (rot==1)||(rot==3)
   call plot(c+1,r+1,color)
   call plot(c+2,r+1,color)
   call plot(c,r+2,color)
   call plot(c+1,r+2,color)
   if erase
    return 0
   endif
   lok=!(readpix(c-1,r+3)||readpix(c,r+3)||readpix(c+2,r+2))
   rok=!(readpix(c+1,r+3)||readpix(c+2,r+3)||readpix(c+2,r+2)||readpix(c+3,r+2))
   rotok=!(readpix(c+2,r+2)||readpix(c+2,r+3))
   return readpix(c,r+3)||readpix(c+1,r+3)
  endif
 endif
endsub

sub drawI(byte c,byte r,byte rot,byte erase)
 byte color=14
 if erase
  color=0
 endif
 if (rot==0)||(rot==2)
  call plot(c,r+2,color)
  call plot(c+1,r+2,color)
  call plot(c+2,r+2,color)
  call plot(c+3,r+2,color)
  if erase
   return 0
  endif
  lok=!readpix(c-1,r+3)
  rok=!readpix(c+4,r+3)
  rotok=!(readpix(c+2,r+3)||readpix(c+2,r+4))
  return readpix(c,r+3)||readpix(c+1,r+3)||readpix(c+2,r+3)||readpix(c+3,r+3)
 else
  if (rot==1)||(rot==3)
   call plot(c+2,r,color)
   call plot(c+2,r+1,color)
   call plot(c+2,r+2,color)
   call plot(c+2,r+3,color)
   if erase
    return 0
   endif
   lok=!(readpix(c+1,r+1)||readpix(c+1,r+2)||readpix(c+1,r+3)||readpix(c+1,r+4))
   rok=!(readpix(c+3,r+1)||readpix(c+3,r+2)||readpix(c+3,r+3)||readpix(c+3,r+4))
   rotok=!(readpix(c,r+3)||readpix(c+1,r+3)||readpix(c+3,r+3))
  return readpix(c+2,r+4)
  endif
 endif
endsub

sub drawSq(byte c,byte r,byte rot,byte erase)
 byte color=13
 if erase
  color=0
 endif
 call plot(c+1,r+1,color)
 call plot(c+2,r+1,color)
 call plot(c+1,r+2,color)
 call plot(c+2,r+2,color)
 if erase
  return 0
 endif
 lok=!(readpix(c,r+2)||readpix(c,r+3))
 rok=!(readpix(c+3,r+2)||readpix(c+3,r+3))
 rotok=1
 return readpix(c+1,r+3)||readpix(c+2,r+3)
endsub

sub checkframe(byte r)
 byte rr=r+3
 if rr>bttm-1
  rr=bttm-1
 endif
 while rr>=r
  if checkline(rr)
   pr.ch beep
  else
   rr=rr-1
  endif
 endwhile
endsub

sub checkline(byte r)
 byte c=0
 for c=lhs+1:rhs-1
  if !readpix(c,r)
   return 0
  endif
 endfor
 call deleterow(r)
 score=score+1
 call printscore()
 return 1
endsub

sub deleterow(byte r)
 byte i=r
 byte c=0
 byte v=0
 byte empty=0
 while (i>top+1)&&(!empty)
  empty=1
  for c=lhs+1:rhs-1
   v=readpix(c,i-1)
   if v
    empty=0
   endif
   call plot(c,i,v)
  endfor
  i=i-1
 endwhile
endsub

sub printnewlines()
 byte i=0
 for i=0:19
  pr.nl
 endfor
endsub

sub printintro()
 ^hpos=10
 pr.msg "TETRIS - PRESS ANY KEY"
endsub

sub clearintro()
 ^hpos=10
 pr.msg "                      "
endsub

sub printtext()
 ^hpos=10
 pr.msg "SCORE: "
endsub

sub printscore()
 ^hpos=17
 pr.dec score
endsub

sub loser()
 ^hpos=10
 pr.msg "GAME OVER - SCORE WAS "
 pr.dec score
endsub

sub prng()
 rr=rr*8191+7; ' Mersenne prime
endsub