[DBPro] DBPro interpreted - GameCreators Forum

Author

Message

zapakitul

17

Years of Service

User Offline

Joined: 1st Mar 2007

Location: In my world

Posted: 21st Dec 2007 22:29

Link

After i found out i cannot wrap dbpro commands into a interpreted language i gaved up the ideea on making InterPreted DBPro! But i don't think it is a problem posting the snippet so other can learn from my code! Here it is! Using Dark_side file requester .dll

DarkSide_Set_File_Requester_Extension ".Z3D"
DarkSide_Set_File_Requester_Extension_Pattern "1"
DarkSide_Open_File_Requester
DarkSide_Return_File_Requester_Full
Do
scr$=Get clipboard$()

interfisier(scr$)
InterLinie(Line$)

If escapekey() = 1 Then End
sync
Loop

Function InterLinie(Line$)
Dim Parametru(9)
Dim Parametru$(9)
TypeOfData=1
AuFostGasiteGhilimele=0
StringTemporar$="";
IndicePS=1
IndiceP=1
AFostGasitParametru=0
length=Len(Line$)
i=1
Command$="";
While i<=length
   Char$=Mid$(Line$,i)
   If Char$="/" And i<length
      If Mid$(Line$,i+1) = "/" Then ok=1
   Endif
   If ok=1 Then Exit
   If Char$<>";" And Char$<>" " And AFostGasitParametru=0 And Char$<>"("
      Command$=Command$+Char$
   Endif
   If Char$="("
      AFostGasitParametru=1
   Endif
   If AFostGasitParametru=1 And Char$<>";" And Char$<>"("
      If Char$="," Or Mid$(Line$,i+1)=")"
         If TypeOfData=1
            Parametru(IndiceP)=Val(StringTemporar$)
            IndiceP=IndiceP+1
         Endif
         If TypeOfData=2
            Parametru$(IndicePS)=StringTemporar$
            IndicePS=IndicePS+1
         Endif
         StringTemporar$=""
      Endif
      If Char$="'" Then AuFostGasiteGhilimele=AuFostGasiteGhilimele+1
      If AuFostGasiteGhilimele=1 Then TypeOfData=2
      If AuFostGasiteGhilimele=2
         AuFostGasiteGhilimele=0
         TypeOfData=1
      Endif
      If Char$<>"," And Char$<>"'"
         StringTemporar$=StringTemporar$+Char$
      Endif
   Endif
   If Char$=")"
      AFostGasitParametru=0
   Endif
   If Char$=";"
      Command$=Upper$(Command$)
      Select Command$
         Case "MAKE_CUBE"
            make object cube Parametru(1),Parametru(2)
         endcase
         Case "SCREENOUT"
            text Parametru(1),Parametru(2),Parametru$(1)
         EndCase
         Case "LOAD_OBJECT"
            load object Parametru$(1),Parametru(1)
         EndCase
         Case "POSITION_WINDOW"
            set Window position Parametru(1),Parametru(2)
         EndCase
         Case "WINDOW_TITLE"
            set Window title Parametru$(1)
         EndCase
         Case "WINDOW_SIZE"
            set Window size Parametru(1),Parametru(2)
         EndCase
         Case "WINDOW_ON"
            SET Window ON
         EndCase
         Case "WINDOW_OFF"
            SET Window OFF
         EndCase
         Case "MAXIMIZE_WINDOW"
            MAXIMIZE Window
         EndCase
         Case "MINIMIZE_WINDOW"
            MINIMIZE Window
         EndCase
         Case "HIDE_WNIDOW"
            hide Window
         EndCase
         Case "SHOW_WINDOW"
            show Window
         EndCase
         Case "DISPLAY_MODE"
            set display mode Parametru(1),Parametru(2),Parametru(2)
         EndCase
         Case "SYNC_ON"
            sync on
         EndCase
         Case "SYNC_OFF"
            sync off
         EndCase
         Case "CLEAR_SCREEN"
            Cls
         EndCase
         Case "HOLD_MOUSE"
            Wait mouse
         EndCase
         Case "HOLD_KEY"
            Wait Key
         EndCase
         Case "EXIT"
            Exit
         EndCase
         Case "SYNC"
            sync
         EndCase
         Case "SET_SYNC_RATE"
            sync rate Parametru(1)
         EndCase
         Case "FONT_TEXT"
            set text font Parametru$(1)
         EndCase
         Case "SET_TRANSPARENT_TEXT"
            set text transparent
         EndCase
         Case "TEXT_SIZE"
            set text size Parametru(1)
         EndCase
         Case "TEXT_COLOR"
            ink rgb(Parametru(1),Parametru(2),Parametru(3)),0
         EndCase
         Case "MAKE_BOX"
            box Parametru(1),Parametru(2),Parametru(3),Parametru(4)
         EndCase
         Case "LOCK_PIXELS"
            Lock pixels
         EndCase
         Case "UNLOCK_PIXELS"
            Unlock pixels
         EndCase
         Case "MAKE_CIRCLE"
            Circle Parametru(1),Parametru(2),Parametru(3)
         EndCase
         Case "MAKE_ELLIPSE"
            ellipse Parametru(1),Parametru(2),Parametru(3),Parametru(4)
         EndCase
         Case "LOAD_SOUND"
            load Sound Parametru$(1),Parametru(2)
         EndCase
         Case "PLAY_SOUND"
            Play Sound Parametru(1)
         EndCase
         Case "STOP_SOUND"
            Stop Sound Parametru(1)
         EndCase
         Case "PAUSE_SOUND"
            pause Sound Parametru(1)
         EndCase
         Case "RESUME_SOUND"
            Resume Sound Parametru(1)
         EndCase
         Case "DELETE_SOUND"
            Delete Sound Parametru(1)
         EndCase
         Case "LOOP_SOUND"
            Loop Sound Parametru(1)
         EndCase
         Case "SAVE_SOUND"
            save Sound Parametru$(1),Parametru(1)
         EndCase
         Case "RECORD_SOUND"
            record Sound Parametru(1)
         EndCase
         Case "STOP_RECORD_SOUND"
            Stop recording Sound
         EndCase
         Case "SOUND_SPEED"
            set Sound speed Parametru(1),Parametru(2)
         EndCase
         Case "SOUND_VOLUME"
            set Sound volume Parametru(1),Parametru(2)
         EndCase
         Case "ESCAPEKEY_OFF"
            DISABLE ESCAPEKEY
         EndCase
         Case "ESCAPEKEY_ON"
            ENABLE ESCAPEKEY
         EndCase
         Case "SYSTEMKEYS_OFF"
            DISABLE SYSTEMKEYS
         EndCase
         Case "SYSTEMKEYS_ON"
            ENABLE SYSTEMKEYS
         EndCase
         Case "EXIT_PROMPT"
            Exit prompt Parametru$(1),Parametru$(2)
         EndCase
         Case "LOAD_MUSIC"
            load music Parametru$(1),Parametru(1)
         EndCase
         Case "DELETE_MUSIC"
            Delete music Parametru(1)
         EndCase
         Case "PLAY_MUSIC"
            Play music Parametru(1)
         EndCase
         Case "LOOP_MUSIC"
            Loop music Parametru(1)
         EndCase
         Case "STOP_MUSIC"
            Stop music Parametru(1)
         EndCase
         Case "PAUSE_MUSIC"
            pause music Parametru(1)
         EndCase
         Case "RESUME_MUSIC"
            Resume music Parametru(1)
         EndCase
         Case "MUSIC_SPEED"
            set music speed Parametru(1),Parametru(2)
         EndCase
         Case "MUSIC_VOLUME"
            set music volume Parametru(1),Parametru(2)
         EndCase
         Rem UpDate 1
         Case "LOAD_IMAGE"
            load image Parametru$(1),Parametru(1)
         EndCase
         Case "DELETE_IMAGE"
            Delete image Parametru(1)
         EndCase
         Case "SAVE_IMAGE"
            save image Parametru$(1),Parametru(1)
         EndCase
         Case "GET_IMAGE"
            Get image Parametru(1),Parametru(2),Parametru(3),Parametru(4),Parametru(5)
         EndCase
         Case "PASTE_IMAGE"
            paste image Parametru(1),Parametru(2),Parametru(3)
         EndCase
         Case "MAKE_CAMERA"
            make camera Parametru(1)
         EndCase
         Case "DELETE_CAMERA"
            Delete camera Parametru(1)
         EndCase
         Case "MOVE_CAMERA"
            move camera Parametru(1)
         EndCase
         Case "POSITION_CAMERA"
            position camera Parametru(1),Parametru(2),Parametru(3)
         EndCase
       
         Case "ROTATE_CAMERA"
            rotate camera Parametru(1),Parametru(2),Parametru(3)
         EndCase
         Case "XROTATE_CAMERA"
            xrotate camera Parametru(1)
         EndCase
         Case "YROTATE_CAMERA"
            yrotate camera Parametru(1)
         EndCase
         Case "ZROTATE_CAMERA"
            zrotate camera Parametru(1)
         EndCase
         Case "TURN_CAMERA_LEFT"
            turn camera Left Parametru(1)
         EndCase
         Case "TURN_CAMERA_RIGHT"
            turn camera Right Parametru(1)
         EndCase
         Case "PITCH_CAMERA_UP"
            PITCH CAMERA UP Parametru(1)
         EndCase
         Case "PITCH_CAMERA_DOWN"
            PITCH CAMERA down Parametru(1)
         EndCase
         Case "ROLL_CAMERA_LEFT"
            ROLL CAMERA Left Parametru(1)
         EndCase
         Case "ROLL_CAMERA_RIGHT"
            ROLL CAMERA Right Parametru(1)
         EndCase
         Case "SET_CURRENT_CAMERA"
            SET CURRENT CAMERA Parametru(1)
         EndCase
         Case "CLEAR_CAMERA_VIEW"
            Clear CAMERA View Parametru(1)
         EndCase
         Case "AUTOCAM_ON"
            AUTOCAM ON
         EndCase
         Case "AUTOCAM_OFF"
            AUTOCAM OFF
         EndCase
         Case "BACKDROP_ON"
            BACKDROP ON
         EndCase
         Case "BACKDROP_OFF"
            BACKDROP OFF
         EndCase
         Case "TEXTURE_BACKDROP"
            TEXTURE BACKDROP Parametru(1)
         EndCase
         Case "BOMB_PORTICLES"
            bomb_particles()
         EndCase
         Case "MAKE_PARTICLES"
            make_particles()
         EndCase
         Case "MAKE_PARTICLES_FOUNTAIN"
            make_particles_fountain()
         EndCase
         Case "MAKE_PARTICLE_FIRE"
            make_particle_fire();
         EndCase
         Case "SET_CAMERA_FOV"
            SET CAMERA FOV Parametru(1)
         EndCase
         Case "SET_CAMERA_RANGE"
            SET CAMERA RANGE Parametru(1),Parametru(2)
         EndCase
         Case "SET_CAMERA_VIEW"
            SET CAMERA View Parametru(1),Parametru(2),Parametru(3),Parametru(4)
         EndCase
         Case "SET_CAMERA_ASPECT"
            SET CAMERA ASPECT Parametru(1)
         EndCase
         Case "CONTROL_CAMERA_USING_ARROWKEYS "
            CONTROL CAMERA Using ARROWKEYS Parametru(1),Parametru(2),Parametru(3)
         EndCase
         Case "SHOW_MOUSE"
            show mouse
         EndCase
         Case "HIDE_MOUSE"
            hide mouse
         EndCase
         Case "POSITION_MOUSE"
            position mouse Parametru(1),Parametru(2)
         EndCase
         Case "MAKE_MWORLD"
            MAKE MATRIX Parametru(1),Parametru(2),Parametru(3),5,5
         EndCase
         Case "DELETE_MWORLD"
            Delete MATRIX Parametru(1)
         EndCase
         Case "TEXTURE_MWORLD"
            PREPARE MATRIX TEXTURE Parametru(1),Parametru(2),1,1
         EndCase
         Case "POSITION_MWORLD"
            POSITION MATRIX Parametru(1),Parametru(2),Parametru(3),Parametru(4)
         EndCase
         Case "RANDOMIZE_MWORLD "
            Randomize MATRIX Parametru(1),Parametru(2)
         EndCase
         Case "GHOST_MWORLD_ON "
            GHOST MATRIX ON Parametru(1)
         EndCase
         Case "GHOST_MWORLD_OFF"
            GHOST MATRIX OFF Parametru(1)
         EndCase
         Case "SET_MWORLD_WIREFRAME_ON"
            SET MATRIX WIREFRAME ON Parametru(1)
         EndCase
         Case "SET_MWORLD_WIREFRAME_OFF"
            SET MATRIX WIREFRAME OFF Parametru(1)
         EndCase
         Case "UPDATE_MWORLD"
         update matrix Parametru(1)
         endcase
         Case "DELETE_OBJECT"
            Delete object Parametru(1)
         EndCase
         Case "SHOW_OBJECT"
            show object Parametru(1)
         EndCase
         Case "HIDE_OBJECT"
            hide object Parametru(1)
         EndCase
         Case "POSITION_OBJECT "
            POSITION OBJECT Parametru(1),Parametru(2),Parametru(3),Parametru(4)
         EndCase
         `Case "SCALE_OBJECT"
            `SCALE OBJECT Parametru(1),Prametru(2),Parametru(3),Parametru(4)
         `EndCase
         `Case "ROTATE_OBJECT"
            `ROTATE OBJECT Parametru(1),Prametru(2),Parametru(3),Parametru(4)
         `EndCase
         Case "MOVE_OBJECT"
            MOVE OBJECT Parametru(1),Parametru(2)
         EndCase
         Case "XROTATE_OBJECT "
            XROTATE OBJECT Parametru(1),Parametru(2)
         EndCase
         Case "YROTATE_OBJECT"
            YROTATE OBJECT Parametru(1),Parametru(2)
         EndCase
         Case "ZROTATE_OBJECT"
            ZROTATE OBJECT Parametru(1),Parametru(2)
         EndCase
         Case "CONTROL_OBJECT"
         ctr_obj()
         endcase
         Case "MAKE_CONE"
         make_cone()
         endcase
         Case "MAKE_SPHERE"
         make_sphere()
         endcase
         Case "LOOP_ROTATE"
         loop_rotate()
         endcase
         Case "TEXTURE_OBJECT"
         texture_object()
         endcase
         Case ""

