'
'
' CRACK ART 'CA_PACK'
'
' Kompressionsroutine f�r CA?-Bilder
'
' ½ Detlef R”ttger & Jan Borchers 1989-91
'
'
INLINE ca_pack%,590
'
resolution&=XBIOS(4)                            ! Aufl”sung holen
IF resolution&>2                                ! keine ST-Aufl”sung
  END
ENDIF
'
DO
  fpath$=CHR$(GEMDOS(25)+65)+":"+DIR$(0)+"\*.CA"+CHR$(resolution&+49)
  FILESELECT #"SAVE CA",fpath$,"",fname$        ! File ausw„hlen
  CLS
  IF fname$=""                                  ! Abbruch
    END
  ENDIF
  '
  FOR i&=1 TO 50
    DEFFILL RANDOM(16),1,0
    PCIRCLE RANDOM(WORK_OUT(0)),RANDOM(WORK_OUT(1)),RANDOM(50)
  NEXT i&
  '
  buffer$=STRING$(32000,0)                      ! Buffer reservieren
  HIDEM
  len%=C:ca_pack%(L:XBIOS(2),L:V:buffer$)       ! Image packen
  SHOWM
  '
  PRINT AT(1,1);"Bild von 32000 Bytes auf ";len%;" Bytes (";
  PRINT INT(100*len%/32000);"%) gepackt."
  '
  OPEN "O",#1,fname$                            ! File ”ffnen
  '
  SELECT resolution&
    '
  CASE 0                                        ! Low Res
    header$=STRING$(4+32,0)
    DPOKE V:header$,&H4341                      ! 'CA'-Kennung
    DPOKE V:header$+2,&H100                     ! Low Res gepackt
    FOR i&=0 TO 15                              ! 16 Farben
      DPOKE V:header$+4+i&*2,XBIOS(7,W:i&,W:-1) AND &H777
    NEXT i&
    BPUT #1,V:header$,4+32
    '
  CASE 1                                        ! Med Res
    header$=STRING$(4+8,0)
    DPOKE V:header$,&H4341                      ! 'CA'-Kennung
    DPOKE V:header$+2,&H101                     ! Med Res gepackt
    FOR i&=0 TO 3                               ! 4 Farben
      DPOKE V:header$+4+i&*2,XBIOS(7,W:i&,W:-1) AND &H777
    NEXT i&
    BPUT #1,V:header$,4+8
    '
  CASE 2                                        ! High Res
    header$=STRING$(4,0)
    DPOKE V:header$,&H4341                      ! 'CA'-Kennung
    DPOKE V:header$+2,&H102                     ! High Res gepackt
    BPUT #1,V:header$,4
    '
  ENDSELECT
  '
  BPUT #1,V:buffer$,len%
  CLOSE #1
  '
  WHILE MOUSEK
  WEND
  REPEAT
  UNTIL MOUSEK
LOOP