FAQ  •  Register  •  Login

Chessboard Attack + Source code

Moderator: nitrofurano

<<

LCD

Posts: 596

Joined: Fri Feb 13, 2009 3:11 pm

Location: Vienna, Austria

Post Sun Jul 17, 2011 7:48 pm

Chessboard Attack + Source code

"Chessboard Attack" is finally out. You can download it from my website or WOS now.
Image
http://www.worldofspectrum.org/infoseek ... id=0026121
If someone want to peek at the code:
(Please note, song was linked externaly, so it os not included here)
  Code:
' Chessboard Attack (c) 2011 By LCD, written using BorIDE, Retro-X and ZXBC
' Based on my "Blind King" unfinished game
dim x,y,x1,y1,col,a,scan,posx,posy,xpos,ypos,white,black,px,py,orgx,orgy,won,sets as ubyte
dim counter,figures,lives,oldtime,maxtime,multiplier as integer
dim key$ as string
dim scr,adr,score,actual as uinteger

function Lset(strg$ as string,fill$ as string,length as Ubyte) as string
   while len(strg$)<length
      strg$=fill$+strg$
   wend
   return strg$
end function
FUNCTION attrAddress(x as uByte, y as uByte) as uInteger               
';; This function returns the memory address of the Character Position
';; x,y in the attribute screen memory.
';; Adapted from code by Jonathan Cauldwell - Adapted for ZX BASiC by Britlion from Na_TH_AN's fourspriter
asm
   ld      a,(IX+7)        ;ypos
   rrca
   rrca
   rrca               ;' Multiply by 32
   ld      l,a        ;' Pass to L
   and     3          ;' Mask with 00000011
   add     a,88       ;' 88 * 256 = 22528 - start of attributes.
   ld      h,a        ;' Put it in the High Byte
   ld      a,l        ;' We get y value *32
   and     224        ;' Mask with 11100000
   ld      l,a        ;' Put it in L
   ld      a,(IX+5)   ;' xpos
   add     a,l        ;' Add it to the Low byte
   ld      l,a        ;' Put it back in L, and we're done. HL=Address.
end asm
   y=y
   x=x
END FUNCTION
FUNCTION scrAddress(x as uByte, y as uByte) as Uinteger
asm
;' This fn returns the address into HL of the screen address
;' x,y in character grid notation.
;' Original code was extracted by BloodBaz - Adapted for ZX BASiC by Britlion from Na_TH_AN's fourspriter

         ; x Arrives in A, y is in stack.
         and     31
         ld      l,a
         ld      a,(IX+7) ; Y value
         ld      d,a
         and     24
         add     a,64
         ld      h,a
         ld      a,d
         and     7
         rrca
         rrca
         rrca
         or      l
         ld      l,a
               
end asm
   y=y:x=x
END FUNCTION
sub putblock(x as Ubyte,y as ubyte,wid as ubyte,hgt as ubyte,adr as Uinteger)
   dim scr,attribute as Uinteger
   dim y1 as Ubyte
   dim a as Ubyte
   poke uinteger @putblock1+7,wid
   poke uinteger @putblock2+7,wid
   for y1=0 to hgt-1
      scr=scrAddress(x,y+y1)
      for a=0 to 7
         poke uinteger @putblock1+1,adr
         poke uinteger @putblock1+4,scr
         putblock1:
         asm
            ld hl,1
            ld de,2
            ld bc,3
            ldir
         end asm
         adr=adr+wid
         scr=scr+256
      next a
   next y1
   attribute=attrAddress(x,y)
   for y1=0 to hgt-1
      poke uinteger @putblock2+1,adr
      poke uinteger @putblock2+4,attribute
      adr=adr+wid
      attribute=attribute+32
      putblock2:
      asm
         ld hl,4
         ld de,5
         ld bc,6
         ldir
      end asm
   next y1
End sub
function ScanField(x as integer,y as integer,mask as ubyte) as ubyte
   dim result as ubyte
   dim adr as uinteger
   if x>=0 and x<8 and y>=0 and y<8 then
      adr=@chessboard+(y*8)+x
      result=peek adr&mask
   end if
   return result
end function
sub SetField(x as uinteger,y as uinteger,fig as ubyte)
   dim adr as uinteger
   adr=@chessboard+(y<<3)+x
   poke adr,(peek adr)|fig
end sub
sub PutField(x as uinteger,y as uinteger,fig as ubyte) 'Not BORedwith figure
   poke @chessboard+x+(y<<3),fig
end sub

function ScanDiagonal(x as integer,y as integer) as ubyte
 'This scans diagonal fields from x,y until figure or end of field for queen or bishop
   dim dist,f1,f2,f3,f4,d as Integer
   dim hidden,result as ubyte
  dist=1:f1=0:hidden=0:result=0
   while dist<8 and hidden=0
      d=ScanField(x-dist,y-dist,7)
      if d=0 then
         dist=dist+1
      elseif d=5 then
         f1=16:hidden=1
      elseif d=4 then
         f1=8:hidden=1
      else
         hidden=1
      end If
   wend
   result=result bor f1
   dist=1:f2=0:hidden=0
   while dist<8 and hidden=0
      d=ScanField(x+dist,y+dist,7)
      if d=0 then
         dist=dist+1
      elseif d=5 then
         f2=16:hidden=1
      elseif d=4 then
         f2=8:hidden=1
      else
         hidden=1
      end If
   wend
   result=result bor f2
   dist=1:f3=0:hidden=0
   while dist<8 and hidden=0
      d=ScanField(x+dist,y-dist,7)
      if d=0 then
         dist=dist+1
      elseif d=5 then
         f3=16:hidden=1
      elseif d=4 then
         f3=8:hidden=1
      else
         hidden=1
      end If
   wend
   result=result bor f3
   dist=1:f4=0:hidden=0
   while dist<8 and hidden=0
      d=ScanField(x-dist,y+dist,7)
      if d=0 then
         dist=dist+1
      elseif d=5 then
         f4=16:hidden=1
      elseif d=4 then
         f4=8:hidden=1
      else
         hidden=1
      end If
   wend
   result=result bor f4
   return result
