Графика на бейсике

PUT (k + 2, 6), c%(66 * (ASC(MID$(g$, k)) - 44)), PSET

DECLARE SUB sprite (x%, y%, form%, col%)
DECLARE SUB playnote ()
'qbasic
CONST pi = 3.1415926#
DEFINT A-Z
DIM SHARED dot(15, 127)
DIM SHARED loops: loops = 0
DIM SHARED page: page = 0
DIM n AS SINGLE, r AS SINGLE, f AS SINGLE
' Читаем изображения спрайтов
RESTORE
FOR j = 0 TO 127
  READ q$
  FOR i = 0 TO 15
    IF MID$(q$, i + 1, 1) = "*" THEN dot(i, j) = 1 ELSE dot(i, j) = 0
  NEXT i
NEXT j
' Граф режим  VGA 320*200*16 цветов
SCREEN 7
' Рисуем 8 видео страниц
FOR k = 0 TO 7
  SCREEN , , k, k
  form = k
  FOR n = 1 TO 19 STEP pi / 6
    r = 10 + 10 * n
    f = n + k * pi / 6 / 8
    sprite 160 + r * COS(f), 100 - r * SIN(f), form, 12
    sprite 160 + r * COS(f), 100 + r * SIN(f), form, 10
    form = (form + 1) MOD 8
  NEXT n
NEXT k
' собственно анимация с музыкой
RESTORE music
DO
  IF INKEY$ <> "" THEN SCREEN 0: WIDTH 80: END
  playnote
LOOP
 
