'===========================================================================
' Subject: PB ICON VIEWER                    Date: 05-28-98 (20:19)       
' Author:  Dieter Folger                     Code: PB                     
' Origin:  folger@bamberg.baynet.de        Packet: GRAPHICS.ABC
'===========================================================================
'--------------------------------------------------'
' ICONSHOW.BAS for PowerBasic 3.x                  '
' Version 1.4  05.07.1998                          '
'--------------------------------------------------'
' Shows all *.ICO files in current directory,      '
' 36 per screen using original icon palette.       '
' VGA card and color monitor required.             '
' Freeware (c) 1997/98 by Dieter Folger            '
' E-mail: folger@bamberg.baynet.de                 '
' For comments, improvements or questions          '
' I'd like to hear from you. Have fun!             '
'--------------------------------------------------'
'==================================================
' MAIN PROGRAM
'==================================================
 DEFINT A - Z
 File$ = DIR$ ("*.ICO") 'get first *.ICO file in dir
 IF File$ = "" THEN     'no *.ICO files found
    PRINT "No icons found in current directory"
    GOTO Quit
 END IF
   'switch to graphic mode, set
   'palette and prepare screen:
 SetScreen
 DO
   IF File$ = "" THEN GOTO Finish  'quit if there are no more files
   X = 50 : Y = 60                 'position of upper left icon
   FOR Icons = 1 TO 36             'maximum 36 per screen
       OPEN File$ FOR BINARY AS #1
         'Check if it's really an icon file (has always 766 bytes):
       IF LOF(1) <> 766 THEN DECR Icons : GOTO NextOne
       Count = 0
       REDIM Pixel?(1:1024)       'dim array for icon pixels
       FOR i = 1 TO 1024 STEP 8   'get AND mask of icon
           GET #1, 638 + Count, B
             'When a bit is set in AND mask then background should look
             'through and we mark this position with a dummy (16):
           FOR j = 0 TO 7
               IF BIT(B, j) THEN Pixel?(7 + i - j) = 16
           NEXT
           INCR Count
        NEXT
        Count = 0
        FOR i = 1 TO 1024 STEP 2  'get XOR mask of icon
            GET #1, 126 + Count, B
              'when pixel array is still 0 at "i"-position
              '(=no dummy set) we have to calculate pixel color:
            IF Pixel?(i) = 0 THEN Pixel?(i) = (B AND 240) / 16
            IF Pixel?(i+1) = 0 THEN Pixel?(i + 1) = B AND 15
            INCR Count
        NEXT
          'Make a button as icon background:
        MakeButton x - 6, y - 6, x + 38, y + 38
          'Prepare to write file name centered under button:
        f = (12 - LEN(File$)) \ 2
        F$ = LEFT$(SPACE$(f) + File$ + Space$(f) + " ", 12)
        PPrint F$, x - 29, Y + 40, 14, 6
        Count = 1
        FOR Row = 32 TO 1 STEP -1
            FOR Col = 1 to 32
                  'When pixel in array is a valid color
                  '(i.e. not 16) then show it:
                IF Pixel?(Count) < 16 THEN
                   SetPixel X + Col, Y + Row, Pixel?(Count)
                END IF
                INCR Count
            NEXT
        NEXT
        INCR X, 102
        IF X > 600 THEN X = 50 : INCR Y , 64
   NextOne:
        CLOSE
        File$=DIR$  'Get next *.ICO file in DIR
        IF File$ = "" THEN EXIT FOR
   NEXT
Finish: 'No more icons in dir or 36 shown:
   IF File$ = "" THEN
      PPrint "No more icons found. Press ESC to end.", 160, 440, 15, 6
   ELSE
      PPrint "  Press a key to continue (ESC = end) ", 160, 440, 15, 6
   END IF
   DO : K$=INKEY$ : LOOP UNTIL LEN(K$)
 LOOP UNTIL K$ = CHR$(27)
 SCREEN 0   'back to text mode
Quit:
 COLOR 10 : PRINT "þ ";: COLOR 7
 PRINT "ICONSHOW is freeware (c) 1998 by D. Folger"
END
'==================================================
' END OF MAIN PROGRAM
'==================================================
'------------
SUB SetScreen
'------------
 SCREEN 12
 FOR Clr = 0 TO 15  'Set palette
     READ b, g, r   'read data
     SetRGB Clr, r, g, b
 NEXT
 MakeWindow 0, 0, 640, 480, 6
 PPrint "I C O N S H O W  1.4", 235, 10, 11, 6
 PPrint "    Freeware (c) 1998 by D. Folger    ", 165, 25, 15, 6
