|
27.04.2012, 19:58
|
#1
|
Дэвелопер
Регистрация: 04.09.2005
Адрес: Красноярск
Сообщений: 1,376
Написано 491 полезных сообщений (для 886 пользователей)
|
Ещё стихоплёт
Я тоже сделал генератор для рифмования.
Фразы читаются из файлов, и мелкие настройки в файле info.txt - можно без изменения кода подставить иное содержание.
Пара примеров:
Не зная боли день без ссоры
крутая тварь на дубе в чём
По чём морочит рот хвалёный
всё водит сказками с мостом
Дыра в заборе квас весёлый
святая цепь на дубе том
С конём порочен жмот хвалёный
позорит пасека златом
Лежащий в коме рот зелёный
из мая дрель забудет лом
По чём в рассрочку таз борщёвый
направит скатертью огём
Кажись, стрёмную эталонную строфу я взял.
Исходник:
SuperStrict
Framework brl.basic
Import brl.d3d7max2d
Import brl.filesystem
Import brl.textstream
Import brl.freetypefont
Import brl.retro
ChangeDir(CurrentDir())
AppTitle = "ptzm1"
Graphics(600, 600)
Global frazeCount:Int = 10
Local breakPos:Int[] = [2, 6, 10]
Local fntSize:Int = 26
If(FileType("data\info.txt") = 1)
Local text:String = LoadText("data\info.txt")
Local mas:String[] = text.Split("~r~n")
frazeCount = Int(mas[0])
Local k:Int, cnt:Int = Int(mas[1])
breakPos = New Int[cnt]
For k = 0 Until cnt
breakPos[k] = Int(mas[2 + k])
Next
EndIf
Global frazes:String[][] = New String[][frazeCount]
LoadFrazes()
Local f1:TImageFont = LoadImageFont("data\font.ttf", fntSize)
Local f2:TImageFont = LoadImageFont("data\font.ttf", 16)
Local k:Int, j:Int, break:Int
Local x:Float, y:Float, x0:Float
Local s:String, full:String = "", save:Int, path:String = ""
'Print frazes.Length
Local seed:Int, r:Int
While Not(KeyHit(KEY_ESCAPE) Or AppTerminate())
x0 = 40
x = x0
y = 50
save = KeyHit(KEY_F2)
SetImageFont(f1)
SetColor(200, 200, 200)
SeedRnd(seed)
For k = 0 Until frazeCount
If(frazes[k] = Null) Then Continue
If(seed = 0)
r = 0
Else
r = Rand(0, frazes[k].Length - 1)
EndIf
s = frazes[k][r]
x = x + DrawFraze(s, x, y)
If(save = True) Then full:+s + " "
break = False
For j = 0 Until breakPos.Length
If(k = breakPos[j])
break = True
Exit
EndIf
Next
If(break = True)
If(x0 < 50)
x0:+20
Else
x0:-20
EndIf
x = x0
y:+40
If(save = True) Then full:+"~r~n"
EndIf
Next
SetImageFont(f2)
SetColor(130, 130, 130)
DrawText("Пробел - генерить новое", 20, 540)
DrawText("F2 - сохранить", 20, 560)
If(path <> "") Then DrawText("Сохранено: " + path, 250, 560)
Flip
Cls
If(KeyHit(KEY_SPACE))
if(seed = 0)
seed = MilliSecs()
Else
seed:+Rand(5000, 50000)
EndIf
EndIf
If(save = True)
CreateDir("save")
path = "save\" + CurrentDate() + ", " + CurrentTime() + ".txt"
path = path.Replace(":", " ")
SaveText(full, path)
full = ""
EndIf
Wend
End
Function DrawFraze:Float(fraze:String, x:Float, y:Float)
fraze:+" "
DrawText(fraze, x, y)
Return TextWidth(fraze)
End Function
Function LoadFrazes()
Local k:Int, text:String, path:String
For k = 0 Until frazeCount
path = "data\" + k + ".txt"
If(FileType(path) <> 1) Then Continue 'RuntimeError("Файл " + path + " не найден. Выход из программы.")
text = Trim(LoadText(path))
frazes[k] = text.Split("~r~n")
Next
End Function
Картинка:
|
(Offline)
|
|
Эти 7 пользователя(ей) сказали Спасибо Жека за это полезное сообщение:
|
|
28.04.2012, 12:48
|
#2
|
Дэвелопер
Регистрация: 04.09.2005
Адрес: Красноярск
Сообщений: 1,376
Написано 491 полезных сообщений (для 886 пользователей)
|
Ответ: Ещё стихоплёт
Новая версия, 1.1.
Улучшения:
- отказ от SeedRnd(), который был в цикле;
- рандом улучшен;
- словарная база расширена;
- управление мышкой: левая кнопка - новый текст, правая - сохранить.
Избранное:
Залился горем крот весёлый
витая мразь не видит ждём
Споём приспичит byte учёный
всё водит рябчиком кругом
Решил кривляться спорт скруглённый
внатуре моль мохнатым злом
Пердун пупочек таз сгущёный
бессмертно сможет так в простом
Девичьей доле дуб топлёный
родная мразь как будто днём
Плечом отскочит гриф тяжёлый
безумно дерево эй, йоу!
Пошёл сдаваться свист без ссоры
кусая соль работай ртом
Пешком граничный лось хвалёный
отлично сказками благом
Умел бояться гроб рифлёный
Рехнулся что ли свет убойный
отстойна мразь получит хром
Мостом дружище крот отмщённый
в неволе яйцами вальтом
Пошёл сдаваться бред особый
коварна вязь явилась ртом
Проём порочен мат лощёный
некстати будет ли за шторм
У лукоморья бред за шторой
отстойна хрень зарубит гром
И в нём приспичит long амёба
бухает около огём
Архив с .exe и исходником прилагается.
|
(Offline)
|
|
Эти 5 пользователя(ей) сказали Спасибо Жека за это полезное сообщение:
|
|
09.08.2012, 13:30
|
#3
|
Мастер
Регистрация: 23.09.2009
Адрес: ленобласть
Сообщений: 1,189
Написано 447 полезных сообщений (для 2,526 пользователей)
|
Ответ: Ещё стихоплёт
круто, стихи программистов)))
|
(Offline)
|
|
Ваши права в разделе
|
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
|
|
|
Часовой пояс GMT +4, время: 11:51.
|