CD Actual 15/CDACTUAL15.iso/cdactual/program/basic/QBNWS105.ZIP/DAZZLING.ZIP/DAZZLING.BAS

BASIC Source File | 1990-11-22 | 15.6 KB | 422 lines

'           +===================================================+
'           |                   DAZZLING.BAS                    |
'           |             Written and Developed by:             |
'           |                  Lawrence Stone                   |
'           |                                                   |
'           |                Copyright (C), 1990                |
'           |                   Lawrence Stone                  |
'           |                All Rights Reserved                |
'           |                                                   |
'           |   The code in this module is for the exclusive    |
'           |   use of readers of the QBNews or any QuickBASIC, |
'           |   BASCOM, or PDS programmer.  The source code and |
'           |   object modules derived from this code may be    |
'           |   freely distributed without the express written  |
'           |   permission of the author.                       |
'           |                                                   |
'           |   Donations of appreciation for this author's     |
'           |   work are gladly accepted.  Please, no donations |
'           |   over $10,000 <GRIN>.                            |
'           |                                                   |
'           |   Lawrence Stone               November 22, 1990  |
'           |   P.O. Box 5715                                   |
'           |   Charleston, OR  97420                           |
'           +---------------------------------------------------+
'
'           +===================================================+
'           |   Compile swithces:  bc dazzling /o;              |
'           +---------------------------------------------------+

' $INCLUDE: 'DAZZLING.BI'

SUB Curtains (Direction%, Arry%()) STATIC

    ' Arry%()           The screen image array.
    '
    ' Direction = odd   Curtains close from outside toward inside.
    ' Direction = even  Curtains open from inside toward outside.
    '
    ' Monitor -+------  Must be DIM SHARED or COMMON SHARED in main module.
    ' ScrnEls /

    Start = 79: finish = 159
    StepCount = 2
    start2 = 1: finish2 = ScrnEls * 2
    StepCount2 = 160
    Direction = Direction MOD 2         'Force Direction into a "1" or "0".

    IF Direction THEN
        SWAP Start, finish
        StepCount = -StepCount
        SWAP start2, finish2
        finish2 = finish2 - 1
        StepCount2 = -StepCount2
    END IF

    FOR N = Start TO finish STEP StepCount
        DEF SEG = Monitor
        FOR J = start2 TO finish2 STEP StepCount2
            IF (N + J) \ 2 < ScrnEls THEN   'Prevents subscript out of range.
                '---- Right side of screen.
                OneByte = Arry((N + J) \ 2) AND &HFF       'Extract high byte.
                count = &H0 - Direction + J + N
                GOSUB CurtainPoke
                OneByte = (Arry((N + J) \ 2) AND &HFF00) \ 256   'Extract low.
                count = &H0 + 1 - Direction + N + J
                GOSUB CurtainPoke

                '---- Left side of screen.
                I = (79 - N) * 2
                OneByte = Arry((N + J + I) \ 2) AND &HFF    'Extract high byte.
                count = &H0 - Direction + J + I + N
                GOSUB CurtainPoke
                OneByte = (Arry((N + J + I) \ 2) AND &HFF00) \ 256'Extract low.
                count = &H0 + 1 - Direction + N + J + I
                GOSUB CurtainPoke
            END IF
        NEXT
        DEF SEG  'We must return to BASIC's segment before we call TickPause.
        IF N MOD 3 THEN TickPause 1   'A short delay for effect.
    NEXT

    EXIT SUB

CurtainPoke:
    POKE count, OneByte
RETURN

END SUB

SUB Dazzle (Operation%, Direction%, Arry%()) STATIC

    ' Operation         Description
    ' ---------         ---------------------------------
    '     0             Pull Full Screen Restore
    '     1             Dazzled with Stair Steps
    '     2             Dazzled with 8 Vertical Blinds
    '     3             Dazzled with 4 Vertical Blinds
    '     4             Dazzled with Slots
    '     5             Dazzled with Diagonal Fills
    '     6             Dazzled with Side Slides
    '     7             Dazzled with Rolling Grates
    '     8             Dazzled with Venetian Blinds
    '
    ' Direction = odd   Screen restore is left to right or, top to bottom
    ' Direction = even  Screen restore is right to left or, bottom to top
    '
    ' Arry%()           Screen array
    '
    ' MaxLine \
    ' Monitor -+------  Must be DIM SHARED or COMMON SHARED in main module.
    ' ScrnEls /

    GOSUB InitDazzle

    FOR J = Start TO finish STEP StepCount   'Force a dazzle.
        DEF SEG = Monitor                    'Define segment address.
        FOR N = J TO finish2 STEP StepCount2
            High = Arry(N \ 2) AND &HFF              'Extract the high byte.
            Low = (Arry(N \ 2) AND &HFF00) \ 256     'Extract the low byte.
            POKE &H0 - 1 + N, High           'POKE the high byte (color attr).
            POKE &H0 + N, Low                'POKE the low byte (character).

            ' Slow pull down/up windows needed for compiled code if you
            ' don't want it to just "flash" onto the monitor.
            IF Operation = 0 AND N MOD 479 = 0 THEN
                DEF SEG
                TickPause 1
                DEF SEG = Monitor
            END IF

        NEXT
        DEF SEG                              'Back to BASIC.

        '**** Short Pause for added effect.
        IF Operation < 4 THEN
            TickPause 1
        ELSEIF Operation > 7 THEN
            IF J MOD 199 = 0 THEN TickPause 1
        ELSEIF Operation = 7 THEN
            IF J MOD 7 = 0 THEN TickPause 1
        ELSEIF Operation <> 0 THEN
            IF J MOD 3 = 0 THEN TickPause 1
        END IF
    NEXT

    EXIT SUB

