'===========================================================================
' Subject: TSR THAT SHOWS A COLOR TABLE      Date: 07-13-98 (11:01)       
' Author:  Dieter Folger                     Code: PB                     
' Origin:  folger@bamberg.baynet.de        Packet: PB.ABC
'===========================================================================
'---------------------------------------------------------------------------
' PBCOLOR.BAS for Power Basic 3.x
' TSR that shows a color table with
' color attribute numbers.
' Hotkey is ALT-C.
' Useful when you write programs using
' QPrint, QAttr etc.
' If you call PBCOLOR with any character
' on the command line, it won't stay resident. 
' Freeware (c) 1995 by Dieter Folger
'---------------------------------------------------------------------------
 DEFINT A - Z
 IF LEN(COMMAND$) THEN        ' Don't stay resident
    SaveScreen Temp$
    ColorTable ""             ' Show color table
    RestoreScreen Temp$
    END
 END IF
 POPUP MULTIPLEX &HC000, 254   ' reg AX and DX get this char as ID
 REG 1, &HC000 : REG 4, 254    ' check for char (then already installed)
 CALL INTERRUPT &H2F           ' multiplex interrrupt
 IF REG(1) <> &HC000 AND REG(4) <> 254 THEN END 
 x& = SETMEM(-600000)          ' release unused memory
 x& = SETMEM(1024)
 POPUP KEY CHR$(8,46,247)      ' ALT-C is hot key
 SwapFile$ = LEFT$(CURDIR$,2) + "\PBCOL.SWP" ' Swap file to use
 PRINT "PBCOLOR installed"
 PRINT "Press ALT-C to activate"
 REG 1, &HC001 : REG 4, 253             ' Alter AX, DX to 253 
 POPUP SLEEP USING EMS, SwapFile$       ' and go to sleep
 WHILE 1 = 1                            ' eternal loop
   Yy = CSRLIN : Xx = POS(0)            ' save cursor position
   IF REG(1) = &HC000 AND REG(4) = 254 THEN ' don't install again
      PRINT "PBCOLOR already installed"
      PRINT "PRESS ALT-C to activate"
      GOTO SleepNow
   ELSE
     SaveScreen Scrn1$                  ' save screen and
     ColorTable FKey$                   ' show the color table
   END IF
   IF FKey$ = "U" THEN                  ' uninstall
      IF POPUP(1) THEN                  ' if it's possible
         RestoreScreen Scrn1$           ' restore screen and
         PRINT "PBCOLOR removed from memory"
  END                            ' uninstall program
      ELSE                              ' if not possible
         SaveScreen Temp$               ' tell user how to do it
  LOCATE 10, 23 : COLOR 15,1
         PRINT " Can't uninstall within a program "
         LOCATE 11, 23
         PRINT "  Uninstall from DOS prompt       "
  FKey$ = ""
         DO : LOOP UNTIL INSTAT
  RestoreScreen Temp$
      END IF
   END IF
   RestoreScreen Scrn1$
 SleepNow:
   LOCATE Yy,Xx, 1                     ' Restore cursor position
   REG 1, &HC001 : REG 4, 253          ' Alter AX, DX to show it's resident
   POPUP SLEEP                         ' before going to sleep
 WEND
'----------------------------------------------------------------------------
SUB ColorTable(FKey$) 
'----------------------------------------------------------------------------
  COLOR  15, 1 : CLS
  LOCATE 2, 26, 0 : PRINT "Power Basic Color Attributes"
  Blink 0                       ' enable hilite background
  C = 8 : R = 5 : LOCATE R, C
  FOR Back = 0 TO 15
      FOR Fore = 0 TO 15
          Col$ = " " + RIGHT$("000" + LTRIM$(STR$(Back * 16 + Fore)), 3) + " "
          LOCATE R + Back, C
          B = Back : F = Fore
          IF Back > 7 THEN B = Back - 8 : F = Fore + 16
          COLOR F, B : PRINT Col$;
          INCR C, 4 : IF C > 68 THEN C = 8
      NEXT
  NEXT
  COLOR 15, 1, 0
  LOCATE 24, 25, 0 : PRINT "Press a key to enable blinking"
  DO : K$ = INKEY$ : LOOP UNTIL LEN(K$)
  Blink 1                       ' leave program with blink attr  
  LOCATE 24, 22, 0 : PRINT "Press a key to end - <U> to uninstall"
  DO : K$ = INKEY$ : LOOP UNTIL LEN(K$)
  COLOR 7, 0
  IF UCASE$(K$) = "U" THEN FKey$ = "U"  
END SUB
'----------------------------------------------------------------------------
SUB Blink (BYVAL Mode)  ' Mode: 1 = blink / 0 = hilite background
'----------------------------------------------------------------------------
  ! mov ax, &H1003 
  ! mov bx, Mode 
  ! int &H10
END SUB
'----------------------------------------------------------------------------
SUB SaveScreen (ScreenSave$)
'----------------------------------------------------------------------------
  IF (PbvScrnCard AND 1) = 0 THEN
 Address = &HB800  
  ELSE
 Address = &HB000  
  END IF
  DEF SEG = Address 
      ScreenSave$ = PEEK$(0,4000)
  DEF SEG
END SUB
'----------------------------------------------------------------------------
SUB RestoreScreen (ScreenSave$)
'----------------------------------------------------------------------------
  IF (PbvScrnCard AND 1) = 0 THEN
 Address = &HB800 
  ELSE
 Address = &HB000 
  END IF
  DEF SEG = Address
      POKE$ 0, ScreenSave$
  DEF SEG
END SUB