Sorry your browser is not supported!

Set Display Mode 800,600,32
Set Window On

Center Text Screen Width()/2,Screen Height()/2,"The Xmas Gift"
Center Text Screen Width()/2,Screen Height()/2+24,"by Frankie 'Techlord' Taylor"
Center Text Screen Width()/2,Screen Height()/2 + 48,"Christmas DBPro Minimal Media Coding Competition 2007"
Wait 3000
Cls
Center Text Screen Width()/2,Screen Height()/2,"Be the first to guess whats in the small Xmas Package and receive a REAL big Suprize!"
Center Text Screen Width()/2,Screen Height()/2 + 24,"~ Hints ~"
Center Text Screen Width()/2,Screen Height()/2 + 36,"It can be found in a Christmas Song."
Center Text Screen Width()/2,Screen Height()/2 + 48,"Type your guess in as a single word with no spaces."
Center Text Screen Width()/2,Screen Height()/2 + 60,"If you give up, type 'Quit' to exit."
Center Text Screen Width()/2,Screen Height()/2 + 84,"Enter Your Forum Nickname to Start"

Repeat
    Set Cursor Screen Width()/2 + (17 * 8),Screen Height()/2 + 84
    Input ": ",XGIFT_ForumNickname$
Until XGIFT_ForumNickname$ <> ""
Clear Entry Buffer

Cls
Center Text Screen Width()/2,Screen Height()/2,"Get Ready to Play " + XGIFT_ForumNickname$ + "!"
Wait 3000

Sync On
Sync Rate 60

XGIFT_Light = 1
XGIFT_Package =  1
XGIFT_Guess$ = ""

Color Backdrop RGB(0,127,0)
Load Object "Gift01.x",XGIFT_Package
Make Light XGIFT_Light
Xrotate Object XGIFT_Light,90

XGIFT_State = 0
XGIFT_Message$ = XGIFT_ForumNickname$ + ", Guess What Santa Brought You For Xmas?"

Repeat

    Center Text Screen Width()/2,8,XGIFT_Message$
    Center Text Screen Width()/2,32,XGIFT_Entry$ `+ "[" + Str$(XGIFT_State) + "]"
    Select XGIFT_State
        Case -1
            Center Text Screen Width()/2,24, "Thanks for Playing " + XGIFT_ForumNickname$ + ". Have a Very Merry Christmas and Happy New Year!"
            If XGIFT_GameOver
                Sync
                Wait Key
                End
            EndIf
            Center Text Screen Width()/2,Screen Height() - 128, "(ESC)APE or (RETURN)?"
            Sync
            Do
                If EscapeKey() Then End
                If ReturnKey()
                        Clear Entry Buffer
                        XGIFT_State = 0
                        Exit
                EndIf
            Loop
        EndCase

        Case 0
            XGIFT_Entry$ = Entry$(1)
            If ReturnKey()
                XGIFT_Guess$ = Left$(Lower$(XGIFT_Entry$),Len(XGIFT_Entry$)-1)`make lowercase & strip of chr(13)
                XGIFT_Entry$ = ""
                Clear Entry Buffer
                If XGIFT_Guess$ = "quit"
                    XGIFT_State = -1
                Else
                    If Len(XGIFT_Guess$) > 2
                        XGIFT_State = 1
                    Else
                        XGIFT_Message$ = "You have to guess something. Please Try Again? "
                        XGIFT_State = 0
                    EndIf
                EndIf
            EndIf
        EndCase

        Case 1
            FTP Connect "www.hpquest.com", "dbpxmasgift", XGIFT_Guess$ + "X1"
            FTP Get File XGIFT_Guess$,XGIFT_Guess$,512
            If Get FTP Status() = 0  Or Get FTP Failure() = 1
                    Inc XGIFT_Check
                    XGIFT_Message$ = "Sorry, Santa checked his List " + Str$(XGIFT_Check) + " time(s) and found that You have been NAUGHTY!" `+ Get FTP Error$()
                    XGIFT_State = -1
            Else
                    XGIFT_LetterToSanta = 1
                    Open To Write XGIFT_LetterToSanta,"Dear_Santa.txt"
                        Write String XGIFT_LetterToSanta,"Dear Santa, Thank You, From " + XGIFT_ForumNickname$ + "."
                    Close File XGIFT_LetterToSanta
                    XGIFT_State = 2
            EndIf
        EndCase

        Case 2
            FTP Proceed
            If Get FTP Progress() > -1
                XGIFT_Message$ = "Santa is checking his list, he's checking it " + Str$(Get FTP Progress()) + "..."
            Else
                FTP Terminate
                FTP Put File "Dear_Santa.txt"
                FTP Disconnect
                XGIFT_State = 3
            EndIf
        EndCase

        Case 3
            XGIFT_Message$ = "Santa checked his list and found that you have been NICE. He left you a Special Gift!"
            XGIFT_Contents = 1
            Open To Read XGIFT_Contents,XGIFT_Guess$
                Read String XGIFT_Contents,XGIFT_Contents$
            Close File XGIFT_Contents
            XGIFT_State = 4
        EndCase

        Case 4
            Inc XGIFT_Counter
            If XGIFT_Counter = 255
                XGIFT_Message$ = XGIFT_Contents$
                XGIFT_Counter = 0
                XGIFT_GameOver = 1
                XGIFT_State = -1
            EndIf
        EndCase

    EndSelect

    Rotate Object XGIFT_Package ,Object Angle X(XGIFT_Package)+.5,Object Angle Y(XGIFT_Package)+.5,Object Angle Z(XGIFT_Package)+.5

    Sync

Until EscapeKey()
End

remstart
******************************************************************************************************************
         Santas gift delivery by Attila 2007

         help santa deliver his gifts, you will deliver 10 gifts to the houses indicated by
         yellow arrows. You will deliver all gifts in 150 seconds, or loose the game.

         Use the arrow-keys to accelerate, break and turn left or right your sledge.
         Drop the gifts using the space key. While droppping a camera in the right upper corner
         shows the falling gift.

         If you hit the house you will get a paket too.

******************************************************************************************************************
remend
set display mode 640,480,16
randomize rnd(timer()+mousex()+mousey())
`
` Umcomment following lines for windows mode
`
remstart
set window on
set window title "Merry Christmas"
set window position 320,240
set window layout 1,1,1
restore window
remend

set text transparent
set text font "Verdana"
set text size 18
set text to bold
backdrop on
color backdrop rgb(0,0,64)
hide mouse
`set ambient light 100
fog on
fog color rgb(96,96,128)
fog distance 450
autocam off

type NotenRecord
   note as integer
   speed as integer
   volume as integer
endtype

dim master_note(-1) as NotenRecord


dim cx#(10)
dim cz#(10)
dim co(10)
ccnt=0

` some music
CreateMidi("bing",13,7,"q c5 r r r q")
CreateMidi("wewishyou",25,7,"q g4 c5 r c5 d5 q c5 b4 a4 r a4 r r a4 d5 r d5 e5 d5 c5 b4 r g4 r g4 r e5 r e5 f5 e5 d5 c5 r a4 r g4 g4 a4 r d5 r b4 r c5 r r q")

load music "wewishyou.mid",1
load music "bing.mid",2
loop music 1
set music volume 1,70

makeIntro(9)
sprite 9,0,0,9
sync on
sync rate 0
`sledge(100)
te=timer()+10000
`instrument 11 = cowbell
`
MakeBitmap("SNOW",12)
MakeBitmap("BRANCH",10)
MakeBitmap("BARK",11)
MakeBitmap("GROUND",13)
MakeBitmap("HOUSE",14)
MakeBitmap("ROOF",15)
MakeBitmap("FIREPLACE",16)
MakeBitmap("COVER",17)
MakeBitmap("SKY",18)

create bitmap 25,150,20
set current bitmap 25
ink rgb(255,64,0),0
box 0,0,150,20
ink rgb(255,255,0),0
line 0,5,150,5

get image 25,0,0,150,20
set current bitmap 0

load bitmap "Gift01.jpg",20
set current bitmap 20
get image 19,62,80,116,128
set current bitmap 0

make matrix 1,1000,1000,20,20
prepare matrix texture 1,13,1,1
randomize matrix 1,25
update matrix 1

`Skybox
make object plain 2000,1000,500
texture object 2000,18
position object 2000,500,250,1000
clone object 2000,2001
yrotate object 2001,180
position object 2001,500,250,0
make object plain 2002,1000,500
texture object 2002,18
yrotate object 2002,270
position object 2002,1000,250,500
make object plain 2003,1000,500
texture object 2003,18
yrotate object 2003,90
position object 2003,0,250,500

y1#=get ground height(1,500,500)

MAKE SNOW PARTICLES 1, 12, 3550, 500,y1#+10,500, 50, 35, 50

`  Ceate the x-mas trees

no=100
`  Tree(s)
for tree=0 to 20
   px=500+(rnd(150)-75)
   pz=500+(rnd(150)-75)
   y2#=get ground height(1,px,pz)
   oldeh=0
   for n=0 to 2
      for h=1 to 180 step 30
         make object plain no,6-n,4-n
         texture object no,10
         if n=0 then eh=3
         if n=1 then eh=5
         if n=2 then eh=6.5
         position object no, px,y2#+eh,pz
         yrotate object no,h
         set object transparency no,1
         set object cull no,0
         no=no+1
      next h
   next n
next tree

`  House
for h=1 to 10
   make object box no,10,6,7
   texture object no, 14
   ok=0
   while ok=0
      px=500+(rnd(150)-75)
      pz=500+(rnd(150)-75)
      sync
      y2#=get ground height(1,px,pz)
      position object no,px,y2#+3,pz
      if object collision (no,0)
         ok=0
      else
         ok=1
      endif
   endwhile
   co(ccnt)=no
   cx#(ccnt)=px
   cz#(ccnt)=pz
   no=no+1
   `Roof
   make object box no,9.8,5.7,5.7
   xrotate object no, 45
   position object no,px,y2#+5.5,pz
   texture object no,15
   no=no+1
   make object box no, 2,10,3
   texture object no, 16
   position object no, px+6,y2#+5,pz
   no=no+1
   make object box no, 2,.1,3
   texture object no, 17
   position object no, px+6,y2#+10.05,pz
   ccnt=ccnt+1
   no=no+1
next h
max=no-1

r#=0
while timer() < te
   sleep 1
   sync
endwhile
delete sprite 9

` Visor
make object box 1,8,.1,8
boxtexture(20)
texture object 1,20
set object transparency 1,1
set object cull 1,0
`xrotate object 1,wrapvalue(-45)
yg#=get ground height(1,500,500)
position object 1, 500,yg#+5,500

