8-Bit Software Online Conversion
:0.$.BBCBAN2 - Listing
100code%=C%:store%=S%:main=code%+&9C:a
dr=&70:len=&76:dots=&77
110DIM X%(25),Y%(25),apeX%(25),apeY%(2
5)
120MODE 7:PROCheader:PROCgetparams
130MODE 0:HIMEM=&2C00
140VDU 2:*FX3,64
150FOR loop%=1 TO LEN(M$):CLS
160let$=MID$(M$,loop%,1):PROCdrawlette
r(let$)
170IF let$<>" " PROCdumpletter
180NEXT:VDU 3,7:END
190:
1000DEF PROCheader
1010FOR I%=0 TO 1
1020VDU 157,129,141:PRINT" SPLINETEXT
V1.1 by David James"
1030NEXT:VDU 31,0,24,157,129:PRINTSPC10
"(C) BEEBUG 1990";:VDU 28,0,23,39,2
1040ENDPROC
1050:
1060DEF PROCgetparams
1070REPEAT PRINT'" Your message ";
1080INPUT LINE M$:UNTIL LEN(M$)>0
1090REPEAT PRINT'" Width of letters (in
ches) :";
1100INPUT "" xsize:UNTIL xsize>0
1110REPEAT PRINT'" Height of letters (i
nches) :";
1120INPUT "" ysize:UNTIL ysize>0
1160IF xsize>7.1111 xsize=7.1111
1170IF xsize<=(32/9) THEN xdpp=2
1180IF xsize<=(16/9) THEN xdpp=1
1190ydpp=3:IF ysize>8 ysize=8
1200IF ysize<=(16/3) THEN ydpp=2
1210IF ysize<=(8/3) THEN ydpp=1
1220ysc=(ysize/ydpp)*1279*3/(8*28)
1230ENDPROC
1240:
1250DEF PROCscalex
1260xs=xsize:realx=xs*xmax/29
1270adjx=INT(0.5+realx*9)/9
1280xs=(adjx*xs)/realx
1290xsc=(1024*xs*9)/(16*xdpp*29)
1300xsc=(xmax*xsc-4)/xmax
1310ENDPROC
1320:
1330DEF PROCdrawletter(letter$)
1340IF letter$=" " THEN PROCls(108*xsiz
e):ENDPROC
1350RESTORE (2610+10*(INSTR("ABCDEFGHIJ
KLMNOPQRSTUVWXYZ.!,",letter$)))
1360READ S$,fill$
1370XS=FNt(1):YS=FNt(2):xmax=FNt(3)
1380PROCscalex
1390REPEAT READ N$
1400IF N$<>"E" READ S$:L%=(LENS$)/2
1410IF N$="S" PROCspline ELSE IF N$="L"
PROCline
1420UNTIL N$="E"
1440ENDPROC
1450:
1460DEF PROCline
1470PROCline1(0,1,0,1)
1480IF XS<>0 PROCline1(2*XS,-1,0,1)
1490IF YS<>0 PROCline1(0,1,2*YS,-1)
1500IF XS<>0 AND YS<>0 PROCline1(2*XS,-
1,2*YS,-1)
1510ENDPROC
1520:
1530DEF PROCline1(xc,xm,yc,ym)
1540x=FNd(1,xc,xm):y=FNd(2,yc,ym)
1550MOVE FNy(y),FNx(x)
1560FOR N%=1 TO L%-1
1570x=FNd(1+2*N%,xc,xm)
1580y=FNd(2*(N%+1),yc,ym)
1590DRAW FNy(y),FNx(x)
1600NEXT N%
1610ENDPROC
1620:
1630DEF PROCspline
1640PROCspline1(0,1,0,1)
1650IF XS<>0 PROCspline1(2*XS,-1,0,1)
1660IF YS<>0 PROCspline1(0,1,2*YS,-1)
1670IF XS<>0 AND YS<>0 PROCspline1(2*XS
,-1,2*YS,-1)
1680ENDPROC
1690:
1700DEF PROCspline1(xc,xm,yc,ym)
1710FOR N%=0 TO L%-1
1720x=FNd(1+2*N%,xc,xm):Y%(N%+1)=FNx(x)
1730y=FNd(2*(N%+1),yc,ym):X%(N%+1)=FNy(
y)
1740NEXT N%
1750FOR J%=1 TO L%
1760apeX%(J%)=((X%(J%)*4)-X%(J%+1)-X%(J
%-1))/2
1770apeY%(J%)=((Y%(J%)*4)-Y%(J%+1)-Y%(J
%-1))/2
1780NEXT
1790MOVE X%(1),Y%(1)
1800FOR J%=1 TO L%-2
1810FOR n=0 TO 0.5 STEP .02
1820N=1-n:m=n*2:M=1-m
1830IF J%=1 PROCsimplebow(J%)
1840IF J%>1 PROChalfbow
1850NEXT:NEXT
1860FOR n=0.5 TO 1 STEP .02
1870PROCsimplebow(J%-1)
1880NEXT n
1890DRAW FNrx(X%(J%+1)),FNry(Y%(J%+1))
1900ENDPROC
1910:
1920DEF PROCsimplebow(J%)
1930DRAW FNrx(FNbowX(J%,n)),FNry(FNbowY
(J%,n))
1940ENDPROC
1950:
1960DEF PROChalfbow
1970LOCAL BowX,BowX2,BowY,BowY2
1980BowX=m*FNbowX(J%,n)
1990BowX2=M*FNbowX(J%-1,n+.5)
2000BowY=m*FNbowY(J%,n)
2010BowY2=M*FNbowY(J%-1,n+.5)
2020DRAW FNrx(BowX+BowX2),FNry(BowY+Bow
Y2)
2030ENDPROC
2040:
2050DEF FNbowX(J%,n)
2060LOCAL X%,X2%,apeX%
2070X%=X%(J%):X2%=X%(J%+2)
2080apeX1%=apeX%(J%+1)
2090=((X%+(n*(apeX1%-X%)))*(1-n))+((ape
X1%+(n*(X2%-apeX1%)))*n)
2100:
2110DEF FNbowY(J%,n)
2120LOCAL Y%,Y2%,apeY%
2130Y%=Y%(J%):Y2%=Y%(J%+2)
2140apeY1%=apeY%(J%+1)
2150=((Y%+(n*(apeY1%-Y%)))*(1-n))+((ape
Y1%+(n*(Y2%-apeY1%)))*n)
2160:
2170DEF FNx(pos)=1023-xsc*pos
2180DEF FNy(pos)=ysc*pos
2190DEF FNrx(x):IF x<0 THEN =0
2200IF x>1279 THEN =1279 ELSE =x
2210DEF FNry(y):IF y<0 THEN =0
2220IF y>1023 THEN =1023 ELSE =y
2230:
2240DEF FNt(P%)=(ASC(MID$(S$,P%,1))-48)
/2
2250DEF FNd(P%,c,m)=c+m*FNt(P%)
2260:
2270DEF PROCdumpletter
2280?dots=16/xdpp
2290lines%=INT(.99999999+(4+xmax*xsc)/6
4)
2300len%=INT(.99999999+28*ysc/16)
2310PROCdump:PROCls(20*xsize)
2320ENDPROC
2330:
2340DEF PROCdump
2350FOR Y%=0 TO (xdpp*lines%)-1
2360IF xdpp=1 x%=&500*Y% ELSE IF xdpp=2
x%=&280*Y% ELSE x%=&280*(Y% DIV 2)+4*(Y
% MOD 2)
2370!adr=&3000+x%:?len=len%
2380CALL main:PROCprint:PROCls(1)
2390IF xdpp=1 !adr=&3001+x%:?len=len%:C
ALL main
2400PROCprint:PROCls(23)
2410NEXT Y%:ENDPROC
2420:
2430DEF PROCls(L%)
2440VDU 1,27,1,51,1,L%,1,13,1,10
2450ENDPROC
2460:
2470DEF PROCprint
2480VDU 1,27,1,90,1,(8*len%*ydpp) MOD&1
00,1,(8*len%*ydpp) DIV&100
2490FOR I%=0 TO (8*len%-1)
2500FOR J%=1 TO ydpp
2510VDU 1,I%?store%
2520NEXT ,:ENDPROC
2610:
2620DATA L0h,22,L,L;D;@101DgLg,L,LUFCLC
,E
2630DATA 00`,22,L,N1010gNg,S,NgVdZ£½[[T
WO,S,WO]H`@Z5N1,L,JR@R@ZJZ,S,JZMYOVMSJR,
L,L=@=@GLG,S,LGPEQBP?L=,E
2640DATA 0Ld,J2,S,dFb>X4K0>44>0L,S,UFRA
K>DAAF@L,L,dFUF,E
2650DATA 0Lb,22,L,0L01M1,S,M1X5£?bL,L,@
L@>F>,S,F>L@QERL,E
2660DATA 0L^,22,L,0M01^1^?@?@GZGZM,E
2670DATA 00Z,22,L,01@1@CVCVQ@Q@YZYZg0g0
1,E
2680DATA 00d,J2,S,Y7R2K0>44>0L4Z>dKhXdb
ZdR,S,UCQ?K>DAAF@LARDWKZRWUR,L,UCNCNNdNd
1Z1Y7,L,dRUR,E
2690DATA LLh,22,L,0N01@1@CLC,E
2700DATA 8L@,22,L,0M0181,E
2710DATA 00X,D2,L,HCHgXgXE,S,0E2;75D1Q5
V;XE,L,0E0I@I@C,S,@CA@D?G@HC,E
2720DATA 00d,22,L,010g@g@VOgbgPRd1R1DE@
A@101,E
2730DATA 00X,22,L,010g@g@AXAX101,E
2740DATA M0j,22,L,M1G1>P>1010gFgMJ,E
2750DATA 00£,22,L,010gAgOIOg£g£1O1ANA10
1,E
2760DATA KLf,K2,S,K0>44>0L,S,K?DBAG@L,E
2770DATA 00`,22,L,LB@B@1010gLg,S,LgVd½^
`U½KVELB,L,IN@N@ZIZ,S,IZMXOTMPIN,E
2780DATA 00f,J2,S,K0>44>0L4Z>dKhXdbZfLb
>,L,b>f>f0K0,S,K?DBAG@LAQDVKYRVUQVLUGRBK
?,E
2790DATA 00£,22,L,FC@C@1010gOg,S,Og[a£W
^NXI,S,XI[F^A`;`3a1,L,a1P1,S,P1N=KBFC,L,
IM@M@YIY,S,IYMWOSMOIM,E
2800DATA 00½,F2,S,½WZ`SeFh9e2`0W0U2O9HF
DIAG=D<A=?A,S,0A2993F0S3Z9½BZISPFTCWE[H½
K[MW,L,½WMW,L,?A0A,E
2810DATA G0^,2f,L,G1?1?Y0Y0gGg,E
2820DATA I0b,2f,L,0D0g@g@D,S,@DB?I=,S,0
D1<65=1I0,E
2830DATA H0£,2f,L,HD@g0g?1H1,E
2840DATA T0x,2f,L,TQN1=10g?gFCMgTg,E
2850DATA KLf,22,L,KVDg0g=L,E
2860DATA K0f,2f,L,KSBg0gBEB1K1,E
2870DATA 00g,22,L,½g0g0YHY0?01½1½?D?½Y½
g,E
2880DATA 00>,22,L,01>1>?0?01,E
2890DATA 00>,225H,L,01>1>?0?01,L,4E0Y0f
>f>Y:E4E,E
2900DATA 00>,44,L,030?>?>3;0407303,E