-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy path!ASCII.bas
194 lines (194 loc) · 5.06 KB
/
!ASCII.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
10 'FONT EDITOR
20 '
30 'This program allows you to creat and modify chracters with ASCII codes from 128 to 255 in the medium resolution mode.
40 '
50 DIM A(7,7)
60 SCREEN 1
70 CLS
80 '
90 'define keys
100 KEY OFF
110 KEY 1,"":KEY 2,"":KEY 3,"":KEY 4,""
120 KEY 10,CHR$(27)
130 '
140 'Set up point to characters
150 CBASE=&H4000
160 DEF SEG=0
170 POKE &H7C,0
180 POKE &H7D,&H40
190 POKE &H7E,PEEK(510)
200 POKE &H7F,PEEK(511)
210 DEF SEG
220 '
230 ACODE=128
240 '
250 'Set up screen
260 LOCATE 1,14:PRINT"FONT EDITOR"
270 FOR J=1 TO 8 : LOCATE 4+J,18 : PRINT"........"; : NEXT J
280 FOR I=1 TO 12 : READ SR,SC,P$ :LOCATE SR,SC : PRINT P$ : NEXT I
290 DATA 4,1,"ASCII CODE: ",1,30,CURSOR,2,30,"D DRAW",3,30,"E ERASE", 4,30,"M MOVE",6,1,"F1 -1 F2 +1",7,1,"F3 -5 F4 +5",6,30,CHARACTER, 7,30,"C CLEAR",8,30,"L LOAD",9,30,"S SAVE",11,30,"F10 ESCAPE"
300 '
310 'display all characters
320 LOCATE 23,18 : PRINT"wait ...";
330 FOR I=0 TO 7
340 LOCATE 15+I,1
350 FOR J=0 TO 31
360 CH=32*I+J
370 IF CH>6 AND CH<14 THEN CH=32
380 PRINT CHR$(CH);
390 NEXT J
400 PRINT
410 NEXT I
420 LOCATE 23,18 : PRINT SPC(8);
430 '
440 '********** MAIN PROGRAM **********
450 'Set cursor
460 ROW=0 : COLUMN=0 : CURS=0
470 '
480 'new ascii
490 GOSUB 650 'show code & symbol
500 '
510 'main loop
520 BLINK%=0
530 IF CURS=-1 THEN A(ROW,COLUMN)=0
540 IF CURS=+1 THEN A(ROW,COLUMN)=1
550 '
560 'blink entry
570 GOSUB 720 'place cursor
580 '
590 A$=INKEY$
600 DEF SEG : POKE 106,0 'clear buffer
610 ON LEN(A$) GOTO 890,1000
620 GOTO 560
630 '***********************************
640 '
650 '* SUBROUTINE : show code & symbol
660 LOCATE 4,13 : PRINT USING "###";ACODE;
670 CH=ACODE
680 IF CH>6 AND CH<14 THEN CH=32
690 LOCATE 10,10 : PRINT CHR$(CH);
700 RETURN
710 '
720 '* SUBROUTINE : place cursor
730 BLINK%=(BLINK%+1) MOD 20
740 IF BLINK%<10 THEN 810 ELSE 760
750 '
760 'cursor off
770 IF A(ROW,COLUMN)=0 THEN CH$="."
780 IF A(ROW,COLUMN)=1 THEN CH$="#"
790 GOTO 860
800 '
810 'cursor on
820 IF CURS=-1 THEN CH$="-"
830 IF CURS=0 THEN CH$="*"
840 IF CURS=1 THEN CH$="+"
850 '
860 LOCATE 5+ROW,18+COLUMN : PRINT CH$;
870 RETURN
880 '
890 'LENGTH IS 1
900 CODE1=ASC(A$) AND &H5F
910 IF CODE1=ASC("E") THEN CURS=-1:GOTO 510 'back to main loop
920 IF CODE1=ASC("M") THEN CURS=0:GOTO 510 'back to main loop
930 IF CODE1=ASC("D") THEN CURS=1:GOTO 510 'back to main loop
940 IF CODE1=ASC("C") THEN 1210
950 IF CODE1=ASC("S") THEN 1330
960 IF CODE1=ASC("L") THEN 1540
970 IF CODE1=27 THEN 1910
980 BEEP:BEEP:GOTO 560 'back to blink entry
990 '
1000 IF ASC(A$)<>0 THEN 510
1010 CODE2=ASC(RIGHT$(A$,1))
1020 GOSUB 1750 'remove cursor
1030 '
1040 'cursor
1050 IF CODE2=71 THEN CR=-1:CC=-1:GOTO 1820 'upper r
1060 IF CODE2=73 THEN CR=-1:CC=+1:GOTO 1820 'upper l
1070 IF CODE2=79 THEN CR=+1:CC=-1:GOTO 1820 'lower l
1080 IF CODE2=81 THEN CR=+1:CC=+1:GOTO 1820 'lower r
1090 IF CODE2=72 THEN CR=-1:CC=0 :GOTO 1820 'up
1100 IF CODE2=80 THEN CR=+1:CC=0 :GOTO 1820 'down
1110 IF CODE2=75 THEN CR=0:CC=-1 :GOTO 1820 'leaf
1120 IF CODE2=77 THEN CR=0:CC=+1 :GOTO 1820 'right
1130 '
1140 'ascii code
1150 IF CODE2=59 THEN CA=-1:GOTO 1860
1160 IF CODE2=60 THEN CA=+1:GOTO 1860
1170 IF CODE2=61 THEN CA=-5:GOTO 1860
1180 IF CODE2=62 THEN CA=+5:GOTO 1860
1190 GOTO 560
1200 '
1210 'clear char
1220 LOCATE 23,18 : PRINT"wait ...."
1230 FOR I=0 TO 7
1240 LOCATE 5+I,18
1250 PRINT"........";
1260 FOR J=0 TO 7
1270 A(I,7-J)=0
1280 NEXT J
1290 NEXT I
1300 LOCATE 23,18 : PRINT SPC(9)
1310 GOTO 560
1320 '
1330 'save character
1340 IF ACODE<128 THEN 1490
1350 LOCATE 23,18 : PRINT"wait ....";
1360 FOR I=0 TO 7
1370 A0=0
1380 FOR J=0 TO 7
1390 A0=A0+A0+A(I,J)
1400 NEXT J
1410 POKE CBASE+8*(ACODE-128)+I,A0
1420 NEXT I
1430 I=INT(ACODE/32):J=ACODE MOD 32
1440 LOCATE 15+I,1+J
1450 PRINT CHR$(ACODE)
1460 LOCATE 23,18 : PRINT SPC(9)
1470 GOTO 560 'back to blink entry
1480 '
1490 LOCATE 23,10 : PRINT"cannot save ASCII<128";
1500 FOR I=1 TO 1000 :NEXT I
1510 LOCATE 23,10 : PRINT SPC(22);
1520 GOTO 560 'back to blink entry
1530 '
1540 'load character
1550 LOCATE 23,18 : PRINT "wait ...."
1560 DEF SEG
1570 COFF=CBASE+8*(ACODE-128)
1580 IF ACODE>127 THEN 1610
1590 DEF SEG=&HF000
1600 COFF=&HFA6E+8*ACODE
1610 FOR I=0 TO 7
1620 A%=PEEK(COFF+I)
1630 FOR J=0 TO 7
1640 X%=A% AND 1
1650 A(I,7-J)=X%
1660 IF X% THEN X$="#" ELSE X$="."
1670 LOCATE 5+I,18+(7-I) : PRINT X$
1680 A%=INT(A%/2)
1690 NEXT J
1700 NEXT I
1710 DEF SEG
1720 LOCATE 23,18 : PRINT SPC(9);
1730 GOTO 560 'back to blink entry
1740 '
1750 '* SUBROUTINE : remove cursor
1760 IF A(ROW,COLUMN)=0 THEN CH$="."
1770 IF A(ROW,COLUMN)=1 THEN CH$="#"
1780 LOCATE 5+ROW,18+COLUMN : PRINT CH$;
1790 RETURN
1800 '
1810 'new cursor
1820 ROW=(ROW+CR+8) MOD 8
1830 COLUMN=(COLUMN+CC+8) MOD 8
1840 GOTO 510
1850 '
1860 'new ascii
1870 ACODE=ACODE+CA
1880 IF ACODE<=0 OR ACODE>=255 THEN ACODE=ACODE-CA:BEEP:BEEP
1890 GOTO 480
1900 '
1910 'escape
1920 LOCATE 23,1
1930 END