` Arrow
make object box 2,3,5,3
set current bitmap 20
get image 21,1,2,6,4
texture object 2,21
set current bitmap 0
make object box 3,2.9,3,3
xrotate object 3,45
texture object 3,21
position object 2 ,cx#(0),37,cz#(0)
position object 3 ,cx#(0),35.6,cz#(0)

load object "Gift01.x", 10
scale object 10,3,3,3

x#=500
z#=490
r#=atanfull(cx#(0)-x#,cz#(0)-z#)
speed#=.1
position camera x#,y1#+50,z#

make camera 1
position camera 1, 208,sh+3,208
set camera to image 1,1,256,256
`  Position the Sprite (Output Screen) right/top
lp=screen width()+1
sprite 1,lp,-30,1
size sprite 1, 256,192

create bitmap 25,150,20
set current bitmap 25
ink rgb(255,0,0),0
box 0,0,150,20
get image 25,0,0,150,20
set current bitmap 0

create bitmap 26,154,40
set current bitmap 26
ink rgb(0,0,200),0
box 0,0,154,40
ink rgb(255,255,0),0
set text size 13
text 5,3,"Remaining time"
get image 26,0,0,154,40
set current bitmap 0

sprite 26,5,screen height()-67,26
sprite 25,7,screen height()-50,25
size sprite 25,150,20


Restart:
clear entry buffer
tr=0
drop=0
Treffer=0
st=timer()
clear entry buffer

