'===========================================================================
' Subject: 256 COLORS ICON VIEWER FOR PB     Date: 01-28-99 (09:08)       
' Author:  Dieter Folger                     Code: PB                     
' Origin:  folger@bamberg.baynet.de        Packet: GRAPHICS.ABC
'===========================================================================
 '--------------------------------------------------------
 ' ICON256.BAS for Power Basic
 ' Shows 256 colors icon files
 ' Freeware (c) 1998 by D. Folger
 ' VESA mode 101h (640x480x255) is used.
 ' Compatible graphics card required (this is checked).
 ' Demo program shows the 256 colors icons that can be
 ' found in current dir.
 ' Note: Icons that do not use the standard palette are
 ' not shown with correct colors.
 '--------------------------------------------------------
$IF 0
 Structure of icon files:
          256 colors icon        16 colors icon
 Name     Size    Offs           Size   Offs
 ----------------------------------------------------
 Header     62      0h    (0d)     62     0h   (0d)
 Palette  1024     3eh   (62d)     64    3eh  (62d)
 XOR mask 1024    43Eh (1086d)    512    7Eh (126d)
 AND mask  128    83Eh (2110d)    128   27Eh (638d)
 ----------------------------------------------------
 Total    2238 bytes              766 bytes
$ENDIF
 DEFINT A-Z
 TYPE VInfo 'need this for video check
    Sign     AS STRING * 4
    Version  AS INTEGER
    OEMPtr   AS LONG
    Capibil  AS STRING * 4
    ListPtr  AS LONG
    VidMem   AS INTEGER
    Reserved AS STRING * 262
 END TYPE
 ' check if user has VESA compatible card
 IF VesaSupport = 0 THEN PRINT "Sorry, SVGA is not supported." : END
 VesaSet 'Vesa mode 101h (640x480x255)
 File$ = DIR$("*.ICO")
 x = 20 : y = 100 'coordinates of first icon to show
 IF LEN(File$) THEN DO
    OPEN File$ FOR BINARY AS #1
    IF LOF(1) <> 2238 THEN CLOSE : GOTO NextOne
    SEEK #1,&h83e 'start of AND mask
    idx = 0 ' pointer
    REDIM Test(1:1024) AS BYTE
    FOR i = 1 TO 1024 STEP 8
        GET #1, &h83e + idx, b
        FOR j = 0 TO 7         'decode AND-mask
            IF BIT(b, j) THEN Test(7 + i - j) = 1
        NEXT
        INCR idx
    NEXT
    IF ShowIcon = 0 THEN PalSet 'set palette as stored in icon file
    idx = 1024  'pointer
    SEEK #1, &h43e
    GET$ #1, 1024, I$   ' Get XOR mask
    FOR Row = 1 to 32   ' Draw icon now
        FOR Col = 1 to 32
            c? = ASC(MID$(I$,idx,1))
            IF Test(idx) THEN c? = 248 'background is grey
                                       'could be changed
            DECR idx
            PixSet x + col, y + row, c?
        NEXT
    NEXT
    CLOSE
    INCR ShowIcon : INCR x, 40 : IF x > 600 THEN x = 20 : INCR y,40
    IF y > 440 THEN EXIT LOOP 'screen is full
   NextOne:
    File$=DIR$
 LOOP UNTIL File$ = ""
 DO:LOOP WHILE INKEY$=""
 'restore text mode
 ! MOV ax,3
 ! INT &h10
 print ShowIcon;"icons shown"
END
'=== main program ends here ===================================================
'---------
SUB VesaSet
'---------
 !  mov  ax, &h4F02
 !  mov  bx, &h101  ;set mode 101h (640x480x255)
 !  int  &h10
END SUB
'---------
SUB PalSet
'---------
 SEEK #1, 62  'Palette starts here
 GET$ #1, 1024, Pal$  ' Get palette
 FOR i% = 1 TO 1024 STEP 4
     b% = ASC(MID$(Pal$, i%,  1))    \ 4
     g% = ASC(MID$(Pal$, i% + 1, 1)) \ 4
     r% = ASC(MID$(Pal$, i% + 2, 1)) \ 4
     OUT &H3C8, c? : OUT &H3C9, r%
     OUT &H3C9, g% : OUT &H3C9, b%
     INCR c?
 NEXT
END SUB
'------------------------------------------
SUB PixSet (byval x%, byval y%, BYVAL col?)
'------------------------------------------
 'slowly, but it works
 ! mov ah,&h0c
 ! mov al,col?
 ! mov dx,y%
 ! mov cx,x%
 ! int &h10
END SUB
'-------------------
FUNCTION VesaSupport
'-------------------
 DIM SVGA AS VInfo
 segm = VARSEG(SVGA)
 Offs = VARPTR(SVGA)
 ! mov ax, &H4F00
 ! mov es, Segm
 ! mov di, Offs
 ! int &H10
 ! mov support, al
 ! mov status, ah
 VesaSupport = 0 'suppose it's not supported
 IF SVGA.Sign = "VESA" AND Support = &H4F _
 AND Status = 0 THEN Vesasupport = -1
END FUNCTION