.z80
                              aseg
                            org 100h

;::::: program na komprimaci souboru typu .COM  { a asi take na obrazky.. }
;:::::::::::      princip algoritnu :
;::  1) pocet opakujicich se bytu
;::  2) zpetny offset [-4   az -259] , bitmapa na 8 bytu
;::  3) zpetny offset [-260 az -771] , bitmapa na 16 bytu
;:::::::::::

BDOS   equ 5
ZAR    equ 33h
DELTAL equ DELIPS-DELIST ; offset pro ulozeni sizze rozbaleneho
DELTUL equ DELIPU-DELIST
DELFRM equ FRMDEL-DELIST

START:
          jp MZLITE
VSVTL:
 db "  options :",10,10,13
 db "     -p  :  relocate under CCP while extracting",10,13
 db "     -x  :  extract",10,13
 db "     -e  :  extra compression { for commercial version only }",10,13,36
MZLUVOD:
 db 10,13
 db "MZlitå commanä compressor (c© 199³ Svatopluë Sveã, version 2.01b, 01-27-93"
 db 10,10,13,36,0,0,0,0
STACK: dw 0
DELT8:  db 0
DELT8F: dw 0
DELT9:  db 0
DELT9F: dw 0
METODA: db 0
;::::::::::::
LITE:   ; ::::::::::::: zhusti od ^hl do ^(hl+bc) : do  ^de ::::::::::::::::
     ld hl,(FROMLITE)
                              push hl
               xor a
     dec hl
     ld bc,512
LITE44:
               xor a
     ld (hl),a
     dec hl
     dec bc
     ld a,b
          or c
          jr nz,LITE44    ; vynuluj prvni pod nim
                              pop hl
     ld de,(TOLITE)
     ld bc,(UNLSIZE)
          call PKLITE    ; zabal to
     ld hl,(TOLITE)
                         ex de,hl
               or a
               sbc hl,de ; delka zabaleneho
     inc hl
     ld (LITESIZE),hl
          ret
;::::::
;---------------  V L A S T N I  B A L I C I  R U T I N A  --------------
BYTEOPAK: db 0
BITMAP: dw 0,0,0 ; az 24 bitova bitmapa
;::::::
WILLBECOMP:    ; :: zjisti,zda je mozno neco skompresovat,kdyz ano,
;::::: vrati v a - 0: zadna komprese, 1: opakujici se, 2: 8.8, 3: 9.16
     ld (PKLIHL),hl
     ld (PKLIDE),de
     ld (PKLIBC),bc
     ld a,(hl)
     ld (BYTEOPAK),a  ; aby to nemusela delat zjistovaci rutina
          call POSOOP ; zjisti po sobe se opakujici
     ld (POCOPAK),a      ; pocet shod : 1..1
     ld a,16             ; 16 bitu mapa
     ld bc,511           ; zacinam od hranice 8 bit. offsetu,init cpir
     ld de,-771          ; a mam navic 9 bit. offset : = -260 -511 = -771
          call BEDELTA   ; zpet : 8 bitu mapa
     ld (DELT9F),hl      ; adresa startu shody
     ld (DELT9),a        ; pocet shod
     ld a,8              ; 8 bitu mapa,8 bitu offset
     ld bc,255           ;  pro cpir
     ld de,-259          ; pro start backsearch
          call BEDELTA   ; zpet : 255+4,8 {0 = -4,255 = -259 }
     ld (DELT8),a        ; pocet shod   { do bc : 255 }
     ld (DELT8F),hl      ; adresa startu shody
     ld a,(POCOPAK)
     ld hl,OPTABZ
     ld e,a
     ld d,0
               add hl,de
     ld a,(hl)
     ld c,a
     ld a,(DELT8)
     ld e,a
     ld hl,OPTAB8
               add hl,de
     ld a,(hl)           ; beru 8.8
               cp c      ; 8.8 - zab = ..
          jr c,WILL01    ; zab je vyssi,nez 8.8
          jr z,WILL01    ; zab je pri depack rychlejsi..
     ld c,a              ; zab je nizsi,nez 8.8
     ld hl,OPTAB16        ; ulozim 8.8 do c
     ld a,(DELT9)
     ld e,a
               add hl,de
     ld a,(hl)
               cp c      ; 8.16 - 8.8 = ..
          jr c,WILL02    ; 8.8 > 8.16
          jr z,WILL02    ; 8.8 = 8.16
WILL04:
     ld hl,(DELT9F)
     ld (DELTA),hl
     ld a,(DELT9)
     ld b,16
          call MAKEBITM  ; udelej z delty a b bitovou mapu do ^bitmap
     ld a,3
WILL99:
     ld de,(PKLIDE)
     ld hl,(PKLIHL)
     ld bc,(PKLIBC)
               or a
          ret
WILL01:
     ld c,a              ; zab je vyssi,nez 8.8
     ld hl,OPTAB16        ; ulozim zab do c
     ld a,(DELT9)
     ld e,a
               add hl,de
     ld a,(hl)
               cp c      ; 8.16 - zab = ..
          jr c,WILL03
          jr z,WILL03
          jr WILL04
WILL03:                  ; zab je nejlepsi
               or a
          jr z,WILL99    ; ret s zero = no compression
     ld a,(POCOPAK)
     ld (POSHOD),a
     ld a,1
          jr WILL99
WILL02:
     ld hl,(DELT8F)
     ld (DELTA),hl
     ld a,(DELT8)
     ld b,8
          call MAKEBITM
     ld a,2
          jr WILL99