end Function
function ScanStraight(x as integer,y as integer) as ubyte
 'This scans straight fields until figure or end of field for queen or rook
  dim dist,f1,f2,f3,f4,d as integer
   dim hidden,result as ubyte
  dist=1:f1=0:hidden=0:result=0
   while dist<8 and hidden=0
      d=ScanField(x-dist,y,7)
      if d=0 then
         dist=dist+1
      elseif d=5 then
         f1=16:hidden=1
      elseif d=2 then
         f1=2:hidden=1
      else
         hidden=1
      end If
   wend
   result=result bor f1
   dist=1:f2=0:hidden=0
   while dist<8 and hidden=0
      d=ScanField(x+dist,y,7)
      if d=0 then
         dist=dist+1
      elseif d=5 then
         f2=16:hidden=1
      elseif d=2 then
         f2=2:hidden=1
      else
         hidden=1
      end If
   wend
   result=result bor f2
   dist=1:f3=0:hidden=0
   while dist<8 and hidden=0
      d=ScanField(x,y-dist,7)
      if d=0 then
         dist=dist+1
      elseif d=5 then
         f3=16:hidden=1
      elseif d=2 then
         f3=2:hidden=1
      else
         hidden=1
      end If
   wend
   result=result bor f3
   dist=1:f4=0:hidden=0
   while dist<8 and hidden=0
      d=ScanField(x,y+dist,7)
      if d=0 then
         dist=dist+1
      elseif d=5 then
         f4=16:hidden=1
      elseif d=2 then
         f4=2:hidden=1
      else
         hidden=1
      end If
   wend
   result=result bor f4
   return result
end Function
function ScanNear(x as ubyte,y as ubyte) as ubyte
 'This scans next fields of x,y until figure for king or pawn
  dim result as ubyte
  if ScanField(x-1,y-1,7)=1 or ScanField(x+1,y-1,7)=1 then result=1:end if
   if ScanField(x-1,y-1,7)=6 or ScanField(x,y-1,7)=6 or ScanField(x+1,y-1,7)=6 or ScanField(x-1,y,7)=6 or ScanField(x+1,y,7)=6 or ScanField(x-1,y+1,7)=6 or ScanField(x,y+1,7)=6 or ScanField(x+1,y+1,7)=6 then result=result bor 32:end if
   return result
end Function
function ScanKnight(x as ubyte,y as ubyte) as ubyte
 'This scans field x,y if attacked by knight
   dim result as ubyte
   if ScanField(x-1,y-2,7)=3 or ScanField(x+1,y-2,7)=3   or ScanField(x-1,y+2,7)=3 or ScanField(x+1,y+2,7)=3   or ScanField(x-2,y-1,7)=3 or ScanField(x+2,y-1,7)=3   or ScanField(x-2,y+1,7)=3 or ScanField(x+2,y+1,7)=3 then result=4:end if
   return result   
end Function
function ScanFields(x as ubyte,y as ubyte) as ubyte
   dim scan,fig1,fig2,fig3,fig4,fig5,fig6 as ubyte
   scan=ScanNear(x,y)
   fig1=scan band 1
   fig6=scan band 32
   scan=ScanKnight(x,y)
   fig3=scan band 4
   scan=ScanStraight(x,y)|ScanDiagonal(x,y)
   fig2=scan band 2
   fig4=scan band 8
   fig5=scan band 16

   if fig1 then print at 2,25;"\APawn";:else print at 2,25;"       ";:end If
   if fig2 then print at 3,25;"\BRook";:else print at 3,25;"       ";:end If
   if fig3 then print at 4,25;"\CKnight";:else print at 4,25;"       ";:end If
   if fig4 then print at 5,25;"\DBishop";:else print at 5,25;"       ";:end If
   if fig5 then print at 6,25;"\EQueen";:else print at 6,25;"       ";:end If
   if fig6 then print at 7,25;"\FKing";:else print at 7,25;"       ";:end If
end Function
sub ScoreBoard()
   print at 0,24;"\{p1}\{b1}\{i7}Attacked";
   print at 8,24;"\{p2}\{i7}\{b1}Pieces: ";
   print at 11,24;"\{p4}\{i7}\{b1} Lifes: ";
   print at 14,24;"\{p6}\{i0}\{b1} Time:  ";
   print at 17,24;"\{p3}\{i7}\{b1} Score: ";
end sub
sub waitnokey()
   while inkey$<>""
   wend
