10 ' Character Definer
20 ' by James Cadwallader
30 ' Amstrad Action April 1987
40 ON ERROR GOTO 1740
50 DEFINT a-z
60 SYMBOL AFTER 256
70 oldmem!=HIMEM 
80 SYMBOL AFTER 32
90 newmem!=HIMEM
100 clr$=CHR$(22)+CHR$(1):opq$=CHR$(22)+CHR$(0)
110 a=65:i$="*"
120 DIM c(7,7),d(7),e(7,7)
130 INK 0,13:INK 1,1:INK 2,18:INK 3,23
140 MODE 1:fin=0:gf=0
150 GOSUB 840
160 LOCATE 15,2:PEN 2:PRINT"[";
170 PEN 3:PRINT"TAB";
180 PEN 2:PRINT"]";
190 PEN 1:PRINT" to go on."
200 LOCATE 15,4:PEN 2:PRINT"[";
210 PEN 3:PRINT"CLR";
220 PEN 2:PRINT"]";
230 PEN 1:PRINT" to clear grid."
240 LOCATE 15,6:PEN 2:PRINT"[";
250 PEN 3:PRINT"COPY";
260 PEN 2:PRINT"]";
270 PEN 1:PRINT" to toggle guide."
280 LOCATE 1,14
290 PEN 2
300 PRINT" Select character : ";
310 MOVE 318,192:DRAWR 114,0,1:DRAWR 0,-18
320 DRAWR -114,0:DRAWR 0,18
330 MOVER 128,0:DRAWR 50,0:DRAWR 0,-18
340 DRAWR -50,0:DRAWR 0,18
350 LOCATE 21,14
360 WHILE i$<>CHR$(13)
370 GOSUB 1800
380 i$=INKEY$
390 IF i$=CHR$(243) THEN a=a+1
400 IF i$=CHR$(242) THEN a=a-1
410 IF a<32 THEN a=255 ELSE IF a>255 THEN a=32
420 WEND
430 x=0:y=0
440 PEN 1
450 LOCATE 5,17:PRINT" PRESS (";
460 PEN 3:PRINT"R";
470 PEN 1:PRINT") TO RE-SELECT, (";
480 PEN 3:PRINT"C";
490 PEN 1:PRINT") TO";
500 LOCATE 7,19:PRINT"CONTINUE , (";
510 PEN 3:PRINT"S";
520 PEN 1:PRINT")";
530 PRINT" TO SAVE OR"
540 LOCATE 9,21:PRINT"(";
550 PEN 3:PRINT"L";
560 PEN 1:PRINT") TO LOAD."
570 WHILE i$<>"c"
580 i$=INKEY$
590 k$=LOWER$(i$)
600 IF k$="r" THEN 140
610 IF k$="s" THEN f=0:GOSUB 1260:GOTO 140
620 IF k$="l" THEN f=1:GOSUB 1260:GOTO 140
630 WEND
640 GOSUB 1540
650 WHILE fin=0
660 GOSUB 1000
670 k$=INKEY$:IF k$="" THEN 670
680 IF k$=CHR$(9) THEN GOSUB 1200:fin=1
690 GOSUB 960
700 IF k$=CHR$(242) THEN x=x-1
710 IF k$=CHR$(243) THEN x=x+1
720 IF k$=CHR$(241) THEN y=y+1
730 IF k$=CHR$(240) THEN y=y-1
740 IF x>7 THEN x=0 ELSE IF x<0 THEN x=7
750 IF y>7 THEN y=0 ELSE IF y<0 THEN y=7
760 IF INKEY(47)=0 THEN GOSUB 1090
770 IF INKEY(79)=0 THEN GOSUB 1150
780 IF INKEY(16)=0 THEN GOSUB 1660
790 IF INKEY(9)=0 THEN GOSUB 1540
800 GOSUB 1040
810 WEND
820 ERASE c,e:ERASE d:GOTO 140
830 END
840 ' Set up the screen
850 BORDER 13
860 MOVE 14,384:DRAWR 130,0,1
870 DRAWR 0,-130:DRAWR -130,0
880 DRAWR 0,130
890 MOVE 94,240:DRAWR 18,0,1
900 DRAWR 0,-18:DRAWR -18,0
910 DRAWR 0,18
920 MOVE 46,240:DRAWR 34,0
930 DRAWR 0,-18:DRAWR -34,0
940 DRAWR 0,18
950 RETURN
960 LOCATE x+2,y+2:PEN 1
970 IF c(x,y)=1 THEN PAPER 3:PRINT" "; ELSE IF e(x,y)=1 THEN PAPER 1:PRINT" "; ELSE PAPER 0:PRINT" "
980 PAPER 0
990 RETURN
1000 IF c(x,y)=1 THEN PRINT clr$;:PEN 1 ELSE IF e(x,y)=1 THEN PEN 2:PRINT clr$;
1010 LOCATE x+2,y+2:PRINT"+"
1020 PRINT opq$;
1030 RETURN
1040 ' Characters
1050 IF c(x,y)=1 THEN PLOT -10,-10,3:ELSE PLOT -10,-10,0
1060 PLOT 48+x*4,238-y*2:PLOTR 2,0
1070 PLOT 96+x*2,238-y*2
1080 RETURN
1090 ' Space pressed
1100 PAPER 3
1110 c(x,y)=1
1120 LOCATE x+2,y+2:PRINT" "
1130 PAPER 0
1140 RETURN
1150 ' delete pressed
1160 IF c(c,y)=1 AND e(x,y)=0 THEN PAPER 0:LOCATE x+2,y+2:PRINT" " ELSE IF e(x,y)=1 THEN PAPER 1:LOCATE x+2,y+2:PRINT" "
1170 c(x,y)=0
1180 PAPER 0
1190 RETURN
1200 ' Program characters
1210 DEF FNbin=c(0,i)*128+c(1,i)*64+c(2,i)*32+c(3,i)*16+c(4,i)*8+c(5,i)*4+c(6,i)*2+c(7,i)
1220 FOR i=0 TO 7:d(i)=FNbin
1230 NEXT
1240 SYMBOL a,d(0),d(1),d(2),d(3),d(4),d(5),d(6),d(7)
1250 RETURN
1260 ' Save / Load
1270 CLS:LOCATE 17,2
1280 IF f=0 THEN PRINT"SAVE." ELSE PRINT"LOAD."
1290 PEN 3
1300 PRINT STRING$(40,"_");
1310 LOCATE 1,23
1320 PRINT STRING$(40,"_");
1330 LOCATE 3,7:PRINT SPC(38);STRING$(38,8);
1340 PEN 2
1350 INPUT " Filename :";flnm$
1360 IF LEN(flnm$)>8 THEN PEN 3:PRINT"Too long!":GOTO 1330
1370 IF LOWER$(RIGHT$(flnm$,4))<>".chr" THEN flnm$=flnm$+".chr"
1380 IF f=0 THEN SAVE flnm$,b,newmem!,oldmem!-newmem! ELSE IF f=1 THEN LOAD flnm$
1390 SOUND 1,15,5,15
1400 PEN 1
1410 IF ef=0 AND f=0 THEN PRINT"Saved :"; ELSE IF ef=0 AND f=1 THEN PRINT"Loaded :";
1420 IF ef=0 THEN PEN 3:PRINT UPPER$(flnm$):PRINT
1430 PEN 2
1440 IF ef=0 AND f=0 THEN PRINT" Remember to use ";:PEN 1:PRINT"SYMBOL AFTER 32";:PEN 2:PRINT USING"&";"BEFORE  ";:PEN 1:PRINT"LOAD";:PEN 2:PRINT"ing ";UPPER$(flnm$);" from your program."
1450 PEN 1
1460 LOCATE 7,20
1470 PEN 2:PRINT"    [";
1480 PEN 3:PRINT"ANY KEY";
1490 PEN 2:PRINT"]";
1500 PEN 1:PRINT" to continue."
1510 IF INKEY$="" THEN 1510
1520 f-0:ef=0
1530 RETURN
1540 ' Character matrix
1550 xc=2:yc=2:gf=gf XOR 1
1560 FOR yp=190 TO 176 STEP -2
1570 FOR xp=368 TO 382 STEP 2
1580 IF TEST(xp,yp)=2 AND c(xc-2,yc-2)<> 1 THEN LOCATE xc,yc:PAPER gf:PRINT" ";
1590 IF TEST(xp,yp)=2 THEN e(xc-2,yc-2)=gf
1600 xc=xc+1
1610 IF xc>9 THEN xc=2:yc=yc+1
1620 NEXT
1630 NEXT
1640 PAPER 0
1650 RETURN
1660 ' Clear grid
1670 ERASE c,e:ERASE d
1680 FOR r=2 TO 9
1690 LOCATE 2,r:PRINT STRING$(8,32);
1700 NEXT
1710 LOCATE 4,11:PRINT"  ";
1720 LOCATE 7,11:PRINT" ";
1730 RETURN
1740 ' Error
1750 ' Clearing Grid twice in succesion will cause
1760 ' the computer to try and ERASE arrays twice!
1770 IF ERR=32 THEN ef=1 ' if filing error don't print SAVED/LOADED etc.
1780 RESUME NEXT
1790 RETURN
1800 LOCATE 21,14
1810 FOR i=a-3 TO a+3
1820 j=i
1830 IF j<32 THEN j=j+224 ELSE IF j>255 THEN j=j-224
1840 IF j=a THEN PAPER 1:PEN 2 ELSE PEN 3:PAPER 0
1850 PRINT CHR$(j);
1860 NEXT
1870 a$=MID$(STR$(a),2)
1880 LOCATE 29,14:IF a<100 THEN PRINT"0";
1890 PRINT a$;
1900 RETURN
