I noticed that the assembler doesn't like using IX and IY as half registers. Is it unsupported, or using a different syntax than the one I expected - LD IXH,A ?
Technically, they aren't official Zilog instructions, but most assemblers go for them. It's sometimes really handy to load IX and IY in halves, or you desperately need that extra register :-)
From a manual on assembler:
More Control Over Index Registers
You know, you can access the high and low bytes of IX and IY. It's a little more complicated because the instructions aren't officially supported by ZiLog, and it is a little on the unelegant side. Nevertheless they can be useful in some circumstances, like when all your registers are locked up and you need an 8-bit counter bad.
The high byte of IX is called either IXH or HX (remember these are unofficial registers so there are no standard names). The low byte is called either IXL or LX. The high and low bytes of IY are named similarly.
To use a part of an index register in an instruction:
Pick an instruction that allows both H and L to be used as an operand, excepting shifts, rotates, BIT, SET, and RES.
Use H if you want the high byte, or L if you want the low byte.
Immediately precede this instruction with .DB $DD to use the IX half-registers, or .DB $FD to use the IY half-registers.
Example: LD E, IXH
.DB $DD
LD E, H
Example: SUB IYL
.DB $FD
SUB L
Be aware that once you specify a prefix, you are locked into using that index register's half-registers. It is impossible to combine the half-registers of HL, IX, or IY in one instruction:
.DB $DD ;LD IXH, IXL
LD H, L
Clearly, a US keyboard doesn't have this £ thing. I have no idea if it's on a spanish or austrian one. I doubt it. So, just in case you need it, with a default US character set, the ` (back quote) seems to do the same job in compiled code.
Chances are I'm the only person that's relevant to. But hey I'm sharing anyway. Hush.
I have polished a bit my sprite routine, writting it in just one file and erasing repeated code (it worked OK up to this point) and adding a new subroutine to set the background colour of the playing area. Wheter I use or not this routine (and even if I take it out of the sprite routine file and copy it in any part of the main program code) its causing the graphics behave strangely.
When I'm drawing the "show room" (the only one atm, where I'm trying the graphics and the movements) I call (via Gosub) the routines drawing the different parts, i.e.:
GOSUB ESQUINA -- DRAWS THE CORNERS
GOSUB HABITACINESCONPUERTA -- DRAWS THE "WALLS" AND THE DOORS
When I draw the decoration parts (i.e. a carpet, or different floor designs) I see one of the coordinates of the sprites is changed:
If I draw the carpet (GOSUB ALFOMBRA), then the transparent window has its Y coordinate changed, whatever the correct value is.
If I draw the star (GOSUB ESTRELLA), the main sprite's X coordinate is changed.
And so on. I'll copy the .bas files for the game and the library so you can check it changing between the decorations (MADERA, FLECHAIZDA,FLECHADERECHA,ESTRELLA,SUELOEQUIS,LABERINTO). Perhaps it makes any sense to you. I don't include the .rle file because its the same I sent you last time.
The main program:
Code:
#include <sinclair.bas>
#include <keys.bas>
'pause 0
'declaracion variables
DIM UP AS UBYTE: DIM DOWN AS UBYTE: DIM LEFT AS UBYTE: DIM RIGHT AS UBYTE
DIM X AS UBYTE: DIM XA AS UBYTE: DIM Y AS UBYTE: DIM YA AS UBYTE
DIM FRAME AS UBYTE: DIM DIRECCION AS UBYTE
DIM XE AS UBYTE: DIM XEA AS UBYTE: DIM YE AS UBYTE: DIM YEA AS UBYTE: DIM XVENT AS UBYTE: DIM YVENT AS UBYTE
DIM FRAMEE AS UBYTE:DIM VERTICAL AS UBYTE: DIM HORIZONTAL AS UBYTE: DIM CONTADORE AS UBYTE: DIM DIRECCIONE AS UBYTE
DIM VELOCIDAD AS UBYTE:DIM VELOCIDADE AS UBYTE
DIM PAPELFONDO AS UBYTE
DIM MAPA (0 TO 1,0 TO 14) AS uByte => {{5,0,1,0,1,0,1,1,1,1,1,0,0,0,0 } , _
{6,0,1,1,1,1,2,2,2,1,1,0,0,0,0 }}
'pantalla
DIM PANTALLA AS UBYTE
LET PANTALLA=0
'variables
LET X=80:LET XA=80:LET Y=120:LET YA=120
LET FRAME=0: LET DIRECCION=0
LET XE=60:LET XEA=60:LET YE=88:LET YEA=88: LET XVENT=96:LET YVENT=160
LET FRAMEE=0:LET VERTICAL=1:LET HORIZONTAL=0: LET CONTADORE=0:LET DIRECCIONE=0
LET VELOCIDAD=1:LET VELOCIDADE=2
LET PAPELFONDO=5
'imprime pantalla
unchunk (@pantalla,16384,2614)
paper PAPELFONDO: ink O: bright 0
'BUCLE PRINCIPAL
bucle:
DO
GOSUB teclado
GOSUB mayordom
GOSUB impresion
LOOP
end
'lectura del teclado
teclado:
LET UP=MULTIKEYS(KEYQ)
LET DOWN=MULTIKEYS(KEYA)
LET LEFT=MULTIKEYS(KEYO)
LET RIGHT=MULTIKEYS(KEYP)
IF UP AND (X-16)>25 AND Y>101-(X/2) AND Y<138+(X/2)THEN LET X=X-VELOCIDAD: LET DIRECCION=1:END IF
IF DOWN AND X+16<120 THEN LET X=X+VELOCIDAD: LET DIRECCION=0: END IF
IF LEFT AND Y>101-(X/2) THEN LET Y=Y-VELOCIDAD: LET DIRECCION=3:END IF
IF RIGHT AND Y<138+(X/2) THEN LET Y=Y+VELOCIDAD: LET DIRECCION=2:END IF
IF UP+DOWN+LEFT+RIGHT>0 THEN LET FRAME=FRAME+1:IF FRAME>1 THEN LET FRAME=0:END IF:END IF
RETURN
mayordom:
LET XE=XE+(VERTICAL*VELOCIDADE)
LET YE=YE+(HORIZONTAL*VELOCIDADE)
'IF INT (RND*100)=1 THEN LET VERTICAL=1:END IF
'IF INT (RND*100)=1 THEN LET HORIZONTAL=1: END IF
IF XE<43 OR XE>103 THEN LET VERTICAL=VERTICAL*-1:END IF
IF YE<101-(XE/2) OR YE>138+(XE/2) THEN LET HORIZONTAL=HORIZONTAL*-1:END IF
'LET CONTADORE=CONTADORE +1:IF CONTADORE>100 THEN LET DIRECCIONE=INT (RND*2):LET CONTADOREE=0:GOSUB CAMBIODIRE:END IF
LET FRAMEE=FRAMEE+1: IF FRAMEE>1 THEN LET FRAMEE=0:END IF
RETURN
CAMBIODIRE:
IF DIRECCIONE=0 THEN LET VERTICAL=VERTICAL*(-1):LET HORIZONTAL=0:END IF
IF DIRECCIONE=1 THEN LET HORIZONTAL =HORIZONTAL*-1:LET VERTICAL=0:END IF
RETURN
impresion:
ASM
HALT
; Wait for scan line
LD BC,1137
fspRedrawloop:
DEC BC
LD A,B
OR C
JR NZ,fspRedrawloop
END ASM
SUB psprite (xd as ubyte,yd as ubyte,gfx as uinteger)
POKE @esprite,xd: POKE @esprite+1,yd: POKE Uinteger (@esprite+2),gfx
POKE @xor1,121:POKE @xor2,122:POKE @xor3,123
gosub printsprite
END SUB
SUB xorsprite (xd as ubyte,yd as ubyte,gfx as uinteger)
POKE @esprite,xd: POKE @esprite+1,yd: POKE Uinteger (@esprite+2),gfx
POKE @xor1,169:POKE @xor2,170:POKE @xor3,171:POKE @mask+1,0: POKE @carry,167':POKE @esprite+5,7:'POKE @esprite+4,255':POKE @esprite+6,60
gosub printsprite
END SUB
SUB andsprite (xd as ubyte,yd as ubyte,gfx as uinteger)
POKE @esprite,xd: POKE @esprite+1,yd: POKE Uinteger (@esprite+2),gfx
POKE @xor1,161:POKE @xor2,162:POKE @xor3,163:POKE @mask+1,255:POKE @carry,0':POKE @esprite+5,0:POKE @esprite+4,246'230':POKE @esprite+6,0
gosub printsprite
END SUB
SUB orsprite (xd as ubyte,yd as ubyte,gfx as uinteger)
POKE @esprite,xd: POKE @esprite+1,yd: POKE Uinteger (@esprite+2),gfx
POKE @xor1,177:POKE @xor2,178:POKE @xor3,179
gosub printsprite
END SUB
SUB spriteh (h as ubyte)
POKE @altura+1,h
END SUB
SUB cpbuffer (xd as ubyte,yd as ubyte,buff as Uinteger)
POKE @buffer,xd:POKE @buffer+1,yd: POKE uinteger @buffer+5,buff
gosub copybuffer
END SUB
SUB rstbuffer (xd as ubyte,yd as ubyte,buff as Uinteger)
POKE @buffer,xd:POKE @buffer+1,yd: POKE uinteger @buffer+5,buff
gosub restorebuffer
END SUB
SUB cpattr (xd as ubyte, yd as ubyte, buff as Uinteger)
LET xattr=INT (xd/8): LET yattr=INT (yd/8): LET dirattr=22528+(32*xattr)+yattr
'POKE uinteger @buffer+5,buff
POKE buff,PEEK dirattr: POKE buff+1,PEEK (dirattr+1): POKE buff+2,PEEK (dirattr+2)
POKE buff+3,PEEK (dirattr+32): POKE buff+4,PEEK (dirattr+33): POKE buff+5,PEEK (dirattr+34)
POKE buff+6,PEEK (dirattr+64): POKE buff+7,PEEK (dirattr+65): POKE buff+8,PEEK (dirattr+66)
END SUB
SUB rstattr (xd as ubyte, yd as ubyte, buff as Uinteger)
LET xattr=INT (xd/8): LET yattr=INT (yd/8): LET dirattr=22528+(32*xattr)+yattr
'POKE uinteger @buffer+5,buff
POKE dirattr,PEEK buff: POKE dirattr+1,PEEK (buff+1): POKE dirattr+2,PEEK (buff+2)
POKE dirattr+32,PEEK (buff+3): POKE dirattr+33,PEEK (buff+4): POKE dirattr+34,PEEK (buff+5)
POKE dirattr+64,PEEK (buff+6): POKE dirattr+65,PEEK (buff+7): POKE dirattr+66,PEEK (buff+8)
END SUB
SUB fondocolor (col as ubyte)
POKE @dircol+1,col
ASM
ld a,14
ld hl,22630
lineacolor:
ld b,20
celdacolor:
END ASM
dircol:
ASM
ld (hl),12
inc hl
djnz celdacolor
ld DE,12
add hl,DE
dec a
jp nz,lineacolor
END ASM
END SUB
esprite:
ASM
xp: defb 0
yp: defb 0
gfxdir: defw 0
; This is the sprite routine and expects coordinates in (c ,b) form,
; where c is the vertical coord from the top of the screen (0-176), and
; b is the horizontal coord from the left of the screen (0 to 240).
; Sprite data is stored as you'd expect in its unshifted form as this
; routine takes care of all the shifting itself. This means that sprite
; handling isn't particularly fast but the graphics only take 1/8th of the
; space they would require in pre-shifted form.
; On entry HL must point to the unshifted sprite data.
sprit7: xor 7 ; complement last 3 bits.
inc a ; add one for luck!
sprit3: rl d ; rotate left...
rl c ; ...into middle byte...
rl e ; ...and finally into left character cell.
dec a ; count shifts we've done.
jr nz,sprit3 ; return until all shifts complete.
; Line of sprite image is now in e + c + d, we need it in form c + d + e.
ld a,e ; left edge of image is currently in e.
ld e,d ; put right edge there instead.
ld d,c ; middle bit goes in d.
ld c,a ; and the left edge back into c.
jr sprit0 ; we've done the switch so transfer to screen.
END ASM
printsprite:
ASM
sprite:
ld hl,(gfxdir)
ld bc,(xp)
ld (dispx),bc ; store coords in dispx for now.
call scadd ; calculate screen address.
END ASM
altura:
ASM
ld a,16 ; height of sprite in pixels.
sprit1: ex af,af' ; store loop counter.
push de ; store screen address.
ld c,(hl) ; first sprite graphic.
inc hl ; increment poiinter to sprite data.
ld d,(hl) ; next bit of sprite image.
inc hl ; point to next row of sprite data.
ld (sprtmp),hl ; store it for later.
END ASM
mask:
ASM
ld e,0 ; blank right byte for now.
ld a,b ; b holds y position.
and 7 ; how are we straddling character cells?
jr z,sprit0 ; we're not straddling them, don't bother shifting.
cp 8 ; 5 or more right shifts needed?
jr nc,sprit7 ; yes, shift from left as it's quicker.
end asm
carry:
asm
and a ; oops, carry flag is set so clear it.
sprit2: rr c ; rotate left byte right...
rr d ; ...through middle byte...
rr e ; ...into right byte.
dec a ; one less shift to do.
jr nz,sprit2 ; return until all shifts complete.
sprit0: pop hl ; pop screen address from stack.
ld a,(hl) ; what's there already.
END ASM
xor1:
ASM
xor c ; merge in image data. a9 169 a1 161 79 121 b1 177
ld (hl),a ; place onto screen.
inc l ; next character cell to right please.
ld a,(hl) ; what's there already.
END ASM
xor2:
ASM
xor d ; merge with middle bit of image. aa 170 a2 162 7a 122 b2 178
ld (hl),a ; put back onto screen.
inc l ; next bit of screen area.
ld a,(hl) ; what's already there.
END ASM
xor3:
ASM
xor e ; right edge of sprite image data. ab 171 a3 163 7b 123 b3 179
ld (hl),a ; plonk it on screen.
ld a,(dispx) ; vertical coordinate.
inc a ; next line down.
ld (dispx),a ; store new position.
and 63 ; are we moving to next third of screen?
jr z,sprit4 ; yes so find next segment.
and 7 ; moving into character cell below?
jr z,sprit5 ; yes, find next row.
dec l ; left 2 bytes.
dec l ; not straddling 256-byte boundary here.
inc h ; next row of this character cell.
sprit6: ex de,hl ; screen address in de.
ld hl,(sprtmp) ; restore graphic address.
ex af,af' ; restore loop counter.
dec a ; decrement it.
jp nz,sprit1 ; not reached bottom of sprite yet to repeat.
ret ; job done.
sprit4: ld de,30 ; next segment is 30 bytes on.
add hl,de ; add to screen address.
jp sprit6 ; repeat.
sprit5: ld de,63774 ; minus 1762.
add hl,de ; subtract 1762 from physical screen address.
jp sprit6 ; rejoin loop.
; This routine returns a screen address for (c, b) in de.
scadd: ld a,c ; get vertical position.
and 7 ; line 0-7 within character square.
add a,64 ; 64 * 256 = 16384 (Start of screen display)
ld d,a ; line * 256.
ld a,c ; get vertical again.
rrca ; multiply by 32.
rrca
rrca
and 24 ; high byte of segment displacement.
add a,d ; add to existing screen high byte.
ld d,a ; that's the high byte sorted.
ld a,c ; 8 character squares per segment.
rlca ; 8 pixels per cell, mulplied by 4 = 32.
rlca ; cell x 32 gives position within segment.
and 224 ; make sure it's a multiple of 32.
ld e,a ; vertical coordinate calculation done.
ld a,b ; y coordinate.
rrca ; only need to divide by 8.
rrca
rrca
and 31 ; squares 0 - 31 across screen.
add a,e ; add to total so far.
ld e,a ; hl = address of screen.
ret
END ASM
buffer:
ASM
xcoord: defb 0
ycoord: defb 0
altura: defb 0
gfx: defw 0
buf: defw 0
END ASM
copybuffer:
ASM
copybuffer:
;rutina para copiar algo en algun sitio, más o menos.
; This routine returns a screen address for (c, b) in de.
ld bc,(xcoord)
call scadd
ld (gfx),de
ld b,16
ld HL,(gfx) ;apuntar a la primera celda de la pantalla
ld DE,(buf) ;apuntar al buffer
bucle3: ld a,(HL) ;capturo el grafico en a
;LD C,a ;y lo paso a C
;ld a,(HL) ;cargo en a el contenido de la celda destino
;xor C ;xoreo con lo que traigo del grafico
ld (DE),a ;lo pinto en (hasta aquí sale xdd)
inc L
inc E
ld a,(HL)
ld (DE),a
inc L
inc E
ld a,(HL)
ld (DE),a
dec L
dec L
call uphl
inc E
djnz bucle3
ret
END ASM
restorebuffer:
ASM
restorebuffer:
;rutina para copiar algo en algun sitio, más o menos.
; This routine returns a screen address for (c, b) in de.
ld bc,(xcoord)
call scadd
ld (gfx),de
ld b,16
ld HL,(gfx) ;apuntar a la primera celda del destino
ld DE,(buf) ;apuntar al origen
bucle2: ld a,(DE) ;capturo el grafico en a
;LD C,a ;y lo paso a C
;ld a,(HL) ;cargo en a el contenido de la celda destino
;xor C ;xoreo con lo que traigo del grafico
ld (HL),a ;lo pinto en la pantalla (hasta aquí sale xdd)
inc L
inc E
ld a,(DE)
ld (HL),a
inc L
inc E
ld a,(DE)
ld (HL),a
dec L
dec L
call uphl
inc E
djnz bucle2
ret
uphl:
inc h
ld a,h
and 7
ret nz
ld a,l
add a,32
ld l,a
ret c
ld a,h
sub 8
ld h,a
ret
This version enhances zxbasm (ZX BASIC assembler), so the compilation process is much much faster:
Download here: <!-- m --><a class="postlink" href="http://www.boriel.com/files/zxb/zxbasic-1.2.5r1513e.msi">http://www.boriel.com/files/zxb/zxbasic-1.2.5r1513e.msi</a><!-- m -->
I think we need some word in the definition for subs and functions that makes -O2/3 NOT optimize something out of the loop because it doesn't seem to be called - but needs to be kept in, perhaps because it contains asm code that we need to keep.
REQUIRED SUB Name()
REQUIRED FUNCTION a(b as uInteger) as uinteger
or some such?
This then culminates in interesting stuff like
REQUIRED SUB initialize () AS INTERRUPT
<code>
END SUB
This version fix -O3 bug related to bit-rotation routines (mostly used in graphics and scroll routines).
Download here: <!-- m --><a class="postlink" href="http://www.boriel.com/files/zxb/zxbasic-1.2.5r1513c.msi">http://www.boriel.com/files/zxb/zxbasic-1.2.5r1513c.msi</a><!-- m -->
If you previously experienced any problem with -O3, you should try now with this new release.
Also, for people wanting to send me some test code: you may also send me the code in a private message attachment (e.g. you have a game you don't want others to see before it's finished, or even a commercial game, etc...)
I don't know how to call this, but heretic might be close. Let me explain what happens:
I'm making my crap game and I'm following strictly the programmers manual of good practics, you know, first I do the loading screen, then I do some graphics, sprite first and then the backgrounds and at last I try to do some code to move the whole thing with QAOPM (it could be I'm reading the manual upside down, yes).
Now I'm at the stage where I have the sprites done and I'm making the rooms' background. At this stage I just draw it all on the screen and when I'm happy with an item I add a ' before the line to make it a coment and move on to the next item. When I have everything, I will sort it all out.
Well, I had the first room layout. I did a carpet to decorate it. It was ok so I greyed it out (with the ' ) and started to desing a "David Star". When I print it, the first two graphics of the sprite data (which happen to be the mask for the sprite looking down) are corrupted. Somehow it seems that the background data (made with plots and draws) is overwritting the beginning of the sprite data. The strange thing is that if I print the carpet first and over it I print the star, nothing happens. And if I print the star making it double lined, everything is OK too.
So I'll send you a package with the code and attachements so you can check it if you want. No need to hurry up, I can workaround it and go on with the game.
It would be nice to be able to map the program produced in memory, work out where it is - and optionally, where gaps are (very useful for IM2 stuff) so that the gaps could be used. Even if only as buffer memory for other functions.