M README.md => README.md +1 -0
@@ 61,6 61,7 @@ To display the list of operators inside of Orca, use `CmdOrCtrl+G`.
- `:` **midi**(channel octave note): Sends a midi note.
- `;` **note**(octave note): Sends a single note.
- `/` **byte**(hb lb): Sends a single byte.
+- `$` **self**(path): Inject file in grid.
#### Advanced
M src/main.tal => src/main.tal +40 -115
@@ 594,12 594,13 @@ RTN
( run ) ROT GET-VALUE #0a - 2* TOS ;op-table/func ++ LDA2 JMP2
&no-uc
( special )
- CHAR-BANG =~ ;op-bang/func JCN2
- CHAR-HASH =~ ;op-comment/func JCN2
- CHAR-SEMI =~ ;op-pitch/func JCN2
- CHAR-EQUAL =~ ;op-synth/func JCN2
- CHAR-COLON =~ ;op-midi/func JCN2
- CHAR-SLASH =~ ;op-byte/func JCN2
+ [ LIT '* ] =~ ;op-bang/func JCN2
+ [ LIT '# ] =~ ;op-comment/func JCN2
+ [ LIT '= ] =~ ;op-synth/func JCN2
+ [ LIT '; ] =~ ;op-pitch/func JCN2
+ [ LIT ': ] =~ ;op-midi/func JCN2
+ [ LIT '/ ] =~ ;op-byte/func JCN2
+ [ LIT '$ ] =~ ;op-self/func JCN2
POP
( erase )
CHAR-DOT .head/addr LDZ2 SET-CELL
@@ 780,6 781,21 @@ RTN
&cross POP2 LIT '+ RTN
&dot POP2 LIT '. RTN
+@get-word ( addr* -- word* )
+
+ ;&word #0020 ;mclr JSR2
+ &while
+ INC2 DUP2 GET-CELL
+ DUP LIT '. = ,&skip JCN
+ DUP ;&word ROT ;sput JSR2
+ &skip
+ LIT '. ! ,&while JCN
+ POP2
+ ;&word
+
+RTN
+ &word $20
+
@is-selected ( x y -- bool )
DUP .selection/y1 LDZ < ,&end JCN
@@ 794,7 810,7 @@ RTN
@draw-guide ( -- )
- #0020 #0000
+ #0021 #0000
&loop
( x ) DUP2 #84 SFT2 .grid/x1 LDZ2 ++ #0020 ++ .Screen/x DEO2
( y ) DUP2 #000f AND2 10** .grid/y1 LDZ2 ++ #0020 ++ .Screen/y DEO2
@@ 870,24 886,30 @@ RTN
@load-file ( -- )
- ;filepath .File/name DEO2
+ #0000 ;filepath ,inject-file JSR
+ ;draw-grid JSR2
+ RESET-STATE
+
+RTN
+
+@inject-file ( x y path* -- )
+
+ .File/name DEO2
#0001 .File/length DEO2
- ( x,y ) LIT2r 0000
+ OVR ,&anchor-x STR
&stream
;&b .File/read DEO2
( write )
;&b LDA IS-CHAR-KEY #00 = ,&invalid JCN
- OVRr STHr STHkr ;&b LDA ;set-cell JSR2
+ DUP2 ;&b LDA ;set-cell JSR2
&invalid
- ( incr-x ) SWPr INCr SWPr
- ( incr-y )
+ ( inc x ) SWP INC SWP
;&b LDA #0a ! ,&no-lb JCN
- INCr NIPr LITr 00 SWPr
+ ( inc y ) INC
+ ( reset x ) [ LIT &anchor-x $1 ] ROT POP SWP
&no-lb
.File/success DEI2 #0000 !! ,&stream JCN
- POP2r
- ;draw-grid JSR2
- RESET-STATE
+ POP2
RTN
&b $1
@@ 985,108 1007,11 @@ RTN
@paste-snarf ( -- )
- ;snarf-txt .File/name DEO2
- #0001 .File/length DEO2
- ( x,y ) LIT2r 0000
- &stream
- ;&b .File/read DEO2
- ( incr-y )
- ;&b LDA #0a ! ,&no-lb JCN
- INCr NIPr LITr 00 SWPr
- ,&continue JMP
- &no-lb
- ( write )
- .selection/x1 LDZ OVRr STHr +
- .selection/y1 LDZ STHkr +
- ;&b LDA ;set-cell JSR2
- ( incr-x ) SWPr INCr SWPr
- &continue
- .File/success DEI2 #0000 !! ,&stream JCN
- POP2r
+ .selection LDZ2 ;snarf-txt ;inject-file JSR2
;draw-grid JSR2
RTN
- &b $1
-
-( string generics )
-
-@slen ( str* -- len* )
-
- DUP2 ,scap JSR SWP2 --
-
-RTN
-
-@scap ( str* -- str-end* )
-
- LDAk #00 ! JMP RTN
- &while INC2 LDAk ,&while JCN
-
-RTN
-
-@sput ( str* char -- )
-
- ROT ROT ,scap JSR STA
-
-RTN
-
-@spop ( str* -- )
-
- LDAk ,&no-null JCN
- POP2 RTN &no-null
- #00 ROT ROT ,scap JSR #0001 -- STA
-
-RTN
-
-( memory generics )
-
-@mclr ( addr* len* -- )
-
- OVR2 ++ SWP2
- &loop
- STH2k #00 STH2r STA
- INC2 GTH2k ,&loop JCN
- POP2 POP2
-
-RTN
-
-@mcpy ( src* dst* len* -- )
-
- SWP2 STH2
- OVR2 ++ SWP2
- &loop
- LDAk STH2kr STA INC2r
- INC2 GTH2k ,&loop JCN
- POP2 POP2
- POP2r
-
-RTN
-
-( generics )
-
-@within-rect ( x* y* rect -- flag )
-
- STH
- ( y < rect.y1 ) DUP2 STHkr #02 + LDZ2 << ,&skip JCN
- ( y > rect.y2 ) DUP2 STHkr #06 + LDZ2 >> ,&skip JCN
- SWP2
- ( x < rect.x1 ) DUP2 STHkr LDZ2 << ,&skip JCN
- ( x > rect.x2 ) DUP2 STHkr #04 + LDZ2 >> ,&skip JCN
- POP2 POP2 POPr
- #01
-RTN
- &skip
- POP2 POP2 POPr
- #00
-
-RTN
-
-@print ( short* -- )
-
- &short ( short* -- ) SWP ,&byte JSR
- &byte ( byte -- ) DUP #04 SFT ,&char JSR
- &char ( char -- ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD EMIT
-
-RTN
+~src/stdlib.tal
~src/opcodes.tal
~src/assets.tal
M src/opcodes.tal => src/opcodes.tal +17 -2
@@ 5,13 5,13 @@
:op-i :op-j :op-k :op-l :op-m :op-n :op-o :op-p
:op-q :op-r :op-s :op-t :op-u :op-v :op-w :op-x
:op-y :op-z
- :op-bang :op-comment :op-synth :op-midi :op-pitch :op-byte
+ :op-bang :op-comment :op-synth :op-midi :op-pitch :op-byte :op-self
&docs
:op-a/docs :op-b/docs :op-c/docs :op-d/docs :op-e/docs :op-f/docs :op-g/docs :op-h/docs
:op-i/docs :op-j/docs :op-k/docs :op-l/docs :op-m/docs :op-n/docs :op-o/docs :op-p/docs
:op-q/docs :op-r/docs :op-s/docs :op-t/docs :op-u/docs :op-v/docs :op-w/docs :op-x/docs
:op-y/docs :op-z/docs
- :op-bang/docs :op-comment/docs :op-synth/docs :op-midi/docs :op-pitch/docs :op-byte/docs
+ :op-bang/docs :op-comment/docs :op-synth/docs :op-midi/docs :op-pitch/docs :op-byte/docs :op-self/docs
&func
:op-a/func :op-b/func :op-c/func :op-d/func :op-e/func :op-f/func :op-g/func :op-h/func
:op-i/func :op-j/func :op-k/func :op-l/func :op-m/func :op-n/func :op-o/func :op-p/func
@@ 518,6 518,21 @@ RTN
RTN
+@op-self "self $1
+ &docs '$ "Load 20 "orca 20 "file $1
+ &func ( char -- )
+
+ POP
+ .head/addr LDZ2 STH2k
+ &while
+ INC2 DUP2 ;get-port-right-raw JSR2 LIT '. ! ,&while JCN
+ POP2
+ ( has bang ) ;get-bang JSR2 ,&is-bang JCN [ POP2r RTN ] &is-bang
+ .head LDZ2 INC STH2kr ;get-word JSR2 ;inject-file JSR2
+ ( animate ) IO-TYPE STH2r SET-TYPE
+
+RTN
+
( helpers )
@set-port-output ( value addr* -- )
A src/stdlib.tal => src/stdlib.tal +88 -0
@@ 0,0 1,88 @@
+( string generics )
+
+@slen ( str* -- len* )
+
+ DUP2 ,scap JSR SWP2 --
+
+RTN
+
+@scap ( str* -- str-end* )
+
+ LDAk #00 ! JMP RTN
+ &while INC2 LDAk ,&while JCN
+
+RTN
+
+@sput ( str* char -- )
+
+ ROT ROT ,scap JSR STA
+
+RTN
+
+@spop ( str* -- )
+
+ LDAk ,&no-null JCN
+ POP2 RTN &no-null
+ #00 ROT ROT ,scap JSR #0001 -- STA
+
+RTN
+
+( memory generics )
+
+@mclr ( addr* len* -- )
+
+ OVR2 ++ SWP2
+ &loop
+ STH2k #00 STH2r STA
+ INC2 GTH2k ,&loop JCN
+ POP2 POP2
+
+RTN
+
+@mcpy ( src* dst* len* -- )
+
+ SWP2 STH2
+ OVR2 ++ SWP2
+ &loop
+ LDAk STH2kr STA INC2r
+ INC2 GTH2k ,&loop JCN
+ POP2 POP2
+ POP2r
+
+RTN
+
+@print ( short* -- )
+
+ &short ( short* -- ) SWP ,&byte JSR
+ &byte ( byte -- ) DUP #04 SFT ,&char JSR
+ &char ( char -- ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD EMIT
+
+RTN
+
+@print-str ( string* -- )
+
+ #0001 SUB2
+ &while
+ INC2 LDAk DUP #18 DEO ,&while JCN
+ POP2
+
+JMP2r
+
+( generics )
+
+@within-rect ( x* y* rect -- flag )
+
+ STH
+ ( y < rect.y1 ) DUP2 STHkr #02 + LDZ2 << ,&skip JCN
+ ( y > rect.y2 ) DUP2 STHkr #06 + LDZ2 >> ,&skip JCN
+ SWP2
+ ( x < rect.x1 ) DUP2 STHkr LDZ2 << ,&skip JCN
+ ( x > rect.x2 ) DUP2 STHkr #04 + LDZ2 >> ,&skip JCN
+ POP2 POP2 POPr
+ #01
+RTN
+ &skip
+ POP2 POP2 POPr
+ #00
+
+RTN