вторник, 31 декабря 2013 г.

Функция вычисляющая длину двоичного представления числа по крайней еденице.

Код функции добавленной в класс Editor2D

Она нужна будет в расчёте правильности симметрии. Выход симметрии конечности за максимальное количество конечностей будет рассчитываться только по дублирующей маски. Если же на конечность будут указывать как блокирующая так и дублирующая маска, то конечность будет считаться блокированной.

воскресенье, 15 декабря 2013 г.

Описание симметрии для part-unit

Ссылка на просмотр документа

https://docs.google.com/spreadsheet/pub?key=0AsrwJwA0dJabdFVNaVBUQlVWaUVrYUNOM2VLVVFLeVE&output=html

Здесь можно оставить комментарии на самом документе https://docs.google.com/spreadsheet/ccc?key=0AsrwJwA0dJabdFVNaVBUQlVWaUVrYUNOM2VLVVFLeVE&usp=sharing

Поясню относительно масок и симметрии. Симметрия нужна для того что бы те конечности которые нуждаются в дублировании или же те конечности которые мешают другим конечностям были реализованы. Было бы весьма не реалистично делать так что бы можно было летать на одном крыле или скакать галопом на одной ноге. Тип симметрии показывает с чётного или нечётного номера должна начинаться симметрия, это нужно что бы нельзя было воткнуть конечности "боком". Маска дублирования показывает то в каких "слотах" конечность должна быть повторена. А маска блокирования естественно показывает то в каких "слотах" нельзя размещать какую либо конечность.

  • Симметрия рассматривается включительно, то есть нулевой бит в маске указывает на саму же конечность (01234567) , поэтому он игнорируется. Сделано так для упрощения попыток вообразить себе всё это. Например значение 3 = (11) означает простейшую симметрию двух рядом расположенных конечностей. При этом первый бит означает саму же конечность и игнорируется. Но возможно в будущем он будет анализироваться для каких то других целей. Поэтому всё же устанавливайте его в значение True.
  • Бит блокировки на дублированной конечности делает её блокированной, при этом дублирование не рассматривается.
  • То есть если на конечности есть бит блокировки, то бит дублирования рассматриваеться как дополнительная опция.
  • Конечность считается истинно блокированной лишь если на ней есть бит блокирования и нет бита дублирования. Иначе конечность просто дублированная. В качестве примера можно привести крылья и многоножку. Крыло может быть большим и блокировать другие конечности, но если крылья будут крайними, то ничему они мешать не будут. Поэтому для крыльев просто блокирование, а для многоножки блокирование-дублирование.


Сам по себе игровой движок не будет обрабатывать эти данные, модуль редактора будет просто проверять валидность проектов перед включением их в игру. Если после морфирования будет получена неверная конфигурация, то неправильные конечности будут заблокированы.

среда, 4 декабря 2013 г.

Новые рисунки от AleksTrask



Первый рисунок войдёт в игру как кнопка интерфейса, а второй скорее всего станет одной из заставок.

воскресенье, 10 ноября 2013 г.

Рисунки с морфидами.

 Как бы так будут выглядеть маленькие морфиды ещё не вкусившие достаточно генетического материала наземных животных.

(автор картинок AleksTrask)

Неверная симметрия.

Алгоритм вычисления симметричности морфида стал настолько сложным что я сам начал в нём путаться несмотря на обилие комментариев. Это слишком сложно. Буду думать над более простой реализацией различных симметрий. Так же принимаю ваши идеи.

четверг, 31 октября 2013 г.

Проверка симетрии конечностей в редакторе.

У каждой конечности есть требования симметрии, они хранятся в первой целочисленной ячейке внутреннего типа данных Editor2dPartUnitMorfid. Который равен 10001

Public Const Editor2dPartUnitMorfid As Integer = 10001 ' ID редактора PartUnit морфидов
Тип симметрии обозначается числом от 0 до 4.

0 - нет симетрии.

1 - симметрия типа 1-2
1357
2468

2 - симметрия типа 2-4 (1-3 тоже)
1357
2468

3 - замещение типа 1-2
1357
2468

4 - замещение типа 2-4 (1-3 тоже)
1357
2468

Главная конечность, дублирующая (такая же как и главная) и заблокированная (заменённая пустой).

Код проверяющий симметричность проекта юнита созданного в 2D редакторе морфид, процедура находиться в классе  Editor2D. Ещё не до конца дописанный код далее

суббота, 19 октября 2013 г.

Приблизительная геймплейная концепция морфидов.

Генетическая программа это тригер и действие. Тригером может служить фермент или достижение нужной массы определённой частью. А действие как выработка другого фермента, так и команда на рост, апоптоз или морфирование определённой части в другую. По сути это будут простейшие линейные скрипты использующие в качестве условий ферментные флаги. Так же некоторые юниты смогут распылять произвольные ферменты при помощи желез запуская те или иные последовательности в других юнитах.

Новые метода класса GroupUniversalValues

Я добавил в класс 2 функции поиска нужных элементов массива по диапазону, это будет очень удобно, поскольку позволит точно классифицировать принадлежность объектов как при редактировании, так и в игре, а так же упростит написание серверных плагинов. Исходный код новых функций ниже:

воскресенье, 13 октября 2013 г.

Простое диалоговое окно с 3 вариантами ответа и картинкой.

Пока я не сделал универсальное диалоговое окно с массивом ответов, я решил сделать использующее всего 3 варианта ответа простенькое диалоговое окошко.
https://dl.dropboxusercontent.com/u/86123252/projects/StarE/20131013/dialogs.zip


пятница, 11 октября 2013 г.

понедельник, 7 октября 2013 г.

Диалоговое окно выбора файла

Делаю данное меню для своего проекта, требуется загружать игровые ресурсы как из /usr/share/appname так и из ~/.appname









Не найдя готового решения я сделал своё.
FileName = FileDialogForm.AskFileName ("Заголовок окна", "единственный путь", " надпись кнопки OK", "Надпись кнопки Cancel", "Единственная маска файлов", Единственная картинка для значков файла , Массив масок , Массив значков для масок , показывать ли скрытые файлы , массив путей)
http://gambas.pro/forum/download/file.php?id=114

пятница, 4 октября 2013 г.

Полный архив исходников на Gambas

Предварительный формат файлов для редактора морфид.

Код обеспечивающий редактирование мормид и требуемые константы я выложу позднее, сейчас я опубликую формат файлов. Части юнитов и юниты.

Часть морфиды: blank-fut.part-unit
'= Это комментарий
'= Данный формат файлов описывает часть юнита
begin part-unit
hp=0
armor=0
hp-armor=0
armorK=0
minimal-demage-armor=0
chance-demage=0
max-hp=0
weight=0
power=0
begin universal-values
name=Балластное свойство
id=0
next value
name=
id=10001
value-godc=
begin game-object-data

'= Здесь название юнита для 2D редактора морфид
add-string=Тестовая лапа

'= Поля зарезервированны
add-string=
add-string=
add-string=

'= Имя файла с картинкой
add-string=pictures/test/test-model-1/fut-test-model-1.png

'= Описание юнита
add-string= Обычное описание

'= Тип необходимой симетрии (0-нет симетрии, 1 - симетрия 12, 2 - симетрия 23, 3 -  замещение 12, 4 - замещение 23)
add-integer=0

'= Координата X в 2D редакторе
add-integer=0

'= Координата Y в 2D редакторе
add-integer=0

'= Координата Z в 2D редакторе, на всякий случай, вдруг станет 3D редактором
add-integer=0

add-integer=0

'= Это лапа, значение 1 (0 голова, 1 лапа, 9 хвост)
add-integer=1

end game-object-data
next value
end universal-values
end part-unit

 И сама морфида:  blank.unit
begin unit
speed=0
type-unit=
tactics=0
formation=0
group=0
x=0
y=0
z=0
writ=0
writ-target=0
writ-x=0
writ-y=0
writ-z=0
begin other-values
begin universal-values
name=
id=0
next value

'= Описание юнита для 2D редактора морфид
name=
id=10002
value-godc=
begin game-object-data

'= Название юнита
add-string=Тестовый юнит

add-string=
add-string=
add-string=

'= Имя файла с картинкой для редактора
add-string=pictures/test/test-model-1/body-test-model-1.png

'= Описание юнита
add-string= Обычное описание юнита


add-integer=0

'= Крепление конечности координаты XYZ (0 голова)
add-integer=0
add-integer=0
add-integer=0

'= Крепление конечности координаты XYZ (1 лапа)
add-integer=0
add-integer=0
add-integer=0

