Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   forum.boolean.name > Проекты > Проекты на BlitzMax

Ответ
 
Опции темы
Старый 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
Просмотров: 1010
Размер:	13.1 Кб
ID:	16725  
Вложения
Тип файла: zip ptzm1_release.zip (340.9 Кб, 749 просмотров)
(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)
Старый 28.04.2012, 12:48   #2
Жека
Дэвелопер
 
Регистрация: 04.09.2005
Адрес: Красноярск
Сообщений: 1,376
Написано 491 полезных сообщений
(для 886 пользователей)
Ответ: Ещё стихоплёт

Новая версия, 1.1.
Улучшения:
- отказ от SeedRnd(), который был в цикле;
- рандом улучшен;
- словарная база расширена;
- управление мышкой: левая кнопка - новый текст, правая - сохранить.

Избранное:
Залился горем крот весёлый 
витая мразь не видит ждём 
Споём приспичит byte учёный 
всё водит рябчиком кругом

Решил кривляться спорт скруглённый 
внатуре моль мохнатым злом 
Пердун пупочек таз сгущёный 
бессмертно сможет так в простом 

Девичьей доле дуб топлёный 
родная мразь как будто днём 
Плечом отскочит гриф тяжёлый 
безумно дерево эй, йоу! 

Пошёл сдаваться свист без ссоры 
кусая соль работай ртом 
Пешком граничный лось хвалёный 
отлично сказками благом 

Умел бояться гроб рифлёный 

Рехнулся что ли свет убойный 
отстойна мразь получит хром 
Мостом дружище крот отмщённый 
в неволе яйцами вальтом 

Пошёл сдаваться бред особый 
коварна вязь явилась ртом 
Проём порочен мат лощёный 
некстати будет ли за шторм 

У лукоморья бред за шторой 
отстойна хрень зарубит гром 
И в нём приспичит long амёба 
бухает около огём

Архив с .exe и исходником прилагается.
Вложения
Тип файла: zip ptzm1.1_release.zip (325.9 Кб, 776 просмотров)
(Offline)
 
Ответить с цитированием
Эти 5 пользователя(ей) сказали Спасибо Жека за это полезное сообщение:
impersonalis (09.08.2012), pepel (09.08.2012), Randomize (28.04.2012), Reks888 (28.04.2012), SBJoker (28.04.2012)
Старый 09.08.2012, 13:30   #3
pepel
Мастер
 
Аватар для pepel
 
Регистрация: 23.09.2009
Адрес: ленобласть
Сообщений: 1,189
Написано 447 полезных сообщений
(для 2,526 пользователей)
Ответ: Ещё стихоплёт

круто, стихи программистов)))
(Offline)
 
Ответить с цитированием
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +4, время: 19:53.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com