;:::
MAKEBITM:  ; udela a ulozi bitovou mapu podle vstupu
     ld hl,BITMAP
     ld (MYBITM),hl
     ld hl,(PKLIHL) ; aktualni pozice
     ld (POSHOD),a  ; pocet shod pro skok ve zdroji pri dalsim hledani
               or a
     ld de,(DELTA)  ; misto,kde doslo ke shode
               sbc hl,de ; offset :
     ld a,b
               cp 8 ; mam interpretovat jako -4 = 4 = 0 ?
          jr nz,MKBM01   ;  ne,jako -260 = 260 = 0
     ld de,-4
          jr MKBM02
MKBM01:
     ld de,-260
MKBM02:
               add hl,de ; odectu ty 4 : -259=255,-4=0
     ld (OFFSET),hl ; mam korektni delta offset..,8 nebo 9 bitovy
     ld hl,(DELTA)  ; odtud zacinam s predkem
     inc hl
     ld de,(PKLIHL) ; odtud zacinam se zdrojem
     inc de         ; prvni preskocim,ty mi obstara primo offset
     ld c,8         ; pro zaplneni bajtu
MKBM15:
     ld a,(de)
               cp (hl)   ; shoda ?
          jr nz,MKBM10   ; ne
                    scf
     inc de         ; dalsi ze zdroje - z aktualu
          jr MKBM11
MKBM10:
               xor a
MKBM11:
                         exx
                    rl e
                         exx
     inc hl         ; dalsi z predku
     dec c
          jr z,MKBM12 ; plny counter
MKBM16:
          djnz MKBM15 ; plny pocet bitu, pozadovanych do bitmapy
                         exx
     ld a,e
                         exx
                              push hl
     ld hl,(MYBITM)
     ld (hl),a
     inc hl
     ld (MYBITM),hl
                              pop hl
          ret
MKBM12:
     ld c,8
                         exx
     ld a,e
                         exx
                              push hl
     ld hl,(MYBITM)
     ld (hl),a
     inc hl
     ld (MYBITM),hl
                              pop hl
          jr MKBM16
MYBITM: dw 0
;  :::  optimalizacni tabulka ::::
;::: 9,16 ma slusne vysledky az pri 6 shodach;8,8 az pri 4{3:0.75}
OPTAB16: db 0,0,0,0, 0, 70,58,49,44,38,35,32,29,27,25,23,22,21
OPTAB8:  db 0,0,0,0, 56,45,38,32,28,25,0
OPTABZ:  db 0,0,0,63,47,38,31,27,23,21,19,17,16,14,13,12,11,11
;::: zkusime pak pro 8.8-3{0.75} 9.16-4{0.88} a z-2{0.94}
POSOOP:   ; :: vrati v a pocet stejnych bytu vuci bytu x :::
     ld a,(hl)      ; bajt pro shodu
     ld b,16        ; max. pocet po sobe,ktery mohu registrovat
POSO01:
     inc hl
               cp (hl)
          jr nz,POSO02   ; uz neni shoda
          djnz POSO01    ; aspon jednou = 1 : o.k.,vrati presne tolik,
POSO02:                  ; kolik jich tam je
     ld a,16
               sub b
          ret
;::::::::: rutina,zjistujici pocet shod podle vstupu ::: 9.16 nebo 8.8 ::
BEDELTA:  ; ::: KOLIK je za hl-de shod s hl ? :::
     ld (BEDE97+1),a     ; delka bitmapy : zatim 8,16
               cp 16
          jr nz,BEDE01
     ld a,4
          jr BEDE02
BEDE01:
     ld a,3
BEDE02:
     ld (BEDE96+1),a
Š     ld (BEDE98+1),bc
     ld (BEDE99+1),de
               xor a
     ld (MAXLONG),a      ; setup : = 0
     ld hl,(PKLIHL)      ; zdroj
                         exx ; 1
                              push hl
                              push bc
     ld hl,(PKLIHL) ; priprava na zpetne
BEDE99:
     ld bc,0
               add hl,bc ; startovni pozice prohledavani v predku
BEDE98:             ; budto -771 nebo -259
     ld bc,0        ; delka intervalu : budto 511 nebo 255
SUMS06:             ; takze : -771 az -260 nebo -259 az -4 : sem to muze
                         exx  ; 0,zdroj ; dobehnout a zacit compare
     ld a,(hl)      ; pro porovnani : zdroj
                         exx  ; 1,zpet
                              cpir  ; hledam ve zpetnem
          jp po,SUMS02   ; vubec se zde nenaleza,ani jednou,rovnou pryc
     ld (FROMZBYV),bc         ; odkud zacit znova + kolik zbyva prohledat
     ld (FROMZAC),hl          ; adresa ZA touto shodou,aut. inc hl
               xor a
     ld (LONG),a            ; pocet dalsich : setup = 0
     ld a,c         ; kontrola :
BEDE96:
               cp 0 ; pokud bych zajel do sebe : omezit !
          jr nc,SUMS04 ; ne,o.k., takze normal : 8 nebo 16
          jr BEDE10 ; ano,takze to nech postaru
SUMS04:
BEDE97:
     ld c,0        ; zbyva 8,{16}, na prvni ukazuje ^MAXSADR
BEDE10:   ; :::::::::::::  hledam dalsi shody  ::::::::::::::
                         exx  ; 0
     inc hl
     ld a,(hl)      ; beru dalsi bajt pro compare
                         exx  ; 1
                              cpir  ; dalsi ?
          jp po,SUMS03   ; uz zadna dalsi shoda neni
     ld a,(LONG)
     inc a
     ld (LONG),a    ; dalsi shoda, o.k.
          jr BEDE10
SUMS03:
          jr nz,SUMS10   ; konec a shoda nebyla
     ld a,(LONG)         ; a byla,takze jeste pripocist
     inc a
     ld (LONG),a
