                  IF 0
                  >PART 'StartPrg'
* Routinen um vom STE/Falcon ber die JoyPad-Ports ein Programm
* an den Jaguar zu schicken
*
* (c) 1994 Bastian Schick
* Version 4  -  29.5.95


DestAdr           EQU $4000

                  pea     doit(pc)
                  move.w  #38,-(sp)
                  trap    #14
                  addq.l  #6,sp
                  clr.w   -(sp)
                  trap    #1


doit:             move.l  $04BA.w,-(sp)
                  sf      $FFFF9203.w
                  lea     jag_prg(pc),a0
                  lea     DestAdr.w,a1
                  move.l  #jag_end-jag_prg,d0
                  bsr.s   SendPRG2Jaggy
                  move.l  $04BA.w,d7
                  sub.l   (sp)+,d7
                  trap    #1
                  rts
SendPRG2Jaggy:    lea     jag_prg(pc),a0
                  move.l  #(jag_end-jag_prg)>>2,d2
                  move.l  #DestAdr,d1
                  bsr     WriteDumpL
                  beq.s   error_sp
                  move.w  #StartSub,d0
                  bsr.s   SendWord_STE
                  beq.s   error_sp
                  move.l  #DestAdr,d0
                  bsr     SendLong_STE
error_sp:         rts
;-----------------
Print:            movem.l d0-d2/a0-a2,-(sp)
                  move.l  7*4(sp),-(sp)
                  move.w  #9,-(sp)
                  trap    #1
                  addq.l  #6,sp
                  movem.l (sp)+,d0-d2/a0-a2
                  move.l  (sp)+,(sp)
                  rts
*************************
* transmission-routines *
*************************
StartSub          EQU $83
WriteLongs        EQU $88
FirstTimeOutInit  EQU 120
TimeOutInit       EQU 70

SendRegs          REG d1-d3/d6-a2
SendWord_STE:     movem.l SendRegs,-(sp)
                  lea     $04BA.w,a2
                  moveq   #FirstTimeOutInit,d7
                  add.l   (a2),d7
                  lea     $FFFF9201,a0

SendWord_STE2:    btst    #3,(a0)
                  bne.s   SendWord_STE3
                  cmp.l   (a2),d7
                  bhi.s   SendWord_STE2
                  moveq   #0,d0
                  movem.l (sp)+,SendRegs
                  rts
SendWord_STE3:    lea     2(a0),a1
                  rol.w   #8,d0
                  moveq   #$10,d2
                  moveq   #3,d3
                  moveq   #7,d6
SendWord_STE4:    moveq   #$C0,d1
                  and.w   d0,d1
                  rol.w   #2,d0
                  or.b    d2,d1

                  moveq   #TimeOutInit,d7
                  add.l   (a2),d7
SendWord_STE5:    btst    #3,(a0)
                  bne.s   SendWord_STE6    ; auf BUSY high warten
                  cmp.l   (a2),d7
                  bhi.s   SendWord_STE5
                  bra     TimeOut2

SendWord_STE6:    move.b  d1,(a1)          ; Bit mit STROBE
                  moveq   #TimeOutInit,d7
                  add.l   (a2),d7
SendWord_STE7:    btst    #3,(a0)
                  beq.s   SendWord_STE8    ; auf BUSY low warten
                  cmp.l   (a2),d7
                  bhi.s   SendWord_STE7
                  bra     TimeOut2
SendWord_STE8:    clr.b   (a1)             ; STROBE low

                  dbra    d6,SendWord_STE4
                  moveq   #-1,d0
                  movem.l (sp)+,SendRegs
                  rts
** SendLong_STE **
SendLong_STE:     movem.l SendRegs,-(sp)
                  lea     $FFFF9201,a0
                  lea     2(a0),a1
                  lea     $04BA.w,a2
                  moveq   #FirstTimeOutInit,d7
                  add.l   (a2),d7

SendLong_STE1:    btst    #3,(a0)
                  bne.s   SendLong_STE2    ; auf BUSY high warten
                  cmp.l   (a2),d7
                  bhi.s   SendLong_STE1
                  moveq   #0,d0
                  movem.l (sp)+,SendRegs
                  rts

SendLong_STE2:    rol.l   #3,d0
                  moveq   #$10,d2
                  moveq   #3,d3
                  moveq   #9,d6            ; 10*3 Bit
SendLong_STE3:    moveq   #$E0,d1
                  and.w   d0,d1
                  rol.l   #3,d0
                  or.b    d2,d1

                  moveq   #TimeOutInit,d7
                  add.l   (a2),d7
SendLong_STE4:    btst    #3,(a0)
                  bne.s   SendLong_STE5    ; auf BUSY high warten
                  cmp.l   (a2),d7
                  bhi.s   SendLong_STE4
                  bra     TimeOut2
SendLong_STE5:    move.b  d1,(a1)          ; Bit mit STROBE
                  moveq   #TimeOutInit,d7
                  add.l   (a2),d7
SendLong_STE6:    btst    d3,(a0)
                  beq.s   SendLong_STE7
                  cmp.l   (a2),d7
                  bhi.s   SendLong_STE6
                  bra     TimeOut2         ; auf Busy low warten
SendLong_STE7:    sf      (a1)             ; STROBE low
                  dbra    d6,SendLong_STE3

                  moveq   #$C0,d1
                  and.w   d0,d1
                  or.b    d2,d1

                  moveq   #TimeOutInit,d7
                  add.l   (a2),d7
SendLong_STE8:    btst    #3,(a0)
                  bne.s   SendLong_STE9    ; auf BUSY high warten
                  cmp.l   (a2),d7
                  bhi.s   SendLong_STE8
                  bra     TimeOut2
SendLong_STE9:    move.b  d1,(a1)          ; Bit mit STROBE
                  moveq   #TimeOutInit,d7
                  add.l   (a2),d7
SendLong_STE10:   btst    d3,(a0)
                  beq.s   SendLong_STE11
                  cmp.l   (a2),d7
                  bhi.s   SendLong_STE10
                  bra     TimeOut2         ; auf Busy low warten
SendLong_STE11:   sf      (a1)             ; STROBE low

                  moveq   #-1,d0
                  movem.l (sp)+,SendRegs
                  rts
*****************
** GetWord_STE **
*****************
GetWord_STE:      movem.l SendRegs,-(sp)
                  moveq   #FirstTimeOutInit,d7
                  add.l   $04BA.w,d7
                  lea     $FFFF9201,a0
GetWord_STE1:     btst    #3,(a0)
                  beq.s   GetWord_STE2
                  cmp.l   $04BA.w,d7
                  bhi.s   GetWord_STE1

                  moveq   #0,d0
                  movem.l (sp)+,SendRegs
                  rts

GetWord_STE2:     lea     2(a0),a1
                  moveq   #0,d0
                  moveq   #0,d2

                  moveq   #7,d6
GetWord_STE3:     st      (a1)             ; /Busy high
                  bsr     _WaitStrobeHigh
                  move.b  (a1),d1
                  sf      (a1)             ; /Busy low
                  add.b   d1,d1
                  roxl.w  #1,d0
                  add.b   d1,d1
                  roxl.w  #1,d0
                  bsr     _WaitStrobeLow
                  dbra    d6,GetWord_STE3
                  moveq   #-1,d1
                  movem.l (sp)+,SendRegs
                  rts
*****************
** GetLong_STE **
*****************
GetLong_STE:      movem.l SendRegs,-(sp)
                  lea     $04BA.w,a2
                  moveq   #20,d7
                  add.l   (a2),d7
                  lea     $FFFF9201,a0
                  sf      2(a0)
GetLong_STE1:     btst    #3,(a0)
                  beq.s   GetLong_STE2
                  cmp.l   (a2),d7
                  bhi.s   GetLong_STE1
                  sf      2(a0)
                  moveq   #0,d0
                  movem.l (sp)+,SendRegs
                  rts

GetLong_STE2:     lea     2(a0),a1
                  moveq   #0,d0
                  moveq   #0,d2
                  moveq   #9,d6
GetLong_STE3:     st      (a1)             ; Busy high
                  moveq   #TimeOutInit,d7
                  add.l   (a2),d7
GetLong_STE6:     btst    #3,(a0)
                  bne.s   GetLong_STE7
                  cmp.l   (a2),d7
                  bhi.s   GetLong_STE6
                  bra.s   TimeOut2
GetLong_STE7:     moveq   #$E0,d1
                  and.b   (a1),d1
                  sf      (a1)             ; Busy low
                  rol.l   #3,d0
                  or.b    d1,d0

                  moveq   #TimeOutInit,d7
                  add.l   (a2),d7
GetLong_STE8:     btst    #3,(a0)
                  beq.s   GetLong_STE9
                  cmp.l   (a2),d7
                  bhi.s   GetLong_STE8
                  bra.s   TimeOut2
GetLong_STE9:     dbra    d6,GetLong_STE3

                  st      (a1)
                  moveq   #TimeOutInit,d7
                  add.l   (a2),d7
GetLong_STE10:    btst    #3,(a0)
                  bne.s   GetLong_STE11
                  cmp.l   (a2),d7
                  bhi.s   GetLong_STE10
                  bra.s   TimeOut2

GetLong_STE11:    moveq   #$C0,d1
                  and.b   (a1),d1
                  sf      (a1)             ; Busy low
                  rol.l   #3,d0
                  or.b    d1,d0
                  rol.l   #1,d0

                  moveq   #TimeOutInit,d7
                  add.l   (a2),d7
GetLong_STE12:    btst    #3,(a0)
                  beq.s   GetLong_STE13
                  cmp.l   (a2),d7
                  bhi.s   GetLong_STE12
                  bra.s   TimeOut2
GetLong_STE13:    moveq   #-1,d1
                  movem.l (sp)+,SendRegs
                  rts
*****************
_WaitStrobeHigh:  moveq   #60,d7
                  add.l   $04BA.w,d7
_wait0_sw:        btst    #3,(a0)          ; 12
                  bne.s   _ok_wbh          ;  8    auf BUSY high warten
                  cmp.l   $04BA.w,d7
                  bhi.s   _wait0_sw
                  bra.s   TimeOut
