Mercurial > hg > index.cgi

annotate exbas10.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 routine is dead code that is never used by any Basic ROMs.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
229 L80D0 lda PIA1+2 ; check memory size jump
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
230 bita #2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
231 bne L80DA ; brif high
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
232 sta SAMREG+29 ; set SAM for 64K memory size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
233 L80DA jmp ,x ; jump to address in X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
234 fcb 0,0 ; dead space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
235 L80DE fcb 25 ; 25 Extended Basic commands
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
236 fdb L8183 ; reserved word table (commands)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
237 fdb L813C ; interpretation handler (commands)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
238 fcb 14 ; 14 Extended Basic functions
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
239 fdb L821E ; reserved word table (functions)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
240 fdb L8168 ; function handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
241 L80E8 fcc 'EXTENDED COLOR BASIC 1.0'
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
242 fcb 0x0d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
243 fcc 'COPYRIGHT (C) 1980 BY TANDY'
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
244 fcb 0x0d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
245 fcc 'UNDER LICENSE FROM MICROSOFT'
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
246 fcb 0x0d,0x0d,0x00
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
247 ; Extended Basic command interpretation loop
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
248 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
249 bhi L8148 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
250 ldx #L81F0 ; point to dispatch table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
251 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
252 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
253 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
254 beq L8154 ; brif so - for MID$()=, TIMER=
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
255 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
256 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
257 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
258 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
259 cmpa #0x90 ; MID$?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
260 lbeq L86D6 ; brif so (substring replacement)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
261 cmpa #0x9f ; TIMER?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
262 lbeq L8960 ; brif so - TIMER setting
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
263 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
264 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
265 ; Function handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
266 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
267 bls L8170 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
268 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
269 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
270 cmpb #2*8 ; Above HEX$?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
271 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
272 pshs b ; save token value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
273 jsr LB262 ; evaluate the function parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
274 puls b ; get back token value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
275 L817D ldx #L8257 ; point to dispatch table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
276 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
277 ; Reserved words (commands)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
278 L8183 fcs 'DEL' ; 0xb5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
279 fcs 'EDIT' ; 0xb6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
280 fcs 'TRON' ; 0xb7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
281 fcs 'TROFF' ; 0xb8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
282 fcs 'DEF' ; 0xb9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
283 fcs 'LET' ; 0xba
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
284 fcs 'LINE' ; 0xbb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
285 fcs 'PCLS' ; 0xbc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
286 fcs 'PSET' ; 0xbd
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
287 fcs 'PRESET' ; 0xbe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
288 fcs 'SCREEN' ; 0xbf
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
289 fcs 'PCLEAR' ; 0xc0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
290 fcs 'COLOR' ; 0xc1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
291 fcs 'CIRCLE' ; 0xc2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
292 fcs 'PAINT' ; 0xc3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
293 fcs 'GET' ; 0xc4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
294 fcs 'PUT' ; 0xc5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
295 fcs 'DRAW' ; 0xc6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
296 fcs 'PCOPY' ; 0xc7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
297 fcs 'PMODE' ; 0xc8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
298 fcs 'PLAY' ; 0xc9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
299 fcs 'DLOAD' ; 0xca
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
300 fcs 'RENUM' ; 0xcb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
301 fcs 'FN' ; 0xcc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
302 fcs 'USING' ; 0xcd
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
303 ; Dispatch table (commands)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
304 L81F0 fdb DEL ; 0xb5 DEL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
305 fdb EDIT ; 0xb6 EDIT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
306 fdb TRON ; 0xb7 TRON
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
307 fdb TROFF ; 0xb8 TROFF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
308 fdb DEF ; 0xb9 DEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
309 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
310 fdb LINE ; 0xbb LINE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
311 fdb PCLS ; 0xbc PCLS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
312 fdb PSET ; 0xbd PSET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
313 fdb PRESET ; 0xbe PRESET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
314 fdb SCREEN ; 0xbf SCREEN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
315 fdb PCLEAR ; 0xc0 PCLEAR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
316 fdb COLOR ; 0xc1 COLOR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
317 fdb CIRCLE ; 0xc2 CIRCLE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
318 fdb PAINT ; 0xc3 PAINT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
319 fdb GET ; 0xc4 GET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
320 fdb PUT ; 0xc5 PUT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
321 fdb DRAW ; 0xc6 DRAW
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
322 fdb PCOPY ; 0xc7 PCOPY
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
323 fdb PMODETOK ; 0xc8 PMODE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
324 fdb PLAY ; 0xc9 PLAY
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
325 fdb DLOAD ; 0xca DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
326 fdb RENUM ; 0xcb RENUM
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
327 ; Reserved words (functions)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
328 L821E fcs 'ATN' ; 0x94
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
329 fcs 'COS' ; 0x95
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
330 fcs 'TAN' ; 0x96
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
331 fcs 'EXP' ; 0x97
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
332 fcs 'FIX' ; 0x98
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
333 fcs 'LOG' ; 0x99
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
334 fcs 'POS' ; 0x9a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
335 fcs 'SQR' ; 0x9b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
336 fcs 'HEX$' ; 0x9c
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
337 fcs 'VARPTR' ; 0x9d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
338 fcs 'INSTR' ; 0x9e
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
339 fcs 'TIMER' ; 0x9f
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
340 fcs 'PPOINT' ; 0xa0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
341 fcs 'STRING$' ; 0xa1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
342 ; Dispatch table (functions)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
343 L8257 fdb ATN ; 0x94 ATN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
344 fdb COS ; 0x95 COS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
345 fdb TAN ; 0x96 TAN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
346 fdb EXP ; 0x97 EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
347 fdb FIX ; 0x98 FIX
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
348 fdb LOG ; 0x99 LOG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
349 fdb POS ; 0x9a POS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
350 fdb SQR ; 0x9b SQR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
351 fdb HEXDOL ; 0x9c HEX$
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
352 fdb VARPTRTOK ; 0x9d VARPTR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
353 fdb INSTR ; 0x9e INSTR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
354 fdb TIMER ; 0x9f TIMER
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
355 fdb PPOINT ; 0xa0 PPOINT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
356 fdb STRING ; 0xa1 STRING$
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
357 ; Generic output handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
358 XVEC3 tst DEVNUM ; screen?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
359 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
360 pshs b ; save register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
361 ldb DEVNUM ; get output device
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
362 cmpb #-3 ; check for DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
363 puls b ; restore register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
364 bne L8285 ; brif not DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
365 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
366 L8285 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
367 ; 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
368 ; 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
369 ; 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
370 XVEC8 lda DEVNUM ; get device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
371 inca ; is it tape?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
372 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
373 lda FILSTA ; get tape file status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
374 cmpa #2 ; output file?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
375 bne L8285 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
376 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
377 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
378 clr DEVNUM ; reset output to screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
379 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
380 jmp LA444 ; write EOF block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
381 ; 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
382 XVEC18 ldd #0xba42 ; initialize PLAY volume
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
383 std VOLHI
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
384 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
385 sta TEMPO
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
386 sta OCTAVE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
387 asla ; set default note length to 5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
388 sta NOTELN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
389 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
390 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
391 std ANGLE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
392 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
393 std HORDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
394 ldb #96
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
395 std VERDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
396 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
397 ; 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
398 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
399 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
400 jsr LADEB ; do a BREAK/pause check
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
401 ldx CHARAD ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
402 stx TINPTR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
403 lda ,x+ ; get current input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
404 beq L82CF ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
405 cmpa #': ; statement separator?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
406 beq L82F1 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
407 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
408 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
409 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
410 bne L82D8 ; brif not end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
411 jmp LAE15 ; go do the "END"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
412 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
413 std CURLIN ; set current line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
414 stx CHARAD ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
415 lda TRCFLG ; are we tracing?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
416 beq L82F1 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
417 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
418 jsr PUTCHR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
419 lda CURLIN ; restore MSB of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
420 jsr LBDCC ; show line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
421 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
422 jsr PUTCHR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
423 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
424 tfr cc,b ; save status flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
425 cmpa #0x98 ; is it CSAVE?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
426 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
427 cmpa #0x97 ; is it CLOAD?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
428 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
429 tfr b,cc ; restore character status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
430 jsr LADC6 ; go process command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
431 bra L82BB ; restart interpretation loop
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
432 ; 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
433 ; 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
434 ; 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
435 ; 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
436 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
437 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
438 bne L8310 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
439 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
440 stx 2,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
441 L8310 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
442 ; 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
443 ; 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
444 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
445 bra L82BB ; go do another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
446 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
447 bra L82BB ; go do another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
448 ; 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
449 L831A jsr GETNCH ; get character after CSAVE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
450 cmpa #'M ; is it CSAVEM?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
451 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
452 jsr GETNCH ; eat the "M"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
453 jsr LA578 ; parse file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
454 bsr L836C ; get start address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
455 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
456 bsr L836C ; get end address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
457 cmpx 2,s ; compare to start address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
458 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
459 bsr L836C ; get execution address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
460 stx CASBUF+11 ; put in file header
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
461 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
462 bne L8310 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
463 lda #2 ; file type to machine language
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
464 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
465 jsr LA65F ; write header
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
466 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
467 inc BLKTYP ; set block type to data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
468 jsr WRLDR ; write a data leader
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
469 ldx 4,s ; get starting address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
470 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
471 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
472 sta BLKLEN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
473 ldd 2,s ; get ending address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
474 subd CBUFAD ; see how much is left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
475 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
476 leas 6,s ; clean up stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
477 jmp LA491 ; write EOF block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
478 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
479 bhs L8367 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
480 incb ; set block size to remainder
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
481 stb BLKLEN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
482 L8367 jsr SNDBLK ; write a data block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
483 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
484 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
485 jsr LB73D ; evaluate unsigned expression to X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
486 ldu ,s ; get return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
487 stx ,s ; save result on stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
488 tfr u,pc ; return to caller
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
489 ; COS function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
490 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
491 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
492 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
493 ; 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
494 TAN jsr LBC2F ; save FPA0 in FPA3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
495 clr RELFLG ; reset quadrant flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
496 bsr L837E ; calculate SIN(x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
497 ldx #V4A ; save result in FPA5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
498 jsr LBC35
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
499 ldx #V40 ; get back original argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
500 jsr LBC14
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
501 clr FP0SGN ; force result positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
502 lda RELFLG ; get quadrant flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
503 bsr L83A6 ; calculate COS(x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
504 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
505 lbeq LBA92 ; brif so - overflow
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
506 ldx #V4A ; point to sin(x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
507 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
508 L83A6 pshs a ; save sign flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
509 jmp LBFA6 ; expand polynomial
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
510 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
511 ; 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
512 ; 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
513 ATN lda FP0SGN ; get sign of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
514 pshs a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
515 bpl L83B8 ; brif positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
516 bsr L83DC ; flip sign of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
517 L83B8 lda FP0EXP ; get exponent
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 cmpa #0x81 ; exponent for 1.0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
520 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
521 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
522 bsr L83A3 ; calculate reciprocal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
523 L83C5 ldx #L83E0 ; point to polynomical coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
524 jsr LBEF0 ; expand polynomial
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
525 puls a ; get exponent of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
526 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
527 blo L83D7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
528 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
529 jsr LB9B9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
530 L83D7 puls a ; get sign of original
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
531 tsta ; was it positive?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
532 bpl L83DF ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
533 L83DC jmp LBEE9 ; flip sign of result
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
534 L83DF rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
535 ; 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
536 ; 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
537 ; 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
538 ; fewer coefficients.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
539 L83E0 fcb 11 ; 12 coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
540 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
541 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
542 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
543 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
544 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
545 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
546 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
547 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
548 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
549 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
550 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
551 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
552 ; 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
553 L841D fcb 3 ; four coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
554 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
555 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
556 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
557 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
558 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
559 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
560 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
561 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
562 ; LOG function (natural log, ln)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
563 ; 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
564 ; ln(A*2^B).
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
565 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
566 ; 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
567 ; (log2(A) + B)*ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
568 ; 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
569 ; (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
570 ; 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
571 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
572 ; 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
573 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
574 ; 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
575 ; 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
576 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
577 ; 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
578 ; 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
579 ; 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
580 ; 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
581 LOG jsr LBC6D ; get status of FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
582 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
583 ldx #L8432 ; point to 1/sqrt(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
584 lda FP0EXP ; get exponent of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
585 suba #0x80 ; remove bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
586 pshs a ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
587 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
588 sta FP0EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
589 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
590 ldx #L8437 ; point to sqrt(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
591 jsr LBB8F ; divide that by FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
592 ldx #LBAC5 ; point to 1.0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
593 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
594 ldx #L841D ; point to coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
595 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
596 ldx #L843C ; point to -0.5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
597 jsr LB9C2 ; add result
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
598 puls b ; get original exponent back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
599 jsr LBD99 ; add B to FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
600 ldx #L8441 ; point to ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
601 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
602 ; 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
603 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
604 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
605 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
606 ; Exponentiation operator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
607 ; 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
608 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
609 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
610 bne L8491 ; brif base is not 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
611 jmp LBA3A ; 0^(nonzero) is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
612 L8491 ldx #V4A ; save exponent (to FPA5)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
613 jsr LBC35
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
614 clrb ; result sign will default to positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
615 lda FP1SGN ; check if base is positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
616 bpl L84AC ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
617 jsr INT ; convert exponent to integer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
618 ldx #V4A ; point to original expoent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
619 lda FP1SGN ; get sign of FPA1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
620 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
621 bne L84AC ; brif not equal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
622 coma ; flip sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
623 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
624 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
625 pshs b ; save result sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
626 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
627 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
628 jsr LBACA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
629 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
630 puls a ; get result sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
631 rora ; brif it was negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
632 lbcs LBEE9 ; brif negative - flip sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
633 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
634 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
635 ; 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
636 L84C9 fcb 7 ; eight coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
637 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
638 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
639 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
640 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
641 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
642 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
643 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
644 fcb 0x81,0x00,0x00,0x00,0x00 ; 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
645 ; EXP function (e^x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
646 EXP ldx #L84C4 ; point to correction factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
647 jsr LBACA ; multiply it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
648 jsr LBC2F ; save corrected argument to FPA3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
649 lda FP0EXP ; get exponent of FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
650 cmpa #0x88 ; is it too big?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
651 blo L8504 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
652 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
653 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
654 lda CHARAC ; get ls byte of integer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
655 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
656 beq L8501
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
657 deca ; adjust for the extra +1 above
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
658 pshs a ; save integer exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
659 ldx #V40 ; get fractional part of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
660 jsr LB9B9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
661 ldx #L84C9 ; point to coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
662 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
663 clr RESSGN ; force result to be positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
664 puls a ; get back original exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
665 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
666 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
667 ; 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
668 FIX jsr LBC6D ; get status of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
669 bmi L852C ; brif negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
670 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
671 L852C com FP0SGN ; flip the sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
672 bsr L8529 ; do "INT" on this
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
673 jmp LBEE9 ; flip the sign back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
674 ; EDIT command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
675 EDIT jsr L89AE ; get line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
676 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
677 L8538 lda #1 ; "LIST" flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
678 sta VD8 ; set to list the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
679 jsr LAD01 ; find line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
680 lbcs LAED2 ; brif line wasn't found
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
681 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
682 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
683 subd #LINBUF+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
684 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
685 L854D ldd BINVAL ; get the line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
686 jsr LBDCC ; display it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
687 jsr LB9AC ; put a space after it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
688 ldx #LINBUF+1 ; point to iput uffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
689 ldb VD8 ; are we listing?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
690 bne L8581 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
691 L855C clrb ; reset digit accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
692 L855D jsr L8687 ; get a keypress
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
693 jsr L90AA ; set carry if not numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
694 bcs L8570 ; brif not a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
695 suba #'0 ; remove ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
696 pshs a ; save digit value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
697 lda #10 ; multiply accumulator by 10
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
698 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
699 addb ,s+ ; add in new digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
700 bra L855D ; go check for another digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
701 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
702 adcb #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
703 cmpa #'A ; abort?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
704 bne L857D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
705 jsr LB958 ; to a CR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
706 bra L8538 ; restart EDIT process
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
707 L857D cmpa #'L ; list?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
708 bne L858C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
709 L8581 bsr L85B4 ; list the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
710 clr VD8 ; reset to "not listing"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
711 jsr LB958 ; do a CR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
712 bra L854D ; start editing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
713 L858A leas 2,s ; lose return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
714 L858C cmpa #0x0d ; ENTER?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
715 bne L859D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
716 bsr L85B4 ; echo out the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
717 L8592 jsr LB958 ; do a CR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
718 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
719 stx CHARAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
720 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
721 L859D cmpa #'E ; exit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
722 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
723 cmpa #'Q ; quit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
724 bne L85AB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
725 jsr LB958 ; do a CR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
726 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
727 L85AB bsr L85AF ; go do commands
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
728 bra L855C ; go handle another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
729 L85AF cmpa #0x20 ; space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
730 bne L85C3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
731 skip2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
732 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
733 L85B6 lda ,x ; get buffer chracter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
734 beq L85C2 ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
735 jsr PUTCHR ; output character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
736 leax 1,x ; move to next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
737 decb ; done?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
738 bne L85B6 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
739 L85C2 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
740 L85C3 cmpa #'D ; delete?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
741 bne L860F ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
742 L85C7 tst ,x ; end of line?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
743 beq L85C2 ; brif so - can't delete
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
744 bsr L85D1 ; remove a character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
745 decb ; done all requested?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
746 bne L85C7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
747 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
748 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
749 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
750 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
751 lda 1,y ; get next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
752 sta ,y ; move it forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
753 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
754 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
755 L85DE cmpa #'I ; insert?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
756 beq L85F5 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
757 cmpa #'X ; extend?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
758 beq L85F3 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
759 cmpa #'H ; "hack"?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
760 bne L8646 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
761 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
762 tfr x,d ; calculate new line length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
763 subd #LINBUF+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
764 stb VD7 ; save new length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
765 L85F3 bsr L85B4 ; display the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
766 L85F5 jsr L8687 ; read a character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
767 cmpa #0x0d ; ENTER?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
768 beq L858A ; brif so - terminate entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
769 cmpa #0x1b ; ESC?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
770 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
771 cmpa #0x08 ; backspace?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
772 bne L8626 ; brif no
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
773 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
774 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
775 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
776 bsr L85D1 ; remove character from the buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
777 bra L85F5 ; go handle more input
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
778 L860F cmpa #'C ; change?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
779 bne L85DE ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
780 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
781 beq L8625 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
782 jsr L8687 ; get a key stroke
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
783 bcs L861E ; brif valid key
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
784 bra L8613 ; try again if invalid key
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
785 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
786 bsr L8659 ; echo it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
787 decb ; changed number requested?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
788 bne L8613 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
789 L8625 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
790 L8626 ldb VD7 ; get length of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
791 cmpb #LBUFMX-1 ; at maximum line length?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
792 bne L862E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
793 bra L85F5 ; process another input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
794 L862E pshs x ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
795 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
796 bne L8630 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
797 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
798 stb 1,x ; move it forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
799 cmpx ,s ; at the original buffer pointer?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
800 bne L8634 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
801 leas 2,s ; remove saved buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
802 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
803 bsr L8659 ; echo it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
804 inc VD7 ; bump line length counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
805 bra L85F5 ; go handle more stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
806 L8646 cmpa #0x08 ; backspace?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
807 bne L865C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
808 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
809 decb ; done enough of them?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
810 bne L864A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
811 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
812 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
813 beq L8625 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
814 leax -1,x ; move pointer back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
815 lda #0x08 ; character to echo - BS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
816 L8659 jmp PUTCHR ; echo character to screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
817 L865C cmpa #'K ; "kill"?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
818 beq L8665 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
819 suba #'S ; search?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
820 beq L8665 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
821 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
822 L8665 pshs a ; save kill/search flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
823 bsr L8687 ; read target
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
824 pshs a ; save search character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
825 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
826 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
827 tst 1,s ; is it KILL?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
828 bne L8679 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
829 bsr L8659 ; echo the character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
830 leax 1,x ; move ahead
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
831 bra L867C ; check next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
832 L8679 jsr L85D1 ; remove character from buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
833 L867C lda ,x ; get character in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
834 cmpa ,s ; are we at the target?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
835 bne L866B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
836 decb ; have we found enough of them?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
837 bne L866B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
838 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
839 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
840 cmpa #0x7f ; graphics (or DEL)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
841 bhs L8687 ; brif so - ignore it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
842 cmpa #0x5f ; SHIFT-UP?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
843 bne L8694 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
844 lda #0x1b ; replace with ESC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
845 L8694 cmpa #0x0d ; carriage return?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
846 beq L86A6 ; brif so (C=0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
847 cmpa #0x1b ; ESC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
848 beq L86A6 ; brif so (C=0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
849 cmpa #0x08 ; backspace?
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 #32 ; control code?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
852 blo L8687 ; brif control code - try again
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
853 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
854 L86A6 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
855 ; TRON and TROFF commands
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
856 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
857 TROFF clra ; clear flag for trace disabled
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
858 sta TRCFLG ; save trace status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
859 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
860 ; POS function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
861 POS lda DEVNUM ; get original device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
862 pshs a ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
863 jsr LA5AE ; fetch device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
864 jsr LA406 ; check for open file
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
865 jsr LA35F ; set up print parameters
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
866 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
867 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
868 ; VARPTR function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
869 VARPTRTOK jsr LB26A ; make sure we have (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
870 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
871 pshs d ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
872 jsr LB357 ; parse variable descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
873 jsr LB267 ; make sure there is a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
874 puls d ; get original end of arrays
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
875 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
876 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
877 bne L8724 ; brif so (FC error)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
878 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
879 ; 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
880 ; 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
881 L86D6 jsr GETNCH ; eat the MID$ token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
882 jsr LB26A ; force (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
883 jsr LB357 ; evaluate the variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
884 pshs x ; save variable descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
885 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
886 cmpd FRETOP ; is it in string space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
887 bls L86EB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
888 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
889 bls L86FD ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
890 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
891 jsr LB56D ; allocate space in string space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
892 pshs x ; save pointer to string space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
893 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
894 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
895 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
896 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
897 pshs u ; save descriptor address again
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
898 L86FD jsr LB738 ; evaluate ",start"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
899 pshs b ; save start offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
900 tstb ; is start 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
901 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
902 ldb #255 ; default use the entire string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
903 cmpa #') ; end of parameters?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
904 beq L870E ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
905 jsr LB738 ; evaluate ",length"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
906 L870E pshs b ; save length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
907 jsr LB267 ; make sure we have a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
908 ldb #0xb3 ; make sure we have =
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
909 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
910 bsr L8748 ; evaluate replacement string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
911 tfr x,u ; save replacement string address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
912 ldx 2,s ; get original string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
913 lda ,x ; get length of original string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
914 suba 1,s ; subtract start position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
915 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
916 L8724 jmp LB44A ; raise illegal function call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
917 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
918 cmpa ,s ; compare to length desired
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
919 bhs L872E ; brif new length fits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
920 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
921 L872E lda 1,s ; get position offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
922 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
923 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
924 decb ; we work with 0-based offsets
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
925 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
926 tsta ; replacing 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
927 beq L8746 ; brif so - done
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
928 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
929 bls L873F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
930 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
931 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
932 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
933 jsr LA59A ; copy string data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
934 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
935 L8748 jsr LB156 ; evaluate expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
936 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
937 ; STRING$ function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
938 STRING jsr LB26A ; make sure we have (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
939 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
940 pshs b ; save repeat count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
941 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
942 jsr LB156 ; evaluate the thing to repeat
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
943 jsr LB267 ; make sure we have a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
944 lda VALTYP ; is it string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
945 bne L8768 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
946 jsr LB70E ; get 8 bit character code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
947 bra L876B ; use that
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
948 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
949 L876B pshs b ; save repeat character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
950 ldb 1,s ; get repeat count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
951 jsr LB50F ; reserve space for the string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
952 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
953 beq L877B ; brif NULL string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
954 L8776 sta ,x+ ; put character into string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
955 decb ; put enough?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
956 bne L8776 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
957 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
958 ; INSTR function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
959 INSTR jsr LB26A ; evaluate (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
960 jsr LB156 ; evaluate first argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
961 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
962 pshs b ; save start position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
963 lda VALTYP ; get type of first argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
964 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
965 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
966 stb ,s ; save offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
967 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
968 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
969 jsr LB156 ; evaluate the search string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
970 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
971 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
972 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
973 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
974 jsr L8748 ; evalute the target string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
975 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
976 jsr LB267 ; make sure we have a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
977 ldx 3,s ; get search string address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
978 jsr LB659 ; get string details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
979 pshs b ; save search string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
980 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
981 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
982 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
983 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
984 ldb 6,s ; get start position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
985 decb ; zero-base it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
986 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
987 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
988 ldu 2,s ; get target string pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
989 ldb 1,s ; get targetlength
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
990 lda ,s ; get length of serach
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
991 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
992 inca ; add one for "inclusivity"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
993 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
994 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
995 L87CD lda ,x+ ; compare a byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
996 cmpa ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
997 bne L87DF ; brif no match
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
998 decb ; compared all of target?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
999 bne L87CD ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1000 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
1001 skip1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1002 L87D9 clrb ; flag no match
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1003 leas 7,s ; clean up stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1004 jmp LB4F3 ; return unsigned B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1005 L87DF inc 6,s ; bump start position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1006 leax 1,y ; move starting pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1007 bra L87BE ; see if we match now
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1008 ; Number parsing handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1009 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
1010 bne L8845 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1011 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
1012 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
1013 clr FPA0+3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1014 ldx #FPA0+2 ; point to accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1015 jsr GETNCH ; eat the &
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1016 cmpa #'O ; octal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1017 beq L880A ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1018 cmpa #'H ; hex?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1019 beq L881F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1020 jsr GETCCH ; reset flags on input
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1021 bra L880C ; go process octal (default)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1022 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
1023 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
1024 ldb #3 ; base 8 multiplier
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1025 bsr L8834 ; add digit to accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1026 L880A jsr GETNCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1027 L880C bcs L8800 ; brif numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1028 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
1029 clr FPA0+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1030 clr VALTYP ; result is numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1031 clr FPSBYT ; clear out any extra precision
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1032 clr FP0SGN ; make it positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1033 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
1034 stb FP0EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1035 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
1036 L881F jsr GETNCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1037 bcs L882E ; brif digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1038 jsr LB3A2 ; set carry if not alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1039 L8826 bcs L880E ; brif not alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1040 cmpa #'G ; is it valid HEX digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1041 bhs L880E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1042 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
1043 L882E ldb #4 ; four bits per digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1044 bsr L8834 ; add digit to accumlator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1045 bra L881F ; process another digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1046 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
1047 rol ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1048 lbcs LBA92 ; brif too big - overflow
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1049 decb ; done enough bit shifts?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1050 bne L8834 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1051 L883F suba #'0 ; remove ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1052 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
1053 sta 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1054 L8845 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1055 ; Expression evaluation handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1056 XVEC15 puls u ; get back return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1057 clr VALTYP ; set result to numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1058 ldx CHARAD ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1059 jsr GETNCH ; get the input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1060 cmpa #'& ; HEX or OCTAL?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1061 beq L87EB ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1062 cmpa #0xcc ; FN?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1063 beq L88B4 ; brif so - do "FNx()"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1064 cmpa #0xff ; function token?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1065 bne L8862 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1066 jsr GETNCH ; get function token value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1067 cmpa #0x83 ; USR?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1068 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
1069 L8862 stx CHARAD ; restore input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1070 jmp ,u ; return to mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1071 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
1072 leax 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1073 bne L8845 ; brif not - we're good
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1074 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
1075 L886E jmp LAC46 ; raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1076 ; DEF command (DEF FN, DEF USR)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1077 DEF ldx [CHARAD] ; get two input characters
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1078 cmpx #0xff83 ; USR?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1079 lbeq L890F ; brif so - do DEF USR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1080 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
1081 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
1082 jsr LB26A ; make sure we have (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1083 ldb #0x80 ; disallow arrays as arguments
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1084 stb ARYDIS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1085 jsr LB357 ; evaluate variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1086 bsr L88B1 ; make sure it's numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1087 jsr LB267 ; make sure we have )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1088 ldb #0xb3 ; make sure we have =
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1089 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1090 ldx V4B ; get variable descriptor address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1091 ldd CHARAD ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1092 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
1093 ldd VARPTR ; get descriptor address of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1094 std 2,x ; save argument descriptor address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1095 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
1096 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
1097 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1098 ldb #0x80 ; disable array lookup
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1099 stb ARYDIS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1100 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
1101 jsr LB35C ; find the variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1102 stx V4B ; save descriptor pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1103 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
1104 ; Evaluate an FN call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1105 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
1106 pshs x ; save descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1107 jsr LB262 ; evaluate parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1108 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
1109 puls u ; get FN descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1110 ldb #2*25 ; code for undefined function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1111 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
1112 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
1113 ldy CHARAD ; save current input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1114 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
1115 stu CHARAD ; put input pointer there
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1116 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
1117 pshs a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1118 ldd ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1119 ldu 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1120 pshs u,y,x,d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1121 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
1122 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
1123 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
1124 std ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1125 stu 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1126 puls a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1127 sta 4,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1128 jsr GETCCH ; test end of FN formula
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1129 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
1130 sty CHARAD ; restore input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1131 L88EF rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1132 ; Error handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1133 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
1134 blo L88EF ; brif not - return to mainline
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1135 jsr LA7E9 ; turn off tape
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1136 jsr LA974 ; turn off sound
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1137 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
1138 clr DEVNUM ; reset output to screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1139 jsr LB95C ; do a newline if needed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1140 jsr LB9AF ; do a ?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1141 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
1142 jmp LAC60 ; go display error message
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1143 ; 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
1144 ; 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
1145 L890B fcc 'UF' ; 25 undefined function call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1146 fcc 'NE' ; 26 File not found
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1147 ; DEF USR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1148 L890F jsr GETNCH ; eat the USR token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1149 bsr L891C ; get pointer to USR call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1150 pshs x ; save FN exec address location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1151 bsr L8944 ; calculate execution address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1152 puls u ; get FN address pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1153 stx ,u ; save new address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1154 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1155 L891C clrb ; default routine number is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1156 jsr GETNCH ; fetch the call number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1157 bcc L8927 ; brif not a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1158 suba #'0 ; remove ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1159 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
1160 jsr GETNCH ; eat the call number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1161 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
1162 aslb ; two bytes per address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1163 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
1164 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1165 ; Evaluate a USR call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1166 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
1167 ldx ,x ; get routine address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1168 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1169 jsr LB262 ; evaluate argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1170 ldx #FP0EXP ; point to FPA0 (argument value)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1171 lda VALTYP ; is it string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1172 beq L8943 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1173 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
1174 ldx FPA0+2 ; get string descriptor pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1175 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
1176 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
1177 L8944 ldb #0xb3 ; check for "="
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1178 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1179 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
1180 ; Extended Basic IRQ handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1181 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
1182 bmi L8952 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1183 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
1184 L8952 lda PIA0+2 ; clear VSYNC interrupt
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1185 ldx TIMVAL ; increment the TIMER value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1186 leax 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1187 stx TIMVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1188 jmp L9C3E ; check for other stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1189 ; TIMER=
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1190 L8960 jsr GETNCH ; eat the TIMER token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1191 bsr L8944 ; evaluate =nnnn to X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1192 stx TIMVAL ; set the timer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1193 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1194 ; TIMER function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1195 TIMER ldx TIMVAL ; get timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1196 stx FPA0+2 ; set it in FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1197 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
1198 ; DEL command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1199 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
1200 jsr LAF67 ; parse line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1201 jsr LAD01 ; find line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1202 stx VD3 ; save address of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1203 jsr GETCCH ; is there something more?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1204 beq L8990 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1205 cmpa #0xac ; dash?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1206 bne L89BF ; brif not - error out
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1207 jsr GETNCH ; each the -
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1208 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
1209 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
1210 bra L8990 ; do the deletion
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1211 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
1212 sta BINVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1213 L8990 ldu VD3 ; point end to start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1214 skip2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1215 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
1216 ldd ,u ; check for end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1217 beq L899F ; brif end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1218 ldd 2,u ; get line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1219 subd BINVAL ; is it in range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1220 bls L8993 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1221 L899F ldx VD3 ; get starting line address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1222 bsr L89B8 ; close up gap
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1223 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
1224 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
1225 jsr LACF1 ; recompute netl ine pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1226 jmp LAC73 ; return to immediate mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1227 L89AE jsr LAF67 ; parse a line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1228 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
1229 L89B4 lda ,u+ ; copy a byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1230 sta ,x+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1231 L89B8 cmpu VARTAB ; end of program?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1232 bne L89B4 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1233 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
1234 L89BF rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1235 ; LINE INPUT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1236 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
1237 jsr GETNCH ; eat the "INPUT" token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1238 cmpa #'# ; device number?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1239 bne L89D2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1240 jsr LA5A5 ; parse device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1241 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
1242 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
1243 L89D2 cmpa #'" ; is there a prompt?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1244 bne L89E1 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1245 jsr LB244 ; parse the string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1246 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
1247 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1248 jsr LB99F ; go actually display the prompt
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1249 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
1250 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
1251 leas 2,s ; clean up stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1252 clr DEVNUM ; reset to screen/keyboard
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1253 jsr LB357 ; parse a variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1254 stx VARDES ; save pointer to it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1255 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
1256 ldx #LINBUF ; point to input buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1257 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
1258 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
1259 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
1260 ; RENUM command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1261 L89FC jsr LAF67 ; read a line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1262 ldx BINVAL ; get value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1263 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1264 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
1265 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
1266 jmp LAD01 ; go find line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1267 RENUM jsr LAD26 ; erase variables
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1268 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
1269 std VD5 ; set starting line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1270 std VCF ; set number interval
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1271 clrb ; now D is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1272 std VD1 ; save default start for renumbering
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1273 jsr GETCCH ; are there any arguments
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1274 bcc L8A20 ; brif not numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1275 bsr L89FC ; fetch line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1276 stx VD5 ; save line beginning number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1277 jsr GETCCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1278 L8A20 beq L8A3D ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1279 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
1280 bcc L8A2D ; brif next isn't numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1281 bsr L89FC ; fetch starting line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1282 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
1283 jsr GETCCH ; fetch input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1284 L8A2D beq L8A3D ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1285 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
1286 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
1287 bsr L89FC ; parse the number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1288 stx VCF ; save interval
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1289 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
1290 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
1291 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
1292 stx VD3 ; save address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1293 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
1294 bsr L8A04 ; find that line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1295 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
1296 blo L8A83 ; brif so - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1297 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
1298 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
1299 jsr LACEF ; recalculate next line pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1300 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
1301 stx VD3 ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1302 bsr L8A91 ; make sure line numbers exist
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1303 bsr L8A68 ; renumber the actual lines
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1304 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
1305 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
1306 jsr LAD26 ; erase variables, reset stack, etc.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1307 jsr LACEF ; recalculate next line pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1308 jmp LAC73 ; bounce back to immediate mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1309 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
1310 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
1311 sta VD8 ; save line number flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1312 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
1313 ldd VD5 ; get the current renumbering number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1314 bsr L8A86 ; return if end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1315 L8A71 tst VD8 ; test line number flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1316 bne L8A77 ; brif not adding new numbers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1317 std 2,x ; set new number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1318 L8A77 ldx ,x ; point to next line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1319 bsr L8A86 ; return if end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1320 addd VCF ; add interval to current number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1321 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
1322 cmpa #MAXLIN ; maximum legal number?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1323 blo L8A71 ; brif so - do another
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1324 L8A83 jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1325 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
1326 ldd ,x ; get next line pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1327 puls d ; unclobber D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1328 bne L8A90 ; brif not end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1329 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
1330 L8A90 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1331 L8A91 ldx TXTTAB ; get start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1332 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
1333 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
1334 bsr L8A86 ; return if end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1335 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
1336 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
1337 lda ,x ; check input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1338 beq L8A95 ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1339 stx TEMPTR ; save current pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1340 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
1341 beq L8AB2 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1342 deca ; does line exist?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1343 beq L8AD3 ; brif line number exists
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1344 deca ; not part of something to process?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1345 bne L8A9B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1346 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
1347 sta ,x+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1348 bra L8A99 ; go process another
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1349 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
1350 dec 2,x ; is MS byte zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1351 beq L8AB9 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1352 clra ; set MS byte to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1353 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
1354 dec 4,x ; is it zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1355 beq L8AC0 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1356 clrb ; clear byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1357 L8AC0 std 1,x ; save binary number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1358 std BINVAL ; save trial number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1359 jsr LAD01 ; find the line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1360 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
1361 bcs L8AAC ; brif line number not found
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1362 ldd V47 ; get address of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1363 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
1364 std ,x ; save address of correct number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1365 bra L8A99 ; go process more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1366 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
1367 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
1368 ldx 2,x ; get correct line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1369 stx V47 ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1370 bra L8AC7 ; insert into line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1371 L8ADD ldx TXTTAB ; get beginning of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1372 bra L8AE5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1373 L8AE1 ldx CHARAD ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1374 leax 1,x ; move it forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1375 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
1376 leax 2,x ; move past line address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1377 L8AE9 leax 1,x ; move forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1378 L8AEB stx CHARAD ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1379 L8AED jsr GETNCH ; get an input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1380 L8AEF tsta ; is it actual 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1381 beq L8AE1 ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1382 bpl L8AED ; brif not a token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1383 ldx CHARAD ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1384 cmpa #0xff ; function?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1385 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
1386 jsr RVEC22 ; do the RAM hook thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1387 cmpa #0xa7 ; THEN?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1388 beq L8B13 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1389 cmpa #0x84 ; ELSE?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1390 beq L8B13 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1391 cmpa #0x81 ; GO(TO|SUB)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1392 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
1393 jsr GETNCH ; get TO/SUB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1394 cmpa #0xa5 ; GOTO?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1395 beq L8B13 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1396 cmpa #0xa6 ; GOSUB?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1397 bne L8AEB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1398 L8B13 jsr GETNCH ; fetch character after token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1399 bcs L8B1B ; brif numeric (line number)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1400 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
1401 bra L8AEF ; keep checking for line numbers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1402 L8B1B ldx CHARAD ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1403 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1404 jsr LAF67 ; parse line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1405 ldx CHARAD ; get input pointer after line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1406 L8B24 lda ,-x ; get character before pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1407 jsr L90AA ; set C if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1408 bcs L8B24 ; brif not numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1409 leax 1,x ; move pointer up
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1410 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
1411 subb 1,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1412 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
1413 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
1414 blo L8B41 ; brif less than 5 bytes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1415 leau ,x ; move remainder of program backward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1416 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
1417 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
1418 jsr L89B8 ; shift program backward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1419 bra L8B55
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1420 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
1421 ldx VARTAB ; get end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1422 stx V43 ; set source pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1423 negb ; get positive difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1424 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
1425 stx V41 ; set copy destination
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1426 stx VARTAB ; save new end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1427 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
1428 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
1429 stx CHARAD ; set input there
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1430 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
1431 lda #1 ; set "new number" flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1432 sta ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1433 sta 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1434 sta 4,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1435 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
1436 bne L8B67 ; brif it is not zero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1437 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
1438 inc 2,x ; flag MSB as 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1439 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
1440 ldb BINVAL+1 ; get LSB of number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1441 bne L8B71 ; brif nonzero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1442 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
1443 inc 4,x ; flag LSB as 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1444 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
1445 jsr GETCCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1446 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
1447 beq L8B13 ; brif so - process another
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1448 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
1449 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
1450 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
1451 L8B7F leax 1,x ; move forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1452 ldd 2,x ; get this line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1453 std CURLIN ; save it (for error message)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1454 jsr L8A86 ; return if end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1455 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
1456 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
1457 L8B8C lda ,x ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1458 beq L8B7F ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1459 deca ; valid line new line number?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1460 beq L8BAE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1461 suba #2 ; undefined line?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1462 bne L8B8A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1463 pshs x ; save line number pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1464 ldx #L8BD9-1 ; show UL message
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1465 jsr STRINOUT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1466 ldx ,s ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1467 ldd 1,x ; get undefined line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1468 jsr LBDCC ; display line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1469 jsr LBDC5 ; print out "IN XXXX"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1470 jsr LB958 ; do a newline
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1471 puls x ; get input pointer back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1472 L8BAE pshs x ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1473 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
1474 std FPA0+2 ; save it in FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1475 jsr L880E ; adjust FPA0 as integer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1476 jsr LBDD9 ; convert to text string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1477 puls u ; get previous input pointer address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1478 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
1479 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
1480 lda ,x ; do we have a digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1481 beq L8BC9 ; brif not - end of number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1482 decb ; mark a byte consumed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1483 sta ,u+ ; put digit in program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1484 bra L8BBE ; copy another digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1485 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
1486 tstb ; did number fill whole space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1487 beq L8B8C ; brif so - move on
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1488 leay ,u ; save end of number pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1489 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
1490 jsr L89B8 ; close up gap in program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1491 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
1492 bra L8B8C ; go process more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1493 L8BD9 fcn 'UL '
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1494 ; HEX$ function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1495 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
1496 ldx #STRBUF+2 ; point to string buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1497 ldb #4 ; convert 4 nibbles
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1498 L8BE5 pshs b ; save nibble counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1499 clrb ; clear digit accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1500 lda #4 ; do 4 shifts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1501 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
1502 rol FPA0+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1503 rolb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1504 deca ; done all shifts?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1505 bne L8BEA ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1506 tstb ; do we have a nonzero digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1507 bne L8BFF ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1508 lda ,s ; is it last digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1509 deca
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1510 beq L8BFF ; brif so - keep the 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1511 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
1512 beq L8C0B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1513 L8BFF addb #'0 ; add ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1514 cmpb #'9 ; above 9?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1515 bls L8C07 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1516 addb #7 ; adjust into alpha range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1517 L8C07 stb ,x+ ; save digit in output
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1518 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
1519 L8C0B puls b ; get back nibble counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1520 decb ; done all?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1521 bne L8BE5 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1522 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
1523 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
1524 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
1525 ; DLOAD command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1526 DLOAD jsr LA429 ; close files
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1527 L8C1B clr ,-s ; save default token (not DLOADM)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1528 cmpa #'M ; is it DLOADM?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1529 bne L8C25 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1530 sta ,s ; save the "M"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1531 jsr GETNCH ; eat the "M"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1532 L8C25 jsr LA578 ; parse the file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1533 jsr GETCCH ; get character after file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1534 beq L8C44 ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1535 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
1536 cmpa #', ; do we have 2 commas?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1537 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
1538 jsr EVALEXPB ; evaluate baud rate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1539 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
1540 tstb ; was argument 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1541 beq L8C42 ; brif so - 300 baud
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1542 lda #44 ; constant for 1200 baud
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1543 decb ; was it 1?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1544 lbne LB44A ; raise error if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1545 L8C42 sta DLBAUD ; save baud rate constant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1546 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
1547 pshs a ; save register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1548 lda #-3 ; set input to DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1549 sta DEVNUM
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1550 puls a ; restore register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1551 tst ,s+ ; is it DLOADM?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1552 bne L8C85 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1553 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
1554 tstb ; ASCII?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1555 beq L8C5F ; brif not - do error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1556 jsr LAD19 ; clear out program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1557 jmp LAC7C ; go read program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1558 L8C5F jmp LA616 ; raise bad file mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1559 ; CLOADM patch for Extended Basic
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1560 L8C62 jsr GETNCH ; get character after CLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1561 cmpa #'M ; CLOADM?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1562 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
1563 clr FILSTA ; close tape file
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1564 jsr GETNCH ; eat the "M"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1565 jsr LA578 ; parse file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1566 jsr LA648 ; find the file
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1567 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
1568 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
1569 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
1570 dec DEVNUM ; set source device to tape
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1571 jsr LA635 ; go read the first block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1572 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
1573 ; 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
1574 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
1575 bne L8C5F ; brif not - raise an error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1576 ldx ZERO ; default load offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1577 jsr GETCCH ; is there any offset?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1578 beq L8C96 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1579 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
1580 jsr LB73D ; evaluate offset in X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1581 L8C96 stx VD3 ; save offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1582 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
1583 L8C9B bsr L8CC6 ; get type of "amble"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1584 pshs a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1585 bsr L8CBF ; read in block length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1586 tfr d,y ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1587 bsr L8CBF ; read in load address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1588 addd VD3 ; add in offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1589 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
1590 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
1591 lda ,s+ ; get "amble" type
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1592 lbne LA42D ; brif postamble - close file
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1593 L8CB1 bsr L8CC6 ; read a data byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1594 sta ,x ; save in memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1595 cmpa ,x+ ; did it actually save?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1596 bne L8CCD ; brif not RAM - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1597 leay -1,y ; done yet?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1598 bne L8CB1 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1599 bra L8C9B ; look for another "amble"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1600 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
1601 L8CC1 bsr L8CC6 ; read character to A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1602 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
1603 L8CC5 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1604 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
1605 tst CINBFL ; EOF?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1606 beq L8CC5 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1607 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
1608 L8CD0 bsr L8D14 ; transmit file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1609 pshs b,a ; save file status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1610 inca ; was file found?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1611 beq L8CDD ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1612 ldu ZERO ; zero U - first block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1613 bsr L8CE4 ; read block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1614 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
1615 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
1616 jmp LAC46 ; raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1617 L8CE2 ldu CBUFAD ; get block number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1618 L8CE4 leax 1,u ; bump block number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1619 stx CBUFAD ; save new block number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1620 ldx #CASBUF ; use cassette buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1621 jsr L8D7C ; read a block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1622 jmp LA644 ; reset input buffer pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1623 ; Generic input handler for Extended Basic
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1624 XVEC4 lda DEVNUM ; get device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1625 cmpa #-3 ; DLOAD?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1626 bne L8D01 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1627 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
1628 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
1629 tst CINCTR ; anything available?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1630 bne L8D02 ; brif so - fetch one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1631 com CINBFL ; flag EOF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1632 L8D01 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1633 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
1634 ldx CINPTR ; get buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1635 lda ,x+ ; get character from buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1636 pshs a ; save it for return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1637 stx CINPTR ; save new input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1638 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
1639 bne L8D12 ; brif buffer not empty
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1640 bsr L8CE2 ; go read a block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1641 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
1642 L8D14 clra ; clear attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1643 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
1644 leay ,s ; set up frame pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1645 bra L8D1D ; go read block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1646 L8D1B bsr L8D48 ; bump attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1647 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
1648 bsr L8D58
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1649 bne L8D1B ; brif no echo or error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1650 ldx #CFNBUF+1 ; point to file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1651 L8D26 lda ,x+ ; get file name characater
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1652 jsr L8E04 ; send it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1653 cmpx #CFNBUF+9 ; end of file name?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1654 bne L8D26 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1655 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
1656 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
1657 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
1658 bne L8D1B ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1659 sta 2,y ; save file type
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1660 bsr L8D72 ; read ASCII flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1661 bne L8D1B ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1662 sta 3,y ; save ASCII flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1663 bsr L8D6B ; read check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1664 bne L8D1B ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1665 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
1666 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
1667 L8D48 inc ,y ; bump attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1668 lda ,y ; get new count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1669 cmpa #5 ; done 5 times?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1670 blo L8D6A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1671 lda #0xbc ; send abort code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1672 jsr L8E0C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1673 jmp LA619 ; raise an I/O error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1674 L8D58 pshs a ; save compare character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1675 bsr L8DB8 ; send character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1676 bne L8D60 ; brif read error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1677 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
1678 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
1679 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
1680 bsr L8DB8 ; send it and read
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1681 bne L8D6A ; brif read error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1682 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
1683 L8D6A rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1684 L8D6B bsr L8D72 ; read character from rs232
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1685 bne L8D6A ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1686 lda 1,y ; get check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1687 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1688 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
1689 pshs a,cc ; save result (and flags)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1690 eora 1,y ; accumulate xor checksum
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1691 sta 1,y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1692 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
1693 L8D7C clra ; reset attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1694 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
1695 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
1696 rol 6,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1697 lsr 7,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1698 leay ,s ; set up frame pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1699 bra L8D8B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1700 L8D89 bsr L8D48 ; bump attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1701 L8D8B lda #0x97 ; send block request code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1702 bsr L8D58
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1703 bne L8D89 ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1704 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
1705 bsr L8E04
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1706 lda 7,y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1707 bsr L8E04
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1708 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
1709 bne L8D89 ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1710 bsr L8D72 ; read block size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1711 bne L8D89 ; brif read error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1712 sta 4,y ; save character count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1713 ldx 2,y ; get buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1714 ldb #128 ; length of data block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1715 L8DA7 bsr L8D72 ; read a data byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1716 bne L8D89 ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1717 sta ,x+ ; save byte in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1718 decb ; done a whole block?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1719 bne L8DA7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1720 bsr L8D6B ; read check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1721 bne L8D89 ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1722 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
1723 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
1724 L8DB8 clr 1,y ; clear check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1725 bsr L8E0C ; output character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1726 L8DBC clra ; clear attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1727 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
1728 orcc #0x50 ; disable interrupts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1729 lda TIMOUT ; get timout delay (variable)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1730 ldx ZERO ; get constant timeout value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1731 L8DC5 bsr L8DE6 ; get RS232 status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1732 bcc L8DC5 ; brif "space" - waiting for "mark"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1733 L8DC9 bsr L8DE6 ; get RS232 status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1734 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
1735 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
1736 ldb #1 ; set bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1737 pshs b ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1738 clra ; reset data byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1739 L8DD4 bsr L8DF7 ; wait one bit time
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1740 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
1741 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1742 bcc L8DDE ; brif "space" (0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1743 ora ,s ; merge bit probe in
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1744 L8DDE asl ,s ; shift bit probe over
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1745 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
1746 leas 1,s ; remove bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1747 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
1748 L8DE6 ldb PIA1+2 ; get RS232 value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1749 rorb ; put in C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1750 leax 1,x ; bump timeout
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1751 bne L8DF6 ; brif nonzero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1752 deca ; did the number of waits expire?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1753 bne L8DF6 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1754 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
1755 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
1756 inca ; clear Z (A was zero above)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1757 L8DF6 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1758 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
1759 L8DF9 pshs a ; save register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1760 lda DLBAUD ; get baud rate constant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1761 L8DFD brn L8DFD ; do nothing - delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1762 deca ; time expired?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1763 bne L8DFD ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1764 puls a,pc ; restore register and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1765 L8E04 pshs a ; save character to send
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1766 eora 1,y ; accumulate chechsum
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1767 sta 1,y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1768 puls a ; get character back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1769 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
1770 orcc #0x50 ; disable interrupts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1771 bsr L8DF7 ; do a bit delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1772 bsr L8DF7 ; do another bit delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1773 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
1774 bsr L8DF7 ; do a bit delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1775 ldb #1 ; bit probe start at LSB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1776 pshs b ; save bitprobe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1777 L8E1D lda 2,s ; get output byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1778 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
1779 beq L8E25 ; brif output is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1780 lda #2 ; set output to "marking"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1781 L8E25 sta PIA1 ; send bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1782 bsr L8DF7 ; do a bit delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1783 asl ,s ; shift bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1784 bcc L8E1D ; brif not last bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1785 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
1786 sta PIA1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1787 leas 1,s ; lose bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1788 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
1789 ; PRINT USING
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1790 ; 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
1791 ; 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
1792 ; Extended Color Basic ROM.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1793 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1794 ; This uses several variables:
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1795 ; VD5: pointer to format string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1796 ; VD7: next print item flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1797 ; VD8: right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1798 ; 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
1799 ; VDA: status byte (bits as follows):
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1800 ; 6: force comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1801 ; 5: force leading *
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1802 ; 4: floating $
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1803 ; 3: pre-sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1804 ; 2: post-sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1805 ; 0: scientific notation
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1806 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
1807 sta VD9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1808 L8E3B decb ; consume character from format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1809 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
1810 jsr GETCCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1811 lbeq L8ED8 ; brif end of line - bail
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1812 stb VD3 ; save remaining string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1813 jsr LB156 ; evaluate the argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1814 jsr LB146 ; error if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1815 ldx FPA0+2 ; get descriptor for argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1816 stx V4D ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1817 ldb VD9 ; get length counter to use
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1818 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
1819 jsr LB99F ; print the formatted string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1820 ldx FPA0+2 ; get formatted string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1821 ldb VD9 ; get requested length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1822 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
1823 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
1824 lbmi L8FB3 ; brif so - go process more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1825 jsr LB9AC ; output a space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1826 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
1827 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
1828 stx TEMPTR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1829 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
1830 sta VD9 ; save length counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1831 L8E71 lda ,x ; get character in string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1832 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
1833 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
1834 cmpa #0x20 ; space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1835 bne L8E82 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1836 inc VD9 ; bump spaces count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1837 leax 1,x ; move format pointer forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1838 decb ; consume character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1839 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
1840 L8E82 ldx TEMPTR ; restore format string pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1841 ldb VD3 ; get back format string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1842 lda #'% ; show % as debugging aid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1843 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
1844 jsr PUTCHR ; output character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1845 bra L8EB9 ; go process more format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1846 ; PRINT extension for USING
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1847 XVEC9 cmpa #0xcd ; USING?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1848 beq L8E95 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1849 rts ; return to mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1850 ; 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
1851 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
1852 jsr LB158 ; evaluate the format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1853 jsr LB146 ; error if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1854 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
1855 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1856 ldx FPA0+2 ; get format string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1857 stx VD5 ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1858 bra L8EAE ; process format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1859 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
1860 beq L8EB4 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1861 ldx VD5 ; get back format string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1862 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
1863 ldb ,x ; get length of format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1864 bne L8EB7 ; brif string is non-null
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1865 L8EB4 jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1866 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
1867 L8EB9 clr VDA ; clear status (new item)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1868 L8EBB clr VD9 ; clear left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1869 lda ,x+ ; get character from format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1870 cmpa #'! ; ! (use first character of string)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1871 lbeq L8E37 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1872 cmpa #'# ; digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1873 beq L8F24 ; brif so - handle numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1874 decb ; consume format character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1875 bne L8EE2 ; brif not done
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1876 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
1877 jsr PUTCHR ; output format string character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1878 L8ED2 jsr GETCCH ; get current input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1879 bne L8EA8 ; brif not end of statement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1880 lda VD7 ; get next item flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1881 L8ED8 bne L8EDD ; brif more print items
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1882 jsr LB958 ; do newline
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1883 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
1884 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
1885 L8EE2 cmpa #'+ ; is it + (pre-sign)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1886 bne L8EEF ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1887 jsr L8FD8 ; send a "+" if flags set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1888 lda #8 ; flag for pre-sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1889 sta VDA ; set flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1890 bra L8EBB ; go interpret some more stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1891 L8EEF cmpa #'. ; decimal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1892 beq L8F41 ; brif so - numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1893 cmpa #'% ; % (show string)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1894 lbeq L8E69 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1895 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
1896 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
1897 cmpa #'$ ; double $?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1898 beq L8F1A ; brif so - floating $
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1899 cmpa #'* ; double *?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1900 bne L8EFB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1901 lda VDA ; get status byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1902 ora #0x20 ; enable * padding
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1903 sta VDA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1904 cmpb #2 ; is $$ the last two?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1905 blo L8F20 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1906 lda 1,x ; is it $ after?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1907 cmpa #'$
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1908 bne L8F20 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1909 decb ; consume the "$"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1910 leax 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1911 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
1912 L8F1A lda VDA ; indicate floating $
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1913 ora #0x10
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1914 sta VDA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1915 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
1916 inc VD9 ; add one more left place
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1917 L8F24 clr VD8 ; clear right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1918 L8F26 inc VD9 ; bump left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1919 decb ; consume character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1920 beq L8F74 ; brif end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1921 lda ,x+ ; get next format character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1922 cmpa #'. ; decimal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1923 beq L8F4F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1924 cmpa #'# ; digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1925 beq L8F26 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1926 cmpa #', ; comma flag?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1927 bne L8F5A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1928 lda VDA ; set commas flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1929 ora #0x40
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1930 sta VDA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1931 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
1932 L8F41 lda ,x ; get character after .
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1933 cmpa #'# ; digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1934 lbne L8E88 ; brif not - invalid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1935 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
1936 sta VD8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1937 leax 1,x ; consume the .
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1938 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
1939 decb ; consume character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1940 beq L8F74 ; brif end of format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1941 lda ,x+ ; get another format character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1942 cmpa #'# ; digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1943 beq L8F4F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1944 L8F5A cmpa #0x5e ; up arrow?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1945 bne L8F74 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1946 cmpa ,x ; two of them?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1947 bne L8F74 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1948 cmpa 1,x ; three of them?
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 2,x ; four 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 cmpb #4 ; string actually has the characters?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1953 blo L8F74 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1954 subb #4 ; consome them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1955 leax 4,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1956 inc VDA ; set scientific notation bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1957 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
1958 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
1959 lda VDA ; is it pre-sign?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1960 bita #8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1961 bne L8F96 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1962 dec VD9 ; undo pre-sign adjustment
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1963 tstb ; end of string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1964 beq L8F96 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1965 lda ,x ; get next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1966 suba #'- ; post sign force?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1967 beq L8F8F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1968 cmpa #'+-'- ; plus?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1969 bne L8F96 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1970 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
1971 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
1972 ora VDA ; merge with flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1973 sta VDA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1974 decb ; consume character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1975 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
1976 lbeq L8ED8 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1977 stb VD3 ; save format string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1978 jsr LB141 ; evluate numeric expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1979 lda VD9 ; get left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1980 adda VD8 ; add in right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1981 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
1982 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
1983 jsr L8FE5 ; format value according to settings
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1984 leax -1,x ; move buffer pointer back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1985 jsr STRINOUT ; display formatted number string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1986 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
1987 jsr GETCCH ; get current input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1988 beq L8FC6 ; brif end of statement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1989 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
1990 cmpa #'; ; list separator ;?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1991 beq L8FC4 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1992 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
1993 bra L8FC6 ; process next item
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1994 L8FC4 jsr GETNCH ; munch the semicolon
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1995 L8FC6 ldx VD5 ; get format string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1996 ldb ,x ; get length of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1997 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
1998 ldx 2,x ; point to string address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1999 abx ; move pointer to correct spot
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2000 ldb VD3 ; get remaining string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2001 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
2002 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
2003 L8FD8 pshs a ; save character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2004 lda #'+ ; "error" flag character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2005 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
2006 beq L8FE3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2007 jsr PUTCHR ; output error flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2008 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
2009 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
2010 ldb #0x20 ; blank space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2011 lda VDA ; get flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2012 bita #8 ; pre-sign?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2013 beq L8FF2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2014 ldb #'+ ; plus sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2015 L8FF2 tst FP0SGN ; get sign of value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2016 bpl L8FFA ; brif positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2017 clr FP0SGN ; make number positive (for later)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2018 ldb #'- ; negative sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2019 L8FFA stb ,u+ ; put sign in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2020 ldb #'0 ; put a zero there
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2021 stb ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2022 anda #1 ; check scientific notation force
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2023 lbne L910D ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2024 ldx #LBDC0 ; point to FP 1E+9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2025 jsr LBCA0 ; is it less?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2026 bmi L9023 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2027 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
2028 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
2029 bne L9011
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2030 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
2031 sta 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2032 cmpx #STRBUF+3 ; done yet?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2033 bne L9015 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2034 lda #'% ; put "overflow" flag at start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2035 sta ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2036 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2037 L9023 lda FP0EXP ; get exponent of value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2038 sta V47 ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2039 beq L902C ; brif value is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2040 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
2041 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
2042 lbmi L90B3 ; brif < 100,000,000
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2043 nega ; get negative difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2044 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
2045 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
2046 jsr L90EA ; put leading zeroes in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2047 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
2048 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
2049 lda V47 ; get base 10 exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2050 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
2051 lda V47 ; get base 10 exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2052 jsr L9249 ; check for decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2053 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2054 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
2055 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
2056 L9050 deca ; subtract one place (for decimal)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2057 jsr L90EA ; put zeroes in buffer (trailing)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2058 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
2059 tsta ; was there a post sign?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2060 beq L9060 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2061 cmpb #'* ; was first character a *?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2062 beq L9060 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2063 stb ,u+ ; store the post sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2064 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
2065 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
2066 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
2067 stx TEMPTR ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2068 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
2069 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
2070 suba VD9 ; subtract out required left digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2071 beq L90A9 ; brif no padding needed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2072 lda ,x ; get current character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2073 cmpa #0x20 ; space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2074 beq L9065 ; brif so - advance pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2075 cmpa #'* ; *?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2076 beq L9065 ; brif so - advance pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2077 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
2078 L907C pshs a ; save character on stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2079 lda ,x+ ; get next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2080 cmpa #'- ; minus?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2081 beq L907C ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2082 cmpa #'+ ; plus?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2083 beq L907C ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2084 cmpa #'$ ; $?
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 #'0 ; zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2087 bne L909E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2088 lda 1,x ; get character after 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2089 bsr L90AA ; clear carry if number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2090 bcs L909E ; brif not number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2091 L9096 puls a ; get character off stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2092 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
2093 bne L9096 ; brif not - restore another
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2094 bra L9065 ; keep cleaning up buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2095 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
2096 tsta ; is it NUL?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2097 bne L909E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2098 ldx TEMPTR ; get string buffer start pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2099 lda #'% ; put error flag in front
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2100 sta ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2101 L90A9 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2102 L90AA cmpa #'0 ; zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2103 blo L90B2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2104 suba #'9+1 ; set C if > "9"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2105 suba #-('9+1)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2106 L90B2 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2107 L90B3 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2108 beq L90B8 ; brif not right digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2109 deca ; account for decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2110 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
2111 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
2112 clra ; force shift counter to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2113 L90BD pshs a ; save shift counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2114 L90BF bpl L90CB ; brif positive count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2115 pshs a ; save shift counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2116 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
2117 puls a ; get shift counter back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2118 inca ; account for the shift
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2119 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
2120 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
2121 suba ,s+ ; account for adjustment
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2122 sta V47 ; save new exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2123 adda #9 ; account for significant places
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2124 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
2125 lda VD9 ; get left decimal counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2126 suba #9 ; account for significant figures
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2127 suba V47 ; subtract exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2128 bsr L90EA ; output leading zeroes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2129 jsr L9263 ; initialize decimal and comma counters
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2130 bra L90FF ; process remainder of digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2131 L90E2 pshs a ; save zero counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2132 lda #'0 ; insert a 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2133 sta ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2134 puls a ; get back counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2135 L90EA deca ; do we need more zeroes?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2136 bpl L90E2 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2137 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2138 L90EE lda VD9 ; get left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2139 bsr L90EA ; put that many zeroes in
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2140 jsr L924D ; put decimal in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2141 lda #-9 ; figure out filler zeroes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2142 suba V47
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2143 bsr L90EA ; output required leader zeroes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2144 clr V45 ; clear decimal pointer counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2145 clr VD7 ; clear comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2146 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
2147 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2148 bne L9108 ; brif there are right digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2149 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
2150 L9108 adda V47 ; add base 10 exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2151 lbra L9050 ; add in leading astrisks, etc.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2152 L910D lda FP0EXP ; get exponent of FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2153 pshs a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2154 beq L9116 ; brif 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2155 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
2156 L9116 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2157 beq L911B ; brif no right digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2158 deca ; account for decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2159 L911B adda VD9 ; get left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2160 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
2161 ldb VDA ; get status flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2162 andb #4 ; post-sign?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2163 bne L9129 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2164 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
2165 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
2166 suba #9 ; account for significant figures
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2167 pshs a ; save shift counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2168 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
2169 pshs a ; save counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2170 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
2171 puls a ; get back counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2172 inca ; account for the shift
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2173 bra L9130 ; see if we need more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2174 L913C lda ,s ; get original shift count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2175 bmi L9141 ; brif shifting happened
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2176 clra ; flag for no shifting
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2177 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
2178 adda VD9 ; add left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2179 inca ; and post sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2180 adda STRBUF+3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2181 sta V45 ; save decimal counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2182 clr VD7 ; clear comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2183 jsr L9202 ; convert to decimal string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2184 puls a ; get shift counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2185 jsr L9281 ; put the needed zeroes in
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2186 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2187 bne L915A ; brif we want some
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2188 leau -1,u ; remove te decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2189 L915A ldb ,s+ ; get original exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2190 beq L9167 ; brif it was 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2191 ldb V47 ; get base 10 exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2192 addb #9 ; account for significant figures
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2193 subb VD9 ; remove left digit count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2194 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
2195 L9167 lda #'+ ; positive sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2196 tstb ; is base 10 exponent positive?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2197 bpl L916F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2198 lda #'- ; negative sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2199 negb ; flip exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2200 L916F sta 1,u ; put exponent sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2201 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
2202 sta ,u++
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2203 lda #'0-1 ; initialize digit accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2204 L9177 inca ; bump digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2205 subb #12 ; are we at the right digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2206 bcc L9177 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2207 addb #'0+12 ; add ASCII bias and undo extra subtraction
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2208 std ,u++ ; save exponent in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2209 clr ,u ; clear final byte in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2210 jmp L9054 ; insert *, $, etc.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2211 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
2212 ldb ,x ; get sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2213 pshs b ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2214 lda #0x20 ; default pad with spaces
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2215 ldb VDA ; get flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2216 bitb #0x20 ; padding with *?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2217 puls b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2218 beq L919E ; brif no padding
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2219 lda #'* ; pad with *
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2220 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
2221 bne L919E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2222 tfr a,b ; use pad character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2223 L919E pshs b ; save first character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2224 L91A0 sta ,x+ ; store padding
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2225 ldb ,x ; get next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2226 beq L91B6 ; brif end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2227 cmpb #'E ; exponent?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2228 beq L91B6 ; brif so - treat as 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2229 cmpb #'0 ; zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2230 beq L91A0 ; brif so - pad it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2231 cmpb #', ; leading comma?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2232 beq L91A0 ; brif so - pad it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2233 cmpb #'. ; decimal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2234 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
2235 L91B6 lda #'0 ; put a zero before
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2236 sta ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2237 L91BA lda VDA ; get status byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2238 bita #0x10 ; floating $?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2239 beq L91C4 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2240 ldb #'$ ; stuff a $ in
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2241 stb ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2242 L91C4 anda #4 ; pre-sgn?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2243 puls b ; get back first character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2244 bne L91CC ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2245 stb ,-x ; save leading character (sign)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2246 L91CC rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2247 L91CD pshs u ; save buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2248 clra ; initial exponent offset is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2249 L91D0 sta V47 ; save exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2250 ldb FP0EXP ; get actual exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2251 cmpb #0x80 ; is value >= 1.0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2252 bhi L91E9 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2253 ldx #LBDC0 ; point to FP number 1E9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2254 jsr LBACA ; multiply by 1000000000
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2255 lda V47 ; account for 9 shifts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2256 suba #9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2257 bra L91D0 ; brif not there yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2258 L91E4 jsr LBB82 ; divide by 10
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2259 inc V47 ; account for shift
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2260 L91E9 ldx #LBDBB ; point to 999999999
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2261 jsr LBCA0 ; compare it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2262 bgt L91E4 ; brif not in range yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2263 L91F1 ldx #LBDB6 ; point to 99999999.9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2264 jsr LBCA0 ; compare
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2265 bgt L9200 ; brif in range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2266 jsr LBB6A ; multiply by 10
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2267 dec V47 ; account for shift
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2268 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
2269 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
2270 L9202 pshs u ; save buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2271 jsr LB9B4 ; add .5 (round off)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2272 jsr LBCC8 ; convert to integer format
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2273 puls u ; restore buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2274 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
2275 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
2276 L9211 bsr L9249 ; check for comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2277 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
2278 adda 3,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2279 sta FPA0+3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2280 lda FPA0+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2281 adca 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2282 sta FPA0+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2283 lda FPA0+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2284 adca 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2285 sta FPA0+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2286 lda FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2287 adca ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2288 sta FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2289 incb ; add one to digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2290 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
2291 rolb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2292 bvc L9213 ; brif we haven't "wrapped"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2293 bcc L9235 ; brif subtracting
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2294 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
2295 negb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2296 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
2297 leax 4,x ; move to next power
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2298 tfr b,a ; save digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2299 anda #0x7f ; mask off subtract flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2300 sta ,u+ ; save digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2301 comb ; toggle add/subtract
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2302 andb #0x80
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2303 cmpx #LBEE9 ; done all places?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2304 bne L9211 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2305 clr ,u ; but NUL at end
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2306 L9249 dec V45 ; at decimal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2307 bne L9256 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2308 L924D stu VARPTR ; save decimal point pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2309 lda #'. ; insert decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2310 sta ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2311 clr VD7 ; clear comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2312 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2313 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
2314 bne L9262 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2315 lda #3 ; reset comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2316 sta VD7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2317 lda #', ; insert comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2318 sta ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2319 L9262 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2320 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
2321 adda #10 ; account for significant figures
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2322 sta V45 ; save decimal counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2323 inca ; add one for decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2324 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
2325 bcc L926A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2326 adda #5 ; renormalize to range 1-3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2327 sta VD7 ; save comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2328 lda VDA ; get status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2329 anda #0x40 ; commas wanted?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2330 bne L927A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2331 sta VD7 ; clear comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2332 L927A rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2333 L927B pshs a ; save zeroes counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2334 bsr L9249 ; check for decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2335 puls a ; get back counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2336 L9281 deca ; need a zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2337 bmi L928E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2338 pshs a ; save counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2339 lda #'0 ; put a zero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2340 sta ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2341 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
2342 bne L927B ; brif not done enough
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2343 L928E rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2344 ; 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
2345 ; 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
2346 ; with the DRAW command.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2347 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2348 ; 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
2349 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
2350 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2351 asla ; two bytes per address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2352 ldu a,u ; get routine address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2353 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2354 ; 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
2355 L9298 bsr L928F ; fetch normalization routine pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2356 jmp ,u ; transfer control to it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2357 L929C fdb L92A6 ; PMODE 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2358 fdb L92C2 ; PMODE 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2359 fdb L92A6 ; PMODE 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2360 fdb L92C2 ; PMODE 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2361 fdb L92A6 ; PMODE 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2362 ; Two colour mode address calculatoin
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2363 L92A6 pshs u,b ; savce registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2364 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
2365 lda VERBEG+1 ; get vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2366 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2367 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
2368 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
2369 ldb HORBEG+1 ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2370 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
2371 lsrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2372 lsrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2373 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
2374 lda HORBEG+1 ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2375 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
2376 ldu #L92DD ; point to pixel mask lookup
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2377 lda a,u ; get pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2378 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
2379 ; four colour address calculation
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2380 L92C2 pshs u,b ; save registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2381 ldb HORBYT ; get bytes per graphics row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2382 lda VERBEG+1 ; get vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2383 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2384 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
2385 tfr d,x ; put it in returnlocatin
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2386 ldb HORBEG+1 ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2387 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
2388 lsrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2389 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
2390 lda HORBEG+1 ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2391 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
2392 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
2393 lda a,u ; get pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2394 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
2395 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
2396 fcb 0x08,0x04,0x02,0x01
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2397 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
2398 ; Move X down one graphics row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2399 L92E9 ldb HORBYT ; get bytes per row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2400 abx ; add to screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2401 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2402 ; 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
2403 L92ED lsra ; move pixel mask right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2404 bcc L92F3 ; brif same byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2405 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
2406 leax 1,x ; move to next byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2407 L92F3 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2408 ; 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
2409 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
2410 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
2411 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
2412 leax 1,x ; move to next byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2413 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2414 ; 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
2415 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
2416 ldy #HORBEG ; point to storage location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2417 L9303 cmpb #192 ; is vertical outside range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2418 blo L9309 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2419 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
2420 L9309 clra ; zero extend vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2421 std 2,y ; save vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2422 ldd BINVAL ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2423 cmpd #256 ; in range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2424 blo L9317 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2425 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
2426 L9317 std ,y ; save horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2427 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2428 ; Normalize coordinates for proper PMODE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2429 L931A jsr L92FC ; parse coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2430 L931D ldu #HORBEG ; point to start coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2431 L9320 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2432 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
2433 bhs L932C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2434 ldd 2,u ; get vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2435 lsra ; divide it by two
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2436 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2437 std 2,u ; save it back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2438 L932C lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2439 cmpa #4 ; pmode 4?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2440 bhs L9338 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2441 ldd ,u ; cut horizontal coordinate in half
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2442 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2443 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2444 std ,u ; save new coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2445 L9338 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2446 ; PPOINT function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2447 PPOINT jsr L93B2 ; evaluate two expressions (coordinates)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2448 jsr L931D ; normalize coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2449 jsr L9298 ; get screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2450 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
2451 ldb PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2452 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
2453 bcc L935B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2454 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
2455 blo L9351 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2456 rora ; shift right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2457 rora
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2458 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
2459 L9351 inca ; colour numbers start at 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2460 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
2461 adda CSSVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2462 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
2463 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
2464 jmp LB4F3 ; return B as FP number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2465 L935B tsta ; is pixel on?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2466 beq L9356 ; brif not, return 0 (off)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2467 clra ; set colour number to "1"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2468 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
2469 ; PSET command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2470 PSET lda #1 ; PSET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2471 bra L9366 ; go turn on the pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2472 ; PRESET command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2473 PRESET clra ; PRESET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2474 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
2475 jsr LB26A ; enforce (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2476 jsr L931A ; evaluate coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2477 jsr L9581 ; evaluate colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2478 jsr LB267 ; enforce )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2479 jsr L9298 ; get address of pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2480 L9377 ldb ,x ; get screen data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2481 pshs b ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2482 tfr a,b ; duplicate pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2483 coma ; invert mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2484 anda ,x ; turn off screen pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2485 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
2486 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
2487 ora ,s+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2488 sta ,x ; put it on screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2489 suba ,s+ ; nonzero if screen data changed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2490 ora CHGFLG ; propagate change flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2491 sta CHGFLG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2492 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2493 ; 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
2494 ; 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
2495 L938F ldx HORDEF ; set default start coords
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2496 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2497 ldx VERDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2498 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2499 cmpa #0xac ; do we start with a -?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2500 beq L939E ; brif no starting coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2501 jsr L93B2 ; parse coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2502 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
2503 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2504 jsr LB26A ; require a (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2505 jsr LB734 ; evaluate two expressions
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2506 ldy #HOREND ; point to storage location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2507 jsr L9303 ; process coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2508 bra L93B8 ; finish up with a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2509 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
2510 jsr L92FC ; evaluate coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2511 L93B8 jmp LB267 ; force a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2512 ; LINE command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2513 LINE cmpa #0x89 ; is it LINE INPUT?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2514 lbeq L89C0 ; brif so - go handle it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2515 cmpa #'( ; starting coord?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2516 beq L93CE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2517 cmpa #0xac ; leading -?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2518 beq L93CE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2519 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
2520 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2521 L93CE jsr L938F ; parse coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2522 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
2523 stx HORDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2524 ldx VEREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2525 stx VERDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2526 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
2527 cmpa #0xbe ; PRESET?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2528 beq L93E9 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2529 cmpa #0xbd ; PSET?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2530 lbne LB277 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2531 ldb #01 ; PSET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2532 skip1lda ; skip byte and set A nonzero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2533 L93E9 clrb ; PRESET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2534 pshs b ; save PSET/PRESET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2535 jsr GETNCH ; eat the PSET/PRESET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2536 jsr L9420 ; normalize coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2537 puls b ; get back PSET/PRESET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2538 stb SETFLG ; flag which we're doing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2539 jsr L959A ; set colour byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2540 jsr GETCCH ; get next bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2541 lbeq L94A1 ; brif no box option
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2542 jsr SYNCOMMA ; make sure it's comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2543 ldb #'B ; make sure "B" for "box"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2544 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2545 bne L9429 ; brif something follows the B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2546 bsr L9444 ; draw horizontal line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2547 bsr L946E ; draw vertical line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2548 ldx HORBEG ; save horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2549 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2550 ldx HOREND ; switch in horizontal end
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2551 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2552 bsr L946E ; draw vertical line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2553 puls x ; get back original start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2554 stx HORBEG ; put it back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2555 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
2556 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2557 bra L9444 ; draw horizontal line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2558 L9420 jsr L931D ; normalize the start coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2559 ldu #HOREND ; point to end coords
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2560 jmp L9320 ; normalize those coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2561 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
2562 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2563 bra L9434 ; fill the box
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2564 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
2565 L9432 stx VERBEG ; save new vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2566 L9434 jsr L9444 ; draw a horizontal line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2567 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
2568 cmpx VEREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2569 beq L9443 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2570 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
2571 leax 1,x ; move down the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2572 bra L9432 ; go draw another line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2573 L9443 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2574 ; 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
2575 L9444 ldx HORBEG ; get starting horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2576 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2577 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
2578 bcc L9451 ; brif end is > start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2579 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
2580 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2581 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
2582 leay 1,y ; coordinates are inclusive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2583 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
2584 puls u ; restore original start coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2585 stu HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2586 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
2587 L945E sta VD7 ; save pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2588 jsr L9377 ; turn on pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2589 lda VD7 ; get pixel mask back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2590 jsr ,u ; move one pixel right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2591 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
2592 bne L945E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2593 L946B rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2594 L946C puls b,a ; clean up stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2595 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
2596 pshs b,a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2597 jsr L9710 ; get vertical difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2598 bcc L947B ; brif end coordinate > start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2599 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
2600 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2601 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
2602 leay 1,y ; the coordinates are inclusive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2603 jsr L9298 ; get screen pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2604 puls u ; restore start coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2605 stu VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2606 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
2607 bra L945E ; draw vertical line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2608 ; 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
2609 L948A fdb L92ED ; PMODE 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2610 fdb L92F4 ; PMODE 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2611 fdb L92ED ; PMODE 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2612 fdb L92F4 ; PMODE 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2613 fdb L92ED ; PMODE 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2614 L9494 ldu #L948A ; point to jump table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2615 ldb PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2616 aslb ; two bytes per address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2617 ldu b,u ; get jump address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2618 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2619 ; 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
2620 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
2621 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2622 ; 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
2623 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
2624 jsr L9710 ; calculate difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2625 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
2626 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
2627 ldy #L951B ; point to decrease vertical coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2628 L94B2 pshs d ; save vertical difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2629 ldu #L9506 ; point to increase horizontal coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2630 jsr L971D ; get difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2631 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
2632 bcc L94C1 ; brif horizontal end > horizontal start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2633 ldu #L9514 ; point to decrease hoizontal coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2634 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
2635 puls x ; get X difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2636 bcc L94CC ; brif horiz diff > vert diff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2637 exg u,y ; swap change routine pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2638 exg d,x ; swap differences
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2639 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
2640 pshs d ; save larger difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2641 lsra ; divide by two
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2642 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2643 bcs L94DD ; brif odd number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2644 cmpu #L950D+1 ; increase or decrease?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2645 blo L94DD ; brif increase
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2646 subd #1 ; back up one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2647 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
2648 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
2649 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
2650 jsr L9377 ; turn on a pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2651 ldx 6,s ; get distnace counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2652 beq L9502 ; brif line is completely drawn
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2653 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
2654 stx 6,s ; save new counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2655 jsr [8,s] ; increment/decrement larger delta
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2656 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
2657 addd 2,s ; add the smallest difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2658 std ,s ; save new minor coordinate incrementcounter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2659 subd 4,s ; subtractout the largest difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2660 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
2661 std ,s ; save new minor coordinate increment
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2662 jsr ,y ; adjust minor coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2663 bra L94E2 ; go draw another pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2664 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
2665 puls a,b,x,y,u,pc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2666 L9506 ldx HORBEG ; bump horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2667 leax 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2668 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2669 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2670 L950D ldx VERBEG ; bump vertical 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 VERBEG
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 L9514 ldx HORBEG ; decrement horizontal 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 HORBEG
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 L951B ldx VERBEG ; decrement vertical 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 VERBEG
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 ; 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
2683 L9522 ldu #VD3 ; point to temp storage
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2684 ldx #255 ; set maximum horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2685 stx ,u
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2686 ldx #191 ; set maximum vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2687 stx 2,u
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2688 jmp L9320 ; normalize them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2689 ; PCLS command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2690 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
2691 bsr L955A ; evaluate colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2692 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
2693 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
2694 ldx BEGGRP ; get start of graphics screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2695 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
2696 cmpx ENDGRP ; at end of graphics page?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2697 bne L953B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2698 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2699 L9542 ldb BAKCOL ; get background colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2700 bra L9536 ; do the clearing dance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2701 ; COLOR command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2702 COLOR cmpa #', ; check for comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2703 beq L9552 ; brif no foreground colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2704 bsr L955A ; evaluate first colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2705 stb FORCOL ; set foreground colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2706 jsr GETCCH ; is there a background colour?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2707 beq L9559 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2708 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
2709 bsr L955A ; evaluate background colour argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2710 stb BAKCOL ; set background colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2711 L9559 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2712 ; 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
2713 L955A jsr EVALEXPB ; evaluate colour code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2714 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
2715 lbhs LB44A ; brif not - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2716 clra ; CSS value for first colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2717 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
2718 blo L956C ; brif first colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2719 lda #8 ; flag second colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2720 subb #4 ; adjust into basic range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2721 L956C pshs a ; save CSS value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2722 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2723 rora ; 4 colour or 2?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2724 bcc L957B ; brif 2 colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2725 tstb ; was it 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2726 bne L9578 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2727 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
2728 L9578 decb ; convert to zero based
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2729 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
2730 L957B rorb ; is colour number odd?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2731 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
2732 clrb ; force colour 0 if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2733 bra L9579
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2734 ; Set all pixel byte and active colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2735 L9581 jsr L959A ; set colour byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2736 jsr GETCCH ; is there something to evaluate?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2737 beq L9598 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2738 cmpa #') ; )?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2739 beq L9598 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2740 jsr SYNCOMMA ; force comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2741 cmpa #', ; another comma?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2742 beq L9598 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2743 jsr L955A ; evaluate expression and return colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2744 bsr L95A2 ; save colour and pixel byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2745 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
2746 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
2747 tst SETFLG ; doing PRESET?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2748 bne L95A2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2749 ldb BAKCOL ; default to background colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2750 L95A2 stb WCOLOR ; save working colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2751 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
2752 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
2753 stb ALLCOL ; set all pixels byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2754 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2755 L95AA bne L95CF ; brif graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2756 L95AC pshs x,b,a ; save registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2757 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
2758 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
2759 sta 8,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2760 sta 6,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2761 sta 4,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2762 sta 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2763 sta 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2764 sta -2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2765 sta -4,x ; reset to alpha mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2766 sta -6,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2767 sta -8,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2768 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
2769 anda #7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2770 sta PIA1+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2771 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
2772 L95CF pshs x,b,a ; save registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2773 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2774 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
2775 ldb #0x10 ; shift to high 4 bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2776 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2777 orb #0x80 ; set to graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2778 orb CSSVAL ; set the desired colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2779 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
2780 anda #7 ; mask off VDG control
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2781 pshs a ; merge with new VDG control
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2782 orb ,s+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2783 stb PIA1+2 ; set new VDG mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2784 lda BEGGRP ; get start of graphics page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2785 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
2786 jsr L960F ; set SAM control register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2787 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2788 adda #3 ; shift to VDG values
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2789 cmpa #7 ; PMODE 4?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2790 bne L95F7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2791 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
2792 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
2793 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
2794 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
2795 ldx #SAMREG ; point to VDG control bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2796 L9600 rora ; get bit to set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2797 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
2798 sta 1,x ; set the bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2799 bra L9609
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2800 L9607 sta ,x ; clear the bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2801 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
2802 decb ; done all bits?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2803 bne L9600 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2804 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2805 L960F ldb #7 ; 7 screen address bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2806 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
2807 bra L9600 ; go program SAM bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2808 L9616 lda PIA1+2 ; get VDG bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2809 anda #0xf7 ; keep everything but CSS bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2810 ora CSSVAL ; set correct CSS bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2811 sta PIA1+2 ; set desired CSS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2812 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2813 ; PMODE command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2814 PMODETOK cmpa #', ; is first argument missing?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2815 beq L9650 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2816 jsr EVALEXPB ; evaluate PMODE number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2817 cmpb #5 ; valid (0-4)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2818 bhs L966D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2819 lda #6 ; get start of graphics memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2820 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
2821 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
2822 ldu #L9706+1 ; point to lookup table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2823 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
2824 cmpa TXTTAB ; does it fit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2825 bhi L966D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2826 sta ENDGRP ; save end of graphics
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2827 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
2828 lda b,u ; get bytes per row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2829 sta HORBYT ; set it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2830 lsrb ; restore PMODE value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2831 stb PMODE ; set graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2832 clra ; set background colour to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2833 sta BAKCOL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2834 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
2835 sta FORCOL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2836 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
2837 beq L966C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2838 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
2839 tstb ; page 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2840 beq L966D ; brif so - not valid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2841 decb ; zero-base it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2842 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
2843 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2844 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
2845 pshs b ; save start of screen memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2846 addb ENDGRP ; add current and address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2847 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
2848 cmpb TXTTAB ; does it fit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2849 bhi L966D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2850 stb ENDGRP ; save new end of graphics
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2851 puls b ; get back start of graphics
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2852 stb BEGGRP ; set start of graphics
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2853 L966C rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2854 L966D jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2855 ; SCREEN command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2856 SCREEN cmpa #', ; is there a mode?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2857 beq L967F ; brif no mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2858 jsr EVALEXPB ; get mode argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2859 tstb ; set Z if alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2860 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
2861 jsr GETCCH ; is there a second argument?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2862 beq L966C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2863 L967F jsr LB738 ; evaluate ,<expr>
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2864 tstb ; colour set 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2865 beq L9687 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2866 ldb #8 ; flag for colour set 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2867 L9687 stb CSSVAL ; set colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2868 bra L9616 ; set up VDG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2869 ; PCLEAR command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2870 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
2871 tstb ; 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2872 beq L966D ; brif zero - not allowed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2873 cmpb #9 ; more than 8?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2874 bhs L966D ; brif so - not allowed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2875 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
2876 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
2877 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
2878 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
2879 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
2880 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
2881 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
2882 lblo LB44A ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2883 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
2884 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
2885 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
2886 addd #200 ; make some extra space (for stack)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2887 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
2888 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
2889 ldu VARTAB ; get end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2890 stx VARTAB ; save new end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2891 cmpu VARTAB ; is old end higher?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2892 bhs L96D4 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2893 L96BD lda ,-u ; copy a byte upward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2894 sta ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2895 cmpu TXTTAB ; at beginning?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2896 bne L96BD ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2897 sty TXTTAB ; save new start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2898 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
2899 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
2900 jsr LAD26 ; reset variables and stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2901 jmp LAD9E ; return to interpretation loop
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2902 L96D4 ldu TXTTAB ; get start of program
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 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
2905 L96DB lda ,u+ ; move a byte downward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2906 sta ,y+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2907 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
2908 bne L96DB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2909 bra L96CB ; finish up
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2910 ; 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
2911 ; rest of the initialization code.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2912 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
2913 stb TXTTAB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2914 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
2915 L96EC sta GRPRAM ; set graphics memory start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2916 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
2917 clra ; set PMODE to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2918 sta PMODE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2919 lda #16 ; 16 bytes per graphics row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2920 sta HORBYT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2921 lda #3 ; set foreground colour to 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2922 sta FORCOL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2923 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
2924 sta ENDGRP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2925 ldx TXTTAB ; get start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2926 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
2927 L9703 jmp LAD19 ; do a "NEW"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2928 ; 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
2929 L9706 fcb 16,6 ; PMODE 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2930 fcb 32,12 ; PMODE 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2931 fcb 16,12 ; PMODE 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2932 fcb 32,24 ; PMODE 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2933 fcb 32,24 ; PMODE 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2934 ; Calculate absolute value of vertical coordinate difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2935 L9710 ldd VEREND ; get ending address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2936 subd VERBEG ; get difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2937 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
2938 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
2939 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
2940 puls cc,pc ; restore C and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2941 ; Calculate absolute value of horizontal coordinate difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2942 L971D ldd HOREND ; get end coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2943 subd HORBEG ; calculate difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2944 bra L9714 ; turn into absolute value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2945 ; PCOPY command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2946 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
2947 pshs d ; save address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2948 ldb #0xa5 ; make sure we have TO
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2949 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2950 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
2951 puls x ; get back source
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2952 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
2953 ldy #0x300 ; 0x300 words to copy
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2954 L9736 ldd ,x++ ; copy a word
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2955 std ,u++
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2956 leay -1,y ; done?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2957 bne L9736 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2958 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2959 L973F jsr EVALEXPB ; evaluate page number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2960 tstb ; zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2961 beq L9752 ; brif invalid page number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2962 ; 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
2963 ; 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
2964 ; 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
2965 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
2966 bhi L9752 ; brif so - error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2967 decb ; zero-base the page number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2968 lda #6 ; 6 "pages" per graphics page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2969 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
2970 addb GRPRAM ; add start of graphics memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2971 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
2972 L9751 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2973 L9752 jmp LB44A ; raise illegal function call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2974 ; GET command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2975 GET clrb ; GET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2976 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
2977 PUT ldb #1 ; PUT flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2978 L975A stb VD8 ; save GET/PUT flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2979 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
2980 L975F cmpa #'@ ; @ before coordinates?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2981 bne L9765 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2982 jsr GETNCH ; eat the @
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2983 L9765 jsr L938F ; evaluate start/end coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2984 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
2985 jsr L98CC ; get pointer to array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2986 tfr X,D ; save descriptor pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2987 ldu ,x ; get offset to next descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2988 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
2989 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
2990 stu VD1 ; save end of data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2991 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
2992 ldb ,x ; get dimension count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2993 aslb ; two bytes per dimension size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2994 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
2995 stx VCF ; save start of array data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2996 lda VALTYP ; is it numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2997 bne L9752 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2998 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
2999 jsr GETCCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3000 beq L97B7 ; brif no action flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3001 com VD4 ; flag action enabled
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3002 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
3003 tst VD8 ; PUT?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3004 bne L979A ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3005 ldb #'G ; check for full graphics option
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3006 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3007 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
3008 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
3009 ldx #L9839 ; point to action table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3010 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
3011 ldy ,x++ ; get "set bit" action routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3012 cmpa ,x+ ; does token match?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3013 beq L97AE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3014 decb ; checked all?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3015 bne L979F ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3016 jmp LB277 ; raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3017 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
3018 stu VD9 ; save clear bit action address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3019 jsr GETNCH ; munch the acton token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3020 bra L97CA ; handle rest of process
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3021 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
3022 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3023 rora ; odd number mode?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3024 bcc L97C0 ; brif even
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3025 ldb #0xfc ; bottom 2 bits mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3026 L97C0 tfr b,a ; save mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3027 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
3028 stb HORBEG+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3029 anda HOREND+1 ; round down end address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3030 sta HOREND+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3031 L97CA jsr L971D ; get horizontal size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3032 bcc L97D3 ; brif end > start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3033 ldx HOREND ; switch end in for start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3034 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3035 L97D3 std HOREND ; save size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3036 jsr L9710 ; calculate vertical size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3037 bcc L97DE ; brif end > start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3038 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
3039 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3040 L97DE std VEREND ; save vertical size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3041 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3042 rora ; even?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3043 ldd HOREND ; get difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3044 bcc L97EB ; brif even (2 colour)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3045 addd HOREND ; add in size (double it)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3046 std HOREND ; save adjusted end size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3047 L97EB jsr L9420 ; normalize differences
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3048 ldd HOREND ; get end coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3049 ldx VEREND ; get end size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3050 leax 1,x ; make vertical size inclusive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3051 stx VEREND ; save it back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3052 tst VD4 ; got "G" or GET action
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3053 bne L9852 ; brif given
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3054 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
3055 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3056 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3057 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3058 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3059 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3060 addd #1 ; make it inclusive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3061 std HOREND ; save new coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3062 jsr L9298 ; convert to screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3063 L9808 ldb HOREND+1 ; get horizontal size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3064 pshs x ; save screen position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3065 L980C tst VD8 ; get/put flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3066 beq L9831 ; brif get
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3067 bsr L9823 ; bump array data pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3068 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
3069 sta ,x+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3070 L9816 decb ; are we done the row?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3071 bne L980C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3072 puls x ; get screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3073 jsr L92E9 ; move to next row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3074 dec VEREND+1 ; done?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3075 bne L9808 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3076 L9822 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3077 L9823 ldu VCF ; get array data location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3078 leau 1,u ; bump it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3079 stu VCF ; save new array data location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3080 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
3081 bne L9822 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3082 L982E jmp LB44A ; raise function call error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3083 L9831 lda ,x+ ; get data from screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3084 bsr L9823 ; bump array data pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3085 sta ,u ; put data in array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3086 bra L9816 ; do the loopy thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3087 ; PUT actions
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3088 L9839 fdb L9894,L989B ; PSET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3089 fcb 0xbd
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3090 fdb L989B,L9894 ; PRESET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3091 fcb 0xbe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3092 fdb L98B1,L989B ; OR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3093 fcb 0xb1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3094 fdb L9894,L98B1 ; AND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3095 fcb 0xb0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3096 fdb L98A1,L98A1 ; NOT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3097 fcb 0xa8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3098 L9852 addd #1 ; add to horiz difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3099 std HOREND ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3100 lda VD8 ; PUT?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3101 bne L9864 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3102 ldu VD1 ; get end of array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3103 L985D sta ,-u ; zero out a byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3104 cmpu VCF ; done?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3105 bhi L985D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3106 L9864 jsr L9298 ; get screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3107 ldb PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3108 rorb ; even?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3109 bcc L986E ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3110 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
3111 L986E ldb #1 ; set bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3112 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
3113 L9873 pshs x,a ; save screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3114 ldu HOREND ; get horizontal size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3115 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
3116 lsrb ; move bit probe right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3117 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
3118 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
3119 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
3120 cmpy VD1 ; end of array data?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3121 beq L982E ; raise error if so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3122 L9884 tst VD8 ; PUT?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3123 beq L98A7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3124 bitb ,y ; test bit in array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3125 beq L9890 ; brif not set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3126 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
3127 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
3128 L9894 coma ; invert mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3129 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
3130 sta ,x ; save on screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3131 bra L98B1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3132 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
3133 sta ,x ; save on screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3134 bra L98B1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3135 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
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 L98A7 bita ,x ; is the bit set?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3139 beq L98B1 ; brif not - do nothing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3140 tfr b,a ; get bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3141 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
3142 sta ,y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3143 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
3144 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
3145 leau -1,u ; account for consumed pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3146 cmpu ZERO ; done yet?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3147 bne L9877 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3148 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
3149 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
3150 leax a,x ; move ahead one line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3151 puls a ; get back screen pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3152 leas 2,s ; lose the screen pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3153 dec VEREND+1 ; done all rows?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3154 bne L9873 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3155 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3156 L98CC jsr LB357 ; evaluate a variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3157 ldb ,-x ; get variable name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3158 lda ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3159 tfr d,u ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3160 ldx ARYTAB ; get start of arrays
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3161 L98D7 cmpx ARYEND ; end of arrays?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3162 lbeq LB44A ; brif not found
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3163 cmpu ,x ; correct variable?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3164 beq L98E8 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3165 ldd 2,x ; get array size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3166 leax d,x ; move to next array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3167 bra L98D7 ; check this array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3168 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
3169 rts ; obviously this rts is not needed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3170 L98EB rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3171 ; PAINT command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3172 PAINT cmpa #'@ ; do we have @ before coords?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3173 bne L98F2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3174 jsr GETNCH ; eat the @
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3175 L98F2 jsr L93B2 ; evaluate coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3176 jsr L931D ; normalize coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3177 lda #1 ; PSET flag (use working colour)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3178 sta SETFLG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3179 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
3180 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
3181 pshs d ; save them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3182 jsr GETCCH ; is there anything else?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3183 beq L990A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3184 jsr L9581 ; evaluate border colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3185 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
3186 sta VD8 ; save border colour pixel byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3187 puls d ; get back working colour details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3188 std WCOLOR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3189 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
3190 pshs u,x,b,a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3191 jsr L9522 ; set up starting coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3192 jsr L928F ; point to pixel mask routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3193 stu VD9 ; save pixel mask routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3194 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
3195 beq L9931 ; brif hit border immediately
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3196 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
3197 lda #1 ; set direction to "down"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3198 sta VD7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3199 jsr L99BA ; save "down" frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3200 neg VD7 ; set direction to "up"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3201 jsr L99BA ; save "up" frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3202 L9931 sts TMPSTK ; save stack pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3203 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
3204 bne L993B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3205 lds TMPSTK ; get back stack pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3206 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
3207 clr CHGFLG ; mark nothing changed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3208 sts TMPSTK ; save stack pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3209 leax 1,x ; move start coordinate right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3210 stx HORBEG ; save new coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3211 stu VD1 ; save length of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3212 sta VD7 ; save up/down flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3213 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
3214 bmi L9954 ; brif negative going (up)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3215 incb ; bump vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3216 cmpb VD6 ; at end?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3217 bls L9958 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3218 clrb ; set vertical to 0 (wrap around)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3219 L9954 tstb ; did we wrap?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3220 beq L9934 ; do another block if so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3221 decb ; move up a row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3222 L9958 stb VERBEG+1 ; save vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3223 jsr L99DF ; paint from horizontal to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3224 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
3225 cmpd #3 ; less than 3 pixels?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3226 blo L9969 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3227 leax -2,x ; move two pixels left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3228 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
3229 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
3230 L996C bsr L99BA ; save paint data frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3231 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
3232 comb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3233 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
3234 std VD1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3235 ble L998C ; brif parent line is shorter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3236 jsr L9506 ; bump horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3237 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
3238 bne L9983 ; brif not border
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3239 ldd #-1 ; move left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3240 bra L9970 ; keep looking
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3241 L9983 jsr L9514 ; move horizontally left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3242 bsr L99C6 ; save horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3243 bsr L99E8 ; paint right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3244 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
3245 L998C jsr L9506 ; bump horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3246 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
3247 stx HORBEG ; set as curent coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3248 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
3249 comb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3250 subd #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3251 ble L999E ; brif doesn't extend
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3252 tfr d,x ; save length of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3253 bsr L99A1 ; save paint frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3254 L999E jmp L9934
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3255 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
3256 puls y ; get return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3257 ldd HORBEG ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3258 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
3259 lda VD7 ; get up/down flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3260 nega ; reverse it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3261 L99AC ldb VERBEG+1 ; get vertical coordainte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3262 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
3263 pshs y ; put return address back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3264 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
3265 jsr LAC33
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3266 ldd VCB ; get line length back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3267 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3268 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
3269 puls y ; get return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3270 ldd HOREND ; get start coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3271 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
3272 lda VD7 ; get up/down flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3273 bra L99AC ; finish up with the stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3274 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
3275 stx HOREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3276 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3277 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
3278 ldy HOREND ; get last horizontal start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3279 bsr L99C6 ; save current coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3280 sty HORBEG ; save coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3281 bsr L99E8 ; paint a line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3282 ldx VCD ; get number painted
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3283 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
3284 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
3285 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3286 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
3287 ldy #L9514 ; decrement horizontal coordinate address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3288 bra L99EE ; go paint line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3289 L99E8 ldy #L9506 ; increment horizontal coordinate address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3290 jsr ,y ; bump coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3291 L99EE ldu ZERO ; initialize pixel count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3292 ldx HORBEG ; get starting coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3293 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
3294 cmpx VD3 ; at end?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3295 bhi L9A0B ; brif right of max
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3296 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
3297 bsr L9A12 ; at border?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3298 beq L9A09 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3299 jsr L9377 ; set pixel to paint colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3300 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
3301 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
3302 jsr ,y ; inc/dec screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3303 bra L99F2 ; go do another pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3304 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
3305 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
3306 tfr d,x ; and in X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3307 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
3308 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3309 L9A12 jsr [VD9] ; get the screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3310 tfr a,b ; save pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3311 andb VD8 ; set pixel to border colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3312 pshs b,a ; save mask and border
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3313 anda ,x ; mask current pixel into A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3314 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
3315 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
3316 ; PLAY command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3317 ; 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
3318 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
3319 ldb #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3320 pshs x,b ; save default values
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3321 jsr LB156 ; evaluate argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3322 clrb ; enable DA and sound output
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3323 jsr LA9A2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3324 jsr LA976
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3325 L9A32 jsr LB654 ; fetch PLAY string details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3326 bra L9A39 ; go evaluate the string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3327 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
3328 L9A39 stb VD8 ; save length of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3329 beq L9A37 ; brif end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3330 stx VD9 ; save start of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3331 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
3332 L9A43 tst VD8 ; have anything left?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3333 beq L9A37 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3334 jsr L9B98 ; get command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3335 cmpa #'; ; command separator?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3336 beq L9A43 ; brif so - ignore it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3337 cmpa #'' ; '?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3338 beq L9A43 ; brif so - ignore it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3339 cmpa #'X ; execuate sub string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3340 lbeq L9C0A ; brif so - handle it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3341 bsr L9A5C ; handle other commands
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3342 bra L9A43 ; look for more stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3343 L9A5C cmpa #'O ; octave?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3344 bne L9A6D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3345 ldb OCTAVE ; get current octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3346 incb ; 1-base it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3347 bsr L9AC0 ; get value if present
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3348 decb ; zero-base it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3349 cmpb #4 ; valid octave?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3350 bhi L9ACD ; raise error if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3351 stb OCTAVE ; save new octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3352 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3353 L9A6D cmpa #'V ; volume?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3354 bne L9A8B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3355 ldb VOLHI ; get current high volume limit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3356 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
3357 lsrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3358 subb #31 ; subtract out mid value offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3359 bsr L9AC0 ; read argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3360 cmpb #31 ; maximum range is 31
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3361 bhi L9ACD ; brif out of range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3362 aslb ; adjust back in range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3363 aslb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3364 pshs b ; save new volume
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3365 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
3366 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
3367 subb ,s+ ; subtract volume from low limit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3368 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
3369 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3370 L9A8B cmpa #'L ; note length?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3371 bne L9AB2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3372 ldb NOTELN ; get current length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3373 bsr L9AC0 ; read parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3374 tstb ; resulting length 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3375 beq L9ACD ; brif so - problem
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3376 stb NOTELN ; save new length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3377 clr DOTVAL ; reset note timer scale factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3378 L9A9A bsr L9A9F ; check for dot
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3379 bcc L9A9A ; brif there was one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3380 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3381 L9A9F tst VD8 ; check length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3382 beq L9AAD ; brif zero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3383 jsr L9B98 ; get command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3384 cmpa #'. ; dot?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3385 beq L9AAF ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3386 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
3387 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
3388 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3389 L9AAF inc DOTVAL ; bump number of dots
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3390 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3391 L9AB2 cmpa #'T ; tempo?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3392 bne L9AC3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3393 ldb TEMPO ; get current tempo
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3394 bsr L9AC0 ; parse tempo argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3395 tstb ; 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3396 beq L9ACD ; brif so - invalid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3397 stb TEMPO ; save new tempo
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3398 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3399 L9AC0 jmp L9BAC ; evaluate various operators
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3400 L9AC3 cmpa #'P ; pause?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3401 bne L9AEB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3402 jsr L9CCB ; evaluate parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3403 tstb ; is the pause number 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3404 bne L9AD0 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3405 L9ACD jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3406 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
3407 ldx VOLHI
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3408 pshs x,a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3409 lda #0x7e ; drop DA to mid range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3410 sta VOLHI
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3411 sta VOLLOW
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3412 clr DOTVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3413 bsr L9AE7 ; go play a "silence"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3414 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
3415 sta DOTVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3416 stx VOLHI
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3417 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3418 L9AE7 clr ,-s ; set not number 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3419 bra L9B2B ; go play it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3420 L9AEB cmpa #'N ; N for "note"?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3421 bne L9AF2 ; brif not - it's optional
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3422 jsr L9B98 ; skip the "N"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3423 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
3424 blo L9AFA ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3425 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
3426 bls L9AFF ; brif not - valid note
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3427 L9AFA jsr L9BBE ; evaluate a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3428 bra L9B22 ; process note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3429 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
3430 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
3431 ldb a,x ; get not number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3432 tst VD8 ; any command characters left?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3433 beq L9B22 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3434 jsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3435 cmpa #'# ; sharp?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3436 beq L9B15 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3437 cmpa #'+ ; also sharp?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3438 bne L9B18 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3439 L9B15 incb ; add one half tone
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3440 bra L9B22
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3441 L9B18 cmpa #'- ; flat?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3442 bne L9B1F ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3443 decb ; subtract one half tone
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3444 bra L9B22
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3445 L9B1F jsr L9BE2 ; back up command pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3446 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
3447 cmpb #11 ; is it valid?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3448 bhi L9ACD ; raise error if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3449 pshs b ; save note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3450 ldb NOTELN ; get note length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3451 L9B2B lda TEMPO ; get tempo value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3452 mul ; calculate note duration
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3453 std VD5 ; save duration
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3454 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
3455 lda OCTAVE ; get current octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3456 cmpa #1 ; 0 or 1?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3457 bhi L9B64 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3458 ldx #L9C62 ; point to delay table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3459 ldb #2*12 ; 24 bytes per octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3460 mul ; now we have the base address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3461 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
3462 puls b ; get back note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3463 aslb ; two bytes per delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3464 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
3465 leay ,x ; save pointer to note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3466 bsr L9B8C ; calculate note timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3467 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
3468 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
3469 lda VOLHI ; get high value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3470 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
3471 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
3472 lda VOLLOW ; get low value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3473 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
3474 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
3475 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
3476 nop ; a delay to fine tune frequencies
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3477 L9B5A sta PIA1 ; set DA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3478 ldx ,y ; get delay value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3479 L9B5F leax -1,x ; count down
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3480 bne L9B5F ; brif not done yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3481 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3482 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
3483 ldb #12 ; 12 bytes per octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3484 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
3485 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
3486 puls b ; get back note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3487 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
3488 bsr L9B8C ; calculate timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3489 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
3490 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
3491 lda VOLHI ; get high value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3492 bsr L9B83 ; send high value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3493 bsr L9B80 ; send low value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3494 lda VOLLOW ; get low value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3495 bsr L9B83 ; send low value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3496 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
3497 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
3498 nop ; fine tuning delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3499 L9B83 sta PIA1 ; set DA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3500 lda ,x ; get delay value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3501 L9B88 deca ; count down
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3502 bne L9B88 ; brif not done
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3503 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3504 L9B8C ldb #0xff ; base timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3505 lda DOTVAL ; get number of dots
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3506 beq L9B97 ; use default value if 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3507 adda #2 ; add in constant timer factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3508 mul ; multiply scale by base
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3509 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
3510 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3511 L9B97 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3512 L9B98 pshs x ; save register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3513 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
3514 beq L9BEB ; brif not - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3515 ldx VD9 ; get parsing address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3516 lda ,x+ ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3517 stx VD9 ; save pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3518 dec VD8 ; account for character consumed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3519 cmpa #0x20 ; space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3520 beq L9B9A ; brif so - skip it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3521 puls x,pc ; restore register and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3522 L9BAC bsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3523 cmpa #'+ ; add one?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3524 beq L9BEE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3525 cmpa #'- ; subtract one?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3526 beq L9BF2 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3527 cmpa #'> ; double?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3528 beq L9BFC ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3529 cmpa #'< ; halve?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3530 beq L9BF7 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3531 L9BBE cmpa #'= ; variable equate?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3532 beq L9C01 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3533 jsr L90AA ; clear carry if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3534 bcs L9BEB ; brif not numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3535 clrb ; initialize value to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3536 L9BC8 suba #'0 ; remove ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3537 sta VD7 ; save digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3538 lda #10 ; make room for digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3539 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3540 tsta ; did we overflow 8 bits?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3541 bne L9BEB ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3542 addb VD7 ; add in digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3543 bcs L9BEB ; brif that overflowed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3544 tst VD8 ; more digits?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3545 beq L9BF1 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3546 jsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3547 jsr L90AA ; clear carry if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3548 bcc L9BC8 ; brif another digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3549 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
3550 ldx VD9 ; move pointer back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3551 leax -1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3552 stx VD9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3553 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3554 L9BEB jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3555 L9BEE incb ; bump param
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3556 beq L9BEB ; brif overflow
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3557 L9BF1 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3558 L9BF2 tstb ; already zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3559 beq L9BEB ; brif so - underflow
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3560 decb ; decrease parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3561 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3562 L9BF7 tstb ; already at 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3563 beq L9BEB ; brif so - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3564 lsrb ; halve it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3565 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3566 L9BFC tstb ; will it overflow?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3567 bmi L9BEB ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3568 aslb ; double it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3569 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3570 L9C01 pshs u,y ; save registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3571 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
3572 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
3573 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
3574 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
3575 ldb #2 ; room for 4 bytes?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3576 jsr LAC33
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3577 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
3578 ldx VD9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3579 pshs x,b ; save them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3580 jmp L9A32 ; go process the sub string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3581 L9C1B ldx VD9 ; get command pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3582 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3583 jsr L9B98 ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3584 jsr LB3A2 ; set carry if not alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3585 bcs L9BEB ; brif not a variable reference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3586 L9C27 jsr L9B98 ; get command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3587 cmpa #'; ; semicolon?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3588 bne L9C27 ; keep scanning if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3589 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
3590 ldu CHARAD ; get current interpreter input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3591 pshs u ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3592 stx CHARAD ; point interpreter at command string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3593 jsr LB284 ; evaluate expression as string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3594 puls x ; restore interpeter input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3595 stx CHARAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3596 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3597 ; 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
3598 ; 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
3599 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
3600 tfr a,dp
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3601 ldd PLYTMR ; is PLAY running?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3602 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
3603 subd VD5 ; subtract out the interval
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3604 std PLYTMR ; save new timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3605 bhi L9C5A ; brif it isn't <= 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3606 clr PLYTMR ; disable the timer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3607 clr PLYTMR+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3608 puls a ; get saved CC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3609 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
3610 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
3611 pshs a ; set fake "FIRQ" stack frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3612 L9C5A rti
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3613 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
3614 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
3615 fdb 0x0150,0x013d,0x012b,0x011a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3616 fdb 0x010a,0x00fb,0x00ed,0x00df
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3617 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
3618 fdb 0x00a6,0x009d,0x0094,0x008b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3619 fdb 0x0083,0x007c,0x0075,0x006e
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3620 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
3621 fcb 0x83,0x7b,0x74,0x6d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3622 fcb 0x67,0x61,0x5b,0x56
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3623 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
3624 fcb 0x3f,0x3b,0x37,0x34
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3625 fcb 0x31,0x2e,0x2b,0x28
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3626 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
3627 fcb 0x1d,0x1b,0x19,0x18
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3628 fcb 0x16,0x14,0x13,0x12
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3629 ; DRAW command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3630 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
3631 ldb #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3632 pshs x,b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3633 stb SETFLG ; set to "PSET" mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3634 stx VD5 ; clear update and draw flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3635 jsr L959A ; set active colour byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3636 jsr LB156 ; evaluate command string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3637 L9CC6 jsr LB654 ; fetch command string details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3638 bra L9CD3 ; interpret the command string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3639 L9CCB jsr L9B98 ; fetch command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3640 jmp L9BBE ; evaluate a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3641 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
3642 L9CD3 stb VD8 ; save length counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3643 beq L9CD1 ; brif end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3644 stx VD9 ; save pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3645 lbeq L9DC7 ; brif overall end of command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3646 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
3647 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
3648 jsr L9B98 ; get command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3649 cmpa #'; ; semicolon?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3650 beq L9CDD ; brif so - ignore it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3651 cmpa #'' ; '?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3652 beq L9CDD ; brif so - ignore that too
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3653 cmpa #'N ; update position toggle?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3654 bne L9CF4 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3655 com VD5 ; toggle update position flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3656 bra L9CDD ; get on for another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3657 L9CF4 cmpa #'B ; blank flag?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3658 bne L9CFC ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3659 com VD6 ; toggle blank flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3660 bra L9CDD ; get on for another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3661 L9CFC cmpa #'X ; substring?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3662 lbeq L9D98 ; brif so - execute command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3663 cmpa #'M ; move draw position?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3664 lbeq L9E32 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3665 pshs a ; save command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3666 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
3667 tst VD8 ; is there something there?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3668 beq L9D21 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3669 jsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3670 jsr LB3A2 ; set C if not alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3671 pshs cc ; save alpha state
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3672 jsr L9BE2 ; move back pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3673 puls cc ; get back alpha flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3674 bcc L9D21 ; brif it's alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3675 bsr L9CCB ; evaluate a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3676 L9D21 puls a ; get command back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3677 cmpa #'C ; color change?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3678 beq L9D4F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3679 cmpa #'A ; angle?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3680 beq L9D59 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3681 cmpa #'S ; scale?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3682 beq L9D61 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3683 cmpa #'U ; up?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3684 beq L9D8F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3685 cmpa #'D ; down?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3686 beq L9D8C ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3687 cmpa #'L ; left?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3688 beq L9D87 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3689 cmpa #'R ; right?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3690 beq L9D82 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3691 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
3692 beq L9D72 ; brif E (45°)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3693 deca ; F (135°?)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3694 beq L9D6D ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3695 deca ; G (225°?)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3696 beq L9D7B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3697 deca ; H (315°?)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3698 beq L9D69 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3699 L9D4C jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3700 L9D4F jsr L955D ; adjust colour for PMODE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3701 stb FORCOL ; save new foreground colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3702 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
3703 L9D57 bra L9CDD ; go process another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3704 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
3705 bhs L9D4C ; brif not valid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3706 stb ANGLE ; save new angle
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3707 bra L9D57 ; go process another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3708 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
3709 bhs L9D4C ; brif out of range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3710 stb SCALE ; save new scale factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3711 bra L9D57 ; go process another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3712 L9D69 clra ; make horizontal negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3713 bsr L9DC4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3714 skip1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3715 L9D6D clra ; keep horizontal distance positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3716 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
3717 bra L9DCB ; go do the draw thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3718 L9D72 clra ; zero extend horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3719 tfr d,x ; set it as vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3720 bsr L9DC4 ; negate horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3721 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
3722 bra L9DCB ; go do the draw thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3723 L9D7B clra ; zero extend horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3724 tfr d,x ; copy horizontal to vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3725 bsr L9DC4 ; negate horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3726 bra L9DCB ; go do the drawing thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3727 L9D82 clra ; zero extend horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3728 L9DB3 ldx ZERO ; no vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3729 bra L9DCB ; go do the drawing things
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3730 L9D87 clra ; zero extend horizontal
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 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
3733 L9D8C clra ; zero extend distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3734 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
3735 L9D8F clra ; zero extend distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3736 bsr L9DC4 ; negate distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3737 L9D92 ldx ZERO ; zero out vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3738 exg x,d ; swap vertical and horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3739 bra L9DCB ; go do the drawing thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3740 L9D98 jsr L9C1B ; evaluate substring expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3741 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
3742 jsr LAC33
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3743 ldb VD8 ; save current command string state
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3744 ldx VD9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3745 pshs x,b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3746 jmp L9CC6 ; go evaluate the sub string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3747 L9DA9 ldb SCALE ; get scale factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3748 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
3749 clra ; zero extend
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3750 exg d,x ; put distance somewhere useful
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3751 sta ,-s ; save MS of distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3752 bpl L9DB6 ; brif positive distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3753 bsr L9DC3 ; negate the distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3754 L9DB6 jsr L9FB5 ; multiply D and X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3755 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
3756 lsra ; divide by 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3757 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3758 L9DBD lsra ; ...divide by 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3759 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3760 tst ,s+ ; negative distance?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3761 bpl L9DC7 ; brif it was positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3762 L9DC3 nega ; negate D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3763 L9DC4 negb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3764 sbca #0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3765 L9DC7 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3766 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
3767 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3768 L9DCB pshs b,a ; save horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3769 bsr L9DA9 ; apply scale factor to vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3770 puls x ; get horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3771 pshs b,a ; save scaled vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3772 bsr L9DA9 ; apply scale to horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3773 puls x ; get back vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3774 ldy ANGLE ; get draw angle and scale
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3775 pshs y ; save them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3776 L9DDC tst ,s ; is there an angle?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3777 beq L9DE8 ; brif no angle
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3778 exg x,d ; swap distances
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3779 bsr L9DC3 ; negate D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3780 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
3781 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
3782 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
3783 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
3784 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
3785 bmi L9DF2 ; brif we went negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3786 tfr d,u ; save calculated end coordindate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3787 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
3788 ldx ZERO ; default vertical end is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3789 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
3790 bmi L9DFC ; brif negative - use 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3791 tfr d,x ; save calculated end coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3792 L9DFC cmpu #256 ; is horizontal in range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3793 blo L9E05 ; brif su
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3794 ldu #255 ; maximize it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3795 L9E05 cmpx #192 ; is vertical in range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3796 blo L9E0D ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3797 ldx #191 ; maximize it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3798 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
3799 std HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3800 ldd VERDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3801 std VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3802 stx VEREND ; set end coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3803 stu HOREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3804 tst VD5 ; are we updating position?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3805 bne L9E21 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3806 stx VERDEF ; update default coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3807 stu HORDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3808 L9E21 jsr L9420 ; normalize coordindates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3809 tst VD6 ; are we drawing something?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3810 bne L9E2B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3811 jsr L94A1 ; draw the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3812 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
3813 clr VD6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3814 jmp L9CDD ; do another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3815 L9E32 jsr L9B98 ; get a command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3816 pshs a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3817 jsr L9E5E ; evaluate horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3818 pshs b,a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3819 jsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3820 cmpa #', ; comma between coordinates?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3821 lbne L9D4C ; brif not - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3822 jsr L9E5B ; evaluate vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3823 tfr d,x ; save vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3824 puls u ; get horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3825 puls a ; get back first command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3826 cmpa #'+ ; was it + at start?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3827 beq L9E56 ; brif +; treat values as positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3828 cmpa #'- ; was it -?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3829 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
3830 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
3831 jmp L9DCB ; move draw position (relative)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3832 L9E5B jsr L9B98 ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3833 L9E5E cmpa #'+ ; leading +?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3834 beq L9E69 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3835 cmpa #'- ; leading -?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3836 beq L9E6A ; brif so - negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3837 jsr L9BE2 ; move pointer back one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3838 L9E69 clra ; 0 for +, nonzero for -
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3839 L9E6A pshs a ; save sign flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3840 jsr L9CCB ; evaluate number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3841 puls a ; get sign flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3842 tsta ; negative?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3843 beq L9E78 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3844 clra ; zero extend and negate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3845 negb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3846 sbca #0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3847 L9E78 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3848 ; Table of sines and cosines for CIRCLE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3849 L9E79 fdb 0x0000,0x0001 ; subarc 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3850 fdb 0xfec5,0x1919 ; subarc 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3851 fdb 0xfb16,0x31f2 ; subarc 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3852 fdb 0xf4fb,0x4a51 ; subarc 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3853 fdb 0xec84,0x61f9 ; subarc 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3854 fdb 0xe1c7,0x78ae ; subarc 5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3855 fdb 0xd4dc,0x8e3b ; subarc 6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3856 fdb 0xc5e5,0xa269 ; subarc 7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3857 fdb 0xb506,0xb506 ; subarc 8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3858 ; CIRCLE command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3859 ; 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
3860 CIRCLE cmpa #'@ ; is there an @ before coordinates?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3861 bne L9EA3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3862 jsr GETNCH ; eat the @
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3863 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
3864 jsr L93B2 ; parse coordinates for circle centre
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3865 jsr L931D ; normalize the start coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3866 ldx ,u ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3867 stx VCB ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3868 ldx 2,u ; get vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3869 stx VCD ; saveit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3870 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
3871 jsr LB73D ; evaluate radius expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3872 ldu #VCF ; point to temp storage
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3873 stx ,u ; save radius
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3874 jsr L9320 ; normalize radius
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3875 lda #1 ; default to PSET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3876 sta SETFLG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3877 jsr L9581 ; evaluate the colour expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3878 ldx #0x100 ; height/width default value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3879 jsr GETCCH ; is there a ratio?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3880 beq L9EDF ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3881 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
3882 jsr LB141 ; evaluate the ratio
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3883 lda FP0EXP ; multiply ratio by 256
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3884 adda #8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3885 sta FP0EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3886 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
3887 L9EDF lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3888 bita #2 ; is it even?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3889 beq L9EE9 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3890 tfr x,d ; double the ratio
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3891 leax d,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3892 L9EE9 stx VD1 ; save height/width ratio
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3893 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
3894 stb SETFLG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3895 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
3896 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
3897 pshs b,a ; save startpoint
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3898 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
3899 std VD9 ; save endp oint
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3900 puls a,b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3901 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
3902 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
3903 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3904 ldx VEREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3905 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3906 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
3907 anda #1 ; even octant?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3908 beq L9F11 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3909 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
3910 addb #8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3911 L9F11 aslb ; four bytes per table entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3912 aslb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3913 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
3914 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
3915 jsr L9FA7 ; calculate horizontal offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3916 puls u ; get back table entry pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3917 leau -2,u ; move to cosine entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3918 pshs x ; save horizontal offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3919 jsr L9FA7 ; calculate vertical offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3920 puls y ; put horizontal in Y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3921 lda ,s ; get octant number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3922 anda #3 ; is it 0 or 4?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3923 beq L9F31 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3924 cmpa #3 ; is it 3 or 7?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3925 beq L9F31 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3926 exg x,y ; swap horizontal and vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3927 L9F31 stx HOREND ; save horizontal offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3928 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
3929 ldd VD1 ; get height/width ratio
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3930 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
3931 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
3932 tsta ; did it overflow?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3933 lbne LB44A ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3934 stb VEREND ; save vertical coordinate MSB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3935 tfr u,d ; get LSW of product
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3936 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
3937 lda ,s ; get octant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3938 cmpa #2 ; is it 0 or 1?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3939 blo L9F5B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3940 cmpa #6 ; is it 6 or 7?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3941 bhs L9F5B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3942 ldd VCB ; get horizontal centre
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3943 subd HOREND ; subtract horizontal displacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3944 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
3945 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
3946 clrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3947 bra L9F68
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3948 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
3949 addd HOREND ; add displacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3950 bcs L9F66 ; brif overlod
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3951 cmpd VD3 ; larger than max horizontal coord?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3952 blo L9F68 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3953 L9F66 ldd VD3 ; maximize the coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3954 L9F68 std HOREND ; save horizontal ending coordainte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3955 lda ,s ; get octant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3956 cmpa #4 ; is it 0-3?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3957 blo L9F7A ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3958 ldd VCD ; get vertical coordinate of centre
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3959 subd VEREND ; subtract displacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3960 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
3961 clra ; minimize to top of screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3962 clrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3963 bra L9F87
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3964 L9F7A ldd VCD ; get vertical centre coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3965 addd VEREND ; add displacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3966 bcs L9F85 ; brif we overflowed the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3967 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
3968 blo L9F87 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3969 L9F85 ldd VD5 ; maximize the coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3970 L9F87 std VEREND ; save end coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3971 tst VD8 ; check first time flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3972 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
3973 bsr L9FDF ; draw the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3974 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
3975 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
3976 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
3977 cmpd VD9 ; at end point?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3978 beq L9FA6 ; brif drawing finished
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3979 L9F9A incb ; bump arc counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3980 cmpb #8 ; done 8 arcs?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3981 bne L9FA3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3982 inca ; bump octant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3983 clrb ; reset subarc number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3984 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
3985 L9FA3 jmp L9EFD ; go do another arc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3986 L9FA6 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3987 L9FA7 ldx VCF ; get radius
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3988 ldd ,u ; get sine/cosine table entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3989 beq L9FB4 ; brif 0 - offset = radius
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3990 subd #1 ; adjust values to correct range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3991 bsr L9FB5 ; multiply radius by sine/cosine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3992 tfr y,x ; resturn result in X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3993 L9FB4 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3994 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
3995 clr 4,s ; reset overflow byte (YH)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3996 lda 3,s ; calcuate B*XL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3997 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3998 std 6,s ; put in "U"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3999 ldd 1,s ; calculate B*XH
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4000 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4001 addb 6,s ; accumluate with previous product
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4002 adca #0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4003 std 5,s ; save in YL,UH
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4004 ldb ,s ; calculate A*XL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4005 lda 3,s
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 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
4008 std 5,s ; save in YL,UH
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4009 bcc L9FD4 ; brif no carry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4010 inc 4,s ; bump YH for carry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4011 L9FD4 lda ,s ; calculate A*XH
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4012 ldb 2,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4013 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4014 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
4015 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
4016 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
4017 L9FDF jmp L94A1 ; go draw a line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4018 L9FE2 clrb ; default arc number (0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4019 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
4020 beq L9FF8 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4021 jsr SYNCOMMA ; evaluate , + expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4022 jsr LB141
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4023 lda FP0EXP ; multiply by 64
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4024 adda #6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4025 sta FP0EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4026 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
4027 andb #0x3f ; max value of 63
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4028 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
4029 andb #7 ; calculate subarc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4030 lsra ; calculate octant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4031 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4032 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4033 rts