'===========================================================================
' Subject: PB TEXT MODE SCREEN SAVER          Date: 11-05-96 (11:12)       
'  Author: Alexander Podkolzin                Code: PB                     
'  Origin: APP@nw.sbank.e-burg.su           Packet: TEXT.ABC
'===========================================================================
'-------------------------------------------------------------------------
'
' Simple text mode screen saver (PowerBasic 3.2).
' Author - Alexander Podkolzin <APP@nw.sbank.e-burg.su>
' Public domain.
' Test it before using!
'
'-------------------------------------------------------------------------
' Not PowerBasic users! Exclude subs SaveScreen and RestoreScreen...
'-------------------------------------------------------------------------
'
  DEFINT a-z
'

  ScreenSaver

'
  SUB ScreenSaver
'
'   It works fine on my 100DX4 ...
'
     %MaxStars = 50               ' Number of "stars" on the screen
     DIM Star(2000)               ' Array of "stars"
'
     SaveScreen w$,1,1,80,25,0
'
     CLS                          ' Initial settings...
     RANDOMIZE TIMER
'
     FOR i=1 TO %MaxStars
        Star(INT(RND*1999)+1) = 1
     NEXT
'
     s$=CHR$(250)
     FOR k=1 TO 2000
        IF Star(k)<>0 THEN
           GOSUB CalcYX
           GOSUB ShowStar
        END IF
     NEXT
'
     DO                           ' Main loop
        s$=INKEY$
        IF s$<>"" THEN EXIT LOOP
'
        k = INT(RND*1999)+1
'
        IF Star(k)=1 THEN
           s$=CHR$(250)
        ELSEIF Star(k)=2 THEN
           s$=CHR$(249)
        ELSEIF Star(k)=3 THEN
           s$=CHR$(7)
        ELSEIF Star(k)>4 THEN
           s$=" "
        END IF
'
        IF k<2001 THEN
           IF Star(k)<>0 THEN
              GOSUB CalcYX
              GOSUB ShowStar
              INCR Star(k)
              IF Star(k)>4 THEN
                 GOSUB KillStar
                 n=0
                 FOR i=1 TO 2000
                    IF Star(i)<>0 THEN INCR n
                 NEXT
                 d = %MaxStars - n
                 IF d>0 THEN
                    FOR i=1 TO d
                       GOSUB AddStar
                    NEXT
                 END IF
              END IF
           END IF
        END IF
        COLOR 8,0
        LOCATE 1,72               ' Printing time at upper right corner
        PRINT TIME$;              ' of the screen.
     LOOP
'
     RestoreScreen w$,1,1
'
     EXIT SUB
'

CalcYX:
     y = k \ 80 +1
     x = (k MOD 80)+1
     RETURN
'

KillStar:
     Star(k)=0
     LOCATE y,x
     PRINT " ";
     RETURN
'
'

ShowStar:
     LOCATE y,x
     c = INT(RND*15)+1            ' Random color (1 - 15)
     COLOR c,0
     PRINT s$;
     RETURN
'
'

AddStar:
     DO
        k = INT(RND*2000)+1
        IF k<2001 AND Star(k)=0 THEN
           Star(k)=1
           EXIT LOOP
        END IF
     LOOP
     RETURN
'
  END SUB
'
'-------------------------------------------------------------------------
  SUB SaveScreen(w$,xb%,yb%,xe%,ye%,sh%) PUBLIC
     DIM temp AS BYTE PTR
     DIM WinPtr AS BYTE PTR
     DIM TextPtr AS BYTE PTR
     lx% = (xe% - xb% + 1) * 2
     ly% = ye% - yb% + 1
     IF sh% THEN
        INCR lx%,2
        INCR ly%
     END IF
     l$ = RIGHT$(" " + STR$(lx%), 3 )
     w$ = l$ + SPACE$( lx% * ly% )
     WinPtr = PBVSCRNBUFF + (yb%-1)*160 + (xb%-1)*2
     TextPtr = STRPTR32(w$) + 3
     FOR i%=1 TO ly%
        temp = WinPtr
        FOR k%=1 TO lx%
           @TextPtr = @temp
           INCR TextPtr
           INCR temp
        NEXT
        INCR WinPtr,160
     NEXT
  END SUB
'-------------------------------------------------------------------------
  SUB RestoreScreen(w$,xb%,yb%) PUBLIC
     DIM temp AS BYTE PTR
     DIM WinPtr AS BYTE PTR
     DIM TextPtr AS BYTE PTR
     l$ = LEFT$(w$,3)
     w$ = LTRIM$(w$,l$)
     lx% = VAL(l$)
     ly% = LEN(w$) \ lx%
     TextPtr = STRPTR32(w$)
     WinPtr = PBVSCRNBUFF + (yb%-1)*160 + (xb%-1)*2
     FOR i%=1 TO ly%
        temp = WinPtr
        FOR k%=1 TO lx%
           @temp = @TextPtr
           INCR TextPtr
           INCR temp
        NEXT
        INCR WinPtr,160
     NEXT
  END SUB
'-------------------------------------------------------------------------