SpindleyQ/honeylisp
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

isometric experiments

Browse source
This commit is contained in:
Jeremy Penner 2021-09-13 23:16:03 -04:00
parent 432a4fa26a
commit c0160c7018
7 changed files with 37 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
editor/gfxedit.fnl
View file

@ -29,8 +29,10 @@
(when (>= itile 1) (set self.itile itile)))) (when (>= itile 1) (set self.itile itile))))
(fn GraphicsEditView.draw-sprite [self x y itile ?key] (fn GraphicsEditView.draw-sprite [self x y itile ?key]
(let [sprite (self.tilecache:sprite itile ?key)]
(when sprite
(love.graphics.setColor 1 1 1) (love.graphics.setColor 1 1 1)
(love.graphics.draw (self.tilecache:sprite itile ?key) x y 0 self.sprite-scale self.sprite-scale)) (love.graphics.draw sprite x y 0 self.sprite-scale self.sprite-scale))))
(fn GraphicsEditView.draw-tile-selector [self x y w ?key] (fn GraphicsEditView.draw-tile-selector [self x y w ?key]
(var tilex x) (var tilex x)

3
editor/tiledraw/iigs.fnl
View file

@ -8,6 +8,7 @@
(fn tile-to-sprite [tile] (fn tile-to-sprite [tile]
(if tile (make-canvas 16 16 (fn [canvas] (if tile (make-canvas 16 16 (fn [canvas]
(love.graphics.clear 0 0 0 0)
(for [y 0 15] (for [y 0 15]
(for [x 0 15] (for [x 0 15]
(let [ibyte (+ (* y 16) x 1) (let [ibyte (+ (* y 16) x 1)
@ -15,6 +16,6 @@
mask (bit.band (bit.rshift byte 4) 0xf) mask (bit.band (bit.rshift byte 4) 0xf)
color (bit.band byte 0xf) color (bit.band byte 0xf)
rgb (if (= mask 0) (gs-to-rgb (. pal (+ color 1))) [255 0 255])] rgb (if (= mask 0) (gs-to-rgb (. pal (+ color 1))) [255 0 255])]
(putpixel x y rgb)))))))) (when (= mask 0) (putpixel x y rgb)))))))))
{: tile-to-sprite : pal : gs-to-rgb} {: tile-to-sprite : pal : gs-to-rgb}

1
editor/tileedit/iigs.fnl
View file

@ -7,5 +7,6 @@
:draw-bits #(if (= $1.icolor 17) 0xf0 (- $1.icolor 1)) :draw-bits #(if (= $1.icolor 17) 0xf0 (- $1.icolor 1))
:palette #(lume.concat (icollect [_ color (ipairs pal)] (gs-to-rgb color)) [[255 0 255]]) :palette #(lume.concat (icollect [_ color (ipairs pal)] (gs-to-rgb color)) [[255 0 255]])
:pixel-storage-divisor #1 :pixel-storage-divisor #1
:preview-locations #[[8 0] [0 5] [16 5] [8 10]]
} }

13
editor/tileedit/init.fnl
View file

