100 'program newsfront.bas to create new characteer sets for the ibm-pc 105 'craig newlander , 1984 all rights reserved 110 ' 115 KEY OFF: SCREEN 1: COLOR 9,0:CLS:CLEAR,&HF800 120 DEFINT A-Z:ON ERROR GOTO 1115:FOR R=1 TO 10:KEY R,"":NEXT 125 DIM H(7,1), V(4,1), BIN(7,1), FONT(1), FL(1), CH$(1) ,FILE$(1) 130 DIM GRIDA(188),GRIDB(188):GOSUB 1145 'initailize arrays 135 ' 140 'set up screen 145 ' 150 PRINT " <"CHR$(27) CHR$(24) CHR$(25) CHR$(26); 155 PRINT "> "; 160 LINE (0,10)-(319,170),1,B:LINE(1,11)-(318,169),2,B 165 LINE (2,11)-(2,169),2: LINE (317,11)-(317,169),2 170 LINE (3,12)-(316,168),1,B 175 ' 180 FOR A=31 TO 95 STEP 8 185 LINE (84,A)-(148,A),1:LINE (A+53,32)-(A+53,94),1 190 LINE (172,A)-(236,A),1:LINE (A+141,32)-(A+141,94),1 195 NEXT:GOSUB 970:G=1:GOSUB 970 200 ' 205 LOCATE 14,10:PRINT "f9" SPC(18) "f10"; 210 LOCATE 16,8 :PRINT "grid a" SPC(14) "grid b"; 215 GET (16,118)-(148,128),GRIDA 220 GET (172,118)-(304,128),GRIDB 225 ' 230 LOCATE 23,1:PRINT " ^f1 f2 f4 ^f5 f6"; 235 LOCATE 24,1:PRINT " load load bios save save"; 240 LOCATE 25,1:PRINT " file char char file char"; 245 GOTO 800 250 ' 255 'main input 260 ' 265 DEF SEG=0:POKE &H417,&H40:DEF SEG 'set num lock to cusor mode 270 I$=INKEY$:IF I$="" THEN 270 275 IF I$=CHR$(0)+CHR$(72) THEN IF V(1,G)=V(0,G) THEN 265 ELSE V(1,G)=V(1,G)-8:GOTO 370 'up 280 IF I$=CHR$(0)+CHR$(75) THEN IF H(1,G)=H(0,G) THEN 265 ELSE H(1,G)=H(1,G)-8:GOTO 370 'left 285 IF I$=CHR$(0)+CHR$(77) THEN IF H(1,G)=H(3,G) THEN 265 ELSE H(1,G)=H(1,G)+8:GOTO 370 'right 290 IF I$=CHR$(0)+CHR$(80) THEN IF V(1,G)=V(3,G) THEN 265 ELSE V(1,G)=V(1,G)+8:GOTO 370 'down 295 IF I$=CHR$(0)+CHR$(82) THEN 400 'insert 300 IF I$=CHR$(0)+CHR$(83) THEN 440 'delete 305 IF I$=CHR$(0)+CHR$(60) THEN 505 'load char 310 IF I$=CHR$(0)+CHR$(62) THEN 600 'load char from bios 315 IF I$=CHR$(0)+CHR$(64) THEN 750 'save char 320 IF I$=CHR$(0)+CHR$(67) THEN 800 'grid a 325 IF I$=CHR$(0)+CHR$(68) THEN 835 'grid b 330 IF I$=CHR$(0)+CHR$(94) THEN 870 'load file 335 IF I$=CHR$(0)+CHR$(98) THEN 930 'save file 340 IF I$=CHR$(32) THEN GOSUB 970: GOTO 265 'clear grid 345 IF I$=CHR$(27) THEN SCREEN 0,0:WIDTH 80:END 'escape 350 GOTO 265 355 ' 360 'move dot 365 ' 370 IF POINT (H(2,G)+1,V(2,G))=2 THEN PSET (H(2,G),V(2,G)),2 ELSE PSET (H(2,G),V(2,G)),3 375 IF POINT (H(1,G)+1,V(1,G))=2 THEN PSET (H(1,G),V(1,G)),3 ELSE PSET (H(1,G),V(1,G)),2 380 H(2,G)=H(1,G):V(2,G)=V(1,G):GOTO 265 385 ' 390 'insert 395 ' 400 IF POINT (H(1,G)+1,V(1,G))=3 THEN BEEP: GOTO 265 ELSE PAINT (H(1,G),V(1,G)),3,1:PSET (H(1,G),V(1,G)),2 405 COL=(H(1,G)-H(0,G))/8:ROW=(V(1,G)-V(0,G))/8 410 PSET (H(4,G)+COL,V(4,G)+ROW),3 415 BIN(ROW,G)=BIN(ROW,G) OR &H80/2^COL 420 GOSUB 480:GOTO 265 425 ' 430 'delete 435 ' 440 IF POINT (H(1,G)+1,V(1,G))=2 THEN BEEP : GOTO 265 ELSE PAINT (H(1,G),V(1,G)),2,1:PSET (H(1,G),V(1,G)),3 445 COL=(H(1,G)-H(0,G))/8:ROW=(V(1,G)-V(0,G))/8 450 PSET (H(4,G)+COL,V(4,G)+ROW),0 455 BIN(ROW,G)=BIN(ROW,G) XOR &H80/2^COL 460 GOSUB 480: GOTO 265 465 ' 470 'print hex value 475 ' 480 HX$=HEX$ (BIN(ROW,G)):IF LEN(HX$)=1 THEN HX$="0" +HX$ 485 LOCATE ROW+5,H(7,G):PRINT HX$:RETURN 490 ' 495 ' load charcter from memory 500 ' 505 LOCATE 20: GOSUB 1030 510 LOCATE,H(6,G):PRINT "char code: ";:MAXCHAR=3:GOSUB 1050:CH$(G)=S$ 515 IF CH$(G)="" THEN 580 520 IF CH$(G)="a" OR CH$(G)="A" THEN IF G=0 THEN 580 ELSE 680 525 IF CH$(G)="B" OR CH$(G)="b" THEN IF G=1 THEN 580 ELSE 680 530 CH=VAL(CH$(G)):IF CH<0 OR CH>255 THEN 580 535 CH=CH MOD 128:FL(G)=0:GOSUB 970 540 FOR ROW=0 TO 7 545 BIN(ROW,G)=PEEK(FONT(G)+CH*8+ROW) : M=&H80: MH=H(0,G) 550 FOR COL= 0 TO 7 555 IF NOT BIN(ROW,G) AND M THEN 565 560 PAINT (MH,V(0,G)+8*ROW),3,1:PSET(H(4,G)+COL,V(4,G)+ROW),3 565 M=M/2: MH=MH+8 570 NEXT COL: GOSUB 480 575 NEXT ROW:GOTO 265 580 BEEP:CH$(G)="":GOSUB 1030: GOTO 265 585 ' 590 ' load char from bios 595 ' 600 LOCATE 20:GOSUB 1030 605 LOCATE ,H(6,G):PRINT "char code : ";:MAXCHAR =3:GOSUB 1050:CH$(G)=S$ 610 IF CH$(G)="" THEN 580 615 CH=VAL(CH$(G)): IF CH<0 OR CH>255 THEN 580 620 CH=CH MOD 128 :FL(G)=0:GOSUB 970 :DEF SEG=&HF000 625 FOR ROW=0 TO 7 630 BIN(ROW,G)=PEEK(&HFA6E+CH*8+ROW): M=&H80:MH=H(0,G) 635 FOR COL=0 TO 7 640 IF NOT BIN(ROW,G) AND M THEN 650 645 PAINT (MH,V(0,G)=8*ROW),3,1:PSET (H(4,G)+COL,V(4,G)+ROW),3 650 M=M/2 : MH=MH+8 655 NEXT COL :GOSUB 480 660 NEXT ROW:GOTO 265 665 ' 670 'load chr from opposite grid 675 ' 680 NG=G XOR 1:CH$(G)=CH$(NG):GOSUB 1030 685 IF CH$(G) <>"" THEN LOCATE ,H(6,G): PRINT "char code: " CH$(G) 690 FL(G)=0 :GOSUB 970 695 FOR ROW =0 TO 7 700 BIN(ROW,G)=BIN(ROW,NG):M=&H80:MH=H(0,G) 705 FOR COL=0 TO 7 710 IF NOT BIN(ROW,G) AND M THEN 720 715 PAINT(MH,V(0,G)+8*ROW),3,1:PSET (H(4,G)+COL,V(4,G)+ROW),3 720 M=M/2:MH=MH+8 725 NEXT COL:GOSUB 480 730 NEXT ROW : GOTO 265 735 ' 740 'save cahr to memory 745 ' 750 LOCATE 20:GOSUB 1030:IF CH$(G) <>"" THEN 765 755 LOCATE ,H(6,G):PRINT" char code: ";:MAXCHAR=3:GOSUB 1050:CH$(G)=S$ 760 IF CH$="" THEN 580 765 CH=VAL(CH$(G)):IF CH<0 OR CH>255 THEN 580 770 CH=CH MOD 128 :FL(G)=1:GOSUB 1030 775 FOR ROW=0 TO 7 :POKE FONT(G)+CH*8+ROW,BIN(ROW,G):NEXT 780 LOCATE ,H(6,G):PRINT "char "CH$(G) " saved";:CH$(G)="":GOTO 265 785 ' 790 'switch to grid a 795 ' 800 PUT (172,118),GRIDB,PSET 805 LINE (172,123)-(210,123):LINE (267,123)-(304,123) 810 PUT (16,118),GRIDA,PRESET 815 G=0: GOTO 265 820 ' 825 'switch to grid b 830 ' 835 PUT (16,118),GRIDA,PSET 840 LINE (16,123)-(50,123):LINE (107,123)-(148,123) 845 PUT (172,118),GRIDB,PRESET 850 G=1:GOTO 265 855 ' 860 'load files 865 ' 870 LOCATE 18 :GOSUB 1030 875 LOCATE ,H(5,G):PRINT "file? ";:MAXCHAR=12:GOSUB 1050 :FILE$(G)=S$ 880 GOSUB 1030 :IF FILE$(G)="" THEN BEEP:GOTO 265 885 FL(G)=1:IF FILE$(G)="new" OR FILE$(G)="NEW" THEN 900 890 BLOAD FILE$(G),FONT(G) 895 LOCATE ,H(6,G):PRINT FILE$(G);: GOTO 265 900 LOCATE ,H(6,G):PRINT "working..."; 905 FOR BYTE=0 TO &H3FF :POKE FONT(G)+BYTE,0:NEXT 910 LOCATE ,H(6,G):PRINT "memory cleared";:FILE$(G)="":GOTO 265 915 ' 920 'save file 925 ' 930 LOCATE 18:GOSUB 1030:IF FILE$(G) <>"" THEN 945 935 LOCATE ,H(5,G): PRINT"file? ";: MAXCHAR=12:GOSUB 1050:FILE$(G)=S$ 940 GOSUB 1030 :IF FILE$(G)="" THEN BEEP:GOTO 265 945 BSAVE FILE$(G),FONT(G),&H400 950 LOCATE,H(5,G):PRINT FILE$(G) " saved";:FILE$(G)="":FL(G)=1:GOTO 265 955 ' 960 ' paint grid 965 ' 970 LOCATE 3:GOSUB 1030 975 ROW=5:FOR R=35 TO 91 STEP 8 980 FOR C=H(0,G) TO H(3,G) STEP 8:PAINT (C,R),2,1:NEXT C 985 LOCATE ROW,H(7,G)-2: PRINT &H0; 990 ROW=ROW+1:NEXT R 995 IF FL(G)=1 THEN LOCATE 20:GOSUB 1030:FL(G)=0 1000 FOR ROW=0 TO 7:BIN(ROW,G)=0:NEXT 1005 H(1,G)=H(0,G):V(1,G)=V(0,G):PSET (H(1,G),V(1,G)) 1010 H(2,G)=H(1,G): V(2,G)=V(1,G):RETURN 1015 ' 1020 ' blanker 1025 ' 1030 LOCATE ,H(5,G):PRINT SPC(18):RETURN 1035 ' 1040 'keyboard input 1045 ' 1050 S$="":KCHAR=0:START=POS(0) 1055 CHAR$=INKEY$:IF CHAR$="" THEN 1055 1060 IF CHAR$=CHR$(13) THEN RETURN 1065 IF CHAR$=CHR$(8) THEN GOSUB 1085:GOTO 1055 1070 IF LEN(CHAR$)>1 OR CHAR$MAXCHAR THEN KCHAR=MAXCHAR:GOTO 1055 1080 PRINT CHAR$;:S$=S$+CHAR$:GOTO 1055 1085 IF KCAHR=0 THEN RETURN 1090 KCHAR=KCAHR-1 :LOCATE ,START+KCHAR:PRINT CHR$(32) ;:LOCATE ,START+KCHAR 1095 S$=LEFT$S$,KCHAR):RETURN 1100 ' 1105 'errors 1110 ' 1115 IF ERL=890 THEN LOCATE ,H(6,G):PRINT"file not found";:FILE$(G)="":FL(G)=1:RESUME 265 1120 IF ERL=945 THEN LOCATE ,H(6,G):PRINT"file not saved";:FILE$(G)="":FL(G)=1:RESUME 265 1125 ON ERROR GOTO 0 1130 ' 1135 ' initialize arrays 1140 ' 1145 FOR C=0 TO 1:FOR R=0 TO 7 :READ H(R,C):NEXT R,C 1150 DATA 88,88,88,144,113,2,4,6 1155 DATA 176,176,176,232,201,22,24,36 1160 FOR C=0 TO 1:FOR R=0 TO 4:READ V(R,C):NEXT R,C 1165 DATA 35,35,35,91,16 1170 DATA 35,35,35,91,16 1175 FONT (0)=&HF800:FONT(1)=&HFC00:RETURN EAD V(R,C):NEXT R,C 1165 DATA 35,35,35,91,16 1170 DATA 35,35,35,91,16 1175 FONT (0)=&HF800:FONT(1)=&HFC00:RETURN