'= Крепление конечности координаты XYZ (2 лапа)
add-integer=0
add-integer=0
add-integer=0

'= Крепление конечности координаты XYZ (3 лапа)
add-integer=0
add-integer=0
add-integer=0

'= Крепление конечности координаты XYZ (4 лапа)
add-integer=0
add-integer=0
add-integer=0

'= Крепление конечности координаты XYZ (5 лапа)
add-integer=0
add-integer=0
add-integer=0

'= Крепление конечности координаты XYZ (6 лапа)
add-integer=0
add-integer=0
add-integer=0

'= Крепление конечности координаты XYZ (7 лапа)
add-integer=0
add-integer=0
add-integer=0

'= Крепление конечности координаты XYZ (8 лапа)
add-integer=0
add-integer=0
add-integer=0

'= Крепление конечности координаты XYZ (9 хвост)
add-integer=0
add-integer=0
add-integer=0

end game-object-data

next value

end universal-values
end other-values
unit no-parts
end unit

понедельник, 30 сентября 2013 г.

Формат описания юнита

Собственно UnitClass.SaveClass сформировала набор строк. Этот набор строк описывает состояние класса. Это формат в котором можно описать свои типы юнитов.

begin и end строки формируют структуру объекта. unit строки это дополнительное структурное  дублирование для UnitClass. Я его ввёл на тот случай если буду что то переписывать.

Структура юнита


begin unit
speed=10
type-unit=тестовый юнит
tactics=0
formation=1
group=0
x=0
y=0
z=0
writ=0
writ-target=0
writ-x=0
writ-y=0
writ-z=0
begin other-values
begin universal values
name=
id=0
next value
name=
id=1000
value-integer=1488
next value
name=
id=1001
value-string=14/88
next value
name=
id=1001
value-float=14,88
next value
name=
id=5
value-godc=
begin game-object-data
add-string=это сложное свойство имеющее набор из 3 массивов, целочисленного, дробного и строчного
add-string=Строка сложного внутреннего свойства
add-integer=14
add-integer=88
add-single=3,1415999
add-single=13,1300001
end game-object-data
next value
end universal values
end other-values
unit parts
unit begin-part
begin part-unit
hp=0
armor=0
hp-armor=0
armorK=0
minimal-demage-armor=0
chance-demage=0
max-hp=0
weight=0
power=0
begin universal values
name=
id=0
next value
name=дополнительное свойство нулевой дополнительной части объекта
id=0
value-string=строка
next value
end universal values
end part-unit
unit end-part
unit begin-part
begin part-unit
hp=1000
armor=0
hp-armor=0
armorK=0
minimal-demage-armor=0
chance-demage=0
max-hp=0
weight=0
power=0
begin universal values
name=
id=0
next value
name=дополнительное свойство первой дополнительной части объекта
id=0
value-integer=100500
next value
end universal values
end part-unit
unit end-part
end unit

Решил выкладывать код на gist.github.com

 https://gist.github.com/anonymous/6762398


воскресенье, 29 сентября 2013 г.

UnitClass , ещё не отлаживал.

Таки дописал UnitClass, завтра займусь отладкой что ли.
' Gambas class file

  Public Speed As Integer ' скорость
  Public Parts As New PartUnitClass[] ' конечности лапы
  '1-8 лапы    9 голова     10 хвост
 
  Public TypeUnit As String ' наименование юнита
 
  Public OtherValues As New GroupUniversalValues ' дополнительные признаки юнита
 
  Public Tactics As Integer ' используемая тактика, нападать строем, нападать бегом, отойти подальше,
  Public Formation As Integer ' где в строю идти, арьергард, авангард, правый фланг, левый фланг, охрана героя
 
  Public Group As Integer ' группа в которую входит юнит
 
  Public X As Integer
  Public Y As Integer ' координаты
  Public Z As Integer
 
  Public Writ As Integer ' текущий приказ
  Public WritTarget As Integer ' цель приказа
  Public WritX As Integer
  Public WritY As Integer ' координаты точки назначения из приказа, если равны нулю или достигнутым, то происходит новый расчёт
  Public WritZ As Integer
 
  'Public Sub _new()
  ' Dim p As New PartUnitClass
  ' Limb.Add(p)
  'End

Public Function SaveClass() As String[]
  ' Сохраняет класс в виде массива строк
  Dim rData As New String[] ' массив для результата
  Dim a As Integer ' счётчик цикла
  Dim m As Integer ' ограничитель цикла
 
  Dim aParts As Integer
  Dim mParts As Integer ' для перебора частей
  Dim oValues As String[] ' дополнительные свойства объекта
  Dim PartData As String[] ' ссылка для массива с сохранением части
 
 
  rData.Add("begin unit") ' начало описания
 
  'сохранение основных свойств
  rData.Add("speed=" & LTrim(Str(Speed))) 'Speed
  rData.Add("type-unit=" & TypeUnit) 'TypeUnit
  rData.Add("tactics=" & LTrim(Str(Tactics))) 'Tactics
  rData.Add("formation=" & LTrim(Str(Formation))) 'Formation
  rData.Add("group=" & LTrim(Str(Group))) 'Group
  rData.Add("x=" & LTrim(Str(X))) ' X
  rData.Add("y=" & LTrim(Str(Y))) ' Y
  rData.Add("z=" & LTrim(Str(Z))) ' Z
  rData.Add("writ=" & LTrim(Str(Writ))) 'Writ
  rData.Add("writ-target=" & LTrim(Str(WritTarget))) 'WritTarget
  rData.Add("writ-x=" & LTrim(Str(WritX))) ' WritX
  rData.Add("writ-y=" & LTrim(Str(WritY))) ' WritY
  rData.Add("writ-z=" & LTrim(Str(WritZ))) ' WritZ 
  'rData.Add("=" & LTrim(Str())) '
 
  ' Сохранение дополнительных признаков юнита
  rData.Add "begin other-values"
  If OtherValues.Count > 0 Then
    'есть дополнительные свойства
    oValues = OtherValues.SaveClass ' получение массива строк с дополнительными свойствами юнита.
    m = oValues.Max
    For a = 0 To m
     rData.Add(oValues[a])
    Next
  Endif
  rData.Add("end other-values")
  
  ' Сохранение частей юнита
  If Parts.Count = 0 Then
    ' частей и у юнита нет
    rData.Add("unit no-parts") ' У юнита нет частей
  Endif
  If Parts.Count > 0 Then
    ' У юнита есть части
    rData.Add("unit parts") 
    mParts = Parts.Max ' колличество частей
    For aParts = 0 To mParts
      PartData = Null ' очистка ссылки на массив
      PartData = Parts[aParts].SaveClass ' сохранение части в массив
      m = PartData.Max
      rData.Add("unit begin-part") ' начало описания части
      For a = 0 To m
        rData.Add(PartData[a])    'добавление строк части в массив
      Next
      rData.Add("unit end-part") ' конец описания части
    Next
       
  Endif
  rData.Add("end unit") ' конец описания
  Return rData ' возврат значения
End

Public Sub LoadClass(ByRef ArrayData As String[], Optional StartScan As Integer = 0, Optional StopScan As Integer = -1)
  ' Функция загружающая данные в класс из массива строк
  ' Так же принимает начало и конец сканирования
  Dim a As Integer
  Dim m As Integer
  Dim Stage As Integer
  Dim sData As New ClassStringData ' класс для операций со строковыми переменными
  Dim S As String ' текущая строка
  Dim OP As String ' оператор
  Dim Value As String ' значение
 
  Dim BeginOtherValues As Integer ' строка начала описания лрполнительных свойств
  Dim EndOtherValues As Integer ' строка окончания описания дополнительных свойств
  Dim oValues As String[] ' ссылка на массив для дополнительных свойств
 
  Dim BeginPart As Integer ' начало описания части
  Dim EndPart As Integer ' конец описания части
  Dim PartIndex As Integer ' текущая часть
  Dim PartTMP As PartUnitClass ' временная переменная под текущую часть юнита
 
  If ArrayData = Null Then Return ' вместо массива переданна пустая переменная
  If ArrayData.Count = 0 Then Return ' Если в массиве нет элементов, то выйти
 
  m = StopScan
  If StopScan = -1 Then m = ArrayData.Max ' значение по умолчанию
 
  For a = StartScan To m
    S = ArrayData[a] ' текущая строка
    'перебор нужной части массива
    If Stage = 0 Then
      ' чтение базовых параметров класса
      OP = sData.GetOpS(S) ' извлечение оператора
      Value = sData.GetValueS(S) ' извлечение значения
     
      If OP = "speed" Then Speed = Val(Value) '  rData.Add("speed=" & LTrim(Str(Speed))) 'Speed
      If OP = "type-unit" Then TypeUnit = Value
      If OP = "tactics" Then Tactics = Val(Value) ' rData.Add("tactics=" & LTrim(Str(Tactics))) 'Tactics
      If OP = "formation" Then Formation = Val(Value) ' rData.Add("formation=" & LTrim(Str(Formation))) 'Formation
      If OP = "group" Then Group = Val(Value) ' rData.Add("group=" & LTrim(Str(Group))) 'Group
      If OP = "x" Then X = Val(Value) ' rData.Add("x=" & LTrim(Str(X))) ' X
      If OP = "y" Then Y = Val(Value) ' rData.Add("y=" & LTrim(Str(Y))) ' Y
      If OP = "z" Then Z = Val(Value) ' rData.Add("z=" & LTrim(Str(Z))) ' Z
      If OP = "writ" Then Writ = Val(Value) ' rData.Add("writ=" & LTrim(Str(Writ))) 'Writ
      If OP = "writ-target" Then WritTarget = Val(Value) ' rData.Add("writ-target=" & LTrim(Str(WritTarget))) 'WritTarget
      If OP = "writ-x" Then WritX = Val(Value) ' rData.Add("writ-x=" & LTrim(Str(WritX))) ' WritX
      If OP = "writ-y" Then WritY = Val(Value) ' rData.Add("writ-y=" & LTrim(Str(WritY))) ' WritY
      If OP = "writ-z" Then WritZ = Val(Value) ' rData.Add("writ-z=" & LTrim(Str(WritZ))) ' WritZ 
     
      If OP = "begin other-values" Then Stage = 1 ' начались дополнительные свойства
     
    Endif
    If Stage = 1 Then
      ' считывание дополнительных свойств
      If sData.GetOpS(S) = "begin other-values" Then BeginOtherValues = a ' начало описания дополнительных свойств
      EndOtherValues = sData.FindStringIndex(ArrayData, "end other-values", BeginOtherValues, m) ' поиск окончания описания дополнительных типов
      oValues = sData.CopyStringArray(ArrayData, BeginOtherValues, EndOtherValues) ' копирование нужного куска в другой массив
      OtherValues.LoadClass(oValues) ' загрузка массива дополнительных свойств
      Stage = 2 ' Стадия окончена
      a = EndOtherValues ' передвинуть счётчик что бы не просматривал уже загруженные данные
    Endif
    If Stage = 2 Then
      ' Стадия 2 Загрузка частей юнита
      If sData.GetOpS(S) = "unit no-parts" Then
        Stage = 4 ' У юнита нет частей, стадия 4
      Endif
      If sData.GetOpS(S) = "unit parts" Then
        ' У юнита есть части
        Stage = 3
      Endif
      
    Endif
    If Stage > 2 Then Break ' Если уже не вторая стадия, прервать цикл
    ' Довольно быдлокодское решение, но я сегодня явно не в форме.
    ' Я решил сократить данный цикл что бы этот быдлокод минимально влиял на выполнение программы.
    ' Думаю Стадию 1 стоит переписать в дальнейшем и вынести за пределы цикла.
   
  Next
  Parts.Clear ' очистка массива с частями
 
  If Stage = 3 Then
    ' добавление частей
    a = EndOtherValues + 1 ' начинаем считать с конца описания дополнительных свойств
    m = sData.FindStringIndex(ArrayData, "end unit", a, m) ' поиск конца описания класса в массиве
    If m = -1 Then m = StopScan
    If m = -1 Then m = ArrayData.Max ' защита от дурака который не внесёт в файл "end unit"
   
   
     
    Do
      S = ArrayData[a]
      If sData.GetOpS = "unit begin-part" Then
        BeginPart = sData.FindStringIndex(ArrayData, "unit begin-part", a, m) ' поиск начала текущей части
        EndPart = sData.FindStringIndex(ArrayData, "unit end-part", a, m) ' поиск конца текущей части
        'Как это работает... Я только что написал и уже забыл.
        'Вообще это оптимизация, я так рассудил что лучше установку переменных BeginPart и EndPart
        'Проводить только при нахождении строки "unit begin-part" . А всякий мусор между "unit end-part" и "unit begin-part"
        'Не рассматривать, всё равно там могут быть разве что комментарии
      Endif 
     
      ' Здесь могло бы быть рассмотрение того что находиться между "unit end-part" и "unit begin-part"
     
      If BeginPart <> -1 And EndPart <> -1 Then
        ' часть найдена
        PartTMP = Null ' обнулить на всякий случай
        PartTMP = New PartUnitClass ' создать новую часть для юнита
        PartTMP.LoadClass(ArrayData, BeginPart, EndPart) ' загрузить часть во временную переменную
        Parts.Add(PartTMP) ' добавить часть в массив
        a = EndPart ' передвинуть счётчик
        BeginPart = -1 ' Знаю быдлокод
        EndPart = -1 ' Это устанавливает значения в такое положение дабы операция не повторилась ещё раз до установки BeginPart и EndPart
      Endif
      a = a + 1 ' увеличить счётчик на 1
    Loop Until a > m ' выйти из цикла если счётчик больше ограничителя
  Endif
 
 
End

среда, 25 сентября 2013 г.

Класс для описания частей юнитов вроде готов

Класс PartUnitClass
Я решил во все классы от PartUnistClass и крупнее сделать с функциями загрузки которые принимают параметры StartScan и StopScan обозначающие начальную и последнюю строку в массиве который они должны просматривать, и с передачей массива по ссылке, что позволит не создавать в памяти много копий строк массива при загрузке.
' Gambas class file

  'PartUnitClass
 
  Public HP As Integer ' здоровье
  Public Armor As Integer ' броня
  Public HpArmor As Integer ' целостность брони
  Public ArmorK As Integer ' коэффициент повреждаемости брони, в процентах
  Public MinimalDemageArmor As Integer ' минимальный предел наносимого повреждения, если наносимое повреждение меньше, то оно не имеет значения
  Public ChanceDemage As Integer ' процент покрытия бронёй, проще говоря вероятность того что броня примет урон на себя
 
  Public MaxHP As Integer ' предел здоровья
  Public MaxArmor As Integer ' предел брони
 
  Public Weight As Integer ' масса в граммах
  Public Power As Integer ' сила в ньютонах
  ' 40 байт
 
  'надо будет предусмотреть параметры регенерации
 
  Public OtherValues As New GroupUniversalValues ' прочие значения в универсальных типах
  '+20 байта
 
Public Sub LoadClass(ByRef DataArray As String[], Optional StartLoad As Integer = 0, StopLoad As Integer = -1)  'загрузка класса из массива строк
  'Так же принимает StartLoad и StopLoad для ограничения просматриваемой в массиве области
  Dim sData As New ClassStringData ' класс для операций со строками
  Dim a As Integer '
  Dim oValues As String[] ' массив для OtherValues
  Dim m As Integer
  Dim BeginOV As Integer ' та строка после которой идут свойства OtherValues
  Dim OP As String ' оператор
  Dim Value As String ' параметр оператора
 
  m = DataArray.Max
  If StopLoad <> -1 Then m = StopLoad
 
  BeginOV = sData.FindStringIndex(DataArray, "begin other-values", StartLoad, StopLoad) ' где закнчиваются основные свойства и начинаються дополнительные
     
  For a = StartLoad To BeginOV ' просмотр от начала описания до начала описания дополнительных свойств
    'присвоение базовых свойств объекта
    OP = sData.GetOpS(DataArray[a])
    Value = sData.GetValueS(DataArray[a]) ' выборка значений из строки
       
    'присвоение нужных свойств
    If OP = "hp" Then
      'HP
      HP = Val(Value)
    Endif
    If OP = "armor" Then
      'Armor
      Armor = Val(Value)
    Endif
    If OP = "hp-armor" Then
      'HpArmor
      HpArmor = Val(Value)
    Endif
    If OP = "armork" Then
      'ArmorK
      ArmorK = Val(Value)
    Endif
    If OP = "minimal-demage-armor" Then
      'MinimalDemageArmor
      MinimalDemageArmor = Val(Value)
    Endif
    If OP = "chance-demage" Then
      'ChanceDemage
      ChanceDemage = Val(Value)
    Endif
    If OP = "max-hp" Then
      'MaxHP
      MaxHP = Val(Value)
    Endif
    If OP = "weight" Then
      ' Weight
      Weight = Val(Value)
    Endif
    If OP = "power" Then
      ' Power
      Power = Val(Value)
    Endif
    If OP = "" Then
      '
      ' = Val(Value)
    Endif
       
  Next
 
  ' Присваивание OtherValues
  oValues = sData.CopyStringArray(DataArray, BeginOV, m) ' получение массива с OtherValues (копирование фрагмента из основного)
  OtherValues.LoadClass(oValues) ' зарузка нужных строк в OtherValues
 