end sub
sub DisplaySinglePiece(x as ubyte,y as ubyte)
   dim scan,a,x1,y1,white,black as ubyte
   scan=ScanField(x,y,255)
   a=scan band 7
   x1=x*3
   y1=y*3
   white=scan band 32
   black=scan band 64
   if scan band 128 then putblock(x1,y1,3,3,@HiddenGFX)
   elseif a=1 and white then putblock(x1,y1,3,3,@PawnGFX1)
   elseif a=1 and black then putblock(x1,y1,3,3,@PawnGFX2)
   elseif a=2 and white then putblock(x1,y1,3,3,@TowerGFX1)
   elseif a=2 and black then putblock(x1,y1,3,3,@TowerGFX2)
   elseif a=3 and white then putblock(x1,y1,3,3,@KnightGFX1)
   elseif a=3 and black then putblock(x1,y1,3,3,@KnightGFX2)
   elseif a=4 and white then putblock(x1,y1,3,3,@LaeuferGFX1)
   elseif a=4 and black then putblock(x1,y1,3,3,@LaeuferGFX2)
   elseif a=5 and white then putblock(x1,y1,3,3,@QueenGFX1)
   elseif a=5 and black then putblock(x1,y1,3,3,@QueenGFX2)
   elseif a=6 and white then putblock(x1,y1,3,3,@KingGFX1)
   elseif a=6 and black then putblock(x1,y1,3,3,@KingGFX2)
   end if
end sub
sub ShowPieces()
   dim x,y as ubyte
   for y=0 to 7
      for x=0 to 7
         DisplaySinglePiece(x,y)
      next x
   next y
end sub
sub AttrSquare(x as ubyte,y as ubyte,col as ubyte)
   dim adr as uinteger
   adr=attrAddress(x*3,y*3)
   poke adr,col:poke adr+1,col:poke adr+2,col
   poke adr+32,col:poke adr+33,col:poke adr+34,col
   poke adr+64,col:poke adr+65,col:poke adr+66,col
end sub
sub StoreAttr(x as ubyte,y as ubyte)
   dim adr,adr1 as uinteger
   adr=attrAddress(x*3,y*3)
   adr1=@Attrbuffer
   poke adr1,peek adr:poke uinteger adr1+1,peek (uinteger,adr+1)
   poke adr1+3,peek (adr+32):poke uinteger adr1+4,peek (uinteger,adr+33)
   poke adr1+6,peek (adr+64):poke uinteger adr1+7,peek (uinteger,adr+65)
end sub
sub RestoreAttr(x as ubyte,y as ubyte)
   dim adr,adr1 as uinteger
   adr=@Attrbuffer
   adr1=attrAddress(x*3,y*3)
   poke adr1,peek adr:poke uinteger adr1+1,peek (uinteger,adr+1)
   poke adr1+32,peek (adr+3):poke uinteger adr1+33,peek (uinteger,adr+4)
   poke adr1+64,peek (adr+6):poke uinteger adr1+65,peek (uinteger,adr+7)
end sub

sub EmptyField(x as ubyte,y as ubyte)
   dim scan as ubyte
   dim adr as uinteger
    scan=ScanField(x,y,127)
   if scan & 32 then adr=@EmptyGFX1
   elseif scan & 64 then adr=@EmptyGFX2
   end if
   putblock(x*3,y*3,3,3,adr)
   PutField(x,y,ScanField(x,y,scan))
end sub

function Clock(tim as uinteger) as String
   dim mins,sec,secs as uinteger
   dim s$,m$,f$ as String
   secs=int(tim/50)
   if secs<16 then
      f$="\{f1}"
   Else
      f$="\{f0}"
   end if
   mins=int(secs/60)
   sec=secs mod 60
   m$=str(mins)
   if len(m$)=1 then
      m$="0"+m$
   end if
   s$=str(sec)
   if len(s$)=1 then
      s$="0"+s$
   end if
   return f$+m$+":"+s$
   'return str(int(tim/50))+" "
end function
function timer(limit as uinteger) as uinteger
   dim time1 as uinteger
   time=limit-peek(uinteger,23672)
   time1=int(time/50)
   if time1<>int(oldtime/50) then
      print ink 7;at 15,25;Clock(time)
   end if
   oldtime=time
   return time1
end Function
sub SetFigures(counter as byte,figure as ubyte)
   while counter>0
      x=int(rnd*7.9999):y=int(rnd*6.9999)
      if ScanField(x,y,7)=0 then
         SetField(x,y,figure):counter=counter-1
      end If
   end while
end sub

sets=1
' randomize usr 24576 'Init Sound (not included in this source code)
' randomize usr 33026 'Start interrupts (not included in this source code)



beginn:
' Copy reseted board to board work-buffer
for a=0 to 63
   poke @chessboard+a,peek (@chessboard1+a)
next a