DATA "................"
DATA "................"
DATA "...***....***..."
DATA "..*****..*****.."
DATA "................"
DATA "..**.**..**.**.."
DATA "...***....***..."
DATA ".......**......."
DATA ".**...****...**."
DATA ".**..******..**."
DATA "..************.."
DATA ".....******....."
DATA ".....******....."
DATA "...*..*..*..*..."
DATA "..***.*..*.***.."
DATA "..*****..*****.."
DATA "................"
DATA "...***....***..."
DATA "..*****..*****.."
DATA "................"
DATA "..**.**..**.**.."
DATA "..**.**..**.**.."
DATA "...***....***..."
DATA ".......**......."
DATA ".**...****...**."
DATA ".**..******..**."
DATA "..************.."
DATA ".....******....."
DATA "...*..*****....."
DATA "..***.*..*..*..."
DATA "..*****..*.***.."
DATA ".........*****.."
DATA "................"
DATA "................"
DATA "...***....***..."
DATA "..*****..*****.."
DATA "..*****........."
DATA ".........**.**.."
DATA "...***....***..."
DATA ".......**......."
DATA "......****......"
DATA ".....******....."
DATA ".**.********.**."
DATA ".***.******.***."
DATA ".....******....."
DATA "...*..*..*..*..."
DATA "..***.*..*.***.."
DATA "..*****..*****.."
DATA "................"
DATA "................"
DATA "...***....***..."
DATA "..*****..*****.."
DATA ".........*****.."
DATA "..**.**..*****.."
DATA "...***....***..."
DATA ".......**......."
DATA ".**...****...**."
DATA ".**..******..**."
DATA "..************.."
DATA ".....******....."
DATA ".....******....."
DATA "...*..*..*..*..."
DATA "..***.*..*.***.."
DATA "..*****..*****.."
DATA "................"
DATA ".........***...."
DATA "...***..*****..."
DATA "..*****........."
DATA "........**.**..."
DATA "..**.**..***...."
DATA "...***.........."
DATA ".......**......."
DATA "..**..****..**.."
DATA "..**.******.**.."
DATA "...**********..."
DATA ".....******....."
DATA ".....******....."
DATA "...*..*..*..*..."
DATA "..***.*..*.***.."
DATA "..*****..*****.."
DATA "................"
DATA "......***......."
DATA "...***.***......"
DATA "..*****........."
DATA "........**......"
DATA "..**.**.*......."
DATA "...***.........."
DATA ".......**......."
DATA ".**...****...**."
DATA ".**..******..**."
DATA "..************.."
DATA ".....******....."
DATA ".....******....."
DATA "...*..*..*..*..."
DATA "..***.*..*.***.."
DATA "..*****..*****.."
DATA "................"
DATA "................"
DATA "....*.***......."
DATA "...*.*****......"
DATA "................"
DATA "...*.**.**......"
DATA "....*.***......."
DATA ".............**."
DATA ".**...****...**."
DATA ".**..********..."
DATA "..*********....."
DATA ".....******....."
DATA ".....******....."
DATA "....*.*..*.*...."
DATA "...***....***..."
DATA "...****..****..."
DATA "................"
DATA "................"
DATA "....***..***...."
DATA "...****.*****..."
DATA "................"
DATA "...**.*.**.**..."
DATA "....***..***...."
DATA "................"
DATA "..**..****..**.."
DATA "..**.******.**.."
DATA "...**********..."
DATA ".....******....."
DATA ".....******....."
DATA "...*..*..*..*..."
DATA "..***.*..*.***.."
DATA "..*****..*****.."
' Наша школьная страна
' f - Герцы, t - миллисекунды
music:
DATA 1176, 250
DATA 1319, 250
DATA 1483, 250
DATA 2358, 250
DATA 2358, 250
DATA 2222, 250
DATA 2222, 250
DATA 1976, 250
DATA 1483, 250
DATA 1760, 250
DATA 1572, 375
DATA 1572, 125
DATA 1572, 250
DATA 1976, 250
DATA 1319, 500
DATA 1108, 250
DATA 1176, 250
DATA 1319, 250
DATA 2222, 250
DATA 2222, 250
DATA 1976, 250
DATA 1976, 250
DATA 1872, 250
DATA 1108, 250
DATA 1319, 250
DATA 1176, 250
DATA 1108, 250
DATA 1176, 250
DATA 1319, 250
DATA 1483, 500
DATA 1176, 250
DATA 1319, 250
DATA 1483, 250
DATA 2358, 250
DATA 2358, 250
DATA 2222, 250
DATA 2222, 250
DATA 1976, 250
DATA 1483, 250
DATA 1760, 250
DATA 1572, 375
DATA 1572, 125
DATA 1572, 250
DATA 1976, 250
DATA 1319, 500
DATA 1108, 250
DATA 1176, 250
DATA 1319, 250
DATA 2222, 250
DATA 2222, 250
DATA 1976, 250
DATA 1976, 250
DATA 1872, 250
DATA 1108, 250
DATA 1319, 250
DATA 1176, 250
DATA 1108, 250
DATA 1176, 250
DATA 1319, 250
DATA 1483, 500
DATA 1483, 500
DATA 1976, 500
DATA 1108,1000
DATA 1319, 500
DATA 1483,1500
DATA 1760, 250
DATA 1572, 250
DATA 1483, 500
DATA 1760, 250
DATA 1572, 250
DATA 1483, 500
DATA 1760, 250
DATA 1572, 250
DATA 1483,1500
DATA 1483, 500
DATA 1976, 500
DATA 1108,1000
DATA 1319, 500
DATA 1483,1500
DATA 1760, 250
DATA 1572, 250
DATA 1483, 500
DATA 1760, 250
DATA 1572, 250
DATA 1483, 500
DATA 1572, 250
DATA 1760, 250
DATA 1976,1500
DATA 1976, 250
DATA 1976, 250
DATA 2222, 500
DATA 1976, 250
DATA 1976, 250
DATA 2222, 500
DATA 1976, 250
DATA 1976, 250
DATA 2222,1000
DATA 1976, 750
DATA 1976, 250
DATA 2222, 500
DATA 1976, 250
DATA 1976, 250
DATA 2222, 500
DATA 1976, 250
DATA 1976, 250
DATA 2222,1000
DATA 1976, 750
DATA 1976, 250
DATA 1108, 500
DATA 1319, 250
DATA 1572, 250
DATA 1483, 500
DATA 1872, 250
DATA 2222, 250
DATA 1976,2000
DATA   -1,  -1
 
SUB playnote
' читаем частоту и длительность ноты
READ f, t
' конец мелодии ?
IF f < 0 THEN
  loops = loops + 1
  ' повторяем мелодию 2 раза
  IF loops < 2 THEN
    RESTORE music: READ f, t
  ELSE
  ' выход в Дос после 2 го повтора
    SLEEP 4: SCREEN 0: WIDTH 80: END
  END IF
