Now handles variable sized maps, and many textures.

This commit is contained in:
Martin Haye 2013-09-06 14:52:52 -07:00
parent 2c3931c826
commit af12b3862e
3 changed files with 386 additions and 256 deletions

View File

@ -38,6 +38,9 @@
<copy todir="${build.dir}/root/assets"> <copy todir="${build.dir}/root/assets">
<fileset dir="./data/images" includes="*.bin*"/> <fileset dir="./data/images" includes="*.bin*"/>
</copy> </copy>
<copy todir="${build.dir}/root/assets">
<fileset dir="./data/maps" includes="*.bin*"/>
</copy>
<copy todir="${build.dir}/root/assets"> <copy todir="${build.dir}/root/assets">
<fileset dir="./data/tables" includes="*.bin*"/> <fileset dir="./data/tables" includes="*.bin*"/>
</copy> </copy>

View File

@ -3,10 +3,10 @@
; Constants ; Constants
TOP_LINE = $2180 ; 24 lines down from top TOP_LINE = $2180 ; 24 lines down from top
NLINES = 128 NLINES = 128
SKY_COLOR_E = 1 ; blue SKY_COLOR_E = $11 ; blue
SKY_COLOR_O = 1 ; blue SKY_COLOR_O = $11 ; blue
GROUND_COLOR_E = 4 ; orange GROUND_COLOR_E = $14 ; orange
GROUND_COLOR_O = 0 ; black GROUND_COLOR_O = $00 ; black
TEX_SIZE = $555 ; 32x32 + 16x16 + 8x8 + 4x4 + 2x2 + 1x1 TEX_SIZE = $555 ; 32x32 + 16x16 + 8x8 + 4x4 + 2x2 + 1x1
; Byte offset for each pixel in the blit unroll ; Byte offset for each pixel in the blit unroll
@ -21,21 +21,21 @@ BLIT_OFF6 = 24
BLIT_STRIDE = 29 BLIT_STRIDE = 29
; Renderer zero page ; Renderer zero page
lineCt = $3 ; len 1 playerDir = $3 ; len 1
txNum = $4 ; len 1 playerX = $4 ; len 2 (hi=integer, lo=fraction)
txColumn = $5 ; len 1 playerY = $6 ; len 2 (hi=integer, lo=fraction)
pLine = $6 ; len 2
pDst = $8 ; len 2 pDst = $8 ; len 2
pTex = $A ; len 2 pTex = $A ; len 2
pixNum = $C ; len 1 pixNum = $C ; len 1
byteNum = $D ; len 1 byteNum = $D ; len 1
pTmp = $E ; len 2 pTmp = $E ; len 2
tmp = $10 ; len 2 tmp = $10 ; len 2
backBuf = $12 ; len 1 (value 0 or 1) mapWidth = $12 ; len 1
frontBuf = $13 ; len 1 (value 0 or 1) mapHeight = $13 ; len 1
pRayData = $14 ; len 2 pRayData = $14 ; len 2
playerX = $16 ; len 2 (hi=integer, lo=fraction) txNum = $16 ; len 1
playerY = $18 ; len 2 (hi=integer, lo=fraction) txColumn = $17 ; len 1
pLine = $18 ; len 2
rayDirX = $1A ; len 1 rayDirX = $1A ; len 1
rayDirY = $1B ; len 1 rayDirY = $1B ; len 1
stepX = $1C ; len 1 stepX = $1C ; len 1
@ -48,42 +48,34 @@ deltaDistX = $52 ; len 1
deltaDistY = $53 ; len 1 deltaDistY = $53 ; len 1
dist = $54 ; len 2 dist = $54 ; len 2
diff = $56 ; len 2 diff = $56 ; len 2
playerDir = $58 ; len 1 pMap = $58 ; len 2
lineCt = $5A ; len 1
; Other monitor locations ; Other monitor locations
a2l = $3E a2l = $3E
a2h = $3F a2h = $3F
resetVec = $3F2 resetVec = $3F2
; Tables and buffers
decodeTo01 = $800
decodeTo23 = $900
decodeTo45 = $A00
decodeTo56 = $B00
decodeTo57 = $C00
clrBlitRollE = $D00 ; size 3*(128/2) = $C0, plus 2 for tya and rts
clrBlitRollO = $DC2 ; size 3*(128/2) = $C0, plus 2 for tya and rts
XF00 = $E00 ; unused
prodosBuf = $AC00 ; temporary, before building the tables
screen = $2000
;--------------------------------- ;---------------------------------
; The following are all in aux mem... ; The following are all in aux mem...
expandVec = $800 ; size with expandCode: $30E9 expandVec = $800 ; size of expansion code: $30E9
expandCode = $900
textures = $3900 textures = $3900
tex0 = textures
tex1 = tex0+TEX_SIZE
tex2 = tex1+TEX_SIZE
tex3 = tex2+TEX_SIZE
texEnd = tex3+TEX_SIZE
; back to main mem ; back to main mem
;--------------------------------- ;---------------------------------
blitRoll = $B000 ; Unrolled blitting code. Size 29*128 = $E80, plus 1 for rts ; Main-mem tables and buffers
MLI = $BF00 ; Entry point for ProDOS MLI decodeTo01 = $A900
memMap = $BF58 ; ProDOS memory map decodeTo23 = $AA00
decodeTo45 = $AB00
decodeTo56 = $AC00
decodeTo57 = $AD00
clrBlitRollE = $AE00 ; size 3*(128/2) = $C0, plus 2 for tya and rts
clrBlitRollO = $AEC2 ; size 3*(128/2) = $C0, plus 2 for tya and rts
XAF84 = $AF84 ; unused
prodosBuf = $B000 ; temporary, before building the tables
blitRoll = $B000 ; Unrolled blitting code. Size 29*128 = $E80, plus 1 for rts
MLI = $BF00 ; Entry point for ProDOS MLI
memMap = $BF58 ; ProDOS memory map
; I/O locations ; I/O locations
kbd = $C000 kbd = $C000

