home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / gags / physical / physical.txt < prev   
Encoding:
Text File  |  1990-10-22  |  21.6 KB  |  705 lines
  1. MODULE Physical;
  2.  
  3. (*----------------------------------------------------------------------------
  4.  * System-Version: MOS 3.5
  5.  *----------------------------------------------------------------------------
  6.  * Version       : 1.0
  7.  *----------------------------------------------------------------------------
  8.  * Text-Version  : V#00039
  9.  *----------------------------------------------------------------------------
  10.  * Modul-Holder  : Meinolf Schneider
  11.  *----------------------------------------------------------------------------
  12.  * Copyright May 1990 by Digital Art Meinolf Schneider
  13.  *----------------------------------------------------------------------------
  14.  * MS  : Meinolf Schneider
  15.  *----------------------------------------------------------------------------
  16.  * Datum    Autor Version Bemerkung (Arbeitsbericht)
  17.  *----------------------------------------------------------------------------
  18.  * 06.05.90 MS    1.0     Grundversion
  19.  *----------------------------------------------------------------------------
  20.  * Modul-Beschreibung:
  21.  *
  22.  * Residentes Gimmick-Programm für Atari ST mit monochromen Monitor, bei dem
  23.  * die Maus nach den physikalischen Gesetzen funktioniert.
  24.  *----------------------------------------------------------------------------
  25.  *) (*$S-,R-,C-,N+*)
  26.  
  27.  
  28. FROM    System          IMPORT  ADDRESS, ADR, BYTE;
  29.  
  30. FROM    MSSystems       IMPORT  EnterSupervisorMode,
  31.                                 WriteString, WriteLn, Write;
  32.  
  33. FROM    MSSounds        IMPORT  StartSound, SetSampleFrequency;
  34.  
  35.  
  36. TYPE    FixReal         =       RECORD
  37.                                   CASE  : BOOLEAN OF
  38.                                   FALSE:
  39.                                     I             : INTEGER;
  40.                                     (* Integer-Teil *)
  41.                                     F             : CARDINAL|
  42.                                     (* Fraction-Teil *)
  43.                                   TRUE:
  44.                                     H             : LONGINT;
  45.                                     (* gesamte Zahl *)
  46.                                   END;
  47.                                 END;
  48.  
  49.         FixRealVector   =       RECORD
  50.                                   X, Y            : FixReal;
  51.                                 END;
  52.  
  53.  
  54.  
  55.         MouseRec        =       RECORD
  56.                                   Mass                    : FixReal;
  57.                                   UserPower               : FixReal;
  58.                                   DesktopFriction         : FixReal;
  59.                                   DesktopGravity          : FixRealVector;
  60.                                   
  61.                                   Speed                   : FixRealVector;
  62.                                   Position                : FixRealVector;
  63.                                   Impulse                 : FixRealVector;
  64.                                 
  65.                                   ScreenMaximum           : FixRealVector;
  66.                                 END;
  67.  
  68.  
  69. CONST           (* Zugriffoffsets für LineA-Variablen *)
  70.                 V_REZ_HZ           =       -$C;
  71.                 V_REZ_VT           =       -$4;
  72.                 CUR_X              =       -$158;
  73.                 CUR_Y              =       -$156;
  74.                 GCURX              =       -$25A;
  75.                 GCURY              =       -$258;
  76.                 CUR_FLAG           =       -$154;
  77.                 CUR_MS_STAT        =       -$15C;
  78.                 USER_MOT           =       -$32;
  79.                 MOUSE_BT           =       -$253;
  80.                 M_HID_CT           =       -$256;
  81.                 
  82.  
  83. VAR     VBLStack                : ARRAY[0..100] OF CARDINAL;
  84.         OldVBLIRQ               : ADDRESS;
  85.         
  86.         i                       : CARDINAL;
  87.         
  88.         MouseChanged            : BYTE;
  89.         Collision               : BYTE;
  90.         DoPhysical              : BYTE;
  91.         
  92.         Mouse                   : MouseRec;
  93.         LineA                   : ADDRESS;
  94.         
  95.         OldMouseVector          : ADDRESS;
  96.         OldIKBDSYS              : ADDRESS;
  97.         KeyBuffer               : POINTER TO RECORD
  98.                                     BufferStart : ADDRESS;
  99.                                     size        : CARDINAL;
  100.                                     head        : CARDINAL; (* nächste Taste an *)
  101.                                     tail        : CARDINAL; (* nächste Taste rein *)
  102.                                   END;
  103.  
  104.         
  105.         
  106. (*---------------------------------------------------------------------------*)
  107.  
  108. TABLE.L KlickSound:
  109.          $80828689, $8B8C8D8D, $8D8D8089, $D6D8D8D8, $D8D8D8D8, $D8D8D8D8,
  110.          $D6B26630, $27272727, $27272727, $27272727, $27272727, $27272727,
  111.          $27272727, $27272727, $27272727, $2727272E, $475E7489, $A1B7CAD8,
  112.          $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8,
  113.          $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D7,
  114.          $D2CDC8C4, $C1BEBCBA, $B7B5B3B2, $B1B0AEAF, $AEACACAA, $A9A8A7A7,
  115.          $A6A5A5A2, $A09F9E9C, $9A999999, $99999999, $99979696, $95949391,
  116.          $908E8D8B, $8A888786, $84828281, $80808080, $7F7E7E7E, $7F808080,
  117.          $80808082, $84848687, $898A8D8F, $91939494, $9698999B, $9D9E9F9F,
  118.          $A0A1A2A2, $A3A4A4A4, $A5A4A4A3, $A3A2A1A1, $A2A1A2A1, $A09F9E9B,
  119.          $9A989795, $95949290, $908E8F8E, $8D8D8B89, $87868585, $84848281,
  120.          $80807F7E, $7D7B7A79, $78777775, $73716F6E, $6D6D6C6A, $69676665,
  121.          $65646362, $6160605F, $5E5D5C5B, $5B5A5A59, $59585858, $59595A5A,
  122.          $5A5B5B5B, $5B5C5C5C, $5D5E5E5F, $5F5F5F5E, $5E5F5F5F, $5E5E5D5E,
  123.          $5E5E5F60, $61626262, $62626261, $60606060, $5F5F5E5D, $5C5B5B5B,
  124.          $5A5A5A5B, $5B5B5B5A, $5A595959, $59595959, $58575758, $59595959,
  125.          $59595A5A, $5B5B5C5D, $5E5E6061, $62636565, $67696A6C, $6E6F7071,
  126.          $73737577, $78797A7B, $7C7C7D7E, $7E7F8080, $80808081, $81818080,
  127.          $80818282, $82828282, $83838484, $84848585, $86868686, $86878788,
  128.          $88888888, $88888888, $88888888, $88888989, $8989898A, $8A8B8B8B,
  129.          $8B8B8B8C, $8D8D8D8D, $8C8D8D8D, $8D8E8E8D, $8E8E8F8F, $90909090,
  130.          $91919292, $92929393, $94949494, $94949495, $95959696, $96979797,
  131.          $97979797, $97989999, $99989999, $99999999, $9A9B9B9B, $9C9C9C9D,
  132.          $9D9E9E9E, $A0A0A0A0, $A0A1A1A1, $A2A2A3A3, $A3A3A3A3, $A4A4A4A4,
  133.          $A4A5A5A5, $A5A4A4A4, $A4A4A4A4, $A4A4A3A3, $A2A2A2A2, $A2A2A2A2,
  134.          $A1A1A2A1, $A1A1A1A1, $A1A0A0A0, $A0A09F9F, $9E9F9E9E, $9E9E9D9C,
  135.          $9C9B9B9B, $9B9A9A99, $99999999, $98979797, $97979696, $95959494,
  136.          $94939292, $92929190, $90909090, $8F8E8D8D, $8D8D8D8D, $8C8B8B8A,
  137.          $8A8A8989, $89888888, $87868686, $86858585, $84848483, $82828282,
  138.          $81808080, $80807F7F, $7E7E7E7E, $7E7E7D7D, $7C7C7C7C, $7C7C7C7C,
  139.          $7C7C7C7B, $7B7A7B7B, $7A7A7A7A, $7A7A7A7A, $7A7A7A7A, $7A7A7A7A,
  140.          $7A7A7A7A, $7A7A7A7B, $7A7B7B7B, $7B7C7C7C, $7C7D7D7E, $7E7E7E7E,
  141.          $7E7E7F7F, $7F7F8080, $80808000;
  142.  
  143.  
  144.  
  145. (*---------------------------------------------------------------------------*)
  146.  
  147.  
  148. (*$L-*)
  149. PROCEDURE KeyBufferCheck;
  150. BEGIN
  151.   ASSEMBLER
  152.   move.w        SR,-(A7)
  153.   ori.w         #$0700,SR
  154.   
  155.   movem.l       A0/D0,-(A7)
  156.   
  157.   move.l        LineA,A0
  158.   btst          #1,MOUSE_BT(A0)         ; Rechte Maustaste gedrückt?
  159.   beq.w         ED                      ; Nee !
  160.   
  161.   move.l        KeyBuffer,A0
  162.   move.w        KeyBuffer.tail(A0),D0
  163.   cmp.w         KeyBuffer.head(A0),D0
  164.   beq.w         ED                      ; Nix drin!
  165.  
  166.   move.w        KeyBuffer.tail(A0),D0
  167.   sub.w         KeyBuffer.head(A0),D0
  168.   bcc           ok
  169.   add.w         KeyBuffer.size(A0),D0
  170.  !ok
  171.   lsr.w         #2,D0           ; DIV 4
  172.   subq.w        #1,D0
  173.   
  174.   movem.l       A1-A3/D1,-(A7)
  175.   
  176.   move.l        LineA,A2
  177.   lea           Mouse,A3
  178.   
  179.   move.w        KeyBuffer.head(A0),D1
  180.   move.l        KeyBuffer.BufferStart(A0),A1
  181.  
  182.  !NextKey
  183.   addq.w        #4,D1
  184.   cmp.w         KeyBuffer.size(A0),D1
  185.   bcs           NoWarpAround
  186.   clr.w         D1
  187.  !NoWarpAround
  188.   
  189.   ; Physical Mouse an/aus
  190.   cmpi.b        #' ',3(A1,D1.W)
  191.   bne           NoOnOff
  192.   not.b         DoPhysical
  193.   beq.w         Goon
  194.   move.w        GCURX(A2),MouseRec.Position.X(A3)
  195.   move.w        GCURY(A2),MouseRec.Position.Y(A3)
  196.   clr.w         MouseRec.Position.X.F(A3)
  197.   clr.w         MouseRec.Position.Y.F(A3)
  198.   clr.l         MouseRec.Speed.X(A3)
  199.   clr.l         MouseRec.Speed.Y(A3)
  200.   bra.w         Goon
  201.  
  202.  !NoOnOff
  203.   cmpi.b        #'5',3(A1,D1.W)
  204.   bne           NoZeroGravity
  205.   clr.l         MouseRec.DesktopGravity.X(A3)
  206.   clr.l         MouseRec.DesktopGravity.Y(A3)
  207.   bra.w         Goon
  208.   
  209.  !NoZeroGravity
  210.   cmpi.b        #'8',3(A1,D1.W)
  211.   bne           NoUpGravity
  212.   subi.l        #$100,MouseRec.DesktopGravity.Y(A3)
  213.   bra.w         Goon
  214.  
  215.  !NoUpGravity
  216.   cmpi.b        #'2',3(A1,D1.W)
  217.   bne           NoDownGravity
  218.   addi.l        #$100,MouseRec.DesktopGravity.Y(A3)
  219.   bra.w         Goon
  220.  
  221.  !NoDownGravity
  222.   cmpi.b        #'4',3(A1,D1.W)
  223.   bne           NoLeftGravity
  224.   subi.l        #$100,MouseRec.DesktopGravity.X(A3)
  225.   bra.w         Goon
  226.  
  227.  !NoLeftGravity
  228.   cmpi.b        #'6',3(A1,D1.W)
  229.   bne           NoRightGravity
  230.   addi.l        #$100,MouseRec.DesktopGravity.X(A3)
  231.   bra.w         Goon
  232.  
  233.  !NoRightGravity
  234.   cmpi.b        #'7',3(A1,D1.W)
  235.   bne           NoLessPower
  236.   subi.w        #$1,MouseRec.UserPower.I(A3)
  237.   bpl.w         Goon
  238.   clr.w         MouseRec.UserPower.I(A3)
  239.   bra.w         Goon
  240.  
  241.  !NoLessPower
  242.   cmpi.b        #'9',3(A1,D1.W)
  243.   bne           NoMorePower
  244.   addi.w        #$1,MouseRec.UserPower.I(A3)
  245.   bra.w         Goon
  246.  
  247.  !NoMorePower
  248.   cmpi.b        #'1',3(A1,D1.W)
  249.   bne           NoLessFriction
  250.   addi.l        #$100,MouseRec.DesktopFriction(A3)
  251.   cmpi.l        #$10000,MouseRec.DesktopFriction(A3)
  252.   ble.w         Goon
  253.   move.l        #$10000,MouseRec.DesktopFriction(A3)
  254.   bra.w         Goon
  255.  
  256.  !NoLessFriction
  257.   cmpi.b        #'3',3(A1,D1.W)
  258.   bne           NoMoreFriction
  259.   subi.l        #$100,MouseRec.DesktopFriction(A3)
  260.   bpl.w         Goon
  261.   clr.l         MouseRec.DesktopFriction(A3)
  262.   bra.w         Goon
  263.  
  264.  !NoMoreFriction
  265.   cmpi.b        #'-',3(A1,D1.W)
  266.   bne           NoLessMass
  267.   addi.l        #$1,MouseRec.Mass(A3)
  268.   cmpi.l        #$90,MouseRec.Mass(A3)
  269.   ble.w         Goon
  270.   move.l        #$90,MouseRec.Mass(A3)
  271.   bra.w         Goon
  272.  
  273.  !NoLessMass
  274.   cmpi.b        #'+',3(A1,D1.W)
  275.   bne           NoMoreMass
  276.   subi.l        #$1,MouseRec.Mass(A3)
  277.   bpl           Goon
  278.   clr.l         MouseRec.Mass(A3)
  279.  
  280.  !NoMoreMass
  281.  !Goon
  282.   dbf.w         D0,NextKey
  283.   
  284.   ; Tastaturbuffer löschen
  285.   move.w        KeyBuffer.tail(A0),KeyBuffer.head(A0)
  286.   
  287.   movem.l       (A7)+,A1-A3/D1
  288.   
  289.  !ED
  290.   movem.l       (A7)+,A0/D0
  291.   move.w        (A7)+,SR
  292.   END;
  293. END KeyBufferCheck;
  294. (*$L+*)
  295.  
  296.  
  297.  
  298. (*$L-*)
  299. PROCEDURE KeyXBRA;
  300. BEGIN
  301.   ASSEMBLER
  302.   asc           'XBRA'
  303.   asc           'PHYS'
  304.   dc.w          0
  305.   END;
  306. END KeyXBRA;
  307. (*$L+*)
  308.  
  309. (*$L-*)
  310. PROCEDURE NewKeyVector;
  311. BEGIN
  312.   ASSEMBLER
  313.   pea           KeyBufferCheck          ; Erst die alte Routine aufrufen, damit
  314.   move.l        OldIKBDSYS,-(A7)        ; diese den Tastaturbuffer füllt.
  315.   END;
  316. END NewKeyVector;
  317. (*$L+*)
  318.  
  319.  
  320. (*---------------------------------------------------------------------------*)
  321.  
  322. (*$L-*)
  323. PROCEDURE MouseXBRA;
  324. BEGIN
  325.   ASSEMBLER
  326.   asc           'XBRA'
  327.   asc           'PHYS'
  328.   dc.w          0
  329.   END;
  330. END MouseXBRA;
  331. (*$L+*)
  332.  
  333. (*$L-*)
  334. PROCEDURE NewMouseVector;
  335. BEGIN
  336.   ASSEMBLER
  337.   tst.b         DoPhysical
  338.   beq           DoOld
  339.   
  340.   movem.l       A1-A2/D0,-(A7)
  341.   lea           Mouse,A1
  342.   move.l        LineA,A2
  343.   move.b        1(A0),D0
  344.   ext.w         D0
  345.   add.w         D0,MouseRec.Impulse.X(A1)
  346.   move.w        MouseRec.Position.X(A1),CUR_X(A2)  ; wegen Protos. oder
  347.   move.w        MouseRec.Position.X(A1),GCURX(A2)  ; andere trickreiche
  348.   move.b        2(A0),D0                           ; Zeitgenossen...
  349.   ext.w         D0
  350.   add.w         D0,MouseRec.Impulse.Y(A1)
  351.   move.w        MouseRec.Position.Y(A1),CUR_Y(A2)
  352.   move.w        MouseRec.Position.Y(A1),GCURY(A2)
  353.   
  354.   clr.b         1(A0)   ; unsere Ostereier => 00
  355.   clr.b         2(A0)
  356.   movem.l       (A7)+,A1-A2/D0
  357.   
  358.  !DoOld
  359.   move.l        OldMouseVector,-(A7)
  360.   END;
  361. END NewMouseVector;
  362. (*$L+*)
  363.  
  364.  
  365.  
  366. (*---------------------------------------------------------------------------*)
  367.  
  368. (*$L-*)
  369. PROCEDURE MulFixReals ( F1  : FixReal;
  370.                         F2  : FixReal ): FixReal;
  371. BEGIN
  372.   ASSEMBLER
  373.   movem.l       D3-D7,-(A7)
  374.   move.l        -(A3),D0        ; F2
  375.   move.l        -(A3),D2        ; F3
  376.   
  377.   clr.w         D5              ; Vorzeichenflag
  378.   
  379.   tst.l         D0              ; Faktor 2 negativ ?
  380.   bpl           go
  381.   neg.l         D0
  382.   eori.w        #1,D5
  383.  !go
  384.   tst.l         D2
  385.   bpl           go2             ; Faktor 1 negativ ?
  386.   neg.l         D2
  387.   eori.w        #1,D5
  388.  !go2
  389.   
  390.   move.w        D5,-(A7)        ; Vorzeichen des Ergebnisses merken
  391.   
  392.   
  393.   swap          D0
  394.   move.w        D0,D1           ; D1.W = HighWord (Vorkomma) Faktor 2
  395.   swap          D0              ; D0.W = LowWord (Nachkomma) Faktor 2
  396.   
  397.   swap          D2
  398.   move.w        D2,D3           ; D3.W = HighWord (Vorkomma) Faktor 1
  399.   swap          D2              ; D2.W = LowWord (Nachkomma) Faktor 1
  400.   
  401.   ; D6.L = LowDoubleWord Ergebnis
  402.   ; D7.L = HighDoubleWord Ergebnis
  403.   
  404.   move.w        D2,D6           ; Frac (F2) * Frac (F1)
  405.   mulu          D0,D6           ; = LowDoubleWord
  406.   
  407.   move.w        D3,D7           ; Trunc (F2) * Trunc (F1)
  408.   mulu          D1,D7           ; = HightDoubleWord
  409.   
  410.   mulu          D0,D3           ; Frac (F2) * Trunc (F1)
  411.   moveq.l       #0,D4
  412.   move.w        D3,D4           ; => HighWord of LowDoubleWord
  413.   swap          D4
  414.   moveq.l       #0,D5
  415.   swap          D3              ; und LowWord of HighDoubleWord
  416.   move.w        D3,D5
  417.   
  418.   add.l         D4,D6           ; zum Ergebnis addieren
  419.   addx.l        D5,D7
  420.   
  421.   mulu          D1,D2           ; Trunc (F2) * Frac (F1)
  422.   moveq.l       #0,D4
  423.   move.w        D2,D4           ; => HightWord of LowDoubleWord
  424.   swap          D4
  425.   moveq.l       #0,D5           ; und LowWord of HighDoubleWord
  426.   swap          D2
  427.   move.w        D2,D5
  428.   
  429.   add.l         D4,D6           ; wieder addieren
  430.   addx.l        D5,D7
  431.   
  432.   move.w        D7,D6           ; Ergebnis ist (ohne Rangecheck!)
  433.   swap          D6              ; (LowWord of HighDoubleWord und
  434.   tst.w         (A7)+           ; HightWord of LowDoubleWord) => FIXREAL
  435.   beq           go3
  436.   neg.l         D6              ; Vorzeichen wieder anbringen
  437.   
  438.  !go3
  439.   move.l        D6,(A3)+        ; fertig
  440.   
  441.   movem.l       (A7)+,D3-D7
  442.   END;
  443. END MulFixReals;
  444. (*$L+*)
  445.  
  446.  
  447.  
  448. (*---------------------------- VBL - Interrupt -----------------------------*)
  449.  
  450. (*$L-*)
  451. PROCEDURE VBLXBRA;
  452. BEGIN
  453.   ASSEMBLER
  454.   asc           'XBRA'
  455.   asc           'PHYS'
  456.   dc.w          0
  457.   END;
  458. END VBLXBRA;
  459. (*$L+*)
  460.  
  461. (*$L-*)
  462. PROCEDURE VBLIRQ;
  463. BEGIN
  464.   ASSEMBLER
  465.   movem.l       D0-D7/A0-A6,-(A7)
  466.   
  467.   bset          #3,$484
  468.   
  469.   lea           VBLStack,A3             ; Jetzt nehmen wir unseren Stack,
  470.   
  471.   jsr           KeyBufferCheck
  472.   
  473.   tst.b         DoPhysical
  474.   beq.w         ED
  475.   
  476.   sf            Collision
  477.   
  478.   move.l        LineA,A1
  479.   lea           Mouse,A0
  480.   sf            MouseChanged
  481.   
  482.   move.l        MouseRec.UserPower(A0),(A3)+
  483.   move.l        MouseRec.Impulse.X(A0),(A3)+
  484.   clr.l         MouseRec.Impulse.X(A0)
  485.   jsr           MulFixReals                     ; Gesamtkraft => A3-Stack
  486.   move.l        MouseRec.Mass(A0),(A3)+
  487.   jsr           MulFixReals                     ; a=F/m => A3-Stack
  488.   move.l        -(A3),D1
  489.   add.l         MouseRec.Speed.X(A0),D1
  490.   add.l         MouseRec.DesktopGravity.X(A0),D1
  491.   move.l        D1,(A3)+
  492.   move.l        MouseRec.DesktopFriction(A0),(A3)+
  493.   jsr           MulFixReals
  494.   move.l        -(A3),D1
  495.   move.l        D1,MouseRec.Speed.X(A0)
  496.   add.l         MouseRec.Position.X(A0),D1
  497.   bpl           NotOverTheLeft
  498.   clr.l         D1
  499.   neg.l         MouseRec.Speed.X(A0)
  500.   tst.w         MouseRec.Speed.X.I(A0)
  501.   beq           SetXPosition
  502.   st            Collision
  503.   bra           SetXPosition
  504.  !NotOverTheLeft
  505.   cmp.l         MouseRec.ScreenMaximum.X(A0),D1
  506.   bls           NotOverTheRight
  507.   neg.l         MouseRec.Speed.X(A0)
  508.   move.l        MouseRec.ScreenMaximum.X(A0),D1
  509.   cmpi.w        #$FFFF,MouseRec.Speed.X.I(A0)
  510.   beq           SetXPosition
  511.   st            Collision
  512.  !NotOverTheRight
  513.  !SetXPosition
  514.   move.l        D1,MouseRec.Position.X(A0)
  515.   swap          D1
  516.   cmp.w         GCURX(A1),D1
  517.   beq           NoXSet
  518.   move.w        D1,GCURX(A1)
  519.   move.w        D1,CUR_X(A1)
  520.   st            MouseChanged
  521.  !NoXSet
  522.   
  523.   
  524.   move.l        MouseRec.UserPower(A0),(A3)+
  525.   move.l        MouseRec.Impulse.Y(A0),(A3)+
  526.   clr.l         MouseRec.Impulse.Y(A0)
  527.   jsr           MulFixReals                     ; Gesamtkraft => A3-Stack
  528.   move.l        MouseRec.Mass(A0),(A3)+
  529.   jsr           MulFixReals                   ; a=F/m => A3-Stack
  530.   move.l        -(A3),D1
  531.   add.l         MouseRec.Speed.Y(A0),D1
  532.   add.l         MouseRec.DesktopGravity.Y(A0),D1
  533.   move.l        D1,(A3)+
  534.   move.l        MouseRec.DesktopFriction(A0),(A3)+
  535.   jsr           MulFixReals                   ; v'=v*f => A3-Stack
  536.   move.l        -(A3),D1
  537.   move.l        D1,MouseRec.Speed.Y(A0)
  538.   add.l         MouseRec.Position.Y(A0),D1
  539.   bpl           NotOverTheTop
  540.   neg.l         MouseRec.Speed.Y(A0)
  541.   clr.l         D1
  542.   tst.w         MouseRec.Speed.Y.I(A0)
  543.   beq           SetYPosition
  544.   st            Collision
  545.   bra           SetYPosition
  546.  !NotOverTheTop
  547.   cmp.l         MouseRec.ScreenMaximum.Y(A0),D1
  548.   bls           NotOverTheBottom
  549.   neg.l         MouseRec.Speed.Y(A0)
  550.   move.l        MouseRec.ScreenMaximum.Y(A0),D1
  551.   cmpi.w        #$FFFF,MouseRec.Speed.Y.I(A0)
  552.   beq           SetYPosition
  553.   st            Collision
  554.  !NotOverTheBottom
  555.  !SetYPosition
  556.   move.l        D1,MouseRec.Position.Y(A0)
  557.   swap          D1
  558.   cmp.w         GCURY(A1),D1
  559.   beq           NoYSet
  560.   move.w        D1,GCURY(A1)
  561.   move.w        D1,CUR_Y(A1)
  562.   st            MouseChanged
  563.  !NoYSet
  564.   
  565.   
  566.   tst.b         MouseChanged
  567.   beq           ED
  568.   move.w        GCURX(A1),D0
  569.   move.w        GCURY(A1),D1
  570.   move.l        USER_MOT(A1),A1
  571.   move.w        SR,-(A7)
  572.   ori.w         #$0700,SR
  573.   jsr           (A1)
  574.   move.w        (A7)+,SR
  575.   move.l        LineA,A1
  576.   tst.w         M_HID_CT(A1)
  577.   bne           MouseIsFutsch
  578.   st            CUR_FLAG(A1)
  579.   bset          #5,CUR_MS_STAT(A1)
  580.   
  581.  !MouseIsFutsch
  582.   tst.b         Collision
  583.   beq           ED
  584.   lea           VBLStack,A3
  585.   move.l        #KlickSound,(A3)+
  586.   clr.w         (A3)+
  587.   jsr           StartSound
  588.  
  589.  !ED
  590.   movem.l       (A7)+,D0-D7/A0-A6
  591.  
  592.   move.l        OldVBLIRQ,-(A7)         ; alte VBL-Routine macht weiter...
  593.   END;
  594. END VBLIRQ;
  595. (*$L+*)
  596.  
  597.  
  598. (*$L-*)
  599. PROCEDURE InstallVBLIRQ;
  600. BEGIN
  601.   ASSEMBLER
  602.   jsr           EnterSupervisorMode
  603.   move.w        SR,-(A7)
  604.   ori.w         #$0700,SR
  605.   
  606.   move.l        $70,OldVBLIRQ
  607.   lea           VBLXBRA,A0
  608.   lea           VBLIRQ,A0
  609.   move.l        $70,-4(A0)              ; XBRA-Vektor setzen
  610.   move.l        A0,$70
  611.   
  612.   move.w        (A7)+,SR
  613.   andi.w        #$DFFF,SR
  614.   END;
  615. END InstallVBLIRQ;
  616. (*$L+*)
  617.  
  618.  
  619.  
  620.  
  621. (*--------------------------------------------------------------------------*)
  622.  
  623. BEGIN
  624.   Writeln;
  625.   WriteString ( 'PHYSICAL CURSOR installed.' );
  626.   Writeln;
  627.   WriteString ( 'Written with MEGAMAX MODULA-2 for the TOS-Magazin by Meinolf Schneider' );
  628.   Writeln;
  629.   WriteString ( '© May 1990 by Meinolf Schneider' );
  630.   Writeln;
  631.   Writeln;
  632.   FOR i := 0 TO 30000 DO END;
  633.   FOR i := 0 TO 30000 DO END;
  634.   
  635.   SetSampleFrequency ( 9000 );
  636.   
  637.   ASSEMBLER
  638.   ; Adressen der LineA-Variablen abfragen und setzen
  639.   dc.w          $A000
  640.   move.l        A0,LineA
  641.   
  642.   move.w        #1,-(A7)        ; I/O-Buffer f. Tastatur ermitteln
  643.   move.w        #14,-(A7)
  644.   trap          #14
  645.   addq.w        #4,A7
  646.   move.l        D0,KeyBuffer
  647.   
  648.   
  649.   move.w        #34,-(A7)       ; Keyboardvektoren abfragen
  650.   trap          #14
  651.   addq.l        #2,A7
  652.   move.l        D0,A1
  653.   
  654.   jsr           EnterSuperVisorMode
  655.   move.w        SR,-(A7)
  656.   ori.w         #$0700,SR
  657.   
  658.   ; Mousevektor umbiegen...
  659.   lea           MouseXBRA,A0
  660.   move.l        16(A1),OldMouseVector
  661.   move.l        16(A1),(A0)
  662.   move.l        #NewMouseVector,16(A1)
  663.   
  664.   ; Keyboardvektor umbiegen...
  665.   lea           KeyXBRA,A0
  666.   move.l        32(A1),OldIKBDSYS
  667.   move.l        32(A1),8(A0)
  668.   move.l        #NewKeyVector,32(A1)
  669.   
  670.   
  671.   ; Startwerte setzen
  672.   move.l        LineA,A0
  673.   lea           Mouse,A1
  674.   move.w        GCURX(A0),MouseRec.Position.X(A1)
  675.   move.w        GCURY(A0),MouseRec.Position.Y(A1)
  676.   clr.w         MouseRec.Position.X.F(A1)
  677.   clr.w         MouseRec.Position.Y.F(A1)
  678.   move.l        #$140000,MouseRec.UserPower(A1)
  679.   move.l        #$FC00,MouseRec.DesktopFriction(A1)
  680.   clr.l         MouseRec.DesktopGravity.X(A1)
  681.   move.l        #$1000,MouseRec.DesktopGravity.Y(A1)
  682.   move.l        #$90,MouseRec.Mass(A1)
  683.   clr.l         MouseRec.Speed.X(A1)
  684.   clr.l         MouseRec.Speed.Y(A1)
  685.   clr.l         MouseRec.Impulse.X(A1)
  686.   clr.l         MouseRec.Impulse.Y(A1)
  687.   
  688.   clr.w         MouseRec.ScreenMaximum.X.F(A1)
  689.   move.w        V_REZ_HZ(A0),MouseRec.ScreenMaximum.X(A1)
  690.   subq.w        #1,MouseRec.ScreenMaximum.X(A1)
  691.   clr.w         MouseRec.ScreenMaximum.Y.F(A1)
  692.   move.w        V_REZ_VT(A0),MouseRec.ScreenMaximum.Y(A1)
  693.   subq.w        #1,MouseRec.ScreenMaximum.Y(A1)
  694.   
  695.   
  696.   st            DoPhysical
  697.   
  698.   move.w        (A7)+,SR
  699.   andi.w        #$DFFF,SR
  700.   END;
  701.   
  702.   InstallVBLIRQ;
  703. END Physical.
  704.  
  705.