@@ 0,0 1,665 @@
+( Orca
+
+ TODO
+ - Synthax highlight
+ - B operating doesn't loop around
+ - Detect capitalization
+ - Comments
+ - Scale selection
+ - Load/Save
+ - Copy/Paste
+ - Copy/paste(chorded)
+)
+
+%RTN { JMP2r }
+%++ { #01 ADD } %-- { #01 SUB }
+%8++ { #0008 ADD2 }
+%8** { #30 SFT2 } %8// { #03 SFT2 }
+%MOD { DUP2 DIV MUL SUB }
+%MOD8 { #07 AND }
+%MOD2 { #01 AND }
+
+%DATA-CELLS { #2000 }
+%DATA-LOCKS { #3000 }
+%DATA-TYPES { #4000 }
+
+%LDA-CHAR { #24 MOD #00 SWP ;b36clc ADD2 LDA } ( b36 -- char )
+%LDA-VALUE { #20 SUB #00 SWP ;values ADD2 LDA } ( char -- b36 )
+
+%LDA-INDEX { #00 SWP #00 .grid/width LDZ MUL2 ROT #00 SWP ADD2 } ( x y -- index )
+%LDA-CELL { LDA-INDEX DATA-CELLS ADD2 LDA } ( x y -- char )
+%SET-CELL { ROT ROT LDA-INDEX DATA-CELLS ADD2 STA } ( x y char -- )
+%LDA-TYPE { LDA-INDEX DATA-TYPES ADD2 LDA } ( x y -- type )
+%SET-TYPE { ROT ROT LDA-INDEX DATA-TYPES ADD2 STA } ( x y type -- )
+%LDA-LOCK { LDA-INDEX DATA-TYPES ADD2 LDA } ( x y -- type )
+%SET-LOCK { ROT ROT LDA-INDEX DATA-TYPES ADD2 STA } ( x y type -- )
+%LDA-PORT { } ( x y lock -- char )
+%SET-PORT { } ( x y char -- )
+
+%LDA-CELL-VALUE { LDA-CELL LDA-VALUE } ( x y -- b36 )
+
+( devices )
+
+|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
+|10 @Console [ &vector $2 &pad $6 &char $1 &byte $1 &short $2 &string $2 ]
+|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &color $1 ]
+|80 @Controller [ &vector $2 &button $1 &key $1 ]
+|90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &chord $1 ]
+
+( variables )
+
+@timer [ &byte $1 &frame $1 &speed $1 ]
+@grid [ &width $1 &height $1 ]
+@selection [ &x1 $1 &y1 $1 &x2 $1 &y2 $1 ]
+@cursor [ &x $2 &y $2 ]
+
+|0100
+
+ ( theme ) #08f3 .System/r DEO2 #08fc .System/g DEO2 #08f9 .System/b DEO2
+ ( vectors ) ;on-button .Controller/vector DEO2
+ ( vectors ) ;on-mouse .Mouse/vector DEO2
+ ( vectors ) ;on-frame .Screen/vector DEO2
+
+ ( find size )
+ .Screen/width DEI2 8// SWP POP .grid/width STZ
+ .Screen/height DEI2 8// SWP POP #02 SUB .grid/height STZ
+
+ ( fill grid with dots )
+
+ ;start JSR2
+ ;redraw JSR2
+
+BRK
+
+@on-frame
+
+ .timer LDZ ++ DUP .timer STZ
+
+ ( skip ) #08 EQU ,&tick JCN BRK &tick
+
+ .timer/frame LDZ ++ .timer/frame STZ
+
+ ;run JSR2
+
+ #00 .timer STZ
+
+BRK
+
+@on-button
+
+ .Controller/key DEI #00 EQU ,&no-key JCN
+ .selection/x1 LDZ .selection/y1 LDZ .Controller/key DEI SET-CELL
+ ;redraw JSR2
+ &no-key
+
+ ( arrows )
+ .Controller/button DEI #f0 AND
+ DUP #04 SFT #01 AND #01 NEQ ,&no-up JCN
+ .selection/y1 LDZ #00 EQU ,&no-up JCN
+ .selection/y1 LDZ -- .selection/y1 STZ
+ .selection/y2 LDZ -- .selection/y2 STZ &no-up
+ DUP #05 SFT #01 AND #01 NEQ ,&no-down JCN
+ .selection/y1 LDZ .grid/height LDZ -- EQU ,&no-down JCN
+ .selection/y1 LDZ ++ .selection/y1 STZ
+ .selection/y2 LDZ ++ .selection/y2 STZ &no-down
+ DUP #06 SFT #01 AND #01 NEQ ,&no-left JCN
+ .selection/x1 LDZ #00 EQU ,&no-left JCN
+ .selection/x1 LDZ -- .selection/x1 STZ
+ .selection/x2 LDZ -- .selection/x2 STZ &no-left
+ DUP #07 SFT #01 AND #01 NEQ ,&no-right JCN
+ .selection/x1 LDZ .grid/width LDZ -- EQU ,&no-right JCN
+ .selection/x1 LDZ ++ .selection/x1 STZ
+ .selection/x2 LDZ ++ .selection/x2 STZ &no-right
+ POP
+
+ .Controller/key DEI #08 NEQ ,&no-backspace JCN
+ .selection/x1 LDZ .selection/y1 LDZ #2e SET-CELL ( put . char )
+ &no-backspace
+
+ ;redraw JSR2
+
+BRK
+
+@on-mouse
+
+ .Mouse/state DEI #00 EQU ,&no-touch JCN
+ .Mouse/x DEI2 8// SWP POP .selection/x1 STZ
+ .Mouse/y DEI2 8// SWP POP .selection/y1 STZ
+ ;redraw JSR2
+ &no-touch
+
+ ( clear last cursor )
+ .cursor/x LDZ2 .Screen/x DEO2
+ .cursor/y LDZ2 .Screen/y DEO2
+ ;blank_icn .Screen/addr DEO2
+ #30 .Screen/color DEO
+
+ ( record cursor positions )
+ .Mouse/x DEI2 .cursor/x STZ2
+ .Mouse/y DEI2 .cursor/y STZ2
+
+ ( draw new cursor )
+ .cursor/x LDZ2 .Screen/x DEO2
+ .cursor/y LDZ2 .Screen/y DEO2
+ ;cursor_icn .Screen/addr DEO2
+ #32 .Mouse/state DEI #01 EQU ADD .Screen/color DEO
+
+BRK
+
+@start ( -- )
+
+ #00 .grid/height LDZ
+ &ver
+ #00 .grid/width LDZ
+ &hor
+ ( get x,y ) SWP2 OVR STH SWP2 OVR STHr
+ #2e SET-CELL
+ ( incr ) SWP ++ SWP
+ DUP2 LTH ,&hor JCN
+ POP2
+ ( incr ) SWP ++ SWP
+ DUP2 LTH ,&ver JCN
+ POP2
+
+ #9a .timer/speed STZ
+
+RTN
+
+( operations )
+
+@get-bang ( x y -- bang )
+RTN
+
+( old )
+
+@is-selected ( x y -- flag )
+
+ .selection/x1 LDZ .selection/y1 LDZ EQU2
+
+RTN
+
+@get-port ( x y lock -- value )
+
+ (
+ DUP #01 NEQ ^$no-lock JCN
+ DUP2 #01 SET-LOCK
+ $no-lock
+ STH DUP2 #02 #02 STHr MUL ADD ,set-type JSR2
+ LDA-CELL
+ )
+
+RTN
+
+@get-cell-sprite ( x y -- addr )
+
+ DUP2 LDA-CELL
+ ( if character is dot )
+ DUP #2e NEQ ,&no-bar JCN
+ ( check if x,y is grid )
+ POP
+ DUP2 MOD8 #00 EQU SWP MOD8 #00 EQU #0101 NEQ2 ,&no-marker8 JCN POP2 ;marker8_icn RTN &no-marker8
+ DUP2 MOD2 #00 EQU SWP MOD2 #00 EQU #0101 NEQ2 ,&no-marker4 JCN POP2 ;marker4_icn RTN &no-marker4
+ POP2 ;font RTN
+ &no-bar
+ STH POP2 STHr
+ #20 SUB #00 SWP 8** ;font ADD2
+
+RTN
+
+( operators )
+
+@op-a ( x y char -- )
+
+ POP
+ ( get left ) DUP2 SWP -- SWP LDA-CELL-VALUE STH
+ ( get right ) DUP2 SWP ++ SWP LDA-CELL-VALUE STH
+ ( incr y ) ++
+ ( get result ) ADDr STHr
+ LDA-CHAR
+ SET-CELL
+
+RTN
+
+@op-b ( x y char -- )
+
+ POP
+ ( get left ) DUP2 SWP -- SWP LDA-CELL-VALUE STH
+ ( get right ) DUP2 SWP ++ SWP LDA-CELL-VALUE STH
+ ( incr y ) ++
+ ( get result ) SUBr STHr
+ LDA-CHAR
+ SET-CELL
+
+ ( NOTE: Issue is not with modulo, but with converting ff to 36 )
+
+RTN
+
+@op-c ( x y char -- )
+
+ POP
+ ++
+ #30 .timer/frame LDZ MOD8 ADD SET-CELL
+
+RTN
+
+@op-d ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-e ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-f ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-g ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-h ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-i ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-j ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-k ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-l ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-m ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-n ( x y char -- )
+
+ STH
+ ( limit )
+ DUP ,¬-edge JCN
+ #2a SET-CELL POP STHr RTN
+ ¬-edge
+ ( collide )
+ DUP2 -- LDA-CELL #2e EQU ,¬-collide JCN
+ #2a SET-CELL POP STHr RTN
+ ¬-collide
+ ( move )
+ DUP2 STHr
+ SWP -- SWP SET-CELL
+ #2e SET-CELL
+
+RTN
+
+@op-o ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-p ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-q ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-r ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-s ( x y char -- )
+
+ STH
+ ( clear ) DUP2 #2e SET-CELL
+ ( move ) ++ DUP2 #01 SET-LOCK
+ STHr SET-CELL
+
+RTN
+
+@op-t ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-u ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-v ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-w ( x y char -- )
+
+ STH
+ ( limit )
+ OVR ,¬-edge JCN
+ #2a SET-CELL POP STHr RTN
+ ¬-edge
+ ( collide )
+ DUP2 SWP -- SWP LDA-CELL #2e EQU ,¬-collide JCN
+ #2a SET-CELL POP STHr RTN
+ ¬-collide
+ ( move )
+ DUP2
+ SWP -- SWP STHr SET-CELL
+ #2e SET-CELL
+
+RTN
+
+@op-x ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-y ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-z ( x y char -- )
+
+ POP POP2
+
+RTN
+
+@op-bang ( x y char -- )
+
+ POP
+ #2e SET-CELL
+
+RTN
+
+@run-char ( x y char -- )
+
+ ( skip dot )
+ DUP #2e NEQ ,¬-dot JCN
+ POP POP2 RTN
+ ¬-dot
+
+ ( skip locked )
+ ROT ROT DUP2 LDA-LOCK #00 EQU ,¬-locked JCN
+ POP POP2 RTN
+ ¬-locked
+ ROT
+
+ ( A ) DUP #41 EQU ;op-a JCN2 ( B ) DUP #42 EQU ;op-b JCN2
+ ( C ) DUP #43 EQU ;op-c JCN2 ( D ) DUP #44 EQU ;op-d JCN2
+ ( E ) DUP #45 EQU ;op-e JCN2 ( F ) DUP #46 EQU ;op-f JCN2
+ ( G ) DUP #47 EQU ;op-g JCN2 ( H ) DUP #48 EQU ;op-h JCN2
+ ( I ) DUP #49 EQU ;op-i JCN2 ( J ) DUP #4a EQU ;op-j JCN2
+ ( K ) DUP #4b EQU ;op-k JCN2 ( L ) DUP #4c EQU ;op-l JCN2
+ ( M ) DUP #4d EQU ;op-m JCN2 ( N ) DUP #4e EQU ;op-n JCN2
+ ( O ) DUP #4f EQU ;op-o JCN2 ( P ) DUP #50 EQU ;op-p JCN2
+ ( Q ) DUP #51 EQU ;op-q JCN2 ( R ) DUP #52 EQU ;op-r JCN2
+ ( S ) DUP #53 EQU ;op-s JCN2 ( T ) DUP #54 EQU ;op-t JCN2
+ ( U ) DUP #55 EQU ;op-u JCN2 ( V ) DUP #56 EQU ;op-v JCN2
+ ( W ) DUP #57 EQU ;op-w JCN2 ( X ) DUP #58 EQU ;op-x JCN2
+ ( Y ) DUP #59 EQU ;op-y JCN2 ( Z ) DUP #5a EQU ;op-z JCN2
+ ( * ) DUP #2a EQU ;op-bang JCN2
+ POP POP2
+
+RTN
+
+@init ( -- )
+
+ #00 .grid/height LDZ
+ &ver
+ #00 .grid/width LDZ
+ &hor
+ ( get x,y ) SWP2 OVR STH SWP2 OVR STHr
+ ( unlock ) #00 SET-LOCK
+ ( incr ) SWP ++ SWP
+ DUP2 LTH ,&hor JCN
+ POP2
+ ( incr ) SWP ++ SWP
+ DUP2 LTH ,&ver JCN
+ POP2
+
+RTN
+
+@run ( -- )
+
+ ;init JSR2
+
+ #00 .grid/height LDZ
+ &ver
+ #00 .grid/width LDZ
+ &hor
+ ( get x,y ) SWP2 OVR STH SWP2 OVR STHr
+ DUP2 LDA-CELL ;run-char JSR2
+ ( incr ) SWP ++ SWP
+ DUP2 LTH ,&hor JCN
+ POP2
+ ( incr ) SWP ++ SWP
+ DUP2 LTH ,&ver JCN
+ POP2
+ ;redraw JSR2
+
+RTN
+
+@draw-interface ( -- )
+
+ .Screen/height DEI2 #0008 SUB2 .Screen/y DEO2
+
+ ( Positionx )
+ #0000 .Screen/x DEO2
+ .selection/x1 LDZ
+ DUP #04 SFT LDA-CHAR #20 SUB #00 SWP 8** ;font ADD2 .Screen/addr DEO2
+ #22 .Screen/color DEO
+ #0008 .Screen/x DEO2
+ #0f AND LDA-CHAR #20 SUB #00 SWP 8** ;font ADD2 .Screen/addr DEO2
+ #22 .Screen/color DEO
+
+ ( Positiony )
+ #0010 .Screen/x DEO2
+ .selection/y1 LDZ
+ DUP #04 SFT LDA-CHAR #20 SUB #00 SWP 8** ;font ADD2 .Screen/addr DEO2
+ #22 .Screen/color DEO
+ #0018 .Screen/x DEO2
+ #0f AND LDA-CHAR #20 SUB #00 SWP 8** ;font ADD2 .Screen/addr DEO2
+ #22 .Screen/color DEO
+
+ #0020 .Screen/x DEO2
+ ;position_icn .Screen/addr DEO2
+ #23 .Screen/color DEO
+
+ ( Frame )
+ #0030 .Screen/x DEO2
+ .timer/frame LDZ
+ DUP #04 SFT LDA-CHAR #20 SUB #00 SWP 8** ;font ADD2 .Screen/addr DEO2
+ #22 .Screen/color DEO
+ #0038 .Screen/x DEO2
+ #0f AND LDA-CHAR #20 SUB #00 SWP 8** ;font ADD2 .Screen/addr DEO2
+ #22 .Screen/color DEO
+
+ #0040 .Screen/x DEO2
+ ;beat_icn .Screen/addr DEO2
+ #21 .timer/frame LDZ MOD8 #00 EQU #02 MUL ADD .Screen/color DEO
+
+ ( Speed )
+ #0050 .Screen/x DEO2
+ .timer/speed LDZ
+ DUP #04 SFT LDA-CHAR #20 SUB #00 SWP 8** ;font ADD2 .Screen/addr DEO2
+ #22 .Screen/color DEO
+ #0058 .Screen/x DEO2
+ #0f AND LDA-CHAR #20 SUB #00 SWP 8** ;font ADD2 .Screen/addr DEO2
+ #22 .Screen/color DEO
+
+ ( TODO: Signal VU )
+
+ ( File )
+ .Screen/width DEI2 #0028 SUB2 .Screen/x DEO2
+ .Screen/x DEI2 8++ .Screen/x DEO2 ;eye_icns .Screen/addr DEO2 #21 .Screen/color DEO
+ .Screen/x DEI2 8++ .Screen/x DEO2 ;filestate_icn .Screen/addr DEO2 #21 .Screen/color DEO
+ .Screen/x DEI2 8++ .Screen/x DEO2 ;load_icn .Screen/addr DEO2 #21 .Screen/color DEO
+ .Screen/x DEI2 8++ .Screen/x DEO2 ;save_icn .Screen/addr DEO2 #21 .Screen/color DEO
+
+RTN
+
+@redraw ( -- )
+
+ #00 .grid/height LDZ
+ &ver
+ ( pos-y ) OVR #00 SWP 8** .Screen/y DEO2
+ #00 .grid/width LDZ
+ &hor
+ ( pos-x ) OVR #00 SWP 8** .Screen/x DEO2
+ ( get x,y ) SWP2 OVR STH SWP2 OVR STHr
+ ( sprite ) DUP2 ;get-cell-sprite JSR2 .Screen/addr DEO2
+ ( draw ) ;is-selected JSR2 #0d MUL #21 ADD .Screen/color DEO
+ ( incr ) SWP ++ SWP
+ DUP2 LTH ,&hor JCN
+ POP2
+ ( incr ) SWP ++ SWP
+ DUP2 LTH ,&ver JCN
+ POP2
+
+ ;draw-interface JSR2
+
+RTN
+
+( char to b36 )
+
+@values [
+
+ 00 00 00 00 00 00 00 00
+ 00 00 00 00 00 00 00 00
+
+ 00 01 02 03 04 05 06 07
+ 08 09 00 00 00 00 00 00
+
+ 00 0a 0b 0c 0d 0e 0f 10
+ 11 12 13 14 15 16 17 18
+ 19 1a 1b 1c 1d 1e 1f 20
+ 21 22 23 00 00 00 00 00
+
+ 00 0a 0b 0c 0d 0e 0f 10
+ 11 12 13 14 15 16 17 18
+ 19 1a 1b 1c 1d 1e 1f 20
+ 21 22 23 00 00 00 00 00
+
+]
+
+( b36 to char-lc )
+
+@b36clc [
+ 30 31 32 33 34 35 36 37
+ 38 39 61 62 63 64 65 66
+ 67 68 69 6a 6b 6c 6d 6e
+ 6f 70 71 72 73 74 75 76
+ 77 78 79 7a
+]
+
+@cursor_icn [ 80c0 e0f0 f8e0 1000 ]
+@blank_icn [ 0000 0000 0000 0000 ]
+@position_icn [ 0066 4200 0042 6600 ]
+@beat_icn [ 0000 1038 7c38 1000 ]
+@marker8_icn [ 0000 2400 0024 0000 ]
+@marker4_icn [ 0000 0000 0000 1000 ]
+@filestate_icn [ 1054 28c6 2854 1000 ]
+@load_icn [ feaa d6aa d4aa f400 ]
+@save_icn [ fe82 8282 848a f400 ]
+
+@eye_icns
+ [ 0038 4492 2810 0000 ] ( open )
+ [ 0000 0082 4438 0000 ] ( closed )
+
+
+@font ( specter8-frag font )
+[
+ 0000 0000 0000 0000 0008 0808 0800 0800
+ 0014 1400 0000 0000 0024 7e24 247e 2400
+ 0008 1e28 1c0a 3c08 0000 2204 0810 2200
+ 0030 4832 4c44 3a00 0008 1000 0000 0000
+ 0004 0808 0808 0400 0020 1010 1010 2000
+ 005a 2442 4224 5a00 0000 0808 3e08 0800
+ 0000 0000 0000 0810 0000 0000 3e00 0000
+ 0000 0000 0000 0800 0000 0204 0810 2000
+ 003c 464a 5262 3c00 0018 0808 0808 1c00
+ 003c 4202 3c40 7e00 003c 421c 0242 3c00
+ 000c 1424 447e 0400 007e 407c 0242 3c00
+ 003c 407c 4242 3c00 007e 0204 0810 1000
+ 003c 423c 4242 3c00 003c 4242 3e02 3c00
+ 0000 0010 0000 1000 0000 1000 0010 1020
+ 0000 0810 2010 0800 0000 003e 003e 0000
+ 0000 1008 0408 1000 003c 420c 1000 1000
+ 003c 4232 4a42 3c00 003c 4242 7e42 4200
+ 007c 427c 4242 7c00 003c 4240 4042 3c00
+ 007c 4242 4242 7c00 007e 4078 4040 7e00
+ 007e 4078 4040 4000 003c 4240 4642 3c00
+ 0042 427e 4242 4200 001c 0808 0808 1c00
+ 007e 0202 0242 3c00 0042 4478 4442 4200
+ 0040 4040 4040 7e00 0042 665a 4242 4200
+ 0042 6252 4a46 4200 003c 4242 4242 3c00
+ 007c 4242 7c40 4000 003c 4242 4244 3a00
+ 007c 4242 7c44 4200 003e 403c 0242 3c00
+ 007e 0808 0808 1000 0042 4242 4244 3a00
+ 0042 4242 4224 1800 0042 4242 5a66 4200
+ 0042 423c 4242 4200 0042 423e 0242 3c00
+ 007e 020c 3040 7e00 000c 0808 0808 0c00
+ 0040 2010 0804 0200 0030 1010 1010 3000
+ 0008 1400 0000 0000 0000 0000 0000 7e00
+ 0008 0400 0000 0000 0000 3c02 3e42 3a00
+ 0040 407c 4242 7c00 0000 3c42 4042 3c00
+ 0002 023e 4242 3e00 0000 3c42 7e40 3e00
+ 0000 3e40 7840 4000 0000 3c42 3e02 3c00
+ 0040 405c 6242 4200 0008 0018 0808 0400
+ 0008 0018 0808 4830 0040 4244 7844 4200
+ 0010 1010 1010 0c00 0000 6c52 5252 5200
+ 0000 5c62 4242 4200 0000 3c42 4242 3c00
+ 0000 7c42 427c 4040 0000 3e42 423e 0202
+ 0000 5c62 4040 4000 0000 3e40 3c02 7c00
+ 0008 7e08 0808 1000 0000 4242 4244 3a00
+ 0000 4242 4224 1800 0000 5252 5252 2e00
+ 0000 4224 1824 4200 0000 4242 3e02 7c00
+ 0000 7e02 3c40 7e00 000c 0810 1008 0c00
+ 0008 0808 0808 0800 0030 1008 0810 3000
+ 0000 0032 4c00 0000 3c42 99a1 a199 423c
+]
+
+@data [ ]<
\ No newline at end of file