Необходимо сделать объемный вращающийся куб

@Averonix · Регистрация: 14.12.2009

Студворк — интернет-сервис помощи студентам

Нужна помощь по задачке на qbasic - необходимо сделать объемный вращающийся куб, при этом пользователем должен задаваться его размер... Очень желательно сделать его на этой неделе... Заранее благодарю за помощь!

@VS · 14.12.2009, 22:30

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
DEFINT A-Z
 
One$ = "BR30 BU25 C1 R54 U45 L54 D45 BE20 P1, 1G20 C2 G20"
Two$ = "R54 E20 L54 BD5 P2, 2 U5 C4 G20 U45 E20 D45 BL5 P4, 4"
Plot$ = One$ + Two$
APage% = 0
VPage% = 1
HPage% = 2
Angle% = 0
CLS
SCREEN 8, 0, VPage%, VPage%
 PCOPY VPage%, HPage%
 SLEEP 1
 DO
     SCREEN 8, 0, APage%, VPage%
     CLS 1
     DRAW "TA" + STR$(Angle%) + Plot$
     Angle% = (Angle% + 15) MOD 360
 
     SWAP APage%, VPage%
     Kbd$ = INKEY$
     SELECT CASE Kbd$
          CASE CHR$(0) + CHR$(104)
               PCOPY HPage%, APage%
               SLEEP 3
          CASE ""
          CASE ELSE
               EXIT DO
     END SELECT
 LOOP
 END

@Averonix · 15.12.2009, 00:01 **[ТС]**

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

@gehh · 07.06.2014, 21:28

Примите и этот. Он тоже вращается.
(программа проверена)

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
DEFSNG F, X-Z
DEFLNG I
CLS
 
SCREEN 12
WINDOW (-6, 4.4)-(6, -4.5)
 
f = .78
DO
   f = f + .01
   x1 = 2.83 * COS(f): y1 = SIN(f)
   x2 = -2.83 * SIN(f): y2 = COS(f)
   x3 = -2.83 * COS(f): y3 = -SIN(f)
   x4 = 2.83 * SIN(f): y4 = -COS(f)
 
   LINE (x1, y1 - 2)-(x2, y2 - 2), 11
   LINE (x2, y2 - 2)-(x3, y3 - 2), 11
   LINE (x3, y3 - 2)-(x4, y4 - 2), 11
   LINE (x4, y4 - 2)-(x1, y1 - 2), 11
   LINE (x1, y1 + 2)-(x2, y2 + 2), 11
   LINE (x2, y2 + 2)-(x3, y3 + 2), 11
   LINE (x3, y3 + 2)-(x4, y4 + 2), 11
   LINE (x4, y4 + 2)-(x1, y1 + 2), 11
   LINE (x1, y1 - 2)-(x1, y1 + 2), 11
   LINE (x2, y2 - 2)-(x2, y2 + 2), 11
   LINE (x3, y3 - 2)-(x3, y3 + 2), 11
   LINE (x4, y4 - 2)-(x4, y4 + 2), 11
 
   FOR i = 1 TO 500000: NEXT i
   LINE (x1, y1 - 2)-(x2, y2 - 2), 0
   LINE (x2, y2 - 2)-(x3, y3 - 2), 0
   LINE (x3, y3 - 2)-(x4, y4 - 2), 0
   LINE (x4, y4 - 2)-(x1, y1 - 2), 0
   LINE (x1, y1 + 2)-(x2, y2 + 2), 0
   LINE (x2, y2 + 2)-(x3, y3 + 2), 0
   LINE (x3, y3 + 2)-(x4, y4 + 2), 0
   LINE (x4, y4 + 2)-(x1, y1 + 2), 0
   LINE (x1, y1 - 2)-(x1, y1 + 2), 0
   LINE (x2, y2 - 2)-(x2, y2 + 2), 0
   LINE (x3, y3 - 2)-(x3, y3 + 2), 0
   LINE (x4, y4 - 2)-(x4, y4 + 2), 0
LOOP WHILE INKEY$ = ""
END

Удачи вам!

@Quiet Snow · 08.06.2014, 18:29

Averonix, в закреплённой теме есть ссылка на FAQ как подобное делать.
Можно не только куб. Там и проекции и текстуры даже есть, правда QB но не суть.

Прога из сообщения #2 не является ответом, т.к. вращается плоская картинка.

Прога gehh-а тоже смутный вариант, иммитация изометрии, крутить точки по эллипсам
сверху и снизу, во-первых нет относительности в пространстве, во-вторых это не 3D,
а его одноразовая "эмуляция".