_ok_wbh:          rts
******************
_WaitStrobeLow:   moveq   #60,d7
                  add.l   $04BA.w,d7
_wait_bl:         btst    #3,(a0)          ; 12
                  beq.s   _ok_wbl          ;  8    auf BUSY high warten
                  cmp.l   $04BA.w,d7
                  bhi.s   _wait_bl
******************
TimeOut:          addq.l  #4,sp
TimeOut2:         movem.l (sp)+,d1-d3/d6-a1
                  sf      $FFFF9203.w
                  pea     timeout(pc)
                  bsr     Print
                  moveq   #0,d0
_ok_wbl:          rts
timeout:          DC.B "TimeOut",13,10,0
                  EVEN
******************
* In D1,D2,A0
******************
WriteDumpL:       movem.l d0-d2/a0-a2,-(sp)
                  sf      $FFFF9203.w

again_wdl:        move.w  #WriteLongs,d0
                  bsr     SendWord_STE     ; Commando
                  beq.s   exit_wdl

                  move.l  d1,d0
                  bsr     SendLong_STE     ; Start-Adress
                  beq.s   exit_wdl

                  move.l  d2,d0
                  bsr     SendLong_STE     ; Anzahl der Lang-Worte
                  beq.s   exit_wdl

                  sf      $FFFF9203.w

wait_wdl:         bsr     GetWord_STE
                  beq.s   exit_wdl1
                  cmp.w   #WriteLongs,d0
                  bne.s   exit_wdl

                  moveq   #0,d3
loop_wdl:         move.l  (a0)+,d0
                  move.l  d0,d1

                  eor.l   d3,d1
                  add.l   d1,d3

                  bsr     SendLong_STE
                  beq.s   exit_wdl

                  dbra    d2,loop_wdl
                  sub.l   #$010000,d2
                  bpl.s   loop_wdl
                  bsr     GetLong_STE
                  cmp.l   d0,d3
                  bne.s   error_wdl

                  moveq   #-1,d0
                  movem.l (sp)+,d0-d2/a0-a2
                  rts
exit_wdl1:        pea     timeout1(pc)
                  bra.s   cont_wdl

exit_wdl:         pea     timeout(pc)
                  bra.s   cont_wdl
error_wdl:        pea     WriteDumpErr(pc)
cont_wdl:         bsr     Print
                  moveq   #0,d0
                  movem.l (sp)+,d0-d2/a0-a2
                  rts
timeout1:         DC.B "WriteDumpL-TimeOut",13,10,0
WriteDumpErr:     DC.B "Error in transmission !",13,10,0
                  EVEN

                  ENDPART
                  ENDC
* JAG_BALL
* geschrieben : 6.8.94
* letzte nderung : 15.10.96/24.09.95/21.10.94/29.8.94/22.8.94/8.8.94/7.8.94
*
* (c) 1994 Bastian Schick
*
* Steuerung :
* Pfeil hoch + ABC => XYZ-Add +1
* Pfeil runter + ABC => XYZ-Add -1
* 1/2/3 => XYZ-Add != XYZ-Add
* 4/5/6 => XYZ-Add = 0
* 0     => X-Add = Y-Add = Z-Add = 0
* Option => alles auf Null

BITMAP            EQU 1                    ; 1 = Bitmap darstellen
COLORMAP          EQU 1                    ; 1 = Farben darstellen
MMULT             EQU 1

DEBUG             EQU 0


TextWidth         EQU 2                    ; 2*8 Bytes
TextHeight        EQU 24
TWB               EQU TextWidth*8

HiRes             EQU 0
screen_size       EQU 320*284
screen            EQU $100000
screen1           EQU $100008
z_buffer          EQU $100010
TextScreen        EQU screen-TWB*TextHeight
vars              EQU $050000
max_y             EQU 240

                  OPT P+

max_points        EQU 10000

                  BASE A6,vars
                  PATH 'E:\BJL\JAG_BALL\'

jag_prg:
start:
                  >PART 'INIT0'
* created 24.09.95
* (c) Bastian Schick
*
* setup OP,GPU,DSP,CPU to a defined state
* OP = STOP (at $0)
* DSP,GPU : big-endian,stopped,IRQs disabled
* dummy irq
* inits SP to $1000
* stops PIT and JPIT1 & 2
* 68k-SR set to $2000
* CPU-IRQs disabled
* CPU registers are cleared (for debug purposes)
;-----------------
;--    INIT     --
INIT:             move    #$2700,sr
                  lea     $1000.w,sp
                  lea     $F00000,a0
                  move.l  #$070007,d0      ; big endian
                  move.l  d0,$210C(a0)
                  move.l  d0,$F1A10C
                  moveq   #0,d0
                  move.l  d0,$2114(a0)     ; stop gpu
                  move.l  d0,$F1A114       ; stop dsp
                  move.l  d0,$2100(a0)     ; disable GPU-IRQs
; disable DSP-IRQs
                  move.l  #%10001111100000000,$F1A100
                  move.l  #%111111<<8,$F10020 ; clear and disable IRQs

                  move.l  d0,0.w
                  moveq   #4,d0
                  move.l  d0,4.w
                  moveq   #0,d0
                  move.l  d0,$20(a0)       ; set OP to STOP-OBJECT
                  move.w  d0,$26(a0)       ; clear OP-Flag
                  move.l  d0,$2A(a0)       ; border black
                  move.w  d0,$56(a0)       ; set CRY mode to color/not BW
                  move.w  d0,$58(a0)       ; background black
                  move.l  d0,$50(a0)       ; stop PIT
                  move.l  d0,$F10000       ; stop JPIT1
                  move.l  d0,$F10004       ; stop JPIT2
                  move.l  #$1F00<<16,$E0(a0) ; clear pending irqs
                  move.w  #$7FFF,$4E(a0)   ; no VI
                  lea     dummy_irq(pc),a0
                  move.l  a0,$0100.w
                  bra.s   INIT1
dummy_irq:        move.l  #$1F00<<16,$F000E0
                  rte
INIT1:            moveq   #0,d0
                  moveq   #0,d1
                  moveq   #0,d2
                  moveq   #0,d3
                  moveq   #0,d4
                  moveq   #0,d5
                  moveq   #0,d6
                  moveq   #0,d7
                  movea.l d0,a0
                  movea.l d0,a1
                  movea.l d0,a2
                  movea.l d0,a3
                  movea.l d0,a4
                  movea.l d0,a5
                  movea.l d0,a6
                  move    a0,usp
;-----------------
                  ENDPART
                  >PART 'init'
                  move    #$2700,sr
                  lea     $3FFC,sp
                  lea     vars,a6
                  bsr     InitTimer
                  bsr     VideoInit
                  bsr     InitTxtScreen
                  bsr     InitOP
;                  bsr     InitCLUT
                  bsr     InitGPU

                  clr.l   points(a6)
                  lea     normal+8(a6),a0
;                  adda.l  #jag_end-bild,a0
                  adda.l  #184576,a0
                  move.l  a0,d0
                  addq.l  #7,d0
                  and.w   #$FFF8,d0
                  move.l  d0,_normal(a6)   ; 8er-Adresse
                  movea.l d0,a2
                  add.l   #max_points*8,d0
                  move.l  d0,gedreht0(a6)
                  add.l   #max_points*12,d0
                  movea.l d0,a4
                  move.l  d0,color(a6)
                  add.l   #max_points*2,d0

                  move.w  #100,radius(a6)
                  lea     screen+8,a5
                  move.l  #screen,phys(a6)

                  bsr     cls
                  bsr     swap
                  bsr     cls
                  bsr     swap

                  bsr     xaxe
                  bsr     yaxe
                  bsr     zaxe
                  IF COLORMAP
                  bsr     ColorMap
                  ENDC
                  IF BITMAP
                  bsr     MakeBitMap
                  ENDC
                  bsr     kugel
                  move.l  points(a6),d0
                  clr.l   Cursor(a6)
                  bsr     PrintDEZ
                  ENDPART
                  >PART 'main'
                  moveq   #0,d0
                  move.l  d0,xadd(a6)
                  clr.l   yadd(a6)
                  clr.l   zadd(a6)
                  move.l  #0,x(a6)
                  move.l  #0,y(a6)
                  move.l  #0,z(a6)
lo0:              move.w  #-1,$F10002      ; Timer starten
                  move.l  #10000,last(a6)
lo:
                  bsr     swap
                  bsr     cls
                  movem.l x(a6),d0-d2
                  bsr     DoGPU
                  moveq   #-1,d1
                  sub.w   $F10038,d1
;                  bsr     swap
                  move.w  #-1,$F10002
                  move.l  #10000,d0
                  ext.l   d1
                  divu    d1,d0
                  ext.l   d0               ; Frames/s
                  cmp.l   last(a6),d0
                  bhs.s   ok
                  move.l  d0,last(a6)
                  move.l  #TWB*16,Cursor(a6)
                  bsr     PrintDEZ

ok:               move.l  #TWB*8,Cursor(a6)
                  bsr     PrintDEZ

                  movem.l x(a6),d0-d2
                  movem.l xadd(a6),d5-d7
                  add.l   d5,d0
                  add.l   d6,d1
                  add.l   d7,d2
                  moveq   #$7F,d3
                  and.l   d3,d0
                  and.l   d3,d1
                  and.l   d3,d2
                  movem.l d0-d2,x(a6)
                  bsr     GetJoyPad1
                  move.l  joy_pad+4(a6),d0
                  beq.s   lo
                  btst    #28,d0
                  beq.s   no_reset
                  illegal
                  bra     lo0
no_reset:
                  ENDPART
                  >PART 'joy'
                  btst    #28,d0           ; PAUSE
                  beq.s   no_break
                  illegal
                  nop
                  bra     lo0

no_break:         btst    #29,d0           ; "A"
                  beq.s   no_A
                  btst    #20,d0           ; hoch
                  beq.s   *+2
                  subq.l  #1,d5
                  btst    #21,d0
                  beq.s   cont_joy
                  addq.l  #1,d5
                  bra.s   cont_joy
no_A:             btst    #25,d0           ; "B"
                  beq.s   no_B
                  btst    #20,d0           ; hoch
                  beq.s   *+2
                  subq.l  #1,d6
                  btst    #21,d0
                  beq.s   cont_joy
                  addq.l  #1,d6
                  bra.s   cont_joy