End

Public Function SaveClass() As String[]
  ' Функция возвращает строковый массив вмещающий данные класса.
  Dim rArray As New String[] ' возвращаемый массив
  Dim oValues As String[] ' прочие значения из массива OtherValues
  Dim a As Integer ' счётчик цикла
  Dim m As Integer ' ограничитель цикла
 
  rArray.Add("begin part-unit") ' начало описания
  rArray.Add("hp=" & LTrim(Val(HP))) ' HP
  'rArray.Add("=" & LTrim(Val())) '
  rArray.Add("armor=" & LTrim(Val(Armor))) ' Armor
  rArray.Add("hp-armor=" & LTrim(Val(HpArmor))) ' HpArmor
  rArray.Add("armorK=" & LTrim(Val(ArmorK))) ' ArmorK
  rArray.Add("minimal-demage-armor=" & LTrim(Val(MinimalDemageArmor))) ' MinimalDemageArmor
  rArray.Add("chance-demage=" & LTrim(Val(ChanceDemage))) ' ChanceDemage
  rArray.Add("max-hp=" & LTrim(Val(MaxHP))) ' MaxHP
  rArray.Add("weight=" & LTrim(Val(Weight))) ' Weight
  rArray.Add("power=" & LTrim(Val(Power))) ' Power
  'rArray.Add("=" & LTrim(Val())) ' для сохранения других общих свойств
 
  oValues = OtherValues.SaveClass() ' сохранение остальных свойств объекта
 
  m = oValues.Max
  For a = 0 To m
    ' добавление в массив нужных значений
    rArray.Add(oValues[a])
  Next
 
  rArray.Add("end part-unit") ' конец описания
  Return rArray ' возврат значения
 
End

Специальный класс для работы со строковыми массивами и строками.

Позволяет разлагать строки на оператор=значение, копировать часть одного массива в другой и искать нужную строку в массиве.
' Gambas class file

' ClassStringData
' Класс содержит функции нужные для разделения строк на параметр=значение
' По сути он дублирует модуль ModuleStringData
' А сделанно всё так из за герметичности классов, они не допускают использование и вызов функций из обычных модулей
' инкапсуляция же. FUCK!FUCK!FUCK!FUCK!FUCK!FUCK!FUCK!FUCK!


Public Function GetOpS(S As String) As String
  'процедура возвращает оператор
  'процедура настроена на символ = в качестве разделителя
  Dim l As Integer ' длинна строки
  Dim a As Integer ' счётчик цикла
  Dim Op As String ' оператор
 
  l = Len(S)
 
  If l > 0 Then
    'строка не пустая
    For a = 1 To l
      'цикл же
      If Mid(S, a, 1) = "=" Then Break ' досрочный выход из цикла по причине нахождения разделителя
      Op = Op & Mid(S, a, 1) ' наращивание по одному символу
    Next
   Endif
   Return Op 'возврат значения
      
End
Public Function GetValueS(S As String) As String
  'процедура возвращает значение находящиеся после оператора, если оно конечно есть
  'в любом другом случае возвращает пустое значение
  Dim l As Integer ' длинна строки
  Dim a As Integer ' счётчик цикла
  Dim Value As String ' значение 
  Dim v As Boolean ' началось ли значение
 
  l = Len(s)
 
  If l > 2 Then
    'тут есть значение, хотя оператора может и не быть :) минимум для оператора и значения это 3
    'это не баг, это фича
    For a = 1 To l
     If v Then
      'значение началось
      Value = Value & Mid(s, a, 1) ' заполняем значение
     End If 
     If v = False Then
      'значение ещё не началось
      If Mid(S, a, 1) = "=" Then v = True ' значение начинаеться
     End If
     'именно такой порядок проверки условий нужен что бы в значение не попал разделитель "="
    Next
  Endif
  Return Value 'возврат значения
End

Public Function CopyStringArray(SourceArray As String[], Optional StartIndex As Integer = 0, Optional StopIndex As Integer = -1) As String[]
  ' Функция копирует один одномерный строковый массив в другой, при этом используеться необязательные параметры границ копирования
  Dim a As Integer ' счётчик цикла
  Dim EndCopy As Integer ' окончание копирования
  Dim StartCopy As Integer ' начало копирования
  Dim rData As New String[] ' возвращаемый массив для результата
 
  EndCopy = StopIndex
  StartCopy = StartIndex ' кэширование значений 
  If EndCopy = -1 Then EndCopy = SourceArray.Max ' обработка значения "по умолчанию"
 
  For a = StartCopy To EndCopy
    'цикл копирующий массив
    rData.Add(SourceArray[a])
  Next
  Return rData ' возвратить получившийся массив 
End

Public Function FindStringIndex(StringArray As String[], S As String, Optional StartScan As Integer = 0, Optional StopScan As Integer = -1) As Integer
  'Функция ищет в массиве нужную строку и возвращает её индекс в массиве
  Dim a As Integer ' счётчик цикла
  Dim m As Integer ' ограничитель счётчика
  Dim e As Boolean ' досрочный выход из цикла
  Dim r As Integer ' результат
  m = StringArray.Max
  If StopScan <> -1 Then m = m = StopScan
  If StringArray.Count = 0 Then e = True ' досрочный выход если в массив пуст
  For a = StartScan To m
    If e Then Break
    If StringArray[a] = S Then
      'строка найдена
      r = a
      e = True
    Endif
  Next
  Return r
End

воскресенье, 22 сентября 2013 г.

Главное меню, скорее всего переделаю.

GroupUniversalValues похоже полностью готов.

Добавлены необязательные параметры у функций которые теперь позволяют указывать в одной строке как ID так и Имя ячейки в пачке.

Public Function GetValueName(Name As String, Optional DefaultValue As Variant = Null) As Variant
Public Function GetValueID(ID As Integer, Optional DefaultValue As Variant = Null) As Variant
Public Function EditValueName(Name As String, Value As Variant, Optional ID As Integer = 0) As Integer
Public Function EditValueID(ID As Integer, Value As Variant, Optional Name As String = "") As Integer
Public Function AddValueName(Name As String, Value As Variant, Optional ID As Integer = 0) As Integer
Public Function AddValueID(ID As Integer, Value As Variant, Optional Name As String = "") As Integer
Весь исходник класса.
' Gambas class file

' Класс содержащий дополнительные свойства для юнита или части юнита
' Содержит пачку дополнительных свойств

' Как работать с данным классом
' Нужно сначала запросить номер искомого элемента по имени или ID
' После проверить не равно ли оно -1 что означает отсутствие этого свойства у объекта
' И если всё в порядке то обратиться к массиву Values и извлечь оттуда элемент по нужному номеру

Public NameValue As New String[] ' имя параметра
Public IDValue As New Integer[] ' числовое значение совпадающее с именем параметра
' каждый параметр должен должен обладать своим ID, а так же NameValue и IDValue должны быть синхронизированны
Public Values As New Variant[] ' Всё таки я решил хранить значения в типе Variant
 
 '4 + 4 + 8 = 16 байт на одно свойство
Public Count As Integer ' колличество свойств 
 
Public Function FindName(Name As String) As Integer
  'Возвращает номер значения в массиве по имени, ищет его
  Dim a As Integer ' счётчик цикла
  Dim e As Boolean ' флаг досрочного выхода
  Dim x As Integer ' возвращаемое значение
  x = -1 ' свойство не найдено
  If Count > 0 Then
   For a = 0 To Count 
    If NameValue[a] = Name Then
     'нужное имя найдено
     x = a ' присвоение значения возвращаемой переменной
     e = True ' запланировать досрочный выход
    End If
    If e = True Then Break ' совершить досрочный выход
   Next
  End If
  Return x ' возвратить значение
End