@Good-Morning · 25.07.2014, 01:53

Вот более-менее рабочий вариант:

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
TYPE poi
  x AS SINGLE
  y AS SINGLE
END TYPE
DECLARE SUB dr (p AS poi, x AS SINGLE, y AS SINGLE, z AS SINGLE, sh AS INTEGER, alfa AS SINGLE, gamma AS SINGLE)
DECLARE SUB drawline (p0 AS poi, p1 AS poi)
DECLARE SUB changescreen ()
CONST sc = 250
CONST w = 320
CONST l = 200
CONST pi = 3.14
 
DIM SHARED sch
SCREEN 7, , 1, 0
DIM STime AS DOUBLE
DIM temp(1 TO 8)  AS poi
DO WHILE INKEY$ = ""
    g = g + (TIMER - STime) * .5
    STime = TIMER
    IF g > 1.6 THEN g = 0
    
    CALL dr(temp(1), 400, -100, -100, 500, .7, g)
    CALL dr(temp(2), 400, -100, 100, 500, .7, g)
    CALL dr(temp(4), 400, 100, 100, 500, .7, g)
    CALL dr(temp(6), 600, -100, 100, 500, .7, g)
    CALL dr(temp(8), 600, 100, 100, 500, .7, g)
    
    IF g < 1.4 THEN CALL dr(temp(5), 600, -100, -100, 500, .7, g)
    IF g > .2 THEN CALL dr(temp(3), 400, 100, -100, 500, .7, g)
    
    CALL drawline(temp(1), temp(2))
    CALL drawline(temp(2), temp(4))
    CALL drawline(temp(6), temp(8))
    CALL drawline(temp(2), temp(6))
    CALL drawline(temp(4), temp(8))
    
    IF g > .2 THEN CALL drawline(temp(3), temp(4))
    IF g > .2 THEN CALL drawline(temp(3), temp(1))
    IF g < 1.3 THEN CALL drawline(temp(5), temp(6))
    IF g < 1.3 THEN CALL drawline(temp(1), temp(5))
    
    CALL changescreen
LOOP
 
SUB changescreen
    SCREEN , , sch, 1 - sch
    sch = 1 - sch
    CLS
END SUB
 
SUB dr (p AS poi, x AS SINGLE, y AS SINGLE, z AS SINGLE, sh AS INTEGER, alfa AS SINGLE, gamma AS SINGLE)
    r = x - sh
    rr = SQR(r ^ 2 + y ^ 2)
    IF r <> 0 THEN rr = rr * SGN(r)
    x1 = sh + rr * SIN(gamma + ATN(y / r))
    y1 = rr * COS(gamma + ATN(y / r))
    r = x1 - sh
    rr = SQR(r ^ 2 + z ^ 2)
    IF r <> 0 THEN rr = rr * SGN(r)
    x1 = sh + rr * COS(alfa + ATN(z / r))
    z1 = rr * SIN(alfa + ATN(z / r))
    a = y1 * sc / x1: b = z1 * sc / x1
    p.x = 160 - a: p.y = 100 - b
END SUB
 
SUB drawline (p0 AS poi, p1 AS poi)
    LINE (p0.x, p0.y)-(p1.x, p1.y)
END SUB

@xod · 25.07.2014, 08:00

Я потрясен!
А что делает процедура changescreen() ??!
Это на грани фантастики!
Был бы вам очень благодарен, если бы вы хоть что-нибудь
добавили к своей программе (мини-REM)
Спасибо!

@Good-Morning · 25.07.2014, 16:01

комментарии к программе

Тип poi - содержит координаты точки на экране.
Процедура dr - вычисляет координаты точки на экране по параметрам: координаты точки в пространстве, расстоянию до оси поворота,
углам поворота (alfa=0.7 отвечает за вид "сверху", gamma - отвечает за "поворот" куба), глобальный sc - расстояние от наблюдателя до
экрана. Результат помещается в параметр p.
Процедура drawline - просто рисует линию от точки до точки, координаты которых содержатся в объектах типа poi.
Процедура changescreen - меняет рабочую страницу экрана на демонстрирующуюся и очищает рабочую. В общем, то, что у VS, было в
виде:

QBasic/QuickBASIC
1
2
3
SCREEN 8, 0, APage%, VPage%
...
 SWAP APage%, VPage%