@ -34,6 +34,9 @@
(files.platform-methods TileView :editor.tileedit :map-bitxy :pixel-color :draw-on :draw-off :draw-bits (files.platform-methods TileView :editor.tileedit :map-bitxy :pixel-color :draw-on :draw-off :draw-bits
:palette :pixel-storage-divisor) :palette :pixel-storage-divisor)
(files.default-platform-method TileView :editor.tileedit :preview-locations
(fn [self] (let [(w h) (self:tilesize)] [[0 0] [w 0] [0 h] [w h]])))
(fn TileView.tile [self] (fn TileView.tile [self]
(local (w h) (self:tilesize)) (local (w h) (self:tilesize))
(or (-?> self.tilecache.tiles (. self.itile) (. (or self.tilekey :gfx))) (or (-?> self.tilecache.tiles (. self.itile) (. (or self.tilekey :gfx)))
@ -77,7 +80,12 @@
(set (tile.word y) (textfield self "Default word" tile.word x (+ y style.padding.y) (* 100 SCALE) (* 200 SCALE))) (set (tile.word y) (textfield self "Default word" tile.word x (+ y style.padding.y) (* 100 SCALE) (* 200 SCALE)))
(set (tile.label y) (textfield self "Label" tile.label x (+ y style.padding.y) (* 100 SCALE) (* 200 SCALE)))) (set (tile.label y) (textfield self "Label" tile.label x (+ y style.padding.y) (* 100 SCALE) (* 200 SCALE))))
(each [iflag flagname (ipairs (tiles.flags))] (each [iflag flagname (ipairs (tiles.flags))]
(set y (self:draw-tile-flag flagname x (+ y style.padding.y))))) (set y (self:draw-tile-flag flagname x (+ y style.padding.y))))
y)
(fn TileView.draw-tile-preview [self x y]
(each [_ [tx ty] (ipairs (self:preview-locations))]
(self:draw-sprite (+ x (* tx self.sprite-scale)) (+ y (* ty self.sprite-scale)) self.itile self.tilekey)))
(fn TileView.draw-tile-palette [self x y w] (fn TileView.draw-tile-palette [self x y w]
(local pal (self:palette)) (local pal (self:palette))
@ -107,7 +115,8 @@
(local (x y) (values (+ self.position.x style.padding.x (- self.scroll.x)) (local (x y) (values (+ self.position.x style.padding.x (- self.scroll.x))
(+ self.position.y style.padding.y (- self.scroll.y)))) (+ self.position.y style.padding.y (- self.scroll.y))))
(local (editor-w editor-h) (self:draw-tile-editor (self:tile) x y)) (local (editor-w editor-h) (self:draw-tile-editor (self:tile) x y))
(self:draw-tile-flags (+ x editor-w pixel-size) y) (local preview-y (self:draw-tile-flags (+ x editor-w pixel-size) y))
(self:draw-tile-preview (+ x editor-w pixel-size) (+ preview-y style.padding.y))
(var selector-y (+ y editor-h pixel-size)) (var selector-y (+ y editor-h pixel-size))
(set selector-y (+ selector-y (self:draw-tile-palette x selector-y (- self.size.x 20)))) (set selector-y (+ selector-y (self:draw-tile-palette x selector-y (- self.size.x 20))))
(each [_ key (ipairs (self:tilekeys))] (each [_ key (ipairs (self:tilekeys))]

2
neutgs/game.json
View file

@ -1 +1 @@
{"tiles":[{"flags":[],"word":"","label":"","gfx":"0F000E0B07070707070707070707070707070707070707070702070707070707070707070707070702070707070707070707070707070707070707070707070707070707070404040404040707070707070707070505050505050505070707070707070606060606060606060607070707070708080808080808080807070707070707090909090909090907070707070707070B0B0B0B0B0B0B0B0B070707070707070D0D0D0D0D0D0D0D0D0D070707070707070E0E0E0E0E0E0E0E0707070707070707070F0F07070F0F0707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707"},{"flags":[],"word":"","label":"","gfx":"00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000006060000000000000606000000000000000600000000000000060000000000000006000000000000000600000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000060000000000000000000606000000000600000000000000000606000000000000060000000606060600000000000000000606060606000000000000000000000000000000000000000000000000000000000000000000000000000000"},{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00BF0F0F0F0F0F0F0F0F0F005F0F0F00505F0F0F0F0F0F0F0F0F0F00BF0F0F00BF0F0F0F0F0F00BF0F0F0F0F0F0F0F0F0F0F0F0F00B05F0F0F0F0F0F0F0F00B0BF0F0F0F0F0F0F0F0F0F0F0F0F00B05050BF0F0F0F0F0F0F0F00B050BF00B05050BF0F0F0F0F0F0F0F0F0F0F0F0F00B0BF0F00B05F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00B05F0F0F0050BF00BF0F0F0F0F0F0F0F0F005F00BF0F0F005F0F0F0F00BF0F0F0F00BF0F0F0F0F00BF0F0F0F005F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00BF0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0"},{"flags":[],"word":"","label":"","gfx":"00000000000000000000000000000000000000000000000000000000000000000000000E00000000000E0000000000000000000E00000000000E00000000000000000000000000000E0000000E0E0E00000000000000000000000000000000000000000000000E0E0E0E0E0E0000000000000000000E0E080E0E080E0000000000000000000E0E0E0E0E0E0E000E000000000000000E0E0606060E00000E0E00000E0E0E00000E0E0E0E000E00000E0000000000000000000000000E000000000000000000000E00000000000000000000000000000E0E000000000000000000000000000E0E0000000000000000000000000000000000000000000000000000"}],"platform":"iigs","levels":[{"loadword":"","map":"000000000000000000000000000000000000000000000000000000000000000000000000000000000000002000000000200000000000000000000000000000400000000040000000000000000000000000000040000020204000000000000000000000000000004000004000000000000000000000000000000000402020400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000","tickword":"","moveword":"","objects":[]}]} {"tiles":[{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00F0FF0F0F0F0F0F0F0F0F0F0F0F00F0F0F0F0F0FF0F0F0F0F0F0F0F00A0A0F0F0F0F0F0F0A0AF0F0F0F00A0A0A0A0A0A0F0F0A0A0A0A0A0AF00A0A0A0A0A0A0A0A0A0A0A0A0A0A0A0AF00A0A0A0A0A0A0F0F0A0A0A0A0A0AF0F0F0F00A0A0F0F0F0F0F0F0A0AF0F0F0F0F0F0F0F00F0F0F0F0F0FF0F0F0F0F0F0F0F0F0F0F0F00F0FF0F0F0F0F0F0F0"},{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00808F0F0F0F0F0F0F0F0F0F0F0F0080808080808F0F0F0F0F0F0F0F008080208020802080808F0F0F0F00808080808020802080808080808F008080808080808080808080808080808F00808080808080808080808080808F0F0F0F008080808020802080208F0F0F0F0F0F0F0F0080808020802F0F0F0F0F0F0F0F0F0F0F0F00808F0F0F0F0F0F0F0"},{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00904F0F0F0F0F0F0F0F0F0F0F0F0040409090404F0F0F0F0F0F0F0F009090904040909090404F0F0F0F00909040909090404090909040909F004040909040409090904040909040409F00904090904040404090904090909F0F0F0F004090909090904090904F0F0F0F0F0F0F0F0040409090404F0F0F0F0F0F0F0F0F0F0F0F00409F0F0F0F0F0F0F0"},{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F00707F0F0F0F0F0F0F0F0F0F0F0F0070707070707F0F0F0F0F0F0F0F007070707070707070707F0F0F0F00707070707070707070707070707F00707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070303070707070707070707070707030303030307070707070707070707030303F00303030307070707070703030303F0F0F0F003030303070703030303F0F0F0F0F0F0F0F0030303030303F0F0F0F0F0F0F0F0F0F0F0F00303F0F0F0F0F0F0F0"}],"platform":"iigs","levels":[{"loadword":"","map":"000000000000000000000000000000000000000000000000000000000000000000000000000000000000002000000000200000000000000000000000000000400000000040000000000000000000000000000040000020204000000000000000000000000000004000004000000000000000000000000000000000402020400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000","tickword":"","moveword":"","objects":[]}],"tilesets":{"jaye-tileset":"gfx","neut-tileset":"neut"}}

27
neutgs/init.fnl
View file

@ -62,24 +62,22 @@
(form itile-to-tile [(fn [ssc itile] (form itile-to-tile [(fn [ssc itile]
[:block (ssc:expr-word itile) [:asl] [:asl] [:clc] [:adc #($1:lookup-addr :tiles)]])]) [:block (ssc:expr-word itile) [:asl] [:asl] [:clc] [:adc #($1:lookup-addr :tiles)]])])
(fn enable-shadowing () (set! (word-at (ref :0xc035)) (& (word-at (ref :0xc035)) 0xfff1)))
(fn disable-shadowing () (set! (word-at (ref :0xc035)) (| (word-at (ref :0xc035)) 0x000e)))
(global word with-shadowing 0) (global word with-shadowing 0)
(fn draw-test-tiles (i) (fn draw-test-tiles (i)
(when with-shadowing (disable-shadowing)) (when with-shadowing (disable-shadow-writes))
(let (x 0 y 0 screen 0x2000) (let (x 0 y 0 screen 0x2000)
(while (< y 12) (while (< y 37)
(draw-object screen (itile-to-tile (& (+ x y i) 3))) (let (tile (itile-to-tile (& (+ x y i) 3)))
(draw-object screen tile))
(set! x (+ x 1)) (set! x (+ x 1))
(if (= x 20) (if (= x 20)
(do (set! x 0) (do (set! y (+ y 1))
(set! y (+ y 1)) (set! x (if (& y 1) 1 0))
(set! screen (+ screen [(+ 8 (* 160 15))]))) (set! screen (+ screen [(+ 12 (* 160 4))])))
(set! screen (+ screen 8))))) (set! screen (+ screen 8)))))
(when with-shadowing (when with-shadowing
(enable-shadowing) (enable-shadow-writes)
(if (= with-shadowing 1) (if (= with-shadowing 1)
(let (x 0 y 0 screen 0x2000) (let (x 0 y 0 screen 0x2000)
(while (< y 12) (while (< y 12)
@ -112,11 +110,15 @@
(EMStartUp 0x2000 0 0 320 0 200 userID) (EMStartUp 0x2000 0 0 320 0 200 userID)
(GrafOn) (GrafOn)
(ClearScreen 0) (ClearScreen 0)
(let (screen 0x12000) (while (< screen 0x1a000)
(word! screen 0)
(set! screen (+ screen 2))))
(set-palette 0 [pal]) (set-palette 0 [pal])
(SetAllSCBs 0) (SetAllSCBs 0)
(enable-shadow-writes)
(draw-test-tiles 0)
(wait-for-key) (wait-for-key)
(enable-shadowing)
(let (tile-task (new-task (ref draw-test-tiles-forever))) (let (tile-task (new-task (ref draw-test-tiles-forever)))
(wait-for-key) (wait-for-key)
(set! with-shadowing 1) (set! with-shadowing 1)
@ -124,7 +126,8 @@
(set! with-shadowing 2) (set! with-shadowing 2)
(wait-for-key) (wait-for-key)
(set! with-shadowing false) (set! with-shadowing false)
(reset-task tile-task (ref yield-forever))) (reset-task tile-task (ref yield-forever))
(wait-for-key))
(GrafOff) (GrafOff)

3
ssc/iigs/graphics.fnl
View file

@ -90,6 +90,9 @@
block)) block))
#(compile $1 #(compile $1
(fn enable-shadow-writes () (set! (word-at (ref :0xc035)) (& (word-at (ref :0xc035)) 0xfff1)))
(fn disable-shadow-writes () (set! (word-at (ref :0xc035)) (| (word-at (ref :0xc035)) 0x000e)))
; The fastest way to draw any graphics on the IIgs is to map the stack pointer to ; The fastest way to draw any graphics on the IIgs is to map the stack pointer to
; video memory, and use stack-pushing instructions to write values. draw-object ; video memory, and use stack-pushing instructions to write values. draw-object
; takes a location in video memory and a pointer to a machine code routine called a "drawfn" ; takes a location in video memory and a pointer to a machine code routine called a "drawfn"