Public Function FindID(ID As Integer) As Integer
  'Возвращает номер значения в массиве по ID, ищет его
  'Поиск по ID быстрее
  Dim a As Integer ' счётчик цикла
  Dim e As Boolean ' флаг досрочного выхода
  Dim x As Integer ' возвращаемое значение
  x = -1 ' свойство не найдено
  If Count > 0 Then
   For a = 0 To Count 
    If IDValue[a] = ID Then
     'нужное имя найдено
     x = a ' присвоение значения возвращаемой переменной
     e = True ' запланировать досрочный выход
    End If
    If e = True Then Break ' совершить досрочный выход
   Next
  End If
  Return x ' возвратить значение
End

'Функция добавления значения
Public Function AddValueName(Name As String, Value As Variant, Optional ID As Integer = 0) As Integer
 'добавляет значение по имени, возвращает тот же результат что и FindName, а именно номер значения в массиве Values[]
 'не проверяет есть ли значение уже в массиве
 Values.Add(Value)
 NameValue.Add(Name)
 IDValue.Add(ID)
 Count = Count + 1 ' увеличение счётчика
 Return Count ' возвратить номер добавленного элемента
End
Public Function AddValueID(ID As Integer, Value As Variant, Optional Name As String = "") As Integer
 'добавляет значение по ID, возвращает тот же результат что и FindID, а именно номер значения в массиве Values[]
 'не проверяет есть ли значение уже в массиве
 Values.Add(Value)
 NameValue.Add("")
 IDValue.Add(ID)
 Count = Count + 1 ' увеличение счётчика
 Return Count ' возвратить номер добавленного элемента
End

'Функции редактирования/добавления значения

Public Function EditValueName(Name As String, Value As Variant, Optional ID As Integer = 0) As Integer
 'Изменяет значение по имени или добавляет его если оно отсутствует
  Dim a As Integer
  Dim c As Integer
  Dim v As Integer
 
  v = FindName(Name) ' следует оптимизировать методом китайского кода
  If v = -1 Then
    'значение не найдено
    c = AddValueName(Name, Value, ID) ' создать нужное значение
  Endif
  If v > -1 Then
   'значение найдено
   Values[v] = Value ' присвоить значение
   c = v
  Endif
  Return c ' возвратить номер присвоенного значения
End

Public Function EditValueID(ID As Integer, Value As Variant, Optional Name As String = "") As Integer
 'Изменяет значение по ID или добавляет его если оно отсутствует
  Dim a As Integer
  Dim c As Integer
  Dim v As Integer
 
  v = FindID(ID) ' следует оптимизировать методом китайского кода
  If v = -1 Then
    'значение не найдено
    c = AddValueID(ID, Value, Name) ' создать нужное значение
  Endif
  If v > -1 Then
   'значение найдено
   Values[v] = Value ' присвоить значение
   c = v
  Endif
  Return c ' возвратить номер присвоенного значения
End


Public Sub _new()
 'при создании объекта необходимо записать балластное свойство
 Dim v As Variant
 Values.Add(v, 0)
 NameValue.Add("", 0)
 IDValue.Add(0, 0)
 Count = 0 ' установка счётчика в 0
End

' Функции возвращающие нужные значения сразу. Будут оптимизированы методом китайского кода
Public Function GetValueName(Name As String, Optional DefaultValue As Variant = Null) As Variant
 Dim rv As Variant
 Dim nv As Integer
 nv = FindName(Name)
 If nv <> -1 Then
  rv = Values[nv]
 Endif
 Return rv
End
Public Function GetValueID(ID As Integer, Optional DefaultValue As Variant = Null) As Variant
 Dim rv As Variant
 Dim nv As Integer
 rv = DefaultValue
 nv = FindID(ID)
 If nv <> -1 Then
  rv = Values[nv]
 Endif
 Return rv
End

Public Function SaveClass() As String[]
  'Функция возвращает массив строк содержащий все значения сохранённые в классе
  Dim Srm As New String[] ' массив для результата
  Dim r As String ' результат 1 строка
  Dim a As Integer ' счётчик цикла
  Dim m As Integer ' мксимальное значение цикла
  Dim TypeGameObjectDataClass As Integer ' тип переменной
  Dim t As New GameObjectDataClass ' пустая переменная для определения типа
 
  'переменные для сохранения вложенных значений GameObjectDataClass
  Dim godcStrings As New String[] 'массив для временного хранения строк
  Dim godcA As Integer ' счётчик цикла для перебора массива
  Dim godcM As Integer ' конец счётчика
  Dim godcLink As GameObjectDataClass ' переменная ссылка для ускорения опраций с объектом
 
  TypeGameObjectDataClass = TypeOf(t) ' тип контейнера для сложных свойств-объектов с более чем одним параметров
  m = Values.Max
  Srm.Add("begin universal values")
  For a = 0 To m
   'перебор всех значений
   Srm.Add("name=" & NameValue[a])
   Srm.Add("id=" & Str(IDValue[a]))
  
   If TypeOf(Values[a]) = gb.Integer Then
    'значение integer
     Srm.Add("value-integer=" & Str(Values[a]))
   Endif
   If TypeOf(Values[a]) = gb.Single Then
    'значение Single
     Srm.Add("value-single=" & Str(Values[a]))
   Endif
   If TypeOf(Values[a]) = gb.Float Then
    'значение float
     Srm.Add("value-float=" & Str(Values[a]))
   Endif
   If TypeOf(Values[a]) = gb.String Then
    'значение строка
     Srm.Add("value-string=" & Values[a])
   Endif
   If TypeOf(Values[a]) = TypeGameObjectDataClass Then
    'комплексное значение GameObjectDataClass
    'здесь надо будет сохранено куча строк
    Srm.Add("value-godc=") ' GameObjectDataClass
    godcStrings.Clear ' очистка массива
    godcLink = Null ' обнудение переменной ссылки
    godcLink = Values[a] ' присвоение ссылки, в дальнейшем использовать для операций эту ссылку
    godcStrings = godcLink.SaveClass() ' сохранение класса в массив
    ' а теперь надо перебрать массив и сохранить его строки в массиве Srm этого класса
    godcM = godcStrings.Max ' узнать индекс последнего элемента в массиве
    For godcA = 0 To godcM
      'собственно перебор
      Srm.Add(godcStrings[godcA]) ' добавить в Srm массив значение из возвращённого массива
    Next
   
   Endif
  
   Srm.Add("next value")
    
  Next
  Srm.Add("end universal values")
  Return Srm
End

Public Sub LoadClass(DataArray As String[])
  ' Функция загружает в класс необходимые значения
  ' Она будет сложнее чем GameObjectDataClass ибо ей нужно фильтровать много типов значений
  ' Надо бы придумать формат
  '
  ' Формат:
  ' name=Ox
  ' id=150
  ' value-integer=10
  ' next value
  ' name=axe
  ' id=1
  ' value-godc
  ' begin game-object-data
  ' данные GameObjectDataClass
  ' end game-object-data
  ' end universal values
 
  Dim a As Integer 'счётчик цикла
  Dim m As Integer 'ограничитель цикла
  Dim Name As String ' имя
  Dim ID As Integer ' ID
 
  Dim sdata As New ClassStringData ' класс для операций разложения строк
  Dim OP As String
  Dim Value As String ' переменные для кэширования значений операций разложения строки
  Dim r As Integer ' временная переменная
   
  Dim DataValue As Variant ' значение
  Dim ValueInteger As Integer
  Dim ValueSingle As Single
  Dim ValueFloat As Float
  Dim ValueString As String
  Dim ValueGODC As GameObjectDataClass ' значения конкретных типов. Создание и инициализация объекта проходит внутри тела процедуры
  Dim Srm As New String[] ' текстовый массив для вложенных сложных типов
 
  Count = 0
  NameValue.Clear
  IDValue.Clear
  Values.Clear ' очистка объекта от старых данных
  _new ' нициализация объекта заново и создание балластного значения под индексом 0
   
  m = DataArray.Max ' установление ограничителя цикла
 
  For a = 0 To m
    'перебор строк
    OP = sdata.GetOpS(DataArray[a])
    Value = sdata.GetValueS(DataArray[a]) ' разложение строки на оператор и параметр
   
    If OP = "name" Then
      'присвоение имени
      Name = Value
    Endif
    If OP = "id" Then
      'присвоение ID
      ID = Val(Value)
    Endif
   
    If OP = "value-integer" Then
      'целое число
      ValueInteger = Val(Value) ' присвоение и преобразование в нужный тип средствами runtime среды
      DataValue = ValueInteger ' присовение преобразованного значения переменной variant     
    Endif
    If OP = "value-single" Then
      'дробное число
      ValueSingle = Val(Value) ' присвоение и преобразование в нужный тип средствами runtime среды
      DataValue = ValueSingle ' присовение преобразованного значения переменной variant     
    Endif
    If OP = "value-float" Then
      'float
      ValueFloat = Val(Value) ' присвоение и преобразование в нужный тип средствами runtime среды
      DataValue = ValueFloat ' присовение преобразованного значения переменной variant     
    Endif
    If OP = "value-string" Then
      'строка
      ValueString = Value ' присвоение и преобразование в нужный тип средствами runtime среды
      DataValue = ValueString ' присовение преобразованного значения переменной variant     
    Endif
   
    If OP = "value-godc" Then
      ' вложенный сложный объект
      ' Тут то придёться подумать как правильно это написать
      ValueGODC = New GameObjectDataClass ' создание нового сложного объекта
      Srm.Clear
      Do
        'цикл перебора строк
        a = a + 1 ' увеличение счётчика вышестоящего цикла FOR
        OP = sdata.GetOpS(DataArray[a]) ' вычленение оператора
        Srm.Add(DataArray[a]) ' копирование строки во временный массив
      Loop Until OP = "end game-object-data" ' окончание описания сложного объекта
      ' Строки относящиеся к вложенному объекту скопированны в массив Srm
      ' Счётчик (a) тоже скорректирован что бы не просматривать строки относящиеся к вложенному объекту ещё раз
      ValueGODC.LoadClass(Srm)  ' обработка строк вложенным сложным объектом и загрузка в него данных
      DataValue = ValueGODC ' присвоение ссылки переменной типа Variant, промежуточной
      ValueGODC = Null ' очистка первичной ссылки на загруженный сложный объект
    Endif
   
    If OP = "next value" Then
      'следующее значение, присвоить
      r = AddValueID(ID, DataValue) ' здесь мы добавляем новое значение и кэшируем его позицию в списке для быстрого использования
      ' использеться функция AddValueID которая не проверяет есть ли уже объект в массиве
      NameValue[r] = Name ' присвоение имени
      DataValue = Null ' обнуление используемых переменных
      ID = 0
      Name = ""
    Endif
   
  Next
 