no_B:             btst    #13,d0           ; "C"
                  beq.s   cont_joy
                  btst    #20,d0           ; hoch
                  beq.s   *+2
                  subq.l  #1,d7
                  btst    #21,d0
                  beq.s   cont_joy
                  addq.l  #1,d7
cont_joy:         btst    #4,d0            ; "0"
                  beq.s   no_0
                  moveq   #0,d5
                  moveq   #0,d6
                  moveq   #0,d7
no_0:             btst    #19,d0           ; "1"
                  beq.s   *+2
                  neg.l   d5
                  btst    #7,d0            ; "2"
                  beq.s   *+2
                  neg.l   d6
                  btst    #3,d0            ; "3"
                  beq.s   *+2
                  neg.l   d7
                  btst    #18,d0           ; "4"
                  beq.s   *+2
                  moveq   #0,d5
                  btst    #6,d0            ; "5"
                  beq.s   *+2
                  moveq   #0,d6
                  btst    #2,d0            ; "6"
                  beq.s   *+2
                  moveq   #0,d7

                  btst    #9,d0
                  beq.s   no_opt
                  moveq   #0,d5
                  moveq   #0,d6
                  moveq   #0,d7
                  movem.l d5-d7,x(a6)
no_opt:           movem.l d5-d7,xadd(a6)
                  bra     lo
exit:             ENDPART
                  >PART 'InitCLUT'
InitCLUT:         move.w  #255,d0
                  move.w  #$0800,d1        ; blau
                  lea     $F00400,a0
loop_iC:          move.w  d1,(a0)+
                  addq.w  #$01,d1
                  dbra    d0,loop_iC
                  move.l  #$F0FF,$F00400
                  rts
                  ENDPART
                  >PART 'InitTimer'
InitTimer:        move.w  #26590,$F10000
                  move.w  #-1,$F10002
                  clr.w   $F10020
                  rts
                  ENDPART
*******************
* Init- und Hilfsroutine fr den Bildschirm
* (c) 1994 Bastian Schick
**************************
* Handler fr POL (Pseudo-Objekt-Liste)
*
                  >PART 'Befehls-Codes'
OBJ_DISABLE       EQU 0
OBJ_ENABLE        EQU 1

OBJ_ADD           EQU $10
OBJ_KILL          EQU $11
                  ENDPART
                  >PART 'd0=AddPObject(*POL,type,...)'
* AddPseudoObject
* IN : A0  Zeiger auf POL
*      D0  Typ 0..4
*---------------------------------
* Type 0 and Type 1
*      D1.hi/.lo  Xpos/Ypos
*      D2         Height
*      D3.hi/.lo  Pitch/BpP
*      D4.hi/.lo  DWidth/IWidth
*      D5.hi/.lo  FirstPel/Cindex
*      D6         Flags
*      A1         Data
* Type 1 (SBM) only
*      D7.l       Size (xxrrvvhh)
*---------------------------------
* Type 2 (GPU)
*      D1         Ypos
*      D2.l       data.hi
*      D3.l       data.lo
*---------------------------------
* Type 3 (BRANCH)
*      D1         Ypos
*      D2         Condition
*      D3         Link D3>0 => forward
*---------------------------------
* Type 4 (STOP)
*      D1         Interrupt (D1<>0)
*      D2.l       data.hi
*      D3.l       data.lo
*---------------------------------
*---------------------------------
* Out : D0        =0 => Error
*       A0        New POL-Ptr
*---------------------------------
AddPObject:       cmp.w   #4,d0
                  bhi.s   AddPObject4
                  move.w  d0,(a0)+         ; Type Eintragen
                  cmp.w   #1,d0
                  bhi.s   AddPObject1
                  move.w  #obj_bm_len,(a0)
                  subq.w  #1,d0
                  bmi.s   *+4
                  move.w  #obj_sc_len,(a0)
                  addq.l  #2,a0
                  move.l  a1,(a0)+         ; Data
                  move.l  d1,(a0)+         ; Xpos/Ypos
                  move.w  d2,(a0)+         ; Height
                  move.w  #1,(a0)+         ; Link
                  move.b  d3,(a0)+         ; BpP
                  swap    d3
                  move.b  d3,(a0)+         ; Pitch
                  swap    d3
                  move.l  d4,(a0)+         ; Dwidth/Iwidth
                  move.b  d5,(a0)+         ; Cindex
                  move.b  d6,(a0)+         ; Flags
                  swap    d5
                  move.w  d5,(a0)+         ; FirstPel
                  swap    d5
                  tst.w   d0
                  bmi.s   AddPObject0
                  move.l  d7,(a0)+         ; xx;hscale;vscale;rem
AddPObject0:      moveq   #-1,d0
                  rts
AddPObject1:      subq.w  #2,d0            ; GPU ?
                  bne.s   AddPObject2
                  move.w  #obj_gp_len,(a0)+
                  move.w  d1,(a0)+
                  move.w  #1,(a0)+
                  move.l  d2,(a0)+
                  move.l  d3,(a0)+
                  moveq   #-1,d0
                  rts
AddPObject2:      subq.w  #1,d0            ; Branch
                  bne.s   AddPObject3
                  move.w  #obj_br_len,(a0)+
                  movem.w d1-d3,(a0)
                  addq.l  #6,a0
                  move.w  #1,(a0)+
                  moveq   #-1,d0
                  rts
AddPObject3:      move.w  #obj_st_len,(a0)+
                  move.w  d1,(a0)+
                  move.l  d2,(a0)+
                  move.l  d3,(a0)+
                  moveq   #-1,d0
                  rts
AddPObject4:      moveq   #0,d0
                  rts
                  ENDPART
                  >PART 'struct object'
NEXT_OBJ          EQU 1
***************************************
* BitMap oder Scaled BitMap - Objekte *
***************************************
                  RSRESET
obj_bm_type:      RS.W 1                   ; Type
obj_bm_l:         RS.W 1                   ; Gre des Objektes (fr MakeOBL)
obj_bm_data:      RS.L 1                   ; Data
obj_bm_x:         RS.W 1                   ; X
obj_bm_y:         RS.W 1                   ; Y pos in Halbzeilen
obj_bm_height:    RS.W 1                   ; Hhe ODER cc bei BRANCH OBJECT
obj_bm_link:      RS.W 1                   ; Abstand zum Nchsten Objekt in Objekten
obj_bm_bits:      RS.B 1                   ; Bits pro Pixel
obj_bm_pitch:     RS.B 1                   ; Pitch
obj_bm_dwidth:    RS.W 1                   ; Breite in Phrases
obj_bm_iwidth:    RS.W 1                   ; Bildbreite (sichtbar)
obj_bm_cindex:    RS.B 1                   ; Farb-Offset
obj_bm_flags:     RS.B 1                   ; Flags
obj_bm_firstpx:   RS.W 1                   ; FirstPixel
obj_bm_len        EQU ^^RSCOUNT
obj_dummy1:       RS.B 1
obj_sc_rem:       RS.B 1
obj_sc_vscale:    RS.B 1
obj_sc_hscale:    RS.B 1                   ; Ergnzungen fr Scaled BitMap
obj_sc_len        EQU ^^RSCOUNT

**************
* GPU-Object *
**************
                  RSRESET
obj_gp_type:      RS.W 1
obj_gp_l:         RS.W 1                   ; Gre des Objektes (fr MakeOBL)
obj_gp_y:         RS.W 1
obj_gp_data1:     RS.L 1
obj_gp_data2:     RS.L 1
obj_gp_link:      RS.W 1

obj_gp_len        EQU ^^RSCOUNT
*****************
* Branch-Object *
*****************
                  RSRESET
obj_br_type:      RS.W 1
obj_br_l:         RS.W 1                   ; Gre des Objektes (fr MakeOBL)
obj_br_y:         RS.W 1
obj_br_cc:        RS.W 1                   ; Bedingung
obj_br_link:      RS.W 2
obj_br_len        EQU ^^RSCOUNT
***************
* Stop-Object *
***************
                  RSRESET
obj_st_type:      RS.W 1
obj_st_l:         RS.W 1
obj_st_int:       RS.W 1
obj_st_data1:     RS.L 1
obj_st_data2:     RS.L 1
obj_st_len        EQU ^^RSCOUNT
                  ENDPART
                  >PART 'MakeOBL'
MakeOBL:          movem.l d0-a4,-(sp)

                  move.l  #$FF000000,d4

                  lea     obj_list(a6),a0
                  lea     obj_list(a6),a1
                  lea     (a1),a4          ; start merken
                  moveq   #0,d7            ; object counter

                  lea     Objekte(pc),a2   ; source
loop_mo:          lea     (a2),a3          ; Ptr auf akt. Objekt retten
                  movem.w (a2)+,d1/d5      ; Type
                  tst.w   d1
                  bpl.s   ok_mo
                  cmp.w   #$AFFE,d1
                  beq     exit_mo
                  lea     -4(a2,d5.w),a2
                  bra.s   loop_mo

ok_mo:            addq.w  #1,d7
                  and.w   #7,d1
                  ext.l   d1
                  move.w  d1,d0
                  subq.w  #2,d0
                  bmi     bm_sc_mo
                  beq     gpu_mo           ; 2=GPU-Object
                  subq.w  #2,d0
                  bmi.s   branch_mo        ; 3=Branch Object
* Stop-Objekt erzeugen
                  moveq   #1,d0
                  and.w   (a2)+,d0
                  lsl.w   #3,d0
                  or.w    d0,d1            ; Interrupt Flag
                  movem.l (a2)+,d0/d2

                  lsl.l   #4,d2
                  or.l    d2,d1
                  move.l  d0,(a0)+
                  move.l  d1,(a0)+
                  lea     24(a0),a0
                  lea     32(a1),a1
                  bra.s   loop_mo