SUMS10:
     ld a,(MAXLONG)
     ld hl,LONG
               cp (hl)   ; je ma shoda > maximalni ?
          jr c,SUMS05    ; je,prerad
     ld hl,(FROMZAC)     ; neni,vem to,za cim jsem prestal
          jr SUMS07      ; a pokracuj
SUMS05:
     ld a,(LONG)
     ld (MAXLONG),a
     ld hl,(FROMZAC)
     dec hl              ; kvuli cpir
     ld (MAXSADR),hl     ; adresa max shody
SUMS07:
     ld bc,(FROMZBYV)    ; tolik jeste zbyva
                         exx  ; 0
     ld hl,(VYRHL)       ; znova porovnani se zdrojem
                         exx  ; 1
          jr SUMS06      ; a hledam dale
SUMS02:
                              pop bc
                              pop hl
                         exx  ; 0
     ld a,(MAXLONG)
     inc a          ; musim pripocist tu prvni shodu..
     ld hl,(MAXSADR)
          ret
;::::
NOCOMP:  db 0 ; nyni zadny vhodny ke kompresi,cili hledam..
POSDB:   db 0 ; bajt pro popocet
POSHOD:  db 0
BITMAPA: dw 0 ; bitova mapa shod ; 8/16 bitu
UNPOCET: db 0 ; pocet po sobe jdoucich uncomp
POPOCET: db 0 ; pocet po sobe jdoucich stejnych
PKLFROM: dw 0
ACTBYTE:  dw 0 ; aktualni output byte
BITCBYTE: dw 0 ; aktualni output_bit_seq byte
OFFSET:  dw 0 ; offset shody ; 8/9 bitovy
;---------------------------------------------------------------------
;::::
PKLITE:   ; komprese od : [ hl do hl+bc ] ; do : [ de az de.. ]
               xor a
     ld (NOCOMP),a
     ld (BITCBYTE),de
     inc de
                         exx
     ld hl,(BITCBYTE)         ; aktualni misto pro ulozeni bit-toku
     ld c,8
                         exx  ; count je na startu prazdny ..
     ld (ACTBYTE),de
     ld (PKLFROM),hl
     ld a,b
     ld (NOWB),a
          call PKLI01
          ret
;:::
PKLI99:
     ld a,(NOCOMP)
               or a      ; nepadam prave pri nacitani uncomp?
          jr z,PKLI98    ; ne
          call PKLI40    ; ano,zarovnej to
PKLI98:
     ld a,010000000b
                         exx
     ld b,7
          call PUTBITS ; uloz ukoncovaci sekvenci
                         exx
     ld a,c
               cp 8
          ret z          ; prave byl count vyprazdnen,o.k.
     ld de,(ACTBYTE)     ; neco tam je ze stareho : opatrne !
     inc de              ; radeji zvysit.
     ld (ACTBYTE),de   ; de = konec zabaleneho
          ret
NOWB: db 0
;:::------====================================================-----:::::
PKLI01:        ;  ----:::::::--  hlavni balici cyklus  --::::::::----:::
     inc b
          jr z,PKLI99    ; konec : sekvence 010.0000 ; 4 bitove,ale 0
     dec b
     ld a,(NOWB)
               cp b
          jr z,PKLI67
     ld a,b
     ld (NOWB),a
          call PISPERC   ; napis procenta projeta
PKLI67:
          call WILLBECOMP ; bude komprese ?
          jr nz,PKLI02    ; ano : skompresuj
PKLI07:
     ld a,(NOCOMP)
               or a      ; poprve uncomp ?
          jr z,PKLI03    ; ano
     ld a,(UNPOCET)      ; ne,zvys pocet o 1
     inc a               ; o jeden neskompresovany v rade vice
     ld (UNPOCET),a
               cp 82     ; maximum ?
          jp z,PKLI04    ; ano,vice uz zaznamenat nemohu,zakoduj a dale
     inc hl              ; zkus to s dalsim bajtem
          jr PKLI01
;:::::::::::::---:::::::------
PKLI03:        ; init pocitani nestejnych bytu
     ld a,1
     ld (NOCOMP),a       ; flag zacinaji uncomp byty
     ld a,1
     ld (UNPOCET),a
     inc hl
          jr PKLI01
;::::::::::::::::::::::::::
PKLI02:   ; kompresuj !
     ld (METODA),a
     ld a,(NOCOMP)       ; osetreni minuleho stavu...
               or a      ; prechod non -> comp ?
          jp z,PKLI05    ; ne,prechod comp,comp
               xor a
     ld (NOCOMP),a       ; uz nebude uncomp
          call PKLI40
          jp PKLI05
PKLI40:   ;  obhospodari nezbalene bajty
     ld a,(UNPOCET)
               cp 4
          jr nc,PKLI20   ; vetsi nez 3,vyplati se 110xxxx {u 4 uspora 1 bit}
     ld b,a
PKLI21:
                              push bc
     ld a,0
                         exx
     ld b,2
          call PUTBITS   ; flag 00 = nesbaleny 1 bajt
                              pop bc               
          djnz PKLI21    ; dodelej ty spatne
          jr PKLI12      ;a vrhni se na kompresi
PKLI20:
               cp 19     ; musim pouzit 6bitnum ?
          jr nc,PKLI22   ; ano
     ld b,3
               sub b     ; uspora 3 mist v poctu kvuli 00,00,00
                              push af
     ld a,01000000b
                         exx
     ld b,3
          call PUTBITS
                              pop af
                    rlca
                    rlca
                    rlca
                    rlca ; doleva kvuli rychlejsimu zpracovani delitem
                         exx
     ld b,4
          call PUTBITS   ; a uloz pocet
          jr PKLI12      ; a vrhni se na kompresi