END IF
' длительность звука в тиках таймера (18 тиков в секунду)
ti = t * 18& / 1000&
' переключение видимой видео страницы
IF loops = 0 THEN SCREEN , , page, page: page = (page + 1) AND 7
FOR i = 1 TO ti
  ' переключение видимой видео страницы
  IF loops = 1 THEN SCREEN , , page, page: page = (page + 1) AND 7
  SOUND f, 1
NEXT i
END SUB
 
SUB sprite (x, y, form, col)
y0 = form * 16
FOR j = 0 TO 15
FOR i = 0 TO 15
IF dot(i, y0 + j) <> 0 THEN
  IF j < 8 THEN c = 15 ELSE c = col
  PSET (x + i, y + j), c
END IF
NEXT i
NEXT j
END SUB

'qbasic
DEFINT A-Z
SCREEN 12
DIM a AS STRING * 1
n$ = "hny2024.pcx"
ON ERROR GOTO etrap2
OPEN n$ FOR INPUT AS #1: CLOSE #1
ON ERROR GOTO 0
OPEN n$ FOR BINARY AS #1
GOSUB pl
ON PLAY(1) GOSUB pl
PLAY ON
GET #1, LOF(1) - 768, a
OUT &H3C8, 0
FOR k = 0 TO 767: GET #1, , a: OUT &H3C9, INT(ASC(a) / 4): NEXT k
SEEK #1, 129
r = 0: d = 0
FOR j = 0 TO 239
i = 0
WHILE i < 640
GET #1, , a: r = ASC(a)
IF r < &HC0 THEN
    d = r: r = 1
ELSE
    r = r - &HC0: GET #1, , a: d = ASC(a)
END IF
FOR k = 1 TO r: PSET (i, j + j), d: PSET (i, j + j + 1), d: i = i + 1: NEXT k
WEND
NEXT j
CLOSE #1
fstop = 1
SLEEP 5
SCREEN 0
END
 
pl:
ON ERROR GOTO etrap
READ m$: PLAY m$
ON ERROR GOTO 0
RETURN
 
etrap:
IF fstop <> 0 THEN SLEEP 2: SCREEN 0: END
RESTORE: RESUME
 
etrap2:
PRINT n$; " - file not found"
SLEEP
SCREEN 0
END
 
DATA "MBL8o3AGAFB-4"
DATA "G4GFGEA2FEFDG4D4EDECF2"
DATA "FGAo4CD4o3B-4DEF+AB-2"
DATA "B-AB-GA4F4GFEGF4p4"

' freebasic
' Эта программа загружает и оживляет DirectX 3D модель (.X файл) используя OpenGL 3D engine
 
#include once "GL/gl.bi"
#include once "GL/glu.bi"
#include once "createtex.bi"
DECLARE FUNCTION LoadModel(mname$,number AS LONG) AS LONG
DECLARE SUB scalemodels
DECLARE FUNCTION LoadGLTextures() AS LONG
DECLARE FUNCTION value(a$,d$) AS SINGLE
DECLARE SUB modify(a AS SINGLE,number AS LONG)
    
DEFLNG a-z
' Длина массива для одной вершины меша
' (3 single - координаты вершины, 3 single - вектор нормали, 2 single - UV)
CONST stride=8*sizeof(SINGLE)
TYPE modeltype
avert AS ushort      ' число вершин
atri  AS ushort      ' число треугольников
pvert  AS SINGLE ptr ' указатель на данные меша
pvert0 AS SINGLE ptr ' указатель на координаты вершин
ptri  AS ushort ptr  ' указатель на треугольники
END TYPE
 
DIM SHARED model(10) AS modeltype
DIM SHARED texture(10) AS GLuint  ' текстуры
 
' всего можно нарисовать 100 фигур
DIM sc(100) AS SINGLE ' масштаб фигуры (по оси Y)
DIM AS SINGLE objy(100),objy1(100) ' координата и скорость фигуры (по оси Y)
 
DIM camerarot AS SINGLE
DIM AS SINGLE yrot,yprecess,zrot,ymod
DIM AS DOUBLE tim,tim0,timstart
 
