pete286/jiles.jor

var lcolor 0x0f lcolor !
var rcolor 0x10 rcolor !
var spriteindex

var refresh-needed
: refresh 1 refresh-needed ! ;

array preview 128 allot

: color! >r dup r@ @ = if drop else r@ ! refresh then rdrop ;

: +sprite! spriteindex spritecount +!cycle spriteindex @ . refresh ;

: draw-palette 0 0x11 for i 79 i 3 << drawfatbox next ;

: draw-preview
  0 18 for
    0 edittarget = if
      i preview tile>buf
      spriteindex @ preview spr>buf
    else
      spriteindex @ preview tile>buf
    then
    i 3 % 2 * 65 + i 3 / 16 * preview paintbuf
  next ;

: mousepos>sprpos 3 >> swap 3 >> swap ;
: mousexys mousepos mousepos>sprpos spriteindex @ ;

: mousepixel! ( color -- )
  >r mousexys getpixel r@ != if
    r@ mousexys putpixel refresh
  then rdrop ;

: gfxfilename
  0 edittarget = if
    s" sprite.gfx"
  else
    NIGHT flag@ if
      s" ntiles.gfx"
    else
      s" tiles.gfx"
    then
  then ;
 
var jiles-old-tick
var jiles-old-draw

44 const ^Z
45 const ^X
31 const ^S
20 const ^T
33 const ^F
46 const ^C
47 const ^V
73 const ^PgUp
81 const ^PgDn

var copysrc

: jiles-tick
  mousepos 128 < swap 128 < and if
    MOUSEL mousedown if lcolor @ mousepixel! then
    MOUSER mousedown if rcolor @ mousepixel! then
  then
  mousepos 136 < swap 312 >= and if
    mousepos swap drop 3 >> dup
    MOUSEL mousedown if lcolor color! else drop then
    MOUSER mousedown if rcolor color! else drop then
  then
  ^LEFT key-pressed if -1 +sprite! then
  ^RIGHT key-pressed if 1 +sprite! then
  ^Z key-pressed if mousexys getpixel lcolor color! then
  ^X key-pressed if mousexys getpixel rcolor color! then
  ^S key-pressed if s" SAVING " type gfxfilename dup type cr savegfx then
  ^T key-pressed if edittarget if 0 else 1 then edittarget! 0 +sprite! then
  ^C key-pressed if spriteindex @ copysrc ! then
  ^V key-pressed if copysrc @ spriteindex @ paste-tile refresh then
  ^F key-pressed if spriteindex @ flip-tile refresh then
  ^PgDn key-pressed if 5 +sprite! then
  ^PgUp key-pressed if -5 +sprite! then
  ^UP key-pressed if -1 spriteindex @ nudge-sprite refresh then
  ^DOWN key-pressed if 1 spriteindex @ nudge-sprite refresh then
  ^TAB key-pressed if
    jiles-old-draw @ ' draw redefine
    jiles-old-tick @ ' tick redefine
    mousehide unfuck invalidate-map reloadtiles
  then
  tick-debounce
;

: jiles-draw
  refresh-needed @ if
    mousehide
    draw-preview
    spriteindex @ drawfatsprite
    lcolor @ 77 0 drawfatbox
    rcolor @ 78 0 drawfatbox
    draw-palette
    mouseshow
    0 refresh-needed !
  then ;

: jiles
  ^TAB key-pressed if
    ' draw definition jiles-old-draw !
    ' tick definition jiles-old-tick !
    ' jiles-draw ' draw redefine
    ' jiles-tick ' tick redefine
    fuck mouseshow refresh
  then ;