PKLI22:
     ld b,19             ; 19 = 0_6
               sub b
                              push af
     ld a,01100000b      ; flag 6bit po sobe uncomp
                         exx
     ld b,3
          call PUTBITS   ; uloz flag
                              pop af
                    rlca
                    rlca
                         exx
     ld b,6
          call PUTBITS
          jr PKLI12      ; a vrhni se na kompresi s retem
PKLI04:                  ; zaznamena 82 po sobe jdoucich uncomp bajtu
     ld a,01100000b
                         exx
     ld b,3
          call PUTBITS   ; flag "po sobe , uncomp,6bit_size"
     ld a,11111100b      ; maximalni pocet [63] = 82 po sobe jdoucich
                         exx
     ld b,6
          call PUTBITS   ; a 6bitova delka posloupnosti
     ld a,82
PKLI12:
     ld hl,(PKLFROM)
     ld e,a
     ld d,0
     ld h,b
     ld l,c
               or a
               sbc hl,de
     ld c,l
     ld b,h
     ld hl,(PKLFROM)
               add hl,de
     ld de,(ACTBYTE)
               xor a
     ld (NOCOMP),a       ; asi bude,ale ja : jako ze nebyla..
          ret
PKLI05:   ; ulozi [pocet] po sobe jdoucich stejnych bytu
               xor a
     ld (NOCOMP),a
     ld a,(METODA)
Š               cp 1      ; po sobe jdouci ?
          jr nz,PKLI06   ; ne
     ld a,1110000b
                         exx
     ld b,3
          call PUTBITS   ; uloz flag "po sobe jdouci"
     ld a,(POSDB)
                         exx
     ld b,8
          call PUTBITS   ; uloz ten byte
     ld a,(POPOCET)
                         exx
     ld b,4
          call PUTBITS
     ld a,(POPOCET)
PKLI10:
     ld hl,(PKLFROM)
     ld e,a
     ld d,0
     ld h,b
     ld l,c
               or a
               sbc hl,de
     ld c,l
     ld b,h
     ld hl,(PKLFROM)
               add hl,de
     ld de,(ACTBYTE)
               xor a
     ld (NOCOMP),a
          jp PKLI01      ; ...a znova
;:::::::::::::::::-----------------------------------:::::::::
PKLI06:   ; uloz offset a bitmapu podle a -  2 : 8.8   ; 3 : 9.16
               cp 3      ; 9.16 ?
          jr z,PKLI30    ; ano
                              push bc
     ld a,11100000b
                         exx
     ld b,3
          call PUTBITS   ; flag 8.8
     ld a,(OFFSET)
PKLI33:
                         exx
     ld b,8
          call PUTBITS   ; delta dozadu
     ld a,(BITMAP)
                         exx
     ld b,8
          call PUTBITS   ; bitmapa_[8]/[16]
                              pop bc
     ld (ACTBYTE),de
     ld a,(POSHOD)
          jr PKLI10
PKLI30:   ; uloz offset [9] a bitmapu [16]
                              push bc
     ld a,11000000b
                         exx
     ld b,3
          call PUTBITS   ; flag 9.16
     ld a,(OFFSET+1)
                    rrca ; 0 -> 7
                         exx
     ld b,1
          call PUTBITS   ; nejvyssi - 9. bit
     ld a,(OFFSET)
                         exx
     ld b,8
          call PUTBITS   ; delta dozadu
     ld a,(BITMAP+1)
          jr PKLI33      ; zkraceni : tyto sekvence se opakuji..
;::::
PUTBITS:  ; ulozi do ^bitcbyte  b bajtu  z  a ;
; uklada se do exx ^hl count je v c , pocet vstupu v b,exx musi byt
; uz nastavene volanym
PUTI99:
                    rlca
                    rl (hl)
     dec c
          jr z,PUTI01    ; prazdny count
PUTI97:
          djnz PUTI99
                         exx
          ret
PUTI01:  ; dalsi byte pro tok
     ld hl,(ACTBYTE)     ; dalsi mohu samozrejme jen z actbyte...
     inc hl
     ld (ACTBYTE),hl     ; pro dalsi,co budou za mnou,ale ja o nich musim
     dec hl              ; informovat s predstihem...,proto si vymezuji
     ld c,8              ; info byte.
          jr PUTI97
;:::::::::::::::::::::::::::::::::::::::::::::::::::::
;:::
MZLITE:  ;----------------- H L A V A ------------------
     ld (VYRSP),sp
     ld sp,STACK
          call RDPARAM   ; nacti parametry   ; o.k.
               or a
          jp z,VYSVETLI
          call DOPARAMS
          rst 0
LITEIT:
     call RDUNLITED ; nacti nezlajtovany
     call LITE      ; zlajtuj
     call WRLITED   ; uloz zlajtovany
ENDING:
     rst 0
;-------------------  P R O C E D U R Y  --------------------
;::::
VYSVETLI:
     ld de,VSVTL
     ld c,9
          ld sp,(VYRSP)
          jp 5
;::::
DOPARAMS:
          call INITVYP ; init pro vypocty procent
     ld a,(PARAMS)
               cp "P"    ; relokace az pod ccp
          jr nz,DOPAR1   ; ne
     ld a,21h
     ld (DELITE+DELFRM),a
     ld hl,0D400h
     ld (DELITE+DELFRM+1),hl
          jr LITEIT
          ret
EXTR: db 0
DOPAR1:
               cp "X"    ; extrakce
          jr nz,DOPAR2
          call EXTRCT
     ld a,1
     ld (EXTR),a
          call RDUNLITED ; nacti zlajtovany
          call EXTRACT   ; rozbal ho
     ld hl,(TOLITE)
                         ex de,hl
               or a
               sbc hl,de
          call WRUNLIT   ; uloz rozlajtovany
          ret
