home *** CD-ROM | disk | FTP | other *** search
/ DarkBasic Professional / DarkBasicPro.iso / data1.cab / Lang_Files_(English) / Help / examples / basic3d / basic3d7-example.dba < prev    next >
Encoding:
Text File  |  2004-09-22  |  9.0 KB  |  339 lines
  1. Rem FX Mini Browser
  2. Rem Created: 28/06/2003 03:57:13
  3.  
  4. rem Init app
  5. sync on : sync rate 60 : hide mouse : backdrop off
  6.  
  7. rem Obtain information on shader capabilities
  8. vs#=get maximum vertex shader version()
  9. ps#=get maximum pixel shader version()
  10.  
  11. rem Screen dimensions
  12. gap=screen height()/20
  13. topline=gap+60
  14. halfwidth=screen width()/2
  15. middleline=screen width()/2
  16. bottomline=screen height()-gap
  17. verthalfline=topline+((bottomline-topline)/2)
  18. rightline=screen width()-gap
  19. displaymax=((bottomline-topline)/18)-2
  20. valuesdisplaymax=((bottomline-(verthalfline+gap))/18)-2
  21. displaywidthmax=((middleline-leftline)/10)-2
  22. valuesdisplaywidthmax=((rightline-middleline)/10)-9
  23.  
  24. rem Create list of FX files
  25. dim list$(0) : empty array list$()
  26. scandir("fx","")
  27. listmax=2+array count(list$())
  28. listtop=1
  29.  
  30. rem Create list of Effect Values
  31. type valuestype name$ vartype hooked endtype
  32. dim values$(0) as valuestype : empty array values$()
  33. valuesmax=1+array count(values$())
  34. valuestop=1
  35.  
  36. rem Setup camera and light for preview camera
  37. position camera 0,0,0,-1000
  38. make camera 1 : set camera view 1,middleline,topline,rightline,verthalfline
  39. set camera aspect 1,(rightline-middleline)/((verthalfline-topline)+0.0)
  40. backdrop on 1 : color backdrop 1,0
  41.  
  42. rem Current vars
  43. highlight=1 : valueshighlight=1 : loadeffect=1
  44.  
  45. rem Initialise interface screen
  46. gosub _initscreen
  47.  
  48. rem Move around world
  49. do
  50.  
  51. rem control interface
  52. if invalues=0
  53.  `
  54.  rem control list highlight
  55.  if scancode()=0 then keypress=0
  56.  if keypress=0
  57.   if upkey()=1 and highlight>1 then dec highlight : keypress=1
  58.   if downkey()=1 and highlight<listmax-1 then inc highlight : keypress=1
  59.   if returnkey()=1 then autosphere=1-autosphere : keypress=1 : loadeffect=highlight
  60.   if scancode()=15 then invalues=1 : keypress=1
  61.   if lower$(inkey$())="t" then transposetoggle=1-transposetoggle : keypress=1 : set effect transpose 1,transposetoggle
  62.   if inkey$()="1" then set effect technique 1,"tec0" : keypress=1
  63.   if inkey$()="2" then set effect technique 1,"tec1" : keypress=1
  64.   if inkey$()="3" then set effect technique 1,"tec2" : keypress=1
  65.  endif
  66.  if highlight>listtop+displaymax then listtop=highlight-displaymax
  67.  if highlight<listtop then listtop=highlight
  68.  if spacekey()=1 then loadeffect=highlight
  69.  `
  70. else
  71.  `
  72.  rem control values highlight
  73.  if scancode()=0 then keypress=0
  74.  if keypress=0
  75.   if upkey()=1 and valueshighlight>1 then dec valueshighlight : keypress=1
  76.   if downkey()=1 and valueshighlight<valuesmax-1 then inc valueshighlight : keypress=1
  77.   if scancode()=15 then invalues=0 : keypress=1
  78.   if lower$(inkey$())="t" then transposetoggle=1-transposetoggle : keypress=1 : set effect transpose 1,transposetoggle
  79.   if spacekey()=1 and effect exist(1)=1
  80.    name$=values$(valueshighlight-1).name$
  81.    vartype=values$(valueshighlight-1).vartype
  82.    select vartype
  83.     case 1 : set effect constant boolean 1,name$,rnd(1) : endcase
  84.     case 2 : set effect constant integer 1,name$,rnd(10) : endcase
  85.     case 3 : set effect constant float 1,name$,rnd(10) : endcase
  86.     case 4
  87.      r=make vector4(1)
  88.      set vector4 1,rnd(100)/100.0,rnd(100)/100.0,rnd(100)/100.0,rnd(100)/100.0
  89.      set effect constant vector 1,name$,1
  90.      r=delete vector4(1)
  91.     endcase
  92.     case 5
  93.      r=make matrix4(2)
  94.      set identity matrix4 2
  95.      set effect constant matrix 1,name$,2
  96.      r=delete matrix4(2)
  97.     endcase
  98.    endselect
  99.    gosub _updateeffectvalues
  100.    keypress=1
  101.   endif
  102.  endif
  103.  if valueshighlight>valuestop+valuesdisplaymax then valuestop=valueshighlight-valuesdisplaymax
  104.  if valueshighlight<valuestop then valuestop=valueshighlight
  105.  `
  106. endif
  107.  
  108. rem Load model and effect on command
  109. if loadeffect<>-1
  110.  effect$=list$(loadeffect-1)
  111.  gosub _loadmodelandeffect
  112.  loadeffect=-1
  113. endif
  114.  
  115. rem Rotate any model in view
  116. if object exist(1)=1
  117.  yrotate object 1,wrapvalue(object angle y(1)+1)
  118. endif
  119.  
  120. rem Move light around slightly
  121. l#=l#+4.0 : set point light 0,camera position x(1)+(cos(l#)*2),camera position y(1)+(sin(l#)*2),camera position z(1)-1
  122.  
  123. rem refresh interface
  124. gosub _refreshscreen
  125.  
  126. rem update screen
  127. sync
  128.  
  129. rem end loop
  130. loop
  131.  
  132. `
  133. ` Subroutines for Interface
  134. `
  135.  
  136. _initscreen:
  137.  
  138. rem Clear screen
  139. create bitmap 1,screen width(),screen height()
  140. set current camera 0 : draw to back
  141. cls rgb(192,192,192)
  142.  
  143. rem Setup font
  144. set text font "Courier New"
  145. set text transparent
  146.  
  147. rem Write labels
  148. set text size 20
  149. ink rgb(0,0,0),0 : center text halfwidth,(gap/2)-10,"DBPRO FX MINI-BROWSER"
  150. set text size 16
  151. center text halfwidth,(gap/2)+10,"[ARROWKEYS] TO NAVIGATE  [TAB] TO TOGGLE  [T] TRANSPOSE TOGGLE"
  152. center text gap+((middleline-(gap*2))/2),topline-20,"FX FILES"
  153. center text middleline+((rightline-middleline)/2),topline-20,"PREVIEW AREA"
  154. center text middleline+((rightline-middleline)/2),verthalfline+gap-20,"EFFECT VALUES"
  155. center text halfwidth,bottomline+(gap/2)-10,"VERTEX SHADER VERSION:"+str$(vs#)+"  PIXEL SHADER VERSION:"+str$(ps#)
  156.  
  157. rem Text for boxout
  158. set current bitmap 0
  159. set text opaque
  160.  
  161. return
  162.  
  163. _refreshscreen:
  164.  
  165. rem Clear screen
  166. set current camera 0
  167. copy bitmap 1,0
  168.  
  169. ink rgb(0,0,0),rgb(192,192,192)
  170. if invalues=0
  171.  center text halfwidth,(gap/2)+30,"[RETURN] TO USE AUTO-SPHERE  [SPACE] TO LOAD EFFECT"
  172. else
  173.  center text halfwidth,(gap/2)+30,"[SPACE] TO SET RANDOM VALUE TO EFFECT VALUE"
  174. endif
  175.  
  176. rem Panel for FX list
  177. ink 0,0 : box gap,topline,middleline-gap,bottomline
  178. ink rgb(255,255,255),0
  179. for n=0 to displaymax
  180.  if listtop+n<listmax
  181.   if listtop+n=highlight and invalues=0
  182.    ink 0,rgb(255,255,255)
  183.   else
  184.    ink rgb(255,255,255),0
  185.   endif
  186.   text gap+10,topline+6+(n*18),right$(list$(listtop+n-1),displaywidthmax)
  187.  endif
  188. next n
  189.  
  190. rem Panel for Values list
  191. ink 0,0 : box middleline,verthalfline+gap,rightline,bottomline
  192. ink rgb(255,255,255),0
  193. if effect exist(1)=0
  194.  `
  195.  tline=1
  196.  for n=0 to checklist quantity()
  197.    if n=0
  198.     text middleline+10,verthalfline+gap+6,"EFFECT ERRORS REPORT"
  199.    else
  200.     desc$=checklist string$(n)
  201.     tperline=valuesdisplaywidthmax+9
  202.     for chunk=0 to len(desc$) step tperline
  203.      text middleline+10,verthalfline+gap+6+(tline*18),left$(right$(desc$,len(desc$)-chunk),tperline)
  204.      inc tline
  205.     next chunk
  206.    endif
  207.  next n
  208.  `
  209. else
  210.  `
  211.  for n=0 to valuesdisplaymax
  212.   if valuestop+n<valuesmax
  213.    if values$(valuestop+n-1).vartype=0
  214.     trgb=rgb(128,128,128)
  215.    else
  216.     if values$(valuestop+n-1).hooked=1
  217.      trgb=rgb(192,255,192)
  218.     else
  219.      trgb=rgb(255,192,192)
  220.     endif
  221.    endif
  222.    if valuestop+n=valueshighlight and invalues=1
  223.     ink 0,trgb
  224.    else
  225.     ink trgb,0
  226.    endif
  227.    text middleline+10,verthalfline+gap+6+(n*18),right$(values$(valuestop+n-1).name$,valuesdisplaywidthmax)
  228.    text rightline-40,verthalfline+gap+6+(n*18),right$(str$(values$(valuestop+n-1).vartype),2)
  229.    text rightline-20,verthalfline+gap+6+(n*18),right$(str$(values$(valuestop+n-1).hooked),2)
  230.   endif
  231.  next n
  232.  `
  233. endif
  234.  
  235. return
  236.  
  237.  
  238. `
  239. ` Subroutines for Effects
  240. `
  241.  
  242. _loadmodelandeffect:
  243.  
  244. rem Delete any existing objects
  245. if object exist(1)=1 then delete object 1
  246.  
  247. rem Show delay when loading
  248. color backdrop 1,0
  249. sync : sync
  250.  
  251. rem Load effect
  252. if effect exist(1)=1 then delete effect 1
  253. load effect "fx\"+effect$,1,1
  254. if effect exist(1)=0
  255.  `
  256.  rem report the errors in the preview window
  257.  perform checklist for effect errors
  258.  `
  259. else
  260.  `
  261. rem Use sphere model or not
  262. if autosphere=1 then make object sphere 1,1,50,50
  263.  `
  264.  rem Use default model if effect has one
  265.  set effect on 1,"fx\"+effect$,1
  266.  `
  267.  rem Then apply the full loaded effect so we can use extra effect commands
  268.  set object effect 1,1
  269.  `
  270.  rem Get Effect Values
  271.  gosub _updateeffectvalues
  272.  valuestop=1
  273.  `
  274.  rem Reset values highlighter
  275.  valueshighlight=1
  276.  `
  277.  rem Move object and camera position in world for greater FX test
  278.  position object 1,500,100,50
  279.  position camera 0,camera position x(0)+500,camera position y(0)+100,camera position z(0)+50
  280.  `
  281.  rem Center above the object and restore cameras
  282.  color backdrop 1,rgb(64,64,64)
  283.  position camera 1,camera position x(0),camera position y(0),camera position z(0)
  284.  rotate camera 1,camera angle x(0),camera angle y(0),camera angle z(0)
  285.  position camera 0,0,0,-10000
  286.  rotate camera 0,0,0,0
  287.  `
  288. endif
  289.  
  290. return
  291.  
  292. _updateeffectvalues:
  293.  `
  294.  perform checklist for effect values 1
  295.  empty array values$()
  296.  for c=1 to checklist quantity()
  297.   array insert at bottom values$()
  298.   values$().name$=checklist string$(c)
  299.   values$().vartype=checklist value a(c)
  300.   values$().hooked=checklist value b(c)
  301.  next c
  302.  valuesmax=1+array count(values$())
  303.  `
  304. return
  305.  
  306. `
  307. ` Function to scan for all FX files
  308. `
  309.  
  310. function scandir(folder$,rel$)
  311.  `
  312.  set dir folder$
  313.  find first : fin=0
  314.  while get file type()>-1
  315.   file$=get file name$()
  316.   if file$="." or file$=".."
  317.    rem ignore . and ..
  318.   else
  319.    if get file type()=1
  320.     scandir(file$,rel$+file$+"\")
  321.     find first
  322.     if fin>0
  323.      for t=1 to fin : find next : next t
  324.     endif
  325.    else
  326.     if lower$(right$(file$,3))=".fx"
  327.      array insert at bottom list$()
  328.      list$()=rel$+file$
  329.     endif
  330.    endif
  331.   endif
  332.   find next
  333.   fin=fin+1
  334.  endwhile
  335.  set dir ".."
  336.  `
  337. endfunction
  338.  
  339.