pdflib: BBCSDL hard copy output

Discussions related to the code libraries supplied with BB4W & BBCSDL
Post Reply
svein
Posts: 34
Joined: Tue 03 Apr 2018, 19:34

pdflib: BBCSDL hard copy output

Post by svein » Sun 01 Dec 2019, 19:51

This is a library to generate one pdf page, example code included.
The pdf file generated opens correctly in window,linux,android and iphone.
This example creates 2 files in your @usr% folder, demo.pdf and demo_hardcopy.pdf.
Please let me know if something is not working for you or if you have any questions.

Svein

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.

      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

      VDU 23,22,596;842;8,16,16,128+8 : REM 1192,1684   (A4 size)
      PROC_PLfont("Courier",12,0)

      REM if 596,842 is too tall for your screen
      DIM r{x%,y%,w%,h%}
      SYS "SDL_GetDisplayBounds",0,r{}
      IF r.h%<860 THEN @zoom%=32768/(860/r.h%)
      REM ......................................

      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("Times",H,0) : REM colour=0=black
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")
      H=10 : Y-=H : PROC_PLfont("Times",H,0)
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")
      H=12 : Y-=H : PROC_PLfont("Times",H,0)
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")
      H=14 : Y-=H : PROC_PLfont("Times",H,0)
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")
      H=16 : Y-=H : PROC_PLfont("Times",H,0)
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")
      H=18 : Y-=H : PROC_PLfont("Times",H,0)
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")
      H=20 : Y-=H : PROC_PLfont("Times",H,0)
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")
      H=22 : Y-=H : PROC_PLfont("Times",H,0)
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")

      REM demo of fonts
      PROC_PLfont("Helvetica",14,0)
      PROC_PLprint(20,800,"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,&FF00) : 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,780,"Times: ")
      PROC_PLfont("Times",14,&FF)
      PROC_PLprint(0,0,"Normal text ")
      PROC_PLfont("TimesB",14,&FF00)
      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,760,"Courier: ")
      PROC_PLfont("Courier",14,&FF)
      PROC_PLprint(0,0,"Normal text ")
      PROC_PLfont("CourierB",14,&FF00)
      PROC_PLprint(0,0,"Bold text ")
      PROC_PLfont("CourierO",14,&FF0000)
      PROC_PLprint(0,0,"Oblique text")

      PROC_PLfont("Symbol",14,0)
      PROC_PLprint(20,740,"Symbol: ")
      PROC_PLfont("Symbol",14,&FF)
      PROC_PLprint(0,0,"Normal text ")

      PROC_PLfont("Zap",14,0)
      PROC_PLprint(20,720,"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 !"

      IF FN_PLcreatepdf(@usr$+"demo.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"
      END

      REM --------------------------------------------------------------------------------------------------------------

      REM Library to create a PDF file for BBCSDL
      REM Hardcoded to one sheet of A4 paper size, or hardcopy of current screen.
      REM Pdflib Version 1.0, Nov.2019
      REM (C) Svein Svensson, (sveinioslo@gmail.com)
      REM May be freely distributed amongst BBCbasic users.

      REM PROC_PLprint(x,y,"text") VDU 5 print, x=0 and y=0 = continue print on line
      REM PROC_PLfont(font alias,font size,font colour)

      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 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

      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
      DEF PROC_PLfont(font$,S%,C%) : LOCAL M% : M%=12
      DEF FN_PLcreatepdf(file$): LOCAL M% : M%=20
      DEF FN_PLhardcopy(file$) : LOCAL M% : M%=21
      PRIVATE tstream$,gstream$,tf$,flag%
      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   x=y=0=continue on line
          PRIVATE oldx,oldy
          VDU 5 : GCOL 10
          IF x=0 AND y=0 THEN
            PRINT text$; : tstream$+=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 ("+text$+") Tj"+CHR$10
            oldx=x : oldy=y
          ENDIF
          tf$=""
          ENDPROC
        WHEN 12 : REM font   (alias)
          IF debug% THEN tstream$+="%font"+CHR$10
          LOCAL 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
          REM a$=@lib$+"DejaVuSansMono.ttf,"
          a$=@lib$+"DejaVuSans.ttf,"
          OSCLI "FONT "+a$+STR$(INT(S%/1.25))+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%=@vdu%!208
          yscreen%=@vdu%!212
          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"
            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$xscreen%+" /Height "+STR$yscreen%
            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 >> >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="11 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-Roman >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="12 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-Bold >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="13 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-Italic >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="14 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-BoldItalic >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="15 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="16 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica-Bold >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="17 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica-Oblique >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="18 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica-BoldOblique >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="19 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="20 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier-Bold >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="21 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier-Oblique >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="22 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier-BoldOblique >> 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
            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%
          =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


RichardRussell
Posts: 90
Joined: Tue 15 Oct 2019, 09:10

Re: pdflib: BBCSDL hard copy output

Post by RichardRussell » Mon 02 Dec 2019, 02:28

svein wrote:
Sun 01 Dec 2019, 19:51
Please let me know if something is not working for you or if you have any questions.
If I copy-and-paste the entire code into SDLIDE and run it, an empty window opens for a fraction of a second and then immediately closes again. The PDF files are generated, but nothing appears on screen. Is that what is supposed to happen (the code contains a comment about "screen output" but there is no screen output here)?

I would be interested to learn more about how this library works. SDL 2.0 does not expose any cross-platform 'hardcopy' capability, so one of the things on my 'to do' list for BBCSDL is to implement the VDU 2 (enable printer) facility by creating a PDF rather than outputting to a physical printer. I have been looking at the libHaru library as a way of achieving this, but it's quite complicated and may be overkill for the intended purpose.

I wonder if the technique you are using could be adapted to be used instead of libHaru. The code would need to be in C, of course (unless it is already a translation from C!) so that it can be compiled and linked with the rest of the interpreter. Do you think it might be suitable for this purpose, and what are the IPR implications? Is your code original (in which case what kind of licence would you intend to grant) or if it's derived from something else how is that licensed?
My posts are moderated; if you are seeing this it has already been approved. If you have a comment about the style or tone of the message please report it to the moderators by clicking the exclamation mark icon rather than complaining on the public forum.

svein
Posts: 34
Joined: Tue 03 Apr 2018, 19:34

Re: pdflib: BBCSDL hard copy output

Post by svein » Mon 02 Dec 2019, 08:02

Quick answer, have to rush.
an empty window opens for a fraction of a second and then immediately closes again. The PDF files are generated, but nothing appears on screen. Is that what is supposed to happen
The example code ends with END, so no. Strange, check if all code got pasted into SLIDE, the end may be missing sometimes.
Is your code original
The code is original,i researched it from the PDF spec. (not easy).
what kind of licence would you intend to grant
You and all BBCSDL users may use it as they see fit.

Svein

svein
Posts: 34
Joined: Tue 03 Apr 2018, 19:34

Re: pdflib: BBCSDL hard copy output

Post by svein » Mon 02 Dec 2019, 11:50

an empty window opens for a fraction of a second and then immediately closes again
Found the cause. It is because your screen is only 720 tall, then the window opens and closes again.
You will need to manually adjust the VDU 23,22 line so it fits your screen.
The @zoom% adjust was a last minute addition when i remembered that you had a tiny screen.
I could not test the result of the zoom until i got to a windows computer. Linux mint does not allow to reduce the screen resolution,
but windows do.
I'll change the demo to adjust the VDU instead of using @zoom%.

Svein

Edit: This should work for you.

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.

      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
      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("Times",H,0) : REM colour=0=black
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")
      H=10 : Y-=H : PROC_PLfont("Times",H,0)
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")
      H=12 : Y-=H : PROC_PLfont("Times",H,0)
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")
      H=14 : Y-=H : PROC_PLfont("Times",H,0)
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")
      H=16 : Y-=H : PROC_PLfont("Times",H,0)
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")
      H=18 : Y-=H : PROC_PLfont("Times",H,0)
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")
      H=20 : Y-=H : PROC_PLfont("Times",H,0)
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")
      H=22 : Y-=H : PROC_PLfont("Times",H,0)
      PROC_PLprint(60,Y,"abcdefghijklmnopqrstuvwxyz 1234567890 ")

      REM demo of fonts
      PROC_PLfont("Helvetica",14,0)
      PROC_PLprint(20,800,"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,&FF00) : 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,780,"Times: ")
      PROC_PLfont("Times",14,&FF)
      PROC_PLprint(0,0,"Normal text ")
      PROC_PLfont("TimesB",14,&FF00)
      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,760,"Courier: ")
      PROC_PLfont("Courier",14,&FF)
      PROC_PLprint(0,0,"Normal text ")
      PROC_PLfont("CourierB",14,&FF00)
      PROC_PLprint(0,0,"Bold text ")
      PROC_PLfont("CourierO",14,&FF0000)
      PROC_PLprint(0,0,"Oblique text")

      PROC_PLfont("Symbol",14,0)
      PROC_PLprint(20,740,"Symbol: ")
      PROC_PLfont("Symbol",14,&FF)
      PROC_PLprint(0,0,"Normal text ")

      PROC_PLfont("Zap",14,0)
      PROC_PLprint(20,720,"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 !"

      IF FN_PLcreatepdf(@usr$+"demo.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"
      END

      REM --------------------------------------------------------------------------------------------------------------

      REM Library to create a PDF file for BBCSDL
      REM Hardcoded to one sheet of A4 paper size, or hardcopy of current screen.
      REM Pdflib Version 1.0, Nov.2019
      REM (C) Svein Svensson, (sveinioslo@gmail.com)
      REM May be freely distributed amongst BBCbasic users.

      REM PROC_PLprint(x,y,"text") VDU 5 print, x=0 and y=0 = continue print on line
      REM PROC_PLfont(font alias,font size,font colour)

      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 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

      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
      DEF PROC_PLfont(font$,S%,C%) : LOCAL M% : M%=12
      DEF FN_PLcreatepdf(file$): LOCAL M% : M%=20
      DEF FN_PLhardcopy(file$) : LOCAL M% : M%=21
      PRIVATE tstream$,gstream$,tf$,flag%
      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   x=y=0=continue on line
          PRIVATE oldx,oldy
          VDU 5 : GCOL 10
          IF x=0 AND y=0 THEN
            PRINT text$; : tstream$+=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 ("+text$+") Tj"+CHR$10
            oldx=x : oldy=y
          ENDIF
          tf$=""
          ENDPROC
        WHEN 12 : REM font   (alias)
          IF debug% THEN tstream$+="%font"+CHR$10
          LOCAL 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
          REM a$=@lib$+"DejaVuSansMono.ttf,"
          a$=@lib$+"DejaVuSans.ttf,"
          OSCLI "FONT "+a$+STR$(INT(S%/1.25))+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%=@vdu%!208
          yscreen%=@vdu%!212
          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"
            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$xscreen%+" /Height "+STR$yscreen%
            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 >> >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="11 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-Roman >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="12 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-Bold >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="13 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-Italic >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="14 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-BoldItalic >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="15 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="16 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica-Bold >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="17 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica-Oblique >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="18 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica-BoldOblique >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="19 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="20 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier-Bold >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="21 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier-Oblique >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="22 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier-BoldOblique >> 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
            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%
          =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

Edit2:
If you want to have a go at this yourself, in your own style of coding.
This is the manual i have used, 'hello world' starting point at page 701.
https://www.adobe.com/content/dam/acom/ ... 0_2008.pdf
Their copyright says:
It is being made available from the web site of Adobe .... under agreement with ISO for those that do not need the official version ....
Happy reading :)

RichardRussell
Posts: 90
Joined: Tue 15 Oct 2019, 09:10

Re: pdflib: BBCSDL hard copy output

Post by RichardRussell » Mon 02 Dec 2019, 15:01

svein wrote:
Mon 02 Dec 2019, 11:50
Found the cause. It is because your screen is only 720 tall, then the window opens and closes again.
The 'true' (native) resolution of my screen is 3200 x 1800 pixels but automatic High DPI scaling kicks in and it appears to be 1280 x 720 to BBCSDL. I can override that by changing the properties but then of course everything is far too small!
I'll change the demo to adjust the VDU instead of using @zoom%.
Edit: This should work for you.
Yes, I now see an output!
If you want to have a go at this yourself, in your own style of coding.
This is the manual i have used, 'hello world' starting point at page 701.
I don't want to 'reinvent the wheel', especially if it's difficult and you've already done the hard work, but because the source code of BBCSDL is published at GitHub I would need you to grant a formal licence to allow me to copy and adapt your code (including translating it to C). If the zlib Licence is acceptable to you (it basically allows anything except pretending that the original code wasn't written by you) perhaps you can copy it into your source code.
My posts are moderated; if you are seeing this it has already been approved. If you have a comment about the style or tone of the message please report it to the moderators by clicking the exclamation mark icon rather than complaining on the public forum.

svein
Posts: 34
Joined: Tue 03 Apr 2018, 19:34

Re: pdflib: BBCSDL hard copy output

Post by svein » Mon 02 Dec 2019, 19:00

I would need you to grant a formal licence to allow me to copy and adapt your code
Done.
The code would need to be in C
Do you think it might be suitable for this purpose
I have used simple straight forward code, so yes.

Svein

Code: Select all

      REM Library to create a PDF file for BBCSDL
      REM Hardcoded to one sheet of A4 paper size, or hardcopy of current screen.
      REM Pdflib Version 1.0, Nov.2019
      REM (C) Svein Svensson, (sveinioslo@gmail.com)

      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

      REM ...........................................................................

      REM PROC_PLprint(x,y,"text") VDU 5 print, x=0 and y=0 = continue print on line
      REM PROC_PLfont(font alias,font size,font colour)

      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 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

      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
      DEF PROC_PLfont(font$,S%,C%) : LOCAL M% : M%=12
      DEF FN_PLcreatepdf(file$): LOCAL M% : M%=20
      DEF FN_PLhardcopy(file$) : LOCAL M% : M%=21
      PRIVATE tstream$,gstream$,tf$,flag%
      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   x=y=0=continue on line
          PRIVATE oldx,oldy
          VDU 5 : GCOL 10
          IF x=0 AND y=0 THEN
            PRINT text$; : tstream$+=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 ("+text$+") Tj"+CHR$10
            oldx=x : oldy=y
          ENDIF
          tf$=""
          ENDPROC
        WHEN 12 : REM font   (alias)
          IF debug% THEN tstream$+="%font"+CHR$10
          LOCAL 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
          REM a$=@lib$+"DejaVuSansMono.ttf,"
          a$=@lib$+"DejaVuSans.ttf,"
          OSCLI "FONT "+a$+STR$(INT(S%/1.25))+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%=@vdu%!208
          yscreen%=@vdu%!212
          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"
            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$xscreen%+" /Height "+STR$yscreen%
            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 >> >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="11 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-Roman >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="12 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-Bold >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="13 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-Italic >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="14 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Times-BoldItalic >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="15 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="16 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica-Bold >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="17 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica-Oblique >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="18 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica-BoldOblique >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="19 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="20 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier-Bold >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="21 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier-Oblique >> endobj"+CHR$10
            xref%(xc%)=len1%+len2%+LEN(a$) : xc%+=1
            a$+="22 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier-BoldOblique >> 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
            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%
          =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


Post Reply