т.к. x=y-x при очередном применении будет в x возвращать то y, то 0.
g = g + (TIMER - STime) * .5 - куб вращается со скоростью полрадиана в секунду. Т.е. за каждую секунду, потраченную на прорисовку,
куб поворачивается на (STime+1-STime)*0.5=0.5 радиан. (STime=Timer - ожидание нового значения времени прорисовки.) Обеспечивает
одинаковую (более-менее) скорость вращения куба при любых fps.
IF g > 1.6 THEN g = 0 - куб делает не полный разворот, а поворачивается 90 градусов и возвращается в исходную позицию.
Блок dr - вычисляются координаты на экране всех нужных в данный момент точек куба.
Блок drawline - прорисовываются все нужные в данный момент ребра куба.
changescreen - демонстрация экрана, работа с новой страницей.

@xod · 25.07.2014, 16:47

Я очень Вам благодарен. Сам я никогда не применял такие
возможности QBasic-а. Да и подобная программа мне встретилась
первый раз. Вы Бейсик-программист N 1 !!!
Большое Спасибо Вам за комментарий.

@Quiet Snow · 27.07.2014, 03:36

Good-Morning, мерцание сильное на DOSBox. Попробуй мой вариант FLIP.
Проекцию я Стасу давал на другом форуме, если найдёшь посмотри, она и тут была где-то,
тема, где был проанализирован чужой код.

Не понятно от чего прётся xod\gehh, 3d пишется элементарно, вроде бы он и заходил в
закреплённую тему.

Добавлено через 16 минут

Сам я никогда не применял такие возможности QBasic-а.

И упаси лосось их применять на QBasic-е... Wireframe - это было на заре 80-x.
Тупо текстуры вышли из моды после Quake 2 и Half-Life, 98-й и 99-й года.

@Good-Morning · 27.07.2014, 18:31

Сообщение от Quiet Snow

Попробуй мой вариант FLIP.

Исправил, спасибо. Как понимаю, это как-то связано с синхроимпульсом?
Оптимизировал, теперь даже на 3000 cycles (DOSBox) тянет.

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
TYPE poi
  x AS SINGLE
  y AS SINGLE
END TYPE
 
TYPE cube
    top1 AS poi
    top2 AS poi
    top3 AS poi
    top4 AS poi
    top5 AS poi
    top6 AS poi
    top7 AS poi
    top8 AS poi
END TYPE
 
DECLARE SUB drcube (c AS cube, g AS SINGLE)
DECLARE SUB dr (p AS poi, x AS SINGLE, y AS SINGLE, z AS SINGLE, sh AS INTEGER, alfa AS SINGLE, gamma AS SINGLE)
DECLARE SUB drawcube (c AS cube)
DECLARE SUB changescreen ()
CONST sc = 250
CONST w = 320
CONST l = 200
CONST pi = 3.14
 
DIM SHARED sch, r
DIM SHARED DrMemD(0 TO 314)  AS cube
SCREEN 7
DIM STime AS DOUBLE, DTime AS DOUBLE, g AS INTEGER
DIM temp(1 TO 8) AS poi
LOCATE 15, 15
PRINT "loading..."
FOR g = 0 TO 314
    CALL drcube(DrMemD(g), g / 200)
    LOCATE 17, 1
    FOR i = 1 TO INT(40 * (g / 320)) + 1
        PRINT CHR$(177);
    NEXT
NEXT
SCREEN , , 1, 0
STime = TIMER
DO WHILE INKEY$ = ""
    DTime = INT((TIMER - STime) * 1000)
    IF DTime > 3 THEN
        g = g + DTime / 3
        STime = TIMER
        IF g > 314 THEN g = 0
        CALL drawcube(DrMemD(g))
        CALL changescreen
    END IF
LOOP
 
SUB changescreen
    SCREEN , , sch, 1 - sch
    sch = 1 - sch
    WAIT &H3DA, 8
    CLS
END SUB
 
SUB dr (p AS poi, x AS SINGLE, y AS SINGLE, z AS SINGLE, sh AS INTEGER, alfa AS SINGLE, gamma AS SINGLE)
    r = x - sh
    rr = SQR(r ^ 2 + y ^ 2)
    IF r <> 0 THEN rr = rr * SGN(r)
    x1 = sh + rr * SIN(gamma + ATN(y / r))
    y1 = rr * COS(gamma + ATN(y / r))
    r = x1 - sh
    rr = SQR(r ^ 2 + z ^ 2)
    IF r <> 0 THEN rr = rr * SGN(r)
    x1 = sh + rr * COS(alfa + ATN(z / r))
    z1 = rr * SIN(alfa + ATN(z / r))
    a = y1 * sc / x1: b = z1 * sc / x1
    p.x = 160 - a: p.y = 100 - b
END SUB
 
