| |
|
|
p.specht
| Wozu lead missglückte Triangulationsversuche? to a Screensaver! Well ...
Windowtitle "The greedy Spechtilation Screensaver"
' (D) Dumpware 2013-08 by P. woodpecker
' usage on alleinige menace the Anwenders/the Anwenderin
randomize:font 2:Windowstyle 16 | 64 :Window 0,0-%maxx,%maxy
declare n&,i&,j&,k&,L!,mins!,im&,jm&,km&,sx!,sy!,free_next&,bound_next&,bound_2ndnext&
declare x![],y![],d&[],flag&
BEGN:
n&=rnd(2000)+3:clear x![]:clear y![]:clear d&[]
setsize x![],n&:setsize y![],n&:setsize d&[],n&
x![]=rnd(width(%hwnd)):y![]=rnd(height(%hwnd))
dec n&:free_next&=0:bound_next&=0:bound_2ndnext&=0
cls 0:usepen 0,5,rgb(0,0,255)
whileloop 0,n&:line x![&Loop],y![&Loop] - x![&Loop]+1,y![&Loop]:endwhile
locate 2,2:print "ENDE MIT ESC (...can last)!"
sx!=x![0]:sy!=y![0]
goto "SKIP"
LOP:
sx!=(x![im&]+x![jm&]+x![km&])/3
sy!=(y![im&]+y![jm&]+y![km&])/3
SKIP:
mins!=10^57:L!=0
whileloop 0,n&:i&=&Loop
case d&[i&]>0:continue
L!=(sqr(x![i&]-sx!)+sqr(y![i&]-sy!))'sqrt
if mins!>L!
mins!=L!
free_next&=i&
endif
endwhile
CASE mins!=10^57:Goto "EXIT"
usepen 0,6,rgb(0,200,0):line x![free_next&],y![free_next&]-x![free_next&]+1,y![free_next&]
mins!=10^57
whileloop 0,n&:i&=&Loop
case d&[i&]=0:continue
case i&=free_next&:continue
L!=(sqr(x![i&]-x![free_next&])+sqr(y![i&]-y![free_next&]))'sqrt
if mins!>L!
mins!=L!
bound_next&=i&
endif
endwhile
usepen 0,2,255:line x![free_next&],y![free_next&] - x![bound_next&],y![bound_next&]
d&[free_next&]=d&[free_next&]+1
d&[bound_next&]=d&[bound_next&]+1
mins!=10^57
whileloop 0,n&:i&=&Loop
case d&[i&]=0:continue
case i&=free_next&:continue
case i&=bound_next&:continue
L!=(sqr(x![i&]-x![free_next&])+sqr(y![i&]-y![free_next&]))'sqrt
if mins!>L!
mins!=L!
bound_2ndnext&=i&
endif
endwhile
usepen 0,2,255:line x![free_next&],y![free_next&] - x![bound_2ndnext&],y![bound_2ndnext&]
d&[free_next&]=d&[free_next&]+1
d&[bound_2ndnext&]=d&[bound_2ndnext&]+1
if n&<51
drawtext x![free_next&],y![free_next&],st$(d&[free_next&])
drawtext x![bound_next&],y![bound_next&],st$(d&[bound_next&])
drawtext x![bound_2ndnext&],y![bound_2ndnext&],st$(d&[bound_2ndnext&])
endif
im&=free_next&:jm&=bound_next&:km&=bound_2ndnext&
waitinput 3
case %key=27:END
goto "LOP"
EXIT:
waitinput 4000
GOTO "BEGN"
|
|
|
| Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 05/09/21 ▲ |
|
|
|