PureBasic Forums - English

Code: Select all

;*****************************************************************************
;*
;* PurePunch Contest #4
;*
;* Name     :  Hase!
;* Author   : coder/FreakyBytes
;* Category : Game
;* Date     : 16th September 2009
;* Notes    : The target is to navigate through the levels as fast as you can.
;*            The dark green fields bring you to the Next level, or not :P
;*            Use the arrow-keys To move your player!
;*            Good Luck!
;*            
;*            Sorry for my bad English...
;*
;*****************************************************************************

;-------------------------------------------------------------------------------
ml=PeekL(?w):len=PeekL(?w+4):img=PeekL(?w+8):px=1:Macro em:ElapsedMilliseconds()
EndMacro:Macro o:?w+12+(l*len)+(y*100)+(x*5):EndMacro:Macro p:Dim f.k(19,18)
For y=0 To 18:For x=0 To 19:f(x,y)\c=PeekL(o):f(x,y)\d=PeekB(o+4):Next:Next
EndMacro:Structure k:c.l:d.b:v.b:EndStructure:InitSprite():InitKeyboard():py=1
Macro r(_k):KeyboardReleased(_k):EndMacro:Macro sh(_x,_y):f(_x,_y)\v=1:EndMacro
OpenWindowedScreen(OpenWindow(0,0,0,800,600,"Hase!",13107201),0,0,800,800,1,0,0)
CatchSprite(0,?w+img):l=0:p:ti=em:Repeat:ExamineKeyboard():ClearScreen($585858)
StartDrawing(ScreenOutput()):For y=0 To 18:For x=0 To 19:If f(x,y)\v
Box(x*40+1,y*40+1,38,38,f(x,y)\c):EndIf:Next:Next:StopDrawing():opx=px:opy=py
For x=px-2 To px+2:For y=py-2 To py+2:If x>=0 And y>=0 And x<20 And y<19:sh(x,y)
EndIf:Next:Next:DisplayTransparentSprite(0,px*40,py*40):If r(203):px-1
ElseIf r(205):px+1:ElseIf r(208):py+1:ElseIf r(200):py-1:EndIf:d=f(px,py)\d
If d=1:px=opx:py=opy:ElseIf d=2:l+1:px=1:py=1:If l>ml:t$="YOU WIN";© 2009 by Martin Peters
t$+#CRLF$+"in "+StrF((em-ti)/60000, 2)+" min":MessageRequester("",t$):End:EndIf
p:ElseIf d<0:l+d:px=1:py=1:p:EndIf:Repeat:EV=WindowEvent():If EV=16:End:EndIf
Until EV=0:FlipBuffers():ForEver:DataSection:w:IncludeBinary "l.bin"
EndDataSection

Code: Select all

;*****************************************************************************
;*
;* PurePunch Contest #4
;*
;* Name     :  HTTP-Time Sync
;* Author   : coder/FreakyBytes
;* Category : Utility
;* Date     : 16th September 2009
;* Notes    : A little Tool to sync your pc-time with a webserver
;*            The code to parse a HTTP-Date is written by AND51, so special thanks to him!
;*            Don't enter á hostname without port, because the app doesn't work, if input only a hostname!
;*
;*****************************************************************************

Procedure.s ReplaceStrings(String$, StringsToFind$, StringsToReplace$, Seperator$="|")
   Protected n.l
   For n=1 To CountString(StringsToFind$, Seperator$)+1
      String$=ReplaceString(String$, StringField(StringsToFind$, n, Seperator$), StringField(StringsToReplace$, n, Seperator$))
   Next
   ProcedureReturn String$
EndProcedure
Define.q stime, rtime, ctime, frq
If Not InitNetwork()
  End
EndIf
ip$ = ProgramParameter()
If Not ip$
  ip$ = InputRequester("HTTP-Time", "Please input a ip or hostname on which runs a webserver! (hostname:port)", "127.0.0.1:80")
EndIf
Con = OpenNetworkConnection(StringField(ip$, 1, ":"), Val(StringField(ip$, 2, ":")))
If Not Con
  End
EndIf
QueryPerformanceFrequency_(@frq)
QueryPerformanceCounter_(@stime)
SendNetworkString(Con, "HEAD / HTTP/1.1"+#CRLF$+"Connection: Close"+#CRLF$+#CRLF$)
Repeat
  If NetworkClientEvent(Con) = #PB_NetworkEvent_Data
    QueryPerformanceCounter_(@rtime)
    Mem = AllocateMemory(2048)
    Len = ReceiveNetworkData(Con, Mem, 2048)
    recv$ = PeekS(Mem, Len)
    Break
  EndIf
  QueryPerformanceCounter_(@ctime)
Until ((ctime-stime)*1000/frq)/1000 >= 10000  ;TimeOut after 10s
If recv$
  CloseNetworkConnection(Con)
  start = FindString(recv$, "Date:", 1)
  ende = FindString(recv$, #CRLF$, start)
  time$ = Mid(recv$, start+6, ende-start-6)
  time$ = Trim(ReplaceStrings(time$, "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec", "01|02|03|04|05|06|07|08|09|10|11|12"))
  t = ParseDate("Day, %dd %mm %yyyy %hh:%ii:%ss GMT", time$)-(((ctime-stime)*1000/frq)/1000)
    date.SYSTEMTIME\wYear=Year(t) 
    date.SYSTEMTIME\wMonth=Month(t) 
    date.SYSTEMTIME\wDay=Day(t) 
    date.SYSTEMTIME\wDayOfWeek=DayOfWeek(t) 
    date.SYSTEMTIME\wHour=Hour(t) 
    date.SYSTEMTIME\wMinute=Minute(t) 
    date.SYSTEMTIME\wSecond=Second(t)
    SetSystemTime_(date)
  MessageRequester("New Time", "New Time is set!"+#CRLF$+FormatDate("%yyyy-%mm-%dd  %hh:%ii:%ss GMT", t)+#CRLF$+"Pingtime: "+StrD((rtime-stime)*1000/frq,2)+"ms")
EndIf
;Debug recv$