'****************************************************************************
'
'  The german Basic Network - BasNet, INTRO (Copperbars f�r PowerBASIC 3.2)
'
'  entwickelt von / developed by    :  Thomas Gohel
'                           Fido    :  Thomas Gohel@2:2410/330.1
'                           InterNet:  author@pbsound.snafu.de
'                           Homepage:  http://www.snafu.de/~pbsound/
'
'  Nach einer TP/MASM Copper-Vorlage aus PC-Underground von:
'                           Boris Bertelsons (The CoExistence)
'                           Mathias Rasch (Vision Factory)
'
'  Maske%: &hff00 = Copper 2 im Vordergrund
'          &h00ff = Copper 1 im Vordergrund
'          &h0000 = Durchdringung beider Copper
'
'****************************************************************************

$COMPILE EXE                        ' als EXE kompilieren
$CPU 80386                          ' einen 386'er hat eh jeder
$LIB ALL OFF                        ' es werden keinerlei Libray's ben�tigt
$ERROR ALL OFF                      ' Error-Behandlung brauchen wir auch nicht

DIM Hoehe AS SHARED INTEGER
SHARED Y1%, Y1_Dir%, Maske%
SHARED Hoehe1%, Hoehe2%, Hoehe3?

Hoehe%  = 88
Hoehe1% = Hoehe% - 1
Hoehe2% = Hoehe%\2-1
Hoehe3? = (128-Hoehe%) \ 2

Y1%     = 0                         ' Start am oberen Bildschirmrand
Y1_Dir% = 2                         ' Bewegung zun�chst nach unten
Maske%  = &h00ff                    ' zun�chst Copper 1 (rot) im Vordergrund

ZeigeBasNet
ZeigeCopper
COLOR 7,0
PRINT "This Intro is written in plain PowerBASIC ...  :)))"
END

SUB ZeigeBasNet
        COLOR 14, 0
        PRINT "                                                      __   __   __   _    __ ___";
        PRINT "���������������������������������������������������� |__| |__| |__  | \| |__  | ";
        PRINT " �� The german Basic Network - Informationen ������  |__| |  |  __| |  | |__  | ";
        PRINT "��������������������������������������������������������������������������������";
        COLOR 15,0
        PRINT
        PRINT "    � Post, Online-Zugang (�ber Mailbox), Fido- & BasNet:"
        PRINT
        PRINT "      performance Multimedia           Fax: 06074-29749"
        PRINT "      R�merstr. 46                 Mailbox: 06074-41307  (24h, 19200bps, 8N1)"
        PRINT "      63128 Dietzenbach                     06074-812355 (24h, 14400bps, 8N1)"
        PRINT "      Deutschland                           06074-812356 (24h, ISDN)"
        COLOR 15,0
        PRINT
        PRINT "    � Anfragen �ber das InterNet (ebenso CompuServe und T-Online):"
        PRINT
        PRINT "      Email Adresse :  basnet@pbsound.snafu.de"
        PRINT "      World Wide Web:  http://www.snafu.de/~pbsound/"
        PRINT
        PRINT "(c) Thomas Gohel/PR, All rights reserved"
        COLOR 11, 0
        PRINT "��������������������������������������������������������������������������������";
        PRINT " �� BasNet = email, sources, toolboxes and much more for BASIC programmers!! �� ";
        PRINT "��������������������������������������������������������������������������������";
END SUB

SUB ZeigeCopper
        DO
           INCR Y1%, Y1_Dir%                 ' Copper-Bewegung
           IF Y1% <=0  OR Y1% >= 220  THEN   ' am Rand
               Y1_Dir% = -Y1_Dir%            ' Richtung umkehren
               ! mov ax, Maske%
               ! mov Maske%[00], ah
               ! mov Maske%[01], al
           END IF
           MakeCopper Y1%, 220-Y1%, Maske%   ' Copper zeichnen
       LOOP WHILE INKEY$ = ""
END SUB