View File

@ -3,22 +3,28 @@
.pc02 ; Enable 65c02 ops .pc02 ; Enable 65c02 ops
; This code is written bottom-up. That is, ; This code is written bottom-up. That is, simple routines first,
; simple routines first, then routines that ; then routines that call those to build complexity. The main
; call those to build complexity. The main
; code is at the very end. We jump to it now. ; code is at the very end. We jump to it now.
jmp test jmp main
; Conditional assembly flags ; Conditional assembly flags
DOUBLE_BUFFER = 1 ; whether to double-buffer DOUBLE_BUFFER = 1 ; whether to double-buffer
DEBUG = 0 ; turn on verbose logging DEBUG = 0 ; turn on verbose logging
; Shared constants, zero page, buffer locations, etc. ; Shared constants, zero page, buffer locations, etc.
.include "render.i" .include "render.i"
; Variables
backBuf: .byte 0 ; (value 0 or 1)
frontBuf: .byte 0 ; (value 0 or 1)
mapBase: .word 0
nTextures: .byte 0
; texture addresses ; texture addresses
texAddrLo: .byte <tex0,<tex1,<tex2,<tex3 MAX_TEXTURES = 20
texAddrHi: .byte >tex0,>tex1,>tex2,>tex3 texAddrLo: .res MAX_TEXTURES
texAddrHi: .res MAX_TEXTURES
; Movement amounts when walking at each angle ; Movement amounts when walking at each angle
; Each entry consists of an X bump and a Y bump, in 8.8 fixed point ; Each entry consists of an X bump and a Y bump, in 8.8 fixed point
@ -45,7 +51,7 @@ walkDirs:
.if DEBUG .if DEBUG
php php
pha pha
jsr _debugStr jsr _writeStr
.byte str,0 .byte str,0
pla pla
plp plp
@ -90,11 +96,30 @@ walkDirs:
.endif .endif
.endmacro .endmacro
; Debug support to print a string following the JSR, in high or low bit ASCII, .macro DEBUG_RDKEY
.if DEBUG
php
pha
phx
phy
jsr rdkey
ply
plx
pla
plp
.endif
.endmacro
; Non-debug function to print a string. Does not preserve registers.
.macro WRITE_STR str
jsr _writeStr
.byte str,0
.endmacro
; Support to print a string following the JSR, in high or low bit ASCII,
; terminated by zero. If the string has a period "." it will be followed ; terminated by zero. If the string has a period "." it will be followed
; automatically by the next address and a CR. ; automatically by the next address and a CR.
.if DEBUG _writeStr:
_debugStr:
pla pla
clc clc
adc #1 adc #1
@ -133,7 +158,6 @@ _debugStr:
lda @ld+1 lda @ld+1
pha pha
rts rts
.endif
;------------------------------------------------------------------------------- ;-------------------------------------------------------------------------------
; Multiply two bytes, quickly but somewhat inaccurately, using logarithms. ; Multiply two bytes, quickly but somewhat inaccurately, using logarithms.
@ -264,6 +288,7 @@ pow2_w_w:
; Cast a ray ; Cast a ray
; Input: pRayData, plus Y reg: precalculated ray data (4 bytes) ; Input: pRayData, plus Y reg: precalculated ray data (4 bytes)
; playerX, playerY (integral and fractional bytes of course) ; playerX, playerY (integral and fractional bytes of course)
; pMap: pointer to current row on the map (mapBase + playerY{>}*height)
; Output: lineCt - height to draw in double-lines ; Output: lineCt - height to draw in double-lines
; txColumn - column in the texture to draw ; txColumn - column in the texture to draw
castRay: castRay:
@ -301,12 +326,6 @@ castRay:
DEBUG_BYTE deltaDistY DEBUG_BYTE deltaDistY
DEBUG_LN DEBUG_LN
; Start at the player's position
lda playerX+1
sta mapX
lda playerY+1
sta mapY
; Next we need to calculate the initial distance on each side ; Next we need to calculate the initial distance on each side
; Start with the X side ; Start with the X side
lda playerX ; fractional byte of player distance lda playerX ; fractional byte of player distance
@ -333,14 +352,11 @@ castRay:
DEBUG_BYTE sideDistY DEBUG_BYTE sideDistY
DEBUG_LN DEBUG_LN
; We're going to use the Y register to index the map. Initialize it. ; Start at the player's position, and init Y reg for stepping in the X dir
lda mapY ldy playerX+1
asl ; assume map is 16 tiles wide... sty mapX
asl lda playerY+1
asl ; ...multiplying by 16 sta mapY
asl
adc mapX ; then add X to get...
tay ; ...starting index into the map.
; the DDA algorithm ; the DDA algorithm
@DDA_step: @DDA_step:
@ -368,7 +384,7 @@ castRay:
sta sideDistY sta sideDistY
lda deltaDistX ; re-init X distance lda deltaDistX ; re-init X distance
sta sideDistX sta sideDistX
lda mapData,y ; check map at current X/Y position lda (pMap),y ; check map at current X/Y position
beq @DDA_step ; nothing there? do another step. beq @DDA_step ; nothing there? do another step.
; We hit something! ; We hit something!
@hitX: @hitX:
@ -403,31 +419,35 @@ castRay:
.endif .endif
; taking a step in the Y direction ; taking a step in the Y direction
@takeStepY: @takeStepY:
tya ; get ready to adjust Y by a whole line lda pMap ; get ready to switch map row
bit stepY ; advance mapY in the correct direction bit stepY ; advance mapY in the correct direction
bmi @negY bmi @negY
inc mapY inc mapY
clc clc
adc #16 ; next row in the map adc mapWidth
bcc @checkY
inc pMap+1
bra @checkY bra @checkY
@negY: @negY:
dec mapY dec mapY
sec sec
sbc #16 sbc mapWidth
bcs @checkY
dec pMap+1
@checkY: @checkY:
sta pMap
.if DEBUG .if DEBUG
DEBUG_STR " sideY" DEBUG_STR " sideY"
jsr @debugSideData jsr @debugSideData
.endif .endif
tay ; row number to Y so we can index the map
lda sideDistX ; adjust side dist in Y dir lda sideDistX ; adjust side dist in Y dir
sec sec
sbc sideDistY sbc sideDistY
sta sideDistX sta sideDistX
lda deltaDistY ; re-init Y distance lda deltaDistY ; re-init Y distance
sta sideDistY sta sideDistY
lda mapData,y ; check map at current X/Y position lda (pMap),y ; check map at current X/Y position
bne @hitY ; nothing there? do another step. bne @hitY ; nothing there? do another step.
jmp @DDA_step jmp @DDA_step
@hitY: @hitY:
; We hit something! ; We hit something!
@ -546,6 +566,16 @@ castRay:
DEBUG_STR "sdy=" DEBUG_STR "sdy="
DEBUG_BYTE sideDistY DEBUG_BYTE sideDistY
DEBUG_LN DEBUG_LN
DEBUG_STR " pMap="
DEBUG_WORD pMap
DEBUG_STR "y="
sty tmp
DEBUG_BYTE tmp
DEBUG_STR "mapByte="
lda (pMap),y
sta tmp
DEBUG_BYTE tmp
DEBUG_LN
rts rts
@debugFinal: @debugFinal:
DEBUG_STR " lineCt=" DEBUG_STR " lineCt="
@ -602,6 +632,9 @@ drawRay:
sta pTex sta pTex
lda texAddrHi,x lda texAddrHi,x
sta pTex+1 sta pTex+1
DEBUG_STR "Ready to call, pTex="
DEBUG_WORD pTex
DEBUG_LN
; jump to the unrolled expansion code for the selected height ; jump to the unrolled expansion code for the selected height
lda lineCt lda lineCt
asl asl
@ -811,37 +844,6 @@ makeDecodeTbls:
bne @shiftA bne @shiftA
rts rts
; Clear all the memory we're going to fill
clearMem:
ldx #$10
lda #$BE
jmp clearScreen2
; Clear the screens
clearScreen:
ldx #>screen
.if DOUBLE_BUFFER
lda #>screen + $40 ; both hi-res screens
.else
lda #>screen + $20 ; one hi-res screen
.endif
clearScreen2:
sta @limit+1
ldy #0
sty pDst
tya
@outer:
stx pDst+1
@inner:
sta (pDst),y
iny
bne @inner
inx
@limit:
cpx #>screen + $20
bne @outer
rts
; Build table of screen line pointers ; Build table of screen line pointers
; on aux zero-page ; on aux zero-page
makeLines: makeLines:
@ -939,27 +941,55 @@ bload:
jmp monitor jmp monitor
@mliCommand: .res 10 ; 10 bytes should be plenty @mliCommand: .res 10 ; 10 bytes should be plenty
; Copy X pages starting at pg Y to aux mem ; Copy pTmp -> pDst (advancing both), length in X(lo) / Y(hi)
copyToAux: copyMem:
sta setAuxWr phx
sty pDst+1 tya
ldy #0 ldy #0
sty pDst tax
@lup: beq @lastPg
lda (pDst),y @pageLup:
lda (pTmp),y
sta (pDst),y sta (pDst),y
iny iny
bne @lup bne @pageLup
inc pTmp+1
inc pDst+1 inc pDst+1
dex dex
bne @lup bne @pageLup
sta clrAuxWr @lastPg:
plx
beq @done
@byteLup:
lda (pTmp),y
sta (pDst),y
inc pTmp
bne :+
inc pTmp+1
: inc pDst
bne :+
inc pDst+1
: dex
bne @byteLup
@done:
rts rts
; Test code to see if things really work ; Read a byte from pTmp and advance it
test: readPtmp:
phy
ldy #0
lda (pTmp),y
ply
inc pTmp
bne :+
inc pTmp+1
: cmp #0
rts
;-------------------------------------------------------------------------------
initMem:
DEBUG_STR "Clearing memory map." DEBUG_STR "Clearing memory map."
; Clear ProDOS mem map so it lets us load stuff anywhere we want ; Clear ProDOS mem map so it lets us load stuff anywhere we want
ldx #$18 ldx #$18
lda #1 lda #1
@memLup: @memLup:
@ -967,94 +997,150 @@ test:
lda #0 lda #0
dex dex
bne @memLup bne @memLup
; Make reset go to monitor ; Make reset go to monitor
lda #<monitor lda #<monitor
sta resetVec sta resetVec
lda #>monitor lda #>monitor
sta resetVec+1 sta resetVec+1
eor #$A5 eor #$A5
sta resetVec+2 sta resetVec+2
; Copy the expansion caller to low stack.
; Put ourselves high on the stack, then copy the expansion caller to low stack.
ldx #$FF
txs
ldx #12 ldx #12
: lda @callIt,x : lda @callIt,x
sta $100,x sta $100,x
dex dex
bpl :- bpl :-
bra :+ rts
@callIt: @callIt:
sta setAuxRd sta setAuxRd
jsr $10A jsr $10A
sta clrAuxRd sta clrAuxRd
rts rts
jmp (expandVec,x) jmp (expandVec,x)
:
;-------------------------------------------------------------------------------
; Establish the initial player position and direction ; Establish the initial player position and direction
setPlayerPos:
; X=2.5 ; X=2.5
lda #2 lda #2
sta playerX+1 sta playerX+1
lda #$80 lda #$80
sta playerX sta playerX
; Y=2.6 ; Y=1.5
lda #2 lda #1
sta playerY+1 sta playerY+1
lda #$80 lda #$80
sta playerY sta playerY
; direction=0 ; direction=0
lda #0 lda #12
sta playerDir sta playerDir
rts
; Load the texture expansion code ;-------------------------------------------------------------------------------
; Load the texture expansion code, copy it to aux mem
loadFiles:
DEBUG_STR "Loading files." DEBUG_STR "Loading files."
lda #>expandVec lda #>expandVec
sta pTmp+1
sta pDst+1
pha pha
lda #<expandVec lda #<expandVec
sta pTmp
sta pDst
pha pha
ldx #<@expandName ldx #<@expandName
lda #>@expandName lda #>@expandName
jsr bload jsr bload
ldx #<(textures-expandVec)
ldy #>(textures-expandVec)
sta setAuxWr
jsr copyMem
sta clrAuxWr
; Load the textures ; Load the map + texture pack
lda #>tex0 lda #8 ; load at $800
sta pTmp+1
pha pha
lda #<tex0 lda #0
sta pTmp
pha pha
ldx #<@tex0Name ldx #<@mapPackName
lda #>@tex0Name lda #>@mapPackName
jsr bload jsr bload
lda #>tex1 ; First comes the map
pha jsr readPtmp
lda #<tex1 cmp #'M'
pha beq :+
ldx #<@tex1name WRITE_STR "M rec missing."
lda #>@tex1name brk
jsr bload ; map starts with width & height
: jsr readPtmp
sta mapWidth
jsr readPtmp
sta mapHeight
; next comes length
jsr readPtmp
tax
jsr readPtmp
tay
; then the map data
lda pTmp
sta mapBase
lda pTmp+1
sta mapBase+1
; skip the map data to find the first texture
txa
clc
adc pTmp
sta pTmp
tya
adc pTmp+1
sta pTmp+1
lda #>tex2 ; Copy the textures to aux mem
pha lda #<textures
lda #<tex2 sta pDst
pha lda #>textures
ldx #<@tex2name sta pDst+1
lda #>@tex2name lda #0
jsr bload sta nTextures
lda #>tex3 @cpTex:
jsr readPtmp
beq @cpTexDone
cmp #'T'
beq :+
WRITE_STR "T rec missing"
brk
: jsr readPtmp ; len lo
tax
jsr readPtmp ; len hi
pha pha
lda #<tex3 ldy nTextures ; record texture address
pha lda pDst
ldx #<@tex3name sta texAddrLo,y
lda #>@tex3name lda pDst+1
jsr bload sta texAddrHi,y
inc nTextures
; copy all the expansion code and textures to aux mem ply
DEBUG_STR "Copying to aux mem." sta setAuxWr
ldy #>expandVec jsr copyMem ; copy the texture to aux mem
ldx #>texEnd - expandVec + 1 sta clrAuxWr
jsr copyToAux bra @cpTex ; next texture
@cpTexDone:
DEBUG_STR "Loaded "
DEBUG_BYTE nTextures
DEBUG_STR "textures."
.if DEBUG
DEBUG_STR "tex1="
lda texAddrLo+1
sta tmp
lda texAddrHi+1
sta tmp+1
DEBUG_WORD tmp
DEBUG_LN
.endif
; load the fancy frame ; load the fancy frame
DEBUG_STR "Loading frame." DEBUG_STR "Loading frame."
@ -1065,7 +1151,7 @@ test:
ldx #<@frameName ldx #<@frameName
lda #>@frameName lda #>@frameName
jsr bload jsr bload
; copy the frame to the other buffer also
.if DOUBLE_BUFFER .if DOUBLE_BUFFER
lda #>$4000 lda #>$4000
pha pha
@ -1075,15 +1161,18 @@ test:
lda #>@frameName lda #>@frameName
jsr bload jsr bload
.endif .endif
rts
; Build all the unrolls and tables @expandName: .byte 10
DEBUG_STR "Making tables." .byte "/LL/EXPAND"
jsr makeBlit @mapPackName: .byte 19
jsr makeClrBlit .byte "/LL/ASSETS/MAP.PACK"
jsr makeDecodeTbls @frameName: .byte 16
jsr makeLines .byte "/LL/ASSETS/FRAME"
; Set up front and back buffers ;-------------------------------------------------------------------------------
; Set up front and back buffers, go to hires mode, and clear for first blit.
graphInit:
lda #0 lda #0
sta frontBuf sta frontBuf
.if DOUBLE_BUFFER .if DOUBLE_BUFFER
@ -1100,11 +1189,11 @@ test:
lda #63 lda #63
sta lineCt sta lineCt
jsr clearBlit jmp clearBlit
@oneLevel:
lda #0 ;-------------------------------------------------------------------------------
sta pixNum ; Render one whole frame
sta byteNum renderFrame:
.if DOUBLE_BUFFER .if DOUBLE_BUFFER
jsr setBackBuf jsr setBackBuf
.endif .endif
@ -1118,12 +1207,46 @@ test:
adc #>precast_0 adc #>precast_0
sta pRayData+1 sta pRayData+1
lda #0 ; Calculate pointer to the map row based on playerY
lda mapBase ; start at row 0, col 0 of the map
ldy mapBase+1
ldx playerY+1 ; integral part of player's Y coord
beq @gotMapRow
clc
@mapLup: ; advance forward one row
adc mapWidth
bcc :+
iny
clc
: dex ; until we reach players Y coord
bne @mapLup
@gotMapRow:
tax ; map row ptr now in X(lo) / Y(hi)
.if DEBUG
phx
phy
stx tmp
sty tmp+1
DEBUG_STR "Initial pMap="
DEBUG_WORD tmp
DEBUG_LN
ply
plx
.endif
lda #0
sta pixNum
sta byteNum
; A-reg needs to be zero at this point -- it is the ray offset.
; Calculate the height, texture number, and texture column for one ray ; Calculate the height, texture number, and texture column for one ray
@oneCol: @oneCol:
pha ; save stx pMap ; set initial map pointer for the ray
tay sty pMap+1
phy ; save map row ptr
phx
pha ; save ray offset
tay ; ray offset where it needs to be
jsr castRay ; cast the ray across the map jsr castRay ; cast the ray across the map
jsr drawRay ; and draw it jsr drawRay ; and draw it
.if DEBUG .if DEBUG
@ -1156,53 +1279,19 @@ test:
inc byteNum inc byteNum
@nextCol: @nextCol:
pla pla
plx
ply
clc clc
adc #4 ; advance to next ray adc #4 ; advance to next ray
ldx byteNum cmp #$FC ; check for end of ray table
cpx #18
beq @nextLevel
jmp @oneCol
@nextLevel:
; flip onto the screen
.if DOUBLE_BUFFER
ldx backBuf
lda frontBuf
sta backBuf
stx frontBuf
lda page1,x
.endif
DEBUG_STR "Done rendering, waiting for key."
@pauseLup:
lda kbd
bpl @pauseLup
sta kbdStrobe ; eat the keypress
; advance
and #$7F
cmp #'w'
beq @forward
cmp #'W'
beq @forward
cmp #'s'
beq @backward
cmp #'S'
beq @backward
cmp #'x'
beq @backward
cmp #'X'
beq @backward
cmp #'a'
beq @left
cmp #'A'
beq @left
cmp #'d'
beq @right
cmp #'D'
beq @right
cmp #$1B
beq @done beq @done
jmp @pauseLup jmp @oneCol ; go back for another ray
@forward: @done:
rts
;-------------------------------------------------------------------------------
; Move the player forward a quarter step
moveForward:
lda playerDir lda playerDir
asl asl
asl asl
@ -1221,8 +1310,11 @@ test:
lda playerY+1 lda playerY+1
adc walkDirs+3,x adc walkDirs+3,x
sta playerY+1 sta playerY+1
jmp @oneLevel rts
@backward:
;-------------------------------------------------------------------------------
; Move the player forward a quarter step
moveBackward:
lda playerDir lda playerDir
asl asl
asl asl
@ -1241,63 +1333,106 @@ test:
lda playerY+1 lda playerY+1
sbc walkDirs+3,x sbc walkDirs+3,x
sta playerY+1 sta playerY+1
jmp @oneLevel rts
@left:
;-------------------------------------------------------------------------------
; Rotate player 22.5 degrees to the left
rotateLeft:
dec playerDir dec playerDir
lda playerDir lda playerDir
cmp #$FF cmp #$FF
bne :+ bne :+
lda #15 lda #15
: sta playerDir : sta playerDir
jmp @oneLevel rts
@right:
;-------------------------------------------------------------------------------
; Rotate player 22.5 degrees to the right
rotateRight:
inc playerDir inc playerDir
lda playerDir lda playerDir
cmp #16 cmp #16
bne :+ bne :+
lda #0 lda #0
: sta playerDir : sta playerDir
jmp @oneLevel rts
;-------------------------------------------------------------------------------
; Flip back buffer onto the screen
flip:
.if DOUBLE_BUFFER
ldx backBuf
lda frontBuf
sta backBuf
stx frontBuf
lda page1,x
.endif
rts
;-------------------------------------------------------------------------------
; The real action
main:
; Put ourselves high on the stack
ldx #$FF
txs
; Set up memory
jsr initMem
jsr setPlayerPos
jsr loadFiles
; Build all the unrolls and tables
DEBUG_STR "Making tables."
jsr makeBlit
jsr makeClrBlit
jsr makeDecodeTbls
jsr makeLines
jsr graphInit
; Render the frame and flip it onto the screen
@nextFrame:
jsr renderFrame
jsr flip
; wait for a key
DEBUG_STR "Done rendering, waiting for key."
@pauseLup:
lda kbd ; check for key
bpl @pauseLup ; loop until one is pressed
sta kbdStrobe ; eat the keypress
and #$7F ; convert to low-bit ASCII because assembler uses that
cmp #$60 ; lower-case?
bcc :+ ; no
sec
sbc #$20 ; yes, convert to upper case
; Dispatch the keypress
: cmp #'W' ; 'W' for forward
bne :+
jsr moveForward
jmp @nextFrame
: cmp #'X' ; 'X' alternative for 'S'
bne :+
lda #'S'
: cmp #'S' ; 'S' for backward
bne :+
jsr moveBackward
jmp @nextFrame
: cmp #'A' ; 'A' for left
bne :+
jsr rotateLeft
jmp @nextFrame
: cmp #'D' ; 'D' for right
bne :+
jsr rotateRight
jmp @nextFrame
: cmp #$1B ; ESC to exit
beq @done
jmp @pauseLup ; unrecognize key -- go back and get another one.
@done: @done:
; back to text mode
bit setText bit setText
bit page1 bit page1
; quit to monitor ; quit to monitor
ldx #$FF ldx #$FF
txs txs
jmp monitor jmp monitor
@expandName: .byte 10
.byte "/LL/EXPAND"
@tex0Name: .byte 21
.byte "/LL/ASSETS/BUILDING01"
@tex1name: .byte 21
.byte "/LL/ASSETS/BUILDING02"
@tex2name: .byte 21
.byte "/LL/ASSETS/BUILDING03"
@tex3name: .byte 21
.byte "/LL/ASSETS/BUILDING04"
@precastName: .byte 18
.byte "/LL/ASSETS/PRECAST"
@frameName: .byte 16
.byte "/LL/ASSETS/FRAME"
; Map data temporarily encoded here. Soon we want to load this from a file instead.
mapData:
.byte 1,4,3,4,2,3,2,4,3,2,4,3,4,0,0,0
.byte 1,0,0,0,0,0,0,3,0,0,2,0,3,0,0,0
.byte 1,0,0,0,0,0,0,1,0,0,3,0,2,0,0,0
.byte 3,0,0,1,2,3,0,4,0,0,4,0,3,0,0,0
.byte 1,0,0,0,0,4,0,0,0,0,0,0,4,0,0,0
.byte 2,0,0,2,0,2,0,0,0,0,0,0,4,0,0,0
.byte 1,0,0,3,0,0,0,3,0,0,3,0,1,0,0,0
.byte 3,0,0,1,0,0,0,3,0,0,2,0,3,0,0,0
.byte 1,0,0,2,0,3,0,2,0,0,4,0,3,0,0,0
.byte 1,0,0,0,0,2,0,0,0,0,0,0,1,0,0,0
.byte 3,0,0,0,0,1,0,0,0,0,0,0,3,0,0,0
.byte 1,0,0,4,0,4,0,3,1,2,4,0,2,0,0,0
.byte 4,0,0,0,0,0,0,0,0,0,0,0,3,0,0,0
.byte 1,2,3,3,3,2,2,1,2,4,2,2,2,0,0,0
; Following are log/pow lookup tables. For speed, align them on a page boundary. ; Following are log/pow lookup tables. For speed, align them on a page boundary.
.align 256 .align 256