Mercurial > hg > index.cgi

annotate exbas11.s @ 0:605ff82c4618

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial check in with cleaned up sources This is the initial check in the source code in a state where it builds byte accurate copies of all the various ROM versions included.
author William Astle <lost@l-w.ca>
date Sat, 08 Dec 2018 19:57:01 -0700
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1 *pragma nolist
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2 include defs.s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3 ; These are the entry points in the Color Basic ROM which are used the the Extended Basic ROM.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4 ; They are included here in order to keep the Extended Basic ROM separate from the Color Basic
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
5 ; ROM.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
6 BAWMST EQU 0xA0E8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
7 CLOAD EQU 0xA498
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
8 CSAVE EQU 0xA44C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
9 DATA EQU 0xAEE0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
10 EVALEXPB EQU 0xB70B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
11 GIVABF EQU 0xB4F4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
12 INT EQU 0xBCEE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
13 LA0E2 EQU 0xA0E2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
14 LA171 EQU 0xA171
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
15 LA176 EQU 0xA176
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
16 LA35F EQU 0xA35F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
17 LA3ED EQU 0xA3ED
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
18 LA406 EQU 0xA406
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
19 LA429 EQU 0xA429
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
20 LA42D EQU 0xA42D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
21 LA444 EQU 0xA444
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
22 LA491 EQU 0xA491
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
23 LA505 EQU 0xA505
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
24 LA578 EQU 0xA578
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
25 LA59A EQU 0xA59A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
26 LA5A5 EQU 0xA5A5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
27 LA5AE EQU 0xA5AE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
28 LA5C7 EQU 0xA5C7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
29 LA5E4 EQU 0xA5E4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
30 LA616 EQU 0xA616
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
31 LA619 EQU 0xA619
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
32 LA635 EQU 0xA635
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
33 LA644 EQU 0xA644
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
34 LA648 EQU 0xA648
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
35 LA65F EQU 0xA65F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
36 LA7E9 EQU 0xA7E9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
37 LA974 EQU 0xA974
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
38 LA976 EQU 0xA976
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
39 LA9A2 EQU 0xA9A2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
40 LA9BB EQU 0xA9BB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
41 LAC1E EQU 0xAC1E
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
42 LAC33 EQU 0xAC33
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
43 LAC46 EQU 0xAC46
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
44 LAC60 EQU 0xAC60
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
45 LAC73 EQU 0xAC73
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
46 LAC7C EQU 0xAC7C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
47 LAC9D EQU 0xAC9D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
48 LACA8 EQU 0xACA8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
49 LACEF EQU 0xACEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
50 LACF1 EQU 0xACF1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
51 LAD01 EQU 0xAD01
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
52 LAD19 EQU 0xAD19
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
53 LAD21 EQU 0xAD21
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
54 LAD26 EQU 0xAD26
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
55 LAD33 EQU 0xAD33
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
56 LAD9E EQU 0xAD9E
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
57 LADC6 EQU 0xADC6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
58 LADD4 EQU 0xADD4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
59 LADEB EQU 0xADEB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
60 LAE15 EQU 0xAE15
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
61 LAED2 EQU 0xAED2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
62 LAF67 EQU 0xAF67
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
63 LAFA4 EQU 0xAFA4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
64 LB035 EQU 0xB035
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
65 LB141 EQU 0xB141
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
66 LB143 EQU 0xB143
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
67 LB146 EQU 0xB146
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
68 LB156 EQU 0xB156
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
69 LB158 EQU 0xB158
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
70 LB244 EQU 0xB244
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
71 LB262 EQU 0xB262
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
72 LB267 EQU 0xB267
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
73 LB26A EQU 0xB26A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
74 LB26F EQU 0xB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
75 LB277 EQU 0xB277
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
76 LB284 EQU 0xB284
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
77 LB2CE EQU 0xB2CE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
78 LB357 EQU 0xB357
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
79 LB35C EQU 0xB35C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
80 LB3A2 EQU 0xB3A2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
81 LB44A EQU 0xB44A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
82 LB4F3 EQU 0xB4F3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
83 LB50F EQU 0xB50F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
84 LB518 EQU 0xB518
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
85 LB51A EQU 0xB51A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
86 LB56D EQU 0xB56D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
87 LB643 EQU 0xB643
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
88 LB654 EQU 0xB654
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
89 LB657 EQU 0xB657
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
90 LB659 EQU 0xB659
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
91 LB69B EQU 0xB69B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
92 LB6A4 EQU 0xB6A4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
93 LB6AD EQU 0xB6AD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
94 LB70E EQU 0xB70E
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
95 LB734 EQU 0xB734
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
96 LB738 EQU 0xB738
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
97 LB73D EQU 0xB73D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
98 LB740 EQU 0xB740
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
99 LB7C2 EQU 0xB7C2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
100 LB958 EQU 0xB958
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
101 LB95C EQU 0xB95C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
102 LB99F EQU 0xB99F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
103 LB9AC EQU 0xB9AC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
104 LB9AF EQU 0xB9AF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
105 LB9B4 EQU 0xB9B4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
106 LB9B9 EQU 0xB9B9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
107 LB9C2 EQU 0xB9C2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
108 LBA1C EQU 0xBA1C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
109 LBA3A EQU 0xBA3A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
110 LBA92 EQU 0xBA92
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
111 LBAC5 EQU 0xBAC5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
112 LBACA EQU 0xBACA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
113 LBB48 EQU 0xBB48
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
114 LBB5C EQU 0xBB5C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
115 LBB6A EQU 0xBB6A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
116 LBB82 EQU 0xBB82
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
117 LBB8F EQU 0xBB8F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
118 LBC14 EQU 0xBC14
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
119 LBC2F EQU 0xBC2F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
120 LBC35 EQU 0xBC35
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
121 LBC4C EQU 0xBC4C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
122 LBC5F EQU 0xBC5F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
123 LBC6D EQU 0xBC6D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
124 LBCA0 EQU 0xBCA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
125 LBCC8 EQU 0xBCC8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
126 LBD99 EQU 0xBD99
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
127 LBDB6 EQU 0xBDB6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
128 LBDBB EQU 0xBDBB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
129 LBDC0 EQU 0xBDC0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
130 LBDC5 EQU 0xBDC5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
131 LBDCC EQU 0xBDCC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
132 LBDD9 EQU 0xBDD9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
133 LBEC0 EQU 0xBEC0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
134 LBEC5 EQU 0xBEC5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
135 LBEE9 EQU 0xBEE9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
136 LBEF0 EQU 0xBEF0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
137 LBEFF EQU 0xBEFF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
138 LBFA6 EQU 0xBFA6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
139 LET EQU 0xAF89
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
140 PUTCHR EQU 0xA282
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
141 SIN EQU 0xBF78
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
142 SNDBLK EQU 0xA7F4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
143 STRINOUT EQU 0xB99C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
144 SYNCOMMA EQU 0xB26D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
145 WRLDR EQU 0xA7D8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
146 *pragma list
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
148 ; EXTENDED COLOR BASIC ROM
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
149 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
150 org EXBAS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
151 fcc 'EX' ; magic number that Color Basic uses to identify the presence of Extended Basic
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
152 L8002 ldx #L80DE ; point to command interpretation table information
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
153 ldu #COMVEC+10 ; point to command interpretation table location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
154 ldb #10 ; 10 bytes to move
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
155 jsr LA59A ; copy command interpretation table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
156 ldx #LB277 ; initialize Disk Basic's entries to error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
157 stx 3,u
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
158 stx 8,u
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
159 ldx #XIRQSV ; set up IRQ service routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
160 stx IRQVEC+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
161 ldx ZERO ; reset the TIMER value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
162 stx TIMVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
163 jsr XVEC18 ; do a bunch of initialization
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
164 ldd #0x2c05 ; initialize DLOAD baud rate constant and timeout
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
165 std DLBAUD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
166 ldx #USR0 ; set up pointer to USR routine addresses
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
167 stx USRADR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
168 ldu #LB44A ; set up USR routine addresses to "FC error"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
169 ldb #10 ; there are 10 routines
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
170 L8031 stu ,x++ ; set a routine to FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
171 decb ; done all?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
172 bne L8031 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
173 lda #0x7e ; op code of JMP extended (for RAM hook intialization)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
174 sta RVEC20 ; command interpretation loop
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
175 ldx #XVEC20
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
176 stx RVEC20+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
177 sta RVEC15 ; expression evaluation
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
178 ldx #XVEC15
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
179 stx RVEC15+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
180 sta RVEC19 ; number parsing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
181 ldx #XVEC19
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
182 stx RVEC19+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
183 sta RVEC9 ; PRINT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
184 ldx #XVEC9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
185 stx RVEC9+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
186 sta RVEC17 ; error handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
187 ldx #XVEC17
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
188 stx RVEC17+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
189 sta RVEC4 ; generic input
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
190 ldx #XVEC4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
191 stx RVEC4+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
192 sta RVEC3 ; generic output
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
193 ldx #XVEC3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
194 stx RVEC3+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
195 sta RVEC8 ; close file
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
196 ldx #XVEC8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
197 stx RVEC8+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
198 sta RVEC23 ; tokenize line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
199 ldx #XVEC23
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
200 stx RVEC23+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
201 sta RVEC18 ; RUN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
202 ldx #XVEC18
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
203 stx RVEC18+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
204 sta EXPJMP ; exponentiation
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
205 ldx #L8489
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
206 stx EXPJMP+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
207 jsr L96E6 ; initialize graphics stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
208 lda PIA0+3 ; enable 60Hz interrupt
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
209 ora #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
210 sta PIA0+3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
211 ldx #'D*256+'K ; magic number for a Disk Basic ROM
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
212 cmpx DOSBAS ; do we have a Disk Basic ROM?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
213 lbeq DOSBAS+2 ; brif so - launch it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
214 andcc #0xaf ; enable interrupts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
215 ldx #L80E8-1 ; show sign on message
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
216 jsr STRINOUT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
217 ldx #XBWMST ; install warm start handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
218 stx RSTVEC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
219 jmp LA0E2 ; set up warm start flag and launch immediate mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
220 ; Extended Basic warm start code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
221 XBWMST nop ; flag to mark routine as valid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
222 clr PLYTMR ; cancel any PLAY command in progress
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
223 clr PLYTMR+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
224 lda PIA0+3 ; enable 60Hz interrupt
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
225 ora #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
226 sta PIA0+3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
227 jmp BAWMST ; let Color Basic's warm start process run
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
228 ; This code is to fix the famous PCLEAR bug. It replaces dead code in the 1.0 ROM. This patch corrects
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
229 ; the input pointer so that it points to the correct place after the program has been relocated by
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
230 ; PCLEAR instead of continuing with something that, in the best case, is a syntax error.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
231 L80D0 lda CURLIN ; immediate mode?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
232 inca
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
233 beq L80DD ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
234 tfr y,d ; save offset to D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
235 subd TXTTAB ; see how far into the program we are
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
236 addd CHARAD ; now adjust the input pointer based on that
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
237 std CHARAD ; save corrected input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
238 L80DD rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
239 L80DE fcb 25 ; 25 Extended Basic commands
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
240 fdb L8183 ; reserved word table (commands)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
241 fdb L813C ; interpretation handler (commands)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
242 fcb 14 ; 14 Extended Basic functions
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
243 fdb L821E ; reserved word table (functions)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
244 fdb L8168 ; function handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
245 L80E8 fcc 'EXTENDED COLOR BASIC 1.1'
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
246 fcb 0x0d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
247 fcc 'COPYRIGHT (C) 1982 BY TANDY'
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
248 fcb 0x0d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
249 fcc 'UNDER LICENSE FROM MICROSOFT'
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
250 fcb 0x0d,0x0d,0x00
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
251 ; Extended Basic command interpretation loop
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
252 L813C cmpa #0xcb ; is it an Extended Basic command?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
253 bhi L8148 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
254 ldx #L81F0 ; point to dispatch table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
255 suba #0xb5 ; normalize the token number so 0 is the first entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
256 jmp LADD4 ; go transfer control to the command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
257 L8148 cmpa #0xff ; is it a function token?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
258 beq L8154 ; brif so - for MID$()=, TIMER=
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
259 cmpa #0xcd ; is it a token for a keyword that isn't a command?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
260 bls L8165 ; brif so - error for USING and FN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
261 jmp [COMVEC+23] ; transfer control to Disk Basic if it is present
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
262 L8154 jsr GETNCH ; get token after the function flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
263 cmpa #0x90 ; MID$?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
264 lbeq L86D6 ; brif so (substring replacement)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
265 cmpa #0x9f ; TIMER?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
266 lbeq L8960 ; brif so - TIMER setting
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
267 jsr RVEC22 ; do a RAM hook in case something wants to extend this
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
268 L8165 jmp LB277 ; we have nothing valid here
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
269 ; Function handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
270 L8168 cmpb #2*33 ; is it a valid Extended Basic function?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
271 bls L8170 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
272 jmp [COMVEC+28] ; transfer control to Disk Basic if it is present
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
273 L8170 subb #2*20 ; normalize Extended Basic functions to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
274 cmpb #2*8 ; Above HEX$?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
275 bhi L817D ; brif so - we don't pre-evaluate an argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
276 pshs b ; save token value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
277 jsr LB262 ; evaluate the function parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
278 puls b ; get back token value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
279 L817D ldx #L8257 ; point to dispatch table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
280 jmp LB2CE ; go transfer control to the function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
281 ; Reserved words (commands)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
282 L8183 fcs 'DEL' ; 0xb5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
283 fcs 'EDIT' ; 0xb6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
284 fcs 'TRON' ; 0xb7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
285 fcs 'TROFF' ; 0xb8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
286 fcs 'DEF' ; 0xb9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
287 fcs 'LET' ; 0xba
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
288 fcs 'LINE' ; 0xbb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
289 fcs 'PCLS' ; 0xbc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
290 fcs 'PSET' ; 0xbd
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
291 fcs 'PRESET' ; 0xbe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
292 fcs 'SCREEN' ; 0xbf
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
293 fcs 'PCLEAR' ; 0xc0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
294 fcs 'COLOR' ; 0xc1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
295 fcs 'CIRCLE' ; 0xc2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
296 fcs 'PAINT' ; 0xc3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
297 fcs 'GET' ; 0xc4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
298 fcs 'PUT' ; 0xc5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
299 fcs 'DRAW' ; 0xc6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
300 fcs 'PCOPY' ; 0xc7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
301 fcs 'PMODE' ; 0xc8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
302 fcs 'PLAY' ; 0xc9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
303 fcs 'DLOAD' ; 0xca
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
304 fcs 'RENUM' ; 0xcb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
305 fcs 'FN' ; 0xcc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
306 fcs 'USING' ; 0xcd
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
307 ; Dispatch table (commands)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
308 L81F0 fdb DEL ; 0xb5 DEL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
309 fdb EDIT ; 0xb6 EDIT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
310 fdb TRON ; 0xb7 TRON
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
311 fdb TROFF ; 0xb8 TROFF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
312 fdb DEF ; 0xb9 DEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
313 fdb LET ; 0xba LET (note: implemented by Color Basic!)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
314 fdb LINE ; 0xbb LINE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
315 fdb PCLS ; 0xbc PCLS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
316 fdb PSET ; 0xbd PSET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
317 fdb PRESET ; 0xbe PRESET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
318 fdb SCREEN ; 0xbf SCREEN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
319 fdb PCLEAR ; 0xc0 PCLEAR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
320 fdb COLOR ; 0xc1 COLOR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
321 fdb CIRCLE ; 0xc2 CIRCLE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
322 fdb PAINT ; 0xc3 PAINT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
323 fdb GET ; 0xc4 GET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
324 fdb PUT ; 0xc5 PUT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
325 fdb DRAW ; 0xc6 DRAW
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
326 fdb PCOPY ; 0xc7 PCOPY
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
327 fdb PMODETOK ; 0xc8 PMODE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
328 fdb PLAY ; 0xc9 PLAY
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
329 fdb DLOAD ; 0xca DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
330 fdb RENUM ; 0xcb RENUM
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
331 ; Reserved words (functions)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
332 L821E fcs 'ATN' ; 0x94
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
333 fcs 'COS' ; 0x95
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
334 fcs 'TAN' ; 0x96
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
335 fcs 'EXP' ; 0x97
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
336 fcs 'FIX' ; 0x98
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
337 fcs 'LOG' ; 0x99
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
338 fcs 'POS' ; 0x9a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
339 fcs 'SQR' ; 0x9b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
340 fcs 'HEX$' ; 0x9c
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
341 fcs 'VARPTR' ; 0x9d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
342 fcs 'INSTR' ; 0x9e
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
343 fcs 'TIMER' ; 0x9f
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
344 fcs 'PPOINT' ; 0xa0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
345 fcs 'STRING$' ; 0xa1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
346 ; Dispatch table (functions)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
347 L8257 fdb ATN ; 0x94 ATN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
348 fdb COS ; 0x95 COS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
349 fdb TAN ; 0x96 TAN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
350 fdb EXP ; 0x97 EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
351 fdb FIX ; 0x98 FIX
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
352 fdb LOG ; 0x99 LOG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
353 fdb POS ; 0x9a POS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
354 fdb SQR ; 0x9b SQR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
355 fdb HEXDOL ; 0x9c HEX$
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
356 fdb VARPTRTOK ; 0x9d VARPTR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
357 fdb INSTR ; 0x9e INSTR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
358 fdb TIMER ; 0x9f TIMER
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
359 fdb PPOINT ; 0xa0 PPOINT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
360 fdb STRING ; 0xa1 STRING$
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
361 ; Generic output handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
362 XVEC3 tst DEVNUM ; screen?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
363 lbeq L95AC ; brif so - force text screen active
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
364 pshs b ; save register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
365 ldb DEVNUM ; get output device
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
366 cmpb #-3 ; check for DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
367 puls b ; restore register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
368 bne L8285 ; brif not DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
369 leas 2,s ; bail out of output handler if DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
370 L8285 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
371 ; Close file handler. This corrects a bug in Color Basic 1.0 which didn't handle writing the
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
372 ; end of file block correctly. That bug is fixed in Color Basic 1.1 so this isn't required
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
373 ; if a recent enough version of Color Basic is installed.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
374 XVEC8 lda DEVNUM ; get device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
375 inca ; is it tape?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
376 bne L8285 ; brif not - we aren't going to mess with it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
377 lda FILSTA ; get tape file status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
378 cmpa #2 ; output file?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
379 bne L8285 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
380 lda CINCTR ; is there anything waiting to be written out?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
381 bne L8285 ; brif so - mainline code will handle it properly
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
382 clr DEVNUM ; reset output to screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
383 leas 2,s ; don't return to mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
384 jmp LA444 ; write EOF block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
385 ; RUN handler - sets up some Extended Basic stuff to defaults at program start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
386 XVEC18 ldd #0xba42 ; initialize PLAY volume
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
387 std VOLHI
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
388 lda #2 ; set PLAY tempo to 2, PLAY octave to 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
389 sta TEMPO
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
390 sta OCTAVE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
391 asla ; set default note length to 5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
392 sta NOTELN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
393 clr DOTVAL ; don't do any note length extension
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
394 ldd ZERO ; initialize DRAW angle and scale to default 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
395 std ANGLE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
396 ldb #128 ; initialize horizontal and vertical default coordinates to the middle of the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
397 std HORDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
398 ldb #96
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
399 std VERDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
400 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
401 ; Command interpretation loop handler; we need to intercept this to implement TRON/TROFF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
402 XVEC20 leas 2,s ; don't return to the mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
403 L82BB andcc #0xaf ; make sure interrupts are running
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
404 jsr LADEB ; do a BREAK/pause check
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
405 ldx CHARAD ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
406 stx TINPTR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
407 lda ,x+ ; get current input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
408 beq L82CF ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
409 cmpa #': ; statement separator?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
410 beq L82F1 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
411 jmp LB277 ; raise error we got here with extra junk
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
412 L82CF lda ,x++ ; get first byte of next line address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
413 sta ENDFLG ; use it to set "END" flag to "END"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
414 bne L82D8 ; brif not end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
415 jmp LAE15 ; go do the "END"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
416 L82D8 ldd ,x+ ; get line number of next line (and leave pointer one before line text)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
417 std CURLIN ; set current line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
418 stx CHARAD ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
419 lda TRCFLG ; are we tracing?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
420 beq L82F1 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
421 lda #'[ ; show opening marker for TRON line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
422 jsr PUTCHR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
423 lda CURLIN ; restore MSB of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
424 jsr LBDCC ; show line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
425 lda #'] ; show closing marker for TRON line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
426 jsr PUTCHR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
427 L82F1 jsr GETNCH ; get the start of the statement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
428 tfr cc,b ; save status flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
429 cmpa #0x98 ; is it CSAVE?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
430 beq L8316 ; brif so - go to Extended Basic patch (adds CSAVEM)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
431 cmpa #0x97 ; is it CLOAD?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
432 beq L8311 ; brif so - go to Extended Basic patch (adds multi-origin binaries)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
433 tfr b,cc ; restore character status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
434 jsr LADC6 ; go process command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
435 bra L82BB ; restart interpretation loop
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
436 ; Tokenizaton handler. This is actually a hack to intercept CLOAD and CSAVE during immediate mode by causing the
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
437 ; tokenization routine to return to the interpretation loop above instead of the mainline interpretation loop. This
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
438 ; is necessary because the first command encountered on a line in immediate mode is executed BEFORE the interpretation
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
439 ; loop RAM hook is called. This patch doesn't actually affect tokenization itself at all.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
440 XVEC23 ldx 2,s ; get return address of caller to the tokenizer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
441 cmpx #LAC9D ; is it coming from immediate mode prior to executing the line?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
442 bne L8310 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
443 ldx #L82F1 ; force return to Extended Basic's main loop patch above
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
444 stx 2,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
445 L8310 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
446 ; These two patches are set up this way so that control can be transferred back to the original Color Basic
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
447 ; implementations if the Extended Basic addons are not triggered.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
448 L8311 jsr L8C62 ; transfer control to Extended Basic's CLOAD handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
449 bra L82BB ; go do another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
450 L8316 bsr L831A ; go do Extended Basic's CSAVE handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
451 bra L82BB ; go do another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
452 ; Extended Basic's CSAVE handler which implements CSAVEM (which Color Basic does not have)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
453 L831A jsr GETNCH ; get character after CSAVE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
454 cmpa #'M ; is it CSAVEM?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
455 lbne CSAVE ; brif not - Color Basic can handle this
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
456 jsr GETNCH ; eat the "M"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
457 jsr LA578 ; parse file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
458 bsr L836C ; get start address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
459 stx CASBUF+13 ; save it in file header
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
460 bsr L836C ; get end address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
461 cmpx 2,s ; compare to start address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
462 lblo LB44A ; brif end address is before the start address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
463 bsr L836C ; get execution address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
464 stx CASBUF+11 ; put in file header
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
465 jsr GETCCH ; are we at the end of the commmand?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
466 bne L8310 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
467 lda #2 ; file type to machine language
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
468 ldx ZERO ; set to binary and single block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
469 jsr LA65F ; write header
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
470 clr FILSTA ; mark any open tape file closed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
471 inc BLKTYP ; set block type to data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
472 jsr WRLDR ; write a data leader
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
473 ldx 4,s ; get starting address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
474 L834D stx CBUFAD ; set start of data address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
475 lda #255 ; try a full length block by default
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
476 sta BLKLEN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
477 ldd 2,s ; get ending address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
478 subd CBUFAD ; see how much is left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
479 bhs L835E ; brif we have more to write
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
480 leas 6,s ; clean up stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
481 jmp LA491 ; write EOF block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
482 L835E cmpd #255 ; do we have a full block left?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
483 bhs L8367 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
484 incb ; set block size to remainder
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
485 stb BLKLEN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
486 L8367 jsr SNDBLK ; write a data block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
487 bra L834D ; go see if we have more to write
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
488 L836C jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
489 jsr LB73D ; evaluate unsigned expression to X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
490 ldu ,s ; get return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
491 stx ,s ; save result on stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
492 tfr u,pc ; return to caller
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
493 ; COS function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
494 COS ldx #L83AB ; point to PI/2 constant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
495 jsr LB9C2 ; add to argument ( cos(x) = sin((pi/2)+x) )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
496 L837E jmp SIN ; now calculate sin((pi/2)+x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
497 ; TAN function. This is determined by the identity TAN(X) = SIN(X)/COS(X)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
498 TAN jsr LBC2F ; save FPA0 in FPA3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
499 clr RELFLG ; reset quadrant flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
500 bsr L837E ; calculate SIN(x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
501 ldx #V4A ; save result in FPA5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
502 jsr LBC35
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
503 ldx #V40 ; get back original argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
504 jsr LBC14
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
505 clr FP0SGN ; force result positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
506 lda RELFLG ; get quadrant flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
507 bsr L83A6 ; calculate COS(x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
508 tst FP0EXP ; did we get 0 for COS(x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
509 lbeq LBA92 ; brif so - overflow
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
510 ldx #V4A ; point to sin(x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
511 L83A3 jmp LBB8F ; divide the sin(x) value by the cos(x) value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
512 L83A6 pshs a ; save sign flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
513 jmp LBFA6 ; expand polynomial
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
514 L83AB fcb 0x81,0x49,0x0f,0xda,0xa2 ; pi/2 constant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
515 ; ATN function (inverse tangent). There are two calculation streams used to improve precision.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
516 ; One if the parameter is >= 1.0 and the other if it is < 1.0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
517 ATN lda FP0SGN ; get sign of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
518 pshs a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
519 bpl L83B8 ; brif positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
520 bsr L83DC ; flip sign of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
521 L83B8 lda FP0EXP ; get exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
522 pshs a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
523 cmpa #0x81 ; exponent for 1.0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
524 blo L83C5 ; brif less - value is less than 1.0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
525 ldx #LBAC5 ; point to FP constant 1.0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
526 bsr L83A3 ; calculate reciprocal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
527 L83C5 ldx #L83E0 ; point to polynomical coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
528 jsr LBEF0 ; expand polynomial
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
529 puls a ; get exponent of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
530 cmpa #0x81 ; did we do a reciprocal calculation?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
531 blo L83D7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
532 ldx #L83AB ; subtract result from pi/2 if we did
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
533 jsr LB9B9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
534 L83D7 puls a ; get sign of original
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
535 tsta ; was it positive?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
536 bpl L83DF ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
537 L83DC jmp LBEE9 ; flip sign of result
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
538 L83DF rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
539 ; Chebyshev modified taylor series coefficients for inverse tangent. Note that these diverge quite significantly
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
540 ; from the standard taylor series after 1/9. The standard coefficients are 1/1,-1/3, 1/5, -1/7, 1/9, -1/11, and
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
541 ; so on. These modified coefficients yield reasonable accuracy for the precision available, presumably with
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
542 ; fewer coefficients.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
543 L83E0 fcb 11 ; 12 coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
544 fcb 0x76,0xb3,0x83,0xbd,0xd3 ; -0.000684793912
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
545 fcb 0x79,0x1e,0xf4,0xa6,0xf5 ; 0.00485094216
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
546 fcb 0x7b,0x83,0xfc,0xb0,0x10 ; -0.0161117018
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
547 fcb 0x7c,0x0c,0x1f,0x67,0xca ; 0.0342096381
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
548 fcb 0x7c,0xde,0x53,0xcb,0xc1 ; -0.0542791328
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
549 fcb 0x7d,0x14,0x64,0x70,0x4c ; 0.0724571965
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
550 fcb 0x7d,0xb7,0xea,0x51,0x7a ; -0.0898023954
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
551 fcb 0x7d,0x63,0x30,0x88,0x7e ; 0.110932413
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
552 fcb 0x7e,0x92,0x44,0x99,0x3a ; -0.142839808
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
553 fcb 0x7e,0x4c,0xcc,0x91,0xc7 ; 0.199999121
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
554 fcb 0x7f,0xaa,0xaa,0xaa,0x13 ; -0.333333316
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
555 fcb 0x81,0x00,0x00,0x00,0x00 ; 1.0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
556 ; Chebyshev modified taylor series coefficients for the ln(x)/ln(2) (base 2 log of x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
557 L841D fcb 3 ; four coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
558 fcb 0x7f,0x5e,0x56,0xcb,0x79 ; 0.434255942 from (2/7)/ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
559 fcb 0x80,0x13,0x9b,0x0b,0x64 ; 0.576584541 from (2/5)/ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
560 fcb 0x80,0x76,0x38,0x93,0x16 ; 0.961800759 from (2/3)/ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
561 fcb 0x82,0x38,0xaa,0x3b,0x20 ; 2.88539007 from 2/ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
562 L8432 fcb 0x80,0x35,0x04,0xf3,0x34 ; 1/sqrt(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
563 L8437 fcb 0x81,0x35,0x04,0xf3,0x34 ; sqrt(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
564 L843C fcb 0x80,0x80,0x00,0x00,0x00 ; -0.5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
565 L8441 fcb 0x80,0x31,0x72,0x17,0xf8 ; ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
566 ; LOG function (natural log, ln)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
567 ; FP representation is of the form A*2^B. Thus, the log routine determines the value of
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
568 ; ln(A*2^B).
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
569 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
570 ; ln(A*2^B) = ln(A) + ln(2^B) = ln(A) + B*ln(2) = (ln(A)/ln(2) + B)*ln(2), OR:
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
571 ; (log2(A) + B)*ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
572 ; Now if we write A as A*(sqrt(2)/sqrt(2)), we haven't changed anything so:
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
573 ; (log2(A*sqrt(2)/sqrt(2)) + B)*ln(2) = (log2(A*sqrt(2)) - log2(sqrt(2)) + B) * ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
574 ; which gives: (-1/2 + log2(A*sqrt(2)) + B) * ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
575 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
576 ; Everything except log2(A*sqrt(2)) is either constant or trivial.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
577 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
578 ; What the actual code below feeds into the modified taylor series is actually:
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
579 ; 1 - (sqrt(2)/(A + sqrt(2)) which algebra reveals to be (A*sqrt(2)-1)/(A*sqrt(2)+1)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
580 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
581 ; Thus, the code is using (A*sqrt(2)-1)/(A*sqrt(2)+1) instead of A*sqrt(2) as one would
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
582 ; expect from the identities. However, the modified coefficients in the series above
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
583 ; could be correcting for that or the introduced error was deemed acceptable.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
584 ; NOTE: this routine does NOT return 0 for LOG(1)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
585 LOG jsr LBC6D ; get status of FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
586 lble LB44A ; brif <= 0 - logarithms don't exist in that case
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
587 ldx #L8432 ; point to 1/sqrt(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
588 lda FP0EXP ; get exponent of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
589 suba #0x80 ; remove bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
590 pshs a ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
591 lda #0x80 ; force exponent to 0 (this turns FPA0 into A in the above description)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
592 sta FP0EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
593 jsr LB9C2 ; add 1/sqrt(2) to A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
594 ldx #L8437 ; point to sqrt(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
595 jsr LBB8F ; divide that by FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
596 ldx #LBAC5 ; point to 1.0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
597 jsr LB9B9 ; subtract result from 1.0: Now FPA0 is 1-(sqrt(2)/(A+1/sqrt(2)))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
598 ldx #L841D ; point to coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
599 jsr LBEF0 ; expand polynomial (calculate base 2 log of modified argument)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
600 ldx #L843C ; point to -0.5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
601 jsr LB9C2 ; add result
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
602 puls b ; get original exponent back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
603 jsr LBD99 ; add B to FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
604 ldx #L8441 ; point to ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
605 jmp LBACA ; multiply by ln(2) which gives us the result in base e
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
606 ; SQR function (square root) - returns the principle root (positive)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
607 SQR jsr LBC5F ; move argument to FPA1 (first argument for exponentiation)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
608 ldx #LBEC0 ; point to 0.5 (exponent for square root)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
609 jsr LBC14 ; set up second argument to exponentiation (the exponent)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
610 ; Exponentiation operator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
611 ; This is calculated as A^x = e^(x*ln(A)) where A is in FPA1 and x is in FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
612 L8489 beq EXP ; do "EXP" if exponent is 0 (this will catch 0^0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
613 tsta ; check that the base is not 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
614 bne L8491 ; brif base is not 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
615 jmp LBA3A ; 0^(nonzero) is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
616 L8491 ldx #V4A ; save exponent (to FPA5)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
617 jsr LBC35
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
618 clrb ; result sign will default to positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
619 lda FP1SGN ; check if base is positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
620 bpl L84AC ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
621 jsr INT ; convert exponent to integer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
622 ldx #V4A ; point to original expoent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
623 lda FP1SGN ; get sign of FPA1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
624 jsr LBCA0 ; compare original exponent with truncated one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
625 bne L84AC ; brif not equal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
626 coma ; flip sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
627 ldb CHARAC ; get LS byte of integer exponent (result sign flag)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
628 L84AC jsr LBC4C ; copy FPA1 (base) to FPA0 (A = sign)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
629 pshs b ; save result sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
630 jsr LOG ; get natural log of the base
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
631 ldx #V4A ; multiply the log by the exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
632 jsr LBACA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
633 bsr EXP ; now raise e to the resulting power
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
634 puls a ; get result sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
635 rora ; brif it was negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
636 lbcs LBEE9 ; brif negative - flip sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
637 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
638 L84C4 fcb 0x81,0x38,0xaa,0x3b,0x29 ; 1.44269504 (correction factor for exponential function)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
639 ; Chebyshev modified taylor series coefficients for e^x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
640 L84C9 fcb 7 ; eight coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
641 fcb 0x71,0x34,0x58,0x3e,0x56 ; 1/(7!*(CF^7))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
642 fcb 0x74,0x16,0x7e,0xb3,0x1b ; 1/(6!*(CF^6))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
643 fcb 0x77,0x2f,0xee,0xe3,0x85 ; 1/(5!*(CF^5))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
644 fcb 0x7a,0x1d,0x84,0x1c,0x2a ; 1/(4!*(CF^4))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
645 fcb 0x7c,0x63,0x59,0x58,0x0a ; 1/(3!*(CF^3))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
646 fcb 0x7e,0x75,0xfd,0xe7,0xc6 ; 1/(2!*(CF^2))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
647 fcb 0x80,0x31,0x72,0x18,0x10 ; 1/(1!*(CF^1))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
648 fcb 0x81,0x00,0x00,0x00,0x00 ; 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
649 ; EXP function (e^x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
650 EXP ldx #L84C4 ; point to correction factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
651 jsr LBACA ; multiply it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
652 jsr LBC2F ; save corrected argument to FPA3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
653 lda FP0EXP ; get exponent of FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
654 cmpa #0x88 ; is it too big?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
655 blo L8504 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
656 L8501 jmp LBB5C ; to 0 (underflow) or overflow error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
657 L8504 jsr INT ; convert argument to an integer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
658 lda CHARAC ; get ls byte of integer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
659 adda #0x81 ; was argument 127? if so, the OV error; adds bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
660 beq L8501
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
661 deca ; adjust for the extra +1 above
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
662 pshs a ; save integer exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
663 ldx #V40 ; get fractional part of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
664 jsr LB9B9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
665 ldx #L84C9 ; point to coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
666 jsr LBEFF ; evaluate polynomial on the fractional part
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
667 clr RESSGN ; force result to be positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
668 puls a ; get back original exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
669 jsr LBB48 ; add original exponent to the fractional result
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
670 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
671 ; FIX function (truncate/round toward 0) (NOTE: INT() always rounds down so INT(-0.5) gives -1 but FIX(-0.5) gives 0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
672 FIX jsr LBC6D ; get status of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
673 bmi L852C ; brif negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
674 L8529 jmp INT ; do regular "int" if positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
675 L852C com FP0SGN ; flip the sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
676 bsr L8529 ; do "INT" on this
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
677 jmp LBEE9 ; flip the sign back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
678 ; EDIT command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
679 EDIT jsr L89AE ; get line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
680 leas 2,s ; we're not going to return to the main loop
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
681 L8538 lda #1 ; "LIST" flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
682 sta VD8 ; set to list the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
683 jsr LAD01 ; find line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
684 lbcs LAED2 ; brif line wasn't found
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
685 jsr LB7C2 ; go unpack the line into the buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
686 tfr y,d ; calculate the actual length of the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
687 subd #LINBUF+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
688 stb VD7 ; save line length (it will only be 8 bits)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
689 L854D ldd BINVAL ; get the line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
690 jsr LBDCC ; display it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
691 jsr LB9AC ; put a space after it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
692 ldx #LINBUF+1 ; point to iput uffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
693 ldb VD8 ; are we listing?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
694 bne L8581 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
695 L855C clrb ; reset digit accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
696 L855D jsr L8687 ; get a keypress
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
697 jsr L90AA ; set carry if not numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
698 bcs L8570 ; brif not a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
699 suba #'0 ; remove ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
700 pshs a ; save digit value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
701 lda #10 ; multiply accumulator by 10
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
702 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
703 addb ,s+ ; add in new digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
704 bra L855D ; go check for another digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
705 L8570 subb #1 ; this converts 0 to 1, but *only* 0 to 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
706 adcb #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
707 cmpa #'A ; abort?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
708 bne L857D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
709 jsr LB958 ; to a CR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
710 bra L8538 ; restart EDIT process
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
711 L857D cmpa #'L ; list?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
712 bne L858C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
713 L8581 bsr L85B4 ; list the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
714 clr VD8 ; reset to "not listing"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
715 jsr LB958 ; do a CR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
716 bra L854D ; start editing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
717 L858A leas 2,s ; lose return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
718 L858C cmpa #0x0d ; ENTER?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
719 bne L859D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
720 bsr L85B4 ; echo out the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
721 L8592 jsr LB958 ; do a CR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
722 ldx #LINBUF+1 ; reset input pointer to start of buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
723 stx CHARAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
724 jmp LACA8 ; join immediate mode to replace the line in the program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
725 L859D cmpa #'E ; exit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
726 beq L8592 ; brif so - end edit with no echo
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
727 cmpa #'Q ; quit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
728 bne L85AB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
729 jsr LB958 ; do a CR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
730 jmp LAC73 ; go to immediate mode with no fanfare - no changes saved
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
731 L85AB bsr L85AF ; go do commands
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
732 bra L855C ; go handle another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
733 L85AF cmpa #0x20 ; space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
734 bne L85C3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
735 skip2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
736 L85B4 ldb #LBUFMX-1 ; display up to a whole line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
737 L85B6 lda ,x ; get buffer chracter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
738 beq L85C2 ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
739 jsr PUTCHR ; output character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
740 leax 1,x ; move to next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
741 decb ; done?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
742 bne L85B6 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
743 L85C2 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
744 L85C3 cmpa #'D ; delete?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
745 bne L860F ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
746 L85C7 tst ,x ; end of line?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
747 beq L85C2 ; brif so - can't delete
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
748 bsr L85D1 ; remove a character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
749 decb ; done all requested?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
750 bne L85C7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
751 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
752 L85D1 dec VD7 ; account for character being removed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
753 leay -1,x ; set pointer and compensate for increment below
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
754 L85D5 leay 1,y ; move to next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
755 lda 1,y ; get next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
756 sta ,y ; move it forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
757 bne L85D5 ; brif we didn't hit the end of the buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
758 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
759 L85DE cmpa #'I ; insert?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
760 beq L85F5 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
761 cmpa #'X ; extend?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
762 beq L85F3 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
763 cmpa #'H ; "hack"?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
764 bne L8646 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
765 clr ,x ; mark current location as end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
766 tfr x,d ; calculate new line length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
767 subd #LINBUF+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
768 stb VD7 ; save new length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
769 L85F3 bsr L85B4 ; display the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
770 L85F5 jsr L8687 ; read a character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
771 cmpa #0x0d ; ENTER?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
772 beq L858A ; brif so - terminate entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
773 cmpa #0x1b ; ESC?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
774 beq L8625 ; brif so - back to command mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
775 cmpa #0x08 ; backspace?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
776 bne L8626 ; brif no
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
777 cmpx #LINBUF+1 ; are we at the start of the buffer?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
778 beq L85F5 ; brif so - it's a no-op
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
779 bsr L8650 ; move pointer back one, do a BS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
780 bsr L85D1 ; remove character from the buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
781 bra L85F5 ; go handle more input
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
782 L860F cmpa #'C ; change?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
783 bne L85DE ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
784 L8613 tst ,x ; is there something to change?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
785 beq L8625 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
786 jsr L8687 ; get a key stroke
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
787 bcs L861E ; brif valid key
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
788 bra L8613 ; try again if invalid key
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
789 L861E sta ,x+ ; put new character in the buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
790 bsr L8659 ; echo it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
791 decb ; changed number requested?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
792 bne L8613 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
793 L8625 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
794 L8626 ldb VD7 ; get length of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
795 cmpb #LBUFMX-1 ; at maximum line length?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
796 bne L862E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
797 bra L85F5 ; process another input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
798 L862E pshs x ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
799 L8630 tst ,x+ ; are we at the end of the line?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
800 bne L8630 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
801 L8634 ldb ,-x ; get character before current pointer, move back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
802 stb 1,x ; move it forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
803 cmpx ,s ; at the original buffer pointer?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
804 bne L8634 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
805 leas 2,s ; remove saved buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
806 sta ,x+ ; save input character in newly made hole
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
807 bsr L8659 ; echo it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
808 inc VD7 ; bump line length counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
809 bra L85F5 ; go handle more stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
810 L8646 cmpa #0x08 ; backspace?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
811 bne L865C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
812 L864A bsr L8650 ; move pointer back, echo BS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
813 decb ; done enough of them?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
814 bne L864A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
815 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
816 L8650 cmpx #LINBUF+1 ; at start of buffer?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
817 beq L8625 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
818 leax -1,x ; move pointer back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
819 lda #0x08 ; character to echo - BS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
820 L8659 jmp PUTCHR ; echo character to screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
821 L865C cmpa #'K ; "kill"?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
822 beq L8665 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
823 suba #'S ; search?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
824 beq L8665 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
825 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
826 L8665 pshs a ; save kill/search flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
827 bsr L8687 ; read target
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
828 pshs a ; save search character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
829 L866B lda ,x ; get current character in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
830 beq L8685 ; brif end of line - nothing more to search
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
831 tst 1,s ; is it KILL?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
832 bne L8679 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
833 bsr L8659 ; echo the character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
834 leax 1,x ; move ahead
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
835 bra L867C ; check next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
836 L8679 jsr L85D1 ; remove character from buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
837 L867C lda ,x ; get character in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
838 cmpa ,s ; are we at the target?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
839 bne L866B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
840 decb ; have we found enough of them?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
841 bne L866B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
842 L8685 puls y,pc ; clean up stack and return to main EDIT routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
843 L8687 jsr LA171 ; get input from the generic input handler (will show the cursor)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
844 cmpa #0x7f ; graphics (or DEL)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
845 bhs L8687 ; brif so - ignore it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
846 cmpa #0x5f ; SHIFT-UP?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
847 bne L8694 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
848 lda #0x1b ; replace with ESC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
849 L8694 cmpa #0x0d ; carriage return?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
850 beq L86A6 ; brif so (C=0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
851 cmpa #0x1b ; ESC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
852 beq L86A6 ; brif so (C=0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
853 cmpa #0x08 ; backspace?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
854 beq L86A6 ; brif so (C=0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
855 cmpa #32 ; control code?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
856 blo L8687 ; brif control code - try again
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
857 orcc #1 ; set C for "valid" (printable) character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
858 L86A6 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
859 ; TRON and TROFF commands
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
860 TRON skip1lda ; load flag with nonzero for trace enabled (and skip next)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
861 TROFF clra ; clear flag for trace disabled
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
862 sta TRCFLG ; save trace status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
863 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
864 ; POS function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
865 POS lda DEVNUM ; get original device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
866 pshs a ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
867 jsr LA5AE ; fetch device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
868 jsr LA406 ; check for open file
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
869 jsr LA35F ; set up print parameters
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
870 ldb DEVPOS ; get current line position for the device
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
871 jmp LA5E4 ; return position in B as unsigned
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
872 ; VARPTR function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
873 VARPTRTOK jsr LB26A ; make sure we have (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
874 ldd ARYEND ; get address of end of arrays
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
875 pshs d ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
876 jsr LB357 ; parse variable descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
877 jsr LB267 ; make sure there is a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
878 puls d ; get original end of arrays
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
879 exg x,d ; swap original end of arrays and the discovered variable pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
880 cmpx ARYEND ; did array end move (variable created?)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
881 bne L8724 ; brif so (FC error)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
882 jmp GIVABF ; return the pointer (NOTE: as signed)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
883 ; MID$() assignment; note that this cannot make the string longer or shorter and if the replacement is shorter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
884 ; than the specified size, only the number of characters actually in the replacement will be used.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
885 L86D6 jsr GETNCH ; eat the MID$ token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
886 jsr LB26A ; force (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
887 jsr LB357 ; evaluate the variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
888 pshs x ; save variable descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
889 ldd 2,x ; point to start of original string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
890 cmpd FRETOP ; is it in string space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
891 bls L86EB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
892 subd MEMSIZ ; is it still in string space (top end)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
893 bls L86FD ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
894 L86EB ldb ,x ; get length of original string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
895 jsr LB56D ; allocate space in string space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
896 pshs x ; save pointer to string space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
897 ldx 2,s ; get to original string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
898 jsr LB643 ; move the string into string space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
899 puls x,u ; get new string address and string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
900 stx 2,u ; save new data address for the string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
901 pshs u ; save descriptor address again
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
902 L86FD jsr LB738 ; evaluate ",start"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
903 pshs b ; save start offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
904 tstb ; is start 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
905 beq L8724 ; brif so - strings offsets are 1-based
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
906 ldb #255 ; default use the entire string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
907 cmpa #') ; end of parameters?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
908 beq L870E ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
909 jsr LB738 ; evaluate ",length"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
910 L870E pshs b ; save length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
911 jsr LB267 ; make sure we have a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
912 ldb #0xb3 ; make sure we have =
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
913 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
914 bsr L8748 ; evaluate replacement string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
915 tfr x,u ; save replacement string address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
916 ldx 2,s ; get original string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
917 lda ,x ; get length of original string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
918 suba 1,s ; subtract start position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
919 bhs L8727 ; brif within the string - insert replacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
920 L8724 jmp LB44A ; raise illegal function call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
921 L8727 inca ; A is now number of characters to the right of the position parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
922 cmpa ,s ; compare to length desired
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
923 bhs L872E ; brif new length fits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
924 sta ,s ; only use as much of the length as will fit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
925 L872E lda 1,s ; get position offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
926 exg a,b ; swap replacement length and position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
927 ldx 2,x ; point to original string address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
928 decb ; we work with 0-based offsets
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
929 abx ; now X points to start of replacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
930 tsta ; replacing 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
931 beq L8746 ; brif so - done
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
932 cmpa ,s ; is replacement shorter than the hole?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
933 bls L873F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
934 lda ,s ; use copy the maximum number specified
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
935 L873F tfr a,b ; save number to move in B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
936 exg u,x ; swap pointers so they are right for the routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
937 jsr LA59A ; copy string data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
938 L8746 puls a,b,x,pc ; clean up stack and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
939 L8748 jsr LB156 ; evaluate expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
940 jmp LB654 ; make sure it's a string and return string details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
941 ; STRING$ function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
942 STRING jsr LB26A ; make sure we have (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
943 jsr EVALEXPB ; evaluate repeat count (error if > 255)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
944 pshs b ; save repeat count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
945 jsr SYNCOMMA ; make sure there's a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
946 jsr LB156 ; evaluate the thing to repeat
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
947 jsr LB267 ; make sure we have a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
948 lda VALTYP ; is it string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
949 bne L8768 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
950 jsr LB70E ; get 8 bit character code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
951 bra L876B ; use that
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
952 L8768 jsr LB6A4 ; get first character of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
953 L876B pshs b ; save repeat character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
954 ldb 1,s ; get repeat count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
955 jsr LB50F ; reserve space for the string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
956 puls a,b ; get character and repeat count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
957 beq L877B ; brif NULL string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
958 L8776 sta ,x+ ; put character into string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
959 decb ; put enough?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
960 bne L8776 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
961 L877B jmp LB69B ; return the newly created string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
962 ; INSTR function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
963 INSTR jsr LB26A ; evaluate (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
964 jsr LB156 ; evaluate first argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
965 ldb #1 ; default start position is 1 (start of string)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
966 pshs b ; save start position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
967 lda VALTYP ; get type of first argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
968 bne L879C ; brif string - use default starting position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
969 jsr LB70E ; convert first argument into string offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
970 stb ,s ; save offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
971 beq L8724 ; brif starting at 0 - not allowed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
972 jsr SYNCOMMA ; make sure there's a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
973 jsr LB156 ; evaluate the search string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
974 jsr LB146 ; make sure it *is* a string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
975 L879C ldx FPA0+2 ; get search string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
976 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
977 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
978 jsr L8748 ; evalute the target string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
979 pshs x,b ; save address and length of target string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
980 jsr LB267 ; make sure we have a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
981 ldx 3,s ; get search string address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
982 jsr LB659 ; get string details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
983 pshs b ; save search string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
984 cmpb 6,s ; compare length of search string to the start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
985 blo L87D9 ; brif start position is beyond the search string - return 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
986 lda 1,s ; get length of target string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
987 beq L87D6 ; brif targetstring is NULL - match will be immediate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
988 ldb 6,s ; get start position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
989 decb ; zero-base it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
990 abx ; now X points to the start position for the search
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
991 L87BE leay ,x ; point to start of search
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
992 ldu 2,s ; get target string pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
993 ldb 1,s ; get targetlength
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
994 lda ,s ; get length of serach
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
995 suba 6,s ; see how much is left in searh
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
996 inca ; add one for "inclusivity"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
997 cmpa 1,s ; do we have less than the target string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
998 blo L87D9 ; brif so - we obviously won't match
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
999 L87CD lda ,x+ ; compare a byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1000 cmpa ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1001 bne L87DF ; brif no match
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1002 decb ; compared all of target?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1003 bne L87CD ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1004 L87D6 ldb 6,s ; get position where we matched
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1005 skip1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1006 L87D9 clrb ; flag no match
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1007 leas 7,s ; clean up stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1008 jmp LB4F3 ; return unsigned B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1009 L87DF inc 6,s ; bump start position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1010 leax 1,y ; move starting pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1011 bra L87BE ; see if we match now
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1012 ; Number parsing handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1013 XVEC19 cmpa #'& ; do we have & (hex or octal)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1014 bne L8845 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1015 leas 2,s ; we won't return to the original invoker
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1016 L87EB clr FPA0+2 ; clear bottom of FPA0 for 16 bit value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1017 clr FPA0+3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1018 ldx #FPA0+2 ; point to accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1019 jsr GETNCH ; eat the &
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1020 cmpa #'O ; octal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1021 beq L880A ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1022 cmpa #'H ; hex?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1023 beq L881F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1024 jsr GETCCH ; reset flags on input
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1025 bra L880C ; go process octal (default)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1026 L8800 cmpa #'8 ; is it a valid octal character?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1027 lbhi LB277 ; brif not (BUG: should be LBHS or above be #'7)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1028 ldb #3 ; base 8 multiplier
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1029 bsr L8834 ; add digit to accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1030 L880A jsr GETNCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1031 L880C bcs L8800 ; brif numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1032 L880E clr FPA0 ; clear upper bytes of FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1033 clr FPA0+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1034 clr VALTYP ; result is numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1035 clr FPSBYT ; clear out any extra precision
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1036 clr FP0SGN ; make it positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1037 ldb #0xa0 ; exponent for integer aligned to right of FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1038 stb FP0EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1039 jmp LBA1C ; go normalize the result and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1040 L881F jsr GETNCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1041 bcs L882E ; brif digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1042 jsr LB3A2 ; set carry if not alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1043 L8826 bcs L880E ; brif not alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1044 cmpa #'G ; is it valid HEX digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1045 bhs L880E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1046 suba #7 ; normalize A-F to be just above 0-9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1047 L882E ldb #4 ; four bits per digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1048 bsr L8834 ; add digit to accumlator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1049 bra L881F ; process another digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1050 L8834 asl 1,x ; shift accumulator one bit left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1051 rol ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1052 lbcs LBA92 ; brif too big - overflow
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1053 decb ; done enough bit shifts?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1054 bne L8834 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1055 L883F suba #'0 ; remove ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1056 adda 1,x ; merge digit into accumlator (this cannot cause carry)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1057 sta 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1058 L8845 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1059 ; Expression evaluation handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1060 XVEC15 puls u ; get back return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1061 clr VALTYP ; set result to numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1062 ldx CHARAD ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1063 jsr GETNCH ; get the input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1064 cmpa #'& ; HEX or OCTAL?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1065 beq L87EB ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1066 cmpa #0xcc ; FN?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1067 beq L88B4 ; brif so - do "FNx()"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1068 cmpa #0xff ; function token?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1069 bne L8862 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1070 jsr GETNCH ; get function token value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1071 cmpa #0x83 ; USR?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1072 lbeq L892C ; brif so - short circuit Color Basic's USR handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1073 L8862 stx CHARAD ; restore input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1074 jmp ,u ; return to mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1075 L8866 ldx CURLIN ; are we in immediate mode?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1076 leax 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1077 bne L8845 ; brif not - we're good
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1078 ldb #2*11 ; code for illegal direct statement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1079 L886E jmp LAC46 ; raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1080 ; DEF command (DEF FN, DEF USR)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1081 DEF ldx [CHARAD] ; get two input characters
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1082 cmpx #0xff83 ; USR?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1083 lbeq L890F ; brif so - do DEF USR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1084 bsr L88A1 ; get descriptor address for FN variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1085 bsr L8866 ; disallow DEF FN in immediate mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1086 jsr LB26A ; make sure we have (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1087 ldb #0x80 ; disallow arrays as arguments
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1088 stb ARYDIS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1089 jsr LB357 ; evaluate variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1090 bsr L88B1 ; make sure it's numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1091 jsr LB267 ; make sure we have )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1092 ldb #0xb3 ; make sure we have =
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1093 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1094 ldx V4B ; get variable descriptor address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1095 ldd CHARAD ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1096 std ,x ; save address of the actual function code in variable descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1097 ldd VARPTR ; get descriptor address of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1098 std 2,x ; save argument descriptor address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1099 jmp DATA ; move to the end of this statement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1100 L88A1 ldb #0xcc ; make sure we have FN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1101 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1102 ldb #0x80 ; disable array lookup
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1103 stb ARYDIS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1104 ora #0x80 ; set bit 7 of first character (to indicate FN variable)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1105 jsr LB35C ; find the variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1106 stx V4B ; save descriptor pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1107 L88B1 jmp LB143 ; make sure we have a numeric variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1108 ; Evaluate an FN call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1109 L88B4 bsr L88A1 ; parse the FNx bit and get the descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1110 pshs x ; save descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1111 jsr LB262 ; evaluate parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1112 bsr L88B1 ; make sure it's a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1113 puls u ; get FN descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1114 ldb #2*25 ; code for undefined function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1115 ldx 2,u ; point to argument variable descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1116 beq L886E ; brif nothing doing there (if it was just created, this will be NULL)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1117 ldy CHARAD ; save current input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1118 ldu ,u ; point to start of FN definition
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1119 stu CHARAD ; put input pointer there
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1120 lda 4,x ; save original value of argument and save it with current input, and variable pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1121 pshs a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1122 ldd ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1123 ldu 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1124 pshs u,y,x,d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1125 jsr LBC35 ; set argument variable to the argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1126 L88D9 jsr LB141 ; go evaluate the FN expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1127 puls d,x,y,u ; get back variable pointers, input pointer, and original variable value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1128 std ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1129 stu 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1130 puls a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1131 sta 4,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1132 jsr GETCCH ; test end of FN formula
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1133 lbne LB277 ; brif not end of statement - problem with the function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1134 sty CHARAD ; restore input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1135 L88EF rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1136 ; Error handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1137 XVEC17 cmpb #2*25 ; is it a valid Extended Basic error code?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1138 blo L88EF ; brif not - return to mainline
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1139 jsr LA7E9 ; turn off tape
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1140 jsr LA974 ; turn off sound
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1141 jsr LAD33 ; clean up stack and other bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1142 clr DEVNUM ; reset output to screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1143 jsr LB95C ; do a newline if needed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1144 jsr LB9AF ; do a ?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1145 ldx #L890B-25*2 ; point to error message table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1146 jmp LAC60 ; go display error message
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1147 ; Extended Basic error codes. Yes, NE is defined here even though it is only actually documented in the
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1148 ; Disk Basic documentation. It is here for the use of DLOAD.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1149 L890B fcc 'UF' ; 25 undefined function call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1150 fcc 'NE' ; 26 File not found
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1151 ; DEF USR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1152 L890F jsr GETNCH ; eat the USR token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1153 bsr L891C ; get pointer to USR call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1154 pshs x ; save FN exec address location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1155 bsr L8944 ; calculate execution address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1156 puls u ; get FN address pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1157 stx ,u ; save new address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1158 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1159 L891C clrb ; default routine number is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1160 jsr GETNCH ; fetch the call number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1161 bcc L8927 ; brif not a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1162 suba #'0 ; remove ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1163 tfr a,b ; save it in the right place
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1164 jsr GETNCH ; eat the call number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1165 L8927 ldx USRADR ; get start address of USR jump table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1166 aslb ; two bytes per address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1167 abx ; now X points to the right entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1168 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1169 ; Evaluate a USR call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1170 L892C bsr L891C ; find the correct routine address location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1171 ldx ,x ; get routine address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1172 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1173 jsr LB262 ; evaluate argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1174 ldx #FP0EXP ; point to FPA0 (argument value)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1175 lda VALTYP ; is it string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1176 beq L8943 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1177 jsr LB657 ; fetch string details (removes it from the string stack)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1178 ldx FPA0+2 ; get string descriptor pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1179 lda VALTYP ; set flags for the value type
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1180 L8943 rts ; call the routine and return to mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1181 L8944 ldb #0xb3 ; check for "="
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1182 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1183 jmp LB73D ; evaluate integer expression to X and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1184 ; Extended Basic IRQ handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1185 XIRQSV lda PIA0+3 ; is it VSYNC interrupt?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1186 bmi L8952 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1187 rti ; really should clear the HSYNC interrupt here
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1188 L8952 lda PIA0+2 ; clear VSYNC interrupt
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1189 ldx TIMVAL ; increment the TIMER value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1190 leax 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1191 stx TIMVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1192 jmp L9C3E ; check for other stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1193 ; TIMER=
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1194 L8960 jsr GETNCH ; eat the TIMER token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1195 bsr L8944 ; evaluate =nnnn to X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1196 stx TIMVAL ; set the timer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1197 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1198 ; TIMER function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1199 TIMER ldx TIMVAL ; get timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1200 stx FPA0+2 ; set it in FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1201 jmp L880E ; return as positive 16 bit value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1202 ; DEL command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1203 DEL lbeq LB44A ; raise error if no argument (probably to avoid accidentally deleting line 0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1204 jsr LAF67 ; parse line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1205 jsr LAD01 ; find line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1206 stx VD3 ; save address of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1207 jsr GETCCH ; is there something more?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1208 beq L8990 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1209 cmpa #0xac ; dash?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1210 bne L89BF ; brif not - error out
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1211 jsr GETNCH ; each the -
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1212 beq L898C ; brif no ending line - use default line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1213 bsr L89AE ; parse second line number and save in BINVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1214 bra L8990 ; do the deletion
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1215 L898C lda #0xff ; set to maximum line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1216 sta BINVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1217 L8990 ldu VD3 ; point end to start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1218 skip2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1219 L8993 ldu ,u ; point to start of next line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1220 ldd ,u ; check for end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1221 beq L899F ; brif end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1222 ldd 2,u ; get line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1223 subd BINVAL ; is it in range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1224 bls L8993 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1225 L899F ldx VD3 ; get starting line address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1226 bsr L89B8 ; close up gap
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1227 jsr LAD21 ; reset input pointer and erase variables
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1228 ldx VD3 ; get start of program after the deletion
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1229 jsr LACF1 ; recompute netl ine pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1230 jmp LAC73 ; return to immediate mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1231 L89AE jsr LAF67 ; parse a line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1232 jmp LA5C7 ; make sure there's nothing more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1233 L89B4 lda ,u+ ; copy a byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1234 sta ,x+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1235 L89B8 cmpu VARTAB ; end of program?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1236 bne L89B4 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1237 stx VARTAB ; save new start of variables/end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1238 L89BF rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1239 ; LINE INPUT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1240 L89C0 jsr L8866 ; raise error if in immediate mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1241 jsr GETNCH ; eat the "INPUT" token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1242 cmpa #'# ; device number?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1243 bne L89D2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1244 jsr LA5A5 ; parse device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1245 jsr LA3ED ; make sure it's valid for input
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1246 jsr SYNCOMMA ; make sure there's a comma after the device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1247 L89D2 cmpa #'" ; is there a prompt?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1248 bne L89E1 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1249 jsr LB244 ; parse the string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1250 ldb #'; ; make sure there's a semicolon after the prompt
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1251 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1252 jsr LB99F ; go actually display the prompt
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1253 L89E1 leas -2,s ; make a hole on the stack (so number of return adddresses is right)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1254 jsr LB035 ; read an input line from current device
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1255 leas 2,s ; clean up stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1256 clr DEVNUM ; reset to screen/keyboard
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1257 jsr LB357 ; parse a variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1258 stx VARDES ; save pointer to it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1259 jsr LB146 ; make sure it's a string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1260 ldx #LINBUF ; point to input buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1261 clra ; make sure we terminate on NUL only
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1262 jsr LB51A ; parse string and store it in string space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1263 jmp LAFA4 ; go assign the string to its final resting place
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1264 ; RENUM command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1265 L89FC jsr LAF67 ; read a line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1266 ldx BINVAL ; get value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1267 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1268 L8A02 ldx VD1 ; get current old number being renumbered
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1269 L8A04 stx BINVAL ; save number being searched for
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1270 jmp LAD01 ; go find line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1271 RENUM jsr LAD26 ; erase variables
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1272 ldd #10 ; default line number interval and start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1273 std VD5 ; set starting line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1274 std VCF ; set number interval
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1275 clrb ; now D is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1276 std VD1 ; save default start for renumbering
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1277 jsr GETCCH ; are there any arguments
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1278 bcc L8A20 ; brif not numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1279 bsr L89FC ; fetch line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1280 stx VD5 ; save line beginning number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1281 jsr GETCCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1282 L8A20 beq L8A3D ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1283 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1284 bcc L8A2D ; brif next isn't numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1285 bsr L89FC ; fetch starting line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1286 stx VD1 ; save the number where we start working
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1287 jsr GETCCH ; fetch input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1288 L8A2D beq L8A3D ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1289 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1290 bcc L8A3A ; brif we don't have a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1291 bsr L89FC ; parse the number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1292 stx VCF ; save interval
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1293 beq L8A83 ; brif we ave a zero interval
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1294 L8A3A jsr LA5C7 ; raise error if more stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1295 L8A3D bsr L8A02 ; get address of old number to process
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1296 stx VD3 ; save address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1297 ldx VD5 ; get the next renumbered line to use
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1298 bsr L8A04 ; find that line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1299 cmpx VD3 ; is it before the previous one?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1300 blo L8A83 ; brif so - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1301 bsr L8A67 ; make sure renumbered line numbers will be in range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1302 jsr L8ADD ; convert line numbers to "expanded" binary
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1303 jsr LACEF ; recalculate next line pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1304 bsr L8A02 ; get address of first line to renumber
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1305 stx VD3 ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1306 bsr L8A91 ; make sure line numbers exist
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1307 bsr L8A68 ; renumber the actual lines
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1308 bsr L8A91 ; update line numbers in program text
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1309 jsr L8B7B ; convert packed binary line numbers to text
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1310 jsr LAD26 ; erase variables, reset stack, etc.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1311 jsr LACEF ; recalculate next line pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1312 jmp LAC73 ; bounce back to immediate mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1313 L8A67 skip1lda ; set line number flag to nonzero (skip next instruction)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1314 L8A68 clra ; set line number flag to zero (insert new numbers)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1315 sta VD8 ; save line number flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1316 ldx VD3 ; get address of line being renumbered
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1317 ldd VD5 ; get the current renumbering number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1318 bsr L8A86 ; return if end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1319 L8A71 tst VD8 ; test line number flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1320 bne L8A77 ; brif not adding new numbers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1321 std 2,x ; set new number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1322 L8A77 ldx ,x ; point to next line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1323 bsr L8A86 ; return if end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1324 addd VCF ; add interval to current number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1325 bcs L8A83 ; brif we overflowed - bad line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1326 cmpa #MAXLIN ; maximum legal number?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1327 blo L8A71 ; brif so - do another
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1328 L8A83 jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1329 L8A86 pshs d ; save D (we're going to clobber it)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1330 ldd ,x ; get next line pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1331 puls d ; unclobber D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1332 bne L8A90 ; brif not end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1333 leas 2,s ; return to caller's caller
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1334 L8A90 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1335 L8A91 ldx TXTTAB ; get start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1336 leax -1,x ; move pointer back one (compensate for leax 1,x below)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1337 L8A95 leax 1,x ; move to next line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1338 bsr L8A86 ; return if end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1339 L8A99 leax 3,x ; move past next line address and line number, go one before line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1340 L8A9B leax 1,x ; move to next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1341 lda ,x ; check input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1342 beq L8A95 ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1343 stx TEMPTR ; save current pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1344 deca ; is it start of packed numeric line number?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1345 beq L8AB2 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1346 deca ; does line exist?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1347 beq L8AD3 ; brif line number exists
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1348 deca ; not part of something to process?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1349 bne L8A9B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1350 L8AAC lda #3 ; set 1st byte to 3 to indicate line number not existing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1351 sta ,x+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1352 bra L8A99 ; go process another
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1353 L8AB2 ldd 1,x ; get MSB of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1354 dec 2,x ; is MS byte zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1355 beq L8AB9 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1356 clra ; set MS byte to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1357 L8AB9 ldb 3,x ; get LSB of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1358 dec 4,x ; is it zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1359 beq L8AC0 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1360 clrb ; clear byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1361 L8AC0 std 1,x ; save binary number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1362 std BINVAL ; save trial number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1363 jsr LAD01 ; find the line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1364 L8AC7 ldx TEMPTR ; get start of packed line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1365 bcs L8AAC ; brif line number not found
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1366 ldd V47 ; get address of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1367 inc ,x+ ; bump first byte to 2 (exists if checking) or 1 if inserting
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1368 std ,x ; save address of correct number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1369 bra L8A99 ; go process more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1370 L8AD3 clr ,x ; clear carry and first byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1371 ldx 1,x ; point to address of correct line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1372 ldx 2,x ; get correct line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1373 stx V47 ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1374 bra L8AC7 ; insert into line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1375 L8ADD ldx TXTTAB ; get beginning of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1376 bra L8AE5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1377 L8AE1 ldx CHARAD ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1378 leax 1,x ; move it forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1379 L8AE5 bsr L8A86 ; return if end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1380 leax 2,x ; move past line address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1381 L8AE9 leax 1,x ; move forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1382 L8AEB stx CHARAD ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1383 L8AED jsr GETNCH ; get an input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1384 L8AEF tsta ; is it actual 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1385 beq L8AE1 ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1386 bpl L8AED ; brif not a token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1387 ldx CHARAD ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1388 cmpa #0xff ; function?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1389 beq L8AE9 ; brif so - ignore it (and following byte)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1390 jsr RVEC22 ; do the RAM hook thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1391 cmpa #0xa7 ; THEN?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1392 beq L8B13 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1393 cmpa #0x84 ; ELSE?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1394 beq L8B13 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1395 cmpa #0x81 ; GO(TO|SUB)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1396 bne L8AED ; brif not - we don't have a line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1397 jsr GETNCH ; get TO/SUB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1398 cmpa #0xa5 ; GOTO?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1399 beq L8B13 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1400 cmpa #0xa6 ; GOSUB?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1401 bne L8AEB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1402 L8B13 jsr GETNCH ; fetch character after token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1403 bcs L8B1B ; brif numeric (line number)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1404 L8B17 jsr GETCCH ; set flags on input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1405 bra L8AEF ; keep checking for line numbers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1406 L8B1B ldx CHARAD ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1407 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1408 jsr LAF67 ; parse line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1409 ldx CHARAD ; get input pointer after line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1410 L8B24 lda ,-x ; get character before pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1411 jsr L90AA ; set C if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1412 bcs L8B24 ; brif not numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1413 leax 1,x ; move pointer up
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1414 tfr x,d ; calculate size of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1415 subb 1,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1416 subb #5 ; make sure at least 5 bytes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1417 beq L8B55 ; brif exactly 5 bytes - no change
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1418 blo L8B41 ; brif less than 5 bytes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1419 leau ,x ; move remainder of program backward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1420 negb ; negate extra number of bytes (to subtract from X)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1421 leax b,x ; now X is the correct position to move program to
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1422 jsr L89B8 ; shift program backward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1423 bra L8B55
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1424 L8B41 stx V47 ; save end of line number space (end of copy)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1425 ldx VARTAB ; get end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1426 stx V43 ; set source pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1427 negb ; get positive difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1428 leax b,x ; now X is the top of the destination block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1429 stx V41 ; set copy destination
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1430 stx VARTAB ; save new end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1431 jsr LAC1E ; make sure enough room and make a hole in the program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1432 ldx V45 ; get end address of destination block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1433 stx CHARAD ; set input there
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1434 L8B55 puls x ; get starting address of the line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1435 lda #1 ; set "new number" flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1436 sta ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1437 sta 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1438 sta 4,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1439 ldb BINVAL ; get MS byte of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1440 bne L8B67 ; brif it is not zero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1441 ldb #1 ; set to 1 if MSB is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1442 inc 2,x ; flag MSB as 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1443 L8B67 stb 1,x ; set MSB of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1444 ldb BINVAL+1 ; get LSB of number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1445 bne L8B71 ; brif nonzero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1446 ldb #1 ; set to 1 if LSB is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1447 inc 4,x ; flag LSB as 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1448 L8B71 stb 3,x ; save LSB of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1449 jsr GETCCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1450 cmpa #', ; multiple line numbers? (ON GOTO, ON GOSUB)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1451 beq L8B13 ; brif so - process another
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1452 bra L8B17 ; go look for more line numbers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1453 L8B7B ldx TXTTAB ; point to start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1454 leax -1,x ; move back (compensate for inc below)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1455 L8B7F leax 1,x ; move forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1456 ldd 2,x ; get this line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1457 std CURLIN ; save it (for error message)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1458 jsr L8A86 ; return if end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1459 leax 3,x ; skip address and line number, stay one before line text
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1460 L8B8A leax 1,x ; move to next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1461 L8B8C lda ,x ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1462 beq L8B7F ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1463 deca ; valid line new line number?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1464 beq L8BAE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1465 suba #2 ; undefined line?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1466 bne L8B8A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1467 pshs x ; save line number pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1468 ldx #L8BD9-1 ; show UL message
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1469 jsr STRINOUT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1470 ldx ,s ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1471 ldd 1,x ; get undefined line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1472 jsr LBDCC ; display line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1473 jsr LBDC5 ; print out "IN XXXX"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1474 jsr LB958 ; do a newline
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1475 puls x ; get input pointer back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1476 L8BAE pshs x ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1477 ldd 1,x ; get binary value of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1478 std FPA0+2 ; save it in FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1479 jsr L880E ; adjust FPA0 as integer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1480 jsr LBDD9 ; convert to text string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1481 puls u ; get previous input pointer address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1482 ldb #5 ; each expanded line uses 5 bytes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1483 L8BBE leax 1,x ; move pointer forward (in string number) past sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1484 lda ,x ; do we have a digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1485 beq L8BC9 ; brif not - end of number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1486 decb ; mark a byte consumed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1487 sta ,u+ ; put digit in program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1488 bra L8BBE ; copy another digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1489 L8BC9 leax ,u ; point to address at end of text number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1490 tstb ; did number fill whole space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1491 beq L8B8C ; brif so - move on
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1492 leay ,u ; save end of number pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1493 leau b,u ; point to the end of the original expanded number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1494 jsr L89B8 ; close up gap in program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1495 leax ,y ; get end of line number pointer back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1496 bra L8B8C ; go process more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1497 L8BD9 fcn 'UL '
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1498 ; HEX$ function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1499 HEXDOL jsr LB740 ; convert argument to positive integer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1500 ldx #STRBUF+2 ; point to string buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1501 ldb #4 ; convert 4 nibbles
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1502 L8BE5 pshs b ; save nibble counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1503 clrb ; clear digit accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1504 lda #4 ; do 4 shifts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1505 L8BEA asl FPA0+3 ; shift a bit off the left of the value into low bits of B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1506 rol FPA0+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1507 rolb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1508 deca ; done all shifts?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1509 bne L8BEA ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1510 tstb ; do we have a nonzero digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1511 bne L8BFF ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1512 lda ,s ; is it last digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1513 deca
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1514 beq L8BFF ; brif so - keep the 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1515 cmpx #STRBUF+2 ; is it a middle zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1516 beq L8C0B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1517 L8BFF addb #'0 ; add ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1518 cmpb #'9 ; above 9?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1519 bls L8C07 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1520 addb #7 ; adjust into alpha range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1521 L8C07 stb ,x+ ; save digit in output
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1522 clr ,x ; make sure we have a NUL term
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1523 L8C0B puls b ; get back nibble counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1524 decb ; done all?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1525 bne L8BE5 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1526 leas 2,s ; don't return mainline (we're returning a string)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1527 ldx #STRBUF+1 ; point to start of converted number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1528 jmp LB518 ; save string in string space, etc., and return it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1529 ; DLOAD command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1530 DLOAD jsr LA429 ; close files
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1531 L8C1B jsr GETCCH ; get back input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1532 suba #'M ; is it DLOADM?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1533 pshs a ; save DLOADM flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1534 bne L8C25 ; brif DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1535 jsr GETNCH ; eat the "M"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1536 L8C25 jsr LA578 ; parse the file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1537 jsr GETCCH ; get character after file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1538 beq L8C44 ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1539 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1540 cmpa #', ; do we have 2 commas?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1541 beq L8C44 ; brif so - use default baud rate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1542 jsr EVALEXPB ; evaluate baud rate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1543 L8C36 lda #44*4 ; delay for 300 baud
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1544 tstb ; was argument 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1545 beq L8C42 ; brif so - 300 baud
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1546 lda #44 ; constant for 1200 baud
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1547 decb ; was it 1?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1548 lbne LB44A ; raise error if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1549 L8C42 sta DLBAUD ; save baud rate constant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1550 L8C44 jsr L8CD0 ; transmit file name and read in file status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1551 pshs a ; save register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1552 lda #-3 ; set input to DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1553 sta DEVNUM
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1554 puls a ; restore register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1555 tst ,s+ ; is it DLOADM?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1556 beq L8C85 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1557 jsr LA5C7 ; check for end of line - error if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1558 tstb ; ASCII?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1559 beq L8C5F ; brif not - do error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1560 jsr LAD19 ; clear out program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1561 jmp LAC7C ; go read program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1562 L8C5F jmp LA616 ; raise bad file mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1563 ; CLOADM patch for Extended Basic
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1564 L8C62 jsr GETNCH ; get character after CLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1565 cmpa #'M ; CLOADM?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1566 lbne CLOAD ; brif not - Color Basic's CLOAD can handle it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1567 clr FILSTA ; close tape file
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1568 jsr GETNCH ; eat the "M"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1569 jsr LA578 ; parse file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1570 jsr LA648 ; find the file
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1571 tst CASBUF+10 ; is it a chunked file?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1572 lbeq LA505 ; brif not - Color Basic's CLOADM can handle it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1573 ldu CASBUF+8 ; get file type and ASCII flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1574 dec DEVNUM ; set source device to tape
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1575 jsr LA635 ; go read the first block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1576 tfr u,d ; put type and ASCII flag somewhere more useful
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1577 ; NOTE: DLOADM comes here to do the final processing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1578 L8C85 subd #0x200 ; is it binary and "machine language"?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1579 bne L8C5F ; brif not - raise an error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1580 ldx ZERO ; default load offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1581 jsr GETCCH ; is there any offset?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1582 beq L8C96 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1583 jsr SYNCOMMA ; make sure there's a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1584 jsr LB73D ; evaluate offset in X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1585 L8C96 stx VD3 ; save offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1586 jsr LA5C7 ; raise error if more stuff follows
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1587 L8C9B bsr L8CC6 ; get type of "amble"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1588 pshs a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1589 bsr L8CBF ; read in block length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1590 tfr d,y ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1591 bsr L8CBF ; read in load address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1592 addd VD3 ; add in offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1593 std EXECJP ; save it as the execution address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1594 tfr d,x ; put load address in a pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1595 lda ,s+ ; get "amble" type
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1596 lbne LA42D ; brif postamble - close file
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1597 L8CB1 bsr L8CC6 ; read a data byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1598 sta ,x ; save in memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1599 cmpa ,x+ ; did it actually save?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1600 bne L8CCD ; brif not RAM - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1601 leay -1,y ; done yet?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1602 bne L8CB1 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1603 bra L8C9B ; look for another "amble"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1604 L8CBF bsr L8CC1 ; read a character to B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1605 L8CC1 bsr L8CC6 ; read character to A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1606 exg a,b ; swap character with previously read one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1607 L8CC5 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1608 L8CC6 jsr LA176 ; read a character from input
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1609 tst CINBFL ; EOF?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1610 beq L8CC5 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1611 L8CCD jmp LA619 ; raise I/O error if EOF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1612 L8CD0 bsr L8D14 ; transmit file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1613 pshs b,a ; save file status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1614 inca ; was file found?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1615 beq L8CDD ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1616 ldu ZERO ; zero U - first block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1617 bsr L8CE4 ; read block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1618 puls a,b,pc ; restore status and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1619 L8CDD ldb #2*26 ; code for NE error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1620 jmp LAC46 ; raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1621 L8CE2 ldu CBUFAD ; get block number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1622 L8CE4 leax 1,u ; bump block number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1623 stx CBUFAD ; save new block number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1624 ldx #CASBUF ; use cassette buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1625 jsr L8D7C ; read a block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1626 jmp LA644 ; reset input buffer pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1627 ; Generic input handler for Extended Basic
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1628 XVEC4 lda DEVNUM ; get device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1629 cmpa #-3 ; DLOAD?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1630 bne L8D01 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1631 leas 2,s ; don't return to mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1632 clr CINBFL ; reset EOF flag to not EOF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1633 tst CINCTR ; anything available?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1634 bne L8D02 ; brif so - fetch one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1635 com CINBFL ; flag EOF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1636 L8D01 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1637 L8D02 pshs u,y,x,b ; save registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1638 ldx CINPTR ; get buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1639 lda ,x+ ; get character from buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1640 pshs a ; save it for return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1641 stx CINPTR ; save new input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1642 dec CINCTR ; account for byte removed from buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1643 bne L8D12 ; brif buffer not empty
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1644 bsr L8CE2 ; go read a block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1645 L8D12 puls a,b,x,y,u,pc ; restore registers, return value, and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1646 L8D14 clra ; clear attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1647 pshs x,b,a ; make a hole for variables
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1648 leay ,s ; set up frame pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1649 bra L8D1D ; go read block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1650 L8D1B bsr L8D48 ; bump attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1651 L8D1D lda #0x8a ; send file request control code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1652 bsr L8D58
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1653 bne L8D1B ; brif no echo or error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1654 ldx #CFNBUF+1 ; point to file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1655 L8D26 lda ,x+ ; get file name characater
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1656 jsr L8E04 ; send it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1657 cmpx #CFNBUF+9 ; end of file name?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1658 bne L8D26 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1659 bsr L8D62 ; output check byte and look for response
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1660 bne L8D1B ; transmit name again if not ack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1661 bsr L8D72 ; get file type (0xff is not found)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1662 bne L8D1B ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1663 sta 2,y ; save file type
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1664 bsr L8D72 ; read ASCII flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1665 bne L8D1B ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1666 sta 3,y ; save ASCII flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1667 bsr L8D6B ; read check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1668 bne L8D1B ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1669 leas 2,s ; lose attempt counter and check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1670 puls a,b,pc ; return file type and ascii flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1671 L8D48 inc ,y ; bump attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1672 lda ,y ; get new count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1673 cmpa #5 ; done 5 times?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1674 blo L8D6A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1675 lda #0xbc ; send abort code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1676 jsr L8E0C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1677 jmp LA619 ; raise an I/O error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1678 L8D58 pshs a ; save compare character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1679 bsr L8DB8 ; send character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1680 bne L8D60 ; brif read error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1681 cmpa ,s ; does it match? (set Z if good)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1682 L8D60 puls a,pc ; restore character and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1683 L8D62 lda 1,y ; get XOR check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1684 bsr L8DB8 ; send it and read
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1685 bne L8D6A ; brif read error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1686 cmpa #0xc8 ; is it ack? (set Z if so)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1687 L8D6A rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1688 L8D6B bsr L8D72 ; read character from rs232
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1689 bne L8D6A ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1690 lda 1,y ; get check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1691 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1692 L8D72 bsr L8DBC ; read a character from rs232
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1693 pshs a,cc ; save result (and flags)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1694 eora 1,y ; accumulate xor checksum
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1695 sta 1,y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1696 puls cc,a,pc ; restore byte, flags, and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1697 L8D7C clra ; reset attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1698 pshs u,y,x,b,a ; make a stack frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1699 asl 7,s ; split block number into two 7 bit chuncks
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1700 rol 6,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1701 lsr 7,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1702 leay ,s ; set up frame pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1703 bra L8D8B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1704 L8D89 bsr L8D48 ; bump attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1705 L8D8B lda #0x97 ; send block request code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1706 bsr L8D58
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1707 bne L8D89 ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1708 lda 6,y ; send out block number (high bits first)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1709 bsr L8E04
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1710 lda 7,y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1711 bsr L8E04
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1712 bsr L8D62 ; send check byte and get ack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1713 bne L8D89 ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1714 bsr L8D72 ; read block size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1715 bne L8D89 ; brif read error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1716 sta 4,y ; save character count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1717 ldx 2,y ; get buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1718 ldb #128 ; length of data block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1719 L8DA7 bsr L8D72 ; read a data byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1720 bne L8D89 ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1721 sta ,x+ ; save byte in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1722 decb ; done a whole block?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1723 bne L8DA7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1724 bsr L8D6B ; read check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1725 bne L8D89 ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1726 leas 4,s ; lose attempt counter, check byte, and buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1727 puls a,b,x,pc ; return with character count in A, clean rest of stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1728 L8DB8 clr 1,y ; clear check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1729 bsr L8E0C ; output character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1730 L8DBC clra ; clear attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1731 pshs x,b,cc ; save registers and interrupt status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1732 orcc #0x50 ; disable interrupts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1733 lda TIMOUT ; get timout delay (variable)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1734 ldx ZERO ; get constant timeout value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1735 L8DC5 bsr L8DE6 ; get RS232 status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1736 bcc L8DC5 ; brif "space" - waiting for "mark"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1737 L8DC9 bsr L8DE6 ; get RS232 status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1738 bcs L8DC9 ; brif "mark" - waiting for "space" (start bit)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1739 bsr L8DF9 ; delay for half of bit time
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1740 ldb #1 ; set bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1741 pshs b ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1742 clra ; reset data byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1743 L8DD4 bsr L8DF7 ; wait one bit time
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1744 ldb PIA1+2 ; get input bit to carry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1745 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1746 bcc L8DDE ; brif "space" (0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1747 ora ,s ; merge bit probe in
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1748 L8DDE asl ,s ; shift bit probe over
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1749 bcc L8DD4 ; brif we haven't done 8 bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1750 leas 1,s ; remove bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1751 puls cc,b,x,pc ; restore interrupts, registers, and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1752 L8DE6 ldb PIA1+2 ; get RS232 value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1753 rorb ; put in C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1754 leax 1,x ; bump timeout
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1755 bne L8DF6 ; brif nonzero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1756 deca ; did the number of waits expire?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1757 bne L8DF6 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1758 leas 2,s ; don't return - we timed out
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1759 puls cc,b,x ; restore interrupts and registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1760 inca ; clear Z (A was zero above)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1761 L8DF6 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1762 L8DF7 bsr L8DF9 ; do first half of bit delay then fall through for second
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1763 L8DF9 pshs a ; save register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1764 lda DLBAUD ; get baud rate constant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1765 L8DFD brn L8DFD ; do nothing - delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1766 deca ; time expired?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1767 bne L8DFD ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1768 puls a,pc ; restore register and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1769 L8E04 pshs a ; save character to send
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1770 eora 1,y ; accumulate chechsum
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1771 sta 1,y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1772 puls a ; get character back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1773 L8E0C pshs b,a,cc ; save registers and interrupt status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1774 orcc #0x50 ; disable interrupts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1775 bsr L8DF7 ; do a bit delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1776 bsr L8DF7 ; do another bit delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1777 clr PIA1 ; set output to space (start bit)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1778 bsr L8DF7 ; do a bit delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1779 ldb #1 ; bit probe start at LSB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1780 pshs b ; save bitprobe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1781 L8E1D lda 2,s ; get output byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1782 anda ,s ; see what our current bit is
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1783 beq L8E25 ; brif output is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1784 lda #2 ; set output to "marking"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1785 L8E25 sta PIA1 ; send bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1786 bsr L8DF7 ; do a bit delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1787 asl ,s ; shift bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1788 bcc L8E1D ; brif not last bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1789 lda #2 ; set output to marking ("stop" bit)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1790 sta PIA1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1791 leas 1,s ; lose bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1792 puls cc,a,b,pc ; restore registers, interrupts, and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1793 ; PRINT USING
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1794 ; This is a massive block of code for something that has limited utility. It is *almost* flexible enough to
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1795 ; be truly useful outside of a narrow range of use cases. Indeed, this comes in at about 1/8 of the total
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1796 ; Extended Color Basic ROM.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1797 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1798 ; This uses several variables:
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1799 ; VD5: pointer to format string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1800 ; VD7: next print item flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1801 ; VD8: right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1802 ; VD9: left digit counter (or length of string argument)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1803 ; VDA: status byte (bits as follows):
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1804 ; 6: force comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1805 ; 5: force leading *
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1806 ; 4: floating $
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1807 ; 3: pre-sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1808 ; 2: post-sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1809 ; 0: scientific notation
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1810 L8E37 lda #1 ; set length to use to 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1811 sta VD9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1812 L8E3B decb ; consume character from format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1813 jsr L8FD8 ; show error flag if flags set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1814 jsr GETCCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1815 lbeq L8ED8 ; brif end of line - bail
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1816 stb VD3 ; save remaining string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1817 jsr LB156 ; evaluate the argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1818 jsr LB146 ; error if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1819 ldx FPA0+2 ; get descriptor for argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1820 stx V4D ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1821 ldb VD9 ; get length counter to use
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1822 jsr LB6AD ; get B bytes of string space (do a LEFT$)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1823 jsr LB99F ; print the formatted string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1824 ldx FPA0+2 ; get formatted string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1825 ldb VD9 ; get requested length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1826 subb ,x ; see if we have any left over
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1827 L8E5F decb ; have we got the right width?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1828 lbmi L8FB3 ; brif so - go process more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1829 jsr LB9AC ; output a space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1830 bra L8E5F ; go see if we're done yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1831 L8E69 stb VD3 ; save current format string counter and pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1832 stx TEMPTR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1833 lda #2 ; initial spaces count = 2 (for the two %s)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1834 sta VD9 ; save length counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1835 L8E71 lda ,x ; get character in string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1836 cmpa #'% ; is it the end of the sequence?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1837 beq L8E3B ; brif so - display requested part of the strign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1838 cmpa #0x20 ; space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1839 bne L8E82 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1840 inc VD9 ; bump spaces count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1841 leax 1,x ; move format pointer forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1842 decb ; consume character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1843 bne L8E71 ; brif not end of format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1844 L8E82 ldx TEMPTR ; restore format string pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1845 ldb VD3 ; get back format string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1846 lda #'% ; show % as debugging aid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1847 L8E88 jsr L8FD8 ; send error indicator if flags set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1848 jsr PUTCHR ; output character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1849 bra L8EB9 ; go process more format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1850 ; PRINT extension for USING
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1851 XVEC9 cmpa #0xcd ; USING?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1852 beq L8E95 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1853 rts ; return to mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1854 ; This is the main entry point for PRINT USING
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1855 L8E95 leas 2,s ; don't return to the mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1856 jsr LB158 ; evaluate the format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1857 jsr LB146 ; error if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1858 ldb #'; ; make sure there's a ; after the string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1859 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1860 ldx FPA0+2 ; get format string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1861 stx VD5 ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1862 bra L8EAE ; process format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1863 L8EA8 lda VD7 ; is there a print item?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1864 beq L8EB4 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1865 ldx VD5 ; get back format string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1866 L8EAE clr VD7 ; reset next print item flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1867 ldb ,x ; get length of format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1868 bne L8EB7 ; brif string is non-null
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1869 L8EB4 jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1870 L8EB7 ldx 2,x ; point to start of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1871 L8EB9 clr VDA ; clear status (new item)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1872 L8EBB clr VD9 ; clear left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1873 lda ,x+ ; get character from format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1874 cmpa #'! ; ! (use first character of string)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1875 lbeq L8E37 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1876 cmpa #'# ; digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1877 beq L8F24 ; brif so - handle numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1878 decb ; consume format character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1879 bne L8EE2 ; brif not done
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1880 jsr L8FD8 ; show a "+" if any flags set - indicates error at end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1881 jsr PUTCHR ; output format string character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1882 L8ED2 jsr GETCCH ; get current input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1883 bne L8EA8 ; brif not end of statement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1884 lda VD7 ; get next item flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1885 L8ED8 bne L8EDD ; brif more print items
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1886 jsr LB958 ; do newline
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1887 L8EDD ldx VD5 ; point to format string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1888 jmp LB659 ; remove from string stack, etc., if appropriate (and return)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1889 L8EE2 cmpa #'+ ; is it + (pre-sign)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1890 bne L8EEF ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1891 jsr L8FD8 ; send a "+" if flags set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1892 lda #8 ; flag for pre-sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1893 sta VDA ; set flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1894 bra L8EBB ; go interpret some more stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1895 L8EEF cmpa #'. ; decimal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1896 beq L8F41 ; brif so - numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1897 cmpa #'% ; % (show string)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1898 lbeq L8E69 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1899 cmpa ,x ; do we have two identical characters?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1900 L8EFB bne L8E88 ; brif not - invalid format character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1901 cmpa #'$ ; double $?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1902 beq L8F1A ; brif so - floating $
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1903 cmpa #'* ; double *?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1904 bne L8EFB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1905 lda VDA ; get status byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1906 ora #0x20 ; enable * padding
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1907 sta VDA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1908 cmpb #2 ; is $$ the last two?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1909 blo L8F20 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1910 lda 1,x ; is it $ after?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1911 cmpa #'$
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1912 bne L8F20 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1913 decb ; consume the "$"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1914 leax 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1915 inc VD9 ; add to digit counter * pad + $ counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1916 L8F1A lda VDA ; indicate floating $
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1917 ora #0x10
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1918 sta VDA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1919 L8F20 leax 1,x ; consume the second format character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1920 inc VD9 ; add one more left place
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1921 L8F24 clr VD8 ; clear right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1922 L8F26 inc VD9 ; bump left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1923 decb ; consume character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1924 beq L8F74 ; brif end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1925 lda ,x+ ; get next format character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1926 cmpa #'. ; decimal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1927 beq L8F4F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1928 cmpa #'# ; digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1929 beq L8F26 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1930 cmpa #', ; comma flag?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1931 bne L8F5A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1932 lda VDA ; set commas flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1933 ora #0x40
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1934 sta VDA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1935 bra L8F26 ; handle more characters to left of decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1936 L8F41 lda ,x ; get character after .
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1937 cmpa #'# ; digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1938 lbne L8E88 ; brif not - invalid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1939 lda #1 ; set right digit counter to 1 (for the .)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1940 sta VD8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1941 leax 1,x ; consume the .
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1942 L8F4F inc VD8 ; add one to right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1943 decb ; consume character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1944 beq L8F74 ; brif end of format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1945 lda ,x+ ; get another format character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1946 cmpa #'# ; digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1947 beq L8F4F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1948 L8F5A cmpa #0x5e ; up arrow?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1949 bne L8F74 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1950 cmpa ,x ; two of them?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1951 bne L8F74 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1952 cmpa 1,x ; three of them?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1953 bne L8F74 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1954 cmpa 2,x ; four of them?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1955 bne L8F74 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1956 cmpb #4 ; string actually has the characters?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1957 blo L8F74 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1958 subb #4 ; consome them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1959 leax 4,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1960 inc VDA ; set scientific notation bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1961 L8F74 leax -1,x ; back up input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1962 inc VD9 ; add one digit for pre-sign force
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1963 lda VDA ; is it pre-sign?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1964 bita #8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1965 bne L8F96 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1966 dec VD9 ; undo pre-sign adjustment
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1967 tstb ; end of string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1968 beq L8F96 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1969 lda ,x ; get next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1970 suba #'- ; post sign force?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1971 beq L8F8F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1972 cmpa #'+-'- ; plus?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1973 bne L8F96 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1974 lda #8 ; trailing + is a pre-sign force
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1975 L8F8F ora #4 ; add in post sign flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1976 ora VDA ; merge with flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1977 sta VDA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1978 decb ; consume character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1979 L8F96 jsr GETCCH ; do we have an argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1980 lbeq L8ED8 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1981 stb VD3 ; save format string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1982 jsr LB141 ; evluate numeric expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1983 lda VD9 ; get left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1984 adda VD8 ; add in right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1985 cmpa #17 ; is it more than 16 digits + decimal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1986 lbhi LB44A ; brif so - this is a problem
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1987 jsr L8FE5 ; format value according to settings
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1988 leax -1,x ; move buffer pointer back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1989 jsr STRINOUT ; display formatted number string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1990 L8FB3 clr VD7 ; reset next print item flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1991 jsr GETCCH ; get current input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1992 beq L8FC6 ; brif end of statement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1993 sta VD7 ; set next print flag to nonzero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1994 cmpa #'; ; list separator ;?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1995 beq L8FC4 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1996 jsr SYNCOMMA ; require a comma between if not ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1997 bra L8FC6 ; process next item
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1998 L8FC4 jsr GETNCH ; munch the semicolon
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1999 L8FC6 ldx VD5 ; get format string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2000 ldb ,x ; get length of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2001 subb VD3 ; subtract amount left after last item
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2002 ldx 2,x ; point to string address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2003 abx ; move pointer to correct spot
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2004 ldb VD3 ; get remaining string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2005 lbne L8EB9 ; if we have more, interpret from there
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2006 jmp L8ED2 ; re-interpret from start if we hit the end
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2007 L8FD8 pshs a ; save character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2008 lda #'+ ; "error" flag character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2009 tst VDA ; did we have some flags set?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2010 beq L8FE3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2011 jsr PUTCHR ; output error flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2012 L8FE3 puls a,pc ; restore character and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2013 L8FE5 ldu #STRBUF+4 ; point to string buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2014 ldb #0x20 ; blank space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2015 lda VDA ; get flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2016 bita #8 ; pre-sign?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2017 beq L8FF2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2018 ldb #'+ ; plus sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2019 L8FF2 tst FP0SGN ; get sign of value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2020 bpl L8FFA ; brif positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2021 clr FP0SGN ; make number positive (for later)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2022 ldb #'- ; negative sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2023 L8FFA stb ,u+ ; put sign in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2024 ldb #'0 ; put a zero there
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2025 stb ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2026 anda #1 ; check scientific notation force
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2027 lbne L910D ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2028 ldx #LBDC0 ; point to FP 1E+9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2029 jsr LBCA0 ; is it less?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2030 bmi L9023 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2031 jsr LBDD9 ; convert FP number to string (we're doing scientific notation)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2032 L9011 lda ,x+ ; advance pointer to end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2033 bne L9011
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2034 L9015 lda ,-x ; make a hole at the start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2035 sta 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2036 cmpx #STRBUF+3 ; done yet?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2037 bne L9015 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2038 lda #'% ; put "overflow" flag at start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2039 sta ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2040 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2041 L9023 lda FP0EXP ; get exponent of value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2042 sta V47 ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2043 beq L902C ; brif value is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2044 jsr L91CD ; convert to number with 9 significant figures to left of decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2045 L902C lda V47 ; get base 10 exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2046 lbmi L90B3 ; brif < 100,000,000
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2047 nega ; get negative difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2048 adda VD9 ; add to number of left digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2049 suba #9 ; account for the 9 we actually have
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2050 jsr L90EA ; put leading zeroes in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2051 jsr L9263 ; initialize the decimal point and comma counters
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2052 jsr L9202 ; convert FPA0 to decimal ASCII in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2053 lda V47 ; get base 10 exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2054 jsr L9281 ; put that many zeroes in buffer, stop at decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2055 lda V47 ; get base 10 exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2056 jsr L9249 ; check for decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2057 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2058 bne L9050 ; brif we want stuff after decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2059 leau -1,u ; delete decimal if not needed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2060 L9050 deca ; subtract one place (for decimal)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2061 jsr L90EA ; put zeroes in buffer (trailing)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2062 L9054 jsr L9185 ; insert * padding, floating $, and post-sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2063 tsta ; was there a post sign?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2064 beq L9060 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2065 cmpb #'* ; was first character a *?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2066 beq L9060 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2067 stb ,u+ ; store the post sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2068 L9060 clr ,u ; make srue it's NUL terminated
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2069 ldx #STRBUF+3 ; point to start of buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2070 L9065 leax 1,x ; move to next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2071 stx TEMPTR ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2072 lda VARPTR+1 ; get address of decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2073 suba TEMPTR+1 ; subtract out actual digits left of decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2074 suba VD9 ; subtract out required left digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2075 beq L90A9 ; brif no padding needed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2076 lda ,x ; get current character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2077 cmpa #0x20 ; space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2078 beq L9065 ; brif so - advance pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2079 cmpa #'* ; *?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2080 beq L9065 ; brif so - advance pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2081 clra ; zero on stack is end of data ponter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2082 L907C pshs a ; save character on stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2083 lda ,x+ ; get next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2084 cmpa #'- ; minus?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2085 beq L907C ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2086 cmpa #'+ ; plus?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2087 beq L907C ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2088 cmpa #'$ ; $?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2089 beq L907C ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2090 cmpa #'0 ; zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2091 bne L909E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2092 lda 1,x ; get character after 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2093 bsr L90AA ; clear carry if number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2094 bcs L909E ; brif not number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2095 L9096 puls a ; get character off stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2096 sta ,-x ; put it back in string buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2097 bne L9096 ; brif not - restore another
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2098 bra L9065 ; keep cleaning up buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2099 L909E puls a ; get the character on the stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2100 tsta ; is it NUL?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2101 bne L909E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2102 ldx TEMPTR ; get string buffer start pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2103 lda #'% ; put error flag in front
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2104 sta ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2105 L90A9 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2106 L90AA cmpa #'0 ; zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2107 blo L90B2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2108 suba #'9+1 ; set C if > "9"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2109 suba #-('9+1)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2110 L90B2 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2111 L90B3 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2112 beq L90B8 ; brif not right digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2113 deca ; account for decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2114 L90B8 adda V47 ; add base 10 exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2115 bmi L90BD ; if >= 0, no shifts are required
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2116 clra ; force shift counter to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2117 L90BD pshs a ; save shift counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2118 L90BF bpl L90CB ; brif positive count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2119 pshs a ; save shift counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2120 jsr LBB82 ; divide FPA0 by 10 (shift 1 digit to the right)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2121 puls a ; get shift counter back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2122 inca ; account for the shift
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2123 bra L90BF ; see if we're done yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2124 L90CB lda V47 ; get base 10 exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2125 suba ,s+ ; account for adjustment
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2126 sta V47 ; save new exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2127 adda #9 ; account for significant places
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2128 bmi L90EE ; brif we don't need zeroes to left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2129 lda VD9 ; get left decimal counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2130 suba #9 ; account for significant figures
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2131 suba V47 ; subtract exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2132 bsr L90EA ; output leading zeroes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2133 jsr L9263 ; initialize decimal and comma counters
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2134 bra L90FF ; process remainder of digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2135 L90E2 pshs a ; save zero counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2136 lda #'0 ; insert a 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2137 sta ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2138 puls a ; get back counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2139 L90EA deca ; do we need more zeroes?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2140 bpl L90E2 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2141 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2142 L90EE lda VD9 ; get left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2143 bsr L90EA ; put that many zeroes in
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2144 jsr L924D ; put decimal in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2145 lda #-9 ; figure out filler zeroes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2146 suba V47
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2147 bsr L90EA ; output required leader zeroes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2148 clr V45 ; clear decimal pointer counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2149 clr VD7 ; clear comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2150 L90FF jsr L9202 ; decode FPA0 to decimal string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2151 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2152 bne L9108 ; brif there are right digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2153 ldu VARPTR ; point to decimal location of decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2154 L9108 adda V47 ; add base 10 exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2155 lbra L9050 ; add in leading astrisks, etc.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2156 L910D lda FP0EXP ; get exponent of FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2157 pshs a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2158 beq L9116 ; brif 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2159 jsr L91CD ; convert to number with 9 figures
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2160 L9116 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2161 beq L911B ; brif no right digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2162 deca ; account for decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2163 L911B adda VD9 ; get left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2164 clr STRBUF+3 ; use buffer byte as temporary storage
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2165 ldb VDA ; get status flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2166 andb #4 ; post-sign?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2167 bne L9129 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2168 com STRBUF+3 ; flip byte if no post sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2169 L9129 adda STRBUF+3 ; subtract 1 if no post sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2170 suba #9 ; account for significant figures
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2171 pshs a ; save shift counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2172 L9130 bpl L913C ; brif no more shifts needed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2173 pshs a ; save counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2174 jsr LBB82 ; divide by 10 (shift right one)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2175 puls a ; get back counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2176 inca ; account for the shift
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2177 bra L9130 ; see if we need more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2178 L913C lda ,s ; get original shift count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2179 bmi L9141 ; brif shifting happened
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2180 clra ; flag for no shifting
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2181 L9141 nega ; calculate position of decimal (negate shift count, add left digit and post sign if needed)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2182 adda VD9 ; add left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2183 inca ; and post sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2184 adda STRBUF+3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2185 sta V45 ; save decimal counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2186 clr VD7 ; clear comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2187 jsr L9202 ; convert to decimal string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2188 puls a ; get shift counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2189 jsr L9281 ; put the needed zeroes in
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2190 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2191 bne L915A ; brif we want some
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2192 leau -1,u ; remove te decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2193 L915A ldb ,s+ ; get original exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2194 beq L9167 ; brif it was 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2195 ldb V47 ; get base 10 exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2196 addb #9 ; account for significant figures
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2197 subb VD9 ; remove left digit count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2198 subb STRBUF+3 ; add one if post sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2199 L9167 lda #'+ ; positive sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2200 tstb ; is base 10 exponent positive?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2201 bpl L916F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2202 lda #'- ; negative sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2203 negb ; flip exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2204 L916F sta 1,u ; put exponent sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2205 lda #'E ; put "E" and advance output pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2206 sta ,u++
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2207 lda #'0-1 ; initialize digit accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2208 L9177 inca ; bump digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2209 subb #10 ; are we at the right digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2210 bcc L9177 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2211 addb #'0+10 ; add ASCII bias and undo extra subtraction
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2212 std ,u++ ; save exponent in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2213 clr ,u ; clear final byte in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2214 jmp L9054 ; insert *, $, etc.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2215 L9185 ldx #STRBUF+4 ; point to start of result
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2216 ldb ,x ; get sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2217 pshs b ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2218 lda #0x20 ; default pad with spaces
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2219 ldb VDA ; get flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2220 bitb #0x20 ; padding with *?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2221 puls b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2222 beq L919E ; brif no padding
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2223 lda #'* ; pad with *
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2224 cmpb #0x20 ; do we have a blank? (positive)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2225 bne L919E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2226 tfr a,b ; use pad character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2227 L919E pshs b ; save first character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2228 L91A0 sta ,x+ ; store padding
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2229 ldb ,x ; get next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2230 beq L91B6 ; brif end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2231 cmpb #'E ; exponent?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2232 beq L91B6 ; brif so - treat as 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2233 cmpb #'0 ; zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2234 beq L91A0 ; brif so - pad it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2235 cmpb #', ; leading comma?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2236 beq L91A0 ; brif so - pad it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2237 cmpb #'. ; decimal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2238 bne L91BA ; brif so - don't put a 0 before it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2239 L91B6 lda #'0 ; put a zero before
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2240 sta ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2241 L91BA lda VDA ; get status byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2242 bita #0x10 ; floating $?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2243 beq L91C4 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2244 ldb #'$ ; stuff a $ in
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2245 stb ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2246 L91C4 anda #4 ; pre-sgn?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2247 puls b ; get back first character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2248 bne L91CC ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2249 stb ,-x ; save leading character (sign)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2250 L91CC rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2251 L91CD pshs u ; save buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2252 clra ; initial exponent offset is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2253 L91D0 sta V47 ; save exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2254 ldb FP0EXP ; get actual exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2255 cmpb #0x80 ; is value >= 1.0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2256 bhi L91E9 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2257 ldx #LBDC0 ; point to FP number 1E9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2258 jsr LBACA ; multiply by 1000000000
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2259 lda V47 ; account for 9 shifts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2260 suba #9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2261 bra L91D0 ; brif not there yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2262 L91E4 jsr LBB82 ; divide by 10
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2263 inc V47 ; account for shift
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2264 L91E9 ldx #LBDBB ; point to 999999999
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2265 jsr LBCA0 ; compare it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2266 bgt L91E4 ; brif not in range yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2267 L91F1 ldx #LBDB6 ; point to 99999999.9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2268 jsr LBCA0 ; compare
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2269 bgt L9200 ; brif in range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2270 jsr LBB6A ; multiply by 10
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2271 dec V47 ; account for shift
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2272 bra L91F1 ; see if we're in range yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2273 L9200 puls u,pc ; restore buffer pointer and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2274 L9202 pshs u ; save buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2275 jsr LB9B4 ; add .5 (round off)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2276 jsr LBCC8 ; convert to integer format
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2277 puls u ; restore buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2278 ldx #LBEC5 ; point to 32 bit powers of 10 (alternating signs)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2279 ldb #0x80 ; intitial digit counter is 0 with 0x80 bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2280 L9211 bsr L9249 ; check for comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2281 L9213 lda FPA0+3 ; add a power of 10
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2282 adda 3,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2283 sta FPA0+3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2284 lda FPA0+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2285 adca 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2286 sta FPA0+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2287 lda FPA0+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2288 adca 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2289 sta FPA0+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2290 lda FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2291 adca ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2292 sta FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2293 incb ; add one to digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2294 rorb ; set V if carry and sign differ
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2295 rolb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2296 bvc L9213 ; brif we haven't "wrapped"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2297 bcc L9235 ; brif subtracting
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2298 subb #10+1 ; take 9's complement if adding
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2299 negb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2300 L9235 addb #'0-1 ; add in ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2301 leax 4,x ; move to next power
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2302 tfr b,a ; save digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2303 anda #0x7f ; mask off subtract flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2304 sta ,u+ ; save digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2305 comb ; toggle add/subtract
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2306 andb #0x80
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2307 cmpx #LBEE9 ; done all places?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2308 bne L9211 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2309 clr ,u ; but NUL at end
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2310 L9249 dec V45 ; at decimal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2311 bne L9256 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2312 L924D stu VARPTR ; save decimal point pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2313 lda #'. ; insert decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2314 sta ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2315 clr VD7 ; clear comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2316 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2317 L9256 dec VD7 ; do we need a comma?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2318 bne L9262 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2319 lda #3 ; reset comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2320 sta VD7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2321 lda #', ; insert comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2322 sta ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2323 L9262 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2324 L9263 lda V47 ; get base 10 exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2325 adda #10 ; account for significant figures
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2326 sta V45 ; save decimal counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2327 inca ; add one for decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2328 L926A suba #3 ; divide by 3, leave remainder in A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2329 bcc L926A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2330 adda #5 ; renormalize to range 1-3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2331 sta VD7 ; save comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2332 lda VDA ; get status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2333 anda #0x40 ; commas wanted?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2334 bne L927A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2335 sta VD7 ; clear comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2336 L927A rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2337 L927B pshs a ; save zeroes counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2338 bsr L9249 ; check for decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2339 puls a ; get back counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2340 L9281 deca ; need a zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2341 bmi L928E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2342 pshs a ; save counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2343 lda #'0 ; put a zero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2344 sta ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2345 lda ,s+ ; get back counter and set flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2346 bne L927B ; brif not done enough
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2347 L928E rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2348 ; From here to the end of the Extended Basic ROM is the PMODE graphics system and related
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2349 ; infrastructure with the exception of the PLAY command which shares some of its machinery
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2350 ; with the DRAW command.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2351 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2352 ; Fetch screen address calculation routine address for the selected graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2353 L928F ldu #L929C ; point to normalization routine jump table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2354 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2355 asla ; two bytes per address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2356 ldu a,u ; get routine address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2357 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2358 ; Normalize VERBEG/HORBEG coordinates and return screen address in X and pixel mask in A.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2359 L9298 bsr L928F ; fetch normalization routine pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2360 jmp ,u ; transfer control to it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2361 L929C fdb L92A6 ; PMODE 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2362 fdb L92C2 ; PMODE 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2363 fdb L92A6 ; PMODE 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2364 fdb L92C2 ; PMODE 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2365 fdb L92A6 ; PMODE 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2366 ; Two colour mode address calculatoin
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2367 L92A6 pshs u,b ; savce registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2368 ldb HORBYT ; get number of bytes in each graphics row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2369 lda VERBEG+1 ; get vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2370 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2371 addd BEGGRP ; now D is the absolute address of the start of the row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2372 tfr d,x ; get address to the return location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2373 ldb HORBEG+1 ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2374 lsrb ; divide by 8 (8 pixels per byte in 2 colour mode)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2375 lsrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2376 lsrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2377 abx ; now X is the address of the actual pixel byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2378 lda HORBEG+1 ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2379 anda #7 ; keep only the low 3 bits which contain the pixel number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2380 ldu #L92DD ; point to pixel mask lookup
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2381 lda a,u ; get pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2382 puls b,u,pc ; restore registers and return result
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2383 ; four colour address calculation
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2384 L92C2 pshs u,b ; save registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2385 ldb HORBYT ; get bytes per graphics row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2386 lda VERBEG+1 ; get vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2387 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2388 addd BEGGRP ; now D is the address of the start of the row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2389 tfr d,x ; put it in returnlocatin
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2390 ldb HORBEG+1 ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2391 lsrb ; divide by 4 (four colour modes have four pixels per byte)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2392 lsrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2393 abx ; now X points to the screen byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2394 lda HORBEG+1 ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2395 anda #3 ; keep low two bits for pixel number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2396 ldu #L92E5 ; point to four colour pixel masks
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2397 lda a,u ; get pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2398 puls b,u,pc ; restore registers and return result
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2399 L92DD fcb 0x80,0x40,0x20,0x10 ; two colour pixel masks
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2400 fcb 0x08,0x04,0x02,0x01
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2401 L92E5 fcb 0xc0,0x30,0x0c,0x03 ; four colour pixel masks
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2402 ; Move X down one graphics row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2403 L92E9 ldb HORBYT ; get bytes per row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2404 abx ; add to screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2405 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2406 ; Move one pixel right in 2 colour mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2407 L92ED lsra ; move pixel mask right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2408 bcc L92F3 ; brif same byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2409 rora ; move pixel mask to left of byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2410 leax 1,x ; move to next byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2411 L92F3 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2412 ; Move one pixel right in 4 colour mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2413 L92F4 lsra ; shift mask half a pixel right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2414 bcc L92ED ; brif not past end of byte - shift one more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2415 lda #0xc0 ; set mask on left of byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2416 leax 1,x ; move to next byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2417 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2418 ; Evaluate two expressions (coordinates). Put first in HORBEG and second in VERBEG.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2419 L92FC jsr LB734 ; evaluate two expressions - first in BINVAL, second in B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2420 ldy #HORBEG ; point to storage location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2421 L9303 cmpb #192 ; is vertical outside range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2422 blo L9309 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2423 ldb #191 ; max it at bottom of screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2424 L9309 clra ; zero extend vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2425 std 2,y ; save vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2426 ldd BINVAL ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2427 cmpd #256 ; in range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2428 blo L9317 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2429 ldd #255 ; max it out to right side of screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2430 L9317 std ,y ; save horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2431 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2432 ; Normalize coordinates for proper PMODE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2433 L931A jsr L92FC ; parse coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2434 L931D ldu #HORBEG ; point to start coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2435 L9320 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2436 cmpa #2 ; is it pmode 0 or 1?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2437 bhs L932C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2438 ldd 2,u ; get vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2439 lsra ; divide it by two
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2440 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2441 std 2,u ; save it back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2442 L932C lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2443 cmpa #4 ; pmode 4?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2444 bhs L9338 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2445 ldd ,u ; cut horizontal coordinate in half
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2446 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2447 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2448 std ,u ; save new coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2449 L9338 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2450 ; PPOINT function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2451 PPOINT jsr L93B2 ; evaluate two expressions (coordinates)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2452 jsr L931D ; normalize coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2453 jsr L9298 ; get screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2454 anda ,x ; get colour value of desired screen coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2455 ldb PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2456 rorb ; is it a two colour m ode?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2457 bcc L935B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2458 L9349 cmpa #4 ; is it on rightmost bits?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2459 blo L9351 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2460 rora ; shift right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2461 rora
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2462 bra L9349 ; see if we're there yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2463 L9351 inca ; colour numbers start at 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2464 asla ; add in colour set (0 or 8)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2465 adda CSSVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2466 lsra ; get colour in range of 0 to 8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2467 L9356 tfr a,b ; put result to B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2468 jmp LB4F3 ; return B as FP number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2469 L935B tsta ; is pixel on?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2470 beq L9356 ; brif not, return 0 (off)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2471 clra ; set colour number to "1"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2472 bra L9351 ; make it 1 or 5 and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2473 ; PSET command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2474 PSET lda #1 ; PSET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2475 bra L9366 ; go turn on the pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2476 ; PRESET command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2477 PRESET clra ; PRESET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2478 L9366 sta SETFLG ; store whether we're setting or resetting
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2479 jsr LB26A ; enforce (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2480 jsr L931A ; evaluate coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2481 jsr L9581 ; evaluate colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2482 jsr LB267 ; enforce )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2483 jsr L9298 ; get address of pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2484 L9377 ldb ,x ; get screen data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2485 pshs b ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2486 tfr a,b ; duplicate pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2487 coma ; invert mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2488 anda ,x ; turn off screen pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2489 andb ALLCOL ; adjust pixel mask to be the current colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2490 pshs b ; merge pixel data into the screen data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2491 ora ,s+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2492 sta ,x ; put it on screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2493 suba ,s+ ; nonzero if screen data changed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2494 ora CHGFLG ; propagate change flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2495 sta CHGFLG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2496 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2497 ; Evaluate two sets of coordinates separated by a minus sign. First at HORBEG,VERBEG and
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2498 ; second at HOREND,VEREND. If no first set, use HORDEF,VERDEF.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2499 L938F ldx HORDEF ; set default start coords
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2500 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2501 ldx VERDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2502 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2503 cmpa #0xac ; do we start with a -?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2504 beq L939E ; brif no starting coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2505 jsr L93B2 ; parse coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2506 L939E ldb #0xac ; make sure we have a -
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2507 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2508 jsr LB26A ; require a (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2509 jsr LB734 ; evaluate two expressions
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2510 ldy #HOREND ; point to storage location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2511 jsr L9303 ; process coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2512 bra L93B8 ; finish up with a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2513 L93B2 jsr LB26A ; make sure there's a (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2514 jsr L92FC ; evaluate coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2515 L93B8 jmp LB267 ; force a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2516 ; LINE command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2517 LINE cmpa #0x89 ; is it LINE INPUT?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2518 lbeq L89C0 ; brif so - go handle it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2519 cmpa #'( ; starting coord?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2520 beq L93CE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2521 cmpa #0xac ; leading -?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2522 beq L93CE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2523 ldb #'@ ; if it isn't the above, make sure it's @
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2524 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2525 L93CE jsr L938F ; parse coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2526 ldx HOREND ; set ending coordinates as the defaults
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2527 stx HORDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2528 ldx VEREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2529 stx VERDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2530 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2531 cmpa #0xbe ; PRESET?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2532 beq L93E9 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2533 cmpa #0xbd ; PSET?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2534 lbne LB277 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2535 ldb #01 ; PSET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2536 skip1lda ; skip byte and set A nonzero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2537 L93E9 clrb ; PRESET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2538 pshs b ; save PSET/PRESET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2539 jsr GETNCH ; eat the PSET/PRESET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2540 jsr L9420 ; normalize coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2541 puls b ; get back PSET/PRESET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2542 stb SETFLG ; flag which we're doing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2543 jsr L959A ; set colour byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2544 jsr GETCCH ; get next bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2545 lbeq L94A1 ; brif no box option
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2546 jsr SYNCOMMA ; make sure it's comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2547 ldb #'B ; make sure "B" for "box"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2548 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2549 bne L9429 ; brif something follows the B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2550 bsr L9444 ; draw horizontal line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2551 bsr L946E ; draw vertical line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2552 ldx HORBEG ; save horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2553 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2554 ldx HOREND ; switch in horizontal end
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2555 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2556 bsr L946E ; draw vertical line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2557 puls x ; get back original start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2558 stx HORBEG ; put it back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2559 ldx VEREND ; do the same dance with the vertical end
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2560 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2561 bra L9444 ; draw horizontal line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2562 L9420 jsr L931D ; normalize the start coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2563 ldu #HOREND ; point to end coords
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2564 jmp L9320 ; normalize those coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2565 L9429 ldb #'F ; make sure we have "BF" for "filled box"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2566 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2567 bra L9434 ; fill the box
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2568 L9430 leax -1,x ; move vertical coordinate up one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2569 L9432 stx VERBEG ; save new vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2570 L9434 jsr L9444 ; draw a horizontal line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2571 ldx VERBEG ; are we at the end of the box?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2572 cmpx VEREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2573 beq L9443 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2574 bcc L9430 ; brif we're moving up the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2575 leax 1,x ; move down the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2576 bra L9432 ; go draw another line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2577 L9443 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2578 ; Draw a horizontal line from HORBEG to HOREND at VERBEG using color mask in ALLCOL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2579 L9444 ldx HORBEG ; get starting horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2580 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2581 jsr L971D ; get absolute value of HOREND-HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2582 bcc L9451 ; brif end is > start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2583 ldx HOREND ; copy end coordinate to start it is smaller
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2584 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2585 L9451 tfr d,y ; save difference - it's a pixel count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2586 leay 1,y ; coordinates are inclusive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2587 jsr L9298 ; get screen position of start coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2588 puls u ; restore original start coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2589 stu HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2590 bsr L9494 ; point to routine to move pizel pointers to right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2591 L945E sta VD7 ; save pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2592 jsr L9377 ; turn on pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2593 lda VD7 ; get pixel mask back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2594 jsr ,u ; move one pixel right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2595 leay -1,y ; turned on enough pixels yet?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2596 bne L945E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2597 L946B rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2598 L946C puls b,a ; clean up stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2599 L946E ldd VERBEG ; save original vertical start coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2600 pshs b,a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2601 jsr L9710 ; get vertical difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2602 bcc L947B ; brif end coordinate > start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2603 ldx VEREND ; swap in end coordinate if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2604 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2605 L947B tfr d,y ; save number of pixels to set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2606 leay 1,y ; the coordinates are inclusive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2607 jsr L9298 ; get screen pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2608 puls u ; restore start coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2609 stu VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2610 bsr L949D ; point to routine to move down one row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2611 bra L945E ; draw vertical line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2612 ; Point to routine which will move one pixel right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2613 L948A fdb L92ED ; PMODE 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2614 fdb L92F4 ; PMODE 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2615 fdb L92ED ; PMODE 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2616 fdb L92F4 ; PMODE 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2617 fdb L92ED ; PMODE 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2618 L9494 ldu #L948A ; point to jump table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2619 ldb PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2620 aslb ; two bytes per address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2621 ldu b,u ; get jump address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2622 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2623 ; Point to routine to move down one row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2624 L949D ldu #L92E9 ; point to "move down one row" routien
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2625 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2626 ; Draw a line from HORBEG,VERBEG to HOREND,VEREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2627 L94A1 ldy #L950D ; point to increase vertical coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2628 jsr L9710 ; calculate difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2629 lbeq L9444 ; brif none - draw a horizontal line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2630 bcc L94B2 ; brif vertical end is > vertical start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2631 ldy #L951B ; point to decrease vertical coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2632 L94B2 pshs d ; save vertical difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2633 ldu #L9506 ; point to increase horizontal coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2634 jsr L971D ; get difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2635 beq L946C ; brif none - draw a vertical line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2636 bcc L94C1 ; brif horizontal end > horizontal start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2637 ldu #L9514 ; point to decrease hoizontal coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2638 L94C1 cmpd ,s ; compare vert and horiz differences
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2639 puls x ; get X difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2640 bcc L94CC ; brif horiz diff > vert diff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2641 exg u,y ; swap change routine pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2642 exg d,x ; swap differences
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2643 L94CC pshs u,d ; save larger difference and routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2644 pshs d ; save larger difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2645 lsra ; divide by two
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2646 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2647 bcs L94DD ; brif odd number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2648 cmpu #L950D+1 ; increase or decrease?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2649 blo L94DD ; brif increase
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2650 subd #1 ; back up one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2651 L94DD pshs x,b,a ; save smallest difference and initial middle offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2652 jsr L928F ; point to proper coordinate to screen conversion routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2653 L94E2 jsr ,u ; convert coordinates to screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2654 jsr L9377 ; turn on a pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2655 ldx 6,s ; get distnace counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2656 beq L9502 ; brif line is completely drawn
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2657 leax -1,x ; account for one pixel drawn
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2658 stx 6,s ; save new counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2659 jsr [8,s] ; increment/decrement larger delta
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2660 ldd ,s ; get the minor coordinate increment counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2661 addd 2,s ; add the smallest difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2662 std ,s ; save new minor coordinate incrementcounter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2663 subd 4,s ; subtractout the largest difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2664 bcs L94E2 ; brif not greater - draw another pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2665 std ,s ; save new minor coordinate increment
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2666 jsr ,y ; adjust minor coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2667 bra L94E2 ; go draw another pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2668 L9502 puls x ; clean up stack and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2669 puls a,b,x,y,u,pc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2670 L9506 ldx HORBEG ; bump horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2671 leax 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2672 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2673 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2674 L950D ldx VERBEG ; bump vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2675 leax 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2676 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2677 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2678 L9514 ldx HORBEG ; decrement horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2679 leax -1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2680 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2681 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2682 L951B ldx VERBEG ; decrement vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2683 leax -1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2684 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2685 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2686 ; Get normalized maximum coordinate values in VD3 and VD5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2687 L9522 ldu #VD3 ; point to temp storage
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2688 ldx #255 ; set maximum horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2689 stx ,u
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2690 ldx #191 ; set maximum vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2691 stx 2,u
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2692 jmp L9320 ; normalize them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2693 ; PCLS command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2694 PCLS beq L9542 ; clear to background colour if no argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2695 bsr L955A ; evaluate colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2696 L9536 lda #0x55 ; consider each byte as 4 groups of 2 bit sub-nibbles
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2697 mul ; now colour is in all four sub-pixels
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2698 ldx BEGGRP ; get start of graphics screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2699 L953B stb ,x+ ; set byte to proper colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2700 cmpx ENDGRP ; at end of graphics page?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2701 bne L953B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2702 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2703 L9542 ldb BAKCOL ; get background colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2704 bra L9536 ; do the clearing dance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2705 ; COLOR command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2706 COLOR cmpa #', ; check for comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2707 beq L9552 ; brif no foreground colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2708 bsr L955A ; evaluate first colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2709 stb FORCOL ; set foreground colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2710 jsr GETCCH ; is there a background colour?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2711 beq L9559 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2712 L9552 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2713 bsr L955A ; evaluate background colour argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2714 stb BAKCOL ; set background colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2715 L9559 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2716 ; Evaluate a colour agument and convert to proper code based on graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2717 L955A jsr EVALEXPB ; evaluate colour code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2718 L955D cmpb #9 ; is it in range of 0-8?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2719 lbhs LB44A ; brif not - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2720 clra ; CSS value for first colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2721 cmpb #5 ; is it first or second colour set?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2722 blo L956C ; brif first colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2723 lda #8 ; flag second colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2724 subb #4 ; adjust into basic range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2725 L956C pshs a ; save CSS value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2726 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2727 rora ; 4 colour or 2?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2728 bcc L957B ; brif 2 colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2729 tstb ; was it 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2730 bne L9578 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2731 L9576 ldb #4 ; if so, make it 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2732 L9578 decb ; convert to zero based
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2733 L9579 puls a,pc ; get back CSS value and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2734 L957B rorb ; is colour number odd?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2735 bcs L9576 ; brif so - force all bits set colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2736 clrb ; force colour 0 if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2737 bra L9579
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2738 ; Set all pixel byte and active colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2739 L9581 jsr L959A ; set colour byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2740 jsr GETCCH ; is there something to evaluate?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2741 beq L9598 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2742 cmpa #') ; )?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2743 beq L9598 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2744 jsr SYNCOMMA ; force comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2745 cmpa #', ; another comma?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2746 beq L9598 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2747 jsr L955A ; evaluate expression and return colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2748 bsr L95A2 ; save colour and pixel byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2749 L9598 jmp GETCCH ; re-fetch input character and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2750 L959A ldb FORCOL ; use foreground colour by default
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2751 tst SETFLG ; doing PRESET?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2752 bne L95A2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2753 ldb BAKCOL ; default to background colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2754 L95A2 stb WCOLOR ; save working colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2755 lda #0x55 ; consider a byte as 4 pixels
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2756 mul ; now all pixels are set to the same bit pattern
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2757 stb ALLCOL ; set all pixels byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2758 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2759 L95AA bne L95CF ; brif graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2760 L95AC pshs x,b,a ; save registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2761 ldx #SAMREG+8 ; point to middle of control register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2762 sta 10,x ; reset display page to 0x400
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2763 sta 8,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2764 sta 6,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2765 sta 4,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2766 sta 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2767 sta 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2768 sta -2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2769 sta -4,x ; reset to alpha mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2770 sta -6,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2771 sta -8,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2772 lda PIA1+2 ; set VDG to alpha mode, colour set 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2773 anda #7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2774 sta PIA1+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2775 puls a,b,x,pc ;restore registers and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2776 L95CF pshs x,b,a ; save registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2777 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2778 adda #3 ; offset to 3-7 (we don't use the bottom 3 modes)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2779 ldb #0x10 ; shift to high 4 bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2780 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2781 orb #0x80 ; set to graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2782 orb CSSVAL ; set the desired colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2783 lda PIA1+2 ; get get original PIA values
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2784 anda #7 ; mask off VDG control
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2785 pshs a ; merge with new VDG control
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2786 orb ,s+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2787 stb PIA1+2 ; set new VDG mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2788 lda BEGGRP ; get start of graphics page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2789 lsra ; divide by two - pages are on 512 byte boundaries
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2790 jsr L960F ; set SAM control register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2791 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2792 adda #3 ; shift to VDG values
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2793 cmpa #7 ; PMODE 4?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2794 bne L95F7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2795 deca ; treat PMODE 4 the same as PMODE 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2796 L95F7 bsr L95FB ; program SAM's VDG bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2797 puls a,b,x,pc ; restore registers and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2798 L95FB ldb #3 ; set 3 bits in register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2799 ldx #SAMREG ; point to VDG control bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2800 L9600 rora ; get bit to set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2801 bcc L9607 ; brif we need to clear the bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2802 sta 1,x ; set the bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2803 bra L9609
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2804 L9607 sta ,x ; clear the bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2805 L9609 leax 2,x ; move to next bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2806 decb ; done all bits?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2807 bne L9600 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2808 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2809 L960F ldb #7 ; 7 screen address bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2810 ldx #SAMREG+6 ; point to screen address bits in SAM
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2811 bra L9600 ; go program SAM bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2812 L9616 lda PIA1+2 ; get VDG bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2813 anda #0xf7 ; keep everything but CSS bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2814 ora CSSVAL ; set correct CSS bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2815 sta PIA1+2 ; set desired CSS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2816 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2817 ; PMODE command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2818 PMODETOK cmpa #', ; is first argument missing?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2819 beq L9650 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2820 jsr EVALEXPB ; evaluate PMODE number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2821 cmpb #5 ; valid (0-4)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2822 bhs L966D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2823 lda GRPRAM ; get start of graphics memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2824 L962E sta BEGGRP ; set start of graphics page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2825 aslb ; multiply mode by two (table has two bytes per entry)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2826 ldu #L9706+1 ; point to lookup table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2827 adda b,u ; add in number of 256 byte pages used for graphics screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2828 cmpa TXTTAB ; does it fit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2829 bhi L966D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2830 sta ENDGRP ; save end of graphics
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2831 leau -1,u ; point to bytes per horizontal row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2832 lda b,u ; get bytes per row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2833 sta HORBYT ; set it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2834 lsrb ; restore PMODE value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2835 stb PMODE ; set graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2836 clra ; set background colour to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2837 sta BAKCOL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2838 lda #3 ; set foreground colour to maximum (3)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2839 sta FORCOL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2840 jsr GETCCH ; is there a starting page number?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2841 beq L966C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2842 L9650 jsr LB738 ; evaluate an expression following a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2843 tstb ; page 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2844 beq L966D ; brif so - not valid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2845 decb ; zero-base it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2846 lda #6 ; each graphics page is 6*256
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2847 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2848 addb GRPRAM ; add to start of graphics memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2849 pshs b ; save start of screen memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2850 addb ENDGRP ; add current and address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2851 subb BEGGRP ; subtract current start (adds size of screen)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2852 cmpb TXTTAB ; does it fit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2853 bhi L966D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2854 stb ENDGRP ; save new end of graphics
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2855 puls b ; get back start of graphics
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2856 stb BEGGRP ; set start of graphics
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2857 L966C rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2858 L966D jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2859 ; SCREEN command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2860 SCREEN cmpa #', ; is there a mode?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2861 beq L967F ; brif no mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2862 jsr EVALEXPB ; get mode argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2863 tstb ; set Z if alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2864 jsr L95AA ; set SAM/VDG for graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2865 jsr GETCCH ; is there a second argument?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2866 beq L966C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2867 L967F jsr LB738 ; evaluate ,<expr>
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2868 tstb ; colour set 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2869 beq L9687 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2870 ldb #8 ; flag for colour set 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2871 L9687 stb CSSVAL ; set colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2872 bra L9616 ; set up VDG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2873 ; PCLEAR command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2874 PCLEAR jsr EVALEXPB ; evaulate number of pages requested
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2875 tstb ; 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2876 beq L966D ; brif zero - not allowed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2877 cmpb #9 ; more than 8?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2878 bhs L966D ; brif so - not allowed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2879 lda #6 ; there are 6 "pages" per graphics page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2880 mul ; now B is the number of pages to reserve
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2881 addb GRPRAM ; add to start of graphics memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2882 tfr b,a ; now A is the MSB of the start of free memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2883 ldb #1 ; program memory always starts one above
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2884 tfr d,y ; save pointer to program memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2885 cmpd ENDGRP ; are we trying to deallocate the current graphics page?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2886 blo L966D ; brif so (note that this prevents PCLEAR 0 anyway)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2887 subd TXTTAB ; subtract out current start of basic program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2888 addd VARTAB ; add in end of program - now D is new top of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2889 tfr d,x ; save new end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2890 inca ; make some extra space (for stack)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2891 subd FRETOP ; see if new top of program fits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2892 bhs L966D ; brif there isn't enough space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2893 jsr L80D0 ; adjust input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2894 nop ; space filler for 1.1 patch (the JSR above)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2895 ldu VARTAB ; get end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2896 stx VARTAB ; save new end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2897 cmpu VARTAB ; is old end higher?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2898 bhs L96D4 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2899 L96BD lda ,-u ; copy a byte upward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2900 sta ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2901 cmpu TXTTAB ; at beginning?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2902 bne L96BD ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2903 sty TXTTAB ; save new start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2904 clr -1,y ; there must always be a NUL before the program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2905 L96CB jsr LACEF ; re-assign basic program addresses
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2906 jsr LAD26 ; reset variables and stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2907 jmp LAD9E ; return to interpretation loop
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2908 L96D4 ldu TXTTAB ; get start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2909 sty TXTTAB ; save new start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2910 clr -1,y ; there must be a NUL at the start of the program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2911 L96DB lda ,u+ ; move a byte downward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2912 sta ,y+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2913 cmpy VARTAB ; at the top of the program?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2914 bne L96DB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2915 bra L96CB ; finish up
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2916 ; Graphics initialization routine - this really should be up at the start of the ROM with the
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2917 ; rest of the initialization code.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2918 L96E6 ldb #0x1e ; set start of program to 0x1e00 ("PCLEAR 4")
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2919 stb TXTTAB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2920 lda #6 ; graphics memory starts immediately after the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2921 L96EC sta GRPRAM ; set graphics memory start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2922 sta BEGGRP ; set start of current graphics page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2923 clra ; set PMODE to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2924 sta PMODE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2925 lda #16 ; 16 bytes per graphics row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2926 sta HORBYT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2927 lda #3 ; set foreground colour to 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2928 sta FORCOL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2929 lda #0x0c ; set ending graphics page (for PMODE 0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2930 sta ENDGRP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2931 ldx TXTTAB ; get start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2932 clr -1,x ; make sure there's a NUL before it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2933 L9703 jmp LAD19 ; do a "NEW"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2934 ; PMODE data table (bytes per row and number of 256 byte pages required for a screen)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2935 L9706 fcb 16,6 ; PMODE 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2936 fcb 32,12 ; PMODE 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2937 fcb 16,12 ; PMODE 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2938 fcb 32,24 ; PMODE 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2939 fcb 32,24 ; PMODE 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2940 ; Calculate absolute value of vertical coordinate difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2941 L9710 ldd VEREND ; get ending address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2942 subd VERBEG ; get difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2943 L9714 bcc L9751 ; brif we didn't carry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2944 pshs cc ; save status (C set if start > end)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2945 jsr L9DC3 ; negate the difference to be positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2946 puls cc,pc ; restore C and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2947 ; Calculate absolute value of horizontal coordinate difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2948 L971D ldd HOREND ; get end coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2949 subd HORBEG ; calculate difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2950 bra L9714 ; turn into absolute value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2951 ; PCOPY command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2952 PCOPY bsr L973F ; fetch address of the source page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2953 pshs d ; save address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2954 ldb #0xa5 ; make sure we have TO
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2955 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2956 bsr L973F ; fetch address of the second page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2957 puls x ; get back source
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2958 tfr d,u ; put destination into a pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2959 ldy #0x300 ; 0x300 words to copy
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2960 L9736 ldd ,x++ ; copy a word
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2961 std ,u++
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2962 leay -1,y ; done?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2963 bne L9736 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2964 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2965 L973F jsr EVALEXPB ; evaluate page number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2966 tstb ; zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2967 beq L9752 ; brif invalid page number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2968 ; BUG: this should be deferred until after the address is calculated at which point it should
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2969 ; be bhs instead of bhi. There should also be a check to make sure the page number is less than
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2970 ; or equal to 8 above so we don't have to test for overflows below.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2971 cmpb TXTTAB ; is page number higher than start of program (BUG!)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2972 bhi L9752 ; brif so - error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2973 decb ; zero-base the page number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2974 lda #6 ; 6 "pages" per graphics page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2975 mul ; now we have proper number of "pages" for the offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2976 addb GRPRAM ; add start of graphics memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2977 exg a,b ; put MSB into A, 0 into B.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2978 L9751 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2979 L9752 jmp LB44A ; raise illegal function call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2980 ; GET command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2981 GET clrb ; GET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2982 bra L975A ; go on to the main body
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2983 PUT ldb #1 ; PUT flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2984 L975A stb VD8 ; save GET/PUT flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2985 jsr RVEC22 ; do the RAM hook dance (so Disk Basic can do its thing)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2986 L975F cmpa #'@ ; @ before coordinates?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2987 bne L9765 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2988 jsr GETNCH ; eat the @
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2989 L9765 jsr L938F ; evaluate start/end coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2990 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2991 jsr L98CC ; get pointer to array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2992 tfr X,D ; save descriptor pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2993 ldu ,x ; get offset to next descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2994 leau -2,u ; move back to array name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2995 leau d,u ; point to end of array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2996 stu VD1 ; save end of data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2997 leax 2,x ; point to number of dimensions
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2998 ldb ,x ; get dimension count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2999 aslb ; two bytes per dimension size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3000 abx ; now X points to start of data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3001 stx VCF ; save start of array data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3002 lda VALTYP ; is it numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3003 bne L9752 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3004 clr VD4 ; set default graphic action to PSET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3005 jsr GETCCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3006 beq L97B7 ; brif no action flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3007 com VD4 ; flag action enabled
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3008 jsr SYNCOMMA ; make sure there's a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3009 tst VD8 ; PUT?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3010 bne L979A ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3011 ldb #'G ; check for full graphics option
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3012 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3013 bra L97CA ; handle the rest of the process
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3014 L979A ldb #5 ; 5 legal actions for PUT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3015 ldx #L9839 ; point to action table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3016 L979F ldu ,x++ ; get "clear bit" action routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3017 ldy ,x++ ; get "set bit" action routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3018 cmpa ,x+ ; does token match?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3019 beq L97AE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3020 decb ; checked all?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3021 bne L979F ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3022 jmp LB277 ; raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3023 L97AE sty VD5 ; save set bit action address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3024 stu VD9 ; save clear bit action address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3025 jsr GETNCH ; munch the acton token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3026 bra L97CA ; handle rest of process
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3027 L97B7 ldb #0xf8 ; mask for bottom three bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3028 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3029 rora ; odd number mode?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3030 bcc L97C0 ; brif even
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3031 ldb #0xfc ; bottom 2 bits mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3032 L97C0 tfr b,a ; save mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3033 andb HORBEG+1 ; round down the start address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3034 stb HORBEG+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3035 anda HOREND+1 ; round down end address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3036 sta HOREND+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3037 L97CA jsr L971D ; get horizontal size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3038 bcc L97D3 ; brif end > start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3039 ldx HOREND ; switch end in for start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3040 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3041 L97D3 std HOREND ; save size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3042 jsr L9710 ; calculate vertical size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3043 bcc L97DE ; brif end > start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3044 ldx VEREND ; swap in vertical end for the start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3045 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3046 L97DE std VEREND ; save vertical size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3047 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3048 rora ; even?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3049 ldd HOREND ; get difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3050 bcc L97EB ; brif even (2 colour)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3051 addd HOREND ; add in size (double it)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3052 std HOREND ; save adjusted end size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3053 L97EB jsr L9420 ; normalize differences
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3054 ldd HOREND ; get end coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3055 ldx VEREND ; get end size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3056 leax 1,x ; make vertical size inclusive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3057 stx VEREND ; save it back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3058 tst VD4 ; got "G" or GET action
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3059 bne L9852 ; brif given
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3060 lsra ; we're going for whole bytes here
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3061 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3062 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3063 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3064 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3065 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3066 addd #1 ; make it inclusive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3067 std HOREND ; save new coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3068 jsr L9298 ; convert to screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3069 L9808 ldb HOREND+1 ; get horizontal size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3070 pshs x ; save screen position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3071 L980C tst VD8 ; get/put flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3072 beq L9831 ; brif get
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3073 bsr L9823 ; bump array data pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3074 lda ,u ; copy data from array to screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3075 sta ,x+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3076 L9816 decb ; are we done the row?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3077 bne L980C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3078 puls x ; get screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3079 jsr L92E9 ; move to next row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3080 dec VEREND+1 ; done?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3081 bne L9808 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3082 L9822 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3083 L9823 ldu VCF ; get array data location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3084 leau 1,u ; bump it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3085 stu VCF ; save new array data location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3086 cmpu VD1 ; did we hit the end of the array?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3087 bne L9822 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3088 L982E jmp LB44A ; raise function call error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3089 L9831 lda ,x+ ; get data from screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3090 bsr L9823 ; bump array data pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3091 sta ,u ; put data in array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3092 bra L9816 ; do the loopy thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3093 ; PUT actions
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3094 L9839 fdb L9894,L989B ; PSET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3095 fcb 0xbd
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3096 fdb L989B,L9894 ; PRESET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3097 fcb 0xbe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3098 fdb L98B1,L989B ; OR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3099 fcb 0xb1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3100 fdb L9894,L98B1 ; AND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3101 fcb 0xb0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3102 fdb L98A1,L98A1 ; NOT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3103 fcb 0xa8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3104 L9852 addd #1 ; add to horiz difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3105 std HOREND ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3106 lda VD8 ; PUT?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3107 bne L9864 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3108 ldu VD1 ; get end of array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3109 L985D sta ,-u ; zero out a byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3110 cmpu VCF ; done?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3111 bhi L985D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3112 L9864 jsr L9298 ; get screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3113 ldb PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3114 rorb ; even?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3115 bcc L986E ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3116 anda #0xaa ; use as pixel mask for 4 colour mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3117 L986E ldb #1 ; set bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3118 ldy VCF ; point to start of array data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3119 L9873 pshs x,a ; save screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3120 ldu HOREND ; get horizontal size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3121 L9877 pshs u,a ; save horizontal size and pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3122 lsrb ; move bit probe right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3123 bcc L9884 ; brif we didn't fall off a byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3124 rorb ; shift carry back in on the left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3125 leay 1,y ; move ahead a byte in the array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3126 cmpy VD1 ; end of array data?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3127 beq L982E ; raise error if so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3128 L9884 tst VD8 ; PUT?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3129 beq L98A7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3130 bitb ,y ; test bit in array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3131 beq L9890 ; brif not set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3132 jmp [VD5] ; do action routine for bit set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3133 L9890 jmp [VD9] ; do action routine for bit clear
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3134 L9894 coma ; invert mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3135 anda ,x ; read screen data and reset the desired bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3136 sta ,x ; save on screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3137 bra L98B1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3138 L989B ora ,x ; merge pixel mask with screen data (turn on bit)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3139 sta ,x ; save on screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3140 bra L98B1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3141 L98A1 eora ,x ; invert the pixel in the screen data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3142 sta ,x ; save on screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3143 bra L98B1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3144 L98A7 bita ,x ; is the bit set?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3145 beq L98B1 ; brif not - do nothing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3146 tfr b,a ; get bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3147 ora ,y ; turn on proper bit in data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3148 sta ,y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3149 L98B1 puls a,u ; get back array address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3150 jsr L92ED ; move screen address to the right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3151 leau -1,u ; account for consumed pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3152 cmpu ZERO ; done yet?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3153 bne L9877 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3154 ldx 1,s ; get start of row back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3155 lda HORBYT ; get number of bytes per row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3156 leax a,x ; move ahead one line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3157 puls a ; get back screen pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3158 leas 2,s ; lose the screen pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3159 dec VEREND+1 ; done all rows?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3160 bne L9873 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3161 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3162 L98CC jsr LB357 ; evaluate a variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3163 ldb ,-x ; get variable name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3164 lda ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3165 tfr d,u ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3166 ldx ARYTAB ; get start of arrays
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3167 L98D7 cmpx ARYEND ; end of arrays?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3168 lbeq LB44A ; brif not found
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3169 cmpu ,x ; correct variable?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3170 beq L98E8 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3171 ldd 2,x ; get array size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3172 leax d,x ; move to next array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3173 bra L98D7 ; check this array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3174 L98E8 leax 2,x ; move pointer to the array header
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3175 rts ; obviously this rts is not needed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3176 L98EB rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3177 ; PAINT command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3178 PAINT cmpa #'@ ; do we have @ before coords?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3179 bne L98F2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3180 jsr GETNCH ; eat the @
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3181 L98F2 jsr L93B2 ; evaluate coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3182 jsr L931D ; normalize coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3183 lda #1 ; PSET flag (use working colour)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3184 sta SETFLG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3185 jsr L9581 ; parse colour and set working colour, etc.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3186 ldd WCOLOR ; get working colour and all pixels byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3187 pshs d ; save them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3188 jsr GETCCH ; is there anything else?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3189 beq L990A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3190 jsr L9581 ; evaluate border colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3191 L990A lda ALLCOL ; get border colour all pixel byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3192 sta VD8 ; save border colour pixel byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3193 puls d ; get back working colour details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3194 std WCOLOR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3195 clra ; store a "stop" frame on the stack so PAINT knows when it's finished unwinding
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3196 pshs u,x,b,a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3197 jsr L9522 ; set up starting coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3198 jsr L928F ; point to pixel mask routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3199 stu VD9 ; save pixel mask routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3200 jsr L99DF ; paint from current horizontal coordinate to zero (left)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3201 beq L9931 ; brif hit border immediately
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3202 jsr L99CB ; paint from current horizontal coordinate upward (right)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3203 lda #1 ; set direction to "down"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3204 sta VD7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3205 jsr L99BA ; save "down" frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3206 neg VD7 ; set direction to "up"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3207 jsr L99BA ; save "up" frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3208 L9931 sts TMPSTK ; save stack pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3209 L9934 tst CHGFLG ; did the paint change anything?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3210 bne L993B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3211 lds TMPSTK ; get back stack pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3212 L993B puls a,b,x,u ; get frame from stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3213 clr CHGFLG ; mark nothing changed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3214 sts TMPSTK ; save stack pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3215 leax 1,x ; move start coordinate right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3216 stx HORBEG ; save new coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3217 stu VD1 ; save length of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3218 sta VD7 ; save up/down flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3219 beq L98EB ; did we hit the "stop" frame?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3220 bmi L9954 ; brif negative going (up)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3221 incb ; bump vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3222 cmpb VD6 ; at end?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3223 bls L9958 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3224 clrb ; set vertical to 0 (wrap around)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3225 L9954 tstb ; did we wrap?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3226 beq L9934 ; do another block if so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3227 decb ; move up a row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3228 L9958 stb VERBEG+1 ; save vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3229 jsr L99DF ; paint from horizontal to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3230 beq L996E ; brif we hit the border immediately
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3231 cmpd #3 ; less than 3 pixels?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3232 blo L9969 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3233 leax -2,x ; move two pixels left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3234 bsr L99A1 ; save paint block on the stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3235 L9969 jsr L99CB ; continue painting to the right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3236 L996C bsr L99BA ; save paint data frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3237 L996E coma ; complement length of line just painted and add to length of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3238 comb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3239 L9970 addd VD1 ; save difference between this line and parent line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3240 std VD1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3241 ble L998C ; brif parent line is shorter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3242 jsr L9506 ; bump horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3243 jsr L9A12 ; see if we bounced into the border
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3244 bne L9983 ; brif not border
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3245 ldd #-1 ; move left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3246 bra L9970 ; keep looking
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3247 L9983 jsr L9514 ; move horizontally left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3248 bsr L99C6 ; save horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3249 bsr L99E8 ; paint right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3250 bra L996C ; save paint block and do more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3251 L998C jsr L9506 ; bump horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3252 leax d,x ; point to right end of parent line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3253 stx HORBEG ; set as curent coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3254 coma ; get amount we extend past parent line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3255 comb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3256 subd #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3257 ble L999E ; brif doesn't extend
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3258 tfr d,x ; save length of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3259 bsr L99A1 ; save paint frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3260 L999E jmp L9934
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3261 L99A1 std VCB ; save number of pixels painted
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3262 puls y ; get return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3263 ldd HORBEG ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3264 pshs x,b,a ; save horizontal coordinate and pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3265 lda VD7 ; get up/down flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3266 nega ; reverse it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3267 L99AC ldb VERBEG+1 ; get vertical coordainte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3268 pshs b,a ; save vertical coord and up/down flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3269 pshs y ; put return address back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3270 ldb #2 ; make sure we haven't overflowed memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3271 jsr LAC33
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3272 ldd VCB ; get line length back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3273 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3274 L99BA std VCB ; save length of painted line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3275 puls y ; get return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3276 ldd HOREND ; get start coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3277 pshs x,b,a ; save horizontal start and length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3278 lda VD7 ; get up/down flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3279 bra L99AC ; finish up with the stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3280 L99C6 ldx HORBEG ; save current horizontal coord and save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3281 stx HOREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3282 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3283 L99CB std VCD ; save number of pixels painted
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3284 ldy HOREND ; get last horizontal start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3285 bsr L99C6 ; save current coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3286 sty HORBEG ; save coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3287 bsr L99E8 ; paint a line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3288 ldx VCD ; get number painted
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3289 leax d,x ; add to the number painted going the other way
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3290 addd #1 ; now D is length of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3291 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3292 L99DF jsr L99C6 ; put starting coordinate in end
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3293 ldy #L9514 ; decrement horizontal coordinate address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3294 bra L99EE ; go paint line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3295 L99E8 ldy #L9506 ; increment horizontal coordinate address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3296 jsr ,y ; bump coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3297 L99EE ldu ZERO ; initialize pixel count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3298 ldx HORBEG ; get starting coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3299 L99F2 bmi L9A0B ; brif out of range for hoizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3300 cmpx VD3 ; at end?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3301 bhi L9A0B ; brif right of max
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3302 pshs u,y ; save counter and inc/dec routine pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3303 bsr L9A12 ; at border?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3304 beq L9A09 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3305 jsr L9377 ; set pixel to paint colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3306 puls y,u ; restore counter and inc/dec/pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3307 leau 1,u ; bump number of painted pixels
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3308 jsr ,y ; inc/dec screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3309 bra L99F2 ; go do another pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3310 L9A09 puls y,u ; get back counter and inc/dec routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3311 L9A0B tfr u,d ; save count in D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3312 tfr d,x ; and in X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3313 subd ZERO ; set flags on D (smaller/faster than cmpd ZERO)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3314 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3315 L9A12 jsr [VD9] ; get the screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3316 tfr a,b ; save pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3317 andb VD8 ; set pixel to border colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3318 pshs b,a ; save mask and border
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3319 anda ,x ; mask current pixel into A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3320 cmpa 1,s ; does it match border? Z=1 if so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3321 puls a,b,pc ; restore mask, border pixel, and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3322 ; PLAY command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3323 ; This is here mixed in with the graphics package because it shares some machinery with DRAW.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3324 PLAY ldx ZERO ; default values for note length, etc.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3325 ldb #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3326 pshs x,b ; save default values
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3327 jsr LB156 ; evaluate argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3328 clrb ; enable DA and sound output
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3329 jsr LA9A2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3330 jsr LA976
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3331 L9A32 jsr LB654 ; fetch PLAY string details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3332 bra L9A39 ; go evaluate the string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3333 L9A37 puls b,x ; get back play string details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3334 L9A39 stb VD8 ; save length of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3335 beq L9A37 ; brif end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3336 stx VD9 ; save start of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3337 lbeq LA974 ; brif NULL string - disable sound and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3338 L9A43 tst VD8 ; have anything left?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3339 beq L9A37 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3340 jsr L9B98 ; get command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3341 cmpa #'; ; command separator?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3342 beq L9A43 ; brif so - ignore it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3343 cmpa #'' ; '?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3344 beq L9A43 ; brif so - ignore it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3345 cmpa #'X ; execuate sub string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3346 lbeq L9C0A ; brif so - handle it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3347 bsr L9A5C ; handle other commands
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3348 bra L9A43 ; look for more stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3349 L9A5C cmpa #'O ; octave?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3350 bne L9A6D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3351 ldb OCTAVE ; get current octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3352 incb ; 1-base it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3353 bsr L9AC0 ; get value if present
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3354 decb ; zero-base it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3355 cmpb #4 ; valid octave?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3356 bhi L9ACD ; raise error if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3357 stb OCTAVE ; save new octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3358 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3359 L9A6D cmpa #'V ; volume?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3360 bne L9A8B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3361 ldb VOLHI ; get current high volume limit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3362 lsrb ; shift 2 bits right (DA is 6 bits in high bits)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3363 lsrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3364 subb #31 ; subtract out mid value offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3365 bsr L9AC0 ; read argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3366 cmpb #31 ; maximum range is 31
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3367 bhi L9ACD ; brif out of range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3368 aslb ; adjust back in range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3369 aslb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3370 pshs b ; save new volume
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3371 ldd #0x7e7e ; midrange value for both high and low
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3372 adda ,s ; add new volume to high limit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3373 subb ,s+ ; subtract volume from low limit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3374 std VOLHI ; save new volume limits (sets high and low amplitudes)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3375 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3376 L9A8B cmpa #'L ; note length?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3377 bne L9AB2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3378 ldb NOTELN ; get current length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3379 bsr L9AC0 ; read parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3380 tstb ; resulting length 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3381 beq L9ACD ; brif so - problem
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3382 stb NOTELN ; save new length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3383 clr DOTVAL ; reset note timer scale factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3384 L9A9A bsr L9A9F ; check for dot
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3385 bcc L9A9A ; brif there was one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3386 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3387 L9A9F tst VD8 ; check length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3388 beq L9AAD ; brif zero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3389 jsr L9B98 ; get command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3390 cmpa #'. ; dot?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3391 beq L9AAF ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3392 jsr L9BE2 ; move input back and bump length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3393 L9AAD coma ; set C to indicate nothing found
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3394 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3395 L9AAF inc DOTVAL ; bump number of dots
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3396 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3397 L9AB2 cmpa #'T ; tempo?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3398 bne L9AC3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3399 ldb TEMPO ; get current tempo
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3400 bsr L9AC0 ; parse tempo argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3401 tstb ; 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3402 beq L9ACD ; brif so - invalid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3403 stb TEMPO ; save new tempo
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3404 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3405 L9AC0 jmp L9BAC ; evaluate various operators
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3406 L9AC3 cmpa #'P ; pause?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3407 bne L9AEB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3408 jsr L9CCB ; evaluate parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3409 tstb ; is the pause number 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3410 bne L9AD0 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3411 L9ACD jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3412 L9AD0 lda DOTVAL ; save current volume and note scale
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3413 ldx VOLHI
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3414 pshs x,a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3415 lda #0x7e ; drop DA to mid range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3416 sta VOLHI
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3417 sta VOLLOW
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3418 clr DOTVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3419 bsr L9AE7 ; go play a "silence"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3420 puls a,x ; restore volume and note scale
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3421 sta DOTVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3422 stx VOLHI
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3423 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3424 L9AE7 clr ,-s ; set not number 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3425 bra L9B2B ; go play it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3426 L9AEB cmpa #'N ; N for "note"?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3427 bne L9AF2 ; brif not - it's optional
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3428 jsr L9B98 ; skip the "N"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3429 L9AF2 cmpa #'A ; is it a valid note?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3430 blo L9AFA ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3431 cmpa #'G ; is it above the note range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3432 bls L9AFF ; brif not - valid note
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3433 L9AFA jsr L9BBE ; evaluate a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3434 bra L9B22 ; process note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3435 L9AFF suba #'A ; normalize note number to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3436 ldx #L9C5B ; point to note number lookup table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3437 ldb a,x ; get not number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3438 tst VD8 ; any command characters left?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3439 beq L9B22 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3440 jsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3441 cmpa #'# ; sharp?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3442 beq L9B15 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3443 cmpa #'+ ; also sharp?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3444 bne L9B18 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3445 L9B15 incb ; add one half tone
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3446 bra L9B22
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3447 L9B18 cmpa #'- ; flat?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3448 bne L9B1F ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3449 decb ; subtract one half tone
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3450 bra L9B22
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3451 L9B1F jsr L9BE2 ; back up command pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3452 L9B22 decb ; adjust note number (zero base it)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3453 cmpb #11 ; is it valid?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3454 bhi L9ACD ; raise error if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3455 pshs b ; save note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3456 ldb NOTELN ; get note length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3457 L9B2B lda TEMPO ; get tempo value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3458 mul ; calculate note duration
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3459 std VD5 ; save duration
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3460 leau 1,s ; point to where the stack goes after we're done
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3461 lda OCTAVE ; get current octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3462 cmpa #1 ; 0 or 1?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3463 bhi L9B64 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3464 ldx #L9C62 ; point to delay table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3465 ldb #2*12 ; 24 bytes per octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3466 mul ; now we have the base address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3467 abx ; now X points to the octave base
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3468 puls b ; get back note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3469 aslb ; two bytes per delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3470 abx ; now we're pointing to the delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3471 leay ,x ; save pointer to note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3472 bsr L9B8C ; calculate note timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3473 std PLYTMR ; set timer for note playing (IRQ will count this down)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3474 L9B49 bsr L9B57 ; set to mid range and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3475 lda VOLHI ; get high value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3476 bsr L9B5A ; set to high value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3477 bsr L9B57 ; set to mid range and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3478 lda VOLLOW ; get low value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3479 bsr L9B5A ; set to low value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3480 bra L9B49 ; do it again (IRQ will break the loop)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3481 L9B57 lda #0x7e ; mid value for DA with RS232 marking
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3482 nop ; a delay to fine tune frequencies
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3483 L9B5A sta PIA1 ; set DA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3484 ldx ,y ; get delay value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3485 L9B5F leax -1,x ; count down
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3486 bne L9B5F ; brif not done yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3487 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3488 L9B64 ldx #L9C92-2*12 ; point to delay table for octaves 2+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3489 ldb #12 ; 12 bytes per octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3490 mul ; now we have the offset to the desired octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3491 abx ; now we point to the start of the octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3492 puls b ; get back note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3493 abx ; now we point to the delay value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3494 bsr L9B8C ; calculate timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3495 std PLYTMR ; set play timer (IRQ counts this down)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3496 L9B72 bsr L9B80 ; send mid value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3497 lda VOLHI ; get high value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3498 bsr L9B83 ; send high value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3499 bsr L9B80 ; send low value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3500 lda VOLLOW ; get low value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3501 bsr L9B83 ; send low value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3502 bra L9B72 ; do it again (IRQ will break the loop)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3503 L9B80 lda #0x7e ; mid range value with RS232 marking
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3504 nop ; fine tuning delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3505 L9B83 sta PIA1 ; set DA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3506 lda ,x ; get delay value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3507 L9B88 deca ; count down
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3508 bne L9B88 ; brif not done
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3509 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3510 L9B8C ldb #0xff ; base timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3511 lda DOTVAL ; get number of dots
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3512 beq L9B97 ; use default value if 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3513 adda #2 ; add in constant timer factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3514 mul ; multiply scale by base
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3515 lsra ; divide by two - each increment will increase note timer by 128
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3516 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3517 L9B97 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3518 L9B98 pshs x ; save register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3519 L9B9A tst VD8 ; do we have anything left?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3520 beq L9BEB ; brif not - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3521 ldx VD9 ; get parsing address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3522 lda ,x+ ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3523 stx VD9 ; save pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3524 dec VD8 ; account for character consumed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3525 cmpa #0x20 ; space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3526 beq L9B9A ; brif so - skip it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3527 puls x,pc ; restore register and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3528 L9BAC bsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3529 cmpa #'+ ; add one?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3530 beq L9BEE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3531 cmpa #'- ; subtract one?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3532 beq L9BF2 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3533 cmpa #'> ; double?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3534 beq L9BFC ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3535 cmpa #'< ; halve?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3536 beq L9BF7 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3537 L9BBE cmpa #'= ; variable equate?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3538 beq L9C01 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3539 jsr L90AA ; clear carry if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3540 bcs L9BEB ; brif not numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3541 clrb ; initialize value to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3542 L9BC8 suba #'0 ; remove ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3543 sta VD7 ; save digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3544 lda #10 ; make room for digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3545 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3546 tsta ; did we overflow 8 bits?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3547 bne L9BEB ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3548 addb VD7 ; add in digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3549 bcs L9BEB ; brif that overflowed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3550 tst VD8 ; more digits?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3551 beq L9BF1 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3552 jsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3553 jsr L90AA ; clear carry if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3554 bcc L9BC8 ; brif another digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3555 L9BE2 inc VD8 ; unaccount for character just read
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3556 ldx VD9 ; move pointer back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3557 leax -1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3558 stx VD9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3559 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3560 L9BEB jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3561 L9BEE incb ; bump param
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3562 beq L9BEB ; brif overflow
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3563 L9BF1 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3564 L9BF2 tstb ; already zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3565 beq L9BEB ; brif so - underflow
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3566 decb ; decrease parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3567 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3568 L9BF7 tstb ; already at 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3569 beq L9BEB ; brif so - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3570 lsrb ; halve it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3571 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3572 L9BFC tstb ; will it overflow?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3573 bmi L9BEB ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3574 aslb ; double it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3575 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3576 L9C01 pshs u,y ; save registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3577 bsr L9C1B ; interpret command string as a variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3578 jsr LB70E ; convert it to an 8 bit number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3579 puls y,u,pc ; restore registers and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3580 L9C0A jsr L9C1B ; evaluate expression in command string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3581 ldb #2 ; room for 4 bytes?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3582 jsr LAC33
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3583 ldb VD8 ; get the command length and pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3584 ldx VD9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3585 pshs x,b ; save them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3586 jmp L9A32 ; go process the sub string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3587 L9C1B ldx VD9 ; get command pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3588 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3589 jsr L9B98 ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3590 jsr LB3A2 ; set carry if not alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3591 bcs L9BEB ; brif not a variable reference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3592 L9C27 jsr L9B98 ; get command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3593 cmpa #'; ; semicolon?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3594 bne L9C27 ; keep scanning if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3595 puls x ; get back start of variable string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3596 ldu CHARAD ; get current interpreter input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3597 pshs u ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3598 stx CHARAD ; point interpreter at command string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3599 jsr LB284 ; evaluate expression as string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3600 puls x ; restore interpeter input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3601 stx CHARAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3602 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3603 ; The bit of Extended Basic's IRQ routine that handles PLAY. Note that everything after
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3604 ; clr PLYTMR+1 could be replaced with a simple lds 8,s followed by rts.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3605 L9C3E clra ; make sure DP is set to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3606 tfr a,dp
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3607 ldd PLYTMR ; is PLAY running?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3608 lbeq LA9BB ; brif not - transfer control on the Color Basic's routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3609 subd VD5 ; subtract out the interval
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3610 std PLYTMR ; save new timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3611 bhi L9C5A ; brif it isn't <= 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3612 clr PLYTMR ; disable the timer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3613 clr PLYTMR+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3614 puls a ; get saved CC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3615 lds 7,s ; set stack to saved U value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3616 anda #0x7f ; clear E flag (to return minimal state)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3617 pshs a ; set fake "FIRQ" stack frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3618 L9C5A rti
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3619 L9C5B fcb 10,12,1,3,5,6,8 ; table of half tone numbers for notes A-G
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3620 L9C62 fdb 0x01a8,0x0190,0x017a,0x0164 ; delays for octave 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3621 fdb 0x0150,0x013d,0x012b,0x011a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3622 fdb 0x010a,0x00fb,0x00ed,0x00df
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3623 fdb 0x00d3,0x00c7,0x00bb,0x00b1 ; delays for octave 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3624 fdb 0x00a6,0x009d,0x0094,0x008b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3625 fdb 0x0083,0x007c,0x0075,0x006e
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3626 L9C92 fcb 0xa6,0x9c,0x93,0x8b ; delays for octave 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3627 fcb 0x83,0x7b,0x74,0x6d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3628 fcb 0x67,0x61,0x5b,0x56
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3629 fcb 0x51,0x4c,0x47,0x43 ; delays for octave 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3630 fcb 0x3f,0x3b,0x37,0x34
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3631 fcb 0x31,0x2e,0x2b,0x28
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3632 fcb 0x26,0x23,0x21,0x1f ; delays for octave 5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3633 fcb 0x1d,0x1b,0x19,0x18
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3634 fcb 0x16,0x14,0x13,0x12
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3635 ; DRAW command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3636 DRAW ldx ZERO ; create an empty "DRAW" frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3637 ldb #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3638 pshs x,b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3639 stb SETFLG ; set to "PSET" mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3640 stx VD5 ; clear update and draw flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3641 jsr L959A ; set active colour byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3642 jsr LB156 ; evaluate command string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3643 L9CC6 jsr LB654 ; fetch command string details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3644 bra L9CD3 ; interpret the command string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3645 L9CCB jsr L9B98 ; fetch command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3646 jmp L9BBE ; evaluate a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3647 L9CD1 puls b,x ; get previously saved command string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3648 L9CD3 stb VD8 ; save length counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3649 beq L9CD1 ; brif end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3650 stx VD9 ; save pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3651 lbeq L9DC7 ; brif overall end of command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3652 L9CDD tst VD8 ; are we at the end of the string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3653 beq L9CD1 ; brif so - return to previous string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3654 jsr L9B98 ; get command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3655 cmpa #'; ; semicolon?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3656 beq L9CDD ; brif so - ignore it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3657 cmpa #'' ; '?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3658 beq L9CDD ; brif so - ignore that too
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3659 cmpa #'N ; update position toggle?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3660 bne L9CF4 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3661 com VD5 ; toggle update position flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3662 bra L9CDD ; get on for another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3663 L9CF4 cmpa #'B ; blank flag?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3664 bne L9CFC ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3665 com VD6 ; toggle blank flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3666 bra L9CDD ; get on for another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3667 L9CFC cmpa #'X ; substring?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3668 lbeq L9D98 ; brif so - execute command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3669 cmpa #'M ; move draw position?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3670 lbeq L9E32 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3671 pshs a ; save command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3672 ldb #1 ; default value if no number follows
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3673 tst VD8 ; is there something there?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3674 beq L9D21 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3675 jsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3676 jsr LB3A2 ; set C if not alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3677 pshs cc ; save alpha state
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3678 jsr L9BE2 ; move back pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3679 puls cc ; get back alpha flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3680 bcc L9D21 ; brif it's alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3681 bsr L9CCB ; evaluate a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3682 L9D21 puls a ; get command back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3683 cmpa #'C ; color change?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3684 beq L9D4F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3685 cmpa #'A ; angle?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3686 beq L9D59 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3687 cmpa #'S ; scale?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3688 beq L9D61 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3689 cmpa #'U ; up?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3690 beq L9D8F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3691 cmpa #'D ; down?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3692 beq L9D8C ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3693 cmpa #'L ; left?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3694 beq L9D87 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3695 cmpa #'R ; right?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3696 beq L9D82 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3697 suba #'E ; normalize the half cardinals to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3698 beq L9D72 ; brif E (45°)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3699 deca ; F (135°?)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3700 beq L9D6D ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3701 deca ; G (225°?)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3702 beq L9D7B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3703 deca ; H (315°?)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3704 beq L9D69 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3705 L9D4C jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3706 L9D4F jsr L955D ; adjust colour for PMODE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3707 stb FORCOL ; save new foreground colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3708 jsr L959A ; set up working colour and all pixels byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3709 L9D57 bra L9CDD ; go process another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3710 L9D59 cmpb #4 ; only 3 angles are valid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3711 bhs L9D4C ; brif not valid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3712 stb ANGLE ; save new angle
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3713 bra L9D57 ; go process another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3714 L9D61 cmpb #63 ; only 64 scale values are possible
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3715 bhs L9D4C ; brif out of range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3716 stb SCALE ; save new scale factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3717 bra L9D57 ; go process another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3718 L9D69 clra ; make horizontal negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3719 bsr L9DC4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3720 skip1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3721 L9D6D clra ; keep horizontal distance positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3722 tfr d,x ; make horizontal distance and vertical distance the same
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3723 bra L9DCB ; go do the draw thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3724 L9D72 clra ; zero extend horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3725 tfr d,x ; set it as vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3726 bsr L9DC4 ; negate horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3727 exg d,x ; swap directions (vertical is now negative)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3728 bra L9DCB ; go do the draw thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3729 L9D7B clra ; zero extend horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3730 tfr d,x ; copy horizontal to vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3731 bsr L9DC4 ; negate horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3732 bra L9DCB ; go do the drawing thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3733 L9D82 clra ; zero extend horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3734 L9DB3 ldx ZERO ; no vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3735 bra L9DCB ; go do the drawing things
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3736 L9D87 clra ; zero extend horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3737 bsr L9DC4 ; negate horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3738 bra L9DB3 ; zero out vertical and do the drawing thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3739 L9D8C clra ; zero extend distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3740 bra L9D92 ; make the distance vertical and zero out horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3741 L9D8F clra ; zero extend distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3742 bsr L9DC4 ; negate distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3743 L9D92 ldx ZERO ; zero out vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3744 exg x,d ; swap vertical and horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3745 bra L9DCB ; go do the drawing thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3746 L9D98 jsr L9C1B ; evaluate substring expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3747 ldb #2 ; is there enough room for the state?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3748 jsr LAC33
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3749 ldb VD8 ; save current command string state
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3750 ldx VD9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3751 pshs x,b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3752 jmp L9CC6 ; go evaluate the sub string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3753 L9DA9 ldb SCALE ; get scale factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3754 beq L9DC8 ; brif zero - default to full size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3755 clra ; zero extend
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3756 exg d,x ; put distance somewhere useful
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3757 sta ,-s ; save MS of distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3758 bpl L9DB6 ; brif positive distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3759 bsr L9DC3 ; negate the distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3760 L9DB6 jsr L9FB5 ; multiply D and X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3761 tfr u,d ; save ms bytes in D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3762 lsra ; divide by 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3763 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3764 L9DBD lsra ; ...divide by 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3765 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3766 tst ,s+ ; negative distance?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3767 bpl L9DC7 ; brif it was positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3768 L9DC3 nega ; negate D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3769 L9DC4 negb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3770 sbca #0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3771 L9DC7 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3772 L9DC8 tfr x,d ; copy unchanged sitance to D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3773 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3774 L9DCB pshs b,a ; save horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3775 bsr L9DA9 ; apply scale factor to vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3776 puls x ; get horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3777 pshs b,a ; save scaled vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3778 bsr L9DA9 ; apply scale to horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3779 puls x ; get back vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3780 ldy ANGLE ; get draw angle and scale
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3781 pshs y ; save them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3782 L9DDC tst ,s ; is there an angle?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3783 beq L9DE8 ; brif no angle
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3784 exg x,d ; swap distances
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3785 bsr L9DC3 ; negate D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3786 dec ,s ; account for one tick around the rotation
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3787 bra L9DDC ; see if we're there yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3788 L9DE8 puls y ; get angle and scale back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3789 ldu ZERO ; default end position (horizontal) is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3790 addd HORDEF ; add default horizontal to horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3791 bmi L9DF2 ; brif we went negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3792 tfr d,u ; save calculated end coordindate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3793 L9DF2 tfr x,d ; get vertical distance somewhere useful
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3794 ldx ZERO ; default vertical end is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3795 addd VERDEF ; add distance to default vertical start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3796 bmi L9DFC ; brif negative - use 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3797 tfr d,x ; save calculated end coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3798 L9DFC cmpu #256 ; is horizontal in range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3799 blo L9E05 ; brif su
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3800 ldu #255 ; maximize it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3801 L9E05 cmpx #192 ; is vertical in range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3802 blo L9E0D ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3803 ldx #191 ; maximize it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3804 L9E0D ldd HORDEF ; set starting coordinates for the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3805 std HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3806 ldd VERDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3807 std VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3808 stx VEREND ; set end coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3809 stu HOREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3810 tst VD5 ; are we updating position?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3811 bne L9E21 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3812 stx VERDEF ; update default coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3813 stu HORDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3814 L9E21 jsr L9420 ; normalize coordindates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3815 tst VD6 ; are we drawing something?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3816 bne L9E2B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3817 jsr L94A1 ; draw the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3818 L9E2B clr VD5 ; reset draw and update flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3819 clr VD6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3820 jmp L9CDD ; do another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3821 L9E32 jsr L9B98 ; get a command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3822 pshs a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3823 jsr L9E5E ; evaluate horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3824 pshs b,a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3825 jsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3826 cmpa #', ; comma between coordinates?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3827 lbne L9D4C ; brif not - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3828 jsr L9E5B ; evaluate vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3829 tfr d,x ; save vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3830 puls u ; get horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3831 puls a ; get back first command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3832 cmpa #'+ ; was it + at start?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3833 beq L9E56 ; brif +; treat values as positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3834 cmpa #'- ; was it -?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3835 bne L9DFC ; brif not - treat it as absolute
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3836 L9E56 tfr u,d ; put horizontal distance somewhere useful
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3837 jmp L9DCB ; move draw position (relative)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3838 L9E5B jsr L9B98 ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3839 L9E5E cmpa #'+ ; leading +?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3840 beq L9E69 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3841 cmpa #'- ; leading -?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3842 beq L9E6A ; brif so - negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3843 jsr L9BE2 ; move pointer back one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3844 L9E69 clra ; 0 for +, nonzero for -
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3845 L9E6A pshs a ; save sign flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3846 jsr L9CCB ; evaluate number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3847 puls a ; get sign flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3848 tsta ; negative?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3849 beq L9E78 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3850 clra ; zero extend and negate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3851 negb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3852 sbca #0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3853 L9E78 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3854 ; Table of sines and cosines for CIRCLE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3855 L9E79 fdb 0x0000,0x0001 ; subarc 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3856 fdb 0xfec5,0x1919 ; subarc 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3857 fdb 0xfb16,0x31f2 ; subarc 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3858 fdb 0xf4fb,0x4a51 ; subarc 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3859 fdb 0xec84,0x61f9 ; subarc 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3860 fdb 0xe1c7,0x78ae ; subarc 5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3861 fdb 0xd4dc,0x8e3b ; subarc 6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3862 fdb 0xc5e5,0xa269 ; subarc 7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3863 fdb 0xb506,0xb506 ; subarc 8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3864 ; CIRCLE command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3865 ; The circle is drawn as a 64 sided polygon (64 LINE commands essentially)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3866 CIRCLE cmpa #'@ ; is there an @ before coordinates?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3867 bne L9EA3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3868 jsr GETNCH ; eat the @
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3869 L9EA3 jsr L9522 ; get max coordinates for screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3870 jsr L93B2 ; parse coordinates for circle centre
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3871 jsr L931D ; normalize the start coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3872 ldx ,u ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3873 stx VCB ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3874 ldx 2,u ; get vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3875 stx VCD ; saveit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3876 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3877 jsr LB73D ; evaluate radius expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3878 ldu #VCF ; point to temp storage
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3879 stx ,u ; save radius
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3880 jsr L9320 ; normalize radius
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3881 lda #1 ; default to PSET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3882 sta SETFLG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3883 jsr L9581 ; evaluate the colour expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3884 ldx #0x100 ; height/width default value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3885 jsr GETCCH ; is there a ratio?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3886 beq L9EDF ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3887 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3888 jsr LB141 ; evaluate the ratio
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3889 lda FP0EXP ; multiply ratio by 256
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3890 adda #8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3891 sta FP0EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3892 jsr LB740 ; evaluate ratio to X (fraction part in LSB)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3893 L9EDF lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3894 bita #2 ; is it even?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3895 beq L9EE9 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3896 tfr x,d ; double the ratio
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3897 leax d,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3898 L9EE9 stx VD1 ; save height/width ratio
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3899 ldb #1 ; set the SET flag to PSET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3900 stb SETFLG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3901 stb VD8 ; set first time flag (set to 0 after arc drawn)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3902 jsr L9FE2 ; evaluate circle starting point (octant, subarc)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3903 pshs b,a ; save startpoint
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3904 jsr L9FE2 ; evaluate circle end point (octant, subarc)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3905 std VD9 ; save endp oint
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3906 puls a,b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3907 L9EFD pshs b,a ; save current circle position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3908 ldx HOREND ; move end coordinates to start coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3909 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3910 ldx VEREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3911 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3912 ldu #L9E79+2 ; point to sine/cosine table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3913 anda #1 ; even octant?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3914 beq L9F11 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3915 negb ; convert 0-7 to 8-1 for odd octants
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3916 addb #8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3917 L9F11 aslb ; four bytes per table entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3918 aslb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3919 leau b,u ; point to correct table entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3920 pshs u ; save sine/cosine table entry pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3921 jsr L9FA7 ; calculate horizontal offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3922 puls u ; get back table entry pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3923 leau -2,u ; move to cosine entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3924 pshs x ; save horizontal offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3925 jsr L9FA7 ; calculate vertical offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3926 puls y ; put horizontal in Y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3927 lda ,s ; get octant number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3928 anda #3 ; is it 0 or 4?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3929 beq L9F31 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3930 cmpa #3 ; is it 3 or 7?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3931 beq L9F31 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3932 exg x,y ; swap horizontal and vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3933 L9F31 stx HOREND ; save horizontal offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3934 tfr y,x ; put vertical offset in X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3935 ldd VD1 ; get height/width ratio
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3936 jsr L9FB5 ; multiply vertical by h/w ratio
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3937 tfr y,d ; save the product to D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3938 tsta ; did it overflow?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3939 lbne LB44A ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3940 stb VEREND ; save vertical coordinate MSB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3941 tfr u,d ; get LSW of product
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3942 sta VEREND+1 ; save LSB of integer part (we have 8 bits of fraction in the ratio)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3943 lda ,s ; get octant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3944 cmpa #2 ; is it 0 or 1?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3945 blo L9F5B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3946 cmpa #6 ; is it 6 or 7?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3947 bhs L9F5B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3948 ldd VCB ; get horizontal centre
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3949 subd HOREND ; subtract horizontal displacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3950 bcc L9F68 ; brif we didn't overflow the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3951 clra ; zero out coordinate if we overflowed the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3952 clrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3953 bra L9F68
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3954 L9F5B ldd VCB ; get horizontal coordinate of the centre
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3955 addd HOREND ; add displacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3956 bcs L9F66 ; brif overlod
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3957 cmpd VD3 ; larger than max horizontal coord?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3958 blo L9F68 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3959 L9F66 ldd VD3 ; maximize the coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3960 L9F68 std HOREND ; save horizontal ending coordainte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3961 lda ,s ; get octant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3962 cmpa #4 ; is it 0-3?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3963 blo L9F7A ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3964 ldd VCD ; get vertical coordinate of centre
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3965 subd VEREND ; subtract displacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3966 bcc L9F87 ; brif we didn't overflow the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3967 clra ; minimize to top of screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3968 clrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3969 bra L9F87
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3970 L9F7A ldd VCD ; get vertical centre coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3971 addd VEREND ; add displacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3972 bcs L9F85 ; brif we overflowed the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3973 cmpd VD5 ; did we go past max coordinate?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3974 blo L9F87 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3975 L9F85 ldd VD5 ; maximize the coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3976 L9F87 std VEREND ; save end coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3977 tst VD8 ; check first time flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3978 bne L9F8F ; do not draw if first time through (it was setting start coord)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3979 bsr L9FDF ; draw the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3980 L9F8F puls a,b ; get arc number and sub arc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3981 lsr VD8 ; get first time flag value (and clear it!)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3982 bcs L9F9A ; do not check for end point after drawing for first coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3983 cmpd VD9 ; at end point?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3984 beq L9FA6 ; brif drawing finished
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3985 L9F9A incb ; bump arc counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3986 cmpb #8 ; done 8 arcs?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3987 bne L9FA3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3988 inca ; bump octant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3989 clrb ; reset subarc number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3990 anda #7 ; make sure octant number stays in 0-7 range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3991 L9FA3 jmp L9EFD ; go do another arc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3992 L9FA6 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3993 L9FA7 ldx VCF ; get radius
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3994 ldd ,u ; get sine/cosine table entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3995 beq L9FB4 ; brif 0 - offset = radius
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3996 subd #1 ; adjust values to correct range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3997 bsr L9FB5 ; multiply radius by sine/cosine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3998 tfr y,x ; resturn result in X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3999 L9FB4 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4000 L9FB5 pshs u,y,x,b,a ; save registers and reserve temp space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4001 clr 4,s ; reset overflow byte (YH)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4002 lda 3,s ; calcuate B*XL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4003 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4004 std 6,s ; put in "U"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4005 ldd 1,s ; calculate B*XH
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4006 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4007 addb 6,s ; accumluate with previous product
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4008 adca #0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4009 std 5,s ; save in YL,UH
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4010 ldb ,s ; calculate A*XL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4011 lda 3,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4012 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4013 addd 5,s ; accumulate with previous partical product
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4014 std 5,s ; save in YL,UH
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4015 bcc L9FD4 ; brif no carry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4016 inc 4,s ; bump YH for carry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4017 L9FD4 lda ,s ; calculate A*XH
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4018 ldb 2,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4019 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4020 addd 4,s ; accumulate with previous partial product
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4021 std 4,s ; save in Y (we can't have a carry here)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4022 puls a,b,x,y,u,pc ; restore multiplicands and return results
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4023 L9FDF jmp L94A1 ; go draw a line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4024 L9FE2 clrb ; default arc number (0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4025 jsr GETCCH ; is there something there for a value?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4026 beq L9FF8 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4027 jsr SYNCOMMA ; evaluate , + expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4028 jsr LB141
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4029 lda FP0EXP ; multiply by 64
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4030 adda #6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4031 sta FP0EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4032 jsr LB70E ; get integer value of circle fraction
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4033 andb #0x3f ; max value of 63
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4034 L9FF8 tfr b,a ; save arc value in A to calculate octant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4035 andb #7 ; calculate subarc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4036 lsra ; calculate octant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4037 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4038 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4039 rts