* branch_object
branch_mo:        move.w  #$07FF,d0
                  and.w   (a2)+,d0
                  lsl.w   #3,d0
                  or.w    d0,d1            ; Ypos
                  moveq   #7,d0
                  and.w   (a2)+,d0
                  swap    d0
                  lsr.l   #2,d0
                  or.l    d0,d1            ; CC

                  move.l  a1,d3            ; akt. Pos merken
                  move.w  (a2)+,d0         ; nchstes Objekt falls CC true
                  bpl.s   ok_bra_mo
                  neg.w   d0
                  move.l  a4,d3            ; sonst absolute
ok_bra_mo:        asl.w   #5,d0            ; * 32
                  ext.l   d0
                  add.l   d3,d0
                  lsr.l   #3,d0
                  ror.l   #8,d0
                  move.l  d0,d3
                  and.l   d4,d0
                  or.l    d0,d1            ; Link (24..31)
                  move.l  d3,d0
                  and.l   #$FFFFFF,d0
                  move.l  d0,(a0)+
                  move.l  d1,(a0)+

                  move.w  #($07FF<<3)|3,d1 ; Branch Always
                  ext.l   d1
                  move.w  (a2)+,d0         ; nchstes Objekt
                  asl.w   #5,d0            ; * 32
                  ext.l   d0
                  add.l   a1,d0
                  lsr.l   #3,d0
                  ror.l   #8,d0
                  move.l  d0,d3
                  and.l   d4,d0
                  or.l    d0,d1            ; Link (24..31)
                  move.l  d3,d0
                  and.l   #$FFFFFF,d0
                  move.l  d0,(a0)+
                  move.l  d1,(a0)+
                  lea     16(a0),a0
                  lea     32(a1),a1
                  bra     loop_mo
* GPU Object
gpu_mo:           move.w  #$03FF,d0
                  and.w   (a2)+,d0
                  lsl.w   #3,d0
                  or.w    d0,d1
                  movem.l (a2)+,d0/d2
                  swap    d2
                  lsr.w   #3,d2
                  and.w   #$E000,d2
                  or.l    d2,d1
                  move.l  d0,(a0)+
                  move.l  d1,(a0)+

                  move.w  #($07FF<<3)|3,d1 ; Branch Always
                  ext.l   d1
                  move.w  (a2)+,d0         ; nchstes Objekt
                  lsl.w   #5,d0            ; * 32
                  ext.l   d0
                  add.l   a1,d0
                  lsr.l   #3,d0
                  ror.l   #8,d0
                  move.l  d0,d3
                  and.l   d4,d0
                  or.l    d0,d1            ; Link (24..31)
                  move.l  d3,d0
                  and.l   #$FFFFFF,d0
                  move.l  d0,(a0)+
                  move.l  d1,(a0)+
                  lea     16(a0),a0
                  lea     32(a1),a1
                  bra     loop_mo

* BitMap oder Scaled BitMap
bm_sc_mo:         moveq   #$F8,d0
                  and.l   (a2)+,d0         ; Data-Adress (3..23)
                  bpl.s   ok_bm_sc_mo
                  add.l   a6,d0
                  add.l   vars,d0
ok_bm_sc_mo:      lsl.l   #8,d0            ; an 63..43

                  move.w  (a2)+,d6         ; X
                  and.w   #$0FFF,d6        ; im 2. Phrase 0..11
                  ext.l   d6

                  move.w  (a2)+,d3
                  and.w   #$07FF,d3
                  lsl.w   #3,d3
                  or.w    d3,d1            ; Y-Pos (3..13)

                  moveq   #0,d3
                  move.w  (a2)+,d3
                  and.w   #$03FF,d3
                  swap    d3
                  lsr.l   #2,d3
                  or.l    d3,d1            ; Hhe (14..23)

                  move.w  (a2)+,d3         ; nchstes Objekt
                  lsl.w   #5,d3            ; * 32
                  ext.l   d3
                  add.l   a1,d3
                  lsr.l   #3,d3
                  ror.l   #8,d3
                  move.l  d3,d2            ; Link retten
                  and.l   d4,d3
                  or.l    d3,d1            ; Link (24..31)

                  move.l  d2,d3
                  and.l   #$FFFFFF,d3
                  or.l    d3,d0
                  move.l  d0,(a0)+
                  move.l  d1,(a0)+

                  moveq   #7,d0
                  and.b   (a2)+,d0
                  ror.w   #4,d0
                  or.w    d0,d6            ; Depth (12..14)

                  moveq   #7,d0
                  and.b   (a2)+,d0
                  swap    d0
                  lsr.l   #1,d0
                  or.l    d0,d6            ; Pitch (15..17)

                  moveq   #0,d0
                  move.w  (a2)+,d0
                  and.w   #$03FF,d0
                  lsl.w   #2,d0
                  swap    d0
                  or.l    d0,d6            ; Dwidth (18..27)

                  moveq   #0,d0
                  move.w  (a2)+,d0
                  and.w   #$03FF,d0
                  ror.l   #4,d0
                  move.l  d0,d1
                  clr.w   d0
                  or.l    d0,d6            ; IWidth (28..31)
                  ext.l   d1               ; und (32..37)

; BS 28.8.95
;                  moveq   #$7F,d0
;                  and.b   (a2)+,d0
                  move.w  #$FE,d0
                  and.b   (a2)+,d0
                  lsr.b   #1,d0

                  lsl.w   #6,d0
                  or.w    d0,d1            ; Index (38..44)

                  moveq   #$0F,d0
                  and.b   (a2)+,d0
                  swap    d0
                  lsr.l   #3,d0
                  or.l    d0,d1            ; Flags (45..48)

                  moveq   #$3F,d0
                  and.w   (a2)+,d0

                  add.w   d0,d0
                  swap    d0
                  or.l    d0,d1
                  move.l  d1,(a0)+
                  move.l  d6,(a0)+

                  lea     16(a0),a0
                  lea     32(a1),a1
                  cmp.w   #obj_sc_len,d5   ; Sized Object
                  bne     loop_mo
                  move.l  (a2)+,-12(a0)
;                  move.b  d0,-8(a0)
;                  move.b  d1,-9(a0)
;                  move.b  d2,-10(a0)
;                  clr.b   -11(a0)
                  bra     loop_mo
exit_mo:          clr.l   (a0)+
                  moveq   #4,d0
                  move.l  d0,(a0)+
                  addq.w  #1,d7
                  move.w  d7,count_obj(a6)
                  movem.l (sp)+,d0-a4
                  rts
                  ENDPART
                  IF 0
                  >PART 'CopyOBL'
CopyOBL:          movem.l d1/a0,-(sp)
                  lea     obj_list(a6),a0
                  lea     obj_list0(a6),a1
                  move.w  count_obj(a6),d1
cobl:
                  REPT 8
                  move.l  (a1)+,(a0)+
                  ENDR
                  dbra    d1,cobl
                  movem.l (sp)+,d1/a0
                  rts
                  ENDPART
                  ENDC
                  >PART 'videoinit'
*****************
*   videoinit   *

; THESE ARE THE NTSC DEFINITIONS
ntsc_width        EQU 1409
ntsc_hmid         EQU 823

ntsc_height       EQU 241
ntsc_vmid         EQU 266

; THESE ARE THE PAL DEFINITIONS
pal_width         EQU 1381
pal_hmid          EQU 843

pal_height        EQU 287
pal_vmid          EQU 322

VideoInit:        movem.l d0-d3/a0,-(sp)
                  lea     $F00000,a0
                  move.w  #322-287,d0      ; vdb
                  move.w  #322+287,d1      ; vde
                  move.w  #(1381+28>>1-1)|$0400,d2 ; hde
                  move.w  #843-(1381+28>>1)+4,d3 ; hdb
                  btst    #4,$F14003
                  beq.s   VideoInit1       ; =0 => PAL
                  move.w  #266-241,d0
                  move.w  #266+241,d1
                  move.w  #(1409>>1-1)|$0400,d2
                  move.w  #823-(1409>>1)+4,d3
VideoInit1:       move.w  d0,$46(a0)
                  move.w  d1,$48(a0)
                  move.w  d2,$3C(a0)
                  move.w  d3,$38(a0)
                  move.w  d3,$3A(a0)
                  addq.w  #2,d1
                  move.w  d1,$4E(a0)
                  movem.l (sp)+,d0-d3/a0
                  rts
*****************
                  ENDPART
                  >PART 'InitOP'
InitOP:           bsr     MakeOBL

                  lea     $F00000,a0
                  lea     obj_list(a6),a1
                  move.l  a1,d0
                  swap    d0
                  move.l  d0,$20(a0)       ; OPL = $10000
                  clr.w   $26(a0)          ; OPF
                  move.w  #$1F01,$E0(a0)
                  move.w  #$06C1,$28(a0)

                  clr.w   $E2(a0)
                  move    sr,d0
                  lea     my_irq(pc),a0
                  move.l  a0,$0100.w
                  and.w   #$F8FF,d0
                  move    d0,sr
                  rts
                  ENDPART
                  >PART 'IRQ'
my_irq:           move.w  d0,-(sp)
                  move.w  $F000E0,d0
                  btst    #0,d0
                  beq.s   no_vi
                  bsr     MakeOBL
                  move.w  scr_flag(a6),$F00026
                  clr.w   flag(a6)

                  move.w  #$0101,$F000E0
no_vi:            clr.w   $F000E2
                  move.w  (sp)+,d0
                  rte
                  ENDPART
                  >PART 'Objekte'
Objekte:          DC.W -1,obj_sc_len
                  DC.L ((bild-jag_prg)+$010200+7)&$FFFFF8
                  DC.W 10,60,240
                  DC.W NEXT_OBJ
                  DC.B 4,1
                  DC.W 384/4,256/4
                  DC.B 0,0
                  DC.W 0
                  DC.B 0,$28,$28,$28

screen1_type:     DC.W 0,obj_sc_len
                  DC.L screen
                  DC.W 20,35,max_y
                  DC.W NEXT_OBJ
                  DC.B 4,3
                  DC.W 240,240
                  DC.B 0,4
                  DC.W 0
                  DC.B 0,$20,$40,$40

screen2_type:     DC.W ~0,obj_sc_len
                  DC.L screen1
                  DC.W 20,35,max_y
                  DC.W NEXT_OBJ
                  DC.B 4,3
                  DC.W 320*6>>3,320*6>>3
                  DC.B 0,4
                  DC.W 0
                  DC.B 0,$20,$40,$40