'Init screen, prepare fonts and UDG
paper 0:ink 6:bright 1:flash 0:border 0:cls
Dim font (767) As uByte => { _
     0,0,  0,  0,  0,  0,  0,  0,  0, _
    16, 16, 16, 16, 16,  0, 16,  0, _
    40, 40, 40,  0,  0,  0,  0,  0, _
    40, 40,254, 40,254, 40, 40,  0, _
    16,124,144,124, 18,252, 16,  0, _
    66,164, 72, 16, 36, 74,132,  0, _
    32, 80, 32, 82,148,136,118,  0, _
    32, 64,  0,  0,  0,  0,  0,  0, _
     8, 16, 32, 32, 32, 16,  8,  0, _
    32, 16,  8,  8,  8, 16, 32,  0, _
    16, 84, 56,254, 56, 84, 16,  0, _
    16, 16, 16,254, 16, 16, 16,  0, _
     0,  0,  0,  0, 32, 32, 64,  0, _
     0,  0,  0,254,  0,  0,  0,  0, _
     0,  0,  0,  0,  0, 96, 96,  0, _
     2,  4,  8, 16, 32, 64,128,  0, _
   124,134,138,146,162,194,124,  0, _
    16, 16,112, 16, 16, 16,124,  0, _
   124,130,  2,124,128,130,254,  0, _
   124,130,  2, 60,  2,130,124,  0, _
     8, 24, 40, 72,136,254,  8,  0, _
   254,128,128,252,  2,130,124,  0, _
   124,130,128,252,130,130,124,  0, _
   254,130,  2,  4,  8, 16, 16,  0, _
   124,130,130,124,130,130,124,  0, _
   124,130,130,126,  2,130,124,  0, _
     0, 32, 32,  0,  0, 32, 32,  0, _
     0, 32, 32,  0, 32, 32, 64,  0, _
    12, 16, 32, 64, 32, 16, 12,  0, _
     0,  0,254,  0,254,  0,  0,  0, _
    96, 16,  8,  4,  8, 16, 96,  0, _
   124,130,  4,  8, 16,  0, 16,  0, _
   124,130,154,170,158,128,124,  0, _
    56, 68,130,254,130,130,130,  0, _
   252, 34, 34, 60, 34, 34,252,  0, _
    60, 66,128,128,128, 66, 60,  0, _
   248, 36, 34, 34, 34, 36,248,  0, _
   254, 34, 40, 56, 40, 34,254,  0, _
   254, 34, 40, 56, 40, 32,112,  0, _
    60, 66,128,128,142, 66, 60,  0, _
   238, 68, 68,124, 68, 68,238,  0, _
   254, 16, 16, 16, 16, 16,254,  0, _
    14,  4,  4,  4,132,132,120,  0, _
   238, 68, 72,112, 72, 68,238,  0, _
   112, 32, 32, 32, 32, 34,254,  0, _
   198,108, 84, 84, 84, 68,238,  0, _
   238, 68,100, 84, 76, 68,238,  0, _
    56, 68,130,130,130, 68, 56,  0, _
   252, 34, 34, 60, 32, 32,112,  0, _
    56, 68,130,146,138, 68, 58,  0, _
   252, 34, 34, 60, 40, 36,114,  0, _
   124,130,128,124,  2,130,124,  0, _
   254,146, 16, 16, 16, 16, 56,  0, _
   238, 68, 68, 68, 68, 68, 56,  0, _
   238, 68, 68, 68, 68, 40, 16,  0, _
   238, 68, 68, 84, 84, 84, 40,  0, _
   238, 68, 40, 16, 40, 68,238,  0, _
   238, 68, 40, 16, 16, 16, 56,  0, _
   254,132,  8, 16, 32, 66,254,  0, _
    56, 32, 32, 32, 32, 32, 56,  0, _
   128, 64, 32, 16,  8,  4,  2,  0, _
    56,  8,  8,  8,  8,  8, 56,  0, _
    16, 56, 84,146, 16, 16, 16,  0, _
     0,  0,  0,  0,  0,  0,255,  0, _
    28, 34, 32,120, 32, 34,254,  0, _
     0,112,  8,120,136,136,124,  0, _
   224, 64, 64,120, 68, 68,248,  0, _
     0, 56, 68,128,128, 68, 56,  0, _
    28,  8,  8,120,136,136,124,  0, _
     0,120,132,132,248,128,124,  0, _
    24, 32, 32,112, 32, 32,112,  0, _
     0,120,132,132,124,  4,120,  0, _
   224, 64, 64,120, 68, 68,238,  0, _
     0, 16,  0, 48, 16, 16,124,  0, _
     8,  0, 24,  8,  8, 72, 48,  0, _
   224, 72, 80, 96, 80, 72,228,  0, _
    64, 64, 64, 64, 64, 72, 48,  0, _
     0,104, 84, 84, 84, 68,238,  0, _
     0,120, 68, 68, 68, 68,238,  0, _
     0, 48, 72,132,132, 72, 48,  0, _
     0,248, 68, 68,120, 64,224,  0, _
     0,124,136,136,120,  8, 28,  0, _
     0,248, 68, 68, 64, 64,224,  0, _
     0,120,128,120,  4,132,120,  0, _
   192, 64,112, 64, 68, 68, 56,  0, _
     0,238, 68, 68, 68, 68, 56,  0, _
     0,238, 68, 68, 68, 40, 16,  0, _
     0,238, 68, 84, 84, 84, 40,  0, _
     0,204, 72, 48, 48, 72,204,  0, _
     0,238, 68, 68, 60,  4,120,  0, _
     0,252,136, 16, 32, 68,252,  0, _
    60, 32, 32,192, 32, 32, 60,  0, _
    16, 16, 16, 16, 16, 16, 16,  0, _
   240, 16, 16, 12, 16, 16,240,  0, _
   136, 84, 34,  0,  0,  0,  0, 60, _
    66,153,161,161,153, 66, 60 _
}
Poke uInteger 23606, (@font (0)) - 256 'Pointer to Font
Poke uInteger 23675,@UDGs 'Pointer to UDG

print at 0,0;"\{i7}\{p1}\{b1} Chessboard Attack 2011 by LCD ";
print at 2,1;"Software used:";
print at 3,2;"*) ZX BASIC Compiler (Boriel)";
print at 4,2;"*) Retro-X";
print at 5,2;"*) BorIDE";
print at 6,2;"*) ZX Spin Emulator";
print at 9,1;"Setup:";
print at 10,1;"[1] 2-Minutes game (profi)";
print at 11,1;"[2] 5-Minutes game (normal)";
print at 12,1;"[3] 10-Minutes game (easy)";
print at 13,1;"[D] Double chess pieces";

