10 ! CHEX CC40 Character Editor
15 ! By Keith Jackson
20 ! Arrow keys to move cursor
30 ! Space to toggle pixel
40 ! CLR to clear character
50 ! Q to exit
100 CALL CHEX(CHEX$())
110 DISPLAY ERASE ALL,"Bye!":PAUSE (1)
120 END
1000 SUB CHEX(CHEX$())
1001 ATTACH HEXTOBITS,BITSTOHEX
1005 PRINT "CHAR 0,0000000000000000 ";
1010 FOR C=0 TO 6
1020 CHEX$(C)="0000000000000000"
1030 CALL CHAR(C,CHEX$(C))
1035 PRINT CHR$(C);
1040 NEXT C
1999 X=4:Y=1:C=0
2000 DISPLAY AT(6),STR$(C);",";CHEX$(C);
2010 CALL CHAR(C,CHEX$(C))
2020 CALL HEXTOBITS(SEG$(CHEX$(C),Y*2-1,2),BITS())
2030 IF BITS(X)=0 THEN BITS(X)=1 ELSE BITS(X)=0
2040 CALL BITSTOHEX(HEXBYTE$,BITS())
2050 CHEXT$=SEG$(CHEX$(C),1,Y*2-2)&HEXBYTE$&SEG$(CHEX$(C),Y*2+1,16)
2060 WAIT=0
2070 WAIT=WAIT+1
2080 IF WAIT=1 THEN CALL CHAR(C,CHEXT$)
2090 IF WAIT=4 THEN CALL CHAR(C,CHEX$(C))
2100 IF WAIT=18 THEN WAIT=0
2110 CALL KEY(K,S)
2120 IF K=255 THEN 2070
2130 CALL CHAR(C,CHEX$(C))
2140 IF K=81 OR K=113 THEN 3999
2150 IF K=232 AND Y>1 THEN Y=Y-1
2151 IF K=233 AND Y<8 THEN Y=Y+1
2160 IF K=252 THEN IF X<4 THEN X=X+1 ELSE IF C>0 THEN X=0:C=C-1
2161 IF K=254 THEN IF X>0 THEN X=X-1 ELSE IF C<6 THEN X=4:C=C+1
2170 IF K=250 THEN CHEX$(C)="0000000000000000"
2180 IF K=32 THEN CHEX$(C)=CHEXT$
2190 GOTO 2000
3999 RELEASE HEXTOBITS,BITSTOHEX
4000 SUBEND
5000 SUB HEXTOBITS(HEX$,BITS())
5010 A=ASC(SEG$(HEX$,1,1)):B=ASC(SEG$(HEX$,2,1))
5020 IF A=49 THEN BITS(4)=1 ELSE BITS(4)=0
5030 IF B<58 THEN NIBBLE=B-48 ELSE NIBBLE=B-55
5040 IF NIBBLE>7 THEN BITS(3)=1:NIBBLE=NIBBLE-8 ELSE BITS(3)=0
5050 IF NIBBLE>3 THEN BITS(2)=1:NIBBLE=NIBBLE-4 ELSE BITS(2)=0
5060 IF NIBBLE>1 THEN BITS(1)=1:NIBBLE=NIBBLE-2 ELSE BITS(1)=0
5070 IF NIBBLE>0 THEN BITS(0)=1 ELSE BITS(0)=0
5500 SUBEND
6000 SUB BITSTOHEX(HEX$,BITS())
6010 IF BITS(4)=1 THEN HEX$="1" ELSE HEX$="0"
6020 NIBBLE=BITS(3)*8+BITS(2)*4+BITS(1)*2+BITS(0)
6030 IF NIBBLE<10 THEN HEX$=HEX$&CHR$(NIBBLE+48) ELSE HEX$=HEX$&CHR$(NIBBLE+55)
6500 SUBEND