SUB drawcube (c AS cube)
    LINE (c.top3.x, c.top3.y)-(c.top7.x, c.top7.y), 5
    LINE (c.top7.x, c.top7.y)-(c.top8.x, c.top8.y), 5
    LINE (c.top7.x, c.top7.y)-(c.top5.x, c.top5.y), 5
    LINE (c.top1.x, c.top1.y)-(c.top2.x, c.top2.y)
    LINE (c.top2.x, c.top2.y)-(c.top4.x, c.top4.y)
    LINE (c.top3.x, c.top3.y)-(c.top4.x, c.top4.y)
    LINE (c.top3.x, c.top3.y)-(c.top1.x, c.top1.y)
    LINE (c.top5.x, c.top5.y)-(c.top6.x, c.top6.y)
    LINE (c.top6.x, c.top6.y)-(c.top8.x, c.top8.y)
    LINE (c.top1.x, c.top1.y)-(c.top5.x, c.top5.y)
    LINE (c.top2.x, c.top2.y)-(c.top6.x, c.top6.y)
    LINE (c.top4.x, c.top4.y)-(c.top8.x, c.top8.y)
END SUB
 
SUB drcube (c AS cube, g AS SINGLE)
    CALL dr(c.top1, 400, -100, -100, 500, .7, g)
    CALL dr(c.top2, 400, -100, 100, 500, .7, g)
    CALL dr(c.top3, 400, 100, -100, 500, .7, g)
    CALL dr(c.top4, 400, 100, 100, 500, .7, g)
    CALL dr(c.top5, 600, -100, -100, 500, .7, g)
    CALL dr(c.top6, 600, -100, 100, 500, .7, g)
    CALL dr(c.top7, 600, 100, -100, 500, .7, g)
    CALL dr(c.top8, 600, 100, 100, 500, .7, g)
END SUB

@Quiet Snow · 28.07.2014, 03:46

Good-Morning, всё равно моргать будет, знаю, что по идее не должно, но будет.
Копируй FLIP подчистую, не боись. Суть ещё в том, что у тебя много тригонометрии и
ресурсоёмких операций на каждую вершину. Я тоже свой двиг написал когда, понял что
сильно дофига, что-то закешировал, но всё равно деления, синусы и прочая муть. Можно
взять проекцию вот такую:

QBasic/QuickBASIC
1
2
    x = HalfRezX - ((TY * K1) / (TX + K2)) * K3
    y = HalfRezY - ((TZ * K1) / (TX + K2)) * K4

2 деления, 4 умножения и 2 сложения. Настраивается несложно, подбираешь коэффициенты.
Ежели на QB\QBasic то таймер дополнительно можно эмулировать через эвент PLAY, это
конечно "грязный" метод, но нативный и халявный.

@Good-Morning · 28.07.2014, 15:49

Сообщение от Quiet Snow

всё равно моргать будет

Не знаю, у меня не моргает. И с 3'000, и с 20'000.

Сообщение от Quiet Snow

Суть ещё в том, что у тебя много тригонометрии и
ресурсоёмких операций на каждую вершину.

В последней программе данные подготавливаются, поэтому там ничего сложнее умножения нет (и то, в таймере).

Сообщение от Quiet Snow

Можно взять проекцию вот такую

Я такую и использую

:

QBasic/QuickBASIC
1
 a = y1 * sc / x1: b = z1 * sc / x1

Остальное все - это относиться к повороту точек в пространстве, чтобы можно было поднять камеру, поворачивать объект.

Сообщение от Quiet Snow

таймер дополнительно можно эмулировать через эвент PLAY

Не понимаю, чем он лучше Timer-а. Не нашел в последнем возможности сохранения скорости вращения при разных частотах. С помощью таймера я добиваюсь, что скорость вращения одинаковая и на 300, и на 3000, и на 20000, и даже на эмуляторе QB во FreeBasic со всеми 2.2 GHz-ами. С play такое не проходит, хотя, возможно, я что-то делаю неправильно.

@Quiet Snow · 29.07.2014, 06:52

Не понимаю, чем он лучше Timer-а.

Тот же таймер, только больше тактов. Не 18.2 в секунду, а много больше.

С play такое не проходит, хотя, возможно, я что-то делаю неправильно.

<DELETED> Обсудим.

Я такую и использую

Что-то подозрительно мало всего, ну ладно потестирую потом. Ну впринципе я догадывался что
свернуть во что-то такое можно с ограниченными проекционными возможностями.
В ENLIGNT факе для демщиков используется такое:

sx = xSize/2+x*dist/(z+dist),
sy = ySize/2-y*dist/(z+dist).