print at 15,1;"Use keys: Q,A,O,P,M/Space & H";
print at 16,1;"or Sinclair Joystick";
print at 18,1;"Written for Scene+ Disczine";
print at 19,1;"Code&GFX by Leszek Chmielewski"
print at 20,1;"Music by Kriss"

print at 22,1;"Press S to Start the game";
a=0
waitnokey()

'Set Maximal time until game over, in frames
maxtime=30050
multiplier=1 'Bonus Multiplicator
print at 12,2;"\{f1}3"
if sets=1 then
   print at 13,2;"\{f0}D";
Else
   print at 13,2;"\{f1}D";
end If

while a=0
   key$=inkey$
   if key$="3" then maxtime=30050:multiplier=1:print at 10,2;"\{f0}1";at 11,2;"\{f0}2";at 12,2;"\{f1}3";:end If
   if key$="2" then maxtime=15050:multiplier=2:print at 10,2;"\{f0}1";at 11,2;"\{f1}2";at 12,2;"\{f0}3";:end If
   if key$="1" then maxtime=6050:multiplier=5:print at 10,2;"\{f1}1";at 11,2;"\{f0}2";at 12,2;"\{f0}3";:end If
   if key$="s" then a=1:end if
   if key$="d" and sets=1 then
      sets=2
      print at 13,2;"\{f1}D";
      waitnokey()
   elseif key$="d" and sets=2 then
      sets=1
      print at 13,2;"\{f0}D";
      waitnokey()
   end If
wend

'Set random seed and reset timer
randomize
cls
score=0
poke Uinteger 23672,0 'Reset the Seed system variable
ScoreBoard()

'Setup pieces on field
SetFigures(8*sets,1) 'Pawn
SetFigures(2*sets,2) 'Rook
SetFigures(2*sets,3) 'Knight
SetFigures(2*sets,4) 'Bishop
SetFigures(1*sets,5) 'Queen
SetFigures(1*sets,6) 'King

'Set variables
figures=16*sets 'figures to find
lives=5 'how often you can point an unoccupied field
won=0 'Win-condition flag
ShowPieces() 'Display the pieces

posx=7:posy=7 'Position of my king piece
ScanFields(posx,posy) 'Scan which pieces are in attacking position

print at 12,26;lives;" ";
print at 9,25;figures;" ";
print at 18,25;"\{p0}\{i2}\{b1}000000";
Mainloop:
x1=posx*3+1:y1=posy*3+1
gosub DisplayMyKing
KeyLoop:
'Check controls keys and move my king around

key$=inkey$
if (key$="o" or key$="6") and posx>0 then EmptyField(posx,posy):posx=posx-1:goto move:end if
if (key$="p" or key$="7") and posx<7 then EmptyField(posx,posy):posx=posx+1:goto move:end if
if (key$="q" or key$="9") and posy>0 then EmptyField(posx,posy):posy=posy-1:goto move:end if
if (key$="a" or key$="8") and posy<7 then EmptyField(posx,posy):posy=posy+1:goto move:end if
'Check for fire key
if key$=" " or key$="m" or key$="0" then waitnokey():gosub search:waitnokey():end if
if key$="h" then gosub hold:end if
'If moved into the field occupied by another chess piece, it is game over. All lifes are lost and display where the figures are
if ScanField(posx,posy,7) or lives=0 then
   goto PlayerLoss
end if
if won then
   goto PlayerWins
end If
gosub Checktime
goto KeyLoop
End

move:
ScanFields(posx,posy):gosub DisplayMyKing:waitnokey():goto Mainloop
move1:
StoreAttr(px,py):AttrSquare(px,py,24):waitnokey():return

search:
'Cursor movement
px=posx
py=posy
orgx=px
orgy=py
StoreAttr(px,py)
AttrSquare(px,py,24)
do
   key$=inkey$
   if (key$="o" or key$="6") and px>0 then RestoreAttr(px,py):px=px-1:gosub move1:end If
   if (key$="p" or key$="7") and px<7 then RestoreAttr(px,py):px=px+1:gosub move1:end If
   if (key$="q" or key$="9") and py>0 then RestoreAttr(px,py):py=py-1:gosub move1:end If
   if (key$="a" or key$="8") and py<7 then RestoreAttr(px,py):py=py+1:gosub move1:end If
   if key$="h" then gosub hold:end if
   gosub Checktime
loop until key$=" " or key$="m" or key$="0"
RestoreAttr(px,py)
scan=ScanField(px,py,255)
if (px=orgx and py=orgy) or (scan band 128)=0 then
   goto searchEnd
end if
if (scan band 15)=0 then
   EmptyField(px,py)
   lives=lives-1
   print at 12,26;lives;" ";
else
   PutField(px,py,scan band 127)
   DisplaySinglePiece(px,py)
   for a=0 to 15 'Flashing square
      AttrSquare(px,py,23)
      pause 2
      AttrSquare(px,py,55)
      pause 2
   next a
   PutField(px,py,scan band 96)
   EmptyField(px,py)
   ScanFields(orgx,orgy)
   figures=figures-1
   if figures=0 then won=1:end if
   print at 9,25;figures;" ";
   restzeit=int((maxtime-peek(uinteger,23672))/500)
   score=score+(sets*multiplier*restzeit)
   print at 18,25;"\{p0}\{i2}\{b1}"+Lset(str(score),"0",6);
