Wäre es nicht mal wieder an der Zeit...

[ts-soft]

Ohhh...geht's schon los?

Wir warten auf die Aufgabe. Soll ein Problem gelöst werden oder ein vorgegebene Code gekürzt?
Ich finde eine Problemlösung macht das ganze Anspruchsvoller.

[STARGÅTE]

Ein Spiel sollte es meiner Meinung nach nicht sein, denn dort wird an "falscher" Stelle optimiert (zB keine Benutzeroberfläche mehr, bei TicTacToe).

Besser wäre irgendein Algorithmus zu erstellen/optimieren der ein genau definiertes Resultat liefert (zB Bild oder Text):
Hier mal mehr oder weniger sinnvolle Beispiele:

• Mandelprotmenge im Intervall [-2,2], i*[-2,2]
• Berechnung der ersten 1000 Primzahlen
• Code, der sich selbst komplett im Debugger ausgibt.

[ts-soft]

6 aus 49, Darstellung ohne Verwendung eines Fonts, also ohne Print, DrawText usw., sondern Malen
Externe Dateien und DataSektion sind auch verboten.

[7x7]

Ob "vorgegebener Code" oder "Problemlösung"...beides wird auf das gleiche hinauslaufen. Der erste "problemgelöste" Code
der eingestellt wird, wird zur Vorgabe und verändert werden.

Hat denn keiner einen Code in der Kiste, der für Puregolf geeignet wäre? Nicht zu klein, nicht zu gross, nicht zu speziell,
etwas lustiges, wo auch evtl.Anfänger (zumindest anfangs ) zurechtkommen...

Stargate? Kein kleines Spielchen parat? Komm...hast doch bestimmt was! Oder ts-soft? NicTheQuick?

[ts-soft]

Guck im CodeArchiv nach, da ist genug verwertbares Material vorhanden, lediglich drauf achten, das keine API und
keine ext. Dateien verwendet werden.

[NicTheQuick]

Wie wär's damit?
Execute Brainfuck code

[STARGÅTE]

Hm, kannst du den mal hier posten den Code, ich kann ihn nicht kopieren, weil keine Zeilenumbrüche mehr da sind.

[NicTheQuick]

Code: Alles auswählen

Procedure displayEndingMsg()
  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
  Input()
  CloseConsole()
  End
EndProcedure
 
Procedure displayErrorThenEnd(msg.s)
  PrintN(msg)
  displayEndingMsg()
EndProcedure
 
Macro bracketSearch(drx = 1) ;drx = -1 to search backwards
  bktCnt = drx ;start count with the current bracket
  ;count nested loops till matching one is found
  Repeat 
    i + drx ;move the code pointer
    If Mid(code$, i, 1) = "]"
      bktCnt - 1
    ElseIf Mid(code$, i, 1) = "["
      bktCnt + 1
    EndIf 
  Until bktCnt = 0
EndMacro
 
If Not OpenConsole()
  MessageRequester("Error", "Unable to open console.")
  End
EndIf
 
Define memsize = 1000          ;this may grow as needed
Define instChars$ = "+-<>.,[]" ;valid characters
Define ptr = 0                 ;memory pointer
 
Print("Filename (blank to use std in)...? ")
filename$ = Input()
If filename$ = ""
  Repeat
    line$ = Input()
    source$ = source$ + line$
  Until line$ = ""
Else
  OpenFile(1, filename$)
  Repeat
    line$ = ReadString(1)
    source$ = source$ + line$
  Until Eof(1)
  CloseFile(1)
EndIf
 
;remove non-code and validate number of brackets
bktCnt = 0
For i = 1 To Len(source$)
  char$ = Mid(source$, i, 1)
  ;validate instruction character
  If FindString(instChars$, char$, 1)
    code$ + char$
    ;count brackets
    Select char$
      Case "["
        bktCnt + 1
      Case "]"
        bktCnt - 1
    EndSelect
  EndIf
Next
 
If bktCnt  ;mismatched brackets
  displayErrorThenEnd("Uneven brackets")
EndIf
 
Dim memory(memsize) ;use integer cell size
Define inLine$ = "" ;input buffer
For i = 1 To Len(code$) ;loop through the code
  Select Mid(code$, i, 1) ;examine the current instruction
    Case "+"
      memory(ptr) + 1
    Case "-"
      memory(ptr) - 1
    Case "."
      Print(Chr(memory(ptr)))
    Case ","
      If inLine$ = "": inLine$ = Input(): EndIf ;buffer input
      memory(ptr) = Asc(Left(inLine$, 1))       ;store first char off the buffer
      inLine$ = Mid(inLine$, 2)                 ;delete first char from the buffer
    Case ">"
      ptr + 1
      If ptr > memsize
        memsize + 1000
        Redim memory.b(memsize)
      EndIf
    Case "<"
      ptr - 1
      If ptr < 0 
        displayErrorThenEnd("Memory pointer out of range")
      EndIf
    Case "["
      If memory(ptr) = 0 
        bracketSearch()
      EndIf
    Case "]"
      If memory(ptr) <> 0 
        bracketSearch(-1)
      EndIf
  EndSelect
Next
displayEndingMsg()

[ts-soft]

Code: Alles auswählen

EnableExplicit
Global b,i,m=1000,C$="+-<>.,[]",p,f.s,l.s,s.s,c.s,o.s,w.s
Macro T
Procedure
EndMacro
Macro E
EndProcedure
EndMacro
T U()
Print(#CRLF$+#CRLF$+"Press ENTER to exit")
Input()
CloseConsole()
End
E
T Z(m$)
PrintN(m$)
U()
E
Macro a(d=1)
b=d
Repeat
i+d
If Mid(o,i)="]"
b-1
ElseIf Mid(o,i)="["
b+1
EndIf
Until b=0
EndMacro
If OpenConsole()=0
MessageRequester("Error","Unable to open console.")
End
EndIf
Print("Filename (blank to use std in)...? ")
f=Input()
If f=""
Repeat
l=Input()
s+l
Until l=""
Else
OpenFile(1,f)
Repeat
l=ReadString(1)
s+l
Until Eof(1)
CloseFile(1)
EndIf
For i=1 To Len(s)
c=Mid(s,i)
If FindString(C$,c)
o+c
Select c
Case "["
b+1
Case "]"
b-1
EndSelect
EndIf
Next
If b
Z("Uneven brackets")
EndIf
Dim _.b(m)
For i=1 To Len(o)
Select Mid(o,i)
Case "+"
_(p)+1
Case "-"
_(p)-1
Case "."
Print(Chr(_(p)))
Case ","
If w=""
w=Input()
EndIf
_(p)=Asc(Left(w,1))
w=Mid(w,2)
Case ">"
p+1
If p>m
m+1000
ReDim _(m)
EndIf
Case "<"
p-1
If p<0
Z("Memory pointer out of range")
EndIf
Case "["
If _(p)=0
a()
EndIf
Case "]"
If _(p)<>0
a(-1)
EndIf
EndSelect
Next
U()

975 Zeichen als Anfang

[rolaf]

Sag mal habt ihr zuviel Zeit?
Einfach den "Rüssel" auf den Tisch legen, wer den kürzesten hat, hat gewonnen.
Natur-Golf...