End

Исправление ошибок

В классе GameObjectDataClass исправил одну ошибку приводящую к ошибке при сохранении:
Public Function SaveClass() As String[]
  ' Функция сохраняет данные класса в строковый массив
  Dim Srm As New String[]  ' массив для результата
  Dim MaxString As Integer ' колличество строк
  Dim MaxInteger As Integer ' колличество целых чисел
  Dim MaxSingle As Integer ' колличество дробных чисел
 
  Dim a As Integer
 
  MaxString = Strings.Max
  MaxInteger = IntegerValues.Max
  MaxSingle = SingleValues.Max
 
  Srm.Add("begin game-object-data") ' заголовок
 
  If Strings.Count > 0 Then
   'строки есть
   For a = 0 To MaxString
    'перебор и запись всех строк
    Srm.Add("add-string=" & Strings[a])
   Next
  Endif
 
  If IntegerValues.Count > 0 Then
   'целые числа есть
   For a = 0 To MaxInteger
    'перебор и запись всех целых чисел
    Srm.Add("add-integer=" & LTrim(Str(IntegerValues[a]))) ' лучше всё таки при конвертировании сразу обрезать пробелы
   Next
  Endif
 
  If SingleValues.Count > 0 Then
   'дробные числа есть
   For a = 0 To MaxSingle
    'перебор и запись всех дробных чисел
    Srm.Add("add-single=" & LTrim(Str(SingleValues[a])))
   Next
  Endif
  Srm.Add("end game-object-data") 
 
  Return Srm ' собственно возврат значения
End

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

четверг, 19 сентября 2013 г.

Дописал процедуры загрузки и сохранения GroupUniversalValues

 Теперь можно сохранять/загружать GroupUniversalValues в массив строк, можно даже сказать конвертировать, загрузка и сохранение вложенного GameObjectDataClass для встроенных в игру типов тоже есть.
' Gambas class file

' Класс содержащий дополнительные свойства для юнита или части юнита
' Содержит пачку дополнительных свойств

' Как работать с данным классом
' Нужно сначала запросить номер искомого элемента по имени или ID
' После проверить не равно ли оно -1 что означает отсутствие этого свойства у объекта
' И если всё в порядке то обратиться к массиву Values и извлечь оттуда элемент по нужному номеру


Public NameValue As New String[] ' имя параметра
Public IDValue As New Integer[] ' числовое значение совпадающее с именем параметра
' каждый параметр должен должен обладать своим ID, а так же NameValue и IDValue должны быть синхронизированны
Public Values As New Variant[] ' Всё таки я решил хранить значения в типе Variant
 
 '4 + 4 + 8 = 16 байт на одно свойство
Public Count As Integer ' колличество свойств 
 
Public Function FindName(Name As String) As Integer
  'Возвращает номер значения в массиве по имени, ищет его
  Dim a As Integer ' счётчик цикла
  Dim e As Boolean ' флаг досрочного выхода
  Dim x As Integer ' возвращаемое значение
  x = -1 ' свойство не найдено
  If Count > 0 Then
   For a = 0 To Count 
    If NameValue[a] = Name Then
     'нужное имя найдено
     x = a ' присвоение значения возвращаемой переменной
     e = True ' запланировать досрочный выход
    End If
    If e = True Then Break ' совершить досрочный выход
   Next
  End If
  Return x ' возвратить значение
End

Public Function FindID(ID As Integer) As Integer
  'Возвращает номер значения в массиве по ID, ищет его
  'Поиск по ID быстрее
  Dim a As Integer ' счётчик цикла
  Dim e As Boolean ' флаг досрочного выхода
  Dim x As Integer ' возвращаемое значение
  x = -1 ' свойство не найдено
  If Count > 0 Then
   For a = 0 To Count 
    If IDValue[a] = ID Then
     'нужное имя найдено
     x = a ' присвоение значения возвращаемой переменной
     e = True ' запланировать досрочный выход
    End If
    If e = True Then Break ' совершить досрочный выход
   Next
  End If
  Return x ' возвратить значение
End

'Функция добавления значения
Public Function AddValueName(Name As String, Value As Variant) As Integer
 'добавляет значение по имени, возвращает тот же результат что и FindName, а именно номер значения в массиве Values[]
 'не проверяет есть ли значение уже в массиве
 Values.Add(Value)
 NameValue.Add(Name)
 IDValue.Add(0)
 Count = Count + 1 ' увеличение счётчика
 Return Count ' возвратить номер добавленного элемента
End
Public Function AddValueID(ID As Integer, Value As Variant) As Integer
 'добавляет значение по ID, возвращает тот же результат что и FindID, а именно номер значения в массиве Values[]
 'не проверяет есть ли значение уже в массиве
 Values.Add(Value)
 NameValue.Add("")
 IDValue.Add(ID)
 Count = Count + 1 ' увеличение счётчика
 Return Count ' возвратить номер добавленного элемента
End

'Функции редактирования/добавления значения

Public Function EditValueName(Name As String, Value As Variant) As Integer
 'Изменяет значение по имени или добавляет его если оно отсутствует
  Dim a As Integer
  Dim c As Integer
  Dim v As Integer
 
  v = FindName(Name) ' следует оптимизировать методом китайского кода
  If v = -1 Then
    'значение не найдено
    c = AddValueName(Name, Value) ' создать нужное значение
  Endif
  If v > -1 Then
   'значение найдено
   Values[v] = Value ' присвоить значение
   c = v
  Endif
  Return c ' возвратить номер присвоенного значения
End

Public Function EditValueID(ID As Integer, Value As Variant) As Integer
 'Изменяет значение по ID или добавляет его если оно отсутствует
  Dim a As Integer
  Dim c As Integer
  Dim v As Integer
 
  v = FindID(ID) ' следует оптимизировать методом китайского кода
  If v = -1 Then
    'значение не найдено
    c = AddValueID(ID, Value) ' создать нужное значение
  Endif
  If v > -1 Then
   'значение найдено
   Values[v] = Value ' присвоить значение
   c = v
  Endif
  Return c ' возвратить номер присвоенного значения
End


Public Sub _new()
 'при создании объекта необходимо записать балластное свойство
 Dim v As Variant
 Values.Add(v, 0)
 NameValue.Add("", 0)
 IDValue.Add(0, 0)
 Count = 0 ' установка счётчика в 0
End



