| Welcome, Guest |
You have to register before you can post on our site.
|
| Forum Statistics |
» Members: 260
» Latest member: Ra001
» Forum threads: 1,073
» Forum posts: 6,437
Full Statistics
|
| Online Users |
There are currently 292 online users.
» 0 Member(s) | 289 Guest(s)
Applebot, Bing, Google
|
| Latest Threads |
Strange Happenings
Forum: Bug Reports
Last Post: boriel
05-23-2025, 09:15 AM
» Replies: 4
» Views: 1,835
|
.tap file code not execut...
Forum: Help & Support
Last Post: Zoran
04-28-2025, 10:59 AM
» Replies: 4
» Views: 2,020
|
Exit from more than one l...
Forum: Wishlist
Last Post: Duefectu
04-23-2025, 10:06 PM
» Replies: 3
» Views: 1,681
|
put small ASM programs li...
Forum: How-To & Tutorials
Last Post: Zoran
04-18-2025, 02:02 PM
» Replies: 6
» Views: 4,074
|
Creating +3 Menus - Loadi...
Forum: Help & Support
Last Post: merlinkv
04-16-2025, 02:08 PM
» Replies: 6
» Views: 2,826
|
Randomize not very random...
Forum: Help & Support
Last Post: Zoran
04-08-2025, 10:40 AM
» Replies: 4
» Views: 2,697
|
Scope rules
Forum: Bug Reports
Last Post: Zoran
04-04-2025, 09:46 AM
» Replies: 2
» Views: 1,445
|
Using constants not allow...
Forum: Bug Reports
Last Post: baltasarq
03-19-2025, 10:00 PM
» Replies: 8
» Views: 3,615
|
404 page not found
Forum: Documentation
Last Post: boriel
03-08-2025, 07:16 PM
» Replies: 5
» Views: 4,675
|
Spectrum keywords codes
Forum: Bug Reports
Last Post: boriel
03-08-2025, 11:00 AM
» Replies: 1
» Views: 1,162
|
|
|
| Chessboard Attack + Source code |
|
Posted by: LCD - 07-17-2011, 07:48 PM - Forum: Gallery
- Replies (3)
|
 |
