I have the feeling that I'm talking to myself, but just in case there is anybody interested here is a slightly modified demo program (it assumes the library will be in the same directory):
Code: Select all
REM Demo of pdflib for bbcsdl, one page generated.
REM Note: The screen output is not perfect WYSIWYG, but more like a draft of the generated pdf file.
REM 1. The fonts are not the same. 2. The pdf grapich is antialiased.
INSTALL @dir$ + "pdflib_rtr"
REM default screen size = 596,842 = A4 paper size
REM default graphics mode = pixels
REM default pdf line style = LineCapButt and LineJoinMiter
REM 1 pixel = 1 pdf unit = A4_paper_width/596 = 0.35278 mm
REM PDF line styles
LineCapRound = &01000000
LineCapSquare = &02000000
LineJoinRound = &04000000
LineJoinBevel = &08000000
REM BBC graphic units
GrUnits = &10000000
DIM r{x%,y%,w%,h%}
SYS "SDL_GetDisplayBounds",0,r{}
IF r.h%>899 THEN
VDU 23,22,596;842;8,16,16,128+8 : REM 1192,1684 (A4 size)
ELSE
VDU 23,22,596;r.h%-60;8,16,16,128+8 : REM reduced height for small screens
ORIGIN 0,(r.h%-842)*2
ENDIF
PROC_PLfont("Courier",12,0)
REM line
style = 0
pencolour=0
penwidth=2
PROC_PLcolour(pencolour,penwidth,style)
PROC_PLline(100,30,400,35)
PROC_PLprint(180,35,"Near horizontal line")
REM outline rectangle
pencolour=0
penwidth=2
fill=0
PROC_PLcolour(pencolour,penwidth,style)
PROC_PLrectangle(100,440,350,100,fill)
REM Filled rectangle
pencolour=&AABBCC
fill=1
PROC_PLcolour(pencolour,penwidth,style)
PROC_PLrectangle(105,445,340,90,fill)
PROC_PLprint(110,485,"Text is always printed on top of graphics.")
PROC_PLprint(110,545,"Filled rectangle inside outline rectangle.")
REM Cubic Bezier curve from four control points
pencolour = &FF : REM blue
penwidth = 5.5
fill=0
PROC_PLcolour(pencolour,penwidth,style)
PROC_PLbezier(10, 10, 100, 100, 200, 300, 400, 300, fill) : REM start,cp1,cp2,end,fill
PROC_PLprint(405,296,"Cubic bezier line")
REM Switching to BBC graphic units mode
style=GrUnits
REM Filled five-pointed star (copy from aagfxdem.bbc)
pencolour = &808080 : REM grey
penwidth = 1.0
fill=1
DIM X(5), Y(5)
X() = 1100,900,1060,1000,940,1100
Y() = 430,430,320,500,320,430
PROC_PLcolour(pencolour,penwidth,style)
PROC_PLpolyline(6, X(), Y(), fill)
PROC_PLprint(870,500,"Polyline filled star")
REM Angled solid ellipse (copy from aagfxdem.bbc)
REM degrees, 0 degree up, clockwise
pencolour = &80A080
angle=30
fill=1
PROC_PLcolour(pencolour,penwidth,style)
PROC_PLellipse(200, 450, 140, 50, angle, fill)
PROC_PLprint(100,590,"Angled solid ellipse")
REM Heart shape from polybezier (copy from aagfxdem.bbc)
x = 600 : y = 250
DIM x(12), y(12)
x() = x, x, x-100, x-100, x-100, x, x, x, x+100, x+100, x+100, x, x
y() = y, y+60, y+60, y, y-60, y-70, y-110, y-70, y-60, y, y+60, y+60, y
pencolour = &400000
penwidth = 1.0
fill=1
PROC_PLcolour(pencolour,penwidth,style)
PROC_PLpolybezier(13, x(), y(), fill)
pencolour = &C0392B
penwidth = 3.0
fill=0
PROC_PLcolour(pencolour,penwidth,style)
PROC_PLpolybezier(13, x(), y(), fill)
PROC_PLprint(410,310,"Heart shape from polybezier")
REM back to pixel mode
style=0
REM Circle
pencolour = 0
penwidth = 2.0
fill=0
PROC_PLcolour(pencolour,penwidth,style)
PROC_PLcircle(450,375,50,fill)
PROC_PLprint(430,372,"Circle")
REM sector diagram, degrees, 0 degree up, clockwise
x=250 : y=350 : radius=60 : fill=1
PROC_PLcolour(&8040FF,penwidth,style)
PROC_PLsector(x,y,radius,0,60,fill) : REM angle=0 extent=60
PROC_PLcolour(&40FF80,penwidth,style)
PROC_PLsector(x,y,radius,60,30,fill) : REM angle=60 extent=30
PROC_PLcolour(&FF8040,penwidth,style)
PROC_PLsector(x,y,radius,90,100,fill)
PROC_PLcolour(&80A0C0,penwidth,style)
PROC_PLsector(x,y,radius,190,150,fill)
PROC_PLcolour(&BBFF00,penwidth,style)
PROC_PLsector(x,y,radius,340,20,fill)
PROC_PLprint(x-radius,y+radius+15,"Filled sector")
PROC_PLprint(x-radius,y+radius+5,"diagram")
REM text waterfall
Y=700
H=8 : Y-=H : PROC_PLfont("Helvetica",H,0) : REM colour=0=black
PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz £€\1234567890 ")
H=10 : Y-=H : PROC_PLfont("Helvetica",H,0)
PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz £€\1234567890 ")
H=12 : Y-=H : PROC_PLfont("Helvetica",H,0)
PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz £€\1234567890 ")
H=14 : Y-=H : PROC_PLfont("Helvetica",H,0)
PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz £€\1234567890 ")
H=16 : Y-=H : PROC_PLfont(@lib$ + "DejaVuSans.ttf",H,0)
PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz £€\1234567890 ")
H=18 : Y-=H : PROC_PLfont(@lib$ + "DejaVuSans.ttf",H,0)
PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz £€\1234567890 ")
H=20 : Y-=H : PROC_PLfont(@lib$ + "DejaVuSans.ttf",H,0)
PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz £€\1234567890 ")
H=22 : Y-=H : PROC_PLfont(@lib$ + "DejaVuSans.ttf",H,0)
PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz £€\1234567890 ")
REM demo of fonts
PROC_PLfont("Helvetica",14,0)
PROC_PLprint(20,820,"Helvetica: ")
PROC_PLfont("Helvetica",14,&FF) : REM colour=blue
PROC_PLprint(0,0,"Normal text ") : REM 0,0 = continue print on line
PROC_PLfont("HelveticaB",14,&8000) : REM colour=green
PROC_PLprint(0,0,"Bold text ")
PROC_PLfont("HelveticaO",14,&FF0000) : REM colour=red
PROC_PLprint(0,0,"Oblique text")
PROC_PLfont("Times",14,0)
PROC_PLprint(20,800,"Times: ")
PROC_PLfont("Times",14,&FF)
PROC_PLprint(0,0,"Normal text ")
PROC_PLfont("TimesB",14,&8000)
PROC_PLprint(0,0,"Bold text ")
PROC_PLfont("TimesI",14,&FF0000)
PROC_PLprint(0,0,"Italic text")
PROC_PLfont("Courier",14,0)
PROC_PLprint(20,780,"Courier: ")
PROC_PLfont("Courier",14,&FF)
PROC_PLprint(0,0,"Normal text ")
PROC_PLfont("CourierB",14,&8000)
PROC_PLprint(0,0,"Bold text ")
PROC_PLfont("CourierO",14,&FF0000)
PROC_PLprint(0,0,"Oblique text")
PROC_PLfont(@lib$ + "FreeSerif.ttf",14,0)
PROC_PLprint(20,760,"FreeSerif: ")
PROC_PLfont(@lib$ + "FreeSerif.ttf",14,&FF)
PROC_PLprint(0,0,"Հայերեն տեքստ ")
PROC_PLfont(@lib$ + "FreeSerif.ttf",14,&8000)
PROC_PLprint(0,0,"Ελληνικό κείμενο ")
PROC_PLfont(@lib$ + "FreeSerif.ttf",14,&FF0000)
PROC_PLprint(0,0,"Русский текст")
PROC_PLfont(@lib$ + "DejaVuSans.ttf",14,0)
PROC_PLprint(20,738,"DejaVuSans: ")
PROC_PLfont(@lib$ + "DejaVuSans.ttf",14,&FF)
PROC_PLprint(0,0,"Հայերեն տեքստ ")
PROC_PLfont(@lib$ + "DejaVuSans.ttf",14,&8000)
PROC_PLprint(0,0,"Ελληνικό κείμενο ")
PROC_PLfont(@lib$ + "DejaVuSans.ttf",14,&FF0000)
PROC_PLprint(0,0,"Русский текст")
PROC_PLfont("Symbol",14,0)
PROC_PLprint(20,716,"Symbol: ")
PROC_PLfont("Symbol",14,&FF)
PROC_PLprint(0,0,"Normal text ")
PROC_PLfont("Zap",14,0)
PROC_PLprint(0,0,"ZapfDingBats: ")
PROC_PLfont("Zap",14,&FF)
PROC_PLprint(0,0,"Normal text ")
MOVE 120,40 : PRINT "Note: Open the PDF file to see the final result !"
ON CLOSE RETURN
IF FN_PLcreatepdf(@usr$+"demo_rtr.pdf")=0 THEN ERROR 0,"can't create pdf_file"
IF FN_PLhardcopy(@usr$+"demo_hardcopy.pdf")=0 THEN ERROR 0,"can't create pdf_file"
ON CLOSE OFF
END
And here is the modified PDFLIB library; I have tried to keep the changes from Svein's original code to a minimum. The only new feature is that
PROC_PLfont can take either a font alias, as before, or a full path to a TTF file. In the latter case the font is embedded in the PDF and Unicode is supported, otherwise only ANSI characters can be used (although the source text is assumed to be UTF-8). There is a maximum of four such TTF fonts, determined in part by not wanting to alter Svein's original PDF object numbers:
Code: Select all
REM Pdflib Version 1.1, Dec.2019, Version 1.2 (RTR) Apr.2020
REM (C) Svein Svensson (sveinioslo@gmail.com) & Richard Russell (www.rtrussell.co.uk)
REM Library to create a PDF file for BBCSDL
REM Hardcoded to one sheet of A4 paper size, or hardcopy of current screen.
REM Modified by Richard Russell to support Unicode text (must have embedded font)
REM aliases to be used in PROC_PLfont():
REM Times,TimesB,TimesI,TimesBI,Helvetica,HelveticaB,HelveticaO,HelveticaBO
REM Courier,CourierB,CourierO,CourierBO,Symbol,Zap
REM Alternatively a path to a TrueType file for Unicode (maximum four such fonts)
REM The PostScript names of 14 Type 1 fonts, known as the standard 14 fonts, are as follows: Times-Roman,
REM Helvetica, Courier, Symbol, Times-Bold, Helvetica-Bold, Courier-Bold, ZapfDingbats, Times-Italic, Helvetica-
REM Oblique, Courier-Oblique, Times-BoldItalic, Helvetica-BoldOblique, Courier-BoldOblique
REM Note: The screen output is not perfect WYSIWYG, but more like a draft of the generated pdf file.
REM 1. The fonts are not the same. 2. The pdf graphics are antialiased.
REM default screen size = 596,842 = A4 paper size
REM default graphics mode = pixels
REM default pdf line style = LineCapButt and LineJoinMiter
REM 1 pixel = 1 pdf unit = A4_paper_width/596 = 0.35278 mm
REM REM PDF line styles
REM LineCapRound = &01000000
REM LineCapSquare = &02000000
REM LineJoinRound = &04000000
REM LineJoinBevel = &08000000
REM REM BBC graphic units
REM GrUnits = &10000000
REM ...........................................................................
REM This software is provided 'as-is', without any express or implied
REM warranty. In no event will the authors be held liable for any damages
REM arising from the use of this software.
REM Permission is granted to anyone to use this software for any purpose,
REM including commercial applications, and to alter it and redistribute it
REM freely, subject to the following restrictions:
REM 1. The origin of this software must not be misrepresented; you must not
REM claim that you wrote the original software. If you use this software
REM in a product, an acknowledgment in the product documentation would be
REM appreciated but is not required.
REM 2. Altered source versions must be plainly marked as such, and must not be
REM misrepresented as being the original software.
REM 3. This notice may not be removed or altered from any source distribution
DEF PROC_PLline(x1,y1,x2,y2) : LOCAL M%,R%
DEF PROC_PLrectangle(x1,y1,x2,y2,R%) : LOCAL M% : M%=1
DEF PROC_PLbezier(x1,y1,x2,y2,x3,y3,x4,y4,R%) : LOCAL M% : M%=2
DEF PROC_PLsector(x,y,r,m,d,R%) : LOCAL M% : M%=3
DEF PROC_PLpolyline(N%,X(),Y(),R%) : LOCAL M% : M%=4
DEF PROC_PLpolybezier(N%,X(),Y(),R%): LOCAL M% : M%=5
DEF PROC_PLellipse(x,y,r1,r2,m,R%): LOCAL M% : M%=6
DEF PROC_PLcircle(x,y,r,R%) : LOCAL M% : M%=7
DEF PROC_PLcolour(C%,W,S%) : LOCAL M% : M%=10
DEF PROC_PLprint(x,y,text$) : LOCAL M% : M%=11 : REM VDU 5 print, x=y=0 = continue print on line
DEF PROC_PLfont(font$,S%,C%) : LOCAL M% : M%=12 : REM (font alias/TTF file,font size,font colour)
DEF FN_PLcreatepdf(file$): LOCAL M% : M%=20 : REM returns zero if the file was not created, for whatever reason.
DEF FN_PLhardcopy(file$) : LOCAL M% : M%=21 : REM same as above
PRIVATE tstream$,gstream$,tf$,flag%,ttf%,ttf$() : DIM ttf$(3)
LOCAL debug% : debug%=0
LOCAL units% : units%=&10000000
GCOL 11
CASE M% OF
WHEN 0 : REM line
IF debug% THEN gstream$+="%line"+CHR$10
IF flag%ANDunits% THEN x1/=2 : x2/=2 : y1/=2 : y2/=2
LINE x1*2,y1*2,x2*2,y2*2
gstream$+=STR$x1+" "+STR$y1+" m "+STR$x2+" "+STR$y2+" l"
WHEN 1 : REM rectangle
IF debug% THEN gstream$+="%rectangle"+CHR$10
IF flag%ANDunits% THEN x1/=2 : x2/=2 : y1/=2 : y2/=2
IF R% THEN RECTANGLE FILL x1*2,y1*2,x2*2,y2*2 ELSE RECTANGLE x1*2,y1*2,x2*2,y2*2
gstream$+=STR$x1+" "+STR$y1+" "+STR$x2+" "+STR$y2+" re"
WHEN 2 : REM cubic bezier, (start,cp1,cp2,end)
IF debug% THEN gstream$+="%bezier"+CHR$10
LOCAL x(),y()
DIM x(3),y(3)
x()=x1,x2,x3,x4
y()=y1,y2,y3,y4
IF flag%ANDunits% THEN x()/=2 : y()/=2
PROC_PLdrawbez(x(),y())
gstream$+=STR$x(0)+" "+STR$y(0)+" m "
gstream$+=STR$x(1)+" "+STR$y(1)+" "+STR$x(2)+" "+STR$y(2)+" "+STR$x(3)+" "+STR$y(3)+" c"
WHEN 3 : REM sector
IF debug% THEN gstream$+="%sector"+CHR$10
LOCAL a,G%,step%
step%=10 : REM anglesteps when plotting circle
G%=LEN(gstream$)
IF flag%ANDunits% THEN x/=2 : y/=2 : r/=2
MOVE x*2,y*2
gstream$+=STR$x+" "+STR$y+" m"
x1=x+SINRAD(m)*r
y1=y+COSRAD(m)*r
DRAW x1*2,y1*2
gstream$+=" "+STR$x1+" "+STR$y1+" l"
FOR a=m TO m+d STEP step%
x1=x+SINRAD(a)*r
y1=y+COSRAD(a)*r
DRAW x1*2,y1*2
gstream$+=" "+STR$x1+" "+STR$y1+" l"
IF LEN(gstream$)-G%>100 THEN gstream$+=CHR$10 : G%=LEN(gstream$)
NEXT
DRAW x*2,y*2
gstream$+=" "+STR$x+" "+STR$y+" l"
WHEN 4 : REM polyline
IF debug% THEN gstream$+="%polyline"+CHR$10
LOCAL xx(),yy(),I%,G%
G%=LEN(gstream$)
DIM xx(N%-1),yy(N%-1)
xx()=X() : yy()=Y()
IF flag%ANDunits% THEN xx()/=2 : yy()/=2
MOVE xx(0)*2,yy(0)*2
gstream$+=STR$xx(0)+" "+STR$yy(0)+" m"
FOR I%=1 TO N%-1
DRAW xx(I%)*2,yy(I%)*2
gstream$+=" "+STR$xx(I%)+" "+STR$yy(I%)+" l"
IF LEN(gstream$)-G%>100 THEN gstream$+=CHR$10 : G%=LEN(gstream$)
NEXT
WHEN 5 : REM cubic polybezier, (start,cp1,cp2,end/start,cp1,cp2,end/start,.......,end)
IF debug% THEN gstream$+="%polybezier"+CHR$10
LOCAL x(),y(),xx(),yy(),I%,G%
G%=LEN(gstream$)
DIM x(3),y(3),xx(N%-1),yy(N%-1)
xx()=X() : yy()=Y()
IF flag%ANDunits% THEN xx()/=2 : yy()/=2
gstream$+=STR$xx(0)+" "+STR$yy(0)+" m"
FOR I%=0 TO N%-4 STEP 3
x(0)=xx(I%) : x(1)=xx(I%+1) : x(2)=xx(I%+2) : x(3)=xx(I%+3)
y(0)=yy(I%) : y(1)=yy(I%+1) : y(2)=yy(I%+2) : y(3)=yy(I%+3)
PROC_PLdrawbez(x(),y())
gstream$+=" "+STR$x(1)+" "+STR$y(1)+" "+STR$x(2)+" "+STR$y(2)+" "+STR$x(3)+" "+STR$y(3)+" c"
IF LEN(gstream$)-G%>100 THEN gstream$+=CHR$10 : G%=LEN(gstream$)
NEXT
IF RIGHT$(gstream$)=CHR$10 THEN gstream$=LEFT$(gstream$)
WHEN 6 : REM angled ellipse
IF debug% THEN gstream$+="%ellipse"+CHR$10
LOCAL x1,x2,x3,x4,y1,y2,y3,y4,x(),y()
IF flag%ANDunits% THEN x/=2 : y/=2 : r1/=2 : r2/=2
DIM x(3),y(3)
m=RAD(m) : r2*=1.333333
x1=x+SIN(m)*r1 : y1=y+COS(m)*r1
x2=x-SIN(m)*r1 : y2=y-COS(m)*r1
m+=PI/2
x3=x1+SIN(m)*r2 : y3=y1+COS(m)*r2
x4=x2+SIN(m)*r2 : y4=y2+COS(m)*r2
x()=x1,x3,x4,x2 : y()=y1,y3,y4,y2
PROC_PLdrawbez(x(),y())
gstream$+=STR$x(0)+" "+STR$y(0)+" m"
gstream$+=" "+STR$x(1)+" "+STR$y(1)+" "+STR$x(2)+" "+STR$y(2)+" "+STR$x(3)+" "+STR$y(3)+" c"
x3=x1-SIN(m)*r2 : y3=y1-COS(m)*r2
x4=x2-SIN(m)*r2 : y4=y2-COS(m)*r2
x()=x2,x4,x3,x1 : y()=y2,y4,y3,y1
PROC_PLdrawbez(x(),y())
gstream$+=" "+STR$x(1)+" "+STR$y(1)+" "+STR$x(2)+" "+STR$y(2)+" "+STR$x(3)+" "+STR$y(3)+" c"
WHEN 7 : REM circle
IF debug% THEN gstream$+="%circle"+CHR$10
LOCAL a,G%,step%
step%=10 : REM anglesteps when plotting circle
G%=LEN(gstream$)
IF flag%ANDunits% THEN x/=2 : y/=2 : r/=2
MOVE x*2,y*2+r*2
gstream$+=" "+STR$x+" "+STR$(y+r)+" m"
FOR a=0 TO 360 STEP step%
x1=x+SINRAD(a)*r
y1=y+COSRAD(a)*r
DRAW x1*2,y1*2
gstream$+=" "+STR$x1+" "+STR$y1+" l"
IF LEN(gstream$)-G%>100 THEN gstream$+=CHR$10 : G%=LEN(gstream$)
NEXT
WHEN 10 : REM colour xxRRGGBB
IF debug% THEN gstream$+="%colour"+CHR$10
LOCAL r&,g&,b&
r&=C%>>16 : g&=C%>>8 : b&=C%
gstream$+=STR$(r&/255)+" "+STR$(g&/255)+" "+STR$(b&/255)+" RG "
gstream$+=STR$(r&/255)+" "+STR$(g&/255)+" "+STR$(b&/255)+" rg "
gstream$+=STR$(S%>>24 AND 3)+" J "+STR$((S%>>24 AND &C)>>2)+" j "
gstream$+=STR$W+" w "+CHR$10
COLOUR 11,r&,g&,b&
VDU 23,23,W|
flag%=S%
ENDPROC
WHEN 11 : REM print UTF-8 text (x=y=0=continue on line)
PRIVATE oldx,oldy
VDU 5 : GCOL 10
IF x=0 AND y=0 THEN
PRINT text$; : tstream$+=tf$+FN_PLencode(tf$,text$)+" Tj"+CHR$10
ELSE
IF flag%ANDunits% THEN x/=2 : y/=2
IF POS
MOVE x*2,y*2+@vdu%!220*2 : PRINT text$;
tstream$+=tf$+STR$(x-oldx)+" "+STR$(y-oldy)+" Td "+FN_PLencode(tf$,text$)+" Tj"+CHR$10
oldx=x : oldy=y
ENDIF
tf$=""
ENDPROC
WHEN 12 : REM font (alias or TTF file)
IF debug% THEN tstream$+="%font"+CHR$10
LOCAL I%,r&,g&,b&,a$,b$
a$=RIGHT$(font$,2)
IF ASC(a$)>96 THEN a$=RIGHT$(a$)
CASE a$ OF
WHEN "B" : b$=",B"
WHEN "I","O" : b$=",I"
WHEN "BI","BO" : b$=",BI"
ENDCASE
IF INSTR(font$, "/") OR INSTR(font$, "\") THEN
a$="""" + font$ + ""","
WHILE ttf$(I%) <> font$ AND ttf$(I%) <> "" : I% += 1 : ENDWHILE
IF ttf% = I% ttf% += 1
ttf$(I%) = font$
font$ = "F" + STR$(I%+1)
ELSE
a$=""""+@lib$+"DejaVuSans.ttf"","
ENDIF
OSCLI "FONT "+a$+STR$(INT(S%/1.333+0.5))+b$
r&=C%>>16 : g&=C%>>8 : b&=C%
COLOUR 10,r&,g&,b&
tf$=STR$(r&/255)+" "+STR$(g&/255)+" "+STR$(b&/255)+" rg "
tf$+="/"+font$+" "+STR$S%+" Tf"+CHR$10
ENDPROC
WHEN 20,21 : REM createpdf + hardcopy
LOCAL F%,I%,J%,xref%(),xc%,len1%,len2%,len3%,len4%,stream$,a$,b$
LOCAL I%%,img%%,imgstart%%,imgw%,imgh%,xscreen%,yscreen%
DIM xref%(99) : xc%=1
F%=OPENOUT(file$)
IF F%=0 THEN =0 : REM can't create file
IF POS
xscreen%=596
yscreen%=842
REM pre
a$="%PDF-1.4"+CHR$10+"%"
a$+=CHR$200 : a$+=CHR$201 : a$+=CHR$202 : a$+=CHR$203 : a$+=CHR$10
xref%(xc%)=LEN(a$) : xc%+=1
a$+="1 0 obj << /Type /Catalog /Outlines 2 0 R /Pages 3 0 R >> endobj"+CHR$10
xref%(xc%)=LEN(a$) : xc%+=1
a$+="2 0 obj << /Type /Outlines /Count 0 >> endobj"+CHR$10
xref%(xc%)=LEN(a$) : xc%+=1
a$+="3 0 obj << /Type /Pages /Kids [4 0 R] /Count 1 >> endobj"+CHR$10
xref%(xc%)=LEN(a$) : xc%+=1
a$+="4 0 obj << /Type /Page /Parent 3 0 R /MediaBox [0 0 "+STR$xscreen%+" "+STR$yscreen%
a$+="] /Contents " : IF M%=21 THEN a$+="7" ELSE a$+="5"
a$+=" 0 R /Resources 6 0 R >> endobj"+CHR$10
xref%(xc%)=LEN(a$) : xc%+=1
IF M%=21 THEN
b$=@tmp$+"hardcopy.bmp"
ORIGIN 0,0
OSCLI "SCREENSAVE "+b$
I%=OPENIN b$
DIM img%% EXT#I%
CLOSE#I%
OSCLI "LOAD "+b$+" "+STR$~img%%
len2%=img%%!2-img%%!10
imgstart%%=img%%+img%%!10
imgw%=img%%!18
imgh%=img%%!22
a$+="5 0 obj << /Type /XObject /Subtype /Image "+CHR$10
a$+="/Width "+STR$imgw%+" /Height "+STR$imgh%
a$+=" /ColorSpace /DeviceRGB /BitsPerComponent 8 /Length "+STR$len2%+" >>"+CHR$10
a$+="stream"+CHR$10
len1%=LEN(a$)
BPUT#F%,a$;
FOR I%%=imgstart%%+len2%-1 TO imgstart%% STEP -1
BPUT#F%,?I%%
NEXT
a$=CHR$10+"endstream endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="6 0 obj << /ProcSet [/PDF /ImageC] /XObject << /Img1 5 0 R >> >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="7 0 obj << /Length >>"+CHR$10
a$+="stream"+CHR$10
b$="q"+CHR$10
b$+="-"+STR$xscreen%+" 0 0 "+STR$yscreen%+" "+STR$xscreen%+" 0 cm"+CHR$10
b$+="/Img1 Do"+CHR$10
b$+="Q"+CHR$10
J%=INSTR(a$,"/Length",0)
a$=LEFT$(a$,J%+6)+" "+STR$LEN(b$)+MID$(a$,J%+7)
a$+=b$+"endstream endobj"+CHR$10
BPUT#F%,a$;
len3%=LEN(a$)
ELSE
stream$=gstream$+"BT"+CHR$10+tstream$+"ET"+CHR$10
len2%=LEN(stream$)
a$+="5 0 obj << /Length "+STR$len2%+" >>"+CHR$10
a$+="stream"+CHR$10
BPUT#F%,a$; : BPUT#F%,stream$;
len1%=LEN(a$)
a$="endstream endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="6 0 obj << /ProcSet [/PDF /Text]"+CHR$10
a$+="/Font << /Times 11 0 R /TimesB 12 0 R /TimesI 13 0 R /TimesBI 14 0 R /Helvetica 15 0 R"+CHR$10
a$+="/HelveticaB 16 0 R /HelveticaO 17 0 R /HelveticaBO 18 0 R /Courier 19 0 R /CourierB 20 0 R"+CHR$10
a$+="/CourierO 21 0 R /CourierBO 22 0 R /Symbol 23 0 R /Zap 24 0 R"+CHR$10
a$+="/F1 25 0 R /F2 26 0 R /F3 27 0 R /F4 28 0 R >> >> endobj"+CHR$10
FOR I% = 0 TO DIM(ttf$(),1)
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
IF ttf$(I%) <> "" THEN
J% = OPENIN(ttf$(I%))
IF J% = 0 ERROR 120, "Couldn't open file " + ttf$(I%)
a$ += STR$(I%+7) + " 0 obj << /Length1 " + STR$EXT#J%
a$ += " /Type /Stream /Length " + STR$EXT#J% + " >> stream" + CHR$10
BPUT#F%,a$; : len1%+=LEN(a$)
REPEAT a$ = GET$#J% BY &1000 : BPUT#F%,a$; : UNTIL LENa$ < &1000
BPUT#F%,10 : len2%+=EXT#J% + 1
CLOSE #J%
a$="endstream endobj"+CHR$10
ELSE
a$ += STR$(I%+7) + " 0 obj null endobj"+CHR$10
ENDIF
NEXT
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="11 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-Roman /Encoding /WinAnsiEncoding >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="12 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-Bold /Encoding /WinAnsiEncoding >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="13 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-Italic /Encoding /WinAnsiEncoding >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="14 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-BoldItalic /Encoding /WinAnsiEncoding >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="15 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica /Encoding /WinAnsiEncoding >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="16 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica-Bold /Encoding /WinAnsiEncoding >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="17 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica-Oblique /Encoding /WinAnsiEncoding >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="18 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica-BoldOblique /Encoding /WinAnsiEncoding >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="19 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier /Encoding /WinAnsiEncoding >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="20 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier-Bold /Encoding /WinAnsiEncoding >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="21 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier-Oblique /Encoding /WinAnsiEncoding >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="22 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier-BoldOblique /Encoding /WinAnsiEncoding >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="23 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Symbol >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="24 0 obj << /Type /Font /Subtype /Type1 /BaseFont /ZapfDingbats >> endobj"+CHR$10
xref%(25)=len1%+len2%+LEN(a$) : xc%+=1
a$+="25 0 obj << /Type /Font /Subtype /Type0 /Encoding /Identity-H /DescendantFonts ["+CHR$10
a$+="<< /CIDSystemInfo << /Ordering (Adobe) /Registry (Adobe) /Supplement 0 >>"+CHR$10
a$+=FN_PLwidths(ttf$(0))
a$+="/Subtype /CIDFontType2 /Type /Font /FontDescriptor << /StemV 777 /ItalicAngle 0 /Type /FontDescriptor"+CHR$10
a$+="/FontName /CIDFont+F1 /Ascent 891 /FontFile2 7 0 R /Flags 4 /FontBBox [-777 -216 777 891]"+CHR$10
a$+="/CapHeight 662 /Descent -216 >> /BaseFont /CIDFont+F1 >>] /BaseFont /CIDFont+F1 >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="26 0 obj << /Type /Font /Subtype /Type0 /Encoding /Identity-H /DescendantFonts ["+CHR$10
a$+="<< /CIDSystemInfo << /Ordering (Adobe) /Registry (Adobe) /Supplement 0 >>"+CHR$10
a$+=FN_PLwidths(ttf$(1))
a$+="/Subtype /CIDFontType2 /Type /Font /FontDescriptor << /StemV 777 /ItalicAngle 0 /Type /FontDescriptor"+CHR$10
a$+="/FontName /CIDFont+F2 /Ascent 891 /FontFile2 8 0 R /Flags 4 /FontBBox [-777 -216 777 891]"+CHR$10
a$+="/CapHeight 662 /Descent -216 >> /BaseFont /CIDFont+F2 >>] /BaseFont /CIDFont+F2 >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="27 0 obj << /Type /Font /Subtype /Type0 /Encoding /Identity-H /DescendantFonts ["+CHR$10
a$+="<< /CIDSystemInfo << /Ordering (Adobe) /Registry (Adobe) /Supplement 0 >>"+CHR$10
a$+=FN_PLwidths(ttf$(2))
a$+="/Subtype /CIDFontType2 /Type /Font /FontDescriptor << /StemV 777 /ItalicAngle 0 /Type /FontDescriptor"+CHR$10
a$+="/FontName /CIDFont+F3 /Ascent 891 /FontFile2 9 0 R /Flags 4 /FontBBox [-777 -216 777 891]"+CHR$10
a$+="/CapHeight 662 /Descent -216 >> /BaseFont /CIDFont+F3 >>] /BaseFont /CIDFont+F3 >> endobj"+CHR$10
xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
a$+="28 0 obj << /Type /Font /Subtype /Type0 /Encoding /Identity-H /DescendantFonts ["+CHR$10
a$+="<< /CIDSystemInfo << /Ordering (Adobe) /Registry (Adobe) /Supplement 0 >>"+CHR$10
a$+=FN_PLwidths(ttf$(3))
a$+="/Subtype /CIDFontType2 /Type /Font /FontDescriptor << /StemV 777 /ItalicAngle 0 /Type /FontDescriptor"+CHR$10
a$+="/FontName /CIDFont+F4 /Ascent 891 /FontFile2 10 0 R /Flags 4 /FontBBox [-777 -216 777 891]"+CHR$10
a$+="/CapHeight 662 /Descent -216 >> /BaseFont /CIDFont+F4 >>] /BaseFont /CIDFont+F4 >> endobj"+CHR$10
BPUT#F%,a$;
len4%=LEN(a$)
ENDIF
REM post
a$="xref"+CHR$10
a$+="0 "+STR$xc%+CHR$10
a$+="0000000000 65535 f"+CHR$10
FOR I%=1 TO xc%-1
a$+=RIGHT$("0000000000"+STR$(xref%(I%)),10)+" 00000 n"+CHR$10
NEXT
a$+="trailer"+CHR$10
a$+="<< /Size "+STR$xc%+" /Root 1 0 R >>"+CHR$10
a$+="startxref"+CHR$10
a$+=STR$(len1%+len2%+len3%+len4%)+CHR$10+"%%EOF"
BPUT#F%,a$
CLOSE#F%
tstream$ = "" : gstream$ = "" : ttf$() = "" : ttf% = 0
=1 : REM file created ok
ENDCASE
IF R% THEN gstream$+=" f"+CHR$10 ELSE gstream$+=" S"+CHR$10
ENDPROC
REM for internal use only
DEF PROC_PLdrawbez(bx(),by()) : bx()*=2 : by()*=2
LOCAL P,ps,x1,x2,x3,x4,x5,y1,y2,y3,y4,y5,a
ps=40 : MOVE bx(0),by(0)
FOR P=1 TO ps
a=P/ps
x1=bx(0)+(bx(1)-bx(0))*a : y1=by(0)+(by(1)-by(0))*a
x2=bx(1)+(bx(2)-bx(1))*a : y2=by(1)+(by(2)-by(1))*a
x3=bx(2)+(bx(3)-bx(2))*a : y3=by(2)+(by(3)-by(2))*a
x4=x1+(x2-x1)*a : y4=y1+(y2-y1)*a
x5=x2+(x3-x2)*a : y5=y2+(y3-y2)*a
DRAW x4+(x5-x4)*a,y4+(y5-y4)*a
NEXT
bx()/=2 : by()/=2
ENDPROC
REM Encode UTF-8 text as ANSI (for built-in fonts) or UCS-2 (for TTF fonts)
DEF FN_PLencode(f$,t$)
LOCAL C%, I%, f%%, u$
IF POS REM SDL thread sync
IF @platform% AND &40 f%% = ]@vdu.hf% ELSE f%% = !@vdu.hf%
IF INSTR(f$, "/F") THEN
u$ = "<"
WHILE I% < LEN(t$)
I% += 1
C% = ASCMID$(t$,I%)
IF C% >= &E0 THEN
C% = (C% << 12) AND &F000
C% OR= (ASCMID$(t$,I%+1) << 6) AND &0FC0
C% OR= ASCMID$(t$,I%+2) AND &003F
I% += 2
ELSEIF C% >= &C0 THEN;
C% = (C% << 6) AND &07C0
C% OR= ASCMID$(t$,I%+1) AND &003F
I% += 1
ENDIF
SYS "FT_Get_Char_Index", f%%, C% TO C%
u$ += RIGHT$("000" + STR$~C%, 4)
ENDWHILE
u$ += ">"
ELSE
REPEAT
I%=INSTR(t$,"\",I%+1)
IF I% THEN t$=LEFT$(t$,I%)+"134"+MID$(t$,I%+1)
UNTIL I%=0
u$ = "("
WHILE I% < LEN(t$)
I% += 1
C% = ASCMID$(t$,I%)
IF C% >= &E0 THEN
C% = (C% << 12) AND &F000
C% OR= (ASCMID$(t$,I%+1) << 6) AND &0FC0
C% OR= ASCMID$(t$,I%+2) AND &003F
I% += 2
ELSEIF C% >= &C0 THEN;
C% = (C% << 6) AND &07C0
C% OR= ASCMID$(t$,I%+1) AND &003F
I% += 1
ENDIF
IF C% > &FF THEN
CASE C% OF
WHEN &20AC: C% = &80 : REM Euro
WHEN &201A: C% = &82
WHEN &0192: C% = &83
WHEN &201E: C% = &84
WHEN &2026: C% = &85
WHEN &2020: C% = &86
WHEN &2021: C% = &87
WHEN &02C6: C% = &88
WHEN &2030: C% = &89
WHEN &0160: C% = &8A
WHEN &2039: C% = &8B
WHEN &0152: C% = &8C
WHEN &017D: C% = &8E
WHEN &2018: C% = &91
WHEN &2019: C% = &92
WHEN &201C: C% = &93
WHEN &201D: C% = &94
WHEN &2022: C% = &95
WHEN &2013: C% = &96
WHEN &2014: C% = &97
WHEN &02DC: C% = &98
WHEN &2122: C% = &99
WHEN &0161: C% = &9A
WHEN &203A: C% = &9B
WHEN &0153: C% = &9C
WHEN &017E: C% = &9E
WHEN &0178: C% = &9F
ENDCASE
ENDIF
u$ += CHR$C%
ENDWHILE
u$ += ")"
ENDIF
= u$
REM Build table of glyph widths (this can be quite slow!)
DEF FN_PLwidths(f$) : IF f$ = "" THEN = ""
LOCAL G%, R%, f%%, a$ : a$ = "/W [ 1 ["
OSCLI "font """ + f$ + """"
IF @platform% AND &40 f%% = ]@vdu.hf% ELSE f%% = !@vdu.hf%
REPEAT
G% += 1
SYS "FT_Load_Glyph", f%%, G%, 1 TO R%
IF R% EXIT REPEAT
IF @platform% AND &40 THEN
a$ += STR$(1000 * !(](f%%+120) + 64) DIV (f%%!104 AND &FFFF)) + " "
ELSE
a$ += STR$(1000 * !(f%%!84 + 40) DIV (f%%!68 AND &FFFF)) + " "
ENDIF
UNTIL FALSE
= LEFT$(a$) + "]]" + CHR$10
Further enhancements that I would like to see are support for multiple pages (so it could be used to implement
File... Print in SDLIDE) and the ability to include multiple bitmap images on the same page (as the *HARDCOPY command in BB4W can). Perhaps Svein might consider adding them?