* Info
                  DC.W 1,obj_sc_len
                  DC.L TextScreen
                  DC.W 20,100,TextHeight-1
                  DC.W NEXT_OBJ
                  DC.B 0,1
                  DC.W TextWidth,TextWidth ; Breite
                  DC.B 0,4
                  DC.W 0
                  DC.B 0,$40,$40,$40
*
                  DC.W $AFFE
                  ENDPART
*******************

                  >PART 'InitGPU'
InitGPU:          lea     $F02110,a0
                  moveq   #0,d0
                  move.w  #$3E00,d0
                  move.l  d0,-$10(a0)
                  lea     GPUcode+4(pc),a1
                  moveq   #0,d0
                  move.l  d0,4(a0)         ; GPU halt
                  movea.l (a1)+,a2
                  move.l  a2,(a0)
                  move.l  (a1)+,d1         ; Lnge in Bytes
                  lsr.l   #2,d1
copy_gpu:         move.l  (a1)+,(a2)+
                  dbra    d1,copy_gpu
                  sub.l   #$010000,d1
                  bpl.s   copy_gpu
                  rts
GPUcode:
                  IF MMULT
                  IBYTES 'ROT5Z_MM.O'
                  ELSE
                  IBYTES 'ROTATEZ5.O'
                  ENDC
                  ENDPART
                  >PART 'DoGPU'
; IN : d0         alpha
;      d1         beta
;      d2         gamma
DoGPU:            lea     $F04000-11*4,a0
                  move.l  #XADD_PIXEL|PITCH3|WIN320|PIXEL16|ZOFFSET1,(a0)
                  tst.w   scr_flag(a6)
                  beq.s   ok_dg
                  move.l  #XADD_PIXEL|PITCH3|WIN320|PIXEL16|ZOFFSET2,(a0)
ok_dg:            addq.l  #4,a0
                  move.l  color(a6),(a0)+  ; Farb-Werte der Pixel
                  move.l  a5,(a0)+         ; Bildschirm-Speicher
                  lea     sin_tab(pc),a1
                  move.w  #$01FC,d4
                  lsl.w   #2,d2
                  move.w  #32*4,d3
                  add.w   d2,d3
                  and.w   d4,d2
                  and.w   d4,d3
                  move.l  0(a1,d3.w),(a0)+ ; sin gamma
                  move.l  0(a1,d2.w),(a0)+ ; cos gamma
                  lsl.w   #2,d1
                  move.w  #32*4,d3
                  add.w   d1,d3
                  and.w   d4,d1
                  and.w   d4,d3
                  move.l  0(a1,d3.w),(a0)+ ; sin beta
                  move.l  0(a1,d1.w),(a0)+ ; cos beta
                  lsl.w   #2,d0
                  move.w  #32*4,d3
                  add.w   d0,d3
                  and.w   d4,d0
                  and.w   d4,d3
                  move.l  0(a1,d3.w),(a0)+ ; sin alpha
                  move.l  0(a1,d0.w),(a0)+ ; cos alpha

                  move.l  points(a6),(a0)+ ; Anzahl der Punkte
                  move.l  _normal(a6),(a0)+ ; Koordinaten
                  lea     $F02110,a0
                  move.l  GPUcode+4(pc),(a0)+
                  move.w  #$01|(1<<11),d0
                  move.l  d0,(a0)
wait_gpu1:        move.l  (a0),d0
                  lsr.w   #1,d0
                  bcs.s   wait_gpu1
                  rts
                  ENDPART
                  >PART 'PrintBIN'
PrintBIN:         movem.l d0-d2,-(sp)
                  moveq   #31,d1
                  move.l  d0,d2
loop_pb:          moveq   #0,d0
                  add.l   d2,d2
                  bcc.s   ok_pb
                  addq.w  #1,d0
ok_pb:            bsr     PrintZiffer
                  dbra    d1,loop_pb
                  movem.l (sp)+,d0-d2
                  rts
                  ENDPART
                  >PART 'PrintDEZ'
PrintDEZ:         movem.l d0/a0-a1,-(sp)
                  lea     TextScreen,a1
                  adda.l  Cursor(a6),a1
                  addq.l  #5,Cursor(a6)
                  divu    #10000,d0
                  bsr.s   PrintZiffer2
                  swap    d0
                  ext.l   d0
                  divu    #1000,d0
                  bsr.s   PrintZiffer2
                  swap    d0
                  ext.l   d0
                  divu    #100,d0
                  bsr.s   PrintZiffer2
                  swap    d0
                  ext.l   d0
                  divu    #10,d0
                  bsr.s   PrintZiffer2
                  swap    d0
                  ext.l   d0
                  bsr.s   PrintZiffer2
                  movem.l (sp)+,d0/a0-a1
                  rts
PrintZiffer2:     lsl.w   #3,d0
                  lea     _0(pc),a0
                  lea     0(a0,d0.w),a0
                  move.b  (a0)+,(a1)+
                  move.b  (a0)+,1*TWB-1(a1)
                  move.b  (a0)+,2*TWB-1(a1)
                  move.b  (a0)+,3*TWB-1(a1)
                  move.b  (a0)+,4*TWB-1(a1)
                  move.b  (a0)+,5*TWB-1(a1)
                  move.b  (a0)+,6*TWB-1(a1)
                  move.b  (a0)+,7*TWB-1(a1)
                  rts

PrintDEZ2:        divu    #10,d0
                  bsr.s   PrintZiffer
                  swap    d0
                  ext.l   d0
                  bsr.s   PrintZiffer
                  rts
                  ENDPART
                  >PART 'InitTxtScreen'

InitTxtScreen:    lea     TextScreen,a0
                  move.l  #$F0FF,$F00400
                  move.w  #TWB*TextHeight-1,d0
                  moveq   #0,d1
loop_its:         move.l  d1,(a0)+
                  dbra    d0,loop_its
                  rts

PrintZiffer:      movem.l d0/a0-a1,-(sp)
                  lea     TextScreen,a1
                  adda.l  Cursor(a6),a1
                  addq.l  #1,Cursor(a6)
                  lsl.w   #3,d0
                  lea     _0(pc,d0.w),a0
                  move.b  (a0)+,(a1)+
                  move.b  (a0)+,1*TWB-1(a1)
                  move.b  (a0)+,2*TWB-1(a1)
                  move.b  (a0)+,3*TWB-1(a1)
                  move.b  (a0)+,4*TWB-1(a1)
                  move.b  (a0)+,5*TWB-1(a1)
                  move.b  (a0)+,6*TWB-1(a1)
                  move.b  (a0)+,7*TWB-1(a1)
                  movem.l (sp)+,d0/a0-a1
                  rts
_0:               IBYTES 'ZAHLEN.BIN'
                  ENDPART

                  >PART 'swap'
swap:             not.w   scr_flag(a6)

                  lea     screen1_type(pc),a0
                  not.w   (a0)
                  lea     screen2_type(pc),a0
                  not.w   (a0)
                  move.l  phys(a6),d0
                  move.l  a5,phys(a6)
                  movea.l d0,a5
                  subq.w  #1,flag(a6)
swap1:            tst.w   flag(a6)
                  bne.s   swap1
                  rts
                  ENDPART
                  >PART 'cls'
cls:              movem.l d0/a0,-(sp)
                  lea     $F02200,a0
                  move.l  a5,(a0)
                  move.l  #WIN320|PITCH3|PIXEL32|ZOFFSET1,4(a0)
                  tst.w   scr_flag(a6)
                  beq.s   ok_cls
                  move.l  #WIN320|PITCH3|PIXEL32|ZOFFSET2,4(a0)
ok_cls:           moveq   #0,d0
                  move.l  d0,$0C(a0)
                  move.l  d0,$18(a0)
                  move.l  d0,$58(a0)
                  move.l  d0,$5C(a0)
                  move.l  d0,$60(a0)
                  move.l  d0,$64(a0)
                  move.l  d0,$68(a0)
                  move.l  d0,$6C(a0)
                  move.l  #(max_y<<16)|160,$3C(a0)
                  move.l  #(4<<18)|PATDSEL|DSTWRZ,$38(a0)
wait:             move.l  $38(a0),d0
                  btst    #0,d0
                  beq.s   wait
                  movem.l (sp)+,d0/a0
                  rts
                  ENDPART
                  >PART 'kugel'

kugel:            moveq   #63,d7
                  lea     sin_tab(pc),a0

                  move.w  #0,d6            ; sin_phi
                  move.w  #32*4,d5         ; cos_phi

loop_k1:          movea.w #127,a1
                  moveq   #0,d4            ; sin_theta
                  move.w  #32*4,d3         ; cos_theta

loop_k2:          move.l  0(a0,d6.w),d0    ; sin(phi)
                  muls    radius(a6),d0
                  swap    d0
                  add.w   d0,d0
                  move.w  d0,d2            ; d2=r*sin(phi)
                  move.l  0(a0,d4.w),d1    ; sin(theta)
                  muls    d1,d0
                  swap    d0
                  rol.l   #1,d0
; x=r*sin(phi)*sin(theta)
                  move.l  0(a0,d3.w),d1
                  muls    d2,d1
                  swap    d1
                  rol.l   #1,d1
; y=r*sin(phi)*cos(theta)
                  move.l  0(a0,d5.w),d2
                  muls    radius(a6),d2
                  swap    d2
                  rol.l   #1,d2
; z=r*cos(phi)
                  ext.l   d0
                  move.l  d0,(a2)+
                  move.w  d1,(a2)+
                  move.w  d2,(a2)+


                  lsl.w   #8,d0
;                  move.w  d0,(a4)+
                  move.w  #$1020,(a4)+
                  addq.l  #1,points(a6)

                  addq.w  #4,d3
                  addq.w  #4,d4
                  and.w   #$01FF,d3
                  and.w   #$01FF,d4
                  subq.w  #1,a1
                  move.w  a1,d0
                  bpl.s   loop_k2
                  addq.w  #4,d5
                  addq.w  #4,d6
                  and.w   #$01FC,d5
                  and.w   #$01FC,d6
                  dbra    d7,loop_k1
                  rts
                  ENDPART
                  >PART 'xaxe'