InitDazzle:
    StepCount = 2: Start = 1: finish2 = ScrnEls * 2
    SELECT CASE Operation
        CASE 0          'Pull Full Screen Restore
            finish = 1: StepCount2 = finish + 1
            IF Direction MOD 2 THEN
                Start = finish2 + 1: finish = Start
                finish2 = 0: StepCount2 = -StepCount2
            END IF
        CASE 1                      'Dazzled Stair Steps
            finish = 42: StepCount2 = finish - 4
        CASE 2                      'Dazzled with 8 Vertical Blinds
            finish = 20: StepCount2 = finish
        CASE 3                      'Dazzled with 4 Vertical Blinds
            finish = 40:  StepCount2 = finish
        CASE 4                      'Dazzled with Slots
            finish = 119:  StepCount2 = finish - 1
        CASE 5                      'Dazzled by Diagonal Fills
            finish = 82: StepCount2 = finish
        CASE 6                      'Dazzled by Side Slides
            finish = 160: StepCount2 = finish
        CASE 7                      'Dazzled by Rolling Grates
            finish = 320: StepCount2 = finish
        CASE 8                      'Dazzled with Venetian Blinds
            finish = 80 * MaxLine - MaxLine
            finish = finish - (finish MOD 160) + 160
            StepCount2 = finish
            StepCount2 = StepCount2 + (StepCount2 MOD 80)
        CASE ELSE
    END SELECT

    IF Direction MOD 2 = 0 AND Operation% <> 0 THEN
        SWAP Start, finish
        IF NOT Operation = 4 THEN Start = Start - 1
        StepCount = -StepCount
    END IF
RETURN

END SUB

SUB GetMonitorSeg

    ' Monitor       Must be DIM SHARED or COMMON SHARED in main module.

    DEF SEG = 0
    IF (PEEK(&H410) AND &H30) = &H30 THEN Monitor = &HB000 ELSE Monitor = &HB800
    DEF SEG

END SUB

SUB Implode (Arry%()) STATIC

    ' Arry%()           The screen image array.
    '
    ' Direction = odd   Curtains close from outside toward inside.
    ' Direction = even  Curtains open from inside toward outside.
    '
    ' Monitor -+------  Must be DIM SHARED or COMMON SHARED in main module.
    ' ScrnEls /

    Start = 1: finish = ScrnEls * 2
    StepCount = 160
    start2 = 0: finish2 = 159
    StepCount2 = 2

    FOR N = Start TO finish \ 2 STEP StepCount
        DEF SEG = Monitor
        IF (N) \ 2 < ScrnEls THEN    'Prevents subscript out of range.
            FOR J = start2 TO finish2 STEP StepCount2
                '---- Top side of screen.
                OneByte = Arry((N + J) \ 2) AND &HFF       'Extract high byte.
                count = &H0 - 1 + J + N
                GOSUB ImplodePoke
                OneByte = (Arry((N + J) \ 2) AND &HFF00) \ 256   'Extract low.
                count = &H0 + N + J
                GOSUB ImplodePoke
            NEXT

            FOR K = J - 1 TO finish - J - 1 STEP StepCount
                '---- Right side of screen.
                OneByte = Arry(K \ 2) AND &HFF       'Extract high byte.
                count = &H0 - 1 + K
                GOSUB ImplodePoke
                OneByte = (Arry(K \ 2) AND &HFF00) \ 256   'Extract low.
                count = &H0 + K
                GOSUB ImplodePoke
            NEXT

            FOR I = finish - N TO finish - N - J + 2 STEP -StepCount2
                '---- Bottom side of screen.
                OneByte = Arry(I \ 2) AND &HFF       'Extract high byte.
                count = &H0 - 1 + I
                GOSUB ImplodePoke
                OneByte = (Arry(I \ 2) AND &HFF00) \ 256   'Extract low.
                count = &H0 + I
                GOSUB ImplodePoke
            NEXT

            FOR J = I + 2 TO N STEP -StepCount
                '---- Left side of screen.
                OneByte = Arry(J \ 2) AND &HFF       'Extract high byte.
                count = &H0 - 1 + J
                GOSUB ImplodePoke
                OneByte = (Arry(J \ 2) AND &HFF00) \ 256   'Extract low.
                count = &H0 + J
                GOSUB ImplodePoke
            NEXT
            start2 = start2 + StepCount2: finish2 = finish2 - StepCount2
        END IF
        DEF SEG
        TickPause 1     'Slow compiled programs down to see it happen!
    NEXT

    EXIT SUB