end if
searchEnd:
key$=""
return

DisplayMyKing:
scan=ScanField(posx,posy,255)
white=scan&32
black=scan&64
if white then adr=@OKingGFX1
elseif black then adr=@OKingGFX2
end if
putblock(posx*3,posy*3,3,3,adr)
return

PlayerWins:
cls
score=score+1000
print at 10,7;"\{f1}Yess! Yes! Yeeees!!!";
print at 12,1;"\{f1}Congratulations, you did it!!!";
print at 14,1;"\{f1}Score: ";score;" Points";
while inkey$<>" ":wend
waitnokey()
goto beginn
PlayerLoss:
adr=@chessboard
for a=0 to 63
poke adr+a,peek(adr+a) band 127
next a
ShowPieces()
print at 10,9;"\{f1}Oh noooooo!!!";
print at 12,1;"\{f1}Sorry, but it is not your day!";
print at 14,1;"\{f1}Score: ";score;" Points";
while inkey$<>" ":wend
waitnokey()
goto beginn
Checktime:
   if timer(maxtime)=0 then
      goto PlayerLoss
   end if
   return

hold:
   actual=peek(uinteger,23672)
   waitnokey()
   print ink 7;flash 1;at 15,25;"Pause"
   while inkey$="":wend
   poke uinteger 23672,actual
   return
   

chessboard:
asm
   defb 0,0,0,0,0,0,0,0
   defb 0,0,0,0,0,0,0,0
   defb 0,0,0,0,0,0,0,0
   defb 0,0,0,0,0,0,0,0
   defb 0,0,0,0,0,0,0,0
   defb 0,0,0,0,0,0,0,0
   defb 0,0,0,0,0,0,0,0
   defb 0,0,0,0,0,0,0,0
end asm
chessboard1:
asm
   defb 160,192,160,192,160,192,160,192
   defb 192,160,192,160,192,160,192,160
   defb 160,192,160,192,160,192,160,192
   defb 192,160,192,160,192,160,192,160
   defb 160,192,160,192,160,192,160,192
   defb 192,160,192,160,192,160,192,160
   defb 160,192,160,192,160,192,160,192
   defb 192,160,192,160,192,160,192,32
end asm

overlay:
'0=Leer
'1=Bauer (1)
'2=Turm (2)
'3=Springer (4)
'4=Läufer (8)
'5=Königin (16)
'6=König (32)

'+128=hidden
'+64=White field
'+32=Black field
asm
   defb 111,079,111,079,111,079,111,079
   defb 079,111,079,111,079,111,079,111
   defb 111,079,111,079,111,079,111,079
   defb 079,111,079,111,079,111,079,111
   defb 111,079,111,079,111,079,111,079
   defb 079,111,079,111,079,111,079,111
   defb 111,079,111,079,111,079,111,079
   defb 079,111,079,111,079,111,079,111
end asm
' Graphics:
UDGs:
asm
   DEFB   000,000,016,056,056,016,124,000
   DEFB   000,084,124,056,056,124,124,000
   DEFB   000,016,056,120,024,056,124,000
   DEFB   000,016,048,108,124,056,124,000
   DEFB   000,084,040,016,108,124,124,000
   DEFB   000,016,056,016,056,068,124,000
end asm
Attrbuffer:
asm
   defb 0,0,0,0,0,0,0,0,0
end asm

PawnGFX1:
asm
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,060,000,000,126,000,000
   DEFB   255,000,000,255,000,000,255,000
   DEFB   000,255,000,000,126,000,001,255
   DEFB   128,000,126,000,000,060,000,000
   DEFB   060,000,000,060,000,000,126,000
   DEFB   000,126,000,000,126,000,000,255
   DEFB   000,003,129,192,007,255,224,007
   DEFB   255,224,003,255,192,000,000,000
   DEFB   111,111,111,111,111,111,111,111
   DEFB   111
end asm
PawnGFX2:
asm
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,060,000,000,126,000,000
   DEFB   255,000,000,255,000,000,255,000
   DEFB   000,255,000,000,126,000,001,255
   DEFB   128,000,126,000,000,060,000,000
   DEFB   060,000,000,060,000,000,126,000
   DEFB   000,126,000,000,126,000,000,255
   DEFB   000,003,129,192,007,255,224,007
   DEFB   255,224,003,255,192,000,000,000
   DEFB   079,079,079,079,079,079,079,079
   DEFB   079
end asm

TowerGFX1:
asm
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,015,060,240,015,060,240,015
   DEFB   060,240,015,255,240,015,255,240
   DEFB   007,255,224,002,000,064,003,255
   DEFB   192,003,255,192,003,255,192,003
   DEFB   255,192,003,255,192,003,255,192
   DEFB   003,255,192,003,255,192,007,255
   DEFB   224,014,000,112,031,255,248,031
   DEFB   255,248,015,255,240,000,000,000
   DEFB   111,111,111,111,111,111,111,111
   DEFB   111
end asm
TowerGFX2:
asm
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,015,060,240,015,060,240,015
   DEFB   060,240,015,255,240,015,255,240
   DEFB   007,255,224,002,000,064,003,255
   DEFB   192,003,255,192,003,255,192,003
   DEFB   255,192,003,255,192,003,255,192
   DEFB   003,255,192,003,255,192,007,255
   DEFB   224,014,000,112,031,255,248,031
   DEFB   255,248,015,255,240,000,000,000
   DEFB   079,079,079,079,079,079,079,079
   DEFB   079
end asm