xaxe:             moveq   #20,d7
                  move.l  #$F000F000,d6
                  moveq   #0,d0
                  moveq   #0,d1
                  moveq   #0,d2
                  move.w  radius(a6),d0
                  move.w  d0,d1
                  neg.l   d1
                  moveq   #0,d2
                  moveq   #0,d3
loop_xaxe:        clr.w   (a2)+
                  movem.w d0/d2-d3,(a2)
                  addq.l  #6,a2
                  clr.w   (a2)+
                  movem.w d1-d3,(a2)
                  addq.l  #6,a2
                  move.l  d6,(a4)+
                  addq.l  #2,points(a6)
                  addq.l  #1,d0
                  subq.l  #1,d1
                  dbra    d7,loop_xaxe
                  rts
                  ENDPART
                  >PART 'yaxe'
yaxe:             move.w  #20,d7
                  move.l  #$9E009E00,d6
                  moveq   #0,d0
                  moveq   #0,d1
                  moveq   #0,d2
                  move.w  radius(a6),d1
                  move.w  d1,d2
                  neg.l   d2
                  moveq   #0,d3
loop_yaxe:        move.l  d0,(a2)+
                  move.w  d1,(a2)+
                  move.w  d3,(a2)+
                  move.l  d0,(a2)+
                  move.w  d2,(a2)+
                  move.w  d3,(a2)+
                  move.l  d6,(a4)+
                  addq.l  #2,points(a6)
                  addq.l  #1,d1
                  subq.l  #1,d2
                  dbra    d7,loop_yaxe
                  rts
                  ENDPART
                  >PART 'zaxe'
zaxe:             move.w  #20,d7
                  move.l  #$C000C000,d6
                  moveq   #0,d0
                  moveq   #0,d1
                  moveq   #0,d2
                  move.w  radius(a6),d2
                  move.w  d2,d3
                  neg.l   d3
loop_zaxe:        move.l  d0,(a2)+
                  move.w  d1,(a2)+
                  move.w  d2,(a2)+

                  move.l  d0,(a2)+
                  move.w  d1,(a2)+
                  move.w  d3,(a2)+
                  move.l  d6,(a4)+
                  addq.l  #2,points(a6)
                  addq.l  #1,d2
                  subq.l  #1,d3
                  dbra    d7,loop_zaxe
                  rts
                  ENDPART
                  >PART 'ColorMap'
ColorMap:         moveq   #63,d7
                  move.l  #$FF00,d5
                  moveq   #100,d1          ; y
                  moveq   #-20,d2
                  moveq   #31,d3           ; z
                  lea     bitmap(pc),a0
loop0_cm:         moveq   #31,d0           ; x
;                  addq.w  #1,d1
                  moveq   #63,d6
loop1_cm:
                  move.l  d0,(a2)+
                  move.w  d1,(a2)+
                  move.w  d3,(a2)+
;                  move.l  d0,(a2)+
;                  move.w  d1,(a2)+
;                  move.w  d3,(a2)+

                  move.w  d6,d5
                  lsr.w   #2,d5
                  ror.w   #4,d5
                  or.w    d7,d5
                  lsr.b   #2,d5
                  ror.w   #4,d5
                  move.w  d5,(a4)+

;                  move.w  d5,(a4)+
                  addq.l  #1,points(a6)
                  subq.l  #1,d0
                  dbra    d6,loop1_cm
                  subq.l  #1,d3
                  dbra    d7,loop0_cm
                  rts
                  ENDPART
                  >PART 'MakeBitMap'
MakeBitMap:       moveq   #63,d7
                  move.l  #$80005000,d5
                  moveq   #20,d1           ; y
                  moveq   #-20,d2
                  moveq   #-63,d3          ; z
                  lea     bitmap(pc),a0
loop0_mbm:        moveq   #-63,d0          ; y
                  move.l  (a0)+,d4
                  moveq   #31,d6
loop1_mbm:        btst    d6,d4
                  beq.s   no_point1_mbm
                  move.l  d0,(a2)+
                  move.w  d1,(a2)+
                  move.w  d3,(a2)+

                  move.l  d0,(a2)+
                  move.w  d2,(a2)+
                  move.w  d3,(a2)+

                  move.l  d5,(a4)+
                  addq.l  #2,points(a6)
no_point1_mbm:    addq.l  #1,d0
                  dbra    d6,loop1_mbm
                  move.l  (a0)+,d4
                  moveq   #31,d6
loop2_mbm:        btst    d6,d4
                  beq.s   no_point2_mbm
                  move.l  d0,(a2)+
                  move.w  d1,(a2)+
                  move.w  d3,(a2)+

                  move.l  d0,(a2)+
                  move.w  d2,(a2)+
                  move.w  d3,(a2)+

                  move.l  d5,(a4)+
                  addq.l  #2,points(a6)
no_point2_mbm:    addq.l  #1,d0
                  dbra    d6,loop2_mbm
                  addq.l  #1,d3
                  dbra    d7,loop0_mbm
                  rts
bitmap:           IBYTES 'BITMAP.BIN'
                  ENDPART
                  >PART 'GetJoyPad1'
JoyA_1            EQU $810E
JoyA_2            EQU $810D
JoyA_3            EQU $810B
JoyA_4            EQU $8107

GetJoyPad1:       movem.l d0-d2/a0,-(sp)
                  move.l  #$F0FFFFFC,d1
                  moveq   #$FF,d2
                  lea     $F14000,a0
                  move.w  #JoyA_1,(a0)
                  move.l  (a0),d0
                  or.l    d1,d0
                  ror.l   #4,d0
                  and.l   d0,d2

                  move.w  #JoyA_2,(a0)
                  move.l  (a0),d0
                  or.l    d1,d0
                  ror.l   #8,d0
                  and.l   d0,d2

                  move.w  #JoyA_3,(a0)
                  move.l  (a0),d0
                  or.l    d1,d0
                  rol.l   #6,d0
                  rol.l   #6,d0
                  and.l   d0,d2

                  move.w  #JoyA_4,(a0)
                  move.l  (a0),d0
                  or.l    d1,d0
                  rol.l   #8,d0
                  and.l   d0,d2

                  not.l   d2
                  lea     joy_pad(a6),a0
                  move.l  (a0),d0
                  move.l  d0,d1
                  move.l  d2,(a0)
                  and.l   #$FF0FFFFF,d2
                  eor.l   d2,d0
                  or.l    #$F00000,d2
                  and.l   d2,d0
                  move.l  d0,4(a0)
                  move.l  (a0),d2
                  eor.l   d2,d1
                  and.l   d2,d1
                  move.l  d1,8(a0)
                  movem.l (sp)+,d0-d2/a0
                  rts
                  ENDPART
                  >PART 'conv_indie'
conv_indie:       lea     bild+256(pc),a0
                  lea     (a0),a1
                  move.w  #(384*240-1)/2-1,d0
loop000:          movem.w (a0)+,d1-d2
                  moveq   #$1F,d3
                  moveq   #$1F,d4
                  and.w   d1,d3
                  and.w   d2,d4            ; Blau
                  lsr.w   #5,d1
                  lsr.w   #5,d2
                  moveq   #$3F,d5
                  moveq   #$3F,d6
                  and.w   d1,d5
                  and.w   d2,d6            ; Grn
                  lsr.w   #6,d1
                  lsr.w   #6,d2            ; Rot
*
                  lsl.w   #6,d3
                  lsl.w   #6,d4            ; Blau
                  ror.w   #5,d1
                  ror.w   #5,d2            ; Rot
*
                  or.w    d1,d3
                  or.w    d3,d5
                  or.w    d2,d4
                  or.w    d4,d6
*
                  or.w    #$01,d5          ; fr VARMOD
                  or.w    #$01,d6
*
                  movem.w d5-d6,(a1)

                  addq.l  #4,a1
                  dbra    d0,loop000
                  rts
                  ENDPART
                  >PART 'sin_tab'
sin_tab:          DC.L 0,1608,3212,4808,6393,7962,9512,11039
                  DC.L 12539,14010,15446,16846,18204,19519,20787,22005
                  DC.L 23170,24279,25329,26319,27245,28105,28898,29621
                  DC.L 30273,30852,31356,31785,32137,32412,32609,32728
                  DC.L 32767,32728,32609,32412,32137,31785,31356,30852
                  DC.L 30273,29621,28898,28105,27245,26319,25329,24279
                  DC.L 23170,22005,20787,19519,18204,16846,15446,14010
                  DC.L 12539,11039,9512,7962,6393,4808,3212,1608
                  DC.L 0,-1608,-3212,-4808,-6393,-7962,-9512,-11039
                  DC.L -12539,-14010,-15446,-16846,-18204,-19519,-20787,-22005
                  DC.L -23170,-24279,-25329,-26319,-27245,-28105,-28898,-29621
                  DC.L -30273,-30852,-31356,-31785,-32137,-32412,-32609,-32728
                  DC.L -32767,-32728,-32609,-32412,-32137,-31785,-31356,-30852
                  DC.L -30273,-29621,-28898,-28105,-27245,-26319,-25329,-24279
                  DC.L -23170,-22005,-20787,-19519,-18204,-16846,-15446,-14010
                  DC.L -12539,-11039,-9512,-7962,-6393,-4808,-3212,-1608
                  ENDPART
                  RSSET 0
obj_list0:
obj_list:         RS.L 30
count_obj:        RS.W 1
joy_pad:          RS.L 3
points:           RS.L 1
flag:             RS.W 1
scr_flag:         RS.W 1
radius:           RS.W 1
phys:             RS.L 1
log:              RS.L 1
_normal:          RS.L 1
gedreht0:         RS.L 1
color:            RS.L 1
xadd:             RS.L 1
yadd:             RS.L 1
zadd:             RS.L 1
x:                RS.L 1
y:                RS.L 1
z:                RS.L 1
last:             RS.L 1
Cursor:           RS.L 1
normal:           RS.L 1
bild:
jag_end:
                  END
                  >PART 'undo'
undo:             movea.l _normal(a6),a0
                  movea.l gedreht0(a6),a1
                  moveq   #-1,d0
                  move.w  points+2(a6),d1
                  add.w   d1,d1
                  add.w   points+2(a6),d1
                  moveq   #0,d2
