honeylisp/game/gfx.fnl

153 lines
3.6 KiB
Plaintext
Raw Normal View History

2020-11-27 04:33:14 +00:00
(local {: lo : hi} (require :lib.util))
(local {: vm : mapw : maph : org} (require :game.defs))
; Graphics routines
(vm:def :hires
[:sta :0xc050]
[:sta :0xc057]
[:sta :0xc052])
(vm:def :mixed [:sta :0xc053])
2020-12-31 16:49:52 +00:00
(vm:def :textmode [:sta :0xc051])
(vm:def :page1 [:sta :0xc054])
(vm:def :page2 [:sta :0xc055])
2020-11-27 04:33:14 +00:00
; starting address:
; 0x2000 + (x*2) + (y%4 * 0x100) + ((y/4) * 0x28)
; x between 0-19
; y between 0-12
; yx - 16-bit value, low byte x, high byte y
(vm.code:append :screeny-lookup [:bytes "\0\040\080"])
(vm:def :yx>screen ; yx -- p
[:lda vm.TOPH :x] ; a=y
[:lsr :a] [:lsr :a] ; a=y/4
[:tay] ; y=y/4
[:lda 0x03]
[:and vm.TOPH :x] ; a=y%4
[:ora 0x20] ; a=0x20 + y%4
[:sta vm.TOPH :x] ; high byte is set (and y is wiped)
[:lda vm.TOP :x] ; a=x
[:asl :a] ; a = x*2
[:clc]
[:adc :screeny-lookup :y] ; a=x*2 + (y/4)*0x28
[:sta vm.TOP :x] ; low byte is set
)
; note: the graphical tile data must not cross a page boundary
; (this happens automatically because each tile is 32 bytes and we
; start them on a page; this lets lookup-tile be fast)
(fn draw-block []
[:block
[:clc]
[:ldy 8]
:loop
[:lda [vm.TOP :x]]
[:sta [vm.ST1 :x]]
[:inc vm.TOP :x]
[:lda vm.ST1H :x]
[:adc 4]
[:sta vm.ST1H :x]
[:dey]
[:bne :loop]])
(fn draw-vertical-block []
[:block
(draw-block)
[:lda vm.ST1H :x]
[:sbc 31] ; with carry clear this is 32
[:sta vm.ST1H :x]
[:lda vm.ST1 :x]
[:ora 0x80]
[:sta vm.ST1 :x]
(draw-block)])
(vm:def :drawtile ; p gfx --
(draw-vertical-block)
[:lda vm.ST1H :x]
[:sbc 31]
[:sta vm.ST1H :x]
[:lda vm.ST1 :x]
[:sbc 0x7f]
[:sta vm.ST1 :x]
(draw-vertical-block)
(vm:drop) (vm:drop))
(vm:def :cleargfx
(vm:push 0x4000)
[:block :page
[:dec vm.TOPH :x]
[:lda 0]
[:block :start
[:sta [vm.TOP :x]]
[:inc vm.TOP :x]
[:bne :start]]
[:lda vm.TOPH :x]
[:cmp 0x20]
[:bne :page]]
(vm:drop))
(vm:def :clearline ; pscreen --
[:lda vm.TOP :x] [:sta vm.W]
[:lda vm.TOPH :x] [:sta vm.WH]
(vm:drop)
[:block
:row
[:ldy 0x27] [:lda 0]
:start
[:sta [vm.W] :y]
[:dey]
[:bpl :start]
[:lda vm.WH]
[:cmp 0x3d]
[:bcs :done]
; cmp has cleared carry for us here
[:lda 4] [:adc vm.WH] [:sta vm.WH]
[:bcc :row]
:done])
(vm:word :drawfooter
0x39d0 :clearline
0x2250 :clearline 0x22d0 :clearline 0x2350 :clearline 0x23d0 :clearline)
(vm:word :drawmaprow ; pscreen pmap -- pmap
mapw (vm:for
:2dup :bget :lookup-tile :drawtile
:inc :swap :inc :inc :swap) :swap :drop)
(vm:word :drawmap
:map 0x0c00 (vm:until 0x100 :-
2020-11-27 04:33:14 +00:00
:dup :yx>screen ; pmap yx pscreen
:<rot :drawmaprow :swap ; pmap yx
:dup :not) :drop :drop)
(vm:word :clearfooter
:map 0x0300 (vm:until 0x100 :-
2020-11-27 04:33:14 +00:00
:dup 0x0900 :+ :yx>screen
:<rot :drawmaprow :swap
:dup :not) :drop :drop :player-redraw)
2020-11-27 04:33:14 +00:00
(vm.code:append :tilepage [:db #(hi ($1:lookup-addr :jaye-tileset))])
2020-11-27 04:33:14 +00:00
(vm:def :lookup-tile ; itile -- ptile
; each tile is 32 bytes; 2^5
; we save some cycles by storing the indices as lllhhhhh, so we don't need to shift them'
[:lda vm.TOP :x] [:tay]
[:and 0x1f]
2020-12-24 03:17:33 +00:00
[:clc] [:adc :tilepage]
2020-11-27 04:33:14 +00:00
[:sta vm.TOPH :x]
[:tya] [:and 0xe0]
[:sta vm.TOP :x])
2020-12-24 03:17:33 +00:00
(vm:def :set-human-tileset
[:lda #(hi ($1:lookup-addr :jaye-tileset))]
2020-12-24 03:17:33 +00:00
[:sta :tilepage])
(vm:def :set-prog-tileset
[:lda #(hi ($1:lookup-addr :neut-tileset))]
[:sta :tilepage])
2020-11-27 04:33:14 +00:00
(vm:word :draw-portrait ; pgfx
0x2252 :over :drawtile
0x2352 :over 32 :+ :drawtile
0x2254 :over 64 :+ :drawtile
0x2354 :swap 96 :+ :drawtile)