DOPAR2:
               or a
          jr nz,VYSVETLI ; zadny dalsi parametr byt nemuze
          jp LITEIT ; bez parametru : = lite it
FROMLITE: dw 0
TOLITE:   dw 0
LITESIZE: dw 0
;:::
EXTRACT:
     ld hl,(UNLSIZE)
     ld bc,128
               or a
               sbc hl,bc ; orizni ten prvni sektor
     ld c,l
     ld b,h
                              push bc
     ld hl,(TOLITE)
     dec hl
     ld e,l
     ld d,h
     dec de
     ld bc,256
     ld (hl),0
                              lddr ; vymaz
                              pop bc
     ld hl,(FROMLITE)
     ld de,(TOLITE)
EELI99:
     ld a,(hl)
               cp ZAR ; zarazka ?
          jr z,EELI20
                              ldi  ; bez : ldi
EELI21:
     inc b
          ret z
     dec b
          jr EELI99
EELI20:             ; je to zarazka...
     dec bc    ; zarazka
     inc hl
     ld a,(hl) ; za zarazkou
     dec bc    ; za zarazkou
     inc hl
               or a ; jen zarazka samotna ?
          jr nz,EELI30   ; ne:komprese !
     ld a,ZAR
     ld (de),a
     inc de
          jr EELI21
EELI30:
                              push de
                         exx
                              pop hl
     ld e,l
     ld d,h
     ld c,a
     ld b,0
               or a
               sbc hl,bc
                         exx
     ld a,(hl)
     inc hl
     dec bc
                         exx
                              ldi ;
     ld c,8    ; hl : odkud,de : kam,b uz je = 0..
EELI40:
                    rlca
          jr c,EELI41
     inc hl
EELI42:
     dec c
          jr nz,EELI40
                              push de
                         exx
                              pop de
          jr EELI21
EELI41:
                              ldi

     inc c
          jr EELI42
;::::::
WRUNLIT:
                              push hl
     ld a,2
          call CHDRV     ; select destination drive
     ld hl,FPAR2
     ld de,FCB2
     ld bc,12
                              ldir ; spec do fcb
     ld de,FCB2
     ld c,19
          call BDOS  ; pro jistotu ho zrus
     ld de,FCB2
     ld c,22
          call BDOS    ; utvor ho
               cp -1   ; chyba ?
          jp z,VIF34   ; ANO
                              pop bc    ; delka rozbaleneho
               xor a
               rl c
               rl b
               rla
Š     ld c,b
     ld b,a
     ld a,(UNLSIZE)
                    res 7,a
               or a
          jr z,WRUNL1
     inc bc    ; o sektor vice kvuli tem <128 bajtum
WRUNL1:
     ld de,(TOLITE)    ; start sbaleneho i s dep. sektorem na zacatku
          call WRITE     ; uloz to od de do ++bc*128
          ret
;::::::
RDUNLITED:
     ld a,1
          call CHDRV     ; vyber source
     ld hl,FPAR1
     ld de,FCB1
     ld bc,12
                              ldir ; presun parametru : source
     ld de,FCB1
     ld c,35
          call 5 ; spocti delku v sektorech
     ld a,(FCB1+34)
               or a      ; > 32kB ?
          jr z,OPEN11    ; ne
     ld a,14
     ld (WPERCENT),a
OPEN11:
     ld hl,(FCB1+33)     ; hl = delka v sektorech
     ld (PDEL),hl
               xor a
                    srl h
                    rr l
                    rra
     ld h,l
     ld l,a
     ld (UNLSIZE),hl     ; delka v bytech
     ld de,FCB1
     ld c,15
          call 5            ; otevri zdroj
               cp 0ffh      ; je tam vubec ten soubor ?
          jr nz,OPEN99      ;     ? je .. do roboty !
          jp ERR_END         ; normal shutdown
INITPERC:
     ld a,(WPERCENT)
     ld (OKNADD),a
               xor a
     ld (ACTADD),a
          ret
OPEN99:
          call INITPERC
     ld de,(FREEMEM)        ; sem nacist cely soubor 32kB,pode mnou uz je
                              push de
RBYTE:
READ4: ; --loop nacitajici bloky,dokud neni all file nebo fullmem--
                              push de
     ld c,26
          call 5
     ld c,20
     ld de,FCB1
          call 5
                             pop de
               or a        ; konec souboru ?
          jr nz,READOUT       ; ano : view a cekam...
     ld hl,80h
               add hl,de
               ex de,hl   ;  de /DMA/ += 80h               
          jr READ4
READOUT:  ; ::::::: vlastni rozbaleni ::::::
                              pop de
                         ex de,hl  ; hl = start1
     ld bc,(UNLSIZE)     ; delka nesbaleneho
               add hl,bc ; hl = end1
                         ex de,hl ; de =  end1
     ld hl,(6)
     dec h
     dec h     ; hl = end2
                         ex de,hl ; de=end2,hl=end1
     inc bc    ; bc =end1-start1
                              lddr ; start1 up to start2
     inc de                   ; ldxx konci pri dalsim !!
     ld (FROMLITE),de    ; odkud zacit balit
     ld hl,(FREEMEM)
     ld a,(EXTR)
               or a
          jr z,RDUN34
     ld bc,256
               add hl,bc
RDUN34:
     ld (TOLITE),hl      ; a kam balit
          ret
;::::::
WRLITED:
          call ENDWO1
     ld hl,(UNLSIZE)
     ld (DELITE+DELTUL+1),hl
     ld hl,(LITESIZE)    ; delka sbaleneho,ktery zacina na freemem
     ld (DELITE+DELTAL+1),hl    ; uloz do prvniho sektoru
               xor a
               rl l
               rl h
               rla
     ld l,h
     ld h,a    ; v sektorech
     ld a,l
               or h
          jr z,WRLI76    ; 0 : bylo to mensi,nez 1 sektor...
     ld a,l
               or a
          jr z,WRLI78
