Показать сообщение отдельно
Старый 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

Картинка:
Миниатюры
Нажмите на изображение для увеличения
Название: ptzm1.png
Просмотров: 1022
Размер:	13.1 Кб
ID:	16725  
Вложения
Тип файла: zip ptzm1_release.zip (340.9 Кб, 765 просмотров)
(Offline)
 
Ответить с цитированием
Эти 7 пользователя(ей) сказали Спасибо Жека за это полезное сообщение:
Артем Валерьевич (27.04.2012), Gector (27.04.2012), pax (28.04.2012), pepel (09.08.2012), Randomize (28.04.2012), SBJoker (27.04.2012), St_AnGer (27.04.2012)