' Функции возвращающие нужные значения сразу. Будут оптимизированы методом китайского кода
Public Function GetValueName(Name As String) As Variant
 Dim rv As Variant
 Dim nv As Integer
 nv = FindName(Name)
 If nv <> -1 Then
  rv = Values[nv]
 Endif
 Return rv
End
Public Function GetValueID(ID As Integer) As Variant
 Dim rv As Variant
 Dim nv As Integer
 nv = FindID(ID)
 If nv <> -1 Then
  rv = Values[nv]
 Endif
 Return rv
End

Public Function SaveClass() As String[]
  'Функция возвращает массив строк содержащий все значения сохранённые в классе
  Dim Srm As New String[] ' массив для результата
  Dim r As String ' результат 1 строка
  Dim a As Integer ' счётчик цикла
  Dim m As Integer ' мксимальное значение цикла
  Dim TypeGameObjectDataClass As Integer ' тип переменной
  Dim t As New GameObjectDataClass ' пустая переменная для определения типа
 
  'переменные для сохранения вложенных значений GameObjectDataClass
  Dim godcStrings As String[] 'массив для временного хранения строк
  Dim godcA As Integer ' счётчик цикла для перебора массива
  Dim godcM As Integer ' конец счётчика
  Dim godcLink As GameObjectDataClass ' переменная ссылка для ускорения опраций с объектом
 
  TypeGameObjectDataClass = TypeOf(t) ' тип контейнера для сложных свойств-объектов с более чем одним параметров
  m = Values.Max
  Srm.Add("begin universal values")
  For a = 0 To m
   'перебор всех значений
   Srm.Add("name=" & NameValue[a])
   Srm.Add("id=" & Str(IDValue[a]))
  
   If TypeOf(Values[a]) = gb.Integer Then
    'значение integer
     Srm.Add("value-integer=" & Str(Values[a]))
   Endif
   If TypeOf(Values[a]) = gb.Single Then
    'значение Single
     Srm.Add("value-single=" & Str(Values[a]))
   Endif
   If TypeOf(Values[a]) = gb.Float Then
    'значение float
     Srm.Add("value-float=" & Str(Values[a]))
   Endif
   If TypeOf(Values[a]) = gb.String Then
    'значение строка
     Srm.Add("value-string=" & Values[a])
   Endif
   If TypeOf(Values[a]) = TypeGameObjectDataClass Then
    'комплексное значение GameObjectDataClass
    'здесь надо будет сохранено куча строк
    Srm.Add("value-godc=") ' GameObjectDataClass
    godcStrings.Clear ' очистка массива
    godcLink = Null ' обнудение переменной ссылки
    godcLink = Values[a] ' присвоение ссылки, в дальнейшем использовать для операций эту ссылку
    godcStrings = godcLink.SaveClass ' сохранение класса в массив
    ' а теперь надо перебрать массив и сохранить его строки в массиве Srm этого класса
    godcM = godcStrings.Max ' узнать индекс последнего элемента в массиве
    For godcA = 0 To godcM
      'собственно перебор
      Srm.Add(godcStrings[godcA]) ' добавить в Srm массив значение из возвращённого массива
    Next
   
   Endif
  
   Srm.Add("next value")
    
  Next
  Srm.Add("end universal values")
  Return Srm
End

Public Sub LoadClass(DataArray As String[])
  ' Функция загружает в класс необходимые значения
  ' Она будет сложнее чем GameObjectDataClass ибо ей нужно фильтровать много типов значений
  ' Надо бы придумать формат
  '
  ' Формат:
  ' name=Ox
  ' id=150
  ' value-integer=10
  ' next value
  ' name=axe
  ' id=1
  ' value-godc
  ' begin game-object-data
  ' данные GameObjectDataClass
  ' end game-object-data
  ' end universal values
 
  Dim a As Integer 'счётчик цикла
  Dim m As Integer 'ограничитель цикла
  Dim Name As String ' имя
  Dim ID As Integer ' ID
 
  Dim sdata As New ClassStringData ' класс для операций разложения строк
  Dim OP As String
  Dim Value As String ' переменные для кэширования значений операций разложения строки
  Dim r As Integer ' временная переменная
   
  Dim DataValue As Variant ' значение
  Dim ValueInteger As Integer
  Dim ValueSingle As Single
  Dim ValueFloat As Float
  Dim ValueString As String
  Dim ValueGODC As GameObjectDataClass ' значения конкретных типов. Создание и инициализация объекта проходит внутри тела процедуры
  Dim Srm As New String[] ' текстовый массив для вложенных сложных типов
 
  Count = 0
  NameValue.Clear
  IDValue.Clear
  Values.Clear ' очистка объекта от старых данных
  _new ' нициализация объекта заново и создание балластного значения под индексом 0
   
  m = DataArray.Max ' установление ограничителя цикла
 
  For a = 0 To m
    'перебор строк
    OP = sdata.GetOpS(DataArray[a])
    Value = sdata.GetValueS(DataArray[a]) ' разложение строки на оператор и параметр
   
    If OP = "name" Then
      'присвоение имени
      Name = Value
    Endif
    If OP = "id" Then
      'присвоение ID
      ID = Val(Value)
    Endif
   
    If OP = "value-integer" Then
      'целое число
      ValueInteger = Val(Value) ' присвоение и преобразование в нужный тип средствами runtime среды
      DataValue = ValueInteger ' присовение преобразованного значения переменной variant     
    Endif
    If OP = "value-single" Then
      'дробное число
      ValueSingle = Val(Value) ' присвоение и преобразование в нужный тип средствами runtime среды
      DataValue = ValueSingle ' присовение преобразованного значения переменной variant     
    Endif
    If OP = "value-float" Then
      'float
      ValueFloat = Val(Value) ' присвоение и преобразование в нужный тип средствами runtime среды
      DataValue = ValueFloat ' присовение преобразованного значения переменной variant     
    Endif
    If OP = "value-string" Then
      'строка
      ValueString = Value ' присвоение и преобразование в нужный тип средствами runtime среды
      DataValue = ValueString ' присовение преобразованного значения переменной variant     
    Endif
   
    If OP = "value-godc" Then
      ' вложенный сложный объект
      ' Тут то придёться подумать как правильно это написать
      ValueGODC = New GameObjectDataClass ' создание нового сложного объекта
      Srm.Clear
      Do
        'цикл перебора строк
        a - a + 1 ' увеличение счётчика вышестоящего цикла FOR
        OP = sdata.GetOpS(DataArray[a]) ' вычленение оператора
        Srm.Add(DataArray[a]) ' копирование строки во временный массив
      Loop Until OP = "end game-object-data" ' окончание описания сложного объекта
      ' Строки относящиеся к вложенному объекту скопированны в массив Srm
      ' Счётчик (a) тоже скорректирован что бы не просматривать строки относящиеся к вложенному объекту ещё раз
      ValueGODC.LoadClass(Srm)  ' обработка строк вложенным сложным объектом и загрузка в него данных
      DataValue = ValueGODC ' присвоение ссылки переменной типа Variant, промежуточной
      ValueGODC = Null ' очистка первичной ссылки на загруженный сложный объект
    Endif
   
    If OP = "next value" Then
      'следующее значение, присвоить
      r = AddValueID(ID, DataValue) ' здесь мы добавляем новое значение и кэшируем его позицию в списке для быстрого использования
      ' использеться функция AddValueID которая не проверяет есть ли уже объект в массиве
      NameValue[r] = Name ' присвоение имени
      DataValue = Null ' обнуление используемых переменных
      ID = 0
      Name = ""
    Endif
   
  Next
 
End

среда, 18 сентября 2013 г.

Пишу потихоньку, процедуры сохранения делать легче чем процедуры загрузки.

' Gambas class file

' Класс содержащий дополнительные свойства для юнита или части юнита
' Содержит пачку дополнительных свойств

' Как работать с данным классом
' Нужно сначала запросить номер искомого элемента по имени или ID
' После проверить не равно ли оно -1 что означает отсутствие этого свойства у объекта
' И если всё в порядке то обратиться к массиву Values и извлечь оттуда элемент по нужному номеру


Public NameValue As New String[] ' имя параметра
Public IDValue As New Integer[] ' числовое значение совпадающее с именем параметра
' каждый параметр должен должен обладать своим ID, а так же NameValue и IDValue должны быть синхронизированны
Public Values As New Variant[] ' Всё таки я решил хранить значения в типе Variant
 
 '4 + 4 + 8 = 16 байт на одно свойство
Public Count As Integer ' колличество свойств  