WRLI76:
     inc hl    ; o ten,ktery tam ma nejake tititi
WRLI78:
     inc hl    ; + ten s rutinou
                              push hl ; delka v sektorech
     ld a,2
          call CHDRV     ; select destination drive
     ld hl,FPAR2
     ld de,FCB2
     ld bc,12
                              ldir ; spec do fcb
     ld de,FCB2
     ld c,19
          call BDOS  ; pro jistotu ho zrus
     ld de,FCB2
     ld c,22
          call BDOS    ; utvor ho
               cp -1   ; chyba ?
          jp z,VIF34   ; ANO
     ld de,DELITE    ; start sbaleneho i s dep. sektorem na zacatku
                              pop bc
                              push bc
          call WRITE     ; uloz to od de do ++bc*128
                              pop hl
          call KONVYSL
     ld de,ENDMES
     ld c,9
          call 5
          ret
VIF34:
          jp ERR_END
ENDMES:
     db 10,10,13,36
ERR_END:
     rst 0
WRITE: ;:::::::: zapise file ::::::::::::
WRIT4:
                              push bc 
                              push de
     ld c,26
          call BDOS ; setdma
     ld de,FCB2
     ld c,21
          call BDOS ; write
                              pop de
                              pop bc
               or a ; 0 - uspech
          jr nz,WIF34 ; neuspech
     ld hl,80h
               add hl,de
                         ex de,hl
     dec bc
     ld a,b
               or c
          jr nz,WRIT4
     ld de,FCB2
     ld c,16
          call BDOS     ; zavri ten soubor
          ret
WIF34:
          jp ERR_END
;:::
RDPARAM:
     ld de,MZLUVOD
     ld c,9
          call 5
     ld hl,80h
     ld a,(hl)
               or a
          ret z     ; bez parametru
                         exx
     ld hl,PARAMS
                         exx
     inc hl
          call PRESKMEZ  ; preskoc mezery
     ld a,(hl)
               cp "-"
          jr nz,RDPA01    ; ted : kdyz bez -x == komprese
          jr RDPA02       ; zatim je to tak
               xor a
               or a
          ret ; return zero = no params
RDPA02:
     ld a,(hl)
               cp "-"
          jr nz,RDPA01   ; zadny dalsi parametr uz neni
     inc hl         ; preskoc "-"
     ld a,(hl)
     inc hl
               and 5Fh
                         exx
     ld (hl),a   ; uloz dalsi parametr
     inc hl
                         exx
          call PRESKMEZ  ; -a-j nebo -a -j
          jr RDPA02
RDPA01:
     ld de,FPAR1
          call RNAME ; nacti jmeno archivu - urcite na prvnim miste
     ld de,FPAR2
          call RNAME ; nacti file - specifikaci + ?,*
     ld hl,FPAR1+12
               xor a
               or (hl)
          ret z
     ld hl,FPAR2+12
               xor a
               or (hl)
          ret nz
     ld a,(DESTDRV)
               cp 88
          jr nz,RDPA03
     ld a,(ACTDRV)
     ld (DESTDRV),a
RDPA03:
     ld hl,FPAR1
     ld de,FPAR2
     ld bc,12
                              ldir
               xor a
     inc a
          ret
;::
RNAME: ; :::::::::: nacte jmeno souboru ::::::
     ld c,25
                              push de
                              push hl
          call 5
                              pop hl
                              pop de
     ld (ACTDRV),a
     ld (RDNFCB),de
          call PRESKMEZ
     ld a,(hl)
Š               or a
          ret z
     ld bc,9  ; ne delsi,nez name + "."
          call PRESKMEZ  ; preskoc mezery
     inc hl
     ld a,(hl)
               cp ":"    ; je specifikace drivu ?
          jr nz,WOC021   ; neni
     dec hl
     ld a,(hl)
               and 5Fh
               sub "A"
                         ex af,af'
     ld a,(SOURDRV)
               cp 88
          jr nz,WOC022   ; uz jedu na destin
                         ex af,af'
     ld (SOURDRV),a
          jr WOC025
WOC022:
                         ex af,af'
     ld (DESTDRV),a
WOC025:
     inc hl    ;za ni
     inc hl    ; za:
          jr WOC023
WOC021:
     dec hl
     ld a,(ACTDRV)
                         ex af,af'
     ld a,(SOURDRV)
               cp 88
          jr nz,WOC024   ; uz jedu na destin
                         ex af,af'
     ld (SOURDRV),a
          jr WOC023
WOC024:
                         ex af,af'
     ld (DESTDRV),a
WOC023:
          call PRESKMEZ
     ld a,(hl)
               or a
          ret z
                         exx
     ld hl,(RDNFCB)
     ld bc,12
               add hl,bc
     ld (hl),1 ; tato polozka je platna
                         exx
     inc de
WOC030:
     ld a,(hl)
               or a
          ret z
               cp " "
          ret z
               cp "."
          jr z,WOC031
               and 5Fh
                              ldi
     ld a,b
               or c
          ret z
          jr WOC030
WOC031:
                         ex de,hl
     ld hl,(RDNFCB)
     ld bc,9
               add hl,bc
                         ex de,hl
     ld bc,3
     inc hl              ; preskoc "."
          jr WOC030
;:::
PRESKMEZ:
     ld a,(hl)
               or a
          ret z
               cp " "
          ret nz
     inc hl
          jr PRESKMEZ
