Fibonacci word/fractal: Difference between revisions
Content added Content deleted
(→{{header|zkl}}: wrong link) |
(added FreeBasic) |
||
Line 309: | Line 309: | ||
}</lang> |
}</lang> |
||
It prints the level 25 word as the Python entry. |
It prints the level 25 word as the Python entry. |
||
=={{header|FreeBASIC}}== |
|||
<lang FreeBASIC>' version 23-06-2015 |
|||
' compile with: fbc -s console "filename".bas |
|||
Dim As String fw1, fw2, fw3 |
|||
Dim As Integer a, b, d , i, n , x, y, w, h |
|||
Dim As Any Ptr img_ptr, scr_ptr |
|||
' data for screen/buffer size |
|||
Data 1, 2, 3, 2, 2, 2, 2, 2, 7, 10, 8, 14 |
|||
Dim As Integer s(38,2) |
|||
For i = 3 To 9 |
|||
Read s(i,1) : Read s(i,2) |
|||
Next |
|||
For i = 9 To 38 Step 6 |
|||
s(i, 1) = s(i -1, 1) +2 : s(i, 2) = s(i -1, 1) + s(i -1, 2) |
|||
s(i +1, 1) = s(i, 2) +2 : s(i +1, 2) = s(i, 2) |
|||
s(i +2, 1) = s(i, 1) + s(i, 2) : s(i +2, 2) = s(i, 2) |
|||
s(i +3, 1) = s(i +1, 1 ) + s(i +2, 1) : s(i +3, 2) = s(i ,2) |
|||
s(i +4, 1) = s(i +3, 1) : s(i +4, 2) = s(i +3, 1) + 2 |
|||
s(i +5, 1) = s(i +3, 1) : s(i +5, 2) = s(i +3, 2) + s(i +4, 2) +2 |
|||
Next |
|||
' we need to set screen in order to create image buffer in memory |
|||
Screen 21 |
|||
scr_ptr = ScreenPtr() |
|||
If (scr_ptr = 0) Then |
|||
Print "Error: graphics screen not initialized." |
|||
Sleep |
|||
End -1 |
|||
End If |
|||
Do |
|||
Cls |
|||
Do |
|||
Print |
|||
Print "For wich n do you want the Fibonacci Word fractal (3 to 35)." |
|||
While Inkey <> "" : fw1 = Inkey : Wend ' empty keyboard buffer |
|||
Input "Enter or a value smaller then 3 to stop: "; n |
|||
If n < 3 Then |
|||
Print : Print "Stopping." |
|||
Sleep 3000,1 |
|||
End |
|||
EndIf |
|||
If n > 35 then |
|||
Print : Print "Fractal is to big, unable to create it." |
|||
Sleep 3000,1 |
|||
Continue Do |
|||
End If |
|||
Loop Until n < 36 |
|||
fw1 = "1" : fw2 = "0" ' construct the string |
|||
For i = 3 To n |
|||
fw3 = fw2 + fw1 |
|||
Swap fw1, fw2 ' swap pointers of fw1 and fw2 |
|||
Swap fw2, fw3 ' swap pointers of fw2 and fw3 |
|||
Next |
|||
fw1 = "" : fw3 = "" ' free up memory |
|||
w = s(n, 1) +1 : h = s(n, 2) +1 |
|||
' allocate memory for a buffer to hold the image |
|||
' use 8 bits to hold the color |
|||
img_ptr = ImageCreate(w,h,0,8) |
|||
If img_ptr = 0 Then ' check if we have created a image buffer |
|||
Print "Failed to create image." |
|||
Sleep |
|||
End -1 |
|||
End If |
|||
x = 0: y = h -1 : d = 1 ' set starting point and direction flag |
|||
PSet img_ptr, (x, y) ' set start point |
|||
For a = 1 To Len(fw2) |
|||
Select Case As Const d |
|||
Case 0 |
|||
x = x + 2 |
|||
Case 1 |
|||
y = y - 2 |
|||
Case 2 |
|||
x = x - 2 |
|||
Case 3 |
|||
y = y + 2 |
|||
End Select |
|||
Line img_ptr, -(x, y) |
|||
b = fw2[a-1] - Asc("0") |
|||
If b = 0 Then |
|||
If (a And 1) Then |
|||
d = d + 3 ' a = odd |
|||
Else |
|||
d = d + 1 ' a = even |
|||
End If |
|||
d = d And 3 |
|||
End If |
|||
Next |
|||
If n < 24 Then ' size is smaller then screen dispay fractal |
|||
Cls |
|||
Put (5, 5),img_ptr, PSet |
|||
Else |
|||
Print |
|||
Print "Fractal is to big for display." |
|||
End If |
|||
' saves fractal as bmp file (8 bit palette) |
|||
If n > 23 Then h = 80 |
|||
Draw String (0, h +16), "saving fractal as fibword" + Str(n) + ".bmp." |
|||
BSave "F_Word" + Str(n) + ".bmp", img_ptr |
|||
Draw String (0, h +32), "Hit any key to continue." |
|||
Sleep |
|||
ImageDestroy(img_ptr) ' free memory holding the image |
|||
Loop</lang> |
|||
=={{header|Icon}} and {{header|Unicon}}== |
=={{header|Icon}} and {{header|Unicon}}== |