Here are 2 Codes from Germany.
HASE!
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
And a small utility with 50 Lines:
HTTP-Time Sync
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$
Here you can download both codes.