Собственно функция сохранения
Public Function SaveClass() As String[]
  'Функция возвращает массив строк содержащий все значения сохранённые в классе
  Dim Srm As New String[] ' массив для результата
  Dim r As String ' результат 1 строка
  Dim a As Integer ' счётчик цикла
  Dim m As Integer ' мксимальное значение цикла
  Dim TypeGameObjectDataClass As Integer ' тип переменной
  Dim t As New GameObjectDataClass ' пустая переменная для определения типа
 
  'переменные для сохранения вложенных значений GameObjectDataClass
  Dim godcStrings As String[] 'массив для временного хранения строк
  Dim godcA As Integer ' счётчик цикла для перебора массива
  Dim godcM As Integer ' конец счётчика
  Dim godcLink As GameObjectDataClass ' переменная ссылка для ускорения опраций с объектом
 
  TypeGameObjectDataClass = TypeOf(t) ' тип контейнера для сложных свойств-объектов с более чем одним параметров
  m = Values.Max
  Srm.Add("begin universal values")
  For a = 0 To m
   'перебор всех значений
   Srm.Add("name=" & NameValue[a])
   Srm.Add("id=" & Str(IDValue[a]))
  
   If TypeOf(Values[a]) = gb.Integer Then
    'значение integer
     Srm.Add("value-integer=" & Str(Values[a]))
   Endif
   If TypeOf(Values[a]) = gb.Single Then
    'значение Single
     Srm.Add("value-single=" & Str(Values[a]))
   Endif
   If TypeOf(Values[a]) = gb.Float Then
    'значение float
     Srm.Add("value-float=" & Str(Values[a]))
   Endif
   If TypeOf(Values[a]) = gb.String Then
    'значение строка
     Srm.Add("value-string=" & Values[a])
   Endif
   If TypeOf(Values[a]) = TypeGameObjectDataClass Then
    'комплексное значение GameObjectDataClass
    'здесь надо будет сохранено куча строк
    Srm.Add("value-godc=") ' GameObjectDataClass
    godcStrings.Clear ' очистка массива
    godcLink = Null ' обнудение переменной ссылки
    godcLink = Values[a] ' присвоение ссылки, в дальнейшем использовать для операций эту ссылку
    godcStrings = godcLink.SaveClass ' сохранение класса в массив
    ' а теперь надо перебрать массив и сохранить его строки в массиве Srm этого класса
    godcM = godcStrings.Max ' узнать индекс последнего элемента в массиве
    For godcA = 0 To godcM
      'собственно перебор
      Srm.Add(godcStrings[godcA]) ' добавить в Srm массив значение из возвращённого массива
    Next
   
   Endif
  
   Srm.Add("next value")
    
  Next
  Srm.Add("end universal values")
  Return Srm
End

воскресенье, 15 сентября 2013 г.

К чему это всё? Что я пишу?

Я пишу движок компьютерной игры. Данный движок позволит создавать стратегические игры с большой детализацией функций юнитов. Проще говоря можно будет создавать юнитов состоящих из множества модулей каждый из которых будет обладать своими свойствами.

Модуль позволяющий давать объекту произвольный набор свойств

Это позволяет придавать объектам множество свойств. Не оптимальный, но имеет функцию оптимизации поиска (кэширование результата) и открытые поля для прямого доступа.

 Gambas class file

' Это класс контейнер предназначенный для хранения тех свойств объектов значимость которых не исчерпывается
' каким либо одним параметром
' Проще говоря данный класс хранит множество других параметров объекта
' GroupUniversalValues.Values

Public Strings As New String[] ' строки
Public IntegerValues As New Integer[] ' целые числа
Public SingleValues As New Single[] ' дробные числа

Public Function SaveClass() As String[]
  ' Функция сохраняет данные класса в строковый массив
  Dim Srm As New String[]  ' массив для результата
  Dim MaxString As Integer ' колличество строк
  Dim MaxInteger As Integer ' колличество целых чисел
  Dim MaxSingle As Integer ' колличество дробных чисел
 
  Dim a As Integer
 
  MaxString = Strings.Max
  MaxInteger = IntegerValues.Max
  MaxSingle = SingleValues.Max
 
  Srm.Add("begin game-object-data") ' заголовок
 
  If Strings.Count > 0 Then
   'строки есть
   For a = 0 To MaxString
    'перебор и запись всех строк
    Srm.Add("add-string=" & Strings[a])
   Next
  Endif
 
  If IntegerValues.Count > 0 Then
   'целые числа есть
   For a = 0 To MaxString
    'перебор и запись всех целых чисел
    Srm.Add("add-integer=" & LTrim(Str(IntegerValues[a]))) ' лучше всё таки при конвертировании сразу обрезать пробелы
   Next
  Endif
 
  If SingleValues.Count > 0 Then
   'дробные числа есть
   For a = 0 To MaxString
    'перебор и запись всех дробных чисел
    Srm.Add("add-single=" & LTrim(Str(SingleValues[a])))
   Next
  Endif
  Srm.Add("end game-object-data") 
 
  Return Srm ' собственно возврат значения
End

Public Sub LoadClass(DataArray As String[])
 'функция принимает массив строк и загружает данные в класс предварительно удаляя прошлые
 Dim sdata As New ClassStringData
 Dim a As Integer ' счётчик цикла
 Dim sm As Integer ' колличество переданных строк
 Dim w As String ' текущая обрабатываемая строка

 Dim OP As String 'оператор в строке
 Dim ValueS As String ' значение в строке

 Strings.Clear
 IntegerValues.Clear
 SingleValues.Clear ' предварительная очистка значений класса
 sm = DataArray.Max ' подсчёт колличества строк

 For a = 0 To sm
  'перебор строк
  'тут нужно использовать разложение строк, а именно функции GetOpS и GetValueS
  w = DataArray[a] ' присваивание значения в кэширующую локальную переменную
  OP = sdata.GetOpS(w) ' извелечение из строки оператора
  'анализ оператора, 3 варианта
  If OP = "add-string" Then
    'строка
    ValueS = sdata.GetValueS(w) ' извлечение строкового значения
    Strings.Add(ValueS) ' добавление строкового значения
  Endif
  If OP = "add-integer" Then
    'целое число
    ValueS = sdata.GetValueS(w) ' извлечение числового значения
    IntegerValues.Add(Val(ValueS)) ' добавление целого числа
  Endif
  If OP = "add-single" Then
    'дробное число
    ValueS = sdata.GetValueS(w) ' извлечение дробного значения
    SingleValues.Add(Val(ValueS)) ' добавление дробного числа
  Endif
   
 Next
 ' Ну вроде всё присвоено, что ещё делать?..

 
End

Star E процесс создания

Выложу ка я исходники, лицензия GPL v.3

' Gambas class file

' Класс содержит функции нужные для разделения строк на параметр=значение
' По сути он дублирует модуль ModuleStringData
' А сделанно всё так из за герметичности классов, они не допускают использование и вызов функций из обычных модулей
' инкапсуляция же. FUCK!FUCK!FUCK!FUCK!FUCK!FUCK!FUCK!FUCK!


Public Function GetOpS(S As String) As String
  'процедура возвращает оператор
  'процедура настроена на символ = в качестве разделителя
  Dim l As Integer ' длинна строки
  Dim a As Integer ' счётчик цикла
  Dim Op As String ' оператор
 
  l = Len(S)
 
  If l > 0 Then
    'строка не пустая
    For a = 1 To l
      'цикл же
      If Mid(S, a, 1) = "=" Then Break ' досрочный выход из цикла по причине нахождения разделителя
      Op = Op & Mid(S, a, 1) ' наращивание по одному символу
    Next
   Endif
   Return Op 'возврат значения
      
End
Public Function GetValueS(S As String) As String
  'процедура возвращает значение находящиеся после оператора, если оно конечно есть
  'в любом другом случае возвращает пустое значение
  Dim l As Integer ' длинна строки
  Dim a As Integer ' счётчик цикла
  Dim Value As String ' значение 
  Dim v As Boolean ' началось ли значение
 
  l = Len(s)
 
  If l > 2 Then
    'тут есть значение, хотя оператора может и не быть :) минимум для оператора и значения это 3
    'это не баг, это фича
    For a = 1 To l
     If v Then
      'значение началось
      Value = Value & Mid(s, a, 1) ' заполняем значение
     End If 
     If v = False Then
      'значение ещё не началось
      If Mid(S, a, 1) = "=" Then v = True ' значение начинаеться
     End If
     'именно такой порядок проверки условий нужен что бы в значение не попал разделитель "="
    Next
  Endif
  Return Value 'возврат значения
End