IceHockey

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
Realizimo
User
User
Posts: 71
Joined: Sun Nov 25, 2012 5:27 pm
Location: Sweden

IceHockey

Post by Realizimo »

Code: Select all

;Ice-hockey by Daniel / Pure 5.30 beta / 2014-07-10
;F2 release mouse
;S Restart
Global.f vinkel_diff , vinkelold , boll_y_test
Global.f pi , boll_y_riktn 
Global.f player_a , player_b, player_a_speed , player_b_speed 
Global.f player_1_speed2 , player_1_speed , player_1_speed3 , player_1_speed_max
Global.f vinkel , boll_x , boll_x_riktn, boll_y, bollspeed , bollspeedstart
Global.f player_1,player_2 , player
Global.f player_1_mal

;{ 
#a1=13
#a2=12
#a3=13
CAPTURECLOCK   = 11025                                      ; Sampling/Replay frequency in 'samples per second' 
BLKSIZE        = #a1*(#a2+#a3)                       ;312   ; Number of samples in capture/play block 
BytesPerSample = 2                                          ; Number of bytes needed for each sample 
Channels       = 1                                          ; Number of channels, 1 for mono, 2 for stereo.
BufSize        =  (BytesPerSample * Channels * BLKSIZE * Channels) ; Buffer to hold TWO blocks
*Header        =  AllocateMemory(BufSize + 12 + 24 + 8)     ; Memory for header and buffer
*P = *Header

; 'RIFF' chunk descriptor - 12 bytes
PokeS(*P,"RIFF",4)                          : *P + 4        ; 00-03 Chunk ID                                     4
PokeL(*P,0)                                 : *P + 4        ; 04-07 Chunk data size (Place holder)               4
PokeS(*P,"WAVE",4)                          : *P + 4        ; 08-11 'RIFF type'                                  4

; 'fmt' Subchunk          - 24 bytes
PokeS(*P,"fmt ",4)                          : *P+ 4         ; 12-15 'SubChunk ID'
PokeL(*P,16)                                : *P+ 4         ; 16-19 'Chunk data size'

PokeW(*P,1)                                 : *P+ 2         ; 20-21 'Compression code' 1=Non-compressed data PCM  2
PokeW(*P,Channels)                          : *P+ 2         ; 22-24 'Number of channels'                          2
PokeL(*P,CAPTURECLOCK)                      : *P+ 4         ; 24-27 'Sample rate'                                 4
PokeL(*P,Channels * BytesPerSample * CAPTURECLOCK) : *P+ 4  ; 28-31 'Average bytes per second'                    4
PokeW(*P,BytesPerSample * Channels)         : *P+ 2         ; 32-33 'Block align' Bytes per sample slice          2
PokeW(*P,8 * BytesPerSample )               : *P+ 2         ; 34-35 'Significant bits per sample'                 2

; 'data' Subchunk          - 8 bytes (+Buffer)
PokeS(*P,"data",4)                          : *P + 4        ; 'SubChunk ID'                                      4
PokeL(*P,BufSize)                           : *P + 4        ; Length of my data                                  4
FillMemory(*P,BufSize,0,#PB_Word)                           ; Clear the buffer

For b=1 To #a1
  For a=1 To #a2
    PokeW(*p,$0733) : *P + 2
  Next a
  For a=1 To #a3
    PokeW(*p,$F8CD) : *P + 2 
  Next a
Next b

;*g = *p - (*Header + BufSize + 12 + 24 + 8)
InitSound()
CatchSound(1,*Header)
PlaySound(1,0,0)
;}
a=$0733
b=$F8CD

#matchtid=300; 300 = 5 minuter

Procedure start()
 ok = 0 : sound = 1 
 If player = 1
  boll_x = 134
  If player_1>500 Or player_1<100 
  player_1 = 300 : MouseLocate (400, 300)
  EndIf
  boll_y = player_1 - 5
  EndIf
 If player = 2
  boll_x = 655
  If player_2>500 Or player_2<100 
  player_2 = 300 : MouseLocate (400, 300)
  EndIf
  boll_y = player_2 - 5
  EndIf
 bollspeedstart+0.2
 bollspeed = 0
EndProcedure

Procedure aipos (boll_x,boll_y,vinkel.d)
ai_y_malpos = (boll_x - 132.5) * Tan(vinkel.d)+boll_y+5
 		If ai_y_malpos>526 
 		 ai_y_malpos = (1065+0) - ai_y_malpos
 		 EndIf
 		If ai_y_malpos<63 
 		 ai_y_malpos = Abs(ai_y_malpos - 67)+67
 		 EndIf
ProcedureReturn ai_y_malpos
EndProcedure

Procedure.d aifart ()
player_1_speed = 1;(player_1_mal-player_1) / Abs(player_1_mal-player_1)
player_1_speed * (player_1_mal - player_1) / Abs(boll_x - 132)
player_1_speed * Abs(boll_x_riktn)
player_1_speed * bollspeed
If Abs(player_1_speed) > player_1_speed_max
player_1_speed = player_1_speed_max * (player_1_mal - player_1) / Abs(player_1_mal - player_1)
EndIf
ProcedureReturn player_1_speed
EndProcedure

If InitMouse() = 0 Or InitSprite() = 0 Or InitKeyboard() = 0
 MessageRequester("Error", "Can't open DirectX 7", 0)
 End
EndIf
Font1 = LoadFont ( #PB_Any , " Arial " , 20, #PB_Font_Bold )
Font2 = LoadFont ( #PB_Any , " Verdana ", 70, #PB_Font_Bold); Or #PB_Font_StrikeOut )


If OpenWindow (1, 0, 0, 800 , 600 , "icehockey...",#PB_Window_SystemMenu | #PB_Window_ScreenCentered )
 ;ButtonGadget (0, 700 , 135 , 45, 20, " Quit ")
 If OpenWindowedScreen ( WindowID (1) , 0, 0, 800 , 600 , 0, 0, 0) = 0
 MessageRequester (" Error ", "Can ’t open windowed screen !",0)
 End
 EndIf
EndIf
langd1 = 84
langd2 = 84
;bredd = 2
 ClearScreen ($FF0000) ; bricka 2
 CreateSprite (0, 16, langd1,#PB_Sprite_PixelCollision)
 StartDrawing ( SpriteOutput (0))
 Box (0, 0, 16, langd1, $00FFFF )
 Box (0, langd1/2, 16, 1, $00AAFF )
 StopDrawing ()
 
 ClearScreen ($FF0000) ; bricka 1
 CreateSprite (3, 16, langd2,#PB_Sprite_PixelCollision)
 StartDrawing ( SpriteOutput (3))
 Box (0,0, 16, langd2, $00FFFF )
 Box (0,langd1/2, 16, 1, $00AAFF )
 StopDrawing ()
 
 ClearScreen ($FF0000) ;boll
 CreateSprite (1, 11, 11,#PB_Sprite_PixelCollision)
 StartDrawing ( SpriteOutput (1))
 Circle (5,5,5, $FFFFFF )
 StopDrawing ()
 
 ClearScreen ($FF0000) ; utespelare
 CreateSprite (2, 16, 320,#PB_Sprite_PixelCollision)
 StartDrawing ( SpriteOutput (2))
 Box (0, 0, 16, 20, $00FFFF )
 Box (0, 150, 16, 20, $00FFFF )
 Box (0, 300, 16, 20, $00FFFF )
 StopDrawing ()
 
 CreateSprite(4,800,600) ; plan
StartDrawing(SpriteOutput(4))
 Box (	86	,	63	,	16	,	153	,$00FFFF)
 Box (	86	,	47	,	628	,	16	,$00FFFF)
 Box (	698	,	63	,	16	,	153	,$00FFFF)								
 Box (	86	,	384	,	16	,	153	,$00FFFF)
 Box (	86	,	537	,	628	,	16	,$00FFFF)
 Box (	698	,	384	,	16	,	153	,$00FFFF)
 Box (119, 0, 16, 47, $FF0000 )
 Box (665, 0, 16, 47, $FF0000 )
 Box (119, 553, 16, 47, $FF0000 )
 Box (665, 553, 16, 47, $FF0000 )
StopDrawing()
 
 boll_x = 400
 boll_y = 300
 pi = 3.1415926536
 
 
Repeat
goal=0
p1 = 0:p2 = 0
MouseLocate (400, 300)
player_1_speed = 0
bollspeedstart = 4
player_1_speed_max = 1.4
player_a = 82
player_a_speed = 6.5
player_b = 82
player_b_speed = 7
p = 100 : ok = 0
player_1 = 300
player_1_speed=0
player = Random(1)+1
StartTime = ElapsedMilliseconds () + #matchtid*1000+2000

Repeat
  ;looptime = ElapsedMilliseconds()
 
 ;raknare+1
 ClearScreen ($FF0000)
 ExamineKeyboard()
 If KeyboardReleased(#PB_Key_F2):R_Mouse+1:If R_Mouse = 2:R_Mouse=0:EndIf:ReleaseMouse(R_Mouse):EndIf

 ExamineMouse()
 WindowEvent()
 

 y = MouseY()
 ;y = WindowMouseY(1)
 ;player_1 = y
 player_2 = y
  
 player_1 = player_1+player_1_speed
 DisplaySprite(3, 119,player_1 - 41)
 DisplaySprite(0, 665,player_2 - 41)
 
 boll_x+boll_x_riktn * bollspeed
 boll_y+boll_y_riktn * bollspeed
 If p = 0
  If SpritePixelCollision ( 3 , 119,player_1 - 41 , 1 , boll_x,boll_y)And ok <> 1
   ok = 1 :sound = 1
   bollspeed + 0.2
   vinkelold = vinkel
   vinkel = vinkel -(player_1 - boll_y - 5) / 48 
   vinkel_diff = Abs(vinkel) - Abs(vinkelold)
    If Abs(vinkel)>0.7 : vinkel = 0.7 * vinkel / Abs(vinkel) : EndIf
   boll_x_riktn = Cos(vinkel) 
   boll_y_riktn = Sin(vinkel) 
   ;player_1_mal = 300
   player_1_speed = (300 - player_1) / 200
 EndIf
 
  If SpritePixelCollision ( 0 , 665,player_2 - 41 , 1 , boll_x,boll_y)And ok <> 2
   ok = 2:sound = 1
   bollspeed + 0.2
   vinkel = vinkel -(player_2 - boll_y - 5) / 48
    If Abs(vinkel)>0.7 : vinkel = 0.7 * vinkel / Abs(vinkel) : EndIf
   boll_x_riktn = -Cos(vinkel) 
   boll_y_riktn = Sin(vinkel)
   player_1_mal = aipos(boll_x,boll_y,vinkel)
   player_1_speed = aifart() 
  EndIf
  EndIf
  
  If boll_y<63 And ok <> 3
   ok = 3:sound = 1
   vinkel = Abs(vinkel)
   boll_y_riktn = Abs(boll_y_riktn)
  EndIf
  If boll_y>526 And ok <> 4
   ok = 4:sound = 1
   vinkel = -Abs(vinkel)
   boll_y_riktn = -Abs(boll_y_riktn)
  EndIf
  
  If boll_x<102 And ok <> 5
   ok = 5
   If boll_y>216 And boll_y<373
    p = 100: p2 = p2+goal : player = 2 : player_1_speed_max +0.15
   Else
    boll_x_riktn = Abs(boll_x_riktn):sound = 1
   EndIf
   ;player_1_mal = 300
   player_1_speed = (300 - player_1) / 200
  EndIf
  If boll_x>682 And ok <> 6
   ok = 6
   If boll_y>216 And boll_y<373
    p = 100 : p1 = p1 +goal :player = 1
   Else
    boll_x_riktn = -Abs(boll_x_riktn):sound = 1
    player_1_mal = aipos(boll_x,boll_y,vinkel)
    player_1_speed = aifart()
   EndIf
  EndIf
 If p<>0
 ;Else
  p = p - 1
  If p = 50
   If player = 1 : player_1_speed = (Random(200) - 100) / 150 : EndIf
   start()
   goal = 1
   sound = 1
  EndIf
  If p = 0
   bollspeed = bollspeedstart
   boll_x_riktn = 0
   boll_y_riktn = 0
   vinkel = 0
  EndIf
 EndIf
 
 DisplaySprite(1,boll_x,boll_y)
 
  If player_a >213 : player_a_speed = -player_a_speed : EndIf
  If player_a <66 : player_a_speed = -player_a_speed : EndIf
  If player_b >213 : player_b_speed = -player_b_speed : EndIf
  If player_b <66 : player_b_speed = -player_b_speed : EndIf
 
 player_a+player_a_speed
 player_b+player_b_speed
 DisplayTransparentSprite(2, 240,player_a)
 DisplayTransparentSprite(2, 544,player_b)
 
 If SpritePixelCollision ( 2, 240,player_a , 1 , boll_x,boll_y)And ok <> 7 And boll_x_riktn<0
  ok = 7:sound = 1
  boll_x_riktn = Abs(boll_x_riktn)
  ;player_1_mal = 300
  player_1_speed = (300 -player_1) / 200
 EndIf
  
 If SpritePixelCollision ( 2, 544,player_b , 1 , boll_x,boll_y)And ok <> 8 And boll_x_riktn>0
  ok = 8:sound = 1
  boll_x_riktn = -Abs(boll_x_riktn)
  player_1_mal = aipos(boll_x,boll_y,vinkel)
  player_1_speed = aifart()
 EndIf
 
  If sound = 1 : PlaySound(1,0,100):sound = 0 : EndIf
  If bollspeed >17 : bollspeed = 17: EndIf
  
  
  DisplayTransparentSprite(4,0,0)
  ;{
 StartDrawing (ScreenOutput()) 
 BackColor($FF0000)
;   DrawingMode(#PB_2DDrawing_Transparent)
 DrawingFont(FontID(font1))
 sekunder = (StartTime - ElapsedMilliseconds()) / 1000
 
  If sekunder =< 0
   DrawText (300, 5, "Match finished", $00FFFF) 
   player_1_speed = 0 : goal=0
 Else
    minuter = sekunder / 60
 sekunder = sekunder - minuter * 60
   DrawText (380, 5, Str(minuter)+":"+RSet(Str(sekunder), 2, "0"), $00FFFF);, $FF0000)
 EndIf
  ;RSet(Str(sekunder), 2, "0")

 DrawText (100, 5, Str(p1 ), $000000);, $FF0000)
 DrawText (680, 5, Str(p2), $000000);, $FF0000)
 ;DrawText (350, 555, "lagg  "+Str(ElapsedTime))

 ;DrawText (380, 21, Str(raknare / 60), $00FFFF);, $FF0000)
 ;DrawText (680, 550, StrD(bollspeed,1), $FFFF00);, $FF0000)
 ;DrawText (380, 550, Str(vinkel * 57.29577951), $FFFF00);, $FF0000)
 ;DrawText (440, 550, StrD(vinkel_diff * 57.29577951,1), $FFFFFF);, $FF0000)
 ;DrawText (300, 550, StrD(player_1_speed,2), $FFFF00);, $FF0000)
 If (p And goal) Or sekunder = > #matchtid
  DrawingFont(FontID(font2))
  DrawText (136 , 80, Str(p1 ), $00FFFF);, $FF0000)
  DrawText (562, 80, Str(p2), $00FFFF);, $FF0000)
 EndIf
 
 StopDrawing ()
  ;}
 If KeyboardPushed(#PB_Key_Escape) :Break 2:EndIf
 
 ;ElapsedTime = ElapsedMilliseconds()-looptime 
 FlipBuffers()
Until KeyboardPushed(#PB_Key_S)

ForEver
User avatar
Tenaja
Addict
Addict
Posts: 1959
Joined: Tue Nov 09, 2010 10:15 pm

Re: IceHockey

Post by Tenaja »

Thank you for sharing.

Did you use an OS other than windows? When I get to the first PlaySound(), I get an error:
The specified #Sound is not initialized.

(This also happens with the automatic cars program.)
Realizimo
User
User
Posts: 71
Joined: Sun Nov 25, 2012 5:27 pm
Location: Sweden

Re: IceHockey

Post by Realizimo »

I Use win7 64bit
What line you get the error?
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: IceHockey

Post by davido »

@Realizimo,
I get same error as Tenaja.
Line 57 Playsound (1,0,0)

I am using Windows 7 and PureBasic 5.31, perhaps you are using an earlier version?
Works ok if all references to PlaySound are erased.
DE AA EB
User avatar
luis
Addict
Addict
Posts: 3895
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy

Re: IceHockey

Post by luis »

Unicode + PokeS() + CatchSound() return value not tested = no sound

Just add #PB_Ascii.
"Have you tried turning it off and on again ?"
User avatar
Paul
PureBasic Expert
PureBasic Expert
Posts: 1285
Joined: Fri Apr 25, 2003 4:34 pm
Location: Canada
Contact:

Re: IceHockey

Post by Paul »

Or turn off "Create Unicode Executable" under Compiler Options.
Image Image
User avatar
luis
Addict
Addict
Posts: 3895
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy

Re: IceHockey

Post by luis »

Obviously ... (I hope...) :lol:
"Have you tried turning it off and on again ?"
Realizimo
User
User
Posts: 71
Joined: Sun Nov 25, 2012 5:27 pm
Location: Sweden

Re: IceHockey

Post by Realizimo »

Thanks luis
guess that was the problem.
here is the new sound rutine (line 13 - 59)
(same to automatic cars (line 77 - 123))

Code: Select all

;{ 
#a1=13
#a2=12
#a3=13
CAPTURECLOCK   = 11025                                      ; Sampling/Replay frequency in 'samples per second' 
BLKSIZE        = #a1*(#a2+#a3)                       ;312   ; Number of samples in capture/play block 
BytesPerSample = 2                                          ; Number of bytes needed for each sample 
Channels       = 1                                          ; Number of channels, 1 for mono, 2 for stereo.
BufSize        =  (BytesPerSample * Channels * BLKSIZE * Channels) ; Buffer to hold TWO blocks
*Header        =  AllocateMemory(BufSize + 12 + 24 + 8)     ; Memory for header and buffer
*P = *Header
; 'RIFF' chunk descriptor - 12 bytes
PokeS(*P,"RIFF",4, #PB_Ascii)               : *P + 4        ; 00-03 Chunk ID                                     4
PokeL(*P,0)                                 : *P + 4        ; 04-07 Chunk data size (Place holder)               4
PokeS(*P,"WAVE",4, #PB_Ascii)               : *P + 4        ; 08-11 'RIFF type'                                  4

; 'fmt' Subchunk          - 24 bytes
PokeS(*P,"fmt ",4, #PB_Ascii)               : *P+ 4         ; 12-15 'SubChunk ID'
PokeL(*P,16)                                : *P+ 4         ; 16-19 'Chunk data size'

PokeW(*P,1)                                 : *P+ 2         ; 20-21 'Compression code' 1=Non-compressed data PCM  2
PokeW(*P,Channels)                          : *P+ 2         ; 22-24 'Number of channels'                          2
PokeL(*P,CAPTURECLOCK)                      : *P+ 4         ; 24-27 'Sample rate'                                 4
PokeL(*P,Channels * BytesPerSample * CAPTURECLOCK) : *P+ 4  ; 28-31 'Average bytes per second'                    4
PokeW(*P,BytesPerSample * Channels)         : *P+ 2         ; 32-33 'Block align' Bytes per sample slice          2
PokeW(*P,8 * BytesPerSample )               : *P+ 2         ; 34-35 'Significant bits per sample'                 2

; 'data' Subchunk          - 8 bytes (+Buffer)
PokeS(*P,"data",4, #PB_Ascii)               : *P + 4        ; 'SubChunk ID'                                      4
PokeL(*P,BufSize)                           : *P + 4        ; Length of my data      
PokeL(*P,BufSize)                           : *P + 4        ; Length of my data                                  4
FillMemory(*P,BufSize,0,#PB_Word)                           ; Clear the buffer

For b=1 To #a1
  For a=1 To #a2
    PokeW(*p,$0733) : *P + 2
  Next a
  For a=1 To #a3
    PokeW(*p,$F8CD) : *P + 2 
  Next a
Next b
InitSound()
CatchSound(0,*Header)
CatchSound(2,*Header)
SetSoundFrequency(0, 5500) 
SetSoundFrequency(2, 23500) 
;}
User avatar
luis
Addict
Addict
Posts: 3895
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy

Re: IceHockey

Post by luis »

Nice by the way, I like it :wink:
"Have you tried turning it off and on again ?"
Realizimo
User
User
Posts: 71
Joined: Sun Nov 25, 2012 5:27 pm
Location: Sweden

Re: IceHockey

Post by Realizimo »

wrong of me. :oops:
this code is for Icehockey
the last one is for automatic cars.

Code: Select all

;{ 
#a1=13
#a2=12
#a3=13
CAPTURECLOCK   = 11025                                      ; Sampling/Replay frequency in 'samples per second' 
BLKSIZE        = #a1*(#a2+#a3)                       ;312   ; Number of samples in capture/play block 
BytesPerSample = 2                                          ; Number of bytes needed for each sample 
Channels       = 1                                          ; Number of channels, 1 for mono, 2 for stereo.
BufSize        =  (BytesPerSample * Channels * BLKSIZE * Channels) ; Buffer to hold TWO blocks
*Header        =  AllocateMemory(BufSize + 12 + 24 + 8)     ; Memory for header and buffer
*P = *Header

; 'RIFF' chunk descriptor - 12 bytes
PokeS(*P,"RIFF",4, #PB_Ascii)               : *P + 4        ; 00-03 Chunk ID                                     4
PokeL(*P,0)                                 : *P + 4        ; 04-07 Chunk data size (Place holder)               4
PokeS(*P,"WAVE",4, #PB_Ascii)               : *P + 4        ; 08-11 'RIFF type'                                  4

; 'fmt' Subchunk          - 24 bytes
PokeS(*P,"fmt ",4, #PB_Ascii)               : *P+ 4         ; 12-15 'SubChunk ID'
PokeL(*P,16)                                : *P+ 4         ; 16-19 'Chunk data size'

PokeW(*P,1)                                 : *P+ 2         ; 20-21 'Compression code' 1=Non-compressed data PCM  2
PokeW(*P,Channels)                          : *P+ 2         ; 22-24 'Number of channels'                          2
PokeL(*P,CAPTURECLOCK)                      : *P+ 4         ; 24-27 'Sample rate'                                 4
PokeL(*P,Channels * BytesPerSample * CAPTURECLOCK) : *P+ 4  ; 28-31 'Average bytes per second'                    4
PokeW(*P,BytesPerSample * Channels)         : *P+ 2         ; 32-33 'Block align' Bytes per sample slice          2
PokeW(*P,8 * BytesPerSample )               : *P+ 2         ; 34-35 'Significant bits per sample'                 2

; 'data' Subchunk          - 8 bytes (+Buffer)
PokeS(*P,"data",4, #PB_Ascii)               : *P + 4        ; 'SubChunk ID'                                      4
PokeL(*P,BufSize)                           : *P + 4        ; Length of my data                                  4
FillMemory(*P,BufSize,0,#PB_Word)                           ; Clear the buffer

For b=1 To #a1
  For a=1 To #a2
    PokeW(*p,$0733) : *P + 2
  Next a
  For a=1 To #a3
    PokeW(*p,$F8CD) : *P + 2 
  Next a
Next b

;*g = *p - (*Header + BufSize + 12 + 24 + 8)
InitSound()
CatchSound(1,*Header)
PlaySound(1,0,0)
;}
Post Reply