10REM Program Spline2 20REM Version B1.1 30REM Author David James 40REM BEEBUG June 1990 50REM Program Subject to copyright 60: 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 141VDU 1,27,1,108,1,margin% 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 1130REPEAT PRINT'" Letters filled (Y/N) :"; 1140INPUT "" YN$:UNTIL INSTR("YyNn",YN$ ) 1141INPUT'"Left margin :"margin% 1150fill%=(YN$="Y" OR YN$="y"):xdpp=4 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" 1430IF fill% PROCfill 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 2530: 2540DEF PROCfill 2550S$=fill$:FOR F%=1 TO LENS$ STEP 2 2560fx%=FNx(FNt(F%)) 2570fy%=FNy(FNt(F%+1)) 2580REM Replace next line with call to your usual routine. 2590PLOT 133,fy%,fx% 2600NEXT: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