~rabbits/orca-toy

ref: b25d778974f9ed71f326b98cfee466df160282fe orca-toy/src/orca.tal -rw-r--r-- 21.9 KiB
b25d7789Devine Lu Linvega Combined helpers 4 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
( app/orca : livecoding ide )

|00 @System &vector $2 &pad $6 &r $2 &g $2 &b $2
|10 @Console &vector $2 &read $1 &pad $5 &write $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|30 @Audio0 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
|40 @Audio1 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
|50 @Audio2 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
|60 @Audio3 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
|80 @Controller &vector $2 &button $1 &key $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &chord $1
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|c0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1

%LOCKED-TYPE { #01 } %PORTEL-TYPE { #02 }
%OPERATOR-TYPE { #03 } %PORTER-TYPE { #04 }
%OUTPUT-TYPE { #05 } %IO-TYPE { #07 }

%MOD { DIVk MUL SUB }
%MOD2 { DIV2k MUL2 SUB2 }

%menu-def { #01 }
%menu-sel { #04 }
%menu-hov { #08 }
%menu-hit { #0014 }
%menu-auto { #15 }
%menu-label { DEOk DEO }
%menu-l { #40 }
%menu-r { #04 }

|0000

@dpad $1 &last $1
@timer &beat $1 &speed $1 &playing $1 &frame $1 &frame-lb $1
@state &timer $1 &changed $1
@guide $1
@filepath $40
@grid &x1 $2 &y1 $2 &x2 $2 &y2 $2 &size &width $1 &height $1 &length $2
@selection &from &x1 $1 &y1 $1 &to &x2 $1 &y2 $1
@cursor &x $2 &y $2
@toolbar &x1 $2 &y1 $2 &x2 $2 &y2 $2
@head &x $1 &y $1 &addr $2
@variables $24
@signal &midi $1 &midi-last $1
@voices $20

|0100 ( -> )

	( theme )
	#0f38 .System/r DEO2
	#0fc8 .System/g DEO2
	#0f98 .System/b DEO2

	( init random )
	;init-prng JSR2

	( drawing mode )
	#15 .Screen/auto DEO

	( size )
	#0328 .Screen/width DEO2
	#01e0 .Screen/height DEO2

	( synths )
	#dd .Audio0/volume DEO #0118 .Audio0/adsr DEO2 #0100 .Audio0/length DEO2
	#ef .Audio1/volume DEO #0334 .Audio1/adsr DEO2 #0100 .Audio1/length DEO2
	#fe .Audio2/volume DEO #1414 .Audio2/adsr DEO2 #0100 .Audio2/length DEO2
	#dd .Audio3/volume DEO #222c .Audio3/adsr DEO2 #0100 .Audio3/length DEO2

	;sin-pcm .Audio0/addr DEO2
	;tri-pcm .Audio1/addr DEO2
	;saw-pcm .Audio2/addr DEO2
	;sqr-pcm .Audio3/addr DEO2

	( x )
	#0010 .grid/x1 STZ2
	.Screen/width DEI2
		DUP2 #03 SFT2 NIP #04 SUB .grid/width STZ
		#01 SFT2 .grid/width LDZ #01 SFT #00 SWP #30 SFT2 ADD2 #0004 ADD2 .grid/x2 STZ2
	( y )
	#0020 .grid/y1 STZ2
	.Screen/height DEI2
		DUP2 #04 SFT2 NIP #05 SUB .grid/height STZ
		#01 SFT2 .grid/height LDZ #01 SFT #00 SWP #40 SFT2 ADD2 .grid/y2 STZ2
	( len )
	#00 .grid/height LDZ #00 .grid/width LDZ MUL2 .grid/length STZ2

	( cache positions )
	.grid/x1 LDZ2 .toolbar/x1 STZ2
	.grid/x2 LDZ2 .toolbar/x2 STZ2
	.grid/y2 LDZ2 #000c ADD2
		DUP2 .toolbar/y1 STZ2
		DUP2 ;draw-dpad/y STA2
		DUP2 ;draw-position/y STA2
		DUP2 ;draw-timer/y STA2
		DUP2 ;draw-speed/y STA2
		DUP2 ;draw-state/y STA2
		DUP2 ;draw-filepath/y STA2
		DUP2 ;draw-meter/y STA2
		#0010 ADD2 .toolbar/y2 STZ2
	( cache x positions )
	.grid/x1 LDZ2 ;draw-position/x STA2
	.grid/x1 LDZ2 #0030 ADD2 ;draw-timer/x STA2
	.grid/x1 LDZ2 #0050 ADD2 ;draw-dpad/x STA2
	.grid/x1 LDZ2 #0050 ADD2 ;draw-speed/x STA2
	.grid/x2 LDZ2 #0028 SUB2 ;draw-meter/x STA2
	.toolbar/x1 LDZ2 #0078 ADD2 ;draw-filepath/x STA2
	.toolbar/x2 LDZ2 #0008 SUB2 ;draw-state/x STA2

	( theme support )
	;load-theme JSR2
	;draw-menu JSR2

	( blank file )
	;file-new JSR2

	( display guide )
	;toggle-guide JSR2

	( draw position )
	;draw-position JSR2

	( start )
	.timer/playing LDZk #00 EQU SWP STZ

	( vectors )
	;untrap JSR2

BRK

@manifest

	&name "Orca $1
	&date "2022-07-02 $1
	&menu
		04 "File $1
			01 'n :file-new "New $1
			01 'r :file-rename "Rename $1
			01 'o :file-open "Open $1
			01 's :file-save "Save $1
		05 "Edit $1
			01 'c :edit-copy "Copy $1
			01 'v :edit-paste "Paste $1
			01 'x :edit-cut "Cut $1
			01 'i :toggle-insert "Insert $1
			00 08 :edit-erase "Erase $1
		03 "Play $1
			00 20 :play-toggle "Pause $1
			01 ', :play-decr "Decr $1
			01 '. :play-incr "Incr $1
		01 "View $1
			01 'h :toggle-guide "Guide $1
		02 "Select $1
			00 1b :select-reset "Reset $1
			01 'a :select-all "All $1
		$1

@untrap ( -- )

	( vectors )
	;on-console .Console/vector DEO2
	;on-button .Controller/vector DEO2
	;on-mouse .Mouse/vector DEO2
	;on-frame .Screen/vector DEO2
	#01 ;draw-filepath JSR2
	#00 .Mouse/state DEO

JMP2r

@trap ( -- )

	( vectors )
	;on-button-trap .Controller/vector DEO2
	;on-mouse-trap .Mouse/vector DEO2
	;on-frame-trap .Screen/vector DEO2
	#00 .Mouse/state DEO
	( clear cursor )
	#40 ;draw-cursor JSR2

JMP2r

@on-console ( -> )

	#00 ;draw-filepath JSR2
	( start )
	[ LIT &listening $1 ] ,&no-start JCN
		#01 ,&listening STR
		;filepath #0040 ;mclr JSR2
		&no-start
	( end )
	.Console/read DEI
	DUPk #1f GTH SWP #7f LTH AND ,&no-end JCN
		#00 ,&listening STR
		&no-end
	( capture )
	,capture-trap JSR
	#01 ;draw-filepath JSR2

BRK

@on-frame-trap ( -> )

	.state/timer LDZ
	DUP #07 AND ,&no-blink JCN
		DUP #03 SFT #01 AND #30 SFT INC ;draw-filepath JSR2
		&no-blink
	INC .state/timer STZ

BRK

@on-button-trap ( -> )

	#00 ;draw-filepath JSR2
	.Controller/key DEI DUP #0d EQU #03 MUL SUB ,capture-trap JSR
	#01 ;draw-filepath JSR2

BRK

@capture-trap ( button -- )

	DUP ,&no-null JCN POP JMP2r &no-null
	[ #08 ] NEQk NIP ,&no-pop JCN ;filepath ;spop JSR2 POP JMP2r &no-pop
	[ #0a ] NEQk NIP ,&no-load JCN ;file-open JSR2 &no-load
	[ #7f ] NEQk NIP ,&no-delete JCN ;filepath #0040 ;mclr JSR2 POP JMP2r &no-delete
	[ #20 ] GTHk NIP ,&no-special JCN ;untrap JSR2 POP JMP2r &no-special
	;filepath ;slen JSR2 NIP #3f EQU ,&no-push JCN
		DUP ;filepath ;sput JSR2
		&no-push
	POP

JMP2r

@on-mouse-trap ( -> )

	( release trap on touch )
	.Mouse/state DEI #00 NEQ JMP BRK
	;untrap JSR2

BRK

@on-frame ( -> )

	( paused )
	.timer/playing LDZ JMP BRK
	( on beat )
	.timer LDZ2 NEQ ,&skip JCN
		;manage-voices JSR2
		;run JSR2
		.timer/frame LDZ2k INC2 ROT STZ2
		#00 .timer/beat STZ
		&skip
	( inc beat )
	.timer/beat LDZk INC SWP STZ

BRK

@on-button ( -> )

	.Controller/button DEI2 ;find-modkey JSR2 ORAk #00 EQU ,&skip JCN
		JSR2 BRK
		&skip
	POP2

	( d-pad handler )
	.Controller/button DEI .dpad/last LDZ
	DUP2 #0200 EQU2 ;dpad-input/start JCN2
	DUP2 #0002 EQU2 ;dpad-input/end JCN2
	DUP #0f AND #02 EQU ;dpad-input/add JCN2
	POP ( pop last )
	.dpad/last STZ

	( modifier handlers )
	.Controller/button DEI #f0 AND ;on-button-arrow JCN2

	( default )
	.Controller/key DEI 
		DUP ;ci-key JSR2 #00 EQU ,&no-input JCN
			DUP ;fill-sel JSR2
		&no-input
	POP

BRK

@on-button-insert ( -> )

	.Controller/key DEI
	[ #00 ] EQUk NIP ,&end JCN
	[ #1b ] NEQk NIP ,&no-esc JCN ;toggle-insert JSR2 POP BRK &no-esc
	[ #20 ] NEQk NIP ,&no-spc JCN #01 #0000 ;mod-sel JSR2 POP BRK &no-spc
	[ #08 ] NEQk NIP ,&no-bks JCN #ff #0000 ;mod-sel JSR2 LIT '. ;fill-sel JSR2 POP BRK &no-bks
	DUP ;ci-key JSR2 #00 EQU ,&no-key JCN 
		DUP ;fill-sel JSR2 #01 #0000 ;mod-sel JSR2 &no-key
	&end
	POP

BRK

@on-button-arrow ( -> )

	( capture )
	.Controller/button DEI
	DUP #0f AND ,&mod STR
	#04 SFT #00 OVR #03 AND ;&vec ADD2 LDA ,&y STR
	#02 SFT #00 SWP #03 AND ;&vec ADD2 LDA ,&x STR
	[ LIT &x $1 ] [ LIT &y $1 ] [ LIT &mod $1 ] ;mod-sel JSR2

BRK
	&vec 00 ff 01 00

@on-mouse ( -> )

	.Mouse/y DEI2 #0014 LTH2 ;trap-menu JCN2

	( clear last cursor )
	#40 ;draw-cursor JSR2
	( draw new cursor )
	.Mouse/x DEI2 DUP2 .cursor/x STZ2 .Screen/x DEO2
	.Mouse/y DEI2 DUP2 .cursor/y STZ2 .Screen/y DEO2
	;cursor-icn .Screen/addr DEO2
	.Mouse/state DEI #00 NEQ DUP ADD #41 ADD .Screen/sprite DEO
	( route )
	.Mouse/x DEI2 .Mouse/y DEI2 .grid ;within-rect JSR2 ,on-mouse-grid JCN
	.Mouse/x DEI2 .Mouse/y DEI2 .toolbar ;within-rect JSR2 ,on-mouse-toolbar JCN

BRK

@on-mouse-grid ( -> )

	.Mouse/state DEI [ LIT &last $1 ]
		ORAk #00 EQU ,&end JCN
		( on down )
		DUP2 #0100 NEQ2 ,&no-down JCN
			,&get-pos JSR ;set-sel-from JSR2
			,&end JMP
			&no-down
		( on release )
		,&get-pos JSR ;set-sel-to JSR2
	&end
	POP ,&last STR

BRK
	&get-pos ( -- x y )
		.Mouse/x DEI2 .grid/x1 LDZ2 SUB2 #03 SFT2 NIP
		.Mouse/y DEI2 .grid/y1 LDZ2 SUB2 #04 SFT2 NIP
	JMP2r

@on-mouse-toolbar ( -> )

	( skip ) .Mouse/state DEI #01 JCN BRK

	( release )
	#00 .Mouse/state DEO

	( left-side )
	.Mouse/x DEI2 .grid/x1 LDZ2 SUB2 #03 SFT2 NIP
	[ #05 ] GTHk NIP ,&no-insert JCN ;toggle-insert JSR2 POP BRK &no-insert
	[ #09 ] GTHk NIP ,&no-pause JCN ;play-toggle JSR2 POP BRK &no-pause
	[ #0d ] GTHk NIP ,&no-speed JCN [ .Mouse/state DEI #01 EQU DUP ADD #01 SUB ] ;mod-speed JSR2 POP BRK &no-speed
	[ #0e ] GTHk NIP OVR .grid/width LDZ SWP SUB #06 GTH #0101 NEQ2 ,&no-rename JCN ;trap JSR2 &no-rename
	POP
	( right-side )
	.grid/x2 LDZ2 .Mouse/x DEI2 SUB2 #03 SFT2 NIP
	[ #00 ] NEQk NIP ,&no-save JCN ;file-save JSR2 &no-save
	[ #02 ] NEQk NIP ,&no-guide JCN ;toggle-guide JSR2 &no-guide
	POP

BRK

( selection )

@play-decr ( -- ) #ff ;mod-speed JSR2 JMP2r
@play-incr ( -- ) #01 ;mod-speed JSR2 JMP2r

@mod-sel ( x y mod -- )

	DUP #04 NEQ ,&no-scale JCN
		POP
		.selection/to LDZ2 ,&add-pos JSR ;set-sel-to JSR2
		JMP2r
		&no-scale
	DUP #01 NEQ ,&no-drag JCN
		POP
		;edit-cut JSR2
		STH2k .selection/from LDZ2 ,&add-pos JSR
		STH2r .selection/to LDZ2 ,&add-pos JSR
			;set-sel-range JSR2
		;edit-paste JSR2
		JMP2r
		&no-drag
	POP
	( default )
	STH2k .selection/from LDZ2 ,&add-pos JSR
	STH2r .selection/to LDZ2 ,&add-pos JSR
		;set-sel-range JSR2

JMP2r
	&add-pos ROT ADD STH ADD STHr JMP2r

@select-reset ( -- )

	.selection/from LDZ2 ;set-sel-from JSR2

JMP2r

@select-all ( -- )

	#0000 .grid/size LDZ2 ,set-sel-range JSR

JMP2r

@set-sel-from ( x y -- )

	DUP2 ,set-sel-range JSR

JMP2r

@set-sel-to ( x y -- )

	.selection/from LDZ2 SWP2

@set-sel-range ( from* to* -- )

	( clamp top-left )
	OVR2 #ff NEQ SWP #ff NEQ AND ,&no-tl JCN
		POP2 POP2 JMP2r
		&no-tl
	( clamp bottom-right )
	OVR2 .grid/height LDZ LTH SWP .grid/width LDZ LTH AND ,&no-br JCN
		POP2 POP2 JMP2r
		&no-br
	( from )
	SWP2 DUP2 .selection/from LDZ2 NEQ2 STH .selection/from STZ2
	( to )
	.selection/y1 LDZ GTHk [ JMP SWP POP ] .grid/height LDZ #01 SUB LTHk [ JMP SWP POP ] STH
	.selection/x1 LDZ GTHk [ JMP SWP POP ] .grid/width LDZ #01 SUB LTHk [ JMP SWP POP ] STHr
	DUP2 .selection/to LDZ2 NEQ2 STH .selection/to STZ2
	( skip redraw when unchanged )
	ADDr STHr #01 JCN JMP2r
	( hide guide )
	.guide LDZ #00 EQU ,&no-guide JCN ;toggle-guide JSR2 &no-guide
	( redraw )
	;draw-grid JSR2
	;draw-position JSR2

JMP2r

@fill-sel ( char -- )

	,&c STR
	.selection/y2 LDZ INC .selection/y1 LDZ
	&ver
		STHk
		.selection/x2 LDZ INC .selection/x1 LDZ
		&hor
			DUP STHkr [ LIT &c $1 ] ;set-cell JSR2
			INC GTHk ,&hor JCN
		POP2 POPr
		INC GTHk ,&ver JCN
	POP2
	#01 .state/changed STZ ;draw-state JSR2

JMP2r

@mod-speed ( mod -- )

	.timer/speed LDZ ADD

@set-speed ( speed -- )

	#1f AND #04 GTHk [ JMP SWP POP ] .timer/speed STZ
	#00 .timer/beat STZ
	;draw-speed JSR2

JMP2r

@toggle-insert ( -- )

	;on-button ;on-button-insert
		.Controller/vector DEI2 ;on-button-insert EQU2
			[ JMP SWP2 POP2 ]
			.Controller/vector DEO2
	;draw-position JSR2

JMP2r

@play-toggle ( -- )

	.timer/playing LDZk #00 EQU SWP STZ
	;draw-timer JSR2

JMP2r

@toggle-guide ( -- )

	.guide LDZk #00 EQU SWP STZ
	;draw-grid JSR2
	.toolbar/y1 LDZ2 .Screen/y DEO2
	.grid/x2 LDZ2 #0018 SUB2 .Screen/x DEO2
	#00 .guide LDZ #40 SFT2 ;help-icn ADD2 .Screen/addr DEO2
	#01 .Screen/sprite DEO

JMP2r

( special )

@dpad-input ( -> )

	&start ( button* -> )
		POP
		#20 .dpad STZ
		;&save JMP2
	&end ( button* -> )
		POP
		.dpad LDZ #7f GTH ,&save JCN
		.dpad LDZ ;fill-sel JSR2
		.selection/from LDZ2 ;set-sel-from JSR2
		#00 .dpad STZ
		.dpad/last STZ
		;draw-speed JSR2
		BRK
		,&save JMP
	&add ( button* -> )
		#02 NEQ ,&save JCN
		DUP #04 SFT .dpad LDZ ADD #7f AND .dpad STZ
		,&save JMP
	&save ( -> )
		.dpad/last STZ
		;draw-dpad JSR2

BRK

@init ( -- )

	LIT '. DUP ;mfil/data STA2
	;data/cells .grid/length LDZ2 ;mfil JSR2
	&grid
	#0000 ;mfil/data STA2
	;data/locks .grid/length LDZ2 STH2k ;mfil JSR2
	;data/types STH2r ;mfil JSR2
	LIT '. DUP ;mfil/data STA2
	;variables #0024 ;mfil JSR2
	#00 .signal/midi STZ

JMP2r

@manage-voices ( -> )

	( iterate thru channels )

	#10 #00 &while EQUk ,&end JCN
		( note ) DUPk ADD .voices ADD LDZk
		( remaining length ) SWP INC LDZ
		( next channel if already 0 ) DUP #00 EQU ,&next-chan JCN
		( update remaining length ) #01 SUB ROTk DUP ADD .voices ADD INC STZ POP
		( send note-off when length reaches 0 )
		#00 NEQ ,&no-off JCN
			( channel ) OVR .Console/write DEO
			( note ) DUP .Console/write DEO
			( off ) #00 .Console/write DEO
		&no-off
		POP
		INC
	,&while JMP &end POP2 JMP2r

	&next-chan POP2 INC
	,&while JMP

JMP2r

@run ( -- )

	,init/grid JSR
	( reset head ) LIT2r 0000
	.grid/height LDZ #00
	&ver
		DUP .head/y STZ
		.grid/width LDZ #00
		&hor
			DUP .head/x STZ
			STH2kr ,run-char JSR
			INC2r
			INC GTHk ,&hor JCN
		POP2
		INC GTHk ,&ver JCN
	POP2
	POP2r
	( do not draw when menu )
	;draw-menu/sel LDA #ff NEQ ,&skip JCN
		;draw-grid JSR2
		;draw-timer JSR2
		&skip

JMP2r

@run-char ( id* -- )

	( cache )
	DUP2 .head/addr STZ2
	( skip locked )
	DUP2 ;data/locks ADD2 LDA ,&locked JCN
	( run unlocked )
	DUP2 ;data/cells ADD2 LDA
	#00 SWP #20 SUB DUP ADD ;op-ascii ADD2 LDA2 JMP2
	&locked
	POP2

JMP2r

( operations )

@get-bang ( -- bang )

	.head/addr LDZ2 ;data/cells ADD2 STH2k
	( left ) #0001 SUB2 LDA LIT '* EQU ,&bang JCN
	( top ) STH2kr #00 .grid/width LDZ SUB2 LDA LIT '* EQU ,&bang JCN
	( right ) STH2kr INC2 LDA LIT '* EQU ,&bang JCN
	( bottom ) STH2kr #00 .grid/width LDZ ADD2 LDA LIT '* EQU ,&bang JCN
	POP2r #00 JMP2r
	&bang POP2r #01

JMP2r

@lerp ( rate target val -- val )

	DUP2 GTHk [ JMP SWP SUB ] STH
	( if rate GTH target )
	ROT DUP STHr LTH ,&skip JCN
		POP2 JMP2r
		&skip
	( target val rate )
	STH
	GTHk ,&no-below JCN
		NIP STHr SUB JMP2r
		&no-below
	NIP STHr ADD

JMP2r

( drawing )

@draw-dpad ( -- )

	[ LIT2 &x $2 ] .Screen/x DEO2
	[ LIT2 &y $2 ] .Screen/y DEO2
	( value )
	#04 ;draw-chr/color STA
	.dpad LDZ ;draw-byte JSR2
	( space )
	#00 .Screen/sprite DEO
	( icon )
	.dpad LDZ #01 ;draw-chr-color JSR2

JMP2r

@draw-position ( -- )

	[ LIT2 &x $2 ] .Screen/x DEO2
	[ LIT2 &y $2 ] .Screen/y DEO2
	( draw size )
	.selection/from LDZ2 .selection/to LDZ2 EQU2k ,&normal JCN
		SWP2 SUB2 DUP2
		&normal
	( value )
	#01 ;draw-chr/color STA
	POP2 ;draw-short JSR2
	( icon )
	;selector-icn #00 [ .Controller/vector DEI2 ;on-button-insert EQU2 ] #40 SFT2 ADD2 .Screen/addr DEO2
	#02 .selection/from LDZ2 .selection/to LDZ2 EQU2 ADD .Screen/sprite DEO

JMP2r

@draw-timer ( -- )

	[ LIT2 &x $2 ] .Screen/x DEO2
	[ LIT2 &y $2 ] .Screen/y DEO2
	( value )
	.timer/frame-lb LDZ
		DUP #03 .timer/playing LDZ DUP ADD SUB ;draw-chr/color STA
		;draw-byte JSR2
	( icon )
	;beat-icn .Screen/addr DEO2
	#03 SWP #07 AND #00 EQU SUB .Screen/sprite DEO

JMP2r

@draw-speed ( -- )

	[ LIT2 &x $2 ] .Screen/x DEO2
	[ LIT2 &y $2 ] .Screen/y DEO2
	( value )
	#01 ;draw-chr/color STA
	.timer/speed LDZ ;draw-byte JSR2
	( th )
	;&th #03 ;draw-str-color JSR2

JMP2r
	&th "th $1

@draw-state ( -- )

	[ LIT2 &x $2 ] .Screen/x DEO2
	[ LIT2 &y $2 ] .Screen/y DEO2
	( icon )
	;save-icn .Screen/addr DEO2
	#01 .Screen/sprite DEO

JMP2r

@draw-filepath ( color -- )

	[ LIT2 &x $2 ] .Screen/x DEO2
	[ LIT2 &y $2 ] .Screen/y DEO2
	( icon )
	;filepath ROT ;draw-str-color JSR2

JMP2r

@draw-meter ( -- )

	[ LIT2 &x $2 ] .Screen/x DEO2
	[ LIT2 &y $2 ] .Screen/y DEO2
	.signal/midi LDZ #07 LTHk [ JMP SWP POP ] STH
	;meter-icn #00 STHkr #40 SFT2 ADD2 .Screen/addr DEO2
	STHr #07 EQU INC .Screen/sprite DEO

JMP2r

@redraw-all ( -- )

@draw-grid ( -- )

	( reset head ) LIT2r 0000
	.grid/height LDZ #00
	&ver
		DUP .head/y STZ
		( x ) .grid/x1 LDZ2 .Screen/x DEO2
		( y ) #00 OVR #40 SFT2 .grid/y1 LDZ2 ADD2 .Screen/y DEO2
		.grid/width LDZ #00
		&hor
			DUP .head/x STZ
			STH2kr .head/addr STZ2
			STH2kr ,get-char-at-addr JSR ,get-color JSR ;draw-chr-color JSR2
			INC2r
			INC GTHk ,&hor JCN
		POP2
		INC GTHk ,&ver JCN
	POP2
	POP2r
	( draw meter )
	;draw-meter JSR2
	( draw guide )
	.guide LDZ ;draw-guide JCN2

JMP2r

@get-color ( -- char type )

	.head LDZ2 ;is-selected JSR2 ,&selected JCN
		#00 .head/addr LDZ2 ;data/types ADD2 LDA ;cell-styles ADD2 LDA JMP2r
	&selected
		#09

JMP2r

@get-char-at-addr ( addr* -- char )

	;data/cells ADD2 LDA
	DUP LIT '. NEQ ,&no-bar JCN
		POP .head LDZ2
		DUP2 #07 AND SWP #0f AND ORA ,&no-cross JCN
			POP2 #7f JMP2r
			&no-cross
		DUP2 #01 AND SWP #03 AND ORA ,&no-dot JCN
			&dot POP2 LIT '. JMP2r
			&no-dot
		DUP2 ,is-selected JSR ,&dot JCN
		.head/addr LDZ2 ;data/types ADD2 LDA ,&dot JCN
		POP2 #20
	&no-bar

JMP2r

@get-word ( addr* -- word* )

	;&word #0020 ;mclr JSR2
	&while
		INC2 DUP2 ;data/cells ADD2 LDA
			DUP LIT '. EQU ,&skip JCN
				DUP ;&word ;sput JSR2
				&skip
			LIT '. NEQ ,&while JCN
	POP2
	;&word

JMP2r
	&word $20

@is-selected ( x y -- bool )

	DUP .selection/y1 LDZ LTH ,&end JCN
	DUP .selection/y2 LDZ GTH ,&end JCN
	OVR .selection/x1 LDZ LTH ,&end JCN
	OVR .selection/x2 LDZ GTH ,&end JCN
		POP2 #01 JMP2r
	&end
	POP2 #00

JMP2r

@draw-guide ( -- )

	#0021 #0000
	&loop
		( x ) DUP2 #84 SFT2 .grid/x1 LDZ2 ADD2 #0020 ADD2 .Screen/x DEO2
		( y ) DUP2 #000f AND2 #40 SFT2 .grid/y1 LDZ2 ADD2 #0020 ADD2 .Screen/y DEO2
		.Screen/y DEI2 .grid/y2 LDZ2 #0030 SUB2 GTH2 ,&skip JCN
		DUP2k ADD2 ;op-table/docs ADD2 LDA2
		( glyph )
			LDAk #08 ;draw-chr-color JSR2
		( space )
			#00 .Screen/sprite DEO
		( text )
			INC2 #01 ;draw-str-color JSR2
		&skip
		INC2 GTH2k ,&loop JCN
	POP2 POP2

JMP2r

@draw-short ( short* -- )

	SWP ,draw-byte JSR

@draw-byte ( byte -- )

	DUP #04 SFT ,draw-hex JSR

@draw-hex ( byte -- )

	 #0f AND DUP #09 GTH #07 MUL ADD #30 ADD ,draw-chr JSR

JMP2r

@draw-chr-color ( char color -- )

	,draw-chr/color STR

@draw-chr ( char -- )

	#20 SUB #00 SWP #40 SFT2 ;font ADD2 .Screen/addr DEO2
	[ LIT &color 01 ] .Screen/sprite DEO

JMP2r

@draw-str-color ( str* color -- )

	,draw-chr/color STR
	;draw-str JSR2 POP2

JMP2r

@get-strw ( str* -- width* )

	;slen JSR2 #30 SFT2

JMP2r

( file )

@file-new ( -- )

	;init JSR2

	( rename to untitled.txt )
	#00 ;draw-filepath JSR2
	;filepath #0040 ;mclr JSR2
	;untitled-txt ;filepath #000d ;mcpy JSR2
	#01 ;draw-filepath JSR2

	( default speed )
	#0b ;set-speed JSR2

	;run JSR2
	#00 .state/changed STZ ;draw-state JSR2

JMP2r

@file-rename ( -- )

	;trap JSR2

JMP2r

@file-open ( -- )

	#0000 ;filepath ,inject-file JSR
	;draw-grid JSR2
	#00 .state/changed STZ ;draw-state JSR2

JMP2r

@inject-file ( x y path* -- )

	.File/name DEO2
	#0001 .File/length DEO2
	OVR ,&anchor-x STR
	&stream
		;&b .File/read DEO2
		( write )
		;&b LDA ;ci-key JSR2 #00 EQU ,&invalid JCN
			DUP2 ;&b LDA ;set-cell JSR2
			&invalid
		( inc x ) SWP INC SWP
		;&b LDA #0a NEQ ,&no-lb JCN
			( inc y ) INC
			( reset x ) [ LIT &anchor-x $1 ] ROT POP SWP
			&no-lb
		.File/success DEI2 ORA ,&stream JCN
	POP2

JMP2r
	&b $1

@file-save ( -- )

	;filepath .File/name DEO2
	#0001 .File/length DEO2
	.grid/height LDZ #00
	&ver
		.grid/width LDZ #00
		&hor
			OVR2 NIP OVR SWP ;get-cell JSR2 ;data/cells ADD2 .File/write DEO2
			INC GTHk ,&hor JCN
		POP2
		( linebreak ) ;&lb .File/write DEO2
		INC GTHk ,&ver JCN
	POP2
	#00 .state/changed STZ ;draw-state JSR2

JMP2r
	&lb 0a

( random )

@init-prng ( -- )

	( seed )
	#00 .DateTime/second DEI
	#00 .DateTime/minute DEI #60 SFT2 EOR2
	#00 .DateTime/hour DEI #c0 SFT2 EOR2 ,prng/x STR2
	#00 .DateTime/hour DEI #04 SFT2
	#00 .DateTime/day DEI DUP2 ADD2 EOR2
	#00 .DateTime/month DEI #60 SFT2 EOR2
	.DateTime/year DEI2 #a0 SFT2 EOR2 ,prng/y STR2

JMP2r

@prng ( -- number* )

	LIT2 &x $2
	DUP2 #50 SFT2 EOR2
	DUP2 #03 SFT2 EOR2
	LIT2 &y $2 DUP2 ,&x STR2
	DUP2 #01 SFT2 EOR2 EOR2
	,&y STR2k POP

JMP2r

( snarf )

@snarf-txt ".snarf $1

@edit-cut ( -- )

	,edit-copy JSR
	LIT '. ;fill-sel JSR2

JMP2r

@edit-copy ( -- )

	;snarf-txt .File/name DEO2
	#0001 .File/length DEO2
	.selection/y2 LDZ INC .selection/y1 LDZ
	&ver
		STHk
		.selection/x2 LDZ INC .selection/x1 LDZ
		&hor
			DUP STHkr ;get-cell JSR2 ;data/cells ADD2 .File/write DEO2
			INC GTHk ,&hor JCN
		POP2 POPr
		( linebreak ) ;&lb .File/write DEO2
		INC GTHk ,&ver JCN
	POP2

JMP2r
	&lb 0a

@edit-paste ( -- )

	.selection LDZ2 ;snarf-txt ;inject-file JSR2
	;draw-grid JSR2

JMP2r

@edit-erase ( -- )

	LIT '. ;fill-sel JSR2

JMP2r

( helpers )

@b36chr ( b36 -- char ) #24 MOD #00 SWP ;b36clc ADD2 LDA JMP2r
@chrb36 ( char -- b36 ) #20 SUB #00 SWP ;values ADD2 LDA JMP2r
@chrmid ( char -- midi ) DUP ,chrb36 JSR SWP ,ciuc JSR #24 MUL ADD #00 SWP ;notes ADD2 LDA JMP2r
@ciuc ( char -- bool ) DUP #40 GTH SWP #5b LTH AND JMP2r
@ci-key ( char -- bool ) DUP #20 GTH SWP #7b LTH AND JMP2r

@set-cell ( x y c -- ) ROT ROT ,get-cell JSR ;data/cells ADD2 STA JMP2r
@get-cell ( x y -- addr* ) #00 SWP #00 .grid/width LDZ MUL2 ROT #00 SWP ADD2 JMP2r

@raw-to-b128 ( raw -- b128 )

	;chrb36 JSR2
	#00 SWP #007f MUL2 #0023 DIV2 NIP

JMP2r

@set-port-output ( value addr* -- )

	( set lock ) STH2k #01 STH2kr ;data/locks ADD2 STA
	( set type ) OUTPUT-TYPE STH2r ;data/types ADD2 STA
	( set data ) ;data/cells ADD2 STA

JMP2r

@set-port-raw ( value addr* -- )

	( set lock ) STH2k #01 STH2kr ;data/locks ADD2 STA
	( set type ) #00 STH2r ;data/types ADD2 STA
	( set data ) ;data/cells ADD2 STA

JMP2r

@get-port-left-raw ( addr* -- value )

	( set type ) STH2k PORTEL-TYPE STH2r ;data/types ADD2 STA
	( get data ) ;data/cells ADD2 LDA

JMP2r

@get-port-left-value ( addr* -- value )

	,get-port-left-raw JSR ;chrb36 JSR2

JMP2r

@get-port-right-raw ( addr* -- value )

	( set lock ) STH2k #01 STH2kr ;data/locks ADD2 STA
	( set type ) PORTER-TYPE STH2r ;data/types ADD2 STA
	( get data ) ;data/cells ADD2 LDA

JMP2r

@get-port-right-value ( addr* -- value )

	,get-port-right-raw JSR ;chrb36 JSR2

JMP2r

( generics )

@mfil ( src* len* -- )

	ADD2k NIP2 SWP2
	&l
		[ LIT2 &data 0000 ] OVR2 STA2
		INC2 INC2 GTH2k ,&l JCN
	POP2 POP2

JMP2r

@within-rect ( x* y* rect -- flag )

	STH
	( y LTH rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ,&skip JCN
	( y GTH rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN
	SWP2
	( x LTH rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN
	( x GTH rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
	POP2 POP2 POPr
	#01
JMP2r
	&skip
	POP2 POP2 POPr
	#00

JMP2r

@untitled-txt "untitled.orca $1

~src/library.tal
~src/assets.tal
~src/manifest.tal

@data
	&cells $4000
	&locks $4000
	&types $4000