home *** CD-ROM | disk | FTP | other *** search
/ The Best of Mecomp Multimedia 2 / MECOMP-CD-II.iso / amiga / tools / workbench / madhouse / developer / e / examples / bouncingpixel / blanker.e < prev    next >
Encoding:
Text File  |  1998-01-03  |  4.4 KB  |  185 lines
  1. /*PROC programinfo
  2.  
  3.    Program   : BouncingPixel
  4.    Contents  : Bildschirmschoner-Modul
  5.    Author    : Aicke Schulz
  6.    Address   : Neudecker Weg, 12355 Berlin, Deutschland
  7.    Phone     : 030/6644822
  8.    Copyright : Teil des Shareware-Programms Madhouse ©1994-1996 by Carsten Jahn und Aicke Schulz
  9.    Compiler  : 3.2e
  10.    OS        : 2.0+ (?)
  11.    History   : 1.0, 27.11.1995
  12.                - erste Veröffentlichung, in Amos programmiert
  13.                1.1, 18.03.1996
  14.                - INT: in E neugeschrieben
  15.                - CHG: Sound erstmal nicht mehr drin (wie mach ich das bloß ???)
  16.                1.2, 04.04.1996
  17.                - INT: Screenmode wählbar (u.a. kleine Hammerroutine die jumpheightmax bestimmt)
  18.                - INT: nutze jetzt den COMPLEMENT-Modus beim zeichnen
  19.                1.3, 11.07.1996
  20.                - INT: benutzt neues Madhouse2 Protokoll
  21.                1.35, 06.01.1997
  22.                - INT: Madhouse2 Protokoll-Anpassung vervollständigt
  23.                1.40, 18.03.1997
  24.                - INT: kleine Optimierungen im Sourcecode
  25.                1.50, 09.12.1997 [CJ]
  26.                - CHG: Kein Complement-Modus mehr (killt GraKas...)
  27.                1.55, 09.12.1997 [CJ]
  28.                - INT: Pixelfarbe einstellbar.
  29.  
  30. ENDPROC*/
  31.  
  32. MODULE 'dos/dos',
  33.        'exec/memory',
  34.        'graphics/modeid',
  35.        'intuition/intuition',
  36.        'intuition/screens',
  37.        'madblankersupport',
  38.        'madhouse/madblankersupport',
  39.        'other/stayrandom'
  40.  
  41. DEF blankjob : PTR TO mbs_blankjob,
  42.     screen : PTR TO screen,
  43.     window : PTR TO window,
  44.     color : mbs_color,
  45.     screenmode, jumpwidth, palette
  46.  
  47. PROC exit ()
  48.  
  49.    IF palette THEN Mbs_freepalette (palette)
  50.  
  51.    IF window THEN CloseWindow (window)
  52.    IF screen THEN CloseScreen (screen)
  53.  
  54.    Mbs_quit ()
  55.    CloseLibrary (madblankersupportbase)
  56.    CleanUp (0)
  57.  
  58. ENDPROC
  59. PROC readprefs ()
  60.  
  61.    jumpwidth := Mbs_getprefs ('jumpwidth', 2)
  62.    screenmode := Mbs_getscreenmodeprefs (0)
  63.  
  64. ENDPROC
  65. PROC setup ()
  66.  
  67.    IF (screen := OpenScreenTagList (NIL,
  68.       [SA_COLORS, [0, 0, 0, 0, 1, 15, 15, 15, - 1] : colorspec,
  69.       SA_DEPTH, 1,
  70.       SA_DISPLAYID, screenmode,
  71.       SA_OVERSCAN, OSCAN_STANDARD,
  72.       SA_QUIET, TRUE,
  73.       SA_TITLE, 'BouncingPixel',
  74.       NIL])) = NIL OR
  75.  
  76.       (window := OpenWindowTagList (NIL,
  77.       [WA_ACTIVATE, TRUE,
  78.       WA_AUTOADJUST, TRUE,
  79.       WA_BORDERLESS, TRUE,
  80.       WA_CUSTOMSCREEN, screen,
  81.       WA_NOCAREREFRESH, TRUE,
  82.       NIL])) = NIL
  83.  
  84.       IF StrCmp (blankjob.language, 'deutsch')
  85.          Mbs_errorreport ('Kann den Screen nicht öffnen.\n')
  86.       ELSE
  87.          Mbs_errorreport ('Could not open Screen.\n')
  88.       ENDIF
  89.  
  90.       exit ()
  91.  
  92.    ENDIF
  93.  
  94.    Mbs_clearmousepointer (screen)
  95.    -> SetDrMd (screen.rastport, $2)
  96.     
  97.     
  98.    IF (palette := Mbs_allocpalette ()) = NIL THEN exit ()
  99.    Mbs_setpalettescreen (palette, screen)
  100.  
  101.    color.r := 0
  102.    color.g := 0
  103.    color.b := 0
  104.    Mbs_putpalettecolor (palette, 0, color)
  105.  
  106.    color.r := 255
  107.    color.g := 255
  108.    color.b := 0
  109.    Mbs_getcolorprefs ('pixelcol', color)
  110.    Mbs_putpalettecolor (palette, 1, color)
  111.   
  112.    Mbs_refreshpalette( palette, screen )
  113. ENDPROC
  114. PROC main ()
  115.  
  116.    DEF counter = 100, jumpheight, jumpheightmax = 0, screenheight, screenwidth, screenrastport, x, y
  117.  
  118.    IF madblankersupportbase := OpenLibrary ('madblankersupport.library', MADBLANKERSUPPORT_VMIN)
  119.  
  120.       ->Mbs_debugmode ()
  121.       blankjob := Mbs_getblankjob ()
  122.  
  123.    ELSE
  124.  
  125.       CleanUp (0)
  126.  
  127.    ENDIF
  128.  
  129.    stayrandom ()
  130.    readprefs ()
  131.    setup ()
  132.  
  133.    screenheight := screen.height * 10
  134.    screenwidth := screen.width
  135.    screenrastport := screen.rastport
  136.  
  137.    x := Rnd (screenwidth)
  138.    y := screenheight
  139.  
  140.    IF Rnd (2) = 0 THEN jumpwidth := - jumpwidth
  141.  
  142.    WHILE screenheight > counter
  143.  
  144.       INC jumpheightmax
  145.       counter := counter + jumpheightmax
  146.  
  147.    ENDWHILE
  148.  
  149.    WHILE Mbs_continueblanking () = MBSCB_CONTINUE
  150.  
  151.         SetAPen( screenrastport, 0 )
  152.       WritePixel (screenrastport, x, y / 10)
  153.  
  154.       x := x + jumpwidth
  155.       INC jumpheight
  156.       y := y + jumpheight
  157.  
  158.       IF x > screenwidth OR x < 0
  159.  
  160.          jumpwidth := - jumpwidth
  161.          x := jumpwidth * 2 + x
  162.  
  163.       ENDIF
  164.  
  165.       IF y > screenheight
  166.  
  167.          y := screenheight
  168.          jumpheight := - Rnd (jumpheightmax - 20) - 20
  169.          y := jumpheight * 2 + y
  170.  
  171.       ENDIF
  172.  
  173.         SetAPen( screenrastport, 1 )
  174.       WritePixel (screenrastport, x, y / 10)
  175.       WaitTOF ()
  176.  
  177.    ENDWHILE
  178.  
  179.    exit()
  180.  
  181. ENDPROC
  182.  
  183. CHAR '$VER: MadhouseBlanker - BouncingPixel® 1.55 (09.12.1997) Aicke Schulz'
  184.  
  185.