' используйте ...,,2+1 чтобы стартовать в полном экране (не в окне)
screenres 1024,768,32,,2
 
'' ReSizeGLScene
glViewport 0, 0, 1024, 768                     '' Reset The Current Viewport
glMatrixMode GL_PROJECTION                     '' Select The Projection Matrix
glLoadIdentity                                 '' Reset The Projection Matrix
gluPerspective 45.0, 640.0/480.0, 0.1, 100.0   '' Calculate The Aspect Ratio Of The Window
glMatrixMode GL_MODELVIEW                      '' Select The Modelview Matrix
glLoadIdentity                                 '' Reset The Modelview Matrix
 
'' Загрузить текстуры
r=LoadGLTextures()
'' Загрузить меши (тело, причёска, лицо)
r=LoadModel("pop_body.x",1)
r=LoadModel("pop_hair.x",2)
r=LoadModel("pop_face.x",3)
'' масштабировать меши
scalemodels
'' установки для OpenGL
glEnable GL_TEXTURE_2D                         '' Enable Texture Mapping ( NEW )
glShadeModel GL_SMOOTH                         '' Enable Smooth Shading
'' цвет фона - светло голубой
glClearColor 0.0, 0.5, 1.0, 1.0                '' Light Blue Background
glClearDepth 1.0                               '' Depth Buffer Setup
glEnable GL_DEPTH_TEST                         '' Enables Depth Testing
glDepthFunc GL_LEQUAL                          '' The Type Of Depth Testing To Do
glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST    '' Really Nice Perspective Calculations
'   enable alphablending
glEnable GL_BLEND
glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
' освещение
DIM AS SINGLE glfLightAmbient(4) = {  1.7, 1.7, 1.7, 1.0 }
DIM AS SINGLE glfLightDiffuse(4) = {  0.3, 0.3, 0.3, 1.0 }
DIM AS SINGLE glfLightSpecular(4) ={  0.0, 0.0, 0.0, 1.0 }
DIM AS SINGLE glfLightPosition(4) ={  0.0, 0.0, -4.0, 0.0 }
DIM AS SINGLE glfLightDirection(4) ={ 0.0, 0.0, 1.0, 0.0 }
DIM AS SINGLE glfLightDirection1(4)={ 1.0 ,1.0, 1.0, 0.0 }
'glEnable (GL_LIGHTING)
glEnable (GL_LIGHT0)
glEnable (GL_LIGHT1)
 
glLightfv (GL_LIGHT0, GL_AMBIENT, @glfLightAmbient(0))
glLightfv (GL_LIGHT0, GL_DIFFUSE, @glfLightDiffuse(0))
glLightfv (GL_LIGHT0, GL_SPECULAR, @glfLightSpecular(0))
glLightfv (GL_LIGHT0, GL_SPOT_DIRECTION, @glfLightDirection(0))
 
glLightfv (GL_LIGHT1, GL_AMBIENT, @glfLightAmbient(0))
glLightfv (GL_LIGHT1, GL_DIFFUSE, @glfLightDiffuse(0))
glLightfv (GL_LIGHT1, GL_SPECULAR, @glfLightSpecular(0))
glLightfv (GL_LIGHT1, GL_SPOT_DIRECTION, @glfLightDirection1(0))
 
glLightfv (GL_LIGHT1, GL_POSITION, @glfLightPosition(0))
'glLightf(GL_LIGHT0,GL_SPOT_EXPONENT,40.0)
 
'glEnable (GL_LIGHTING)
'glEnable (GL_LIGHT0)
 
' основной цикл
DIM AS SINGLE camx, camz ' координаты камеры
onstart=-1
DO
' рестарт анимации каждые 30 секунд
IF onstart OR timer-timstart>30 THEN
    onstart=0
    tim=TIMER()
    tim0=tim
    timstart=tim
    fl=0
    camx=0
    camz=4.0
    camerarot=0
    yrot=0
    yprecess=0
    ymod=0
    zrot=0
    RANDOMIZE TIMER
    FOR i=0 TO 99:sc(i)=.9+.3*RND:objy(i)=1.0+2.0*RND:objy1(i)=.01+.02*RND:NEXT i
