home *** CD-ROM | disk | FTP | other *** search
/ No Fragments Archive 10: Diskmags / nf_archive_10.iso / MAGS / DBA / ST / DBA_03.MSA / GFA_PROG.S / UNPAKLOW.LST < prev    next >
Encoding:
File List  |  1989-04-06  |  3.8 KB  |  75 lines
  1. '                 ****************************************
  2. '                 *   Listing from DBA Diskmagazine 3    *
  3. '                 *                                      *
  4. '                 *   Low-res Degas picture loader       *
  5. '                 *        and un-packer in GFA          *
  6. '                 *  Converted from Hi-soft basic -> GFA *
  7. '                 *     Program by Bonus Software        *
  8. '                 *                                      *
  9. '                 ****************************************
  10. '
  11. '
  12. sc%=XBIOS(3)                                    ! start address screen
  13. '
  14. DO
  15.   SHOWM                                         ! showm mouse
  16.   FILESELECT "a:\pictures\*.pc1","default.pc1",a$  ! fileselector to choose pic.
  17.   IF a$<>""                                     ! if exists
  18.     HIDEM                                       ! hide mouse
  19.     OPEN "i",#1,a$                              ! open picture
  20.     dummy$=INPUT$(2,#1)                         ! read first 2 usless (to us)
  21.     '                                           ! bytes.
  22.     FOR i%=0 TO 15                              ! for next to get the 16 colors
  23.       c%=256*ASC(INPUT$(1,#1))+ASC(INPUT$(1,#1))! make decimal value of it
  24.       SETCOLOR i%,c%                            ! setcolor to the value
  25.     NEXT i%                                     ! get next color
  26.     scr%=sc%                                    ! copy screen address in scr%
  27.     FOR scan%=0 TO 199                          ! for next for number of lines
  28.       FOR plane%=0 TO 6 STEP 2                  ! for next for number of bit
  29.         ~INP(2)
  30.         '                                       ! planes ( low res 4 planes )
  31.         addr%=scr%+160*scan%+plane%             ! screen counter
  32.         volg%=addr%+160                         ! screen counter + 1 line
  33.         DO                                      ! start unpacking
  34.           b%=ASC(INPUT$(1,#1))                  ! get byte
  35.           IF b%<128                             ! if it is smaller then 128
  36.             FOR i%=0 TO b%                      !
  37.               POKE addr%,ASC(INPUT$(1,#1))      ! poke it straight into the
  38.               '                                 ! screen
  39.               IF addr% AND 1
  40.                 addr%=addr%+7
  41.               ELSE
  42.                 INC addr%
  43.               ENDIF
  44.             NEXT i%
  45.           ENDIF
  46.           IF b%>128                             ! if bigger then 128
  47.             tel%=ASC(INPUT$(1,#1))              ! get next byte for signed
  48.             '                                   ! single byte number
  49.             FOR i%=1 TO 256-b%+1                ! subtract it from 256 to know
  50.               '                                 ! the signed one.
  51.               POKE addr%,tel%                   ! poke into screen
  52.               IF addr% AND 1
  53.                 addr%=addr%+7
  54.               ELSE
  55.                 INC addr%
  56.               ENDIF
  57.             NEXT i%
  58.           ENDIF
  59.           EXIT IF addr%=volg%                   !exit if end of line
  60.         LOOP
  61.       NEXT plane%                               ! next plane in line
  62.     NEXT scan%                                  ! next line
  63.     CLOSE #1                                    ! if end of file close #1
  64.     OUT 2,7                                     ! make ping sound to know if
  65.     '                                           ! picture is ready
  66.     ~INP(2)                                     ! wait for key press
  67.     CLS                                         ! clear screen
  68.     SETCOLOR 0,0                                ! black background
  69.     SETCOLOR 15,7,7,7                           ! white letters
  70.   ELSE
  71.     END                                         ! if no filename is chosen
  72.     '                                           ! then just end program
  73.   ENDIF
  74. LOOP
  75.