1 PROGRAM "chr2012.bas"
  100 ALLOCATE 18
  110 CODE TOLT=HEX$("3E,01,01,80,04")
  120 CODE =HEX$("EB,F7,06,C9")
  130 CODE MENT=HEX$("3E,01,01,80,04")
  140 CODE =HEX$("EB,F7,08,C9")
  145 SET INTERRUPTSTOPOFF
  150 OUT 191,12:SET KEYCLICKOFF:SET STATUSOFF:SET 6,0:TEXT 40
  160 ENVELOPE NUMBER2;10,0,63,100;-20,63,-63,100;-20,-63,0,100
  170 SOUND DURATION300,SYNC1,SOURCE2,PITCH25.1,ENVELOPE2
  180 SOUND DURATION300,SYNC1,PITCH25,STYLE128,ENVELOPE2
  190 ENVELOPE NUMBER1;0,63,63,1;-20,-63,-63,20
  200 ENVELOPE NUMBER3;0,63,63,1;20,-63,-63,20
  210 ENVELOPE NUMBER9;0,63,63,1;RELEASE;0,-63,0,50;0,0,-63,50
  220 NUMERIC DEFINED(0TO159)
  230 FOR A=0TO159
  240   LET DEFINED(A)=0
  250 NEXT 
  260 LET FONT=(SPEEK(255,16372)+SPEEK(255,16373)*256)-1152
  270 SET VIDEOMODE0:SET VIDEOX32:SET VIDEOY4
  280 OPEN #10:"video:"
  290 SET #10:SCROLLOFF:SET #10:CURSORCOLOUR2:SET #10:CURSORCHARACTER128:SET #10:COLOR2,50
  300 LET COOR=128:LET COORXTA=4:LET COORYTA=1:LET FILE$=""
  310 SET #102:PALETTE4,55,RED,RED:SET BORDER4
  320 SET VIDEOMODE0:SET VIDEOX38:SET VIDEOY10
  330 OPEN #20:"video:"
  340 PRINT #20:"  1 - LOAD FONT":PRINT #20:"  2 - LOAD UK FONT":PRINT #20:"  3 - LOAD BRD FONT":PRINT #20:"  4 - LOAD EPDOS FONT"
  350 PRINT #20:"  5 - LOAD BOMBER FONT":PRINT #20:"  6 - SAVE CURRENT FONT":PRINT #20:"  7 - SAVE CHRDEFS IN IS-BASIC FORMAT"
  360 PRINT #20:"  8 - CLEAR FONT":PRINT #20::PRINT #20:"          ESC - EXIT FILE MENU";
  370 SET #20:COLOR0,32:SET #20:CURSORCOLOR1:SET #20:CURSORCHARACTER32:SET #20:COLOR1,199
  380 FOR J=32TO159
  390   PRINT #10:CHR$(J);
  400 NEXT 
  410 SET VIDEOMODE0:SET VIDEOX32:SET VIDEOY1
  420 OPEN #11:"video:"
  430 SET #11:SCROLLON:SET #11:CURSORCHARACTER32:SET #11:COLOR0,182:SET #11:COLOR1,12:SET #11:CURSORCOLOR1
  440 DISPLAY #10:AT1FROM1TO4
  450 DISPLAY #11:AT6FROM1TO1
  460 PRINT AT5,1:
  470 FOR J=0TO3
  480   FOR I=0TO7
  490     PRINT #102,ATJ+8,I+16:CHR$(128+I+8*J);
  500   NEXT I
  510 NEXT J
  520 PRINT #102,AT8,27:"I=INVERT"
  530 PRINT #102,AT9,27:"H=HORIZONTAL"
  540 PRINT #102,AT10,27:"V=VERTICAL"
  550 PRINT #102,AT12,27:"D=DEFINE"
  560 PRINT #102,AT13,27:"R=RECALL"
  570 PRINT #102,AT14,27:"N=NEXT"
  580 PRINT #102,AT16,27:"F=FILE MENU"
  590 PRINT #102,AT18,3:"CURRENT ASCII:     LAST RECALLED:"
  600 DIM L(8),CH(8)
  610 DIM CHAR(7,9)
  620 DO 
  630   CLEAR #11
  640   PRINT #11:" SELECT CHARACTER TO BE DEFINED";
  650   PRINT #102,AT14,17:"ASCII:"
  660   DO 
  670     SELECT CASEJOY(0)
  680     CASE 1
  690       IF COORYTA<32THENLET COORYTA=COORYTA+1:LET COOR=COOR+1
  700     CASE 2
  710       IF COORYTA>1THENLET COORYTA=COORYTA-1:LET COOR=COOR-1
  720     CASE 4
  730       IF COORXTA<4THENLET COORXTA=COORXTA+1:LET COOR=COOR+32
  740     CASE 8
  750       IF COORXTA>1THENLET COORXTA=COORXTA-1:LET COOR=COOR-32
  760     CASE 16,17,18,20,24
  770       EXIT DO
  780     CASE ELSE
  790     END SELECT 
  800     SET #10:CURSORCHARACTERCOOR
  810     PRINT #10,ATCOORXTA,COORYTA:;
  820     SOUND PITCHCOOR-32,ENVELOPE1,INTERRUPT
  830     PRINT #102,AT15,19:COOR
  840   LOOP 
  850   CLEAR #11
  860   LET LETTER=COOR
  870   PRINT #102,AT19,13:STR$(LETTER)&" "&CHR$(LETTER)&"  "
  880   PRINT #102,AT14,17:"      "
  890   PRINT #102,AT15,19:"    "
  900   LET X=0:LET Y=0
  910   FOR J=0TO7
  920     FOR I=0TO8
  930       LET CHAR(J,I)=0
  940       PRINT #102,ATI+8,J+5:".";
  950     NEXT I
  960   NEXT J
  970   PRINT #11:"       DESIGNING CHARACTER";
  980   DO 
  990     DO 
 1000       SET #102:INK2
 1010       PRINT #102,ATY+8,X+5:CHR$(159);
 1020       SET #102:INK1
 1030       PRINT #102,ATY+8,X+5:CHR$(46+CHAR(X,Y)*113);
 1040       LET I$=INKEY$:LET JY=JOY(0)
 1050     LOOP UNTILI$<>""ORJY<>0
 1060     IF JY<>0THENLET I$=CHR$(32)
 1070     LET LC$=LCASE$(I$)
 1080     IF JY=8ANDY>0THENLET Y=Y-1
 1090     IF JY=4ANDY<8THENLET Y=Y+1
 1100     IF JY=2ANDX>0THENLET X=X-1
 1110     IF JY=1ANDX<7THENLET X=X+1
 1120     IF LC$="c"THENCALL CLEAR_CHAR
 1130     IF JY>=16THENCALL CHANGE
 1140     IF LC$="d"THENCALL SHOW
 1150     IF LC$="i"THENCALL INVERT
 1160     IF LC$="h"THENCALL HORZ
 1170     IF LC$="v"THENCALL VERT
 1180     IF LC$="r"THENCALL RECALL
 1190     IF LC$="f"THENCALL FILEMENU
 1200   LOOP UNTILLC$="n"
 1210 LOOP 
 1220 END 
 1230 DEF CLEAR_CHAR
 1240   FOR J=0TO7
 1250     FOR I=0TO8
 1260       LET CHAR(J,I)=0
 1270       PRINT #102,ATI+8,J+5:".";
 1280     NEXT I
 1290   NEXT J
 1300 END DEF 
 1310 DEF CHANGE
 1320   LET CHAR(X,Y)=(CHAR(X,Y)+1)BAND1
 1330 END DEF 
 1340 DEF SHOW
 1350   LET DEFINED(LETTER)=1
 1360   FOR J=0TO8
 1370     LET D=0
 1380     LET P=128
 1390     FOR I=0TO7
 1400       LET D=D+P*CHAR(I,J)
 1410       LET P=P/2
 1420     NEXT I
 1430     LET L(J)=D
 1440   NEXT J
 1450   SET CHARACTERLETTERBAND127,L(0),L(1),L(2),L(3),L(4),L(5),L(6),L(7),L(8)
 1460   PRINT #102,AT22,1:"                                                   "
 1470   PRINT #102,AT21,1:"To define character in program use:"
 1480   PRINT #102:"SET CHARACTER ";STR$(LETTERBAND127);",";
 1490   FOR J=0TO7
 1500     PRINT #102:STR$(L(J));",";
 1510   NEXT J
 1520   PRINT #102:STR$(L(8))
 1530 END DEF 
 1540 DEF INVERT
 1550   FOR J=0TO7
 1560     FOR I=0TO8
 1570       LET CHAR(J,I)=(CHAR(J,I)+1)BAND1
 1580       PRINT #102,ATI+8,J+5:CHR$(46+CHAR(J,I)*113);
 1590     NEXT I
 1600   NEXT J
 1610 END DEF 
 1620 DEF VERT
 1630   FOR J=0TO3
 1640     FOR I=0TO8
 1650       LET CHAR(7-J,I)=CHAR(J,I)
 1660       PRINT #102,AT8+I,12-J:CHR$(46+CHAR(J,I)*113);
 1670     NEXT I
 1680   NEXT J
 1690 END DEF 
 1700 DEF HORZ
 1710   FOR J=0TO7
 1720     FOR I=0TO4
 1730       LET CHAR(J,8-I)=CHAR(J,I)
 1740       PRINT #102,AT16-I,5+J:CHR$(46+CHAR(J,I)*113);
 1750     NEXT I
 1760   NEXT J
 1770 END DEF 
 1780 DEF RECALL
 1790   PRINT #102,AT14,17:"ASCII:"
 1800   PRINT #11:"":PRINT #11:"   SELECT CHARACTER TO RECALL";
 1810   DO 
 1820     SELECT CASEJOY(0)
 1830     CASE 1
 1840       IF COORYTA<32THENLET COORYTA=COORYTA+1:LET COOR=COOR+1
 1850     CASE 2
 1860       IF COORYTA>1THENLET COORYTA=COORYTA-1:LET COOR=COOR-1
 1870     CASE 4
 1880       IF COORXTA<4THENLET COORXTA=COORXTA+1:LET COOR=COOR+32
 1890     CASE 8
 1900       IF COORXTA>1THENLET COORXTA=COORXTA-1:LET COOR=COOR-32
 1910     CASE 16,17,18,20,24
 1920       EXIT DO
 1930     CASE ELSE
 1940     END SELECT 
 1950     SET #10:CURSORCHARACTERCOOR
 1960     PRINT #10,ATCOORXTA,COORYTA:;
 1970     SOUND PITCHCOOR-32,ENVELOPE3,INTERRUPT
 1980     PRINT #102,AT15,19:COOR
 1990   LOOP 
 2000   LET N=COOR
 2010   PRINT #102,AT19,32:STR$(N)&" "&CHR$(N)&"  "
 2020   PRINT #102,AT14,17:"      "
 2030   PRINT #102,AT15,19:"    "
 2040   IF N>127THENLET N=N-128
 2050   FOR J=0TO8
 2060     LET D=SPEEK(255,FONT+N+128*J)
 2070     FOR I=7TO0STEP-1
 2080       LET CHAR(I,J)=0
 2090       IF FP(D/2)>0THENLET CHAR(I,J)=1
 2100       LET D=INT(D/2)
 2110       PRINT #102,ATJ+8,I+5:CHR$(46+CHAR(I,J)*113);
 2120     NEXT I
 2130   NEXT J
 2140   CLEAR #11
 2150   PRINT #11:"       DESIGNING CHARACTER";
 2160 END DEF 
 2170 DEF FILEMENU
 2180   DISPLAY #20:AT8FROM1TO10
 2190   CLEAR #11::PRINT #11:"       SELECT FILE OPTION";
 2200   LET I$=INKEY$
 2210   IF I$=""THENGOTO  2200
 2220   IF I$="1"THENGOTO  2690
 2230   IF I$="2"THENLET FILE$="uk.chr":GOTO  2700
 2240   IF I$="3"THENLET FILE$="de.chr":GOTO  2700
 2250   IF I$="4"THENLET FILE$="epdos.chr":GOTO  2700
 2260   IF I$="5"THENLET FILE$="bomber.chr":GOTO  2700
 2270   IF I$="6"THEN
 2280     LET EX$=".CHR":CALL TYPING
 2290     CLEAR #11::PRINT #11:"   FILE SAVING - PLEASE WAIT";
 2300     WHEN EXCEPTIONUSEGALIBA
 2310       OPEN #1:FILE$ACCESSOUTPUT
 2320       CALL USR(MENT,FONT)
 2340       CLOSE #1
 2350       PING 
 2355     END WHEN 
 2360   END IF 
 2370   IF I$="8"THENCLEAR FONT:PING 
 2380   IF I$=CHR$(27)THENGOTO  2780
 2390   IF I$="7"THEN
 2400     LET EX$=".BAS":LET LINNUM=1:CALL TYPING
 2410     CLEAR #11::PRINT #11:"     SAVING BASIC PROGRAM";
 2420     WHEN EXCEPTIONUSEGALIBA
 2430       OPEN #1:FILE$ACCESSOUTPUT
 2440       FOR SO=32TO159
 2450         LET SO2=SO
 2460         IF DEFINED(SO)=1THEN
 2470           IF SO>127THENLET SO2=SO-128
 2480           PRINT #1:STR$(LINNUM)&" SET CHARACTER "&STR$(SO)&",";
 2490           FOR J=0TO8
 2500             LET CH(J)=SPEEK(255,FONT+SO2+128*J)
 2510             PRINT #1:STR$(CH(J));
 2520             IF J<8THENPRINT #1:",";
 2530           NEXT J
 2540           PRINT #1:
 2550           LET LINNUM=LINNUM+1
 2560         END IF 
 2570       NEXT SO
 2580       PRINT #1:STR$(LINNUM)&" ! Created using"
 2590       PRINT #1:STR$(LINNUM+1)&" ! Character Definer 2012"
 2600       PRINT #1:STR$(LINNUM+2)&" ! Visit ENTERPRISEFOREVER.COM"
 2610       PRINT #1:STR$(LINNUM+3)&" ! and EP128.HU"
 2620       CLOSE #1
 2630       PING 
 2640     END WHEN 
 2650     GOTO  2190
 2660   END IF 
 2670   GOTO  2190
 2680   ! * * * Font load
 2690   LET EX$=".CHR":CALL TYPING
 2700   CLEAR #11::PRINT #11:"   FILE LOADING - PLEASE WAIT";
 2710   WHEN EXCEPTIONUSEGALIBA
 2720     OPEN #1:FILE$ACCESSINPUT
 2730     CALL USR(TOLT,FONT)
 2740     CLOSE #1
 2750     PING 
 2760   END WHEN 
 2770   GOTO  2190
 2780   DISPLAY #102:AT8FROM8TO18
 2790   CLEAR #11::PRINT #11:"       DESIGNING CHARACTER";
 2800 END DEF 
 2810 DEF TYPING
 2820   CLEAR #11::PRINT #11:" FILENAME:";:LET FILE$="":LET SO=0
 2830   LET I2$=INKEY$
 2840   IF I2$=""THENGOTO  2830
 2850   SOUND PITCHORD(UCASE$(I2$)),DURATION1,INTERRUPT,SOURCESO,ENVELOPE9
 2860   LET SO=SO+1
 2870   IF SO=3THENLET SO=0
 2880   IF I2$=CHR$(13)THENLET FILE$=FILE$&EX$:GOTO  2945
 2890   IF (I2$>CHR$(47)ANDI2$<CHR$(58))OR(I2$>CHR$(96)ANDI2$<CHR$(123))THEN
 2900     IF LEN(FILE$)<8THENLET FILE$=FILE$&I2$
 2910   END IF 
 2920   IF I2$=CHR$(164)ANDLEN(FILE$)>0THENLET FILE$=FILE$(1:LEN(FILE$)-1)
 2930   CLEAR #11::PRINT #11:" FILENAME:"&UCASE$(FILE$)&EX$&" ";
 2940   GOTO  2830
 2945   CLEAR SOUND
 2950 END DEF 
 2960 HANDLER GALIBA
 2970   SOUND PITCH25,ENVELOPE9,SOURCE2,STYLE128,INTERRUPT
 2980   SOUND PITCH25.1,ENVELOPE9,INTERRUPT
 2990   CLEAR #11::PRINT #11:EXSTRING$(EXTYPE);
 3000   LET I2$=INKEY$
 3010   IF I$=""THENGOTO  3000
 3020   CONTINUE 
 3030 END HANDLER