Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ****************************************************************************
- * VPic (View Picture) V2.00 © 15-06-2002 by Testaware
- * --------------------------------------------------------------------------
- *
- * Code: Peace/TST
- * Home: https://testaware.wordpress.com
- *
- * CLI/Shell: VPic [file|list|path|#DEC] [0|1] [*|?]
- * Workbench: INFO DEFAULT TOOL
- *
- * DLD: © 1992, 1993 by Georg Hörmann
- * XPK: © 1991 Christian Schneider & U.Dominik Mueller
- * ABk: François Lionet © Europress Software
- * REQ: ReqTools Lib 2.9a © 1991-1997 Nico François & Magnus Holmgren
- *
- * Assembler: GenAm Macro Assembler V2.11D Copyright © HiSoft 1985,8
- * Editor: CygnusEd Professional II © 1987,1988,1989 by CygnusSoft Software
- ****************************************************************************
- opt o+,ow-
- Output RAM:1
- Incdir DH1:DevPac/Include/
- Include exec/exec_lib.i
- Include exec/memory.i
- Include graphics/graphics_lib.i
- Include graphics/view.i
- Include libraries/decrunch_lib.i
- Include libraries/dos_lib.i
- Include libraries/dos.i
- Include libraries/dosextens.i
- Include libraries/xpk.i
- Include libraries/reqtools_lib.i
- Include intuition/intuition.i
- Include intuition/intuition_lib.i
- Include intuition/intuitionbase.i
- Include own/rawkey.i
- Include workbench/startup.i
- Include workbench/workbench.i
- ****************************************************************************
- * Strukturanordungen von AmBk Pic.Pac Screen / BitMap
- ****************************************************************************
- ;Packed AMOS Screen-Header
- RsReset
- PsCode rs.l 1
- PsTx rs.w 1
- PsTy rs.w 1
- PsAWx rs.w 1
- PsAWy rs.w 1
- PsAWTx rs.w 1
- PsAWTy rs.w 1
- PsAVx rs.w 1
- PsAVy rs.w 1
- PsCon0 rs.w 1
- PsNbCol rs.w 1
- PsNPlan rs.w 1
- PsPal rs.w 32
- PsLong equ __RS
- SCCode equ $12031990
- ;Packed AMOS BitMap-Header
- RsReset
- Pkcode rs.l 1
- Pkdx rs.w 1
- Pkdy rs.w 1
- Pktx rs.w 1
- Pkty rs.w 1
- Pktcar rs.w 1
- Pknplan rs.w 1
- PkDatas2 rs.l 1
- PkPoint2 rs.l 1
- PkLong equ __RS
- PkDatas1 equ __RS
- BMCode equ $06071963 ;Happy birthday François
- ;IFF BitMap-HeaDer
- RsReset
- ibm_Width rs.w 1
- ibm_Height rs.w 1
- ibm_xPosition rs.w 1
- ibm_yPosition rs.w 1
- ibm_Planes rs.b 1
- ibm_Mask rs.b 1
- ibm_Compression rs.b 1
- ibm_Pad rs.b 1
- ibm_Transparent rs.w 1
- ibm_xAspect rs.b 1
- ibm_yAspect rs.b 1
- ibm_PageWidth rs.w 1
- ibm_PageHeight rs.w 1
- ibm_SIZEOF equ __RS
- ;VPic BitMap-Header
- RsReset
- vbm_Code rs.l 1
- vbm_Width rs.w 1
- vbm_Height rs.w 1
- vbm_ViewMode rs.w 1
- vbm_User rs.w 1
- vbm_Bmap rs.l 1
- vbm_Data equ __RS
- vbm_SIZEOF equ __RS
- vbm_DEPTH equ 1
- ID_VPIC equ $56504943
- ID_VBMP equ $56424D50
- ;VPic spezifische Struktur
- RsReset
- My_VPicBase rs.b 0
- my_DosBase rs.l 1
- my_IntBase rs.l 1
- my_GfxBase rs.l 1
- my_DcrBase rs.l 1
- my_XpkBase rs.l 1
- my_ReqBase rs.l 1
- my_OutPut rs.l 1
- my_OldLock rs.l 1
- my_FileName rs.l 1
- my_FileLock rs.l 1
- my_FileFib rs.b fib_SIZEOF
- my_CountFib rs.b fib_SIZEOF
- my_FileHnd rs.l 1
- my_FileBuf rs.l 1
- my_FileLen rs.l 1
- my_ListBuf rs.l 1
- my_ListLen rs.l 1
- my_PackBuf rs.l 1
- my_PackLen rs.l 1
- my_NewWind rs.l nw_SIZE
- my_WindPtr rs.l 1
- my_NewScrn rs.b ns_SIZEOF
- my_ScrnPtr rs.l 1
- my_PlanPtr rs.l 8
- my_Palette rs.l 1
- my_DefPalette rs.w 32
- my_ColorCount rs.l 1
- my_PkMode rs.b 1
- my_FromCLI rs.b 1
- my_KeyCode rs.b 1
- my_CliDisplay rs.b 1
- my_CliScrn rs.l 1
- my_CliWind rs.l 1
- my_NextScrn rs.l 1
- my_AuthPtr rs.l 1
- my_CopyPtr rs.l 1
- my_AnnoPtr rs.l 1
- my_VbmHeader rs.b vbm_SIZEOF
- my_FmtData rs.b 256
- my_FmtChData rs.b 1024
- my_DataBuf rs.b 1024
- my_InputBuf rs.b 256
- my_RtFileReq rs.l 1
- my_RtInfoReq rs.l 1
- my_RtBut rs.l 1 ;Schalter
- my_SIZEOF rs.w 0
- PKMODE_NORMAL equ 0 ;IFF RAW - Unkomprimiert
- PKMODE_COMPRESSED equ 1 ;IFF RLE - Komprimiert
- PKMODE_AMIGABASIC equ 2 ;IFF ABM - DigiPaint BitMap
- PKMODE_AMOSBITMAP equ 3 ;ABK PCK - Amos Packed BitMap
- PKMODE_AMOSSCREEN equ 4 ;ABK SPK - Amos Packed Screen
- PKMODE_VPICBITMAP equ 5 ;VBM PLN - VPic BitMap Plane
- PKMODE_WBOINFO equ 6 ;WBO INF - WorkBench Info
- PKMODE_ACTUALSCREEN equ 7 ;ACT SCR - Actual Screen
- COLOR_CLI equ $FFF
- COLOR_OS1 equ $001
- COLOR_OS2 equ $002
- COLOR_RED equ $0FF
- COLOR_GRN equ $F0F
- COLOR_BLU equ $FF0
- COLOR_GRY equ $111
- COLOR_DEF equ $000
- ****************************************************************************
- * Meine Macros
- ****************************************************************************
- LIB MACRO
- jsr _LVO\1(a6)
- ENDM
- LAB MACRO
- jmp _LVO\1(a6)
- ENDM
- EXE MACRO
- movea.l 4.w,a6
- LIB \1
- ENDM
- DOS MACRO
- movea.l my_DosBase(a5),a6
- LIB \1
- ENDM
- INT MACRO
- movea.l my_IntBase(a5),a6
- LIB \1
- ENDM
- GFX MACRO
- movea.l my_GfxBase(a5),a6
- LIB \1
- ENDM
- DCR MACRO
- movea.l my_DcrBase(a5),a6
- LIB \1
- ENDM
- XPK MACRO
- movea.l my_XpkBase(a5),a6
- LIB \1
- ENDM
- REQ MACRO
- movea.l my_ReqBase(a5),a6
- LIB \1
- ENDM
- WAIT MACRO
- moveq.l #\1,d1
- bsr Wait
- ENDM
- VPic bra.s .0
- dc.b '$VER: VPic 2.00 FD (15-06-02 21:44:50) '
- dc.b '©2002 by Peace of Testaware'
- cnop 0,4
- ****************************************************************************
- * Test von wo aus das Programm gestartet wurde WB oder CLI/Shell
- ****************************************************************************
- .0 movea.l a0,a2 ;Evtl. Parameter sichern
- move.l d0,d2
- suba.l a1,a1
- EXE FindTask
- movea.l d0,a4
- tst.l pr_CLI(a4)
- bne.s FromCLI
- lea pr_MsgPort(a4),a0
- LIB WaitPort
- lea pr_MsgPort(a4),a0
- LIB GetMsg
- lea VPic(pc),a4
- move.l d0,(a4)
- bsr OpenAll
- movea.l VPic(pc),a4
- movea.l sm_ArgList(a4),a4
- beq CloseAll
- move.l wa_Lock(a4),d1
- DOS CurrentDir
- movea.l wa_Name+wa_SIZEOF(a4),a0
- bsr Start
- EXE Forbid
- movea.l VPic(pc),a1
- LAB ReplyMsg
- ****************************************************************************
- * Programm wurde von der CLI/Shell-Ebene aufgerufen
- ****************************************************************************
- FromCLI movem.l a2/d2,-(sp)
- bsr OpenAll
- DOS Output
- move.l d0,my_OutPut(a5)
- movem.l (sp)+,a0/d0
- move.b #1,my_FromCLI(a5) ;Flag für CLI-Optionen
- subq.l #1,d0
- ble.s Rt_ReqLoop ;Kein Param übergeben
- ;Ein Parameter (irgendwas) wurde angegeben.
- .0 cmpi.b #'?',(a0) ;Syntax anzeigen?
- bne.s .1
- bsr Rt_Usage ;Aha, so wird`s gemacht?
- bra CloseAll
- .1 cmpi.b #'*',(a0) ;Aktuellen Screen darstellen?
- bne.s .2 ;Nö!
- clr.b (a0,d0)
- move.l a0,my_FileName(a5)
- move.l my_CliScrn(a5),my_NextScrn(a5)
- bsr ASCPic
- bra CloseAll
- .2 cmpi.b #' ',-2(a0,d0) ;Datei übergeben?
- bne.s .4 ;ÄhÄh
- cmpi.b #'0',-1(a0,d0) ;In CLI-Window darstellen?
- bne.s .3 ;Nicht nötig!
- move.b #1,my_CliDisplay(a5) ;Flag setzen
- subq.l #2,d0 ;FileNameLen korrigieren
- bra.s .4
- .3 cmpi.b #'1',-1(a0,d0) ;In CLI-Wind & Colorset
- bne.s .4 ;Auch nicht!
- move.b #2,my_CliDisplay(a5)
- subq.l #2,d0
- .4 clr.b (a0,d0) ;Dateiende mit NULL
- bra.s Start
- ;---------------------------------------------------------------------------
- ;Wurde VPic kein Parameter übergeben, so wird mittels der ReqToolsLib ein
- ;File-Requester bereitgestellt in welchem wiederholt eine Gfx-Datei
- ;ausgewählt werden kann.
- ;---------------------------------------------------------------------------
- Rt_ReqLoop lea TxRtLoadPIC(pc),a3
- bsr Rt_Input
- tst.l my_RtBut(a5)
- beq CloseAll
- bsr OpenFile
- bne.s .1
- .0 bsr IffPic
- beq.s .1
- bsr PicDcr
- beq.s .0
- .1 bsr PrtCLine
- bsr FreeBuff
- bsr CKey ;[ESC] betätigt?
- beq CloseAll ;Ja!
- bra.s Rt_ReqLoop
- ****************************************************************************
- * Hauptprogramm
- ****************************************************************************
- Start move.l a0,my_FileName(a5)
- tst.b my_FromCLI(a5)
- beq.s .1 ;DEC/Path-Option NUR über CLI/Shell!
- bsr dec_init ;DirEntryCount-Verfahren?
- bsr.s LockFile ;Pfad übergeben?
- beq.s .3 ;Ja!
- .1 bsr OpenFile ;Datei öffnen
- bne.s .3 ;Fehler!
- .2 bsr VPicList ;Bilderliste übergeben?
- beq.s .3 ;Ja!
- bsr IffPic ;IFF/ABk/VBM/WBO-Bild?
- beq.s .3 ;Ja!
- bsr PicDcr ;Unbekanntes Format! Evtl. entpacken
- beq.s .2 ;Nochmals testen wenn entpackt
- .3 bsr PrtCLine
- bsr FreeBuff
- bra CloseAll
- ****************************************************************************
- * Alle Bilder eines Pfades werden angezeigt, nur über CLI! (Param:path)
- ****************************************************************************
- LockFile move.l my_FileName(a5),d1
- moveq.l #ACCESS_READ,d2
- DOS Lock
- move.l d0,my_FileLock(a5)
- beq Error
- move.l my_FileLock(a5),d1
- lea my_FileFib(a5),a0
- move.l a0,d2
- LIB Examine
- tst.l d0
- beq.s .6
- tst.l my_FileFib+fib_DirEntryType(a5)
- ble.s .6
- move.l my_FileLock(a5),d1
- LIB CurrentDir
- move.l d0,my_OldLock(a5)
- .1 move.l my_FileLock(a5),d1
- lea my_FileFib(a5),a0
- move.l a0,d2
- DOS ExNext
- tst.l d0
- beq.s .5
- .2 lea my_FileFib+fib_FileName(a5),a0
- move.l a0,my_FileName(a5)
- bsr OpenFile
- bne.s .4
- .3 bsr IffPic
- beq.s .4
- bsr PicDcr
- beq.s .3
- .4 bsr FreeBuff
- bsr CKey ;[ESC] betätigt?
- bne.s .1 ;Nein!
- .5 move.l my_FileLock(a5),d1
- DOS UnLock
- move.l my_OldLock(a5),d1
- LIB CurrentDir
- bra Ok
- .6 bsr.s .5
- bra Error
- ****************************************************************************
- * Zeige Bilder aus einer Datenliste (Param:list)
- ****************************************************************************
- VPicList moveq.l #0,d0 ;Test ob Bilderliste übergeben?
- movea.l my_FileBuf(a5),a1
- move.l my_FileLen(a5),d1
- ;---------------------------------------------------------------------------
- ;Der Test ob es sich um eine Bilderliste handelt ist ein wenig umständlich
- ;über ByteCmp geregelt, dafür muß aber kein ID Header als Erkennung der
- ;Liste vorangestellt werden.
- ;---------------------------------------------------------------------------
- .1 cmp.b #10,(a1) ;EndOfLine?
- beq.s .3 ;Ja!
- cmp.b #32,(a1)
- ble.s .2 ;Ungültiges Zeichen für Dateiname
- cmp.b #123,(a1)+
- bge.s .2 ;Ebenfalls ungültig
- addq.l #1,d0
- dbf d1,.1
- .2 bra Error ;Keine Liste bzw. gepackte Datei
- .3 tst.l d0
- beq Error
- ViewList move.l my_FileBuf(a5),my_ListBuf(a5)
- move.l my_FileLen(a5),my_ListLen(a5)
- move.l my_ListLen(a5),d0
- movea.l my_ListBuf(a5),a1
- .1 movea.l a1,a0 ;Bildname aus Liste ermitteln
- moveq.l #0,d1
- .2 cmpi.b #10,(a1)+
- beq.s .3
- addq.l #1,d1
- subq.l #1,d0
- ble.s .6 ;Ende der Liste erreicht?
- bra.s .2 ;Nein!
- .3 tst.l d1 ;Freizeile?
- beq.s .1 ;Ja! Überspringen
- movem.l a1/d0,-(sp)
- clr.b -1(a1)
- move.l a0,my_FileName(a5)
- bsr.s OpenFile
- bne.s .5
- .4 bsr IffPic ;IFF/ABk/VBM/WBO-Bild?
- beq.s .5 ;Ja!
- bsr PicDcr ;Evtl. gepackt?
- beq.s .4 ;Ja!
- .5 bsr FreeBuff
- movem.l (sp)+,a1/d0
- bsr CKey ;[ESC] betätigt?
- bne.s .1 ;Nein!
- .6 movea.l my_ListBuf(a5),a1
- move.l my_ListLen(a5),d0
- EXE FreeMem
- bra Ok
- ****************************************************************************
- * Bild/Liste öffnen und in Buffer einlesen
- ****************************************************************************
- OpenFile bsr PrtView
- move.l my_FileName(a5),d1
- move.l #MODE_OLDFILE,d2
- DOS Open
- move.l d0,my_FileHnd(a5)
- ble.s .1
- move.l my_FileHnd(a5),d1
- moveq #0,d2
- moveq #OFFSET_END,d3
- LIB Seek
- move.l my_FileHnd(a5),d1
- moveq #0,d2
- moveq #OFFSET_BEGINNING,d3
- LIB Seek
- move.l d0,my_FileLen(a5)
- ble.s .1
- move.l my_FileLen(a5),d0
- moveq #MEMF_PUBLIC,d1
- EXE AllocMem
- move.l d0,my_FileBuf(a5)
- ble.s .1
- move.l my_FileHnd(a5),d1
- move.l my_FileBuf(a5),d2
- move.l my_FileLen(a5),d3
- DOS Read
- cmp.l my_FileLen(a5),d0 ;Lesefehler aufgetreten?
- bne.s .1 ;Ja!
- bsr.s .2
- bra Ok ;Kein Fehler!
- .1 bsr.s .2
- bsr PrtVError
- bra Error ;Fehler!
- .2 move.l my_FileHnd(a5),d1 ;Datei immer schließen
- beq.s .3 ;Nicht geöffnet
- clr.l my_FileHnd(a5)
- DOS Close
- .3 rts
- ****************************************************************************
- * Bildspeicher wieder freigeben
- ****************************************************************************
- FreeBuff movea.l my_FileBuf(a5),a1
- move.l my_FileLen(a5),d0
- beq.s .0
- clr.l my_FileLen(a5)
- EXE FreeMem
- .0 rts
- ****************************************************************************
- * Alle benötigten Libraries öffnen, Strukturspeicher reservieren
- ****************************************************************************
- OpenAll move.l #my_SIZEOF,d0
- move.l #MEMF_PUBLIC|MEMF_CLEAR,d1
- EXE AllocMem
- tst.l d0
- ble Error
- movea.l d0,a5
- lea my_DosBase(a5),a2
- lea DosLib(pc),a1
- bsr.s .0
- lea IntLib(pc),a1
- bsr.s .0
- lea GfxLib(pc),a1
- bsr.s .0
- movea.l my_IntBase(a5),a1
- move.l ib_ActiveScreen(a1),my_CliScrn(a5)
- move.l ib_ActiveWindow(a1),my_CliWind(a5)
- rts
- .0 moveq.l #0,d0
- LIB OpenLibrary
- move.l d0,(a2)+
- rts
- ****************************************************************************
- * Alle geöffneten Libraries schließen und Programm beenden
- ****************************************************************************
- CloseAll movea.l my_DosBase(a5),a1
- EXE CloseLibrary
- movea.l my_IntBase(a5),a1
- LIB CloseLibrary
- movea.l my_GfxBase(a5),a1
- LIB CloseLibrary
- tst.l my_DcrBase(a5)
- beq.s .0
- movea.l my_DcrBase(a5),a1
- LIB CloseLibrary
- .0 tst.l my_XpkBase(a5)
- beq.s .1
- movea.l my_XpkBase(a5),a1
- LIB CloseLibrary
- .1 tst.l my_ReqBase(a5)
- beq.s .3
- move.l my_RtFileReq(a5),d0
- beq.s .2
- movea.l d0,a1
- REQ rtFreeRequest
- .2 movea.l my_ReqBase(a5),a1
- EXE CloseLibrary
- .3 movea.l a5,a1
- move.l #my_SIZEOF,d0
- LIB FreeMem
- clr.l d0
- RTS
- ****************************************************************************
- * Zeige das IFF - Format (ILBM/ACBM)
- ****************************************************************************
- IffPic clr.l my_AnnoPtr(a5)
- clr.l my_AuthPtr(a5)
- clr.l my_CopyPtr(a5)
- clr.w my_NewScrn+ns_ViewModes(a5)
- movea.l my_FileBuf(a5),a1 ;Datei-Buffer GLOBAL in A1
- moveq.l #0,d0
- .0 cmpi.l #'BMHD',(a1,d0.l) ;BitMapHeaDer muß sein!
- beq.s chunk0 ;Ja
- addi.l #2,d0 ;Position erhöhen (Word)
- cmpi.l #1024,d0
- ble.s .0
- bra ABkPic ;Nein! Link nächstes Format
- ;---------------------------------------------------------------------------
- ;Zunächst wird der für die Screen-Darstellung nötige Chunk ermittelt.
- ;Standartmäßig wird anhand der übergebenen Screen-Größe bestimmt, in welchem
- ;View-Modus dieser geöffnet werden soll (s. chunk2 'CAMG'). Ebenfalls wird
- ;hier ermittelt, ob die IFF-Grafik im komprimierten Zustand vorliegt.
- ;Kompressionsflag: cmpNone=0 (RAW) / cmpByteRun1=1 (RLE)
- ;---------------------------------------------------------------------------
- chunk0 lea 8(a1,d0.l),a1 ;ID_BMHD überspringen
- lea my_NewScrn(a5),a0
- move.w ibm_Width(a1),ns_Width(a0)
- move.w ibm_Height(a1),ns_Height(a0)
- move.b ibm_Planes(a1),ns_Depth+1(a0)
- move.b ibm_Compression(a1),my_PkMode(a5)
- clr.w ns_ViewModes(a0) ;Def. ViewMode installieren
- cmpi.w #320,ns_Width(a0)
- bls.s .1
- ori.w #V_HIRES,ns_ViewModes(a0)
- .1 cmpi.w #256,ns_Height(a0)
- bls.s .2
- ori.w #V_LACE,ns_ViewModes(a0)
- .2 movea.l my_FileBuf(a5),a1 ;Gfx in A1
- ;---------------------------------------------------------------------------
- ;Hier wird ermittelt an welcher Position der IFF-Datei die Farbeinträge
- ;vorliegen. Falls kein View-Modus der Grafik übermittelt wurde, wird hier
- ;anhand der Farbanzahl bestimmt ob die Grafik im HAM-Modus dargestellt wird.
- ;Unverständlicher Weise wird dieser Vorgang weder von DPaint IV noch von
- ;AMOSPro unterstützt, die Folge sind Falschfarben.
- ;---------------------------------------------------------------------------
- chunk1 cmpi.l #'CMAP',(a1)
- bne.s chunk2
- lea 4(a1),a2 ;Farbtabelle -> A2
- move.l a2,my_Palette(a5)
- cmpi.l #$C0,(a2) ;HAM-Modus?
- bne.s chunk2 ;Nein!
- ori.w #V_HAM,ns_ViewModes(a0) ;HAM-Flag einblenden
- ;---------------------------------------------------------------------------
- ;Ein spezieller Chunk für die Darstellung einer Grafik auf dem Amiga!
- ;Dieser ist von bedeutung wenn die Grafik zum Beispiel im HAM-Modus
- ;angezeigt werden soll. Liegt dieser Eintrag vor, wird der in chunk0/1
- ;vorsorglich installierte View-Modus ersetzt.
- ;---------------------------------------------------------------------------
- chunk2 cmpi.l #'CAMG',(a1)
- bne.s chunk3
- move.w 10(a1),ns_ViewModes(a0)
- ;---------------------------------------------------------------------------
- ;Positionelle Ermittlung der eigentlichen Grafikdaten. Erst hier werden
- ;alle zuvor ermittelten Einstellungen verarbeitet.
- ;---------------------------------------------------------------------------
- chunk3 cmpi.l #'ABIT',(a1) ;DigiPaint RAW Format?
- bne.s chunk4 ;Nein!
- move.b #PKMODE_AMIGABASIC,my_PkMode(a5)
- bra.s IffView ;Grafik zeigen
- ;--------------------------------------------------------------------------
- ;Eventuelle Bemerkungen ( Annotations ) des Grafikers bzw. des
- ;Grafikprogramms, diese Chunks können theoretisch beliebig lang sein.
- ;Übrigens sind diese Chunks nicht standartmäßig für Grafikdateien gedacht,
- ;eigentlich verwendet nur das FORM-Musikformat diesen aber Brilliance sowie
- ;HamLab/ArtPRO usw. unterstützen Annotations ebenso, warum auch nicht VPic!
- ;--------------------------------------------------------------------------
- chunk4 cmpi.l #'ANNO',(a1) ;Annotation?
- bne.s chunk5 ;Nein
- move.l a1,my_AnnoPtr(a5) ;Zeiger für Info merken
- chunk5 cmpi.l #'AUTH',(a1) ;Author?
- bne.s chunk6 ;Nein
- move.l a1,my_AuthPtr(a5) ;Zeiger für Info merken
- chunk6 cmpi.l #'(c) ',(a1) ;Copyright?
- bne.s chunk7 ;Nein
- move.l a1,my_CopyPtr(a5) ;Zeiger für Info merken
- ;--------------------------------------------------------------------------
- ;Die eigentlichen Grafikdaten des darzustellenden Bildes. Diese Daten
- ;liegen nun gepackt (RunLengthEncoding) oder in Raw-Format vor.
- ;--------------------------------------------------------------------------
- chunk7 cmpi.l #'BODY',(a1) ;Normales IFF-Format?
- beq.s IffView ;Ja!
- adda.l #2,a1 ;Zeiger auf nächstes WORD
- bra chunk1 ;Weiter suchen
- IffView lea 8(a1),a4 ;Zeiger auf Gfxdaten -> A4
- bsr PicScrn ;IFF-Screen öffnen
- bne Error ;Wenn Fehler dann Ende!
- movea.l my_ScrnPtr(a5),a3
- lea sc_BitMap(a3),a3
- cmpi.b #PKMODE_NORMAL,my_PkMode(a5)
- beq.s IffNorm
- cmpi.b #PKMODE_COMPRESSED,my_PkMode(a5)
- beq.s IffPack
- cmpi.b #PKMODE_AMIGABASIC,my_PkMode(a5)
- beq.s IffAbas
- ;---------------------------------------------------------------------------
- ;Das IFF-Bild liegt unkomprimiert vor. Die folgende Routine zeigt wohl
- ;eines der schnellsten Verfahren, welches zum Anzeigen einer IFF-Grafik
- ;verwendet werden kann.
- ;---------------------------------------------------------------------------
- IffNorm moveq.l #0,d3
- moveq.l #0,d5
- move.w bm_BytesPerRow(a3),d5
- move.w bm_Rows(a3),d6
- .1 moveq #0,d4
- .2 lea my_PlanPtr(a5),a0
- move.l (a0,d4.w),d0
- beq.s .3
- movea.l a4,a0
- add.l d3,d0
- movea.l d0,a1
- move.l d5,d0
- EXE CopyMem
- adda.l d5,a4
- addq.l #4,d4
- bra.s .2
- .3 subq.w #1,d6
- beq.s IffCols
- add.l d5,d3
- bra.s .1
- ;---------------------------------------------------------------------------
- ;Das IFF-Bild liegt komprimiert vor. Das Kompressionsverfahren muß dem von
- ;Electronic Arts entwickelten 'cmpByteRun1 (RLE)' entsprechen.
- ;---------------------------------------------------------------------------
- IffPack move.w bm_Rows(a3),d6
- .0 move.b bm_Depth(a3),d5
- lea my_PlanPtr(a5),a1
- .1 movea.l (a1),a0
- move.w bm_BytesPerRow(a3),d2
- .2 move.b (a4)+,d0
- bmi.s .4
- .3 move.b (a4)+,(a0)+
- subq.w #1,d2
- subq.b #1,d0
- bpl.s .3
- bra.s .6
- .4 neg.b d0
- bmi.s .2
- move.b (a4)+,d3
- .5 move.b d3,(a0)+
- subq.w #1,d2
- subq.b #1,d0
- bpl.s .5
- .6 tst.w d2
- bne.s .2
- move.l a0,(a1)+
- subq.b #1,d5 ;bm_Depth-1
- bne.s .1
- subq.w #1,d6 ;bm_Rows-1
- bne.s .0
- bra.s IffCols
- ;---------------------------------------------------------------------------
- ;Die Daten des Bildes liegen im speziellen DigiPaint (ACBM) Format vor. In
- ;diesem Modus kann eine Grafik am schnellsten dargestellt werden. AmigaBASIC
- ;läßt grüssen!
- ;---------------------------------------------------------------------------
- IffAbas move.w bm_BytesPerRow(a3),d7
- mulu bm_Rows(a3),d7 ;Größe der Planes -> D7
- lea my_PlanPtr(a5),a2
- .0 movea.l a4,a0 ;Zeiger Grafikdaten
- move.l (a2)+,d0 ;Zeiger BitPlane
- beq.s IffCols ;Keine weitere Plane
- movea.l d0,a1
- move.l d7,d0
- EXE CopyMem
- adda.l d7,a4
- bra.s .0
- ;Jetzt noch die benötigte Farbpalette setzten.
- IffCols movea.l my_Palette(a5),a2
- move.l (a2)+,d7
- divu #3,d7
- moveq.l #0,d6
- .0 movea.l my_ScrnPtr(a5),a0
- lea sc_ViewPort(a0),a0
- move.l d6,d0
- moveq.l #0,d1
- move.b (a2)+,d1
- lsr.b #4,d1
- moveq.l #0,d2
- move.b (a2)+,d2
- lsr.b #4,d2
- moveq.l #0,d3
- move.b (a2)+,d3
- lsr.b #4,d3
- GFX SetRGB4
- addq.l #1,d6
- dbf d7,.0
- bra PicWait
- ****************************************************************************
- * Zeige das spezielle AmBk Pic.Pac - Format (AMOS)
- ****************************************************************************
- ABkPic cmpi.l #"AmBk",(a1) ;AMOS Bank?
- bne VBMPic ;Nein, VPic BitMap Format?
- move.b #PKMODE_AMOSBITMAP,my_PkMode(a5)
- lea my_NewScrn(a5),a0
- lea 20(a1),a1 ;AmBk Head überspringen
- cmpi.l #SCCode,(a1) ;AmBk Pic.Pac Screen Format
- bne.s .1 ;Nein! Pack BitMap Format?
- ;Das Bild wurde mittels 'Spack SCREEN To BANK' gepackt.
- move.b #PKMODE_AMOSSCREEN,my_PkMode(a5)
- move.w PsTx(a1),ns_Width(a0)
- move.w PsTy(a1),ns_Height(a0)
- move.w PsNPlan(a1),ns_Depth(a0)
- move.w PsCon0(a1),ns_ViewModes(a0)
- bra.s .3
- .1 cmpi.l #BMCode,(a1) ;Gepackte BitMap?
- bne Error ;Nein!
- ;---------------------------------------------------------------------------
- ;Es wurden nur die jeweiligen BitMaps mittels 'Pack SCREEN To Bank' gepackt.
- ;Dabei wird weder die Palette noch der ViewMode berücksichtigt.
- ;---------------------------------------------------------------------------
- move.w Pktx(a1),d0
- lsl.w #3,d0
- move.w d0,ns_Width(a0)
- move.w Pkty(a1),d0
- mulu Pktcar(a1),d0
- move.w d0,ns_Height(a0)
- move.w Pknplan(a1),ns_Depth(a0)
- clr.w ns_ViewModes(a0) ;Def. ViewMode installieren
- cmpi.w #320,ns_Width(a0)
- bls.s .2
- ori.w #V_HIRES,ns_ViewModes(a0)
- .2 cmpi.w #256,ns_Height(a0)
- bls.s .3
- ori.w #V_LACE,ns_ViewModes(a0)
- .3 bsr PicScrn ;Screen öffnen
- bne Error ;Hat nicht geklappt
- ;---------------------------------------------------------------------------
- ;Hier beginnt nun die eigentliche Unpack-Routine von François Lionet. Ich
- ;habe sie geringfügig abändern müssen, da sie eigentlich nur für die
- ;Programmierung eigener AMOSPro Extensionen ausgelegt war.
- ;---------------------------------------------------------------------------
- UAEc equ 0
- UDEc equ 4
- UITy equ 8
- UTy equ 10
- UTLine equ 12
- UNPlan equ 14
- UPile equ 16
- UnPack move.l a5,-(sp)
- movea.l my_FileBuf(a5),a0 ;Zeiger auf Bilddaten
- movea.l my_ScrnPtr(a5),a1 ;Zeiger auf Screen
- lea 20(a0),a0 ;Header überspringen
- cmpi.b #PKMODE_AMOSBITMAP,my_PkMode(a5)
- beq.s .1 ;Ist gepackte BitMap!
- lea PsLong(a0),a0 ;Zeiger auf Screen BM
- ;Parameter preparieren!
- .1 lea -UPile(sp),sp ;Arbeitsbereich einrichten
- lea sc_BitMap(a1),a1 ;Screen BitMap -> A1
- move.w bm_BytesPerRow(a1),d7
- move.w Pknplan(a0),UNPlan(sp) ;Anzahl der BitPlanes
- lea bm_Planes(a1),a1 ;Zeiger auf Planes -> A1
- move.l a1,UAEc(sp)
- move.w Pktcar(a0),d6 ;Höhe gepackten Block -> D6
- move.w d6,d0
- mulu d7,d0
- move d0,UTLine(sp) ;Anzahl der Zeilen
- move.w Pktx(a0),a3 ;Breite BitMap in Bytes -> A3
- subq.w #1,a3
- move.w Pkty(a0),UITy(sp) ;Höhe BitMap in Blöcke
- lea PkDatas1(a0),a4 ;Zeiger Tabelle 1 -> A4
- movea.l a0,a5
- movea.l a0,a6
- adda.l PkDatas2(a0),a5 ;Zeiger Tabelle 2 -> A5
- adda.l PkPoint2(a0),a6 ;Zeigertabelle -> A6
- moveq #7,d0
- moveq #7,d1
- move.b (a5)+,d2
- move.b (a4)+,d3
- btst d1,(a6)
- beq.s prep
- move.b (a5)+,d2
- prep subq.w #1,d1
- ;BitMaps entpacken!
- dplan movea.l UAEc(sp),a2 ;BitMap PlanePtr -> A2
- addq.l #4,UAEc(sp) ;Auf nächste Plane
- movea.l (a2),a2 ;Adresse Plane -> A2
- move.w UITy(sp),UTy(sp)
- dligne movea.l a2,a1 ;PlanePtr -> A1
- move.w a3,d4
- dcarre movea.l a1,a0
- move.w d6,d5 ;Blockhöhe
- doctet1 subq.w #1,d5
- bmi.s doct3
- btst d0,d2
- beq.s doct1
- move.b (a4)+,d3
- doct1 move.b d3,(a0)
- add.w d7,a0
- dbra d0,doctet1
- moveq #7,d0
- btst d1,(a6)
- beq.s doct2
- move.b (a5)+,d2
- doct2 dbra d1,doctet1
- moveq #7,d1
- addq.l #1,a6
- bra.s doctet1
- doct3 addq.l #1,a1 ;Auf nächsten Block
- dbra d4,dcarre
- adda.w UTLine(sp),a2 ;Nächste Blockzeile
- subq.w #1,UTy(sp)
- bne.s dligne
- subq.w #1,UNPlan(sp)
- bne.s dplan
- lea UPile(sp),sp ;Arbeitsbereich zurücksetzen
- ;---------------------------------------------------------------------------
- ;Die Farbpalette im Screen setzen. Die jeweiligen Farbwerte liegen bei dem
- ;AmBk Format in Word-Größe vor, was die Farbgebung erheblich vereinfacht.
- ;---------------------------------------------------------------------------
- move.l (sp)+,a5
- lea my_NewScrn(a5),a0
- movea.l my_FileBuf(a5),a1
- lea 20(a1),a1
- cmpi.b #PKMODE_AMOSBITMAP,my_PkMode(a5)
- beq PicWait ;Keine Palette (Packed BitMap)
- move.w PsNbCol(a1),d0 ;Anzahl der Farbeinträge
- lea PsPal(a1),a1 ;Zeiger auf Farbtabelle
- movea.l my_ScrnPtr(a5),a0
- lea sc_ViewPort(a0),a0
- GFX LoadRGB4 ;Farbwerte aktualisieren
- bra PicWait
- ****************************************************************************
- * Zeige das (interne) VPic BitMap Plane - Format (VPIC/VBMP)
- ****************************************************************************
- VBMPic cmpi.l #ID_VBMP,vbm_Bmap(a1) ;VPic BitMap Format?
- bne.s WBOPic ;Nein
- move.b #PKMODE_VPICBITMAP,my_PkMode(a5)
- lea my_NewScrn(a5),a0
- move.w vbm_Width(a1),ns_Width(a0)
- move.w vbm_Height(a1),ns_Height(a0)
- move.w #vbm_DEPTH,ns_Depth(a0)
- move.w vbm_ViewMode(a1),ns_ViewModes(a0)
- bsr PicScrn ;Screen öffnen
- bne Error ;Hat nicht geklappt
- movea.l my_FileBuf(a5),a0 ;Zeiger auf Bilddaten
- lea vbm_Data(a0),a0
- moveq.l #0,d0
- movea.l my_ScrnPtr(a5),a1 ;Zeiger auf Screen
- lea sc_BitMap(a1),a1
- move.w bm_BytesPerRow(a1),d0
- mulu bm_Rows(a1),d0
- movea.l my_PlanPtr(a5),a1
- EXE CopyMem
- bra PicWait
- ****************************************************************************
- * Zeige das Workbench Objekt Info - Format ($E310 0001)
- ****************************************************************************
- WBOPic cmpi.w #WB_DISKMAGIC,do_Magic(a1) ;WBO Info Format?
- bne Error ;Nein! Decrunch
- cmpi.w #WB_DISKVERSION,do_Version(a1)
- bne Error
- move.b #PKMODE_WBOINFO,my_PkMode(a5)
- lea my_NewScrn(a5),a0
- movea.l my_FileBuf(a5),a1
- lea do_Gadget(a1),a1
- move.w #640,ns_Width(a0)
- move.w gg_Height(a1),ns_Height(a0)
- move.w #2,ns_Depth(a0)
- move.w #V_HIRES,ns_ViewModes(a0)
- bsr PicScrn ;Screen öffnen
- bne Error ;Hat nicht geklappt
- moveq.l #0,d6
- moveq.l #0,d7
- movea.l my_FileBuf(a5),a4
- lea do_Gadget(a4),a1
- move.w gg_Width(a1),d6
- move.w gg_Height(a1),d7
- move.l d6,d0 ;kgV 16
- divu #$10,d0
- swap d0
- andi.l #$FFFF,d0
- tst.w d0
- beq.s .0
- sub.l d0,d6
- addi.l #$10,d6
- .0 tst.w do_DrawerData(a4)
- bne.s .1
- adda.l #98,a4
- bra.s .2
- .1 adda.l #154,a4
- .2 lsr.l #3,d6
- moveq.l #0,d4
- WBO_View movea.l my_PlanPtr(a5),a3
- bsr.s .0
- movea.l my_PlanPtr+4(a5),a3
- bsr.s .0
- tst.l d4
- bne PicWait
- adda.l #20,a4
- move.l d6,d4
- bra.s WBO_View
- .0 adda.l d4,a3
- move.l d7,d5
- subq #2,d5
- .1 movea.l a4,a0
- movea.l a3,a1
- move.l d6,d0
- EXE CopyMem
- adda.l d6,a4
- adda.l #80,a3
- dbra d5,.1
- rts
- ****************************************************************************
- * Zeige den aktuellen Screen - [Param:*] [RETURN]
- ****************************************************************************
- ASCPic move.b #PKMODE_ACTUALSCREEN,my_PkMode(a5)
- move.l my_NextScrn(a5),a0 ;Nächster Screen
- move.l (a0),my_NextScrn(a5) ;übergeben
- tst.l my_NextScrn(a5)
- bne.s .0
- move.l my_CliScrn(a5),my_NextScrn(a5)
- .0 movea.l my_NextScrn(a5),a0
- lea my_NewScrn(a5),a1
- move.w sc_Width(a0),ns_Width(a1)
- move.w sc_Height(a0),ns_Height(a1)
- lea sc_ViewPort(a0),a2
- move.w vp_Modes(a2),ns_ViewModes(a1)
- lea sc_BitMap(a0),a0
- move.b bm_Depth(a0),ns_Depth+1(a1)
- bsr PicScrn
- bne Error
- movea.l my_NextScrn(a5),a3
- movea.l my_ScrnPtr(a5),a4
- lea sc_BitMap(a3),a3
- lea sc_BitMap(a4),a4
- moveq.l #0,d7
- move.w bm_BytesPerRow(a4),d7
- mulu bm_Rows(a4),d7
- ;Die aktuellen ScrnPlanes in die ScrnPlanes kopieren
- .1 move.l bm_Planes(a3),d0
- beq.s .2
- move.l bm_Planes(a4),d1
- beq.s .2
- movea.l d0,a0
- movea.l d1,a1
- move.l d7,d0
- EXE CopyMem
- adda.l #4,a3
- adda.l #4,a4
- bra.s .1
- ;Farben setzen
- .2 movea.l my_NextScrn(a5),a1
- lea sc_ViewPort(a1),a1
- movea.l vp_ColorMap(a1),a1
- movea.l cm_ColorTable(a1),a1
- movea.l my_ScrnPtr(a5),a0
- lea sc_ViewPort(a0),a0
- move.l my_ColorCount(a5),d0
- GFX LoadRGB4
- ;Screen aufblinken für Darstellungsinfo
- bsr PicFront
- move.l my_ScrnPtr(a5),a0
- INT DisplayBeep
- WAIT 10 ;Warten auf ColorCorrection
- lea my_InputBuf(a5),a0 ;Für Info (*)
- move.w #$2A00,(a0)
- move.l a0,my_FileName(a5)
- bra PicWait
- ****************************************************************************
- * Unter-Routinen die für jedes Bildformat gleichbedeutend sind
- ****************************************************************************
- PicScrn lea my_NewScrn(a5),a0
- move.w #CUSTOMSCREEN|SCREENBEHIND,ns_Type(a0)
- INT OpenScreen
- move.l d0,my_ScrnPtr(a5)
- beq Error
- movea.l d0,a0 ;PlanePtr kopieren
- lea sc_BitMap(a0),a0
- lea bm_Planes(a0),a0
- lea my_PlanPtr(a5),a1
- moveq.l #8-1,d0
- .0 move.l (a0)+,(a1)+
- dbra d0,.0
- lea my_NewWind(a5),a0
- lea my_NewScrn(a5),a1
- move.w ns_Depth(a1),d0 ;Farbanzahl merken
- moveq.l #0,d1
- bset d0,d1
- move.l d1,my_ColorCount(a5)
- move.w ns_Width(a1),nw_Width(a0)
- move.w ns_Height(a1),nw_Height(a0)
- move.l #MOUSEBUTTONS|RAWKEY,nw_IDCMPFlags(a0)
- move.l #ACTIVATE|BORDERLESS,nw_Flags(a0)
- move.l my_ScrnPtr(a5),nw_Screen(a0)
- move.w #CUSTOMSCREEN,nw_Type(a0)
- LIB OpenWindow
- move.l d0,my_WindPtr(a5)
- bne Ok
- bsr PicClose
- bra Error
- PicWait movea.l my_ScrnPtr(a5),a0 ;Farben kopieren für *Shade
- lea sc_ViewPort(a0),a0
- movea.l vp_ColorMap(a0),a1
- movea.l cm_ColorTable(a1),a1
- lea my_DefPalette(a5),a0
- moveq.l #32-1,d0
- .0 move.w (a1)+,(a0)+
- dbf d0,.0
- tst.b my_CliDisplay(a5) ;Bild zeigen im CLI-Window?
- bne CliDisplay ;Ja
- bsr PicFront
- movea.l my_WindPtr(a5),a0
- movea.l wd_UserPort(a0),a0
- move.b MP_SIGBIT(a0),d1
- moveq.l #0,d0
- bset d1,d0
- EXE Wait
- PicKey WAIT 5
- bsr CKey
- beq.s .0 ;[ESC] = Abbruch
- move.b my_KeyCode(a5),d1
- beq.s PicKey
- cmpi.b #$FF,d1
- beq.s .0
- bra.s .1
- .0 bsr PicBack
- bra WinClose
- ;Auswertung der Tastatureingaben
- .1 cmpi.b #RAW_F1,d1 ;[F1] = Info
- bne.s .2
- bsr PicBack
- bsr PicInfo
- bsr PicFront
- bra.s PicKey
- .2 cmpi.b #RAW_F2,d1 ;[F2] = Save IFF
- bne.s .3
- bsr PicBack
- bsr SaveIFF
- bsr PicFront
- bra.s PicKey
- .3 cmpi.b #RAW_F3,d1 ;[F3] = Negative
- bne.s .4
- bsr Negative
- bra.s PicKey
- .4 cmpi.b #RAW_F4,d1 ;[F4] = CLI Display
- bne.s .5
- bsr PicBack
- bra CliDisplay
- .5 cmpi.b #RAW_F5,d1 ;[F5] = CLI Display + Colorset
- bne.s .6
- bsr PicBack
- bsr CliDisplay
- move.w #COLOR_CLI,d3
- bsr Shade
- bra Ok
- .6 cmpi.b #RAW_F6,d1 ;[F6] = Red Shade
- bne.s .7
- move.l #COLOR_RED,d3
- bsr Shade
- bra PicKey
- .7 cmpi.b #RAW_F7,d1 ;[F7] = Green Shade
- bne.s .8
- move.l #COLOR_GRN,d3
- bsr Shade
- bra PicKey
- .8 cmpi.b #RAW_F8,d1 ;[F8] = Blue Shade
- bne.s .9
- move.l #COLOR_BLU,d3
- bsr Shade
- bra PicKey
- .9 cmpi.b #RAW_F9,d1 ;[F9] = Grey Shade
- bne.s .10
- move.l #COLOR_GRY,d3
- bsr Shade
- bra PicKey
- .10 cmpi.b #RAW_F10,d1 ;[F10] = Def Palette
- bne.s .11
- moveq.l #COLOR_DEF,d3
- bsr Shade
- bra PicKey
- .11 cmpi.b #RAW_HELP,d1 ;[HELP] = Usage
- bne.s .12
- bsr PicBack
- bsr Rt_Usage
- bsr PicFront
- bra PicKey
- .12 cmpi.b #RAW_1,d1 ;[1-8] = Save VBM
- bmi.s .13
- cmpi.b #RAW_9,d1
- bpl.s .13
- bsr.s PicBack
- bsr SaveVBM
- bsr PicFront
- bra PicKey
- .13 cmpi.b #RAW_RETURN,d1 ;[RETURN] = View Next Screen
- bne.s .14
- bsr.s PicBack
- bsr.s WinClose
- bra ASCPic
- .14 cmpi.b #RAW_RALT,d1 ;[RALT] = Multitasking
- bne.s .15
- bsr.s PicBack
- .Loop WAIT 10
- bsr CKey
- cmpi.b #RAW_LALT,d1 ;[LALT] = Stop multitasking
- bne.s .Loop
- bsr.s PicFront
- bra PicKey
- .15 cmpi.b #RAW_N1,d1 ;[N1] = Set OS1.3 color
- bne.s .16
- moveq.l #COLOR_OS1,d3
- bsr Shade
- bra PicKey
- .16 cmpi.b #RAW_N2,d1 ;[N2] = Set OS2.0 color
- bne.s .99
- moveq.l #COLOR_OS2,d3
- bsr Shade
- bra PicKey
- .99 cmpi.b #RAW_SPACE,d1 ;[SPACE] = End
- bne PicKey
- WinClose movea.l my_WindPtr(a5),a0
- INT CloseWindow
- PicClose movea.l my_ScrnPtr(a5),a0
- INT CloseScreen
- bra Ok
- PicBack movea.l my_ScrnPtr(a5),a0
- INT ScreenToBack
- rts
- PicFront movea.l my_ScrnPtr(a5),a0
- INT ScreenToFront
- rts
- ****************************************************************************
- * Informationen der dargestellten Grafik ausgeben - [F1]
- ****************************************************************************
- PicInfo lea my_NewScrn(a5),a0
- lea my_FmtData(a5),a1
- move.l my_FileName(a5),a2
- movea.l a2,a3
- .0 cmpi.b #':',(a2) ;Nur den Dateinamen
- beq.s .1
- cmpi.b #'/',(a2)
- beq.s .1
- tst.b (a2)+
- bne.s .0
- bra.s PicInfoOut
- .1 adda.l #1,a2
- movea.l a2,a3
- bra.s .0
- PicInfoOut move.l a3,(a1)+
- move.w ns_Width(a0),(a1)+
- move.w ns_Height(a0),(a1)+
- move.w ns_Depth(a0),(a1)+
- move.l my_ColorCount(a5),(a1)+
- move.w ns_ViewModes(a0),(a1)+
- move.b my_PkMode(a5),d0
- ext.w d0
- lsl.w #4,d0
- lea TxTyp(pc),a0
- lea (a0,d0),a0
- move.l a0,(a1)+
- move.l my_FileLen(a5),(a1)+
- clr.l (a1)
- clr.l 4(a1)
- clr.l 8(a1)
- lea TxAnno(pc),a2
- clr.w (a2)
- lea TxAuth(pc),a2
- clr.w (a2)
- lea TxCopy(pc),a2
- clr.w (a2)
- move.l my_CopyPtr(a5),d0
- beq.s .0
- move.l #'(c) ',d1
- bsr.s .3
- lea TxAuth(pc),a2
- .0 move.l my_AuthPtr(a5),d0
- beq.s .1
- move.l #'Auth',d1
- bsr.s .3
- lea TxAnno(pc),a2
- .1 move.l my_AnnoPtr(a5),d0
- beq.s .2
- move.l #'Anno',d1
- bsr.s .3
- .2 lea TxInfo(pc),a0
- bsr Rt_Fmt
- lea my_DataBuf(a5),a4
- move.l a0,8(a4)
- lea TxRtPicInfo(pc),a0
- move.l a0,(a4)
- lea TxRtOKCOLS(pc),a0
- move.l a0,4(a4)
- bsr Rt_Request
- tst.l my_RtBut(a5)
- beq Ok
- bra.s ColorTable
- .3 move.b #10,(a2)+
- move.l d1,(a2)
- movea.l d0,a0
- lea 4(a0),a0
- move.l (a0)+,d0
- clr.b (a0,d0)
- move.l a0,(a1)+
- rts
- ColorTable movea.l my_ScrnPtr(a5),a4
- lea sc_ViewPort(a4),a3
- movea.l vp_ColorMap(a3),a3
- movea.l cm_ColorTable(a3),a3
- lea my_FmtData(a5),a4
- move.l my_ColorCount(a5),d0
- cmpi.l #64,d0 ;AGA ist >64 (256 RGB)
- ble.s .NoAGA ;Kein AGA Format
- move.l #64,d0 ;8 BMP ist viel zu viel
- .NoAGA subq.w #1,d0
- moveq #0,d1
- moveq #0,d2
- lea my_DataBuf(a5),a2
- .0 move.w d1,(a4)
- move.w (a3)+,2(a4)
- addq.w #1,d1
- lea TxColMap(pc),a0
- bsr Rt_Fmt
- .1 move.b (a0)+,(a2)+
- bne.s .1
- suba.l #1,a2
- addq.b #1,d2
- cmpi.b #4,d2
- bne.s .2
- moveq #0,d2
- move.b #10,(a2)+ ;Neue Zeile
- .2 dbeq d0,.0
- clr.b -1(a2) ;Ende der Farbtabelle
- lea my_FmtData(a5),a4 ;Buffer wird nicht benötigt!
- lea TxRtColorTab(pc),a0
- move.l a0,(a4)
- lea TxRtOKINFO(pc),a0
- move.l a0,4(a4)
- lea my_DataBuf(a5),a0
- move.l a0,8(a4)
- bsr Rt_Request
- clr.l my_DataBuf(a5) ;Für Dateinamen (löschen)
- tst.l my_RtBut(a5)
- bne PicInfo
- bra Ok
- ****************************************************************************
- * Zur Zeit dargestelltes Bild als IFF-Datei speichern - [F2]
- ****************************************************************************
- SaveIFF lea TxRtSaveIFF(pc),a3
- bsr Rt_Input
- tst.l my_RtBut(a5)
- beq Ok
- move.l my_FileName(a5),d1
- move.l #MODE_NEWFILE,d2
- DOS Open
- move.l d0,my_FileHnd(a5)
- ble PrtSError
- lea my_DataBuf(a5),a3 ;1024 Bytes löschen
- move.l #255,d0
- .0 clr.l (a3)+
- dbf d0,.0
- ;---------------------------------------------------------------------------
- ;Der Haupt-Chunk. Hier werden alle nötigen Daten zur Screen-Verwaltung
- ;installiert.
- ;---------------------------------------------------------------------------
- CreateBMHD lea TxBMHD+8(pc),a3
- lea my_NewScrn(a5),a1
- move.w ns_Width(a1),ibm_Width(a3)
- move.w ns_Height(a1),ibm_Height(a3)
- move.b ns_Depth+1(a1),ibm_Planes(a3)
- clr.b ibm_Compression(a3)
- move.b #$A,ibm_xAspect(a3)
- move.b #$B,ibm_yAspect(a3)
- move.w ns_Width(a1),ibm_PageWidth(a3)
- move.w ns_Height(a1),ibm_PageHeight(a3)
- lea TxBODY(pc),a3
- move.w ns_Width(a1),d0
- and.l #$FFFF,d0
- lsr.w #3,d0 ;Durch 8 teilen
- mulu ns_Height(a1),d0
- mulu ns_Depth(a1),d0
- move.l d0,4(a3) ;BODY-Größe merken
- ;---------------------------------------------------------------------------
- ;Erstellung des IFF-ViewModes. Von vielen Grafikprogrammen einfach
- ;vernachlässigt. Man kann den ViewMode zwar über den BMHD ermitteln, bei
- ;HAM-Grafiken aber würde es unweigerlich zu Schwierigkeiten führen.
- ;---------------------------------------------------------------------------
- CreateCAMG lea TxCAMG(pc),a3
- movea.l my_ScrnPtr(a5),a4
- lea sc_ViewPort(a4),a0
- move.w vp_Modes(a0),10(a3)
- ;Farbwerte ermitteln und als RGB Chunk-Daten eintragen.
- CreateCMAP lea TxBMHD+8(pc),a3 ;ID_BMHD+Len überspringen
- move.b ibm_Planes(a3),d0 ;Anzahl der Planes
- moveq.l #0,d1
- bset d0,d1
- move.l d1,d5 ;Farbanzahl merken
- mulu #3,d1
- moveq.l #0,d6
- lea my_DataBuf(a5),a3
- .1 movea.l sc_ViewPort+vp_ColorMap(a4),a0
- move.l d6,d0
- GFX GetRGB4
- move.l d0,d1
- bmi.s .2
- andi.w #$F00,d0
- lsr.w #4,d0
- move.b d0,(a3)+ ;Rot
- move.l d1,d0
- andi.b #$F0,d1
- move.b d1,(a3)+ ;Grün
- andi.b #$F,d0
- lsl.b #4,d0
- move.b d0,(a3)+ ;Blau
- addq.l #1,d6
- dbf d5,.1
- .2 lea TxCMAP(pc),a3
- btst #0,d6 ;Farbanzahl ungerade?
- beq.s .3 ;Nein!
- addq.l #1,d6
- .3 mulu #3,d6
- move.l d6,4(a3)
- ;---------------------------------------------------------------------------
- ;Die IFF-Head Größe wird ermittelt. Dazu werden nur noch die variablen
- ;Chunk-Größen von CMAP und BODY addiert.
- ;---------------------------------------------------------------------------
- CreateBODY lea TxFORM(pc),a3
- move.l #TxFormL,d7 ;Inklusive BODY+LEN (FORM+LEN)
- add.l TxCMAP+4(pc),d7
- add.l TxBODY+4(pc),d7
- move.l d7,d6
- move.l d6,4(a3)
- ;Nun den IFF-Header speichern.
- SaveHEAD move.l my_FileHnd(a5),d1
- move.l a3,d2
- move.l #TxFormL,d3
- DOS Write
- SaveCMAP move.l my_FileHnd(a5),d1
- lea my_DataBuf(a5),a0
- move.l a0,d2
- move.l TxCMAP+4(pc),d3
- LIB Write
- SaveBODY move.l my_FileHnd(a5),d1
- lea TxBODY(pc),a0
- move.l a0,d2
- moveq.l #8,d3
- LIB Write
- ;Hier werden die eigentlichen Grafikdaten im cmpNone Verfahren gespeichert.
- MakeBODY movea.l my_ScrnPtr(a5),a3
- lea sc_BitMap(a3),a3
- move.w bm_BytesPerRow(a3),d5
- and.l #$FFFF,d5
- move.w bm_Rows(a3),d6
- moveq.l #0,d7
- .1 moveq.l #bm_Planes,d4
- .2 move.l (a3,d4.l),d0
- beq.s .3
- move.l my_FileHnd(a5),d1
- move.l d0,d2
- add.l d7,d2
- move.l d5,d3
- LIB Write
- addq.l #4,d4
- bra.s .2
- .3 add.l d5,d7
- subq.w #1,d6
- bne.s .1
- CloseIFF move.l my_FileHnd(a5),d1
- clr.l my_FileHnd(a5)
- LIB Close
- EndSaveIFF bra PrtULine
- ****************************************************************************
- * Bild als Negativ darstellen - [F3]
- ****************************************************************************
- Negative moveq.l #0,d5
- moveq.l #0,d6
- movea.l my_ScrnPtr(a5),a3
- lea sc_BitMap(a3),a3
- move.w bm_BytesPerRow(a3),d1
- move.w bm_Rows(a3),d2
- .0 move.l bm_Planes(a3),d0
- beq.s .2
- movea.l d0,a0
- move.l d1,d0
- mulu d2,d0
- .1 not.l (a0)+
- subq.l #4,d0
- bne.s .1
- adda.l #4,a3
- bra.s .0
- .2 WAIT 50
- rts
- ****************************************************************************
- * Bild in aktuelles CLI-Window darstellen [Param:0|1] [F4|F5]
- ****************************************************************************
- CliDisplay tst.b my_FromCLI(a5)
- beq Ok
- ;Die jeweiligen ScrnPtr bzw. BitMaps angeben
- movea.l my_ScrnPtr(a5),a3
- lea sc_BitMap(a3),a3
- movea.l my_CliScrn(a5),a4
- lea sc_BitMap(a4),a4
- moveq.l #0,d6
- moveq.l #0,d7
- move.w bm_BytesPerRow(a3),d6
- mulu bm_Rows(a3),d6
- move.w bm_BytesPerRow(a4),d7
- mulu bm_Rows(a4),d7
- cmp.l d6,d7
- ble.s .0
- move.l d6,d7
- .0 bsr CliMaxWind
- move.w bm_Rows(a3),d6
- lsr.w #3,d6
- addq.w #2,d6
- cmpi.w #31,d6
- ble.s .1
- move.w #31,d6
- .1 move.w d6,my_FmtData(a5)
- bsr PrtLLine
- ;Die ScrnPlanes in die aktuellen CLI-ScrnPlanes kopieren
- CopyCliPln move.l bm_Planes(a3),d0
- beq.s .1
- move.l bm_Planes(a4),d1
- beq.s .1
- movea.l d0,a0
- movea.l d1,a1
- move.l d7,d0
- EXE CopyMem
- adda.l #4,a3
- adda.l #4,a4
- bra.s CopyCliPln
- .1 cmpi.b #1,my_CliDisplay(a5)
- beq.s .2
- cmpi.b #2,my_CliDisplay(a5)
- bne.s .2
- move.l #COLOR_CLI,d3
- bsr.s Shade
- .2 bra WinClose
- ****************************************************************************
- * Farben in Rot/Grün/Blau/Grau/Def/OS1/OS2-Töne wandeln [F6-F10|N1|N2]
- ****************************************************************************
- Shade cmpi.w #COLOR_CLI,d3 ;CLI-Scrn Color
- bne.s .0
- movea.l my_CliScrn(a5),a0
- moveq.l #COLOR_DEF,d3
- bra.s .1
- .0 movea.l my_ScrnPtr(a5),a0
- .1 lea sc_ViewPort(a0),a0
- GetColTab movea.l vp_ColorMap(a0),a1
- movea.l cm_ColorTable(a1),a1
- movea.l a1,a2
- move.l my_ColorCount(a5),d0
- cmpi.w #COLOR_DEF,d3 ;Default
- beq.s .1
- cmpi.w #COLOR_OS1,d3 ;OS.13
- bne.s .0
- moveq #4,d0
- lea Col13(pc),a1
- bra.s ColSet
- .0 cmpi.w #COLOR_OS2,d3 ;OS2.0
- bne.s ColClc
- moveq #4,d0
- lea Col20(pc),a1
- bra.s ColSet
- .1 lea my_DefPalette(a5),a1
- bra.s ColSet
- ColClc move.w d0,d1
- andi.l #$FFF,d3
- .1 moveq.l #0,d2
- move.w (a2),d2
- cmpi.w #COLOR_GRY,d3 ;Grey
- bne.s .2
- divu d3,d2
- swap d2
- bra.s .3
- .2 and.w d3,d2
- .3 sub.w d2,(a2)+
- dbf d1,.1
- ColSet GFX LoadRGB4 ;Farbwerte aktualisieren
- rts
- Col13 dc.w $05A,$FFF,$000,$F80
- Col20 dc.w $999,$000,$FFF,$68B
- ****************************************************************************
- * Bild in VPic BitMap - Format speichern [1-8]
- ****************************************************************************
- SaveVBM moveq.l #0,d0
- move.b my_KeyCode(a5),d0
- subq.b #1,d0
- lsl.w #2,d0
- movea.l my_ScrnPtr(a5),a0
- lea sc_BitMap(a0),a0
- lea bm_Planes(a0),a0
- move.l (a0,d0.l),d0 ;Plane[1-8] belegt
- beq Ok ;Nein! aber kein Fehler
- ;Zu speichernde Bitmap-Addresse übergeben
- move.l d0,my_PlanPtr(a5)
- ;Dateiname über ReqToolsFileRequest bestimmen
- lea TxRtSaveVBM(pc),a3
- bsr Rt_Input
- tst.l my_RtBut(a5)
- beq Ok
- OpenVBM move.l my_FileName(a5),d1
- move.l #MODE_NEWFILE,d2
- DOS Open
- move.l d0,my_FileHnd(a5)
- ble PrtSError
- ;Header einrichten & speichern
- moveq.l #0,d0
- lea my_VbmHeader(a5),a3
- move.l #ID_VPIC,vbm_Code(a3)
- move.l #ID_VBMP,vbm_Bmap(a3)
- movea.l my_ScrnPtr(a5),a4
- lea sc_ViewPort(a4),a0
- move.w vp_Modes(a0),vbm_ViewMode(a3)
- lea sc_BitMap(a4),a1
- move.w bm_BytesPerRow(a1),d0
- lsl.w #3,d0
- move.w d0,vbm_Width(a3)
- move.w bm_Rows(a1),vbm_Height(a3)
- move.l my_FileHnd(a5),d1
- move.l a3,d2
- moveq #vbm_SIZEOF,d3
- LIB Write
- ;Plane [1-8] speichern
- moveq.l #0,d0
- moveq.l #0,d3
- move.l my_FileHnd(a5),d1
- move.l my_PlanPtr(a5),d2
- move.w vbm_Width(a3),d0
- move.w vbm_Height(a3),d3
- lsr.w #3,d0
- mulu d0,d3
- LIB Write
- CloseVBM move.l my_FileHnd(a5),d1
- clr.l my_FileHnd(a5)
- LIB Close
- EndVBM bra PrtULine
- ****************************************************************************
- * CLI-Window auf max. Größe & Rahmen löschen
- ****************************************************************************
- CliMaxWind tst.b my_FromCLI(a5)
- beq Ok
- movem.l a0-a6/d0-d2,-(sp)
- movea.l my_CliWind(a5),a0
- move.b #0,wd_BorderLeft(a0)
- move.b #0,wd_BorderTop(a0)
- move.b #0,wd_BorderRight(a0)
- move.b #0,wd_BorderBottom(a0)
- moveq #0,d0
- moveq #0,d1
- moveq #0,d2
- move.w wd_LeftEdge(a0),d2
- sub.l d2,d0
- move.w wd_TopEdge(a0),d2
- sub.l d2,d1
- INT MoveWindow
- move.l #$280,d0
- move.l #$100,d1
- move.w wd_Width(a0),d2
- sub.l d2,d0
- move.w wd_Height(a0),d2
- sub.l d2,d1
- LIB SizeWindow
- WAIT 5
- movea.l my_CliWind(a5),a0
- movea.l wd_RPort(a0),a1
- moveq #0,d0
- GFX SetRast
- WAIT 5
- movem.l (sp)+,a0-a6/d0-d2
- rts
- ****************************************************************************
- * Falls Bildformat mit einem Datenpacker ge'crunch't ist, mittels der
- * decrunch.library entpacken. Die Bezeichnungen der DecrunchLib Offsets
- * entsprechen mit hoher Wahrscheinlichkeit nicht den Originalen. Leider sind
- * mir die Include-Dateien dieser Library nicht bekannt, weshalb ich mir auf
- * recht abenteuerlicher Weise (Reassemblierung einiger Objektdateien) Zugang
- * zu der Library verschaffen musste. Das Ergebnis hat sich aber gelohnt, da
- * nun weit über 100! Packverfahren erkannt und entkomprimiert werden!
- ****************************************************************************
- PicDcr movea.l my_FileBuf(a5),a0 ;Test ob evtl. das
- cmpi.l #'PP20',(a0) ;PP-Data Format?
- beq PpDcr ;Ja! Eigene Decrunchroutine
- cmpi.l #'XPKF',(a0) ;XPKF Format?
- beq XpkDcr ;Ja
- move.l my_DcrBase(a5),d0 ;DcrunchLib geöffnet?
- bne.s .1 ;Ja!
- lea DcrLib(pc),a1 ;DecrunchLib öffnen
- EXE OpenLibrary
- move.l d0,my_DcrBase(a5)
- beq.s .5 ;Hat nicht geklappt!
- .1 DCR dcrAllocTagItem ;Info-Struktur einrichten
- movea.l d0,a3
- move.l my_FileBuf(a5),dcr_PackedBuf(a3)
- move.l my_FileLen(a5),dcr_PackedLen(a3)
- movea.l a3,a0
- LIB dcrInitTagItem
- tst.l d0
- beq.s .4 ;Packverfahren unbekannt
- bsr PrtDcr
- movea.l a3,a0
- LIB dcrDecrunch
- tst.l d0
- beq.s .4 ;Entpackung unmöglich!
- .2 movea.l my_FileBuf(a5),a1
- move.l my_FileLen(a5),d0
- move.l dcr_UnPackedBuf(a3),my_FileBuf(a5)
- move.l dcr_UnPackedLen(a3),my_FileLen(a5)
- EXE FreeMem ;Alten Buffer freigeben
- .3 movea.l a3,a0
- DCR dcrFreeTagItem ;Struct Info freigeben
- bra Ok ;Flag immer = Kein Fehler!
- .4 bsr.s .3
- .5 bsr PrtVError
- bra Error ;Fehler!
- ;---------------------------------------------------------------------------
- ;Falls das Bild im PP-Data Format vorliegt, wird diese Routine aufgerufen.
- ;Da ich fast ausschließlich mit dem PowerPacker 3.0b meine Daten packe, muß
- ;nur im Sonderfall die decrunch.library geöffnet werden, somit braucht diese
- ;nicht immer verfügbar sein (Platzersparnis).
- ;
- ;A0 <= Zeiger auf PP20 Daten
- ;---------------------------------------------------------------------------
- PpDcr move.l my_FileLen(a5),d0
- move.l -4(a0,d0.l),d0
- lsr.l #8,d0
- moveq #MEMF_PUBLIC,d1
- move.l d0,my_PackLen(a5)
- EXE AllocMem
- move.l d0,my_PackBuf(a5)
- ble Error
- .1 bsr PrtDcr
- movea.l my_FileBuf(a5),a0
- movea.l my_PackBuf(a5),a1
- move.l my_FileLen(a5),d0
- bsr.s PpStart
- movea.l my_FileBuf(a5),a1
- move.l my_FileLen(a5),d0
- move.l my_PackBuf(a5),my_FileBuf(a5)
- move.l my_PackLen(a5),my_FileLen(a5)
- LIB FreeMem
- bra Ok
- PpStart lea 4(a0),a3
- adda.l d0,a0
- movea.l a1,a2
- moveq #1,d5
- moveq #3,d6
- moveq #7,d7
- move.l -(a0),d1
- tst.b d1
- beq.s .1
- bsr.s Pp2
- subq.b #1,d1
- lsr.l d1,d5
- .1 lsr.l #8,d1
- adda.l d1,a2
- Pp1 bsr.s Pp2
- bcs.s Pp5
- moveq #0,d2
- .1 moveq #1,d0
- bsr.s Pp4
- add.w d1,d2
- cmp.w d6,d1
- beq.s .1
- .2 moveq #7,d0
- bsr.s Pp4
- move.b d1,-(a2)
- dbra d2,.2
- cmpa.l a2,a1
- bcs.s Pp5
- rts
- Pp2 lsr.l #1,d5
- beq.s .1
- rts
- .1 move.l -(a0),d5
- roxr.l #1,d5
- rts
- Pp3 subq.w #1,d0
- Pp4 moveq #0,d1
- .1 lsr.l #1,d5
- beq.s .3
- .2 roxl.l #1,d1
- dbra d0,.1
- rts
- .3 move.l -(a0),d5
- roxr.l #1,d5
- bra.s .2
- Pp5 moveq #1,d0
- bsr.s Pp4
- moveq #0,d0
- move.b (a3,d1.w),d0
- move.w d1,d2
- cmp.w d6,d2
- bne.s .3
- bsr.s Pp2
- bcs.s .1
- moveq #7,d0
- .1 bsr.s Pp3
- move.w d1,d3
- .2 moveq #2,d0
- bsr.s Pp4
- add.w d1,d2
- cmp.w d7,d1
- beq.s .2
- bra.s .4
- .3 bsr.s Pp3
- move.w d1,d3
- .4 addq.w #1,d2
- .5 move.b (a2,d3.w),-(a2)
- dbra d2,.5
- cmpa.l a2,a1
- bcs.s Pp1
- rts
- ;---------------------------------------------------------------------------
- ;Da das Packprojekt der XPK-(Sub)Libraries weitreichend verwendet wird, und
- ;die 'decrunch.library' leider dieses nicht unterstützt, habe ich folgende
- ;XpkUnpack-Routine integriert. Somit ist VPic kompatibler zu einer Vielzahl
- ;an Packalgorithmen.
- ;---------------------------------------------------------------------------
- XpkDcr move.l my_XpkBase(a5),d0
- bne.s .0
- lea XpkLib(pc),a1
- EXE OpenLibrary
- move.l d0,my_XpkBase(a5)
- beq .2
- .0 movea.l my_FileBuf(a5),a0
- move.l 12(a0),d0
- moveq #MEMF_PUBLIC,d1
- move.l d0,my_PackLen(a5)
- EXE AllocMem
- move.l d0,my_PackBuf(a5)
- ble.s .2
- bsr PrtDcr
- lea XpkTagItem(pc),a0
- move.l my_FileBuf(a5),4(a0)
- move.l my_PackBuf(a5),12(a0)
- move.l my_FileLen(a5),20(a0)
- move.l my_PackLen(a5),28(a0)
- addi.l #XPK_MARGIN,28(a0)
- XPK XpkUnpack
- tst.l d0
- bne.s .1
- movea.l my_FileBuf(a5),a1
- move.l my_FileLen(a5),d0
- move.l my_PackBuf(a5),my_FileBuf(a5)
- move.l my_PackLen(a5),my_FileLen(a5)
- EXE FreeMem
- bra Ok
- .1 movea.l my_PackBuf(a5),a1
- move.l my_PackLen(a5),d0
- EXE FreeMem
- .2 bsr.s PrtVError
- bra Error ;Fehler!
- XpkTagItem dc.l XPK_InBuf,0 ;SAdr
- dc.l XPK_OutBuf,0 ;DAdr
- dc.l XPK_InLen,0 ;SLen
- dc.l XPK_OutBufLen,0 ;DLen
- dc.l XPK_Password,0 ;Password
- dc.l XPK_GetError,0 ;Errorstring
- dc.l XPK_PassThru,-1 ;Packed data
- dc.l XPK_ShortError ;Only error
- dc.l TAG_DONE ;TagItemEnd
- ****************************************************************************
- * Allgemeine Request-/Textausgabe
- ****************************************************************************
- PrtVError lea TxRtVError(pc),a0
- bra.s Rt_Error
- PrtSError lea TxRtSError(pc),a0
- Rt_Error lea my_FmtData(a5),a1
- move.l my_FileName(a5),(a1)
- bsr Rt_Fmt
- lea my_DataBuf(a5),a4
- move.l a0,8(a4)
- lea TxRtError(pc),a0
- move.l a0,(a4)
- lea TxRtOK(pc),a0
- move.l a0,4(a4)
- bsr Rt_Request
- bra.s PrtCLine
- PrtDcr bsr.s PrtCLine
- lea my_FmtData(a5),a0
- move.l my_FileName(a5),(a0)
- lea TxDecr(pc),a0
- bra.s Fmt
- PrtView bsr.s PrtCLine
- lea my_FmtData(a5),a0
- move.l my_FileName(a5),(a0)
- lea TxView(pc),a0
- bra.s Fmt
- PrtLLine lea TxLLine(pc),a0
- bra.s Fmt
- PrtULine lea TxUFeed(pc),a2
- bsr.s Prt
- PrtCLine lea TxCFeed(pc),a2
- Prt tst.b my_FromCLI(a5) ;Nur von CLI/Shell aus
- beq Ok
- movem.l a0-a6/d0-d7,-(sp)
- move.l my_OutPut(a5),d1
- move.l a2,d2
- .0 tst.b (a2)+
- bne.s .0
- move.l a2,d3
- sub.l d2,d3
- DOS Write
- movem.l (sp)+,a0-a6/d0-d7
- rts
- Fmt tst.b my_FromCLI(a5)
- beq Ok
- movem.l a0-a6/d0-d7,-(sp)
- lea my_FmtData(a5),a1
- lea .0(pc),a2
- lea my_FmtChData(a5),a3
- EXE RawDoFmt
- lea my_FmtChData(a5),a2
- bsr.s Prt
- movem.l (sp)+,a0-a6/d0-d7
- rts
- .0 move.b d0,(a3)+
- rts
- Rt_Fmt movem.l a1-a6/d0-d7,-(sp)
- lea my_FmtData(a5),a1
- lea .0(pc),a2
- lea my_FmtChData(a5),a3
- EXE RawDoFmt
- lea my_FmtChData(a5),a0
- movem.l (sp)+,a1-a6/d0-d7
- rts
- .0 move.b d0,(a3)+
- rts
- ****************************************************************************
- * Das DirEntryCount-Verfahren soll eine Erleichterung für eine vereinfachte
- * Parameterübergabe darstellen. Die Idee basiert darauf das die Eintragungen
- * eines Pfades immer gleich über die DOS Funktion Examine ausgelesen werden.
- * Dieses macht sich das DirEntryCount-Verfahren zu nutze indem einfach die
- * Kennung # gefolgt von der Nummer des Eintrages als Ersatz für einen
- * Dateinamen übergeben werden kann, über diese Angabe wird der zu der Nummer
- * gehörende Dateiname ermittelt und eingesetzt.
- ****************************************************************************
- ;Beispiel: VPic DF3:Pics/#7
- ;Ergebnis: VPic DF3:Pics/Name der zu zeigenden Grafik
- dec_init movem.l a0-a6/d0-d7,-(sp)
- movea.l my_FileName(a5),a0 ;A0 = #DirEntryCount
- lea my_CountFib(a5),a1 ;A1 = Buffer[260]
- movea.l a0,a3
- movea.l a1,a4
- dec_searchid cmpi.b #'#',(a0) ;ID_DirEntryCount (#)
- beq.s dec_foundid
- tst.b (a0)+
- bne.s dec_searchid
- bra.s dec_end
- dec_foundid movea.l a0,a2 ;A2 = # Position für Fehler
- clr.b (a0)+ ;Für DosLock
- moveq #0,d0 ;Ziffer
- moveq #0,d7 ;DirEntryCount
- dec_convcount move.b (a0)+,d0 ;String in Count.w Zahl
- subi.b #'0',d0
- bmi.s dec_lock
- mulu #10,d7
- ext.w d0
- add.w d0,d7
- bra.s dec_convcount
- dec_lock move.l a3,d1 ;Pfad ohne DirEntryCount
- moveq.l #ACCESS_READ,d2
- DOS Lock
- move.l d0,d6
- ble.s dec_error
- move.l d6,d1 ;Lock
- move.l a4,d2 ;FileInfoBlock
- LIB Examine
- tst.l d0
- beq.s dec_error
- dec_excount move.l d6,d1 ;Lock
- move.l a4,d2 ;FileInfoBlock
- LIB ExNext
- tst.l d0
- beq.s dec_error
- subq.w #1,d7
- bgt.s dec_excount ;Bis DirEntryCount
- lea fib_FileName(a4),a0
- lea fib_EntryType(a4),a1
- dec_movename move.b (a0)+,(a1)+
- bne.s dec_movename
- movea.l a4,a1 ;FileInfoBlock
- dec_path move.b (a3)+,(a1)+ ;Pfad installieren
- bne.s dec_path
- subq.l #1,a1
- lea fib_EntryType(a4),a0 ;Zwischenpuffer für Datei
- dec_name move.b (a0)+,(a1)+ ;Datei installieren
- bne.s dec_name
- move.l a4,my_FileName(a5) ;Init. Pfad+Datei
- dec_unlock move.l d6,d1
- ble.s dec_end
- DOS UnLock
- dec_end movem.l (sp)+,a0-a6/d0-d7
- rts
- dec_error move.b #'#',(a2) ;ID_DirEntryCount
- move.l a2,my_FileName(a5) ;Angabe zurücksetzen
- bra.s dec_unlock
- ****************************************************************************
- * Fehler/Ok-Flags, Tastatur-Code, Warten
- ****************************************************************************
- Error moveq #-1,d0 ;Fehler!
- rts
- Ok moveq #0,d0 ;Alles geklappt!
- rts
- CKey moveq.l #0,d1
- btst #6,$BFE001
- bne.s .0
- move.b #$FF,my_KeyCode(a5)
- rts
- .0 move.b $BFEC01,d1
- eori.w #$FF,d1
- ror.b #1,d1
- move.b d1,my_KeyCode(a5)
- cmpi.b #RAW_ESC,d1 ;Globaler ESC-Test
- rts
- Wait movem.l a6/d0,-(sp) ;D1 = Wartezyklen 1/50
- DOS Delay
- movem.l (sp)+,a6/d0
- rts
- ****************************************************************************
- * Usage & Keylist
- ****************************************************************************
- Rt_Usage lea my_DataBuf(a5),a4
- lea TxRtUsage(pc),a0
- move.l a0,(a4)
- lea TxRtOKKEYS(pc),a0
- move.l a0,4(a4)
- lea TxUsage(pc),a0
- move.l a0,8(a4)
- bsr.s Rt_Request
- tst.l my_RtBut(a5)
- beq.s Ok
- .0 lea my_DataBuf(a5),a4
- lea TxRtKeys(pc),a0
- move.l a0,(a4)
- lea TxRtOKUSAGE(pc),a0
- move.l a0,4(a4)
- lea TxKeyList(pc),a0
- move.l a0,8(a4)
- bsr.s Rt_Request
- tst.l my_RtBut(a5)
- bne.s Rt_Usage
- bra Ok
- ****************************************************************************
- * ReqTools Request / Filerequest
- ****************************************************************************
- ;In = 0(a4) - Fenstertitel
- ; 4(a4) - Schalterbezeichnung(en)
- ; 8(a4) - Textzeilen
- ;Out = my_RtBut(a5) - Schalternummer
- Rt_Request clr.l my_RtBut(a5)
- bsr Rt_OpenLib
- bne Error
- suba.l a0,a0
- REQ rtAllocRequestA
- tst.l d0
- ble Error
- move.l d0,my_RtInfoReq(a5)
- movea.l d0,a3
- move.l #1,(a3)
- move.w #0,4(a3)
- move.w #0,6(a3)
- move.l (a4),12(a3) ;Fenstertitel
- move.l #0,16(a3)
- suba.l a0,a0
- movea.l 8(a4),a1 ;Textzeilen
- movea.l 4(a4),a2 ;Schalterbezeichnung(en)
- suba.l a4,a4
- LIB rtEZRequestA
- move.l d0,my_RtBut(a5) ;Schalternummer
- movea.l my_RtInfoReq(a5),a1
- LAB rtFreeRequest
- Rt_Input clr.l my_RtBut(a5)
- bsr Rt_OpenLib
- bne Ok
- Rt_FileReq tst.l my_RtFileReq(a5)
- bne.s .0
- suba.l a0,a0
- moveq.l #0,d0
- REQ rtAllocRequestA
- tst.l d0
- ble Error
- move.l d0,my_RtFileReq(a5)
- .0 suba.l a0,a0
- movea.l my_RtFileReq(a5),a1
- move.l #1,(a1)
- move.w #0,4(a1)
- move.w #0,6(a1)
- move.l #0,8(a1)
- lea my_DataBuf(a5),a2
- REQ rtFileRequestA
- move.l d0,my_RtBut(a5)
- beq Ok
- lea my_InputBuf(a5),a0
- move.l a0,my_FileName(a5)
- move.l my_RtFileReq(a5),a1
- lea my_DataBuf(a5),a2
- movea.l 16(a1),a1
- .1 move.b (a1)+,(a0)+
- bne.s .1
- suba.l #1,a0
- cmpi.b #':',-1(a0)
- beq.s .2
- move.b #'/',(a0)+
- .2 move.b (a2)+,(a0)+
- bne.s .2
- bra Ok
- Rt_OpenLib move.l my_ReqBase(a5),d0
- bne.s .0
- lea ReqLib(pc),a1
- EXE OpenLibrary
- move.l d0,my_ReqBase(a5)
- ble.s .1
- .0 bra Ok
- .1 lea .2(pc),a2
- bsr Prt
- bra Error
- .2 dc.b $A,$B,$9B,"33mError",$9B,"0m: Need reqtools.library!",10,0
- ****************************************************************************
- * Datenbereich
- ****************************************************************************
- TxUsage dc.b 'Usage: VPic [file|list|path|#DEC] [0|1] [*|?]',10,10
- dc.b ' file - View a single picture',10
- dc.b ' list - View pics defined in a list',10
- dc.b ' path - View all pics avail in path',10
- dc.b ' #DEC - View pic named by DirEntryCount',10,10
- dc.b ' [0] - View picture in actual CLI-Wind',10
- dc.b ' [1] - View pic and set color in CLI-Wind',10,10
- dc.b ' [*] - View next actual screen',10,10
- dc.b 'VPic V2.00 FD © 2002 by Peace of Testaware',0
- even
- TxKeyList dc.b '[F1] ............ Info of pic [N1] ........Set OS1.3 color',10
- dc.b '[F2] ............ Save as IFF [N2] ........Set OS2.0 color',10
- dc.b '[F3] ........... Negative pic [1-8] .......... Save as VBM',10
- dc.b '[F4] ........ Pic to CLI-Wind [HELP] ... Usage and keylist',10
- dc.b '[F5] .. Pic/color to CLI-Wind [RETURN] .. View next screen',10
- dc.b '[F6] .............. Red shade [RALT] ........ Multitasking',10
- dc.b '[F7] ............ Green shade [LALT] ... Stop multitasking',10
- dc.b '[F8] ............. Blue shade [SPACE] .......... Close pic',10
- dc.b '[F9] ............. Grey shade [LMB] ............ Close pic',10
- dc.b '[F10] ......... Default color [ESC] ............ Abort all',0
- even
- TxRtLoadPIC dc.b 'Load a picture',0
- TxRtSaveIFF dc.b 'Save as IFF',0
- TxRtSaveVBM dc.b 'Save as VBM',0
- TxRtPicInfo dc.b 'Info of picture',0
- TxRtColorTab dc.b 'Colortable [$RGB]',0
- TxRtUsage dc.b 'Usage of VPic',0
- TxRtKeys dc.b 'Keylist of VPic',0
- TxRtError dc.b 'Error',0
- TxRtVError dc.b 'Can`t view %s',0
- TxRtSError dc.b 'Can`t save %s',0
- TxRtOK dc.b ' Ok ',0
- TxRtOKKEYS dc.b 'Keys| Ok ',0
- TxRtOKCOLS dc.b 'Colors| Ok ',0
- TxRtOKINFO dc.b 'Info| Ok ',0
- TxRtOKUSAGE dc.b 'Usage| Ok ',0
- even
- TxFORM dc.b 'FORM'
- dc.l 0
- TxILBM dc.b 'ILBM'
- TxBMHD dc.b 'BMHD'
- dc.l ibm_SIZEOF
- ds.b ibm_SIZEOF
- TxANNO dc.b 'ANNO'
- dc.l 34
- dc.b 'VPic Release 2.00 © by Testaware',0,0
- TxCAMG dc.b 'CAMG'
- dc.l 4
- dc.l 0
- TxCMAP dc.b 'CMAP'
- dc.l 0
- TxFormL equ *-TxFORM
- TxBODY dc.b 'BODY'
- dc.l 0
- TxInfo dc.b 'Name :%s',10
- dc.b 'Width :%d',10
- dc.b 'Height:%d',10
- dc.b 'Depth :%d',10
- dc.b 'Colors:%ld',10
- dc.b 'Mode :$%x',10
- dc.b 'Typ :%s',10
- dc.b 'Size :%ld'
- TxCopy dc.b 10
- dc.b '(c) :%s'
- TxAuth dc.b 10
- dc.b 'Auth :%s'
- TxAnno dc.b 10
- dc.b 'Anno :%s',0
- even
- TxColMap dc.b 'C%02d:$%03x ',0
- even
- TxTyp dc.b 'IFF Raw BitMap ',0
- dc.b 'IFF Compressed ',0
- dc.b 'IFF ACBM BitMap',0
- dc.b 'AMOS DataPack ',0
- dc.b 'AMOS ScreenPack',0
- dc.b 'VPic BitMap ',0
- dc.b 'WorkBench Info ',0
- dc.b 'Actual Screen ',0
- TxView dc.b $9B,'33mView',$9B,'0m: %s',0
- TxDecr dc.b $9B,'33mDecrunch',$9B,'0m: %s',0
- TxUFeed dc.b $B,0
- TxCFeed dc.b $9B,$4D,$A,$B,0
- TxLLine dc.b $C,$9B,'32',$74,$9B,'%d',$48,0
- even
- DosLib DOSNAME
- IntLib INTNAME
- GfxLib GRAFNAME
- XpkLib XPKNAME
- DcrLib DCRNAME
- ReqLib dc.b 'reqtools.library',0
- even
- END
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement