10 REM Program Spline2
   20 REM Version B1.1
   30 REM Author  David James
   40 REM BEEBUG  June 1990
   50 REM Program Subject to copyright
   60 :
  100 code%=C%:store%=S%:main=code%+&9C:adr=&70:len=&76:dots=&77
  110 DIM X%(25),Y%(25),apeX%(25),apeY%(25)
  120 MODE 7:PROCheader:PROCgetparams
  130 MODE 0:HIMEM=&2C00
  140 VDU 2:*FX3,64
  141 VDU 1,27,1,108,1,margin%
  150 FOR loop%=1 TO LEN(M$):CLS
  160 let$=MID$(M$,loop%,1):PROCdrawletter(let$)
  170 IF let$<>" " PROCdumpletter
  180 NEXT:VDU 3,7:END
  190 :
 1000 DEF PROCheader
 1010 FOR I%=0 TO 1
 1020 VDU 157,129,141:PRINT"  SPLINETEXT V1.1 by David James"
 1030 NEXT:VDU 31,0,24,157,129:PRINTSPC10"(C) BEEBUG 1990";:VDU 28,0,23,39,2
 1040 ENDPROC
 1050 :
 1060 DEF PROCgetparams
 1070 REPEAT PRINT'" Your message ";
 1080 INPUT LINE M$:UNTIL LEN(M$)>0
 1090 REPEAT PRINT'" Width of letters (inches) :";
 1100 INPUT "" xsize:UNTIL xsize>0
 1110 REPEAT PRINT'" Height of letters (inches) :";
 1120 INPUT "" ysize:UNTIL ysize>0
 1130 REPEAT PRINT'" Letters filled (Y/N) :";
 1140 INPUT "" YN$:UNTIL INSTR("YyNn",YN$)
 1141 INPUT'"Left margin  :"margin%
 1150 fill%=(YN$="Y" OR YN$="y"):xdpp=4
 1160 IF xsize>7.1111 xsize=7.1111
 1170 IF xsize<=(32/9) THEN xdpp=2
 1180 IF xsize<=(16/9) THEN xdpp=1
 1190 ydpp=3:IF ysize>8 ysize=8
 1200 IF ysize<=(16/3) THEN ydpp=2
 1210 IF ysize<=(8/3) THEN ydpp=1
 1220 ysc=(ysize/ydpp)*1279*3/(8*28)
 1230 ENDPROC
 1240 :
 1250 DEF PROCscalex
 1260 xs=xsize:realx=xs*xmax/29
 1270 adjx=INT(0.5+realx*9)/9
 1280 xs=(adjx*xs)/realx
 1290 xsc=(1024*xs*9)/(16*xdpp*29)
 1300 xsc=(xmax*xsc-4)/xmax
 1310 ENDPROC
 1320 :
 1330 DEF PROCdrawletter(letter$)
 1340 IF letter$=" " THEN PROCls(108*xsize):ENDPROC
 1350 RESTORE (10000+ASC(letter$))
 1360 READ S$,fill$
 1370 XS=FNt(1):YS=FNt(2):xmax=FNt(3)
 1380 PROCscalex
 1390 REPEAT READ N$
 1400 IF N$<>"E" READ S$:L%=(LENS$)/2
 1410 IF N$="S" PROCspline ELSE IF N$="L" PROCline
 1420 UNTIL N$="E"
 1430 IF fill% PROCfill
 1440 ENDPROC
 1450 :
 1460 DEF PROCline
 1470 PROCline1(0,1,0,1)
 1480 IF XS<>0 PROCline1(2*XS,-1,0,1)
 1490 IF YS<>0 PROCline1(0,1,2*YS,-1)
 1500 IF XS<>0 AND YS<>0 PROCline1(2*XS,-1,2*YS,-1)
 1510 ENDPROC
 1520 :
 1530 DEF PROCline1(xc,xm,yc,ym)
 1540 x=FNd(1,xc,xm):y=FNd(2,yc,ym)
 1550 MOVE FNy(y),FNx(x)
 1560 FOR N%=1 TO L%-1
 1570 x=FNd(1+2*N%,xc,xm)
 1580 y=FNd(2*(N%+1),yc,ym)
 1590 DRAW FNy(y),FNx(x)
 1600 NEXT N%
 1610 ENDPROC
 1620 :
 1630 DEF PROCspline
 1640 PROCspline1(0,1,0,1)
 1650 IF XS<>0 PROCspline1(2*XS,-1,0,1)
 1660 IF YS<>0 PROCspline1(0,1,2*YS,-1)
 1670 IF XS<>0 AND YS<>0 PROCspline1(2*XS,-1,2*YS,-1)
 1680 ENDPROC
 1690 :
 1700 DEF PROCspline1(xc,xm,yc,ym)
 1710 FOR N%=0 TO L%-1
 1720 x=FNd(1+2*N%,xc,xm):Y%(N%+1)=FNx(x)
 1730 y=FNd(2*(N%+1),yc,ym):X%(N%+1)=FNy(y)
 1740 NEXT N%
 1750 FOR J%=1 TO L%
 1760 apeX%(J%)=((X%(J%)*4)-X%(J%+1)-X%(J%-1))/2
 1770 apeY%(J%)=((Y%(J%)*4)-Y%(J%+1)-Y%(J%-1))/2
 1780 NEXT
 1790 MOVE X%(1),Y%(1)
 1800 FOR J%=1 TO L%-2
 1810 FOR n=0 TO 0.5 STEP .02
 1820 N=1-n:m=n*2:M=1-m
 1830 IF J%=1 PROCsimplebow(J%)
 1840 IF J%>1 PROChalfbow
 1850 NEXT:NEXT
 1860 FOR n=0.5 TO 1 STEP .02
 1870 PROCsimplebow(J%-1)
 1880 NEXT n
 1890 DRAW FNrx(X%(J%+1)),FNry(Y%(J%+1))
 1900 ENDPROC
 1910 :
 1920 DEF PROCsimplebow(J%)
 1930 DRAW FNrx(FNbowX(J%,n)),FNry(FNbowY(J%,n))
 1940 ENDPROC
 1950 :
 1960 DEF PROChalfbow
 1970 LOCAL BowX,BowX2,BowY,BowY2
 1980 BowX=m*FNbowX(J%,n)
 1990 BowX2=M*FNbowX(J%-1,n+.5)
 2000 BowY=m*FNbowY(J%,n)
 2010 BowY2=M*FNbowY(J%-1,n+.5)
 2020 DRAW FNrx(BowX+BowX2),FNry(BowY+BowY2)
 2030 ENDPROC
 2040 :
 2050 DEF FNbowX(J%,n)
 2060 LOCAL X%,X2%,apeX%
 2070 X%=X%(J%):X2%=X%(J%+2)
 2080 apeX1%=apeX%(J%+1)
 2090 =((X%+(n*(apeX1%-X%)))*(1-n))+((apeX1%+(n*(X2%-apeX1%)))*n)
 2100 :
 2110 DEF FNbowY(J%,n)
 2120 LOCAL Y%,Y2%,apeY%
 2130 Y%=Y%(J%):Y2%=Y%(J%+2)
 2140 apeY1%=apeY%(J%+1)
 2150 =((Y%+(n*(apeY1%-Y%)))*(1-n))+((apeY1%+(n*(Y2%-apeY1%)))*n)
 2160 :
 2170 DEF FNx(pos)=1023-xsc*pos
 2180 DEF FNy(pos)=ysc*pos
 2190 DEF FNrx(x):IF x<0 THEN =0
 2200 IF x>1279 THEN =1279 ELSE =x
 2210 DEF FNry(y):IF y<0 THEN =0
 2220 IF y>1023 THEN =1023 ELSE =y
 2230 :
 2240 DEF FNt(P%)=(ASC(MID$(S$,P%,1))-48)/2
 2250 DEF FNd(P%,c,m)=c+m*FNt(P%)
 2260 :
 2270 DEF PROCdumpletter
 2280 ?dots=16/xdpp
 2290 lines%=INT(.99999999+(4+xmax*xsc)/64)
 2300 len%=INT(.99999999+28*ysc/16)
 2310 PROCdump:PROCls(20*xsize)
 2320 ENDPROC
 2330 :
 2340 DEF PROCdump
 2350 FOR Y%=0 TO (xdpp*lines%)-1
 2360 IF 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%
 2380 CALL main:PROCprint:PROCls(1)
 2390 IF xdpp=1 !adr=&3001+x%:?len=len%:CALL main
 2400 PROCprint:PROCls(23)
 2410 NEXT Y%:ENDPROC
 2420 :
 2430 DEF PROCls(L%)
 2440 VDU 1,27,1,51,1,L%,1,13,1,10
 2450 ENDPROC
 2460 :
 2470 DEF PROCprint
 2480 VDU 1,27,1,90,1,(8*len%*ydpp) MOD&100,1,(8*len%*ydpp) DIV&100
 2490 FOR I%=0 TO (8*len%-1)
 2500 FOR J%=1 TO ydpp
 2510 VDU 1,I%?store%
 2520 NEXT ,:ENDPROC
 2530 :
 2540 DEF PROCfill
 2550 S$=fill$:FOR F%=1 TO LENS$ STEP 2
 2560 fx%=FNx(FNt(F%))
 2570 fy%=FNy(FNt(F%+1))
 2590 PLOT 133,fy%,fx%
 2600 NEXT:ENDPROC
 2610 :
10032 DATA 00N,,E
10049 DATA 00A,;?,L,<dAdA=9=9X0X0],S,0]8_<d,E
10050 DATA 00J,3?,L,:DJDJ=0=,S,0=2F7K<OBVBZ?^;^8Z8W,L,8W0W,S,0W4b=eFbJXFO@J:D,E
10051 DATA 00K,:?,L,0I7I,S,7I8D=BBFBK>N:N,L,:N:S,S,:S<SAVA]9^7X,L,7X0X,S,0X4b=eFbIXER,S,ERJLJED>=<6=1B0I,E
10052 DATA 00L,5I,L,@F0F0L?dGdGLLLLFGFG=@=@F,L,@L6L@\@L,E
10053 DATA 00L,:?,L,0G8G,S,8G9D>BCFCN>Q9N,L,9N1N4dJdJ]:]9U,S,9U@WHSLKH@=<5>0G,E
10054 DATA 00K,:?,S,8T?WGTKJF?=<5?1G0P2]7c>eFcJ[,L,J[C[,S,C[B]>_8[8T,S,=B8E8M>QCLBE=B,E
10055 DATA 00K,:?,S,5=;OC],L,C]0]0dKdK^,S,K^AN==,L,==5=,E
10056 DATA 00L,>?,S,6R1Z5b>eGbKZFR,S,FRLIG?><5?0I6R,S,>OCLCF>C9F9L>O,S,>_C]CW>T9W9]>_,E
10057 DATA 00K,Ab,S,CM<J4M0W5b>eFbJZKQIDD>=<5>1F,L,1F8F,S,8F9D=BCFCM,S,>_C\CT=P8U9\>_,E
10097 DATA 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
10098 DATA 00M,5?,L,8@8=0=0e8e8W,S,8W@[HXLPLGH?@<8@,S,DGAC<C9G,S,9G8K9P,S,9P<TATDP,S,DPEKDG,E
10099 DATA 00L,<?,S,LGH??<5?1G1P5X?[HXLP,L,LPDP,S,DPAT<T9P,S,9P8K9G,S,9G<CACDG,L,DGLG,E
10100 DATA 00M,<?,L,E@E=M=MeEeEW,S,EW=[5X1P1G5?=<E@,S,9G<CACDG,S,DGEKDP,S,DPAT<T9P,S,9P8K9G,E
10101 DATA 00L,>?,L,DFLF,S,LFG?><4@0K4W>[HWLJ,L,LJ8J,S,8J9E>BDF,L,DO8O,S,8O;TATDO,E
10102 DATA 00@,5?,L,<^<Z@Z@U<U<=4=4U0U0Z4Z4_,S,4_6d;e,L,;e@e@_>_,S,>_=_<^,E
10103 DATA 00M,>?,L,EWE[M[M<,S,M<K6F2?182351:,L,1:9:,S,9:=6C7E<,L,E<E@,S,E@=<5?1G1P5X=[EW,S,9G<CACDG,S,DGEKDPS,S,DPAT<T9P,S,9P8K9G,E
10104 DATA 00K,5?,L,8O8=0=0e8e8W,S,8W<ZB[HYKS,L,KSK=C=CP,S,CPAT:S8O,E
10105 DATA 00<,5?5b,L,4=4Y<Y<=4=,L,4^4e<e<^4^,E
10106 DATA 00<,5?5b,L,484Y<Y<7,S,<7:251,L,51010727,S,273748,L,4^4e<e<^4^,E
10107 DATA 00K,5?,L,8F8=0=0e8e8OB[J[@OK=B=;I8F,E
10108 DATA 008,5?,L,0=0e8e8=0=,E
10109 DATA 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
10110 DATA 00K,5?,L,8O8=0=0[8[8W,S,8W<ZB[HYKS,L,KSK=C=CP,S,CPAT:S8O,E
10111 DATA ?0N,??,S,?<6>1F1Q6Y?[,S,?B:D8I8N:S?U,E
10112 DATA 00M,5?,L,8W8[0[01818@,S,8@@<H?LGLPHX@[8W,S,DPAT<T9P,S,9P8L9G,S,9G<CACDG,S,DGELDP,E
10113 DATA 00M,<?,L,EWE[M[M1E1E@,S,E@=<5?1G1P5X=[EW,S,9P<TATDP,S,DPELDG,S,DGAC<C9G,S,9G8L9P,E
10114 DATA 00A,5?,L,8N8=0=0[8[8U,S,8U<ZA\,L,A\AS,S,AS<S8N,E
10115 DATA 00K,??,S,BQ@T=U9S9Q=OHKKFIAD=><7=3@0F,L,0F7F,S,7F:C?BBCCF>H5K1Q4X=[FXJQ,L,JQBQ,E
10116 DATA 00@,:?,S,@=;<6=4A,L,4A4U0U0Z4Z4b<b<Z@Z@U<U<D,S,<D<C=B,L,=B@B@=,E
10117 DATA 00K,FY,L,CIC[K[K=C=CA,S,CA?>9=3?0E,L,0E0[8[8H,S,8H:DAECI,E
10118 DATA >0L,>?,L,>=:=0[8[>E,E
10119 DATA E0Z,EX,L,ERA=9=0[8[=FA[E[,E
10120 DATA >LL,5?,L,>F9=0=:L:L,E
10121 DATA 00L,>?,S,4788:::=,L,:=0[8[>ED[L[@7,S,@7<341,L,4147,E
10122 DATA 00I,5?,L,I=0=0D?T1T1[H[HT9DIDI=,E