"Chessboard Attack" is finally out. You can download it from my website or WOS now.
![[Image: cba_shot.png]](http://members.inode.at/838331/zx/cba_shot.png)
<!-- m --><a class="postlink" href="http://www.worldofspectrum.org/infoseekid.cgi?id=0026121">http://www.worldofspectrum.org/infoseek ... id=0026121</a><!-- m -->
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
|
|
|
| Please re-post |
|
Posted by: boriel - 07-15-2011, 07:43 PM - Forum: Gallery
- No Replies
|
 |
If you have done something and posted it in the "Show off..." thread, you can re-post it now in this sub-forum in a *SINGLE* post, so each program can have its own thread and we can discuss it in a more readable fashion.
|
|
|
| B Integer out of range |
|
Posted by: oblo - 07-12-2011, 05:38 PM - Forum: Help & Support
- Replies (8)
|
|
Hi all
First of all, I'd like to introduce myself. I'm new at this forum but I visit it always I have a doubt about the ZX Basic Compiler.
Now, I'm compiling a large basic program (about 37k) and while the execution in Basic is OK, when I compiled it in a .tzx and try to load it in an emulator, at the end of the load the error B Integer out of range, 30:1 is showed.
The info of the CODE block is 32768,37229 and here is the basic code of the loader:
10 CLEAR 32767
20 LOAD""CODE
30 RANDOMIZE USR 32768
Should I suppose that the program is too big?
Thanks and regards
|
|
|
|
| Returning to basic do not run PRINT.(*solved*) |
|
Posted by: compiuter - 07-01-2011, 05:00 PM - Forum: Bug Reports
- Replies (5)
|
|
I was testing an attr routine. I launch it with pokeing it and randomize usr 60000.
When returns to basic, the problem is if I put a single print, then returns out of memory.
Not this if I put a print at.
I think the compiler affects to variables ch add or something.
Code: Sub GetAddrTileFull(y, x, buf)
Dim attraddr as UInteger
attradr = AttrAddr(y, x)
POKE buf,peek(attradr-32)
POKE buf+1,peek(attradr-31)
POKE buf+2,peek(attradr-30)
POKE buf+3,peek(attradr+2)
POKE buf+4,peek(attradr+34)
POKE buf+5,peek(attradr+34+32)
POKE buf+6,peek(attradr+34+31)
POKE buf+7,peek(attradr+34+30)
POKE buf+8,peek(attradr+34+29)
POKE buf+9,peek(attradr+2+29)
POKE buf+10,peek(attradr-1)
POKE buf+11,peek(attradr-33)
End Sub
Dim x,y as uinteger
x=peek 23421
y=peek 23422
GetAddrTileFull(y,x,23400)
zxb attr1a.bas -T -B -a -Z -O1 --org 32768
Regards.
|
|
|
|
| Out of memory when using uinteger array (*solved*) |
|
Posted by: Darkstar - 06-08-2011, 07:14 PM - Forum: Bug Reports
- Replies (21)
|
|
Code: ' tn = TriangleNumber, mt = MaximumTriangles (# of), rn = RandomNumber, GraphicWidth, GraphicHeight, zn = ZeroNumber (Modifier) 'DIM udg(7) AS UBYTE => {0,1,3,7,15,31,63,127}
INK 6: PAPER 1: FLASH 0: BRIGHT 1: OVER 0: INVERSE 0: DIM tn, mt, rn, gw, gh, znw, znh AS UBYTE: DIM x(4,4) AS UINTEGER: DIM y(4,4) AS UINTEGER
'DIM x(4,4) AS FLOAT: DIM y(4,4) AS FLOAT
tn=0: mt=0: rn=0: znw=0: znh=16
gw=255: gh=175+znh: BORDER 1: CLS: PRINT AT 10,5;"The Sierpinski Triangle";: tn=1: mt=4 '256-1 '176-1
x(tn,1)=znw: y(tn,1)=znh: x(tn,2)=gw/2: y(tn,2)=gh: x(tn,3)=gw: y(tn,3)=znh: GOSUB FirstPoint: tn=tn+1
x(tn,1)=znw: y(tn,1)=gh: x(tn,2)=gw/2: y(tn,2)=znh: x(tn,3)=gw: y(tn,3)=gh: GOSUB FirstPoint: tn=tn+1
x(tn,1)=znw: y(tn,1)=gh: x(tn,2)=gw: y(tn,2)=gh/2: x(tn,3)=znw: y(tn,3)=znh: GOSUB FirstPoint: tn=tn+1
x(tn,1)=gw: y(tn,1)=gh: x(tn,2)=znw: y(tn,2)=gh/2: x(tn,3)=gw: y(tn,3)=znh: GOSUB FirstPoint
tn=1: PRINT AT 12,4;"Press any key to continue";
ScanAnyKey:
IF INKEY$="" THEN GO TO ScanAnyKey: END IF
RANDOMIZE : CLS
DrawTriangles:
rn=INT (RND*3)+1
x(tn,4)=(x(tn,4)+x(tn,rn))/2
y(tn,4)=(y(tn,4)+y(tn,rn))/2
PLOT x(tn,4),y(tn,4)
tn=tn+1: IF tn>mt THEN tn=1: END IF
GO TO DrawTriangles
FirstPoint:
x(tn,4)=x(tn,2): y(tn,4)=y(tn,2): RETURN
This crashes after a few pixels drawn with an out of memory error while if you use float it works fine under
the latest version of the compiler. In version 1.2.6 uinteger works without a hitch. The compilation options are:
zxb Triangles.bas --optimize=2 --output=TRIANGLES.ASM --asm --org=24576 --array-base=1 --string-base=1 --heap-size=1024
zxbasm TRIANGLES.ASM --output=TRIANGLES --tap --BASIC --autorun
On to another subject, what is the correct syntax for "DIM udg(7) AS UBYTE => {0,1,3,7,15,31,63,127}"
as a multidimensional array? I tried "DIM ma(2,2) AS UBYTE => {1,4,6,2,0,55}" but it did not work.
|
|
|
|
| Oh oh |
|
Posted by: Graeme - 06-04-2011, 03:17 PM - Forum: Help & Support
- Replies (12)
|
|
Hola all,
First off, before I forget, the contact form on boriel.com is broken, complains about not being able to call the WPsend function (with the latest IE and firefox beta 7)
Well, I used to program C++ for a living but my programming days are long gone.. I can't even get the compiler to work, I installed Python but I have no idea how to get it up and running.
I have a short ZXS program in basic - could I please send some kind person the text (10 lines of code or so) and you compile it and return a ZX Spectrum tape file?
I'd be so grateful! Thanks!!
Graeme
|
|
|
|
| Calling non-ZXB code with RANDOMIZE USR |
|
Posted by: LTee - 05-13-2011, 02:11 PM - Forum: Help & Support
- Replies (13)
|
|
Hi all, it's been a while but I've been kind of busy. :-)
My game project is almost complete, I just wanted to add some music. I wrote a couple of (quite bad) tunes with Beepola, compiled with the Music Box engine. I've loaded these high into memory (64000 up), well away from my ZXB code and I'm calling them with 'randomize usr X' from within ZXB. The player is configured to play the tune once and then return control to the caller.
I'm having a small problem that I can get around, but I wanted to ask about. If I call the music player from within a SUB or a FUNCTION, the Spectrum crashes after playing the tune. If I call it from OUTSIDE a SUB or FUNCTION (i.e. just from within the main code) then it returns fine.
For example:
Code: cls
pause 0
print "test"
randomize usr 64000
pause 0
print "test 2"
test()
stop
SUB test()
randomize usr 64000
END SUB
In the above code (surmising that the player is loaded at 64000), the tune plays and returns correctly after "test" is printed, but crashes after playing the tune after "test2" is printed.
Is calling external code via "randomize usr" actually supported? It's not in the Wiki, so I'm thinking 'not'. If it is supported, is there something else I should be doing before making such a call? Or is there a better way of doing this?
My main concern is that the call which appears to be working is actually doing something bad that I'm just not seeing immediately and might cause unexpected problems later.
Thanks for any insights! :-)
|
|
|
|
| GOTO (arithmetical expression) |
|
Posted by: JBGV - 05-09-2011, 08:23 PM - Forum: Help & Support
- Replies (2)
|
|
Hello!
Could anyone tell me how I can simulate "GOTO (arithmetical expression)":
ex:
Code: N can have a value between 1 and 20
GOTO (1000+(N*10))
I need to assign values to an array depends on the value "N", I had thought something like this:
Code: ASM
ORG 62000
DEFB 12,5,8,11,12,11,4,11,(...)
END ASM
DIM P(7) AS UBYTE
...
N=20
...
FOR B=0 TO 7
P(B)=PEEK (62000+N+B)
NEXT B
Is this efficient?
Is there a danger that the program itself erase the data stored at positions 62000?
THANKS
|
|
|
|
|
