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