10 REM ****************************************************************
20 REM *	Module name  :	d2n.bas                               *
30 REM *	Purpose      :	Converts Database to Newsdesk Font    *
40 REM *	Created      :	25-09-89			      * 
50 REM *	Last edited  : 	20-10-89		Version 1.0   *
60 REM * 	Copyright    :	G R Buckeridge			      *
70 REM ****************************************************************
80 :
90 m$="................................":m2$="................":z1$="**":z2$="*":z3$=".."
100 WIDTH 80
110 DEFINT a-e,g-y
120 DIM a$(15),b$(15)
130 e$=CHR$(27):DEF FN at$(x,y)=e$+"Y"+CHR$(32+y)+CHR$(32+x):cls$=e$+"H"+e$+"E"
140 DEF FNmess$(mess$)=FNat$(0,28)+mess$+e$+"K"
150 PRINT cls$ TAB(27);"Database to Newsdesk Font Converter"
160 PRINT FNat$(0,4);:INPUT "Database Font Name (without .EXT) ",font$:font$=UPPER$(font$)
170 PRINT FNat$(0,4);"Database Font Name - ";font$;".FNT","Newsdesk Font Name - ";font$;".NEW";
180 IF FIND$(font$+".FNT")="" THEN PRINT:PRINT:PRINT"File does not exist":GOTO 570
190 OPEN"R",1,font$+".fnt",2
200 FIELD 1,2 AS f$
210 OPEN "R",2,font$+".new",128
220 FIELD 2,128 AS n$
230 GOSUB 720
240 :
250 REM start loop
260 PRINT e$;"f";
270 s=&H20
280 FOR p=1 TO 96
290 :
300 PRINT FNmess$("Reading Database Character");p;
310 l=31:r=0:b=0
320 FOR i=0 TO 15:REM makeup char matrix
330 GET #1
340 f=ASC(LEFT$(f$,1))*256+(ASC(RIGHT$(f$,1)))
350 GOSUB 610
360 NEXT
370 :
380 IF p=1 THEN l=0:r=31
390 IF b<11 THEN b=13
400 r=(r-l)*2+2
410 IF r>31 THEN r=31
420 b2=15-b-1
430 :
440 PRINT FNmess$("Setting up Newsdesk Char");p;
450 PRINT FNat$(0,8);
460 FOR i=0 TO b2:b$(i)=m$:PRINT m$:NEXT
470 FOR i=0 TO b
480 b$(i+b2+1)=LEFT$(RIGHT$(a$(i),32-l*2)+m$,32)
490 PRINT b$(i+b2+1)
500 NEXT
510 PRINT FNat$(52,12);"Char code = ";HEX$(s,2);FNat$(52,20);"Character = "CHR$(s);
520 :
530 GOSUB 900
540 :
550 NEXT
560 CLOSE
570 PRINT FNat$(0,28);e$;"e"
580 END
590 REM end loop
600 :
610 REM hex to binary
620 a$(i)="":z=32768!:FOR x=0 TO 15
630 IF f>=z AND l>x THEN l=x
640 IF f>=z AND r<x THEN r=x
650 IF f<>0 AND i>b THEN b=i
660 IF f>=z THEN f=f-z:a$(i)=a$(i)+z1$ ELSE a$(i)=a$(i)+z3$
670 z=z/2
680 NEXT
690 REM PRINT a$(i)
700 RETURN
710 :
720 REM sets up first 384 bytes of Newsdesk file
730 a$="":PRINT FNmess$("Initialising Newsdesk File");
740 a$=STRING$(&H20,CHR$(&HFF))
750 FOR i=1 TO 95
760 a$=a$+CHR$(i)
770 NEXT
780 a$=a$+CHR$(&HFF)
790 LSET n$=a$
800 PUT #2
810 a$=STRING$(35,CHR$(&HFF))+CHR$(&H60)+STRING$(92,CHR$(&HFF))
820 LSET n$=a$
830 PUT #2
840 a$=STRING$(16,CHR$(&HFF))
850 a$=a$+CHR$(&HC)+CHR$(&H12)+CHR$(&H24)+CHR$(8)+CHR$(&H10)+CHR$(&H20)+STRING$(3,CHR$(0))+CHR$(8)+CHR$(&H10)+CHR$(&H20)+STRING$(100,CHR$(0))
860 LSET n$=a$
870 PUT #2
880 RETURN
890 :
900 REM each subsequent 128 byte block of newsdesk file
910 a$=CHR$(s)+CHR$(0)+CHR$(r)+STRING$(5,CHR$(0)):s=s+1
920 IF s=&H7F THEN s=&HA3
930 FOR k=1 TO 15
940 g$=b$(k)
950 GOSUB 1010:GOSUB 1010
960 NEXT
970 LSET n$=a$
980 PUT #2
990 RETURN
1000 :
1010 REM binary TO hex
1020 FOR j=0 TO 24 STEP 8
1030 z=128:g=0
1040 FOR i=1 TO 8
1050 IF MID$(g$,i+j,1)=z2$ THEN g=g+z
1060 z=z/2:NEXT
1070 a$=a$+CHR$(g)
1080 NEXT
1090 RETURN
28:g=0
1040 FOR i=1 TO 8
1050 IF MID$(g$,i+j,1)=z2$ THEN g=g+z
1060 z=z/2:NEXT