10 REM CREATE-A-FONT by Vince Erceg›20 REM ›30 REM PROGRAM WRITTEN: 8/2/83›40 REM ›50 GOSUB 1500:DIM FN$(14),EOR$(18),C$(18),A$(25),XFR$(32),CLEAR$(42),B(C7),A(C7),U(C7),ESC$(C1),LF$(C1),DN$(C1)›55 LF$=CHR$(30):DN$=CHR$(29):A$=" ":A$(C2)=DN$:A$(C3)=LF$:A$(25)=" ":A$(C4)=A$:C$="ERDICSLFT-=+*UKQ:A"›70 ESC$=CHR$(27):GRAPHICS C0:GOSUB 1220:FOR I=C1 TO 18:READ J:EOR$(I)=CHR$(J):NEXT I›75 FOR I=C1 TO 32:READ J:XFR$(I)=CHR$(J):NEXT I›80 FOR X=C0 TO C7:B(C7-X)=INT(C2^X+0.5):NEXT X›90 X=PEEK(C106)-C8:PM=(X+C2)*C256:POKE 623,C1:POKE 54279,X›95 POKE 53277,C3:X=X-C8:Y=USR(ADR(XFR$),57344,X*C256)›100 GRAPHICS C0:POKE C559,C0:POKE 538,155:POKE C16,C64:POKE 53774,C64›110 POKE C756,X:CHBAS=X*C256:A=USR(ADR(CLEAR$),PM-C256*C2,C256*C4):POKE 705,148:POKE 710,C0:POKE 712,148›120 POKE 53248,168:POKE 53250,168:POKE 53251,168:POKE 704,C255:POKE 706,C4›125 POKE 707,C6:POKE 53256,C3:POKE 53258,C3›130 POKE 752,C1:FOR I=C0 TO C3:FOR J=C0 TO 31:POSITION J+C4,I+C15:? ESC$;CHR$(I*32+J);:NEXT J:NEXT I›140 POKE 53259,C3:FOR I=PM-107 TO PM-C64:POKE I,C8:NEXT I:POKE 53253,160›150 DL=PEEK(C560)+PEEK(C561)*C256+C5*C5:POKE DL-19,C13:POKE DL-C7,C13:POKE DL,C13›160 FOR I=PM+281 TO PM+310 STEP C8:FOR J=C0 TO C3:POKE I+J,85:POKE I+J+C128,170:POKE I+J+C4,170›170 POKE I+J+132,85:NEXT J:NEXT I:PM=PM+C5*C5:GOSUB 180:Z=C64:POKE C559,46:GOTO 430›180 POSITION C2,C3:? "ลdit":? "าeverse":? "ฤata":? "ษnvert"›185 ? "รlear":? "ำave Font":? "ฬoad Font":? "ฦrom (Copy)"›190 POKE 82,14:POSITION 14,C3:? "ิo (Copy)":? ESC$;CHR$(156);" Scroll UP"›195 ? ESC$;CHR$(157);" Scroll DN":? ESC$;CHR$(158);" Scroll Left":? ESC$;CHR$(159);" Scroll RT"›200 ? "ีndo":? "หolor change":? "ัuit":POKE 82,C2:POSITION C2,11:? "มntic 4/5   ฬฯวฯ Atari":RETURN ›210 AM=C0:POKE 694,C0:POKE 702,C64:IF PEEK(CONSOL)=C6 THEN 990›220 IF PEEK(CONSOL)=C3 THEN 1400›230 POSITION XC+30,YC+C3:? " ":POSITION XC+30,YC+C3:? " "›235 IF STICK(C0)=C15 AND STRIG(C0) AND PEEK(CH)=C255 THEN 210›240 IF  NOT STRIG(C0) THEN 980›250 S=STICK(C0):IF PEEK(CH)<C255 THEN 330›260 XC=XC+(S>C4 AND S<C8)-(S>C8 AND S<C12)›270 YC=YC+(S=C5)+(S=C9)+(S=C13)-(S=C6)-(S=C10)-(S=14)›280 IF XC<C0 THEN XC=C7›290 IF XC>C7 THEN XC=C0›300 IF YC<C0 THEN YC=C7›310 IF YC>C7 THEN YC=C0›320 POKE CONSOL,C0:POSITION XC+30,YC+C3:? " ";:FOR X=C1 TO C5*C5:NEXT X:GOTO 210›330 IF PEEK(CH)=39 THEN POKE CH,66›340 CLOSE #C1:OPEN #C1,C4,C0,"K:":GET #C1,X:X=X*(X>41 AND X<86):IF  NOT X THEN 210›350 FOR I=C1 TO 18:IF C$(I,I)<>CHR$(X) THEN NEXT I:GOTO 210›360 ON I GOTO 420,440,450,500,510,520,550,580,610,630,650,670,700,730,740,760,780,1150›370 TRAP 390:X1=26:FOR X=160 TO 40 STEP -C4:POKE 53253,X:POSITION X1+C1,C3:? A$:X1=X1-C1:IF X1<C1 THEN 390›380 NEXT X›390 FOR X1=X TO 160:POKE 53253,X1:NEXT X1:POSITION C2,C3:RETURN ›400 IF  NOT STRIG(C0) THEN 400›410 GOTO 210›420 GOSUB 800›430 CHAR=CHBAS+Z*C8:FOR X=C0 TO C7:U(X)=PEEK(CHAR+X):NEXT X:GOTO 950›440 FOR X=PM TO PM+31:POKE X,C255-PEEK(X):SOUND C0,X,C10,C8:NEXT X:GOTO 970›450 GOSUB 370:POKE 538,C0:FOR I=C0 TO C7:POSITION 23,I+C3:? PEEK(CHAR+I);:NEXT I›455 POSITION C2,C0:? "  PRESS JOYSTICK ";›460 ? "BUTTON TO CONTINUE";:LOCATE CX+C4,CY+C15,Z:POSITION CX+C4,CY+C15:? ESC$;CHR$(Z);›465 FOR I=C1 TO C4:FOR J=C1 TO C4›470 POSITION I+C3,J+C5:? ESC$;CHR$(Z);:POSITION I+C9,J+C5:? ESC$;CHR$(Z+C128);:NEXT J:NEXT I›480 IF STRIG(C0) THEN 480›490 POKE 538,155:GOSUB 370:GOSUB 180:GOTO 210›500 FOR I=C0 TO C7:A(I)=PEEK(PM+I*C4):NEXT I:FOR I=C0 TO C7:FOR J=C0 TO C3:POKE PM+I*C4+J,A(C7-I):NEXT J:NEXT I›505 GOTO 970›510 FOR X=PM TO PM+32:POKE X,C0:SOUND C0,X,C6,C8:NEXT X:GOTO 970›520 GOSUB 370:? "ำมึล":? :? "FILE (dev:filename.ext)":INPUT FN$:TRAP 520:CLOSE #C1›525 OPEN #C1,C8,C0,FN$:FOR X=C0 TO 1023›530 I=PEEK(CHBAS+X):POKE CHBAS+X,C255:POKE CHBAS+X,I:PUT #C1,PEEK(CHBAS+X):NEXT X:GOSUB 370›540 ? CHR$(253);"SAVE COMPLETE":FOR X=C1 TO 100:NEXT X:GOSUB 370:CLOSE #C1:GOSUB 180:GOTO 210›550 GOSUB 370:? "ฬฯมฤ":? :? "FILE (dev:filename.ext)":INPUT FN$:TRAP 570:CLOSE #C1›555 OPEN #C1,C4,C0,FN$:FOR X=C0 TO 1023›560 GET #C1,Q:POKE CHBAS+X,C255:POKE CHBAS+X,Q:NEXT X:GOSUB 370›565 ? CHR$(253);"LOAD COMPLETE":FOR X=C1 TO 100:NEXT X›570 GOSUB 370:CLOSE #C1:GOSUB 180:GOTO 430›580 SAX=CX:SAY=CY:GOSUB 370:? "LOCATE CHARACTER TO COPY":? "AND PRESS JOYSTICK BUTTON":GOSUB 800:CX=SAX:CY=SAY›590 FOR X=C0 TO C7:POKE CHAR+X,PEEK(CHBAS+Z*C8+X):NEXT X:GOSUB 370:GOSUB 180›600 FOR I=C0 TO C7:FOR J=C0 TO C3:POKE PM+I*C4+J,PEEK(CHBAS+Z*C8+I):NEXT J:NEXT I:GOTO 210›610 SAX=CX:SAY=CY:GOSUB 370:? "LOCATE CHARACTER TO ":? "REPLACE AND PRESS":? "JOYSTICK BUTTON":GOSUB 800:CX=SAX›620 CY=SAY:FOR X=C0 TO C7:POKE CHBAS+Z*C8+X,PEEK(PM+X*C4):NEXT X:GOSUB 370:GOSUB 180:GOTO 210›630 FOR I=C0 TO C7:A(I)=PEEK(PM+I*C4):NEXT I:X=A(C0):FOR I=C1 TO C7:A(I-C1)=A(I):NEXT I:A(C7)=X:FOR I=C0 TO C7›640 FOR J=C3 TO C0 STEP -C1:POKE PM+I*C4+J,A(I):SOUND C0,100-I*C4-J,10,C8:NEXT J:NEXT I:GOTO 970›650 FOR I=C0 TO C7:A(I)=PEEK(PM+I*C4):NEXT I:X=A(C7):FOR I=C7 TO C1 STEP -C1:A(I)=A(I-C1):NEXT I:A(C0)=X›660 FOR I=C7 TO C0 STEP -C1:FOR J=C0 TO C3:POKE PM+I*C4+J,A(I):SOUND C0,I*J,C12,C8:NEXT J:NEXT I:GOTO 970›670 FOR I=C0 TO C7:A(I)=PEEK(PM+I*C4):A(I)=A(I)*C2›680 IF A(I)>C255 THEN A(I)=A(I)-C255:GOTO 680›690 NEXT I:FOR I=C0 TO C7:FOR J=C0 TO C3:POKE PM+I*C4+J,A(I):SOUND C0,I,C8,C4:NEXT J:NEXT I:GOTO 970›700 FOR I=C0 TO C7:A(I)=PEEK(PM+I*C4):J=A(I)/C2:IF J=INT(J) THEN A(I)=J:GOTO 720›710 A(I)=INT(J)+C128›720 NEXT I:FOR I=C0 TO C7:FOR J=C0 TO C3:POKE PM+I*C4+J,A(I):SOUND C0,C7-I,C8,C4:NEXT J:NEXT I:GOTO 970›730 FOR X=C0 TO C7:POKE CHAR+X,U(X):NEXT X:GOTO 950›740 GOSUB 370:TRAP 740:? "COLOR REGISTER";:INPUT R:? :? "COLOR";:INPUT C:? :? "LUMINANCE";:INPUT L›742 R=R+708:IF R<708 OR R>712 OR C<C0 OR C>C15 OR L<C0 OR L>C15 THEN 740›750 POKE R,C*C16+L:POKE 705,PEEK(712):GOSUB 370:GOSUB 180:IF  NOT AM THEN 220›755 GOTO 1060›760 GOSUB 370:? "PRESS 'Y' TO EXIT PROGRAM":CLOSE #C1:OPEN #C1,C4,C0,"K:":GET #C1,X:IF X=89 THEN 790›770 GOSUB 370:GOSUB 180:GOTO 210›780 FOR I=C0 TO 31:POKE PM+I,PEEK(57344+CHAR-CHBAS+INT(I/C4)):NEXT I:GOTO 970›790 GRAPHICS C0:POKE C559,34:POKE 53277,C0:POKE C756,CHBAS/C256:POKE 538,C0:END ›800 LOCATE CX+C4,CY+C15,Z:ORIG=Z›810 XC=C0:YC=C0:LOCATE CX+C4,CY+C15,Z:POSITION CX+C4,CY+C15:? ESC$;CHR$(Z+C128-C128*(Z=C27));›820 FOR X=C1 TO C10:IF STICK(C0)=C15 AND STRIG(C0) THEN NEXT X:GOTO 810›830 IF  NOT STRIG(C0) THEN 910›840 POSITION CX+C4,CY+C15:? ESC$;CHR$(ORIG);›850 S=STICK(C0):CX=CX+(S>C4 AND S<C8)-(S>C8 AND S<C12):CY=CY+(S=C5)+(S=C9)+(S=C13)-(S=C6)-(S=C10)-(S=14)›860 IF CX<C0 THEN CX=31›870 IF CX>31 THEN CX=C0›880 IF CY<C0 THEN CY=C3›890 IF CY>C3 THEN CY=C0›900 POKE CONSOL,C0:FOR X=C1 TO C10:NEXT X:GOTO 800›910 IF Z>C127 THEN Z=Z-C128:GOTO 910›920 IF (Z>C64 AND Z<96) OR (Z>31 AND Z<65) THEN Z=Z-32:GOTO 940›930 IF Z>-C1 AND Z<32 THEN Z=Z+C64›940 POSITION CX+C4,CY+C15:? ESC$;CHR$(ORIG);:RETURN ›950 SOUND C0,C0,C0,C0:FOR I=PM TO PM+31 STEP C4:FOR J=C0 TO C3:POKE I+J,PEEK(CHAR+(I-PM)/C4):NEXT J:NEXT I›960 GOTO 210›970 SOUND C0,C0,C0,C0:FOR X=PM TO PM+28 STEP C4:POKE CHAR+(X-PM)/C4,PEEK(X):NEXT X:GOTO 210›980 X=USR(ADR(EOR$),PEEK(PM+YC*C4),B(XC)):FOR I=C0 TO C3:POKE PM+YC*C4+I,X:POKE CHAR+YC,X:NEXT I:GOTO 400›990 AM=C1:POKE 752,C1:POKE 538,C0:POSITION C3,C0:? "PRESS ำลฬลริ TO RETURN TO EDITING ";›1000 GOSUB 370:? "1 - ANTIC MODES 4 & 5":? "2 - GRAPHICS MODES 1 & 2":? "3 - TEXT MODE 0":? :? "WHICH";:TRAP 990›1010 POKE 752,C0:INPUT M:POKE 752,C1:IF M<C1 OR M>C3 THEN 990›1020 LIM=38:IF M=C2 THEN LIM=18›1030 IF M=C1 THEN POKE DL+C1,C4:POKE DL+C2,C5›1040 IF M=C2 THEN POKE DL+C1,C6:POKE DL+C2,C7›1050 ? :? "ฯะิษฯฮ Clear display":IF M=C1 THEN ? "ำิมาิ Change colors"›1060 POSITION C2,21:FOR X=C2 TO LIM:CLOSE #C1:OPEN #C1,C4,C0,"K:":POKE CH,C255›1070 IF PEEK(CONSOL)=C5 THEN POKE 538,155:GOTO 1130›1080 IF PEEK(CONSOL)=C6 AND M=C1 THEN 740›1090 IF PEEK(CONSOL)=C3 THEN GOSUB 1140:GOTO 1060›1100 IF PEEK(CH)=C255 THEN 1070›1110 IF M<>C2 OR PEEK(CH)<>C12 THEN 1120›1115 I=PEEK(C106)-C16:J=PEEK(C756):POKE C756,J+C2*(I=J)-C2*(I<>J):POKE CH,C255:GOTO 1070›1120 GET #C1,I:POSITION X,21:? ESC$;CHR$(I);:POSITION X+20*(M=C2),22-(M=C2):? ESC$;CHR$(I);:NEXT X›1125 GOTO 1060›1130 FOR I=C1 TO C3:POKE DL+I,C2:POSITION C0,21:? CHR$(156):NEXT I:GOSUB 370:GOSUB 180:GOTO 210›1140 FOR I=C1 TO C3:POSITION C0,21:? CHR$(156):NEXT I:RETURN ›1150 X=204:Y=51:IF PEEK(PM+C256)=204 THEN X=85:Y=170›1160 FOR I=PM+C256 TO PM+285 STEP C8:FOR J=C0 TO C3:POKE I+J,X:POKE I+J+C128,Y:POKE I+J+C4,Y:POKE I+J+132,X›1170 NEXT J:NEXT I:FOR I=DL-C6 TO DL-C1:POKE I,C2*(X=85)+C4*(X=204):NEXT I:GOTO 210›1180 DATA 104,104,133,204,104,133,205,104,69,204,133,213,104,69,205,133,212,96›1190 DATA 104,104,133,213,104,133,212,104,133,215,104,133,214,162,4,160,0,177,212,145,214,200,208,249,230,213›1200 DATA 230,215,202,208,240,96›1210 REM ALMOST DONE!!›1220 POKE C559,C0:DL=PEEK(C560)+PEEK(C561)*C256:POKE 710,C0:POKE DL+C7,C7›1225 POSITION C4,C2:? "ใ๒ๅแ๔ๅ";CHR$(141);:POKE 752,C1›1230 ? "แ";CHR$(141);"ๆ๏๎๔":POKE DL+C8,C10›1235 FOR X=C2 TO 38:POSITION X,C0:? CHR$(141);:POSITION X,C3:? CHR$(141);:NEXT X›1240 POSITION C3,C7:? "'THE ULTIMATE CHARACTER SET EDITOR'":? :? :? "    Created 8/2/83 by Vince Erceg"›1250 POSITION 19,22:? "PRESS ำิมาิ TO BEGIN";:POKE DL+C13,34:POKE DL+21,50:POKE 54277,C7›1260 RESTORE 1230:FOR I=1536 TO 1554:READ J:POKE I,J:NEXT I:POKE C559,34›1265 A=USR(1536):POSITION 19,C15:? "PLEASE WAIT"›1270 FOR X=C7 TO C0 STEP -C1:POKE 54277,X:POKE 54276,X:FOR Y=C1 TO C7:SOUND C0,X*C2,C8,C8:NEXT Y:NEXT X›1275 SOUND C0,C0,C0,C0›1280 POKE 552,111:POKE 553,C6:POKE C0,C0:FOR I=1570 TO 1695:READ J:POKE I,J:NEXT I:FOR I=C1 TO 42:READ J›1290 CLEAR$(I)=CHR$(J):NEXT I:RESTORE :RETURN ›1300 DATA 104,173,31,208,201,6,240,10,232,142,10,212,142,25,208,76,1,6,96›1310 DATA 0,0,0,48,50,37,51,51,0,179,180,161,178,180,0,52,47,0,35,40,33,46,39,37,0,36,41,51,48,44›1320 DATA 33,57,0,44,41,51,52,0,0,0,0,0,0,0,48,50,37,51,51,0,175,176,180,169,175,174,0,38,47,50›1330 DATA 0,36,41,51,43,0,36,41,50,37,35,52,47,50,57,0,0,165,88,133,203,165,89,133,204,160,0,166,0,240›1340 DATA 13,185,34,6,145,203,200,192,38,208,246,76,148,6,185,73,6,145,203,200,192,38,208,246,169,155,141,26,2›1350 DATA 165,0,73,1,133,0,96,104,104,133,204,104,133,203,104,133,206,104›1370 DATA 133,205,166,206,160,0,169,0,145,203,136,208,251,230,204,202,48,6,208,244,164›1390 DATA 205,208,240,198,204,160,0,145,203,96›1400 GOSUB 370:TRAP 1460:CLOSE #C1:OPEN #C1,C6,C0,"D:*.*"›1410 FOR X=C3 TO 14:INPUT #C1;FN$:FN$=FN$(C3):IF FN$(C3,C12)="FREE SECTO" THEN 1460›1420 IF X/C2=INT(X/C2) THEN POSITION C15,(X+C1)/C2:? FN$;:GOTO 1440›1430 POSITION C2,(X+C2)/C2:? FN$;›1440 NEXT X›1450 ? :? :? "PRESS ANY KEY TO CONTINUE":GOSUB 1470:GOTO 1410›1460 ? :? :? "END..PRESS ANY KEY":GOSUB 1470:GOSUB 180:GOTO 210›1470 POKE CH,C255›1480 IF PEEK(CH)<C255 THEN POKE CH,C255:GOTO 370›1490 GOTO 1480›1500 C0=0:C1=1:C2=C1+C1:C3=C2+C1:C4=C3+C1:C5=C4+C1:C6=C5+C1:C7=C6+C1›1510 C8=C7+C1:C9=C8+C1:C10=C9+C1:C12=C10+C2:C13=C12+C1:C15=C13+C2›1520 C16=C15+C1:C27=C12+C15:C64=C8*C8:C106=106:C127=127:C128=C127+C1›1530 C255=255:C256=C255+C1:C559=559:C560=C559+C1:C561=C560+C1:C756=756:CH=C756+C8:CONSOL=53279›1540 RETURN ›