KnightGFX1:
asm
   DEFB   000,000,000,000,003,128,000,031
   DEFB   128,000,127,000,001,191,000,007
   DEFB   255,128,031,255,128,031,255,128
   DEFB   007,255,192,015,191,192,000,127
   DEFB   192,000,255,224,001,255,224,003
   DEFB   255,224,007,255,224,007,255,224
   DEFB   003,255,192,000,255,000,001,255
   DEFB   128,003,000,192,015,255,240,015
   DEFB   255,240,007,255,224,000,000,000
   DEFB   111,111,111,111,111,111,111,111
   DEFB   111
end asm
KnightGFX2:
asm
   DEFB   000,000,000,000,003,128,000,031
   DEFB   128,000,127,000,001,191,000,007
   DEFB   255,128,031,255,128,031,255,128
   DEFB   007,255,192,015,191,192,000,127
   DEFB   192,000,255,224,001,255,224,003
   DEFB   255,224,007,255,224,007,255,224
   DEFB   003,255,192,000,255,000,001,255
   DEFB   128,003,000,192,015,255,240,015
   DEFB   255,240,007,255,224,000,000,000
   DEFB   079,079,079,079,079,079,079,079
   DEFB   079
end asm

LaeuferGFX1:
asm
   DEFB   000,000,000,000,024,000,000,060
   DEFB   000,000,060,000,000,038,000,000
   DEFB   159,000,001,207,128,003,231,192
   DEFB   003,247,192,007,255,224,007,255
   DEFB   224,007,255,224,007,255,224,003
   DEFB   255,192,001,255,128,000,255,000
   DEFB   000,255,000,001,255,128,003,255
   DEFB   192,007,000,224,015,255,240,015
   DEFB   255,240,007,255,224,000,000,000
   DEFB   111,111,111,111,111,111,111,111
   DEFB   111
end asm
LaeuferGFX2:
asm
   DEFB   000,000,000,000,024,000,000,060
   DEFB   000,000,060,000,000,038,000,000
   DEFB   159,000,001,207,128,003,231,192
   DEFB   003,247,192,007,255,224,007,255
   DEFB   224,007,255,224,007,255,224,003
   DEFB   255,192,001,255,128,000,255,000
   DEFB   000,255,000,001,255,128,003,255
   DEFB   192,007,000,224,015,255,240,015
   DEFB   255,240,007,255,224,000,000,000
   DEFB   079,079,079,079,079,079,079,079
   DEFB   079
end asm

QueenGFX1:
asm
   DEFB   000,000,000,000,024,000,000,060
   DEFB   000,000,060,000,000,102,000,001
   DEFB   255,128,071,126,226,094,060,122
   DEFB   076,153,050,097,195,134,063,255
   DEFB   252,031,255,248,015,255,240,007
   DEFB   255,224,003,255,192,002,000,064
   DEFB   015,255,240,011,102,208,031,255
   DEFB   248,024,000,024,063,255,252,063
   DEFB   255,252,031,255,248,000,000,000
   DEFB   111,111,111,111,111,111,111,111
   DEFB   111
end asm
QueenGFX2:
asm
   DEFB   000,000,000,000,024,000,000,060
   DEFB   000,000,060,000,000,102,000,001
   DEFB   255,128,071,126,226,094,060,122
   DEFB   076,153,050,097,195,134,063,255
   DEFB   252,031,255,248,015,255,240,007
   DEFB   255,224,003,255,192,002,000,064
   DEFB   015,255,240,011,102,208,031,255
   DEFB   248,024,000,024,063,255,252,063
   DEFB   255,252,031,255,248,000,000,000
   DEFB   079,079,079,079,079,079,079,079
   DEFB   079
end asm

KingGFX1:
asm
   DEFB   000,000,000,000,126,000,000,102
   DEFB   000,000,090,000,030,090,120,051
   DEFB   102,204,097,255,134,076,102,050
   DEFB   095,102,250,095,060,250,079,153
   DEFB   242,103,219,230,055,219,236,019
   DEFB   219,200,027,219,216,008,000,016
   DEFB   015,255,240,011,102,208,031,255
   DEFB   248,024,000,024,063,255,252,063
   DEFB   255,252,031,255,248,000,000,000
   DEFB   111,111,111,111,111,111,111,111
   DEFB   111
end asm
KingGFX2:
asm
   DEFB   000,000,000,000,126,000,000,102
   DEFB   000,000,090,000,030,090,120,051
   DEFB   102,204,097,255,134,076,102,050
   DEFB   095,102,250,095,060,250,079,153
   DEFB   242,103,219,230,055,219,236,019
   DEFB   219,200,027,219,216,008,000,016
   DEFB   015,255,240,011,102,208,031,255
   DEFB   248,024,000,024,063,255,252,063
   DEFB   255,252,031,255,248,000,000,000
   DEFB   079,079,079,079,079,079,079,079
   DEFB   079
end asm

OKingGFX1:
asm
   DEFB   000,000,000,000,126,000,000,102
   DEFB   000,000,090,000,030,090,120,051
   DEFB   102,204,097,255,134,076,102,050
   DEFB   095,102,250,095,060,250,079,153
   DEFB   242,103,219,230,055,219,236,019
   DEFB   219,200,027,219,216,008,000,016
   DEFB   015,255,240,011,102,208,031,255
   DEFB   248,024,000,024,063,255,252,063
   DEFB   255,252,031,255,248,000,000,000
   DEFB   110,106,104,110,106,104,110,106
   DEFB   104