;:::
CHDRV:    ; zmeni drive na : actual {0} ,source {1} nebo destin {2}
               or a
          jr nz,CHDR02
     ld a,(ACTDRV)
          jr CHDR04
CHDR02:
     dec a
          jr nz,CHDR03
     ld a,(SOURDRV) ; 0:source
          jr CHDR04
CHDR03:
     ld a,(DESTDRV) ; 1:destin
CHDR04:
     ld e,a
     ld c,14
          call 5    ; vyberdsk
          ret
SOURDRV: db 88 ; int
DESTDRV: db 88 ; int
ACTDRV:  db 88 ; int
RDNFCB:  dw 0  ; int
PARAMS: db 0,0,0,0,0,0,0,0,0,0  ;  parametry ... ODDELENE - : gfc -e -c par
FPAR1:  db 0,"        COM",0  ; prvni paramter
FPAR2:  db 0,"        COM",0  ; druhy parametr,usr + name[11]:12 bytu
VYRBC:    dw 0
FROMZBYV: dw 0
FROMZAC:  dw 0
SECOND:   db 0
LONG:     db 0 ; aktualni shoda
MAXLONG:  db 0  ; maximalni shoda,clearuje head
MAXSADR:  dw 0
NOWOFS:   db 0  ; kterou polozku prave zpracovavam
VYRHL:    dw 0
VYRDE:    dw 0
FREEMEM:  dw VOLNARAM
;:::
STATIST:   ; :: statistika ...
     ld hl,5000h
     ld a,33h       ; soucet vsech  zarazek
     ld bc,497Fh
     ld de,0        ; zarazek
                         exx
     ld hl,0        ; zarazka - 0
                         exx
MLIT02:
                              cpir
          jp po,MLIT01
     inc de
     ld a,(hl)
               or a
          jr nz,MLIT03
                         exx
     inc hl
                         exx
MLIT03:
          ld a,33h
          jr MLIT02
MLIT01:
     nop
     nop
     nop
          ret
COMPR: db 13," Compressing      "
INDRV: db " :"
INNAME: db "                 to      "
OUTDRV: db " :"
OUTNAME: db "             $"
CISLA1: db "($"
PERC: db "       $"
PAST: db "%)$"  ; cislo ,past
NORML: db "     "
CISLA2: db " done. ($"
STOPRO: db "100%)$"
INAIR: db 1
UNCOMPR: db "  Extracting  "
;:::::::
EXTRCT:
     ld hl,UNCOMPR
     ld de,COMPR+1
     ld bc,EXTRCT-UNCOMPR
                              ldir
     ld de,COMPR
     ld c,9
          call 5
     ld de,ENDMES
     ld c,9
          call 5
          ret
KONVYSL:
                              push hl
     ld hl,NORML
     ld de,PERC
     ld bc,5
                              ldir
                              pop hl
                              push hl
                              push hl
                              push hl
          jr PISPE9
PISPERC:       ;::::::: vypise, kolik uz se udelalo ::::
                              push hl
                              push de
                              push bc
     ld de,(FROMLITE)
               or a
               sbc hl,de ; delka doposavad projeteho
               xor a
                    rl l
                    rl h
                    rla
     ld l,h
     ld h,a         ; hl / 128
PISPE9:
     ld (PCIT),hl
          call NASDEL
     ld a,l
               cp 101
          jr c,PISPE4
     ld a,100
PISPE4:
     ld hl,PERC
          call ATOASCI
     ld hl,PERC
PISP1:
     ld a,(hl)
               cp " "
          jr z,PISP2
               cp ")"
          jr z,PISP2
               cp "%"
          jr z,PISP2
     inc hl
          jr PISP1
PISP2:
                         ex de,hl
     ld hl,PAST
     ld bc,3
                              ldir
     ld de,COMPR
     ld c,9
          call 5
     ld a,(INAIR)
               or a
          jr nz,PISPE8
     ld de,CISLA2
          jr PISPE5
PISPE8:
     ld de,CISLA1
PISPE5:
     ld c,9
          call 5
     ld de,PERC
     ld c,9
          call 5
                              pop bc
                              pop de
                              pop hl
          ret
;:::
ENDWO1:
Š               xor a
     ld (INAIR),a
     ld hl,STOPRO
     ld de,PERC
     ld bc,5
                              ldir
     ld de,COMPR
     ld c,9
          call 5
     ld de,CISLA1
     ld c,9
          call 5
     ld de,PERC
     ld c,9
          jp 5
;:::::::::::::::
PCIT:    dw 0       ; aktualni delka
DCIT:    dw 100
PDEL:    dw 0       ; maximalni delka
;  :::::::::
NASDEL:     ; pcit*dcit/pdel : pro c2gray  :  x*0.53 = x*53/100
     ld hl,0
     ld de,(PCIT)
     ld bc,(DCIT)
     ld a,d
               or e
          jr z,NASD01
NASD04:
                    srl b
                    rr c
          jr nc,NASD03
               add hl,de
          jr c,NASD02
NASD03:
     ld a,b
               or c
          jr z,NASD02
                    sla e
                    rl d
          jr c,NASD01
          jr NASD04
NASD02:             ; v hl vysledek nasobeni
     ld de,(PDEL)
     ld bc,0
NASD10:
               or a
               sbc hl,de
     inc bc
          jr nc,NASD10   ; podelit odcitavanim
     dec bc
     ld l,c
     ld h,b
NASD01:
          ret  ; hl = 0
;:::::: vstup : a,^hl , nici vse krome ix,iy
ATOASCI:
     ld (NUMERO),hl
     ld (hl),"0"
               or a
               ret z   ; je to nula
          call ATOBCD
     ld b,0
     ld a,h
     ld c,l
               or a    ; >= 100 ?
     ld hl,(NUMERO)
          jr z,ATOA01  ; ne
          call ATOA10  ; ano,a=1 nebo 2
     ld (hl),e
     ld b,1
     inc hl