END SUB
'------------------------------------------
SUB SetPixel (BYVAL x, BYVAL y, BYVAL colr)
' This routines replaces PSET
' because it's faster
'------------------------------------------
 ! mov dx, &h03ce
 ! mov ax, &h0205
 ! out dx,ax
 ! mov ax, y
 ! mov bx,ax
 ! mov cl,6
 ! shl ax,cl
 ! mov dx,ax
 ! mov cl,4
 ! mov ax,bx
 ! shl ax,cl
 ! add dx,ax
 ! mov ax, x
 ! mov bx,ax
 ! mov cl,3
 ! shr ax,cl
 ! add dx,ax
 ! and bl,7
 ! xor bl,7
 ! mov cl,bl
 ! mov al,1
 ! shl ax,cl
 ! push dx
 ! mov bx,ax
 ! mov dx, &h3ce
 ! mov al,8
 ! out dx,al
 ! inc dx
 ! mov al,bl
 ! out dx,al
 ! pop si
 ! mov ax, &hA000
 ! mov es,ax
 ! mov al,es:[si]
 ! mov al, colr
 ! mov es:[si],al
 ! mov dx, &h03ce
 ! mov ax, &hff08
 ! out dx,ax
 ! mov ax,5
 ! out dx,ax
END SUB
'----------------------------------------------------
'Following routines paint window, button and frames
'----------------------------------------------------
'------------------------------
SUB MakeButton (x1, y1, x2, y2)
'------------------------------
 LINE (x1 - 1, y1 - 1)-(x2 + 1, y2 + 1), 0, B
 LINE (x1 + 1, y1 + 1)-(x2 - 1, y2 - 1), 7, BF
 LeftLine x1, y1, x2, y2
END SUB
'-----------------------------
SUB RightLine (x1, y1, x2, y2)
'-----------------------------
 LINE (x1, y2) - (x1, y1), 0
 LINE (x1, y1) - (x2, y1), 0
 LINE (x1, y2) - (x2, y2), 15
 LINE (x2, y2) - (x2, y1), 15
END SUB
'----------------------------
SUB LeftLine (x1, y1, x2, y2)
'----------------------------
 LINE (x1, y2) - (x1, y1), 15
 LINE (x1, y1) - (x2, y1), 15
 LINE (x1, y2) - (x2, y2),  8
 LINE (x2, y2) - (x2, y1),  8
END SUB
'-----------------------------
SUB MakeBoard (x1, y1, x2, y2)
'-----------------------------
 LINE (x1 + 2 , y1 + 2) - (x2 + 2 , y2 + 2), 8, BF
 LINE (x1, y1) - (x2, y2), 7, BF
 LINE (x1, y1) - (x2, y2), 0, B
 RightLine x1 + 5, y1 + 5, x2 - 5, y2 - 5
 LeftLine  x1 + 1, y1 + 1, x2 - 1, y2 - 1
END SUB
'-----------------------------------
SUB MakeWindow (x1, y1, x2, y2, col)
'-----------------------------------
 IF x2 < 100 THEN x2 = 100
 IF y2 < 32 THEN y2 = 32
 MakeBoard x1, y1, x2, y2
 LINE (x1 + 7, y1 + 7) - (x2 - 8, y2 - 8), Col, BF
 LINE (x1 + 6, y1 + 6) - (x2 - 6, y1 + 6), 0
 LINE (x1 + 7, y1 + 7) - (x2 - 7, y1 + 7), 8, B
END SUB
'-----------------------------------
SUB PPrint (Text$, x%, y%, fg%, bg%)
'Allows to print text in VGA mode
'at any screen position in any
'foreground and background color
'-----------------------------------
 SHARED Seg16??,Ofs16??
 LOCAL i%,j%,k%,z%,char%
 IF Seg16?? = 0 THEN GetFontAdr 'first time only
 DEF SEG = Seg16??
    FOR i = 1 TO Len(Text$)
        Char% = ASC(MID$(Text$, i, 1))
        Adr?? = Ofs16?? + 8 * Char%
        FOR j = 1 TO 8
            FOR k = 1 TO 8
                z = PEEK(Adr?? + k - 1)
                IF BIT(z, 8 - j) THEN
                   SetPixel x + j, y + k, fg
                ELSE
                   SetPixel x + j, y + k, bg
                END IF
            NEXT k
        NEXT j
        INCR x, 8
    NEXT i
 DEF SEG
END SUB
'-------------
SUB GetFontAdr
'-------------
 SHARED Seg16??,Ofs16??
 ! push bp
 ! mov ax,&H1130
 ! mov bh,3
 ! int &H10
 ! mov Seg16??,es
 ! mov Ofs16??,bp
 ! pop bp
END SUB
'---------------------------------------------
'palette data as stored in every icon file
'(would be slower to read them from file):
DATA 0,0,0,0,0,32,0,32,0,0,32,32,32,0,0,32,0
DATA 32,32,32,0,48,48,48,32,32,32,0,0,63,0,63
DATA 0,0,63,63,63,0,0,63,0,63,63,63,0,63,63,63
'------------------------------------
SUB SetRGB (BYVAL c AS BYTE, r, g, b)
'------------------------------------
  LOCAL Col?
  ! mov ax, &h1007 ; get palette color
  ! mov bl, c      ; register value
  ! Int &h10
  ! mov Col?, bh   ; bh holds value now
  OUT &H3C8, Col? : OUT &H3C9, r
  OUT &H3C9, g    : OUT &H3C9, b
END SUB