Добавлено через 12 минут

Остальное все - это относиться к повороту точек в пространстве, чтобы можно было поднять камеру, поворачивать объект.

Достаточно ресурсоёмкое из 3D рассчётов. Где-то я видел на FB, чувак через сдвиговые
операции поворот точек делал. Правда он там копирайт наложил собака, но как-бы можно
простой логикой это делать. Там в демке массив красных точек вращался, ну может видел.

Добавлено через 7 минут

300, и на 3000, и на 20000

3000 тактов это 386-SX на 40 МГц, инфа от Абадябера, можно верить на слово. Ниже можно
уже не ставить на тестирование. Но эмуляция вообще вещь очень кривая, она не учитывает
hardware оптимизацию, да и QuickBasic настолько неповоротлив, что разница в скорости на
разных тачках между его кодом и кодом на ассемблере сильно ощущается.

Новые блоги и статьи Все статьи Все блоги /
Отчёт о затраченных материалах за определенный период с макетом печатной формы Maks 21.04.2026 Отчёт из решения ниже размещён в конфигурации КА2. Задача: показать затраченные материалы за определённый период, с возможностью вывода печатной формы отчёта с шапкой и подвалом. В качестве. . .	Отчёт о спецтехнике находящейся в ремонте Maks 20.04.2026 Отчёт из решения ниже размещен в конфигурации КА2. Задача: отобразить спецтехнику, которая на данный момент находится в ремонте. Есть нетиповой документ "Заявка на ремонт спецтехники" который. . .	Памятка для бота и "визитка" для читателей "Semantic Universe Layer (Слой семантической вселенной)" Hrethgir 19.04.2026 Сгенерировано для краткого описания по случаю сборки и компиляции скелета серверного приложения. И пусть после этого скажут, что статьи сгенерированные AI - туфта и не интересно. И это не реклама -. . .	Запрет удаления строк ТЧ документа при определённом условии Maks 19.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "Аккумуляторы", разработанного в конфигурации КА2. У данного документа есть ТЧ, в которой в зависимости от прав доступа. . .
Модель заражения группы наркоманов alhaos 17.04.2026 Условия задачи сформулированы тут Суть: - Группа наркоманов из 10 человек. - Только один инфицирован ВИЧ. - Колются одной иглой. - Колются раз в день. - Колются последовательно через. . .	Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.

@Averonix 0 / 0 / 0 Регистрация: 14.12.2009 Сообщений: 4

	Необходимо сделать объемный вращающийся куб 14.12.2009, 16:54. Показов 4708. Ответов 13 Метки нет (Все метки) Нужна помощь по задачке на qbasic - необходимо сделать объемный вращающийся куб, при этом пользователем должен задаваться его размер... Очень желательно сделать его на этой неделе... Заранее благодарю за помощь! 0

@Averonix 0 / 0 / 0 Регистрация: 14.12.2009 Сообщений: 4
	15.12.2009, 00:01 [ТС]
	Спасибо за пример, но я уже его видел и не смог разобраться как он работает... И в общем мне надо немного другое, в примере куб вращается вокруг одной грани, а мне необходимо чтобы он вращался вокруг точки в центре куба.. 0

@Quiet Snow Кормпилятор 5044 / 1718 / 409 Регистрация: 25.04.2010 Сообщений: 4,827 Записей в блоге: 2
	08.06.2014, 18:29
	Averonix, в закреплённой теме есть ссылка на FAQ как подобное делать. Можно не только куб. Там и проекции и текстуры даже есть, правда QB но не суть. Прога из сообщения #2 не является ответом, т.к. вращается плоская картинка. Прога gehh-а тоже смутный вариант, иммитация изометрии, крутить точки по эллипсам сверху и снизу, во-первых нет относительности в пространстве, во-вторых это не 3D, а его одноразовая "эмуляция". 1

@xod 156 / 46 / 70 Регистрация: 01.07.2014 Сообщений: 185
	25.07.2014, 08:00
	Я потрясен! А что делает процедура changescreen() ??! Это на грани фантастики! Был бы вам очень благодарен, если бы вы хоть что-нибудь добавили к своей программе (мини-REM) Спасибо! 0

@xod 156 / 46 / 70 Регистрация: 01.07.2014 Сообщений: 185
	25.07.2014, 16:47
	Я очень Вам благодарен. Сам я никогда не применял такие возможности QBasic-а. Да и подобная программа мне встретилась первый раз. Вы Бейсик-программист N 1 !!! Большое Спасибо Вам за комментарий. 0