end asm
OKingGFX2:
asm
   DEFB   000,000,000,000,126,000,000,102
   DEFB   000,000,090,000,030,090,120,051
   DEFB   102,204,097,255,134,076,102,050
   DEFB   095,102,250,095,060,250,079,153
   DEFB   242,103,219,230,055,219,236,019
   DEFB   219,200,027,219,216,008,000,016
   DEFB   015,255,240,011,102,208,031,255
   DEFB   248,024,000,024,063,255,252,063
   DEFB   255,252,031,255,248,000,000,000
   DEFB   078,074,072,078,074,072,078,074
   DEFB   072
end asm

EmptyGFX1:
asm
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   104,104,104,104,104,104,104,104
   DEFB   104
end asm
EmptyGFX2:
asm
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   000,000,000,000,000,000,000,000
   DEFB   072,072,072,072,072,072,072,072
   DEFB   072
end asm

HiddenGFX:
asm
   DEFB   255,255,254,213,085,084,170,190
   DEFB   170,213,097,084,170,128,170,213
   DEFB   028,084,171,042,106,214,086,084
   DEFB   170,108,106,213,216,212,170,177
   DEFB   170,213,099,084,170,198,170,213
   DEFB   077,084,170,250,170,213,085,084
   DEFB   170,186,170,213,069,084,170,198
   DEFB   170,213,069,084,170,186,170,213
   DEFB   085,084,170,170,170,000,000,000
   DEFB   087,087,087,087,087,087,087,087
   DEFB   087
end asm
------------------------------------------------------------
http://lcd-one.da.ru redirector is dead
Visit my http://members.inode.at/838331/index.html home page!
<<

boriel

Site Admin

Posts: 1463

Joined: Wed Nov 01, 2006 6:18 pm

Location: Santa Cruz de Tenerife, Spain

Post Mon Jul 18, 2011 8:04 am

Re: Chessboard Attack + Source code

Awesome! :o
I MUST do a game too! :oops:

You should give a tutorial on how to include sound (perhaps even a library). Many people are asking for this (remember the sound thread). Or even a library.
<<

LCD

Posts: 596

Joined: Fri Feb 13, 2009 3:11 pm

Location: Vienna, Austria

Post Mon Jul 18, 2011 9:52 am

Re: Chessboard Attack + Source code

boriel wrote:Awesome! :o
I MUST do a game too! :oops:

You should give a tutorial on how to include sound (perhaps even a library). Many people are asking for this (remember the sound thread). Or even a library.


In the BorIDE the Interruptmaker is included now, but I'm not decided how to link the code with compiled program.
I think about two methods:
1). Make a binary and inject it into TAP after compilation. This is the easiest way for me, but disadvantages are that the source will not contain these code, and it will work only for TAP and TZX output, and the user must modify the loader by hand.
2). Create ASM code in Clipboard, so the user will be able to put it into the source. This is much harder to do because the Interrupt vectors will not work from any address, so I must ALIGN them (not automaticaly because Interrupt vector must not be set below 128). Maybe a mix of ORG and ALIGN? This must be placed at the end of code.
3). Library: Very hard to do because of the adressing limitations of interrupts.
I think, the second solution is better, but I must also make a TAP 2 ASM decoder to put the music from TAP into source code.
My interruptmaker 1.2+ (available now from WOS) is also able to switch to a different memory bank of Spectrum 128 to play music stored at this place, and also keeps track which screen is displayed. Until the Interruptmaker is fully integrated into BorIDE, anyone can use Interruptmaker.
It produces multiple chunks of code that must be hand-saved:
Vectortable: 256 Byte boundary in memory, has 257 bytes of same value (due to the problem with "floating Bus", two bytes combile the H/L bytes of address to interrupt controll routine.
Vectorjump address (257 bytes boundary): This is the start of intterrupt handling routine which save all important registers (AF, BC, DE, HL and IX + IY to be compatible with some disc drives) and restore them again (never change Stack pointer while interrupts are running).
On/Off code: Code to switch interrupts on and off.
Interrupt call address defines which address will be used in vectorjump routine to be called 50 times per second. In soundtracker this is Startaddress of compiled song with player plus 6 bytes (This info will be displayed at compilation time).
All you need is now to init the song and switch interrupts on using RANDOMIZE USR InterruptsOn.

I'm really curious what kind of game you would write with this tool, Boriel.
------------------------------------------------------------
http://lcd-one.da.ru redirector is dead
Visit my http://members.inode.at/838331/index.html home page!
<<

LCD

Posts: 596

Joined: Fri Feb 13, 2009 3:11 pm

Location: Vienna, Austria

Post Thu Nov 22, 2012 5:58 pm

Re: Chessboard Attack + Source code

New Version of Chessboard Attack surfaced. It is the version 1.1 with many improvments. New source code will be uploaded with the game at WOS, but anyone can download the new version from my website, but without sources. I announce also the work on "Chessboard Attack II" has begunn. At moment designing the game mechanics without coding anythin yet. But the game will be very different from the first part. It is again a mix between Chess and an other game genere that has not been done on the Spectrum because of its imense amount of mathematics (crossing it with chess rules will reduce the amount).
------------------------------------------------------------
http://lcd-one.da.ru redirector is dead
Visit my http://members.inode.at/838331/index.html home page!

Return to Gallery

Who is online

Users browsing this forum: No registered users and 3 guests

cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group.
Designed by Vjacheslav Trushkin for Free Forums/DivisionCore.

phpBB SEO