VPF::Вращение шарика - Форум программистов

welt

Дата 16.11.2005, 17:56 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 89
Регистрация: 21.5.2005
Где: UnderGround

Репутация: нет
Всего: нет

Помогите перевести на паскаль или на Делфи

Код


.386

; Die TransPunkte FUNTIONIERT!!!!!!!!!! ;)
; (c) 1996 by Daniel Vollmer


Data Segment Word Use16
Extrn DrehMatrix: DWord: 9
Extrn Vseg:Word
Extrn XOffs:Word
Extrn YOffs:Word
Extrn ZOffs:DWord
Extrn Dist:DWord
Data EndS

Code Segment DWord Use16

Assume CS: Code, DS: Data

Public LMul, LDiv, LAdd, LSub, LSqrt, LQuad, LTrunc, RotierePunkte, TransPunkte

LMul Proc Pascal Near
Arg A: DWord, B: DWord
    Mov EAX, A
    IMul B
    Shr EAX, 16
    Ret
EndP

LDiv Proc Pascal Near
Arg A: DWord, B: DWord
    Mov EAX, A
    Cdq
    Shld EDX, EAX, 16
    Shl EAX, 16
    IDiv B
    Shld EDX, EAX, 16
    Ret
EndP

LAdd Proc Pascal Near
Arg A: DWord, B: DWord
    Mov EAX, A
    Add EAX, B
    Shld EDX, EAX, 16
    Ret
EndP

LSub Proc Pascal Near
Arg A: DWord, B: DWord
    Mov EAX, A
    Sub EAX, B
    Shld EDX, EAX, 16
    Ret
EndP

LSqrt Proc Pascal Near
Arg A: DWord
    Mov EAX, A
    Or  EAX, EAX
    Jz  Sqrt_Exit
    Mov EBX, 8
    Mov ECX, EAX
    Mov EDI, EAX
Sqrt_Loop:
    Mov EAX, ECX
    Sub EDX, EDX
    Shld EDX, EAX, 16
    Shl EAX, 16
    IDiv EDI
    Cmp EAX, EDI
    Je Sqrt_Exit
    Add EAX, EDI
    Shr EAX, 1
    Mov EDI, EAX
    Dec EBX
    Jz Sqrt_Exit
    Jmp Sqrt_Loop
Sqrt_Exit:
    Shld EDX, EAX, 16
    Ret
EndP

LQuad PRoc Pascal Near
Arg A: DWord
    Mov EAX, A
    IMul EAX
    Shr EAX, 16
    Ret
EndP

LTrunc Proc PAscal Near
Arg A: DWord
    Mov AX, Word Ptr A+2
    Ret
EndP

RotierePunkte Proc Pascal Near
Arg RP_X: DWord,TR_X:DWord,Count:Word,ArrSize:Word
Local RP_X2: DWord, RP_Y2: DWord, RP_Z2: DWord
    Les BX, RP_X
    Lfs SI, TR_X
    Mov di, Count
@doitall:
    Mov EAX, ES:[BX]
    Mov ECX, EAX
    IMul DWord Ptr DrehMatrix
    Shrd EAX, EDX, 16
    Mov RP_X2, EAX

    Mov EAX, ECX
    IMul DWord Ptr DrehMatrix+12
    Shrd EAX, EDX, 16
    Mov RP_Y2, EAX

    Mov EAX, ECX
    IMul DWord Ptr DrehMatrix+24
    Shrd EAX, EDX, 16
    Mov RP_Z2, EAX

    Mov EAX, ES:[BX+4]
    Mov ECX, EAX
    IMul DWord Ptr DrehMatrix+4
    Shrd EAX, EDX, 16
    Add RP_X2, EAX

    Mov EAX, ECX
    IMul DWord Ptr DrehMatrix+16
    Shrd EAX, EDX, 16
    Add RP_Y2, EAX

    Mov EAX, ECX
    IMul DWord Ptr DrehMatrix+28
    Shrd EAX, EDX, 16
    Add RP_Z2, EAX

    Mov EAX, ES:[BX+8]
    Mov ECX, EAX
    IMul DWord Ptr DrehMatrix+8
    Shrd EAX, EDX, 16
    Add EAX, RP_X2
    Mov ES:[SI], EAX

    Mov EAX, ECX
    IMul DWord Ptr DrehMatrix+20
    Shrd EAX, EDX, 16
    Add EAX, RP_Y2
    Mov ES:[SI+4], EAX

    Mov EAX, ECX
    IMul DWord Ptr DrehMatrix+32
    Shrd EAX, EDX, 16
    Add EAX, RP_Z2
    Mov ES:[SI+8], EAX

    Add BX,ArrSize
    Add SI,ArrSize
    Dec DI
    Jnz @doitall
    Ret

RotierePunkte EndP

TransPunkte Proc Pascal Near
Arg Obj:DWord, Count:Word
;    for c1 := 1 to GeoMaxP do begin
;        te1 := LAdd(Temp[c1].z,ZOffs);
;        Coords[c1].X := ltrunc(Ldiv(Temp[c1].x shl 7,te1))+XOffs;
;        Coords[c1].Y := ltrunc(LDiv(Temp[c1].y shl 7,te1))+YOffs;
;    end;
     Les        bx,Obj
     Mov        cx,Count
@transthem:
     mov        edi,es:[bx+8]
     add        edi,ZOffs
     mov        eax,es:[bx]
     cdq
     imul       eax,dist
     idiv       edi
     add        ax,XOffs
     mov        es:[bx+12],ax
     mov        eax,es:[bx+4]
     cdq
     imul       eax,dist
     idiv       edi
     add        ax,YOffs
     mov        es:[bx+14],ax
     add        bx,28
     dec        cx
     jnz        @transthem
     ret

TransPunkte endp

Code EndS

End

Alexeis

Дата 17.11.2005, 11:12 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Вот пример преобразования первой
функции

Код


Function LMul(A: DWord; B: DWord) : DWord;
asm
  Mov EAX, A
  IMul B
  Shr EAX, 16
  mov Result, EAX  //Результат
  Ret
end;

ps Код asm лучше не трогать - так как он работает быстрее

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Штабс

Дата 6.12.2005, 10:49 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

117 строка кода
Les bx,Obj

А на этом не ругается?
вы под чем работаете?
в ДОСе?

я к примеру не могу обойти в виндах это
сам ищу приемлемую замену этой команде

p0s0l

Дата 7.12.2005, 20:37 (ссылка)

(нет голосов)

Загрузка ...

Г-н Посол

Профиль
Группа: Экс. модератор
Сообщений: 3668
Регистрация: 13.7.2003
Где: 58°38' с.ш. 4 9°41' в.д.

Репутация: 58
Всего: 112

Цитата

А на этом не ругается?
вы под чем работаете?
в ДОСе?

я к примеру не могу обойти в виндах это
сам ищу приемлемую замену этой команде

Под виндой это не имеет смысла... Просто делай lea ebx,...
(но всё-таки переводить ДОС-код в Win-код нужно осмысленно, а не покомандно...)

--------------------

С уважением, г-н Посол.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »