0 '  CHRDEF.100                              <<mike safonov 70506,1473>>
1 '  THIS PROGRAM CREATES A 933 BYTE 
2 '  MACHINE-CODE FILE ENABLING CUSTOM-
3 '  DESIGNED LCD CHARACTERS 128-255. 
4 '  IT ALSO CREATES "CUSTOM.DO" WHICH
5 '  IS A SHORT BASIC PROGRAM THAT 
6 '  TOGGLES CUSTOM CHARACTER SET 
7 '  MACHINE CODE FROM ACTIVE TO 
8 '  INACTIVE.
9 '
10 '  EDIT LINE 100 TO RELOCATE START 
11 '  ADDRESS.  RUN THIS PROGRAM ONCE
12 '  TO CREATE THE CODE AND THEN KILL.
13 '
14 '  NOTE:  CUSTOM CHARACTERS WILL
15 '  BE ACTIVE IN ALL MODES (BASIC,
16 '  TEXT, TELCOM, ETC.).   
17 '
18 '  CAUTION:  THE MACHINE CODE IS 
19 '  CALLED EVERY TIME ANY CHARACTER
20 '  IS DISPLAYED ON THE LCD.  THERE-
21 '  FORE, IT IS ESSENTIAL THAT IT BE
22 '  DE-ACTIVATED IF IT IS TO BE OVER-
23 '  WRITTEN BY ANOTHER PROGRAM LEST
24 '  A COLD START BE CAUSED.
25 '***************************************************************************
99  FZ=1:CLS 
100 S=58917  ' start address custom character data 
101 S=S+769:IFFZ=1THENGOSUB2000
102 S=S-769:FZ=0
103 POKES,201:S=S+1 'poke a machine code 'return'
110 CLS:IFS+768>MAXRAMTHENPRINT"OM Error":GOTO130
120 IFS<HIMEMTHENCLEAR256,S:S=HIMEM
130 DIMMZ%(2),HL%(2),BZ%(5,7)
140 CLS:PRINT@2,CHR$(27)"VDRAW CUSTOM CHARACTERS IN BOX BELOW:";:
141 PRINT@44, "  <L>    LOAD SAVED CHR$";
142 PRINT@84, "<ARROW>  MOVE PIXEL CURSOR"
143 PRINT@124,"<S>/<R>  SET/RESET PIXEL
144 PRINT@164,"<ENTER>  SAVE CHARACTER
145 PRINT@204,"  <C>    CLEAR BOX"
146 PRINT@244,"<SPACE>  FLASH PIXEL CURSOR";"
147 GOSUB1100
150 'initialize variables
151 C0=210:R0=24:C=3:R=3:MZ%(0)=22:MZ%(1)=13005:MZ%(2)=-13964:KZ=50:X$="SsRr "+CHR$(13)+CHR$(28)+CHR$(29)+CHR$(30)+CHR$(31)+"LlCc"
152 FORI=0TO7:A%(I)=2^I:NEXT:FORI=0TO2:HL%(I)=0:NEXT
200 KZ=1:Q$=INKEY$:IFQ$=""GOTO200:IFBZ%(C,R)=1THENGOSUB300ELSEGOSUB400
201 ONINSTR(1,X$,Q$)GOSUB300,300,400,400,731,600,700,710,720,730,500,500,800,800
208 R%=R0+R:C%=C0+C
209 'flash pixel cursor
210 Q=BZ%(C,R):FORJ=0TO1:IFQ=1THENGOSUB401:Q=0ELSEGOSUB301:Q=1
211 FORL=1TOKZ:NEXTL:NEXTJ
220 GOTO200
300 BZ%(C,R)=1
301 PSET(C%,R%):RETURN 'S: set pixel
400 BZ%(C,R)=0
401 PRESET(C%,R%):RETURN 'R: reset pixel
500 GOSUB1200:HL=S+6*(Q-128):PRINT@155,;:GOSUB1001:FORC=0TO5:FORR=0TO7:BZ%(C,R)=0:IF(PEEK(HL+C)ANDA%(R))<>0THENBZ%(C,R)=1
501 NEXT:NEXT:C=3:R=3:RETURN
600 PRINT@155,;:HL=VARPTR(HL%(0)):GOSUB1000 '<enter>: save custom character
604 GOSUB1200: PRINT@280,SPACE$(40);:PRINT@305,;:HL=VARPTR(HL%(0)):GOSUB1001:HL=S+6*(Q-128):GOSUB1000
605 PRINT@307,"= CHR$("RIGHT$(STR$(Q),3)")";
606 FORI=1TO1000:NEXT:RUN100
700 IFC=5THENBEEPELSEC=C+1 'chr$(28): move cursor right
701 GOTO731
710 IFC=0THENBEEPELSEC=C-1 'chr$(29): move cursor left
711 GOTO731
720 IFR=0THENBEEPELSER=R-1 'chr$(30): move cursor up
721 GOTO731
730 IFR=7THENBEEPELSER=R+1 'chr$(31): move cursor down
731 KZ=40:RETURN
800 RUN100
1000 MZ%(0)=22:GOTO1002 'read chr$ bit data from lcd 
1001 MZ%(0)=278 'write chr$ bit data to lcd
1002 CALL30300:CALLVARPTR(MZ%(0)),0,HL:RETURN
1100 LINE(209,23)-(216,32),1,B:RETURN
1200 PRINT@315,SPACE$(5);:PRINT@284,;:INPUT"PRESS KEY OR ENTER ASCII CODE";Q$:IFLEN(Q$)=1THENQ=ASC(Q$)ELSEQ=VAL(Q$)
1201 IFQ<128ORQ>255THENBEEP:GOTO1200ELSEQ$=CHR$(Q)
1202 PRINT@280,SPACE$(29)"CHR$("RIGHT$(STR$(Q),3)")":RETURN
1999 '*********************************
2000 'S=entry address for machine code=1+end of custom chr$ data
2001 'THIS SUBROUTINE COPIES A 164 BYTE
2002 'MACHINE CODE PATCH FROM ROM AND
2003 'ADJUSTS JUMP ADDRESSES TO ENABLE
2004 'USER-DEFINED CHR$'S 128-255 TO BE
2005 'DISPLAYED ON LCD.
2006 '
2007 'CHR'S BIT-IMAGE DATA IS IN 128
2008 '6-BYTE RECORDS JUST ABOVE CODE.
2009 '
2010 IFS<HIMEMORS>MAXRAM-164THENBEEP:PRINT"invalid start address":STOP
2020 IFS<HIMEMTHENCLEAR256,S:S=HIMEM
2030 N=S:FORI=0TO4:GOSUB3000:NEXT
2031 DATA227,35,35,35,227
2040 FORI=1TO3:READT:READE:GOSUB3100:NEXT
2041 DATA17183,17266
2042 DATA17760,17797
2043 DATA29678,29711
2044 FORI=1TO3:GOSUB3000:NEXT
2045 DATA195,16,116
2050 FORI=1TO6:READK(I),A(I),L(I),B(I):NEXT
2051 DATA 1,17196,1,17205
2052 DATA 1,17209,1,17228
2053 DATA 1,17256,2,17760
2054 DATA 2,17780,3,29678
2055 DATA 3,29696,4,30480
2056 DATA 3,29710,4,30385
2057 B(6)=S-768-576 
2058 'INPUT"ADDR CHR$'s 32-127 (<cr>=30481)";C1$:IFC1$<>""THENB(5)=VAL(C1$)-1
2059 'INPUT"ADDR CHR$'s 128-255 (<cr>=30961)";C2$:IFC2$<>""THENB(6)=VAL(C2$)-576
2060 FORI=1TO6:K=K(I):A(I)=A(I)+D(K):L=L(I):B(I)=B(I)+D(L):IFB(I)>32767THENB(I)=B(I)-65536
2061 B%(I)=B(I):NEXT
2062 FORI=1TO6:FORJ=0TO1:POKEA(I)+J,PEEK(VARPTR(B%(I))+J):NEXT:NEXT
2070 CLS:PRINT "MACHINE CODE PATCH POKED TO:"
2071 PRINT"    Entry: ";S
2072 PRINT"    End:   ";N-1
2073 PRINT"BIT-IMAGE DATA FOR ALTERNATE            CHARACTERS AT:"
2074 FORI=5TO6:IFB(I)<0THENB(I)=B(I)+65536
2075 NEXT
2076 PRINT"  chr's 32-126: "B(5)+1" to "B(5)+479+1
2077 PRINT"  chr's 128-255 "B(6)+576" to "B(6)+767+576
2080 S%=S-65536:T%=S%
2100 INPUT"ACTIVATE ALTERNATE CHARACTERS (Y/N)";A$
2101 IFA$="Y"ORA$="y"THENA$=""ELSEA$="DE":S%=32755
2102 PRINTA$"activating custom CHR$'s--":FORI=1TO200:NEXT
2103 FORJ=0TO1:X(J)=PEEK(VARPTR(S%)+J):POKE64226+J,X(J):NEXT
2110 GOSUB4000:RETURN 'TO LINE 101
3000 READA:POKEN,A:N=N+1:RETURN
3100 D(I)=N-T:FORJ=TTOE:POKEN,PEEK(J):N=N+1:NEXT:RETURN
3999 'create BASIC program "CUSTOM" to activate/deactivate alternate chr's
4000 OPEN"CUSTOM"FOROUTPUTAS1
4010 PRINT#1,"10 A=PEEK(64226)+256*PEEK(64227)
4020 PRINT#1,"20 IFA=32755THENA%="T%"ELSEA%=32755:A$="CHR$(34)"DE"CHR$(34)
4030 PRINT#1,"30 FORJ=0TO1:X(J)=PEEK(VARPTR(A%)+J):POKE64226+J,X(J):NEXT"
4040 PRINT#1,"40 PRINT"CHR$(34)"Custom characters 128-255 "CHR$(34)"A$"CHR$(34)"activated"CHR$(34)
4050 CLOSE:RETURN