home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Amiga Shareware Floppies / ma42.dms / ma42.adf / FontsCat / FontsCat.S < prev    next >
Encoding:
Text File  |  2002-10-23  |  9.4 KB  |  511 lines
  1. ;    EXEC
  2. FindTask    =-294
  3. Wait        =-318
  4. Signal        =-324
  5. AddPort        =-354
  6. RemPort        =-360
  7. FindPort    =-390
  8. OldOpenLibrary    =-408
  9. CloseLibrary    =-414
  10. OpenLibrary    =-552
  11. CacheClearU    =-636
  12.  
  13. ;    DOS
  14. Open        =-30
  15. Close        =-36
  16. Read        =-42
  17. Write        =-48
  18. Output        =-60
  19. Lock        =-84
  20. UnLock        =-90
  21. Examine        =-102
  22. SetComment    =-180
  23. SetFiledate    =-396
  24.  
  25. ;    INTUITION
  26. DisplayAlert    =-90
  27.  
  28. ;    DISKFONT
  29. AvailFonts    =-36
  30.  
  31.  
  32. ;    ZMIENNE
  33. fileinfoblock    =0
  34. buffer        =262
  35. bufbytes    =266
  36. file        =270
  37. filesize    =274
  38.  
  39. varsize        =278
  40.  
  41. OLDSYS        =34
  42. NEWSYS        =36
  43.  
  44.     move.b    #NEWSYS,system
  45.     lea    dosname,a1
  46.     moveq    #36,d0
  47.     move.l    4,a6
  48.     jsr    OpenLibrary(a6)        ; otworzenie OS2.0 dos.library...
  49.     move.l    d0,dosbase
  50.     tst.l    d0
  51.     bne.s    OS20
  52.  
  53.     move.b    #OLDSYS,system
  54.     lea    dosname,a1
  55.     move.l    4,a6
  56.     jsr    OldOpenLibrary(a6)    ; otworzenie dos.library...
  57.     move.l    d0,dosbase
  58.  
  59. OS20:
  60.     lea    intname,a1
  61.     move.l    4,a6
  62.     jsr    OldOpenLibrary(a6)    ; ...i intuition
  63.     move.l    d0,intbase
  64.  
  65.     lea    portname,a1        ; sprawdzenie, czy w systemie znajduje
  66.     move.l    4,a6            ; sië juû port o nazwie
  67.     jsr    FindPort(a6)        ; "FontsCat port".
  68.     tst.l    d0
  69.     beq.s    notinstalled
  70.  
  71. ;    Jeôli tak, to program jest juû zainstalowany i naleûy go usunâê
  72.  
  73.     move.l    d0,a1
  74.     move.l    16(a1),a1
  75.     move.l    4,a6
  76.     move.l    #$1000,d0
  77.     jsr    Signal(a6)        ; wysîanie sygnaîu Ctrl-C
  78.  
  79.     bsr.w    closelibraries        ; zamkniëcie bibliotek
  80.  
  81.     clr.l    d0            ; wyjôcie z programu
  82.     rts
  83.  
  84. ;    Instalowanie programu
  85.  
  86. notinstalled:
  87.     lea    installinfo,a0
  88.     bsr.w    CLIoutput        ; wysîanie informacji o zainstalowaniu
  89.  
  90.     suba.l    a1,a1
  91.     move.l    4,a6
  92.     jsr    FindTask(a6)        ; znalezienie struktury wîasnego tasku
  93.     move.l    d0,Task
  94.  
  95.     lea    myport,a1
  96.     jsr    AddPort(a6)        ; dodanie do systemu wîasnego portu
  97.  
  98.     lea    diskfontname,a1
  99.     move.l    4,a6
  100.     jsr    OldOpenLibrary(a6)    ; otworzenie diskfont.library
  101.     tst.l    d0
  102.     beq.w    nodiskfont
  103.     move.l    d0,diskfontbase
  104.  
  105.     move.l    diskfontbase,a6
  106.     move.l    AvailFonts+2(a6),AvailFontsAdr
  107.                     ; zachowanie oryginalnego adresu
  108.                     ; funkcji AvailFonts
  109.     move.l    #MyAvailFonts,AvailFonts+2(a6)
  110.                     ; i "podwieszenie" wîasnej procedury
  111.     bsr.w    cacheclear        ; wyczyszczenie cache
  112.  
  113. loop_wait:
  114.     move.l    #$1000,d0
  115.     move.l    4,a6
  116.     jsr    Wait(a6)        ; czekanie na Ctrl-C
  117.  
  118. deinstall:
  119.     move.l    diskfontbase,a6
  120.     cmp.l    #MyAvailFonts,AvailFonts+2(a6)
  121.                     ; sprawdzenie, czy jakiô inny program
  122.                     ; nie zmieniî wektora AvailFonts
  123.     beq.s    remove
  124.  
  125.     move.l    intbase,a6
  126.     moveq    #0,d0
  127.     moveq    #31,d1
  128.     lea    cannotremove,a0
  129.     jsr    DisplayAlert(a6)    ; jeôli tak - wyôwietlenie komunikatu
  130.     bra.s    loop_wait        ; i dalsze czekanie
  131.  
  132. ;    Usuwanie programu i powrót do systemu
  133.  
  134. remove:
  135.     move.l    diskfontbase,a6
  136.     move.l    AvailFontsAdr,AvailFonts+2(a6)
  137.                     ; przywrócenie oryginalnej wartoôci
  138.                     ; wektorowi funkcji AvailFonts
  139.     bsr.w    cacheclear        ; wyczyszczenie cache
  140.     lea    myport,a1
  141.     move.l    4,a6
  142.     jsr    RemPort(a6)        ; usuniëcie MsgPort'u
  143.  
  144.     lea    removeinfo,a0
  145.     bsr.b    CLIoutput        ; powiadomienie o usuniëciu programu
  146.  
  147.     move.l    diskfontbase,a1
  148.     move.l    4,a6
  149.     jsr    CloseLibrary(a6)    ; zamkniëcie diskfont.library
  150.  
  151. nodiskfont:
  152.     bsr.b    closelibraries        ; i pozostaîych bibliotek
  153.  
  154.     clr.l    d0
  155.  
  156.     rts                ; * K * O * N * I * E * C *       :-)
  157.  
  158. ; Czyszczenie cache procesora
  159.  
  160. cacheclear:
  161.     move.l    4,a6
  162.     cmp.w    #37,20(a6)
  163.     blt.s    cacheend
  164.     jsr    CacheClearU(a6)
  165. cacheend:
  166.     rts
  167.  
  168. ;    Zamkniëcie bibliotek
  169.  
  170. closelibraries:
  171.     move.l    dosbase,a1
  172.     move.l    4,a6
  173.     jsr    CloseLibrary(a6)
  174.  
  175.     move.l    intbase,a1
  176.     move.l    4,a6
  177.     jsr    CloseLibrary(a6)
  178.     rts
  179.  
  180. ;    Procedura wyôwietlajâca komunikat w oknie CLI
  181.  
  182. ;    Wejôcie: a0 - adres komunikatu zakoïczonego zerem
  183.  
  184. ;    uûyte rejestry: d0,d1,d2,d3,a0,a1,a6
  185.  
  186. CLIoutput:
  187.     move.l    a0,-(sp)
  188.     moveq    #-1,d0
  189. out_loop:
  190.     add.l    #1,d0
  191.     tst.b    (a0)+
  192.     bne.s    out_loop
  193.     move.l    d0,-(sp)
  194.     move.l    dosbase,a6
  195.     jsr    Output(a6)
  196.     tst.l    d0
  197.     beq.s    out_err
  198.     move.l    d0,d1
  199.     move.l    (sp)+,d3
  200.     move.l    (sp)+,d2
  201.     move.l    dosbase,a6
  202.     jsr    Write(a6)
  203.     rts
  204. out_err:
  205.     move.l    (sp)+,d0
  206.     move.l    (sp)+,d1
  207.     rts
  208.  
  209. ;    Procedura zastëpujâca Availfonts
  210.  
  211. MyAvailFonts:
  212.     btst    #1,d1            ; czcionki z dysku ?
  213.     bne.b    DiskFonts
  214.     move.l    a5,-(sp)        ; jeôli program domaga sië czcionek
  215.     move.l    AvailFontsAdr,a5    ; z ROM'u - wywoîywana jest oryginalna
  216.     jsr    (a5)            ; funkcja AvailFonts
  217.     move.l    (sp)+,a5
  218.     rts                ; powrót
  219.  
  220. ;    Czcionki z dysku
  221.  
  222. diskfonts:
  223.     move.l    a4,-(sp)
  224.     sub.l    #varsize,sp
  225.     move.l    sp,a4
  226.  
  227.     movem.l    d1-d3/d7/a0/a1/a6,-(sp)
  228.  
  229.     move.l    a0,buffer(a4)        ; zapamiëtanie wartoôci przekazywanych
  230.     move.l    d0,bufbytes(a4)        ; do procedury (w a0 - adres bufora
  231.                     ; na listë fontów, w d0 - jego rozmiar)
  232.     lea    fontscat,a0
  233.     bsr.w    fsize
  234.     
  235.     move.l    132(a0),d1
  236.     move.l    136(a0),d2
  237.     move.l    140(a0),d3
  238.  
  239.     lea    fontscatname,a0
  240.     bsr.w    FSize            ; sprawdzenie dîugoôci pliku z
  241.                     ; katalogiem fontów
  242.     cmp.b    #OLDSYS,system
  243.     beq.s    nocompdate
  244.  
  245.     cmp.l    132(a0),d1        ; porównanie dat
  246.     bne.w    nocatalog
  247.     cmp.l    136(a0),d2
  248.     bne.w    nocatalog
  249.     cmp.l    140(a0),d3
  250.     bne.w    nocatalog
  251.  
  252. nocompdate:
  253.     cmp.l    bufbytes(a4),d0
  254.     bge.b    nomem            ; jeôli bufor jest zbyt maîy - wyjôcie
  255.  
  256.     move.l    #fontscatname,d1
  257.     move.l    #$3ed,d2        ; MODE=OldFile
  258.     move.l    dosbase,a6
  259.     jsr    Open(a6)        ; otworzenie katalogu do odczytu
  260.     tst.l    d0
  261.     beq.s    nocatalog
  262.     move.l    d0,file(a4)
  263.  
  264.     move.l    file(a4),d1
  265.     move.l    buffer(a4),d2
  266.     move.l    filesize(a4),d3
  267.     move.l    dosbase,a6
  268.     jsr    Read(a6)        ; odczytanie katalogu do bufora
  269.  
  270.     move.l    file(a4),d1
  271.     move.l    dosbase,a6
  272.     jsr    Close(a6)        ; zamkniëcie pliku
  273.  
  274. ;    Wpisanie adresów nazw czcionek do struktur TextAttr
  275.  
  276.     move.l    buffer(a4),a0
  277.     move.w    (a0)+,d0        ; d0 - iloôê fontów
  278.     move.l    a0,a1
  279.     move.w    d0,d7
  280.     sub.w    #1,d7            ; trzeba odjâê 1, bo uûywamy DBF
  281.     ext.l    d0
  282.     mulu    #10,d0            ; iloôê fontów *10 (dîugoôê TextAttr)
  283.     add.l    d0,a1            ; + adres bufora daje adres nazwy
  284.                     ; pierwszego fontu
  285. seloop2:
  286.     move.l    a1,2(a0)        ; wpisywanie kolejnych adresów
  287.     adda.l    #10,a0
  288. seloop:
  289.     tst.b    (a1)+            ; szukanie nastëpnej nazwy fontu
  290.     bne.s    seloop
  291.     dbf    d7,seloop2
  292. ;-----------------------------
  293.     movem.l    (sp)+,d1-d3/d7/a0/a1/a6
  294.     add.l    #varsize,sp
  295.     move.l    (sp)+,a4
  296.     clr.l    d0            ; brak bîëdu
  297.     rts                ; powrót
  298.  
  299. ;    Bufor jest zbyt maîy, wiëc nie moûna wczytaê katalogu.
  300.  
  301. nomem:
  302.     movem.l    (sp)+,d1-d3/d7/a0/a1/a6
  303.     move.l    filesize(a4),d0        ; w d0 zwracany jest wymagany
  304.     add.l    #varsize,sp        ; rozmiar bufora
  305.     move.l    (sp)+,a4
  306.     rts                ; powrót
  307.  
  308. ;    Katalogu czcionek nie ma na dysku, wiëc trzeba go stworzyê
  309.  
  310. nocatalog:
  311.     movem.l    (sp)+,d1-d3/d7/a0/a1/a6
  312.     move.l    bufbytes(a4),d0
  313.     moveq    #-1,d1
  314.     move.l    a5,-(sp)
  315.     move.l    AvailFontsAdr,a5
  316.     jsr    (a5)            ; skok do systemowego AvailFonts
  317.     move.l    (sp)+,a5
  318.     tst.l    d0
  319.     beq.s    writecatalog        ; jeôli d0=0 - moûna przystâpiê do
  320.                     ; nagrywania katalogu.
  321.     add.l    #varsize,sp
  322.     move.l    (sp)+,a4
  323.     rts                ; powrót
  324.  
  325. writecatalog:
  326.     movem.l    d0-d3/d7/a0-a2/a6,-(sp)
  327.     move.l    #fontscatname,d1
  328.     move.l    #$3ee,d2        ; MODE=NewFile
  329.     move.l    dosbase,a6
  330.     jsr    Open(a6)        ; otworzenie nowego pliku z fontami
  331.     tst.l    d0
  332.     beq.w    cannotwrite
  333.     move.l    d0,file(a4)
  334.  
  335.     move.l    buffer(a4),a0
  336.     move.w    (a0)+,d0        ; obliczenie dîugoôci listy fontów
  337.     ext.l    d0            ; (ale bez ich nazw)
  338.     mulu    #10,d0
  339.     add.l    #2,d0
  340.  
  341.     move.l    file(a4),d1
  342.     move.l    buffer(a4),d2
  343.     move.l    d0,d3
  344.     move.l    dosbase,a6
  345.     jsr    Write(a6)        ; nagranie listy fontów (wszystkich
  346.                     ; struktur TextAttr)
  347. ;-------Nagrywanie nazw czcionek-------
  348.  
  349.     move.l    buffer(a4),a0
  350.     move.w    (a0)+,d7        ; iloôê fontów do d7
  351.     sub.w    #1,d7            ; -1, bo uûywane z DBF
  352. writeloop:
  353.     move.l    2(a0),a1        ; adres nazwy fontu ze struktury
  354.     move.l    a1,a2            ; TextAttr do a1 i a2
  355.     clr.l    d0
  356. ; Search for end of text
  357. sloop:    addq    #1,d0            ; szukanie koïca nazwy
  358.     tst.b    (a1)+
  359.     bne.s    sloop
  360.  
  361. ; ----- a2 - adres nazwy fontu ; d0 - dîugoôê nazwy -----
  362.  
  363.     move.l    a0,-(sp)
  364.     move.l    file(a4),d1
  365.     move.l    a2,d2
  366.     move.l    d0,d3
  367.     move.l    dosbase,a6
  368.     jsr    Write(a6)        ; nagranie nazwy do pliku
  369.     move.l    (sp)+,a0
  370.  
  371.     adda.l    #10,a0            ; obliczenie adresu nastëpnej
  372.                     ; struktury TextAttr
  373.     dbf    d7,writeloop        ; i powrót
  374.  
  375. ;--------------------------------
  376.  
  377.     move.l    file(a4),d1
  378.     move.l    dosbase,a6
  379.     jsr    Close(a6)        ; zamkniëcie pliku
  380.  
  381.     cmp.b    #OLDSYS,system
  382.     beq.s    nosetdate
  383.  
  384.     lea    fontscatname,a0
  385.     bsr.b    fsize
  386.  
  387.     add.l    #132,a0
  388.     move.l    a0,d2
  389.     move.l    #fontscat,d1
  390.     jsr    SetFileDate(a6)        ; ustawienie daty
  391.  
  392. nosetdate:
  393. cannotwrite:
  394.     movem.l    (sp)+,d0-d3/d7/a0-a2/a6
  395.     add.l    #varsize,sp
  396.     move.l    (sp)+,a4
  397.     rts
  398.  
  399. ;    Funkcja podajâca dîugoôê pliku
  400.  
  401. ; wejôcie: a0 - nazwa pliku
  402. ; wyjôcie: dîugoôê pliku w d0 oraz pod etykietâ filesize
  403. ;       a0 - fileinfoblock
  404.  
  405. fsize:
  406.     movem.l    d1/d2/a1/a6,-(sp)
  407.  
  408.     move.l    a0,d1
  409.     moveq    #-2,d2
  410.     move.l    dosbase,a6
  411.     jsr    Lock(a6)
  412.     tst.l    d0
  413.     beq.s    lerr
  414.     move.l    d0,d1
  415.  
  416.     move.l    d1,-(sp)
  417.     move.l    #fileinfoblock,d2
  418.     add.l    a4,d2
  419.     add.l    #3,d2
  420.     and.l    #$fffffffc,d2
  421.     move.l    dosbase,a6
  422.     jsr    Examine(a6)
  423.     move.l    d2,a0
  424.     move.l    124(a0),filesize(a4)
  425.     move.l    (sp)+,d1
  426.  
  427.     move.l    a0,-(sp)
  428.     move.l    dosbase,a6
  429.     jsr    Unlock(a6)
  430.     move.l    (sp)+,a0
  431.  
  432. loadend:
  433.     movem.l    (sp)+,d1/d2/a1/a6
  434.     move.l    filesize(a4),d0
  435.     rts
  436. lerr:
  437.     movem.l    (sp)+,d1/d2/a1/a6
  438.     move.l    #0,filesize(a4)
  439.     clr.l    d0
  440.     rts
  441.  
  442. diskfontname:
  443.     dc.b    'diskfont.library',0
  444.  
  445.     even
  446.  
  447. dosname:
  448.     dc.b    'dos.library',0
  449.  
  450.     even
  451.  
  452. intname:
  453.     dc.b    'intuition.library',0
  454.  
  455.     even
  456.  
  457. myport:
  458. ;    -  Node   -
  459.     dc.l    0        ; Succ
  460.     dc.l    0        ; Pred
  461.     dc.b    4        ; Type=NT_MsgPort
  462.     dc.b    -128        ; Pri
  463.     dc.l    PortName    ; Name
  464. ;    - MsgPort -
  465.     dc.b    2        ; Flags=ignore
  466.     dc.b    0        ; SigBit
  467. Task:    dc.l    0        ; Task
  468. ;    -  List   -
  469. Head:    dc.l    Tail        ; Head
  470. Tail:    dc.l    0        ; Tail
  471.     dc.l    Head        ; TailPred
  472.     dc.b    4        ; Type=NT_MsgPort
  473.     dc.b    0        ; pad
  474.  
  475. PortName:
  476.     dc.b    'FontsCat port',0
  477.  
  478. system:
  479.     dc.b    0
  480.  
  481. fontscat:
  482.     dc.b    'FONTS:',0
  483. fontscatname:
  484.     dc.b    'FONTS:Catalog',0
  485. installinfo:
  486.     dc.b    'FontsCat v.1.0 by PP/TERMOS/UNION succesfully installed.'
  487.     dc.b    10,0
  488. removeinfo:
  489.     dc.b    'FontsCat v.1.0 by PP/TERMOS/UNION succesfully removed.'
  490.     dc.b    10,0
  491. cannotremove:
  492.     dc.b    0,224,13
  493.     dc.b    "WARNING !  I CAN'T EXIT !"
  494.     dc.b    0,1
  495.     dc.b    0,104,23
  496.     dc.b    "Other programs have patched system routines used by me."
  497.     dc.b    0,0
  498.  
  499.     dc.b    '$VER: FontsCat 1.0 (15.04.95)',0
  500.  
  501.     even
  502.  
  503. diskfontbase:
  504.     dc.l    0
  505. intbase:
  506.     dc.l    0
  507. dosbase:
  508.     dc.l    0
  509. availfontsadr:
  510.     dc.l    0
  511.