1 OPTION RUN
10 MEMORY 53999!:aa=54062!:CALL aa:aa=54592!:CALL aa:aa=54763!:CALL aa
50 FOR n=0 TO 10000:NEXT
60 cls=54042!
70 at=54022!
80 sx=54916!
90 sy=54917!
100 CALL cls:PRINT"The CHARACTER DESIGNER. (C) 1987 by J.Stevenson.":PRINT:PRINT:PRINT:PRINT"Please select OPTION with a number (1 to 8 & 0)"
110 PRINT:PRINT:PRINT:PRINT"     1} Design/alter a single character"
120 PRINT
130 PRINT"     2} Design/alter a ICON character (more than 1 character)"
140 PRINT"     ----------------------------"
150 PRINT"     3} See the characters (enlarged)"
160 PRINT:PRINT"     4} Pick up and place the characters (test apperance)"
170 PRINT"     ----------------------------"
180 PRINT"     5} Load a unfinished character set from A:"
190 PRINT:PRINT"     6} Save this character set unfinished to A:"
200 PRINT"     ----------------------------"
210 PRINT"     7} Save these characters as a finished, self locating character set to A:"
220 PRINT"     ----------------------------"
230 PRINT:PRINT"     8} EXIT THIS PROGRAM (to CP/M)"
240 PRINT:PRINT"     0} Reset to standard set"
250 aa=54687!:CALL aa
260 key=PEEK(sy+1):IF (key>56 OR key<48) THEN 250
270 key=key-48
280 IF key=0 THEN aa=54062!:CALL aa:GOTO 100
290 ON key GOSUB 790,1610,2080,2580,2320,2450,2700,2800
300 GOTO 100
310 REM **** SET UP A SINGLE 8x8 GRID ****
320 POKE sx!,5:POKE sy!,5:POKE 54136!,8:POKE 54142!,8
330 aa=54135!:CALL aa
340 PRINT:PRINT TAB(6);:FOR n=1 TO 8:PRINT CHR$(202);:NEXT
350 RETURN
360 REM **** DRAW THE CHAR SET AND INPUT AREA ****
370 POKE sx!,0:POKE sy!,0:CALL at
380 PRINT "[                                                  ]";:aa=54534!:CALL aa
390 RETURN
400 REM **** READ THE KEYS AND ALTER X,Y ****
410 k$=INKEY$:IF k$="" THEN 410
420 key=ASC(k$)
430 IF NOT (key=31 OR key=30 OR key=1 OR key=6) THEN RETURN
440 x=x+(key=31)-(key=30)
450 y=y+(key=1)-(key=6)
460 IF x>30 THEN x=30
470 IF x<0 THEN x=0
480 IF y<0 THEN y=0
490 IF y>89 THEN y=89
500 RETURN
510 POKE sx!,x:POKE sy!,y:CALL at:PRINT ;
520 RETURN
530 x=0:y=52:GOSUB 510
540 GOSUB 400
550 IF key=27 THEN RETURN
560 IF x>2 THEN x=2
570 IF (x=0 AND y<52) THEN y=52
580 GOSUB 510
590 IF WHATTODO=99 THEN RETURN
600 GOTO 540
610 PRINT:POKE sx!,0:POKE sy!,1:CALL at:PRINT text$
620 RETURN
630 char=x*90+(y-20):POKE 54631!,char
640 address=char*8+58000!
650 RETURN
660 REM **** POKE THE EIGHT BYTES INTO SCRAM FROM ADDRESS ****
670 FOR n=0 TO 7
680 POKE 54438!,120
690 POKE 54431!,190-n
700 POKE sy+1,PEEK(address+n)
710 aa=54481!:CALL aa
720 NEXT
730 RETURN
740 DATA "-------PRESS--------","f1     Invert","f3     flip up/down","f7     speckle","CUT    clear","COPY   fill","CAN    rotate left","DEL    rotate up"
750 top$="":FOR n=1 TO 20:top$=top$+CHR$(138):NEXT
760 POKE sx,4:POKE sy,60:CALL at:PRINT CHR$(27);"p";CHR$(134);top$;CHR$(140)
770 RESTORE 740:FOR n=5 TO 20 STEP 2:READ a$:a$=a$+SPACE$(20-LEN(a$)):POKE sx,n:POKE sy,60:CALL at:PRINT CHR$(133);a$;CHR$(133):POKE sx,n+1:POKE sy,60:CALL at:PRINT CHR$(135);top$;CHR$(141):NEXT
780 POKE sx,20:POKE sy,60:CALL at:PRINT CHR$(131);top$;CHR$(137);CHR$(27);"q":RETURN
790 CALL cls
800 POKE 54804!,120
810 POKE 54809!,190
820 GOSUB 310
830 GOSUB 360
840 text$="Select the character with arrow keys, EXIT to mark":GOSUB 610
850 GOSUB 530
860 GOSUB 630
870 POKE sx!,5:POKE sy!,5:aa= 54628!:CALL aa
880 GOSUB 660
890 GOSUB 360
900 GOSUB 740
910 text$="Set/Reset with 1, EXIT to end":GOSUB 610
920 x=5:y=5
930 GOSUB 510
940 GOSUB 400
950 IF key=26 THEN GOSUB 1220:GOTO 930
960 IF key=17 THEN GOSUB 1300:GOTO 930
970 IF key=16 THEN GOSUB 1340:GOTO 930
980 IF key=21 THEN GOSUB 1490:GOTO 930
990 IF key=23 THEN GOSUB 1510:GOTO 930
1000 IF key=8 THEN GOSUB 1520:GOTO 930
1010 IF key=127 THEN GOSUB 1580:GOTO 930
1020 IF x>12 THEN x=12
1030 IF x<5 THEN x=5
1040 IF y>12 THEN y=12
1050 IF y<5 THEN y=5
1060 IF key=49 THEN 1120
1070 IF key<>27 THEN 930
1080 GOSUB 360
1090 PRINT CHR$(7)
1100 RETURN
1110 DATA 128,64,32,16,8,4,2,1
1120 byte=x-5
1130 acr=y-5
1140 POKE sx,5:POKE sy,5
1150 RESTORE 1110
1160 FOR n=0 TO acr:READ vax:NEXT
1170 POKE 54796!,vax
1180 POKE 54782!,char
1190 POKE 54791!,byte
1200 aa=54779!:CALL aa
1210 GOTO 930
1220 REM **** INVERT THE CHARACTER ****
1230 FOR n=0 TO 7:p=PEEK(address+n)
1240 p=255-p
1250 POKE (address+n),p
1260 NEXT
1270 GOSUB 660
1280 POKE sx,5:POKE sy,5:aa=54628!:CALL aa
1290 RETURN
1300 REM **** FLIP UP/down ****
1310 FOR n=0 TO 7:POKE (60707!-n),PEEK(address+n):NEXT
1320 FOR n=7 TO 0 STEP -1:POKE(address+n),PEEK(60700!+n):NEXT
1330 GOTO 1270
1340 REM **** SPECKLE ****
1350 POKE 54782!,char
1360 POKE 54795!,246
1370 DATA 170,85,170,85,170,85,170,85
1380 RESTORE 1370
1390 FOR n=0 TO 7
1400 READ p:vax=PEEK(address+n):POKE (address+n),p
1410 POKE 54796!,vax
1420 POKE 54791!,n
1430 POKE 54809!,190
1440 POKE 54804!,120
1450 POKE sx,5:POKE sy,5
1460 aa=54779!
1470 CALL aa:NEXT:POKE 54795!,238
1480 GOTO 1270
1490 REM **** CLEAR GRID ****
1500 FOR n=0 TO 7:POKE address+n,0:NEXT:GOTO 1270
1510 FOR n=0 TO 7:POKE address+n,255:NEXT:GOTO 1270
1520 REM **** SHIFT LEFT ****
1530 FOR n=0 TO 7
1540 p=PEEK(address+n):p=p*2
1550 IF p>255 THEN p=1+(p-256)
1560 POKE (address+n),p
1570 NEXT:GOTO 1270
1580 top=PEEK (address):FOR n=1 TO 7
1590 POKE (address+(n-1)),PEEK(address+n):NEXT
1600 POKE (address+7),top:GOTO 1270
1610 REM GET THE SIZE OF THE BIG GRID AND DRAW
1620 CALL cls
1630 GOSUB 360
1640 text$="MARK WHERE YOUR ICON WILL START. EXIT to mark":GOSUB 610
1650 GOSUB 530
1660 GOSUB 630
1670 PRINT:PRINT:INPUT "HOW MANY CHARACTER HIGH WILL YOUR 'ICON' BE (1-3)";high
1680 PRINT:PRINT:PRINT:INPUT "HOW MANY CHARACTERS WIDE DO YOU WANT THE 'ICON' (1-8)";wide
1690 PRINT:LINE INPUT "DO YOU WANT THE GRID CLEARED (Y)es or (N)o ";r$
1700 IF UPPER$(r$)="Y" THEN FOR n=0 TO (wide*8)*high:POKE address+n,0:NEXT
1710 IF wide<1 THEN wide=1
1720 IF wide>10 THEN wide=8
1730 IF high>3 THEN high=3
1740 IF high<1 THEN high=1
1750 POKE 54136!,high*8
1760 POKE 54142!,wide*8
1770 POKE sx,0:POKE sy,0
1780 aa=54135!:CALL cls:CALL aa
1790 ccc=char:FOR n=1 TO high:FOR f=1 TO wide:POKE 54631!,ccc:POKE sx,(n-1)*8:POKE sy,(f-1)*8:aa=54628!:CALL aa:POKE sx,27+n:POKE sy,f-1:CALL at:aa=54093!:CALL aa:PRINT CHR$(ccc);:aa=54093!:CALL aa:ccc=ccc+1:NEXT:NEXT
1800 x=0:y=0
1810 GOSUB 510
1820 GOSUB 400
1830 IF x<0 THEN x=0
1840 IF y<0 THEN y=0
1850 IF x>high*8-1 THEN x=high*8-1
1860 IF y>wide*8-1 THEN y=wide*8-1
1870 IF key=49 THEN 1910
1880 IF key<>27 THEN 1810
1890 CALL cls
1900 RETURN
1910 REM *** HERE IF ! PRESSED ***
1920 do=INT (x/8)
1930 ac=INT(y/8)
1940 pdo=x-do*8
1950 pac=y-ac*8
1960 tadd=(do*wide+ac)
1970 RESTORE 1110
1980 FOR n=0 TO pac:READ vax:NEXT
1990 POKE 54796!,vax
2000 POKE 54782!,char+tadd
2010 POKE 54631!,char+tadd
2020 POKE 54791!,pdo
2030 POKE 54804!,(ac*8)
2040 POKE 54809!,31-INT(do*8)
2050 POKE sx,do*8:POKE sy,ac*8
2060 aa=54779!:CALL aa
2070 GOTO 1810
2080 REM **** SEE THE CHARACTERS (ENLARGED) ****
2085 x=0:y=52:POKE 54136!,8:POKE 54142!,8:POKE sx,10:POKE sy,10:aa=54135!:CALL aa
2090 CALL cls
2100 GOSUB 360
2110 text$="Move the cursor with arrows, EXIT to quit":GOSUB 610
2120 whattodo=99
2130 GOSUB 540
2140 IF key=27 THEN whattodo=0:RETURN
2150 GOSUB 630
2160 GOSUB 510
2170 POKE sx,10:POKE sy,10
2180 aa=54628!:CALL aa
2190 GOSUB 510
2200 GOTO 2130
2210 REM **** GET A NAME FROM THE KEYBOARD ****
2211 PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT"Just type {RETURN} to abort this section"
2220 POKE sx,10:POKE sy,0:CALL at:PRINT "File name >";CHR$(27);"p";"         .XXX";CHR$(27);"q"
2230 POKE sx,10:POKE sy,12:CALL at:PRINT CHR$(27);"p";:LINE INPUT name$:PRINT CHR$(27);"q"
2240 IF name$="" THEN RETURN
2250 FOR n=1 TO LEN(name$):IF MID$(name$,n,1)="." THEN PRINT CHR$(7):GOTO 2210
2260 NEXT
2270 name$=name$+"        ":name$=LEFT$(UPPER$(name$),8)
2280 RETURN
2290 FOR n=1 TO LEN (name$):POKE (54167!+n),ASC(MID$(name$,n,1)):NEXT
2300 RETURN
2310 RETURN
2320 REM **** LOAD THE UNFINISHED SET ****
2330 CALL cls
2340 DIR
2350 PRINT:PRINT:PRINT"Please enter the name of the U.D.G.s to Load"
2360 GOSUB 2210
2361 IF name$="" THEN RETURN
2370 name$="A"+name$+"UDG"
2380 POKE 54190!,144
2390 POKE 54191!,226
2400 POKE 54193!,208
2410 POKE 54194!,7
2420 GOSUB 2290
2430 aa=54180!:CALL aa
2440 RETURN
2450 REM **** SAVE THE UNFINISHED SET ****
2460 CALL cls
2470 DIR
2480 PRINT:PRINT:PRINT "Please enter the file name of the U.D.G.s to save"
2490 GOSUB 2210
2491 IF name$="" THEN RETURN
2500 name$="A"+name$+"UDG"
2510 POKE 54209!,144
2520 POKE 54210!,226
2530 POKE 54212!,208
2540 POKE 54213!,7
2550 GOSUB 2290
2560 aa=54202!:CALL aa
2570 RETURN
2580 REM **** LAY THE CHARACTERS ON A GRID TO SEE ****
2590 CALL cls
2600 x=0:y=52
2610 GOSUB 360
2620 text$="KEYS: 1 Pick up/lay a character, EXIT quit":GOSUB 610
2630 char=32
2640 GOSUB 510
2650 GOSUB 400
2660 IF key=27 THEN RETURN
2670 IF key=49 AND x<3 THEN PRINT CHR$(7):GOSUB 630:IF char<32 THEN y=52:char=32
2680 IF key=49 AND x>2 THEN POKE sx,x:POKE sy,y:aa=54093!:CALL aa:PRINT CHR$(char):CALL aa:PRINT CHR$(7)
2690 GOTO 2640
2700 REM set up as .COM
2710 CALL cls
2720 DIR
2730 PRINT:PRINT:PRINT"Enter the name of this .COM file"
2740 GOSUB 2210
2741 IF name$="" THEN RETURN
2750 name$="A"+name$+"COM"
2760 GOSUB 2290
2770 aa=54964!:CALL aa
2780 RETURN
2800 SYSTEM

2741 IF name$=""