ImplodePoke:
    POKE count, OneByte
RETURN

END SUB

SUB ReadBinFile (Arry%(), ScrFile$, LeadingRows%)

    ' Arry%()       The screen array to be filled.
    ' ScrFile$      The name of the BIN file to open and read.
    ' LeadingRows%  The number of rows in the video array to leave blank.
    '
    ' Note:  This routine does no error checking.  It is your responsibility
    '        to make sure that ScrFile$ exists before calling this routine.

    OPEN ScrFile$ FOR BINARY AS #1         'Open a BIN file.
    N = LOF(1)
    temp$ = INPUT$(N, 1)                   'Input 'N' bytes to a work string.
    CLOSE

    '---- Calculate a starting point for inserting our screen into the array.
    IF LeadingRows THEN Start = (LeadingRows% * 80)

    FOR A = 1 TO N STEP 2
        '---- Combine the two bytes into one, long integer.
        N& = (ASC(MID$(temp$, A, 1)) + 256&) + (ASC(MID$(temp$, A + 1, 1)) * 256&) - 256&

        '---- Adjust integer's range to signed short integer range.
        IF N& > 32767 THEN N& = N& - 65536

        Arry(Start + A \ 2) = N&            'Assign the integer to the array.
    NEXT
    temp$ = ""                              'Clear the temporary string.

END SUB

SUB Shake (HowMany%)

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%                                                           %
'%  HumbleWare Custom Programming                12/12/1988  %
'%                                                           %
'%  Routine to "shake" the screen by reprogramming the 6845  %
'%  CRT controllers viewport into video RAM.                 %
'%                                                           %
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'
'+===========================================================+
'|                                                           |
'|  Modified by Lawrence Stone Research Group    11/22/1990  |
'|                                                           |
'|  The principle modification made to this routine is the   |
'|  substitutions of the TickPause delay routine in lieu of  |
'|  the original TIMER + .01 code.                           |
'|                                                           |
'+-----------------------------------------------------------+

    FOR N = 0 TO HowMany

        'move viewport into video RAM by 3 text lines (ie, this is the number
        'of lines your entire screen will jump with each shake.  -LS)
        Lines% = 3

        'turn text lines into register values
        Lo% = (Lines% * 80) MOD 256
        Ho% = (Lines% * 80) \ 256

        'request access to register 12
        OUT &H3D4, 12
        'program register 12
        OUT &H3D5, Ho%

        'request access to register 13
        OUT &H3D4, 13
        'program register 13
        OUT &H3D5, Lo%

        'pause a moment for effect
        TickPause 1

        'restore viewport into video RAM
        Lines% = 0

        'turn text lines into register values
        Lo% = (Lines% * 80) MOD 256
        Ho% = (Lines% * 80) \ 256

        'request access to register 12
        OUT &H3D4, 12
        'program register 12
        OUT &H3D5, Ho%

        'request access to register 13
        OUT &H3D4, 13
        'program register 13
        OUT &H3D5, Lo%

        'pause a moment for effect
        TickPause 1

    NEXT

END SUB

SUB StuffMess (Arry%(), Mess$, Row%, Col%, Fg%, Bg%) STATIC

    ' Arry%()       Screen image array.
    ' Mess$         Message to place into the screen image array.
    ' Row%          Screen row location for the message.
    ' Col%          Screen column location for the message.
    ' Fg%           Foreground color of the message.
    ' Bg%           Background color of the message.

    '---- Convert Foreground & Baground colors to a screen attribute integer.
    BColr = Bg * 16                          'Put color into proper range.
    FColr = Fg                               'Set forground color.
    IF FColr > 15 THEN BColr = BColr + 128   'Set blink attribute.
    FColr = FColr AND 15                     'Remove blink attribute.
    Colr = FColr + BColr                     'Create screen attribute integer.

    '---- Combine the Row & Col position into a starting point for video map.
    Start = (((Row * 160) - 160) + (Col * 2)) - 2

    ArySeg = VARSEG(Arry%(0))       'Segment address of the array.
    AryPtr = VARPTR(Arry%(0))       'Offset of the array.
    I = 0                           'Initialize position counter.

    DEF SEG = ArySeg
    FOR J = 1 TO LEN(Mess$)                             'Loop thru message.
        POKE AryPtr + Start + I, ASC(MID$(Mess$, J, 1)) 'POKE the character.
        POKE AryPtr + Start + I + 1, Colr               'POKE the color.
        I = I + 2                                       'Increment 'I' by 2.
    NEXT
    DEF SEG

END SUB

SUB TickPause (Ticks%) STATIC

    ' Ticks%        The number of ticks to delay.  There are 18.2 ticks
    '               per second.  This routine returns the ticks as an
    '               integer - it does not use QB's floating point routine.

    TestTick = 0

    DEF SEG = zero
    WHILE TestTick < Ticks

        lastTick = Tick
        Tick = PEEK(&H46C)     'Get a tick from the clock.

        '   ---- Prevents endless loop when rolling past midnight.
        IF lastTick <> Tick THEN TestTick = TestTick + 1

    WEND
    DEF SEG

END SUB