Browse code

Progress on orca

neauoire authored on 09/04/2021 05:00:06
Showing 2 changed files
... ...
@@ -1,13 +1,12 @@
1 1
 ( Orca 
2 2
 	
3 3
 	TODO
4
-		- Display guides
5
-		- Clamp selection to grid
6 4
 		- Synthax highlight
5
+		- B operating doesn't loop around
7 6
 		- Locking ports
8 7
 		- Detect capitalization
9
-		- Draw Interface
10 8
 		- Comments
9
+		- Scale selection
11 10
 		- Load/Save
12 11
 		- Copy/Paste
13 12
 		- Copy/paste(chorded)
... ...
@@ -20,7 +19,7 @@
20 19
 
21 20
 ( variables )
22 21
 
23
-;timer { byte 1 frame 1 }
22
+;timer { byte 1 frame 1 speed 1 }
24 23
 ;grid { width 1 height 1 }
25 24
 ;selection { x1 1 y1 1 x2 1 y2 1 }
26 25
 ;cursor { x 2 y 2 }
... ...
@@ -45,7 +44,7 @@
45 44
 
46 45
 	( find size )
47 46
 	~Screen.width 8/ SWP POP =grid.width
48
-	~Screen.height 8/ SWP POP =grid.height
47
+	~Screen.height 8/ SWP POP #02 SUB =grid.height
49 48
 
50 49
 	( fill grid with dots )
51 50
 
... ...
@@ -58,18 +57,19 @@ BRK
58 57
 
59 58
 	~timer #01 ADD DUP =timer
60 59
 
61
-	#10 EQU ^$tick JNZ BRK $tick
60
+	( skip ) #08 EQU ^$tick JNZ BRK $tick
61
+
62
+	~timer.frame #01 ADD =timer.frame
62 63
 
63 64
 	,run JSR2
64 65
 
65 66
 	#00 =timer
66
-	~timer.frame #01 ADD =timer.frame
67 67
 
68 68
 BRK
69 69
 
70 70
 @on-key
71 71
 	
72
-	~Keys.key #00 NEQ ^$continue JNZ BRK $continue
72
+	( skip ) ~Keys.key #00 NEQ ^$continue JNZ BRK $continue
73 73
 
74 74
 	~selection.x1 ~selection.y1 ~Keys.key ,put-char JSR2
75 75
 
... ...
@@ -84,15 +84,19 @@ BRK
84 84
 	( arrows )
85 85
 	~Controller.button #f0 AND
86 86
 		DUP #04 SFT #01 AND #01 NEQ ^$no-up JNZ 
87
+			~selection.y1 #00 EQU ^$no-up JNZ
87 88
 			~selection.y1 #01 SUB =selection.y1 
88 89
 			~selection.y2 #01 SUB =selection.y2 $no-up
89 90
 		DUP #05 SFT #01 AND #01 NEQ ^$no-down JNZ 
91
+			~selection.y1 ~grid.height #01 SUB EQU ^$no-down JNZ
90 92
 			~selection.y1 #01 ADD =selection.y1 
91 93
 			~selection.y2 #01 ADD =selection.y2 $no-down
92 94
 		DUP #06 SFT #01 AND #01 NEQ ^$no-left JNZ 
95
+			~selection.x1 #00 EQU ^$no-left JNZ
93 96
 			~selection.x1 #01 SUB =selection.x1 
94 97
 			~selection.x2 #01 SUB =selection.x2 $no-left
95 98
 		DUP #07 SFT #01 AND #01 NEQ ^$no-right JNZ 
99
+			~selection.x1 ~grid.width #01 SUB EQU ^$no-right JNZ
96 100
 			~selection.x1 #01 ADD =selection.x1 
97 101
 			~selection.x2 #01 ADD =selection.x2 $no-right
98 102
 	POP
... ...
@@ -147,6 +151,8 @@ BRK
147 151
 		DUP2 LTH ^$ver JNZ
148 152
 	POP2
149 153
 
154
+	#9a =timer.speed
155
+
150 156
 RTN
151 157
 
152 158
 @is-selected ( x y -- flag )
... ...
@@ -181,7 +187,7 @@ RTN
181 187
 
182 188
 @get-value-char ( value -- char )
183 189
 	
184
-	#00 SWP ,b36clc ADD2 PEK2
190
+	#24 MOD #00 SWP ,b36clc ADD2 PEK2
185 191
 	
186 192
 RTN
187 193
 
... ...
@@ -193,35 +199,29 @@ RTN
193 199
 
194 200
 @get-char-sprite ( x y -- addr )
195 201
 	
196
-	,get-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2
197
-
198
-RTN
199
-
200
-@get-char-sprite-grid ( x y -- addr )
201
-	
202 202
 	DUP2 ,get-char JSR2 
203 203
 	( if character is dot )
204 204
 	DUP #2e NEQ ^$no-bar JNZ
205 205
 		( check if x,y is grid )
206 206
 		POP
207
-		#08 MOD #00 EQU
208
-		SWP
209
-		#08 MOD #00 EQU
210
-		( make it a + ) #0101 EQU2 #00 SWP #0058 MUL2 ,font ADD2
211
-		RTN
207
+		DUP2 #08 MOD #00 EQU SWP #08 MOD #00 EQU #0101 NEQ2 ^$no-marker8 JNZ POP2 ,marker8_icn RTN $no-marker8
208
+		DUP2 #02 MOD #00 EQU SWP #02 MOD #00 EQU #0101 NEQ2 ^$no-marker4 JNZ POP2 ,marker4_icn RTN $no-marker4
209
+		POP2 ,font RTN
212 210
 	$no-bar
213 211
 	STH POP2 STHr
214 212
 	#20 SUB #00 SWP #0008 MUL2 ,font ADD2
215 213
 
216 214
 RTN
217 215
 
216
+( operators )
217
+
218 218
 @op-a ( x y char -- )
219 219
 
220 220
 	POP
221 221
 	( get left ) DUP2 SWP #01 SUB SWP ,get-value JSR2 STH
222 222
 	( get right ) DUP2 SWP #01 ADD SWP ,get-value JSR2 STH
223 223
 	( incr y ) #01 ADD 
224
-	( get result ) ADDr STHr 
224
+	( get result ) ADDr STHr
225 225
 	,get-value-char JSR2 
226 226
 	,put-char JSR2
227 227
 
... ...
@@ -247,11 +247,190 @@ RTN
247 247
 
248 248
 RTN
249 249
 
250
+@op-d ( x y char -- )
251
+
252
+	POP POP2
253
+	
254
+RTN
255
+
256
+@op-e ( x y char -- )
257
+
258
+	POP POP2
259
+	
260
+RTN
261
+
262
+@op-f ( x y char -- )
263
+
264
+	POP POP2
265
+	
266
+RTN
267
+
268
+@op-g ( x y char -- )
269
+
270
+	POP POP2
271
+	
272
+RTN
273
+
274
+@op-h ( x y char -- )
275
+
276
+	POP POP2
277
+	
278
+RTN
279
+
280
+@op-i ( x y char -- )
281
+
282
+	POP POP2
283
+	
284
+RTN
285
+
286
+@op-j ( x y char -- )
287
+
288
+	POP POP2
289
+	
290
+RTN
291
+
292
+@op-k ( x y char -- )
293
+
294
+	POP POP2
295
+	
296
+RTN
297
+
298
+@op-l ( x y char -- )
299
+
300
+	POP POP2
301
+	
302
+RTN
303
+
304
+@op-m ( x y char -- )
305
+
306
+	POP POP2
307
+	
308
+RTN
309
+
310
+@op-n ( x y char -- )
311
+	
312
+	STH
313
+	( limit )
314
+	DUP #00 NEQ ^$not-edge JNZ
315
+		#2a ,put-char JSR2
316
+		POP STHr
317
+		RTN
318
+	$not-edge
319
+	( collide )
320
+	DUP2 #01 SUB ,get-char JSR2 #2e EQU ^$not-collide JNZ
321
+		#2a ,put-char JSR2
322
+		POP STHr
323
+		RTN
324
+	$not-collide
325
+	DUP2 STHr
326
+	SWP #01 SUB SWP ,put-char JSR2	
327
+	#2e ,put-char JSR2
328
+	
329
+RTN
330
+
331
+@op-o ( x y char -- )
332
+
333
+	POP POP2
334
+	
335
+RTN
336
+
337
+@op-p ( x y char -- )
338
+
339
+	POP POP2
340
+	
341
+RTN
342
+
343
+@op-q ( x y char -- )
344
+
345
+	POP POP2
346
+	
347
+RTN
348
+
349
+@op-r ( x y char -- )
350
+
351
+	POP POP2
352
+	
353
+RTN
354
+
355
+@op-s ( x y char -- )
356
+	
357
+	STH DUP2 STHr
358
+	SWP #01 ADD SWP ,put-char JSR2	
359
+	#2e ,put-char JSR2
360
+	( TODO: Lock )
361
+	
362
+RTN
363
+
364
+@op-t ( x y char -- )
365
+
366
+	POP POP2
367
+	
368
+RTN
369
+
370
+@op-u ( x y char -- )
371
+
372
+	POP POP2
373
+	
374
+RTN
375
+
376
+@op-v ( x y char -- )
377
+
378
+	POP POP2
379
+	
380
+RTN
381
+
382
+@op-w ( x y char -- )
383
+
384
+	POP POP2
385
+	
386
+RTN
387
+
388
+@op-x ( x y char -- )
389
+
390
+	POP POP2
391
+	
392
+RTN
393
+
394
+@op-y ( x y char -- )
395
+
396
+	POP POP2
397
+	
398
+RTN
399
+
400
+@op-z ( x y char -- )
401
+
402
+	POP POP2
403
+	
404
+RTN
405
+
250 406
 @run-char ( x y char -- )
251 407
 	
252 408
 	( A ) DUP #41 EQU ,op-a JNZ2
253 409
 	( B ) DUP #42 EQU ,op-b JNZ2
254 410
 	( C ) DUP #43 EQU ,op-c JNZ2
411
+	( D ) DUP #44 EQU ,op-d JNZ2
412
+	( E ) DUP #45 EQU ,op-e JNZ2
413
+	( F ) DUP #46 EQU ,op-f JNZ2
414
+	( G ) DUP #47 EQU ,op-g JNZ2
415
+	( H ) DUP #48 EQU ,op-h JNZ2
416
+	( I ) DUP #49 EQU ,op-i JNZ2
417
+	( J ) DUP #4a EQU ,op-j JNZ2
418
+	( K ) DUP #4b EQU ,op-k JNZ2
419
+	( L ) DUP #4c EQU ,op-l JNZ2
420
+	( M ) DUP #4d EQU ,op-m JNZ2
421
+	( N ) DUP #4e EQU ,op-n JNZ2
422
+	( O ) DUP #4f EQU ,op-o JNZ2
423
+	( P ) DUP #50 EQU ,op-p JNZ2
424
+	( Q ) DUP #51 EQU ,op-q JNZ2
425
+	( R ) DUP #52 EQU ,op-r JNZ2
426
+	( S ) DUP #53 EQU ,op-s JNZ2
427
+	( T ) DUP #54 EQU ,op-t JNZ2
428
+	( U ) DUP #55 EQU ,op-u JNZ2
429
+	( V ) DUP #56 EQU ,op-v JNZ2
430
+	( W ) DUP #57 EQU ,op-w JNZ2
431
+	( X ) DUP #58 EQU ,op-x JNZ2
432
+	( Y ) DUP #59 EQU ,op-y JNZ2
433
+	( Z ) DUP #5a EQU ,op-z JNZ2
255 434
 	POP POP2
256 435
 
257 436
 RTN
... ...
@@ -279,31 +458,58 @@ RTN
279 458
 	
280 459
 	~Screen.height #0008 SUB2 =Sprite.y
281 460
 
282
-	( TODO: Position )
283
-	( TODO: Frame )
284
-	( TODO: BPM )
285
-
461
+	( Positionx )
462
+	#0000 =Sprite.x
463
+	~selection.x1 
464
+		DUP #04 SFT ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Sprite.addr
465
+	#02 =Sprite.color
466
+	#0008 =Sprite.x
467
+		#0f AND ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Sprite.addr
468
+	#02 =Sprite.color
469
+
470
+	( Positiony )
471
+	#0010 =Sprite.x
472
+	~selection.y1 
473
+		DUP #04 SFT ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Sprite.addr
474
+	#02 =Sprite.color
475
+	#0018 =Sprite.x
476
+		#0f AND ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Sprite.addr
477
+	#02 =Sprite.color
478
+
479
+	#0020 =Sprite.x
480
+	,position_icn =Sprite.addr
481
+	#03 =Sprite.color
482
+
483
+	( Frame )
484
+	#0030 =Sprite.x
485
+	~timer.frame 
486
+		DUP #04 SFT ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Sprite.addr
487
+	#02 =Sprite.color
488
+	#0038 =Sprite.x
489
+		#0f AND ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Sprite.addr
490
+	#02 =Sprite.color
491
+
492
+	#0040 =Sprite.x
493
+	,beat_icn =Sprite.addr
494
+	#01 ~timer.frame #08 MOD #00 EQU #02 MUL ADD =Sprite.color
495
+
496
+	( Speed )
497
+	#0050 =Sprite.x
498
+	~timer.speed 
499
+		DUP #04 SFT ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Sprite.addr
500
+	#02 =Sprite.color
501
+	#0058 =Sprite.x
502
+		#0f AND ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Sprite.addr
503
+	#02 =Sprite.color
504
+
505
+	( TODO: Signal VU )
506
+
507
+	( File )
286 508
 	~Screen.width #0028 SUB2 =Sprite.x
287
-
288
-	( TODO: Toggle Guides )
289
-	~Sprite.x 8+ =Sprite.x
290
-	,eye_icns =Sprite.addr
291
-	#01 =Sprite.color
292
-
293
-	( TODO: New )
294
-	~Sprite.x 8+ =Sprite.x
295
-	,filestate_icn =Sprite.addr
296
-	#01 =Sprite.color
297
-
298
-	( TODO: Load )
299
-	~Sprite.x 8+ =Sprite.x
300
-	,load_icn =Sprite.addr
301
-	#01 =Sprite.color
302
-
303
-	( TODO: Save )
304
-	~Sprite.x 8+ =Sprite.x
305
-	,save_icn =Sprite.addr
306
-	#01 =Sprite.color
509
+	~Sprite.x 8+ =Sprite.x ,eye_icns =Sprite.addr #01 =Sprite.color
510
+	~Sprite.x 8+ =Sprite.x ,filestate_icn =Sprite.addr #01 =Sprite.color
511
+	~Sprite.x 8+ =Sprite.x ,load_icn =Sprite.addr #01 =Sprite.color
512
+	~Sprite.x 8+ =Sprite.x ,save_icn =Sprite.addr #01 =Sprite.color
307 513
 
308 514
 RTN
309 515
 
... ...
@@ -316,7 +522,7 @@ RTN
316 522
 		$hor
317 523
 			( pos-x )   OVR #00 SWP #0008 MUL2 =Sprite.x 
318 524
 			( get x,y ) SWP2 OVR STH SWP2 OVR STHr 
319
-			( sprite )  DUP2 ,get-char-sprite-grid JSR2 =Sprite.addr
525
+			( sprite )  DUP2 ,get-char-sprite JSR2 =Sprite.addr
320 526
 			( draw )    ,is-selected JSR2 #0d MUL #01 ADD =Sprite.color
321 527
 			( incr )    SWP #01 ADD SWP
322 528
 			DUP2 LTH ^$hor JNZ
... ...
@@ -361,16 +567,20 @@ RTN
361 567
 	77 78 79 7a
362 568
 ]
