BBC BASIC for Windows
« 3D renderer is now merged with editor »

Welcome Guest. Please Login or Register.
Apr 5th, 2018, 9:54pm



ATTENTION MEMBERS: Conforums will be closing it doors and discontinuing its service on April 15, 2018.
Ad-Free has been deactivated. Outstanding Ad-Free credits will be reimbursed to respective payment methods.

If you require a dump of the post on your message board, please come to the support board and request it.


Thank you Conforums members.

BBC BASIC for Windows Resources
Online BBC BASIC for Windows documentation
BBC BASIC for Windows Beginners' Tutorial
BBC BASIC Home Page
BBC BASIC on Rosetta Code
BBC BASIC discussion group
BBC BASIC for Windows Programmers' Reference

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: 3D renderer is now merged with editor  (Read 156 times)
michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
xx 3D renderer is now merged with editor
« Thread started on: Sep 14th, 2017, 04:12am »

NOTE: be sure to save this program before you execute it.

I am getting this done at a snails pace.

Its a bit flashy, but I can adjust it. This will work. Now I will give all the triangles 9 variables each so the editor can control which ever one I choose.

I will add different colors to each triangle so they are easier to see.

Code:
      IF INKEY$(-256)="W" INSTALL @lib$+"D3DLIBA" ELSE INSTALL @lib$+"OGLLIB"

      PROCgraphics(1000,800)
      DIM l%(0), b%(1), n%(1), f%(1), s%(1), m%(1), t%(1), y(1), p(1), r(1), X(1), Y(1), Z(1), e(2), a(2)
      ON CLOSE PROCcleanup:QUIT
      ON ERROR PROCcleanup:PRINT REPORT$:END
      IF INKEY$(-256)="W" d% = FN_initd3d(@hwnd%, 1, 0) ELSE d% = FN_initgl(@hwnd%, 1, 0)
      IF d% = 0 ERROR 100, "Can't initialise Direct3D"
      e() = 0, 0, -6
      a() = 0, 0, 0
      l%()=1
      REPEAT
        PROCcreate3d
        b%(0) = FN_load3d(d%, @dir$+"TRIANGLE.B3D", n%(0), f%(0), s%(0))
        IF b%(0) = 0 ERROR 100, "Can't load TRIANGLE.B3D"
        REM  t%(1) = FN_loadtexture(d%, @dir$+"purple.JPG")
        REM  IF t%(1) = 0 ERROR 100, "Can't load face.JPG"
       y() +=.01:REM yaw (rotations around the Y axis)
        REM pitch
        p() =0:REM TIME/100 (pitch angles rotations around the X axis)
        REM roll
        r() = 0:REM TIME/40 (roll angles (rotations around the Z axis)
        REM X (right left)
        X() = 0:REM SIN(TIME/200)
        REM Y() up and down
        Y() = 0
        REM Z() depth
        Z() =  10:REM
  REM PROC_render(d%, &FF7F7F7F, 0, l%(), 2, m%(), t%(), b%(), n%(), f%(), s%(), y(), p(), r(), X(), Y(), Z(), e(), a(), PI/4, 5/4, 1, 1000)
        PROC_render(d%, &FF000000, 0, l%(), 2, m%(), t%(), b%(), n%(), f%(), s%(), y(), p(), r(), X(), Y(), Z(), e(), a(), PI/4, 5/4, 1, 1000, 0) :REM experimental
        WAIT 3
        REM          1     2       3   4    5   6     7     8     9     10    11   yaw pitch roll X    Y    Z eye0123  18   19   20   ^mcd  ^( cam to farplane dist)
        REM 1 Val returned from FN_init3D
        REM 2 back color   3 #of lights   4 light pointers
        REM t%() - holds texture
        REM mcd - minimum near cam distance
    WAIT 1
      UNTIL FALSE
      END
     DEF PROCcleanup
      t%(1) += 0:IF t%(1) PROC_release(t%(1))
      b%(0) += 0:IF b%(0) PROC_release(b%(0))
      b%(1) += 0:IF b%(1) PROC_release(b%(1))
      d% += 0   :IF d%    PROC_release(d%)
      ENDPROC
      DEF PROCcreate3d
      F% = OPENOUT"TRIANGLE.B3D"
      PROC4(6):REM 3 vertices
      PROC4(&100042):REM vertex size &10 and format &42
      res$=""
      res=0
      ls= 0
      LET rs= 24
      counl%=290
      counr%=2110
      REM setup buttons before use
      REM             x , y ,size,"fillcolor","command"
      res$=FNabutton(100,100,25,"light green","fill"):REM keeping it efficient
      res$=FNabutton(125,130,25,"yellow","fill")
      res$=FNabutton(300,100,25,"red","fill")
      res$=FNabutton(300,130,25,"cyan","fill")
      res$=FNabutton(500,100,25,"200,200,190","fill")
      res$=FNabutton(470,100,25,"200,190,200","fill")
      res$=FNabutton(593,70,75,"000,000,000","fill")  :REM select entire triangle
      res$=FNabutton(770,90,25,"100,50,100","fill") :REM LL triangle only
      res$=FNabutton(905,90,25,"50,100,50","fill"):REM LR triangle only
      res$=FNabutton(835,205,25,"200,50,100","fill"):REM TOP triangle only
      PROCcolor("f","white")
      LINE165,165,200,200:LINE200,200,180,200:LINE 200,200,200,180
      LINE 90,90,60,60:LINE 60,60,80,60:LINE 60,60,60,80
      LINE 315,170,315,200:LINE 315,200,300,180:LINE 315,200,330,180
      LINE 315,85,315,50:LINE 315,50,300,70:LINE 315,50,330,70
      LINE 460,115,430,115:LINE 430,115,440,130:LINE 430,115,440,100:LINE 535,115,560,115
      LINE 560,115,550,130:LINE 560,115,550,100:LINE 600,100,660,100:LINE 660,100,630,130
      LINE 630,130,600,100: LINE 800,100,900,100:LINE 900,100,850,200:LINE 850,200,800,100
      PROCcolor("f","black")
      REM TRACKING STARTS HERE
      res$=""
      IF FNabutton(100,100,25,"green","out")="out" THEN res$="out"
      IF FNabutton(125,130,25,"blue","in")="in" THEN res$="in"
      IF FNabutton(300,100,25,"red","down")="down" THEN res$="down"
      IF FNabutton(300,130,25,"orange","up")="up" THEN res$="up"
      IF FNabutton(500,100,25,"purple","right")="right" THEN res$="right"
      IF FNabutton(470,100,25,"200,190,200","left")="left" THEN res$="left"
      IF FNabutton(593,70,75,"000,000,000","all")="all" THEN res$="all"
      IF FNabutton(770,90,25,"100,50,100","LL")="LL" THEN res$="LL" :REM LL triangle only
      IF FNabutton(905,90,25,"50,100,50","LR")="LR" THEN res$="LR":REM LR triangle only
      IF FNabutton(835,205,25,"200,50,100","TOP")="TOP" THEN res$="TOP":REM TOP triangle only
      REM PROCsbox(10,1000,2000,900,"15")
      REM MOVE 30,950:PRINT "3D design tool  :" +res$
      WAIT 2
      REM       LL x            LL y            LL z
      PROC4(FN_f4(-1.0)):PROC4(FN_f4(-1.0)):PROC4(FN_f4(1.0)):PROC4(&FF0000FF)
      REM       LR x            LR y            LR z
      PROC4(FN_f4(1.0)):PROC4(FN_f4(-1.0)):PROC4(FN_f4(1.0)):PROC4(&FF0000FF):REM PROC4(&FF00FF00)
      REM     PEAK X     PEAK Y             PEAK Z
      PROC4(FN_f4(1.0)):PROC4(FN_f4(1.0)):PROC4(FN_f4(1.0)):PROC4(&FF0000FF):REM PROC4(&FFFF0000)

      PROC4(FN_f4(-1.0)):PROC4(FN_f4(-1.0)):PROC4(FN_f4(1.0)):PROC4(&FF0000FF):REM PROC4(&FF0000FF)
      REM       LR x            LR y            LR z
      PROC4(FN_f4(-1)):PROC4(FN_f4(1.0)):PROC4(FN_f4(1.0)):PROC4(&FF0000FF):REM PROC4(&FF00FF00)
      REM     PEAK X     PEAK Y             PEAK Z
      PROC4(FN_f4(1.0)):PROC4(FN_f4(1.0)):PROC4(FN_f4(1.0)):PROC4(&FF0000FF):REM PROC4(&FFFF0000)

      CLOSE #F%
      ENDPROC
      DEF PROC4(A%):BPUT#F%,A%:BPUT#F%,A%>>8:BPUT#F%,A%>>16:BPUT#F%,A%>>24:ENDPROC
      REM x,y is lower left and c$=fillcolor:com$-command
      DEFFNabutton(x,y,size%,c$,com$)
      MOUSE mx,my,mb
      LOCAL ret$
      PROCcolor("f","5")
      PROCrect(x,y,x+size%,y+size%)
      IF com$="fill" THEN
        PROCpaint(x+5,y+5,c$)
      ENDIF
      IF mx>x AND mx<x+size% AND my>y AND my<y+size% THEN
        PROCcolor("f","15"):PROCrect(x,y,x+size%,y+size%)
        IF mb=4 THEN ret$=com$
      ENDIF
      =ret$
      DEFPROCarrowu(x,y)
      PRIVATE xx,yy
      PROCcolor("f","black")
      LINE xx,yy,xx-20,yy-20
      LINE xx,yy,xx+20,yy-20
      PROCcolor("f","15")
      LINE x,y,x-20,y-20
      LINE x,y,x+20,y-20
      xx=x:yy=y
      ENDPROC
      DEFPROCarrowd(x,y)
      PRIVATE hh,vv
      PROCcolor("f","000,000,000")
      LINE hh,vv,hh-20,vv+20
      LINE hh,vv,hh+20,vv+20
      PROCcolor("f","15")
      LINE x,y,x-20,y+20
      LINE x,y,x+20,y+20
      hh=x:vv=y
      ENDPROC
      REM  GRAPHICS(x,y)
      DEF PROCgraphics(x,y)
      VDU 23,22,x;y;8,15,16,1
      OFF
      VDU 5
      ENDPROC
      REM SBOX **********************
      DEF PROCsbox(x%,y%,w%,h%,c$)
      LOCAL ry%,sx%,sy%
      sx%=x%:sy%=y%
      IF x%>w% THEN x%=w%:w%=sx%
      IF y%>h% THEN y%=h%:h%=sy%
      ry%=y%
      PROCcolor("f",c$)
      REPEAT
        LINE x%,y%,w%,y%
        y%=y%+1
      UNTIL y%=h%
      y%=ry%
      IF c$<>"0" THEN PROCcolor("f","000,000,000") ELSE PROCcolor("f","white")
      LINE x%+2,y%+2,w%-2,y%+2
      LINE w%-2,y%+2,w%-2,h%-4
      LINE w%-2,h%-4,x%+2,h%-4
      LINE x%+2,h%-4,x%+2,y%+2
      PROCresetrgb
      ENDPROC
      REM RECT **********************
      DEFPROCrect(x%,y%,w%,h%)
      LOCAL sx%,sy%
      sx%=x%:sy%=y%
      IF x%>w% THEN x%=w%:w%=sx%
      IF y%>h% THEN y%=h%:h%=sy%
      LINE x%,y%,w%,y%
      LINE w%,y%,w%,h%
      LINE w%,h%,x%,h%
      LINE x%,h%,x%,y%
      ENDPROC
      REM pixel *******************
      DEFPROCpixel(x%,y%,c$)
      PROCcolor("f",c$)
      MOVE x%,y%:DRAW x%,y%
      ENDPROC
      REM SET  c$ can be colors like blue or 1 or a R,G,B color
      DEF PROCset(x%,y%,c$)
      LOCAL h%
      PROCcolor("f",c$)
      FOR h%=0 TO 20
        LINE x%+h%,y%,x%+h%,y%+20
      NEXT
      MOVE 0,0
      ENDPROC
      DEFPROCpaint(x%,y%,co$)
      PROCcolor("b","0"):PROCcolor("f",co$)
      FILL x%,y%
      ENDPROC
      REM restore default color palettes
      DEFPROCresetrgb
      COLOUR 0,0,0,0 :COLOUR 1,200,0,0 :COLOUR 2,000,200,000
      COLOUR 3,200,200,000:COLOUR 4,000,000,200:COLOUR 5,200,000,200
      COLOUR 6,000,200,200:COLOUR 7,200,200,200:COLOUR 8,056,056,056
      COLOUR 9,248,056,056:COLOUR 10,056,248,056:COLOUR 11,248,248,056
      COLOUR 12,056,056,248:COLOUR 13,248,056,248:COLOUR 14,056,248,248
      COLOUR 15,248,248,248
      ENDPROC
      DEF PROCcolor(fb$,rgb$)
      PRIVATE assemble$,br%,bg%,bb%
      IF rgb$="0" OR rgb$="black" THEN rgb$="000,000,000"
      IF rgb$="1" OR rgb$="red" THEN rgb$="200,000,000"
      IF rgb$="2" OR rgb$="green" THEN rgb$="000,200,000"
      IF rgb$="3" OR rgb$="yellow" THEN rgb$="200,200,000"
      IF rgb$="4" OR rgb$="blue" THEN rgb$="000,000,200"
      IF rgb$="5" OR rgb$="magenta" THEN rgb$="200,000,200"
      IF rgb$="6" OR rgb$="cyan" THEN rgb$="000,200,200"
      IF rgb$="7" OR rgb$="white" THEN rgb$="200,200,200"
      IF rgb$="8" OR rgb$="grey" THEN rgb$="056,056,056"
      IF rgb$="9" OR rgb$="light red" THEN rgb$="248,056,056"
      IF rgb$="10" OR rgb$="light green" THEN rgb$="056,248,056"
      IF rgb$="11" OR rgb$="light yellow" THEN rgb$="248,248,056"
      IF rgb$="12" OR rgb$="light blue" THEN rgb$="056,056,248"
      IF rgb$="13" OR rgb$="light magenta" THEN rgb$="248,056,248"
      IF rgb$="14" OR rgb$="light cyan" THEN rgb$="056,248,248"
      IF rgb$="15" OR rgb$="light white" THEN rgb$="248,248,248"
      assemble$=rgb$
      br%=VAL(MID$(assemble$,1,3)):bg%=VAL(MID$(assemble$,5,3)):bb%=VAL(MID$(assemble$,9,3))
      IF fb$="f" OR fb$="F" THEN COLOUR 0,br%,bg%,bb% : GCOL 0
      IF fb$="b" OR fb$="B" THEN COLOUR 1,br%,bg%,bb% : GCOL 128+1
      ENDPROC
 
« Last Edit: Sep 14th, 2017, 04:35am by michael » User IP Logged

I like making program generators and like reinventing the wheel
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

| |

This forum powered for FREE by Conforums ©
Terms of Service | Privacy Policy | Conforums Support | Parental Controls