annotate exbas11.s @ 0:605ff82c4618

Initial check in with cleaned up sources This is the initial check in the source code in a state where it builds byte accurate copies of all the various ROM versions included.
author William Astle <lost@l-w.ca>
date Sat, 08 Dec 2018 19:57:01 -0700
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1 *pragma nolist
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2 include defs.s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3 ; These are the entry points in the Color Basic ROM which are used the the Extended Basic ROM.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4 ; They are included here in order to keep the Extended Basic ROM separate from the Color Basic
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
5 ; ROM.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
6 BAWMST EQU 0xA0E8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
7 CLOAD EQU 0xA498
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
8 CSAVE EQU 0xA44C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
9 DATA EQU 0xAEE0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
10 EVALEXPB EQU 0xB70B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
11 GIVABF EQU 0xB4F4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
12 INT EQU 0xBCEE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
13 LA0E2 EQU 0xA0E2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
14 LA171 EQU 0xA171
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
15 LA176 EQU 0xA176
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
16 LA35F EQU 0xA35F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
17 LA3ED EQU 0xA3ED
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
18 LA406 EQU 0xA406
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
19 LA429 EQU 0xA429
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
20 LA42D EQU 0xA42D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
21 LA444 EQU 0xA444
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
22 LA491 EQU 0xA491
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
23 LA505 EQU 0xA505
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
24 LA578 EQU 0xA578
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
25 LA59A EQU 0xA59A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
26 LA5A5 EQU 0xA5A5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
27 LA5AE EQU 0xA5AE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
28 LA5C7 EQU 0xA5C7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
29 LA5E4 EQU 0xA5E4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
30 LA616 EQU 0xA616
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
31 LA619 EQU 0xA619
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
32 LA635 EQU 0xA635
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
33 LA644 EQU 0xA644
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
34 LA648 EQU 0xA648
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
35 LA65F EQU 0xA65F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
36 LA7E9 EQU 0xA7E9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
37 LA974 EQU 0xA974
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
38 LA976 EQU 0xA976
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
39 LA9A2 EQU 0xA9A2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
40 LA9BB EQU 0xA9BB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
41 LAC1E EQU 0xAC1E
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
42 LAC33 EQU 0xAC33
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
43 LAC46 EQU 0xAC46
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
44 LAC60 EQU 0xAC60
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
45 LAC73 EQU 0xAC73
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
46 LAC7C EQU 0xAC7C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
47 LAC9D EQU 0xAC9D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
48 LACA8 EQU 0xACA8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
49 LACEF EQU 0xACEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
50 LACF1 EQU 0xACF1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
51 LAD01 EQU 0xAD01
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
52 LAD19 EQU 0xAD19
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
53 LAD21 EQU 0xAD21
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
54 LAD26 EQU 0xAD26
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
55 LAD33 EQU 0xAD33
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
56 LAD9E EQU 0xAD9E
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
57 LADC6 EQU 0xADC6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
58 LADD4 EQU 0xADD4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
59 LADEB EQU 0xADEB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
60 LAE15 EQU 0xAE15
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
61 LAED2 EQU 0xAED2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
62 LAF67 EQU 0xAF67
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
63 LAFA4 EQU 0xAFA4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
64 LB035 EQU 0xB035
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
65 LB141 EQU 0xB141
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
66 LB143 EQU 0xB143
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
67 LB146 EQU 0xB146
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
68 LB156 EQU 0xB156
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
69 LB158 EQU 0xB158
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
70 LB244 EQU 0xB244
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
71 LB262 EQU 0xB262
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
72 LB267 EQU 0xB267
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
73 LB26A EQU 0xB26A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
74 LB26F EQU 0xB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
75 LB277 EQU 0xB277
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
76 LB284 EQU 0xB284
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
77 LB2CE EQU 0xB2CE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
78 LB357 EQU 0xB357
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
79 LB35C EQU 0xB35C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
80 LB3A2 EQU 0xB3A2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
81 LB44A EQU 0xB44A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
82 LB4F3 EQU 0xB4F3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
83 LB50F EQU 0xB50F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
84 LB518 EQU 0xB518
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
85 LB51A EQU 0xB51A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
86 LB56D EQU 0xB56D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
87 LB643 EQU 0xB643
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
88 LB654 EQU 0xB654
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
89 LB657 EQU 0xB657
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
90 LB659 EQU 0xB659
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
91 LB69B EQU 0xB69B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
92 LB6A4 EQU 0xB6A4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
93 LB6AD EQU 0xB6AD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
94 LB70E EQU 0xB70E
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
95 LB734 EQU 0xB734
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
96 LB738 EQU 0xB738
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
97 LB73D EQU 0xB73D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
98 LB740 EQU 0xB740
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
99 LB7C2 EQU 0xB7C2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
100 LB958 EQU 0xB958
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
101 LB95C EQU 0xB95C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
102 LB99F EQU 0xB99F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
103 LB9AC EQU 0xB9AC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
104 LB9AF EQU 0xB9AF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
105 LB9B4 EQU 0xB9B4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
106 LB9B9 EQU 0xB9B9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
107 LB9C2 EQU 0xB9C2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
108 LBA1C EQU 0xBA1C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
109 LBA3A EQU 0xBA3A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
110 LBA92 EQU 0xBA92
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
111 LBAC5 EQU 0xBAC5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
112 LBACA EQU 0xBACA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
113 LBB48 EQU 0xBB48
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
114 LBB5C EQU 0xBB5C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
115 LBB6A EQU 0xBB6A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
116 LBB82 EQU 0xBB82
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
117 LBB8F EQU 0xBB8F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
118 LBC14 EQU 0xBC14
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
119 LBC2F EQU 0xBC2F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
120 LBC35 EQU 0xBC35
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
121 LBC4C EQU 0xBC4C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
122 LBC5F EQU 0xBC5F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
123 LBC6D EQU 0xBC6D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
124 LBCA0 EQU 0xBCA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
125 LBCC8 EQU 0xBCC8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
126 LBD99 EQU 0xBD99
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
127 LBDB6 EQU 0xBDB6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
128 LBDBB EQU 0xBDBB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
129 LBDC0 EQU 0xBDC0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
130 LBDC5 EQU 0xBDC5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
131 LBDCC EQU 0xBDCC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
132 LBDD9 EQU 0xBDD9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
133 LBEC0 EQU 0xBEC0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
134 LBEC5 EQU 0xBEC5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
135 LBEE9 EQU 0xBEE9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
136 LBEF0 EQU 0xBEF0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
137 LBEFF EQU 0xBEFF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
138 LBFA6 EQU 0xBFA6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
139 LET EQU 0xAF89
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
140 PUTCHR EQU 0xA282
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
141 SIN EQU 0xBF78
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
142 SNDBLK EQU 0xA7F4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
143 STRINOUT EQU 0xB99C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
144 SYNCOMMA EQU 0xB26D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
145 WRLDR EQU 0xA7D8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
146 *pragma list
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
148 ; EXTENDED COLOR BASIC ROM
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
149 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
150 org EXBAS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
151 fcc 'EX' ; magic number that Color Basic uses to identify the presence of Extended Basic
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
152 L8002 ldx #L80DE ; point to command interpretation table information
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
153 ldu #COMVEC+10 ; point to command interpretation table location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
154 ldb #10 ; 10 bytes to move
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
155 jsr LA59A ; copy command interpretation table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
156 ldx #LB277 ; initialize Disk Basic's entries to error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
157 stx 3,u
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
158 stx 8,u
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
159 ldx #XIRQSV ; set up IRQ service routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
160 stx IRQVEC+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
161 ldx ZERO ; reset the TIMER value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
162 stx TIMVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
163 jsr XVEC18 ; do a bunch of initialization
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
164 ldd #0x2c05 ; initialize DLOAD baud rate constant and timeout
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
165 std DLBAUD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
166 ldx #USR0 ; set up pointer to USR routine addresses
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
167 stx USRADR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
168 ldu #LB44A ; set up USR routine addresses to "FC error"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
169 ldb #10 ; there are 10 routines
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
170 L8031 stu ,x++ ; set a routine to FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
171 decb ; done all?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
172 bne L8031 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
173 lda #0x7e ; op code of JMP extended (for RAM hook intialization)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
174 sta RVEC20 ; command interpretation loop
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
175 ldx #XVEC20
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
176 stx RVEC20+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
177 sta RVEC15 ; expression evaluation
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
178 ldx #XVEC15
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
179 stx RVEC15+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
180 sta RVEC19 ; number parsing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
181 ldx #XVEC19
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
182 stx RVEC19+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
183 sta RVEC9 ; PRINT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
184 ldx #XVEC9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
185 stx RVEC9+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
186 sta RVEC17 ; error handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
187 ldx #XVEC17
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
188 stx RVEC17+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
189 sta RVEC4 ; generic input
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
190 ldx #XVEC4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
191 stx RVEC4+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
192 sta RVEC3 ; generic output
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
193 ldx #XVEC3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
194 stx RVEC3+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
195 sta RVEC8 ; close file
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
196 ldx #XVEC8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
197 stx RVEC8+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
198 sta RVEC23 ; tokenize line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
199 ldx #XVEC23
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
200 stx RVEC23+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
201 sta RVEC18 ; RUN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
202 ldx #XVEC18
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
203 stx RVEC18+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
204 sta EXPJMP ; exponentiation
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
205 ldx #L8489
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
206 stx EXPJMP+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
207 jsr L96E6 ; initialize graphics stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
208 lda PIA0+3 ; enable 60Hz interrupt
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
209 ora #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
210 sta PIA0+3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
211 ldx #'D*256+'K ; magic number for a Disk Basic ROM
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
212 cmpx DOSBAS ; do we have a Disk Basic ROM?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
213 lbeq DOSBAS+2 ; brif so - launch it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
214 andcc #0xaf ; enable interrupts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
215 ldx #L80E8-1 ; show sign on message
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
216 jsr STRINOUT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
217 ldx #XBWMST ; install warm start handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
218 stx RSTVEC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
219 jmp LA0E2 ; set up warm start flag and launch immediate mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
220 ; Extended Basic warm start code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
221 XBWMST nop ; flag to mark routine as valid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
222 clr PLYTMR ; cancel any PLAY command in progress
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
223 clr PLYTMR+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
224 lda PIA0+3 ; enable 60Hz interrupt
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
225 ora #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
226 sta PIA0+3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
227 jmp BAWMST ; let Color Basic's warm start process run
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
228 ; This code is to fix the famous PCLEAR bug. It replaces dead code in the 1.0 ROM. This patch corrects
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
229 ; the input pointer so that it points to the correct place after the program has been relocated by
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
230 ; PCLEAR instead of continuing with something that, in the best case, is a syntax error.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
231 L80D0 lda CURLIN ; immediate mode?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
232 inca
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
233 beq L80DD ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
234 tfr y,d ; save offset to D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
235 subd TXTTAB ; see how far into the program we are
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
236 addd CHARAD ; now adjust the input pointer based on that
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
237 std CHARAD ; save corrected input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
238 L80DD rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
239 L80DE fcb 25 ; 25 Extended Basic commands
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
240 fdb L8183 ; reserved word table (commands)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
241 fdb L813C ; interpretation handler (commands)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
242 fcb 14 ; 14 Extended Basic functions
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
243 fdb L821E ; reserved word table (functions)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
244 fdb L8168 ; function handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
245 L80E8 fcc 'EXTENDED COLOR BASIC 1.1'
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
246 fcb 0x0d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
247 fcc 'COPYRIGHT (C) 1982 BY TANDY'
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
248 fcb 0x0d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
249 fcc 'UNDER LICENSE FROM MICROSOFT'
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
250 fcb 0x0d,0x0d,0x00
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
251 ; Extended Basic command interpretation loop
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
252 L813C cmpa #0xcb ; is it an Extended Basic command?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
253 bhi L8148 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
254 ldx #L81F0 ; point to dispatch table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
255 suba #0xb5 ; normalize the token number so 0 is the first entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
256 jmp LADD4 ; go transfer control to the command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
257 L8148 cmpa #0xff ; is it a function token?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
258 beq L8154 ; brif so - for MID$()=, TIMER=
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
259 cmpa #0xcd ; is it a token for a keyword that isn't a command?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
260 bls L8165 ; brif so - error for USING and FN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
261 jmp [COMVEC+23] ; transfer control to Disk Basic if it is present
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
262 L8154 jsr GETNCH ; get token after the function flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
263 cmpa #0x90 ; MID$?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
264 lbeq L86D6 ; brif so (substring replacement)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
265 cmpa #0x9f ; TIMER?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
266 lbeq L8960 ; brif so - TIMER setting
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
267 jsr RVEC22 ; do a RAM hook in case something wants to extend this
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
268 L8165 jmp LB277 ; we have nothing valid here
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
269 ; Function handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
270 L8168 cmpb #2*33 ; is it a valid Extended Basic function?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
271 bls L8170 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
272 jmp [COMVEC+28] ; transfer control to Disk Basic if it is present
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
273 L8170 subb #2*20 ; normalize Extended Basic functions to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
274 cmpb #2*8 ; Above HEX$?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
275 bhi L817D ; brif so - we don't pre-evaluate an argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
276 pshs b ; save token value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
277 jsr LB262 ; evaluate the function parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
278 puls b ; get back token value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
279 L817D ldx #L8257 ; point to dispatch table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
280 jmp LB2CE ; go transfer control to the function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
281 ; Reserved words (commands)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
282 L8183 fcs 'DEL' ; 0xb5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
283 fcs 'EDIT' ; 0xb6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
284 fcs 'TRON' ; 0xb7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
285 fcs 'TROFF' ; 0xb8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
286 fcs 'DEF' ; 0xb9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
287 fcs 'LET' ; 0xba
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
288 fcs 'LINE' ; 0xbb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
289 fcs 'PCLS' ; 0xbc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
290 fcs 'PSET' ; 0xbd
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
291 fcs 'PRESET' ; 0xbe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
292 fcs 'SCREEN' ; 0xbf
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
293 fcs 'PCLEAR' ; 0xc0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
294 fcs 'COLOR' ; 0xc1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
295 fcs 'CIRCLE' ; 0xc2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
296 fcs 'PAINT' ; 0xc3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
297 fcs 'GET' ; 0xc4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
298 fcs 'PUT' ; 0xc5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
299 fcs 'DRAW' ; 0xc6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
300 fcs 'PCOPY' ; 0xc7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
301 fcs 'PMODE' ; 0xc8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
302 fcs 'PLAY' ; 0xc9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
303 fcs 'DLOAD' ; 0xca
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
304 fcs 'RENUM' ; 0xcb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
305 fcs 'FN' ; 0xcc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
306 fcs 'USING' ; 0xcd
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
307 ; Dispatch table (commands)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
308 L81F0 fdb DEL ; 0xb5 DEL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
309 fdb EDIT ; 0xb6 EDIT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
310 fdb TRON ; 0xb7 TRON
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
311 fdb TROFF ; 0xb8 TROFF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
312 fdb DEF ; 0xb9 DEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
313 fdb LET ; 0xba LET (note: implemented by Color Basic!)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
314 fdb LINE ; 0xbb LINE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
315 fdb PCLS ; 0xbc PCLS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
316 fdb PSET ; 0xbd PSET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
317 fdb PRESET ; 0xbe PRESET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
318 fdb SCREEN ; 0xbf SCREEN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
319 fdb PCLEAR ; 0xc0 PCLEAR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
320 fdb COLOR ; 0xc1 COLOR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
321 fdb CIRCLE ; 0xc2 CIRCLE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
322 fdb PAINT ; 0xc3 PAINT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
323 fdb GET ; 0xc4 GET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
324 fdb PUT ; 0xc5 PUT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
325 fdb DRAW ; 0xc6 DRAW
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
326 fdb PCOPY ; 0xc7 PCOPY
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
327 fdb PMODETOK ; 0xc8 PMODE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
328 fdb PLAY ; 0xc9 PLAY
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
329 fdb DLOAD ; 0xca DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
330 fdb RENUM ; 0xcb RENUM
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
331 ; Reserved words (functions)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
332 L821E fcs 'ATN' ; 0x94
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
333 fcs 'COS' ; 0x95
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
334 fcs 'TAN' ; 0x96
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
335 fcs 'EXP' ; 0x97
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
336 fcs 'FIX' ; 0x98
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
337 fcs 'LOG' ; 0x99
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
338 fcs 'POS' ; 0x9a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
339 fcs 'SQR' ; 0x9b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
340 fcs 'HEX$' ; 0x9c
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
341 fcs 'VARPTR' ; 0x9d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
342 fcs 'INSTR' ; 0x9e
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
343 fcs 'TIMER' ; 0x9f
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
344 fcs 'PPOINT' ; 0xa0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
345 fcs 'STRING$' ; 0xa1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
346 ; Dispatch table (functions)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
347 L8257 fdb ATN ; 0x94 ATN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
348 fdb COS ; 0x95 COS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
349 fdb TAN ; 0x96 TAN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
350 fdb EXP ; 0x97 EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
351 fdb FIX ; 0x98 FIX
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
352 fdb LOG ; 0x99 LOG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
353 fdb POS ; 0x9a POS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
354 fdb SQR ; 0x9b SQR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
355 fdb HEXDOL ; 0x9c HEX$
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
356 fdb VARPTRTOK ; 0x9d VARPTR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
357 fdb INSTR ; 0x9e INSTR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
358 fdb TIMER ; 0x9f TIMER
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
359 fdb PPOINT ; 0xa0 PPOINT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
360 fdb STRING ; 0xa1 STRING$
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
361 ; Generic output handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
362 XVEC3 tst DEVNUM ; screen?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
363 lbeq L95AC ; brif so - force text screen active
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
364 pshs b ; save register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
365 ldb DEVNUM ; get output device
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
366 cmpb #-3 ; check for DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
367 puls b ; restore register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
368 bne L8285 ; brif not DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
369 leas 2,s ; bail out of output handler if DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
370 L8285 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
371 ; Close file handler. This corrects a bug in Color Basic 1.0 which didn't handle writing the
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
372 ; end of file block correctly. That bug is fixed in Color Basic 1.1 so this isn't required
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
373 ; if a recent enough version of Color Basic is installed.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
374 XVEC8 lda DEVNUM ; get device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
375 inca ; is it tape?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
376 bne L8285 ; brif not - we aren't going to mess with it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
377 lda FILSTA ; get tape file status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
378 cmpa #2 ; output file?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
379 bne L8285 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
380 lda CINCTR ; is there anything waiting to be written out?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
381 bne L8285 ; brif so - mainline code will handle it properly
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
382 clr DEVNUM ; reset output to screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
383 leas 2,s ; don't return to mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
384 jmp LA444 ; write EOF block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
385 ; RUN handler - sets up some Extended Basic stuff to defaults at program start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
386 XVEC18 ldd #0xba42 ; initialize PLAY volume
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
387 std VOLHI
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
388 lda #2 ; set PLAY tempo to 2, PLAY octave to 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
389 sta TEMPO
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
390 sta OCTAVE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
391 asla ; set default note length to 5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
392 sta NOTELN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
393 clr DOTVAL ; don't do any note length extension
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
394 ldd ZERO ; initialize DRAW angle and scale to default 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
395 std ANGLE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
396 ldb #128 ; initialize horizontal and vertical default coordinates to the middle of the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
397 std HORDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
398 ldb #96
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
399 std VERDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
400 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
401 ; Command interpretation loop handler; we need to intercept this to implement TRON/TROFF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
402 XVEC20 leas 2,s ; don't return to the mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
403 L82BB andcc #0xaf ; make sure interrupts are running
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
404 jsr LADEB ; do a BREAK/pause check
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
405 ldx CHARAD ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
406 stx TINPTR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
407 lda ,x+ ; get current input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
408 beq L82CF ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
409 cmpa #': ; statement separator?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
410 beq L82F1 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
411 jmp LB277 ; raise error we got here with extra junk
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
412 L82CF lda ,x++ ; get first byte of next line address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
413 sta ENDFLG ; use it to set "END" flag to "END"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
414 bne L82D8 ; brif not end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
415 jmp LAE15 ; go do the "END"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
416 L82D8 ldd ,x+ ; get line number of next line (and leave pointer one before line text)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
417 std CURLIN ; set current line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
418 stx CHARAD ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
419 lda TRCFLG ; are we tracing?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
420 beq L82F1 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
421 lda #'[ ; show opening marker for TRON line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
422 jsr PUTCHR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
423 lda CURLIN ; restore MSB of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
424 jsr LBDCC ; show line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
425 lda #'] ; show closing marker for TRON line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
426 jsr PUTCHR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
427 L82F1 jsr GETNCH ; get the start of the statement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
428 tfr cc,b ; save status flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
429 cmpa #0x98 ; is it CSAVE?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
430 beq L8316 ; brif so - go to Extended Basic patch (adds CSAVEM)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
431 cmpa #0x97 ; is it CLOAD?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
432 beq L8311 ; brif so - go to Extended Basic patch (adds multi-origin binaries)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
433 tfr b,cc ; restore character status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
434 jsr LADC6 ; go process command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
435 bra L82BB ; restart interpretation loop
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
436 ; Tokenizaton handler. This is actually a hack to intercept CLOAD and CSAVE during immediate mode by causing the
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
437 ; tokenization routine to return to the interpretation loop above instead of the mainline interpretation loop. This
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
438 ; is necessary because the first command encountered on a line in immediate mode is executed BEFORE the interpretation
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
439 ; loop RAM hook is called. This patch doesn't actually affect tokenization itself at all.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
440 XVEC23 ldx 2,s ; get return address of caller to the tokenizer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
441 cmpx #LAC9D ; is it coming from immediate mode prior to executing the line?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
442 bne L8310 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
443 ldx #L82F1 ; force return to Extended Basic's main loop patch above
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
444 stx 2,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
445 L8310 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
446 ; These two patches are set up this way so that control can be transferred back to the original Color Basic
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
447 ; implementations if the Extended Basic addons are not triggered.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
448 L8311 jsr L8C62 ; transfer control to Extended Basic's CLOAD handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
449 bra L82BB ; go do another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
450 L8316 bsr L831A ; go do Extended Basic's CSAVE handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
451 bra L82BB ; go do another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
452 ; Extended Basic's CSAVE handler which implements CSAVEM (which Color Basic does not have)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
453 L831A jsr GETNCH ; get character after CSAVE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
454 cmpa #'M ; is it CSAVEM?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
455 lbne CSAVE ; brif not - Color Basic can handle this
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
456 jsr GETNCH ; eat the "M"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
457 jsr LA578 ; parse file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
458 bsr L836C ; get start address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
459 stx CASBUF+13 ; save it in file header
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
460 bsr L836C ; get end address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
461 cmpx 2,s ; compare to start address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
462 lblo LB44A ; brif end address is before the start address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
463 bsr L836C ; get execution address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
464 stx CASBUF+11 ; put in file header
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
465 jsr GETCCH ; are we at the end of the commmand?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
466 bne L8310 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
467 lda #2 ; file type to machine language
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
468 ldx ZERO ; set to binary and single block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
469 jsr LA65F ; write header
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
470 clr FILSTA ; mark any open tape file closed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
471 inc BLKTYP ; set block type to data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
472 jsr WRLDR ; write a data leader
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
473 ldx 4,s ; get starting address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
474 L834D stx CBUFAD ; set start of data address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
475 lda #255 ; try a full length block by default
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
476 sta BLKLEN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
477 ldd 2,s ; get ending address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
478 subd CBUFAD ; see how much is left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
479 bhs L835E ; brif we have more to write
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
480 leas 6,s ; clean up stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
481 jmp LA491 ; write EOF block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
482 L835E cmpd #255 ; do we have a full block left?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
483 bhs L8367 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
484 incb ; set block size to remainder
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
485 stb BLKLEN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
486 L8367 jsr SNDBLK ; write a data block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
487 bra L834D ; go see if we have more to write
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
488 L836C jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
489 jsr LB73D ; evaluate unsigned expression to X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
490 ldu ,s ; get return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
491 stx ,s ; save result on stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
492 tfr u,pc ; return to caller
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
493 ; COS function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
494 COS ldx #L83AB ; point to PI/2 constant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
495 jsr LB9C2 ; add to argument ( cos(x) = sin((pi/2)+x) )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
496 L837E jmp SIN ; now calculate sin((pi/2)+x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
497 ; TAN function. This is determined by the identity TAN(X) = SIN(X)/COS(X)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
498 TAN jsr LBC2F ; save FPA0 in FPA3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
499 clr RELFLG ; reset quadrant flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
500 bsr L837E ; calculate SIN(x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
501 ldx #V4A ; save result in FPA5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
502 jsr LBC35
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
503 ldx #V40 ; get back original argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
504 jsr LBC14
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
505 clr FP0SGN ; force result positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
506 lda RELFLG ; get quadrant flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
507 bsr L83A6 ; calculate COS(x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
508 tst FP0EXP ; did we get 0 for COS(x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
509 lbeq LBA92 ; brif so - overflow
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
510 ldx #V4A ; point to sin(x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
511 L83A3 jmp LBB8F ; divide the sin(x) value by the cos(x) value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
512 L83A6 pshs a ; save sign flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
513 jmp LBFA6 ; expand polynomial
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
514 L83AB fcb 0x81,0x49,0x0f,0xda,0xa2 ; pi/2 constant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
515 ; ATN function (inverse tangent). There are two calculation streams used to improve precision.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
516 ; One if the parameter is >= 1.0 and the other if it is < 1.0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
517 ATN lda FP0SGN ; get sign of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
518 pshs a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
519 bpl L83B8 ; brif positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
520 bsr L83DC ; flip sign of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
521 L83B8 lda FP0EXP ; get exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
522 pshs a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
523 cmpa #0x81 ; exponent for 1.0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
524 blo L83C5 ; brif less - value is less than 1.0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
525 ldx #LBAC5 ; point to FP constant 1.0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
526 bsr L83A3 ; calculate reciprocal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
527 L83C5 ldx #L83E0 ; point to polynomical coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
528 jsr LBEF0 ; expand polynomial
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
529 puls a ; get exponent of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
530 cmpa #0x81 ; did we do a reciprocal calculation?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
531 blo L83D7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
532 ldx #L83AB ; subtract result from pi/2 if we did
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
533 jsr LB9B9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
534 L83D7 puls a ; get sign of original
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
535 tsta ; was it positive?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
536 bpl L83DF ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
537 L83DC jmp LBEE9 ; flip sign of result
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
538 L83DF rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
539 ; Chebyshev modified taylor series coefficients for inverse tangent. Note that these diverge quite significantly
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
540 ; from the standard taylor series after 1/9. The standard coefficients are 1/1,-1/3, 1/5, -1/7, 1/9, -1/11, and
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
541 ; so on. These modified coefficients yield reasonable accuracy for the precision available, presumably with
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
542 ; fewer coefficients.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
543 L83E0 fcb 11 ; 12 coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
544 fcb 0x76,0xb3,0x83,0xbd,0xd3 ; -0.000684793912
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
545 fcb 0x79,0x1e,0xf4,0xa6,0xf5 ; 0.00485094216
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
546 fcb 0x7b,0x83,0xfc,0xb0,0x10 ; -0.0161117018
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
547 fcb 0x7c,0x0c,0x1f,0x67,0xca ; 0.0342096381
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
548 fcb 0x7c,0xde,0x53,0xcb,0xc1 ; -0.0542791328
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
549 fcb 0x7d,0x14,0x64,0x70,0x4c ; 0.0724571965
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
550 fcb 0x7d,0xb7,0xea,0x51,0x7a ; -0.0898023954
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
551 fcb 0x7d,0x63,0x30,0x88,0x7e ; 0.110932413
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
552 fcb 0x7e,0x92,0x44,0x99,0x3a ; -0.142839808
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
553 fcb 0x7e,0x4c,0xcc,0x91,0xc7 ; 0.199999121
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
554 fcb 0x7f,0xaa,0xaa,0xaa,0x13 ; -0.333333316
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
555 fcb 0x81,0x00,0x00,0x00,0x00 ; 1.0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
556 ; Chebyshev modified taylor series coefficients for the ln(x)/ln(2) (base 2 log of x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
557 L841D fcb 3 ; four coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
558 fcb 0x7f,0x5e,0x56,0xcb,0x79 ; 0.434255942 from (2/7)/ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
559 fcb 0x80,0x13,0x9b,0x0b,0x64 ; 0.576584541 from (2/5)/ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
560 fcb 0x80,0x76,0x38,0x93,0x16 ; 0.961800759 from (2/3)/ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
561 fcb 0x82,0x38,0xaa,0x3b,0x20 ; 2.88539007 from 2/ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
562 L8432 fcb 0x80,0x35,0x04,0xf3,0x34 ; 1/sqrt(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
563 L8437 fcb 0x81,0x35,0x04,0xf3,0x34 ; sqrt(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
564 L843C fcb 0x80,0x80,0x00,0x00,0x00 ; -0.5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
565 L8441 fcb 0x80,0x31,0x72,0x17,0xf8 ; ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
566 ; LOG function (natural log, ln)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
567 ; FP representation is of the form A*2^B. Thus, the log routine determines the value of
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
568 ; ln(A*2^B).
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
569 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
570 ; ln(A*2^B) = ln(A) + ln(2^B) = ln(A) + B*ln(2) = (ln(A)/ln(2) + B)*ln(2), OR:
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
571 ; (log2(A) + B)*ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
572 ; Now if we write A as A*(sqrt(2)/sqrt(2)), we haven't changed anything so:
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
573 ; (log2(A*sqrt(2)/sqrt(2)) + B)*ln(2) = (log2(A*sqrt(2)) - log2(sqrt(2)) + B) * ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
574 ; which gives: (-1/2 + log2(A*sqrt(2)) + B) * ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
575 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
576 ; Everything except log2(A*sqrt(2)) is either constant or trivial.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
577 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
578 ; What the actual code below feeds into the modified taylor series is actually:
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
579 ; 1 - (sqrt(2)/(A + sqrt(2)) which algebra reveals to be (A*sqrt(2)-1)/(A*sqrt(2)+1)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
580 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
581 ; Thus, the code is using (A*sqrt(2)-1)/(A*sqrt(2)+1) instead of A*sqrt(2) as one would
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
582 ; expect from the identities. However, the modified coefficients in the series above
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
583 ; could be correcting for that or the introduced error was deemed acceptable.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
584 ; NOTE: this routine does NOT return 0 for LOG(1)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
585 LOG jsr LBC6D ; get status of FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
586 lble LB44A ; brif <= 0 - logarithms don't exist in that case
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
587 ldx #L8432 ; point to 1/sqrt(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
588 lda FP0EXP ; get exponent of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
589 suba #0x80 ; remove bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
590 pshs a ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
591 lda #0x80 ; force exponent to 0 (this turns FPA0 into A in the above description)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
592 sta FP0EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
593 jsr LB9C2 ; add 1/sqrt(2) to A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
594 ldx #L8437 ; point to sqrt(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
595 jsr LBB8F ; divide that by FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
596 ldx #LBAC5 ; point to 1.0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
597 jsr LB9B9 ; subtract result from 1.0: Now FPA0 is 1-(sqrt(2)/(A+1/sqrt(2)))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
598 ldx #L841D ; point to coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
599 jsr LBEF0 ; expand polynomial (calculate base 2 log of modified argument)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
600 ldx #L843C ; point to -0.5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
601 jsr LB9C2 ; add result
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
602 puls b ; get original exponent back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
603 jsr LBD99 ; add B to FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
604 ldx #L8441 ; point to ln(2)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
605 jmp LBACA ; multiply by ln(2) which gives us the result in base e
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
606 ; SQR function (square root) - returns the principle root (positive)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
607 SQR jsr LBC5F ; move argument to FPA1 (first argument for exponentiation)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
608 ldx #LBEC0 ; point to 0.5 (exponent for square root)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
609 jsr LBC14 ; set up second argument to exponentiation (the exponent)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
610 ; Exponentiation operator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
611 ; This is calculated as A^x = e^(x*ln(A)) where A is in FPA1 and x is in FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
612 L8489 beq EXP ; do "EXP" if exponent is 0 (this will catch 0^0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
613 tsta ; check that the base is not 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
614 bne L8491 ; brif base is not 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
615 jmp LBA3A ; 0^(nonzero) is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
616 L8491 ldx #V4A ; save exponent (to FPA5)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
617 jsr LBC35
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
618 clrb ; result sign will default to positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
619 lda FP1SGN ; check if base is positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
620 bpl L84AC ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
621 jsr INT ; convert exponent to integer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
622 ldx #V4A ; point to original expoent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
623 lda FP1SGN ; get sign of FPA1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
624 jsr LBCA0 ; compare original exponent with truncated one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
625 bne L84AC ; brif not equal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
626 coma ; flip sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
627 ldb CHARAC ; get LS byte of integer exponent (result sign flag)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
628 L84AC jsr LBC4C ; copy FPA1 (base) to FPA0 (A = sign)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
629 pshs b ; save result sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
630 jsr LOG ; get natural log of the base
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
631 ldx #V4A ; multiply the log by the exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
632 jsr LBACA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
633 bsr EXP ; now raise e to the resulting power
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
634 puls a ; get result sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
635 rora ; brif it was negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
636 lbcs LBEE9 ; brif negative - flip sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
637 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
638 L84C4 fcb 0x81,0x38,0xaa,0x3b,0x29 ; 1.44269504 (correction factor for exponential function)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
639 ; Chebyshev modified taylor series coefficients for e^x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
640 L84C9 fcb 7 ; eight coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
641 fcb 0x71,0x34,0x58,0x3e,0x56 ; 1/(7!*(CF^7))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
642 fcb 0x74,0x16,0x7e,0xb3,0x1b ; 1/(6!*(CF^6))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
643 fcb 0x77,0x2f,0xee,0xe3,0x85 ; 1/(5!*(CF^5))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
644 fcb 0x7a,0x1d,0x84,0x1c,0x2a ; 1/(4!*(CF^4))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
645 fcb 0x7c,0x63,0x59,0x58,0x0a ; 1/(3!*(CF^3))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
646 fcb 0x7e,0x75,0xfd,0xe7,0xc6 ; 1/(2!*(CF^2))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
647 fcb 0x80,0x31,0x72,0x18,0x10 ; 1/(1!*(CF^1))
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
648 fcb 0x81,0x00,0x00,0x00,0x00 ; 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
649 ; EXP function (e^x)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
650 EXP ldx #L84C4 ; point to correction factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
651 jsr LBACA ; multiply it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
652 jsr LBC2F ; save corrected argument to FPA3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
653 lda FP0EXP ; get exponent of FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
654 cmpa #0x88 ; is it too big?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
655 blo L8504 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
656 L8501 jmp LBB5C ; to 0 (underflow) or overflow error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
657 L8504 jsr INT ; convert argument to an integer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
658 lda CHARAC ; get ls byte of integer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
659 adda #0x81 ; was argument 127? if so, the OV error; adds bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
660 beq L8501
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
661 deca ; adjust for the extra +1 above
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
662 pshs a ; save integer exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
663 ldx #V40 ; get fractional part of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
664 jsr LB9B9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
665 ldx #L84C9 ; point to coefficients
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
666 jsr LBEFF ; evaluate polynomial on the fractional part
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
667 clr RESSGN ; force result to be positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
668 puls a ; get back original exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
669 jsr LBB48 ; add original exponent to the fractional result
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
670 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
671 ; FIX function (truncate/round toward 0) (NOTE: INT() always rounds down so INT(-0.5) gives -1 but FIX(-0.5) gives 0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
672 FIX jsr LBC6D ; get status of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
673 bmi L852C ; brif negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
674 L8529 jmp INT ; do regular "int" if positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
675 L852C com FP0SGN ; flip the sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
676 bsr L8529 ; do "INT" on this
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
677 jmp LBEE9 ; flip the sign back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
678 ; EDIT command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
679 EDIT jsr L89AE ; get line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
680 leas 2,s ; we're not going to return to the main loop
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
681 L8538 lda #1 ; "LIST" flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
682 sta VD8 ; set to list the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
683 jsr LAD01 ; find line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
684 lbcs LAED2 ; brif line wasn't found
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
685 jsr LB7C2 ; go unpack the line into the buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
686 tfr y,d ; calculate the actual length of the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
687 subd #LINBUF+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
688 stb VD7 ; save line length (it will only be 8 bits)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
689 L854D ldd BINVAL ; get the line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
690 jsr LBDCC ; display it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
691 jsr LB9AC ; put a space after it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
692 ldx #LINBUF+1 ; point to iput uffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
693 ldb VD8 ; are we listing?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
694 bne L8581 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
695 L855C clrb ; reset digit accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
696 L855D jsr L8687 ; get a keypress
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
697 jsr L90AA ; set carry if not numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
698 bcs L8570 ; brif not a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
699 suba #'0 ; remove ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
700 pshs a ; save digit value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
701 lda #10 ; multiply accumulator by 10
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
702 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
703 addb ,s+ ; add in new digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
704 bra L855D ; go check for another digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
705 L8570 subb #1 ; this converts 0 to 1, but *only* 0 to 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
706 adcb #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
707 cmpa #'A ; abort?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
708 bne L857D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
709 jsr LB958 ; to a CR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
710 bra L8538 ; restart EDIT process
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
711 L857D cmpa #'L ; list?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
712 bne L858C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
713 L8581 bsr L85B4 ; list the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
714 clr VD8 ; reset to "not listing"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
715 jsr LB958 ; do a CR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
716 bra L854D ; start editing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
717 L858A leas 2,s ; lose return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
718 L858C cmpa #0x0d ; ENTER?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
719 bne L859D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
720 bsr L85B4 ; echo out the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
721 L8592 jsr LB958 ; do a CR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
722 ldx #LINBUF+1 ; reset input pointer to start of buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
723 stx CHARAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
724 jmp LACA8 ; join immediate mode to replace the line in the program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
725 L859D cmpa #'E ; exit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
726 beq L8592 ; brif so - end edit with no echo
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
727 cmpa #'Q ; quit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
728 bne L85AB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
729 jsr LB958 ; do a CR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
730 jmp LAC73 ; go to immediate mode with no fanfare - no changes saved
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
731 L85AB bsr L85AF ; go do commands
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
732 bra L855C ; go handle another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
733 L85AF cmpa #0x20 ; space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
734 bne L85C3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
735 skip2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
736 L85B4 ldb #LBUFMX-1 ; display up to a whole line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
737 L85B6 lda ,x ; get buffer chracter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
738 beq L85C2 ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
739 jsr PUTCHR ; output character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
740 leax 1,x ; move to next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
741 decb ; done?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
742 bne L85B6 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
743 L85C2 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
744 L85C3 cmpa #'D ; delete?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
745 bne L860F ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
746 L85C7 tst ,x ; end of line?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
747 beq L85C2 ; brif so - can't delete
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
748 bsr L85D1 ; remove a character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
749 decb ; done all requested?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
750 bne L85C7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
751 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
752 L85D1 dec VD7 ; account for character being removed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
753 leay -1,x ; set pointer and compensate for increment below
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
754 L85D5 leay 1,y ; move to next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
755 lda 1,y ; get next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
756 sta ,y ; move it forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
757 bne L85D5 ; brif we didn't hit the end of the buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
758 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
759 L85DE cmpa #'I ; insert?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
760 beq L85F5 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
761 cmpa #'X ; extend?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
762 beq L85F3 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
763 cmpa #'H ; "hack"?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
764 bne L8646 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
765 clr ,x ; mark current location as end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
766 tfr x,d ; calculate new line length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
767 subd #LINBUF+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
768 stb VD7 ; save new length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
769 L85F3 bsr L85B4 ; display the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
770 L85F5 jsr L8687 ; read a character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
771 cmpa #0x0d ; ENTER?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
772 beq L858A ; brif so - terminate entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
773 cmpa #0x1b ; ESC?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
774 beq L8625 ; brif so - back to command mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
775 cmpa #0x08 ; backspace?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
776 bne L8626 ; brif no
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
777 cmpx #LINBUF+1 ; are we at the start of the buffer?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
778 beq L85F5 ; brif so - it's a no-op
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
779 bsr L8650 ; move pointer back one, do a BS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
780 bsr L85D1 ; remove character from the buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
781 bra L85F5 ; go handle more input
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
782 L860F cmpa #'C ; change?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
783 bne L85DE ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
784 L8613 tst ,x ; is there something to change?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
785 beq L8625 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
786 jsr L8687 ; get a key stroke
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
787 bcs L861E ; brif valid key
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
788 bra L8613 ; try again if invalid key
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
789 L861E sta ,x+ ; put new character in the buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
790 bsr L8659 ; echo it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
791 decb ; changed number requested?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
792 bne L8613 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
793 L8625 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
794 L8626 ldb VD7 ; get length of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
795 cmpb #LBUFMX-1 ; at maximum line length?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
796 bne L862E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
797 bra L85F5 ; process another input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
798 L862E pshs x ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
799 L8630 tst ,x+ ; are we at the end of the line?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
800 bne L8630 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
801 L8634 ldb ,-x ; get character before current pointer, move back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
802 stb 1,x ; move it forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
803 cmpx ,s ; at the original buffer pointer?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
804 bne L8634 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
805 leas 2,s ; remove saved buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
806 sta ,x+ ; save input character in newly made hole
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
807 bsr L8659 ; echo it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
808 inc VD7 ; bump line length counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
809 bra L85F5 ; go handle more stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
810 L8646 cmpa #0x08 ; backspace?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
811 bne L865C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
812 L864A bsr L8650 ; move pointer back, echo BS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
813 decb ; done enough of them?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
814 bne L864A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
815 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
816 L8650 cmpx #LINBUF+1 ; at start of buffer?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
817 beq L8625 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
818 leax -1,x ; move pointer back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
819 lda #0x08 ; character to echo - BS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
820 L8659 jmp PUTCHR ; echo character to screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
821 L865C cmpa #'K ; "kill"?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
822 beq L8665 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
823 suba #'S ; search?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
824 beq L8665 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
825 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
826 L8665 pshs a ; save kill/search flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
827 bsr L8687 ; read target
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
828 pshs a ; save search character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
829 L866B lda ,x ; get current character in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
830 beq L8685 ; brif end of line - nothing more to search
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
831 tst 1,s ; is it KILL?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
832 bne L8679 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
833 bsr L8659 ; echo the character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
834 leax 1,x ; move ahead
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
835 bra L867C ; check next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
836 L8679 jsr L85D1 ; remove character from buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
837 L867C lda ,x ; get character in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
838 cmpa ,s ; are we at the target?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
839 bne L866B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
840 decb ; have we found enough of them?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
841 bne L866B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
842 L8685 puls y,pc ; clean up stack and return to main EDIT routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
843 L8687 jsr LA171 ; get input from the generic input handler (will show the cursor)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
844 cmpa #0x7f ; graphics (or DEL)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
845 bhs L8687 ; brif so - ignore it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
846 cmpa #0x5f ; SHIFT-UP?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
847 bne L8694 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
848 lda #0x1b ; replace with ESC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
849 L8694 cmpa #0x0d ; carriage return?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
850 beq L86A6 ; brif so (C=0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
851 cmpa #0x1b ; ESC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
852 beq L86A6 ; brif so (C=0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
853 cmpa #0x08 ; backspace?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
854 beq L86A6 ; brif so (C=0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
855 cmpa #32 ; control code?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
856 blo L8687 ; brif control code - try again
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
857 orcc #1 ; set C for "valid" (printable) character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
858 L86A6 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
859 ; TRON and TROFF commands
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
860 TRON skip1lda ; load flag with nonzero for trace enabled (and skip next)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
861 TROFF clra ; clear flag for trace disabled
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
862 sta TRCFLG ; save trace status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
863 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
864 ; POS function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
865 POS lda DEVNUM ; get original device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
866 pshs a ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
867 jsr LA5AE ; fetch device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
868 jsr LA406 ; check for open file
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
869 jsr LA35F ; set up print parameters
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
870 ldb DEVPOS ; get current line position for the device
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
871 jmp LA5E4 ; return position in B as unsigned
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
872 ; VARPTR function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
873 VARPTRTOK jsr LB26A ; make sure we have (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
874 ldd ARYEND ; get address of end of arrays
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
875 pshs d ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
876 jsr LB357 ; parse variable descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
877 jsr LB267 ; make sure there is a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
878 puls d ; get original end of arrays
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
879 exg x,d ; swap original end of arrays and the discovered variable pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
880 cmpx ARYEND ; did array end move (variable created?)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
881 bne L8724 ; brif so (FC error)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
882 jmp GIVABF ; return the pointer (NOTE: as signed)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
883 ; MID$() assignment; note that this cannot make the string longer or shorter and if the replacement is shorter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
884 ; than the specified size, only the number of characters actually in the replacement will be used.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
885 L86D6 jsr GETNCH ; eat the MID$ token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
886 jsr LB26A ; force (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
887 jsr LB357 ; evaluate the variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
888 pshs x ; save variable descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
889 ldd 2,x ; point to start of original string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
890 cmpd FRETOP ; is it in string space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
891 bls L86EB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
892 subd MEMSIZ ; is it still in string space (top end)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
893 bls L86FD ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
894 L86EB ldb ,x ; get length of original string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
895 jsr LB56D ; allocate space in string space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
896 pshs x ; save pointer to string space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
897 ldx 2,s ; get to original string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
898 jsr LB643 ; move the string into string space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
899 puls x,u ; get new string address and string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
900 stx 2,u ; save new data address for the string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
901 pshs u ; save descriptor address again
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
902 L86FD jsr LB738 ; evaluate ",start"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
903 pshs b ; save start offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
904 tstb ; is start 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
905 beq L8724 ; brif so - strings offsets are 1-based
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
906 ldb #255 ; default use the entire string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
907 cmpa #') ; end of parameters?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
908 beq L870E ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
909 jsr LB738 ; evaluate ",length"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
910 L870E pshs b ; save length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
911 jsr LB267 ; make sure we have a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
912 ldb #0xb3 ; make sure we have =
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
913 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
914 bsr L8748 ; evaluate replacement string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
915 tfr x,u ; save replacement string address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
916 ldx 2,s ; get original string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
917 lda ,x ; get length of original string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
918 suba 1,s ; subtract start position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
919 bhs L8727 ; brif within the string - insert replacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
920 L8724 jmp LB44A ; raise illegal function call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
921 L8727 inca ; A is now number of characters to the right of the position parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
922 cmpa ,s ; compare to length desired
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
923 bhs L872E ; brif new length fits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
924 sta ,s ; only use as much of the length as will fit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
925 L872E lda 1,s ; get position offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
926 exg a,b ; swap replacement length and position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
927 ldx 2,x ; point to original string address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
928 decb ; we work with 0-based offsets
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
929 abx ; now X points to start of replacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
930 tsta ; replacing 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
931 beq L8746 ; brif so - done
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
932 cmpa ,s ; is replacement shorter than the hole?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
933 bls L873F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
934 lda ,s ; use copy the maximum number specified
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
935 L873F tfr a,b ; save number to move in B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
936 exg u,x ; swap pointers so they are right for the routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
937 jsr LA59A ; copy string data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
938 L8746 puls a,b,x,pc ; clean up stack and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
939 L8748 jsr LB156 ; evaluate expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
940 jmp LB654 ; make sure it's a string and return string details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
941 ; STRING$ function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
942 STRING jsr LB26A ; make sure we have (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
943 jsr EVALEXPB ; evaluate repeat count (error if > 255)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
944 pshs b ; save repeat count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
945 jsr SYNCOMMA ; make sure there's a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
946 jsr LB156 ; evaluate the thing to repeat
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
947 jsr LB267 ; make sure we have a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
948 lda VALTYP ; is it string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
949 bne L8768 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
950 jsr LB70E ; get 8 bit character code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
951 bra L876B ; use that
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
952 L8768 jsr LB6A4 ; get first character of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
953 L876B pshs b ; save repeat character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
954 ldb 1,s ; get repeat count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
955 jsr LB50F ; reserve space for the string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
956 puls a,b ; get character and repeat count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
957 beq L877B ; brif NULL string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
958 L8776 sta ,x+ ; put character into string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
959 decb ; put enough?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
960 bne L8776 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
961 L877B jmp LB69B ; return the newly created string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
962 ; INSTR function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
963 INSTR jsr LB26A ; evaluate (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
964 jsr LB156 ; evaluate first argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
965 ldb #1 ; default start position is 1 (start of string)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
966 pshs b ; save start position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
967 lda VALTYP ; get type of first argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
968 bne L879C ; brif string - use default starting position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
969 jsr LB70E ; convert first argument into string offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
970 stb ,s ; save offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
971 beq L8724 ; brif starting at 0 - not allowed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
972 jsr SYNCOMMA ; make sure there's a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
973 jsr LB156 ; evaluate the search string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
974 jsr LB146 ; make sure it *is* a string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
975 L879C ldx FPA0+2 ; get search string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
976 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
977 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
978 jsr L8748 ; evalute the target string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
979 pshs x,b ; save address and length of target string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
980 jsr LB267 ; make sure we have a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
981 ldx 3,s ; get search string address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
982 jsr LB659 ; get string details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
983 pshs b ; save search string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
984 cmpb 6,s ; compare length of search string to the start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
985 blo L87D9 ; brif start position is beyond the search string - return 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
986 lda 1,s ; get length of target string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
987 beq L87D6 ; brif targetstring is NULL - match will be immediate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
988 ldb 6,s ; get start position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
989 decb ; zero-base it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
990 abx ; now X points to the start position for the search
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
991 L87BE leay ,x ; point to start of search
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
992 ldu 2,s ; get target string pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
993 ldb 1,s ; get targetlength
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
994 lda ,s ; get length of serach
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
995 suba 6,s ; see how much is left in searh
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
996 inca ; add one for "inclusivity"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
997 cmpa 1,s ; do we have less than the target string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
998 blo L87D9 ; brif so - we obviously won't match
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
999 L87CD lda ,x+ ; compare a byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1000 cmpa ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1001 bne L87DF ; brif no match
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1002 decb ; compared all of target?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1003 bne L87CD ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1004 L87D6 ldb 6,s ; get position where we matched
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1005 skip1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1006 L87D9 clrb ; flag no match
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1007 leas 7,s ; clean up stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1008 jmp LB4F3 ; return unsigned B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1009 L87DF inc 6,s ; bump start position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1010 leax 1,y ; move starting pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1011 bra L87BE ; see if we match now
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1012 ; Number parsing handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1013 XVEC19 cmpa #'& ; do we have & (hex or octal)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1014 bne L8845 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1015 leas 2,s ; we won't return to the original invoker
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1016 L87EB clr FPA0+2 ; clear bottom of FPA0 for 16 bit value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1017 clr FPA0+3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1018 ldx #FPA0+2 ; point to accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1019 jsr GETNCH ; eat the &
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1020 cmpa #'O ; octal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1021 beq L880A ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1022 cmpa #'H ; hex?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1023 beq L881F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1024 jsr GETCCH ; reset flags on input
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1025 bra L880C ; go process octal (default)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1026 L8800 cmpa #'8 ; is it a valid octal character?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1027 lbhi LB277 ; brif not (BUG: should be LBHS or above be #'7)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1028 ldb #3 ; base 8 multiplier
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1029 bsr L8834 ; add digit to accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1030 L880A jsr GETNCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1031 L880C bcs L8800 ; brif numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1032 L880E clr FPA0 ; clear upper bytes of FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1033 clr FPA0+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1034 clr VALTYP ; result is numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1035 clr FPSBYT ; clear out any extra precision
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1036 clr FP0SGN ; make it positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1037 ldb #0xa0 ; exponent for integer aligned to right of FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1038 stb FP0EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1039 jmp LBA1C ; go normalize the result and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1040 L881F jsr GETNCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1041 bcs L882E ; brif digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1042 jsr LB3A2 ; set carry if not alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1043 L8826 bcs L880E ; brif not alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1044 cmpa #'G ; is it valid HEX digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1045 bhs L880E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1046 suba #7 ; normalize A-F to be just above 0-9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1047 L882E ldb #4 ; four bits per digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1048 bsr L8834 ; add digit to accumlator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1049 bra L881F ; process another digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1050 L8834 asl 1,x ; shift accumulator one bit left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1051 rol ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1052 lbcs LBA92 ; brif too big - overflow
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1053 decb ; done enough bit shifts?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1054 bne L8834 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1055 L883F suba #'0 ; remove ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1056 adda 1,x ; merge digit into accumlator (this cannot cause carry)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1057 sta 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1058 L8845 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1059 ; Expression evaluation handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1060 XVEC15 puls u ; get back return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1061 clr VALTYP ; set result to numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1062 ldx CHARAD ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1063 jsr GETNCH ; get the input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1064 cmpa #'& ; HEX or OCTAL?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1065 beq L87EB ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1066 cmpa #0xcc ; FN?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1067 beq L88B4 ; brif so - do "FNx()"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1068 cmpa #0xff ; function token?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1069 bne L8862 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1070 jsr GETNCH ; get function token value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1071 cmpa #0x83 ; USR?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1072 lbeq L892C ; brif so - short circuit Color Basic's USR handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1073 L8862 stx CHARAD ; restore input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1074 jmp ,u ; return to mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1075 L8866 ldx CURLIN ; are we in immediate mode?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1076 leax 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1077 bne L8845 ; brif not - we're good
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1078 ldb #2*11 ; code for illegal direct statement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1079 L886E jmp LAC46 ; raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1080 ; DEF command (DEF FN, DEF USR)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1081 DEF ldx [CHARAD] ; get two input characters
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1082 cmpx #0xff83 ; USR?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1083 lbeq L890F ; brif so - do DEF USR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1084 bsr L88A1 ; get descriptor address for FN variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1085 bsr L8866 ; disallow DEF FN in immediate mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1086 jsr LB26A ; make sure we have (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1087 ldb #0x80 ; disallow arrays as arguments
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1088 stb ARYDIS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1089 jsr LB357 ; evaluate variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1090 bsr L88B1 ; make sure it's numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1091 jsr LB267 ; make sure we have )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1092 ldb #0xb3 ; make sure we have =
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1093 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1094 ldx V4B ; get variable descriptor address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1095 ldd CHARAD ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1096 std ,x ; save address of the actual function code in variable descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1097 ldd VARPTR ; get descriptor address of argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1098 std 2,x ; save argument descriptor address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1099 jmp DATA ; move to the end of this statement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1100 L88A1 ldb #0xcc ; make sure we have FN
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1101 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1102 ldb #0x80 ; disable array lookup
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1103 stb ARYDIS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1104 ora #0x80 ; set bit 7 of first character (to indicate FN variable)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1105 jsr LB35C ; find the variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1106 stx V4B ; save descriptor pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1107 L88B1 jmp LB143 ; make sure we have a numeric variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1108 ; Evaluate an FN call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1109 L88B4 bsr L88A1 ; parse the FNx bit and get the descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1110 pshs x ; save descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1111 jsr LB262 ; evaluate parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1112 bsr L88B1 ; make sure it's a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1113 puls u ; get FN descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1114 ldb #2*25 ; code for undefined function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1115 ldx 2,u ; point to argument variable descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1116 beq L886E ; brif nothing doing there (if it was just created, this will be NULL)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1117 ldy CHARAD ; save current input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1118 ldu ,u ; point to start of FN definition
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1119 stu CHARAD ; put input pointer there
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1120 lda 4,x ; save original value of argument and save it with current input, and variable pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1121 pshs a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1122 ldd ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1123 ldu 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1124 pshs u,y,x,d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1125 jsr LBC35 ; set argument variable to the argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1126 L88D9 jsr LB141 ; go evaluate the FN expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1127 puls d,x,y,u ; get back variable pointers, input pointer, and original variable value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1128 std ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1129 stu 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1130 puls a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1131 sta 4,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1132 jsr GETCCH ; test end of FN formula
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1133 lbne LB277 ; brif not end of statement - problem with the function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1134 sty CHARAD ; restore input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1135 L88EF rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1136 ; Error handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1137 XVEC17 cmpb #2*25 ; is it a valid Extended Basic error code?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1138 blo L88EF ; brif not - return to mainline
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1139 jsr LA7E9 ; turn off tape
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1140 jsr LA974 ; turn off sound
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1141 jsr LAD33 ; clean up stack and other bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1142 clr DEVNUM ; reset output to screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1143 jsr LB95C ; do a newline if needed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1144 jsr LB9AF ; do a ?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1145 ldx #L890B-25*2 ; point to error message table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1146 jmp LAC60 ; go display error message
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1147 ; Extended Basic error codes. Yes, NE is defined here even though it is only actually documented in the
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1148 ; Disk Basic documentation. It is here for the use of DLOAD.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1149 L890B fcc 'UF' ; 25 undefined function call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1150 fcc 'NE' ; 26 File not found
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1151 ; DEF USR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1152 L890F jsr GETNCH ; eat the USR token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1153 bsr L891C ; get pointer to USR call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1154 pshs x ; save FN exec address location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1155 bsr L8944 ; calculate execution address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1156 puls u ; get FN address pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1157 stx ,u ; save new address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1158 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1159 L891C clrb ; default routine number is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1160 jsr GETNCH ; fetch the call number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1161 bcc L8927 ; brif not a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1162 suba #'0 ; remove ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1163 tfr a,b ; save it in the right place
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1164 jsr GETNCH ; eat the call number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1165 L8927 ldx USRADR ; get start address of USR jump table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1166 aslb ; two bytes per address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1167 abx ; now X points to the right entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1168 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1169 ; Evaluate a USR call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1170 L892C bsr L891C ; find the correct routine address location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1171 ldx ,x ; get routine address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1172 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1173 jsr LB262 ; evaluate argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1174 ldx #FP0EXP ; point to FPA0 (argument value)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1175 lda VALTYP ; is it string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1176 beq L8943 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1177 jsr LB657 ; fetch string details (removes it from the string stack)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1178 ldx FPA0+2 ; get string descriptor pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1179 lda VALTYP ; set flags for the value type
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1180 L8943 rts ; call the routine and return to mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1181 L8944 ldb #0xb3 ; check for "="
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1182 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1183 jmp LB73D ; evaluate integer expression to X and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1184 ; Extended Basic IRQ handler
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1185 XIRQSV lda PIA0+3 ; is it VSYNC interrupt?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1186 bmi L8952 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1187 rti ; really should clear the HSYNC interrupt here
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1188 L8952 lda PIA0+2 ; clear VSYNC interrupt
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1189 ldx TIMVAL ; increment the TIMER value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1190 leax 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1191 stx TIMVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1192 jmp L9C3E ; check for other stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1193 ; TIMER=
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1194 L8960 jsr GETNCH ; eat the TIMER token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1195 bsr L8944 ; evaluate =nnnn to X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1196 stx TIMVAL ; set the timer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1197 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1198 ; TIMER function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1199 TIMER ldx TIMVAL ; get timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1200 stx FPA0+2 ; set it in FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1201 jmp L880E ; return as positive 16 bit value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1202 ; DEL command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1203 DEL lbeq LB44A ; raise error if no argument (probably to avoid accidentally deleting line 0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1204 jsr LAF67 ; parse line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1205 jsr LAD01 ; find line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1206 stx VD3 ; save address of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1207 jsr GETCCH ; is there something more?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1208 beq L8990 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1209 cmpa #0xac ; dash?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1210 bne L89BF ; brif not - error out
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1211 jsr GETNCH ; each the -
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1212 beq L898C ; brif no ending line - use default line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1213 bsr L89AE ; parse second line number and save in BINVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1214 bra L8990 ; do the deletion
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1215 L898C lda #0xff ; set to maximum line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1216 sta BINVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1217 L8990 ldu VD3 ; point end to start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1218 skip2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1219 L8993 ldu ,u ; point to start of next line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1220 ldd ,u ; check for end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1221 beq L899F ; brif end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1222 ldd 2,u ; get line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1223 subd BINVAL ; is it in range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1224 bls L8993 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1225 L899F ldx VD3 ; get starting line address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1226 bsr L89B8 ; close up gap
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1227 jsr LAD21 ; reset input pointer and erase variables
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1228 ldx VD3 ; get start of program after the deletion
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1229 jsr LACF1 ; recompute netl ine pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1230 jmp LAC73 ; return to immediate mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1231 L89AE jsr LAF67 ; parse a line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1232 jmp LA5C7 ; make sure there's nothing more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1233 L89B4 lda ,u+ ; copy a byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1234 sta ,x+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1235 L89B8 cmpu VARTAB ; end of program?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1236 bne L89B4 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1237 stx VARTAB ; save new start of variables/end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1238 L89BF rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1239 ; LINE INPUT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1240 L89C0 jsr L8866 ; raise error if in immediate mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1241 jsr GETNCH ; eat the "INPUT" token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1242 cmpa #'# ; device number?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1243 bne L89D2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1244 jsr LA5A5 ; parse device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1245 jsr LA3ED ; make sure it's valid for input
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1246 jsr SYNCOMMA ; make sure there's a comma after the device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1247 L89D2 cmpa #'" ; is there a prompt?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1248 bne L89E1 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1249 jsr LB244 ; parse the string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1250 ldb #'; ; make sure there's a semicolon after the prompt
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1251 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1252 jsr LB99F ; go actually display the prompt
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1253 L89E1 leas -2,s ; make a hole on the stack (so number of return adddresses is right)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1254 jsr LB035 ; read an input line from current device
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1255 leas 2,s ; clean up stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1256 clr DEVNUM ; reset to screen/keyboard
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1257 jsr LB357 ; parse a variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1258 stx VARDES ; save pointer to it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1259 jsr LB146 ; make sure it's a string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1260 ldx #LINBUF ; point to input buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1261 clra ; make sure we terminate on NUL only
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1262 jsr LB51A ; parse string and store it in string space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1263 jmp LAFA4 ; go assign the string to its final resting place
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1264 ; RENUM command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1265 L89FC jsr LAF67 ; read a line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1266 ldx BINVAL ; get value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1267 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1268 L8A02 ldx VD1 ; get current old number being renumbered
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1269 L8A04 stx BINVAL ; save number being searched for
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1270 jmp LAD01 ; go find line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1271 RENUM jsr LAD26 ; erase variables
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1272 ldd #10 ; default line number interval and start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1273 std VD5 ; set starting line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1274 std VCF ; set number interval
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1275 clrb ; now D is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1276 std VD1 ; save default start for renumbering
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1277 jsr GETCCH ; are there any arguments
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1278 bcc L8A20 ; brif not numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1279 bsr L89FC ; fetch line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1280 stx VD5 ; save line beginning number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1281 jsr GETCCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1282 L8A20 beq L8A3D ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1283 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1284 bcc L8A2D ; brif next isn't numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1285 bsr L89FC ; fetch starting line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1286 stx VD1 ; save the number where we start working
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1287 jsr GETCCH ; fetch input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1288 L8A2D beq L8A3D ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1289 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1290 bcc L8A3A ; brif we don't have a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1291 bsr L89FC ; parse the number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1292 stx VCF ; save interval
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1293 beq L8A83 ; brif we ave a zero interval
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1294 L8A3A jsr LA5C7 ; raise error if more stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1295 L8A3D bsr L8A02 ; get address of old number to process
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1296 stx VD3 ; save address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1297 ldx VD5 ; get the next renumbered line to use
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1298 bsr L8A04 ; find that line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1299 cmpx VD3 ; is it before the previous one?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1300 blo L8A83 ; brif so - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1301 bsr L8A67 ; make sure renumbered line numbers will be in range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1302 jsr L8ADD ; convert line numbers to "expanded" binary
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1303 jsr LACEF ; recalculate next line pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1304 bsr L8A02 ; get address of first line to renumber
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1305 stx VD3 ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1306 bsr L8A91 ; make sure line numbers exist
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1307 bsr L8A68 ; renumber the actual lines
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1308 bsr L8A91 ; update line numbers in program text
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1309 jsr L8B7B ; convert packed binary line numbers to text
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1310 jsr LAD26 ; erase variables, reset stack, etc.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1311 jsr LACEF ; recalculate next line pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1312 jmp LAC73 ; bounce back to immediate mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1313 L8A67 skip1lda ; set line number flag to nonzero (skip next instruction)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1314 L8A68 clra ; set line number flag to zero (insert new numbers)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1315 sta VD8 ; save line number flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1316 ldx VD3 ; get address of line being renumbered
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1317 ldd VD5 ; get the current renumbering number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1318 bsr L8A86 ; return if end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1319 L8A71 tst VD8 ; test line number flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1320 bne L8A77 ; brif not adding new numbers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1321 std 2,x ; set new number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1322 L8A77 ldx ,x ; point to next line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1323 bsr L8A86 ; return if end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1324 addd VCF ; add interval to current number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1325 bcs L8A83 ; brif we overflowed - bad line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1326 cmpa #MAXLIN ; maximum legal number?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1327 blo L8A71 ; brif so - do another
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1328 L8A83 jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1329 L8A86 pshs d ; save D (we're going to clobber it)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1330 ldd ,x ; get next line pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1331 puls d ; unclobber D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1332 bne L8A90 ; brif not end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1333 leas 2,s ; return to caller's caller
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1334 L8A90 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1335 L8A91 ldx TXTTAB ; get start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1336 leax -1,x ; move pointer back one (compensate for leax 1,x below)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1337 L8A95 leax 1,x ; move to next line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1338 bsr L8A86 ; return if end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1339 L8A99 leax 3,x ; move past next line address and line number, go one before line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1340 L8A9B leax 1,x ; move to next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1341 lda ,x ; check input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1342 beq L8A95 ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1343 stx TEMPTR ; save current pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1344 deca ; is it start of packed numeric line number?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1345 beq L8AB2 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1346 deca ; does line exist?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1347 beq L8AD3 ; brif line number exists
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1348 deca ; not part of something to process?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1349 bne L8A9B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1350 L8AAC lda #3 ; set 1st byte to 3 to indicate line number not existing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1351 sta ,x+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1352 bra L8A99 ; go process another
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1353 L8AB2 ldd 1,x ; get MSB of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1354 dec 2,x ; is MS byte zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1355 beq L8AB9 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1356 clra ; set MS byte to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1357 L8AB9 ldb 3,x ; get LSB of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1358 dec 4,x ; is it zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1359 beq L8AC0 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1360 clrb ; clear byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1361 L8AC0 std 1,x ; save binary number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1362 std BINVAL ; save trial number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1363 jsr LAD01 ; find the line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1364 L8AC7 ldx TEMPTR ; get start of packed line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1365 bcs L8AAC ; brif line number not found
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1366 ldd V47 ; get address of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1367 inc ,x+ ; bump first byte to 2 (exists if checking) or 1 if inserting
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1368 std ,x ; save address of correct number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1369 bra L8A99 ; go process more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1370 L8AD3 clr ,x ; clear carry and first byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1371 ldx 1,x ; point to address of correct line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1372 ldx 2,x ; get correct line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1373 stx V47 ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1374 bra L8AC7 ; insert into line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1375 L8ADD ldx TXTTAB ; get beginning of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1376 bra L8AE5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1377 L8AE1 ldx CHARAD ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1378 leax 1,x ; move it forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1379 L8AE5 bsr L8A86 ; return if end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1380 leax 2,x ; move past line address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1381 L8AE9 leax 1,x ; move forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1382 L8AEB stx CHARAD ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1383 L8AED jsr GETNCH ; get an input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1384 L8AEF tsta ; is it actual 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1385 beq L8AE1 ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1386 bpl L8AED ; brif not a token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1387 ldx CHARAD ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1388 cmpa #0xff ; function?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1389 beq L8AE9 ; brif so - ignore it (and following byte)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1390 jsr RVEC22 ; do the RAM hook thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1391 cmpa #0xa7 ; THEN?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1392 beq L8B13 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1393 cmpa #0x84 ; ELSE?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1394 beq L8B13 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1395 cmpa #0x81 ; GO(TO|SUB)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1396 bne L8AED ; brif not - we don't have a line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1397 jsr GETNCH ; get TO/SUB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1398 cmpa #0xa5 ; GOTO?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1399 beq L8B13 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1400 cmpa #0xa6 ; GOSUB?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1401 bne L8AEB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1402 L8B13 jsr GETNCH ; fetch character after token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1403 bcs L8B1B ; brif numeric (line number)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1404 L8B17 jsr GETCCH ; set flags on input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1405 bra L8AEF ; keep checking for line numbers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1406 L8B1B ldx CHARAD ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1407 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1408 jsr LAF67 ; parse line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1409 ldx CHARAD ; get input pointer after line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1410 L8B24 lda ,-x ; get character before pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1411 jsr L90AA ; set C if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1412 bcs L8B24 ; brif not numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1413 leax 1,x ; move pointer up
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1414 tfr x,d ; calculate size of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1415 subb 1,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1416 subb #5 ; make sure at least 5 bytes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1417 beq L8B55 ; brif exactly 5 bytes - no change
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1418 blo L8B41 ; brif less than 5 bytes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1419 leau ,x ; move remainder of program backward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1420 negb ; negate extra number of bytes (to subtract from X)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1421 leax b,x ; now X is the correct position to move program to
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1422 jsr L89B8 ; shift program backward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1423 bra L8B55
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1424 L8B41 stx V47 ; save end of line number space (end of copy)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1425 ldx VARTAB ; get end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1426 stx V43 ; set source pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1427 negb ; get positive difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1428 leax b,x ; now X is the top of the destination block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1429 stx V41 ; set copy destination
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1430 stx VARTAB ; save new end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1431 jsr LAC1E ; make sure enough room and make a hole in the program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1432 ldx V45 ; get end address of destination block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1433 stx CHARAD ; set input there
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1434 L8B55 puls x ; get starting address of the line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1435 lda #1 ; set "new number" flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1436 sta ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1437 sta 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1438 sta 4,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1439 ldb BINVAL ; get MS byte of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1440 bne L8B67 ; brif it is not zero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1441 ldb #1 ; set to 1 if MSB is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1442 inc 2,x ; flag MSB as 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1443 L8B67 stb 1,x ; set MSB of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1444 ldb BINVAL+1 ; get LSB of number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1445 bne L8B71 ; brif nonzero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1446 ldb #1 ; set to 1 if LSB is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1447 inc 4,x ; flag LSB as 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1448 L8B71 stb 3,x ; save LSB of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1449 jsr GETCCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1450 cmpa #', ; multiple line numbers? (ON GOTO, ON GOSUB)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1451 beq L8B13 ; brif so - process another
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1452 bra L8B17 ; go look for more line numbers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1453 L8B7B ldx TXTTAB ; point to start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1454 leax -1,x ; move back (compensate for inc below)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1455 L8B7F leax 1,x ; move forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1456 ldd 2,x ; get this line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1457 std CURLIN ; save it (for error message)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1458 jsr L8A86 ; return if end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1459 leax 3,x ; skip address and line number, stay one before line text
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1460 L8B8A leax 1,x ; move to next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1461 L8B8C lda ,x ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1462 beq L8B7F ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1463 deca ; valid line new line number?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1464 beq L8BAE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1465 suba #2 ; undefined line?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1466 bne L8B8A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1467 pshs x ; save line number pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1468 ldx #L8BD9-1 ; show UL message
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1469 jsr STRINOUT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1470 ldx ,s ; get input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1471 ldd 1,x ; get undefined line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1472 jsr LBDCC ; display line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1473 jsr LBDC5 ; print out "IN XXXX"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1474 jsr LB958 ; do a newline
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1475 puls x ; get input pointer back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1476 L8BAE pshs x ; save input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1477 ldd 1,x ; get binary value of line number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1478 std FPA0+2 ; save it in FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1479 jsr L880E ; adjust FPA0 as integer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1480 jsr LBDD9 ; convert to text string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1481 puls u ; get previous input pointer address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1482 ldb #5 ; each expanded line uses 5 bytes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1483 L8BBE leax 1,x ; move pointer forward (in string number) past sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1484 lda ,x ; do we have a digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1485 beq L8BC9 ; brif not - end of number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1486 decb ; mark a byte consumed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1487 sta ,u+ ; put digit in program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1488 bra L8BBE ; copy another digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1489 L8BC9 leax ,u ; point to address at end of text number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1490 tstb ; did number fill whole space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1491 beq L8B8C ; brif so - move on
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1492 leay ,u ; save end of number pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1493 leau b,u ; point to the end of the original expanded number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1494 jsr L89B8 ; close up gap in program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1495 leax ,y ; get end of line number pointer back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1496 bra L8B8C ; go process more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1497 L8BD9 fcn 'UL '
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1498 ; HEX$ function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1499 HEXDOL jsr LB740 ; convert argument to positive integer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1500 ldx #STRBUF+2 ; point to string buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1501 ldb #4 ; convert 4 nibbles
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1502 L8BE5 pshs b ; save nibble counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1503 clrb ; clear digit accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1504 lda #4 ; do 4 shifts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1505 L8BEA asl FPA0+3 ; shift a bit off the left of the value into low bits of B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1506 rol FPA0+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1507 rolb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1508 deca ; done all shifts?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1509 bne L8BEA ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1510 tstb ; do we have a nonzero digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1511 bne L8BFF ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1512 lda ,s ; is it last digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1513 deca
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1514 beq L8BFF ; brif so - keep the 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1515 cmpx #STRBUF+2 ; is it a middle zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1516 beq L8C0B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1517 L8BFF addb #'0 ; add ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1518 cmpb #'9 ; above 9?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1519 bls L8C07 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1520 addb #7 ; adjust into alpha range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1521 L8C07 stb ,x+ ; save digit in output
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1522 clr ,x ; make sure we have a NUL term
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1523 L8C0B puls b ; get back nibble counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1524 decb ; done all?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1525 bne L8BE5 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1526 leas 2,s ; don't return mainline (we're returning a string)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1527 ldx #STRBUF+1 ; point to start of converted number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1528 jmp LB518 ; save string in string space, etc., and return it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1529 ; DLOAD command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1530 DLOAD jsr LA429 ; close files
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1531 L8C1B jsr GETCCH ; get back input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1532 suba #'M ; is it DLOADM?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1533 pshs a ; save DLOADM flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1534 bne L8C25 ; brif DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1535 jsr GETNCH ; eat the "M"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1536 L8C25 jsr LA578 ; parse the file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1537 jsr GETCCH ; get character after file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1538 beq L8C44 ; brif end of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1539 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1540 cmpa #', ; do we have 2 commas?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1541 beq L8C44 ; brif so - use default baud rate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1542 jsr EVALEXPB ; evaluate baud rate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1543 L8C36 lda #44*4 ; delay for 300 baud
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1544 tstb ; was argument 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1545 beq L8C42 ; brif so - 300 baud
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1546 lda #44 ; constant for 1200 baud
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1547 decb ; was it 1?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1548 lbne LB44A ; raise error if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1549 L8C42 sta DLBAUD ; save baud rate constant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1550 L8C44 jsr L8CD0 ; transmit file name and read in file status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1551 pshs a ; save register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1552 lda #-3 ; set input to DLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1553 sta DEVNUM
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1554 puls a ; restore register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1555 tst ,s+ ; is it DLOADM?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1556 beq L8C85 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1557 jsr LA5C7 ; check for end of line - error if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1558 tstb ; ASCII?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1559 beq L8C5F ; brif not - do error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1560 jsr LAD19 ; clear out program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1561 jmp LAC7C ; go read program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1562 L8C5F jmp LA616 ; raise bad file mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1563 ; CLOADM patch for Extended Basic
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1564 L8C62 jsr GETNCH ; get character after CLOAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1565 cmpa #'M ; CLOADM?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1566 lbne CLOAD ; brif not - Color Basic's CLOAD can handle it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1567 clr FILSTA ; close tape file
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1568 jsr GETNCH ; eat the "M"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1569 jsr LA578 ; parse file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1570 jsr LA648 ; find the file
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1571 tst CASBUF+10 ; is it a chunked file?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1572 lbeq LA505 ; brif not - Color Basic's CLOADM can handle it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1573 ldu CASBUF+8 ; get file type and ASCII flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1574 dec DEVNUM ; set source device to tape
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1575 jsr LA635 ; go read the first block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1576 tfr u,d ; put type and ASCII flag somewhere more useful
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1577 ; NOTE: DLOADM comes here to do the final processing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1578 L8C85 subd #0x200 ; is it binary and "machine language"?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1579 bne L8C5F ; brif not - raise an error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1580 ldx ZERO ; default load offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1581 jsr GETCCH ; is there any offset?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1582 beq L8C96 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1583 jsr SYNCOMMA ; make sure there's a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1584 jsr LB73D ; evaluate offset in X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1585 L8C96 stx VD3 ; save offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1586 jsr LA5C7 ; raise error if more stuff follows
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1587 L8C9B bsr L8CC6 ; get type of "amble"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1588 pshs a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1589 bsr L8CBF ; read in block length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1590 tfr d,y ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1591 bsr L8CBF ; read in load address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1592 addd VD3 ; add in offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1593 std EXECJP ; save it as the execution address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1594 tfr d,x ; put load address in a pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1595 lda ,s+ ; get "amble" type
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1596 lbne LA42D ; brif postamble - close file
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1597 L8CB1 bsr L8CC6 ; read a data byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1598 sta ,x ; save in memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1599 cmpa ,x+ ; did it actually save?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1600 bne L8CCD ; brif not RAM - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1601 leay -1,y ; done yet?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1602 bne L8CB1 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1603 bra L8C9B ; look for another "amble"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1604 L8CBF bsr L8CC1 ; read a character to B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1605 L8CC1 bsr L8CC6 ; read character to A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1606 exg a,b ; swap character with previously read one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1607 L8CC5 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1608 L8CC6 jsr LA176 ; read a character from input
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1609 tst CINBFL ; EOF?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1610 beq L8CC5 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1611 L8CCD jmp LA619 ; raise I/O error if EOF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1612 L8CD0 bsr L8D14 ; transmit file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1613 pshs b,a ; save file status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1614 inca ; was file found?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1615 beq L8CDD ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1616 ldu ZERO ; zero U - first block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1617 bsr L8CE4 ; read block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1618 puls a,b,pc ; restore status and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1619 L8CDD ldb #2*26 ; code for NE error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1620 jmp LAC46 ; raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1621 L8CE2 ldu CBUFAD ; get block number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1622 L8CE4 leax 1,u ; bump block number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1623 stx CBUFAD ; save new block number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1624 ldx #CASBUF ; use cassette buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1625 jsr L8D7C ; read a block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1626 jmp LA644 ; reset input buffer pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1627 ; Generic input handler for Extended Basic
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1628 XVEC4 lda DEVNUM ; get device number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1629 cmpa #-3 ; DLOAD?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1630 bne L8D01 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1631 leas 2,s ; don't return to mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1632 clr CINBFL ; reset EOF flag to not EOF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1633 tst CINCTR ; anything available?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1634 bne L8D02 ; brif so - fetch one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1635 com CINBFL ; flag EOF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1636 L8D01 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1637 L8D02 pshs u,y,x,b ; save registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1638 ldx CINPTR ; get buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1639 lda ,x+ ; get character from buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1640 pshs a ; save it for return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1641 stx CINPTR ; save new input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1642 dec CINCTR ; account for byte removed from buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1643 bne L8D12 ; brif buffer not empty
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1644 bsr L8CE2 ; go read a block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1645 L8D12 puls a,b,x,y,u,pc ; restore registers, return value, and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1646 L8D14 clra ; clear attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1647 pshs x,b,a ; make a hole for variables
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1648 leay ,s ; set up frame pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1649 bra L8D1D ; go read block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1650 L8D1B bsr L8D48 ; bump attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1651 L8D1D lda #0x8a ; send file request control code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1652 bsr L8D58
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1653 bne L8D1B ; brif no echo or error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1654 ldx #CFNBUF+1 ; point to file name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1655 L8D26 lda ,x+ ; get file name characater
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1656 jsr L8E04 ; send it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1657 cmpx #CFNBUF+9 ; end of file name?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1658 bne L8D26 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1659 bsr L8D62 ; output check byte and look for response
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1660 bne L8D1B ; transmit name again if not ack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1661 bsr L8D72 ; get file type (0xff is not found)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1662 bne L8D1B ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1663 sta 2,y ; save file type
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1664 bsr L8D72 ; read ASCII flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1665 bne L8D1B ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1666 sta 3,y ; save ASCII flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1667 bsr L8D6B ; read check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1668 bne L8D1B ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1669 leas 2,s ; lose attempt counter and check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1670 puls a,b,pc ; return file type and ascii flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1671 L8D48 inc ,y ; bump attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1672 lda ,y ; get new count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1673 cmpa #5 ; done 5 times?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1674 blo L8D6A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1675 lda #0xbc ; send abort code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1676 jsr L8E0C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1677 jmp LA619 ; raise an I/O error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1678 L8D58 pshs a ; save compare character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1679 bsr L8DB8 ; send character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1680 bne L8D60 ; brif read error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1681 cmpa ,s ; does it match? (set Z if good)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1682 L8D60 puls a,pc ; restore character and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1683 L8D62 lda 1,y ; get XOR check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1684 bsr L8DB8 ; send it and read
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1685 bne L8D6A ; brif read error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1686 cmpa #0xc8 ; is it ack? (set Z if so)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1687 L8D6A rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1688 L8D6B bsr L8D72 ; read character from rs232
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1689 bne L8D6A ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1690 lda 1,y ; get check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1691 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1692 L8D72 bsr L8DBC ; read a character from rs232
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1693 pshs a,cc ; save result (and flags)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1694 eora 1,y ; accumulate xor checksum
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1695 sta 1,y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1696 puls cc,a,pc ; restore byte, flags, and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1697 L8D7C clra ; reset attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1698 pshs u,y,x,b,a ; make a stack frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1699 asl 7,s ; split block number into two 7 bit chuncks
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1700 rol 6,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1701 lsr 7,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1702 leay ,s ; set up frame pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1703 bra L8D8B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1704 L8D89 bsr L8D48 ; bump attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1705 L8D8B lda #0x97 ; send block request code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1706 bsr L8D58
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1707 bne L8D89 ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1708 lda 6,y ; send out block number (high bits first)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1709 bsr L8E04
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1710 lda 7,y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1711 bsr L8E04
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1712 bsr L8D62 ; send check byte and get ack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1713 bne L8D89 ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1714 bsr L8D72 ; read block size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1715 bne L8D89 ; brif read error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1716 sta 4,y ; save character count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1717 ldx 2,y ; get buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1718 ldb #128 ; length of data block
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1719 L8DA7 bsr L8D72 ; read a data byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1720 bne L8D89 ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1721 sta ,x+ ; save byte in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1722 decb ; done a whole block?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1723 bne L8DA7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1724 bsr L8D6B ; read check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1725 bne L8D89 ; brif error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1726 leas 4,s ; lose attempt counter, check byte, and buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1727 puls a,b,x,pc ; return with character count in A, clean rest of stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1728 L8DB8 clr 1,y ; clear check byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1729 bsr L8E0C ; output character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1730 L8DBC clra ; clear attempt counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1731 pshs x,b,cc ; save registers and interrupt status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1732 orcc #0x50 ; disable interrupts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1733 lda TIMOUT ; get timout delay (variable)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1734 ldx ZERO ; get constant timeout value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1735 L8DC5 bsr L8DE6 ; get RS232 status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1736 bcc L8DC5 ; brif "space" - waiting for "mark"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1737 L8DC9 bsr L8DE6 ; get RS232 status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1738 bcs L8DC9 ; brif "mark" - waiting for "space" (start bit)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1739 bsr L8DF9 ; delay for half of bit time
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1740 ldb #1 ; set bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1741 pshs b ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1742 clra ; reset data byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1743 L8DD4 bsr L8DF7 ; wait one bit time
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1744 ldb PIA1+2 ; get input bit to carry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1745 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1746 bcc L8DDE ; brif "space" (0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1747 ora ,s ; merge bit probe in
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1748 L8DDE asl ,s ; shift bit probe over
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1749 bcc L8DD4 ; brif we haven't done 8 bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1750 leas 1,s ; remove bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1751 puls cc,b,x,pc ; restore interrupts, registers, and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1752 L8DE6 ldb PIA1+2 ; get RS232 value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1753 rorb ; put in C
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1754 leax 1,x ; bump timeout
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1755 bne L8DF6 ; brif nonzero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1756 deca ; did the number of waits expire?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1757 bne L8DF6 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1758 leas 2,s ; don't return - we timed out
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1759 puls cc,b,x ; restore interrupts and registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1760 inca ; clear Z (A was zero above)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1761 L8DF6 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1762 L8DF7 bsr L8DF9 ; do first half of bit delay then fall through for second
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1763 L8DF9 pshs a ; save register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1764 lda DLBAUD ; get baud rate constant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1765 L8DFD brn L8DFD ; do nothing - delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1766 deca ; time expired?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1767 bne L8DFD ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1768 puls a,pc ; restore register and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1769 L8E04 pshs a ; save character to send
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1770 eora 1,y ; accumulate chechsum
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1771 sta 1,y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1772 puls a ; get character back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1773 L8E0C pshs b,a,cc ; save registers and interrupt status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1774 orcc #0x50 ; disable interrupts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1775 bsr L8DF7 ; do a bit delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1776 bsr L8DF7 ; do another bit delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1777 clr PIA1 ; set output to space (start bit)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1778 bsr L8DF7 ; do a bit delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1779 ldb #1 ; bit probe start at LSB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1780 pshs b ; save bitprobe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1781 L8E1D lda 2,s ; get output byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1782 anda ,s ; see what our current bit is
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1783 beq L8E25 ; brif output is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1784 lda #2 ; set output to "marking"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1785 L8E25 sta PIA1 ; send bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1786 bsr L8DF7 ; do a bit delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1787 asl ,s ; shift bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1788 bcc L8E1D ; brif not last bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1789 lda #2 ; set output to marking ("stop" bit)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1790 sta PIA1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1791 leas 1,s ; lose bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1792 puls cc,a,b,pc ; restore registers, interrupts, and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1793 ; PRINT USING
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1794 ; This is a massive block of code for something that has limited utility. It is *almost* flexible enough to
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1795 ; be truly useful outside of a narrow range of use cases. Indeed, this comes in at about 1/8 of the total
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1796 ; Extended Color Basic ROM.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1797 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1798 ; This uses several variables:
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1799 ; VD5: pointer to format string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1800 ; VD7: next print item flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1801 ; VD8: right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1802 ; VD9: left digit counter (or length of string argument)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1803 ; VDA: status byte (bits as follows):
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1804 ; 6: force comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1805 ; 5: force leading *
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1806 ; 4: floating $
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1807 ; 3: pre-sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1808 ; 2: post-sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1809 ; 0: scientific notation
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1810 L8E37 lda #1 ; set length to use to 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1811 sta VD9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1812 L8E3B decb ; consume character from format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1813 jsr L8FD8 ; show error flag if flags set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1814 jsr GETCCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1815 lbeq L8ED8 ; brif end of line - bail
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1816 stb VD3 ; save remaining string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1817 jsr LB156 ; evaluate the argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1818 jsr LB146 ; error if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1819 ldx FPA0+2 ; get descriptor for argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1820 stx V4D ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1821 ldb VD9 ; get length counter to use
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1822 jsr LB6AD ; get B bytes of string space (do a LEFT$)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1823 jsr LB99F ; print the formatted string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1824 ldx FPA0+2 ; get formatted string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1825 ldb VD9 ; get requested length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1826 subb ,x ; see if we have any left over
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1827 L8E5F decb ; have we got the right width?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1828 lbmi L8FB3 ; brif so - go process more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1829 jsr LB9AC ; output a space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1830 bra L8E5F ; go see if we're done yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1831 L8E69 stb VD3 ; save current format string counter and pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1832 stx TEMPTR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1833 lda #2 ; initial spaces count = 2 (for the two %s)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1834 sta VD9 ; save length counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1835 L8E71 lda ,x ; get character in string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1836 cmpa #'% ; is it the end of the sequence?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1837 beq L8E3B ; brif so - display requested part of the strign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1838 cmpa #0x20 ; space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1839 bne L8E82 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1840 inc VD9 ; bump spaces count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1841 leax 1,x ; move format pointer forward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1842 decb ; consume character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1843 bne L8E71 ; brif not end of format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1844 L8E82 ldx TEMPTR ; restore format string pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1845 ldb VD3 ; get back format string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1846 lda #'% ; show % as debugging aid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1847 L8E88 jsr L8FD8 ; send error indicator if flags set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1848 jsr PUTCHR ; output character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1849 bra L8EB9 ; go process more format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1850 ; PRINT extension for USING
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1851 XVEC9 cmpa #0xcd ; USING?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1852 beq L8E95 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1853 rts ; return to mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1854 ; This is the main entry point for PRINT USING
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1855 L8E95 leas 2,s ; don't return to the mainline code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1856 jsr LB158 ; evaluate the format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1857 jsr LB146 ; error if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1858 ldb #'; ; make sure there's a ; after the string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1859 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1860 ldx FPA0+2 ; get format string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1861 stx VD5 ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1862 bra L8EAE ; process format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1863 L8EA8 lda VD7 ; is there a print item?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1864 beq L8EB4 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1865 ldx VD5 ; get back format string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1866 L8EAE clr VD7 ; reset next print item flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1867 ldb ,x ; get length of format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1868 bne L8EB7 ; brif string is non-null
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1869 L8EB4 jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1870 L8EB7 ldx 2,x ; point to start of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1871 L8EB9 clr VDA ; clear status (new item)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1872 L8EBB clr VD9 ; clear left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1873 lda ,x+ ; get character from format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1874 cmpa #'! ; ! (use first character of string)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1875 lbeq L8E37 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1876 cmpa #'# ; digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1877 beq L8F24 ; brif so - handle numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1878 decb ; consume format character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1879 bne L8EE2 ; brif not done
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1880 jsr L8FD8 ; show a "+" if any flags set - indicates error at end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1881 jsr PUTCHR ; output format string character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1882 L8ED2 jsr GETCCH ; get current input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1883 bne L8EA8 ; brif not end of statement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1884 lda VD7 ; get next item flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1885 L8ED8 bne L8EDD ; brif more print items
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1886 jsr LB958 ; do newline
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1887 L8EDD ldx VD5 ; point to format string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1888 jmp LB659 ; remove from string stack, etc., if appropriate (and return)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1889 L8EE2 cmpa #'+ ; is it + (pre-sign)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1890 bne L8EEF ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1891 jsr L8FD8 ; send a "+" if flags set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1892 lda #8 ; flag for pre-sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1893 sta VDA ; set flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1894 bra L8EBB ; go interpret some more stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1895 L8EEF cmpa #'. ; decimal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1896 beq L8F41 ; brif so - numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1897 cmpa #'% ; % (show string)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1898 lbeq L8E69 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1899 cmpa ,x ; do we have two identical characters?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1900 L8EFB bne L8E88 ; brif not - invalid format character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1901 cmpa #'$ ; double $?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1902 beq L8F1A ; brif so - floating $
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1903 cmpa #'* ; double *?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1904 bne L8EFB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1905 lda VDA ; get status byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1906 ora #0x20 ; enable * padding
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1907 sta VDA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1908 cmpb #2 ; is $$ the last two?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1909 blo L8F20 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1910 lda 1,x ; is it $ after?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1911 cmpa #'$
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1912 bne L8F20 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1913 decb ; consume the "$"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1914 leax 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1915 inc VD9 ; add to digit counter * pad + $ counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1916 L8F1A lda VDA ; indicate floating $
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1917 ora #0x10
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1918 sta VDA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1919 L8F20 leax 1,x ; consume the second format character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1920 inc VD9 ; add one more left place
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1921 L8F24 clr VD8 ; clear right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1922 L8F26 inc VD9 ; bump left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1923 decb ; consume character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1924 beq L8F74 ; brif end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1925 lda ,x+ ; get next format character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1926 cmpa #'. ; decimal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1927 beq L8F4F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1928 cmpa #'# ; digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1929 beq L8F26 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1930 cmpa #', ; comma flag?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1931 bne L8F5A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1932 lda VDA ; set commas flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1933 ora #0x40
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1934 sta VDA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1935 bra L8F26 ; handle more characters to left of decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1936 L8F41 lda ,x ; get character after .
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1937 cmpa #'# ; digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1938 lbne L8E88 ; brif not - invalid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1939 lda #1 ; set right digit counter to 1 (for the .)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1940 sta VD8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1941 leax 1,x ; consume the .
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1942 L8F4F inc VD8 ; add one to right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1943 decb ; consume character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1944 beq L8F74 ; brif end of format string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1945 lda ,x+ ; get another format character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1946 cmpa #'# ; digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1947 beq L8F4F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1948 L8F5A cmpa #0x5e ; up arrow?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1949 bne L8F74 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1950 cmpa ,x ; two of them?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1951 bne L8F74 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1952 cmpa 1,x ; three of them?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1953 bne L8F74 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1954 cmpa 2,x ; four of them?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1955 bne L8F74 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1956 cmpb #4 ; string actually has the characters?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1957 blo L8F74 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1958 subb #4 ; consome them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1959 leax 4,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1960 inc VDA ; set scientific notation bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1961 L8F74 leax -1,x ; back up input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1962 inc VD9 ; add one digit for pre-sign force
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1963 lda VDA ; is it pre-sign?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1964 bita #8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1965 bne L8F96 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1966 dec VD9 ; undo pre-sign adjustment
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1967 tstb ; end of string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1968 beq L8F96 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1969 lda ,x ; get next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1970 suba #'- ; post sign force?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1971 beq L8F8F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1972 cmpa #'+-'- ; plus?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1973 bne L8F96 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1974 lda #8 ; trailing + is a pre-sign force
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1975 L8F8F ora #4 ; add in post sign flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1976 ora VDA ; merge with flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1977 sta VDA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1978 decb ; consume character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1979 L8F96 jsr GETCCH ; do we have an argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1980 lbeq L8ED8 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1981 stb VD3 ; save format string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1982 jsr LB141 ; evluate numeric expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1983 lda VD9 ; get left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1984 adda VD8 ; add in right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1985 cmpa #17 ; is it more than 16 digits + decimal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1986 lbhi LB44A ; brif so - this is a problem
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1987 jsr L8FE5 ; format value according to settings
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1988 leax -1,x ; move buffer pointer back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1989 jsr STRINOUT ; display formatted number string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1990 L8FB3 clr VD7 ; reset next print item flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1991 jsr GETCCH ; get current input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1992 beq L8FC6 ; brif end of statement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1993 sta VD7 ; set next print flag to nonzero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1994 cmpa #'; ; list separator ;?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1995 beq L8FC4 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1996 jsr SYNCOMMA ; require a comma between if not ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1997 bra L8FC6 ; process next item
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1998 L8FC4 jsr GETNCH ; munch the semicolon
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
1999 L8FC6 ldx VD5 ; get format string descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2000 ldb ,x ; get length of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2001 subb VD3 ; subtract amount left after last item
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2002 ldx 2,x ; point to string address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2003 abx ; move pointer to correct spot
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2004 ldb VD3 ; get remaining string length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2005 lbne L8EB9 ; if we have more, interpret from there
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2006 jmp L8ED2 ; re-interpret from start if we hit the end
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2007 L8FD8 pshs a ; save character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2008 lda #'+ ; "error" flag character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2009 tst VDA ; did we have some flags set?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2010 beq L8FE3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2011 jsr PUTCHR ; output error flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2012 L8FE3 puls a,pc ; restore character and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2013 L8FE5 ldu #STRBUF+4 ; point to string buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2014 ldb #0x20 ; blank space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2015 lda VDA ; get flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2016 bita #8 ; pre-sign?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2017 beq L8FF2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2018 ldb #'+ ; plus sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2019 L8FF2 tst FP0SGN ; get sign of value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2020 bpl L8FFA ; brif positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2021 clr FP0SGN ; make number positive (for later)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2022 ldb #'- ; negative sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2023 L8FFA stb ,u+ ; put sign in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2024 ldb #'0 ; put a zero there
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2025 stb ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2026 anda #1 ; check scientific notation force
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2027 lbne L910D ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2028 ldx #LBDC0 ; point to FP 1E+9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2029 jsr LBCA0 ; is it less?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2030 bmi L9023 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2031 jsr LBDD9 ; convert FP number to string (we're doing scientific notation)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2032 L9011 lda ,x+ ; advance pointer to end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2033 bne L9011
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2034 L9015 lda ,-x ; make a hole at the start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2035 sta 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2036 cmpx #STRBUF+3 ; done yet?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2037 bne L9015 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2038 lda #'% ; put "overflow" flag at start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2039 sta ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2040 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2041 L9023 lda FP0EXP ; get exponent of value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2042 sta V47 ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2043 beq L902C ; brif value is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2044 jsr L91CD ; convert to number with 9 significant figures to left of decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2045 L902C lda V47 ; get base 10 exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2046 lbmi L90B3 ; brif < 100,000,000
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2047 nega ; get negative difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2048 adda VD9 ; add to number of left digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2049 suba #9 ; account for the 9 we actually have
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2050 jsr L90EA ; put leading zeroes in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2051 jsr L9263 ; initialize the decimal point and comma counters
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2052 jsr L9202 ; convert FPA0 to decimal ASCII in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2053 lda V47 ; get base 10 exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2054 jsr L9281 ; put that many zeroes in buffer, stop at decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2055 lda V47 ; get base 10 exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2056 jsr L9249 ; check for decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2057 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2058 bne L9050 ; brif we want stuff after decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2059 leau -1,u ; delete decimal if not needed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2060 L9050 deca ; subtract one place (for decimal)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2061 jsr L90EA ; put zeroes in buffer (trailing)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2062 L9054 jsr L9185 ; insert * padding, floating $, and post-sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2063 tsta ; was there a post sign?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2064 beq L9060 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2065 cmpb #'* ; was first character a *?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2066 beq L9060 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2067 stb ,u+ ; store the post sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2068 L9060 clr ,u ; make srue it's NUL terminated
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2069 ldx #STRBUF+3 ; point to start of buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2070 L9065 leax 1,x ; move to next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2071 stx TEMPTR ; save it for later
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2072 lda VARPTR+1 ; get address of decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2073 suba TEMPTR+1 ; subtract out actual digits left of decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2074 suba VD9 ; subtract out required left digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2075 beq L90A9 ; brif no padding needed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2076 lda ,x ; get current character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2077 cmpa #0x20 ; space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2078 beq L9065 ; brif so - advance pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2079 cmpa #'* ; *?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2080 beq L9065 ; brif so - advance pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2081 clra ; zero on stack is end of data ponter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2082 L907C pshs a ; save character on stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2083 lda ,x+ ; get next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2084 cmpa #'- ; minus?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2085 beq L907C ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2086 cmpa #'+ ; plus?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2087 beq L907C ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2088 cmpa #'$ ; $?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2089 beq L907C ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2090 cmpa #'0 ; zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2091 bne L909E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2092 lda 1,x ; get character after 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2093 bsr L90AA ; clear carry if number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2094 bcs L909E ; brif not number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2095 L9096 puls a ; get character off stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2096 sta ,-x ; put it back in string buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2097 bne L9096 ; brif not - restore another
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2098 bra L9065 ; keep cleaning up buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2099 L909E puls a ; get the character on the stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2100 tsta ; is it NUL?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2101 bne L909E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2102 ldx TEMPTR ; get string buffer start pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2103 lda #'% ; put error flag in front
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2104 sta ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2105 L90A9 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2106 L90AA cmpa #'0 ; zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2107 blo L90B2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2108 suba #'9+1 ; set C if > "9"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2109 suba #-('9+1)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2110 L90B2 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2111 L90B3 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2112 beq L90B8 ; brif not right digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2113 deca ; account for decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2114 L90B8 adda V47 ; add base 10 exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2115 bmi L90BD ; if >= 0, no shifts are required
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2116 clra ; force shift counter to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2117 L90BD pshs a ; save shift counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2118 L90BF bpl L90CB ; brif positive count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2119 pshs a ; save shift counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2120 jsr LBB82 ; divide FPA0 by 10 (shift 1 digit to the right)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2121 puls a ; get shift counter back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2122 inca ; account for the shift
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2123 bra L90BF ; see if we're done yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2124 L90CB lda V47 ; get base 10 exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2125 suba ,s+ ; account for adjustment
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2126 sta V47 ; save new exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2127 adda #9 ; account for significant places
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2128 bmi L90EE ; brif we don't need zeroes to left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2129 lda VD9 ; get left decimal counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2130 suba #9 ; account for significant figures
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2131 suba V47 ; subtract exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2132 bsr L90EA ; output leading zeroes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2133 jsr L9263 ; initialize decimal and comma counters
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2134 bra L90FF ; process remainder of digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2135 L90E2 pshs a ; save zero counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2136 lda #'0 ; insert a 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2137 sta ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2138 puls a ; get back counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2139 L90EA deca ; do we need more zeroes?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2140 bpl L90E2 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2141 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2142 L90EE lda VD9 ; get left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2143 bsr L90EA ; put that many zeroes in
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2144 jsr L924D ; put decimal in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2145 lda #-9 ; figure out filler zeroes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2146 suba V47
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2147 bsr L90EA ; output required leader zeroes
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2148 clr V45 ; clear decimal pointer counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2149 clr VD7 ; clear comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2150 L90FF jsr L9202 ; decode FPA0 to decimal string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2151 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2152 bne L9108 ; brif there are right digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2153 ldu VARPTR ; point to decimal location of decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2154 L9108 adda V47 ; add base 10 exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2155 lbra L9050 ; add in leading astrisks, etc.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2156 L910D lda FP0EXP ; get exponent of FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2157 pshs a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2158 beq L9116 ; brif 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2159 jsr L91CD ; convert to number with 9 figures
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2160 L9116 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2161 beq L911B ; brif no right digits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2162 deca ; account for decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2163 L911B adda VD9 ; get left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2164 clr STRBUF+3 ; use buffer byte as temporary storage
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2165 ldb VDA ; get status flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2166 andb #4 ; post-sign?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2167 bne L9129 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2168 com STRBUF+3 ; flip byte if no post sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2169 L9129 adda STRBUF+3 ; subtract 1 if no post sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2170 suba #9 ; account for significant figures
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2171 pshs a ; save shift counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2172 L9130 bpl L913C ; brif no more shifts needed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2173 pshs a ; save counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2174 jsr LBB82 ; divide by 10 (shift right one)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2175 puls a ; get back counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2176 inca ; account for the shift
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2177 bra L9130 ; see if we need more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2178 L913C lda ,s ; get original shift count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2179 bmi L9141 ; brif shifting happened
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2180 clra ; flag for no shifting
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2181 L9141 nega ; calculate position of decimal (negate shift count, add left digit and post sign if needed)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2182 adda VD9 ; add left digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2183 inca ; and post sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2184 adda STRBUF+3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2185 sta V45 ; save decimal counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2186 clr VD7 ; clear comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2187 jsr L9202 ; convert to decimal string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2188 puls a ; get shift counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2189 jsr L9281 ; put the needed zeroes in
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2190 lda VD8 ; get right digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2191 bne L915A ; brif we want some
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2192 leau -1,u ; remove te decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2193 L915A ldb ,s+ ; get original exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2194 beq L9167 ; brif it was 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2195 ldb V47 ; get base 10 exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2196 addb #9 ; account for significant figures
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2197 subb VD9 ; remove left digit count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2198 subb STRBUF+3 ; add one if post sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2199 L9167 lda #'+ ; positive sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2200 tstb ; is base 10 exponent positive?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2201 bpl L916F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2202 lda #'- ; negative sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2203 negb ; flip exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2204 L916F sta 1,u ; put exponent sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2205 lda #'E ; put "E" and advance output pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2206 sta ,u++
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2207 lda #'0-1 ; initialize digit accumulator
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2208 L9177 inca ; bump digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2209 subb #10 ; are we at the right digit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2210 bcc L9177 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2211 addb #'0+10 ; add ASCII bias and undo extra subtraction
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2212 std ,u++ ; save exponent in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2213 clr ,u ; clear final byte in buffer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2214 jmp L9054 ; insert *, $, etc.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2215 L9185 ldx #STRBUF+4 ; point to start of result
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2216 ldb ,x ; get sign
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2217 pshs b ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2218 lda #0x20 ; default pad with spaces
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2219 ldb VDA ; get flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2220 bitb #0x20 ; padding with *?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2221 puls b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2222 beq L919E ; brif no padding
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2223 lda #'* ; pad with *
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2224 cmpb #0x20 ; do we have a blank? (positive)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2225 bne L919E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2226 tfr a,b ; use pad character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2227 L919E pshs b ; save first character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2228 L91A0 sta ,x+ ; store padding
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2229 ldb ,x ; get next character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2230 beq L91B6 ; brif end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2231 cmpb #'E ; exponent?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2232 beq L91B6 ; brif so - treat as 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2233 cmpb #'0 ; zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2234 beq L91A0 ; brif so - pad it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2235 cmpb #', ; leading comma?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2236 beq L91A0 ; brif so - pad it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2237 cmpb #'. ; decimal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2238 bne L91BA ; brif so - don't put a 0 before it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2239 L91B6 lda #'0 ; put a zero before
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2240 sta ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2241 L91BA lda VDA ; get status byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2242 bita #0x10 ; floating $?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2243 beq L91C4 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2244 ldb #'$ ; stuff a $ in
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2245 stb ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2246 L91C4 anda #4 ; pre-sgn?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2247 puls b ; get back first character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2248 bne L91CC ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2249 stb ,-x ; save leading character (sign)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2250 L91CC rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2251 L91CD pshs u ; save buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2252 clra ; initial exponent offset is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2253 L91D0 sta V47 ; save exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2254 ldb FP0EXP ; get actual exponent
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2255 cmpb #0x80 ; is value >= 1.0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2256 bhi L91E9 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2257 ldx #LBDC0 ; point to FP number 1E9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2258 jsr LBACA ; multiply by 1000000000
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2259 lda V47 ; account for 9 shifts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2260 suba #9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2261 bra L91D0 ; brif not there yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2262 L91E4 jsr LBB82 ; divide by 10
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2263 inc V47 ; account for shift
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2264 L91E9 ldx #LBDBB ; point to 999999999
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2265 jsr LBCA0 ; compare it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2266 bgt L91E4 ; brif not in range yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2267 L91F1 ldx #LBDB6 ; point to 99999999.9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2268 jsr LBCA0 ; compare
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2269 bgt L9200 ; brif in range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2270 jsr LBB6A ; multiply by 10
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2271 dec V47 ; account for shift
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2272 bra L91F1 ; see if we're in range yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2273 L9200 puls u,pc ; restore buffer pointer and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2274 L9202 pshs u ; save buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2275 jsr LB9B4 ; add .5 (round off)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2276 jsr LBCC8 ; convert to integer format
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2277 puls u ; restore buffer pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2278 ldx #LBEC5 ; point to 32 bit powers of 10 (alternating signs)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2279 ldb #0x80 ; intitial digit counter is 0 with 0x80 bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2280 L9211 bsr L9249 ; check for comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2281 L9213 lda FPA0+3 ; add a power of 10
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2282 adda 3,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2283 sta FPA0+3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2284 lda FPA0+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2285 adca 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2286 sta FPA0+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2287 lda FPA0+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2288 adca 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2289 sta FPA0+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2290 lda FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2291 adca ,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2292 sta FPA0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2293 incb ; add one to digit counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2294 rorb ; set V if carry and sign differ
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2295 rolb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2296 bvc L9213 ; brif we haven't "wrapped"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2297 bcc L9235 ; brif subtracting
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2298 subb #10+1 ; take 9's complement if adding
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2299 negb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2300 L9235 addb #'0-1 ; add in ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2301 leax 4,x ; move to next power
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2302 tfr b,a ; save digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2303 anda #0x7f ; mask off subtract flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2304 sta ,u+ ; save digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2305 comb ; toggle add/subtract
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2306 andb #0x80
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2307 cmpx #LBEE9 ; done all places?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2308 bne L9211 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2309 clr ,u ; but NUL at end
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2310 L9249 dec V45 ; at decimal?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2311 bne L9256 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2312 L924D stu VARPTR ; save decimal point pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2313 lda #'. ; insert decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2314 sta ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2315 clr VD7 ; clear comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2316 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2317 L9256 dec VD7 ; do we need a comma?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2318 bne L9262 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2319 lda #3 ; reset comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2320 sta VD7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2321 lda #', ; insert comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2322 sta ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2323 L9262 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2324 L9263 lda V47 ; get base 10 exponent offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2325 adda #10 ; account for significant figures
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2326 sta V45 ; save decimal counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2327 inca ; add one for decimal point
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2328 L926A suba #3 ; divide by 3, leave remainder in A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2329 bcc L926A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2330 adda #5 ; renormalize to range 1-3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2331 sta VD7 ; save comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2332 lda VDA ; get status
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2333 anda #0x40 ; commas wanted?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2334 bne L927A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2335 sta VD7 ; clear comma counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2336 L927A rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2337 L927B pshs a ; save zeroes counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2338 bsr L9249 ; check for decimal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2339 puls a ; get back counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2340 L9281 deca ; need a zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2341 bmi L928E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2342 pshs a ; save counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2343 lda #'0 ; put a zero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2344 sta ,u+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2345 lda ,s+ ; get back counter and set flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2346 bne L927B ; brif not done enough
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2347 L928E rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2348 ; From here to the end of the Extended Basic ROM is the PMODE graphics system and related
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2349 ; infrastructure with the exception of the PLAY command which shares some of its machinery
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2350 ; with the DRAW command.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2351 ;
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2352 ; Fetch screen address calculation routine address for the selected graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2353 L928F ldu #L929C ; point to normalization routine jump table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2354 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2355 asla ; two bytes per address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2356 ldu a,u ; get routine address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2357 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2358 ; Normalize VERBEG/HORBEG coordinates and return screen address in X and pixel mask in A.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2359 L9298 bsr L928F ; fetch normalization routine pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2360 jmp ,u ; transfer control to it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2361 L929C fdb L92A6 ; PMODE 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2362 fdb L92C2 ; PMODE 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2363 fdb L92A6 ; PMODE 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2364 fdb L92C2 ; PMODE 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2365 fdb L92A6 ; PMODE 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2366 ; Two colour mode address calculatoin
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2367 L92A6 pshs u,b ; savce registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2368 ldb HORBYT ; get number of bytes in each graphics row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2369 lda VERBEG+1 ; get vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2370 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2371 addd BEGGRP ; now D is the absolute address of the start of the row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2372 tfr d,x ; get address to the return location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2373 ldb HORBEG+1 ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2374 lsrb ; divide by 8 (8 pixels per byte in 2 colour mode)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2375 lsrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2376 lsrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2377 abx ; now X is the address of the actual pixel byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2378 lda HORBEG+1 ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2379 anda #7 ; keep only the low 3 bits which contain the pixel number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2380 ldu #L92DD ; point to pixel mask lookup
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2381 lda a,u ; get pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2382 puls b,u,pc ; restore registers and return result
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2383 ; four colour address calculation
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2384 L92C2 pshs u,b ; save registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2385 ldb HORBYT ; get bytes per graphics row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2386 lda VERBEG+1 ; get vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2387 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2388 addd BEGGRP ; now D is the address of the start of the row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2389 tfr d,x ; put it in returnlocatin
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2390 ldb HORBEG+1 ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2391 lsrb ; divide by 4 (four colour modes have four pixels per byte)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2392 lsrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2393 abx ; now X points to the screen byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2394 lda HORBEG+1 ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2395 anda #3 ; keep low two bits for pixel number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2396 ldu #L92E5 ; point to four colour pixel masks
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2397 lda a,u ; get pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2398 puls b,u,pc ; restore registers and return result
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2399 L92DD fcb 0x80,0x40,0x20,0x10 ; two colour pixel masks
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2400 fcb 0x08,0x04,0x02,0x01
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2401 L92E5 fcb 0xc0,0x30,0x0c,0x03 ; four colour pixel masks
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2402 ; Move X down one graphics row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2403 L92E9 ldb HORBYT ; get bytes per row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2404 abx ; add to screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2405 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2406 ; Move one pixel right in 2 colour mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2407 L92ED lsra ; move pixel mask right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2408 bcc L92F3 ; brif same byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2409 rora ; move pixel mask to left of byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2410 leax 1,x ; move to next byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2411 L92F3 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2412 ; Move one pixel right in 4 colour mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2413 L92F4 lsra ; shift mask half a pixel right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2414 bcc L92ED ; brif not past end of byte - shift one more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2415 lda #0xc0 ; set mask on left of byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2416 leax 1,x ; move to next byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2417 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2418 ; Evaluate two expressions (coordinates). Put first in HORBEG and second in VERBEG.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2419 L92FC jsr LB734 ; evaluate two expressions - first in BINVAL, second in B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2420 ldy #HORBEG ; point to storage location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2421 L9303 cmpb #192 ; is vertical outside range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2422 blo L9309 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2423 ldb #191 ; max it at bottom of screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2424 L9309 clra ; zero extend vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2425 std 2,y ; save vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2426 ldd BINVAL ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2427 cmpd #256 ; in range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2428 blo L9317 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2429 ldd #255 ; max it out to right side of screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2430 L9317 std ,y ; save horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2431 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2432 ; Normalize coordinates for proper PMODE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2433 L931A jsr L92FC ; parse coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2434 L931D ldu #HORBEG ; point to start coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2435 L9320 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2436 cmpa #2 ; is it pmode 0 or 1?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2437 bhs L932C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2438 ldd 2,u ; get vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2439 lsra ; divide it by two
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2440 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2441 std 2,u ; save it back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2442 L932C lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2443 cmpa #4 ; pmode 4?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2444 bhs L9338 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2445 ldd ,u ; cut horizontal coordinate in half
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2446 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2447 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2448 std ,u ; save new coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2449 L9338 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2450 ; PPOINT function
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2451 PPOINT jsr L93B2 ; evaluate two expressions (coordinates)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2452 jsr L931D ; normalize coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2453 jsr L9298 ; get screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2454 anda ,x ; get colour value of desired screen coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2455 ldb PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2456 rorb ; is it a two colour m ode?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2457 bcc L935B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2458 L9349 cmpa #4 ; is it on rightmost bits?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2459 blo L9351 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2460 rora ; shift right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2461 rora
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2462 bra L9349 ; see if we're there yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2463 L9351 inca ; colour numbers start at 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2464 asla ; add in colour set (0 or 8)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2465 adda CSSVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2466 lsra ; get colour in range of 0 to 8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2467 L9356 tfr a,b ; put result to B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2468 jmp LB4F3 ; return B as FP number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2469 L935B tsta ; is pixel on?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2470 beq L9356 ; brif not, return 0 (off)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2471 clra ; set colour number to "1"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2472 bra L9351 ; make it 1 or 5 and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2473 ; PSET command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2474 PSET lda #1 ; PSET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2475 bra L9366 ; go turn on the pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2476 ; PRESET command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2477 PRESET clra ; PRESET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2478 L9366 sta SETFLG ; store whether we're setting or resetting
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2479 jsr LB26A ; enforce (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2480 jsr L931A ; evaluate coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2481 jsr L9581 ; evaluate colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2482 jsr LB267 ; enforce )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2483 jsr L9298 ; get address of pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2484 L9377 ldb ,x ; get screen data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2485 pshs b ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2486 tfr a,b ; duplicate pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2487 coma ; invert mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2488 anda ,x ; turn off screen pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2489 andb ALLCOL ; adjust pixel mask to be the current colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2490 pshs b ; merge pixel data into the screen data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2491 ora ,s+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2492 sta ,x ; put it on screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2493 suba ,s+ ; nonzero if screen data changed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2494 ora CHGFLG ; propagate change flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2495 sta CHGFLG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2496 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2497 ; Evaluate two sets of coordinates separated by a minus sign. First at HORBEG,VERBEG and
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2498 ; second at HOREND,VEREND. If no first set, use HORDEF,VERDEF.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2499 L938F ldx HORDEF ; set default start coords
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2500 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2501 ldx VERDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2502 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2503 cmpa #0xac ; do we start with a -?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2504 beq L939E ; brif no starting coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2505 jsr L93B2 ; parse coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2506 L939E ldb #0xac ; make sure we have a -
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2507 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2508 jsr LB26A ; require a (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2509 jsr LB734 ; evaluate two expressions
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2510 ldy #HOREND ; point to storage location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2511 jsr L9303 ; process coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2512 bra L93B8 ; finish up with a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2513 L93B2 jsr LB26A ; make sure there's a (
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2514 jsr L92FC ; evaluate coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2515 L93B8 jmp LB267 ; force a )
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2516 ; LINE command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2517 LINE cmpa #0x89 ; is it LINE INPUT?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2518 lbeq L89C0 ; brif so - go handle it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2519 cmpa #'( ; starting coord?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2520 beq L93CE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2521 cmpa #0xac ; leading -?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2522 beq L93CE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2523 ldb #'@ ; if it isn't the above, make sure it's @
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2524 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2525 L93CE jsr L938F ; parse coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2526 ldx HOREND ; set ending coordinates as the defaults
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2527 stx HORDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2528 ldx VEREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2529 stx VERDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2530 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2531 cmpa #0xbe ; PRESET?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2532 beq L93E9 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2533 cmpa #0xbd ; PSET?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2534 lbne LB277 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2535 ldb #01 ; PSET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2536 skip1lda ; skip byte and set A nonzero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2537 L93E9 clrb ; PRESET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2538 pshs b ; save PSET/PRESET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2539 jsr GETNCH ; eat the PSET/PRESET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2540 jsr L9420 ; normalize coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2541 puls b ; get back PSET/PRESET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2542 stb SETFLG ; flag which we're doing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2543 jsr L959A ; set colour byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2544 jsr GETCCH ; get next bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2545 lbeq L94A1 ; brif no box option
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2546 jsr SYNCOMMA ; make sure it's comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2547 ldb #'B ; make sure "B" for "box"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2548 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2549 bne L9429 ; brif something follows the B
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2550 bsr L9444 ; draw horizontal line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2551 bsr L946E ; draw vertical line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2552 ldx HORBEG ; save horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2553 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2554 ldx HOREND ; switch in horizontal end
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2555 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2556 bsr L946E ; draw vertical line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2557 puls x ; get back original start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2558 stx HORBEG ; put it back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2559 ldx VEREND ; do the same dance with the vertical end
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2560 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2561 bra L9444 ; draw horizontal line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2562 L9420 jsr L931D ; normalize the start coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2563 ldu #HOREND ; point to end coords
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2564 jmp L9320 ; normalize those coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2565 L9429 ldb #'F ; make sure we have "BF" for "filled box"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2566 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2567 bra L9434 ; fill the box
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2568 L9430 leax -1,x ; move vertical coordinate up one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2569 L9432 stx VERBEG ; save new vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2570 L9434 jsr L9444 ; draw a horizontal line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2571 ldx VERBEG ; are we at the end of the box?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2572 cmpx VEREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2573 beq L9443 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2574 bcc L9430 ; brif we're moving up the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2575 leax 1,x ; move down the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2576 bra L9432 ; go draw another line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2577 L9443 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2578 ; Draw a horizontal line from HORBEG to HOREND at VERBEG using color mask in ALLCOL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2579 L9444 ldx HORBEG ; get starting horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2580 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2581 jsr L971D ; get absolute value of HOREND-HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2582 bcc L9451 ; brif end is > start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2583 ldx HOREND ; copy end coordinate to start it is smaller
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2584 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2585 L9451 tfr d,y ; save difference - it's a pixel count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2586 leay 1,y ; coordinates are inclusive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2587 jsr L9298 ; get screen position of start coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2588 puls u ; restore original start coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2589 stu HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2590 bsr L9494 ; point to routine to move pizel pointers to right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2591 L945E sta VD7 ; save pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2592 jsr L9377 ; turn on pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2593 lda VD7 ; get pixel mask back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2594 jsr ,u ; move one pixel right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2595 leay -1,y ; turned on enough pixels yet?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2596 bne L945E ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2597 L946B rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2598 L946C puls b,a ; clean up stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2599 L946E ldd VERBEG ; save original vertical start coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2600 pshs b,a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2601 jsr L9710 ; get vertical difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2602 bcc L947B ; brif end coordinate > start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2603 ldx VEREND ; swap in end coordinate if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2604 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2605 L947B tfr d,y ; save number of pixels to set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2606 leay 1,y ; the coordinates are inclusive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2607 jsr L9298 ; get screen pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2608 puls u ; restore start coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2609 stu VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2610 bsr L949D ; point to routine to move down one row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2611 bra L945E ; draw vertical line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2612 ; Point to routine which will move one pixel right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2613 L948A fdb L92ED ; PMODE 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2614 fdb L92F4 ; PMODE 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2615 fdb L92ED ; PMODE 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2616 fdb L92F4 ; PMODE 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2617 fdb L92ED ; PMODE 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2618 L9494 ldu #L948A ; point to jump table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2619 ldb PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2620 aslb ; two bytes per address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2621 ldu b,u ; get jump address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2622 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2623 ; Point to routine to move down one row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2624 L949D ldu #L92E9 ; point to "move down one row" routien
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2625 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2626 ; Draw a line from HORBEG,VERBEG to HOREND,VEREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2627 L94A1 ldy #L950D ; point to increase vertical coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2628 jsr L9710 ; calculate difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2629 lbeq L9444 ; brif none - draw a horizontal line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2630 bcc L94B2 ; brif vertical end is > vertical start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2631 ldy #L951B ; point to decrease vertical coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2632 L94B2 pshs d ; save vertical difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2633 ldu #L9506 ; point to increase horizontal coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2634 jsr L971D ; get difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2635 beq L946C ; brif none - draw a vertical line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2636 bcc L94C1 ; brif horizontal end > horizontal start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2637 ldu #L9514 ; point to decrease hoizontal coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2638 L94C1 cmpd ,s ; compare vert and horiz differences
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2639 puls x ; get X difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2640 bcc L94CC ; brif horiz diff > vert diff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2641 exg u,y ; swap change routine pointers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2642 exg d,x ; swap differences
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2643 L94CC pshs u,d ; save larger difference and routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2644 pshs d ; save larger difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2645 lsra ; divide by two
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2646 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2647 bcs L94DD ; brif odd number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2648 cmpu #L950D+1 ; increase or decrease?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2649 blo L94DD ; brif increase
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2650 subd #1 ; back up one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2651 L94DD pshs x,b,a ; save smallest difference and initial middle offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2652 jsr L928F ; point to proper coordinate to screen conversion routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2653 L94E2 jsr ,u ; convert coordinates to screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2654 jsr L9377 ; turn on a pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2655 ldx 6,s ; get distnace counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2656 beq L9502 ; brif line is completely drawn
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2657 leax -1,x ; account for one pixel drawn
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2658 stx 6,s ; save new counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2659 jsr [8,s] ; increment/decrement larger delta
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2660 ldd ,s ; get the minor coordinate increment counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2661 addd 2,s ; add the smallest difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2662 std ,s ; save new minor coordinate incrementcounter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2663 subd 4,s ; subtractout the largest difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2664 bcs L94E2 ; brif not greater - draw another pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2665 std ,s ; save new minor coordinate increment
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2666 jsr ,y ; adjust minor coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2667 bra L94E2 ; go draw another pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2668 L9502 puls x ; clean up stack and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2669 puls a,b,x,y,u,pc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2670 L9506 ldx HORBEG ; bump horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2671 leax 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2672 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2673 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2674 L950D ldx VERBEG ; bump vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2675 leax 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2676 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2677 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2678 L9514 ldx HORBEG ; decrement horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2679 leax -1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2680 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2681 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2682 L951B ldx VERBEG ; decrement vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2683 leax -1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2684 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2685 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2686 ; Get normalized maximum coordinate values in VD3 and VD5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2687 L9522 ldu #VD3 ; point to temp storage
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2688 ldx #255 ; set maximum horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2689 stx ,u
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2690 ldx #191 ; set maximum vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2691 stx 2,u
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2692 jmp L9320 ; normalize them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2693 ; PCLS command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2694 PCLS beq L9542 ; clear to background colour if no argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2695 bsr L955A ; evaluate colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2696 L9536 lda #0x55 ; consider each byte as 4 groups of 2 bit sub-nibbles
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2697 mul ; now colour is in all four sub-pixels
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2698 ldx BEGGRP ; get start of graphics screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2699 L953B stb ,x+ ; set byte to proper colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2700 cmpx ENDGRP ; at end of graphics page?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2701 bne L953B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2702 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2703 L9542 ldb BAKCOL ; get background colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2704 bra L9536 ; do the clearing dance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2705 ; COLOR command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2706 COLOR cmpa #', ; check for comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2707 beq L9552 ; brif no foreground colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2708 bsr L955A ; evaluate first colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2709 stb FORCOL ; set foreground colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2710 jsr GETCCH ; is there a background colour?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2711 beq L9559 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2712 L9552 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2713 bsr L955A ; evaluate background colour argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2714 stb BAKCOL ; set background colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2715 L9559 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2716 ; Evaluate a colour agument and convert to proper code based on graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2717 L955A jsr EVALEXPB ; evaluate colour code
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2718 L955D cmpb #9 ; is it in range of 0-8?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2719 lbhs LB44A ; brif not - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2720 clra ; CSS value for first colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2721 cmpb #5 ; is it first or second colour set?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2722 blo L956C ; brif first colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2723 lda #8 ; flag second colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2724 subb #4 ; adjust into basic range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2725 L956C pshs a ; save CSS value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2726 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2727 rora ; 4 colour or 2?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2728 bcc L957B ; brif 2 colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2729 tstb ; was it 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2730 bne L9578 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2731 L9576 ldb #4 ; if so, make it 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2732 L9578 decb ; convert to zero based
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2733 L9579 puls a,pc ; get back CSS value and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2734 L957B rorb ; is colour number odd?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2735 bcs L9576 ; brif so - force all bits set colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2736 clrb ; force colour 0 if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2737 bra L9579
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2738 ; Set all pixel byte and active colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2739 L9581 jsr L959A ; set colour byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2740 jsr GETCCH ; is there something to evaluate?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2741 beq L9598 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2742 cmpa #') ; )?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2743 beq L9598 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2744 jsr SYNCOMMA ; force comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2745 cmpa #', ; another comma?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2746 beq L9598 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2747 jsr L955A ; evaluate expression and return colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2748 bsr L95A2 ; save colour and pixel byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2749 L9598 jmp GETCCH ; re-fetch input character and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2750 L959A ldb FORCOL ; use foreground colour by default
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2751 tst SETFLG ; doing PRESET?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2752 bne L95A2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2753 ldb BAKCOL ; default to background colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2754 L95A2 stb WCOLOR ; save working colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2755 lda #0x55 ; consider a byte as 4 pixels
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2756 mul ; now all pixels are set to the same bit pattern
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2757 stb ALLCOL ; set all pixels byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2758 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2759 L95AA bne L95CF ; brif graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2760 L95AC pshs x,b,a ; save registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2761 ldx #SAMREG+8 ; point to middle of control register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2762 sta 10,x ; reset display page to 0x400
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2763 sta 8,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2764 sta 6,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2765 sta 4,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2766 sta 2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2767 sta 1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2768 sta -2,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2769 sta -4,x ; reset to alpha mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2770 sta -6,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2771 sta -8,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2772 lda PIA1+2 ; set VDG to alpha mode, colour set 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2773 anda #7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2774 sta PIA1+2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2775 puls a,b,x,pc ;restore registers and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2776 L95CF pshs x,b,a ; save registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2777 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2778 adda #3 ; offset to 3-7 (we don't use the bottom 3 modes)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2779 ldb #0x10 ; shift to high 4 bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2780 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2781 orb #0x80 ; set to graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2782 orb CSSVAL ; set the desired colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2783 lda PIA1+2 ; get get original PIA values
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2784 anda #7 ; mask off VDG control
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2785 pshs a ; merge with new VDG control
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2786 orb ,s+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2787 stb PIA1+2 ; set new VDG mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2788 lda BEGGRP ; get start of graphics page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2789 lsra ; divide by two - pages are on 512 byte boundaries
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2790 jsr L960F ; set SAM control register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2791 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2792 adda #3 ; shift to VDG values
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2793 cmpa #7 ; PMODE 4?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2794 bne L95F7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2795 deca ; treat PMODE 4 the same as PMODE 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2796 L95F7 bsr L95FB ; program SAM's VDG bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2797 puls a,b,x,pc ; restore registers and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2798 L95FB ldb #3 ; set 3 bits in register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2799 ldx #SAMREG ; point to VDG control bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2800 L9600 rora ; get bit to set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2801 bcc L9607 ; brif we need to clear the bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2802 sta 1,x ; set the bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2803 bra L9609
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2804 L9607 sta ,x ; clear the bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2805 L9609 leax 2,x ; move to next bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2806 decb ; done all bits?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2807 bne L9600 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2808 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2809 L960F ldb #7 ; 7 screen address bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2810 ldx #SAMREG+6 ; point to screen address bits in SAM
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2811 bra L9600 ; go program SAM bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2812 L9616 lda PIA1+2 ; get VDG bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2813 anda #0xf7 ; keep everything but CSS bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2814 ora CSSVAL ; set correct CSS bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2815 sta PIA1+2 ; set desired CSS
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2816 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2817 ; PMODE command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2818 PMODETOK cmpa #', ; is first argument missing?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2819 beq L9650 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2820 jsr EVALEXPB ; evaluate PMODE number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2821 cmpb #5 ; valid (0-4)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2822 bhs L966D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2823 lda GRPRAM ; get start of graphics memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2824 L962E sta BEGGRP ; set start of graphics page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2825 aslb ; multiply mode by two (table has two bytes per entry)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2826 ldu #L9706+1 ; point to lookup table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2827 adda b,u ; add in number of 256 byte pages used for graphics screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2828 cmpa TXTTAB ; does it fit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2829 bhi L966D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2830 sta ENDGRP ; save end of graphics
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2831 leau -1,u ; point to bytes per horizontal row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2832 lda b,u ; get bytes per row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2833 sta HORBYT ; set it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2834 lsrb ; restore PMODE value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2835 stb PMODE ; set graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2836 clra ; set background colour to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2837 sta BAKCOL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2838 lda #3 ; set foreground colour to maximum (3)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2839 sta FORCOL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2840 jsr GETCCH ; is there a starting page number?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2841 beq L966C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2842 L9650 jsr LB738 ; evaluate an expression following a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2843 tstb ; page 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2844 beq L966D ; brif so - not valid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2845 decb ; zero-base it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2846 lda #6 ; each graphics page is 6*256
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2847 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2848 addb GRPRAM ; add to start of graphics memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2849 pshs b ; save start of screen memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2850 addb ENDGRP ; add current and address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2851 subb BEGGRP ; subtract current start (adds size of screen)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2852 cmpb TXTTAB ; does it fit?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2853 bhi L966D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2854 stb ENDGRP ; save new end of graphics
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2855 puls b ; get back start of graphics
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2856 stb BEGGRP ; set start of graphics
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2857 L966C rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2858 L966D jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2859 ; SCREEN command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2860 SCREEN cmpa #', ; is there a mode?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2861 beq L967F ; brif no mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2862 jsr EVALEXPB ; get mode argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2863 tstb ; set Z if alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2864 jsr L95AA ; set SAM/VDG for graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2865 jsr GETCCH ; is there a second argument?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2866 beq L966C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2867 L967F jsr LB738 ; evaluate ,<expr>
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2868 tstb ; colour set 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2869 beq L9687 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2870 ldb #8 ; flag for colour set 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2871 L9687 stb CSSVAL ; set colour set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2872 bra L9616 ; set up VDG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2873 ; PCLEAR command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2874 PCLEAR jsr EVALEXPB ; evaulate number of pages requested
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2875 tstb ; 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2876 beq L966D ; brif zero - not allowed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2877 cmpb #9 ; more than 8?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2878 bhs L966D ; brif so - not allowed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2879 lda #6 ; there are 6 "pages" per graphics page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2880 mul ; now B is the number of pages to reserve
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2881 addb GRPRAM ; add to start of graphics memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2882 tfr b,a ; now A is the MSB of the start of free memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2883 ldb #1 ; program memory always starts one above
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2884 tfr d,y ; save pointer to program memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2885 cmpd ENDGRP ; are we trying to deallocate the current graphics page?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2886 blo L966D ; brif so (note that this prevents PCLEAR 0 anyway)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2887 subd TXTTAB ; subtract out current start of basic program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2888 addd VARTAB ; add in end of program - now D is new top of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2889 tfr d,x ; save new end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2890 inca ; make some extra space (for stack)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2891 subd FRETOP ; see if new top of program fits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2892 bhs L966D ; brif there isn't enough space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2893 jsr L80D0 ; adjust input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2894 nop ; space filler for 1.1 patch (the JSR above)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2895 ldu VARTAB ; get end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2896 stx VARTAB ; save new end of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2897 cmpu VARTAB ; is old end higher?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2898 bhs L96D4 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2899 L96BD lda ,-u ; copy a byte upward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2900 sta ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2901 cmpu TXTTAB ; at beginning?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2902 bne L96BD ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2903 sty TXTTAB ; save new start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2904 clr -1,y ; there must always be a NUL before the program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2905 L96CB jsr LACEF ; re-assign basic program addresses
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2906 jsr LAD26 ; reset variables and stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2907 jmp LAD9E ; return to interpretation loop
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2908 L96D4 ldu TXTTAB ; get start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2909 sty TXTTAB ; save new start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2910 clr -1,y ; there must be a NUL at the start of the program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2911 L96DB lda ,u+ ; move a byte downward
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2912 sta ,y+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2913 cmpy VARTAB ; at the top of the program?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2914 bne L96DB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2915 bra L96CB ; finish up
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2916 ; Graphics initialization routine - this really should be up at the start of the ROM with the
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2917 ; rest of the initialization code.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2918 L96E6 ldb #0x1e ; set start of program to 0x1e00 ("PCLEAR 4")
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2919 stb TXTTAB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2920 lda #6 ; graphics memory starts immediately after the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2921 L96EC sta GRPRAM ; set graphics memory start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2922 sta BEGGRP ; set start of current graphics page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2923 clra ; set PMODE to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2924 sta PMODE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2925 lda #16 ; 16 bytes per graphics row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2926 sta HORBYT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2927 lda #3 ; set foreground colour to 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2928 sta FORCOL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2929 lda #0x0c ; set ending graphics page (for PMODE 0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2930 sta ENDGRP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2931 ldx TXTTAB ; get start of program
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2932 clr -1,x ; make sure there's a NUL before it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2933 L9703 jmp LAD19 ; do a "NEW"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2934 ; PMODE data table (bytes per row and number of 256 byte pages required for a screen)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2935 L9706 fcb 16,6 ; PMODE 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2936 fcb 32,12 ; PMODE 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2937 fcb 16,12 ; PMODE 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2938 fcb 32,24 ; PMODE 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2939 fcb 32,24 ; PMODE 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2940 ; Calculate absolute value of vertical coordinate difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2941 L9710 ldd VEREND ; get ending address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2942 subd VERBEG ; get difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2943 L9714 bcc L9751 ; brif we didn't carry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2944 pshs cc ; save status (C set if start > end)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2945 jsr L9DC3 ; negate the difference to be positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2946 puls cc,pc ; restore C and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2947 ; Calculate absolute value of horizontal coordinate difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2948 L971D ldd HOREND ; get end coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2949 subd HORBEG ; calculate difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2950 bra L9714 ; turn into absolute value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2951 ; PCOPY command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2952 PCOPY bsr L973F ; fetch address of the source page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2953 pshs d ; save address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2954 ldb #0xa5 ; make sure we have TO
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2955 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2956 bsr L973F ; fetch address of the second page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2957 puls x ; get back source
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2958 tfr d,u ; put destination into a pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2959 ldy #0x300 ; 0x300 words to copy
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2960 L9736 ldd ,x++ ; copy a word
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2961 std ,u++
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2962 leay -1,y ; done?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2963 bne L9736 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2964 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2965 L973F jsr EVALEXPB ; evaluate page number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2966 tstb ; zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2967 beq L9752 ; brif invalid page number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2968 ; BUG: this should be deferred until after the address is calculated at which point it should
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2969 ; be bhs instead of bhi. There should also be a check to make sure the page number is less than
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2970 ; or equal to 8 above so we don't have to test for overflows below.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2971 cmpb TXTTAB ; is page number higher than start of program (BUG!)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2972 bhi L9752 ; brif so - error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2973 decb ; zero-base the page number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2974 lda #6 ; 6 "pages" per graphics page
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2975 mul ; now we have proper number of "pages" for the offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2976 addb GRPRAM ; add start of graphics memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2977 exg a,b ; put MSB into A, 0 into B.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2978 L9751 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2979 L9752 jmp LB44A ; raise illegal function call
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2980 ; GET command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2981 GET clrb ; GET flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2982 bra L975A ; go on to the main body
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2983 PUT ldb #1 ; PUT flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2984 L975A stb VD8 ; save GET/PUT flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2985 jsr RVEC22 ; do the RAM hook dance (so Disk Basic can do its thing)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2986 L975F cmpa #'@ ; @ before coordinates?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2987 bne L9765 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2988 jsr GETNCH ; eat the @
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2989 L9765 jsr L938F ; evaluate start/end coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2990 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2991 jsr L98CC ; get pointer to array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2992 tfr X,D ; save descriptor pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2993 ldu ,x ; get offset to next descriptor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2994 leau -2,u ; move back to array name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2995 leau d,u ; point to end of array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2996 stu VD1 ; save end of data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2997 leax 2,x ; point to number of dimensions
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2998 ldb ,x ; get dimension count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
2999 aslb ; two bytes per dimension size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3000 abx ; now X points to start of data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3001 stx VCF ; save start of array data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3002 lda VALTYP ; is it numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3003 bne L9752 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3004 clr VD4 ; set default graphic action to PSET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3005 jsr GETCCH ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3006 beq L97B7 ; brif no action flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3007 com VD4 ; flag action enabled
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3008 jsr SYNCOMMA ; make sure there's a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3009 tst VD8 ; PUT?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3010 bne L979A ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3011 ldb #'G ; check for full graphics option
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3012 jsr LB26F
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3013 bra L97CA ; handle the rest of the process
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3014 L979A ldb #5 ; 5 legal actions for PUT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3015 ldx #L9839 ; point to action table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3016 L979F ldu ,x++ ; get "clear bit" action routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3017 ldy ,x++ ; get "set bit" action routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3018 cmpa ,x+ ; does token match?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3019 beq L97AE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3020 decb ; checked all?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3021 bne L979F ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3022 jmp LB277 ; raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3023 L97AE sty VD5 ; save set bit action address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3024 stu VD9 ; save clear bit action address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3025 jsr GETNCH ; munch the acton token
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3026 bra L97CA ; handle rest of process
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3027 L97B7 ldb #0xf8 ; mask for bottom three bits
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3028 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3029 rora ; odd number mode?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3030 bcc L97C0 ; brif even
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3031 ldb #0xfc ; bottom 2 bits mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3032 L97C0 tfr b,a ; save mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3033 andb HORBEG+1 ; round down the start address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3034 stb HORBEG+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3035 anda HOREND+1 ; round down end address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3036 sta HOREND+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3037 L97CA jsr L971D ; get horizontal size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3038 bcc L97D3 ; brif end > start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3039 ldx HOREND ; switch end in for start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3040 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3041 L97D3 std HOREND ; save size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3042 jsr L9710 ; calculate vertical size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3043 bcc L97DE ; brif end > start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3044 ldx VEREND ; swap in vertical end for the start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3045 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3046 L97DE std VEREND ; save vertical size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3047 lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3048 rora ; even?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3049 ldd HOREND ; get difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3050 bcc L97EB ; brif even (2 colour)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3051 addd HOREND ; add in size (double it)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3052 std HOREND ; save adjusted end size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3053 L97EB jsr L9420 ; normalize differences
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3054 ldd HOREND ; get end coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3055 ldx VEREND ; get end size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3056 leax 1,x ; make vertical size inclusive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3057 stx VEREND ; save it back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3058 tst VD4 ; got "G" or GET action
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3059 bne L9852 ; brif given
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3060 lsra ; we're going for whole bytes here
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3061 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3062 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3063 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3064 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3065 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3066 addd #1 ; make it inclusive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3067 std HOREND ; save new coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3068 jsr L9298 ; convert to screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3069 L9808 ldb HOREND+1 ; get horizontal size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3070 pshs x ; save screen position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3071 L980C tst VD8 ; get/put flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3072 beq L9831 ; brif get
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3073 bsr L9823 ; bump array data pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3074 lda ,u ; copy data from array to screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3075 sta ,x+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3076 L9816 decb ; are we done the row?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3077 bne L980C ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3078 puls x ; get screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3079 jsr L92E9 ; move to next row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3080 dec VEREND+1 ; done?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3081 bne L9808 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3082 L9822 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3083 L9823 ldu VCF ; get array data location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3084 leau 1,u ; bump it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3085 stu VCF ; save new array data location
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3086 cmpu VD1 ; did we hit the end of the array?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3087 bne L9822 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3088 L982E jmp LB44A ; raise function call error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3089 L9831 lda ,x+ ; get data from screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3090 bsr L9823 ; bump array data pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3091 sta ,u ; put data in array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3092 bra L9816 ; do the loopy thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3093 ; PUT actions
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3094 L9839 fdb L9894,L989B ; PSET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3095 fcb 0xbd
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3096 fdb L989B,L9894 ; PRESET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3097 fcb 0xbe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3098 fdb L98B1,L989B ; OR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3099 fcb 0xb1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3100 fdb L9894,L98B1 ; AND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3101 fcb 0xb0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3102 fdb L98A1,L98A1 ; NOT
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3103 fcb 0xa8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3104 L9852 addd #1 ; add to horiz difference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3105 std HOREND ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3106 lda VD8 ; PUT?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3107 bne L9864 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3108 ldu VD1 ; get end of array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3109 L985D sta ,-u ; zero out a byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3110 cmpu VCF ; done?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3111 bhi L985D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3112 L9864 jsr L9298 ; get screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3113 ldb PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3114 rorb ; even?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3115 bcc L986E ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3116 anda #0xaa ; use as pixel mask for 4 colour mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3117 L986E ldb #1 ; set bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3118 ldy VCF ; point to start of array data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3119 L9873 pshs x,a ; save screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3120 ldu HOREND ; get horizontal size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3121 L9877 pshs u,a ; save horizontal size and pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3122 lsrb ; move bit probe right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3123 bcc L9884 ; brif we didn't fall off a byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3124 rorb ; shift carry back in on the left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3125 leay 1,y ; move ahead a byte in the array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3126 cmpy VD1 ; end of array data?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3127 beq L982E ; raise error if so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3128 L9884 tst VD8 ; PUT?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3129 beq L98A7 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3130 bitb ,y ; test bit in array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3131 beq L9890 ; brif not set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3132 jmp [VD5] ; do action routine for bit set
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3133 L9890 jmp [VD9] ; do action routine for bit clear
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3134 L9894 coma ; invert mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3135 anda ,x ; read screen data and reset the desired bit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3136 sta ,x ; save on screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3137 bra L98B1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3138 L989B ora ,x ; merge pixel mask with screen data (turn on bit)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3139 sta ,x ; save on screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3140 bra L98B1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3141 L98A1 eora ,x ; invert the pixel in the screen data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3142 sta ,x ; save on screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3143 bra L98B1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3144 L98A7 bita ,x ; is the bit set?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3145 beq L98B1 ; brif not - do nothing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3146 tfr b,a ; get bit probe
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3147 ora ,y ; turn on proper bit in data
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3148 sta ,y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3149 L98B1 puls a,u ; get back array address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3150 jsr L92ED ; move screen address to the right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3151 leau -1,u ; account for consumed pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3152 cmpu ZERO ; done yet?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3153 bne L9877 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3154 ldx 1,s ; get start of row back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3155 lda HORBYT ; get number of bytes per row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3156 leax a,x ; move ahead one line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3157 puls a ; get back screen pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3158 leas 2,s ; lose the screen pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3159 dec VEREND+1 ; done all rows?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3160 bne L9873 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3161 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3162 L98CC jsr LB357 ; evaluate a variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3163 ldb ,-x ; get variable name
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3164 lda ,-x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3165 tfr d,u ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3166 ldx ARYTAB ; get start of arrays
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3167 L98D7 cmpx ARYEND ; end of arrays?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3168 lbeq LB44A ; brif not found
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3169 cmpu ,x ; correct variable?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3170 beq L98E8 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3171 ldd 2,x ; get array size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3172 leax d,x ; move to next array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3173 bra L98D7 ; check this array
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3174 L98E8 leax 2,x ; move pointer to the array header
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3175 rts ; obviously this rts is not needed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3176 L98EB rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3177 ; PAINT command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3178 PAINT cmpa #'@ ; do we have @ before coords?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3179 bne L98F2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3180 jsr GETNCH ; eat the @
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3181 L98F2 jsr L93B2 ; evaluate coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3182 jsr L931D ; normalize coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3183 lda #1 ; PSET flag (use working colour)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3184 sta SETFLG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3185 jsr L9581 ; parse colour and set working colour, etc.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3186 ldd WCOLOR ; get working colour and all pixels byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3187 pshs d ; save them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3188 jsr GETCCH ; is there anything else?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3189 beq L990A ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3190 jsr L9581 ; evaluate border colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3191 L990A lda ALLCOL ; get border colour all pixel byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3192 sta VD8 ; save border colour pixel byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3193 puls d ; get back working colour details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3194 std WCOLOR
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3195 clra ; store a "stop" frame on the stack so PAINT knows when it's finished unwinding
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3196 pshs u,x,b,a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3197 jsr L9522 ; set up starting coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3198 jsr L928F ; point to pixel mask routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3199 stu VD9 ; save pixel mask routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3200 jsr L99DF ; paint from current horizontal coordinate to zero (left)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3201 beq L9931 ; brif hit border immediately
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3202 jsr L99CB ; paint from current horizontal coordinate upward (right)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3203 lda #1 ; set direction to "down"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3204 sta VD7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3205 jsr L99BA ; save "down" frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3206 neg VD7 ; set direction to "up"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3207 jsr L99BA ; save "up" frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3208 L9931 sts TMPSTK ; save stack pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3209 L9934 tst CHGFLG ; did the paint change anything?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3210 bne L993B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3211 lds TMPSTK ; get back stack pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3212 L993B puls a,b,x,u ; get frame from stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3213 clr CHGFLG ; mark nothing changed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3214 sts TMPSTK ; save stack pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3215 leax 1,x ; move start coordinate right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3216 stx HORBEG ; save new coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3217 stu VD1 ; save length of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3218 sta VD7 ; save up/down flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3219 beq L98EB ; did we hit the "stop" frame?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3220 bmi L9954 ; brif negative going (up)?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3221 incb ; bump vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3222 cmpb VD6 ; at end?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3223 bls L9958 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3224 clrb ; set vertical to 0 (wrap around)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3225 L9954 tstb ; did we wrap?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3226 beq L9934 ; do another block if so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3227 decb ; move up a row
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3228 L9958 stb VERBEG+1 ; save vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3229 jsr L99DF ; paint from horizontal to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3230 beq L996E ; brif we hit the border immediately
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3231 cmpd #3 ; less than 3 pixels?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3232 blo L9969 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3233 leax -2,x ; move two pixels left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3234 bsr L99A1 ; save paint block on the stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3235 L9969 jsr L99CB ; continue painting to the right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3236 L996C bsr L99BA ; save paint data frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3237 L996E coma ; complement length of line just painted and add to length of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3238 comb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3239 L9970 addd VD1 ; save difference between this line and parent line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3240 std VD1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3241 ble L998C ; brif parent line is shorter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3242 jsr L9506 ; bump horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3243 jsr L9A12 ; see if we bounced into the border
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3244 bne L9983 ; brif not border
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3245 ldd #-1 ; move left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3246 bra L9970 ; keep looking
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3247 L9983 jsr L9514 ; move horizontally left
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3248 bsr L99C6 ; save horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3249 bsr L99E8 ; paint right
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3250 bra L996C ; save paint block and do more
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3251 L998C jsr L9506 ; bump horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3252 leax d,x ; point to right end of parent line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3253 stx HORBEG ; set as curent coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3254 coma ; get amount we extend past parent line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3255 comb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3256 subd #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3257 ble L999E ; brif doesn't extend
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3258 tfr d,x ; save length of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3259 bsr L99A1 ; save paint frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3260 L999E jmp L9934
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3261 L99A1 std VCB ; save number of pixels painted
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3262 puls y ; get return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3263 ldd HORBEG ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3264 pshs x,b,a ; save horizontal coordinate and pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3265 lda VD7 ; get up/down flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3266 nega ; reverse it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3267 L99AC ldb VERBEG+1 ; get vertical coordainte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3268 pshs b,a ; save vertical coord and up/down flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3269 pshs y ; put return address back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3270 ldb #2 ; make sure we haven't overflowed memory
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3271 jsr LAC33
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3272 ldd VCB ; get line length back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3273 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3274 L99BA std VCB ; save length of painted line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3275 puls y ; get return address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3276 ldd HOREND ; get start coord
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3277 pshs x,b,a ; save horizontal start and length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3278 lda VD7 ; get up/down flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3279 bra L99AC ; finish up with the stack
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3280 L99C6 ldx HORBEG ; save current horizontal coord and save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3281 stx HOREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3282 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3283 L99CB std VCD ; save number of pixels painted
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3284 ldy HOREND ; get last horizontal start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3285 bsr L99C6 ; save current coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3286 sty HORBEG ; save coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3287 bsr L99E8 ; paint a line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3288 ldx VCD ; get number painted
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3289 leax d,x ; add to the number painted going the other way
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3290 addd #1 ; now D is length of line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3291 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3292 L99DF jsr L99C6 ; put starting coordinate in end
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3293 ldy #L9514 ; decrement horizontal coordinate address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3294 bra L99EE ; go paint line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3295 L99E8 ldy #L9506 ; increment horizontal coordinate address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3296 jsr ,y ; bump coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3297 L99EE ldu ZERO ; initialize pixel count
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3298 ldx HORBEG ; get starting coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3299 L99F2 bmi L9A0B ; brif out of range for hoizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3300 cmpx VD3 ; at end?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3301 bhi L9A0B ; brif right of max
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3302 pshs u,y ; save counter and inc/dec routine pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3303 bsr L9A12 ; at border?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3304 beq L9A09 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3305 jsr L9377 ; set pixel to paint colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3306 puls y,u ; restore counter and inc/dec/pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3307 leau 1,u ; bump number of painted pixels
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3308 jsr ,y ; inc/dec screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3309 bra L99F2 ; go do another pixel
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3310 L9A09 puls y,u ; get back counter and inc/dec routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3311 L9A0B tfr u,d ; save count in D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3312 tfr d,x ; and in X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3313 subd ZERO ; set flags on D (smaller/faster than cmpd ZERO)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3314 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3315 L9A12 jsr [VD9] ; get the screen address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3316 tfr a,b ; save pixel mask
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3317 andb VD8 ; set pixel to border colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3318 pshs b,a ; save mask and border
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3319 anda ,x ; mask current pixel into A
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3320 cmpa 1,s ; does it match border? Z=1 if so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3321 puls a,b,pc ; restore mask, border pixel, and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3322 ; PLAY command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3323 ; This is here mixed in with the graphics package because it shares some machinery with DRAW.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3324 PLAY ldx ZERO ; default values for note length, etc.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3325 ldb #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3326 pshs x,b ; save default values
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3327 jsr LB156 ; evaluate argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3328 clrb ; enable DA and sound output
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3329 jsr LA9A2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3330 jsr LA976
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3331 L9A32 jsr LB654 ; fetch PLAY string details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3332 bra L9A39 ; go evaluate the string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3333 L9A37 puls b,x ; get back play string details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3334 L9A39 stb VD8 ; save length of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3335 beq L9A37 ; brif end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3336 stx VD9 ; save start of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3337 lbeq LA974 ; brif NULL string - disable sound and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3338 L9A43 tst VD8 ; have anything left?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3339 beq L9A37 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3340 jsr L9B98 ; get command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3341 cmpa #'; ; command separator?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3342 beq L9A43 ; brif so - ignore it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3343 cmpa #'' ; '?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3344 beq L9A43 ; brif so - ignore it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3345 cmpa #'X ; execuate sub string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3346 lbeq L9C0A ; brif so - handle it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3347 bsr L9A5C ; handle other commands
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3348 bra L9A43 ; look for more stuff
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3349 L9A5C cmpa #'O ; octave?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3350 bne L9A6D ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3351 ldb OCTAVE ; get current octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3352 incb ; 1-base it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3353 bsr L9AC0 ; get value if present
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3354 decb ; zero-base it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3355 cmpb #4 ; valid octave?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3356 bhi L9ACD ; raise error if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3357 stb OCTAVE ; save new octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3358 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3359 L9A6D cmpa #'V ; volume?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3360 bne L9A8B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3361 ldb VOLHI ; get current high volume limit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3362 lsrb ; shift 2 bits right (DA is 6 bits in high bits)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3363 lsrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3364 subb #31 ; subtract out mid value offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3365 bsr L9AC0 ; read argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3366 cmpb #31 ; maximum range is 31
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3367 bhi L9ACD ; brif out of range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3368 aslb ; adjust back in range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3369 aslb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3370 pshs b ; save new volume
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3371 ldd #0x7e7e ; midrange value for both high and low
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3372 adda ,s ; add new volume to high limit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3373 subb ,s+ ; subtract volume from low limit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3374 std VOLHI ; save new volume limits (sets high and low amplitudes)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3375 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3376 L9A8B cmpa #'L ; note length?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3377 bne L9AB2 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3378 ldb NOTELN ; get current length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3379 bsr L9AC0 ; read parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3380 tstb ; resulting length 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3381 beq L9ACD ; brif so - problem
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3382 stb NOTELN ; save new length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3383 clr DOTVAL ; reset note timer scale factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3384 L9A9A bsr L9A9F ; check for dot
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3385 bcc L9A9A ; brif there was one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3386 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3387 L9A9F tst VD8 ; check length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3388 beq L9AAD ; brif zero
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3389 jsr L9B98 ; get command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3390 cmpa #'. ; dot?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3391 beq L9AAF ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3392 jsr L9BE2 ; move input back and bump length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3393 L9AAD coma ; set C to indicate nothing found
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3394 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3395 L9AAF inc DOTVAL ; bump number of dots
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3396 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3397 L9AB2 cmpa #'T ; tempo?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3398 bne L9AC3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3399 ldb TEMPO ; get current tempo
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3400 bsr L9AC0 ; parse tempo argument
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3401 tstb ; 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3402 beq L9ACD ; brif so - invalid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3403 stb TEMPO ; save new tempo
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3404 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3405 L9AC0 jmp L9BAC ; evaluate various operators
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3406 L9AC3 cmpa #'P ; pause?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3407 bne L9AEB ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3408 jsr L9CCB ; evaluate parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3409 tstb ; is the pause number 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3410 bne L9AD0 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3411 L9ACD jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3412 L9AD0 lda DOTVAL ; save current volume and note scale
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3413 ldx VOLHI
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3414 pshs x,a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3415 lda #0x7e ; drop DA to mid range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3416 sta VOLHI
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3417 sta VOLLOW
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3418 clr DOTVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3419 bsr L9AE7 ; go play a "silence"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3420 puls a,x ; restore volume and note scale
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3421 sta DOTVAL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3422 stx VOLHI
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3423 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3424 L9AE7 clr ,-s ; set not number 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3425 bra L9B2B ; go play it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3426 L9AEB cmpa #'N ; N for "note"?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3427 bne L9AF2 ; brif not - it's optional
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3428 jsr L9B98 ; skip the "N"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3429 L9AF2 cmpa #'A ; is it a valid note?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3430 blo L9AFA ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3431 cmpa #'G ; is it above the note range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3432 bls L9AFF ; brif not - valid note
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3433 L9AFA jsr L9BBE ; evaluate a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3434 bra L9B22 ; process note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3435 L9AFF suba #'A ; normalize note number to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3436 ldx #L9C5B ; point to note number lookup table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3437 ldb a,x ; get not number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3438 tst VD8 ; any command characters left?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3439 beq L9B22 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3440 jsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3441 cmpa #'# ; sharp?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3442 beq L9B15 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3443 cmpa #'+ ; also sharp?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3444 bne L9B18 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3445 L9B15 incb ; add one half tone
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3446 bra L9B22
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3447 L9B18 cmpa #'- ; flat?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3448 bne L9B1F ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3449 decb ; subtract one half tone
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3450 bra L9B22
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3451 L9B1F jsr L9BE2 ; back up command pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3452 L9B22 decb ; adjust note number (zero base it)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3453 cmpb #11 ; is it valid?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3454 bhi L9ACD ; raise error if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3455 pshs b ; save note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3456 ldb NOTELN ; get note length
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3457 L9B2B lda TEMPO ; get tempo value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3458 mul ; calculate note duration
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3459 std VD5 ; save duration
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3460 leau 1,s ; point to where the stack goes after we're done
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3461 lda OCTAVE ; get current octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3462 cmpa #1 ; 0 or 1?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3463 bhi L9B64 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3464 ldx #L9C62 ; point to delay table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3465 ldb #2*12 ; 24 bytes per octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3466 mul ; now we have the base address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3467 abx ; now X points to the octave base
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3468 puls b ; get back note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3469 aslb ; two bytes per delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3470 abx ; now we're pointing to the delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3471 leay ,x ; save pointer to note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3472 bsr L9B8C ; calculate note timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3473 std PLYTMR ; set timer for note playing (IRQ will count this down)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3474 L9B49 bsr L9B57 ; set to mid range and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3475 lda VOLHI ; get high value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3476 bsr L9B5A ; set to high value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3477 bsr L9B57 ; set to mid range and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3478 lda VOLLOW ; get low value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3479 bsr L9B5A ; set to low value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3480 bra L9B49 ; do it again (IRQ will break the loop)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3481 L9B57 lda #0x7e ; mid value for DA with RS232 marking
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3482 nop ; a delay to fine tune frequencies
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3483 L9B5A sta PIA1 ; set DA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3484 ldx ,y ; get delay value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3485 L9B5F leax -1,x ; count down
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3486 bne L9B5F ; brif not done yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3487 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3488 L9B64 ldx #L9C92-2*12 ; point to delay table for octaves 2+
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3489 ldb #12 ; 12 bytes per octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3490 mul ; now we have the offset to the desired octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3491 abx ; now we point to the start of the octave
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3492 puls b ; get back note value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3493 abx ; now we point to the delay value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3494 bsr L9B8C ; calculate timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3495 std PLYTMR ; set play timer (IRQ counts this down)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3496 L9B72 bsr L9B80 ; send mid value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3497 lda VOLHI ; get high value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3498 bsr L9B83 ; send high value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3499 bsr L9B80 ; send low value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3500 lda VOLLOW ; get low value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3501 bsr L9B83 ; send low value and delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3502 bra L9B72 ; do it again (IRQ will break the loop)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3503 L9B80 lda #0x7e ; mid range value with RS232 marking
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3504 nop ; fine tuning delay
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3505 L9B83 sta PIA1 ; set DA
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3506 lda ,x ; get delay value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3507 L9B88 deca ; count down
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3508 bne L9B88 ; brif not done
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3509 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3510 L9B8C ldb #0xff ; base timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3511 lda DOTVAL ; get number of dots
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3512 beq L9B97 ; use default value if 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3513 adda #2 ; add in constant timer factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3514 mul ; multiply scale by base
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3515 lsra ; divide by two - each increment will increase note timer by 128
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3516 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3517 L9B97 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3518 L9B98 pshs x ; save register
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3519 L9B9A tst VD8 ; do we have anything left?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3520 beq L9BEB ; brif not - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3521 ldx VD9 ; get parsing address
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3522 lda ,x+ ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3523 stx VD9 ; save pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3524 dec VD8 ; account for character consumed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3525 cmpa #0x20 ; space?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3526 beq L9B9A ; brif so - skip it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3527 puls x,pc ; restore register and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3528 L9BAC bsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3529 cmpa #'+ ; add one?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3530 beq L9BEE ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3531 cmpa #'- ; subtract one?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3532 beq L9BF2 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3533 cmpa #'> ; double?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3534 beq L9BFC ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3535 cmpa #'< ; halve?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3536 beq L9BF7 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3537 L9BBE cmpa #'= ; variable equate?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3538 beq L9C01 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3539 jsr L90AA ; clear carry if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3540 bcs L9BEB ; brif not numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3541 clrb ; initialize value to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3542 L9BC8 suba #'0 ; remove ASCII bias
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3543 sta VD7 ; save digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3544 lda #10 ; make room for digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3545 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3546 tsta ; did we overflow 8 bits?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3547 bne L9BEB ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3548 addb VD7 ; add in digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3549 bcs L9BEB ; brif that overflowed
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3550 tst VD8 ; more digits?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3551 beq L9BF1 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3552 jsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3553 jsr L90AA ; clear carry if numeric
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3554 bcc L9BC8 ; brif another digit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3555 L9BE2 inc VD8 ; unaccount for character just read
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3556 ldx VD9 ; move pointer back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3557 leax -1,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3558 stx VD9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3559 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3560 L9BEB jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3561 L9BEE incb ; bump param
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3562 beq L9BEB ; brif overflow
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3563 L9BF1 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3564 L9BF2 tstb ; already zero?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3565 beq L9BEB ; brif so - underflow
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3566 decb ; decrease parameter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3567 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3568 L9BF7 tstb ; already at 0?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3569 beq L9BEB ; brif so - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3570 lsrb ; halve it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3571 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3572 L9BFC tstb ; will it overflow?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3573 bmi L9BEB ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3574 aslb ; double it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3575 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3576 L9C01 pshs u,y ; save registers
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3577 bsr L9C1B ; interpret command string as a variable
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3578 jsr LB70E ; convert it to an 8 bit number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3579 puls y,u,pc ; restore registers and return
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3580 L9C0A jsr L9C1B ; evaluate expression in command string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3581 ldb #2 ; room for 4 bytes?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3582 jsr LAC33
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3583 ldb VD8 ; get the command length and pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3584 ldx VD9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3585 pshs x,b ; save them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3586 jmp L9A32 ; go process the sub string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3587 L9C1B ldx VD9 ; get command pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3588 pshs x ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3589 jsr L9B98 ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3590 jsr LB3A2 ; set carry if not alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3591 bcs L9BEB ; brif not a variable reference
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3592 L9C27 jsr L9B98 ; get command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3593 cmpa #'; ; semicolon?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3594 bne L9C27 ; keep scanning if not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3595 puls x ; get back start of variable string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3596 ldu CHARAD ; get current interpreter input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3597 pshs u ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3598 stx CHARAD ; point interpreter at command string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3599 jsr LB284 ; evaluate expression as string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3600 puls x ; restore interpeter input pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3601 stx CHARAD
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3602 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3603 ; The bit of Extended Basic's IRQ routine that handles PLAY. Note that everything after
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3604 ; clr PLYTMR+1 could be replaced with a simple lds 8,s followed by rts.
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3605 L9C3E clra ; make sure DP is set to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3606 tfr a,dp
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3607 ldd PLYTMR ; is PLAY running?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3608 lbeq LA9BB ; brif not - transfer control on the Color Basic's routine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3609 subd VD5 ; subtract out the interval
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3610 std PLYTMR ; save new timer value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3611 bhi L9C5A ; brif it isn't <= 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3612 clr PLYTMR ; disable the timer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3613 clr PLYTMR+1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3614 puls a ; get saved CC
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3615 lds 7,s ; set stack to saved U value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3616 anda #0x7f ; clear E flag (to return minimal state)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3617 pshs a ; set fake "FIRQ" stack frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3618 L9C5A rti
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3619 L9C5B fcb 10,12,1,3,5,6,8 ; table of half tone numbers for notes A-G
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3620 L9C62 fdb 0x01a8,0x0190,0x017a,0x0164 ; delays for octave 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3621 fdb 0x0150,0x013d,0x012b,0x011a
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3622 fdb 0x010a,0x00fb,0x00ed,0x00df
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3623 fdb 0x00d3,0x00c7,0x00bb,0x00b1 ; delays for octave 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3624 fdb 0x00a6,0x009d,0x0094,0x008b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3625 fdb 0x0083,0x007c,0x0075,0x006e
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3626 L9C92 fcb 0xa6,0x9c,0x93,0x8b ; delays for octave 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3627 fcb 0x83,0x7b,0x74,0x6d
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3628 fcb 0x67,0x61,0x5b,0x56
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3629 fcb 0x51,0x4c,0x47,0x43 ; delays for octave 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3630 fcb 0x3f,0x3b,0x37,0x34
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3631 fcb 0x31,0x2e,0x2b,0x28
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3632 fcb 0x26,0x23,0x21,0x1f ; delays for octave 5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3633 fcb 0x1d,0x1b,0x19,0x18
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3634 fcb 0x16,0x14,0x13,0x12
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3635 ; DRAW command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3636 DRAW ldx ZERO ; create an empty "DRAW" frame
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3637 ldb #1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3638 pshs x,b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3639 stb SETFLG ; set to "PSET" mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3640 stx VD5 ; clear update and draw flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3641 jsr L959A ; set active colour byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3642 jsr LB156 ; evaluate command string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3643 L9CC6 jsr LB654 ; fetch command string details
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3644 bra L9CD3 ; interpret the command string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3645 L9CCB jsr L9B98 ; fetch command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3646 jmp L9BBE ; evaluate a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3647 L9CD1 puls b,x ; get previously saved command string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3648 L9CD3 stb VD8 ; save length counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3649 beq L9CD1 ; brif end of string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3650 stx VD9 ; save pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3651 lbeq L9DC7 ; brif overall end of command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3652 L9CDD tst VD8 ; are we at the end of the string?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3653 beq L9CD1 ; brif so - return to previous string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3654 jsr L9B98 ; get command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3655 cmpa #'; ; semicolon?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3656 beq L9CDD ; brif so - ignore it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3657 cmpa #'' ; '?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3658 beq L9CDD ; brif so - ignore that too
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3659 cmpa #'N ; update position toggle?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3660 bne L9CF4 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3661 com VD5 ; toggle update position flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3662 bra L9CDD ; get on for another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3663 L9CF4 cmpa #'B ; blank flag?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3664 bne L9CFC ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3665 com VD6 ; toggle blank flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3666 bra L9CDD ; get on for another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3667 L9CFC cmpa #'X ; substring?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3668 lbeq L9D98 ; brif so - execute command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3669 cmpa #'M ; move draw position?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3670 lbeq L9E32 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3671 pshs a ; save command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3672 ldb #1 ; default value if no number follows
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3673 tst VD8 ; is there something there?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3674 beq L9D21 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3675 jsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3676 jsr LB3A2 ; set C if not alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3677 pshs cc ; save alpha state
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3678 jsr L9BE2 ; move back pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3679 puls cc ; get back alpha flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3680 bcc L9D21 ; brif it's alpha
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3681 bsr L9CCB ; evaluate a number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3682 L9D21 puls a ; get command back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3683 cmpa #'C ; color change?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3684 beq L9D4F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3685 cmpa #'A ; angle?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3686 beq L9D59 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3687 cmpa #'S ; scale?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3688 beq L9D61 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3689 cmpa #'U ; up?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3690 beq L9D8F ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3691 cmpa #'D ; down?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3692 beq L9D8C ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3693 cmpa #'L ; left?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3694 beq L9D87 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3695 cmpa #'R ; right?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3696 beq L9D82 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3697 suba #'E ; normalize the half cardinals to 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3698 beq L9D72 ; brif E (45°)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3699 deca ; F (135°?)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3700 beq L9D6D ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3701 deca ; G (225°?)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3702 beq L9D7B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3703 deca ; H (315°?)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3704 beq L9D69 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3705 L9D4C jmp LB44A ; raise FC error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3706 L9D4F jsr L955D ; adjust colour for PMODE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3707 stb FORCOL ; save new foreground colour
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3708 jsr L959A ; set up working colour and all pixels byte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3709 L9D57 bra L9CDD ; go process another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3710 L9D59 cmpb #4 ; only 3 angles are valid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3711 bhs L9D4C ; brif not valid
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3712 stb ANGLE ; save new angle
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3713 bra L9D57 ; go process another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3714 L9D61 cmpb #63 ; only 64 scale values are possible
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3715 bhs L9D4C ; brif out of range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3716 stb SCALE ; save new scale factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3717 bra L9D57 ; go process another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3718 L9D69 clra ; make horizontal negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3719 bsr L9DC4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3720 skip1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3721 L9D6D clra ; keep horizontal distance positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3722 tfr d,x ; make horizontal distance and vertical distance the same
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3723 bra L9DCB ; go do the draw thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3724 L9D72 clra ; zero extend horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3725 tfr d,x ; set it as vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3726 bsr L9DC4 ; negate horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3727 exg d,x ; swap directions (vertical is now negative)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3728 bra L9DCB ; go do the draw thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3729 L9D7B clra ; zero extend horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3730 tfr d,x ; copy horizontal to vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3731 bsr L9DC4 ; negate horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3732 bra L9DCB ; go do the drawing thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3733 L9D82 clra ; zero extend horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3734 L9DB3 ldx ZERO ; no vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3735 bra L9DCB ; go do the drawing things
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3736 L9D87 clra ; zero extend horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3737 bsr L9DC4 ; negate horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3738 bra L9DB3 ; zero out vertical and do the drawing thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3739 L9D8C clra ; zero extend distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3740 bra L9D92 ; make the distance vertical and zero out horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3741 L9D8F clra ; zero extend distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3742 bsr L9DC4 ; negate distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3743 L9D92 ldx ZERO ; zero out vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3744 exg x,d ; swap vertical and horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3745 bra L9DCB ; go do the drawing thing
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3746 L9D98 jsr L9C1B ; evaluate substring expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3747 ldb #2 ; is there enough room for the state?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3748 jsr LAC33
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3749 ldb VD8 ; save current command string state
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3750 ldx VD9
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3751 pshs x,b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3752 jmp L9CC6 ; go evaluate the sub string
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3753 L9DA9 ldb SCALE ; get scale factor
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3754 beq L9DC8 ; brif zero - default to full size
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3755 clra ; zero extend
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3756 exg d,x ; put distance somewhere useful
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3757 sta ,-s ; save MS of distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3758 bpl L9DB6 ; brif positive distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3759 bsr L9DC3 ; negate the distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3760 L9DB6 jsr L9FB5 ; multiply D and X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3761 tfr u,d ; save ms bytes in D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3762 lsra ; divide by 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3763 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3764 L9DBD lsra ; ...divide by 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3765 rorb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3766 tst ,s+ ; negative distance?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3767 bpl L9DC7 ; brif it was positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3768 L9DC3 nega ; negate D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3769 L9DC4 negb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3770 sbca #0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3771 L9DC7 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3772 L9DC8 tfr x,d ; copy unchanged sitance to D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3773 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3774 L9DCB pshs b,a ; save horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3775 bsr L9DA9 ; apply scale factor to vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3776 puls x ; get horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3777 pshs b,a ; save scaled vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3778 bsr L9DA9 ; apply scale to horizontal
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3779 puls x ; get back vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3780 ldy ANGLE ; get draw angle and scale
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3781 pshs y ; save them
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3782 L9DDC tst ,s ; is there an angle?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3783 beq L9DE8 ; brif no angle
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3784 exg x,d ; swap distances
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3785 bsr L9DC3 ; negate D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3786 dec ,s ; account for one tick around the rotation
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3787 bra L9DDC ; see if we're there yet
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3788 L9DE8 puls y ; get angle and scale back
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3789 ldu ZERO ; default end position (horizontal) is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3790 addd HORDEF ; add default horizontal to horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3791 bmi L9DF2 ; brif we went negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3792 tfr d,u ; save calculated end coordindate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3793 L9DF2 tfr x,d ; get vertical distance somewhere useful
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3794 ldx ZERO ; default vertical end is 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3795 addd VERDEF ; add distance to default vertical start
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3796 bmi L9DFC ; brif negative - use 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3797 tfr d,x ; save calculated end coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3798 L9DFC cmpu #256 ; is horizontal in range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3799 blo L9E05 ; brif su
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3800 ldu #255 ; maximize it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3801 L9E05 cmpx #192 ; is vertical in range?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3802 blo L9E0D ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3803 ldx #191 ; maximize it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3804 L9E0D ldd HORDEF ; set starting coordinates for the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3805 std HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3806 ldd VERDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3807 std VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3808 stx VEREND ; set end coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3809 stu HOREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3810 tst VD5 ; are we updating position?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3811 bne L9E21 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3812 stx VERDEF ; update default coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3813 stu HORDEF
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3814 L9E21 jsr L9420 ; normalize coordindates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3815 tst VD6 ; are we drawing something?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3816 bne L9E2B ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3817 jsr L94A1 ; draw the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3818 L9E2B clr VD5 ; reset draw and update flags
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3819 clr VD6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3820 jmp L9CDD ; do another command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3821 L9E32 jsr L9B98 ; get a command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3822 pshs a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3823 jsr L9E5E ; evaluate horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3824 pshs b,a ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3825 jsr L9B98 ; get character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3826 cmpa #', ; comma between coordinates?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3827 lbne L9D4C ; brif not - raise error
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3828 jsr L9E5B ; evaluate vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3829 tfr d,x ; save vertical distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3830 puls u ; get horizontal distance
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3831 puls a ; get back first command character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3832 cmpa #'+ ; was it + at start?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3833 beq L9E56 ; brif +; treat values as positive
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3834 cmpa #'- ; was it -?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3835 bne L9DFC ; brif not - treat it as absolute
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3836 L9E56 tfr u,d ; put horizontal distance somewhere useful
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3837 jmp L9DCB ; move draw position (relative)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3838 L9E5B jsr L9B98 ; get input character
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3839 L9E5E cmpa #'+ ; leading +?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3840 beq L9E69 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3841 cmpa #'- ; leading -?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3842 beq L9E6A ; brif so - negative
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3843 jsr L9BE2 ; move pointer back one
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3844 L9E69 clra ; 0 for +, nonzero for -
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3845 L9E6A pshs a ; save sign flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3846 jsr L9CCB ; evaluate number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3847 puls a ; get sign flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3848 tsta ; negative?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3849 beq L9E78 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3850 clra ; zero extend and negate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3851 negb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3852 sbca #0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3853 L9E78 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3854 ; Table of sines and cosines for CIRCLE
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3855 L9E79 fdb 0x0000,0x0001 ; subarc 0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3856 fdb 0xfec5,0x1919 ; subarc 1
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3857 fdb 0xfb16,0x31f2 ; subarc 2
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3858 fdb 0xf4fb,0x4a51 ; subarc 3
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3859 fdb 0xec84,0x61f9 ; subarc 4
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3860 fdb 0xe1c7,0x78ae ; subarc 5
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3861 fdb 0xd4dc,0x8e3b ; subarc 6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3862 fdb 0xc5e5,0xa269 ; subarc 7
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3863 fdb 0xb506,0xb506 ; subarc 8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3864 ; CIRCLE command
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3865 ; The circle is drawn as a 64 sided polygon (64 LINE commands essentially)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3866 CIRCLE cmpa #'@ ; is there an @ before coordinates?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3867 bne L9EA3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3868 jsr GETNCH ; eat the @
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3869 L9EA3 jsr L9522 ; get max coordinates for screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3870 jsr L93B2 ; parse coordinates for circle centre
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3871 jsr L931D ; normalize the start coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3872 ldx ,u ; get horizontal coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3873 stx VCB ; save it
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3874 ldx 2,u ; get vertical coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3875 stx VCD ; saveit
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3876 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3877 jsr LB73D ; evaluate radius expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3878 ldu #VCF ; point to temp storage
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3879 stx ,u ; save radius
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3880 jsr L9320 ; normalize radius
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3881 lda #1 ; default to PSET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3882 sta SETFLG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3883 jsr L9581 ; evaluate the colour expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3884 ldx #0x100 ; height/width default value
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3885 jsr GETCCH ; is there a ratio?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3886 beq L9EDF ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3887 jsr SYNCOMMA ; make sure we have a comma
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3888 jsr LB141 ; evaluate the ratio
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3889 lda FP0EXP ; multiply ratio by 256
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3890 adda #8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3891 sta FP0EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3892 jsr LB740 ; evaluate ratio to X (fraction part in LSB)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3893 L9EDF lda PMODE ; get graphics mode
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3894 bita #2 ; is it even?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3895 beq L9EE9 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3896 tfr x,d ; double the ratio
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3897 leax d,x
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3898 L9EE9 stx VD1 ; save height/width ratio
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3899 ldb #1 ; set the SET flag to PSET
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3900 stb SETFLG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3901 stb VD8 ; set first time flag (set to 0 after arc drawn)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3902 jsr L9FE2 ; evaluate circle starting point (octant, subarc)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3903 pshs b,a ; save startpoint
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3904 jsr L9FE2 ; evaluate circle end point (octant, subarc)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3905 std VD9 ; save endp oint
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3906 puls a,b
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3907 L9EFD pshs b,a ; save current circle position
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3908 ldx HOREND ; move end coordinates to start coordinates
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3909 stx HORBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3910 ldx VEREND
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3911 stx VERBEG
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3912 ldu #L9E79+2 ; point to sine/cosine table
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3913 anda #1 ; even octant?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3914 beq L9F11 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3915 negb ; convert 0-7 to 8-1 for odd octants
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3916 addb #8
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3917 L9F11 aslb ; four bytes per table entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3918 aslb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3919 leau b,u ; point to correct table entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3920 pshs u ; save sine/cosine table entry pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3921 jsr L9FA7 ; calculate horizontal offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3922 puls u ; get back table entry pointer
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3923 leau -2,u ; move to cosine entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3924 pshs x ; save horizontal offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3925 jsr L9FA7 ; calculate vertical offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3926 puls y ; put horizontal in Y
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3927 lda ,s ; get octant number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3928 anda #3 ; is it 0 or 4?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3929 beq L9F31 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3930 cmpa #3 ; is it 3 or 7?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3931 beq L9F31 ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3932 exg x,y ; swap horizontal and vertical
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3933 L9F31 stx HOREND ; save horizontal offset
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3934 tfr y,x ; put vertical offset in X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3935 ldd VD1 ; get height/width ratio
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3936 jsr L9FB5 ; multiply vertical by h/w ratio
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3937 tfr y,d ; save the product to D
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3938 tsta ; did it overflow?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3939 lbne LB44A ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3940 stb VEREND ; save vertical coordinate MSB
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3941 tfr u,d ; get LSW of product
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3942 sta VEREND+1 ; save LSB of integer part (we have 8 bits of fraction in the ratio)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3943 lda ,s ; get octant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3944 cmpa #2 ; is it 0 or 1?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3945 blo L9F5B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3946 cmpa #6 ; is it 6 or 7?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3947 bhs L9F5B ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3948 ldd VCB ; get horizontal centre
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3949 subd HOREND ; subtract horizontal displacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3950 bcc L9F68 ; brif we didn't overflow the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3951 clra ; zero out coordinate if we overflowed the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3952 clrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3953 bra L9F68
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3954 L9F5B ldd VCB ; get horizontal coordinate of the centre
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3955 addd HOREND ; add displacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3956 bcs L9F66 ; brif overlod
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3957 cmpd VD3 ; larger than max horizontal coord?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3958 blo L9F68 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3959 L9F66 ldd VD3 ; maximize the coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3960 L9F68 std HOREND ; save horizontal ending coordainte
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3961 lda ,s ; get octant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3962 cmpa #4 ; is it 0-3?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3963 blo L9F7A ; brif so
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3964 ldd VCD ; get vertical coordinate of centre
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3965 subd VEREND ; subtract displacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3966 bcc L9F87 ; brif we didn't overflow the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3967 clra ; minimize to top of screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3968 clrb
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3969 bra L9F87
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3970 L9F7A ldd VCD ; get vertical centre coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3971 addd VEREND ; add displacement
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3972 bcs L9F85 ; brif we overflowed the screen
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3973 cmpd VD5 ; did we go past max coordinate?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3974 blo L9F87 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3975 L9F85 ldd VD5 ; maximize the coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3976 L9F87 std VEREND ; save end coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3977 tst VD8 ; check first time flag
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3978 bne L9F8F ; do not draw if first time through (it was setting start coord)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3979 bsr L9FDF ; draw the line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3980 L9F8F puls a,b ; get arc number and sub arc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3981 lsr VD8 ; get first time flag value (and clear it!)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3982 bcs L9F9A ; do not check for end point after drawing for first coordinate
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3983 cmpd VD9 ; at end point?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3984 beq L9FA6 ; brif drawing finished
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3985 L9F9A incb ; bump arc counter
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3986 cmpb #8 ; done 8 arcs?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3987 bne L9FA3 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3988 inca ; bump octant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3989 clrb ; reset subarc number
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3990 anda #7 ; make sure octant number stays in 0-7 range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3991 L9FA3 jmp L9EFD ; go do another arc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3992 L9FA6 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3993 L9FA7 ldx VCF ; get radius
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3994 ldd ,u ; get sine/cosine table entry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3995 beq L9FB4 ; brif 0 - offset = radius
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3996 subd #1 ; adjust values to correct range
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3997 bsr L9FB5 ; multiply radius by sine/cosine
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3998 tfr y,x ; resturn result in X
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
3999 L9FB4 rts
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4000 L9FB5 pshs u,y,x,b,a ; save registers and reserve temp space
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4001 clr 4,s ; reset overflow byte (YH)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4002 lda 3,s ; calcuate B*XL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4003 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4004 std 6,s ; put in "U"
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4005 ldd 1,s ; calculate B*XH
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4006 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4007 addb 6,s ; accumluate with previous product
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4008 adca #0
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4009 std 5,s ; save in YL,UH
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4010 ldb ,s ; calculate A*XL
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4011 lda 3,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4012 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4013 addd 5,s ; accumulate with previous partical product
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4014 std 5,s ; save in YL,UH
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4015 bcc L9FD4 ; brif no carry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4016 inc 4,s ; bump YH for carry
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4017 L9FD4 lda ,s ; calculate A*XH
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4018 ldb 2,s
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4019 mul
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4020 addd 4,s ; accumulate with previous partial product
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4021 std 4,s ; save in Y (we can't have a carry here)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4022 puls a,b,x,y,u,pc ; restore multiplicands and return results
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4023 L9FDF jmp L94A1 ; go draw a line
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4024 L9FE2 clrb ; default arc number (0)
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4025 jsr GETCCH ; is there something there for a value?
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4026 beq L9FF8 ; brif not
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4027 jsr SYNCOMMA ; evaluate , + expression
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4028 jsr LB141
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4029 lda FP0EXP ; multiply by 64
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4030 adda #6
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4031 sta FP0EXP
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4032 jsr LB70E ; get integer value of circle fraction
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4033 andb #0x3f ; max value of 63
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4034 L9FF8 tfr b,a ; save arc value in A to calculate octant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4035 andb #7 ; calculate subarc
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4036 lsra ; calculate octant
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4037 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4038 lsra
605ff82c4618 Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff changeset
4039 rts