363 569
 
364
-@cursor_icn [ 80c0 e0f0 f8e0 1000 ]
365
-@blank_icn  [ 0000 0000 0000 0000 ]
570
+@cursor_icn     [ 80c0 e0f0 f8e0 1000 ]
571
+@blank_icn      [ 0000 0000 0000 0000 ]
572
+@position_icn   [ 0066 4200 0042 6600 ]
573
+@beat_icn       [ 0000 1038 7c38 1000 ]
574
+@marker8_icn    [ 0000 2400 0024 0000 ]
575
+@marker4_icn    [ 0000 0000 0000 1000 ]
576
+@filestate_icn  [ 1054 28c6 2854 1000 ]
577
+@load_icn       [ feaa d6aa d4aa f400 ]
578
+@save_icn       [ fe82 8282 848a f400 ]
366 579
 
367 580
 @eye_icns
368 581
 	[ 0038 4492 2810 0000 ] ( open )
369 582
 	[ 0000 0082 4438 0000 ] ( closed )
370 583
 
371
-@filestate_icn  [ 1054 28c6 2854 1000 ]
372
-@load_icn       [ feaa d6aa d4aa f400 ]
373
-@save_icn       [ fe82 8282 848a f400 ]
374 584
 
375 585
 @font ( specter8-frag font ) 