EndCase
      EndSelect
      Command$=""
      j=1
      While j<=9
         Parametru(j)=0;
         Parametru$(j)="";
         j=j+1
      endwhile
      AFostGasitParametru=0
   Endif
   i=i+1
endwhile
endfunction

Function InterFisier(scr$)

Open To Read 1, scr$
Do
    Read String 1, MyText$
    If MyText$ = "END" Then exitfunction
    interlinie(MyText$)
    If escapekey() = 1 Then End
   
Loop
Close file 1
ENDFUNCTION

Function ctr_obj()
s#=Parametru(2)
a#=Parametru(3)
dist#=Parametru(4)
height#=Parametru(5)
smooth=Parametru(6)
Do

If upkey() Then move object Parametru(1),s#
   If downkey() Then move object Parametru(1),-s#
   If leftkey() Then yrotate object Parametru(1),wrapvalue(object angle y(1)-a#)
   If rightkey() Then yrotate object Parametru(1),wrapvalue(object angle y(1)+a#)
   set camera To follow object position x(Parametru(1)),object position y(Parametru(1)),object position z(Parametru(1)),object angle y(Parametru(1)),dist#,height#,smooth,0
If escapekey() = 1 Then End
Loop
endfunction

Function make_cube()
make object cube Parametru(1),Parametru(2)
endfunction

Function load_tworld()
If file Open(7) Then Close file 7
               Open To Read 7,"library/a_scripts/load_tworld.txt"
               Read String 7,tworld$
               Close file 7
               make terrain 1,tworld$
endfunction

Function make_mworld()
make matrix Parametru(1),Parametru(2),Parametru(3),Parametru(4),Parametru(5)
endfunction

Function load_object()
load object Parametru$(1),Parametru(1)
endfunction
               
Function window_on()
set Window on
endfunction

Function window_title()
 set Window title Parametru$(1)
 endfunction
 
Function load_tworld_texture()
If file Open(8) Then Close file 8
               Open To Read 8,"library/a_scripts/load_tworld_texture.txt"
               Read String 8,tworld_texture$
               Close file 8
               load image tworld_texture$,700
               texture terrain 1,700
 endfunction
 
 Function frame_rate_on()
 sync on
 endfunction
 
 Function set_frame_rate()
 If file Open(9) Then Close file 9
               Open To Read 9,"library/a_scripts/set_frame_rate.txt"
               Read String 9,sfr$
               Close file 9
               sync rate Val(sfr$)
 endfunction
 
 Function object_collision()
 If object exist(1) Then automatic object collision 1,1,1
 endfunction
 
 Function texture_mworld()
 If file Open(10) Then Close file 10
               Open To Read 10,"library/a_scripts/texture_mworld.txt"
               Read String 10,texture$
               Close file 10
               load image texture$,9499
               If matrix exist(1) Then prepare matrix texture 1,9499,1,1
  endfunction
 
  Function screenout()
  text Parametru(1),Parametru(2),Parametru$(1)
  endfunction
 
Function bomb_particles()
For p=123456 To 123460
    make particles p,0,Parametru(4),Parametru(5)
    Color particles p,Rnd(255)*Tan(12),Rnd(255)*Tan(7),Rnd(255)*Tan(22)
    rotate particles p,Rnd(5000)*htan(6),Rnd(5000)*htan(12),Rnd(5000)
    set particle emissions p,Rnd(255)
    set particle floor p,Rnd(200)
set particle gravity p,15*hsin(10)
position particles p,Parametru(1),Parametru(2),Parametru(3)
Next p
  endfunction
 
Function make_particles()
make particles Parametru(1),Parametru(2),Parametru(3),Parametru(4)
Color particles 1,255,0,0
rotate particles 1,90,0,0
Set particle life 1,75
Set particle speed 1,0.004
endfunction

Function make_particles_fountain()
MAKE PARTICLES Parametru(1),0,1000,Parametru(5)
SET PARTICLE GRAVITY Parametru(1),0
Color particles Parametru(1),0,0,500
Position Particles Parametru(1),Parametru(2),Parametru(3),Parametru(4)
endfunction

Function make_particle_fire()
MAKE PARTICLES Parametru(1),0,1000,Parametru(2)
SET PARTICLE GRAVITY Parametru(1),3
SET PARTICLE CHAOS Parametru(1),5
SET PARTICLE EMISSIONS Parametru(1),10000
SET PARTICLE SPEED Parametru(1),0.001
Color particles Parametru(1),200,10,0
set particle life Parametru(1),10
endfunction

Function make_cone()
make object cone Parametru(1),Parametru(2)
endfunction

Function make_sphere()
make object sphere Parametru(1),Parametru(2)
endfunction

Function Hide_Window()
Hide Window
endfunction

Function Show_Window()
show Window
endfunction

Function Window_size()
set Window size Parametru(1),Parametru(2)
endfunction

Function loop_rotate()
Do
If spacekey() = 1 Then yrotate object 1,object angle y(1) + 0.4
Loop
endfunction

Function texture_object()
texture object Parametru(1),Parametru(2)
endfunction

+ Code Snippet

DarkSide_Set_File_Requester_Extension ".Z3D"
DarkSide_Set_File_Requester_Extension_Pattern "1"
DarkSide_Open_File_Requester
DarkSide_Return_File_Requester_Full
Do
scr$=Get clipboard$()


interfisier(scr$)
InterLinie(Line$)

If escapekey() = 1 Then End
sync
Loop


Function InterLinie(Line$)
Dim Parametru(9)
Dim Parametru$(9)
TypeOfData=1
AuFostGasiteGhilimele=0
StringTemporar$="";
IndicePS=1
IndiceP=1
AFostGasitParametru=0
length=Len(Line$)
i=1
Command$="";
While i<=length
   Char$=Mid$(Line$,i)
   If Char$="/" And i<length
      If Mid$(Line$,i+1) = "/" Then ok=1
   Endif
   If ok=1 Then Exit
   If Char$<>";" And Char$<>" " And AFostGasitParametru=0 And Char$<>"("
      Command$=Command$+Char$
   Endif
   If Char$="("
      AFostGasitParametru=1
   Endif
   If AFostGasitParametru=1 And Char$<>";" And Char$<>"("
      If Char$="," Or Mid$(Line$,i+1)=")"
         If TypeOfData=1
            Parametru(IndiceP)=Val(StringTemporar$)
            IndiceP=IndiceP+1
         Endif
         If TypeOfData=2
            Parametru$(IndicePS)=StringTemporar$
            IndicePS=IndicePS+1
         Endif
         StringTemporar$=""
      Endif
      If Char$="'" Then AuFostGasiteGhilimele=AuFostGasiteGhilimele+1
      If AuFostGasiteGhilimele=1 Then TypeOfData=2
      If AuFostGasiteGhilimele=2
         AuFostGasiteGhilimele=0
         TypeOfData=1
      Endif
      If Char$<>"," And Char$<>"'"
         StringTemporar$=StringTemporar$+Char$
      Endif
   Endif
   If Char$=")"
      AFostGasitParametru=0
   Endif
   If Char$=";"
      Command$=Upper$(Command$)
      Select Command$
         Case "MAKE_CUBE"
            make object cube Parametru(1),Parametru(2)
         endcase
         Case "SCREENOUT"
            text Parametru(1),Parametru(2),Parametru$(1)
         EndCase
         Case "LOAD_OBJECT"
            load object Parametru$(1),Parametru(1)
         EndCase
         Case "POSITION_WINDOW"
            set Window position Parametru(1),Parametru(2)
         EndCase
         Case "WINDOW_TITLE"
            set Window title Parametru$(1)
         EndCase
         Case "WINDOW_SIZE"
            set Window size Parametru(1),Parametru(2)
         EndCase
         Case "WINDOW_ON"
            SET Window ON
         EndCase
         Case "WINDOW_OFF"
            SET Window OFF
         EndCase
         Case "MAXIMIZE_WINDOW"
            MAXIMIZE Window
         EndCase
         Case "MINIMIZE_WINDOW"
            MINIMIZE Window
         EndCase
         Case "HIDE_WNIDOW"
            hide Window
         EndCase
         Case "SHOW_WINDOW"
            show Window
         EndCase
         Case "DISPLAY_MODE"
            set display mode Parametru(1),Parametru(2),Parametru(2)
         EndCase
         Case "SYNC_ON"
            sync on
         EndCase
         Case "SYNC_OFF"
            sync off
         EndCase
         Case "CLEAR_SCREEN"
            Cls
         EndCase
         Case "HOLD_MOUSE"
            Wait mouse
         EndCase
         Case "HOLD_KEY"
            Wait Key
         EndCase
         Case "EXIT"
            Exit
         EndCase
         Case "SYNC"
            sync
         EndCase
         Case "SET_SYNC_RATE"
            sync rate Parametru(1)
         EndCase
         Case "FONT_TEXT"
            set text font Parametru$(1)
         EndCase
         Case "SET_TRANSPARENT_TEXT"
            set text transparent
         EndCase
         Case "TEXT_SIZE"
            set text size Parametru(1)
         EndCase
         Case "TEXT_COLOR"
            ink rgb(Parametru(1),Parametru(2),Parametru(3)),0
         EndCase
         Case "MAKE_BOX"
            box Parametru(1),Parametru(2),Parametru(3),Parametru(4)
         EndCase
         Case "LOCK_PIXELS"
            Lock pixels
         EndCase
         Case "UNLOCK_PIXELS"
            Unlock pixels
         EndCase
         Case "MAKE_CIRCLE"
            Circle Parametru(1),Parametru(2),Parametru(3)
         EndCase
         Case "MAKE_ELLIPSE"
            ellipse Parametru(1),Parametru(2),Parametru(3),Parametru(4)
         EndCase
         Case "LOAD_SOUND"
            load Sound Parametru$(1),Parametru(2)
         EndCase
         Case "PLAY_SOUND"
            Play Sound Parametru(1)
         EndCase
         Case "STOP_SOUND"
            Stop Sound Parametru(1)
         EndCase
         Case "PAUSE_SOUND"
            pause Sound Parametru(1)
         EndCase
         Case "RESUME_SOUND"
            Resume Sound Parametru(1)
         EndCase
         Case "DELETE_SOUND"
            Delete Sound Parametru(1)
         EndCase
         Case "LOOP_SOUND"
            Loop Sound Parametru(1)
         EndCase
         Case "SAVE_SOUND"
            save Sound Parametru$(1),Parametru(1)
         EndCase
         Case "RECORD_SOUND"
            record Sound Parametru(1)
         EndCase
         Case "STOP_RECORD_SOUND"
            Stop recording Sound
         EndCase
         Case "SOUND_SPEED"
            set Sound speed Parametru(1),Parametru(2)
         EndCase
         Case "SOUND_VOLUME"
            set Sound volume Parametru(1),Parametru(2)
         EndCase
         Case "ESCAPEKEY_OFF"
            DISABLE ESCAPEKEY
         EndCase
         Case "ESCAPEKEY_ON"
            ENABLE ESCAPEKEY
         EndCase
         Case "SYSTEMKEYS_OFF"
            DISABLE SYSTEMKEYS
         EndCase
         Case "SYSTEMKEYS_ON"
            ENABLE SYSTEMKEYS
         EndCase
         Case "EXIT_PROMPT"
            Exit prompt Parametru$(1),Parametru$(2)
         EndCase
         Case "LOAD_MUSIC"
            load music Parametru$(1),Parametru(1)
         EndCase
         Case "DELETE_MUSIC"
            Delete music Parametru(1)
         EndCase
         Case "PLAY_MUSIC"
            Play music Parametru(1)
         EndCase
         Case "LOOP_MUSIC"
            Loop music Parametru(1)
         EndCase
         Case "STOP_MUSIC"
            Stop music Parametru(1)
         EndCase
         Case "PAUSE_MUSIC"
            pause music Parametru(1)
         EndCase
         Case "RESUME_MUSIC"
            Resume music Parametru(1)
         EndCase
         Case "MUSIC_SPEED"
            set music speed Parametru(1),Parametru(2)
         EndCase
         Case "MUSIC_VOLUME"
            set music volume Parametru(1),Parametru(2)
         EndCase
         Rem UpDate 1
         Case "LOAD_IMAGE"
            load image Parametru$(1),Parametru(1)
         EndCase
         Case "DELETE_IMAGE"
            Delete image Parametru(1)
         EndCase
         Case "SAVE_IMAGE"
            save image Parametru$(1),Parametru(1)
         EndCase
         Case "GET_IMAGE"
            Get image Parametru(1),Parametru(2),Parametru(3),Parametru(4),Parametru(5)
         EndCase
         Case "PASTE_IMAGE"
            paste image Parametru(1),Parametru(2),Parametru(3)
         EndCase
         Case "MAKE_CAMERA"
            make camera Parametru(1)
         EndCase
         Case "DELETE_CAMERA"
            Delete camera Parametru(1)
         EndCase
         Case "MOVE_CAMERA"
            move camera Parametru(1)
         EndCase
         Case "POSITION_CAMERA"
            position camera Parametru(1),Parametru(2),Parametru(3)
         EndCase
       
         Case "ROTATE_CAMERA"
            rotate camera Parametru(1),Parametru(2),Parametru(3)
         EndCase
         Case "XROTATE_CAMERA"
            xrotate camera Parametru(1)
         EndCase
         Case "YROTATE_CAMERA"
            yrotate camera Parametru(1)
         EndCase
         Case "ZROTATE_CAMERA"
            zrotate camera Parametru(1)
         EndCase
         Case "TURN_CAMERA_LEFT"
            turn camera Left Parametru(1)
         EndCase
         Case "TURN_CAMERA_RIGHT"
            turn camera Right Parametru(1)
         EndCase
         Case "PITCH_CAMERA_UP"
            PITCH CAMERA UP Parametru(1)
         EndCase
         Case "PITCH_CAMERA_DOWN"
            PITCH CAMERA down Parametru(1)
         EndCase
         Case "ROLL_CAMERA_LEFT"
            ROLL CAMERA Left Parametru(1)
         EndCase
         Case "ROLL_CAMERA_RIGHT"
            ROLL CAMERA Right Parametru(1)
         EndCase
         Case "SET_CURRENT_CAMERA"
            SET CURRENT CAMERA Parametru(1)
         EndCase
         Case "CLEAR_CAMERA_VIEW"
            Clear CAMERA View Parametru(1)
         EndCase
         Case "AUTOCAM_ON"
            AUTOCAM ON
         EndCase
         Case "AUTOCAM_OFF"
            AUTOCAM OFF
         EndCase
         Case "BACKDROP_ON"
            BACKDROP ON
         EndCase
         Case "BACKDROP_OFF"
            BACKDROP OFF
         EndCase
         Case "TEXTURE_BACKDROP"
            TEXTURE BACKDROP Parametru(1)
         EndCase
         Case "BOMB_PORTICLES"
            bomb_particles()
         EndCase
         Case "MAKE_PARTICLES"
            make_particles()
         EndCase
         Case "MAKE_PARTICLES_FOUNTAIN"
            make_particles_fountain()
         EndCase
         Case "MAKE_PARTICLE_FIRE"
            make_particle_fire();
         EndCase
         Case "SET_CAMERA_FOV"
            SET CAMERA FOV Parametru(1)
         EndCase
         Case "SET_CAMERA_RANGE"
            SET CAMERA RANGE Parametru(1),Parametru(2)
         EndCase
         Case "SET_CAMERA_VIEW"
            SET CAMERA View Parametru(1),Parametru(2),Parametru(3),Parametru(4)
         EndCase
         Case "SET_CAMERA_ASPECT"
            SET CAMERA ASPECT Parametru(1)
         EndCase
         Case "CONTROL_CAMERA_USING_ARROWKEYS "
            CONTROL CAMERA Using ARROWKEYS Parametru(1),Parametru(2),Parametru(3)
         EndCase
         Case "SHOW_MOUSE"
            show mouse
         EndCase
         Case "HIDE_MOUSE"
            hide mouse
         EndCase
         Case "POSITION_MOUSE"
            position mouse Parametru(1),Parametru(2)
         EndCase
         Case "MAKE_MWORLD"
            MAKE MATRIX Parametru(1),Parametru(2),Parametru(3),5,5
         EndCase
         Case "DELETE_MWORLD"
            Delete MATRIX Parametru(1)
         EndCase
         Case "TEXTURE_MWORLD"
            PREPARE MATRIX TEXTURE Parametru(1),Parametru(2),1,1
         EndCase
         Case "POSITION_MWORLD"
            POSITION MATRIX Parametru(1),Parametru(2),Parametru(3),Parametru(4)
         EndCase
         Case "RANDOMIZE_MWORLD "
            Randomize MATRIX Parametru(1),Parametru(2)
         EndCase
         Case "GHOST_MWORLD_ON "
            GHOST MATRIX ON Parametru(1)
         EndCase
         Case "GHOST_MWORLD_OFF"
            GHOST MATRIX OFF Parametru(1)
         EndCase
         Case "SET_MWORLD_WIREFRAME_ON"
            SET MATRIX WIREFRAME ON Parametru(1)
         EndCase
         Case "SET_MWORLD_WIREFRAME_OFF"
            SET MATRIX WIREFRAME OFF Parametru(1)
         EndCase
         Case "UPDATE_MWORLD"
         update matrix Parametru(1)
         endcase
         Case "DELETE_OBJECT"
            Delete object Parametru(1)
         EndCase
         Case "SHOW_OBJECT"
            show object Parametru(1)
         EndCase
         Case "HIDE_OBJECT"
            hide object Parametru(1)
         EndCase
         Case "POSITION_OBJECT "
            POSITION OBJECT Parametru(1),Parametru(2),Parametru(3),Parametru(4)
         EndCase
         `Case "SCALE_OBJECT"
            `SCALE OBJECT Parametru(1),Prametru(2),Parametru(3),Parametru(4)
         `EndCase
         `Case "ROTATE_OBJECT"
            `ROTATE OBJECT Parametru(1),Prametru(2),Parametru(3),Parametru(4)
         `EndCase
         Case "MOVE_OBJECT"
            MOVE OBJECT Parametru(1),Parametru(2)
         EndCase
         Case "XROTATE_OBJECT "
            XROTATE OBJECT Parametru(1),Parametru(2)
         EndCase
         Case "YROTATE_OBJECT"
            YROTATE OBJECT Parametru(1),Parametru(2)
         EndCase
         Case "ZROTATE_OBJECT"
            ZROTATE OBJECT Parametru(1),Parametru(2)
         EndCase
         Case "CONTROL_OBJECT"
         ctr_obj()
         endcase
         Case "MAKE_CONE"
         make_cone()
         endcase
         Case "MAKE_SPHERE"
         make_sphere()
         endcase
         Case "LOOP_ROTATE"
         loop_rotate()
         endcase
         Case "TEXTURE_OBJECT"
         texture_object()
         endcase
         Case ""

         EndCase
      EndSelect
      Command$=""
      j=1
      While j<=9
         Parametru(j)=0;
         Parametru$(j)="";
         j=j+1
      endwhile
      AFostGasitParametru=0
   Endif
   i=i+1
endwhile
endfunction

 Function InterFisier(scr$)

Open To Read 1, scr$
Do
    Read String 1, MyText$
    If MyText$ = "END" Then exitfunction
    interlinie(MyText$)
    If escapekey() = 1 Then End
   
Loop
Close file 1
ENDFUNCTION


Function ctr_obj()
s#=Parametru(2)
a#=Parametru(3)
dist#=Parametru(4)
height#=Parametru(5)
smooth=Parametru(6)
Do

   If upkey() Then move object Parametru(1),s#
   If downkey() Then move object Parametru(1),-s#
   If leftkey() Then yrotate object Parametru(1),wrapvalue(object angle y(1)-a#)
   If rightkey() Then yrotate object Parametru(1),wrapvalue(object angle y(1)+a#)
   set camera To follow object position x(Parametru(1)),object position y(Parametru(1)),object position z(Parametru(1)),object angle y(Parametru(1)),dist#,height#,smooth,0
If escapekey() = 1 Then End
Loop
endfunction

Function make_cube()
make object cube Parametru(1),Parametru(2)
endfunction

Function load_tworld()
If file Open(7) Then Close file 7
               Open To Read 7,"library/a_scripts/load_tworld.txt"
               Read String 7,tworld$
               Close file 7
               make terrain 1,tworld$
endfunction

Function make_mworld()
make matrix Parametru(1),Parametru(2),Parametru(3),Parametru(4),Parametru(5)
endfunction

Function load_object()
load object Parametru$(1),Parametru(1)
endfunction
               
Function window_on()
set Window on
endfunction               

Function window_title()
 set Window title Parametru$(1)
 endfunction
 
Function load_tworld_texture()
If file Open(8) Then Close file 8
               Open To Read 8,"library/a_scripts/load_tworld_texture.txt"
               Read String 8,tworld_texture$
               Close file 8
               load image tworld_texture$,700
               texture terrain 1,700
 endfunction
 
 Function frame_rate_on()
 sync on
 endfunction
 
 Function set_frame_rate()
 If file Open(9) Then Close file 9
               Open To Read 9,"library/a_scripts/set_frame_rate.txt"
               Read String 9,sfr$
               Close file 9
               sync rate Val(sfr$)
 endfunction
 
 Function object_collision()
 If object exist(1) Then automatic object collision 1,1,1
 endfunction
 
 Function texture_mworld()
 If file Open(10) Then Close file 10
               Open To Read 10,"library/a_scripts/texture_mworld.txt"
               Read String 10,texture$
               Close file 10
               load image texture$,9499
               If matrix exist(1) Then prepare matrix texture 1,9499,1,1
  endfunction
 
  Function screenout()
  text Parametru(1),Parametru(2),Parametru$(1)
  endfunction
 
Function bomb_particles()
For p=123456 To 123460
    make particles p,0,Parametru(4),Parametru(5)
    Color particles p,Rnd(255)*Tan(12),Rnd(255)*Tan(7),Rnd(255)*Tan(22)
    rotate particles p,Rnd(5000)*htan(6),Rnd(5000)*htan(12),Rnd(5000)
    set particle emissions p,Rnd(255)
    set particle floor p,Rnd(200)
set particle gravity p,15*hsin(10)
position particles p,Parametru(1),Parametru(2),Parametru(3)
Next p
  endfunction
 
Function make_particles()
make particles Parametru(1),Parametru(2),Parametru(3),Parametru(4)
Color particles 1,255,0,0
rotate particles 1,90,0,0
Set particle life 1,75
Set particle speed 1,0.004
endfunction

Function make_particles_fountain()
MAKE PARTICLES Parametru(1),0,1000,Parametru(5)
SET PARTICLE GRAVITY Parametru(1),0
Color particles Parametru(1),0,0,500
Position Particles Parametru(1),Parametru(2),Parametru(3),Parametru(4)
endfunction

Function make_particle_fire()
MAKE PARTICLES Parametru(1),0,1000,Parametru(2)
SET PARTICLE GRAVITY Parametru(1),3
SET PARTICLE CHAOS Parametru(1),5
SET PARTICLE EMISSIONS Parametru(1),10000
SET PARTICLE SPEED Parametru(1),0.001
Color particles Parametru(1),200,10,0
set particle life Parametru(1),10
endfunction

Function make_cone()
make object cone Parametru(1),Parametru(2)
endfunction

Function make_sphere()
make object sphere Parametru(1),Parametru(2)
endfunction

Function Hide_Window()
Hide Window
endfunction

Function Show_Window()
show Window
endfunction

Function Window_size()
set Window size Parametru(1),Parametru(2)
endfunction

Function loop_rotate()
Do
If spacekey() = 1 Then yrotate object 1,object angle y(1) + 0.4
Loop
endfunction

Function texture_object()
texture object Parametru(1),Parametru(2)
endfunction

Back to top

Profile PM Email Website

Dr Schnitzengruber

16

Years of Service

User Offline

Joined: 19th Jul 2007

Location: C:/Projects/failed/ schnitzengruber

Posted: 22nd Dec 2007 01:08

Link

Quote: "But i don't think it is a problem posting the snippet so other can learn from my code! "

It's not a problem because you need DBPro to use that code. As long as nobody posts the .exe you should be okay

. Altough, this is like a uber-slow version of DB that can't have plug-ins or constants.

Back to top

Profile PM

Aaron Miller

18

Years of Service

User Offline

Joined: 25th Feb 2006

Playing: osu!

Posted: 29th Dec 2007 02:25

Link

Quote: "As long as nobody posts the .exe you should be okay"

Don't call it DBP, call it "interpreted basic" or something. Post the EXE and change the commands a little. That'd be legal according to the DBP license. Lee and Mike would be mad most likely, but then again they still have FPSC and versus any piracy that there is for DBP I don't think this would be as big a deal.

Cheers,

-naota

Madness never stops..... It takes a breather every once in a while, but then it grabs it's inhaler and chases you down the street with a cane.
Aex.Uni forums

Back to top

Profile PM Email Website

n008

17

Years of Service

User Offline

Joined: 18th Apr 2007

Location: Chernarus

Posted: 29th Dec 2007 03:15

Link

Quote: "Lee and Mike would be mad most likely"

And since lee:TGC::God:universe, zapitikal == user.dead();

Back to top

Profile PM

n008

17

Years of Service

User Offline

Joined: 18th Apr 2007

Location: Chernarus

Posted: 29th Dec 2007 03:15

Link

Quote: "Lee and Mike would be mad most likely"

And since lee:TGC::God:universe,

+ Code Snippet

zapitikal = user.dead();

Back to top

Profile PM

calcyman

16

Years of Service

User Offline

Joined: 31st Aug 2007

Location: The Uncertainty Principle

Posted: 29th Dec 2007 15:09

Link

@n008: Couldn't you have edited your first post?

@Zapakitul: I theorised about doing something like this, but not as an interpreted language. Behold, a program which can code itself!

Your signature has been erased by a hyper-intelligent pan-dimensional being (a mod)

Back to top

Profile PM Email

n008

17

Years of Service

User Offline

Joined: 18th Apr 2007

Location: Chernarus

Posted: 29th Dec 2007 15:44

Link

@Calcyman: I didn't do that on purpose ...

Back to top

Profile PM

Sorry your browser is not supported!

Code Snippets / [DBPro] DBPro interpreted