-
Notifications
You must be signed in to change notification settings - Fork 0
/
UNESS.BAS
2131 lines (1947 loc) · 55.2 KB
/
UNESS.BAS
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
DECLARE FUNCTION optostr$ ()
DECLARE FUNCTION str.imm$ ()
DECLARE FUNCTION str.zp$ ()
DECLARE FUNCTION str.zpx$ ()
DECLARE FUNCTION str.zpy$ ()
DECLARE FUNCTION str.abso$ ()
DECLARE FUNCTION str.absx$ ()
DECLARE FUNCTION str.absy$ ()
DECLARE FUNCTION str.pre$ ()
DECLARE FUNCTION str.post$ ()
DECLARE FUNCTION hexpad$ (n&, p&)
DECLARE SUB save ()
DECLARE SUB vb ()
DECLARE SUB config ()
DECLARE FUNCTION filerequest$ ()
DECLARE FUNCTION zpx& ()
DECLARE FUNCTION zpy& ()
DECLARE FUNCTION abso& ()
DECLARE FUNCTION absx& ()
DECLARE FUNCTION absy& ()
DECLARE FUNCTION pre& ()
DECLARE FUNCTION post& ()
DECLARE FUNCTION zp& ()
DECLARE FUNCTION breakpoint! ()
DECLARE SUB op.sbc (typ&)
DECLARE SUB op.brk ()
DECLARE SUB op.php ()
DECLARE SUB op.plp ()
DECLARE SUB op.cpy (typ&)
DECLARE SUB op.bit (typ&)
DECLARE SUB op.cpx (typ&)
DECLARE SUB op.eor (typ&)
DECLARE SUB crappygfxengine ()
DECLARE SUB patterntables ()
DECLARE SUB op.rti ()
DECLARE SUB op.dec (typ&)
DECLARE SUB op.sty (typ&)
DECLARE SUB op.stx (typ&)
DECLARE SUB op.and (typ&)
DECLARE SUB op.inc (typ&)
DECLARE SUB op.ldy (typ&)
DECLARE SUB op.cmp (typ&)
DECLARE SUB op.rts ()
DECLARE FUNCTION pop% ()
DECLARE SUB op.jsr ()
DECLARE SUB push (r%)
DECLARE SUB moveup ()
DECLARE SUB loadfont ()
DECLARE FUNCTION anybyte% (posi&)
DECLARE SUB putbyte (byte%, posi&)
DECLARE SUB hagla (x, y, text$)
DECLARE SUB op.branch ()
DECLARE SUB op.tya ()
DECLARE SUB op.adc (typ&)
DECLARE SUB op.jmp (typ&)
DECLARE SUB op.txs ()
DECLARE SUB header ()
DECLARE SUB utskrift ()
DECLARE SUB op.ldx (typ&)
DECLARE SUB op.rol (typ&)
DECLARE SUB op.ror (typ&)
DECLARE SUB op.asl (typ&)
DECLARE SUB op.sec ()
DECLARE SUB op.sed ()
DECLARE SUB op.cli ()
DECLARE SUB op.clv ()
DECLARE SUB op.clc ()
DECLARE SUB op.cld ()
DECLARE SUB op.sei ()
DECLARE SUB op.ora (typ&)
DECLARE SUB op.lsr (typ&)
DECLARE SUB op.sta (typ&)
DECLARE SUB op.pla ()
DECLARE SUB op.pha ()
DECLARE SUB op.tsx ()
DECLARE SUB op.txa ()
DECLARE SUB op.dex ()
DECLARE SUB op.dey ()
DECLARE SUB op.lda (typ&)
DECLARE SUB op.inx ()
DECLARE SUB op.iny ()
DECLARE SUB op.tax ()
DECLARE SUB op.tay ()
DECLARE SUB emulate ()
DECLARE SUB getinput ()
DEFINT C, R
'Status: SV1BDIZC
' All registers must be shared
loadfont
DIM SHARED reg.a AS INTEGER, reg.x AS INTEGER, reg.y AS INTEGER
DIM SHARED reg.s AS INTEGER, pc AS LONG, reg.sp AS INTEGER
DIM SHARED nmi AS LONG, brk AS LONG
DIM SHARED fil$, byte$, opcode$
DIM SHARED ut AS INTEGER, utstep AS INTEGER
DIM SHARED bokstav(52, 5) AS INTEGER, rabies
DIM SHARED vramposi AS INTEGER, vblank AS INTEGER, ppu1 AS INTEGER
DIM SHARED sprramposi AS INTEGER, sprram(256) AS INTEGER
DIM SHARED ppustat AS INTEGER, sprite0(1) AS INTEGER, lines AS INTEGER
DIM SHARED s AS INTEGER, joy1emu AS INTEGER, joy1reads AS INTEGER
DIM SHARED joy1reset AS INTEGER, ppu2 AS INTEGER, firstread AS INTEGER
DIM SHARED bpoint AS LONG, skip AS INTEGER
DIM SHARED mirroring AS INTEGER, scrollwrite AS INTEGER
DIM SHARED scrollx(16) AS INTEGER, scrolly(16) AS INTEGER
DIM SHARED ppu1log(15) AS INTEGER
DIM SHARED pal(63, 2) AS INTEGER
DIM SHARED palemu AS INTEGER, frame AS INTEGER
DIM SHARED bank1(16383) AS INTEGER, bank2(16383) AS INTEGER
DIM SHARED ram(2047) AS INTEGER, vram(16383) AS INTEGER
DIM SHARED loopy.t AS INTEGER, loopy.x AS INTEGER
DIM SHARED fpstimer, fps AS INTEGER
ON ERROR GOTO 14
GOTO 7
14
SCREEN 0
PRINT "D'oh!"
PRINT "If this was caused by the file requester, don't worry about it."
PRINT "If it was caused by something else, please mail us."
END
7 firstread = 1
skip = 2
'uNESsential NES emulator. Version 0.20+
'
'Changes:
' Comments translated into English
' BVC/BVS fixed, were copies of BCC/BCS
' Use arrays instead of files to emulate memory
' Instruction printing works again
' Add the last few instruction (just some missing addressing modes for SBC and EOR)
' Wrap zero-page addresses in pre and post indexed modes
' Implement the indirect JMP bug
' Fix return address written by NMI
' Improve sprite palette
'
'General info:
'opcode functions are called op.???(?).
'All register variables are called reg.?. (exception: pc, which cannot be INT)
'Variables:
'fil$ - Filname of the current rom.
'byte$ - variable for reading a byte from memory.
byte$ = CHR$(0)
CLS
'Load a rom
config
fil$ = COMMAND$
IF fil$ = "" THEN fil$ = filerequest$
IF fil$ = "" THEN END
SCREEN 12
CLS
'Preparations
joy1reads = 1
FOR r = 1 TO 253
sprram(r) = &HF0
NEXT r
COLOR 12
hagla 1, 270, "joypads"
hagla 1, 290, "pattern tables"
hagla 270, 290, "palette"
FOR c = 0 TO 15
LINE (270 + c * 4, 300)-(273 + c * 4, 303), c, BF
scrollx(c) = -1
scrolly(c) = -1
ppu1log(c) = 0
NEXT c
OPEN fil$ FOR BINARY AS #1 'The rom has file number #1.
reg.s = &H2C 'Status bit 6=1 (?)
reg.sp = 255 'Stack pointer should be 255(!?)
header
LINE (459, 407)-(639, 407), 8, , 21845
patterntables
lasttimer = TIMER
emulate 'Start emulating!
FUNCTION abso&
pc = pc + 1
a = anybyte(pc)
pc = pc + 1
b = anybyte(pc)
abso = a + b * 256
END FUNCTION
FUNCTION absx&
pc = pc + 1
a = anybyte(pc)
pc = pc + 1
b = anybyte(pc)
absx = (a + b * 256 + reg.x) AND 65535
END FUNCTION
FUNCTION absy&
pc = pc + 1
a = anybyte(pc)
pc = pc + 1
b = anybyte(pc)
absy = (a + b * 256 + reg.y) AND 65535
END FUNCTION
FUNCTION anybyte% (posi AS LONG)
IF (posi AND &H8000) THEN
IF (posi AND &H4000) THEN
anybyte% = bank2(posi AND &H3FFF)
ELSE
anybyte% = bank1(posi AND &H3FFF)
END IF
ELSEIF posi < &H800 THEN
anybyte% = ram(posi)
ELSEIF posi = &H2002 THEN
anybyte% = ppustat: ppustat = ppustat AND 127: scrollwrite = 0
ELSEIF posi = &H2004 THEN
anybyte% = sprram(sprramposi)
ELSEIF posi = &H2007 THEN
IF (ppu1 AND 4) THEN okn = 32 ELSE okn = 1
table = vramposi AND &HFC00
IF table = &H2400 THEN
IF mirroring = 0 THEN
anybyte% = vram(vramposi XOR &H400)
ELSE
anybyte% = vram(vramposi)
END IF
ELSEIF table = &H2800 THEN
IF mirroring = 1 THEN
anybyte% = vram(vramposi XOR &H800)
ELSE
anybyte% = vram(vramposi)
END IF
ELSEIF table = &H2C00 THEN
IF mirroring = 0 THEN
anybyte% = vram(vramposi XOR &H400)
ELSE
anybyte% = vram(vramposi XOR &H800)
END IF
ELSE
anybyte% = vram(vramposi)
END IF
IF firstread = 0 THEN
vramposi = vramposi + okn
END IF
firstread = 0
ELSEIF posi = &H4016 THEN
IF (joy1emu AND joy1reads) = joy1reads THEN anybyte% = 1
joy1reads = joy1reads * 2
IF joy1reads > 256 THEN joy1reads = 256
END IF
END FUNCTION
FUNCTION breakpoint
COLOR 14
hagla 400, 1, "breakpoint:"
DO WHILE u = 0
SELECT CASE INKEY$
CASE "4"
bp1 = bp1 + 1
IF bp1 = 16 THEN bp1 = 0
GOSUB up
CASE "3"
bp2 = bp2 + 16
IF bp2 = 256 THEN bp2 = 0
GOSUB up
CASE "2"
bp3 = bp3 + 256
IF bp3 = 4096 THEN bp3 = 0
GOSUB up
CASE "1"
bp4 = bp4 + 4096
IF bp4 = 65536 THEN bp4 = 0
GOSUB up
CASE CHR$(13): u = 1
CASE CHR$(27): u = 2
END SELECT
LOOP
IF u = 1 THEN breakpoint = bp4 + bp3 + bp2 + bp1
EXIT FUNCTION
up:
LINE (450, 1)-(470, 9), 0, BF
hagla 450, 1, LCASE$(HEX$(bp4 \ 4096) + HEX$(bp3 \ 256) + HEX$(bp2 \ 16) + HEX$(bp1))
RETURN
END FUNCTION
SUB config 'Read the cfg file (rom directory) :)
OPEN "uness.cfg" FOR INPUT AS #10
INPUT #10, o$
CLOSE
IF o$ = "-" THEN
OPEN "uness.cfg" FOR INPUT AS #10
PRINT "Welcome to uNESsential v0.20"
PRINT "Please tell me where your roms are stored (example: c:\roms)."
INPUT "->", roms$
IF RIGHT$(roms$, 1) = "\" THEN GOTO ooo
roms$ = roms$ + "\"
ooo:
CLOSE
OPEN "uness.cfg" FOR OUTPUT AS #10
PRINT #10, roms$
CLOSE
EXIT SUB
END IF
END SUB
DEFINT A-B, X-Y
SUB crappygfxengine
'Background.
'IF (ppu2 AND 8) THEN
DIM imgpal(15)
DIM tile(7, 7)
DIM bk(63, 59)
DIM attr(31, 31)
DIM sprpal(15) AS INTEGER
DIM bgpal(15, 3) AS INTEGER
o = ppu1 AND 3
IF o = 0 THEN adr = &H2000
IF o = 1 THEN adr = &H2400
IF o = 2 THEN adr = &H2800
IF o = 3 THEN adr = &H2C00
'Set palette(s).
FOR c = 0 TO 15
IF (c AND 3) = 0 THEN
r = vram(&H3F00) AND 63
ELSE
r = vram(&H3F00 + c) AND 63
END IF
bgpal(c, 0) = pal(r, 0)
bgpal(c, 1) = pal(r, 1)
bgpal(c, 2) = pal(r, 2)
IF palemu = 1 THEN PALETTE c, 65536 * pal(r, 2) + 256 * pal(r, 1) + pal(r, 0)
NEXT c
LOCATE 2, 63
FOR c = 0 TO 15
r = vram(&H3F10 + c) AND 63
mindiff = 300000
best = 0
FOR bc = 0 TO 15
rdiff = bgpal(bc, 0) - pal(r, 0)
gdiff = bgpal(bc, 1) - pal(r, 1)
bdiff = bgpal(bc, 2) - pal(r, 2)
diff = rdiff * rdiff + gdiff * gdiff + bdiff * bdiff
IF diff = 0 THEN
best = bc
EXIT FOR
ELSEIF diff < mindiff THEN
best = bc
mindiff = diff
END IF
NEXT bc
sprpal(c) = best
LINE (270 + c * 4, 305)-(273 + c * 4, 308), sprpal(c), BF
'PRINT "ß";
NEXT c
IF ppu2 AND 8 THEN
'Build the 32*30 tile matrix.
addr = &H2000
FOR cy = 0 TO 29
FOR cx = 0 TO 31
bk(cx, cy) = vram(addr + cy * 32 + cx)
NEXT cx
NEXT cy
IF mirroring = 1 THEN addr = &H2400
FOR cy = 0 TO 29
FOR cx = 32 TO 63
bk(cx, cy) = vram(addr + cy * 32 + cx - 32)
NEXT cx
NEXT cy
IF mirroring = 1 THEN addr = &H2000 ELSE addr = &H2800
FOR cy = 30 TO 59
FOR cx = 0 TO 31
bk(cx, cy) = vram(addr + (cy - 30) * 32 + cx)
NEXT cx
NEXT cy
IF mirroring = 1 THEN addr = &H2400
FOR cy = 30 TO 59
FOR cx = 32 TO 63
bk(cx, cy) = vram(addr + (cy - 30) * 32 + cx - 32)
NEXT cx
NEXT cy
addr = &H23C0
FOR cy = 0 TO 7
FOR cx = 0 TO 7
c = vram(addr + cy * 8 + cx)
attr(cx * 2, cy * 2) = c AND 3
attr(cx * 2 + 1, cy * 2) = (c \ 4) AND 3
attr(cx * 2, cy * 2 + 1) = (c \ 16) AND 3
attr(cx * 2 + 1, cy * 2 + 1) = c \ 64
NEXT cx
NEXT cy
IF mirroring = 1 THEN addr = &H27C0
FOR cy = 0 TO 7
FOR cx = 8 TO 15
c = vram(addr + cy * 8 + cx - 8)
attr(cx * 2, cy * 2) = c AND 3
attr(cx * 2 + 1, cy * 2) = (c \ 4) AND 3
attr(cx * 2, cy * 2 + 1) = (c \ 16) AND 3
attr(cx * 2 + 1, cy * 2 + 1) = c \ 64
NEXT cx
NEXT cy
IF mirroring = 1 THEN addr = &H23C0 ELSE addr = &H2BC0
FOR cy = 8 TO 15
FOR cx = 0 TO 7
c = vram(addr + (cy - 8) * 8 + cx)
attr(cx * 2, cy * 2 - 1) = c AND 3
attr(cx * 2 + 1, cy * 2 - 1) = (c \ 4) AND 3
attr(cx * 2, cy * 2) = (c \ 16) AND 3
attr(cx * 2 + 1, cy * 2) = c \ 64
NEXT cx
NEXT cy
IF mirroring = 1 THEN addr = &H27C0
FOR cy = 8 TO 15
FOR cx = 8 TO 15
c = vram(addr + (cy - 8) * 8 + cx - 8)
attr(cx * 2, cy * 2 - 1) = c AND 3
attr(cx * 2 + 1, cy * 2 - 1) = (c \ 4) AND 3
attr(cx * 2, cy * 2) = (c \ 16) AND 3
attr(cx * 2 + 1, cy * 2) = c \ 64
NEXT cx
NEXT cy
y = 15
x = 15
FOR b = 0 TO 15
cxa = scrollx(b) \ 16
cxb = scrollx(b) AND 15
IF scrolly(b) <> -1 THEN
cya = scrolly(b) \ 16
cyb = scrolly(b) AND 15
cym = scrolly(b) AND 7
END IF
FOR a = 0 TO 15
c = a + cxa
d = b + cya
IF c > 31 THEN c = c - 32
IF d > 29 THEN d = d - 30
'LOCATE 10, 40: PRINT c
LINE ((cxb XOR 15) + a * 16, (cyb XOR 15) + b * 16)-((cxb XOR 15) + a * 16 + 15, (cym XOR 15) + b * 16 + 15), attr(c, d) * 4, BF
NEXT a
NEXT b
okning = 0
FOR bb0 = 0 TO 29
IF (bb0 AND 1) = 0 THEN
i = bb0 \ 2
cx = scrollx(i) \ 8
cxm = scrollx(i) AND 7
IF scrolly(i) <> -1 THEN
cy = scrolly(i) \ 8
cym = scrolly(i) AND 7
END IF
okning = (ppu1log(i) AND 16) * 8
scrollx(i) = -1
scrolly(i) = -1
END IF
bb = bb0 + cy
FOR ab = cx TO cx + 31
bbb = bb
IF bbb > 59 THEN bbb = bbb - 60
abb = ab
IF abb > 63 THEN abb = abb - 64
'LOCATE 1, 40: PRINT ASC(MID$(bytes$, c, 1))
a = okning + ((bk(abb, bbb) AND 15) * 8)
b = 300 + ((bk(abb, bbb) AND 240) / 2)
GET (a, b)-(a + 7, b + 7), tile
'PSET (a, b), 12
PUT (x - cxm, y - cym), tile, OR
x = x + 8
IF x = 271 THEN y = y + 8: x = 15
NEXT ab
NEXT bb0
END IF
'Sprites.
IF ppu2 AND 16 THEN
asize = (ppu1 AND 32)
okning = (ppu1 AND 8) * 16
IF asize = 0 THEN
FOR c = 0 TO 252 STEP 4
y = sprram(c)
IF y < &HF0 THEN
y = y + 15
x = sprram(c + 3) + 15
attr = sprram(c + 2)
IF (attr AND 128) THEN
sy = 7: sys = -1
ELSE
sy = 0: sys = 1
END IF
IF (attr AND 64) THEN
sx = 7: sxs = -1
ELSE
sx = 0: sxs = 1
END IF
rp = (attr AND 32)
rpal = (attr AND 3) * 4
a = okning + ((sprram(c + 1) AND 15) * 8)
b = 300 + ((sprram(c + 1) AND 240) \ 2)
FOR cy = sy TO (sy XOR 7) STEP sys
FOR cx = sx TO (sx XOR 7) STEP sxs
sprcol = POINT(a + cx, b + cy)
IF sprcol AND 3 THEN
IF rp = 0 THEN
PSET (x + ax, y + bx + 1), sprpal(sprcol OR rpal)
ELSEIF (POINT(x + ax, y + bx + 1) AND 3) = 0 THEN
PSET (x + ax, y + bx + 1), sprpal(sprcol OR rpal)
END IF
END IF
ax = ax + 1
NEXT cx
bx = bx + 1: ax = 0
NEXT cy
ax = 0: bx = 0
END IF
NEXT c
ELSEIF asize = 32 THEN
FOR c = 0 TO 252 STEP 4
y = sprram(c)
IF y < &HF0 THEN
y = y + 15
x = sprram(c + 3) + 15
attr = sprram(c + 2)
IF (attr AND 128) THEN
sy = 7: sys = -1
ELSE
sy = 0: sys = 1
END IF
rp = (attr AND 32)
rpal = (attr AND 3) * 4
IF (attr AND 64) = 0 THEN
a = okning + ((sprram(c + 1) AND 15) * 8)
b = 300 + ((sprram(c + 1) AND 240) \ 2)
FOR spr = 8 TO 0 STEP -8
FOR cy = sy TO (sy XOR 7) STEP sys
FOR cx = 0 TO 7
sprcol = POINT(a + cx, b + cy)
IF sprcol AND 3 THEN
IF rp = 0 THEN
PSET (x + ax, y + bx + 1), sprpal(sprcol OR rpal)
ELSEIF (POINT(x + ax, y + bx + 1) AND 3) = 0 THEN
PSET (x + ax, y + bx + 1), sprpal(sprcol OR rpal)
END IF
END IF
ax = ax + 1
NEXT cx
bx = bx + 1: ax = 0
NEXT cy
ax = 0: bx = 0
a = a - 8
IF a = 120 OR a = -8 THEN a = a + 128: b = b - 8
NEXT spr
END IF
END IF
NEXT c
END IF
END IF
END SUB
DEFSNG A-B, X-Y
SUB emulate
byte$ = " "
'ut = 1
'OPEN "debug.log" FOR BINARY AS #9
DO
byte% = anybyte(pc)
IF ut = 1 THEN utskrift
'Note! May want to place the most common ones first
SELECT CASE byte%
CASE &HA9: pc = pc + 1: op.lda (pc): s = s + 2
CASE &HA5: pc = pc + 1: op.lda (anybyte(pc)): s = s + 3
CASE &HB5: op.lda (zpx): s = s + 4
CASE &HAD: op.lda (abso): s = s + 4
CASE &HBD: op.lda (absx): s = s + 4
CASE &HB9: op.lda (absy): s = s + 4
CASE &HA1: op.lda (pre): s = s + 6
CASE &HB1: op.lda (post): s = s + 5
CASE &HD0: s = s + 2: pc = pc + 1: IF (reg.s AND 2) = 0 THEN op.branch 'op.bne
CASE &HF0: s = s + 2: pc = pc + 1: IF (reg.s AND 2) THEN op.branch 'op.beq
CASE &H10: s = s + 2: pc = pc + 1: IF (reg.s AND 128) = 0 THEN op.branch 'op.bpl
CASE &H30: s = s + 2: pc = pc + 1: IF (reg.s AND 128) THEN op.branch 'op.bmi
CASE &H90: s = s + 2: pc = pc + 1: IF (reg.s AND 1) = 0 THEN op.branch 'op.bcc
CASE &HB0: s = s + 2: pc = pc + 1: IF (reg.s AND 1) THEN op.branch 'op.bcs
CASE &H50: s = s + 2: pc = pc + 1: IF (reg.s AND 64) = 0 THEN op.branch 'op.bvc
CASE &H70: s = s + 2: pc = pc + 1: IF (reg.s AND 64) THEN op.branch 'op.bvs
CASE &HAA: op.tax
CASE &H8A: op.txa
CASE &HA8: op.tay
CASE &H98: op.tya
CASE &H9A: op.txs
CASE &HBA: op.tsx
CASE &HE6: pc = pc + 1: op.inc (anybyte(pc)): s = s + 5
CASE &HF6: op.inc (zpx): s = s + 6
CASE &HEE: op.inc (abso): s = s + 6
CASE &HFE: op.inc (absx): s = s + 7
CASE &HC6: pc = pc + 1: op.dec (anybyte(pc)): s = s + 5
CASE &HD6: op.dec (zpx): s = s + 6
CASE &HCE: op.dec (abso): s = s + 6
CASE &HDE: op.dec (absx): s = s + 7
CASE &HE8: op.inx
CASE &HC8: op.iny
CASE &H85: pc = pc + 1: op.sta (anybyte(pc)): s = s + 2
CASE &H95: op.sta (zpx): s = s + 3
CASE &H8D: op.sta (abso): s = s + 3
CASE &H9D: op.sta (absx): s = s + 4
CASE &H99: op.sta (absy): s = s + 5
CASE &H81: op.sta (pre): s = s + 6
CASE &H91: op.sta (post): s = s + 6
CASE &H86: pc = pc + 1: op.stx (anybyte(pc)): s = s + 3
CASE &H96: op.stx (zpy): s = s + 4
CASE &H8E: op.stx (abso): s = s + 4
CASE &H84: pc = pc + 1: op.sty (anybyte(pc)): s = s + 3
CASE &H94: op.sty (zpx): s = s + 4
CASE &H8C: op.sty (abso): s = s + 4
CASE &HA2: pc = pc + 1: op.ldx (pc): s = s + 2
CASE &HA6: pc = pc + 1: op.ldx (anybyte(pc)): s = s + 3
CASE &HB6: op.ldx (zpy): s = s + 4
CASE &HAE: op.ldx (abso): s = s + 4
CASE &HBE: op.ldx (absy): s = s + 4
CASE &HA0: pc = pc + 1: op.ldy (pc): s = s + 2
CASE &HA4: pc = pc + 1: op.ldy (anybyte(pc)): s = s + 3
CASE &HB4: op.ldy (zpx): s = s + 4
CASE &HAC: op.ldy (abso): s = s + 4
CASE &HBC: op.ldy (absx): s = s + 4
CASE &HCA: op.dex
CASE &H88: op.dey
CASE &H48: op.pha
CASE &H68: op.pla
CASE &H8: op.php
CASE &H28: op.plp
CASE &H4A: reg.s = reg.s AND 254: reg.s = (reg.s OR (reg.a AND 1))
reg.a = reg.a \ 2: reg.s = reg.s AND 125
IF reg.a = 0 THEN reg.s = reg.s OR 2
s = s + 2
CASE &H46: pc = pc + 1: op.lsr (anybyte(pc)): s = s + 5
CASE &H56: op.lsr (zpx): s = s + 6
CASE &H4E: op.lsr (abso): s = s + 6
CASE &H5E: op.lsr (absx): s = s + 7
CASE &HA: reg.s = reg.s AND 254: reg.a = reg.a * 2
IF (reg.a AND 256) THEN reg.a = reg.a - 256: reg.s = reg.s OR 1
reg.s = reg.s AND 125
IF reg.a = 0 THEN reg.s = reg.s OR 2
IF reg.a > 127 THEN reg.s = reg.s OR 128
s = s + 2
CASE &H6: pc = pc + 1: op.asl (anybyte(pc)): s = s + 5
CASE &H16: op.asl (zpx): s = s + 6
CASE &HE: op.asl (abso): s = s + 6
CASE &H1E: op.asl (absx): s = s + 7
CASE &H29: pc = pc + 1: op.and (pc): s = s + 2
CASE &H25: pc = pc + 1: op.and (anybyte(pc)): s = s + 3
CASE &H35: op.and (zpx): s = s + 4
CASE &H2D: op.and (abso): s = s + 4
CASE &H3D: op.and (absx): s = s + 4
CASE &H39: op.and (absy): s = s + 4
CASE &H21: op.and (pre): s = s + 6
CASE &H31: op.and (post): s = s + 5
CASE &H9: pc = pc + 1: op.ora (pc): s = s + 2
CASE &H5: pc = pc + 1: op.ora (anybyte(pc)): s = s + 3
CASE &H15: op.ora (zpx): s = s + 4
CASE &HD: op.ora (abso): s = s + 4
CASE &H1D: op.ora (absx): s = s + 4
CASE &H19: op.ora (absy): s = s + 4
CASE &H1: op.ora (pre): s = s + 6
CASE &H11: op.ora (post): s = s + 5
CASE &H49: pc = pc + 1: op.eor (pc): s = s + 2
CASE &H45: pc = pc + 1: op.eor (anybyte(pc)): s = s + 3
CASE &H55: op.eor (zpx): s = s + 4
CASE &H4D: op.eor (abso): s = s + 4
CASE &H5D: op.eor (absx): s = s + 4
CASE &H59: op.eor (absy): s = s + 4
CASE &H41: op.eor (pre): s = s + 6
CASE &H51: op.eor (post): s = s + 5
CASE &H2A
reg.a = reg.a + reg.a + (reg.s AND 1)
IF reg.a < 256 THEN
reg.s = reg.s AND 254
ELSE
reg.a = reg.a - 256: reg.s = reg.s OR 1
END IF
reg.s = reg.s AND 125
IF reg.a = 0 THEN reg.s = reg.s OR 2
IF reg.a > 127 THEN reg.s = reg.s OR 128
s = s + 2
CASE &H26: pc = pc + 1: op.rol (anybyte(pc)): s = s + 5
CASE &H36: op.rol (zpx): s = s + 6
CASE &H2E: op.rol (abso): s = s + 6
CASE &H3E: op.rol (absx): s = s + 7
CASE &H6A
reg.a = reg.a + (reg.s AND 1) * 256
reg.s = reg.s AND 254
reg.s = (reg.s OR (reg.a AND 1))
reg.a = reg.a \ 2
reg.s = reg.s AND 125
IF reg.a = 0 THEN reg.s = reg.s OR 2
IF reg.a > 127 THEN reg.s = reg.s OR 128
s = s + 2
CASE &H66: pc = pc + 1: op.ror (anybyte(pc)): s = s + 5
CASE &H76: op.ror (zpx): s = s + 6
CASE &H6E: op.ror (abso): s = s + 6
CASE &H7E: op.ror (absx): s = s + 7
CASE &H38: op.sec
CASE &HF8: op.sed
CASE &H78: op.sei
CASE &H18: op.clc
CASE &HD8: op.cld
CASE &H58: op.cli
CASE &HB8: op.clv
CASE &H4C: op.jmp (1)
CASE &H6C: op.jmp (2)
CASE &H20: op.jsr
CASE &H60: op.rts
CASE &HC9: pc = pc + 1: op.cmp (pc): s = s + 2
CASE &HC5: pc = pc + 1: op.cmp (anybyte(pc)): s = s + 3
CASE &HD5: op.cmp (zpx): s = s + 4
CASE &HCD: op.cmp (abso): s = s + 4
CASE &HDD: op.cmp (absx): s = s + 4
CASE &HD9: op.cmp (absy): s = s + 4
CASE &HC1: op.cmp (pre): s = s + 6
CASE &HD1: op.cmp (post): s = s + 5
CASE &HE0: pc = pc + 1: op.cpx (pc): s = s + 2
CASE &HE4: pc = pc + 1: op.cpx (anybyte(pc)): s = s + 3
CASE &HEC: op.cpx (abso): s = s + 4
CASE &HC0: pc = pc + 1: op.cpy (pc): s = s + 2
CASE &HC4: pc = pc + 1: op.cpy (anybyte(pc)): s = s + 3
CASE &HCC: op.cpy (abso): s = s + 4
CASE &H24: pc = pc + 1: op.bit (anybyte(pc)): s = s + 3
CASE &H2C: op.bit (abso): s = s + 4
CASE &H69: pc = pc + 1: op.adc (pc): s = s + 2
CASE &H65: pc = pc + 1: op.adc (anybyte(pc)): s = s + 3
CASE &H75: op.adc (zpx): s = s + 4
CASE &H6D: op.adc (abso): s = s + 4
CASE &H7D: op.adc (absx): s = s + 4
CASE &H79: op.adc (absy): s = s + 4
CASE &H61: op.adc (pre): s = s + 6
CASE &H71: op.adc (post): s = s + 5
CASE &HE9: pc = pc + 1: op.sbc (pc): s = s + 2
CASE &HE5: pc = pc + 1: op.sbc (anybyte(pc)): s = s + 3
CASE &HF5: op.sbc (zpx): s = s + 4
CASE &HED: op.sbc (abso): s = s + 4
CASE &HFD: op.sbc (absx): s = s + 4
CASE &HF9: op.sbc (absy): s = s + 4
CASE &HE1: op.sbc (pre): s = s + 6
CASE &HF1: op.sbc (post): s = s + 5
CASE &H0: op.brk
CASE &H40: op.rti
CASE &HEA: s = s + 2
CASE ELSE
utstep = 1
IF ut = 0 THEN
ut = 1
utskrift
END IF
END SELECT
pc = pc + 1
IF s > 113.85 THEN
s = s - 113.85
lines = lines + 1
IF (ppustat AND 64) = 0 THEN
IF (ppu2 AND 16) THEN
IF sprram(0) + 1 = lines THEN ppustat = ppustat OR 64
END IF
END IF
IF vblank = 0 THEN
IF (ppu2 AND 24) THEN
vramposi = vramposi AND &HFBE0
vramposi = vramposi OR (loopy.t AND &H41F)
scrollx((lines \ 16) + 1) = ((loopy.t AND 1024) \ 4) OR ((loopy.t AND 31) * 8) OR loopy.x
END IF
IF (lines AND 15) = 0 THEN ppu1log(lines \ 16) = ppu1
END IF
IF lines = 241 THEN vb
IF lines = 262 THEN vb: lines = 0
getinput
END IF
'DO WHILE INKEY$ = "": LOOP
'DO WHILE INKEY$ = "": LOOP
'DO WHILE INKEY$ = "": LOOP
'patterntables
'o$ = CHR$(pc \ 256)'High byte pc
'PUT #9, , o$
'o$ = CHR$(pc AND 255)'Low byte pc
'PUT #9, , o$
'o$ = CHR$(reg.a)'A-register
'PUT #9, , o$
'o$ = CHR$(reg.x)'X-register
'PUT #9, , o$
'o$ = CHR$(reg.y)'Y-register
'PUT #9, , o$
'o$ = CHR$(reg.sp)'SP-register
'PUT #9, , o$
'o$ = CHR$(reg.s)'Status-register
'PUT #9, , o$
'o$ = CHR$(byte%)'opcode
'PUT #9, , o$
IF pc = bpoint THEN ut = 1
LOOP
END SUB
FUNCTION filerequest$
' FileRequester 1.10 - New features : PageUp and PageDown can now be
' used.
' This is the NEW version.
DIM FileName$(255)
OPEN "uness.cfg" FOR INPUT AS #10
INPUT #10, path$
CLOSE #10
Listing$ = "*.nes"
Relist:
LET chc = 1
CLS
SCREEN 0, 0, 3
COLOR 0, 0
CLS
FILES path$ + Listing$
COLOR 7, 0
LET TextRow = 0
LET FileNumber = 0
FOR a = 1 TO 255
LET FileName$(a) = ""
NEXT
LET TextRow = TextRow + 1
FOR a = 1 TO 255
LET TextRow = TextRow + 1
FOR h = 0 TO 3
LET FileNumber = FileNumber + 1
FOR G = 1 TO 12
IF SCREEN(TextRow, G + (18 * h)) = 32 AND G = 1 THEN LET done = 1: LET G = 12: LET h = 3: LET a = 255
IF CHR$(SCREEN(TextRow, G + (18 * h))) <> " " THEN LET FileName$(FileNumber) = FileName$(FileNumber) + CHR$(SCREEN(TextRow, G + (18 * h)))
NEXT
NEXT
NEXT
CLS
GOSUB DrawFileRequester
DO
k$ = INKEY$
SELECT CASE k$
CASE CHR$(0) + "H": GOSUB MoveCursorUpFR
CASE CHR$(0) + "P": GOSUB MoveCursorDownFR
CASE CHR$(0) + "Q": GOSUB PageDownFR
CASE CHR$(0) + "I": GOSUB PageUpFR
CASE "": LET EscPressed = 1: LET KeyBoardCommandsUpdated = 0: GOSUB DrawFileRequester: LET FileRequesterStatus = 1: filerequester$ = "_NoFile": GOTO EndThisSub
END SELECT
IF k$ > "" THEN
IF ASC(k$) = 13 THEN LET EnterPressed = 1: LET KeyBoardCommandsUpdated = 0: LET FileRequesterStatus = 0: GOSUB DrawFileRequester: LET ChosenFile$ = path$ + FileName$(chc + page): filerequest$ = ChosenFile$: GOTO EndThisSub
END IF
LOOP
'
PageUpFR:
IF chc + page - 18 < 0 THEN RETURN
LET page = page - 18
GOSUB DrawFileRequester
RETURN
'
PageDownFR:
IF FileName$(chc + page + 18) = "" THEN RETURN
LET page = page + 18
GOSUB DrawFileRequester
RETURN
'
MoveCursorUpFR:
IF chc - 1 = 0 AND page = 0 THEN RETURN
LET chc = chc - 1
IF chc = 0 THEN LET page = page - 1: LET chc = 1
GOSUB DrawFileRequester
RETURN
'
MoveCursorDownFR:
IF chc + 1 > 18 AND FileName$(chc + 1) = "" THEN RETURN
IF FileName$(chc + 1 + page) = "" THEN RETURN
LET chc = chc + 1
IF chc = 19 THEN LET page = page + 1: LET chc = 18
GOSUB DrawFileRequester
RETURN
'
DrawFileRequester:
PCOPY 0, 3
SCREEN 0, 0, 3
COLOR 7, 0
IF ScreenCleared = 0 THEN ScreenCleared = 1: CLS
LOCATE 2, 12
COLOR 9, 1: PRINT "²±²±²±²±²±²±²±²±²±²±²±²±²±²±²±²"
LOCATE 2, 13
COLOR 15, 1: PRINT topic$: COLOR 9, 1
FOR a = 1 TO 19
LOCATE 2 + a, 12
PRINT "² ²"
NEXT
LOCATE 21, 12: PRINT "²±²±²±²±²±²±²±²±²±²±²±²±²±²±²±²"
LOCATE 22, 12: PRINT "² ²"
LOCATE 22, 14: COLOR 15, 9: PRINT Listing$: COLOR 9, 1
LOCATE 23, 12: PRINT "²±²±²±²±²±²±²±²±²±²±²±²±²±²±²±²"
FOR a = 1 TO 18
LOCATE 2 + a, 13
IF chc = a THEN COLOR 15, 15
IF chc <> a THEN COLOR 9, 15
LOCATE 2 + a, 13: PRINT "±²±²±²±²±²±²±²±²±²±²±²±²±²±²±"
LOCATE 2 + a, 14: PRINT FileName$(a + page)
NEXT
IF KeyBoardCommandsUpdated = 1 THEN GOTO BlitScreen
LET KeyBoardCommandsUpdated = 1
LOCATE 2, 46: COLOR 9, 0: PRINT "Keyboard Commands"
LOCATE 4, 46
IF EscPressed = 1 THEN COLOR 12, 0: PRINT "(A)bort (ESC)"
IF EscPressed = 0 THEN COLOR 9, 0: PRINT "(A)bort (ESC)"
LOCATE 5, 46
IF EnterPressed = 1 THEN COLOR 10, 0: PRINT "(L)oad file (Enter)"
IF EnterPressed = 0 THEN COLOR 9, 0: PRINT "(L)oad file (Enter)"
LOCATE 6, 46
COLOR 9, 0: PRINT "(C)hange filetype to list (TAB)"
BlitScreen:
SCREEN 0, 0, 0
PCOPY 3, 0
RETURN
'
EnterNewFileSpec:
LOCATE 22, 12: COLOR 9, 1: PRINT "² ²": COLOR 15, 9
LOCATE 22, 14: INPUT "", Listing$
LET KeyBoardCommandsUpdated = 0
KILL ProgPath$ + "fr.ini"
OPEN ProgPath$ + "fr.ini" FOR OUTPUT AS #6
PRINT #6, Listing$
CLOSE #6
ScreenCleared = 0: GOTO Relist
'
EndThisSub:
END FUNCTION
DEFINT A
SUB getinput
in$ = INKEY$
IF in$ <> "" THEN
SELECT CASE in$
CASE "o", "i": ut = ut XOR 1
CASE "p": palemu = palemu XOR 1: PALETTE
CASE "b": bpoint = breakpoint
CASE "+": skip = skip + 1
CASE "-": IF skip > 1 THEN skip = skip - 1
CASE "z": joy1emu = joy1emu XOR 1: PSET (21, 284), POINT(21, 284) XOR 9
CASE "x": joy1emu = joy1emu XOR 2: PSET (19, 284), POINT(19, 284) XOR 9
CASE "c": joy1emu = joy1emu XOR 4: PSET (14, 284), POINT(14, 284) XOR 9
CASE "v": joy1emu = joy1emu XOR 8: PSET (16, 284), POINT(16, 284) XOR 9
CASE "s": utstep = 1: ut = 1
CASE "r": utstep = 0
CASE CHR$(0) + "H": joy1emu = joy1emu XOR 16: PSET (10, 282), POINT(10, 282) XOR 9
CASE CHR$(0) + "P": joy1emu = joy1emu XOR 32: PSET (10, 284), POINT(10, 284) XOR 9
CASE CHR$(0) + "K": joy1emu = joy1emu XOR 64: PSET (9, 283), POINT(9, 283) XOR 9
CASE CHR$(0) + "M": joy1emu = joy1emu XOR 128: PSET (11, 283), POINT(11, 283) XOR 9
CASE "q": END
END SELECT
END IF
END SUB
DEFSNG A
SUB hagla (x, y, text$)
FOR o = 1 TO LEN(text$)
IF ASC(MID$(text$, o, 1)) > 96 AND ASC(MID$(text$, o, 1)) < 123 THEN
hus = ASC(MID$(text$, o, 1)) - 97
GOTO rita
END IF
IF ASC(MID$(text$, o, 1)) > 48 AND ASC(MID$(text$, o, 1)) < 58 THEN
hus = ASC(MID$(text$, o, 1)) - 20