1 REM  CHARACTER DESIGNER 
2 REM  BY RICK LIDDELL 2002 
3 REM  THIS PROGRAM IS 
4 REM  FREEWARE. PLEASE 
5 REM  FEEL FREE TO MODIFY 
6 REM  THE ROUTINES IN YOUR 
7 REM  OWN PROGRAMS. 
8 REM  WWW.RICKS-GRAPHICS.CO.UK/AREA99 
9 CALL CLEAR
10 CALL SCREEN(2)
11 CALL COLOR(1,6,2)
12 CALL COLOR(2,6,2)
13 FOR I=3 TO 11
14 CALL COLOR(I,4,2)
15 NEXT I
16 CALL COLOR(12,5,2)
17 CALL COLOR(13,4,2)
18 FC=4
19 BC=2
20 OPTION BASE 1
21 DIM CB(8,8)
22 FOR X=1 TO 8
23 FOR Y=1 TO 8
24 CB(X,Y)=32
25 NEXT Y
26 NEXT X
27 CALL CHAR(33,"FFFFC0C0C0C0C0C0")
28 CALL CHAR(34,"FFFF000000000000")
29 CALL CHAR(35,"FFFF030303030303")
30 CALL CHAR(36,"C0C0C0C0C0C0C0C0")
31 CALL CHAR(37,"0303030303030303")
32 CALL CHAR(38,"C0C0C0C0C0C0FFFF")
33 CALL CHAR(39,"000000000000FFFF")
34 CALL CHAR(40,"030303030303FFFF")
35 CALL CHAR(58,"FF81BDBDBDBD81FF")
36 CALL CHAR(59,"007E424242427E00")
37 CALL CHAR(60,"FFFFFFFFFFFFFFFF")
38 CALL CHAR(128,"0000000000000000")
39 CALL CHAR(123,"183C7EFF3C3C3C00")
40 CALL CHAR(124,"10307EFEFE7E3010")
41 CALL CHAR(125,"080C7E7F7F7E0C08")
42 CALL CHAR(126,"003C3C3CFF7E3C18")
43 REM  TOP BOX 
44 CALL HCHAR(1,4,33)
45 CALL HCHAR(1,5,34,24)
46 CALL HCHAR(1,29,35)
47 CALL HCHAR(2,4,36)
48 CALL HCHAR(2,29,37)
49 CALL HCHAR(3,4,38)
50 CALL HCHAR(3,5,39,24)
51 CALL HCHAR(3,29,40)
52 REM  PUT TITLE IN TOP BOX     
53 A$="   CHARACTER DESIGNER"
54 R=2
55 GOSUB 234
56 REM  PREVIEW BOX 
57 CALL HCHAR(5,4,33)
58 CALL HCHAR(5,5,34)
59 CALL HCHAR(5,6,35)
60 CALL HCHAR(6,4,36)
61 CALL HCHAR(6,6,37)
62 CALL HCHAR(7,4,38)
63 CALL HCHAR(7,5,39)
64 CALL HCHAR(7,6,40)
65 CALL HCHAR(5,7,39)
66 CALL HCHAR(7,7,34)
67 REM  MAIN BOX 
68 CALL HCHAR(5,8,33)
69 CALL HCHAR(5,9,34,8)
70 CALL HCHAR(5,17,35)
71 CALL VCHAR(6,8,36,8)
72 CALL VCHAR(6,17,37,8)
73 CALL HCHAR(14,8,38)
74 CALL HCHAR(14,9,39,8)
75 CALL HCHAR(14,17,40)
76 REM  PLACE PREVIEW CHAR 
77 CALL HCHAR(6,5,128)
78 REM  PLACE ZERO CODES 
79 CALL VCHAR(6,19,48,8)
80 CALL VCHAR(6,20,48,8)
81 REM  PLACE ARROWS 
82 CALL HCHAR(6,26,123)
83 CALL HCHAR(7,26,69)
84 CALL HCHAR(9,23,124)
85 CALL HCHAR(9,24,83)
86 CALL HCHAR(9,29,125)
87 CALL HCHAR(9,28,68)
88 CALL HCHAR(12,26,126)
89 CALL HCHAR(11,26,88)
90 CALL HCHAR(9,26,59)
91 CALL HCHAR(9,5,123)
92 CALL HCHAR(10,5,80)
93 REM  PLACE INSTRUCTIONS 
94 A$="SPACE  TURN ON/OFF BLOCK"
95 R=17
96 GOSUB 234
97 A$="P      PREVIEW CHARACTER"
98 R=18
99 GOSUB 234
100 A$="F,B       CHANGE COLOURS"
101 R=19
102 GOSUB 234
103 CALL HCHAR(22,4,34,26)
104 A$="  BY RICK LIDDELL 2002"
105 R=23
106 GOSUB 234
107 A$="    f r e e  w a r e"
108 R=24
109 GOSUB 234
110 ROW=6
111 COL=9
112 CURS=59
113 CALL HCHAR(ROW,COL,CURS)
114 REM  MOVE CURSOR 
115 CALL KEY(0,KEY,STATUS)
116 IF STATUS=0 THEN 115
117 IF KEY=ASC("E")THEN 127
118 IF KEY=ASC("X")THEN 136
119 IF KEY=ASC("S")THEN 145
120 IF KEY=ASC("D")THEN 154
121 IF KEY=ASC(" ")THEN 163
122 IF KEY=ASC("P")THEN 223
123 IF KEY=ASC("F")THEN 238
124 IF KEY=ASC("B")THEN 244
125 GOTO 115
126 REM  CURSOR UP 
127 BLK=CB(ROW-5,COL-8)
128 CALL HCHAR(ROW,COL,BLK)
129 ROW=ROW-1
130 IF ROW<6 THEN 133
131 GOSUB 174
132 GOTO 113
133 ROW=13
134 GOTO 131
135 REM  CURSOR DOWN 
136 BLK=CB(ROW-5,COL-8)
137 CALL HCHAR(ROW,COL,BLK)
138 ROW=ROW+1
139 IF ROW>13 THEN 142
140 GOSUB 174
141 GOTO 113
142 ROW=6
143 GOTO 140
144 REM  CURSOR LEFT 
145 BLK=CB(ROW-5,COL-8)
146 CALL HCHAR(ROW,COL,BLK)
147 COL=COL-1
148 IF COL<9 THEN 151
149 GOSUB 174
150 GOTO 113
151 COL=16
152 GOTO 149
153 REM  CURSOR RIGHT 
154 BLK=CB(ROW-5,COL-8)
155 CALL HCHAR(ROW,COL,BLK)
156 COL=COL+1
157 IF COL>16 THEN 160
158 GOSUB 174
159 GOTO 113
160 COL=9
161 GOTO 158
162 REM  PLACE BLOCK 
163 IF CB(ROW-5,COL-8)=32 THEN 169
164 CALL HCHAR(ROW,COL,32)
165 CB(ROW-5,COL-8)=32
166 CURS=59
167 IF COL<13 THEN 216
168 IF COL>12 THEN 219
169 CALL HCHAR(ROW,COL,60)
170 CB(ROW-5,COL-8)=60
171 CURS=58
172 IF COL<13 THEN 216
173 IF COL>12 THEN 219
174 IF CB(ROW-5,COL-8)=32 THEN 176
175 IF CB(ROW-5,COL-8)=60 THEN 178
176 CURS=59
177 RETURN
178 CURS=58
179 RETURN
180 REM  WORK OUT CHAR CODE   
181 RESTORE
182 CC$=""
183 FOR I=1 TO 4
184 IF CB(ROW-5,I+Z)=32 THEN 192
185 IF CB(ROW-5,I+Z)=60 THEN 195
186 NEXT I
187 FOR I=1 TO 16
188 READ R$,C$
189 IF R$=CC$ THEN 198
190 NEXT I
191 GOTO 113
192 A$="0"
193 CC$=CC$&A$
194 GOTO 186
195 A$="1"
196 CC$=CC$&A$
197 GOTO 186
198 CALL HCHAR(ROW,SP,ASC(C$))
199 GOTO 113
200 DATA 0000,0
201 DATA 0001,1
202 DATA 0010,2
203 DATA 0011,3
204 DATA "0100",4
205 DATA "0101",5
206 DATA "0110",6
207 DATA "0111",7
208 DATA "1000",8
209 DATA "1001",9
210 DATA "1010",A
211 DATA "1011",B
212 DATA "1100",C
213 DATA "1101",D
214 DATA "1110",E
215 DATA "1111",F
216 Z=0
217 SP=19
218 GOTO 181
219 Z=4
220 SP=20
221 GOTO 181
222 REM  CALCULATE PREVIEW 
223 A$=""
224 FOR I=6 TO 13
225 FOR J=19 TO 20
226 CALL GCHAR(I,J,X)
227 A$=A$&CHR$(X)
228 NEXT J
229 NEXT I
230 CALL CHAR(128,A$)
231 CALL HCHAR(6,5,128)
232 GOTO 115
233 REM  PRINT STRING 
234 FOR I=1 TO LEN(A$)
235 CALL HCHAR(R,I+4,ASC(SEG$(A$,I,1)))
236 NEXT I
237 RETURN
238 FC=FC+1
239 IF FC>16 THEN 242
240 CALL COLOR(13,FC,BC)
241 GOTO 115
242 FC=0
243 GOTO 115
244 BC=BC+1
245 IF BC>16 THEN 248
246 CALL COLOR(13,FC,BC)
247 GOTO 115
248 BC=0
249 GOTO 115