ATOA01:
     ld a,c
          call ATOA10
     ld a,d
               cp "0"
          jr nz,ATOA02
     dec b
     inc b
          jr z,ATOA03
ATOA02:
     ld (hl),d
     inc hl
ATOA03:
     ld (hl),e
          ret
NUMERO: dw 0
;:
ATOA10:
                              push af
                    rrca
                    rrca
                    rrca
                    rrca
               and 0Fh
               add a,"0"
     ld d,a
                              pop af
               and 0Fh
               add a,"0"
     ld e,a
          ret
ASCNUM: db "  0"
;--------
ATOBCD:
     ld hl,0
     ld de,1
     ld b,8
ATOB01:
                    rrca
          jr c,ATOB02
ATOB03:
                         ex af,af'
     ld a,e
               add a,e
               daa
     ld e,a
     ld a,d
               adc a,d
               daa
     ld d,a
                         ex af,af'
          djnz ATOB01
          ret
ATOB02:
                         ex af,af'
     ld a,l
               add a,e
               daa
     ld l,a
     ld a,h
               adc a,d
               daa
     ld h,a
                         ex af,af'
          jr ATOB03
;:::
INITVYP:
     ld a,(SOURDRV)
               add a,"A"
     ld (INDRV),a
     ld a,(DESTDRV)
               add a,"A"
     ld (OUTDRV),a
     ld hl,FPAR1+1
     ld de,INNAME
          call POZPREP
     ld hl,FPAR2+1
     ld de,OUTNAME
          call POZPREP
     ld a,"0"
     ld (PERC),a
     ld hl,PAST
     ld de,PERC+1
     ld bc,3
                              ldir
     ld de,COMPR
     ld c,9
          call 5
          ret
POZPREP:
     ld bc,8
                              push hl
POZPR1:
     ld a,(hl)
               cp " " ; jdu na ext
          jr z,POZPR2
                              ldi
          jp po,POZPR2
          jr POZPR1
POZPR2:
                              pop hl
     ld bc,8
               add hl,bc ; najezd na ..
     ld a,"."
     ld (de),a
     inc de
     ld bc,3
                              ldir
          ret
;::::
UNLSIZE:   dw 0
COUNT:     db 0
ACT_BYTE:  dw 0
BITC_BYTE: dw 0
PKLIHL: dw 0
PKLIBC: dw 0
PKLIDE: dw 0
POCOPAK: db 0
DELTA: dw 0
VYRSP:   dw 0
FCB1:    db 0,"           ",0
         dw 0,0,0,0,0,0,0,0,0,0,0,0,0
FCB2:    db 0,"           ",0
         dw 0,0,0,0,0,0,0,0,0,0,0,0,0
OKNADD:  db 0
ACTADD:  db 0
WPERCENT: db 8
;-------------------------
;::::  rozbalovaci rutina v delce jednoho sektoru ! ::::
 db "HERE-"
DELITE:   ; rozbali,da se na zacatek,musi byt <= 128 b !?
.phase 100h
DELIST:
 db "MZ"
DELI50:
FRMDEL:   ; kde ma zacinat rozbalovaci rutina;pod bdos nebo pod ccp
     ld hl,(6)
     dec h
                         ex de,hl
                              push de
     ld hl,DELI10
     ld bc,DELI98-DELI10+1
                              ldir ; soupne nahoru depacker
                              pop hl
          jp (hl)
DELI10:
     ld de,DELI98   ; konstanta : kde zacinaji data,asi 161h..nebo 180h...
DELIPS:
     ld bc,0   ; delka sbaleneho,to jedine doda pakovac
                         ex de,hl
               add hl,bc      ; konec1:hl,konec2:de
     inc bc
                              push bc   ; delka zabaleneho
                              lddr ; presun nahoru
                              inc de ; start hora
                         ex de,hl ; do hl
                         exx
     ld hl,1FFh
     ld b,0
               xor a
DELI78:
     ld (hl),a
     dec hl
          djnz DELI78    ; init prvniho pod nim
                         exx
                              pop bc ; delka zabaleneho
     ld de,200h     ; kam
DELI99:
     ld a,(hl)
               cp ZAR ; zarazka ?
          jr z,DELI20
                              ldi  ; bez : ldi
DELI21:
     inc b
Š          jr z,DELI65
     dec b
          jr DELI99
DELI65:
     ld c,b
                              push bc
     ld hl,200h
     ld de,100h
DELIPU:
     ld bc,0   ; delka rozbaleneho, take doda pakovac
                              ldir ; relokace dolu ke 100h
          jp 100h
DELI20:             ; je to zarazka...
     dec bc    ; zarazka
     inc hl
     ld a,(hl) ; za zarazkou
     dec bc    ; za zarazkou
     inc hl
               or a ; jen zarazka samotna ?
          jr nz,DELI30   ; ne:komprese !
     ld a,ZAR
     ld (de),a
     inc de
          jr DELI21
DELI30:
                              push de
                         exx
                              pop hl
     ld e,l
     ld d,h
     ld c,a
     ld b,0
               or a
               sbc hl,bc
                         exx
     ld a,(hl)
     inc hl
     dec bc
                         exx
                              ldi ;
     ld c,8    ; hl : odkud,de : kam,b uz je = 0..
DELI40:
                    rlca
          jr c,DELI41
     inc hl
DELI42:
     dec c
          jr nz,DELI40
                              push de
                         exx
                              pop de
          jr DELI21
DELI41:
                              ldi

     inc c
          jr DELI42
DELI98:
.dephase
;:::::::::
VOLNARAM:
     end