while -1
   if spacekey() and drop=0
      rp#=r#
      sp#=speed#
      py#=y#+8
      lp=screen width()-256
      drop=-1
      fs#=.1
      sleep 1
   endif

   if drop=-1
      dpz#=cos(rp#)
      dpx#=cos(90-rp#)
      zp#=z#+sp#*dpz#
      xp#=x#+sp#*dpx#
      py#=py#-fs#
      yrotate object 10,wrapvalue(r#+180)
      position object 10,xp#,py#,zp#
      if fs# < 1 then fs#=fs#*1.2
      set camera to follow 1,xp#,py#,zp#,r#+90,9,py#+5,35,1
      point camera 1,xp#,py#,zp#
      gh#=get ground height(1,xp#,zp#)
      if object collision(10,co(tr))
         if not music playing(2) then play music 2
         set music volume 2, 120
         tr=tr+1
         drop=0
         lp=screen width()+1
         sprite 50+Treffer,Treffer*58,0,19
         sync
         Treffer=Treffer+1
         dpz#=cos(r#)
         dpx#=cos(90-r#)
         zp#=z#+10*dpz#
         xp#=x#+10*dpx#
         zp#=z#
         xp#=x#
         yrotate object 10,wrapvalue(r#+180)
         position object 10,xp#,y#+2.0,zp#
         set camera to follow 1,xp#,y#+4,zp#,r#+90,9,42,15,1
         sprite 1,lp,-30,1
         if treffer >= 9 then goto win
      endif
      if py# <= (gh#-10) and drop=-1
         drop=0
         lp=screen width()+1
         sleep 500
         ts=ts-5000
      endif
   else
      dpz#=cos(r#)
      dpx#=cos(90-r#)
      zp#=z#+10*dpz#
      xp#=x#+10*dpx#
         zp#=z#
         xp#=x#
      yrotate object 10,wrapvalue(r#+180)
      position object 10,xp#,y#+4.0,zp#
      set camera to follow 1,xp#,y#+4,zp#,r#+90,9,42,15,1
`      position camera 2,xp#,y#+4,zp#
`      yrotate camera 2,wrapvalue(r#+180)
`      point camera 2,xp#,0,zp#
   endif

   position object 2 ,cx#(tr),37,cz#(tr)
   position object 3 ,cx#(tr),34.6,cz#(tr)

   sprite 1,lp,-30,1
   if rightkey() then r#=r#+1.2
   if leftkey() then r#=r#-1.2
   if upkey() then speed#=speed#+.01
   if downkey() then speed#=speed#-.01
   if speed# < 0 then speed#=0
   if speed# > 1.5 then speed#=1.5
   oldx#=x#
   oldz#=z#

   dz#=cos(r#)
   dx#=cos(90-r#)

   di#=sqrt((x#-500)*(x#-500)+(z#-500)*(z#-500))
   if di# > 250 then r#=r#+2
   dz#=cos(r#)
   dx#=cos(90-r#)
   z#=z#+speed#*dz#
   x#=x#+speed#*dx#
   y#=get ground height(1,px#,z#)+35
   y#=40
   position object 1,x#,y#,z#
   yrotate object 1,wrapvalue(r#)

   set camera to follow 0,x#,y#,z#,r#+5,5,y#+2,15,1
   point camera x#,y#,z#
   position particles 1,x#,y#+6,z#
   ink rgb(0,0,128),0
   t=150-int((timer()-st)/1000)
   if t < 0 then goto lost
   size sprite 25,t+1,20
   ink rgb(0,0,255),0

   sync
endwhile
end

lost:
   for h=50 to 61
      if sprite exist(h) then delete sprite h
   next h
   set text size 84
   center text 320,240,"you loose"
   set text size 32
   center text 320,340,"press any key to restart or esc to exit"
   sync
   clear entry buffer
   suspend for key
   goto Restart
   end

win:
   for h=50 to 61
      if sprite exist(h) then delete sprite h
   next h
   set text size 84
   center text 320,240,"you win"
   set text size 32
   center text 320,340,"press any key to restart or esc to exit"
   sync
   clear entry buffer
   suspend for key
   goto Restart
   end

function boxtexture(nr)
create bitmap nr,128,128
set current bitmap nr
ink rgb(255,32,0),0
box 0,0,128,128
ink rgb(255,255,0),0
box 2,2,126,4
box 2,124,126,126
box 2,2,4,126
box 124,2,126,126
ink rgb(0,0,0),0
box 6,6,122,122
ink rgb(0,0,32),0
line 63,6,63,122
line 64,6,64,122
line 65,6,65,122

line 6,63,122,63
line 6,64,122,64
line 6,65,122,65

get image nr,0,0,128,128
set current bitmap 0
sync
endfunction

function MakeBitmap(N$,nr)
create bitmap nr,128,128
set current bitmap nr
if n$="SKY"
   randomize timer()
   ink rgb(128,128,255),0
   box 0,0,128,128
   for n=1 to 120
      px=rnd(256)-64
      py=rnd(128)
      m=rnd(20)+5
      for h=1 to m
         ink rgb(255-m,255-m,255),1
         ellipse px,py,h,2*h/3
      next h
   next n
endif
if n$="COVER"
   ink rgb(164,164,164),0
   box 0,0,128,128
   ink rgb(0,0,0),0
   box 10,10,118,118
endif
if n$="FIREPLACE"
   ink rgb(164,164,164),0
   box 0,0,128,128
   ink rgb(16,16,16),0
   for h=1 to 128 step 12
      line 0,h,128,h
   next h
endif
if n$="ROOF"
   ink rgb(164,32,0),0
   box 0,0,128,128
   ink rgb(255,255,1255),0
   for h=-128 to 128 step 20
      line h,0,h+128,128
   next h
   for h=256 to 1 step -20
      line h,0,h-128,128
   next h
endif
if n$="HOUSE"
   ink rgb(164,164,0),0
   box 0,0,128,128
   ink rgb(16,16,128),0
   for h=1 to 128 step 12
      line 0,h,128,h
   next h
   ink rgb(128,128,128),0
   for h=2 to 128 step 12
      line 0,h,128,h
   next h
   ink rgb(255,0,0),0
   box 44,10,84,70
   ink rgb(0,0,16),0
   box 48,14,80,66
   ink rgb(255,0,0),0
   line 63,14,63,66
   line 64,14,64,66
   line 65,14,65,66
   line 48,29,80,29
   line 48,30,80,30
   line 48,31,80,31
endif
if n$="BRANCH"
   ink rgb(255,255,0),0
   box 0,0,128,1
   ink rgb(0,128,0),0
   box 0,0,128,128
   for h=1 to 1500
      ink rgb(200,200,0),0
      px=rnd(128)
      py=rnd(128)
      dot px,py
      ink rgb(60,80,0),0
      dot px-.5,py-.5
   next h

   ink 0,0
   for h=1 to 64
      box 0,0,h,2*(64-h)
   next h
   for h=1 to 64
      box 64+h,0,128,2*(h)
   next h
   for h=0 to 128 step 8
      line 64,h,h/2,128
      line 64,h,128-h/2,128
   next h
   ink rgb(255,255,255),0
   line 64,0,0,128
   line 64,1,1,128
   line 64,0,128,128
   line 64,1,128,127
endif
if n$="GROUND"
   ink rgb(240,240,243),0
   box 0,0,128,128
   for h=1 to 100
      px=rnd(128)
      py=rnd(128)
      r=rnd(15)
      for p1=0 to 2
         ink rgb(255,255,255),0
         circle px,py,r
         ink rgb(255,255,255),0
         circle px+1,py+1,r
      next p1
   next h
endif
if n$="SNOW"
   ink rgb(0,0,0),0
   box 0,0,128,128
   ink rgb(255,255,255),0
   for h=1 to 128 step 10
      line h,0,128-h,128
      line 0,h,128,128-h
   next h
   ink rgb(0,0,0),0
   for r=64 to 128
      circle 64,64,r
   next h
endif
if n$="BARK"
   ink rgb(64,64,0),0
   box 0,0,128,128
   for h=1 to 1500
      ink rgb(220,220,0),0
      px=rnd(128)
      py=rnd(128)
      ink rgb(128,96,0),0
      dot px,py
      for n1=0 to 5
         dot px,py+n1
      next n1
      dot px+,py
      for n1=0 to 5
         dot px+1,py+n1
      next n1
   next h
endif

`for h=1 to 20:ink rgb(189,120,36),0:px=rnd(128):py=rnd(128):for h1=1 to 10:circle px,py,h1:next h1:next h:endif
get image nr,0,0,128,128
set current bitmap 0
sync
endfunction

function MakeIntro(nr)
create bitmap nr,640,480
set current bitmap nr
ink rgb(250,250,255),0
box 0,0,640,480

ink rgb(196,196,255),1
for h=1 to 2000
   px=rnd(640)
   py=rnd(480)
   line px,py,px+4,py+4
   line px+4,py+4,px,py+4
   line px+2,py,px+2,py
next h

set text size 64
set text to bold
ink rgb(128,128,255),0
center text 319,80,"merry Christmas"
ink rgb(32,32,32),0
center text 323,82,"merry Christmas"
ink rgb(255,64,32),0
center text 321,81,"merry Christmas"

set text size 32
ink rgb(128,128,255),0
center text 319,200,"take control of Santas sledge!"
ink rgb(164,164,255),0
center text 321,201,"take control of Santas sledge!"

ink rgb(128,128,255),0
center text 319,240,"use arrow-key to control speed"
ink rgb(164,164,255),0
center text 321,241,"use arrow-key to control speed"

ink rgb(128,128,255),0
center text 319,274,"and direction. Use space to drop gift."
ink rgb(164,164,255),0
center text 321,275,"and direction. Use space to drop gift."

ink rgb(128,128,255),0
center text 319,310,"Target is indicated by arrow"
ink rgb(164,164,255),0
center text 321,311,"Target is indicated by arrow"


ink rgb(128,128,255),0
center text 320,430,"(C) 2007 by Attila"
ink rgb(32,32,255),0
center text 321,431,"(C) 2007 by Attila"
get image nr,0,0,640,480
set current bitmap 0
set text size 12
sprite nr,0,0,nr
sync
endfunction



function CreateMidi(file as string,instrument as integer,tempo as integer,notes as string)
remstart
   Base of this procedure was posted on 23rd Dec 2006 by Hobgoblin Lord in TGC Forums
remend
SPEED=165
notes=" "+notes
for a = 1 to len(notes)
   watch$=mid$(notes,a)
   if watch$=" "
      start=a:test_note$=""
      repeat
         inc start
         new$=mid$(notes,start)
         if new$<>" "
            test_note$=test_note$+new$
         endif
      until new$=" " or start=len(notes)
    note_on=1
    if len(test_note$)=1
      select lower$(test_note$)
         case "q":SPEED=135:endcase
         case "8":speed=134:endcase
         case "h":speed=140:endcase
         case "r":array insert at bottom master_note():count=array count(master_note())
            master_note(count).note=0:master_note(count).speed=SPEED:master_note(count).volume=0
         endcase
      endselect
      note_on=0
    else
      temp_note$=left$(test_note$,1):temp_octave=val(right$(test_note$,1))
      select lower$(temp_note$)
         case "c":note_base=0:endcase
         case "d":note_base=2:endcase
         case "e":note_base=4:endcase
         case "f":note_base=5:endcase
         case "g":note_base=7:endcase
         case "a":note_base=9:endcase
         case "b":note_base=11:endcase
      endselect
      inc note_base,Temp_octave*12
      if len(test_note$)=3 then inc note_base
    endif
      if note_on=1
        array insert at bottom master_note()
        count=array count(master_note())
        master_note(count).note=note_base
        master_note(count).speed=SPEED
        master_note(count).volume=127
      endif
    endif
   next a

   `figure bytes in the track
   track_total=20+((array count(master_note())+1)*9)
   if file exist("making_bytes.txt")=1 then delete file "making_bytes.txt"
   open to write 1,"making_bytes.txt"
   write long 1,track_total
   close file 1
   open to read 1,"making_bytes.txt"
      read byte 1,track_bytesD
      read byte 1,track_bytesc
      read byte 1,track_bytesB
      read byte 1,track_bytesA
   close file 1
   if file exist("making_bytes.txt") then delete file "making_bytes.txt"
   `create the actual midi file
   file=file+".mid"
   if file exist(file)=1 then delete file file
      open to write 1,file
      `write the header
      write byte 1,77:write byte 1,84:write byte 1,104:write byte 1,100:write byte 1,0:write byte 1,0:write byte 1,0:write byte 1,6
      write byte 1,0:write byte 1,0:write byte 1,0:write byte 1,1
      `write track header
      write byte 1,TEMPO:write byte 1,192
      `affects duration
      write byte 1,77:write byte 1,84:write byte 1,114:write byte 1,107
      `number of bytes in the track
      write byte 1,track_bytesa:write byte 1,track_bytesb:write byte 1,track_bytesc:write byte 1,track_bytesd
      `instrument and delta set up
      write byte 1,0:write byte 1,192:write byte 1,INSTRUMENT
      `instrument
      write byte 1,0:write byte 1,255:write byte 1,89:write byte 1,2:write byte 1,0:write byte 1,0:write byte 1,0:write byte 1,255:write byte 1,81:write byte 1,3:write byte 1,9:write byte 1,39:write byte 1,192:write byte 1,0
      `write the notes
      `turn the note on
      for count = 0 to array count(master_note())
         write byte 1,144:write byte 1,master_note(count).note:write byte 1,master_note(count).volume:write byte 1,master_note(count).speed:write byte 1,64
         `turn it off
         write byte 1,128:write byte 1,master_note(count).note:write byte 1,0:write byte 1,0
      next count
      `write track end
      write byte 1,255,:write byte 1,47,:write byte 1,0,:write byte 1,1
      close file 1
endfunction

remstart
******************************************************************************************************************
         Santas gift delivery by Attila 2007

         help santa deliver his gifts, you will deliver 10 gifts to the houses indicated by
         yellow arrows. You will deliver all gifts in 150 seconds, or loose the game.

         Use the arrow-keys to accelerate, break and turn left or right your sledge.
         Drop the gifts using the space key. While droppping a camera in the right upper corner
         shows the falling gift.

         If you hit the house you will get a paket too.

******************************************************************************************************************
remend
set display mode 640,480,16
randomize rnd(timer()+mousex()+mousey())
`
` uncomment following lines for windows mode
`
remstart
set window on
set window title "Merry Christmas"
set window position 320,240
set window layout 1,1,1
restore window
remend

set text transparent
set text font "Verdana"
set text size 18
set text to bold
backdrop on
color backdrop rgb(0,0,64)
hide mouse
`set ambient light 100
fog on
fog color rgb(96,96,128)
fog distance 450
autocam off

type NotenRecord
   note as integer
   speed as integer
   volume as integer
endtype

dim master_note(-1) as NotenRecord


dim cx#(10)
dim cz#(10)
dim co(10)
ccnt=0

` some music
CreateMidi("bing",13,7,"q c5 r r r q")
CreateMidi("wewishyou",25,7,"q g4 c5 r c5 d5 q c5 b4 a4 r a4 r r a4 d5 r d5 e5 d5 c5 b4 r g4 r g4 r e5 r e5 f5 e5 d5 c5 r a4 r g4 g4 a4 r d5 r b4 r c5 r r q")

load music "wewishyou.mid",1
load music "bing.mid",2
loop music 1
set music volume 1,70

makeIntro(9)
sprite 9,0,0,9
sync on
sync rate 0
`sledge(100)
te=timer()+10000
`instrument 11 = cowbell
`
MakeBitmap("SNOW",12)
MakeBitmap("BRANCH",10)
MakeBitmap("BARK",11)
MakeBitmap("GROUND",13)
MakeBitmap("HOUSE",14)
MakeBitmap("ROOF",15)
MakeBitmap("FIREPLACE",16)
MakeBitmap("COVER",17)
MakeBitmap("SKY",18)

create bitmap 25,150,20
set current bitmap 25
ink rgb(255,64,0),0
box 0,0,150,20
ink rgb(255,255,0),0
line 0,5,150,5

get image 25,0,0,150,20
set current bitmap 0

load bitmap "Gift01.jpg",20
set current bitmap 20
get image 19,62,80,116,128
set current bitmap 0

make matrix 1,1000,1000,20,20
prepare matrix texture 1,13,1,1
randomize matrix 1,25
update matrix 1

`Skybox
make object plain 2000,1000,500
texture object 2000,18
position object 2000,500,250,1000
make object plain 2001,1000,500
yrotate object 2001,180
position object 2001,500,250,0
make object plain 2002,1000,500
texture object 2002,18
yrotate object 2002,270
position object 2002,1000,250,500
make object plain 2003,1000,500
texture object 2003,18
yrotate object 2003,90
position object 2003,0,250,500

y1#=get ground height(1,500,500)

MAKE SNOW PARTICLES 1, 12, 3550, 500,y1#+10,500, 50, 35, 50

`  Ceate the x-mas trees

no=100
`  Tree(s)
for tree=0 to 20
   px=500+(rnd(150)-75)
   pz=500+(rnd(150)-75)
   y2#=get ground height(1,px,pz)
   oldeh=0
   for n=0 to 2
      for h=1 to 180 step 30
         make object plain no,6-n,4-n
         texture object no,10
         if n=0 then eh=3
         if n=1 then eh=5
         if n=2 then eh=6.5
         position object no, px,y2#+eh,pz
         yrotate object no,h
         set object transparency no,1
         set object cull no,0
         no=no+1
      next h
   next n
next tree

`  House
for h=1 to 10
   make object box no,10,6,7
   texture object no, 14
   ok=0
   while ok=0
      px=500+(rnd(150)-75)
      pz=500+(rnd(150)-75)
      sync
      y2#=get ground height(1,px,pz)
      position object no,px,y2#+3,pz
      if object collision (no,0)
         ok=0
      else
         ok=1
      endif
   endwhile
   co(ccnt)=no
   cx#(ccnt)=px
   cz#(ccnt)=pz
   no=no+1
   `Roof
   make object box no,9.8,5.7,5.7
   xrotate object no, 45
   position object no,px,y2#+5.5,pz
   texture object no,15
   no=no+1
   make object box no, 2,10,3
   texture object no, 16
   position object no, px+6,y2#+5,pz
   no=no+1
   make object box no, 2,.1,3
   texture object no, 17
   position object no, px+6,y2#+10.05,pz
   ccnt=ccnt+1
   no=no+1
next h
mx=no-1

r#=0
while timer() < te
   sleep 1
   sync
endwhile
delete sprite 9

` Visor
make object box 1,8,.1,8
boxtexture(20)
texture object 1,20
set object transparency 1,1
set object cull 1,0
`xrotate object 1,wrapvalue(-45)
yg#=get ground height(1,500,500)
position object 1, 500,yg#+5,500

` Arrow
make object box 2,3,5,3
set current bitmap 20
get image 21,1,2,6,4
texture object 2,21
set current bitmap 0
make object box 3,2.9,3,3
xrotate object 3,45
texture object 3,21
position object 2 ,cx#(0),37,cz#(0)
position object 3 ,cx#(0),35.6,cz#(0)

load object "Gift01.x", 10
scale object 10,3,3,3

x#=500
z#=490
r#=atanfull(cx#(0)-x#,cz#(0)-z#)
speed#=.1
position camera x#,y1#+50,z#

make camera 1
position camera 1, 208,sh+3,208
set camera to image 1,1,256,256
`  Position the Sprite (Output Screen) right/top
lp=screen width()+1
sprite 1,lp,-30,1
size sprite 1, 256,192

create bitmap 25,150,20
set current bitmap 25
ink rgb(255,0,0),0
box 0,0,150,20
get image 25,0,0,150,20
set current bitmap 0

create bitmap 26,154,40
set current bitmap 26
ink rgb(0,0,200),0
box 0,0,154,40
ink rgb(255,255,0),0
set text size 13
text 5,3,"Remaining time"
get image 26,0,0,154,40
set current bitmap 0

sprite 26,5,screen height()-67,26
sprite 25,7,screen height()-50,25
size sprite 25,150,20

lvl=-1
Restart:
lvl=lvl+1
clear entry buffer
tr=0
drop=0
Treffer=0
st=timer()
clear entry buffer

while -1
   if spacekey() and drop=0
      rp#=r#
      sp#=speed#
      py#=y#+8
      lp=screen width()-256
      drop=-1
      fs#=.1
      sleep 1
   endif

   if drop=-1
      dpz#=cos(rp#)
      dpx#=cos(90-rp#)
      zp#=z#+sp#*dpz#
      xp#=x#+sp#*dpx#
      py#=py#-fs#
      yrotate object 10,wrapvalue(r#+180)
      position object 10,xp#,py#,zp#
      if fs# < 1 then fs#=fs#*1.2
      set camera to follow 1,xp#,py#,zp#,r#+90,9,py#+5,35,1
      point camera 1,xp#,py#,zp#
      gh#=get ground height(1,xp#,zp#)
      if object collision(10,co(tr))
         if not music playing(2) then play music 2
         set music volume 2, 120
         tr=tr+1
         drop=0
         lp=screen width()+1
         sprite 50+Treffer,Treffer*58,0,19
         sync
         Treffer=Treffer+1
         dpz#=cos(r#)
         dpx#=cos(90-r#)
         zp#=z#+10*dpz#
         xp#=x#+10*dpx#
         zp#=z#
         xp#=x#
         yrotate object 10,wrapvalue(r#+180)
         position object 10,xp#,y#+2.0,zp#
         set camera to follow 1,xp#,y#+4,zp#,r#+90,9,42,15,1
         sprite 1,lp,-30,1
         if treffer >= 9 then goto win
      endif
      if py# <= (gh#-10) and drop=-1
         drop=0
         lp=screen width()+1
         sleep 500
         ts=ts-5000
      endif
   else
      dpz#=cos(r#)
      dpx#=cos(90-r#)
      zp#=z#+10*dpz#
      xp#=x#+10*dpx#
         zp#=z#
         xp#=x#
      yrotate object 10,wrapvalue(r#+180)
      position object 10,xp#,y#+4.0,zp#
      set camera to follow 1,xp#,y#+4,zp#,r#+90,9,42,15,1
`      position camera 2,xp#,y#+4,zp#
`      yrotate camera 2,wrapvalue(r#+180)
`      point camera 2,xp#,0,zp#
   endif

   position object 2 ,cx#(tr),37,cz#(tr)
   position object 3 ,cx#(tr),34.6,cz#(tr)

   sprite 1,lp,-30,1
   if rightkey() then r#=r#+1.2
   if leftkey() then r#=r#-1.2
   if upkey() then speed#=speed#+.01
   if downkey() then speed#=speed#-.01
   if speed# < 0 then speed#=0
   if speed# > 1.5 then speed#=1.5
   oldx#=x#
   oldz#=z#

   dz#=cos(r#)
   dx#=cos(90-r#)

   di#=sqrt((x#-500)*(x#-500)+(z#-500)*(z#-500))
   if di# > 250 then r#=r#+2
   dz#=cos(r#)
   dx#=cos(90-r#)
   z#=z#+speed#*dz#
   x#=x#+speed#*dx#
   y#=get ground height(1,px#,z#)+35
   y#=40
   position object 1,x#,y#,z#
   yrotate object 1,wrapvalue(r#)

   set camera to follow 0,x#,y#,z#,r#+5,5,y#+2,15,1
   point camera x#,y#,z#
   position particles 1,x#,y#+6,z#
   ink rgb(0,0,128),0
   t=150-int((timer()-st)/1000)-(lvl/2)
   if t < 0 then goto lost
   size sprite 25,t+1,20
   ink rgb(0,0,255),0

   sync
endwhile
end

lost:
   for h=50 to 61
      if sprite exist(h) then delete sprite h
   next h
   set text size 84
   center text 320,240,"you loose"
   set text size 32
   center text 320,340,"press any key to restart or esc to exit"
   sync
   clear entry buffer
   suspend for key
   goto Restart
   end

win:
   for h=50 to 61
      if sprite exist(h) then delete sprite h
   next h
   set text size 84
   center text 320,240,"you win"
   set text size 32
   center text 320,340,"press any key to restart or esc to exit"
   sync
   clear entry buffer
   suspend for key
   goto Restart
   end

function boxtexture(nr)
create bitmap nr,128,128
set current bitmap nr
ink rgb(255,32,0),0
box 0,0,128,128
ink rgb(255,255,0),0
box 2,2,126,4
box 2,124,126,126
box 2,2,4,126
box 124,2,126,126
ink rgb(0,0,0),0
box 6,6,122,122
ink rgb(0,0,32),0
line 63,6,63,122
line 64,6,64,122
line 65,6,65,122

line 6,63,122,63
line 6,64,122,64
line 6,65,122,65

get image nr,0,0,128,128
set current bitmap 0
sync
endfunction

function MakeBitmap(N$,nr)
create bitmap nr,128,128
set current bitmap nr
if n$="SKY"
   randomize timer()
   ink rgb(128,128,255),0
   box 0,0,128,128
   for n=1 to 120
      px=rnd(256)-64
      py=rnd(128)
      m=rnd(20)+5
      for h=1 to m
         ink rgb(255-m,255-m,255),1
         ellipse px,py,h,2*h/3
      next h
   next n
endif
if n$="COVER"
   ink rgb(164,164,164),0
   box 0,0,128,128
   ink rgb(0,0,0),0
   box 10,10,118,118
endif
if n$="FIREPLACE"
   ink rgb(164,164,164),0
   box 0,0,128,128
   ink rgb(16,16,16),0
   for h=1 to 128 step 12
      line 0,h,128,h
   next h
endif
if n$="ROOF"
   ink rgb(164,32,0),0
   box 0,0,128,128
   ink rgb(255,255,1255),0
   for h=-128 to 128 step 20
      line h,0,h+128,128
   next h
   for h=256 to 1 step -20
      line h,0,h-128,128
   next h
endif
if n$="HOUSE"
   ink rgb(164,164,0),0
   box 0,0,128,128
   ink rgb(16,16,128),0
   for h=1 to 128 step 12
      line 0,h,128,h
   next h
   ink rgb(128,128,128),0
   for h=2 to 128 step 12
      line 0,h,128,h
   next h
   ink rgb(255,0,0),0
   box 44,10,84,70
   ink rgb(0,0,16),0
   box 48,14,80,66
   ink rgb(255,0,0),0
   line 63,14,63,66
   line 64,14,64,66
   line 65,14,65,66
   line 48,29,80,29
   line 48,30,80,30
   line 48,31,80,31
endif
if n$="BRANCH"
   ink rgb(255,255,0),0
   box 0,0,128,1
   ink rgb(0,128,0),0
   box 0,0,128,128
   for h=1 to 1500
      ink rgb(200,200,0),0
      px=rnd(128)
      py=rnd(128)
      dot px,py
      ink rgb(60,80,0),0
      dot px-.5,py-.5
   next h

   ink 0,0
   for h=1 to 64
      box 0,0,h,2*(64-h)
   next h
   for h=1 to 64
      box 64+h,0,128,2*(h)
   next h
   for h=0 to 128 step 8
      line 64,h,h/2,128
      line 64,h,128-h/2,128
   next h
   ink rgb(255,255,255),0
   line 64,0,0,128
   line 64,1,1,128
   line 64,0,128,128
   line 64,1,128,127
endif
if n$="GROUND"
   ink rgb(240,240,243),0
   box 0,0,128,128
   for h=1 to 512
      ink rgb(255,255,255),0
      px=rnd(128)
      py=rnd(128)
      dot px,py
      dot px+1,py+1
   next h
   for h=1 to 512
      ink rgb(220,220,255),0
      px=rnd(128)
      py=rnd(128)
      dot px,py
      dot px+1,py-1
   next h
   for h=1 to 100
      px=rnd(128)
      py=rnd(128)
      r=rnd(15)
      for p1=0 to 2
         ink rgb(255,255,255),0
         circle px,py,r
         ink rgb(255,255,255),0
         circle px+1,py+1,r
      next p1
   next h
endif
if n$="SNOW"
   ink rgb(0,0,0),0
   box 0,0,128,128
   ink rgb(255,255,255),0
   for h=1 to 128 step 10
      line h,0,128-h,128
      line 0,h,128,128-h
   next h
   ink rgb(0,0,0),0
   for r=64 to 128
      circle 64,64,r
   next h
endif
if n$="BARK"
   ink rgb(64,64,0),0
   box 0,0,128,128
   for h=1 to 1500
      ink rgb(220,220,0),0
      px=rnd(128)
      py=rnd(128)
      ink rgb(128,96,0),0
      dot px,py
      for n1=0 to 5
         dot px,py+n1
      next n1
      dot px,py
      for n1=0 to 5
         dot px+1,py+n1
      next n1
   next h
endif

`for h=1 to 20:ink rgb(189,120,36),0:px=rnd(128):py=rnd(128):for h1=1 to 10:circle px,py,h1:next h1:next h:endif
get image nr,0,0,128,128
set current bitmap 0
sync
endfunction

function MakeIntro(nr)
create bitmap nr,640,480
set current bitmap nr
ink rgb(250,250,255),0
box 0,0,640,480

ink rgb(196,196,255),1
for h=1 to 2000
   px=rnd(640)
   py=rnd(480)
   line px,py,px+4,py+4
   line px+4,py+4,px,py+4
   line px+2,py,px+2,py
next h

set text size 64
set text to bold
ink rgb(128,128,255),0
center text 319,80,"merry Christmas"
ink rgb(32,32,32),0
center text 323,82,"merry Christmas"
ink rgb(255,64,32),0
center text 321,81,"merry Christmas"

set text size 32
ink rgb(128,128,255),0
center text 319,200,"take control of Santas sledge!"
ink rgb(164,164,255),0
center text 321,201,"take control of Santas sledge!"

ink rgb(128,128,255),0
center text 319,240,"use arrow-key to control speed"
ink rgb(164,164,255),0
center text 321,241,"use arrow-key to control speed"

ink rgb(128,128,255),0
center text 319,274,"and direction. Use space to drop gift."
ink rgb(164,164,255),0
center text 321,275,"and direction. Use space to drop gift."

ink rgb(128,128,255),0
center text 319,310,"Target is indicated by arrow"
ink rgb(164,164,255),0
center text 321,311,"Target is indicated by arrow"


ink rgb(128,128,255),0
center text 320,430,"(C) 2007 by Attila"
ink rgb(32,32,255),0
center text 321,431,"(C) 2007 by Attila"
get image nr,0,0,640,480
set current bitmap 0
set text size 12
sprite nr,0,0,nr
sync
endfunction



function CreateMidi(file as string,instrument as integer,tempo as integer,notes as string)
remstart
   Base of this procedure was posted on 23rd Dec 2006 by Hobgoblin Lord in TGC Forums
remend
SPEED=165
notes=" "+notes
for a = 1 to len(notes)
   watch$=mid$(notes,a)
   if watch$=" "
      start=a:test_note$=""
      repeat
         inc start
         new$=mid$(notes,start)
         if new$<>" "
            test_note$=test_note$+new$
         endif
      until new$=" " or start=len(notes)
    note_on=1
    if len(test_note$)=1
      select lower$(test_note$)
         case "q":SPEED=135:endcase
         case "8":speed=134:endcase
         case "h":speed=140:endcase
         case "r":array insert at bottom master_note():count=array count(master_note())
            master_note(count).note=0:master_note(count).speed=SPEED:master_note(count).volume=0
         endcase
      endselect
      note_on=0
    else
      temp_note$=left$(test_note$,1):temp_octave=val(right$(test_note$,1))
      select lower$(temp_note$)
         case "c":note_base=0:endcase
         case "d":note_base=2:endcase
         case "e":note_base=4:endcase
         case "f":note_base=5:endcase
         case "g":note_base=7:endcase
         case "a":note_base=9:endcase
         case "b":note_base=11:endcase
      endselect
      inc note_base,Temp_octave*12
      if len(test_note$)=3 then inc note_base
    endif
      if note_on=1
        array insert at bottom master_note()
        count=array count(master_note())
        master_note(count).note=note_base
        master_note(count).speed=SPEED
        master_note(count).volume=127
      endif
    endif
   next a

   `figure bytes in the track
   track_total=20+((array count(master_note())+1)*9)
   if file exist("making_bytes.txt")=1 then delete file "making_bytes.txt"
   open to write 1,"making_bytes.txt"
   write long 1,track_total
   close file 1
   open to read 1,"making_bytes.txt"
      read byte 1,track_bytesD
      read byte 1,track_bytesc
      read byte 1,track_bytesB
      read byte 1,track_bytesA
   close file 1
   if file exist("making_bytes.txt") then delete file "making_bytes.txt"
   `create the actual midi file
   file=file+".mid"
   if file exist(file)=1 then delete file file
      open to write 1,file
      `write the header
      write byte 1,77:write byte 1,84:write byte 1,104:write byte 1,100:write byte 1,0:write byte 1,0:write byte 1,0:write byte 1,6
      write byte 1,0:write byte 1,0:write byte 1,0:write byte 1,1
      `write track header
      write byte 1,TEMPO:write byte 1,192
      `affects duration
      write byte 1,77:write byte 1,84:write byte 1,114:write byte 1,107
      `number of bytes in the track
      write byte 1,track_bytesa:write byte 1,track_bytesb:write byte 1,track_bytesc:write byte 1,track_bytesd
      `instrument and delta set up
      write byte 1,0:write byte 1,192:write byte 1,INSTRUMENT
      `instrument
      write byte 1,0:write byte 1,255:write byte 1,89:write byte 1,2:write byte 1,0:write byte 1,0:write byte 1,0:write byte 1,255:write byte 1,81:write byte 1,3:write byte 1,9:write byte 1,39:write byte 1,192:write byte 1,0
      `write the notes
      `turn the note on
      for count = 0 to array count(master_note())
         write byte 1,144:write byte 1,master_note(count).note:write byte 1,master_note(count).volume:write byte 1,master_note(count).speed:write byte 1,64
         `turn it off
         write byte 1,128:write byte 1,master_note(count).note:write byte 1,0:write byte 1,0
      next count
      `write track end
      write byte 1,255,:write byte 1,47,:write byte 1,0,:write byte 1,1
      close file 1
endfunction

Rem Project: Winter Challenge 2007
Rem Created: 12/9/2007 11:37:45 AM

Rem ***** Main Source File *****


rem set display mode
hide mouse
set display mode 800,600,32



`make images before call to sync


rem collision check array
checks=4
if checks<4 then checks=4
if checks>360 then checks=360
`width of the angles
angwidth=360/checks
`make arrays for collision data
dim ang#(checks-1,2)
dim sort#(checks-1,2)



``declare image constants
#constant brick_1 = 10
#constant brick_2 = 11
#constant snow1 = 15
#constant stars = 16
#constant crosshair = 20
#constant detail_map = 22
#constant height_map = 700  




rem make the bricks for the walls
ink rgb(100,250,100),0
box 0,0,128,128
ink rgb(250,100,100),0
box 0,0,120,120
get image brick_1,0,0,128,128
get image brick_2,0,0,120,120


cls

rem make the crosshair image
lock pixels

ink rgb(255, 255, 255) , rgb(0,0,0)

circle 12, 12, 1
circle 12, 12, 2
circle 12, 12, 10
circle 12, 12, 11



unlock pixels

`grab image as texture
get image crosshair, 0,0,25,25


cls




rem make the snow image
lock pixels

ink rgb(255, 255, 255) , rgb(0,0,0)

for xx = 1 to 10
circle 12, 12, xx
next xx


unlock pixels

`grab image as texture
get image snow1, 0,0,25,25



cls







` make some stars and put a 1000 star limit
lock pixels
for Create_Image = 1 to 512 * 512
if Create_Image < 1000
dot rnd(512),rnd(512), rgb(255,255,255)
endif
next Create_Image
unlock pixels
get image stars, 0,0,512,512




`rem create a snow detail

cls


lock pixels

for Create_Image = 1 to 256*256

green = rnd(200)+50
dot rnd(256),rnd(256), rgb(250,250,250)
next Create_Image
unlock pixels
get image detail_map, 0,0,256,256
blur_image( detail_map , 6 )

cls

`create heightmap
lock pixels
for Create_Image = 1 to 10*10
`put a restriction on the land bumps
xx = rnd(10)
yy = rnd(10)
white = rnd(255)
dot xx,yy, rgb(white,white,white)
next Create_Image
unlock pixels

get image height_map, 1,1,10,10

make Object Plain 11, 16, 12
Position Object 11, 0, 0, 10
Lock Object On 11
texture object 11,height_map
sync
delete image height_map
delete object 11

get image height_map, 1,1,500,500



make memblock from image 200,height_map






sync on
sync rate 60
autocam off
set camera range 0,0.1,25000
backdrop on
color backdrop 0,0
set normalization on
set camera fov 0,90




`` make a skysphere
make object sphere 888, -8000,3,3
texture object 888,stars
set object light 888,0






xx = 0
yy = 0
zz = 0
make object cube 9999,10
` make a ground plain
for ground_plain = 1 to 100


make object box Ground_plain + 1000, 50,5,50

position object Ground_plain+1000,xx,0,zz

make mesh from object ground_plain + 1000,ground_plain + 1000

add limb 9999,ground_plain , ground_plain + 1000
offset limb 9999,ground_plain, xx,yy,zz
delete object ground_plain + 1000
delete mesh ground_plain + 1000


xx = xx + 50

if xx = 500
xx = 0
zz = zz + 50
endif


next ground_plain

make mesh from object 199,9999
delete object 9999
make object 9999,199,detail_map
convert object fvf 9999,338
set object normals 9999


update_ground()



scale object 9999,500,200,500


set light mapping on 9999,detail_map








`make the outer walls
make object box 4000, 50,500,2500
make object box 4001, 50,500,2500
make object box 4002, 2500,500,50
make object box 4003, 2500,500,50


position object 4000, 0,200,1100
position object 4001, 2200,200,1100
position object 4002, 1100,200,0
position object 4003, 1100,200,2200



texture object 4000,brick_1
texture object 4001,brick_1
texture object 4002,brick_1
texture object 4003,brick_1


scale object texture 4000,20,10
scale object texture 4001,20,10
scale object texture 4002,20,10
scale object texture 4003,20,10


set light mapping on 4000,detail_map
set light mapping on 4001,detail_map
set light mapping on 4002,detail_map
set light mapping on 4003,detail_map





rem make invisible collision map

make object cube 6666,1
for xx = 1 to 4
make mesh from object 1,3999+xx
add limb 6666,xx,1
offset limb 6666, xx,object position x(3999+xx),object position y(3999+xx),object position z(3999+xx)
delete mesh 1
next xx

exclude object on 6666





``make snow particles

make object plain 900, 10,10
texture object 900,snow1

set object transparency 900,4


for xx = 901 to 1000
instance object xx,900
position object xx, rnd(2500)-200,rnd(450),rnd(2500)-200

rnd_size = rnd(50)
scale object xx, 100+rnd_size,100+rnd_size,100+rnd_size

next xx




rem make presents to gather
load object "gift01.x", 44
load image "gift01.jpg",44

scale object 44,5,5,5
xrotate object 44,90
for xx = 1100 to 1200
instance object xx, 44
scale object xx,15,15,15
zrotate object xx,90
yrotate object xx,90
cx# = rnd(2500)-200
cz# = rnd(2500)-200
height#=10001-intersect object(9999,cx#,10000,cz#,cx#,-10000,cz#)

position object xx, cx#,height#+15,cz#

next xx







`set light and atmosphere levels
set ambient light 25

set point light 0,0,0,0
set light range 0, 1000
color light 0,rgb(50,255,50)  





player = 100


make object cube player,10
position object player, 500,260,500
posx#=object position x(player)
posz#=object position z(player)

`
`Height cam is off the ground
charht#=260
`speed to move
spd#=3
`set the radius for collisions
radius#=10.0
`set initial camera position
position camera 500,charht#,500
yrotate camera 180














do

set cursor 0,0
print "Sync Rate set at ",srate," Press Enter to change"
print "FPS:",screen fps()

if scancode()=0 then hold=0
if returnkey()=1 and hold=0
   hold=1
   if srate=60
      srate=0
   else
      srate=60
   endif
   sync rate srate
endif

paste image crosshair,screen width()/2-12,screen height()/2-12,1

position mouse screen width()/2,screen height()/2 

`Get initial positions and a revert set
oldx#=camera position x()
oldz#=camera position z()
cx#=camera position x()
cy#=camera position y()
cz#=camera position z()
ca#=camera angle y()
`generic mouselook
mx#=mousemovex()/4.0
my#=mousemovey()/4.0
`if mouseclick()=0 then show mouse
if mouseclick()>1
 `  hide mouse
`   position mouse 320,240
   xrotate camera wrapvalue(camera angle x()+my#)
   yrotate camera wrapvalue(camera angle y()+mx#)
   if camera angle x()>80 and camera angle x()<180 then xrotate camera 80
   if camera angle x()<270 and camera angle x()>180 then xrotate camera 270
endif
if mouseclick()=3
   cx#=newxvalue(cx#,ca#,spd#)
   cz#=newzvalue(cz#,ca#,spd#)
   position camera cx#,cy#,cz#
endif
`If you want to back up
if inkey$()="s"
   cx#=newxvalue(cx#,wrapvalue(ca#-180),spd#)
   cz#=newzvalue(cz#,wrapvalue(ca#-180),spd#)
   position camera cx#,cy#,cz#
endif
if inkey$()="z"
   cx#=newxvalue(cx#,wrapvalue(ca#-90),spd#)
   cz#=newzvalue(cz#,wrapvalue(ca#-90),spd#)
   position camera cx#,cy#,cz#
endif
if inkey$()="x"
   cx#=newxvalue(cx#,wrapvalue(ca#+90),spd#)
   cz#=newzvalue(cz#,wrapvalue(ca#+90),spd#)
   position camera cx#,cy#,cz#
endif

set point light 0,cx#,cy#+500,cz#

`Show the camera angle
print "Camera angle:",camera angle y()
`The main sliding collision code

`for obj = 4000 to 4003
obj = 6666
gosub _collision
`next obj


rem we have alot of choices as to how we "collide" against this terrain.
rem but for ease of use, I'm using the tried and true intersect object method



`calculate the height at player X & Z


height#=10001-intersect object(9999,cx#,10000,cz#,cx#,-10000,cz#)



`put player at the new height
position camera cx#,height#+35,cz#
`simple camera follow
`set camera to follow posx#,height#,posz#,object angle y(player),25,25,20,0




`position the skysphere at the player position
position object 888, camera position x(),camera position y(),camera position z()








rem handle particles
for xx = 900 to 1000

yy = object position y(xx) - 3
position object xx, object position x(xx),yy,object position z(xx)
set object to camera orientation xx
`check if object is to low
if object position y(xx) < 0  
position object xx,  rnd(2500)-200,850+rnd(100),rnd(2500)-200

endif


next xx






if level_time < timer()






level_time = timer() + 10000


endif













fastsync
loop




new_level:

``handle presents
for xx = 1100 to 1200

cx# = rnd(2500)-200
cz# = rnd(2500)-200
height#=10001-intersect object(9999,cx#,10000,cz#,cx#,-10000,cz#)

position object xx, cx#,height#+15,cz#

next xx





return






``reserve memblock 255 and bitmap 255 for image modification

function blur_image( image as integer , blur_amount as integer)


make memblock from image 255,image
make bitmap from memblock 255,255
delete image image
delete memblock 255
blur bitmap 255, blur_amount
make memblock from bitmap 255,255
delete bitmap 255
make image from memblock image,255
delete memblock 255


endfunction





function update_ground


image_size = 500
memblock1 = 200

land = 0

LOCK VERTEXDATA FOR limb 9999,land,2

for a=0 to get vertexdata vertex count()


          X#=GET VERTEXDATA POSITION X(a)`+limb position x(9999, land)
          Z#=GET VERTEXDATA POSITION Z(a)`+limb position z(9999,land)
      cx = x#
      cy = z#


`      works out where in memory to plot position
      mem_y = int(cy)*(image_size*4)
      mem_x = (int(cx)*4)
      mem_location = mem_x + mem_y+1

rem this reads the heightmap and gets the appropiate number
if mem_location > 0
if mem_location < get memblock size(memblock1)
     height# =  memblock byte(memblock1, mem_location)
else
height# = 0
endif
endif
if mem_location < 0 then height# = 20

SET VERTEXDATA POSITION a,GET VERTEXDATA POSITION X(a),height#,GET VERTEXDATA POSITION Z(a)


if height# < 25 then color = rgb(int(height#)*2+100,int(height#)*2+100,int(height#)*2+100)
if height# => 25 then color=rgb(int(height#),int(50+height#),int(height#))
if height# => 100 then color=rgb(200,200,200)

     SET VERTEXDATA DIFFUSE a,color     


next a
unlock vertexdata


set object light 9999,0

endfunction




_collision:
`make 72 collision points. You can use more or less, but this number seems to work good.
`These are vectors every 5 degrees from the camera position out.
`They return the distance when they hit an object
for x=0 to checks-1
   chx#=newxvalue(cx#,x*angwidth,100)
   chz#=newzvalue(cz#,x*angwidth,100)
   ang#(x,1)=intersect object(obj,cx#,cy#,cz#,chx#,cy#,chz#)
   if ang#(x,1)=0 then ang#(x,1)=999999
   ang#(x,2)=x*angwidth
   sort#(x,1)=ang#(x,1)
   sort#(x,2)=ang#(x,2)
next x

`sort the array to find the closest object and it's degrees
for x=0 to checks-2
for y=x+1 to checks-1
   if ang#(x,1)>ang#(y,1)
      temp#=ang#(x,1)
      temp2#=ang#(x,2)
      ang#(x,1)=ang#(y,1)
      ang#(x,2)=ang#(y,2)
      ang#(y,1)=temp#
      ang#(y,2)=temp2#
   endif
next x
next y
`This is the closest wall and what degrees you would face to see it
print "Angle to closest wall:",ang#(0,2)
print "Distance to that wall:",ang#(0,1)
`find +-90 degrees from the closest one for when you walk into a corner so it doesn't shake
prev=wrapvalue(ang#(0,2)-90)/angwidth
nxt=wrapvalue(ang#(0,2)+90)/angwidth
newd#=radius#-ang#(0,1)
newa#=wrapvalue(ang#(0,2)-180)
newd1#=radius#-sort#(prev,1)
newa1#=wrapvalue(sort#(prev,2)-180)
newd2#=radius#-sort#(nxt,1)
newa2#=wrapvalue(sort#(nxt,2)-180)
`if you are less than radius from a wall, push you out to 20 from it
if ang#(0,1)<radius# and ang#(0,1)>0.0
   repx#=newxvalue(cx#,newa#,newd#)
   repz#=newzvalue(cz#,newa#,newd#)
   position camera repx#,cy#,repz#
endif
cx#=camera position x()
cz#=camera position z()
`this is if you are coming into a corner, this pushes you sideways
if sort#(prev,1)<radius# and sort#(prev,1)>0.0
   repx1#=newxvalue(cx#,newa1#,newd1#)
   repz1#=newzvalue(cz#,newa1#,newd1#)
   position camera repx1#,cy#,repz1#
endif
cx#=camera position x()
cz#=camera position z()
`and the other way. above is left, this is right
if sort#(nxt,1)<radius# and sort#(nxt,1)>0.0
   repx2#=newxvalue(cx#,newa2#,newd2#)
   repz2#=newzvalue(cz#,newa2#,newd2#)
   position camera repx2#,cy#,repz2#
endif
return

`==============================================
`|    Christmas Minimal Media Compo - 2007    |
`|  Bmaczero's Entry - Defend the North Pole! |
`|                                            |
`| This is NOT the final version, but it may  |
`| be judged as though it was if no other     |
`| version is submitted before the deadline   |
`==============================================

PresentDirectory$="E:/Brian/Programming/Projects/In Progress/Christmas Compo/"

`Basic setup
set window title "North Pole Defense - Christmas Compo '07"
autocam off : hide mouse
randomize timer()
disable escapekey

#Constant SizeX 200
#Constant SizeY 100
#Constant SizeZ 30
#Constant NoOfEnemyLocs 22
#Constant rotationmultiplier 200
#Constant PlayerObj 12
#Constant loc 60

#Constant PtEnemy 5
#Constant PtElf 5
#Constant PtSnowball 1

full as boolean
recordedscore as boolean
placed as boolean
cheating as boolean

dim EnemyLocations(NoOfEnemyLocs,3)

`Used to keep track of when each enemy is created, so the snowballs can be timed
dim CreationTimes(50)
dim DeathRecords(50)
dim DeathRecordsElf(20)
dim ElfTimes(20)
dim HighScores(10)
dim HighScoresN$(10)

If file exist("HighScores.txt")=1 and file exist("HighNames.txt")=1
   Load array "HighScores.txt",HighScores(10)
   Load array "HighNames.txt",HighScoresN$(10)
   else
   for c=1 to 10
      HighScoresN$(c)="BmacZero"
   next c
   for g=1 to 10
      HighScores(g)=650-((g-1)*50)
   next g
endif

`Set the enemy locations in an array - the enemies will only appear in these locations
`1 is X pos, 2 is Y pos, 3 is Z pos
for e=1 to 6 : EnemyLocations(e,2)=35 : EnemyLocations(e,3)=-20 : next e
for e=7 to 13 : EnemyLocations(e,2)=70 : EnemyLocations(e,3)=-70 : next e
for e=14 to 22 : EnemyLocations(e,2)=135 : EnemyLocations(e,3)=-120 : next e

EnemyLocations(1,1)=110
EnemyLocations(2,1)=70
EnemyLocations(3,1)=30
EnemyLocations(4,1)=-30
EnemyLocations(5,1)=-70
EnemyLocations(6,1)=-110

EnemyLocations(7,1)=120
EnemyLocations(8,1)=80
EnemyLocations(9,1)=40
EnemyLocations(10,1)=0
EnemyLocations(11,1)=-40
EnemyLocations(12,1)=-80
EnemyLocations(13,1)=-120

EnemyLocations(14,1)=160
EnemyLocations(15,1)=120
EnemyLocations(16,1)=80
EnemyLocations(17,1)=40
EnemyLocations(18,1)=0
EnemyLocations(19,1)=-40
EnemyLocations(20,1)=-80
EnemyLocations(21,1)=-120
EnemyLocations(22,1)=-160

`Set up fog and light
fog on : fog color 0,0,30 : set ambient light 84 : color ambient light rgb(240,240,255)
position light 0,0,400,-400 : point light 0,0,50,0 : set spot light 0,35,45

`Different colors of presents
load image PresentDirectory$+"Gift01.jpg",10,1
load image PresentDirectory$+"Gift01.jpg",11,1
load image PresentDirectory$+"Gift01.jpg",12,1
ChangeColor(11,0,1,0)
ChangeColor(12,0,0,1)

`Targeting Radical
create bitmap 2,35,35
set current bitmap 2
for c=1 to 34
    for r=1 to 34
    dot r,c,0
    next r
next c
ink rgb(255,0,0),0
circle 18,18,17 : circle 18,18,16
line 18,0,18,35 : line 0,18,35,18
get image 2,1,1,35,35
set current bitmap 0
delete bitmap 2

`Powerup - Rapidfire
make object cube 16,5
hide object 16
position object 16,0,0,-1000

`Base Bullet (not visible)
load object PresentDirectory$+"Gift01.x",13
scale object 13,8,8,8
exclude object on 13
position object 13,0,-1000,0

`Base enemy Bullet (not visible)
make object sphere 15,8
position object 15,0,-1000,0
exclude object on 15

`Base enemy (not visible)
make object sphere 10,1
`Body
make object sphere 2,1 : scale object 2,2000,3000,1000
make mesh from object 10,2
delete object 2
add limb 10,1,10
offset limb 10,1,0,20,0
link limb 10,0,1
`Head
make object sphere 3,1 : scale object 3,1500,1500,1000
make mesh from object 11,3
delete object 3
add limb 10,2,11
link limb 10,1,2
offset limb 10,2,0,21.5,0
`Texture
create bitmap 1,2,2 : set current bitmap 1
dot 1,1,rgb(255,100,100)
dot 1,2,rgb(255,100,100)
dot 2,1,rgb(255,100,100)
dot 2,2,rgb(255,100,100)
get image 1,1,1,2,2
delete bitmap 1
set current bitmap 0
texture object 10,1
position object 10,0,-1000,0
set object emissive 10,rgb(255,150,150)
hide object 10

`Base elf (not visible)
make object sphere 1500,1
`Body
add limb 1500,1,10
offset limb 1500,1,0,20,0
link limb 1500,0,1
`Head
add limb 1500,2,11
link limb 1500,1,2
offset limb 1500,2,0,21.5,0
`Hat
make object cone 1000,15
make mesh from object 15,1000
delete object 1000
add limb 1500,3,15
link limb 1500,2,3
offset limb 1500,3,0,10,0
`Texture
create bitmap 1,2,2 : set current bitmap 1
dot 1,1,rgb(100,255,100)
dot 1,2,rgb(100,255,100)
dot 2,1,rgb(100,255,100)
dot 2,2,rgb(100,255,100)
get image 3,1,1,2,2
delete bitmap 1
set current bitmap 0
texture object 1500,3
position object 1500,0,-1000,0
set object emissive 1500,rgb(150,255,150)
hide object 1500

`Floor
make matrix 1,1000,300,20,50
position matrix 1,-500,-60,-200
set matrix wireframe off 1
`Texture
create bitmap 1,100,40
ink rgb(224,146,58),0
for g=1 to 40
    line 1,g,100,g
next g
ink 0,0
line 1,40,100,40
line 1,20,100,20
line 50,1,50,20
line 25,20,25,40
line 75,20,75,40
line 1,39,100,39
line 1,19,100,19
line 51,1,51,20
line 26,20,26,40
line 76,20,76,40
get image 4,1,1,100,40
delete bitmap 1
set current bitmap 0
prepare matrix texture 1,4,20,50
update matrix 1

`Backdrop
make object box 11,1000,500,10
position object 11,0,150,-170

`Front middle box
make object box 1,SizeX,SizeY,SizeZ
position object 1,0,0,0
`Front sides
make object box 4,SizeX,SizeY,SizeZ
rotate object 4,0,45,0
position object 4,-161,0.0,67.5
make object box 5,SizeX,SizeY,SizeZ
rotate object 5,0,315,0
position object 5,161,0.0,67.5

`Second middle box
make object box 2,SizeX+100,SizeY+50,SizeZ
position object 2,0,10,-50
`Second sides
make object box 6,SizeX+100,SizeY+50,SizeZ
rotate object 6,0,45,0
position object 6,-246,10,51
make object box 7,SizeX+100,SizeY+50,SizeZ
rotate object 7,0,-45,0
position object 7,246,10,51

`Last middle box
make object box 3,SizeX+200,SizeY+100,SizeZ
position object 3,0,50,-100
`Last sides
make object box 8,SizeX+200,SizeY+100,SizeZ
rotate object 8,0,45,0
position object 8,-327,50,36
make object box 9,SizeX+200,SizeY+100,SizeZ
rotate object 9,0,-45,0
position object 9,327,50,36

`Cannon
make object cylinder PlayerObj,3
scale object PlayerObj,315,2500,315
position object PlayerObj,0,150,270

`Make a bitmap of the directions, because pasting an image is way more
`efficient then constantly typing text, especially when changes in text size
`are involved.
create bitmap 1,screen width(),screen height()
set text font "arial"
set current bitmap 1
set text to bold
set text size 24
ink rgb(100,100,100),0
Text 102,62,"Defend the North Pole! - Directions"
Text 102,82,"Christmas Minimal Media Compo 2007"
Text 102,102,"by BmacZero"
ink rgb(255,120,120),0
Text 100,60,"Defend the North Pole! - Directions"
Text 100,80,"Christmas Minimal Media Compo 2007"
Text 100,100,"by BmacZero"
set text to normal
Text 100,140,"Controls:"
Text 120,170,"Move the mouse to aim the present cannon."
Text 120,200,"Press the left mouse button to shoot a present."
Text 100,240,"Hints:"
Text 120,270,"If a kid has to wait too long for his or her presents, they may get mad at you and"
Text 120,290,"throw snowballs.  Get hit by too many of these, and it's game over!"
Text 120,320,"Watch out for elves with their pointed hats.  Don't shoot them!  They will throw you"
Text 120,340,"powerups to help you in your fight."
Text 120,370,"Snowballs can knock presents away, and visa versa.  This can help you block stray"
Text 120,390,"shots, but it also means that if you get swamped with lots of kids, it won't be easy"
Text 120,410,"to get rid of them."
Text 120,460,"Enter a difficulty level (between 1 and 10):"
get image 20,1,1,screen width(),screen height()
delete bitmap 1
set current bitmap 0

`Make a bitmap of the intro
create bitmap 1,screen width(),screen height()
set current bitmap 1
set text to bold
ink rgb(100,100,100),0
Text 102,62,"Defend the North Pole!"
Text 102,82,"Christmas Minimal Media Compo 2007"
Text 102,102,"by BmacZero"
ink rgb(255,120,120),0
Text 100,60,"Defend the North Pole!"
Text 100,80,"Christmas Minimal Media Compo 2007"
Text 100,100,"by BmacZero"
set text to normal
Text 100,140,"For years, Santa has generously delivered presents to the children of the world,"
Text 100,160,"from his workshop at the North Pole.  However, the children soon began to take his"
Text 100,180,"kind acts for granted.  They became greedier and greedier, until they finally decided"
Text 100,200,"to invade the North Pole, and take all the gifts they could get!  You must hold them"
Text 100,220,"off for as long as possible by giving them presents, allowing Santa and the other"
Text 100,240,"elves a chance to escape before those rowdy kids get in."
Text 100,280,"They are starting to pop out of the hidden, icy caves into Santa's workshop.  You can"
Text 100,300,"send them packing by giving them presents.  But how long can you keep them satisfied?"
Text 100,340,"Press any key to continue..."
get image 24,1,1,screen width(),screen height()
delete bitmap 1
set current bitmap 0

`Make a solid black image to use in fading the screen


`Make bitmap of the credits
create bitmap 1,screen width(),screen height() : set current bitmap 1
set text to bold
ink rgb(100,100,100),0
Text 102,62,"Defend the North Pole! - Credits"
Text 102,82,"Christmas Minimal Media Compo 2007"
Text 102,102,"by BmacZero"
ink rgb(255,120,120),0
Text 100,60,"Defend the North Pole! - Credits"
Text 100,80,"Christmas Minimal Media Compo 2007"
Text 100,100,"by BmacZero"
set text to normal
Text 120,140,"Thanks to Ric, who initiated the Minimal Media Compo and organized it."
Text 120,160,"Thanks to both Ric and Steve Vink, the judges for the compo."
Text 120,180,"Thanks also to David Gervais, who made the 'Minimal Media' for this compo - the gift."
Text 120,200,"Special thanks to TEH_CODERER, who wrote a code snippet to change the gift's color."
get image 22,1,1,screen width(),screen height()
delete bitmap 1
set current bitmap 0

`Make bitmap of the menu
create bitmap 1,screen width(),screen height() : set current bitmap 1
set text to bold
ink rgb(100,100,100),0
Text 102,62,"Defend the North Pole!"
Text 102,82,"Christmas Minimal Media Compo 2007"
Text 102,102,"by BmacZero"
ink rgb(255,120,120),0
Text 100,60,"Defend the North Pole!"
Text 100,80,"Christmas Minimal Media Compo 2007"
Text 100,100,"by BmacZero"
set text to normal
Text 120,140,"Press '1' to Play Game"
Text 120,170,"Press '2' to View High Scores"
Text 120,200,"Press '3' to View Credits"
Text 120,230,"Press '4' to Quit"
get image 23,1,1,screen width(),screen height()
delete bitmap 1
set current bitmap 0

sync on : sync rate 60

Intro:
do
paste image 24,0,0
if scancode()>0 then gosub Menu
sync
loop

Menu:
timerarrive=timer()
Do
paste image 23,0,0
if escapekey()=1 or inkey$()="4"
    if timer()-timerarrive>100 then gosub ExitSub
endif
if inkey$()="1" then gosub Directions
if inkey$()="2" then gosub HighScores_
if inkey$()="3" then gosub Credits
sync
loop

Directions:
timerold=timer()
difficulty$=""
Do
paste image 20,0,0
text 120,480,difficulty$
if escapekey()=1 then gosub Menu
if timer()-timerold>100 and scancode()>0
    timerold=timer()
    if difficulty$="1" and scancode()=11 then difficulty$="10"
    if scancode()>=2 and scancode()<=11 and difficulty$="" then difficulty$=inkey$()
    if returnkey()=1 or spacekey()=1 then gosub NewGame
    if scancode()=14
        if len(difficulty$)=1 then difficulty$=""
        if len(difficulty$)=2 then difficulty$="1"
    endif
endif

sync
loop

HighScores_:
create bitmap 1,screen width(),screen height() : set current bitmap 1
`Make a bitmap of the high scores
set text to bold
ink rgb(100,100,100),0
Text 102,62,"Defend the North Pole! - High Scores"
Text 102,82,"Christmas Minimal Media Compo 2007"
Text 102,102,"by BmacZero"
ink rgb(255,120,120),0
Text 100,60,"Defend the North Pole! - High Scores"
Text 100,80,"Christmas Minimal Media Compo 2007"
Text 100,100,"by BmacZero"
set text to normal
for c=1 to 5
    text 100,loc+(80*(c)),"Difficulty Level "+str$(c)
    text 120,loc+(80*(c))+20,HighScoresN$(c)
    text 250,loc+(80*(c))+20,str$(HighScores(c))
next c
for c=6 to 10
    text 400,loc+(80*(c-5)),"Difficulty Level "+str$(c)
    text 420,loc+(80*(c-5))+20,HighScoresN$(c)
    text 550,loc+(80*(c-5))+20,str$(HighScores(c))
next c
if image exist(21)=1 then delete image 21
get image 21,1,1,screen width(),screen height()
delete bitmap 1
set current bitmap 0

do
paste image 21,0,0
if escapekey()=1 then gosub Menu
if scancode()>0 and timer()-timerold>100
    timerold=timer()
    gosub Menu
endif
sync
loop


Credits:
do
paste image 22,0,0
if escapekey()=1 then gosub Menu
if scancode()>0 and timer()-timerold>100
    timerold=timer()
    gosub Menu
endif
sync
loop


NewGame:
`Reset all the stuff from the last game
delete objects 100,300
position camera 0,190,280
point camera 0,90,0
bulletno=100
enemyno=201
timerold2=timer()
health=100
enemybulletno=251
bulletdelay=3500
enemydelay=1500
score=0
distance=450
fog color 0,0,30
fog distance 450
difficultyno=val(difficulty$)
minimumdelay=(11-difficultyno)*200
dectime=(11-difficultyno)*20
WinnerName$=""
timerold4=timer()
newplace=0
elfobject=301
spriteno=1
powerupno=321
rapidfire=400
fakebulletno=331

`-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
`-=-=-=-=-     MAIN LOOP!    -=-=-=-=-=-=-
`-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
do

gosub DisplayInformation
gosub CheckGameOver

if escapekey()=1 then gosub Menu
paste image 2,mousex()-18,mousey()-18,1
if inkey$()="?" then cheating=1-cheating

`The speed of the game constantly increases, this manages that
if timer()-timerold3>dectime
timerold3=timer()
if enemydelay>minimumdelay then dec enemydelay
if bulletdelay>minimumdelay then dec bulletdelay
endif

if bulletno>199 then bulletno=101
if enemyno>249 then enemyno=201
if enemybulletno>299 then enemybulletno=251
if elfobject>319 then elfobject=301
if powerupno>329 then powerupno=321
if fakebulletno>369 then fakebulletno=331    

pick screen mousex(),mousey(),75

Gosub ControlPackages `Moves existing packages and checks for their collisions
Gosub ControlSnowballs `Move existing snowballs and check for hitting the PlayerObj
Gosub ControlEnemies `Control the shooting of new snowballs
Gosub ControlShooting `Shoot new presents
Gosub ControlNewObjects `Make new elves or enemies
Gosub ControlPlayer `Point the gun, and debug controls
Gosub ControlElves `Control the delivery of powerups

sync
loop
`-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
`-=-=-=-=-    -=-=-=-=-=-    -=-=-=-=-=-=-
`-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

ControlPackages:
for bob=100 to 200
    if object exist(bob)=1
        move object bob,6
        collidedobject=object collision(bob,0)
        if collidedobject>200 and collidedobject<251 or collidedobject=201
            full=0
            clone object fakebulletno,bob
            delete object bob
            position object fakebulletno,object position x(collidedobject),object position y(collidedobject),object position z(collidedobject)+20
            glue object to limb fakebulletno,collidedobject,1
            DeathRecords(collidedobject-200)=1
            inc score,PtEnemy
            inc fakebulletno
        endif
        if collidedobject>300 and collidedobject<321 or collidedobject=301
            dec score,PtElf
            full=0
            DeathRecordsElf(collidedobject-300)=1
            delete object bob
        endif
        if collidedobject>250 and collidedobject<301
            delete object collidedobject
            delete object bob
            inc score,PtSnowball
        endif
    endif
next bob
for bob=330 to 370
if object exist(bob)=1
    move object down bob,1
    if object position y(bob)<0 then delete object bob
endif
next bob
return


ControlElves:
for eon=301 to 320
    if object exist(eon)=1
        if timer()-elftimes(eon-300)>3000 and DeathRecordsElf(eon-300)=0
            if object exist(powerupno)=1 then delete object powerupno
            instance object powerupno,16
            position object powerupno,object position x(eon)-10,object position y(eon)+20,object position z(eon)
            point object powerupno,object position x(PlayerObj),object position y(PlayerObj),object position z(PlayerObj)
            DeathRecordsElf(eon-300)=1
            inc powerupno
        endif
        if DeathRecordsElf(eon-300)=1
            move object down eon,1
            if object position y(eon)<0 
                delete object eon
                DeathRecords(eon-300)=0
            endif
        endif
        if DeathRecordsElf(eon-300)=2
            move object up eon,1
            if object position z(eon)>-30 and object position z(eon)<-10 then dpos=35
            if object position z(eon)>-80 and object position z(eon)<-60 then dpos=70
            if object position z(eon)<-110 and object position z(eon)>-130 then dpos=135
            if object position y(eon)=>dpos
                DeathRecordsElf(eon-300)=0
                ElfTimes(eon-300)=timer()
            endif
        endif
    endif
next eon
for c=321 to 330
    if object exist(c)=1
    move object c,4
    if object collision(c,PlayerObj)=1
        delete object c
        rapidfire=1
    endif
    endif
next c
if rapidfire<400
    inc rapidfire,1
    text screen width()/2,(screen height()/2)+20,"Rapidfire! : "+str$(400-rapidfire)
endif
return


DisplayInformation:
text 0,screen height()-20,"Screen FPS: "+str$(screen fps())
if health>69 then ink rgb(100,255,100),0
if health=60 then ink rgb(200,255,200),0
if health=40 then ink rgb(250,160,100),0
if health=20 then ink rgb(250,80,80),0
Text 10,10,"Health: "
box 80,12,80+health,22
Text 10,30,"Score: "+str$(score)
return


ControlSnowballs:
for eob=251 to 300
    if object exist(eob)=1
        move object eob,5
        collision=object collision(eob,0)
        if collision=PlayerObj and cheating=0
            delete object eob
            dec health,20
        endif
    endif
next eob
return

ControlPlayer:
point object PlayerObj,(get pick vector x()*rotationmultiplier),(get pick vector y()*rotationmultiplier),(get pick vector z()*rotationmultiplier)
xrotate object PlayerObj,wrapvalue(object angle x(PlayerObj)-100)

if cheating=1
    if leftkey()=1 then yrotate camera wrapvalue(camera angle y()-1)
    if rightkey()=1 then yrotate camera wrapvalue(camera angle y()+1)
    if upkey()=1 then move camera 2
    if downkey()=1 then move camera -2
    text screen width()/2,screen height()/2,"Invincibility!"
    if inkey$()="t" then paste image 4,50,50
endif
return

CheckGameOver:
if health<1
    if distance>0
        dec distance
        fog distance distance
        else
        if recordedscore=1
            if placed=1
                text screen width()/2,screen height()/2+20,"High Score! Please enter your name."
                if timer()-timerold4>100 and scancode()>0
                    timerold4=timer()
                    if returnkey()=1 or spacekey()=1
                        HighScoresN$(difficultyno)=WinnerName$
                        Gosub Menu
                    endif
                    if scancode()=14 then WinnerName$=left$(WinnerName$,len(WinnerName$))
                    WinnerName$=WinnerName$+inkey$()
                endif
                text screen width()/2,screen height()/2+40,WinnerName$
                else
                if scancode()>0 then gosub Menu
            endif
            else
            gosub CheckScore
        endif
    endif
    text screen width()/2,screen height()/2,"Game Over"
    text 80,10,"Game Over"
endif
return

CheckScore:
if score>=HighScores(difficultyno)
    placed=1
    HighScores(difficultyno)=score
endif
recordedscore=1
return

ControlShooting:
if mouseclick()=1 and timer()-timerold>rapidfire and health>1
    timerold=timer()
    delete object bulletno
    clone object bulletno,13
    position object bulletno,object position x(PlayerObj),object position y(PlayerObj),object position z(PlayerObj)
    point object bulletno,(get pick vector x()*rotationmultiplier),(get pick vector y()*rotationmultiplier),(get pick vector z()*rotationmultiplier)
    xrotate object bulletno,wrapvalue(object angle x(bulletno)-7)
    texture object bulletno,rnd(2)+10
    inc bulletno
endif
return

ControlEnemies:
for eoe=201 to 250
    if object exist(eoe)=1
        if timer()-CreationTimes(eoe-200)>bulletdelay and DeathRecords(eoe-200)=0
            if object exist(enemybulletno)=1 then delete object enemybulletno
            instance object enemybulletno,15
            position object enemybulletno,object position x(eoe)-10,object position y(eoe)+20,object position z(eoe)
            point object enemybulletno,object position x(PlayerObj),object position y(PlayerObj),object position z(PlayerObj)
            CreationTimes(eoe-200)=timer()
            inc enemybulletno
        endif
        if DeathRecords(eoe-200)=1
            move object down eoe,1
            if object position y(eoe)<0
                delete object eoe
                DeathRecords(eoe-200)=0
            endif
        endif
        if DeathRecords(eoe-200)=2
            move object up eoe,1
            if object position z(eoe)>-30 and object position z(eoe)<-10 then dpos=35
            if object position z(eoe)>-80 and object position z(eoe)<-60 then dpos=70
            if object position z(eoe)<-110 and object position z(eoe)>-130 then dpos=135
            if object position y(eoe)=>dpos
                DeathRecords(eoe-200)=0
                CreationTimes(eoe-200)=timer()
            endif
        endif
    endif
next eoe
return
    


ControlNewObjects:
if timer()-timerold2>enemydelay and Full=0
    timerold2=timer()
    retrythat:
    inc Failures
    if Failures>NoOfEnemyLocs+2
        Full=1
        Gosub Continue
    endif
    randomnumber=rnd(NoOfEnemyLocs-1)+1
    for g=201 to 250
    if object exist(g)=1
        if EnemyLocations(randomnumber,1)=object position x(g) and EnemyLocations(randomnumber,2)=object position y(g)
            gosub retrythat
        endif
    endif
    next g
    for g=301 to 320
        if object exist(g)=1
            if EnemyLocations(randomnumber,1)=object position x(g) and EnemyLocations(randomnumber,2)=object position y(g)
                gosub retrythat
            endif
        endif
    next g
    elforenemy=rnd(8)
    if elforenemy=0
        instance object elfobject,1500
        position object elfobject,EnemyLocations(randomnumber,1),EnemyLocations(randomnumber,2)-20,EnemyLocations(randomnumber,3)
        ElfTimes(elfobject-300)=timer()
        DeathRecordsElf(elfobject-300)=2
        set object collision to polygons elfobject
        inc elfobject
        else
        instance object enemyno,10
        DeathRecords(enemyno-200)=2
        position object enemyno,EnemyLocations(randomnumber,1),EnemyLocations(randomnumber,2)-20,EnemyLocations(randomnumber,3)
        set object collision to polygons enemyno
        inc enemyno
    endif
    Continue:
    Failures=0
endif
return


ExitSub:
if file exist("HighScores.txt") then Delete file "HighScores.txt"
if file exist("HighNames.txt") then delete file "HighNames.txt"
save array "HighScores.txt",HighScores(10)
save array "HighNames.txt",HighScoresN$(10)
end

`Functions to randomize present color - thanks to TEH_CODERER
function ChangeColor(ImageNumber,ColorToR,ColorToG,ColorToB)
make memblock from image 1,ImageNumber
delete image ImageNumber
for x=0 to 256
   for y=0 to 192
      c=ReadFromImageMemblock(1,256,192,x,y)
      if rgbg(c)<72 and rgbb(c)<64
         if x>79 and x<90 and y>101 and y<115 then DONTDOIT=1
         if DONTDOIT=0
            r=rgbr(c)*ColorToR : g=rgbr(c)*ColorToG : b=rgbr(c)*ColorToB : WriteToImageMemblock(1,256,192,x,y,r,g,b)
            else
            DONTDOIT=0
         endif
      endif
   next y
next x
make image from memblock ImageNumber,1
delete memblock 1
endfunction

function WriteToImageMemblock(MemblockID,ImageWidth,ImageHeight,X,Y,RedValue,GreenValue,BlueValue)
MemblockPosition=X+(Y*ImageWidth)
if MemblockPosition>=0 and MemblockPosition<(ImageWidth*ImageHeight)
   write memblock dword MemblockID,12+(MemblockPosition*4),rgb(RedValue,GreenValue,BlueValue)
endif
endfunction

function ReadFromImageMemblock(MemblockID,ImageWidth,ImageHeight,X,Y)
MemblockPosition=X+(Y*ImageWidth)
if MemblockPosition>=0 and MemblockPosition<(ImageWidth*ImageHeight)
   ColorValue=memblock dword(MemblockID,12+(MemblockPosition*4))
endif
endfunction ColorValue

turtledove

if button_down() = 1 and button_down_var = 0
    button_down_var = 1
    `do stuff here
endif
if button_down() = 0 and button_down_var = 1
    button_down_var = 0
endif