home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / gags / snow / snow.txt < prev   
Text File  |  1990-10-22  |  28KB  |  787 lines
  1. MODULE Snow;
  2.  
  3. (*----------------------------------------------------------------------------
  4.  * System-Version: MOS 3.5
  5.  *----------------------------------------------------------------------------
  6.  * Version       : 1.0
  7.  *----------------------------------------------------------------------------
  8.  * Text-Version  : V#00034
  9.  *----------------------------------------------------------------------------
  10.  * Modul-Holder  : Meinolf Schneider
  11.  *----------------------------------------------------------------------------
  12.  * Copyright July 1990 by Digital Art Meinolf Schneider
  13.  *----------------------------------------------------------------------------
  14.  * MS  : Meinolf Schneider
  15.  *----------------------------------------------------------------------------
  16.  * Datum    Autor Version Bemerkung (Arbeitsbericht)
  17.  *----------------------------------------------------------------------------
  18.  * 27.07.90 MS    1.0     Grundversion
  19.  *----------------------------------------------------------------------------
  20.  * Modul-Beschreibung:
  21.  *
  22.  * Residentes Gimmick-Programm für Atari ST mit monochromen Monitor, bei dem
  23.  * Schneefall und Vereisung simuliert wird. Die Vereisung kann mit einem
  24.  * Eiskratzer entfernt werden.
  25.  *----------------------------------------------------------------------------
  26.  *) (*$S-,R-,C-,N+,M-*)
  27.  
  28.  
  29. FROM    System          IMPORT  ADDRESS, ADR, BYTE;
  30.  
  31. FROM    MSSystems       IMPORT  MinMaxRandom, EnterSupervisorMode,
  32.                                 Allocate;
  33.  
  34. FROM    MSGraphics      IMPORT  Sprite, CopyScreen, Switch, SwitchSides,
  35.                                 DisplayScreen, WorkScreen,
  36.                                 DrawText, GetSystemScreen, FillScreen,
  37.                                 ClearScreen;
  38.  
  39. FROM    MSMouse         IMPORT  MouseRec, ReadMouse;
  40.  
  41. FROM    MSSounds        IMPORT  Sound, StartASound, StopASound, NewSound,
  42.                                 ASoundIsActive, SetSampleFrequency;
  43.  
  44.  
  45. CONST   PicFreq                 =       4; (* Alle vier VBLs ein Bild malen *)
  46.         PicsPerSec              =       72 DIV PicFreq;
  47.          
  48.         sTRUE                   =       BYTE ( $00 );
  49.         sFALSE                  =       BYTE ( $FF );
  50.         
  51.         TitleTime               =       3 * 60 * PicsPerSec;
  52.                                         (* 3 Minuten *)
  53.         SnowBegin               =       60 * PicsPerSec;
  54.                                         (* 1 Minute *)
  55.         
  56.         MaxNoOfSnowFlakes       =       200;
  57.  
  58.  
  59. TYPE     Bool            =       BYTE; (* 00=FALSE, FF=TRUE *)
  60.          
  61.          SnowFlake       =       RECORD
  62.                                   IsThere                       : Bool;
  63.                                   
  64.                                   WordPosition                  : CARDINAL;
  65.                                   FallOffset                    : CARDINAL;
  66.                                   (* Offset in Bytes für neue Fallposition der
  67.                                    * Schneeflocke *)
  68.                                   
  69.                                   HorPosition                   : CARDINAL;
  70.                                   HorCenterLongWordPosition     : CARDINAL;
  71.                                   
  72.                                   ThreePointPattern             : LONGCARD;
  73.                                   OnePointPattern               : LONGCARD;
  74.                                 
  75.                                   CheckANDPattern               : LONGCARD;
  76.                                   CheckStopValue                : LONGCARD;
  77.                                   CheckRightFallValue           : LONGCARD;
  78.                                   CheckLeftFallValue            : LONGCARD;
  79.                                   CheckRightLeftOrStopValue     : LONGCARD;
  80.                                 END;
  81.  
  82.  
  83. VAR     VBLStack                : ARRAY[0..99] OF CARDINAL;
  84.         VBLTimer                : CARDINAL;
  85.         OldVBLIRQ               : ADDRESS;
  86.         
  87.         TOSScreen               : ADDRESS;
  88.         
  89.         TOSScreenOnDisplay      : BOOLEAN;
  90.         DirectTOSScreenShow     : BOOLEAN;
  91.         
  92.         SnowScreen              : ADDRESS;
  93.         SnowSpriteList          : ADDRESS;
  94.         
  95.         SnowRate                : CARDINAL;
  96.         (* 0 = jedes mal eine neue Schneeflocke
  97.          * x = Möglichkeit einer neuer Schneeflocke 1:x
  98.          *)
  99.         SnowFlakes              : ARRAY[0..MaxNoOfSnowFlakes] OF SnowFlake;
  100.         SnowLines               : ARRAY[0..400] OF Byte;
  101.         SnowThere               : BOOLEAN;
  102.         (* TRUE, wenn es anfängt zu schneien *)
  103.         SnowWait                : CARDINAL;
  104.         (* Wartezeit, bis es anfängt zu schneien *)
  105.         
  106.         ShowTitle               : BOOLEAN;
  107.         (* TRUE, wenn die Copyright-Meldung zu sehen ist. *)
  108.         TitleWasThere           : BOOLEAN;
  109.         (* TRUE, wenn die Copyright-Meldung zu sehen war. *)
  110.         TitleTimer              : CARDINAL;
  111.         
  112.         ScratchSoundADR         : ADDRESS;
  113.         ScratchSound            : Sound;
  114.         
  115.         IceScratchThere         : BOOLEAN;
  116.         MyMouse                 : MouseRec;
  117.         
  118.         
  119. (*---------------------------------------------------------------------------*)
  120.  
  121. TABLE.L  TabSnowSpriteList:
  122.          $0000061C, $00028000, $00000010, $00000460, $FFF7FFF7, $00120012,
  123.          $00080001, $0000004C, $0000008A, $000000C8, $00000106, $00000144,
  124.          $00000182, $000001C0, $000001FE, $0000024E, $0000028C, $000002CA,
  125.          $00000308, $00000346, $00000384, $000003C2, $00000400, $0000003E,
  126.          $00030012, $00010107, $071E1D7A, $756A351A, $0D060301, $000000C0,
  127.          $E0B058AC, $56AB55AA, $55AB56AC, $58B0E000, $00000000, $00000000,
  128.          $80808000, $00000000, $00000000, $003E0003, $00120000, $0003030F,
  129.          $0E3D3A35, $1A0D0603, $01000000, $00E0F0D8, $AC56AB55, $AA55AA55,
  130.          $AB56ACD8, $70000000, $00000000, $0080C040, $C0800000, $00000000,
  131.          $0000003E, $00030012, $00000001, $0107071E, $1D1A0D06, $03010000,
  132.          $00000070, $78ECD6AB, $55AA55AA, $55AA55AB, $D66C3800, $00000000,
  133.          $000080C0, $60A060C0, $80000000, $00000000, $003E0003, $00120000,
  134.          $00000003, $030F0E0D, $06030100, $00000000, $00383CF6, $EBD5AA55,
  135.          $AA55AA55, $AAD56B36, $1C000000, $00000080, $C060B050, $B060C080,
  136.          $00000000, $0000003E, $00030012, $00000000, $00010107, $07060301,
  137.          $00000000, $0000001C, $1E7B75EA, $D5AA55AA, $55AAD56A, $351B0E00,
  138.          $00000000, $80C060B0, $58A858B0, $60C08000, $00000000, $003E0003,
  139.          $00120000, $00000000, $00030303, $01000000, $00000000, $000E0F3D,
  140.          $3AF5EAD5, $AA55AAD5, $6A351A0D, $07000000, $0080C060, $B058AC54,
  141.          $AC58B060, $C0800000, $0000003E, $00030012, $00000000, $00000001,
  142.          $01010000, $00000000, $00000007, $071E1D7A, $75EAD5AA, $D56A351A,
  143.          $0D060300, $000080C0, $60B058AC, $56AA56AC, $58B060C0, $80000000,
  144.          $00500004, $00120000, $00000000, $00000000, $00000000, $00000000,
  145.          $0003030F, $0E3D3AF5, $EAD56A35, $1A0D0603, $01000080, $C060B058,
  146.          $AC56AB55, $AB56AC58, $B060C000, $00000000, $00000000, $00000000,
  147.          $00000000, $00000000, $003E0003, $0012FCFC, $F0F0C0C0, $00000000,
  148.          $0080C0E0, $F0F8FCFE, $1F0F0703, $01000000, $00000000, $00000103,
  149.          $070FFFFF, $FFFFFFFF, $7F3F3F3F, $3F3F7FFF, $FFFFFFFF, $0000003E,
  150.          $00030012, $FEFEF8F8, $E0E08080, $808080C0, $E0F0F8FC, $FEFF0F07,
  151.          $03010000, $00000000, $00000000, $00010307, $FFFFFFFF, $FF7F3F1F,
  152.          $1F1F1F1F, $3F7FFFFF, $FFFF0000, $003E0003, $0012FFFF, $FCFCF0F0,
  153.          $C0C0C0C0, $C0E0F0F8, $FCFEFFFF, $07030100, $00000000, $00000000,
  154.          $00000000, $0183FFFF, $FFFF7F3F, $1F0F0F0F, $0F0F1F3F, $7FFFFFFF,
  155.          $0000003E, $00030012, $FFFFFEFE, $F8F8E0E0, $E0E0E0F0, $F8FCFEFF,
  156.          $FFFF8381, $00000000, $00000000, $00000000, $000080C1, $FFFFFF7F,
  157.          $3F1F0F07, $07070707, $0F1F3F7F, $FFFF0000, $003E0003, $0012FFFF,
  158.          $FFFFFCFC, $F0F0F0F0, $F0F8FCFE, $FFFFFFFF, $C1C00000, $00000000,
  159.          $00000000, $00000080, $C0E0FFFF, $7F3F1F0F, $07030303, $0303070F,
  160.          $1F3F7FFF, $0000003E, $00030012, $FFFFFFFF, $FEFEF8F8, $F8F8F8FC,
  161.          $FEFFFFFF, $FFFFE0E0, $80800000, $00000000, $00000000, $80C0E0F0,
  162.          $FF7F3F1F, $0F070301, $01010101, $03070F1F, $3F7F0000, $003E0003,
  163.          $0012FFFF, $FFFFFFFF, $FCFCFCFC, $FCFEFFFF, $FFFFFFFF, $F0F0C0C0,
  164.          $00000000, $00000000, $0080C0E0, $F0F87F3F, $1F0F0703, $01000000,
  165.          $00000103, $070F1F3F, $00000050, $00040012, $FFFFFFFF, $FFFFFEFE,
  166.          $FEFEFEFF, $FFFFFFFF, $FFFFF8F8, $E0E08080, $00000000, $000080C0,
  167.          $E0F0F8FC, $3F1F0F07, $03010000, $00000000, $00010307, $0F1FFFFF,
  168.          $FFFFFFFF, $FF7F7F7F, $7F7FFFFF, $FFFFFFFF, $FFF7FFF7, $00080008,
  169.          $00080001, $0000004C, $0000005C, $00000074, $0000008C, $000000A4,
  170.          $000000BC, $000000D4, $000000EC, $00000104, $00000114, $0000012C,
  171.          $00000144, $0000015C, $00000174, $0000018C, $000001A4, $00000010,
  172.          $00010008, $03030C0C, $3030C0C0, $00000018, $00020008, $01010606,
  173.          $18186060, $80800000, $00000000, $00000018, $00020008, $00000303,
  174.          $0C0C3030, $C0C00000, $00000000, $00000018, $00020008, $00000101,
  175.          $06061818, $60608080, $00000000, $00000018, $00020008, $00000000,
  176.          $03030C0C, $3030C0C0, $00000000, $00000018, $00020008, $00000000,
  177.          $01010606, $18186060, $80800000, $00000018, $00020008, $00000000,
  178.          $00000303, $0C0C3030, $C0C00000, $00000018, $00020008, $00000000,
  179.          $00000101, $06061818, $60608080, $00000010, $00010008, $FCFCF3F3,
  180.          $CFCF3F3F, $00000018, $00020008, $FEFEF9F9, $E7E79F9F, $7F7FFFFF,
  181.          $FFFFFFFF, $00000018, $00020008, $FFFFFCFC, $F3F3CFCF, $3F3FFFFF,
  182.          $FFFFFFFF, $00000018, $00020008, $FFFFFEFE, $F9F9E7E7, $9F9F7F7F,
  183.          $FFFFFFFF, $00000018, $00020008, $FFFFFFFF, $FCFCF3F3, $CFCF3F3F,
  184.          $FFFFFFFF, $00000018, $00020008, $FFFFFFFF, $FEFEF9F9, $E7E79F9F,
  185.          $7F7FFFFF, $00000018, $00020008, $FFFFFFFF, $FFFFFCFC, $F3F3CFCF,
  186.          $3F3FFFFF, $00000018, $00020008, $FFFFFFFF, $FFFFFEFE, $F9F9E7E7,
  187.          $9F9F7F7F;
  188.          
  189.          TabScratchSound:
  190.          $7F7F7F7F, $7F7F8080, $80808080, $81828282, $83848484, $86868889,
  191.          $898A8B8C, $8D8E9091, $92929496, $97979899, $9A9B9C9D, $9E9E9E9F,
  192.          $A0A1A2A4, $A5A7A8A9, $A9AAACAC, $AEAFB2B4, $B7BABCBE, $C2C5C9CC,
  193.          $D0D4D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8,
  194.          $D8D8D8D8, $D8D8D8D4, $CCC5C1BD, $BDBDBFC1, $C3C5C9CF, $D6D8D8D8,
  195.          $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D2D4D8D8, $D8D8D8D8, $D8D8D8D8,
  196.          $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D2, $B596817E,
  197.          $8797A3A4, $9B8F898B, $92A2BAD0, $D8D8D8D8, $D4BCA08B, $7E777576,
  198.          $7A7F8382, $7E808B96, $A7A6977B, $502D2727, $375A788D, $97928E94,
  199.          $A5B3BABC, $C1D3D8D8, $D8D8D8D8, $D8C5B2B0, $B7C2D1D8, $D8D8D8D8,
  200.          $D09E7567, $80B1CDCB, $C0B6AEA5, $94806242, $2F344559, $68696358,
  201.          $4236342B, $27272727, $3A779C81, $46272727, $27577E73, $634B3B38,
  202.          $46482A27, $2727347D, $BCC8B092, $77574654, $5E56698B, $9C896E47,
  203.          $27272727, $27272727, $27273B52, $6C7C5227, $2727272D, $739FA27E,
  204.          $67524D40, $34364341, $272B4881, $9981582B, $27273B6C, $81705B55,
  205.          $6167798D, $A9AEB0B0, $BEC38C52, $2A2A3546, $6E878C89, $7A643C28,
  206.          $27272728, $47798A57, $2C272727, $27272D46, $5D8DCCD5, $C3A9772F,
  207.          $27273862, $756C5E46, $2A272727, $27272738, $4D6C8F80, $7A603B39,
  208.          $608CB4D8, $D8BB7130, $27272727, $27272727, $27272727, $27272727,
  209.          $27272727, $27272727, $27272727, $27272727, $27272727, $283C363D,
  210.          $4A617D86, $68272727, $27272A28, $27272727, $27272727, $27272727,
  211.          $27272727, $27272727, $27272727, $27272727, $27272727, $27272727,
  212.          $27272727, $27272727, $27272727, $27272727, $27272727, $27272727,
  213.          $27272727, $27272727, $27272727, $27272A39, $2C272727, $27272727,
  214.          $27272727, $27272727, $27272727, $27272727, $27272727, $27272727,
  215.          $27272727, $27272727, $27272727, $27272727, $27272727, $27272838,
  216.          $28272727, $27272727, $27272727, $27272727, $27272727, $27272A38,
  217.          $28272727, $2728507A, $7A4E2727, $272A5C8B, $86584468, $A5C9B273,
  218.          $2F272738, $78B3D6D8, $D8D7B88A, $65666C56, $41364472, $B7D8D8CA,
  219.          $8C645962, $7A8F9EAC, $C7D8D8D8, $BB90777A, $8B9FA79D, $866F6264,
  220.          $625D5756, $5771A0C8, $D8D8D3AF, $868093B0, $C8CAB9A2, $9AA9BDCC,
  221.          $D0BD9772, $5956636D, $65493644, $77BED8D8, $D8D8D8D8, $D3CDD8D8,
  222.          $D8D7CAC6, $D4D8D8D8, $D8D8D0AD, $A2B6D6D8, $D8D8D8D8, $D8D8D8D8,
  223.          $D8D8D8D8, $D8D8D3AD, $94898074, $6C7389A8, $C8D8D8D8, $D8D8D8D8,
  224.          $D8D8BEAB, $ACC1D7D8, $D8D8D7CE, $C6BDB1A0, $908DA9D4, $D8D8D8D8,
  225.          $D8D4AE93, $8D9AB0C7, $D6D8D8D8, $D8D8D7CF, $CDD6D8D8, $D8D8D8D8,
  226.          $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8,
  227.          $D8D8D8D7, $D7D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8,
  228.          $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8,
  229.          $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8,
  230.          $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8,
  231.          $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8,
  232.          $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8,
  233.          $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8,
  234.          $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8,
  235.          $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8,
  236.          $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8, $D8D8D8D8,
  237.          $D8D8D8D8, $D8D8D8D8, $D6D4D2D0, $CDCBC8C6, $C5C3C1C0, $BEBDBCBB,
  238.          $BAB8B7B6, $B5B3B2B1, $B0AEADAC, $AAA9A7A5, $A2A1A09E, $9D9C9B9A,
  239.          $99989796, $94949290, $908E8D8C, $8B8A8988, $87868585, $84848300;
  240.  
  241.  
  242.          
  243.  
  244. (*---------------------------------------------------------------------------*)
  245.   
  246. (*$L-*)
  247. PROCEDURE CopySnowScreen;
  248. BEGIN
  249.   ASSEMBLER
  250.   movem.l       A3-A6/D2-D7,-(A7)
  251.   
  252.   move.l        SnowScreen,A4
  253.   move.l        WorkScreen,A5
  254.   move.l        TOSScreen,A6
  255.   lea           SnowLines,A0
  256.   bra           NextLine
  257.   
  258.  !ED
  259.   movem.l       (A7)+,A3-A6/D2-D7
  260.   rts
  261.   
  262.  !NextLine
  263.   tst.b         (A0)+
  264.   bmi.s         ED
  265.  
  266.   movem.l       (A4)+,D0-D3
  267.   movem.l       (A6)+,D4-D7
  268.   and.l         D0,D4
  269.   and.l         D1,D5
  270.   and.l         D2,D6
  271.   and.l         D3,D7
  272.   movem.l       D4-D7,(A5)
  273.   lea           16(A5),A5
  274.   
  275.   movem.l       (A4)+,D0-D3
  276.   movem.l       (A6)+,D4-D7
  277.   and.l         D0,D4
  278.   and.l         D1,D5
  279.   and.l         D2,D6
  280.   and.l         D3,D7
  281.   movem.l       D4-D7,(A5)
  282.   lea           16(A5),A5
  283.   
  284.   movem.l       (A4)+,D0-D3
  285.   movem.l       (A6)+,D4-D7
  286.   and.l         D0,D4
  287.   and.l         D1,D5
  288.   and.l         D2,D6
  289.   and.l         D3,D7
  290.   movem.l       D4-D7,(A5)
  291.   lea           16(A5),A5
  292.   
  293.   movem.l       (A4)+,D0-D3
  294.   movem.l       (A6)+,D4-D7
  295.   and.l         D0,D4
  296.   and.l         D1,D5
  297.   and.l         D2,D6
  298.   and.l         D3,D7
  299.   movem.l       D4-D7,(A5)
  300.   lea           16(A5),A5
  301.   
  302.   movem.l       (A4)+,D0-D3
  303.   movem.l       (A6)+,D4-D7
  304.   and.l         D0,D4
  305.   and.l         D1,D5
  306.   and.l         D2,D6
  307.   and.l         D3,D7
  308.   movem.l       D4-D7,(A5)
  309.   lea           16(A5),A5
  310.   
  311.   bra           NextLine
  312.   END;
  313. END CopySnowScreen;
  314. (*$L+*)
  315.  
  316.  
  317. (*$L-*)
  318. PROCEDURE DrawAndAnimateSnowFlakes;
  319. BEGIN
  320.   ASSEMBLER
  321.   movem.l       D6/D7/A4,-(A7)
  322.   
  323.   lea           SnowFlakes,A0
  324.   move.l        WorkScreen,A1
  325.   move.l        TOSScreen,A2
  326.   move.l        SnowScreen,A4
  327.   
  328.   move.w        #MaxNoOfSnowFlakes,D7
  329.  
  330.  !NextSnowFlake
  331.   tst.b         SnowFlake.IsThere(A0)
  332.   beq.w         NewSnowFlake
  333.   
  334.   move.w        SnowFlake.FallOffset(A0),D6
  335.   add.w         SnowFlake.WordPosition(A0),D6
  336.   move.w        D6,SnowFlake.WordPosition(A0)
  337.   
  338.  !DrawSnowFlake ; --> auf die WorkScreen
  339.   move.l        SnowFlake.ThreePointPattern(A0),D1
  340.   and.l         D1,0(A1,D6.W)
  341.   move.l        SnowFlake.OnePointPattern(A0),D1
  342.   and.l         D1,-80(A1,D6.W)
  343.   and.l         D1,80(A1,D6.W)
  344.   
  345.   ; Testen, ob Schneeflocke liegen bleibt oder weiter fällt:
  346.   move.l        80(A2,D6.W),D1  ; Zeile unter der Schneeflocke auf TOSScreen
  347.   and.l         SnowFlake.CheckANDPattern(A0),D1
  348.   beq.w         StopSnowFlake
  349.   cmp.l         SnowFlake.CheckStopValue(A0),D1
  350.   beq.w         StopSnowFlake
  351.   cmp.l         SnowFlake.CheckLeftFallValue(A0),D1
  352.   beq           SnowFlakeLeftFall
  353.   cmp.l         SnowFlake.CheckRightFallValue(A0),D1
  354.   beq           SnowFlakeRightFall
  355.   move.l        80(A4,D6.W),D1  ; Zeile unter der Schneeflocke auf SnowScreen
  356.   not.l         D1
  357.   and.l         SnowFlake.CheckANDPattern(A0),D1
  358.   cmp.l         SnowFlake.CheckStopValue(A0),D1
  359.   beq.w         StopSnowFlake
  360.   cmp.l         SnowFlake.CheckRightLeftOrStopValue(A0),D1
  361.   beq           SnowFlakeRightLeftOrStop
  362.   cmp.l         SnowFlake.CheckRightFallValue(A0),D1
  363.   beq           SnowFlakeRightFall
  364.   cmp.l         SnowFlake.CheckLeftFallValue(A0),D1
  365.   beq           SnowFlakeLeftFall
  366.   
  367.  !SnowFlakeGoon
  368.  !NoSnowFlakeChanges
  369.  !NoSnowFlake
  370.   lea           38(A0),A0
  371.   dbf           D7,NextSnowFlake
  372.   movem.l       (A7)+,A4/D6/D7
  373.   rts
  374.  
  375.  
  376.  !SnowFlakeLeftFall
  377.   ; Schneeflocke ein Pixel nach links schieben
  378.   subq.w        #1,SnowFlake.HorPosition(A0)
  379.   beq.w         NewSnowFlake
  380.   addq.w        #1,SnowFlake.HorCenterLongWordPosition(A0)
  381.   cmpi.w        #31,SnowFlake.HorCenterLongWordPosition(A0)
  382.   bne           SetUpPatterns
  383.   ; Wordüberlauf:
  384.   subq.w        #2,SnowFlake.WordPosition(A0)
  385.   subi.w        #16,SnowFlake.HorCenterLongWordPosition(A0)
  386.   bra           SetUpPatterns
  387.  
  388.  
  389.  !SnowFlakeRightFall
  390.   ; Schneeflocke ein Pixel nach rechts schieben
  391.   addq.w        #1,SnowFlake.HorPosition(A0)
  392.   cmpi.w        #639,SnowFlake.HorPosition(A0)
  393.   beq           NewSnowFlake
  394.   subq.w        #1,SnowFlake.HorCenterLongWordPosition(A0)
  395.   bne           SetUpPatterns
  396.   ; Wordüberlauf:
  397.   addq.w        #2,SnowFlake.WordPosition(A0)
  398.   addi.w        #16,SnowFlake.HorCenterLongWordPosition(A0)
  399.   bra           SetUpPatterns
  400.  
  401.  
  402.  !SnowFlakeRightLeftOrStop
  403.   move.w        #0,(A3)+
  404.   move.w        #1,(A3)+
  405.   jsr           MinMaxRandom
  406.   move.w        -(A3),D1
  407.   beq           SnowFlakeLeftFall
  408.   bra.w         SnowFlakeRightFall
  409.   
  410.  
  411.  !SetUpPatterns
  412.   move.w        SnowFlake.HorCenterLongWordPosition(A0),D6
  413.   moveq.l       #-1,D1
  414.   bclr          D6,D1
  415.   move.l        D1,SnowFlake.OnePointPattern(A0)
  416.   not.l         D1
  417.   move.l        D1,SnowFlake.CheckRightLeftOrStopValue(A0)
  418.   subq.w        #1,D6
  419.   bset          D6,D1
  420.   move.l        D1,SnowFlake.CheckLeftFallValue(A0)
  421.   bclr          D6,D1
  422.   addq.w        #2,D6
  423.   bset          D6,D1
  424.   move.l        D1,SnowFlake.CheckRightFallValue(A0)
  425.   subq.w        #2,D6
  426.   bset          D6,D1
  427.   move.l        D1,SnowFlake.CheckANDPattern(A0)
  428.   move.l        D1,SnowFlake.CheckStopValue(A0)
  429.   not.l         D1
  430.   move.l        D1,SnowFlake.ThreePointPattern(A0)
  431.   bra           SnowFlakeGoon
  432.   
  433.  !NewSnowFlake
  434.   move.w        #0,(A3)+
  435.   move.w        SnowRate,(A3)+
  436.   jsr           MinMaxRandom
  437.   tst.w         -(A3)
  438.   bne.w         SnowFlakeGoon
  439.   
  440.   move.w        #1,(A3)+
  441.   move.w        #3,(A3)+
  442.   jsr           MinMaxRandom
  443.   move.w        -(A3),D6
  444.   mulu          #80,D6
  445.   move.w        D6,SnowFlake.FallOffset(A0)
  446.   st            SnowFlake.IsThere(A0)
  447.   
  448.   move.w        #1,(A3)+
  449.   move.w        #638,(A3)+
  450.   jsr           MinMaxRandom            ; horizontale Position der Flocke
  451.   move.w        #2,(A3)+
  452.   move.w        #360,(A3)+
  453.   jsr           MinMaxRandom            ; Startzeile der Flocke
  454.   move.w        -(A3),D6
  455.   mulu          #80,D6
  456.   moveq.l       #0,D1
  457.   move.w        -(A3),D1
  458.   move.w        D1,SnowFlake.HorPosition(A0)
  459.   divu          #16,D1
  460.   add.w         D1,D1
  461.   cmpi.w        #78,D1
  462.   bne           IsNotLastWord
  463.   add.w         D1,D6
  464.   subq.w        #2,D6
  465.   move.w        D6,SnowFlake.WordPosition(A0)
  466.   swap          D1
  467.   not.w         D1
  468.   andi.w        #$F,D1
  469.   move.w        D1,SnowFlake.HorCenterLongWordPosition(A0)
  470.   bra           SetUpPatterns
  471.   
  472.  !IsNotLastWord
  473.   add.w         D1,D6
  474.   move.w        D6,SnowFlake.WordPosition(A0)
  475.   swap          D1
  476.   not.w         D1
  477.   andi.w        #$F,D1
  478.   add.w         #$10,D1
  479.   cmpi.w        #$1F,D1
  480.   beq           IsWordBoundary
  481.   move.w        D1,SnowFlake.HorCenterLongWordPosition(A0)
  482.   bra           SetUpPatterns
  483.  !IsWordBoundary
  484.   subq.w        #2,SnowFlake.WordPosition(A0)
  485.   subi.w        #16,D1
  486.   move.w        D1,SnowFlake.HorCenterLongWordPosition(A0)
  487.   bra           SetUpPatterns
  488.  
  489.  
  490.  
  491.  !StopSnowFlake
  492.   sf            SnowFlake.IsThere(A0)
  493.   move.w        #0,(A3)+
  494.   move.w        #1,(A3)+
  495.   jsr           MinMaxRandom
  496.   tst.w         -(A3)
  497.   beq           BIGSnowFlake
  498.   move.l        SnowFlake.OnePointPattern(A0),D1
  499.   and.l         D1,0(A4,D6.W)                   ; Einzeichnen in die SnowScreen
  500.   bra           SnowFlakeGoon
  501.  !BIGSnowFlake
  502.   move.l        SnowFlake.OnePointPattern(A0),D1
  503.   and.l         D1,-80(A4,D6.W)                   ; Einzeichnen in die SnowScreen
  504.   and.l         D1,80(A4,D6.W)                   ; Einzeichnen in die SnowScreen
  505.   move.l        SnowFlake.ThreePointPattern(A0),D1
  506.   and.l         D1,0(A4,D6.W)                   ; Einzeichnen in die SnowScreen
  507.   bra           SnowFlakeGoon
  508.   END;
  509. END DrawAndAnimateSnowFlakes;
  510. (*$L+*)
  511.  
  512.  
  513.  
  514. PROCEDURE DrawTitle;
  515. BEGIN
  516.   DrawText ( WorkScreen, 14, 9, TRUE,
  517.   '                       S N O W                     ' );
  518.   DrawText ( WorkScreen, 14, 10, TRUE,
  519.   ' Written with MEGAMAX MODULA-2 for the TOS-Magazin ' );
  520.   DrawText ( WorkScreen, 14, 11, TRUE,
  521.   '           © July 1990 by Meinolf Schneider        ' );
  522. END DrawTitle;
  523.  
  524.  
  525. PROCEDURE MakeSnow;
  526. BEGIN
  527.   IF ~TitleWasThere
  528.   THEN
  529.     IF ShowTitle
  530.     THEN
  531.       DrawTitle;
  532.       IF MyMouse.RightButton.JustPressed
  533.       THEN
  534.         TitleWasThere := TRUE;
  535.         ShowTitle := FALSE;
  536.       END;
  537.     ELSE
  538.       INC ( TitleTimer );
  539.       ShowTitle := (TitleTimer > TitleTime);
  540.     END;
  541.   END;
  542.   DrawAndAnimateSnowFlakes;
  543. END MakeSnow;
  544.  
  545.  
  546. PROCEDURE IceScratchSteering;
  547. BEGIN
  548.   ReadMouse ( MyMouse );
  549.   WITH MyMouse DO
  550.     IF RightButton.Pressed
  551.     THEN
  552.       IF RightButton.JustPressed
  553.       THEN
  554.         IceScratchThere := TRUE;
  555.         ASSEMBLER
  556.         dc.w      $A00A         ; Hide Mouse
  557.         END;
  558.       END;
  559.     ELSIF RightButton.JustReleased
  560.     THEN
  561.       StopASound ( ScratchSound );
  562.       IceScratchThere := FALSE;
  563.       ASSEMBLER
  564.       dc.w      $A009   ; Mauscursor wieder einschalten
  565.       END;
  566.     END;
  567.   END;
  568. END IceScratchSteering;
  569.  
  570.  
  571.  
  572. PROCEDURE WaitForSnow;
  573. BEGIN
  574.   INC ( SnowWait );
  575.   IF SnowWait > SnowBegin
  576.   THEN
  577.     SnowThere := TRUE;
  578.   END;
  579. END WaitForSnow;
  580.   
  581.   
  582. PROCEDURE ScratchLine ( x1, y1, x2, y2    : INTEGER );
  583. VAR     dx, dy, t, vx, vy       : INTEGER;
  584. BEGIN
  585.   dx := ABS ( x2 - x1 );
  586.   dy := ABS ( y2 - y1 );
  587.   IF (x2-x1) < 0
  588.   THEN
  589.     vx := -1;
  590.   ELSE
  591.     vx := 1;
  592.   END;
  593.   IF (y2-y1) < 0
  594.   THEN
  595.     vy := -1;
  596.   ELSE
  597.     vy := 1;
  598.   END;
  599.   dx := dx + 1;
  600.   dy := dy + 1;
  601.   Sprite ( SnowScreen, SnowSpriteList, 1, x1, y1 );
  602.   IF dx > dy
  603.   THEN
  604.     t := dx - dy;
  605.     REPEAT
  606.       IF x1 # x2
  607.       THEN
  608.         x1 := x1 + vx;
  609.         t := t - dy;
  610.         IF t < 0
  611.         THEN
  612.           t := t + dx;
  613.           y1 := y1 + vy;
  614.         END;
  615.         Sprite ( SnowScreen, SnowSpriteList, 1, x1, y1 );
  616.       END;
  617.     UNTIL x1 = x2;
  618.   ELSE
  619.     t := dy - dx;
  620.     REPEAT
  621.       IF y1 # y2
  622.       THEN
  623.         y1 := y1 + vy;
  624.         t := t - dx;
  625.         IF t < 0
  626.         THEN
  627.           t := t + dy;
  628.           x1 := x1 + vx
  629.         END;
  630.         Sprite ( SnowScreen, SnowSpriteList, 1, x1, y1 );
  631.       END;
  632.     UNTIL y1 = y2;
  633.   END;
  634. END ScratchLine;
  635.   
  636.   
  637. PROCEDURE MakePicture;
  638. BEGIN
  639.   IF TOSScreenOnDisplay
  640.   THEN
  641.     IceScratchSteering;
  642.     IF DirectTOSScreenShow
  643.     THEN
  644.       IF SnowThere OR IceScratchThere
  645.       THEN
  646.         DirectTOSScreenShow := FALSE;
  647.       ELSE
  648.         WaitForSnow;
  649.       END;
  650.       Switch ( TOSScreen );
  651.     ELSE
  652.       IF IceScratchThere
  653.       THEN (* Eis entfernen *)
  654.         ScratchLine ( MyMouse.Position.X.I, MyMouse.Position.Y.I,
  655.                       MyMouse.OldPosition.X.I, MyMouse.OldPosition.Y.I );
  656.         IF (MyMouse.Speed.X.I = 0) & (MyMouse.Speed.Y.I = 0)
  657.         THEN
  658.           StopASound ( ScratchSound );
  659.         ELSIF ~ASoundIsActive ( ScratchSound )
  660.         THEN
  661.           StartASound ( ScratchSound, 10 );
  662.         END;
  663.       END;
  664.       IF SnowThere
  665.       THEN
  666.         IF SnowRate # 0
  667.         THEN
  668.           DEC ( SnowRate );
  669.         END;
  670.         CopySnowScreen;
  671.         MakeSnow;
  672.       ELSE
  673.         CopyScreen ( TOSScreen, WorkScreen );
  674.         WaitForSnow;
  675.       END;
  676.       IF IceScratchThere
  677.       THEN (* Eiskratzer einzeichnen *)
  678.         Sprite ( WorkScreen, SnowSpriteList, 0,
  679.                  MyMouse.Position.X.I, MyMouse.Position.Y.I );
  680.       END;
  681.       DirectTOSScreenShow := ~SnowThere & ~IceScratchThere;
  682.       SwitchSides;
  683.     END;
  684.   END;
  685. END MakePicture;
  686.  
  687.  
  688. (*---------------------------- VBL - Interrupt -----------------------------*)
  689.  
  690. (*$L-*)
  691. PROCEDURE VBLXBRA;
  692. BEGIN
  693.   ASSEMBLER
  694.   asc           'XBRA'
  695.   asc           'SNOW'
  696.   dc.w          0
  697.   END;
  698. END VBLXBRA;
  699. (*$L+*)
  700.  
  701. (*$L-*)
  702. PROCEDURE VBLIRQ;
  703. BEGIN
  704.   ASSEMBLER
  705.   subq.w        #1,$452
  706.   bmi.w         ED                      ; VBLHandler gesperrt
  707.   
  708.   subi.w        #1,VBLTimer
  709.   bpl.w         ED                      ; Bildaufbau nur bei jedem
  710.                                         ; 3. Monitorbild
  711.   
  712.   move.w        #PicFreq-1,VBLTimer             ; Timer zurücksetzen
  713.   
  714.   movem.l       D0-D7/A0-A6,-(A7)
  715.   
  716.   clr.l         D0                      ; Lesen der aktuellen Bildschirmadresse
  717.   move.l        #$FF8201,A0
  718.   movep.w       0(A0),D0
  719.   lsl.l         #8,D0
  720.   
  721.   move.w        #1,TOSScreenOnDisplay
  722.   cmp.l         TOSScreen,D0
  723.   beq           go
  724.   cmp.l         DisplayScreen,D0
  725.   beq           go
  726.   clr.w         TOSScreenOnDisplay      ; Bildschirm wurde von jemand
  727.                                         ; anderes umgesetzt
  728.  !go
  729.   lea           VBLStack,A3             ; Jetzt nehmen wir unseren Stack,
  730.   jsr           MakePicture             ; und malen das neue Bild
  731.   
  732.   movem.l       (A7)+,D0-D7/A0-A6
  733.  
  734.  !ED
  735.   addq.w        #1,$452
  736.   move.l        OldVBLIRQ,-(A7)      ; alte VBL-Routine macht weiter...
  737.   END;
  738. END VBLIRQ;
  739. (*$L+*)
  740.  
  741.  
  742. (*$L-*)
  743. PROCEDURE InstallVBLIRQ;
  744. BEGIN
  745.   ASSEMBLER
  746.   jsr           EnterSupervisorMode
  747.   move.w        SR,-(A7)
  748.   ori.w         #$0700,SR
  749.   
  750.   move.l        $70,OldVBLIRQ
  751.   lea           VBLXBRA,A0
  752.   lea           VBLIRQ,A0
  753.   move.l        $70,-4(A0)              ; XBRA-Vektor setzen
  754.   move.l        A0,$70
  755.   
  756.   move.w        (A7)+,SR
  757.   andi.w        #$DFFF,SR
  758.   END;
  759. END InstallVBLIRQ;
  760. (*$L+*)
  761.  
  762. (*--------------------------------------------------------------------------*)
  763.  
  764.  
  765. BEGIN
  766.   ReadMouse ( MyMouse );
  767.   ReadMouse ( MyMouse );
  768.   ASSEMBLER
  769.   move.l        #TabSnowSpriteList,SnowSpriteList
  770.   move.l        #TabScratchSound,ScratchSoundADR
  771.   lea           SnowLines,A0
  772.   st            400(A0)         ; Endekennung
  773.   END;
  774.   SnowRate := 30 * PicsPerSec;
  775.   Allocate ( SnowScreen, 32560L );
  776.   NewSound ( ScratchSound, ScratchSoundADR, FALSE, 0L );
  777.   ClearScreen ( SnowScreen + 560L );
  778.   FillScreen ( SnowScreen );
  779.   SetSampleFrequency ( 6269 );
  780.   TOSScreen := GetSystemScreen();
  781.   TOSScreenOnDisplay := TRUE;
  782.   DirectTOSScreenShow := TRUE;
  783.   VBLTimer := PicFreq;
  784.   InstallVBLIRQ;
  785. END Snow.
  786.  
  787.