Code archives/Miscellaneous/XKCD Time Castle Generator
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
| Much debate was had about this XKCD comic which updated every 30 minutes. This is just a demo to show how it could possibly have been scripted. Demo and image files here: http://kieryn.com/xkcd-time/ | |||||
Global baseImage= LoadImage("C:\start.png")
Global sizeX = ImageWidth(baseImage)
Global sizeY = ImageHeight(baseImage)
Graphics sizeX, sizeY
baseImage= LoadImage("C:\start.png")
Global imgClumps = LoadAnimImage("C:\clumps.png", 30,30,0,4)
Global imgSquareClumps = LoadAnimImage("C:\squareclumps.png", 30,30,0,4)
MaskImage imgClumps, 255,255,255
MaskImage imgSquareClumps, 255,255,255
Const stateWandering = 0
Const statePlanning = 1
Const stateBuildingClumps = 2
Const stateBuildingSquareClumps = 3
Const stateBuildingSmooth = 4
Const stateBuildingBattlements = 5
Const stateBuildingFinished = 6
Type Person
Field dir
Field x, y
Field cx, cy, cw, ch
Field state
Field bTimer
End Type
Function Render()
SetBuffer BackBuffer()
DrawImage baseImage, 0,0
For p.Person = Each Person
RenderPerson p
Next
VWait
Flip
End Function
Function RenderPerson(p.Person)
Color 0,0,0
waveA# = Rnd(0.5, 1.2)
waveB# = Rnd(2, 3.5)
offSetA# = Rnd(360)
offSetB# = Rnd(360)
For a# = 0 To 360.0 Step 0.2
r = 8 + 0.5 * Sin(waveA*a+offSetA) + 0.3 * Sin(waveB*a+offSetB)
For r2# = r To r+0.6 Step 0.3
x = p\x + r2 * Cos(a)
y = p\y + r2 * Sin(a)
Plot x, y
Next
Next
x0 = p\x
y0 = p\y + 10
x1 = p\x + Rnd(-5,5)
y1 = p\y + 30 + Rnd(-2,2)
WLine x0,y0,x1,y1
x2 = x1 + Rnd(5,8)
x3 = x1 - Rnd(5,8)
y2 = y1 + 30 + Rnd(-2,2)
WLine x0,y0,x2,y1
WLine x0,y0,x3,y1
WLine x2,y2,x1,y1
WLine x3,y2,x1,y1
End Function
Function WLine(x0,y0,x1,y1)
waveA# = Rnd(0.5, 2) * 360
offsetA = Rnd(360)
waveB# = Rnd(0.5, 2) * 360
offsetB = Rnd(360)
For n# = 0 To 1.0 Step 0.01
wobble1# = Sin(n*180) * (0.5+ Sin(n*waveA+offsetA))
wobble2# = Sin(n*180) * (0.5+ Sin(n*waveB+offsetB))
dX# = x1 - x0
dY# = y1 - y0
x# = x0 + (n+0.05*wobble1) * dX
y# = y0 + (n+0.05*wobble2) * dY
For x2# = x To x+0.6 Step 0.3
For y2# = y To y+0.6 Step 0.3
Plot x2, y2
Next
Next
Next
End Function
Function UpdatePeople()
SetBuffer ImageBuffer(baseImage)
For p.Person = Each Person
If p\state >= stateBuildingClumps Then
p\x = p\cx + p\cw*0.5
p\y = p\cy - 50
p\bTimer = p\bTimer + p\state -1
If p\bTimer > 6 Then
p\state = p\state + 1
p\bTimer = 0
End If
End If
If p\state = stateBuildingSquareClumps Or p\state = stateBuildingSmooth Or p\state = stateBuildingBattlements Then
x = Rnd(p\cx, p\cx+p\cw-30)
y = p\cy-p\ch
f = Floor(Rnd(4))
DrawImage imgSquareClumps, x, y+2, f
Color 2,2,2
Rect x, y+30, 30, sizeY
End If
If p\state = stateWandering Then
p\x = sizeX * Rnd(0.1, 0.7)
p\y = sizeY * 0.52 + 0.11 * p\x
If Rnd(10) > 8 Then
p\state = statePlanning
End If
ElseIf p\state = statePlanning Then
If Rnd(10) > 8 Then
p\state = stateWandering
End If
For i = 1 To 100
If (p\state = statePlanning)
FindGoodSandCastlePlace(p)
End If
Next
ElseIf p\state = stateBuildingClumps Then
x = Rnd(p\cx, p\cx+p\cw-30)
y = p\cy-p\ch
f = Floor(Rnd(4))
DrawImage imgClumps, x, y, f
Color 2,2,2
Rect x, y+30, 30, sizeY
ElseIf p\state = stateBuildingSmooth Then
Color 1,1,1
bwL = Rnd(1, 3)
bwR = Rnd(1, 3)
bh = -Rnd(5, 15)
Rect p\cx-bwL, p\cy-bh, p\cw+bwL+bwR, sizeY
th = 7
x0 = Rnd(p\cx-2.5, p\cx+p\cw)
x1 = x0 + Rnd(10, 20)
If x1 > p\cx+ p\cw+2.5 Then x1 = p\cx+ p\cw+2.5
Rect x0, p\cy-p\ch, x1-x0, th
ElseIf p\state = stateBuildingBattlements Then
Color 255,255,255
For x = p\cx + 4 To p\cx+p\cw-2 Step 7
If Rnd(10) > 7 And measureBlack(x,p\cy-p\ch-1, x+2, p\cy-p\ch-1) = 0 Then
Rect x,p\cy-p\ch, 2, 2
End If
Next
ElseIf p\state = stateBuildingFinished Then
Color 1,1,1
bwL = Rnd(1, 3)
bwR = Rnd(1, 3)
bh = -Rnd(5, 15)
Rect p\cx-bwL, p\cy-bh, p\cw+bwL+bwR, sizeY
Rect p\cx, p\cy-p\ch, p\cw, sizeY
th = Rnd(7,10)
Rect p\cx-2.5, p\cy-p\ch, p\cw+5, th
Rect p\cx-1.3, p\cy-p\ch, p\cw+2.7, th +2
Color 255,255,255
For x = p\cx + 4 To p\cx+p\cw-2 Step 7
If measureBlack(x,p\cy-p\ch-1, x+2, p\cy-p\ch-1) = 0 Then
Rect x,p\cy-p\ch, 2, 2
End If
Next
SetBuffer BackBuffer()
p\state = stateWandering
End If
Next
End Function
Function FindGoodSandCastlePlace(p.Person)
x = sizeX * 0.4 + 0.3 * sizeX * Rnd(-1,1) * Rnd(1)
y = sizeY * Rnd(0.5, 0.9)
w = Rnd(1,10)
h = 16 - w*2
w = w * 7 + 10
h = h + 18 + Rnd(10)
x2 = x + Rnd(20)
If measureBlack(x, y, x+w, y) < 40 And measureBlack(x, y+5, x+w, y+5) > 90 Then
p\cx = x
p\cy = y+8
p\cw = w
p\ch = h
p\state = stateBuildingClumps
End If
End Function
Function measureBlack(x0, y0, x1, y1)
SetBuffer ImageBuffer(baseImage)
black = 0
For n# = 0 To 1.0 Step 0.01
dX# = x1 - x0
dY# = y1 - y0
x = x0 + n * dX
y = y0 + n * dY
GetColor x, y
If ColorRed() < 20 Then
black = black + 1
End If
Next
Return black
End Function
SeedRnd MilliSecs()
p.Person = New Person
Global iframe = 1
Global iSequence = 1
While Not KeyHit(1)
UpdatePeople()
Render()
If (KeyHit(57)) Or iframe > 100 Then
FreeImage baseImage
baseImage= LoadImage("C:\start.png")
p\state = stateWandering
iSequence = iSequence + 1
CreateDir "C:\out\" + iSequence
iframe = 1
End If
SaveBuffer BackBuffer(), "C:\out\" + iSequence + "\" + iframe + ".bmp"
iframe = iframe + 1
Wend
End |
Comments
| ||
| Im trying to start this program, but it works only with debug mode on. Compiling or running this without Debugmode makes an error: "Unable to set graphic mode" The graphic files are in the c:\ directory, all 3 of them. And even the compiled program is in the C directory. BlitzPlus and Blitz3d do the same error. Im using windows XP Update: ok found out that if i do following changes the code works then : |
Code Archives Forum
   |