376 586
 [
... ...
@@ -379,7 +589,7 @@ RTN
379 589
 	0008 1e28 1c0a 3c08 0000 2204 0810 2200
380 590
 	0030 4832 4c44 3a00 0008 1000 0000 0000
381 591
 	0004 0808 0808 0400 0020 1010 1010 2000
382
-	0000 2214 0814 2200 0000 0808 3e08 0800
592
+	005a 2442 4224 5a00 0000 0808 3e08 0800
383 593
 	0000 0000 0000 0810 0000 0000 3e00 0000
384 594
 	0000 0000 0000 0800 0000 0204 0810 2000
385 595
 	003c 464a 5262 3c00 0018 0808 0808 1c00
... ...
@@ -424,4 +634,4 @@ RTN
424 634
 	0000 0032 4c00 0000 3c42 99a1 a199 423c
425 635
 ]
426 636
 
427
-@data [ elephant ]
428 637
\ No newline at end of file
638
+@data [ ]
429 639
\ No newline at end of file
... ...
@@ -10,10 +10,6 @@ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10 10
 WITH REGARD TO THIS SOFTWARE.
11 11
 */
12 12
 
13
-typedef unsigned char Uint8;
14
-typedef signed char Sint8;
15
-typedef unsigned short Uint16;
16
-typedef signed short Sint16;
17 13
 typedef unsigned int Uint32;
18 14
 typedef signed int Sint32;
19 15