SUB MakeCopper(BYVAL Y_Pos1%, BYVAL Y_Pos2%, BYVAL Overlay_Maske%)
        LOCAL Maxrow%

        ! mov ax, Y_Pos1%           ; maximale y-Koordinate bestimmen
        ! cmp ax, Y_Pos2%
        ! ja  Ax_High
        ! mov ax, Y_Pos2%

        Ax_High:
        ! add ax, Hoehe%            ; H�he drauf
        ! mov MaxRow%, ax           ; maximale Zeile, die beachtet werden mu�

        ! xor cx, cx                ; Zeilenz�hler mit 0 starten

        ! call WaitRetrace          ; auf Retrace warten zur Synchronisation

        Next_Line:
        ! inc cx                    ; Zeilenz�hler hochz�hlen

        ! mov bx, cx                ; Farbe 1 berechnen
        ! sub bx, Y_Pos1%           ; dazu Position relativ zum Copperstart holen
        ! cmp bx, Hoehe2%           ; schon 2. H�lfte ?
        ! jle Copper1_Up
        ! sub bx, Hoehe1%           ; dann bx:=127-bx
        ! neg bx

        Copper1_Up:
        ! or bx, bx
        ! jns Copper1_Ok            ; positiv, dann Farbe
        ! xor bl, bl

        Copper1_Ok:
        ! mov ax, cx                ; Farbe 2 berechnen
        ! sub ax, Y_Pos2%           ; Position relativ berechnen
        ! cmp ax, Hoehe2%           ; 2. H�lfte
        ! jle Copper2_Up
        ! sub ax, Hoehe1%           ; dann ax:=127-ax
        ! neg ax

        Copper2_Up:
        ! or ax, ax                 ; positiv, dann Farbe
        ! jns Copper2_Ok
        ! xor al, al

        Copper2_Ok:
        ! mov bh, al                ; bl hat jetzt Farbe Copper 1 / bh Copper 2

        ! mov ax, bx                ; Overlay berechnen
        ! and ax, Overlay_Maske%    ; Copper 1 oder 2 ausmaskieren
        ! or al, al                 ; Copper 1 Vorrang
        ! je Copper1_Hinten
        ! xor bh, bh                ; dann Copper 2 l�schen

        Copper1_Hinten:
        ! or ah, ah                 ; Copper 2 Vorrang
        ! je Copper2_Hinten
        ! xor bl, bl                ; dann Copper 1 l�schen

        Copper2_Hinten:

        ! xor al, al                ; Farbe 0 im DAC selektieren
        ! mov dx, &h3c8
        ! out dx, al

        ! or bl, bl                 ; wenn Copper 1 schwarz -> lassen
        ! je bl_0
        ! add bl, Hoehe3?           ; sonst aufhellen, um Maximalhelligkeit
                                    ' zu erreichen
        bl_0:
        ! or bh, bh                 ; f�r Copper 2 das Gleiche
        ! je bh_0
        ! add bh, Hoehe3?

        bh_0:

        ' jetzt auf horizontalen Retrace warten und Copper aktivieren

        ! cli                       ; Interrupts l�schen, da SEHR zeitkritisch
        ! mov dx, &h3da             ; Input Status Register 1 selektieren

        In_Retrace:
        ! in al, dx                 ; auf Display warten
        ! test al, 1
        ! jne In_Retrace

        In_Display:
        ! in al, dx                 ; Warten auf (Horizontal-) Retrace
        ! test al, 1
        ! je In_Display

        ! mov al, bl                ; Farbe 1 laden
        ! mov dx, &h3c9             ; und setzen
        ! out dx, al                ; Rot-Anteile f�r Copper 1 setzen
        ! mov al, bh
        ! out dx, al                ; Gruen-Anteile f�r Copper 2 setzen
        ! xor al, al
        ! out dx, al

        ! cmp cx, MaxRow%           ; letzte Zeile erzeugt ?
        ! jne Next_Line

        ! mov dx, &h3da             ; ja -> beenden

        Wait_Hret:
                                    ' vor dem Abschalten, unbedingt auf Retrace
        ! in al, dx                 ; warten, sonst Flimmern in letzter Zeile
        ! test al, 1
        ! je Wait_Hret

        ! xor al, al                ; Farbe 0 im DAC selektieren
        ! mov dx, &h3c8
        ! out dx, al
        ! inc dx                    ; alle auf 0 setzen: schwarz
        ! out dx, al
        ! out dx, al
        ! out dx, al

        ! sti
        EXIT SUB

        WaitRetrace:
        ! mov dx, &h03da
        WaitRet1:
        ! in al, dx
        ! test al, 8
        ! jnz WaitRet1
        WaitRet2:
        ! in al, dx
        ! test al, 8
        ! jz WaitRet2
        ! retn
END SUB