END IF
scenetri=0
motion=0
' анимация и управление камерой 40 раз в секунду (каждые 25 миллисекунд)
IF TIMER()-tim>.025 THEN
    tim=tim+.025
    '  стрелки двигают камеру
    IF multikey(&h48) THEN camz+=.05
    IF multikey(&h50) THEN camz-=.05
    IF multikey (&h4B) THEN camx+=.05
    IF multikey (&h4D) THEN camx-=.05
    camerarot += 0.01     '' X Axis Rotation
    yrot = yrot+0.05     '' Y Axis Rotation
    yprecess+=0.03
    ymod = ymod+0.12
    zrot += 0.01     '' Z Axis Rotation
    motion=-1
END IF
'' очистить экран
glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT      '' Clear Screen And Depth Buffer
 
''''''''''
' Углы и координаты камеры в терминах DarkBasic
glMatrixMode GL_PROJECTION                     '' Select The Projection Matrix
glLoadIdentity                                 '' Reset The Modelview Matrix
' Очень важная процедура - если её пропустить, то мы ничего не увидим
' (отрисовка с углом камеры 45 градусов, видимость Z от 0.1 до 100, длина к ширине - 640/480)
'Very important function (if we miss it, we can't see anything)
gluPerspective 45.0, 640.0/480.0, 0.1, 100.0   '' Calculate The Aspect Ratio Of The Window
' position camera
glTranslatef camx - 0.3, -0.5, camz + 0.4*SIN(camerarot)
' rotate camera
' обратите внимание, что аргументы при вращении в OpenGl - градусы,
' а аргументы sin и cos - радианы
' т е камера покачивается отн. оси Y на -3.0 до 3.0 градуса
glRotatef 3.0*SIN(camerarot),0.0, 1.0, 0.0
' вывод фигур
obj=0
FOR nobj=-1 TO 3
    obj+=1
    ' если установлен флаг motion, создать эффект падения фигуры
    IF motion THEN
        objy1(obj)-=.0006
        IF objy1(obj)<-.02 THEN objy1(obj)=-.02
        objy(obj)+=objy1(obj)
        IF objy(obj)<0 THEN
            objy(obj)=0
            objy1(obj)=-objy1(obj)*.97
        END IF
    END IF
    ' движение рук
    modify(ymod+2*obj,1)    
    ''''''
    ' Переключиться с управления положения камеры на управление моделью
    glMatrixMode GL_MODELVIEW                      '' Select The Modelview Matrix
    glLoadIdentity                                 '' Reset The Modelview Matrix
    
    ''''''
    ' разместить модель в 3D пространстве
    glTranslatef 0.2+0.3*nobj+(.3+.05*COS(yrot))*raw, 0.4+objy(obj), -6.0-1.0*SIN(nobj)
    ' вращать модель отн оси Y
    glRotatef 30.0*yprecess+60.0*SIN(yrot)+30.0*nobj,0.0, 1.0, 0.0
    ' вращать модель отн оси X
    glRotatef 5.0*SIN(yrot),1.0, 0.0, 0.0
    ' масштабировать модель отн оси Y (чтобы фигурки были разного роста)
    glScalef 1.0,sc(obj),1.0
    ' рисуем 3 меша
    FOR number=1 TO 3
        glPushMatrix
        ' эффект покачивания головы (причёска и лицо вращаются вдоль оси Z)
        IF number=2 OR number=3 THEN
            glRotatef 10.0*SIN(yrot*1.5+nobj), 0.0,0.0,1.0
        END IF
        glBindTexture GL_TEXTURE_2D, texture(number)     '' Выбрать текстуру
        ' Выбрать координаты вершин
        glEnableClientState(GL_VERTEX_ARRAY)
        glVertexPointer(3,GL_FLOAT,stride,model(number).pvert)
        ' Выбрать векторы нормалей (отключено)
        '  glEnableClientState(GL_NORMAL_ARRAY)
        '  glNormalPointer(GL_FLOAT,stride,model(number).pvert+3)
        ' Выбрать UV текстуры
        glEnableClientState(GL_TEXTURE_COORD_ARRAY)
        glTexCoordPointer(2,GL_FLOAT,stride,model(number).pvert+6)
        ntri=model(number).atri
        ' Сколько всего треугольников в сцене 
        scenetri=scenetri+ntri
        triang=ntri*3
        ' short ! Нарисовать меш из треугольников
        glDrawElements(GL_TRIANGLES,triang,GL_UNSIGNED_SHORT,model(number).ptri)
        glPopMatrix
    NEXT number ' след. меш
NEXT nobj ' след фигура
' Update screen ' Обновить экран
flip
' Подсчитать быстродействие и вывести в заголовок окна
fl=(fl+1) AND 255
IF fl=0 THEN
    fps=INT(256.0/(TIMER()-tim0)):tim0=TIMER()
    windowtitle "Scene triangles="+STR$(scenetri)+" fps="+STR$(fps)
END IF
' если нажата Esc или крестик окна мышкой, то финиш
q$=INKEY$:IF q$=CHR$(27) OR q$=CHR$(255)+CHR$(107) THEN END
LOOP ' конец основного цикла
END  ' конец основной программы, далее функции и процедуры
 
'' Load Bitmaps And Convert To Textures
'' Загрузить .BMP текстуры и преобразовать их в текстуры OpenGL
FUNCTION LoadGLTextures() AS LONG
DIM TextureImage AS ulong ptr   ' Create Storage Space For The Texture
TextureImage=imagecreate(256,256)
BLOAD exepath+"\pop_body.bmp",TextureImage
texture(1) = CreateTexture(TextureImage,256,256,TEX_MASKED+TEX_MIPMAP)
BLOAD exepath+"\pop_hair.bmp",TextureImage
texture(2) = CreateTexture(TextureImage,128,128,TEX_MASKED+TEX_MIPMAP)
BLOAD exepath+"\pop_face.bmp",TextureImage
texture(3) = CreateTexture(TextureImage,128,128,TEX_MASKED+TEX_MIPMAP)
ImageDestroy(TextureImage)
RETURN -1
END FUNCTION
 
' масштабировать меши. Модель .x была захвачена из игры, поэтому требует 
' небольшой правки
SUB scalemodels
DIM AS SINGLE ptr modeldata,modeldata0
DIM AS SINGLE ymin,ymax,xmin,xmax,zmin,zmax,x,y,z,x0,y0,z0
DIM AS SINGLE dx,dy,dz,sc,angx
DIM AS LONG cnt,i,p,p0,number
sc=.3 ' уменьшить меш до масштаба 0.3
FOR number=1 TO 3
    IF model(number).avert=0 THEN EXIT SUB
    cnt=model(number).avert
    IF model(number).pvert=0 THEN EXIT SUB
    modeldata=model(number).pvert
    modeldata0=model(number).pvert0
    FOR i=0 TO cnt -1
        p=8*i:p0=3*i
        x=modeldata[p]
        y=modeldata[p+1]-1.2
        z=modeldata[p+2]
 
        modeldata[p]=sc*x
        modeldata[p+1]=sc*y
        modeldata[p+2]=sc*z
        
        modeldata0[p0]=sc*x
        modeldata0[p0+1]=sc*y
        modeldata0[p0+2]=sc*z
    NEXT i
NEXT number
END SUB
 
' Load vertex, normals, triangles and uv data from the text file (converted from text .x 3D model)
' Загрузить вершины,нормали,треугольники и UV из файла .X
' Файл .X был доработан так:
' 1) Перевод строки LF заменён на обычный CR,LF
' 2) В начале каждого массива стоит комментарий #vert,#norm,#tri,#uv
' (это не мешает при загрузке .X файла из стандартных программ, например mview.exe)
FUNCTION LoadModel(mname$,number AS LONG) AS LONG
DIM AS LONG cnt,cvert,ctri,i,q,p,p0
DIM modeldata AS SINGLE ptr
DIM modeldata0 AS SINGLE ptr
DIM modeltri AS ushort ptr
OPEN exepath+"\"+mname$ FOR INPUT AS #1
WHILE NOT EOF(1)
LINE INPUT #1,a$
IF a$="#vert" THEN
    LINE INPUT #1,a$
    cnt=value(a$,";")
    model(number).avert=cnt
    ' Выделить память 8*4*cnt байт, где 8=3+3+2 - массив вершин, нормалей и uv,
    ' 4 - размер Single в байтах
    model(number).pvert=allocate(8*sizeof(SINGLE)*cnt)
    ' дополнительно выделить память под координаты вершин
    model(number).pvert0=allocate(3*sizeof(SINGLE)*cnt)
    modeldata=model(number).pvert
    modeldata0=model(number).pvert0
    FOR i=0 TO model(number).avert-1
        LINE INPUT #1,a$
        p=8*i:p0=3*i
        ' Правка 1 - масштабировать координаты вершин x,y - до 0.1, z - до 0.4
        ' и сдвинуть координату по z
        modeldata[p]=value(a$,";")
        modeldata0[p0]=modeldata[p]
        modeldata[p+1]=value(a$,";")
        modeldata0[p0+1]=modeldata[p+1]
        modeldata[p+2]=value(a$,";")
        modeldata0[p0+2]=modeldata[p+2]
    NEXT i
ELSEIF a$="#norm" THEN
    LINE INPUT #1,a$
    cnt=value(a$,";")
    FOR i=0 TO model(number).avert-1
        p=8*i
        LINE INPUT #1,a$
        modeldata[p+3]=value(a$,";")
        modeldata[p+4]=value(a$,";")
        modeldata[p+5]=value(a$,";")
    NEXT i
ELSEIF a$="#tri" THEN
    LINE INPUT #1,a$
    cnt=value(a$,";")
    model(number).atri=cnt
    ' Выделить память подд треугольники 6=3*2*cnt где 2 - размер ushort в байтах
    model(number).ptri=allocate(3*sizeof(ushort)*cnt)
    modeltri=model(number).ptri
    FOR i=0 TO model(number).atri-1
        q=3*i
        LINE INPUT #1,a$:unused=value(a$,";")
        modeltri[q]=value(a$,",")
        modeltri[q+1]=value(a$,",")
        modeltri[q+2]=value(a$,";")
    NEXT i
ELSEIF a$="#uv" THEN
    LINE INPUT #1,a$
    cnt=value(a$,";")
    FOR i=0 TO model(number).avert-1
        p=8*i
        LINE INPUT #1,a$
        modeldata[p+6]=value(a$,";")
        modeldata[p+7]=1.0-value(a$,";")
    NEXT i
END IF
WEND
CLOSE #1
RETURN -1
END FUNCTION
' Получить очередное число из строки (d$ символ-разделитель)
FUNCTION value(a$,d$) AS SINGLE
b$=MID$(a$,1,INSTR(a$,d$)-1):a$=MID$(a$,INSTR(a$,d$)+1)
value=VAL(b$)
END FUNCTION
 
' Простая анимация меша (движение рук)
SUB modify(a AS SINGLE,number AS LONG)
DIM modeldata AS SINGLE ptr
DIM modeldata0 AS SINGLE ptr
DIM AS SINGLE x,y,z,x0,y0,z0,xt,yt,ang,sina,cosa,sina1
DIM AS LONG p0,p,nvert,i
modeldata=model(number).pvert
modeldata0=model(number).pvert0
nvert=model(number).avert
IF modeldata=0 OR modeldata0=0 THEN EXIT SUB
ang=.3*SIN(a)+.8
sina=SIN(ang)
cosa=COS(ang)
' для всех вершин меша
FOR i=0 TO nvert-1
    ' x0,y0,z0 - координаты вершины в исходном меше
    p0=i*3:p=i*8
    x0=modeldata0[p0]
    y0=modeldata0[p0+1]
    z0=modeldata0[p0+2]
    ' если вершина относится к рукам
    IF y0>-.08 AND ABS(x0)>.04 THEN
        IF x0<0 THEN sina1=sina ELSE sina1=-sina
        IF x0<0 THEN xt=x0+.04 ELSE xt=x0-0.04
        yt=y0+.06
        x=xt*cosa-yt*sina1
        y=xt*sina1+yt*cosa
        IF x0<0 THEN x=x-.04 ELSE x=x+0.04
        y=y-.06
    ' иначе ничего не делать
    ELSE
        x=x0
        y=y0
    END IF
    ' изменить меш (z в данном примере не меняется)
    modeldata[p  ]=x
    modeldata[p+1]=y
NEXT i
END SUB