;                  bra     copy
                  ENDPART
                  >PART 'Copy(a0,a1,d1.w,d0.l,d2.w)'
* D0 Maske
* D1 Anzahl in Long
* D2 Pitch
* A0 Src
* A1 Dst
copy:
                  movem.l d0-d1/a0-a2,-(sp)
                  lea     $F02200,a2
                  move.l  d0,$2C(a2)       ; Maske
                  move.l  #$010000,d0
                  move.w  d1,d0
                  move.l  d0,$3C(a2)

                  moveq   #0,d1
                  move.w  #$4028,d1
                  or.w    d2,d1
                  move.l  d1,$04(a2)
                  or.w    #$8000,d1
                  move.l  d1,$28(a2)
                  move.l  a0,d0
                  and.w   #$FFF8,d0
                  move.l  d0,$24(a2)       ; A2-Base : SRC

                  moveq   #0,d1
                  move.l  d1,$30(a2)       ; A2 Pixel-Pointer

                  move.l  a1,d0
                  and.w   #$FFF8,d0
                  move.l  d0,(a2)          ; A1-Base : Dest
                  move.l  d1,$0C(a2)       ; A1-Pixel-Pointer
                  move.l  #$01800001,$38(a2)
wait_blitter2:    move.l  $38(a2),d0
                  lsr.w   #1,d0
;                  bcc.s   wait_blitter2
                  movem.l (sp)+,d0-d1/a0-a2
                  rts
                  ENDPART
                  >PART 'plot'
plot:             movem.l d4-d5,-(sp)
                  move.w  #336,d5
                  mulu    d1,d5            ; y*80
                  ext.l   d0
                  add.l   d0,d5
                  move.b  d2,0(a5,d5.l)
                  movem.l (sp)+,d4-d5
                  rts

plot_eor:         moveq   #80,d0
                  mulu    d3,d0
                  move.w  d2,d4
                  lsr.w   #3,d2
                  add.w   d2,d0
                  move.w  d4,d2
                  neg.w   d4
                  addq.w  #7,d4
                  bchg    d4,0(a6,d0.w)
                  rts
                  ENDPART
                  >PART 'rot_y'
rot_y:            move.w  #points,d7
                  movea.l gedreht0(a6),a0
                  movea.l gedreht1(a6),a1
                  lea     sin_tab,a2
                  lsl.w   #2,d0
                  move.w  #32*4,d1
                  add.w   d0,d1
                  and.w   #$01FF,d0
                  and.w   #$01FF,d1
                  movea.l 0(a2,d0.w),a3    ; sin alpha
                  movea.l 0(a2,d1.w),a4    ; cos alpha
loop_ry:          move.l  a3,d2
                  move.l  a4,d3
                  movem.w (a0)+,d4-d6
                  muls    d4,d3
                  muls    d6,d2
                  add.l   d2,d3
                  swap    d3
                  rol.l   #1,d3
                  move.w  d3,(a1)+         ; x=x*co+z*si
                  move.l  a3,d2
                  move.l  a4,d3
                  neg.w   d4
                  muls    d4,d2
                  muls    d6,d3
                  add.l   d2,d3
                  swap    d3
                  rol.l   #1,d3
                  move.w  d5,(a1)+
                  move.w  d3,(a1)+
                  dbra    d7,loop_ry

                  movea.l gedreht0(a6),a0
                  movea.l gedreht1(a6),a1
                  move.w  #points,d7
loop1_ry:         move.l  (a1)+,(a0)+
                  move.w  (a1)+,(a0)+
                  dbra    d7,loop1_ry
                  rts
                  ENDPART
                  >PART 'rot_x'
rot_x:            move.w  #points,d7
                  movea.l gedreht0(a6),a0
                  movea.l gedreht1(a6),a1
                  lea     sin_tab,a2
                  lsl.w   #2,d0
                  move.w  #32*4,d1
                  add.w   d0,d1
                  and.w   #$01FF,d0
                  and.w   #$01FF,d1
                  movea.l 0(a2,d0.w),a3    ; sin alpha
                  movea.l 0(a2,d1.w),a4    ; cos alpha
loop_rx:          move.l  a3,d2
                  move.l  a4,d3
                  movem.w (a0)+,d4-d6
                  muls    d5,d3
                  muls    d6,d2
                  add.l   d2,d3
                  swap    d3
                  rol.l   #1,d3
                  move.w  d4,(a1)+         ; y=y*co+z*si
                  move.w  d3,(a1)+
*
                  move.l  a3,d2
                  move.l  a4,d3
                  neg.w   d5
                  muls    d5,d2
                  muls    d6,d3
                  add.l   d2,d3
                  swap    d3
                  rol.l   #1,d3
                  move.w  d3,(a1)+
                  dbra    d7,loop_rx

                  movea.l gedreht0(a6),a0
                  movea.l gedreht1(a6),a1
                  move.w  #points,d7
loop1_rx:         move.l  (a1)+,(a0)+
                  move.w  (a1)+,(a0)+
                  dbra    d7,loop1_rx
                  rts
                  ENDPART
                  >PART 'blitter'
blitter:          lea     $F02200,a0

                  IF 1
                  movea.l #screen+max_x,a1 ; a1_base
                  move.w  #220,d1
lb:               move.l  a1,(a0)
                  lea     max_x*2(a1),a1
                  move.l  #%110001111100001,a1_flags(a0)
                  move.l  #$050020,a1_clip(a0)
                  move.l  #$040004,a1_step(a0)
                  move.l  #$01,a1_pixel(a0)
                  move.l  #$DC00C7,pattern(a0)
                  move.l  #$B1009C,pattern+4(a0)
                  move.l  #$FEDCEAC7,src_data(a0)
                  move.l  #$D6B1C29C,src_data+4(a0)
                  move.l  #$FFFFE7E7,src_z1(a0)
                  move.l  #$CFCFB7B7,src_z1+4(a0)
                  move.l  #$FFFFE000,src_z2(a0)
                  move.l  #$C001A002,src_z2+4(a0)
                  move.l  #$FFA9B66C,intensity_inc(a0)
                  move.l  #$9F9F8004,z_inc(a0)
                  move.l  #$050020,counters(a0)
                  move.l  #%11010011000001111000|(1<<9),blit_command(a0)
                  ENDC
wait_blit:        move.l  blit_status(a0),d0
                  lsr.w   #1,d0
                  bcc.s   wait_blit
                  dbra    d1,lb
                  rts
                  ENDPART
                  >PART 'draw_it'
                  move.w  points+2(a6),d7
                  subq.w  #1,d7
                  movea.l gedreht0(a6),a0
                  movea.l color(a6),a1
                  moveq   #0,d0
loop_di:          movem.l (a0)+,d0-d2
                  move.w  (a1)+,d4
;                  move.w  #$1000,d4
                  cmp.w   #-5,d1
                  blt.s   ok_di2
                  moveq   #25,d3
                  add.w   d1,d3            ; z merken
                  add.w   d3,d3
                  asr.w   #2,d1
                  add.w   d1,d0
                  add.w   d2,d1
                  add.w   #168,d0
                  add.w   #max_y/2,d1
                  mulu    #336*2,d1        ; y*200
                  ext.l   d0
                  add.l   d0,d1
                  add.l   d0,d1
                  tst.w   d3
                  bmi.s   ok_di2
                  cmp.w   #255,d3
                  blt.s   ok_di
                  move.w  #255,d3
ok_di:            and.w   #$FF,d3
                  or.w    d3,d4
                  move.w  d4,0(a5,d1.l)
ok_di2:           dbra    d7,loop_di
                  rts

                  move.w  points+2(a6),d7
                  subq.w  #1,d7
                  movea.l gedreht0(a6),a0
                  movea.l color(a6),a1
                  moveq   #0,d0
loop_dia:         movem.l (a0)+,d0-d2
;                  subq.l  #8,d0
;                  subq.l  #8,d1
;                  subq.l  #8,d2
                  move.w  (a1)+,d4
                  move.w  #$F000,d4
                  cmp.w   #-5,d1
                  blt.s   ok_di2a
                  moveq   #25,d3
                  add.w   d1,d3            ; z merken
                  add.w   d3,d3
                  asr.w   #2,d1
                  sub.w   d1,d0
                  neg.w   d1
                  add.w   d2,d1
                  add.w   #168,d0
                  add.w   #max_y/2,d1
                  mulu    #336*2,d1        ; y*200
                  ext.l   d0
                  add.l   d0,d1
                  add.l   d0,d1
                  tst.w   d3
                  bmi.s   ok_di2a
                  cmp.w   #255,d3
                  blt.s   ok_dia
                  move.w  #255,d3
ok_dia:           and.w   #$FF,d3
                  or.w    d3,d4
                  move.w  d4,0(a5,d1.l)
ok_di2a:          dbra    d7,loop_dia
                  rts
                  ENDPART
                  >PART ''
rot_x_gpu:        moveq   #0,d2
                  bra.s   cont_rot
rot_y_gpu:        moveq   #10,d2
                  bra.s   cont_rot
rot_z_gpu:        moveq   #20,d2
cont_rot:         lea     $F03FEC,a0
                  lea     sin_tab(pc),a2
                  lsl.w   #2,d0
                  move.w  #32*4,d1
                  add.w   d0,d1
                  and.w   #$01FC,d0
                  and.w   #$01FC,d1
                  move.l  0(a2,d1.w),(a0)+ ; sin alpha
                  move.l  0(a2,d0.w),(a0)+ ; cos alpha


                  move.l  points(a6),(a0)+
                  move.l  xyl(a6),(a0)+
                  move.l  gedreht0(a6),(a0)+

                  lea     $F02110,a0
                  add.l   #$F03000,d2
                  move.l  d2,(a0)+
                  moveq   #$11,d0
                  move.l  d0,(a0)
wait_gpu_rot:     move.l  (a0),d0
                  lsr.w   #1,d0
                  bcs.s   wait_gpu_rot
                  clr.l   (a0)
                  rts
                  ENDPART
                  >PART 'draw_it'
