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 (10000+ASC(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)) 2590PLOT 133,fy%,fx% 2600NEXT:ENDPROC 2610: 10032DATA 00N,,E 10049DATA 00A,;?,L,<dAdA=9=9X0X0],S,0]8` <d,E 10050DATA 00J,3?,L,:DJDJ=0=,S,0=2F7K<OBV BZ?^;^8Z8W,L,8W0W,S,0W4b=eFbJXFO@J:D,E 10051DATA 00K,:?,L,0I7I,S,7I8D=BBFBK>N:N ,L,:N:S,S,:S<SAVA]9^7X,L,7X0X,S,0X4b=eFb IXER,S,ERJLJED>=<6=1B0I,E 10052DATA 00L,5I,L,@F0F0L?dGdGLLLLFGFG=@ =@F,L,@L6L@½@L,E 10053DATA 00L,:?,L,0G8G,S,8G9D>BCFCN>Q9N ,L,9N1N4dJdJ]:]9U,S,9U@WHSLKH@=<5>0G,E 10054DATA 00K,:?,S,8T?WGTKJF?=<5?1G0P2]7 c>eFcJ[,L,J[C[,S,C[B]>`8[8T,S,=B8E8M>QCL BE=B,E 10055DATA 00K,:?,S,5=;OC],L,C]0]0dKdK^,S ,K^AN==,L,==5=,E 10056DATA 00L,>?,S,6R1Z5b>eGbKZFR,S,FRLI G?><5?0I6R,S,>OCLCF>C9F9L>O,S,>`C]CW>T9W 9]>`,E 10057DATA 00K,Ab,S,CM<J4M0W5b>eFbJZKQIDD >=<5>1F,L,1F8F,S,8F9D=BCFCM,S,>`C½CT=P8U 9½>`,E 10097DATA 00L,5?,S,C@<<4=0D4L>OAPCS>U9Q, L,9Q1Q,S,1Q5X>[GYJR,L,JRJA,S,JAK?L>,L,L> L=D=,S,D=C>C@,S,CKAD<B8E:I@JCK,E 10098DATA 00M,5?,L,8@8=0=0e8e8W,S,8W@[HX LPLGH?@<8@,S,DGAC<C9G,S,9G8K9P,S,9P<TATD P,S,DPEKDG,E 10099DATA 00L,<?,S,LGH??<5?1G1P5X?[HXLP, L,LPDP,S,DPAT<T9P,S,9P8K9G,S,9G<CACDG,L, DGLG,E 10100DATA 00M,<?,L,E@E=M=MeEeEW,S,EW=[5X 1P1G5?=<E@,S,9G<CACDG,S,DGEKDP,S,DPAT<T9 P,S,9P8K9G,E 10101DATA 00L,>?,L,DFLF,S,LFG?><4@0K4W>[ HWLJ,L,LJ8J,S,8J9E>BDF,L,DO8O,S,8O;TATDO ,E 10102DATA 00@,5?,L,<^<Z@Z@U<U<=4=4U0U0Z4 Z4`,S,4`6d;e,L,;e@e@`>`,S,>`=`<^,E 10103DATA 00M,>?,L,EWE[M[M<,S,M<K6F2?182 351:,L,1:9:,S,9:=6C7E<,L,E<E@,S,E@=<5?1G 1P5X=[EW,S,9G<CACDG,S,DGEKDPS,S,DPAT<T9P ,S,9P8K9G,E 10104DATA 00K,5?,L,8O8=0=0e8e8W,S,8W<ZB[ HYKS,L,KSK=C=CP,S,CPAT:S8O,E 10105DATA 00<,5?5b,L,4=4Y<Y<=4=,L,4^4e<e <^4^,E 10106DATA 00<,5?5b,L,484Y<Y<7,S,<7:251,L ,51010727,S,273748,L,4^4e<e<^4^,E 10107DATA 00K,5?,L,8F8=0=0e8e8OB[J[@OK=B =;I8F,E 10108DATA 008,5?,L,0=0e8e8=0=,E 10109DATA 00Z,5?,L,8O8=0=0[8[8W,S,8W<ZB[ HW,S,HWKZQ[WYZS,L,ZSZ=S=SP,S,SPQTLSJO,L, JOJ=A=AP,S,AP?T:S8O,E 10110DATA 00K,5?,L,8O8=0=0[8[8W,S,8W<ZB[ HYKS,L,KSK=C=CP,S,CPAT:S8O,E 10111DATA ?0N,??,S,?<6>1F1Q6Y?[,S,?B:D8I 8N:S?U,E 10112DATA 00M,5?,L,8W8[0[01818@,S,8@@<H? LGLPHX@[8W,S,DPAT<T9P,S,9P8L9G,S,9G<CACD G,S,DGELDP,E 10113DATA 00M,<?,L,EWE[M[M1E1E@,S,E@=<5? 1G1P5X=[EW,S,9P<TATDP,S,DPELDG,S,DGAC<C9 G,S,9G8L9P,E 10114DATA 00A,5?,L,8N8=0=0[8[8U,S,8U<ZA½ ,L,A½AS,S,AS<S8N,E 10115DATA 00K,??,S,BQ@T=U9S9Q=OHKKFIAD=> <7=3@0F,L,0F7F,S,7F:C?BBCCF>H5K1Q4X=[FXJ Q,L,JQBQ,E 10116DATA 00@,:?,S,@=;<6=4A,L,4A4U0U0Z4Z 4b<b<Z@Z@U<U<D,S,<D<C=B,L,=B@B@=,E 10117DATA 00K,FY,L,CIC[K[K=C=CA,S,CA?>9= 3?0E,L,0E0[8[8H,S,8H:DAECI,E 10118DATA >0L,>?,L,>=:=0[8[>E,E 10119DATA E0Z,EX,L,ERA=9=0[8[=FA[E[,E 10120DATA >LL,5?,L,>F9=0=:L:L,E 10121DATA 00L,>?,S,4788:::=,L,:=0[8[>ED[ L[@7,S,@7<341,L,4147,E 10122DATA 00I,5?,L,I=0=0D?T1T1[H[HT9DIDI =,E