draw_it:          lea     $F03FF0,a1
                  move.l  color(a6),(a1)+
                  move.l  gedreht0(a6),(a1)+
                  move.l  points(a6),(a1)+
                  move.l  a5,(a1)+

                  lea     $F02114,a0
wait_gpu_di:      move.l  (a0),d0
                  lsr.w   #1,d0
                  bcs.s   wait_gpu_di

                  subq.l  #4,a0
                  moveq   #10,d2
                  add.l   GPUcode+4(pc),d2
                  move.l  d2,(a0)+
                  moveq   #$01,d0
                  move.l  d0,(a0)
wait_gpu_di1:     move.l  (a0),d0
                  lsr.w   #1,d0
;                  bcs.s   wait_gpu_di1
                  rts
                  ENDPART

                  IF 0
                  >PART 'InitScreen'
InitScreen:       lea     $F00000,a0
                  clr.w   $28(a0)
                  clr.w   $26(a0)
                  IF HiRes
                  move.w  #856,$2E(a0)
                  move.w  #1810,$34(a0)
                  move.w  #160,$38(a0)
                  move.w  #160,$3A(a0)
                  move.w  #1650,$3C(a0)

                  move.w  #721,$3E(a0)     ; 685
                  move.w  #720,$44(a0)     ; 680
                  move.w  #720,$40(a0)     ; 680
                  move.w  #10,$42(a0)
                  move.w  #35,$46(a0)
                  move.w  #718,$48(a0)
                  move.w  #719,$4E(a0)
max_y             SET 342
                  ELSE
                  move.w  #856,$2E(a0)
                  move.w  #619+2,$3E(a0)
                  move.w  #610+2,$40(a0)
                  move.w  #20,$42(a0)
                  move.w  #610+2,$44(a0)
                  move.w  #34,$46(a0)
                  move.w  #600+2,$48(a0)
                  move.w  #619,$4E(a0)
max_y             SET 284
max_x             SET 344
                  ENDC
                  rts
                  ENDPART
* Init- und Hilfsroutine fr den Bildschirm
* (c) 1994 Bastian Schick
                  >PART 'struct object'
NEXT_OBJ          EQU 1

                  RSRESET
obj_typ:          RS.W 1                   ; Type
obj_data:         RS.L 1                   ; Data
obj_x:            RS.W 1                   ; X
obj_y:            RS.W 1                   ; Y pos in Halbzeilen
obj_height:       RS.W 1                   ; Hhe ODER cc bei BRANCH OBJECT
obj_link:         RS.W 1                   ; Abstand zum Nchsten Objekt in Objekten
obj_bits:         RS.B 1                   ; Bits pro Pixel
obj_pitch:        RS.B 1                   ; Pitch
obj_dwidth:       RS.W 1                   ; Breite in Phrases
obj_iwidth:       RS.W 1                   ; Bildbreite (sichtbar)
obj_cindex:       RS.B 1                   ; Farb-Offset
obj_flags:        RS.B 1                   ; Flags
obj_hscale:       RS.W 1
obj_vscale:       RS.W 1
obj_rem:          RS.W 1
obj_len           EQU ^^RSCOUNT
                  ENDPART
                  >PART 'MakeOBL'
MakeOBL:          movem.l d0-d5/a0-a2,-(sp)

                  lea     $010000,a0
                  lea     $010000,a1
                  lea     Objekte(pc),a2
loop_mo:          move.w  (a2)+,d1         ; Type
                  move.w  d1,d5            ; merken
                  bpl.s   ok_mo
                  cmp.w   #$AFFE,d1
                  beq     exit_mo
                  lea     obj_len-2(a2),a2
                  bra.s   loop_mo

ok_mo:            ext.l   d1
                  move.l  (a2)+,d0
                  and.w   #$FFF8,d0        ; Data-Adress (3..23)
                  lsl.l   #8,d0            ; an 63..43

                  move.w  (a2)+,d2         ; X
                  and.w   #$07FF,d2        ; im 2. Phrase 0..11
                  ext.l   d2

                  move.w  (a2)+,d3
                  and.w   #$07FF,d3
                  lsl.w   #3,d3
                  or.w    d3,d1            ; Y-Pos (3..13)

                  moveq   #0,d3
                  move.w  (a2)+,d3
                  and.w   #$03FF,d3
                  swap    d3
                  lsr.l   #2,d3
                  or.l    d3,d1            ; Hhe (14..23)

                  move.w  (a2)+,d3         ; nchstes Objekt
                  lsl.w   #5,d3            ; * 32
                  ext.l   d3
                  add.l   a1,d3
                  lsr.l   #3,d3
                  ror.l   #8,d3
                  move.l  d3,d4
                  and.l   #$FF000000,d3
                  or.l    d3,d1            ; Link (24..31)

                  move.l  d4,d3
                  and.l   #$FFFFFF,d3
                  or.l    d3,d0
                  movem.l d0-d1,(a0)

                  move.b  (a2)+,d0
                  and.w   #7,d0
                  ror.w   #4,d0
                  or.w    d0,d2            ; Depth (12..14)
                  moveq   #0,d0
                  move.b  (a2)+,d0
                  and.w   #7,d0
                  swap    d0
                  lsr.l   #1,d0
                  or.l    d0,d2            ; Pitch (15..17)

                  moveq   #0,d0
                  move.w  (a2)+,d0
                  and.w   #$03FF,d0
                  lsl.w   #2,d0
                  swap    d0
                  or.l    d0,d2            ; Dwidth (18..27)

                  moveq   #0,d0
                  move.w  (a2)+,d0
                  and.w   #$03FF,d0
                  ror.l   #4,d0
                  move.l  d0,d1
                  clr.w   d0
                  or.l    d0,d2            ; IWidth (28..31)
                  ext.l   d1               ; und (32..37)

                  move.b  (a2)+,d0
                  and.w   #$7F,d0
                  lsl.w   #6,d0
                  or.w    d0,d1            ; Index (38..44)

                  moveq   #0,d0
                  move.b  (a2)+,d0
                  swap    d0
                  lsr.l   #3,d0
                  or.l    d0,d1            ; Flags (45..48)

                  movem.l d1-d2,8(a0)

                  addq.l  #6,a2
                  lea     32(a0),a0
                  lea     32(a1),a1
                  cmp.w   #1,d5            ; Sized Object
                  bne     loop_mo
                  movem.w -6(a2),d0-d2
                  move.b  d0,-8(a0)
                  move.b  d1,-9(a0)
                  move.b  d2,-10(a0)
                  clr.b   -11(a0)
                  bra     loop_mo
exit_mo:          clr.l   (a0)+
                  moveq   #4,d0
                  move.l  d0,(a0)+

                  move.w  scr_flag(a6),$F00026
                  clr.w   flag(a6)

                  movem.l (sp)+,d0-d5/a0-a2
                  rts
                  ENDPART
                  >PART 'InitOP'
_InitOP:          bsr     MakeOBL
                  lea     $F00000,a0
                  moveq   #1,d0
                  move.l  d0,$20(a0)       ; OPL = $10000
                  IF DEBUG
                  move.l  d0,$0300.w
                  ENDC
                  clr.w   $26(a0)          ; OPF
                  move.w  #$07C1,$28(a0)
                  IF DEBUG
                  move.w  #$07C1,$0314
                  ENDC
                  clr.l   $2A(a0)
                  move.w  #$3DFF,$58(a0)
                  clr.w   $58(a0)
                  move.w  #$1F01,$E0(a0)
                  clr.w   $E2(a0)
                  move    sr,d0
                  lea     my_irq(pc),a0
                  move.l  a0,$0100.w
                  and.w   #$F8FF,d0
                  move    d0,sr
                  rts
                  ENDPART
                  >PART 'IRQ'
my_irq:           move.w  d0,-(sp)
                  move.w  $F000E0,d0
                  btst    #0,d0
                  beq.s   no_vi
                  bsr     MakeOBL
                  move.w  #$0101,$F000E0
no_vi:
;                  btst    #3,d0
;                  beq.s   no_1k
;                  bsr     _2000HzIRQ
;                  move.w  #$0809,$F000E0
no_1k:            clr.w   $F000E2
                  move.w  (sp)+,d0
                  rte
                  ENDPART
                  >PART 'Objekte'
Objekte:          DC.W -1
                  DC.L ((bild-jag_prg)+$010200+7)&$FFFFF8
                  DC.W 10,60,240
                  DC.W NEXT_OBJ
                  DC.B 4,1
                  DC.W 384/4,256/4
                  DC.B 0,0
                  DC.W $28,$28,$28

screen1_type:     DC.W 0
                  DC.L screen
                  DC.W 20,35,max_y
                  DC.W NEXT_OBJ
                  DC.B 4,3
                  DC.W 240,240
                  DC.B 0,4
                  DC.W $20,$40,$40

screen2_type:     DC.W ~0
                  DC.L screen1
                  DC.W 20,35,max_y
                  DC.W NEXT_OBJ
                  DC.B 4,3
                  DC.W 240,240
                  DC.B 0,4
                  DC.W $20,$40,$40
* Info
                  DC.W 1
                  DC.L TextScreen
                  DC.W 20,100,TextHeight-1
                  DC.W NEXT_OBJ
                  DC.B 0,1
                  DC.W TextWidth,TextWidth ; Breite
                  DC.B 0,4
                  DC.W $40,$40,$40
*
                  DC.W $AFFE
                  ENDPART
                  >PART 'InitOP'
InitOP:           lea     $F00000,a0
                  lea     $010000,a1
                  moveq   #4,d0
                  clr.l   (a1)
                  move.l  d0,$04(a1)

                  moveq   #1,d0
                  move.l  d0,$20(a0)       ; OPL = $10000
                  clr.w   $26(a0)          ; OPF
                  clr.w   scr_flag(a6)
                  move.w  #$06C1,$28(a0)
                  clr.l   $2A(a0)
;                  move.w  #$3DFF,$58(a0)
                  clr.w   $58(a0)
                  move.w  #$1F01,$E0(a0)
                  clr.w   $E2(a0)
                  move    sr,d0
                  ori     #$0700,sr
                  lea     my_irq(pc),a0
                  move.l  a0,$0100.w
                  and.w   #$F8FF,d0
                  move    d0,sr
                  rts
                  ENDPART
                  ENDC
                  END
